Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0100/lin814.for
There is 1 other file named lin814.for in the archive. Click here to see a list.
C              LINEAR LEAST-SQUARES CURVE FITTING PROGRAM               CF0 0010
C                               1/81                                    CF0 0020
C ***       PROGRAM CURRENTLY DIMENSIONED FOR 65 MAX VARIABLES          CF0 0030
C --- BEFORE TRANSFORMATIONS, 40 VARIABLES AFTER TRANSFORMATIONS,       CF0 0040
C --- 1000 OBSERVATIONS,  COMPONENT EFFECTS TABLE = (VARIABLES X        CF0 0050
C --- OBSERVATIONS) = 6,562, 8 FORMAT CARDS, AND 5 DELETE OBSERVATIONS  CF0 0060
C --- CARDS AND 5 INDICATOR-VARIABLE-OBSERVATIONS CARDS.                CF0 0061
C                                                                       CF0 0070
C          PROGRAM WRITTEN AND REVISED AT STANDARD OIL (INDIANA) BY     CF0 0080
C     R. A. BREHMER, P. E. PIECHOCKI, W. B. TRAVER, F. M. JACOBSEN,     CF0 0090
C     F. M. OLIVA, R. J. TOMAN AND F. S. WOOD IN DOUBLE PRECISION       CF0 0100
C     FOR IBM 360 AND 370 SYSTEM COMPUTERS (SHARE LIBRARY PROGRAM       CF0 0110
C     NUMBER 360D-13.6.008).                                            CF0 0111
C                                                                       CF0 0120
C          PROGRAM CONVERTED AT UNIV. CAL(BERKELEY) BY N. H. TIMM TO    CF0 0130
C     SINGLE PRECISION FOR CDC 6000 SERIES COMPUTERS (VIM LIBRARY       CF0 0140
C     PROGRAM NUMBER G2-CAL-LINWOOD).  UPDATED BY TIMM, WOOD, AND       CF0 0150
C     B. E. FOSTER AND ELI COHEN, NORTHWESTERN UNIVERSITY.              CF0 0151
C                                                                       CF0 0160
C          PROGRAM MODIFIED AT ALCOA R&D LABORATORIES BY  R. F. KOHM    CF0 0170
C     TO ALLOW FOR OVERLAYING AND CONVERSION FOR DECSYSTEM-10 AND 20    CF0 0180
C     COMPUTERS (DECUS LIBRARY PROGRAM NUMBER LINWOOD-10-257).  PROGRAM CF0 0181
C     ADAPTED FOR INTERACTIVE USE BY E. R. ZIEGEL AND UPDATED BY        CF0 0182
C     M. P. KELLY, BOTH AT STANDARD OIL.                                CF0 0183
C     PROGRAM FOR DECSYSTEM PDP-11 COMPUTERS CONVERTED AT U.S. NAVAL    CF0 0184
C     AVIONICS FACILITY, INDIANAPOLIS, INDIANA BY D. F. ZARNOW          CF0 0185
C     (DECUS LIBRARY PROGRAM NUMBER LINWOOD-11-419).                    CF0 0186
C                                                                       CF0 0190
C          PROGRAM CONVERTED AT UNIV. WISCONSIN BY J. D. MURAT AND      CF0 0191
C     T. R. ZEISLER FOR BURROUGHS 4700 AND 6700 SYSTEM COMPUTERS (CUBE  CF0 0192
C     LIBRARY PROGRAM NUMBER WIS/LINWOOD).  THE PROJECT WAS INITIATED   CF0 0193
C     BY D. S. RUMSEY OF BURROUGHS.                                     CF0 0194
C                                                                       CF0 0200
C          PROGRAM CONVERTED AT JOHNSON SPACE CENTER BY J. E. KEITH     CF0 0201
C     FOR UNIVAC 1108 COMPUTERS (PROGRAM NUMBER LINWOOD).               CF0 0202
C                                                                       CF0 0203
C          PROGRAM CONVERTED AT U.S. NAVAL AVIONICS FACILITY,           CF0 0210
C     INDIANAPOLIS, IND. BY D. F. ZARNOW FOR HONEYWELL 60000/600/66     CF0 0211
C     COMPUTERS.  PROGRAM UPDATED AT CPC INTERNATIONAL, ARGO, ILLINOIS  CF0 0212
C     BY J. L. MAXWELL AND J. E. MC LEOD (HLSUA LIBRARY PROGRAM NUMBER  CF0 0213
C     GES-1206).                                                        CF0 0214
C                                                                       CF0 0215
C          FOR GLOSSARY OF TERMS, DEFINITIONS OF STATISTICS AND         CF0 0220
C     INTERPRETATION OF RESULTS SEE USER'S MANUAL IN BOOK "FITTING      CF0 0230
C     EQUATIONS TO DATA" BY C. DANIEL AND F. S. WOOD WITH ASSISTANCE    CF0 0240
C     OF J. W. GORMAN, 2ND EDITION, WILEY 1980.                         CF0 0250
C                                                                       CF0 0260
C                                                                       CF0 0270
C ---    AUXILIARY EQUIPMENT NEEDED TO RUN PROGRAM (DEFINED IN          CF0 0280
C --- SUBROUTINE BASPGM, CF1)                                           CF0 0290
C                                                                       CF0 0300
C ---      CARD READER (UNIT 5), PRINTER (6), 4 SCRATCH FILES (1 TO 4)  CF0 0310
C --- AND CARD PUNCH (7) IF DESIRED.                                    CF0 0320
C                                                                       CF0 0330
C                                                                       CF0 0340
C ---               ORDER OF CARDS FOR EACH PROBLEM                     CF0 0350
C                                                                       CF0 0360
C --- 1  CONTROL CARD.                                                  CF0 0370
C --- 2  FORMAT CARD(S), IF ANY.                                        CF0 0380
C --- 3  DELETE OBSERVATIONS CARD(S), IF ANY.                           CF0 0381
C --- 4  INDICATOR-VARIABLE-OBSERVATIONS CARD(S), IF ANY.               CF0 0382
C --- 5  TRANSFORMATION CARD(S), IF ANY.                                CF0 0390
C --- 6  INFORMATION CARD(S) FOR PRINTOUT, IF ANY.                      CF0 0400
C --- 7  NAMES OF VARIABLES CARD(S) FOR PRINTOUT, IF ANY.               CF0 0410
C --- 8  CP SELECTED SEARCH CARD(S), IF ANY.                            CF0 0420
C --- 9  DATA CARDS (IF NOT READ FROM A FILE).                          CF0 0430
C ---10  END CARD (END IN COL 1-3 OF IDENTIFICATION FIELD).  THE NUMBER CF0 0440
C ---     OF END CARDS MUST EQUAL THE NUMBER OF CARDS PER OBSERVATION.  CF0 0450
C ---     END CARDS ARE NOT NEEDED IF DATA ARE READ FROM A FILE.        CF0 0451
C ---11  ESTIMATE OF VARIANCE CARD(S), IF ANY, FOR EACH                 CF0 0460
C ---     DEPENDENT VARIABLE.                                           CF0 0470
C ---                                                                   CF0 0480
C ---                                                                   CF0 0490
C --- NOTE: FORMAT, DATA, END AND NAME CARDS ARE NOT NEEDED IN          CF0 0500
C ---        SUBSEQUENT PROBLEMS IF SAME INPUT DATA ARE REUSED.         CF0 0510
C                                                                       CF0 0520
C                                                                       CF0 0530
C ---                  GLOSSARY OF CONTROL CARD                         CF0 0540
C                                                                       CF0 0550
C --- COL. Q(I) DESCRIPTION    (NOTE: BLANKS = 0)                       CF0 0560
C --- 1-18      PROBLEM IDENTIFICATION.                                 CF0 0570
C ---19-20   1  NUMBER OF INDEPENDENT VARIABLES READ IN.                CF0 0580
C ---21-22   2  NUMBER OF   DEPENDENT VARIABLES READ IN.                CF0 0590
C ---   24      E CAUSES RESIDUALS, Y AND FITTED Y TO TO BE             CF0 0600
C ---              LISTED WITH E FORMAT RATHER THAN F FORMAT.           CF0 0610
C ---   25   3  1 DO TRANSFORMATIONS.                                   CF0 0620
C ---   26   4  1 WEIGHT OBSERVATIONS. WEIGHT ENTERED IN LAST POSITION. CF0 0630
C ---           2 WEIGHT BY 1/VAR. OF OBSERVATION.  VARIANCE ENTERED.   CF0 0631
C ---   27   5  1 LET B(0) = ZERO, OTHERWISE B(0) IS CALCULATED VALUE.  CF0 0640
C ---   28   6  1 CHECK OBSERVATION NUMBER SEQUENCE.                    CF0 0650
C ---   29   7  1 CHECK SEQUENCE WITHIN OBSERVATION NUMBER.             CF0 0660
C ---   30   8  1 DO BACK TRANSFORMATION OF DEPENDENT VARIABLE.         CF0 0670
C ---   31   9  1 PUNCH DATA FOR CONFIDENCE INTERVAL PROGRAM.           CF0 0680
C ---   32  10  0 (OR BLANK) LIST ALL INPUT DATA.                       CF0 0690
C ---           1 LIST ONLY 1ST OBSERVATION.                            CF0 0700
C ---           2 DO NOT LIST ANY INPUT DATA.                           CF0 0710
C ---   33  11  0 LIST TRANSFORMATIONS AND ALL TRANSFORMED DATA.        CF0 0720
C ---           1 LIST TRANSFORMATIONS AND 1ST TRANSFORMED OBSERVATION. CF0 0730
C ---           2 DO NOT LIST TRANSFORMATIONS OR TRANSFORMED DATA.      CF0 0740
C ---   34  12  1 DO NOT LIST SUMS OF VARIABLES.                        CF0 0750
C ---   35  13  1 DO NOT LIST RAW SUMS AND CROSS PRODUCTS WHEN B(O)=O.  CF0 0760
C ---   36  14  1 DO NOT LIST RESIDUAL SUMS AND CROSS PRODUCTS.         CF0 0770
C ---   37  15  1 DO NOT LIST MEANS AND ROOT MEAN SQUARES OF VARIABLES. CF0 0780
C ---   38  16  1 DO NOT LIST SIMPLE CORRELATION COEFFICIENTS.          CF0 0790
C ---   39  17  1 DO NOT LIST INVERSE MATRIX.                           CF0 0800
C ---   40  18  1 DO NOT PRINT PLOTS OF RESIDUALS VS. FITTED Y.         CF0 0810
C ---           2 PLOT (A) RESIDUALS AND (B) COMPONENT AND COMPONENT-   CF0 0820
C ---              PLUS-RESIDUALS VS. EACH INDEPENDENT VARIABLE.        CF0 0830
C ---           3 PLOT (A) RESIDUALS ONLY.                              CF0 0840
C ---           4 PLOT (B) COMPONENT AND COMPONENT-PLUS-RESIDUALS ONLY. CF0 0850
C ---           5 PLOT (B) BUT EXPAND SCALE TO FILL EACH PLOT.          CF0 0860
C ---           TO OMIT PLOTS OF SPECIFIC INDEPENDENT VARIABLES, ON     CF0 0861
C ---           THE TRANSFORMATION CARDS PUT A 2 IN THE OMIT COLUMNS    CF0 0862
C ---           OF THOSE VARIABLES.                                     CF0 0863
C ---   41  19  0 READ DATA WITH STANDARD FORMAT (A6, I4, I2, 10F6.3).  CF0 0870
C ---           1 READ DATA WITH FORMAT TO BE READ, 1CARD(72COL)ASSUMED.CF0 0880
C ---           2 READ DATA WITH READ DATA (REDATA) SUBROUTINE.         CF0 0890
C ---   42  20  0 DO NOT SAVE DATA FOR NEXT PROBLEM.                    CF0 0900
C ---           1 SAVE DATA FOR NEXT PROBLEM.                           CF0 0910
C ---           2 REUSE DATA FROM PREVIOUS PROBLEM.                     CF0 0920
C ---43-44  21  MAXIMUM NUMBER OF VARIABLES IN CP                       CF0 0930
C ---            STANDARD SEARCH IF GREATER THAN 12,                    CF0 0931
C ---            MODIFIED LEAPS AND BOUNDS SEARCH IF GREATER THAN 18.   CF0 0932
C ---   45  22  NUMBER OF FORMAT CARDS IF GREATER THAN 1. (8 MAX.)      CF0 0940
C ---46-47  23  NUMBER OF INFORMATION CARDS TO BE READ FOR DISPLAY ON   CF0 0950
C ---            PRINTOUT IF DESIRED, 72 COL. EACH, 12 CARDS MAXIMUM.   CF0 0960
C ---   48  24  0 DO NOT READ NAMES OF VARIABLES FOR DISPLAY ON         CF0 0970
C ---              PRINTOUT.                                            CF0 0980
C ---           1 READ NAMES OF VARIABLES FROM CARDS. (NAMES IN SAME    CF0 0990
C ---              POSITION AS VARIABLES ON TRANSFORMATION CARDS -      CF0 1000
C ---              COLS. 1-6, 11-16, - - - , 61-66. (NAMES ARE NOT      CF0 1010
C ---              MOVED, ONLY LISTED OR DELETED.)                      CF0 1020
C ---           2 REUSE NAMES OF VARIABLES FROM PREVIOUS PROBLEM.       CF0 1030
C ---   49  25  CP SEARCH FOR CANDIDATE EQUATIONS.  USE ESTIMATE        CF0 1040
C ---            OF VARIANCE (RMS) FROM                                 CF0 1050
C ---             1 FULL EQUATION,                                      CF0 1060
C ---             2 SUBSET EQUATION WITH MINIMUM RMS VALUE, OR          CF0 1070
C ---             3 ESTIMATE OF VARIANCE CARD, F16.8 FORMAT.            CF0 1080
C ---             CP SEARCH BY MODIFIED LEAPS AND BOUNDS.               CF0 1081
C ---             4 ESTIMATE RMS FROM 1 ABOVE,                          CF0 1082
C ---             5 ESTIMATE RMS FROM 2 ABOVE, OR                       CF0 1083
C ---             6 ESTIMATE RMS FROM 3 ABOVE.                          CF0 1084
C ---   50  26  NUMBER OF CP SELECTED SEARCH CARDS TO BE READ.          CF0 1090
C ---            KEYPUNCH WITH A 18(2X,I2) FORMAT IN ASCENDING ORDER    CF0 1100
C ---            THE IDENTIFICATION NUMBER OF THE VARIABLES (AFTER      CF0 1110
C ---            TRANSFORMATIONS) TO BE USED IN THAT SEARCH.            CF0 1120
C ---            ALL OTHER VARIABLES WILL BE PLACED IN BASIC EQUATION.  CF0 1130
C ---            IF THE TOTAL NUMBER OF VARIABLES TO BE SEARCHED IS     CF0 1131
C ---            LARGE, GIVE TOTAL IN COLUMNS 43-44.                    CF0 1132
C ---   51  27  1 LIST COMPONENT-EFFECT TABLE, REQUIRED X(I) PRECISION, CF0 1140
C ---              ESTIMATE OF STANDARD DEVIATION FROM NEAR NEIGHBORS,  CF0 1150
C ---              AND FUNCTIONS OF FITTED Y.                           CF0 1160
C ---           2 LIST ONLY ESTIMATE OF STD. DEVIATION AND FUNCTIONS.   CF0 1170
C ---           3 LIST ONLY FUNCTIONS OF FITTED Y.                      CF0 1171
C ---52-53  28  NUMBER OF FILE IF DATA ARE READ FROM SEPARATE FILE,     CF0 1180
C ---            NO END CARD IF ONLY ONE SET OF DATA IS ON EACH FILE.   CF0 1190
C ---54-55  29  NUMBER OF INDEPENDENT VARIABLES GREATER THAN THE 99     CF0 1200
C ---             ALLOWED IN COLS 19-20.                                CF0 1210
C ---56-58  30  TO REDUCE PRINTOUT WITH MANY OBSERVATIONS,              CF0 1220
C ---             NUMBER OF CENTRAL OBSERVATIONS AND RESIDUALS NOT      CF0 1230
C ---             TO BE PRINTED WITH E IN COL 24.                       CF0 1240
C ---   59  31  CROSS VERIFICATION OF MODEL AND COEFFICIENTS WITH A     CF0 1250
C ---            SECOND SAMPLE OF DATA.                                 CF0 1260
C ---             1 WRITE B(0) AND B(I)S ON FILE KTIN5 IN ONE PROBLEM   CF0 1270
C ---               (TRANSFORMATIONS ARE NOT SAVED).                    CF0 1280
C ---             2 READ  B(0) AND B(I)S ON FILE KTIN5 IN NEXT PROBLEM  CF0 1290
C ---               WITH SECOND SET OF OBSERVATIONS.                    CF0 1300
C ---   60  32  NUMBER OF DELETE OBSERVATION CARDS.  KEYPUNCH           CF0 1301
C ---            OBSERVATION NUMBER OF DATA TO BE DELETED IN ORDER READ CF0 1302
C ---            BY COMPUTER USING 7(I4,6X) FORMAT.  5 CARDS MAXIMUM.   CF0 1303
C ---   61  33  NUMBER OF INDICATOR-VARIABLE-OBSERVATION CARDS.         CF0 1304
C ---            USING A 7(I4,2X,I3,1X) FORMAT, KEYPUNCH OBSERVATION    CF0 1305
C ---            NUMBER (IN ORDER READ) AND VARIABLE NUMBER (BEFORE     CF0 1306
C ---            TRANSFORMATIONS) INTO WHICH A 1 IS TO BE INSERTED.     CF0 1307
C ---            5 CARDS MAXIMUM.                                       CF0 1308
C                                                                       CF0 1310
C          ROUTINES CF1 THROUGH CF16 ARE WRITTEN IN USASI FORTRAN IV    CF0 1320
C                                                                       CF0 1330
C                                                                       CF0 1340
C ***                   DIMENSION STATEMENTS TO MAKE                    CF0 1350
C ***              A 50 VARIABLE, 2000 OBSERVATION PROGRAM              CF0 1360
C *** DOUBLE PRECISION IDZA(2000), IDENT, IEND, LIEND                   CF0 1370
C *** DIMENSION AMAX(50), AMIN(50), AVATR( 75), AVG(50), B(50),         CF0 1380
C ***1    BETA(50), C(50,50), DATA( 76), DELTA(2000), FMT(144),         CF0 1390
C ***2    IDZB(2000), IOMIT( 75), IQ(40), ITLOC( 75), ITRFM( 75),       CF0 1400
C ***3    LSORT(2000), SIGMA(50), STDDEV(50), VAR(50), VARTR( 75),      CF0 1410
C ***4    W1(50), YRESID(50), YYCC(2000), YYIN(2000), Z(51,51)          CF0 1420
C *** DIMENSION A(50,50), LP(50), C(50)     (IN SUBROUTINE CF6)         CF0 1430
C                                                                       CF0 1440
C ***                   DIMENSION STATEMENTS TO MAKE                    CF0 1450
C ***              A 80 VARIABLE, 1000 OBSERVATION PROGRAM              CF0 1460
C *** DOUBLE PRECISION IDZA(1000), IDENT, IEND, LIEND                   CF0 1470
C *** DIMENSION AMAX(80), AMIN(80), AVATR(105), AVG(80), B(80),         CF0 1480
C ***1    BETA(80), C(80,80), DATA(106), DELTA(1000), FMT(144),         CF0 1490
C ***2    IDZB(1000), IOMIT(105), IQ(40), ITLOC(105), ITRFM(105),       CF0 1500
C ***3    LSORT(1000), SIGMA(80), STDDEV(80), VAR(80), VARTR(105),      CF0 1510
C ***4    W1(80), YRESID(80), YYCC(1000), YYIN(1000), Z(81,81)          CF0 1520
C *** DIMENSION A(80,80), LP(80), C(80)     (IN SUBROUTINE CF6)         CF0 1530
C                                                                       CF0 1540
C                                                                       CF0 1550
C ---      LOCATION AND DIMENSIONS OF COMMON STATEMENTS *               CF0 1560
C --- A USED IN CF 1-5,9,12,  DIM=MAX OBSERVATIONS                      CF0 1570
C ---              16,18                                                CF0 1571
C --- B USED IN CF 1-5,9,12,  DIM=(MAX TRANSFORMATIONS+1)+MAX VARIABLES CF0 1580
C ---              19                                                   CF0 1581
C --- C USED IN CF 0-4,12,19  DIM=3*MAX VARIABLES OR 36 MIN.            CF0 1590
C --- D USED IN CF 1,3,4,9,   IN CF 4 AVAILABLE FOR REDATA CALCULATIONS CF0 1600
C ---              12,18,19                                             CF0 1601
C --- D IN CF 3               DIM=3*(MAX OBSV.) + INTERGER MAX OBSV.    CF0 1610
C --- D IN CF 9               DIM=GRIDA+GRIDB+2*(MAX OBSV.)+MAX VAR     CF0 1620
C --- D IN CF 12              DIM=IS(20+K) WHERE K=18 OR MAX VAR,  +    CF0 1630
C ---                             GRIDA(1378)+GRIDB(1378)               CF0 1631
C ---   IN DOUBLE PRECISION PROGRAMS GRIDA, GRIDB ARE SINGLE PRECISION  CF0 1632
C --- E USED IN CF 1,3,4,6,   DIM=MAX OBSERVATIONS                      CF0 1640
C ---              9,12,18                                              CF0 1641
C --- F USED IN CF 1-5,8,16   DIM=2*MAX TRANSFORMATIONS                 CF0 1650
C --- FORFIT IN CF 0-3,12     DIM=10                                    CF0 1651
C ---              18,19                                                CF0 1652
C --- G USED IN CF 1-4,9,12,  DIM=MAX VAR BEFORE TRANS+144(12CARDSX12A6)CF0 1660
C ---              16,18,19                                             CF0 1661
C --- H USED IN CF 0-4,6,9,   DIM=(MAX VAR+1) + (MAX VAR * MAX VAR) +   CF0 1670
C ---              12,13,19       (MAX VAR+1 * MAX VAR+1)               CF0 1680
C --- J USED IN CF 3,4,12,    DIM=MAX OBSERVATIONS                      CF0 1690
C ---              18,19                                                CF0 1691
C --- K USED IN CF 0-5,8,9,   DIM=40 CONTROL CARD SWITCHES              CF0 1692
C ---              12,15,18,19                                          CF0 1700
C --- L USED IN CF 1-3,15     DIM=MAX OBSERVATIONS DELETED, 7*MNOMTC, + CF0 1701
C --- L USED IN CF 1-3,15     DIM=MAX OBSERVATIONS DELETED, 7*MNOMTC, + CF0 1701
C ---                             MAX INDICATOR VAR. OBSVS., 14*MNIVOC. CF0 1702
C --- M USED IN CF 1,2,4                                                CF0 1703
C --- N USED IN CF 1-3,9,15,19                                          CF0 1704
C --- 0 USED IN CF 0-5,9,15                                             CF0 1705
C --- P USED IN CF 1-3,16                                               CF0 1706
C --- Q USED IN CF 0-4,9,12,                                            CF0 1707
C ---              15,16,18,19                                          CF0 1708
C --- R USED IN CF 1-4,9,12                                             CF0 1709
C --- S USED IN CF 1,12,19    DIM=MAXICP                                CF0 1710
C --- T USED IN CF 2,9        DIM=MAX VAR AFTER TRANSFORMATIONS         CF0 1711
C ---                                                                   CF0 1720
C --- * DEFINITION OF SUBROUTINES: CF0=MAIN, 1=BASPGM, 2=STAT, 3=FIT,   CF0 1730
C ---    4=REDATA, 5=TRANSF, 6=INV, 7=MINMAX, 8=YBACK, 9=PITCHA,        CF0 1740
C ---   10=GRID, 11=PACK, 12=CPMAIN, 13=SWEEP, 14=SORT, 15=CCARD,       CF0 1750
C ---   16=TRANPT, 17=FALPHA, 18=CPPLOT, 19=LBMAIN, 20=LANDB, 21=STORE  CF0 1751
C ---   22=BACK, 23=COEF, 24=PIVOT, 25=VARSET                           CF0 1752
C --                                                                    CF0 1760
C ---***************************************************************    CF0 1770
C --                                                                    CF0 1780
C ---      LIMIT TRAP THAT CAN BE SET BY INSTALLATION STATISTICIAN      CF0 1790
C ---                                                                   CF0 1800
C --- MAXSRH, THE TOTAL NUMBER OF VARIABLES THAT CAN BE SEARCHED, IS    CF0 1810
C ---  SET IN CPMAIN, CF12.  EACH COMPUTER CENTER MAY WISH TO HAVE      CF0 1820
C ---  MORE THAN ONE PROGRAM COMPILED WITH DIFFERENT LEVELS OF MAXSRH   CF0 1830
C ---  LIMITS.                                                          CF0 1840
C --- THE TOTAL NUMBER OF SEARCHES = 2**MAXSRH.                         CF0 1850
C ---    WHEN MAXSRH = 12, TOTAL =   4,096 SEARCHES,                    CF0 1860
C ---    WHEN MAXSRH = 14, TOTAL =  16,384 SEARCHES,                    CF0 1870
C ---    WHEN MAXSRH = 18, TOTAL = 256,144 SEARCHES.                    CF0 1880
C --                                                                    CF0 1890
C ---***************************************************************    CF0 1900
C --                                                                    CF0 1910
C --                                                                    CF0 1920
C --- ROOT SEGMENT OF THE OVERLAY PROGRAM                               CF0 1930
C                                                                       CF0 1940
C                                                                       CF0 1950
C        SUSGESTED OVERLAY CARDS TO BE INCLUDED IN THE LINK STEP        CF0 1960
C                                                                       CF0 1970
C --- OVERLAY AAA                                                       CF0 1980
C ---  INSERT BASPGM,CCARD                                              CF0 1990
C --- OVERLAY AAA                                                       CF0 2000
C ---  INSERT STAT,REDATA,TRANSF                                        CF0 2001
C --- OVERLAY AAA                                                       CF0 2010
C ---  INSERT FIT,INV,YBACK,MINMAX,FALPHA                               CF0 2020
C --- OVERLAY AAA                                                       CF0 2030
C ---  INSERT PITCHA                                                    CF0 2040
C --- OVERLAY AAA                                                       CF0 2050
C ---  INSERT CPMAIN                                                    CF0 2060
C --- OVERLAY AAA                                                       CF0 2061
C ---  INSERT LBMAIN,LANDB,VARSET,STORE,BACK,COEF,PIVOT                 CF0 2062
C ---                                                                   CF0 2070
C --                                                                    CF0 2080
C ---***************************************************************    CF0 2090
C --                                                                    CF0 2100
C --- VARIABLE DEFINITION FOR THE ROOT SEGMENT                          CF0 2110
C --                                                                    CF0 2120
C --- K 411  : INDICATOR VARIABLE FOR CALL TO FIT. IF K411 = 411        CF0 2130
C ---          TRANSFER IS MADE IN FIT TO STATEMENT 411.                CF0 2140
C ---          OTHERWISE THE ENTRY IS AT THE BEGINNING OF FIT.          CF0 2150
C ---          THE TEST FOR TRANSFER TO 411 IS MADE IN FIT.             CF0 2160
C --                                                                    CF0 2170
C --                                                                    CF0 2180
C --- N77    : INDICATOR VARIABLE FOR BASIC PROGRAM CALL. (BASPGM)      CF0 2190
C ---          IF N77 = 77 CONTROL IS SENT TO STATEMENT 77. THIS CALL   CF0 2200
C ---          IS THE RESULT OF A RETURN TO &77 FROM STAT.              CF0 2210
C --                                                                    CF0 2220
C ---                                                                   CF0 2230
C --- M 10   : INDICATOR VARIABLE FOR BASIC PROGRAM CALL. (BASPGM)      CF0 2240
C ---          IF M10=10 CONTROL IS SENT TO STATEMENT 10 IN BASPGM.     CF0 2250
C ---          THIS CALL IS THE RESULT OF A RETURN TO &10 FROM STAT.    CF0 2260
C --                                                                    CF0 2270
C --                                                                    CF0 2280
C ---  SET K411 TO 0. WHEN K411 = 411, CALLS TO FIT WILL RESULT IN      CF0 2290
C ---  STARTING AT STATEMENT 411 IN FIT.                                CF0 2300
C --                                                                    CF0 2310
      IMPLICIT REAL*8(A-H,O-Z)                                          CF0 2320
C --- IN SINGLE PRECISION PROGRAMS NSIZE = ISIZE AT STATEMENT 144       CF0 2321
C --- IN DOUBLE PRECISION PROGRAMS NSIZE = 2*ISIZE                      CF0 2322
      DIMENSION STDDEV(40)                                              CF0 2330
      DOUBLE PRECISION IDENT,IEND                                       CF0 2331
      COMMON /CCCCCC/ COM3(240)                                         CF0 2340
      COMMON /FORFIT/ RMS, YCMAX, YCMIN, YSS(10), MAXYSS, K411, NCP     CF0 2350
      COMMON /HHHHHH/ BETA(41), C(40,40), Z(41,41), NNNN, MXSIZE        CF0 2360
      COMMON /KKKKKK/ IQ(40), PR1, PR2, PR3, K, KFM, NODEP, NOIND,      CF0 2370
     1                NOOBSV, ICURY                                     CF0 2380
      COMMON /OOOOOO/ KNODEP, KNOIND, KNOVAR, KNVP1, L, NOVAR           CF0 2390
      COMMON /QQQQQQ/ KTIN, KTOU, KTPCH, KKK, KONE, KTWO, MNO, NFILE    CF0 2400
      EQUIVALENCE (COM3(161),STDDEV(1))                                 CF0 2410
       K411 = 0                                                         CF0 2420
C --- SET N77 TO 0. IF N77 = 77, THEN BASIC PROGRAM WILL START AT       CF0 2430
C --- STATEMENT 77 .                                                    CF0 2440
      CALL OPNFLS                                                       CF0 2441
      N77=0                                                             CF0 2450
C --- SET M10 TO 0. IF M10 = 10, THEN BASIC PROGRAM WILL START AT       CF0 2460
C --- STATEMENT 10.                                                     CF0 2470
      M10 = 0                                                           CF0 2480
      GO TO 12                                                          CF0 2490
   77 N77=77                                                            CF0 2500
      M10=0                                                             CF0 2510
       GO TO 12                                                         CF0 2520
 10   M10=0                                                             CF0 2530
 12   CONTINUE                                                          CF0 2540
C --- CALL THE BASIC LINEAR LEAST-SQUARES CURVE-FITTING PROGRAM         CF0 2550
C --- WITH THE APPROPRIATE INDICATOR VARIABLES.                         CF0 2560
      ITON=0                                                            CF0 2561
      CALL BASPGM(N77,M10,ITON)                                         CF0 2570
      IF(ITON.EQ.1)GO TO 9999                                           CF0 2571
      CALL STAT(ISIZE,IRTRN)                                            CF0 2580
      GO TO(77,10,144), IRTRN                                           CF0 2590
  144 NSIZE = 2*ISIZE                                                   CF0 2591
      CALL FIT(C,MAXINF,NOOBSV,NSIZE,IRTRN)                             CF0 2600
      GO TO(10,1250), IRTRN                                             CF0 2601
 1250 IF(IQ(18).EQ.1.OR.IQ(8).EQ.1) GO TO 481                           CF0 2610
C --                                                                    CF0 2620
C --- DO PLOTTING                                                       CF0 2630
C --                                                                    CF0 2640
      CALL PITCHA(YCMAX,YCMIN,C,MAXINF,NOOBSV,ISIZE)                    CF0 2650
 481  IF(IQ(9)-1) 485,482,485                                           CF0 2660
 482  WRITE(KTOU,484) PR1,PR2,PR3                                       CF0 2670
 484  FORMAT(1H1,3A6//35H PUNCH-OUTS FOR CONFIDENCE INTERVAL ,          CF0 2680
     1  19H PROGRAM REQUESTED.  )                                       CF0 2690
C ---   CALCULATE CPS FOR SELECTION OF VARIABLES IF DESIRED.            CF0 2700
 485   IF(NCP.LT.1 .OR. NOIND .EQ. 1) GO TO 487                         CF0 2710
      IF(IQ(25).GT.3) GO TO 486                                         CF0 2711
      ZMS=RMS/(STDDEV(K)*STDDEV(K)*(NOOBSV-1))                          CF0 2720
      CALL CPMAIN(ZMS)                                                  CF0 2730
      GO TO 489                                                         CF0 2731
 486  CALL LBMAIN                                                       CF0 2732
 489  CONTINUE                                                          CF0 2740
 487  K = K+1                                                           CF0 2750
C --- CHECK TO SEE IF ALL DEPENDENT VARIABLES HAVE BEEN RUN. IF NOT     CF0 2760
C --- RE-ENTER FIT AT STATEMENT 411.  IF ALL HAVE BEEN RUN. GO BACK AND CF0 2770
C --- READ IN THE NEXT PROBLEM.                                         CF0 2780
      IF(K-NOVAR) 411,411,10                                            CF0 2790
 411   K411 = 411                                                       CF0 2800
      GO TO 144                                                         CF0 2810
 9999 STOP                                                              CF0 2811
      END                                                               CF0 2820
      SUBROUTINE BASPGM(N77,M10,ITON)                                   CF1 0010
C          SUBROUTINE READS CONTROL CARD, (FORMAT AND TRANSFORMATION    CF1 0020
C     CARDS IF SO INDICATED ON CONTROL CARD) DATA CARDS AND END CARD(S).CF1 0030
C          CHECKS FOR BZERO, E FORMAT OF PRINTOUT, CONFIDENCE INTERVAL  CF1 0040
C     CALCULATION, WEIGHTING FACTORS, INDEX OF CARDS AND SEQUENCE(IF    CF1 0050
C     DESIRED).                                                         CF1 0060
C                                                                       CF1 0070
C *** DEFINES DIMENSION LIMITS IN MXVRBT, MXVPBT, MXVRAT, MXVPAT,       CF1 0080
C ***        MXOBS, MXSIZE, MXFMTC AND MXFMTD FOR ERROR TRAPS.          CF1 0090
C                                                                       CF1 0100
      IMPLICIT REAL*8(A-H,O-Z)                                          CF1 0110
      DOUBLE PRECISION IDENT, IEND, LIEND                               CF1 0120
      DIMENSION AVATR( 65), DATA( 66), FMT(144), IOMIT( 65), ITLOC( 65) CF1 0130
C ---                                                                   CF1 0140
      COMMON /AAAAAA/ COM1(1000)                                        CF1 0150
      COMMON /BBBBBB/ COM2(186)                                         CF1 0160
      COMMON /CCCCCC/ COM3(240)                                         CF1 0170
      COMMON /DDDDDD/ COM4(3500)                                        CF1 0180
      COMMON /EEEEEE/ LSORT(1000)                                       CF1 0190
      COMMON /FFFFFF/ VARTR( 65), ITRFM( 65)                            CF1 0200
      COMMON /FORFIT/ RMS, YCMAX, YCMIN, YSS(10), MAXYSS, K411, NCP     CF1 0201
      COMMON /GGGGGG/ BI(65), EQU(144)                                  CF1 0210
      COMMON /HHHHHH/ BETA(41), C(40,40), Z(41,41), NNNN, MXSIZE        CF1 0220
      COMMON /KKKKKK/ IQ(40), PR1, PR2, PR3, K, KFM, NODEP, NOIND,      CF1 0230
     1                NOOBSV, ICURY                                     CF1 0240
      COMMON /LLLLLL/ XEFMT, JOMIT(35), JIVOS(35), JIV(35), NOMIT,      CF1 0250
     1                NIVOS, NFOUND, JFOUND                             CF1 0251
      COMMON /MMMMMM/ IDENT, IEND, BZRO, IOBSV, ISEQ, JOBSV, KSL2,      CF1 0260
     1                NOERR, NVP1, NOEQ                                 CF1 0270
      COMMON /NNNNNN/ DEFR, XNOIND, NOVM1, MXVRBT, MXVPBT, MXVRAT,      CF1 0280
     1                MXVPAT, MXOBSV, MAXIND, MAXOBS                    CF1 0290
      COMMON /OOOOOO/ KNODEP, KNOIND, KNOVAR, KNVP1, L, NOVAR           CF1 0300
      COMMON /PPPPPP/ JNOVAR, KCP, NRDLMT                               CF1 0310
      COMMON /QQQQQQ/ KTIN, KTOU, KTPCH, KKK, KONE, KTWO, MNO, NFILE    CF1 0320
      COMMON /RRRRRR/ KTBIN1, KTBIN2, KTBIN3, KTBIN4, KTBIN5            CF1 0330
      COMMON /SSSSSS/ ICP(40), MAXICP, MAXLBS, MINLBS, MAXCPS, MINCPS   CF1 0340
C ---          EQUIVALENCE STATEMENTS IN CF 1, 2 AND 5                  CF1 0350
      EQUIVALENCE (COM1(1),AVATR(1)), (COM1(106),ITLOC(1)),             CF1 0360
     1            (COM1(321),IOMIT(1))                                  CF1 0370
C ---          EQUIVALENCE STATEMENTS IN CF 1 AND 2                     CF1 0380
      EQUIVALENCE (COM2(1),DATA(1))                                     CF1 0390
C                                                                       CF1 0400
      EQUIVALENCE (COM3(1),FMT(1))                                      CF1 0410
      DATA EBLANK/6H      /                                             CF1 0420
      DATA LIEND,PBLANK/3HEND,1H /                                      CF1 0430
      IEND=LIEND                                                        CF1 0440
      BLANK=PBLANK                                                      CF1 0450
C ---                                                                   CF1 0460
C --- DETERMINE THE ENTRY POINT STATEMENT FOR SUBROUTINE                CF1 0470
C ---                                                                   CF1 0480
C --- IF(N77.EQ.77) GO TO 77                                            CF1 0490
      IF(M10.EQ.10) GO TO 10                                            CF1 0500
C                                                                       CF1 0510
C ***    DEFINITION OF DIMENSION LIMITS FOR USE IN ERROR TRAPS.         CF1 0520
C                                                                       CF1 0530
C --- MAXIMUM NUMBER OF INDEPENDENT AND DEPENDENT VARIABLES             CF1 0540
C --- MXVRBT = BEFORE TRANSFORMATIONS                                   CF1 0550
      MXVRBT = 65                                                       CF1 0560
C --- MXVPBT = BEFORE TRANSFORMATIONS PLUS 1                            CF1 0570
      MXVPBT = MXVRBT + 1                                               CF1 0580
C --- MXVRAT = AFTER TRANSFORMATIONS                                    CF1 0590
      MXVRAT = MXVRBT - 25                                              CF1 0600
C --- MXVPAT = AFTER TRANSFORMATIONS PLUS 1                             CF1 0610
      MXVPAT = MXVRAT + 1                                               CF1 0620
C --- MXOBSV = MAXIMUM NUMBER OF OBSERVATIONS                           CF1 0630
      MXOBSV = 1000                                                     CF1 0640
C --- MAXIMUM NUMBER ( INDEPENDENT VARIABLES X OBSERVATIONS IN          CF1 0650
C --- COMPONENT EFFECTS TABLE (CF3) AND PLOTS (CF9) ) = MXSIZE, SIZE OF CF1 0660
C --- C AND Z ARRAYS.                                                   CF1 0670
      MXSIZE = (MXVRAT*MXVRAT) + (MXVPAT*MXVPAT)                        CF1 0680
C --- ISIZE = MXSIZE/NOOBSV, NOOBSV AND ISIZE ARE USED IN ARGUMENT      CF1 0690
C --- OF CALL FIT AND CALL PITCHA TO SET SIZE OF ARRAYS DE AND X.       CF1 0700
C --- MXFMTC = MAXIMUM NUMBER OF FORMAT CARDS READ.                     CF1 0710
      MXFMTC = 8                                                        CF1 0720
C --- MXFMTD = MXFMTC X 18 = DIMENSIONS OF FMT                          CF1 0730
      MXFMTD = MXFMTC * 18                                              CF1 0740
C --- MXINFC = MAXIMUM NUMBER OF INFORMATION CARDS.                     CF1 0741
      MXINFC = 12                                                       CF1 0742
C --- MNOMTC = MAXIMUM NUMBER OF DELETE OBSERVATION CARDS.              CF1 0743
      MNOMTC = 5                                                        CF1 0744
C --- MNOMIT = MNOMTC*7 OBSERVATIONS/CARD, 7(I4,6X), IDENT OF           CF1 0745
C ---          OBSERVATIONS TO BE DELETED.  DIMENSION OF JOMIT(MNOMIT). CF1 0746
C --- MNIVOC = MAXIMUM NUMBER OF INDICATOR VARIABLE OBSERVATION CARDS.  CF1 0747
      MNIVOC = 5                                                        CF1 0748
C --- MNIVOS = MNIVOC*7 OBSERVATIONS PER CARD, 7(I4,3X,I3),             CF1 0749
C ---          OBSERVATIONS TO PUT A 1 IN LOCATION OF SPECIFIED         CF1 0750
C ---          INDICATOR VARIABLE BEFORE TRANSFORMATIONS. DIMENSIONS    CF1 0751
C ---          JIVOS(MNIVOS) AND JIV(MNIVOS).                           CF1 0752
C --- MAXCPS = MAXIMUM NUMBER OF VARIABLES ALLOWED IN A STANDARD CP     CF1 0753
C ---          SEARCH, SET BY TIME AND MONEY RESTRAINTS.  IN 1979,      CF1 0754
C                                                                       CF1 0750
C ---          18 VARIABLES OR 262,144 SEARCHES TOOK 4 MINUTES          CF1 0755
C ---          IN AN IBM 370.                                           CF1 0756
      MAXCPS = 18                                                       CF1 0757
C --- MAXLBS = MAXIMUM NUMBER OF VARIABLES ALLOWED IN A MODIFIED LEAPS  CF1 0760
C ---          AND BOUNDS CP SEARCH, SET BY TIME AND MONEY RESTRAINTS.  CF1 0761
C ---          IN 1980, 25 VARIABLES OR 33,554,432 SEARCHES TOOK        CF1 0762
C ---          3 SECONDS IN AN IBM 370.  MAXLBS MUST BE .LE.MX IN       CF1 0763
C ---          SUBROUTINE LBMAIN.  IF MXVRAT=40, MAXLBS CAN BE SET      CF1 0764
C ---          AS HIGH AS 40, HOWEVER, MAXLBS=30 ALLOWS 1073MM SEARCHES.CF1 0765
      MAXLBS = 30                                                       CF1 0766
C --- MINCPS = MINIMUM NUMBER OF VARIABLES IN STANDARD CP SEARCH        CF1 0770
C ---          WITHOUT OVERRIDE OF THE TOTAL NUMBER OF VARIABLES        CF1 0771
C ---          GIVEN IN COLUMNS 43-44 OF CONTROL CARD.                  CF1 0772
      MINCPS = 12                                                       CF1 0773
C --- MINLBS = MINIMUM NUMBER OF VARIABLES IN MODIFIED LEAPS AND        CF1 0780
C ---          BOUNDS CP SEARCH WITHOUT OVERRIDE OF TOTAL NUMBER OF     CF1 0781
C ---          VARIABLES GIVEN IN COLUMNS 43-44 OF CONTROL CARD.        CF1 0782
      MINLBS = 18                                                       CF1 0783
C --- MAXICP = MAXIMUM NUMBER OF CP SELECTED SEARCH VARIABLES TO BE     CF1 0790
C ---          READ, 18(2X,I2) VARIABLES/CARD.                          CF1 0791
      MAXICP = 40                                                       CF1 0792
C --- MXSRCD = MAXIMUM NUMBER OF CP SELECTED SEARCH CARDS, 18 VAR/CARD. CF1 0793
      MXSRCD = (MAXICP/18) + 1                                          CF1 0794
               J=MOD(MAXICP,18)                                         CF1 0795
               IF(J.EQ.0) MXSRCD = MXSRCD - 1                           CF1 0796
C --- MAXYSS = DIMENSION OF YSS IN COMMON /FORFIT/, USED IN SUBROUTINE  CF1 0800
C ---          LANDB.  THE NUMBER OF DEPENDENT VARIABLES ALLOWABLE.     CF1 0801
      MAXYSS = 10                                                       CF1 0802
C                                                                       CF1 0803
C ***    DEFINITION OF SCRATCH, INPUT AND OUTPUT FILES                  CF1 0810
C     (FORMATS: KTBIN1-5=VARIABLE BLOCKED, KTIN AND KTOU=FIXED BLOCKED) CF1 0811
C                                                                       CF1 0812
C --- KTBIN1 STORES ENGLISH NAMES OF VARIABLES WHEN IQ(24) = 1          CF1 0813
C ---        AND STORES SIMPLE CORRELATION COEFFICIENTS AND INVERSE     CF1 0814
C ---        MATRIX WHEN IQ(25), IQ(26) OR IQ(27) = 1.                  CF1 0815
      KTBIN1 = 1                                                        CF1 0820
C --- KTBIN2 STORES CROSS PRODUCTS OF INDEPENDENT AND DEPENDENT VARABLESCF1 0830
      KTBIN2 = 2                                                        CF1 0840
C --- KTBIN3 STORES TRANSFORMED DATA WHEN IQ(3)=1.                      CF1 0850
      KTBIN3 = 3                                                        CF1 0860
C --- KTBIN5 STORES DATA READ FROM CARDS FOR LATER USE WHEN IQ(20)=1.   CF1 0870
      KTBIN5 = 4                                                        CF1 0880
C --- KTIN   READS CARDS IN                                             CF1 0890
      KTIN   = 5                                                        CF1 0900
C --- KTOU   WRITES PRINT-OUT                                           CF1 0910
      KTOU   = 6                                                        CF1 0920
C --- KTPCH  PUNCHES CARDS WHEN IQ(9) = 1.                              CF1 0930
      KTPCH  = 7                                                        CF1 0940
C                                                                       CF1 0950
C *** READ CONTROL CARD                                                 CF1 0960
C                                                                       CF1 0970
   10 READ(KTIN,800,END=3000)                                           CF1 0980
     1               PR1,PR2,PR3,IQ(1),IQ(2),XEFMT,(IQ(JZ),JZ=3,40)     CF1 0990
  800 FORMAT(3A6,2I2,1X,A1,18I1,I2,I1,I2,4I1,2I2,I3,10I1)               CF1 1000
C                                                                       CF1 1010
C --- WRITE PROBLEM IDENTIFICATION ON OUTPUT FILE                       CF1 1020
C                                                                       CF1 1030
      TYPE 3999, PR1, PR2, PR3,MXVRAT,MXOBSV                            CF1 1031
 3999 FORMAT(//27H0LINWOOD - DEC VERSION 1981/22H0LINEAR LEAST-SQUARES ,CF1 1032
     1         21HCURVE-FITTING PROGRAM //1H0 3A6/                      CF1 1033
     2         1H0,I5,10H VARIABLE,,I5,20H OBSERVATION PROGRAM//)       CF1 1034
      WRITE(KTOU,805) MXVRAT, MXOBSV, PR1, PR2, PR3                     CF1 1040
  805 FORMAT(1H1,44X,42HLINEAR LEAST-SQUARES CURVE-FITTING PROGRAM//    CF1 1050
     1 28H 1981 VERSION OF THE LINWOOD,I3,10H VARIABLE,,I5,             CF1 1060
     2 20H OBSERVATION PROGRAM//                                        CF1 1061
     3 55H REFER TO FITTING EQUATIONS TO DATA BY DANIEL AND WOOD,,      CF1 1062
     4 33H SECOND EDITION, WILEY PUBLISHER,/                            CF1 1063
     5 49H FOR GLOSSARY OF TERMS, USER'S MANUAL, DETAILS OF,            CF1 1064
     6 44H CALCULATIONS AND INTERPRETATION OF RESULTS.// 1H0,3A6/)      CF1 1065
C                                                                       CF1 1070
C --- CALCULATE NUMBER OF VARIABLES FROM CONTROL CARD VALUES            CF1 1080
C                                                                       CF1 1090
      IF(IQ(1).LT.99) GO TO 2                                           CF1 1091
      IQ(1) = IQ(1) + IQ(29)                                            CF1 1100
    2 NOIND=IQ(1)                                                       CF1 1110
      NODEP=IQ(2)                                                       CF1 1120
      NOVAR=IQ(1)+IQ(2)                                                 CF1 1130
      NVP1=NOVAR+1                                                      CF1 1140
      CALL CCARD(MXFMTC, MXINFC, MNOMTC, MNIVOC, MXSRCD,                CF1 1141
     1   MAXLBS, MINLBS, MAXCPS, MINCPS)                                CF1 1142
      IF(NOVAR.LE.MXVRBT) GO TO 6                                       CF1 1150
      WRITE(KTOU,5) MXVRBT, NOVAR                                       CF1 1160
    5 FORMAT( 1H0//////1X, 45H******THIS VERSION OF PROGRAM DIMENSIONED CF1 1170
     1FOR,I3,11H VARIABLES,,I3,34H REQUESTED.  ALL PROBLEMS FLUSHED.)   CF1 1180
      TYPE 5,MXVRBT,NOVAR                                               CF1 1181
      CALL EXIT                                                         CF1 1190
C                                                                       CF1 1200
C --- INITIALIZE INPUT STORAGE AREAS, SWITCHES, AND FILES               CF1 1210
C                                                                       CF1 1220
    6 MVP1 = NVP1                                                       CF1 1230
      IF(MVP1.GT.MXVPAT) MVP1 = MXVPAT                                  CF1 1240
      NFILE = KTIN                                                      CF1 1250
      IF(IQ(28).GT.0) NFILE=IQ(28)                                      CF1 1260
      DO 15 J=1,MVP1                                                    CF1 1270
      DO 15 I=1,MVP1                                                    CF1 1280
      Z(I,J)=0.                                                         CF1 1290
   15 CONTINUE                                                          CF1 1300
C                                                                       CF1 1310
C --- CONTROL ON CP PUNCH                                               CF1 1320
      KCP=2                                                             CF1 1330
      IF(IQ(9).EQ.2) KCP=1                                              CF1 1340
      KFM   = IQ(22)                                                    CF1 1350
      IF(IQ(20).EQ.2) GO TO 18                                          CF1 1351
      IF(IQ(31).GT.0) IQ(20) = 0                                        CF1 1360
   18 IF(IQ(20)) 21,20,20                                               CF1 1370
   20 REWIND KTBIN5                                                     CF1 1380
   21 REWIND KTBIN3                                                     CF1 1390
      REWIND KTBIN2                                                     CF1 1400
      REWIND KTBIN1                                                     CF1 1410
      KNOIND=NOIND                                                      CF1 1420
      KNODEP=NODEP                                                      CF1 1430
      KNOVAR=NOVAR                                                      CF1 1440
      KNVP1 =NVP1                                                       CF1 1450
      JNOIND=NOIND                                                      CF1 1460
      JNODEP=NODEP                                                      CF1 1470
      JNOVAR=NOVAR                                                      CF1 1480
C                                                                       CF1 1490
C                                                                       CF1 1500
C --- DETERMINE NUMBER OF EQUATIONS IN PROBLEM AND FORMAT OF INPUT DATA CF1 1510
C                                                                       CF1 1520
      IQF=IQ(19)+1                                                      CF1 1530
      IQE=IQ(20)+1                                                      CF1 1540
      IF(IQE.GE.1.AND.IQE.LE.3) GO TO 26                                CF1 1550
      WRITE(KTOU,24) IQ(20)                                             CF1 1560
   24 FORMAT(1H0,36HBAD VALUE FOR MODEL CONTROL. VALUE =,I2)            CF1 1570
      CALL EXIT                                                         CF1 1580
   26 GO TO (28,32,36),IQE                                              CF1 1590
   28 WRITE(KTOU,30)                                                    CF1 1600
   30 FORMAT(1H0,24HPROBLEM HAS ONE EQUATION)                           CF1 1610
      GO TO 38                                                          CF1 1620
   32 NOEQ=1                                                            CF1 1630
      WRITE(KTOU,34) NOEQ                                               CF1 1640
   34 FORMAT(1H0, 9HEQUATION ,I2,28H OF A MULTI-EQUATION PROBLEM)       CF1 1650
      GO TO 38                                                          CF1 1660
   36 NOEQ=NOEQ+1                                                       CF1 1670
      WRITE(KTOU,34) NOEQ                                               CF1 1680
      GO TO 80                                                          CF1 1690
   38 IF(IQF.GE.1.AND.IQF.LE.3) GO TO 42                                CF1 1700
      WRITE(KTOU,40) IQ(19)                                             CF1 1710
   40 FORMAT(1H0,37HBAD VALUE FOR FORMAT CONTROL. VALUE =,I2)           CF1 1720
      CALL EXIT                                                         CF1 1730
C                                                                       CF1 1740
C --- READ DATA VIA STD. OR SPECIAL FORMAT, OR READ DATA SUBROUTINE.    CF1 1750
C                                                                       CF1 1760
   42 GO TO (44,52,72),IQF                                              CF1 1770
   44 WRITE(KTOU,50)                                                    CF1 1780
   50 FORMAT(1H0,51HDATA READ WITH STANDARD FORMAT (A6, I4, I2, 10F6.3))CF1 1790
      GO TO 80                                                          CF1 1800
   52 WRITE(KTOU,53)                                                    CF1 1810
   53 FORMAT(1H0,29HDATA READ WITH SPECIAL FORMAT)                      CF1 1820
      IF(KFM.LE.MXFMTC) GO TO 56                                        CF1 1830
      WRITE(KTOU,57) MXFMTC, KFM                                        CF1 1840
   57 FORMAT(1H0, 27H****PROGRAM DIMENSIONED FOR, I2,                   CF1 1850
     1 14H FORMAT CARDS., I3, 27HREQUESTED. PROBLEM FLUSHED. )          CF1 1860
      CALL EXIT                                                         CF1 1870
   56 IF(KFM.LE.0) KFM=1                                                CF1 1880
      FMT(1)=BLANK                                                      CF1 1890
      DO 62 I=2, MXFMTD                                                 CF1 1900
      FMT(I)=FMT(1)                                                     CF1 1910
   62 CONTINUE                                                          CF1 1920
      DO 2022 I=1,KFM                                                   CF1 1930
      KZ=18*I                                                           CF1 1940
      LZ=KZ-17                                                          CF1 1950
      READ(KTIN,1030) (FMT(JZ),JZ=LZ,KZ)                                CF1 1960
 1030 FORMAT(18A4)                                                      CF1 1970
      WRITE(KTOU,64) I,(FMT(JZ),JZ=LZ,KZ)                               CF1 1980
   64 FORMAT(1H0,11HFORMAT CARD,I2,1X,18A4)                             CF1 1990
 2022 CONTINUE                                                          CF1 2000
      GO TO 80                                                          CF1 2010
   72 WRITE(KTOU,74)                                                    CF1 2020
   74 FORMAT(1H0,32HDATA READ WITH SUBROUTINE REDATA )                  CF1 2030
C                                                                       CF1 2040
C --- INDICATE ON OUTPUT FILE IF BZERO =0, OR BZERO = CALCULATED VALUE  CF1 2050
C                                                                       CF1 2060
   80 IF(IQ(5)) 17,17,16                                                CF1 2070
   16 BZRO=0.                                                           CF1 2080
      WRITE(KTOU,980)                                                   CF1 2090
  980 FORMAT(10H0BZERO = 0)                                             CF1 2100
      GO TO 86                                                          CF1 2110
   17 BZRO=1.                                                           CF1 2120
      WRITE(KTOU,985)                                                   CF1 2130
  985 FORMAT(25H0BZERO = CALCULATED VALUE)                              CF1 2140
C                                                                       CF1 2150
C --- PUNCH CONTROL CARDS FOR CONFIDENCE INTERVAL CALCULATIONS**********CF1 2151
   86 IF(IQ(9)-1) 47,46,47                                              CF1 2152
   46 CONTINUE                                                          CF1 2153
C  46 WRITE(KTPCH,801)PR1,PR2,PR3,(IQ(JZ),JZ=1,8)                       CF1 2154
  801 FORMAT(3A6,2I2,2X,6I1,35HPUNCH-OUTS FOR CONFIDENCE INTERVAL ,     CF1 2155
     1  7HPROGRAM )                                                     CF1 2156
C                                                                       CF1 2157
C --- READ DELETE OBSERVATION CARDS.                                    CF1 2158
C                                                                       CF1 2159
   47 NOMIT = 0                                                         CF1 2160
      IF(IQ(32).EQ.0) GO TO 168                                         CF1 2170
      JC = MNOMTC                                                       CF1 2171
      NOMITC = IQ(32)                                                   CF1 2172
      IF(NOMITC.LE.JC) JC = NOMITC                                      CF1 2173
      DO 160 J = 1, JC                                                  CF1 2174
      NOMIT = NOMIT + 7                                                 CF1 2175
      J1    = NOMIT - 6                                                 CF1 2176
  160 READ(KTIN,161) (JOMIT(I),I=J1,NOMIT)                              CF1 2177
  161 FORMAT( 7(I4,6X) )                                                CF1 2178
  162 IF(JOMIT(NOMIT).NE.0) GO TO 164                                   CF1 2179
      NOMIT = NOMIT - 1                                                 CF1 2180
      IF(NOMIT.NE.0) GO TO 162                                          CF1 2190
      WRITE(KTOU,163)  NOMITC                                           CF1 2191
  163 FORMAT(1H0//1X,6H******,I2, 32H DELETE CARD(S) WITH (7(I4,6X)) ,  CF1 2192
     1 48HFORMAT REQUESTED, NO OBSERVATION NUMBERS FOUND. ,6H******//)  CF1 2193
  164 WRITE(KTOU,264)                                                   CF1 2194
  264 FORMAT(1H0,26HOBSERVATIONS TO BE DELETED )                        CF1 2195
      WRITE(KTOU,265) (JOMIT(I),I=1,NOMIT)                              CF1 2196
  265 FORMAT(1H ,10X, 7(I4,8X) / (11X, 7(I4,8X)) )                      CF1 2197
      IF(NOMITC.LE.MNOMTC) GO TO 168                                    CF1 2198
      WRITE(KTOU,165) MNOMTC, NOMITC                                    CF1 2199
  165 FORMAT(1H0//////1X,  45H******THIS VERSION OF PROGRAM DIMENSIONED CF1 2200
     1FOR,I2,26H DELETE OBSERVATION CARDS,,I2,  42H REQUESTED.  NOT ALL CF1 2210
     2OBSERVATIONS DELETED.,6H******//////)                             CF1 2211
      JC = JC + 1                                                       CF1 2212
      DO 166 J = JC, NOMITC                                             CF1 2213
  166 READ(KTIN,167) DUMMY                                              CF1 2214
  167 FORMAT(A4)                                                        CF1 2215
  168 NFOUND = 0                                                        CF1 2216
C                                                                       CF1 2217
C --- READ INDICATOR VARIABLE OBSERVATION CARDS.                        CF1 2218
C                                                                       CF1 2219
      NIVOS = 0                                                         CF1 2220
      IF(IQ(33).EQ.0) GO TO 178                                         CF1 2230
      JC = MNIVOC                                                       CF1 2231
      NIVOC = IQ(33)                                                    CF1 2232
      IF(NIVOC.LE.JC) JC=NIVOC                                          CF1 2233
      DO 170 J=1, JC                                                    CF1 2234
      NIVOS = NIVOS + 7                                                 CF1 2235
      J1    = NIVOS - 6                                                 CF1 2236
  170 READ(KTIN,171) (JIVOS(I), JIV(I), I=J1,NIVOS)                     CF1 2237
  171 FORMAT( 7(I4,2X,I3,1X) )                                          CF1 2238
  172 IF(JIVOS(NIVOS).NE.0) GO TO 174                                   CF1 2239
      NIVOS = NIVOS - 1                                                 CF1 2240
      IF(NIVOS.NE.0) GO TO 172                                          CF1 2250
      WRITE(KTOU,173) NIVOC                                             CF1 2251
  173 FORMAT(1H0//1X,6H******,I2,33H INDICATOR VARIABLE CARD(S) WITH ,  CF1 2252
     1 57H(7(I4,2X,I3,1X) FORMAT REQUESTED, NO OBSERVATION NUMBERS ,    CF1 2253
     2 14HFOUND.  ******/)                                              CF1 2254
  174 WRITE(KTOU,266)                                                   CF1 2255
  266 FORMAT(1H0,50HOBSERVATIONS AND INDICATOR VARIABLES INTO WHICH A , CF1 2256
     1 19H1 IS TO BE INSERTED )                                         CF1 2257
      WRITE(KTOU,268) (JIVOS(I), JIV(I), I=1,NIVOS)                     CF1 2258
  268 FORMAT(1H ,10X, 7(I4,1X,I3,4X) / (11X, 7(I4,1X,I3,4X)) )          CF1 2259
      IF(NIVOC.LE.MNIVOC) GO TO 178                                     CF1 2260
      WRITE(KTOU,175) MNIVOC, NIVOC                                     CF1 2261
  175 FORMAT(1H0//////1X,  45H******THIS VERSION OF PROGRAM DIMENSIONED CF1 2262
     1FOR,I2,39H INDICATOR-VARIABLE-OBSERVATIONS CARDS.,I3,             CF1 2263
     2 33H REQUESTED.  NOT ALL OBSERVATIONS/7X,                         CF1 2264
     3 33HHAVE INDICATOR VARIABLES.  ******//////)                      CF1 2265
      JC = JC + 1                                                       CF1 2266
      DO 176 J = JC, NIVOC                                              CF1 2267
  176 READ(KTIN,177) DUMMY                                              CF1 2268
  177 FORMAT(A4)                                                        CF1 2269
  178 JFOUND = 0                                                        CF1 2270
C                                                                       CF1 2271
C ---      CHECK FOR TRANSFORMATION CARD INDICATOR + READ IN            CF1 2272
      IF(IQ(3) ) 54, 54, 48                                             CF1 2273
   48 NOBSP =NOVAR/7                                                    CF1 2274
      IF(MOD(NOVAR,7)) 6001,6001,6003                                   CF1 2275
 6001 NOBSP = NOBSP + 1                                                 CF1 2276
 6003 J2 = 0                                                            CF1 2277
 6002 J2 = J2 + 7                                                       CF1 2280
      J1 = J2 - 6                                                       CF1 2290
      IF(J2.GT.NOVAR) J2 = NOVAR                                        CF1 2291
      READ(KTIN,975)(ITRFM(JZ),VARTR(JZ),ITLOC(JZ),IOMIT(JZ),           CF1 2300
     1              AVATR(JZ),JZ=J1,J2 )                                CF1 2310
  975 FORMAT(I2,F5.0,I2,I1,  T1,2X,A5,3X, I2,F5.0,I2,I1, T11,2X,A5,3X,  CF1 2320
     1       I2,F5.0,I2,I1, T21,2X,A5,3X, I2,F5.0,I2,I1, T31,2X,A5,3X,  CF1 2321
     2       I2,F5.0,I2,I1, T41,2X,A5,3X, I2,F5.0,I2,I1, T51,2X,A5,3X,  CF1 2322
     3       I2,F5.0,I2,I1, T61,2X,A5,3X)                               CF1 2323
C*****     NOTE  THE T FORMAT IS AN IBM 360 METHOD USED TO GO BACK      CF1 2330
C     TO COLUMN 1 (T1) AND REREAD THE TRANSFORMATION CARD WITH THE      CF1 2340
C     FORMAT THAT FOLLOWS.  IN THE IBM 7044 READ 18 IS USED TO REREAD   CF1 2350
C     80 COLUMNS WITH A DIFFERENT FORMAT.  THE CARDS USED ARE           CF1 2360
C     READ(KTIN,975)(ITRFM(JZ),VARTR(JZ),ITLOC(JZ),IOMIT(JZ),JZ= J1,J2) CF1 2370
C 975 FORMAT(7(I2, F5.0, I2, I1))                                       CF1 2380
C     READ(18,990) (AVATR(JZ),JZ=J1,J2 )                                CF1 2390
C 990 FORMAT(7(2X,A5,3X))                                               CF1 2400
C*****                                                                  CF1 2410
      IF(J2.LT.NOVAR) GO TO 6002                                        CF1 2420
C          PUNCH FOR CONFIDENCE INTERVAL CALCULATIONS*******************CF1 2430
      IF(IQ(9) - 1 ) 54, 58, 54                                         CF1 2440
   58 WRITE(KTPCH,992) (ITRFM(JZ),AVATR(JZ),ITLOC(JZ),IOMIT(JZ), JZ=1,  CF1 2450
     1  NOVAR )                                                         CF1 2460
C          CARD OUTPUT FOR TRANSFORMATIONS IF CONFIDENCE INTVL PUNCH-OUTCF1 2470
  992 FORMAT(7(I2, A5, I2, I1))                                         CF1 2480
C                                                                       CF1 2490
C --- READ  EQUATION AND NAMES OF VARIABLES FOR DISPLAY ON PRINTOUT     CF1 2500
C --- IF DESIRED                                                        CF1 2510
C                                                                       CF1 2520
   54 IF(IQ(23).EQ.0) GO TO 11                                          CF1 2530
      IF(IQ(23).LE.MXINFC) GO TO 12                                     CF1 2531
      WRITE(KTOU,803) MXINFC, IQ(23)                                    CF1 2532
  803 FORMAT(1H0//////1X,  45H******THIS VERSION OF PROGRAM DIMENSIONED CF1 2533
     1FOR,I3,19H INFORMATION CARDS,,I3,26H REQUESTED.  ALL PROBLEMS ,   CF1 2534
     2  8HFLUSHED.)                                                     CF1 2535
      CALL EXIT                                                         CF1 2536
   12 NEQU = IQ(23)*12                                                  CF1 2540
      READ(KTIN,802)(EQU(I),I=1,NEQU)                                   CF1 2550
  802 FORMAT( 12A6 )                                                    CF1 2560
      WRITE(KTOU,270)                                                   CF1 2561
  270 FORMAT(1H0,17HINFORMATION CARDS )                                 CF1 2562
      WRITE(KTOU,272) (EQU(I), I=1,NEQU)                                CF1 2563
  272 FORMAT(1H ,10X, 12A6 / (11X, 12A6) )                              CF1 2564
   11 IF(IQ(24) - 1) 600, 602, 604                                      CF1 2570
  600 DO 601 I = 1, NOVAR                                               CF1 2580
  601 BI(I) = EBLANK                                                    CF1 2590
      IQ(24) = 1                                                        CF1 2591
      GO TO 13                                                          CF1 2600
  602 READ(KTIN,603) (BI(I), I=1,NOVAR)                                 CF1 2610
  603 FORMAT( 7(A6,4X) )                                                CF1 2620
C --- SAVE NAMES OF VARIABLES                                           CF1 2630
   13 WRITE(KTBIN1) (BI(I), I=1,NOVAR)                                  CF1 2640
      GO TO 614                                                         CF1 2650
  604 READ(KTBIN1) (BI(I), I=1,NOVAR)                                   CF1 2660
      REWIND KTBIN1                                                     CF1 2670
      WRITE(KTBIN1) (BI(I), I=1,NOVAR)                                  CF1 2680
  614 IF(IQ(24).EQ.0) GO TO 154                                         CF1 2681
      IF(IQ(3).EQ.1) GO TO 154                                          CF1 2682
      WRITE(KTOU,273)                                                   CF1 2683
  273 FORMAT(1H0,18HNAMES OF VARIABLES )                                CF1 2684
      WRITE(KTOU,274) (BI(I),I=1,NOVAR)                                 CF1 2685
  274 FORMAT(1H ,10X, 10(A6,6X) / (11X, 10(A6,6X)) )                    CF1 2686
  154 IF(IQ(3).EQ.0) GO TO 155                                          CF1 2687
C ---       LIST TRANSFORMATIONS                                        CF1 2688
      CALL TRANPT                                                       CF1 2689
  155 IF(IQ(26).EQ.0) GO TO 14                                          CF1 2700
C --- READ VARIABLES TO BE SEARCHED IN CP SUBROUTINE                    CF1 2710
      NCARD = IQ(26)                                                    CF1 2720
      IF(NCARD.LE.MXSRCD) GO TO 807                                     CF1 2721
      WRITE(KTOU,804) MXSRCD, NCARD                                     CF1 2722
  804 FORMAT(1H0//////1X,  45H******THIS VERSION OF PROGRAM DIMENSIONED CF1 2723
     1FOR,I3,26H CP SELECTED SEARCH CARDS,,/1X,I3,                      CF1 2724
     2 31H REQUESTED.  CP SEARCH NOT RUN. )                             CF1 2725
      IQ(25) = 0                                                        CF1 2730
      DO 806 J1=1, NCARD                                                CF1 2731
  806 READ(KTIN,177) DUMMY                                              CF1 2732
      GO TO 14                                                          CF1 2733
  807 J1 = 18*NCARD                                                     CF1 2734
      IF(J1.GT.MAXICP) J1=MAXICP                                        CF1 2735
      READ(KTIN,152) (ICP(I),I=1,J1)                                    CF1 2740
  152 FORMAT( 18(2X,I2) )                                               CF1 2750
      WRITE(KTOU,278)                                                   CF1 2751
  278 FORMAT(1H0,40HVARIABLES ON CP SELECTED SEARCH CARD(S). )          CF1 2752
  605 IF(ICP(J1).NE.0) GO TO 606                                        CF1 2753
      J1 = J1 - 1                                                       CF1 2754
      IF(J1.NE.0) GO TO 605                                             CF1 2755
  606 WRITE(KTOU,279) (ICP(I),I=1,J1)                                   CF1 2756
  279 FORMAT(1H ,10X, 10(I4,8X),3(/11X, 10(I4,8X)) )                    CF1 2760
   14 WRITE(KTOU,280)                                                   CF1 2761
  280 FORMAT(1H0)                                                       CF1 2762
      RETURN                                                            CF1 2770
 3000 CONTINUE                                                          CF1 2780
      ITON=1                                                            CF1 2781
      RETURN                                                            CF1 2782
      END                                                               CF1 2800
      SUBROUTINE STAT(ISIZE,IRTRN)                                      CF2 0010
C                                                                       CF2 0020
C          SUBROUTINE LISTS OBSERVED AND TRANSFORMED DATA, CALCULATES   CF2 0030
C     DEGREES OF FREEDOM, SUMS OF VARIABLES, RAW AND RESIDUAL SUMS OF   CF2 0040
C     SQUARES AND CROSS PRODUCTS, RANGE OF VARIABLES, MEANS AND         CF2 0050
C     STANDARD DEVIATION OF VARIABLES, SIMPLE CORRELATION COEFFICIENTS, CF2 0060
C     AND PUNCHES CARDS FOR CONFIDENCE INTERVAL AND CP PROGRAMS.        CF2 0070
C                                                                       CF2 0080
      IMPLICIT REAL*8(A-H,O-Z)                                          CF2 0090
      DOUBLE PRECISION IDENT, IEND                                      CF2 0100
      DIMENSION AMAX(40), AMIN(40), AVATR( 65), AVG(40), B(40),         CF2 0110
     1          DATA(66), FMT(144), IOMIT(65), ITLOC(65),               CF2 0120
     2          SIGMA(40), STDDEV(40), W1(40)                           CF2 0130
C                                                                       CF2 0140
      COMMON /AAAAAA/ COM1(1000)                                        CF2 0150
      COMMON /BBBBBB/ COM2(186)                                         CF2 0160
      COMMON /CCCCCC/ COM3(240)                                         CF2 0170
      COMMON /FFFFFF/ VARTR( 65), ITRFM( 65)                            CF2 0180
      COMMON /FORFIT/ RMS, YCMAX, YCMIN, YSS(10), MAXYSS, K411, NCP     CF2 0190
      COMMON /GGGGGG/ BI(65), EQU(144)                                  CF2 0200
      COMMON /HHHHHH/ BETA(41), C(40,40), Z(41,41), NNNN, MXSIZE        CF2 0210
      COMMON /KKKKKK/ IQ(40), PR1, PR2, PR3, K, KFM, NODEP, NOIND,      CF2 0220
     1                NOOBSV, ICURY                                     CF2 0230
      COMMON /LLLLLL/ XEFMT, JOMIT(35), JIVOS(35), JIV(35), NOMIT,      CF2 0240
     1                NIVOS, NFOUND, JFOUND                             CF2 0250
      COMMON /MMMMMM/ IDENT, IEND, BZRO, IOBSV, ISEQ, JOBSV, KSL2,      CF2 0260
     1                NOERR, NVP1, NOEQ                                 CF2 0270
      COMMON /NNNNNN/ DEFR, XNOIND, NOVM1, MXVRBT, MXVPBT, MXVRAT,      CF2 0280
     1                MXVPAT, MXOBSV, MAXIND, MAXOBS                    CF2 0290
      COMMON /OOOOOO/ KNODEP, KNOIND, KNOVAR, KNVP1, L, NOVAR           CF2 0300
      COMMON /PPPPPP/ JNOVAR, KCP, NRDLMT                               CF2 0310
      COMMON /QQQQQQ/ KTIN, KTOU, KTPCH, KKD, KOND, KTWD, MND, NFILE    CF2 0320
      COMMON /RRRRRR/ KTBIN1, KTBIN2, KTBIN3, KTBIN4, KTBIN5            CF2 0330
      COMMON /TTTTTT/ NOPLOT(40)                                        CF2 0331
C ---          EQUIVALENCE STATEMENTS IN CF 1, 2 AND 5 (IOMIT ALSO IN 3)CF2 0340
      EQUIVALENCE (COM1(1),AVATR(1)), (COM1(106),ITLOC(1)),             CF2 0350
     1            (COM1(321),IOMIT(1))                                  CF2 0360
C ---          EQUIVALENCE STATEMENTS IN CF 1 AND 2                     CF2 0370
      EQUIVALENCE (COM2(1),DATA(1)), (COM2(107),B(1))                   CF2 0380
      EQUIVALENCE (COM3(1),FMT(1))                                      CF2 0390
C ---          EQUIVALENCE STATEMENTS IN CF 2 AND 3                     CF2 0400
      EQUIVALENCE (COM1(1),AMAX(1)), (COM1(81),AMIN(1)),                CF2 0410
     1            (COM1(161),W1(1))                                     CF2 0420
      EQUIVALENCE (COM3(1),AVG(1)), (COM3(81),SIGMA(1)),                CF2 0430
     1            (COM3(161),STDDEV(1))                                 CF2 0440
C                                                                       CF2 0450
      WRITE(KTOU,10) PR1, PR2, PR3                                      CF2 0460
   10 FORMAT(1H1,32X,42HLINEAR LEAST-SQUARES CURVE-FITTING PROGRAM//    CF2 0470
     1 1H ,3A6// )                                                      CF2 0480
      TYPE 817, IQ(1), IQ(2)                                            CF2 0481
  817 FORMAT(11H0DATA INPUT,6X,I5,22H INDEPENDENT VARIABLES,I5,         CF2 0482
     1       22H DEPENDENT VARIABLE(S)/)                                CF2 0483
      IQ(10) = IQ(10) - 1                                               CF2 0490
      IF (IQ(10))  55, 55, 75                                           CF2 0500
   55 IF (IQ(4))  65, 65, 70                                            CF2 0510
C          HEADING LINES FOR DATA CARDS LISTING                         CF2 0520
   65 WRITE(KTOU,815) IQ(1) , IQ(2)                                     CF2 0530
  815 FORMAT(11H0DATA INPUT        , 6X,  I5,                           CF2 0540
     122H INDEPENDENT VARIABLES,I5,22H DEPENDENT VARIABLE(S)//          CF2 0550
     2                          121H OBSV.  SEQ.   1-11-21    2-12-22   CF2 0560
     3 3-13-23    4-14-24    5-15-25    6-16-26    7-17-27    8-18-28   CF2 0570
     4 9-19-29   10-20-30)                                              CF2 0580
      GO TO 75                                                          CF2 0590
C          HEADING LINES FOR DATA CARDS LISTING WITH WT OF OBSERVATION. CF2 0600
   70 WRITE(KTOU,816) IQ(1) , IQ(2)                                     CF2 0610
  816 FORMAT(11H0DATA INPUT        , 6X,  I5,                           CF2 0620
     122H INDEPENDENT VARIABLES,I5,22H DEPENDENT VARIABLE(S), 6X,       CF2 0630
     221HWEIGHT OF OBSERVATION//121H OBSV.  SEQ.   1-11-21    2-12-22   CF2 0640
     3 3-13-23    4-14-24    5-15-25    6-16-26    7-17-27    8-18-28   CF2 0650
     4 9-19-29   10-20-30)                                              CF2 0660
C          INITIALIZE INSTRUCTIONS + COUNTERS TO READ OBSERVATIONS      CF2 0670
   75 NOOBSV = 0                                                        CF2 0680
      NOERR  = 0                                                        CF2 0690
      JOBSV  = 0                                                        CF2 0700
      KSL2   = 1                                                        CF2 0710
      NRDLMT = NOVAR                                                    CF2 0720
C          ADJUST FOR WEIGHT OF OBSERVATION IF DESIRED                  CF2 0730
      IF(IQ(4).GT.0) NRDLMT = NVP1                                      CF2 0740
C          SET UP INDEX LIMITS TO WRITE FIRST CARD OF DATA GROUP        CF2 0750
      IF(NRDLMT - 10) 76,66,66                                          CF2 0760
   76 MNO = NRDLMT                                                      CF2 0770
      GO TO 77                                                          CF2 0780
   66 MNO=10                                                            CF2 0790
   77 JSEQ=0                                                            CF2 0800
C --- SET INDICATOR VARIABLE N77 BACK TO 0                              CF2 0810
      N77 = 0                                                           CF2 0820
      N = 1                                                             CF2 0830
      IF(IQ(19))  67, 68, 67                                            CF2 0840
   67 M  = NRDLMT                                                       CF2 0850
      MP = NRDLMT                                                       CF2 0860
      GO TO 69                                                          CF2 0870
   68 M=10                                                              CF2 0880
      MP=10                                                             CF2 0890
   69  KSL1   = 1                                                       CF2 0900
C          READ OBSERVATIONS- MP VALUES PER DATA CARD                   CF2 0910
      IF(IQ(20) -2 ) 83, 144, 83                                        CF2 0920
   83 IF(IQ(19) - 1 ) 78, 73, 84                                        CF2 0930
   84 CALL REDATA                                                       CF2 0940
      GO TO 82                                                          CF2 0950
   73 READ(NFILE,FMT,END=124) IDENT,IOBSV,ISEQ, (DATA(JZ), JZ = N,M )   CF2 0960
      GO TO 82                                                          CF2 0970
   78 READ(NFILE,820,END=124) IDENT,IOBSV,ISEQ, (DATA(JZ), JZ = N,M )   CF2 0980
C          DATA CARD  INPUT                                             CF2 0990
  820 FORMAT(1A6, I4, I2, 10F6.3)                                       CF2 1000
   82 IF(IDENT - IEND) 85,242,85                                        CF2 1010
  242 IF(M - NRDLMT) 241,142,142                                        CF2 1020
  241 N = N + MP                                                        CF2 1030
      M = M + MP                                                        CF2 1040
      READ(NFILE,820,END=124) IDENT,IOBSV,ISEQ, (DATA(JZ), JZ = N,M )   CF2 1050
      GO TO 242                                                         CF2 1060
C          CHECK OBSERVATION NO. SEQUENCE IF DESIRED                    CF2 1070
   85 IF( IQ(6) ) 125, 125, 100                                         CF2 1080
C               CHECK IF FIRST CARD OF OBSERVATION HAS OBSERVATION NO.  CF2 1090
C               LARGER THAN PREVIOUS OBSERVATION NO.                    CF2 1100
  100 GO TO (105, 115), KSL1                                            CF2 1110
  105  KSL1 = 2                                                         CF2 1120
      IF( IOBSV - JOBSV) 110, 110, 125                                  CF2 1130
C               COUNT ERROR                                             CF2 1140
  110 NOERR= NOERR +1                                                   CF2 1150
C               WRITE ERROR MESSAGE                                     CF2 1160
      WRITE(KTOU,840)  IOBSV,JOBSV                                      CF2 1170
C          ERROR MSG IF OBSV. NO. NOT IN ASCENDING SEQUENCE             CF2 1180
  840 FORMAT(11H0OBSV. NO. I4,41H IS NOT IN ASCENDING SEQUENCE W/OBSV. NCF2 1190
     1O I4)                                                             CF2 1200
      GO TO 125                                                         CF2 1210
C               CHECK IF CARDS WITHIN OBSERVATION HAVE SAME OBSERVATION CF2 1220
C               NO.                                                     CF2 1230
  115 IF(IOBSV-JOBSV)120,125,120                                        CF2 1240
  120 NOERR=NOERR + 1                                                   CF2 1250
      WRITE(KTOU,835)  JOBSV                                            CF2 1260
C          ERROR MSG IF DATA CARDS W/IN OBSV. HAVE INCORRECT OBSV. NO.  CF2 1270
  835 FORMAT(23H0DATA CARDS W/IN OBSV. I4, 25H HAVE INCORRECT OBSV. NO.)CF2 1280
C          CHECK IF SEQUENCE NO. WITHIN OBSERVATION IS ONE + PREVIOUS   CF2 1290
  124 IF(NFILE.NE.KTIN) REWIND NFILE                                    CF2 1300
      IDENT = IEND                                                      CF2 1310
  125 IF(IQ(7)) 140, 140, 130                                           CF2 1320
  130 IF(ISEQ-JSEQ-1)135,140,135                                        CF2 1330
  135 NOERR=NOERR +1                                                    CF2 1340
C          WRITE ERROR MESSAGE                                          CF2 1350
      WRITE(KTOU,845)  IOBSV                                            CF2 1360
C          ERROR MSG IF SEQ. NO. OF OBSV. NOT 1 GREATER THAN PREVIOUS   CF2 1370
  845 FORMAT(25H0SEQ. NO. W/IN OBSV. NO. I4,10H INCORRECT)              CF2 1380
C          INCREMENT SEQUENCE NO. IF PRESENT ONE IN ERROR               CF2 1390
      ISEQ =ISEQ + 1                                                    CF2 1400
C          MAKE CURRENT SEQUENCE NO. = PREVIOUS SEQUENCE NO.            CF2 1410
C          MAKE CURRENT OBSV. NO = PREVIOUS OBSV. NO                    CF2 1420
  140 JSEQ = ISEQ                                                       CF2 1430
      JOBSV= IOBSV                                                      CF2 1440
      IF(M - NRDLMT)141,142,142                                         CF2 1450
C          INCREMENT COUNTERS FOR VARIABLES ON NEXT DATA CARD           CF2 1460
  141 N=N+MP                                                            CF2 1470
      M=M+MP                                                            CF2 1480
      GO TO 83                                                          CF2 1490
  142 IF(IQ(20)) 145, 145, 143                                          CF2 1500
  143 WRITE(KTBIN5)  IDENT,IOBSV,ISEQ, (DATA(JZ), JZ = 1, NRDLMT)       CF2 1510
      GO TO 145                                                         CF2 1520
  144 READ (KTBIN5)  IDENT,IOBSV,ISEQ, (DATA(JZ), JZ = 1, NRDLMT)       CF2 1530
C                                                                       CF2 1540
C          CHECK FOR CARD WITH WORD END IN FIRST 6 COLUMNS FOR LAST OBSVCF2 1550
  145 IF(IDENT-IEND)  45,250,45                                         CF2 1560
   45 IF((NOMIT - NFOUND).EQ.0) GO TO 146                               CF2 1570
C ---      DELETE KOMIT OBSERVATIONS IF REQUESTED                       CF2 1580
      J = NFOUND + 1                                                    CF2 1590
      IF(JOMIT(J).NE.IOBSV) GO TO 146                                   CF2 1600
      NFOUND = NFOUND + 1                                               CF2 1610
      GO TO 247                                                         CF2 1620
  146 IF((NIVOS - JFOUND).EQ.0) GO TO 46                                CF2 1630
C --- PUT 1.0 IN SPECIFIED INDICATOR VARIABLE BEFORE TRANSFORMATIONS.   CF2 1640
      J = JFOUND + 1                                                    CF2 1650
      IF(JIVOS(J).NE.IOBSV) GO TO 46                                    CF2 1660
      JFOUND = JFOUND + 1                                               CF2 1670
      JA = JIV(J)                                                       CF2 1680
      IF(JA.GT.0.AND.JA.LE.NOVAR) GO TO 42                              CF2 1690
      WRITE(KTOU,40) IOBSV, JA                                          CF2 1700
   40 FORMAT(1H0,49H******INDICATOR VARIABLE ASSIGNED FOR OBSERVATION,  CF2 1710
     1I4,12H FOUND TO BE,I3,38H.  A VALUE LESS THAN 1 OR GREATER THAN,  CF2 1720
     2 17H THE TOTAL NUMBER/7X,54HOF VARIABLES NOT ALLOWED.  ASSIGNMENT CF2 1730
     3SKIPPED.  ****** /)                                               CF2 1740
      GO TO 46                                                          CF2 1750
   42 DATA(JA)= 1.0D0                                                   CF2 1760
      WRITE(KTOU,44)  JA, IOBSV                                         CF2 1770
   44 FORMAT(1H ,42HA VALUE OF 1.0 HAS BEEN PLACED IN VARIABLE, I3,     CF2 1780
     1 15H OF OBSERVATION, I7)                                          CF2 1790
C                                                                       CF2 1800
C ---      LIST DATA IF DESIRED                                         CF2 1810
   46 IF(IQ(10)) 147, 147, 149                                          CF2 1820
  147  ISEQ=0                                                           CF2 1830
C               INCLUDE OBSERVATION NO. IF FIRST CARD OF OBSERVATION    CF2 1840
C          DATA CARD  LISTING-CARD 1 OF THE OBSERVATION                 CF2 1850
      WRITE(KTOU,825)      IOBSV,ISEQ, (DATA(JZ), JZ = 1,MNO )          CF2 1860
  825 FORMAT(1H I4, I6, 10F11.3)                                        CF2 1870
      IF(IQ(10).EQ.0) IQ(10) = 1                                        CF2 1880
       KKK=10                                                           CF2 1890
  170  IF(NRDLMT - KKK)149,149,148                                      CF2 1900
  148  KONE=KKK+1                                                       CF2 1910
       IF(NRDLMT - (KKK+10))166,166,165                                 CF2 1920
  165  KTWO=KKK+10                                                      CF2 1930
       GO TO 167                                                        CF2 1940
  166  KTWO=NRDLMT                                                      CF2 1950
  167  ISEQ=ISEQ+1                                                      CF2 1960
      WRITE(KTOU,830)            ISEQ, (DATA(JZ), JZ = KONE, KTWO )     CF2 1970
C          DATA CARD  LISTING-CARDS OTHER THAN 1ST OF THE OBSERVATION   CF2 1980
  830 FORMAT(5X, I6, 10F11.3)                                           CF2 1990
       KKK=KKK+10                                                       CF2 2000
       GO TO 170                                                        CF2 2010
C          END OF LOOP WHICH READS ONE OBSERVATION                      CF2 2020
C                                                                       CF2 2030
C          INCREMENT NO. OF OBSERVATIONS COUNTER                        CF2 2040
  149 NOOBSV = NOOBSV + 1                                               CF2 2050
C          AFTER READING + CHECKING ALL VARIABLES, CHECK IF ANY SEQUEN- CF2 2060
C          CING ERRORS OCCURRED. IF NONE OCCUR, CONTINUE PROCESSING THE CF2 2070
C          OBSERVATION. IF THE NO. OF ERRORS IS LESS THAN FIVE, CONTINUECF2 2080
C          READING DATA + CHECKING THE SEQUENCE W/O PROCESSING. WHEN THECF2 2090
C          NO. OF ERRORS REACHES FIVE, CONTINUE READING DATA BUT DISCON-CF2 2100
C          TINUE CHECKING SEQUENCING + PROCESSING.  PRINTER MESSAGES    CF2 2110
C          NOTIFY USER OF THESE ALTERNATIVES.                           CF2 2120
      IF(NOERR)150, 185, 150                                            CF2 2130
  150 IF(NOERR-5)247,155, 155                                           CF2 2140
  155 GO TO (160,77), KSL2                                              CF2 2150
  160 KSL2 = 2                                                          CF2 2160
      INSQOB = 0                                                        CF2 2170
      INSQCD = 0                                                        CF2 2180
      INTRFM = 0                                                        CF2 2190
      WRITE (KTOU,855)  PR1,PR2,PR3                                     CF2 2200
C          ERROR MSG IF MORE THAN 5 ERRORS FOUND IN SEQ CHECKING DATA   CF2 2210
  855 FORMAT(9H0PROBLEM 3A6,91H HAS 5 ERRORS IN SEQUENCING OF DATA. PROBCF2 2220
     1LEM SKIPPED AT THIS POINT. NO FURTHER DATA CHECKS.)               CF2 2230
      GO TO 77                                                          CF2 2240
C          DO ALGEBRAIC TRANSFORMATIONS ON SCALED DATA                  CF2 2250
  185 IF(IQ(3) ) 230,230,190                                            CF2 2260
  190 CALL TRANSF                                                       CF2 2270
C          CHECK IF ANY SPILLS IN DOING TRANSFORMATIONS                 CF2 2280
C          COMPUTE RAW SUMS + CROSS PRODUCTS, WEIGHTED OR UNWEIGHTED    CF2 2290
  230 IF(KNVP1.GT.MXVPAT) GO TO 77                                      CF2 2300
      IF(IQ(4) ) 235,235,240                                            CF2 2310
  235 DATA(NVP1) = 1.0                                                  CF2 2320
C --- WEIGHT OBSERVATION BY 1/(VARIANCE OF OBSERVATION)                 CF2 2330
  240 IF(IQ(4).EQ.2) DATA(NVP1)=1.0/ DATA(NVP1)                         CF2 2340
      DO 243 J=1, KNOVAR                                                CF2 2350
  243 Z(J, KNVP1) = Z(J, KNVP1) + DATA (J) * DATA(NVP1)                 CF2 2360
      IF(IQ(5).EQ.0) GO TO 246                                          CF2 2370
      DO 245 J=1, KNOVAR                                                CF2 2380
      DO 245 M=J, KNOVAR                                                CF2 2390
  245 Z(J,M) = Z(J, M) + DATA(J) * DATA (M) * DATA (NVP1)               CF2 2400
C          CHECK FOR SPILLS                                             CF2 2410
  246 KNVP1 = KNVP1                                                     CF2 2420
      Z(KNVP1, KNVP1) = Z(KNVP1, KNVP1) + DATA(NVP1)                    CF2 2430
C          WRITE OBSERVATION ON BINARY TAPE -FOR LATER USE-             CF2 2440
      DATA(KNVP1) = DATA(NVP1)                                          CF2 2450
      WRITE(KTBIN3)  IDENT,IOBSV,      (DATA(JZ), JZ = 1, KNVP1  )      CF2 2460
  247 JOBSV=IOBSV                                                       CF2 2470
C          END OF LOOP FOR READING ALL OBSERVATIONS                     CF2 2480
      GO TO 77                                                          CF2 2490
  250 IF((NIVOS - JFOUND).EQ.0) GO TO 254                               CF2 2500
      WRITE(KTOU,251) NIVOS, JFOUND                                     CF2 2510
  251 FORMAT(1H0//1X,6H******,I3,29H OBSERVATIONS WITH INDICATOR ,      CF2 2520
     1 21HVARIABLES REQUESTED. ,I3,15H FOUND.  ******/)                 CF2 2530
  254 IF(NOERR) 255, 265, 255                                           CF2 2540
  255 WRITE(KTOU,860) PR1,PR2,PR3, NOERR                                CF2 2550
C          ERROR MSG IF LESS THAN 5 ERRORS FOUND AFTER ALL SEQ CHECKS   CF2 2560
C               COMPLETED.                                              CF2 2570
  860 FORMAT(9H0PROBLEM 3A6,10H SKIPPED. I2,93H ERRORS. IF THE NO. OF ERCF2 2580
     1RORS IS LESS THAN 5, ALL THE OBSERVATIONS HAVE BEEN SEQUENCE CHECKCF2 2590
     2ED)                                                               CF2 2600
C --- READ REMAINING CP SEARCH CARDS AND ESTIMATE OF VARIANCE CARDS, IF CF2 2610
C ---   ANY, AND THEN RETURN TO READ NEXT CONTROL CARD.                 CF2 2620
 9010 JC = 0                                                            CF2 2630
      IF(IQ(25).EQ.3) JC = 1                                            CF2 2640
      I = NOVAR - NOIND                                                 CF2 2650
      JC = (JC + IQ(26))*I                                              CF2 2660
      IF(JC.LT.2) GO TO 9014                                            CF2 2670
      DO 9012 J = 2, JC                                                 CF2 2680
 9012 READ(KTIN,9013) DUMMY                                             CF2 2690
 9013 FORMAT(A4)                                                        CF2 2700
 9014 IRTRN=2                                                           CF2 2710
      RETURN                                                            CF2 2720
C          FINALIZE THE NO. VARIABLE QUANTITIES                         CF2 2730
  265 NOVAR = KNOVAR                                                    CF2 2740
      NOIND = KNOIND                                                    CF2 2750
      NODEP = KNODEP                                                    CF2 2760
      NVP1  = KNVP1                                                     CF2 2770
C          CALCULATE DEGREES OF FREEDOM + CHECK                         CF2 2780
      XNOOBS = Z(NVP1, NVP1)                                            CF2 2790
      XNOVAR = NOVAR                                                    CF2 2800
      XNOIND = NOIND                                                    CF2 2810
      RNOOBS = NOOBSV                                                   CF2 2820
      DEFR   = RNOOBS - XNOIND - BZRO                                   CF2 2830
       IF(KNOIND+KNODEP-MXVRAT)299,299,296                              CF2 2840
  296 WRITE(KTOU,297) MXVRAT                                            CF2 2850
      TYPE 297,MXVRAT                                                   CF2 2851
  297  FORMAT(1H0///94H0AFTER PERFORMING TRANSFORMATIONS, THE NUMBER OF CF2 2860
     1INDEPENDENT PLUS DEPENDENT VARIABLES EXCEEDS ,I3/17H0PROBLEM SKIPPCF2 2870
     2ED. )                                                             CF2 2880
      GO TO 9010                                                        CF2 2890
  299 IF(DEFR) 266, 266, 267                                            CF2 2900
  266 WRITE(KTOU,935) DEFR                                              CF2 2910
      TYPE 935, DEFR                                                    CF2 2911
C          PRINTER + TAPE MSG IF DEGREES OF FREEDOM ZERO OR NEGATIVE    CF2 2920
  935 FORMAT(40H0THE CALCULATED DEGREES OF FREEDOM ARE  F5.0,39H NO FURTCF2 2930
     1HER CALCULATIONS. NEXT PROBLEM.)                                  CF2 2940
      GO TO 9010                                                        CF2 2950
C          PUNCH XNOBS, DEGREES OF FREEDOM, KNOIND + KNODEP FOR CONFDNCECF2 2960
C            INTERVAL CALCULATIONS.                                     CF2 2970
  267 IF(IQ(9) - 1 ) 269, 268, 269                                      CF2 2980
  268 CONTINUE                                                          CF2 2981
C 268 WRITE (KTPCH,1020) XNOOBS, DEFR, KNOIND, KNODEP                   CF2 2990
C        HEXADECIMAL PUNCHOUT FOR CONFIDENCE INTERVAL PROGRAM***********CF2 3000
C 1020 FORMAT(5Z16)                                                     CF2 3010
C          LIST  TRANSFORMED DATA IF DESIRED                            CF2 3020
  269 REWIND KTBIN3                                                     CF2 3030
      IQ(11) = IQ(11) - 1                                               CF2 3040
      IF(IQ(3)) 3032,3032,263                                           CF2 3050
C                                                                       CF2 3060
  263 IF(IQ(11).EQ.2) GO TO 264                                         CF2 3070
      CALL TRANPT                                                       CF2 3080
  264  IF(KNOIND)282,282,281                                            CF2 3090
  281 IF(KNODEP)283,283,284                                             CF2 3100
  282 WRITE(KTOU,286)                                                   CF2 3110
      TYPE 286                                                          CF2 3111
  286 FORMAT(1H0///74H0AFTER PERFORMING THE TRANSFORMATIONS, THERE ARE NCF2 3120
     1O INDEPENDENT VARIABLES./17H0PROBLEM SKIPPED.)                    CF2 3130
      GO TO 9010                                                        CF2 3140
  283 WRITE(KTOU,287)                                                   CF2 3150
      TYPE 287                                                          CF2 3151
  287 FORMAT(1H0///72H0AFTER PERFORMING THE TRANSFORMATIONS, THERE ARE NCF2 3160
     1O DEPENDENT VARIABLES./17H0PROBLEM SKIPPED.)                      CF2 3170
      GO TO 9010                                                        CF2 3180
C                                                                       CF2 3190
  284 IF(IQ(11)) 1014, 1012, 2000                                       CF2 3200
 1012 WRITE(KTOU,1013) KNOIND, KNODEP                                   CF2 3210
 1013 FORMAT(40H0FIRST OBSERVATION AFTER TRANSFORMATIONS , 6X,          CF2 3220
     1                              24HTHE FITTED EQUATION HAS ,I2,     CF2 3230
     224H INDEPENDENT VARIABLES, I2,22H DEPENDENT VARIABLE(S) / )       CF2 3240
      GO TO 2000                                                        CF2 3250
 1014 WRITE(KTOU,864) KNOIND, KNODEP                                    CF2 3260
  864 FORMAT(27H0DATA AFTER TRANSFORMATIONS, 6X,                        CF2 3270
     1                              24HTHE FITTED EQUATION HAS ,I2,     CF2 3280
     224H INDEPENDENT VARIABLES, I2,22H DEPENDENT VARIABLE(S) / )       CF2 3290
 2000 IF(IQ(24).EQ.0) GO TO 2014                                        CF2 3300
C ---       PRINT NAMES OF VARIABLES IF DESIRED                         CF2 3310
      JA = 0                                                            CF2 3320
      DO 606 J = 1, JNOVAR                                              CF2 3330
      IF(IOMIT(J).EQ.1) GO TO 606                                       CF2 3340
      JA = JA + 1                                                       CF2 3350
      BI(JA) = BI(J)                                                    CF2 3360
      NOPLOT(JA) = IOMIT(J)                                             CF2 3361
  606 CONTINUE                                                          CF2 3370
      IF(IQ(11)) 2011,2011,3032                                         CF2 3380
 2011 WRITE(KTOU,2012) (BI(I), I=1,NOVAR)                               CF2 3390
 2012 FORMAT(1H ,11X,A6,9(6X,A6)/  ( 12X,A6,9(6X,A6)) )                 CF2 3400
 2014 WRITE(KTOU,862)                                                   CF2 3410
  862 FORMAT(126H OBSV.     1-11-21     2-12-22     3-13-23     4-14-24 CF2 3420
     1    5-15-25     6-16-26     7-17-27     8-18-28     9-19-29    10-CF2 3430
     220-30 )                                                           CF2 3440
C AMAX(  ) AND AMIN(  ) ARE LOCATIONS FOR MAX + MIN OF VARIABLES        CF2 3450
 3032 DO 3000 I=1,NOVAR                                                 CF2 3460
      AMIN(I)=1D32                                                      CF2 3470
      AMAX(I)=-AMIN(I)                                                  CF2 3480
 3000 CONTINUE                                                          CF2 3490
      TYPE 1015, KNOIND, KNODEP                                         CF2 3491
 1015 FORMAT(25H0THE FITTED EQUATION HAS ,I2,23H INDEPENDENT VARIABLES,,CF2 3492
     1       I3,22H DEPENDENT VARIABLE(S) /)                            CF2 3493
      DO 275 I=1, NOOBSV                                                CF2 3500
      READ (KTBIN3)  IDENT,IOBSV,      (DATA(JZ), JZ = 1,  NOVAR )      CF2 3510
      DO 3008 JZ=1,NOVAR                                                CF2 3520
      IF(DATA(JZ)-AMIN(JZ)) 3002,3004,3004                              CF2 3530
 3002 AMIN(JZ)=DATA(JZ)                                                 CF2 3540
 3004 IF(DATA(JZ)-AMAX(JZ)) 3008,3008,3006                              CF2 3550
 3006 AMAX(JZ)=DATA(JZ)                                                 CF2 3560
 3008 CONTINUE                                                          CF2 3570
      IF(IQ(3)) 275,275,3034                                            CF2 3580
 3034 IF(IQ(11)) 2002,3036,275                                          CF2 3590
 3036 IF(IQ(11).EQ.0) IQ(11) = 1                                        CF2 3600
 2002 WRITE(KTOU,865)IOBSV,(DATA(JZ),JZ=1,NOVAR)                        CF2 3610
C 865 FORMAT(1H ,I4,1X,1P10E12.5/( 6X,1P10E12.5))                       CF2 3620
  865 FORMAT(1H ,I4, (T7,1P10E12.5) )                                   CF2 3630
  275 CONTINUE                                                          CF2 3640
C --- W1(  ) IS THE LOCATION FOR THE RANGE OF VARIABLES                 CF2 3650
      DO 3010 JZ=1,NOVAR                                                CF2 3660
      W1(JZ)=AMAX(JZ)-AMIN(JZ)                                          CF2 3670
 3010 CONTINUE                                                          CF2 3680
C          LIST SUMS OF VARIABLES IF DESIRED                            CF2 3690
      IF(IQ(12) ) 305,285,305                                           CF2 3700
  285 WRITE(KTOU,870)                                                   CF2 3710
      TYPE 870                                                          CF2 3711
C          SUM OF VARIABLES LISTING                                     CF2 3720
  870 FORMAT(18H0SUMS OF VARIABLES)                                     CF2 3730
      WRITE(KTOU,875) (Z(I,NVP1), I =1,NOVAR)                           CF2 3740
      TYPE 875, (Z(I,NVP1), I=1,NOVAR)                                  CF2 3741
  875 FORMAT(6X, 1P10E12.5)                                             CF2 3750
C ---      CALCULATE MEAN                                               CF2 3760
  305 DO 2040   I=1, NOVAR                                              CF2 3770
      AVG(I)= Z(I,NVP1)/Z(NVP1,NVP1)                                    CF2 3780
 2040 Z(I,KNVP1) = 0.                                                   CF2 3790
C          SAVE Z(1,1) IF JOINT CONFIDENCE INTERVAL PUNCH OUT RQSTD     CF2 3800
      B(30) = Z(1,1)                                                    CF2 3810
      IF(IQ(5))  307,307,288                                            CF2 3820
  288 IF(NODEP.GT.MAXYSS) GO TO 290                                     CF2 3821
      DO 289 J=1, NODEP                                                 CF2 3822
      JA = NOIND + J                                                    CF2 3823
  289 YSS(J) = Z(JA,JA)                                                 CF2 3824
C          LIST RAW SUMS OF SQUARES + CROSS PRODUCTS IF DESIRED + B0=0  CF2 3830
  290 IF(IQ(13))  306,295,306                                           CF2 3840
  295 WRITE(KTOU,885)                                                   CF2 3850
C          HEADING LINE FOR RAW SUMS OF SQUARES + CROSS PRODUCTS        CF2 3860
  885 FORMAT(37H0RAW SUMS OF SQUARES + CROSS PRODUCTS/126H           1-1CF2 3870
     11-21     2-12-22     3-13-23     4-14-24     5-15-25     6-16-26  CF2 3880
     2   7-17-27     8-18-28     9-19-29    10-20-30  )                 CF2 3890
      DO 300 J=1, NOVAR                                                 CF2 3900
      WRITE(KTOU,865)  J, (Z(JZ,J), JZ = 1,J )                          CF2 3910
  300 CONTINUE                                                          CF2 3920
C          PUNCH RAW SUMS + CROSS PRODUCTS, TRIANGULAR, IF CONFIDENCE   CF2 3930
C            INTERVAL DATA NEEDED + BZERO = 0.                          CF2 3940
  306 IF(IQ(9) - 1 )  325,308,325                                       CF2 3950
C        HEXADECIMAL PUNCHOUT FOR CONFIDENCE INTERVAL PROGRAM           CF2 3960
308    CONTINUE                                                         CF2 3961
C 308 WRITE(KTPCH,1020)((Z(JZA,JZB),JZB=1,KNOIND),JZA=1,KNOIND)         CF2 3970
      GO TO 325                                                         CF2 3980
C ---                                                                   CF2 3990
C ---      TAKE MEAN OUT OF EACH OBSERVATION OF INDEPENDENT VARIABLES   CF2 4000
C ---                                                                   CF2 4010
  307 REWIND KTBIN3                                                     CF2 4020
      DO 2038 I = 1, KNOVAR                                             CF2 4030
      DO 2038 M = I, KNOVAR                                             CF2 4040
 2038 Z(I,M) = 0.                                                       CF2 4050
      DO 2035 J = 1, NOOBSV                                             CF2 4060
      READ (KTBIN3)  IDENT,IOBSV,      (DATA(JZ), JZ = 1, KNVP1  )      CF2 4070
      DO 2036 I = 1, KNOVAR                                             CF2 4080
 2036 DATA(I) = DATA(I) - AVG(I)                                        CF2 4090
C ---      COMPUTE RAW SUMS AND CROSS PRODUCTS - WITH MEAN REMOVED      CF2 4100
C ---      THEY EQUAL THE RESIDUAL SUMS AND CROSS PRODUCTS.             CF2 4110
C ---      THESE VALUES ARE USED TO CALCULATE INVERSE MATRIX            CF2 4120
      DO 2037 I=1, KNOVAR                                               CF2 4130
      DO 2037 M = I, KNOVAR                                             CF2 4140
 2037 Z(I,M) = Z(I, M) + DATA(I) * DATA (M) * DATA (KNVP1)              CF2 4150
 2035 CONTINUE                                                          CF2 4160
      IF(NODEP.GT.MAXYSS) GO TO 310                                     CF2 4161
      DO 309 J=1, NODEP                                                 CF2 4162
      JA = NOIND + J                                                    CF2 4163
  309 YSS(J) = Z(JA,JA)                                                 CF2 4164
C          PUNCH RESIDUALS IF CONFIDENCE INTERVAL DATA NEEDED + BZERO   CF2 4170
C            NOT EQUAL TO 0.                                            CF2 4180
  310 IF(IQ(9) - 1 ) 314, 312, 314                                      CF2 4190
C        HEXADECIMAL PUNCHOUT FOR CONFIDENCE INTERVAL PROGRAM***********CF2 4200
312   CONTINUE                                                          CF2 4201
C 312 WRITE(KTPCH,1020)((Z(JZA,JZB),JZB=1,KNOIND),JZA=1,KNOIND)         CF2 4210
C          LIST RESIDUALS IF DESIRED                                    CF2 4220
  314 IF(IQ(14) ) 325,315,325                                           CF2 4230
  315 WRITE(KTOU,895)                                                   CF2 4240
C          RESIDUAL SUMS                                                CF2 4250
  895 FORMAT(42H0RESIDUAL SUMS OF SQUARES + CROSS PRODUCTS)             CF2 4260
      DO 320 J=1, NOVAR                                                 CF2 4270
  320 WRITE(KTOU,865)  J, (Z(JZ,J), JZ = 1,J )                          CF2 4280
C          CHECK DIAGONALS OF RESIDUALS                                 CF2 4290
  325 NOVM1 =NOVAR-1                                                    CF2 4300
      DO 350   I=1, NOVAR                                               CF2 4310
      IF(Z(I,I).GT.1.0D-07) GO TO 340                                   CF2 4320
      WRITE(KTOU,905)  I                                                CF2 4330
      TYPE 905, I                                                       CF2 4331
  905 FORMAT(34H0RESIDUAL DIFFERENCE FOR VARIABLE I2,31H IS ZERO. VARIABCF2 4340
     1LE IS CONSTANT.)                                                  CF2 4350
C          **** PROGRAM GIVES UP IF  Z(I,I) = 0                         CF2 4360
      WRITE (KTOU,906)                                                  CF2 4370
      TYPE 906                                                          CF2 4371
  906 FORMAT(16H PROBLEM SKIPPED)                                       CF2 4380
      GO TO 9010                                                        CF2 4390
  340 SIGMA(I) = DSQRT(Z(I,I))                                          CF2 4400
  350 Z(I,I) = 1.                                                       CF2 4410
C          SAVE DEPENDENT VARIABLE PORTION ABOVE DIAGONAL OF THE RESIDU-CF2 4420
C          AL MATRIX FOR STATISTICAL COMPUTATIONS TO COME.              CF2 4430
      L=NOIND+1                                                         CF2 4440
      DO 353J=L, NOVAR                                                  CF2 4450
      WRITE(KTBIN2)    (Z(JZ,J), JZ = 1,NOIND )                         CF2 4460
  353 CONTINUE                                                          CF2 4470
C ---      CALCULATE ROOT MEAN SQUARE OF VARIABLE                       CF2 4480
      IF(Z(NVP1,NVP1).GT.RNOOBS) GO TO 355                              CF2 4490
      RTDEFR = DSQRT(RNOOBS - 1.0)                                      CF2 4500
      GO TO 356                                                         CF2 4510
  355 RTDEFR = DSQRT(Z(NVP1,NVP1)-1.0)                                  CF2 4520
  356 DO 360    I=1, NOVAR                                              CF2 4530
  360 STDDEV(I)=SIGMA(I)/RTDEFR                                         CF2 4540
C          LIST CALCULATED MEANS + ROOT MEAN SQUARES IF DESIRED         CF2 4550
      IF(IQ(15) )  365,362,365                                          CF2 4560
C ---      LIST DELETED OBSERVATIONS, IF ANY.                           CF2 4570
  362 IF(NOMIT.EQ.0) GO TO 364                                          CF2 4580
      IF(NFOUND.EQ.0) GO TO 909                                         CF2 4590
      WRITE(KTOU,907)                                                   CF2 4600
  907 FORMAT(21H0OBSERVATIONS DELETED)                                  CF2 4610
      WRITE(KTOU,908) (JOMIT(JZ),JZ=1,NFOUND)                           CF2 4620
  908 FORMAT(2X, 10I12)                                                 CF2 4630
      IF((NOMIT-NFOUND).EQ.0) GO TO 364                                 CF2 4640
  909 WRITE(KTOU,910)                                                   CF2 4650
  910 FORMAT(23H0OBSERVATIONS NOT FOUND )                               CF2 4660
      J = NFOUND + 1                                                    CF2 4670
      WRITE(KTOU,908) (JOMIT(JZ),JZ=J,NOMIT)                            CF2 4680
  364 WRITE(KTOU,911)                                                   CF2 4690
      TYPE 911                                                          CF2 4691
  911 FORMAT(19H0MEANS OF VARIABLES)                                    CF2 4700
      WRITE(KTOU,875) (AVG(JZ), JZ = 1, NOVAR )                         CF2 4710
      TYPE 875, (AVG(JZ),JZ=1,NOVAR)                                    CF2 4711
      WRITE(KTOU,915)                                                   CF2 4720
      TYPE 915                                                          CF2 4721
  915 FORMAT(31H0ROOT MEAN SQUARES OF VARIABLES )                       CF2 4730
      WRITE(KTOU,875) (STDDEV(JZ), JZ = 1,NOVAR )                       CF2 4740
      TYPE 875, (STDDEV(JZ), JZ = 1,NOVAR )                             CF2 4741
C                                                                       CF2 4750
C          PUNCHOUTS FOR SEPARATE CP PROGRAM                            CF2 4760
  365 GO TO(3305,369), KCP                                              CF2 4770
3305     CONTINUE                                                       CF2 4771
C3305 WRITE(KTPCH,3307) PR1,PR2,PR3,NOVAR,NOOBSV                        CF2 4780
C3307 FORMAT(6HCPCPCP,3A6,2Z8)                                          CF2 4790
C     WRITE(KTPCH,1020)(STDDEV(JZ),JZ=1,NOVAR)                          CF2 4800
  369 ISIZE  =  MXSIZE/NOOBSV                                           CF2 4810
      IRTRN=3                                                           CF2 4820
      RETURN                                                            CF2 4830
      END                                                               CF2 4840
      SUBROUTINE FIT(DE,MAXINF,NBSV,ISIZE,IRTRN)                        CF3 0010
C                                                                       CF3 0020
C          SUBROUTINE CALCULATES COEFFICIENTS OF EACH INDEPENDENT       CF3 0030
C     VARIABLE, CALCULATES AND LISTS STATISTICS OF FIT, CALCULATES      CF3 0040
C     FITTED Y VALUES AND RESIDUALS, AND ORDERS RESIDUALS, CALCULATES   CF3 0050
C     COMPONENT EFFECTS TABLE AND ESTIMATES ERROR FROM NEAR NEIGHBORS.  CF3 0060
C                                                                       CF3 0070
      IMPLICIT REAL*8(A-H,O-Z)                                          CF3 0080
      DOUBLE PRECISION IDZA(1000)                                       CF3 0090
      REAL*4 DE(NBSV,ISIZE), STUDNR(1000)                               CF3 0091
      DIMENSION AMAX(40), AMIN(40), AVG(40), B(40), D(40),              CF3 0100
     1          DELSD(1000), DELTA(1000), DELYN(1000), IDRS1(1000),     CF3 0110
     2          IDRS2(1000), IOMIT( 65), JSORT(1000), RELINF(40),       CF3 0120
     3          RISQRD(40), SIGB(40), SIGMA(40), STDDEV(40),            CF3 0130
     4          TVALUE(40), VAR(40), W1(40), XXIN(1000), YRESID(40),    CF3 0140
     5          YYCC(1000), YYIN(1000)                                  CF3 0141
C --- THE DIMENSIONS OF DE(NOOBSV,ISIZE) ARE SET IN CALL FIT IN CF2.    CF3 0150
C --- ISIZE = MXSIZE/NOOBSV.  MXSIZE = THE DIMENSIONS OF C AND Z.       CF3 0160
      COMMON /AAAAAA/ COM1(1000)                                        CF3 0170
      COMMON /BBBBBB/ COM2(186)                                         CF3 0180
      COMMON /CCCCCC/ COM3(240)                                         CF3 0190
      COMMON /DDDDDD/ COM4(3500)                                        CF3 0200
      COMMON /EEEEEE/ LSORT(1000)                                       CF3 0210
      COMMON /FFFFFF/ VARTR( 65), ITRFM( 65)                            CF3 0220
      COMMON /FORFIT/ RMS, YCMAX, YCMIN, YSS(10), MAXYSS, K411, NCP     CF3 0230
      COMMON /GGGGGG/ BI(65), EQU(144)                                  CF3 0240
      COMMON /HHHHHH/ BETA(41), C(40,40), Z(41,41), NNNN, MXSIZE        CF3 0250
      COMMON /JJJJJJ/ IDZB(1000)                                        CF3 0260
      COMMON /KKKKKK/ IQ(40), PR1, PR2, PR3, K, KFM, NODEP, NOIND,      CF3 0270
     1                NOOBSV, ICURY                                     CF3 0280
      COMMON /LLLLLL/ XEFMT, JOMIT(35), JIVOS(35), JIV(35), NOMIT,      CF3 0290
     1                NIVOS, NFOUND, JFOUND                             CF3 0291
      COMMON /NNNNNN/ DEFR, XNOIND, NOVM1, MXVRBT, MXVPBT, MXVRAT,      CF3 0300
     1                MXVPAT, MXOBSV, MAXIND, MAXOBS                    CF3 0310
      COMMON /OOOOOO/ KNODEP, KNOIND, KNOVAR, KNVP1, L, NOVAR           CF3 0320
      COMMON /PPPPPP/ JNOVAR, KCP, NRDLMT                               CF3 0330
      COMMON /QQQQQQ/ KTIN, KTOU, KTPCH, KKK, KONE, KTWO, MNO, NFILE    CF3 0340
      COMMON /RRRRRR/ KTBIN1, KTBIN2, KTBIN3, KTBIN4, KTBIN5            CF3 0350
C ---          EQUIVALENCE STATEMENTS IN CF 2 AND 3(IOMIT ALSO IN 1, 5) CF3 0360
      EQUIVALENCE (COM1(1),AMAX(1)), (COM1(81),AMIN(1)),                CF3 0370
     1            (COM1(161),W1(1)), (COM1(241),D(1)),                  CF3 0380
     2            (COM1(321),IOMIT(1)), (COM1(426),RELINF(1)),          CF3 0381
     3            (COM1(506),RISQRD(1)), (COM1(586),SIGB(1))            CF3 0382
      EQUIVALENCE (COM3(1),AVG(1)), (COM3(81),SIGMA(1)),                CF3 0390
     1            (COM3(161),STDDEV(1))                                 CF3 0400
C ---          EQUIVALENCE STATEMENTS IN CF 3 ALONE                     CF3 0410
      EQUIVALENCE (BETA(1),TVALUE(1))                                   CF3 0420
      EQUIVALENCE (COM2(1),YRESID(1)), (COM2(1),VAR(1)),                CF3 0430
     1            (COM2(107),B(1))                                      CF3 0440
      EQUIVALENCE (COM4(3001),JSORT(1)), (COM4(1001),XXIN(1)),          CF3 0450
     1            (COM4(3001),STUDNR(1)),                               CF3 0451
     1            (COM4(1001),IDZA(1)),  (COM4(2001),YYIN(1)),          CF3 0460
     2            (COM4(1001),DELYN(1)), (COM4(2001),DELSD(1))          CF3 0470
      EQUIVALENCE (C(1),IDRS1(1)), (Z(1),IDRS2(1))                      CF3 0480
C ---          EQUIVALENCE STATEMENTS IN CF 3, 9                        CF3 0490
      EQUIVALENCE (COM1(1),DELTA(1)), (COM4(1),YYCC(1))                 CF3 0500
      DATA EFORMT,TOTALH/1HE,6H TOTAL/                                  CF3 0510
      DATA ZIP,HALF,ONE,TWO/0.0D0,0.5D0,1.0D0,2.0D0/                    CF3 0511
      DATA SMALL,VSMALL,VLARGE/1.0D-06,1.0D-10,1.0D+32/                 CF3 0512
C1020 FORMAT(5Z16)                                                      CF3 0520
      IBZERO = 1                                                        CF3 0521
      IF(IQ(5).EQ.1) IBZERO = 0                                         CF3 0522
      IF(K411.EQ.411) GO TO 411                                         CF3 0530
      DO 370  I = 1, NOVM1                                              CF3 0540
      IPL1 =I+1                                                         CF3 0550
      DO 370   J=IPL1, NOVAR                                            CF3 0560
      Z(I,J)=Z(I,J)/(SIGMA(I)*SIGMA(J))                                 CF3 0570
C          SQUARE THE TRIANGULAR R(I,J) MATRIX                          CF3 0580
370   Z(J,I)= Z(I,J)                                                    CF3 0590
C          CHECK FOR SPILLS                                             CF3 0600
C          PUNCH R(I,J) VALUES, TRIANGULAR, IF CONFIDENCE INTERVAL DATA CF3 0610
C            NEEDED.                                                    CF3 0620
      IF(IQ(9) -1) 373, 372,373                                         CF3 0630
C        HEXADECIMAL PUNCHOUT FOR CONFIDENCE INTERVAL PROGRAM***********CF3 0640
372   CONTINUE                                                          CF3 0641
C 372 WRITE(KTPCH,1020)((Z(JZA,JZB),JZB=1,KNOIND),JZA=1,KNOIND)         CF3 0650
C          LIST THE SIMPLE CORRELATION COEFFICIENTS IF DESIRED          CF3 0660
  373 IF(IQ(16) ) 385,375,385                                           CF3 0670
  375 WRITE(KTOU,920)                                                   CF3 0680
  920 FORMAT(1H0,45HSIMPLE CORRELATION COEFFICIENTS, R(I,I PRIME))      CF3 0690
      DO 149 J=1, NOVAR                                                 CF3 0700
  149 WRITE(KTOU,3040) J, (Z(JZ,J),JZ=1,J)                              CF3 0710
C          INVERT INDEPENDENT VARIABLE PORTION OF THE SIMPLE CORRELATIONCF3 0720
C          COEFFICIENT MATRIX, R(I,J), I=J=NO. IND. VARIABLES           CF3 0730
  385 GO TO(3315,386), KCP                                              CF3 0740
C     CP  PUNCH                                                         CF3 0750
 3315 DO  3317  J = 1, NOVAR                                            CF3 0760
3317   CONTINUE                                                         CF3 0761
C3317 WRITE(KTPCH,1020)(Z(J,JZ),JZ=1,NOVAR)                             CF3 0770
C  ---STORE MATRIX TO BE INVERTED IN C.  ORIGINAL MATRIX IN Z IS        CF3 0780
C  ---PRESERVED                                                         CF3 0790
  386 DO 8338 I=1,NOIND                                                 CF3 0800
      DO 8338 J=1,NOIND                                                 CF3 0810
 8338 C(I,J)=Z(I,J)                                                     CF3 0820
      NNNN=NOIND                                                        CF3 0830
      IQPLOT = IQ(18)                                                   CF3 0831
      CALL INV                                                          CF3 0840
C          AFTER INVERTING, THE INVERSE IS C(I,J)                       CF3 0850
C          CHECK FOR SPILLS                                             CF3 0860
      IF(NNNN.NE.999) GO TO 388                                         CF3 0870
      WRITE(KTOU,387)                                                   CF3 0880
      TYPE 387                                                          CF3 0881
  387 FORMAT(1H0,49H*******MATRIX OF SIMPLE CORRELATION COEFFICIENTS  , CF3 0890
     1 44HIS SINGULAR.  MATRIX WILL NOT INVERT.*******  )               CF3 0900
      IRTRN=1                                                           CF3 0910
      RETURN                                                            CF3 0911
C          LIST INVERSE IF DESIRED                                      CF3 0920
  388 IF(IQ(17) ) 400,390,400                                           CF3 0930
  390 WRITE(KTOU,925)                                                   CF3 0940
C          INVERSE LISTING                                              CF3 0950
  925 FORMAT(1H0,21HINVERSE, C(I,I PRIME))                              CF3 0960
      DO 395 I=1, NOIND                                                 CF3 0970
  395 WRITE(KTOU,3040) I, (C(I,JZ),JZ=1,I)                              CF3 0980
C --- ***NORMAL FORMAT                                                  CF3 0990
C3040 FORMAT(1H ,I4, 1X,10(F12.3)/(   6X, 10F12.3) )                    CF3 1000
C --- ***FORMAT USED TO CHECK PRECISION OF CALCULATIONS                 CF3 1010
C3040 FORMAT(1H ,I4, 1X, 6(1PE18.11, 2X)/ (   6X, 6(1PE18.11, 2X)) )    CF3 1020
C --- ***                                                               CF3 1030
 3040 FORMAT(1H ,I4, (T7,10F12.3) )                                     CF3 1040
C          BEGIN CALCULATIONS FOR EACH DEPENDENT VARIABLE               CF3 1050
  400 REWIND KTBIN2                                                     CF3 1060
C          PUNCH REMAINDER OF NON-REPITITIVE DATA FOR CONFIDENCE INTER- CF3 1070
C            VAL CALCULATIONS.                                          CF3 1080
      IF(IQ(9) -1 ) 401,510,401                                         CF3 1090
C          PUNCH MEANS OF THE INDEPENDENT VARIABLES                     CF3 1100
C        HEXADECIMAL PUNCHOUT FOR CONFIDENCE INTERVAL PROGRAM***********CF3 1110
510   CONTINUE                                                          CF3 1111
C 510 WRITE(KTPCH,1020)(AVG(JZ),JZ=1,KNOIND)                            CF3 1120
C          PUNCH  INVERSE OF R(I,J) MATRIX                              CF3 1130
C        HEXADECIMAL PUNCHOUT FOR CONFIDENCE INTERVAL PROGRAM***********CF3 1140
C     WRITE(KTPCH,1020)((C(JZA,JZB),JZB=1,KNOIND),JZA=1,KNOIND)         CF3 1150
C          REARRANGE TRFMTN INFO IF BACK TRANSFORMING DEPENDENT VARIABLECF3 1160
  401 IF(IQ(3) ) 406,406,402                                            CF3 1170
  402 IF(IQ(8) ) 406,406,403                                            CF3 1180
  403 K=1                                                               CF3 1190
      DO 405 I=1, JNOVAR                                                CF3 1200
      IF(IOMIT(I).EQ.1) GO TO 405                                       CF3 1210
      ITRFM(K) = ITRFM(I)                                               CF3 1220
      VARTR(K) = VARTR(I)                                               CF3 1230
      K =K+1                                                            CF3 1240
  405 CONTINUE                                                          CF3 1250
  406 NCP = IQ(25) + IQ(26)                                             CF3 1260
      WNOBS = Z(KNVP1,KNVP1)                                            CF3 1261
      J = NOVAR - NOIND                                                 CF3 1270
      IF(NCP.LT.1.AND.IQ(27).LT.1.AND.J.EQ.1.AND.IQ(18).LT.2) GO TO 410 CF3 1280
C ---    STORE SIMPLE CORR. COEFS. AND INVERSE WHEN IQ(25) AND IQ(26)=1 CF3 1290
      DO 408  I = 1, NOIND                                              CF3 1300
  408 WRITE(KTBIN1) (C(I,J), J = I,NOIND)                               CF3 1310
      DO 409 I = 1, NOVAR                                               CF3 1320
  409 WRITE(KTBIN1)    (Z(I,J), J = I,NOVAR )                           CF3 1330
      WRITE(KTBIN1) (AMAX(J),  J=1,NOVAR)                               CF3 1340
      WRITE(KTBIN1) (AMIN(J),  J=1,NOVAR)                               CF3 1350
      WRITE(KTBIN1) (AVG(J),   J=1,NOVAR)                               CF3 1360
      WRITE(KTBIN1) (SIGMA(J), J=1,NOVAR)                               CF3 1370
      WRITE(KTBIN1) (STDDEV(J),J=1,NOVAR)                               CF3 1380
      WRITE(KTBIN1) (W1(J),    J=1,NOVAR)                               CF3 1390
      WRITE(KTBIN1)  WNOBS                                              CF3 1391
C          SET LOOP TO CALCULATE STATISTICS FOR EACH DEPENDENT VARIABLE CF3 1400
  410 K = L                                                             CF3 1410
  411 RSQD = ZIP                                                        CF3 1420
      K411 = 0                                                          CF3 1430
      BZERO =ZIP                                                        CF3 1440
      SUMB  =ZIP                                                        CF3 1450
      REWIND KTBIN3                                                     CF3 1460
      YYMIN =VLARGE                                                     CF3 1470
      YCMIN =VLARGE                                                     CF3 1480
      YYMAX = -YYMIN                                                    CF3 1490
      YCMAX = -YCMIN                                                    CF3 1500
      ICURY = K - NOIND                                                 CF3 1510
C          READ RESIDUAL VALUES FOR DEPENDENT VARIABLES                 CF3 1520
      READ(KTBIN2) (YRESID(JZ), JZ =1,NOIND )                           CF3 1530
      IF(ICURY.EQ.1) GO TO 418                                          CF3 1540
C ---    READ SIMPLE CORR. COEFS. AND INVERSE WHEN IQ(25) AND IQ(26)=1  CF3 1550
      REWIND KTBIN1                                                     CF3 1560
      IF(IQ(24).EQ.0) GO TO 412                                         CF3 1570
      READ(KTBIN1) ( DUM, I=1, NOVAR)                                   CF3 1580
  412 DO 413  I = 1, NOIND                                              CF3 1590
  413 READ(KTBIN1) (C(I,J), J = I,NOIND)                                CF3 1600
C          SQUARE C MATRIX.                                             CF3 1610
      NOIM1 = NOIND - 1                                                 CF3 1620
      DO 414  I = 1, NOIM1                                              CF3 1630
      IPL1 =I+1                                                         CF3 1640
      DO 414 J = IPL1, NOIND                                            CF3 1650
  414 C(J,I)= C(I,J)                                                    CF3 1660
      DO 416 I = 1, NOVAR                                               CF3 1670
  416 READ(KTBIN1)    (Z(I,J), J = I,NOVAR )                            CF3 1680
      READ(KTBIN1) (AMAX(J),  J=1,NOVAR)                                CF3 1690
      READ(KTBIN1) (AMIN(J),  J=1,NOVAR)                                CF3 1700
      READ(KTBIN1) (AVG(J),   J=1,NOVAR)                                CF3 1710
      READ(KTBIN1) (SIGMA(J), J=1,NOVAR)                                CF3 1720
      READ(KTBIN1) (STDDEV(J),J=1,NOVAR)                                CF3 1730
      READ(KTBIN1) (W1(J),    J=1,NOVAR)                                CF3 1740
      READ(KTBIN1)  WNOBS                                               CF3 1741
C          SQUARE Z MATRIX.                                             CF3 1750
      DO 417  I = 1, NOVM1                                              CF3 1760
      IPL1 = I + 1                                                      CF3 1770
      DO 417 J = IPL1, NOVAR                                            CF3 1780
  417 Z(J,I)= Z(I,J)                                                    CF3 1790
C          WRITE HEADING LINE FOR STATISTICS                            CF3 1800
  418 WRITE(KTOU,5101) PR1,PR2,PR3,ICURY,BI(K), AMIN(K), AMAX(K), W1(K) CF3 1810
 5101 FORMAT(1H1,38X,42HLINEAR LEAST-SQUARES CURVE-FITTING PROGRAM//    CF3 1820
     1     1X, 3A6,9H  DEP VAR,I2,2H: ,A6,        22X,8HMIN Y = ,       CF3 1830
     2     1PE10.3,2X,8HMAX Y = ,1PE10.3,2X,10HRANGE Y = ,1PE10.3/ )    CF3 1840
      TYPE 5100,PR1,PR2,PR3,ICURY,BI(K),AMIN(K),AMAX(K),W1(K)           CF3 1841
 5100 FORMAT(//1H ,3A6,9H  DEP VAR,I2,2H: ,A6,22X,8HMIN Y = ,1PE10.3,2X,CF3 1842
     1         8HMAX Y = ,1PE10.3,2X,10HRANGE Y = ,1PE10.3/)            CF3 1843
      IF(IQ(23).LT.1) GO TO 942                                         CF3 1850
      NEQU = IQ(23)*12                                                  CF3 1860
      WRITE(KTOU,943) (EQU(I), I=1, NEQU )                              CF3 1870
  943 FORMAT(1H , 18X, 12A6 )                                           CF3 1880
  942 IF(NOMIT.EQ.0) GO TO 944                                          CF3 1881
      IF(NFOUND.EQ.0) GO TO 909                                         CF3 1882
      WRITE(KTOU,907) (JOMIT(JZ),JZ=1,NFOUND)                           CF3 1883
  907 FORMAT(19X,22HOBSERVATIONS DELETED: ,8(I4,2X),7(/41X,8(I4,2X)))   CF3 1884
      IF((NOMIT-NFOUND).EQ.0) GO TO 944                                 CF3 1885
      J = NFOUND + 1                                                    CF3 1886
  909 WRITE(KTOU,910) (JOMIT(JZ),JZ=J,NOMIT)                            CF3 1887
  910 FORMAT(19X,24HOBSERVATIONS NOT FOUND: ,8(I4,2X),7(/43X,8(I4,2X))) CF3 1888
  944 WRITE(KTOU,945)                                                   CF3 1889
      TYPE 945                                                          CF3 1890
  945 FORMAT(1H0,10HIND.VAR(I),3X,4HNAME,4X,9HCOEF.B(I),6X,             CF3 1900
     110HS.E. COEF.,3X,7HT-VALUE,3X,8HR(I)SQRD,4X,8HMIN X(I),7X,        CF3 1910
     28HMAX X(I),6X,10HRANGE X(I),2X,12HREL.INF.X(I) )                  CF3 1920
C          CALCULATE BETA VALUES                                        CF3 1930
      DO 420 I=1, NOIND                                                 CF3 1940
      BETA(I) = ZIP                                                     CF3 1950
      DO 419 J=1, NOIND                                                 CF3 1960
C --- K IS THE POSITION OF THE DEPENDENT VARIABLE                       CF3 1970
  419 BETA(I)=BETA(I)+C(I,J)*Z(J,K)                                     CF3 1980
C          CALCULATE B(I), COEFFICIENTS OF EQUATION                     CF3 1990
      B(I)  =BETA(I)*SIGMA(K)/SIGMA(I)                                  CF3 2000
C          CALCULATE B(I)*X(I) FOR BZERO CALCULATIONS                   CF3 2010
      BZERO = BZERO +(B(I)*AVG(I))                                      CF3 2020
C          CALCULATE R ZERO SQ, OVER-ALL  MULT. CORREL. COEFF.          CF3 2030
  420 RSQD=RSQD + BETA(I)*Z(I,K)                                        CF3 2040
C          CALC BZERO                                                   CF3 2050
      BZERO =AVG(K)-BZERO                                               CF3 2060
C          CALCULATE  CONSTANT TERM FOR SIGMA BETA CALC                 CF3 2070
      FACTOR = DSQRT((ONE - RSQD)/DEFR)                                 CF3 2080
C          CALCULATE COEFFECIENTS + STATISTICS FOR EACH IND. VARIABLE   CF3 2090
      DX = ZIP                                                          CF3 2100
      XNOBS = DFLOAT(NOOBSV)                                            CF3 2110
      XNOIND= DFLOAT(NOIND)                                             CF3 2120
      DO 425 I=1, NOIND                                                 CF3 2130
C          CALCULATE STANDARD DEV. OF BETA                              CF3 2140
      SGBETA = DSQRT(C(I,I)) * FACTOR                                   CF3 2150
C          CALCULATE T-VALUE AND PLACE IN BETA FOR USE IN CPMAIN.       CF3 2160
      TVALUE(I) = DABS(BETA(I)/SGBETA)                                  CF3 2170
C          CALCULATE SIGB(I), THE STANDARD ERROR OF EACH COEFFICIENT.   CF3 2180
      SIGB(I)  =SGBETA*SIGMA(K)/SIGMA(I)                                CF3 2190
      RELINF(I) = DABS(B(I)*W1(I)/W1(K))                                CF3 2200
      RISQRD(I) = ONE - (ONE/C(I,I) )                                   CF3 2210
      D(I) = SIGB(I)*SIGB(I)                                            CF3 2220
  425 SUMB=SUMB+(B(I)*YRESID(I))                                        CF3 2230
C          PERFORM F RATIO TEST ON OVERALL REGRESSION                   CF3 2240
      FRATIO =RSQD*DEFR/(XNOIND*(ONE-RSQD))                             CF3 2250
C          CALCULATE TOTAL SUM OF SQUARES, SSYT                         CF3 2260
      SSYT=SIGMA(K)*SIGMA(K)                                            CF3 2270
C          CALCULATE RESIDUAL SUM OF SQUARES, RSS                       CF3 2280
      RSS   = SSYT - SUMB                                               CF3 2290
C          CALCULATE RESIDUAL MEAN SQUARE, RMS                          CF3 2300
      RMS = RSS/DEFR                                                    CF3 2310
C          CALCULATE RESIDUAL ROOT MEAN SQUARE, RRMS                    CF3 2320
      RRMS = DSQRT(RMS)                                                 CF3 2330
      IF(IBZERO.EQ.1) GO TO 421                                         CF3 2340
C ---      REDEFINE RSQD IF B0 = ZERO                                   CF3 2350
      FACTOR = AVG(K)*AVG(K)*WNOBS                                      CF3 2360
      SSYT = SSYT - FACTOR                                              CF3 2370
      SUMB = SUMB - FACTOR                                              CF3 2380
      RSQD = SUMB/SSYT                                                  CF3 2390
      WRITE(KTOU,948)                                                   CF3 2391
      TYPE 948                                                          CF3 2392
  948 FORMAT(1H ,5X,1H0,14X,8HB(0) = 0 )                                CF3 2400
      GO TO 432                                                         CF3 2410
C          CALCULATE STANDARD ERROR OF B(0).                            CF3 2420
  421 SSBZR = ZIP                                                       CF3 2430
      DO 431 I=1, NOIND                                                 CF3 2440
      DO 431 J=1, I                                                     CF3 2450
      SBZR = (AVG(I)/SIGMA(I)) * (AVG(J)/SIGMA(J)) * C(I,J)             CF3 2460
      IF(I.NE.J) SBZR = SBZR*TWO                                        CF3 2470
  431 SSBZR = SSBZR + SBZR                                              CF3 2480
      SBZR = DSQRT(SSBZR + ONE/XNOBS) * RRMS                            CF3 2490
      TVALUE(K) = DABS(BZERO/SBZR)                                      CF3 2500
      TYPE 949, BZERO, SBZR, TVALUE(K)                                  CF3 2501
      WRITE(KTOU,949) BZERO, SBZR, TVALUE(K)                            CF3 2510
  949 FORMAT(1H ,5X,1H0,13X,1PE12.5,5X,1PE9.2,4X,0PF5.1)                CF3 2520
C          WRITE COEFFECIENTS + STATISTICS FOR EACH IND. VARIABLE       CF3 2530
  432 DO 433 I=1, NOIND                                                 CF3 2540
      TYPE 950, I, BI(I), B(I), SIGB(I), TVALUE(I), RISQRD(I),          CF3 2541
     1 AMIN(I), AMAX(I), W1(I), RELINF(I)                               CF3 2542
  433 WRITE(KTOU,950) I, BI(I), B(I), SIGB(I), TVALUE(I), RISQRD(I),    CF3 2550
     1 AMIN(I), AMAX(I), W1(I), RELINF(I)                               CF3 2560
C --- ***NORMAL FORMAT                                                  CF3 2570
C 950 FORMAT(1H ,4X,I2,5X,A6,   2X,1PE12.5, 5X,1PE9.2,4X,0PF5.1,5X,     CF3 2580
C --- ***FORMAT USED TO CHECK PRECISION OF CALCULATIONS                 CF3 2590
C 950 FORMAT(1H ,4X,I2,5X,A6, 1X,  1PE20.13,   1PE9.2,2X,0PF5.1,5X,     CF3 2591
C --- ***                                                               CF3 2592
  950 FORMAT(1H ,4X,I2,5X,A6,   2X,1PE12.5, 5X,1PE9.2,4X,0PF5.1,5X,     CF3 2593
     1F7.4,1PE14.3,1PE15.3,5X,1PE10.3,4X,0PF6.2 )                       CF3 2594
      WRITE(KTOU,3014) NOOBSV                                           CF3 2595
      TYPE 3014, NOOBSV                                                 CF3 2596
 3014 FORMAT(1H0,19HNO. OF OBSERVATIONS,11X,I5)                         CF3 2600
      WRITE(KTOU,3016) NOIND                                            CF3 2610
 3016 FORMAT(1H ,21HNO. OF IND. VARIABLES,10X,I4)                       CF3 2620
      NDEFR=DEFR+0.01                                                   CF3 2630
      WRITE(KTOU,3018) NDEFR                                            CF3 2640
 3018 FORMAT(1H , 27HRESIDUAL DEGREES OF FREEDOM,4X,I4)                 CF3 2650
      IF(IBZERO.EQ.0) GO TO 422                                         CF3 2660
      WRITE(KTOU,3020) FRATIO                                           CF3 2670
 3020 FORMAT(1H ,7HF-VALUE,22X,F8.1)                                    CF3 2680
  422 WRITE(KTOU,3022) RRMS                                             CF3 2690
 3022 FORMAT(1H ,25HRESIDUAL ROOT MEAN SQUARE,3X,F16.8)                 CF3 2700
      TYPE 3022, RRMS                                                   CF3 2701
      WRITE(KTOU,3024) RMS                                              CF3 2710
 3024 FORMAT(1H ,20HRESIDUAL MEAN SQUARE,8X,F16.8)                      CF3 2720
      WRITE(KTOU,3026) RSS                                              CF3 2730
      TYPE 3026, RSS                                                    CF3 2731
 3026 FORMAT(1H ,23HRESIDUAL SUM OF SQUARES,5X,F16.8)                   CF3 2740
      TYPE 3028, SSYT                                                   CF3 2751
      WRITE(KTOU,3028) SSYT                                             CF3 2750
 3028 FORMAT(1H ,20HTOTAL SUM OF SQUARES,6X,F18.8)                      CF3 2760
      TYPE 3030, RSQD                                                   CF3 2761
      WRITE(KTOU,3030) RSQD                                             CF3 2770
 3030 FORMAT(1H ,27HMULT. CORREL. COEF. SQUARED,8X,F5.4)                CF3 2780
      PAR = XNOBS - DEFR                                                CF3 2781
C -- (1 - ADJRSQ)/(1 - RSQD) = (N WITH B(0)=0 OR N-1 OTHERWISE)/(N-P)   CF3 2782
      ADJRSQ = ONE - ((ONE - RSQD)*(XNOBS - ONE)/DEFR)                  CF3 2783
      IF(IBZERO.EQ.0) ADJRSQ = ONE - ((ONE - RSQD)*XNOBS/DEFR)          CF3 2784
      WRITE(KTOU,3031) ADJRSQ                                           CF3 2785
 3031 FORMAT(1H ,30HADJ. MULT. CORR. COEF. SQUARED, 5X, F5.4)           CF3 2786
      PAR = XNOBS - DEFR                                                CF3 2787
      TYPE 3031, ADJRSQ                                                 CF3 2788
C --- TO CALCULATE FIT AND RESIDUALS USING COEFFICIENTS SAVED FROM      CF3 2790
C ---    PREVIOUS RUN.                                                  CF3 2800
C --- CONTROL CARD COL 59, IQ(31)=1, WRITE B(0)AND B(I)'S ON KTBIN5     CF3 2810
C ---                      IQ(31)=2,  READ B(0)AND B(I)'S ON KTBIN5     CF3 2820
      NEWOBS = IQ(31)                                                   CF3 2821
      IF(NEWOBS.EQ.0) GO TO 6901                                        CF3 2830
      REWIND KTBIN5                                                     CF3 2840
      IF(NEWOBS.EQ.2) GO TO 6001                                        CF3 2850
      IF(IBZERO.EQ.0) BZERO = ZIP                                       CF3 2860
      WRITE(KTBIN5) BZERO, (B(J),J=1,NOVAR)                             CF3 2870
      DO 6018 I = 1, NOIND                                              CF3 2871
 6018 WRITE(KTBIN5) (C(I,J),J=1,NOIND)                                  CF3 2872
      WRITE(KTBIN5) (SIGMA(J),J=1,NOIND),(AVG(J),J=1,NOIND),RRMS,WNOBS, CF3 2873
     1               DEFR, PAR                                          CF3 2874
      WRITE(KTOU,6020)                                                  CF3 2880
 6020 FORMAT(1H0,  39H*** COEFFICIENTS SAVED AS REQUESTED *** )         CF3 2890
      GO TO 6901                                                        CF3 2900
 6001 READ(KTBIN5)  BZERO, (B(J),J=1,NOVAR)                             CF3 2910
      DO 6022 I = 1, NOIND                                              CF3 2911
 6022 READ(KTBIN5) (C(I,J),J=1,NOIND)                                   CF3 2912
      READ(KTBIN5) (SIGMA(J),J=1,NOIND),(AVG(J),J=1,NOIND),VRRMS,VNOBS, CF3 2913
     1              VDEFR, VPAR                                         CF3 2914
C          SQUARE C MATRIX.                                             CF3 2915
      NOIM1 = NOIND - 1                                                 CF3 2916
      DO 6023 I = 1, NOIM1                                              CF3 2917
      IPL1 =I+1                                                         CF3 2918
      DO 6023 J = IPL1, NOIND                                           CF3 2919
 6023 C(J,I)= C(I,J)                                                    CF3 2920
      WRITE(KTOU,946)                                                   CF3 2921
  946 FORMAT(1H0,10HIND.VAR(I),3X,4HNAME,4X,9HCOEF.B(I),41X,            CF3 2930
     18HMIN X(I),7X,8HMAX X(I),6X,10HRANGE X(I),2X,12HREL.INF.X(I) )    CF3 2940
      WRITE(KTOU,6030)                                                  CF3 2950
 6030 FORMAT(1H0, 38H*** COEFFICIENTS FROM PREVIOUS FIT *** )           CF3 2960
      WRITE(KTOU,949) BZERO                                             CF3 2970
      DO 6425 I=1, NOIND                                                CF3 2980
      RELINF(I) = DABS(B(I)*W1(I)/W1(K))                                CF3 2990
 6425 WRITE(KTOU,951) I,BI(I),B(I),AMIN(I),AMAX(I),W1(I),RELINF(I)      CF3 3000
  951 FORMAT(1H ,4X,I2,5X,A6,   2X,1PE12.5, 35X,                        CF3 3010
     1     1PE14.3,1PE15.3,5X,1PE10.3,4X,0PF6.2 )                       CF3 3020
      RSS = ZIP                                                         CF3 3030
 6901 CALL SORT(NOIND, RELINF, LSORT )                                  CF3 3040
      IF(NOIND.EQ.1) LSORT(1) = 1                                       CF3 3050
      MAXINF = LSORT(NOIND)                                             CF3 3060
      NTABLE = IQ(27)                                                   CF3 3061
      IF(NOOBSV.LE.MXOBSV) GO TO 3034                                   CF3 3070
      WRITE(KTOU,3032) MXOBSV                                           CF3 3080
 3032 FORMAT(1H0//1X, 36HNUMBER OF OBSERVATIONS GREATER THAN ,I4,       CF3 3090
     1 36H. CALCULATIONS OF RESIDUALS SKIPPED.  )                       CF3 3100
      GO TO 481                                                         CF3 3110
 3034 IF(NTABLE.LT.1.OR.NTABLE.GT.2) GO TO 426                          CF3 3120
      IF(NTABLE.GT.1) GO TO 4444                                        CF3 3130
C                                                                       CF3 3140
C --- SET LIMIT OF EFFECT OF REQUIRED X(I) PRECISION                    CF3 3141
      PI = ONE                                                          CF3 3142
      PI = PI/XNOIND                                                    CF3 3143
      DUM  = XNOBS/(RMS*PI*12.)                                         CF3 3144
      WRITE(KTOU,2040)                                                  CF3 3145
 2040 FORMAT(1H0,71X,23HREQUIRED X(I) PRECISION,        /67X, 7H(DIGIT  CF3 3146
     126HRIGHT OF DECIMAL POSITIVE,/75X,25HLEFT OF DECIMAL NEGATIVE) )  CF3 3147
      WRITE(KTOU,2042)                                                  CF3 3148
 2042 FORMAT(1H0, 73X,10HIND.VAR(I),4X,5HDIGIT )                        CF3 3149
      DO 221 I=1,NOIND                                                  CF3 3150
      D(I) = D(I)*DUM                                                   CF3 3151
      IF(D(I).LE.ZIP) D(I)=VSMALL                                       CF3 3152
      DNP = DLOG10(D(I))                                                CF3 3153
      IF(DNP.LE.ZIP) GO TO 876                                          CF3 3154
      DNP = DNP/TWO                                                     CF3 3155
      GO TO 878                                                         CF3 3156
  876 DNP = (DNP/TWO) - ONE                                             CF3 3157
  878 NP  = DNP + DSIGN(HALF,DNP)                                       CF3 3158
      IF(NP.EQ.0) NP= 1                                                 CF3 3159
      IF(AMAX(I).EQ.ONE.AND.W1(I).EQ.ONE) NP = -1                       CF3 3160
      IF(W1(I).EQ.ZIP) NP = -1                                          CF3 3161
  221 WRITE(KTOU,2044)  I, NP                                           CF3 3162
 2044 FORMAT(1H , 77X, I2, 8X, I3 )                                     CF3 3163
C --- ******TRAP NOT TO EXEED DIMENTIONS OF DE(NOOBSV,ISIZE))***********CF3 3164
 4444 IF(NOIND.LE.ISIZE) GO TO 4                                        CF3 3165
C --- IN SINGLE PRECISION, J=MXSIZE, IN DOUBLE J=2*MXSIZE.              CF3 3166
      J = 2*MXSIZE                                                      CF3 3167
      WRITE(KTOU,3) J                                                   CF3 3170
    3 FORMAT(1H0//48H NUMBER OF OBSERVATIONS X NUMBER OF INDEPENDENT ,  CF3 3180
     1 17HVARIABLES EXCEEDS/1X,31HCURRENT DIMENSIONS OF COMPONENT,      CF3 3190
     2 39H EFFECT OR NEAR NEIGHBOR CALCULATIONS (, I5, 1H) )            CF3 3200
      GO TO 426                                                         CF3 3210
    4 IF(NTABLE.GT.1) GO TO 102                                         CF3 3220
C --- CALCULATE COMPONENT EFFECT TABLE.                                 CF3 3221
C ---    LOAD JSORT WITH RELINF IN DECENDING ORDER.                     CF3 3230
      NT = NOIND + 1                                                    CF3 3240
      DO 2 IA = 1, NOIND                                                CF3 3250
      JA = NT - IA                                                      CF3 3260
      IB = LSORT(JA)                                                    CF3 3270
      RELINF(IA) = BI(IB)                                               CF3 3280
    2 JSORT(IA) = IB                                                    CF3 3290
      WRITE(KTOU,5102)                                                  CF3 3300
 5102 FORMAT(1H1,38X,42HLINEAR LEAST-SQUARES CURVE FITTING PROGRAM)     CF3 3310
      WRITE(KTOU,5104) PR1,PR2,PR3,ICURY,BI(K)                          CF3 3320
 5104 FORMAT(1H0,   3A6,9H  DEP VAR,I2,2H: ,A6)                         CF3 3330
      WRITE(KTOU,8)                                                     CF3 3340
    8 FORMAT(1H0,  42HCOMPONENT EFFECT OF EACH VARIABLE ON EACH ,       CF3 3350
     1 27HOBSERVATION (IN UNITS OF Y)                                   CF3 3360
     2/ 52H (VARIABLES ORDERED BY THEIR RELATIVE INFLUENCE --- ,        CF3 3370
     363HOBSERVATIONS ORDERED BY INFLUENCE OF MOST INFLUENTIAL VARIABLE)CF3 3380
     5//1X,5H SEQ., 6H OBSV., 8X, 9HVARIABLES)                          CF3 3390
      WRITE(KTOU,9) (JSORT(I),I = 1, NOIND)                             CF3 3400
    9 FORMAT(1H , 11X, 14(4X,I4), 5(/12X,14(4X,I4)) )                   CF3 3410
      WRITE(KTOU,11) (RELINF(I), I=1,NOIND), TOTALH                     CF3 3420
   11 FORMAT( 1H , 11X, 14(2X,A6), 5(/12X,14(2X,A6)) )                  CF3 3430
C --- CALCULATIONS USED IN BOTH COMPONENT EFFECT AND NEAR NEIGHBORS.    CF3 3431
  102 DO  6 IA = 1, NOOBSV                                              CF3 3440
      READ(KTBIN3) DUM,      IDZB(IA), (VAR(JZ), JZ = 1, NOVAR )        CF3 3450
      YYIN(IA) = VAR(K)                                                 CF3 3460
      YCALC = BZERO                                                     CF3 3470
      DO  5 IB = 1, NOIND                                               CF3 3480
      YCALC = YCALC + B(IB)*VAR(IB)                                     CF3 3490
    5 DE(IA,IB) = B(IB)*(VAR(IB) - AVG(IB))                             CF3 3500
    6 YYCC(IA) = YCALC                                                  CF3 3510
      DO  7 IC = 1, NOOBSV                                              CF3 3520
      DELTA(IC) = YYIN(IC) - YYCC(IC)                                   CF3 3530
    7 XXIN(IC) = DE(IC,MAXINF)                                          CF3 3540
      REWIND KTBIN3                                                     CF3 3550
      NTP = NOOBSV + 1                                                  CF3 3560
      NTL = NOOBSV                                                      CF3 3570
      IF(NTABLE.GT.1) GO TO 103                                         CF3 3580
C --- MORE COMPONENT EFFECT TABLE CALCULATIONS.                         CF3 3581
      CALL SORT(NOOBSV, XXIN, LSORT)                                    CF3 3590
      DO 12 IA = 1, NTL                                                 CF3 3600
      TOTALC = ZIP                                                      CF3 3601
      JB = NTP - IA                                                     CF3 3610
      JA = LSORT(JB)                                                    CF3 3620
      DO 10 I = 1, NOIND                                                CF3 3621
      JC = JSORT(I)                                                     CF3 3622
      XXIN(I) = DE(JA,JC)                                               CF3 3623
   10 TOTALC = TOTALC + XXIN(I)                                         CF3 3624
   12 WRITE(KTOU,13) IA, IDZB(JA), ( XXIN(I), I=1,NOIND), TOTALC        CF3 3630
   13 FORMAT(1H , I4, 2X, I4, 2X, 14(F8.2), 5(/13X,14(F8.2)) )          CF3 3640
  103 CALL SORT(NOOBSV, YYCC, LSORT)                                    CF3 3650
      JC = 4                                                            CF3 3660
   14 J = NTL*JC                                                        CF3 3670
      IF(J.LE.MXOBSV) GO TO 15                                          CF3 3680
      JC = JC - 1                                                       CF3 3690
      GO TO 14                                                          CF3 3700
   15 IC = 0                                                            CF3 3710
      DO 17 JD = 1, JC                                                  CF3 3720
      NTL = NTL - 1                                                     CF3 3730
      DO 17 IA = 1, NTL                                                 CF3 3740
      JA1 = LSORT(IA)                                                   CF3 3750
      JB = IA + JD                                                      CF3 3760
      JA2 = LSORT(JB)                                                   CF3 3770
      SSD = ZIP                                                         CF3 3780
      DO 16 IB = 1, NOIND                                               CF3 3790
      ADJAY = DE(JA1,IB) - DE(JA2,IB)                                   CF3 3800
   16 SSD = SSD + (ADJAY*ADJAY)                                         CF3 3810
      IC = IC + 1                                                       CF3 3820
      DELSD(IC) = SSD/RMS                                               CF3 3830
   17 DELYN(IC) = DABS(DELTA(JA1) - DELTA(JA2) )                        CF3 3840
      NTL = NOOBSV                                                      CF3 3850
      IC = 0                                                            CF3 3860
      DO 117 JD = 1, JC                                                 CF3 3870
      NTL = NTL - 1                                                     CF3 3880
      DO 117 IA = 1, NTL                                                CF3 3890
      JA1 = LSORT(IA)                                                   CF3 3900
      JB = IA + JD                                                      CF3 3910
      JA2 = LSORT(JB)                                                   CF3 3920
      IC = IC + 1                                                       CF3 3930
      IDRS1(IC) = IDZB(JA1)                                             CF3 3940
  117 IDRS2(IC) = IDZB(JA2)                                             CF3 3950
      WRITE(KTOU,5102)                                                  CF3 3960
      WRITE(KTOU,5106) PR1,PR2,PR3,ICURY,BI(K),RRMS                     CF3 3970
 5106 FORMAT(1H0,   3A6,9H  DEP VAR,I2,2H: ,A6, 9X,                     CF3 3980
     1 45HRESIDUAL ROOT MEAN SQUARE OF FITTED EQUATION:,  F10.2 )       CF3 3990
      WRITE(KTOU,18) JC                                                 CF3 4000
   18 FORMAT(1H0,  47HSTANDARD DEVIATION ESTIMATED FROM RESIDUALS OF ,  CF3 4010
     1 44HNEIGHBORING OBSERVATIONS (OBSERVATIONS 1 TO ,I1, 7H APART ,   CF3 4020
     2 19HIN FITTED Y ORDER).//36H       CUMULATIVE     ---------ORDER, CF3 4030
     3 59HED BY WSSD----------  ---------ORDERED BY FITTED Y--------- / CF3 4040
     4 58H  NO.    STD DEV      WSSD   OBSV.  OBSV.  DEL RESIDUALS  ,   CF3 4050
     5 45HWSSD  DEL RESIDUALS  FITTED Y   OBSV.    SEQ. )               CF3 4060
      CALL SORT( IC, DELSD, JSORT)                                      CF3 4070
      SUMDLY = ZIP                                                      CF3 4080
      XDEFR = DFLOAT(NDEFR)                                             CF3 4090
      XNOBS = DFLOAT(NOOBSV)                                            CF3 4100
      ADJAY = 1.128*DSQRT(XDEFR/XNOBS)                                  CF3 4110
      NTL = NOOBSV                                                      CF3 4111
      IF(JC.EQ.1) NTL = NTL - 1                                         CF3 4112
      DO 19 IA = 1, NTL                                                 CF3 4120
      JA = JSORT(IA)                                                    CF3 4130
      IC = LSORT(IA)                                                    CF3 4140
      SUMDLY = SUMDLY + DELYN(JA)                                       CF3 4150
      STDDLY = SUMDLY / ( DFLOAT(IA)*ADJAY)                             CF3 4160
   19 WRITE(KTOU,20)IA,STDDLY,DELSD(JA),IDRS1(JA),IDRS2(JA),DELYN(JA),  CF3 4170
     1  DELSD(IA),DELYN(IA),YYCC(IC), IDZB(IC), IA                      CF3 4180
   20 FORMAT(1H ,I3, 2X,F8.2,4X,F8.2,2(3X,I4),3X,F8.2,3X,F8.2,2X,F8.2,  CF3 4190
     1     F13.2, 5X, I4, 4X, I4 )                                      CF3 4200
C                                                                       CF3 4210
C                                                                       CF3 4220
C ---                                                                   CF3 4230
      REWIND KTBIN1                                                     CF3 4240
C --- REPLACE Z AND C MATRIX IF CP SEARCH IS DESIRED.                   CF3 4250
      IF(IQ(24).EQ.0) GO TO 22                                          CF3 4260
      READ(KTBIN1) ( DUM, I=1, NOVAR)                                   CF3 4270
   22 DO 23  I = 1, NOIND                                               CF3 4280
   23 READ(KTBIN1) (C(I,J), J = I,NOIND)                                CF3 4290
      DO 24 I = 1, NOVAR                                                CF3 4300
   24 READ(KTBIN1)    (Z(I,J), J = I,NOVAR )                            CF3 4301
C ---      SQUARE C AND Z MATRIX.                                       CF3 4302
      NOVM1 = NOVAR - 1                                                 CF3 4303
      DO 26  I = 1, NOVM1                                               CF3 4304
      IPL1 = I + 1                                                      CF3 4305
      DO 26 J = IPL1, NOVAR                                             CF3 4310
      C(J,I)= C(I,J)                                                    CF3 4311
   26 Z(J,I)= Z(I,J)                                                    CF3 4312
C          CALCULATE FITTED Y AND LIST WITH RESIDUALS                   CF3 4313
C          INITIALIZE B ZERO WITH ZERO IF YCALC HAS BZERO = 0           CF3 4314
  426 IF(IQ(5)) 428,428,427                                             CF3 4315
  427 BZERO = ZIP                                                       CF3 4320
  428 IF(IQ(9).NE.1) GO TO 438                                          CF3 4321
C        HEXADECIMAL PUNCHOUT FOR CONFIDENCE INTERVAL PROGRAM***********CF3 4322
C     WRITE(KTPCH,1020)RMS,BZERO,(B(JZ),JZ=1,KNOIND)                    CF3 4323
  438 JBACK = 1                                                         CF3 4324
      IF(IQ(8).EQ.1) GO TO 430                                          CF3 4325
      JBACK = 0                                                         CF3 4330
C *****NOTE IF FUNCTION TABLE IS DESIRED AT ALL TIMES, PUT A C IN COL 1 CF3 4331
C *****OF IF(NTABLE---) GO TO 429, 475 AND 6903 SWITCH CARDS.********** CF3 4332
      IF(NTABLE.LT.1) GO TO 429                                         CF3 4333
      WRITE(KTOU,5102)                                                  CF3 4334
      WRITE(KTOU,5104) PR1,PR2,PR3,ICURY,BI(K)                          CF3 4335
      WRITE(KTOU,5108)                                                  CF3 4340
 5108 FORMAT(1H0,46HFUNCTIONS RELATED TO THE VARIANCE OF FITTED Y.,     CF3 4341
     1 41H  OBSERVATIONS ORDERED BY COMPUTER INPUT.)                    CF3 4342
      WRITE(KTOU,5120)                                                  CF3 4350
 5120 FORMAT(1H0,49HSTUDENTIZED RESIDUAL = RESIDUAL / SQUARE ROOT OF ,  CF3 4351
     1 21HVARIANCE OF RESIDUAL.)                                        CF3 4352
      WRITE(KTOU,5122)                                                  CF3 4360
 5122 FORMAT(1H ,49HDELETED-STUDENTIZED RESIDUAL = RESIDUAL / SQUARE ,  CF3 4361
     1 30HROOT OF RESIDUAL VARIANCE WHEN/5X,22HTHAT RESIDUAL HAS BEEN,  CF3 4362
     2 43H DELETED FROM THE RESIDUAL SUMS OF SQUARES.)                  CF3 4363
      WRITE(KTOU,5124)                                                  CF3 4370
 5124 FORMAT(1H ,39HVARIANCE RATIO = VARIANCE OF FITTED Y /,            CF3 4371
     1 22H VARIANCE OF RESIDUAL.)                                       CF3 4372
      WRITE(KTOU,5126)                                                  CF3 4380
 5126 FORMAT(1H ,47HMAHALANOBIS DISTANCE = VARIANCE RATIO ADJUSTED ,    CF3 4381
     1 31HFOR THE NUMBER OF OBSERVATIONS.)                              CF3 4382
      WRITE(KTOU,5127)                                                  CF3 4383
 5127 FORMAT(1H ,48HDISTANCE IN INFLUENCE AND FACTOR SPACE, INFAC = ,   CF3 4384
     1 30H(WEIGHTED SQUARED STANDARDIZED / 5X,                          CF3 4385
     2 26HDISTANCE)(VARIANCE RATIO). )                                  CF3 4386
      WRITE(KTOU,5128)                                                  CF3 4390
 5128 FORMAT(1H ,45HDELETE-EFFECT = (VARIANCE RATIO)(STUDENTIZED ,      CF3 4391
     1 22HRESIDUAL SQUARED / P).)                                       CF3 4392
      WRITE(KTOU,5130)                                                  CF3 4400
 5130 FORMAT(1H ,49HDFFITS = (SQUARE ROOT OF VARIANCE RATIO)(DELETED-,  CF3 4401
     1 22HSTUDENTIZED RESIDUAL).)                                       CF3 4402
      DFFITL = DSQRT(PAR/XNOBS)*TWO                                     CF3 4410
      WRITE(KTOU,5132)  DFFITL                                          CF3 4411
 5132 FORMAT(1H ,4X,42HLIMITING VALUE OF DFFITS FOR THIS PROBLEM,,      CF3 4412
     1 15H 2*SQRT(P/N), =, F4.1 )                                       CF3 4413
      WRITE(KTOU,5110)                                                  CF3 4420
 5110 FORMAT(1H0,39X, 8HDELETED-, 24X,                                  CF3 4421
     1       54H-----------------------DISTANCE-----------------------/ CF3 4422
     2 1X,26X,30HSTUDENTIZED STUDENTIZED   S.E.,16X,13HVAR.   MAHAL-,   CF3 4423
     3 26X,13HDELETE-EFFECT/                                            CF3 4424
     4 1X,6HIDENT., 7H  OBSV.,4X,33HRESIDUAL  RESIDUAL    RESIDUAL   ,  CF3 4430
     5 58HFITTED Y  V(Y)/RMS   RATIO   ANOBIS   WSSD   INFAC  DFFITS,   CF3 4431
     6 17H   VALUE  PERCENT )                                           CF3 4432
  429 IF(NEWOBS.EQ.2) DELETE = ZIP                                      CF3 4440
  430 PAR = XNOBS - DEFR                                                CF3 4441
      IF(NEWOBS.NE.2) GO TO 439                                         CF3 4442
      RRMS = VRRMS                                                      CF3 4443
      WNOBS = VNOBS                                                     CF3 4444
      PAR = VPAR                                                        CF3 4445
      DEFR = VDEFR                                                      CF3 4446
C --- SET MIN VALUE OF DELETE-EFFECT FVALUE TO CALCULATE PERCENT EFFECT.CF3 4447
      DEFR = VDEFR                                                      CF3 4448
C --- SET MIN VALUE OF DELETE-EFFECT FVALUE TO CALCULATE PERCENT EFFECT.CF3 4449
  439 DEMIN = 0.47                                                      CF3 4450
      IF(PAR.GT.4) DEMIN = 0.90                                         CF3 4451
      DO 475 IB = 1, NOOBSV                                             CF3 4452
      COVTY = ZIP                                                       CF3 4453
      READ(KTBIN3) IDZA(IB),IDZB(IB), (VAR(JZ), JZ = 1,NOVAR), WEIGHT   CF3 4460
      YCALC = BZERO                                                     CF3 4461
      DO 440 J=1, NOIND                                                 CF3 4462
  440 YCALC = YCALC + B(J) * VAR(J)                                     CF3 4463
C          INITIALIZE BACK-TRANSFORMATION ROUTINE                       CF3 4464
      IF(JBACK ) 470,470,445                                            CF3 4465
  445 CALL YBACK(K,YCALC)                                               CF3 4466
      CALL YBACK(K,VAR(K) )                                             CF3 4470
       INFAC     = 0                                                    CF3 4471
      STUDNR(IB) = ZIP                                                  CF3 4472
  470 DIFF  = VAR(K)- YCALC                                             CF3 4473
      DELTA(IB) = DIFF                                                  CF3 4474
      YYIN(IB)  = VAR(K)                                                CF3 4475
      YYCC(IB)  = YCALC                                                 CF3 4480
      CALL MINMAX(YCMIN, YCMAX, YCALC )                                 CF3 4481
      RSS = RSS + (DIFF * DIFF)                                         CF3 4482
      IF(JBACK.EQ.1) GO TO 475                                          CF3 4483
C --- COMPUTATION FOR THE COVARIANCE CONTRIBUTION TO THE VARIANCE       CF3 4484
C --- OF THE FITTED Y (COVTY) AND THE RESIDUAL (COVTR).                 CF3 4485
C ---                                                                   CF3 4490
      DO 444 J=1,NOIND                                                  CF3 4491
      DO 442 I=1,NOIND                                                  CF3 4492
C ---    NOTE : : :  C MATRIX CONTAINS (X'X) INVERSE                    CF3 4493
C --- COVTY IS THE COVARIANCE CONTRIBUTION TO                           CF3 4494
C --- THE VARIANCE OF THE FITTED Y.                                     CF3 4495
C ---    COVTR = 1. - COVTY, FOR NEW Y OBS. COVTR = 1. + COVTY.         CF3 4500
      COVTY=COVTY +                                                     CF3 4501
     1((VAR(J)-AVG(J))*(VAR(I)-AVG(I))*C(I,J)/(SIGMA(I)*SIGMA(J)))      CF3 4502
  442 CONTINUE                                                          CF3 4503
  444 CONTINUE                                                          CF3 4504
C --- ADD 1/SUM OF WEIGHTED OBSERVATIONS. IF NOT WEIGHTED L.S., WNOBS=N.CF3 4505
      COVTY=COVTY+(1.D0 / WNOBS)                                        CF3 4510
C ---                                                                   CF3 4511
C --- COVTY IS TERM REQUIRED FOR TOLERENCE INTERVAL CALCULATIONS,       CF3 4512
C ---    I.E.  COVAR TERM FOR FITTED Y.                                 CF3 4513
      COVTR = DABS((( ONE / WEIGHT) - COVTY) + VSMALL)                  CF3 4514
      IF(NEWOBS.EQ.2) COVTR = ( ONE / WEIGHT) + COVTY                   CF3 4515
      IF(DABS(DELTA(IB)).LT.SMALL)   DELTA(IB) = ZIP                    CF3 4516
C --- STUDNR = STUDENTIZED RESIDUAL                                     CF3 4520
      STUDNR(IB) = DIFF/(DSQRT(COVTR)*RRMS)                             CF3 4521
      IF(NTABLE.LT.1) GO TO 475                                         CF3 4522
C --- DRMS = DELETED RESIDUAL MEAN SQUARE                               CF3 4523
      DRMS= (DEFR*RMS - (DIFF*DIFF/COVTR))/(DEFR-ONE)                   CF3 4524
C --- DSTUDR = DELETED-STUDENTIZED RESIDUAL                             CF3 4525
      DSTUDR     = DIFF/DSQRT(COVTR*DRMS)                               CF3 4530
C --- COMPUTE WSS DISTANCE.                                             CF3 4531
      SSD = ZIP                                                         CF3 4532
      DO  446 J=1, NOIND                                                CF3 4533
      SDX = ( VAR(J) - AVG(J))                                          CF3 4534
      SSDX= SDX*SDX*B(J)*B(J)                                           CF3 4535
  446 SSD = SSD + SSDX                                                  CF3 4540
      SSD = SSD/RMS                                                     CF3 4541
      VRATIO = COVTY/COVTR                                              CF3 4542
C ---  INFAC = DISTANCE IN INFLUENCE AND FACTOR SPACE                   CF3 4543
      INFAC     = IDINT(VRATIO*SSD + HALF)                              CF3 4544
      IWSSD     = IDINT(SSD + HALF)                                     CF3 4545
C                                                                       CF3 4546
C --- MAHALANOBIS DISTANCE, VRATIO ADJUSTED FOR NUMBER OF OBSERVATIONS. CF3 4547
      IMAHAL = IDINT(((COVTY-(ONE/XNOBS))/COVTR)*(XNOBS*(XNOBS - TWO)/  CF3 4548
     1          (XNOBS - ONE)) + HALF)                                  CF3 4549
C --- SEFITY = STANDARD ERROR OF FITTED Y                               CF3 4550
      SEFITY = DSQRT(COVTY*RMS)                                         CF3 4551
      IF(NEWOBS.EQ.2) GO TO 451                                         CF3 4552
C --- CALCULATE DELETE EFFECT, SEE COOK, TECHNOMETRICS, FEB. 1977.      CF3 4553
      DELETE = STUDNR(IB)*STUDNR(IB)*VRATIO/PAR                         CF3 4554
C --- DFFITS = WELSCHS DELETED FIT                                      CF3 4555
      DFFITS = DABS(DSQRT(VRATIO)*DSTUDR    )                           CF3 4560
C --- UNLESS FVALUE(DELETE) GT DEMIN, DO NOT CALCULATE % PROBILITY.     CF3 4561
      IF(DELETE.LT.DEMIN) GO TO 451                                     CF3 4570
      CALL FALPHA(PAR,DEFR,DELETE,PERCNT)                               CF3 4580
      WRITE(KTOU,5112) IDZA(IB),IDZB(IB),DELTA(IB),STUDNR(IB),DSTUDR,   CF3 4590
     1 SEFITY,COVTY,VRATIO,IMAHAL,IWSSD,INFAC,    DFFITS,DELETE,PERCNT  CF3 4591
 5112 FORMAT(1H ,A6,I6,F13.3,3X,F5.1,7X,F5.1,F12.3,  3X,F7.4,4X,F5.1,   CF3 4600
     1            3I8,      F8.1,F8.1,3X,F4.0 )                         CF3 4601
      GO TO 475                                                         CF3 4610
  451 WRITE(KTOU,5112) IDZA(IB),IDZB(IB),DELTA(IB),STUDNR(IB),DSTUDR,   CF3 4620
     1 SEFITY,COVTY,VRATIO,IMAHAL,IWSSD,INFAC,    DFFITS,DELETE         CF3 4630
  475 CONTINUE                                                          CF3 4640
C ---                                                                   CF3 4650
      IF(NEWOBS.NE.2) GO TO 6902                                        CF3 4660
      RMS  = RSS/DEFR                                                   CF3 4661
      RRMS = DSQRT(RMS)                                                 CF3 4662
      WRITE(KTOU,5102)                                                  CF3 4663
      WRITE(KTOU,5104) PR1,PR2,PR3,ICURY,BI(K)                          CF3 4664
      WRITE(KTOU,5114)                                                  CF3 4665
 5114 FORMAT(1H0,45HFIT OF SECOND SAMPLE USING COEFFICIENTS FROM ,      CF3 4666
     1 20HFIRST SAMPLE OF DATA)                                         CF3 4667
      WRITE(KTOU,3014) NOOBSV                                           CF3 4668
      NPAR= NOOBSV - NDEFR                                              CF3 4670
      WRITE(KTOU,3015) NPAR                                             CF3 4680
 3015 FORMAT(1H ,17HNO. OF PARAMETERS,14X,I4)                           CF3 4681
      WRITE(KTOU,3018) NDEFR                                            CF3 4682
      RSQD = (SSYT - RSS - FACTOR) / SSYT                               CF3 4683
      WRITE(KTOU,3022) RRMS                                             CF3 4684
      WRITE(KTOU,3024)  RMS                                             CF3 4685
      WRITE(KTOU,3026)  RSS                                             CF3 4686
      WRITE(KTOU,3028) SSYT                                             CF3 4687
      IF(IQ(5).EQ.1) GO TO 6902                                         CF3 4690
      WRITE(KTOU,3030) RSQD                                             CF3 4700
C ---      ORDER RESIDUALS                                              CF3 4710
 6902 CALL SORT(NOOBSV, DELTA, LSORT)                                   CF3 4720
      NT = NOOBSV + 1                                                   CF3 4730
      IF(NTABLE.LT.1) GO TO 6903                                        CF3 4731
      WRITE(KTOU,5102)                                                  CF3 4732
      WRITE(KTOU,5104) PR1,PR2,PR3,ICURY,BI(K)                          CF3 4733
 6903 IF(XEFMT.EQ.EFORMT) GO TO 1230                                    CF3 4734
C                                                                       CF3 4740
      REWIND KTBIN3                                                     CF3 4750
      WRITE(KTOU,1015)                                                  CF3 4760
 1015 FORMAT(1H0,61H-----------------ORDERED BY COMPUTER INPUT--------- CF3 4770
     1---------,3X,62H---------------------ORDERED BY RESIDUALS---------CF3 4780
     2------------/1X,  6HIDENT.,2X,5HOBSV.,1X,12HWSS DISTANCE,1X,6HOBS.CF3 4790
     3 Y,5X,8HFITTED Y, 5X,10HRESIDUAL  ,1X,5HOBSV.,6X,6HOBS. Y,        CF3 4800
     45X,8HFITTED Y, 2X,14HORDERED RESID.,13H STUD.RESID. ,  3HSEQ )    CF3 4810
C                                                                       CF3 4820
C ---      CALCULATE WEIGHTED SQUARED STANDARDIZED DISTANCE (WSSD) IN   CF3 4830
C ---      INFLUENCE SPACE OF EACH OBSERVATION.                         CF3 4840
      DO 1220 IC = 1, NOOBSV                                            CF3 4850
      SSD = ZIP                                                         CF3 4860
      IA = NT - IC                                                      CF3 4870
        JC = LSORT(IA)                                                  CF3 4880
      READ(KTBIN3) IDZA(IC),IDZB(IC), (VAR(JZ), JZ = 1,NOVAR )          CF3 4890
      DO 2031 J=1, NOIND                                                CF3 4900
      SDX = ( VAR(J) - AVG(J))                                          CF3 4910
      SSDX= SDX*SDX*B(J)*B(J)                                           CF3 4920
 2031 SSD = SSD + SSDX                                                  CF3 4930
      SSD = SSD/RMS                                                     CF3 4940
      IWSSD     = IDINT(SSD + HALF)                                     CF3 4950
      WRITE(KTOU,1219) IDZA(IC),IDZB(IC),IWSSD,    YYIN(IC),YYCC(IC),   CF3 4960
     1DELTA(IC),IDZB(JC),YYIN(JC),YYCC(JC),DELTA(JC),STUDNR(JC),IC      CF3 4970
 1219 FORMAT(1H ,A6,   I6, I8,    3F13.3, 1X,I6,3F13.3,6X,F5.1,4X,I4)   CF3 4980
 1220 CONTINUE                                                          CF3 4990
      GO TO 1241                                                        CF3 5000
 1230 WRITE(KTOU,1232)                                                  CF3 5010
 1232 FORMAT(1H0,54H--------------ORDERED BY COMPUTER INPUT-------------CF3 5020
     1--,4X,65H----------------------ORDERED BY RESIDUALS---------------CF3 5030
     2--------/1X,6HIDENT.,1X,8HOBS. NO.,5X,6HOBS. Y,6X,8HFITTED Y,6X,  CF3 5040
     310HRESIDUAL  ,2X,8HOBS. NO.,5X,6HOBS. Y,6X,8HFITTED Y,2X,         CF3 5050
     414HORDERED RESID.,13H STUD.RESID. ,  3HSEQ)                       CF3 5060
      IF(IQ(30).GT.NOOBSV) IQ(30) = 0                                   CF3 5070
      NSTOP = (NOOBSV - IQ(30))/2                                       CF3 5080
      DO 1240 IC = 1, NSTOP                                             CF3 5090
      IA = NT - IC                                                      CF3 5100
        JC = LSORT(IA)                                                  CF3 5110
      WRITE(KTOU,1234) IDZA(IC),IDZB(IC),YYIN(IC),YYCC(IC),DELTA(IC),   CF3 5120
     1IDZB(JC),YYIN(JC),YYCC(JC),DELTA(JC),STUDNR(JC),IC                CF3 5130
 1234 FORMAT(1H ,A6,I6,3(3X,1PE11.4),3X,I6,3(3X,1PE11.4),5X,0PF5.1,     CF3 5140
     1         4X,I4)                                                   CF3 5141
 1240 CONTINUE                                                          CF3 5150
C --- ROUND UP WHEN (NOOBSV - IQ(30) ) IS ODD NUMBER                    CF3 5151
      NSTOP = (NOOBSV - IQ(30) + 1)/2                                   CF3 5152
      NSTOP = NOOBSV - NSTOP + 1                                        CF3 5160
      DO 2240 IC = NSTOP, NOOBSV                                        CF3 5170
      IA = NT - IC                                                      CF3 5180
      JC = LSORT(IA)                                                    CF3 5190
 2240 WRITE(KTOU,1234) IDZA(IC),IDZB(IC),YYIN(IC),YYCC(IC),DELTA(IC),   CF3 5200
     1IDZB(JC),YYIN(JC),YYCC(JC),DELTA(JC),STUDNR(JC),IC                CF3 5210
 1241 IF(IQ(8).EQ.0) GO TO 1250                                         CF3 5220
      WRITE(KTOU,1242)                                                  CF3 5230
 1242 FORMAT(1H0, // 1X, 81H******OBSERVED AND FITTED Y VALUES BACK TRANCF3 5240
     1SFORMED, RESIDUAL PLOTS DELETED****** )                           CF3 5250
      GO TO 481                                                         CF3 5260
 1250 IF(IQPLOT.LT.6) GO TO 481                                         CF3 5270
      IF(IQPLOT.EQ.6) IQ(18)=2                                          CF3 5271
      IF(IQPLOT.EQ.7) IQ(18)=3                                          CF3 5272
      IF(IQPLOT.EQ.8) IQ(18)=4                                          CF3 5273
      IF(IQPLOT.EQ.9) IQ(18)=5                                          CF3 5274
      DO 1252 IC = 1, NOOBSV                                            CF3 5275
 1252 DELTA(IC) = DBLE(STUDNR(IC))*RRMS                                 CF3 5276
      CALL SORT(NOOBSV,DELTA,LSORT)                                     CF3 5277
  481 CONTINUE                                                          CF3 5280
      IRTRN=2                                                           CF3 5290
      RETURN                                                            CF3 5291
      END                                                               CF3 5300
      SUBROUTINE REDATA                                                 CF4 0010
C                                                                       CF4 0020
C ---    SUBROUTINE TO READ DATA. CAN BE REVISED TO SUIT SPECIAL NEEDS. CF4 0030
C                                                                       CF4 0040
C ---    CONTROL CARD SHOULD INDICATE THE NUMBER OF INDEPENDENT         CF4 0050
C     VARIABLES BEING RETURNED IN ARRAY LABELLED DATA(106).             CF4 0060
C     IDENTIFICATION CAN BE RETURNED USING A6 FORMAT IN IDENT.          CF4 0070
C ---     NUMBER OF OBSERVATIONS (NOOBSV) ARE COUNTED IN CF2.           CF4 0080
C     THE OBSERVATION NUMBER CAN BE RETURNED USING I4 FORMAT IN IOBSV.  CF4 0090
C     THE SEQUENCE NUMBER CAN BE RETURNED USING I2 FORMAT IN ISEQ IF    CF4 0100
C     DESIRED.                                                          CF4 0110
C ---     DATA CAN BE READ FROM NFILE SPECIFIED IN COLUMNS 52-53 OF     CF4 0120
C --- CONTROL CARD.                                                     CF4 0130
C ---     ARRAYS THAT CAN BE USED IN REDATA TO SAVE COMPUTER CORE SPACE CF4 0140
C     ARE COM4, LSORT AND IDZB, E.G.                                    CF4 0150
C     EQUIVALENCE (COM4,NEWARY)  WHERE NEWARY IS USED IN REDATA.        CF4 0160
C ---     KSL2 CAN BE USED AS A SWITCH.  KSL2 IS SET = 1 IN MAIN AFTER  CF4 0170
C     CONTROL CARD IS READ.  IF KSL2 IS SET = 2 IN REDATA AFTER READING CF4 0180
C     FIRST OBSERVATION, SUBSEQUENT OBSERVATIONS CAN BE READ IN         CF4 0190
C     DIFFERENT MANNER USING KSL2 AS A SWITCH.                          CF4 0200
C                                                                       CF4 0210
      IMPLICIT REAL*8(A-H,O-Z)                                          CF4 0220
      DOUBLE PRECISION IDENT, IEND                                      CF4 0230
      DIMENSION AVATR( 65), DATA( 66), FMT(144), IOMIT( 65), ITLOC( 65) CF4 0240
      COMMON /AAAAAA/ COM1(1000)                                        CF4 0250
      COMMON /BBBBBB/ COM2(186)                                         CF4 0260
      COMMON /CCCCCC/ COM3(240)                                         CF4 0270
      COMMON /DDDDDD/ COM4(3500)                                        CF4 0280
      COMMON /EEEEEE/ LSORT(1000)                                       CF4 0290
      COMMON /FFFFFF/ VARTR( 65), ITRFM( 65)                            CF4 0300
      COMMON /GGGGGG/ BI(65), EQU(144)                                  CF4 0310
      COMMON /HHHHHH/ BETA(41), C(40,40), Z(41,41), NNNN, MXSIZE        CF4 0320
      COMMON /JJJJJJ/ IDZB(1000)                                        CF4 0330
      COMMON /KKKKKK/ IQ(40), PR1, PR2, PR3, K, KFM, NODEP, NOIND,      CF4 0340
     1                NOOBSV, ICURY                                     CF4 0350
C                                                                       CF4 0360
      COMMON /MMMMMM/ IDENT, IEND, BZRO, IOBSV, ISEQ, JOBSV, KSL2,      CF4 0370
     1                NOERR, NVP1, NOEQ                                 CF4 0380
      COMMON /OOOOOO/ KNODEP, KNOIND, KNOVAR, KNVP1, L, NOVAR           CF4 0390
      COMMON /QQQQQQ/ KTIN, KTOU, KTPCH, KKK, KONE, KTWO, MNO, NFILE    CF4 0400
      COMMON /RRRRRR/KTBIN1, KTBIN2, KTBIN3, KTBIN4, KTBIN5             CF4 0410
C ---          EQUIVALENCE STATEMENTS IN CF 4 ARE THE SAME AS IN CF 1   CF4 0420
      EQUIVALENCE (COM1(1),AVATR(1)), (COM1(106),ITLOC(1)),             CF4 0430
     1            (COM1(321),IOMIT(1))                                  CF4 0440
      EQUIVALENCE (COM2(1),DATA(1))                                     CF4 0450
      EQUIVALENCE (COM3(1),FMT(1))                                      CF4 0460
C     READ(NFILE,FMT,END=99) IDENT,IOBSV,ISEQ,(DATA(JZ), JZ=1,40)       CF4 0470
      IF(IDENT - IEND ) 4,99,4                                          CF4 0480
    4 IA = IA                                                           CF4 0490
      RETURN                                                            CF4 0500
   99 IDENT = IEND                                                      CF4 0510
      RETURN                                                            CF4 0520
      END                                                               CF4 0530
      SUBROUTINE TRANSF                                                 CF5 0010
C                                                                       CF5 0020
C          SUBROUTINE TO PERFORM TRANSFORMATION OF VARIABLES            CF5 0030
C                                                                       CF5 0040
      IMPLICIT REAL*8(A-H,O-Z)                                          CF5 0050
      DIMENSION AVATR( 65), DATA( 66), IOMIT( 65), ITLOC( 65)           CF5 0060
      COMMON /AAAAAA/ COM1(1000)                                        CF5 0070
      COMMON /BBBBBB/ COM2(186)                                         CF5 0080
      COMMON /FFFFFF/ VARTR( 65), ITRFM( 65)                            CF5 0090
      COMMON /KKKKKK/ IQ(40), PR1, PR2, PR3, K, KFM, NODEP, NOIND,      CF5 0100
     1                NOOBSV, ICURY                                     CF5 0110
      COMMON /OOOOOO/ KNODEP, KNOIND, KNOVAR, KNVP1, L, NOVAR           CF5 0120
C ---          EQUIVALENCE STATEMENTS IN CF 1, 2 AND 5                  CF5 0130
      EQUIVALENCE (COM1(1),AVATR(1)), (COM1(106),ITLOC(1)),             CF5 0140
     1            (COM1(321),IOMIT(1))                                  CF5 0150
      EQUIVALENCE (COM2(1),DATA(1))                                     CF5 0160
C                                                                       CF5 0170
C          THE FOLLOWING TRANSFORMATION CODES ARE REPRESENTED           CF5 0180
C     BLANK = NO TRANSFORMATION                                         CF5 0190
C         0 = NO TRANSFORMATION                                         CF5 0200
C         1 = NATURAL LOG (BASE E)                                      CF5 0210
C         2 = COMMON LOG (BASE 10)                                      CF5 0220
C         3 = ANTI-LOG OF NATURAL LOG                                   CF5 0230
C         4 = ANTI-LOG OF COMMON LOG                                    CF5 0240
C         5 = POWER RAISING                                             CF5 0250
C         6 = PRODUCT OF VARIABLE AND ARGUMENT (CON)                    CF5 0260
C         7 = QUOTIENT OF VARIABLE AND ARGUMENT (CON)                   CF5 0270
C         8 = ALGEBRAIC SUM OF VARIABLE AND ARGUMENT (CON)              CF5 0280
C         9 = PRODUCT OF TWO VARIABLES                                  CF5 0290
C        10 = QUOTIENT OF TWO VARIABLES                                 CF5 0300
C        11 = SUM OF TWO VARIABLES                                      CF5 0310
C        12 = DIFFERENCE OF TWO VARIABLES                               CF5 0320
C        13 = SIN OF VAR IN RADIANS                                     CF5 0330
C        14 = COS OF VAR IN RADIANS                                     CF5 0340
C        15 = QUOTIENT OF ARGUMENT DIVIDED BY VARIABLE                  CF5 0350
C        16 = LN(LN(X))  WHERE LN = NATURAL LOG                         CF5 0360
C        17 = LOG(LOG(X))                                               CF5 0370
C        18 = LOG(X+K) = BASE 10 LOG OF (VARIABLE + .OR. - ARGUMENT)    CF5 0380
C        19 =  E**(E**X) = INVERSE OF NUMBER 16                         CF5 0390
C        20 =  10**(10**X)=INVERSE OF NUMBER 17                         CF5 0400
C                                                                       CF5 0410
      DO  65 IA= 1, NOVAR                                               CF5 0420
      VX = DATA(IA)                                                     CF5 0430
      VY = VARTR(IA)                                                    CF5 0440
      K = ITRFM(IA)                                                     CF5 0450
      IF( (K.GT.0) .AND. (K.LT.21) ) GO TO 50                           CF5 0460
      VALUE = VX                                                        CF5 0470
      GO TO 60                                                          CF5 0480
C          DETERMINE TRANSFORMATION                                     CF5 0490
   50 GO TO(1,2,3,4,5,6,7,8,9, 9, 9, 9,13,14,15,16,17,18,19,20), K      CF5 0500
C               NATURAL LOG                                             CF5 0510
    1 VALUE = DLOG(VX)                                                  CF5 0520
      GO TO 60                                                          CF5 0530
C               COMMON LOG                                              CF5 0540
    2 VALUE = DLOG10(VX)                                                CF5 0550
      GO TO 60                                                          CF5 0560
C               ANTI-LOG OF NATURAL LOG                                 CF5 0570
    3 VALUE = DEXP(VX)                                                  CF5 0580
      GO TO 60                                                          CF5 0590
C               ANTI-LOG OF COMMON  LOG                                 CF5 0600
    4 VALUE = DEXP(2.302585093 * VX)                                    CF5 0610
      GO TO 60                                                          CF5 0620
C               POWER RAISING                                           CF5 0630
    5 VALUE = VX ** VY                                                  CF5 0640
      GO TO 60                                                          CF5 0650
C               PRODUCT OF VAR + CON                                    CF5 0660
    6 VALUE = VX * VY                                                   CF5 0670
      GO TO 60                                                          CF5 0680
C               QUOTIENT OF VAR + CON                                   CF5 0690
    7 VALUE = VX / VY                                                   CF5 0700
      GO TO 60                                                          CF5 0710
C               SUM OF VAR + CON                                        CF5 0720
    8 VALUE = VX + VY                                                   CF5 0730
      GO TO 60                                                          CF5 0740
    9 MA = IDINT(0.01 * VY)                                             CF5 0750
      NA = IDINT(DMOD(VY,1.0D2))                                        CF5 0760
      K = K - 8                                                         CF5 0770
      GO TO (91,10,11,12), K                                            CF5 0780
C               PRODUCT OF TWO VARIABLES                                CF5 0790
   91 VALUE = DATA(MA) * DATA(NA)                                       CF5 0800
      GO TO 60                                                          CF5 0810
C               QUOTIENT OF TWO VARIABLES                               CF5 0820
   10 VALUE = DATA(MA) / DATA(NA)                                       CF5 0830
      GO TO 60                                                          CF5 0840
C               SUM OF TWO VARIABLES                                    CF5 0850
   11 VALUE = DATA(MA) + DATA(NA)                                       CF5 0860
      GO TO 60                                                          CF5 0870
C               DIFFERENCE OF TWO VARIABLES                             CF5 0880
   12 VALUE = DATA(MA) - DATA(NA)                                       CF5 0890
      GO TO 60                                                          CF5 0900
C               SIN OF VAR IN RADIANS                                   CF5 0910
   13 VALUE = DSIN(VX)                                                  CF5 0920
      GO TO 60                                                          CF5 0930
C               COS OF VAR IN RADIANS                                   CF5 0940
   14 VALUE = DCOS(VX)                                                  CF5 0950
      GO TO 60                                                          CF5 0960
   15 VALUE = VY / VX                                                   CF5 0970
      GO TO 60                                                          CF5 0980
   16 VALUE = DLOG(DLOG(VX))                                            CF5 0990
      GO TO 60                                                          CF5 1000
   17 VALUE = DLOG10(DLOG10(VX))                                        CF5 1010
      GO TO 60                                                          CF5 1020
   18 VALUE = DLOG10(VX + VY)                                           CF5 1030
      GO TO 60                                                          CF5 1040
   19 VALUE = DEXP(DEXP(VX))                                            CF5 1050
      GO TO 60                                                          CF5 1060
   20 VALUE = DEXP(2.302585093 * DEXP(2.302585093 * VX))                CF5 1070
      GO TO 60                                                          CF5 1080
C          DETERMINE LOCATION TO PLACE VARIABLE                         CF5 1090
   60 IF( ITLOC(IA) .GT. 0) GO TO 62                                    CF5 1100
      DATA(IA) = VALUE                                                  CF5 1110
      GO TO 65                                                          CF5 1120
   62 NA = ITLOC(IA)                                                    CF5 1130
      DATA(NA) = VALUE                                                  CF5 1140
   65 CONTINUE                                                          CF5 1150
C          OMIT VARIABLES SPECIFIED, RECALCULATING NET NO. LEFT         CF5 1160
      L=NOIND +1                                                        CF5 1170
      KNO = 1                                                           CF5 1180
      DO 115  IA = 1, NOIND                                             CF5 1190
      IF(IOMIT(IA).EQ.1) GO TO 115                                      CF5 1200
      DATA(KNO) = DATA(IA)                                              CF5 1210
      KNO = KNO + 1                                                     CF5 1220
  115 CONTINUE                                                          CF5 1230
      KNOIND = KNO -1                                                   CF5 1240
      DO 125  IA = L, NOVAR                                             CF5 1250
      IF(IOMIT(IA).EQ.1) GO TO 125                                      CF5 1260
      DATA(KNO) = DATA(IA)                                              CF5 1270
      KNO = KNO +1                                                      CF5 1280
  125 CONTINUE                                                          CF5 1290
      KNVP1 = KNO                                                       CF5 1300
      KNOVAR= KNO -1                                                    CF5 1310
      KNODEP= KNOVAR -KNOIND                                            CF5 1320
      RETURN                                                            CF5 1330
      END                                                               CF5 1340
      SUBROUTINE INV                                                    CF6 0010
C                                                                       CF6 0020
C          SUBROUTINE INVERTS MATRIX BY THE GAUSS-JORDAN METHOD OF      CF6 0030
C     REDUCTION AS DESCRIBED IN MATHEMATICAL METHODS FOR DIGITAL        CF6 0040
C     COMPUTERS, WILEY PUB.   COMMON USERS GROUP PROGRAM NO 5.0.039     CF6 0050
C                                                                       CF6 0060
C     LS = 0 TO OBTAIN INVERSE.                                         CF6 0070
C     LS = 1 TO OBTAIN PRODUCT FORM OF THE INVERSE.                     CF6 0080
C     LS = 2 WHEN THE MATRIX IS SINGULAR.                               CF6 0090
C                                                                       CF6 0100
C     N IS THE NUMBER OF INDEPENDENT VARIABLES.                         CF6 0110
C     DETT HAS THE VALUE OF THE DETERMINANT.                            CF6 0120
C     LEXP IS THE EXPONENT OF THE DETERMINANT.                          CF6 0130
C     INCOMING MATRIX A (C IN MAIN LINE) IS DESTROYED AND REPLACED BY   CF6 0140
C     THE INVERSE MATRIX.                                               CF6 0150
C                                                                       CF6 0160
      IMPLICIT REAL*8(A-H,O-Z)                                          CF6 0170
      DIMENSION C(40), LP(40)                                           CF6 0180
      COMMON /EEEEEE/ LSORT(1000)                                       CF6 0190
      COMMON /HHHHHH/ BETA(41), A(40,40), Z(41,41), N, MXSIZE           CF6 0200
C ---          EQUIVALENCE STATEMENTS IN CF 6 ALONE                     CF6 0210
C --- EQUIVALENCE (LSORT(1),C(1)), (LSORT(2*MXVRAT+1),LP(1))            CF6 0220
      EQUIVALENCE (LSORT(1),C(1)), (LSORT(161),LP(1))                   CF6 0230
      IF(N.NE.1)GO TO 1315                                              CF6 0240
      A(1,1)=1./A(1,1)                                                  CF6 0250
      RETURN                                                            CF6 0260
 1315 NN=N                                                              CF6 0270
      LS = 0                                                            CF6 0280
      DETT=1.                                                           CF6 0290
      M2=1                                                              CF6 0300
      LEXP=0                                                            CF6 0310
      LP(1)=0                                                           CF6 0320
      DO 1 M1=1,N                                                       CF6 0330
      BIG=0.                                                            CF6 0340
      DO 2 I=1,N                                                        CF6 0350
      DO 3 J=1,M2                                                       CF6 0360
      IF(I-LP(J))3,2,3                                                  CF6 0370
    3 CONTINUE                                                          CF6 0380
      IF(DABS(BIG)-DABS(A(I,1)))4,2,2                                   CF6 0390
    4 BIG=A(I,1)                                                        CF6 0400
      L1=I                                                              CF6 0410
    2 CONTINUE                                                          CF6 0420
      DETT=DETT*BIG                                                     CF6 0430
      BETT=DABS(DETT)                                                   CF6 0440
      IF(BETT-1.0D+30)100,100,101                                       CF6 0450
  100 IF(BETT-1.0D-30)103,102,102                                       CF6 0460
  101 DETT=DETT/1.0D+30                                                 CF6 0470
      LEXP=LEXP+30                                                      CF6 0480
      GO TO 102                                                         CF6 0490
  103 DETT=DETT/1.0D-30                                                 CF6 0500
      LEXP=LEXP-30                                                      CF6 0510
  102 M2=M1                                                             CF6 0520
C --- ************* TRAP IF MATRIX IS SINGULAR.  THE DEFINITION OF      CF6 0530
C --- ************* SINGULAR IS MACHINE DEPENDENT.                      CF6 0531
      IF (DABS(BIG).LE.(1.D-14)) GO TO 999                              CF6 0540
      LP(M1)=L1                                                         CF6 0550
      IF(NN-1)50,51,50                                                  CF6 0560
   50 DO 8 I=2,NN                                                       CF6 0570
    8 A(L1,I-1)=A(L1,I)/BIG                                             CF6 0580
      IF(L1-1)9,10,9                                                    CF6 0590
   10 LN=2                                                              CF6 0600
   13 LM=N                                                              CF6 0610
      GO TO 15                                                          CF6 0620
    9 LM=L1-1                                                           CF6 0630
      LN=1                                                              CF6 0640
   15 DO 11 I=LN,LM                                                     CF6 0650
      C(I)=-A(I,1)                                                      CF6 0660
      IF(C(I))12,111,12                                                 CF6 0670
  111 DO 112 J=2,NN                                                     CF6 0680
  112 A(I,J-1)=A(I,J)                                                   CF6 0690
      GO TO 11                                                          CF6 0700
   12 DO 65 J=2,NN                                                      CF6 0710
   65 A(I,J-1)=C(I)*A(L1,J-1)+A(I,J)                                    CF6 0720
   11 CONTINUE                                                          CF6 0730
      IF(LN-1)19,18,19                                                  CF6 0740
   18 LN=LN+L1                                                          CF6 0750
      IF(LN-N)13,13,19                                                  CF6 0760
   19 C(L1)=1.                                                          CF6 0770
      DO 77 I=1,N                                                       CF6 0780
   77 A(I,NN)=C(I)/BIG                                                  CF6 0790
    1 NN=NN-LS                                                          CF6 0800
   55 DO 34 K=1,N                                                       CF6 0810
      DO 16 J=1,N                                                       CF6 0820
   16 C(J)=A(J,K)                                                       CF6 0830
      DO 34 J=1,N                                                       CF6 0840
      L=LP(J)                                                           CF6 0850
      IF(K-J)56,34,34                                                   CF6 0860
   56 IF(LP(K)-L)34,34,57                                               CF6 0870
   57 DETT=-DETT                                                        CF6 0880
   34 A(J,K)=C(L)                                                       CF6 0890
      IF(LS)70,71,70                                                    CF6 0900
   71 DO 20 J=1,N                                                       CF6 0910
      DO 21 K=1,N                                                       CF6 0920
   21 C(K)=A(J,K)                                                       CF6 0930
      DO 20 K=1,N                                                       CF6 0940
      L=LP(K)                                                           CF6 0950
   20 A(J,L)=C(K)                                                       CF6 0960
      RETURN                                                            CF6 0970
   51 A(L1,1)=-1.                                                       CF6 0980
      DO 52 I=1,N                                                       CF6 0990
   52 A(I,1)=-A(I,1)/BIG                                                CF6 1000
      GO TO 55                                                          CF6 1010
   70 DO 83 I=1,N                                                       CF6 1020
      J=N+1-I                                                           CF6 1030
   83 A(I,J)=A(I,J)-1.                                                  CF6 1040
      RETURN                                                            CF6 1050
  999 N = 999                                                           CF6 1060
      RETURN                                                            CF6 1070
      END                                                               CF6 1080
      SUBROUTINE MINMAX(TMIN,TMAX,T )                                   CF7 0010
C                                                                       CF7 0020
C          SUBROUTINE TO FIND MINIMUM AND MAXIMUM OF ANY GIVEN ARRAY    CF7 0030
C                                                                       CF7 0040
      IMPLICIT REAL*8(A-H,O-Z)                                          CF7 0050
      IF (T-TMIN)  2,3,3                                                CF7 0060
    2 TMIN = T                                                          CF7 0070
    3 IF (T-TMAX)  5,5,4                                                CF7 0080
    4 TMAX = T                                                          CF7 0090
    5 RETURN                                                            CF7 0100
      END                                                               CF7 0110
      SUBROUTINE YBACK (KQ, ZBAK)                                       CF8 0010
C                                                                       CF8 0020
C          SUBROUTINE TO PREFORM BACK TRANSFORMATION OF VARIABLES       CF8 0030
C                                                                       CF8 0040
      IMPLICIT REAL*8(A-H,O-Z)                                          CF8 0050
      COMMON /FFFFFF/ VARTR( 65), ITRFM( 65)                            CF8 0060
      COMMON /KKKKKK/ IQ(40), PR1, PR2, PR3, K, KFM, NODEP, NOIND,      CF8 0070
     1                NOOBSV, ICURY                                     CF8 0080
                              LBJ = ITRFM(KQ)                           CF8 0090
      KV = 1                                                            CF8 0100
      IF( KQ .EQ. 0 ) KV = 2                                            CF8 0110
      VK = VARTR(KQ)                                                    CF8 0120
      IF( LBJ .LT.1) GO TO 9                                            CF8 0130
      IF( LBJ .GT.8) GO TO 10                                           CF8 0140
      GO TO(1,2,3,4,5,6,7,8 ), LBJ                                      CF8 0150
    1 ZBAK = DEXP(ZBAK)                                                 CF8 0160
      GO TO 9                                                           CF8 0170
    2 ZBAK = DEXP(2.302585093 * ZBAK)                                   CF8 0180
      GO TO 9                                                           CF8 0190
    3 ZBAK = DLOG(ZBAK)                                                 CF8 0200
      GO TO 9                                                           CF8 0210
    4 ZBAK = DLOG10(ZBAK)                                               CF8 0220
      GO TO 9                                                           CF8 0230
    5 GO TO(51,  9), KV                                                 CF8 0240
   51 ZBAK = DEXP(DLOG(ZBAK) / VK)                                      CF8 0250
      GO TO 9                                                           CF8 0260
    6 GO TO(61,  9), KV                                                 CF8 0270
   61 ZBAK = ZBAK / VK                                                  CF8 0280
      GO TO 9                                                           CF8 0290
    7 GO TO(71,  9), KV                                                 CF8 0300
   71 ZBAK = ZBAK * VK                                                  CF8 0310
      GO TO 9                                                           CF8 0320
    8 GO TO(81,  9), KV                                                 CF8 0330
   81 ZBAK = ZBAK - VK                                                  CF8 0340
    9 RETURN                                                            CF8 0350
   10 IF( LBJ .LT. 13) GO TO 9                                          CF8 0360
      KBJ = LBJ  - 12                                                   CF8 0370
      GO TO (13,14,15,16,17,18,19,20), KBJ                              CF8 0380
   13 ZBAK = DARSIN(ZBAK)                                               CF8 0390
      GO TO 9                                                           CF8 0400
   14 ZBAK = DARCOS(ZBAK)                                               CF8 0410
      GO TO 9                                                           CF8 0420
   15 GO TO(151,  9), KV                                                CF8 0430
  151 ZBAK =  VK / ZBAK                                                 CF8 0440
      GO TO 9                                                           CF8 0450
   16 ZBAK = DEXP(DEXP(ZBAK))                                           CF8 0460
      GO TO 9                                                           CF8 0470
   17 ZBAK = DEXP(2.302585093 * ZBAK)                                   CF8 0480
      GO TO 2                                                           CF8 0490
   18 GO TO(181,  9), KV                                                CF8 0500
  181 ZBAK = DEXP(2.302585093 * ZBAK) - VK                              CF8 0510
      GO TO 9                                                           CF8 0520
   19 ZBAK = DLOG(ZBAK)                                                 CF8 0530
      GO TO 3                                                           CF8 0540
   20 ZBAK = DLOG10(ZBAK)                                               CF8 0550
      GO TO 4                                                           CF8 0560
      END                                                               CF8 0570
      SUBROUTINE PITCHA(YCMAX,YCMIN,X,MAXINF,NBSV,ISIZE)                CF9 0010
C                                                                       CF9 0020
C ---      SUBROUTINE PLOTS (1) CUMULATIVE FREQUENCY OF RESIDUALS,      CF9 0030
C --- (2) RESIDUALS VS. FITTED Y, AND EACH INDEPENDENT VARIABLE VS.     CF9 0040
C --- (3) RESIDUALS AND (4) COMPONENT-EFFECTS-PLUS-RESIDUALS.           CF9 0050
C                                                                       CF9 0060
      IMPLICIT REAL*8(A-H,O-Z)                                          CF9 0070
      REAL*4 GRIDA(53,26), GRIDB(53,26)                                 CF9 0080
      DIMENSION AMAX(40), AMIN(40), B(40), COMPR(1000), DELTA(1000),    CF9 0090
     1          RESID(9),    X(NBSV,ISIZE), YYCC(1000), ICOMP(9),       CF9 0100
     2          NEG(8), POS(8), PRAX(51), IAND(3), ICPR(24)             CF9 0110
      COMMON /AAAAAA/ COM1(1000)                                        CF9 0120
      COMMON /BBBBBB/ COM2(186)                                         CF9 0130
      COMMON /DDDDDD/ COM4(3500)                                        CF9 0140
      COMMON /EEEEEE/ LSORT(1000)                                       CF9 0150
      COMMON /GGGGGG/ BI(65), EQU(144)                                  CF9 0160
      COMMON /HHHHHH/ BETA(41), C(40,40), Z(41,41), NNNN, MXSIZE        CF9 0170
      COMMON /KKKKKK/ IQ(40), PR1, PR2, PR3, K, KFM, NODEP, NOIND,      CF9 0180
     1                NOOBSV, ICURY                                     CF9 0190
      COMMON /NNNNNN/ DEFR, XNOIND, NOVM1, MXVRBT, MXVPBT, MXVRAT,      CF9 0200
     1                MXVPAT, MXOBSV, MAXIND, MAXOBS                    CF9 0210
      COMMON /OOOOOO/ KNODEP, KNOIND, KNOVAR, KNVP1, L, NOVAR           CF9 0220
      COMMON /QQQQQQ/ KTIN, KTOU, KTPCH, KKK, KONE, KTWO, MNO, NFILE    CF9 0230
      COMMON /RRRRRR/ KTBIN1, KTBIN2, KTBIN3, KTBIN4, KTBIN5            CF9 0240
      COMMON /TTTTTT/ NOPLOT(40)                                        CF9 0241
C ---          EQUIVALENCE STATEMENTS IN CF 3, 9                        CF9 0250
      EQUIVALENCE (COM1(1),DELTA(1)), (COM4(1),YYCC(1))                 CF9 0260
C ---          EQUIVALENCE STATEMENTS IN CF 9 ALONE                     CF9 0270
      EQUIVALENCE (COM4(1001),GRIDA(1)),(COM4(1691),GRIDB(1))           CF9 0280
      EQUIVALENCE (COM2(1),AMAX(1)), (COM2(107),B(1)),                  CF9 0290
     1            (COM4(2381),AMIN(1)), (COM4(2461),COMPR(1))           CF9 0300
      DATA RESID/1HR,1HE,1HS,1HI,1HD,1HU,1HA,1HL,1HS/                   CF9 0310
      DATA POS/1HP,1HO,1HS,1HI,1HT,1HI,1HV,1HE/                         CF9 0320
      DATA NEG/1HN,1HE,1HG,1HA,1HT,1HI,1HV,1HE/                         CF9 0330
      DATA IPLUS/4H++++/                                                CF9 0340
      DATA ICOMPT/4HCCCC/                                               CF9 0350
      DATA ISAME/4H****/                                                CF9 0360
      DATA ICOMP/1HC,1HO,1HM,1HP,1HO,1HN,1HE,1HN,1HT/                   CF9 0370
      DATA IAND/1HA,1HN,1HD/                                            CF9 0380
      DATA ICPR/1HC,1HO,1HM,1HP,1HO,1HN,1HE,1HN,1HT,1H ,1HP,1HL,1HU,    CF9 0390
     11HS,1H ,1HR,1HE,1HS,1HI,1HD,1HU,1HA,1HL,1HS/                      CF9 0400
      DATA PRAX/.000233,  .000302,  .000390,  .000501,  .000641,        CF9 0410
     1          .000816,  .001035,  .001306,  .001641,  .002052,        CF9 0420
     2          .002555,  .003167,  .003907,  .004797,  .005868,        CF9 0430
     3          .007143,  .008656,  .010444,  .012545,  .015003,        CF9 0440
     4          .017864,  .021178,  .025588,  .029379,  .034380,        CF9 0450
     5          .040059,  .046479,  .053699,  .061780,  .070781,        CF9 0460
     6          .080757,  .091759,  .103835,  .117023,  .131357,        CF9 0470
     7          .146859,  .163543,  .181411,  .200454,  .220650,        CF9 0480
     8          .241964,  .264347,  .287740,  .312067,  .337243,        CF9 0490
     9          .363169,  .389739,  .416834,  .444330,  .472097,        CF9 0500
     A          .500000/                                                CF9 0510
      ITYPE = 1                                                         CF9 0520
C --- ITYPE SELECTS FORM OF PLOT TO BE MADE IN SUBROUTINE GRID.         CF9 0530
      XNP=NOOBSV                                                        CF9 0540
      JJC=LSORT(NOOBSV)                                                 CF9 0550
      DELP=DELTA(JJC)                                                   CF9 0560
      IIC=LSORT(1)                                                      CF9 0570
      YIW=(1.005D0*(DELP-DELTA(IIC)))/51.                               CF9 0580
      XIW=(1.005D0*(YCMAX-YCMIN))/101.                                  CF9 0590
      IF(YCMAX.EQ.YCMIN) XIW=0.0001                                     CF9 0600
      IF(DELTA(IIC).LT.0.0.AND.DELP.GT.0.0) GO TO 3                     CF9 0610
      WRITE(KTOU,5)                                                     CF9 0620
    5 FORMAT(1H0//60H **** PLOTS DELETED, ALL RESIDUALS ARE POSITIVE OR CF9 0621
     1NEGATIVE.)                                                        CF9 0622
      RETURN                                                            CF9 0623
    3 DLEV = DELP                                                       CF9 0630
      DO 2 IA=1, 51                                                     CF9 0640
      DLEV = DLEV - YIW                                                 CF9 0650
      IF(DLEV.GT.0.) GO TO 2                                            CF9 0660
      L1 = IA + 1                                                       CF9 0670
      GO TO 4                                                           CF9 0680
    2 CONTINUE                                                          CF9 0690
    4 CALL GRID(GRIDA,GRIDB,L1,ITYPE)                                   CF9 0700
      DO 30 IA=1,NOOBSV                                                 CF9 0710
      JAC=LSORT(IA)                                                     CF9 0720
      LINE = IDINT((DELP-DELTA(JAC))/YIW)+2                             CF9 0730
      IF(LINE.LT.2.OR.LINE.GT.52) GO TO 30                              CF9 0740
      LOCX1=IDINT((YYCC(JAC)-YCMIN)/XIW)+1                              CF9 0750
      IF(LOCX1.LT.1.OR.LOCX1.GT.101) GO TO 10                           CF9 0760
      IF(LOCX1.EQ.1) LOCX1=2                                            CF9 0770
      LOCX2=LOCX1+4                                                     CF9 0780
      LCHAR=MOD(LOCX2,4)                                                CF9 0790
      LWORD=LOCX2/4                                                     CF9 0800
      IF(LCHAR) 8,6,8                                                   CF9 0810
    6 LCHAR=4                                                           CF9 0820
      LWORD=LWORD-1                                                     CF9 0830
    8 CALL PACK(GRIDA(LINE,LWORD),LCHAR,IPLUS)                          CF9 0840
   10 PRLOC=(IA-0.5)/XNP                                                CF9 0850
      IF(PRLOC-0.5) 12,12,18                                            CF9 0860
   12 DO 14 IB=1,51                                                     CF9 0870
      IF(PRLOC-PRAX(IB)) 16,16,14                                       CF9 0880
   14 CONTINUE                                                          CF9 0890
      IB=51                                                             CF9 0900
   16 LOCP1=IB                                                          CF9 0910
      GO TO 24                                                          CF9 0920
   18 DO 20 IB=1,51                                                     CF9 0930
      IC=52-IB                                                          CF9 0940
      IF(PRLOC+PRAX(IC)-1.) 22,22,20                                    CF9 0950
   20 CONTINUE                                                          CF9 0960
   22 LOCP1=IB+50                                                       CF9 0970
   24 LOCP2=LOCP1+4                                                     CF9 0980
      LCHAR=MOD(LOCP2,4)                                                CF9 0990
      LWORD=LOCP2/4                                                     CF9 1000
      IF(LCHAR) 28,26,28                                                CF9 1010
   26 LCHAR=4                                                           CF9 1020
      LWORD=LWORD-1                                                     CF9 1030
   28 CALL PACK(GRIDB(LINE,LWORD),LCHAR,IPLUS)                          CF9 1040
   30 CONTINUE                                                          CF9 1050
      WRITE(KTOU,34) PR1,PR2,PR3,ICURY,BI(K)                            CF9 1060
   34 FORMAT(1H1,     1X,3A6, 9H  DEP VAR ,I2,2H: ,A6,16X,              CF9 1070
     136HCUMULATIVE DISTRIBUTION OF RESIDUALS)                          CF9 1080
      WRITE(KTOU,36)                                                    CF9 1090
   36 FORMAT(1H ,17X,101H.0002  .001  .005  .01 .02   .05  .1    .2   .3CF9 1100
     1  .4  .5  .6  .7   .8    .9   .95  .98 .99 .995   .999)           CF9 1110
      WRITE(KTOU,38) ((GRIDB(IA,JZ),JZ=1,26),IA=1,3)                    CF9 1120
   38 FORMAT(1H ,19X,25A4,A2)                                           CF9 1130
      WRITE(KTOU,40) (POS(IA-3),(GRIDB(IA,JZ),JZ=1,26),IA=4,11)         CF9 1140
   40 FORMAT(1H ,17X,A1,1X,25A4,A2)                                     CF9 1150
      DO 46 IA=12,22                                                    CF9 1160
      IF(IA.EQ.L1) GO TO 42                                             CF9 1170
      WRITE(KTOU,38) (GRIDB(IA,JZ),JZ=1,26)                             CF9 1180
      GO TO 46                                                          CF9 1190
   42 WRITE(KTOU,44) (GRIDB(IA,JZ),JZ=1,26)                             CF9 1200
   44 FORMAT(1H ,17X,1H0,1X,25A4,A2)                                    CF9 1210
   46 CONTINUE                                                          CF9 1220
      DO 54 IA=23,31                                                    CF9 1230
      IF(IA.EQ.L1) GO TO 50                                             CF9 1240
      WRITE(KTOU,48) RESID(IA-22),(GRIDB(IA,JZ),JZ=1,26)                CF9 1250
   48 FORMAT(1H ,5X,A1,13X,25A4,A2)                                     CF9 1260
      GO TO 54                                                          CF9 1270
   50 WRITE(KTOU,52) RESID(IA-22),(GRIDB(IA,JZ),JZ=1,26)                CF9 1280
   52 FORMAT(1H ,5X,A1,11X,1H0,1X,25A4,A2)                              CF9 1290
   54 CONTINUE                                                          CF9 1300
      DO 58 IA=32,42                                                    CF9 1310
      IF(IA.EQ.L1) GO TO 56                                             CF9 1320
      WRITE(KTOU,38) (GRIDB(IA,JZ),JZ=1,26)                             CF9 1330
      GO TO 58                                                          CF9 1340
   56 WRITE(KTOU,44) (GRIDB(IA,JZ),JZ=1,26)                             CF9 1350
   58 CONTINUE                                                          CF9 1360
      WRITE(KTOU,40) (NEG(IA-42),(GRIDB(IA,JZ),JZ=1,26),IA=43,50)       CF9 1370
      WRITE(KTOU,38) ((GRIDB(IA,JZ),JZ=1,26),IA=51,53)                  CF9 1380
      WRITE(KTOU,36)                                                    CF9 1390
      WRITE(KTOU,60)                                                    CF9 1400
   60 FORMAT(1H ,54X,33HCUMULATIVE FREQUENCY, NORMAL GRID)              CF9 1410
      IF(YCMAX.EQ.YCMIN) GO TO 300                                      CF9 1411
      WRITE(KTOU,62) PR1,PR2,PR3,ICURY,BI(K)                            CF9 1420
   62 FORMAT(1H1,     1X,3A6, 9H  DEP VAR ,I2,2H: ,A6,22X,21HRESIDUAL VSCF9 1430
     1. FITTED Y )                                                      CF9 1440
      YCAVG = (YCMAX + YCMIN) / 2.                                      CF9 1450
      WRITE(KTOU,64) YCMIN, YCAVG, YCMAX                                CF9 1460
   64 FORMAT(1H ,13X, F10.3, 40X, F10.3, 40X, F10.3)                    CF9 1470
      WRITE(KTOU,38) ((GRIDA(IA,JZ),JZ=1,26),IA=1,3)                    CF9 1480
      WRITE(KTOU,40) (POS(IA-3),(GRIDA(IA,JZ),JZ=1,26),IA=4,11)         CF9 1490
      DO 68 IA=12,22                                                    CF9 1500
      IF(IA.EQ.L1) GO TO 66                                             CF9 1510
      WRITE(KTOU,38) (GRIDA(IA,JZ),JZ=1,26)                             CF9 1520
      GO TO 68                                                          CF9 1530
   66 WRITE(KTOU,44) (GRIDA(IA,JZ),JZ=1,26)                             CF9 1540
   68 CONTINUE                                                          CF9 1550
      DO 72 IA=23,31                                                    CF9 1560
      IF(IA.EQ.L1) GO TO 70                                             CF9 1570
      WRITE(KTOU,48) RESID(IA-22),(GRIDA(IA,JZ),JZ=1,26)                CF9 1580
      GO TO 72                                                          CF9 1590
   70 WRITE(KTOU,52) RESID(IA-22),(GRIDA(IA,JZ),JZ=1,26)                CF9 1600
   72 CONTINUE                                                          CF9 1610
      DO 76 IA=32,42                                                    CF9 1620
      IF(IA.EQ.L1) GO TO 74                                             CF9 1630
      WRITE(KTOU,38) (GRIDA(IA,JZ),JZ=1,26)                             CF9 1640
      GO TO 76                                                          CF9 1650
   74 WRITE(KTOU,44) (GRIDA(IA,JZ),JZ=1,26)                             CF9 1660
   76 CONTINUE                                                          CF9 1670
      WRITE(KTOU,40) (NEG(IA-42),(GRIDA(IA,JZ),JZ=1,26),IA=43,50)       CF9 1680
      WRITE(KTOU,38) ((GRIDA(IA,JZ),JZ=1,26),IA=51,53)                  CF9 1690
      WRITE(KTOU,64) YCMIN, YCAVG, YCMAX                                CF9 1700
      WRITE(KTOU,78)                                                    CF9 1710
   78 FORMAT(1H ,66X,8HFITTED Y)                                        CF9 1720
      IF(IQ(18).EQ.0) GO TO 300                                         CF9 1730
C --- PLOT RESIDUALS AND COMPONENT-PLUS-RESIDUALS VS IND. VARIABLES.    CF9 1740
      REWIND KTBIN1                                                     CF9 1750
      ITYPE = 3                                                         CF9 1760
      IF(IQ(24).EQ.0) GO TO 81                                          CF9 1770
      READ(KTBIN1) ( DUM, I=1, NOVAR)                                   CF9 1780
   81 IA = NOIND + NOVAR                                                CF9 1790
      DO 82 J=1,IA                                                      CF9 1800
   82 READ(KTBIN1)                                                      CF9 1810
      READ(KTBIN1) (AMAX(I),I=1,NOVAR)                                  CF9 1820
      READ(KTBIN1) (AMIN(I),I=1,NOVAR)                                  CF9 1830
      NTIME = 2                                                         CF9 1840
      IF(IQ(18).EQ.3.OR.IQ(18).EQ.5) GO TO 83                           CF9 1850
      IF(MAXINF.EQ.1) NTIME=1                                           CF9 1860
      IF(NTIME.EQ.1) GO TO 83                                           CF9 1870
      REWIND KTBIN3                                                     CF9 1880
      IF(MAXINF.EQ.NOIND) GO TO 146                                     CF9 1890
      IDONE1 = MAXINF - 1                                               CF9 1900
      IREAD = MAXINF + 1                                                CF9 1910
      DO 143 J = 1, NOOBSV                                              CF9 1920
  143 READ(KTBIN3) DUM,IDUM,(DUM,I=1,IDONE1), X(J,1),                   CF9 1930
     1             (DUM,I=IREAD,NOIND)                                  CF9 1940
      GO TO 150                                                         CF9 1950
  146 IDONE1 = MAXINF - 1                                               CF9 1960
      DO 147 J = 1, NOOBSV                                              CF9 1970
  147 READ(KTBIN3) DUM,IDUM,(DUM,I=1,IDONE1), X(J,1)                    CF9 1980
  150 YCMIN = 1.0E+32                                                   CF9 1990
      YCMAX = - YCMIN                                                   CF9 2000
      AMID = ( AMAX(MAXINF) + AMIN(MAXINF) )/ 2.0                       CF9 2010
      DO 251 J = 1, NOOBSV                                              CF9 2020
      YC = B(MAXINF)*(X(J,1) - AMID )                                   CF9 2030
      RC = YC + DELTA(J)                                                CF9 2040
      IF(YC.LT.YCMIN) YCMIN=YC                                          CF9 2050
      IF(RC.LT.YCMIN) YCMIN=RC                                          CF9 2060
      IF(YC.GT.YCMAX) YCMAX=YC                                          CF9 2070
  251 IF(RC.GT.YCMAX) YCMAX=RC                                          CF9 2080
      YIY = (1.0005D0*(YCMAX - YCMIN))/51.                              CF9 2090
      YYMAX = YCMAX                                                     CF9 2100
   83 REWIND KTBIN3                                                     CF9 2110
C --- READ INDEPENDENT VARIABLES FROM KTBIN3 IN GROUPS OF ISIZE.        CF9 2120
      IDONE  =  1                                                       CF9 2130
      IOVER  =  NOIND - ISIZE                                           CF9 2140
      IF(IOVER.GT.0) GO TO 85                                           CF9 2150
      IPLOT  =  NOIND                                                   CF9 2160
      DO 84 J = 1, NOOBSV                                               CF9 2170
   84 READ(KTBIN3) DUM,IDUM,(X(J,I),I=1,NOIND)                          CF9 2180
      GO TO 95                                                          CF9 2190
   85 IREAD  =  ISIZE + 1                                               CF9 2200
      IPLOT  =  ISIZE                                                   CF9 2210
      DO 86 J = 1, NOOBSV                                               CF9 2220
   86 READ(KTBIN3) DUM,IDUM,(X(J,I),I=1,ISIZE),(DUM,I=IREAD,NOIND)      CF9 2230
      GO TO 95                                                          CF9 2240
   87 IDONE  = IDONE + ISIZE                                            CF9 2250
      IDONE1 = IDONE - 1                                                CF9 2260
      IOVER  = IOVER - ISIZE                                            CF9 2270
      IF(IOVER.GT.0) GO TO 89                                           CF9 2280
      IPLOT  =  NOIND                                                   CF9 2290
      DO 88 J = 1, NOOBSV                                               CF9 2300
      IREAD = NOIND - IDONE1                                            CF9 2310
   88 READ(KTBIN3) DUM,IDUM,(DUM,I=1,IDONE1),(X(J,I),I=1,IREAD)         CF9 2320
      GO TO 95                                                          CF9 2330
   89 IPLOT  = IDONE1+ ISIZE                                            CF9 2340
      IREAD  = IPLOT + 1                                                CF9 2350
      DO 90 J = 1, NOOBSV                                               CF9 2360
   90 READ(KTBIN3) DUM,IDUM,(DUM,I=1,IDONE1),(X(J,I),I=1,ISIZE),        CF9 2370
     1             (DUM,I=IREAD,NOIND)                                  CF9 2380
   95 M = 0                                                             CF9 2390
      DO 290 I = IDONE, IPLOT                                           CF9 2400
      M = M + 1                                                         CF9 2410
      IF(AMAX(I).EQ.AMIN(I) ) GO TO 290                                 CF9 2411
      IF(NOPLOT(I).EQ.2) GO TO 290                                      CF9 2412
      IF(IQ(18).GT.3) GO TO 201                                         CF9 2420
C --- PLOT RESIDUALS VS. EACH INDEPENDENT VARIABLE.                     CF9 2430
      YIW=(1.0005D0*(DELP-DELTA(IIC)))/51.                              CF9 2440
      XMAX = AMAX(I)                                                    CF9 2450
      XMIN = AMIN(I)                                                    CF9 2460
      IF(XMAX.GT.0.0) GO TO 96                                          CF9 2470
      XIW=(1.0005D0*(XMAX-XMIN))/101.                                   CF9 2480
      GO TO 97                                                          CF9 2490
   96 XIW=(1.0005*XMAX-XMIN) / 101.                                     CF9 2500
   97 CALL GRID(GRIDA,GRIDB,L1,ITYPE)                                   CF9 2510
      DO 130 IA=1,NOOBSV                                                CF9 2520
      JAC=LSORT(IA)                                                     CF9 2530
      LINE = IDINT((DELP-DELTA(JAC))/YIW)+2                             CF9 2540
      IF(LINE.LT.2.OR.LINE.GT.52) GO TO 130                             CF9 2550
      LOCX1=IDINT((X(JAC,M)-XMIN)/XIW)+1                                CF9 2560
      IF(LOCX1.LT.1.OR.LOCX1.GT.101) GO TO 130                          CF9 2570
      IF(LOCX1.EQ.1) LOCX1=2                                            CF9 2580
      LOCX2=LOCX1+4                                                     CF9 2590
      LCHAR=MOD(LOCX2,4)                                                CF9 2600
      LWORD=LOCX2/4                                                     CF9 2610
      IF(LCHAR) 108,106,108                                             CF9 2620
  106 LCHAR=4                                                           CF9 2630
      LWORD=LWORD-1                                                     CF9 2640
  108 CALL PACK(GRIDA(LINE,LWORD),LCHAR,IPLUS)                          CF9 2650
  130 CONTINUE                                                          CF9 2660
      WRITE(KTOU,162) PR1,PR2,PR3,ICURY,BI(K),I,BI(I)                   CF9 2670
  162 FORMAT(1H1,     1X,3A6, 9H  DEP VAR ,I2,2H: ,A6, 9X,34HRESIDUALS VCF9 2680
     1S. INDEPENDENT VARIABLE, I2, 2H: , A6 )                           CF9 2690
      XAVG = (XMAX + XMIN)/ 2.                                          CF9 2700
      XUQ  = (XMAX + XAVG)/ 2.                                          CF9 2710
      XLQ  = (XMIN + XAVG)/ 2.                                          CF9 2720
      WRITE(KTOU,164) XMIN,XLQ,XAVG,XUQ,XMAX                            CF9 2730
  164 FORMAT(1H ,13X,F10.3,14X,F10.3,16X,F10.3,14X,F10.3,16X,F10.3)     CF9 2740
      WRITE(KTOU,38) ((GRIDA(IA,JZ),JZ=1,26),IA=1,3)                    CF9 2750
      WRITE(KTOU,40) (POS(IA-3),(GRIDA(IA,JZ),JZ=1,26),IA=4,11)         CF9 2760
      DO 168 IA=12,22                                                   CF9 2770
      IF(IA.EQ.L1) GO TO 166                                            CF9 2780
      WRITE(KTOU,38) (GRIDA(IA,JZ),JZ=1,26)                             CF9 2790
      GO TO 168                                                         CF9 2800
  166 WRITE(KTOU,44) (GRIDA(IA,JZ),JZ=1,26)                             CF9 2810
  168 CONTINUE                                                          CF9 2820
      DO 172 IA=23,31                                                   CF9 2830
      IF(IA.EQ.L1) GO TO 170                                            CF9 2840
      WRITE(KTOU,48) RESID(IA-22),(GRIDA(IA,JZ),JZ=1,26)                CF9 2850
      GO TO 172                                                         CF9 2860
  170 WRITE(KTOU,52) RESID(IA-22),(GRIDA(IA,JZ),JZ=1,26)                CF9 2870
  172 CONTINUE                                                          CF9 2880
      DO 176 IA=32,42                                                   CF9 2890
      IF(IA.EQ.L1) GO TO 174                                            CF9 2900
      WRITE(KTOU,38) (GRIDA(IA,JZ),JZ=1,26)                             CF9 2910
      GO TO 176                                                         CF9 2920
  174 WRITE(KTOU,44) (GRIDA(IA,JZ),JZ=1,26)                             CF9 2930
  176 CONTINUE                                                          CF9 2940
      WRITE(KTOU,40) (NEG(IA-42),(GRIDA(IA,JZ),JZ=1,26),IA=43,50)       CF9 2950
      WRITE(KTOU,38) ((GRIDA(IA,JZ),JZ=1,26),IA=51,53)                  CF9 2960
      WRITE(KTOU,164) XMIN,XLQ,XAVG,XUQ,XMAX                            CF9 2970
      WRITE(KTOU,178) I, BI(I)                                          CF9 2980
  178 FORMAT(1H0,55X,20HINDEPENDENT VARIABLE, I2, 2H: , A6 )            CF9 2990
      IF(IQ(18).EQ.3) GO TO 290                                         CF9 3000
C --- CALCULATE COMPONENT AND COMPONENT PLUS RESIDUAL FOR EACH OBSV.    CF9 3010
  201 L2 = 99                                                           CF9 3020
      AMID = ( AMAX(I) + AMIN(I) )/ 2.0                                 CF9 3030
      YCMIN = 1.0E+32                                                   CF9 3040
      YCMAX = - YCMIN                                                   CF9 3050
      DO 202 J = 1, NOOBSV                                              CF9 3060
      YC = B(I)*(X(J,M) - AMID )                                        CF9 3070
      RC = YC + DELTA(J)                                                CF9 3080
      YYCC(J)  = YC                                                     CF9 3090
      COMPR(J) = RC                                                     CF9 3100
      IF(YC.LT.YCMIN) YCMIN=YC                                          CF9 3110
      IF(RC.LT.YCMIN) YCMIN=RC                                          CF9 3120
      IF(YC.GT.YCMAX) YCMAX=YC                                          CF9 3130
  202 IF(RC.GT.YCMAX) YCMAX=RC                                          CF9 3140
      XMAX=AMAX(I)                                                      CF9 3150
      XMIN=AMIN(I)                                                      CF9 3160
      IF(XMAX.GT.0.0) GO TO 204                                         CF9 3170
      XIW=(1.0005D0*(XMAX-XMIN))/101.                                   CF9 3180
      GO TO 206                                                         CF9 3190
  204 XIW=(1.0005D0*(XMAX-XMIN))/101.                                   CF9 3200
  206 IF(IQ(18).EQ.5) GO TO 208                                         CF9 3210
      IF(NTIME.EQ.2) GO TO 210                                          CF9 3220
  208 YIY = (1.0005D0*(YCMAX - YCMIN))/51.                              CF9 3230
      YYMAX = YCMAX                                                     CF9 3240
      NTIME = 2                                                         CF9 3250
  210 CALL GRID(GRIDA,GRIDB,L2,ITYPE)                                   CF9 3260
C --- FIND THE CHARACTER NUMBER (ABSCISSA) (1 TO 101)                   CF9 3270
      NOP = 0                                                           CF9 3280
      DO 220 J=1, NOOBSV                                                CF9 3290
      LOCX1=IDINT((X(J,M)-XMIN)/XIW)+1                                  CF9 3300
      IF(LOCX1.LT.1.OR.LOCX1.GT.101) GO TO 220                          CF9 3310
      IF(LOCX1.EQ.1) LOCX1=2                                            CF9 3320
      LOCX2 = LOCX1 + 4                                                 CF9 3330
      LCHAR = MOD(LOCX2,4)                                              CF9 3340
C --- FIND WORD NUMBER (1 TO 26 AT 6 CHARACTERS PER WORD)               CF9 3350
      LWORD = LOCX2/4                                                   CF9 3360
      IF(LCHAR) 216, 214, 216                                           CF9 3370
  214 LCHAR = 4                                                         CF9 3380
      LWORD = LWORD - 1                                                 CF9 3390
  216 LINE = IDINT((YYMAX-YYCC(J))/YIY)+2                               CF9 3400
C --- DONT PRINT IF LINE IS TOO LARGE.                                  CF9 3410
      IF(LINE.LT.2.OR.LINE.GT.52) GO TO 220                             CF9 3420
C --- PLACE PLOTTING CHARACTER IN POSITION LCHAR OF GRIDA(LINE,WORD)    CF9 3430
      CALL PACK(GRIDA(LINE,LWORD),LCHAR,ICOMPT)                         CF9 3440
      LINE2 = IDINT((YYMAX-COMPR(J))/YIY)+2                             CF9 3450
      IF(LINE2.LT.2.OR.LINE2.GT.52) GO TO 119                           CF9 3460
      ISYM = IPLUS                                                      CF9 3470
      IF(LINE2.EQ.LINE) ISYM=ISAME                                      CF9 3480
      CALL PACK(GRIDA(LINE2,LWORD),LCHAR,ISYM)                          CF9 3490
      GO TO 220                                                         CF9 3500
  119 NOP = NOP + 1                                                     CF9 3510
  220 CONTINUE                                                          CF9 3520
      WRITE(KTOU,230) PR1,PR2,PR3,ICURY,BI(K),I,BI(I)                   CF9 3530
  230 FORMAT(1H1,     1X,3A6, 9H  DEP VAR ,I2,2H: ,A6, 9X, 49HCOMPONENT CF9 3540
     1WITH RESIDUALS VS. INDEPENDENT VARIABLE , I2, 2H: , A6/           CF9 3550
     2 49X, 42HC = COMPONENT, + = WITH RESIDUAL, * = BOTH )             CF9 3560
      XAVG = (XMAX + XMIN)/ 2.                                          CF9 3570
      XUQ  = (XMAX + XAVG)/ 2.                                          CF9 3580
      XLQ  = (XMIN + XAVG)/ 2.                                          CF9 3590
      WRITE(KTOU,164) XMIN,XLQ,XAVG,XUQ,XMAX                            CF9 3600
      WRITE(KTOU,38) ((GRIDA(IA,JZ),JZ=1,26),IA=1,15)                   CF9 3610
      WRITE(KTOU,231) (ICPR(IA-15),(GRIDA(IA,JZ),JZ=1,26),IA=16,22)     CF9 3620
  231 FORMAT(1H ,13X,           A1,5X,25A4,A2)                          CF9 3630
      WRITE(KTOU,232) (ICOMP(IA-22),ICPR(IA-15),                        CF9 3640
     1                (GRIDA(IA,JZ),JZ=1,26),IA=23,25)                  CF9 3650
  232 FORMAT(1H ,5X,A1,7X,      A1,5X,25A4,A2)                          CF9 3660
      WRITE(KTOU,233) (ICOMP(IA-22),IAND(IA-25), ICPR(IA-15),           CF9 3670
     1                (GRIDA(IA,JZ),JZ=1,26),IA=26,28)                  CF9 3680
  233 FORMAT(1H ,5X,A1,3X,A1,3X,A1,5X,25A4,A2)                          CF9 3690
      WRITE(KTOU,232) (ICOMP(IA-22),ICPR(IA-15),                        CF9 3700
     1                (GRIDA(IA,JZ),JZ=1,26),IA=29,31)                  CF9 3710
      WRITE(KTOU,231) (ICPR(IA-15),(GRIDA(IA,JZ),JZ=1,26),IA=32,39)     CF9 3720
      WRITE(KTOU,38) ((GRIDA(IA,JZ),JZ=1,26),IA=40,53)                  CF9 3730
      WRITE(KTOU,164) XMIN,XLQ,XAVG,XUQ,XMAX                            CF9 3740
      WRITE(KTOU,178) I, BI(I)                                          CF9 3750
      WRITE(KTOU,234) NOP                                               CF9 3760
  234 FORMAT(1H , I3, 26H RESIDUALS OUTSIDE OF PLOT )                   CF9 3770
  290 CONTINUE                                                          CF9 3780
      IF(IOVER.LE.0) GO TO 291                                          CF9 3790
      REWIND KTBIN3                                                     CF9 3800
      GO TO 87                                                          CF9 3810
C --- REPLACE Z AND C MATRIX IF CP SEARCH IS DESIRED.                   CF9 3820
  291 IF(IQ(25).EQ.0.AND.IQ(26).EQ.0) GO TO 300                         CF9 3830
      REWIND KTBIN1                                                     CF9 3840
      IF(IQ(24).EQ.0) GO TO 292                                         CF9 3850
      READ(KTBIN1) ( DUM, I=1, NOVAR)                                   CF9 3860
  292 DO 293  I = 1, NOIND                                              CF9 3870
  293 READ(KTBIN1) (C(I,J), J = I,NOIND)                                CF9 3880
      DO 294 I = 1, NOVAR                                               CF9 3890
  294 READ(KTBIN1)    (Z(I,J), J = I,NOVAR )                            CF9 3900
C ---      SQUARE Z MATRIX.                                             CF9 3910
      NOVM1 = NOVAR - 1                                                 CF9 3920
      DO 296  I = 1, NOVM1                                              CF9 3930
      IPL1 = I + 1                                                      CF9 3940
      DO 296 J = IPL1, NOVAR                                            CF9 3950
  296 Z(J,I)= Z(I,J)                                                    CF9 3960
  300 RETURN                                                            CF9 3970
      END                                                               CF9 3980
      SUBROUTINE GRID(GRIDA,GRIDB,L1,ITYPE)                             CF100010
C                                                                       CF100020
C     SUBROUTINE MAKES GRIDA FOR RESIDUALS VS. FITTED Y.                CF100030
C     SUBROUTINE MAKES GRIDB FOR CUMULATIVE DISTRIBUTION OF RESIDUALS.  CF100040
C --- GRIDA IS ALSO USED TO PLOT COMPONENT-PLUS RESIDUALS VS EACH       CF100050
C ---    INDEPENDENT VARIABLE AND IS USED TO MAKE THE CP VS P PLOTS.    CF100060
C ---    WHEN ITYPE = 1, BOTH GRIDA AND GRIDB PLOTS ARE MADE.           CF100070
C ---    WHEN ITYPE = 2, GRIDA ALONE IS MADE.                           CF100080
C ---    WHEN ITYPE = 3, THE PLOT AREA IS BLANKED OUT, REUSING THE      CF100090
C ---      OUTLINE FROM A PREVIOUS PLOT.                                CF100100
C ---    L1 IS THE LINE AT WHICH THE RESIDUALS CROSS 0.  WHEN L1=99,    CF100110
C ---      THE ZERO LINE IS NOT PLOTTED.                                CF100120
C                                                                       CF100130
C                                                                       CF100140
      DIMENSION GRIDA(53,26),GRIDB(53,26),GRDA(7),GRDB(4)               CF100150
      DATA GRDA/4H*---,4H-*--,4H--*-,4H---*,4H----,2H*-,2H--/           CF100160
      DATA GRDB/4HI   ,2H I,4HI---,2H-I/                                CF100170
      DATA BLANK/4H    /,BLINK/4H   '/                                  CF100180
      GO TO (1,21,23), ITYPE                                            CF100190
    1 DO 2 IA=1,5                                                       CF100200
      DO 2 IB=1,5                                                       CF100210
      IC=(IA-1)*5+IB                                                    CF100220
      GRIDA(1,IC)=GRDA(IB)                                              CF100230
    2 GRIDA(53,IC)=GRDA(IB)                                             CF100240
      GRIDA(1,26)=GRDA(6)                                               CF100250
      GRIDA(53,26)=GRDA(6)                                              CF100260
      GRIDB(1, 1)=GRDA(1)                                               CF100270
      GRIDB(1, 2)=GRDA(3)                                               CF100280
      GRIDB(1, 3)=GRDA(5)                                               CF100290
      GRIDB(1, 4)=GRDA(3)                                               CF100300
      GRIDB(1, 5)=GRDA(2)                                               CF100310
      GRIDB(1, 6)=GRDA(2)                                               CF100320
      GRIDB(1, 7)=GRDA(4)                                               CF100330
      GRIDB(1, 8)=GRDA(5)                                               CF100340
      GRIDB(1, 9)=GRDA(1)                                               CF100350
      GRIDB(1,10)=GRDA(3)                                               CF100360
      GRIDB(1,11)=GRDA(4)                                               CF100370
      GRIDB(1,12)=GRDA(4)                                               CF100380
      GRIDB(1,13)=GRDA(4)                                               CF100390
      GRIDB(1,14)=GRDA(4)                                               CF100400
      GRIDB(1,15)=GRDA(4)                                               CF100410
      GRIDB(1,16)=GRDA(5)                                               CF100420
      GRIDB(1,17)=GRDA(1)                                               CF100430
      GRIDB(1,18)=GRDA(3)                                               CF100440
      GRIDB(1,19)=GRDA(4)                                               CF100450
      GRIDB(1,20)=GRDA(5)                                               CF100460
      GRIDB(1,21)=GRDA(2)                                               CF100470
      GRIDB(1,22)=GRDA(2)                                               CF100480
      GRIDB(1,23)=GRDA(1)                                               CF100490
      GRIDB(1,24)=GRDA(5)                                               CF100500
      GRIDB(1,25)=GRDA(1)                                               CF100510
      GRIDB(1,26)=GRDA(7)                                               CF100520
      DO 4 IA=1,26                                                      CF100530
    4 GRIDB(53,IA)=GRIDB(1,IA)                                          CF100540
      DO 8 IA=2,52                                                      CF100550
      DO 6 IB=2,25                                                      CF100560
      GRIDA(IA,IB)=BLANK                                                CF100570
      GRIDB(IA,IB)=BLANK                                                CF100580
    6 CONTINUE                                                          CF100590
      GRIDB(IA,13)=BLINK                                                CF100600
    8 CONTINUE                                                          CF100610
      DO 10 IA=2,52                                                     CF100620
      GRIDA(IA,1)=GRDB(1)                                               CF100630
      GRIDA(IA,26)=GRDB(2)                                              CF100640
      GRIDB(IA,1)=GRDB(1)                                               CF100650
   10 GRIDB(IA,26)=GRDB(2)                                              CF100660
      DO 12 IA=2,25                                                     CF100670
      GRIDA(L1,IA)=GRDA(5)                                              CF100680
   12 GRIDB(L1,IA)=GRDA(5)                                              CF100690
      GRIDA(L1,1)=GRDB(3)                                               CF100700
      GRIDA(L1,26)=GRDB(4)                                              CF100710
      GRIDB(L1,1)= GRDB(3)                                              CF100720
      GRIDB(L1,26)=GRDB(4)                                              CF100730
      RETURN                                                            CF100740
   21 DO 22 IA=1,5                                                      CF100750
      DO 22 IB=1,5                                                      CF100760
      IC=(IA-1)*5+IB                                                    CF100770
      GRIDA(1,IC)=GRDA(IB)                                              CF100780
   22 GRIDA(53,IC)=GRDA(IB)                                             CF100790
      GRIDA(1,26)=GRDA(6)                                               CF100800
      GRIDA(53,26)=GRDA(6)                                              CF100810
   23 DO 24 IA=2,52                                                     CF100820
      DO 24 IB=2,25                                                     CF100830
   24 GRIDA(IA,IB)=BLANK                                                CF100840
      IF(L1.NE.99) GO TO 28                                             CF100850
      DO 26 IA=2,52                                                     CF100860
      GRIDA(IA,1)=GRDB(1)                                               CF100870
   26 GRIDA(IA,26)=GRDB(2)                                              CF100880
      RETURN                                                            CF100890
   28 DO 29 IA=2,52                                                     CF100900
      GRIDA(IA,1)=GRDB(1)                                               CF100910
   29 GRIDA(IA,26)=GRDB(2)                                              CF100920
      DO 30 IA=2,25                                                     CF100930
   30 GRIDA(L1,IA)=GRDA(5)                                              CF100940
      GRIDA(L1,1)=GRDB(3)                                               CF100950
      GRIDA(L1,26)=GRDB(4)                                              CF100960
      RETURN                                                            CF100970
      END                                                               CF100980
      SUBROUTINE PACK(X,N,C)                                            CF110010
C                                                                       CF110020
C          SUBROUTINE PLACES THE APPROPRIATE SYMBOLS ON THE PLOTS       CF110030
C     CHARACTER C IS PLACED IN BYTE N OF WORD X, WHERE WORD X IS        CF110031
C     A SIMULATE BYTE IBM 360 WORD, WITH BYTES NUMBERED FROM THE LEFT.  CF110032
C     N TAKES VALUES OF 1, 2, 3 OR 4.  PACK IS CALLED FROM PITCHA       CF110033
C     AND CPMAIN.                                                       CF110034
C                                                                       CF110040
      Y=X                                                               CF110080
      CALL DEPSIT(C,N,Y)                                                CF110090
      X=Y                                                               CF110110
      RETURN                                                            CF110120
      END                                                               CF110130
      SUBROUTINE CPMAIN(ZMS)                                            CF120010
C ---    SUBROUTINE SETS UP AND CONTROLS CP CALCULATIONS, PRINTOUTS,    CF120020
C     AND PLOTS.  CP MAIN AND ASSOC. SUBROUTINES WRITTEN BY F.S.WOOD.   CF120030
C                                                                       CF120040
C ---          GLOSSARY OF CP PROGRAM TERMS                             CF120050
C --- AVAR() NAME OF VARIABLE IN ENGLISH.                               CF120060
C --- BI  () ARRAY OF ENGLISH NAMES OF VARIABLES IN FULL EQUATION.      CF120070
C --- C   () C ARRAY OF SIMPLE CORRELATION COEFFICIENTS OF BASIC        CF120080
C ---         EQUATION.                                                 CF120090
C --- CP  () ARRAY OF CP VALUES INDEXED BY L,  CP(L) = (ZSSL/ZMS) - NP. CF120100
C --- CPHI   FIRST SETTING OF CPHIGH.                                   CF120110
C --- CPHIGH MAXIMUM CP VALUE OF EQUATION PRINTED IN CP SEARCH.  THE    CF120120
C ---         LEVEL IS RESET AFTER LCP CANDIDATES HAVE BEEN FOUND TO    CF120130
C ---         THE CP VALUE OF THE LOWEST JCP  EQUATION.                 CF120140
C --- CPTOP  LARGEST CP VALUE USED IN THE CP VS. P PLOT.                CF120150
C --- HAPPY  ELEMENT C(JOY,JOY), USED TO SWEEP MATRIX.                  CF120160
C --- IBACK  IN T DIRECTED SEARCH, NUMBER OF VARIABLES BACK FROM MIN    CF120161
C ---         CP.  USED TO SET BASIC SET OF VARIABLES.                  CF120162
C --- IC     COUNTER.                                                   CF120170
C --- ICP () INDEX OF VARIABLES READ FROM INPUT CARD TO BE SEARCHED.    CF120180
C ---         OTHER VARIABLES IN FULL EQUATION ARE PLACED IN BASIC      CF120190
C ---         EQUATION.                                                 CF120200
C --- ICURY  THE NUMBER OF THE DEPENDENT VARIABLE.                      CF120210
C --- IN     NUMBER OF VARIABLES IN EACH EQUATION.                      CF120220
C --- INOUT()INDEX OF VARIABLE POSITIONS USED TO DETERMINE WHICH        CF120230
C ---         VARIABLE IS IN EACH EQUATION.                             CF120240
C --- IP  () INDEX OF P VARIABLES IN EQUATION L.                        CF120250
C --- IS  () ARRAY USED TO GENERATE THE GARSIDE SEQUENCE FOR ADDING     CF120260
C ---         AND DELEATING VARIABLES.                                  CF120270
C --- ISRCH  INDICATION THAT CP SEARCH HAS BEEN REQUESTED IF=1, IQ(25). CF120280
C --- IVGT() INDEX OF VARIABLES IN BASIC EQUATION.                      CF120290
C --- IVLT() INDEX OF VARIABLES TO BE SEARCHED.                         CF120300
C --- JCP    NUMBER OF LOWEST CP EQUATIONS IN FIRST LCP EQUATIONS.      CF120310
C --- JMAX   MAXIMUM NUMBER OF SWEEPS.                                  CF120320
C --- JOY    NAME OF VARIABLE USED TO SWEEP Z ARRAY, SOMETIMES FSW.     CF120330
C --- JRETRN COUNT OF SWEEPS BEFORE RETURNING TO BASIC SCC MATRIX C.    CF120340
C --- JSWEEP COUNT OF SWEEPS BEFORE CHANGING SIZE OF SWEEP.             CF120350
C --- K      THE POSITION OF THE DEPENDENT VARIABLE IN THE Z ARRAY.     CF120360
C --- KRET   NUMBER OF VARIABLES PRESENT BEFORE RETURNING TO BASIC SCC  CF120370
C ---         MATRIX C.                                                 CF120380
C --- KSEQ   COUNT OF K VARIABLES IN CURRENT SWEEP.                     CF120390
C --- KSEQP1 SIZE OF SWEEP (K VARIABLES IN CURRENT SEQUENCE PLUS 1).    CF120400
C --- L      INDEX OF EQUATIONS USED IN CP CALCULATIONS.                CF120410
C --- LCP    NUMBER OF EQUATIONS FOUND BEFORE RESETTING CPHIGH.         CF120420
C --- LE     NUMBER OF SUBSET EQUATION WITH RMS LESS THAN FULL          CF120430
C ---         EQUATION.                                                 CF120440
C --- LMORE  MAXCIP - LCP                                               CF120450
C --- MAXCIP TRAP FOR MAXIMUM DIMENSIONS OF CP AND IP.                  CF120460
C --- MAXCPS MAXIMUM NUMBER OF VARIABLES ALLOWED IN STANDARD CP SEARCH  CF120461
C ---         SET BY TIME AND MONEY RESTRAINTS IN SUBROUTINE BASPGM.    CF120462
C --- MAXNPR MAXIMUM NUMBER OF SORTED CP VALUES PRINTED (SET IN CPPLOT) CF120470
C --- MAXSRH TRAP FOR MAXIMUM NUMBER OF VARIABLES TO BE SEARCHED.       CF120480
C --- MINCPS MINIMUM NUMBER OF VARIABLES IN STANDARD CP SEARCH WITHOUT  CF120481
C ---         OVERRIDE OF TOTAL NUMBER OF VARIABLES GIVEN IN COLUMNS    CF120482
C ---         43-44 OF CONTROL CARD.  LIMIT IS SET IN SUBROUTINE BASPGM.CF120483
C --- MP     VALUE  OF P DEPENDING IF NGT IS ZERO OR NOT.               CF120490
C --- NCP    NUMBER OF CP AND FACTORIAL SEARCHES.                       CF120500
C --- NFCARD NUMBER OF FACTORIAL SEARCH CARDS, IQ(26),COL52.            CF120510
C --- NGT    NUMBER OF VARIABLES IN BASIC EQUATION, NO. OF VARIABLES    CF120520
C ---         WITH THE GREATER T-VALUES.                                CF120530
C --- NLT    NUMBER OF VARIABLES TO BE SEARCHED,  NO. OF VARIABLES      CF120540
C ---         WITH THE LOWER T-VALUES.                                  CF120550
C --- NODEP  NUMBER OF DEPENDENT VARIABLES.                             CF120560
C --- NOIND  NUMBER OF INDEPENDENT VARIABLES.                           CF120570
C --- NOVAR  NUMBER OF VARIABLES, DEPENDENT AND INDEPENDENT.            CF120580
C --- NP     = N - 2P, UPDATED AND USED IN EACH CP CALCULATION.         CF120590
C --- NSRCH  NUMBER OF THAT PARTICULAR SEARCH.                          CF120600
C --- P      NUMBER OF VARIABLES IN EQUATION COUNTING BZERO.            CF120610
C --- RMS    RESIDUAL MEAN SQUARE OF FULL EQUATION, TAKEN AS THE        CF120620
C ---         ESTIMATED VARIANCE OF Y FOR THE CP CALCULATION.           CF120630
C --- RMSE   ESTIMATE OF RMS EITHER READ FROM CARD OR VALUE FOUND IN    CF120640
C ---         SUBSET EQUATION THAT IS SMALLER THAN RMS.                 CF120650
C --- RMSR   RATIO OF RMS/RMSE.                                         CF120660
C --- SIGN   POSITIVE SIGN INDICATES VARIABLE ADDED, NEGATIVE SIGN      CF120670
C ---         INDICATES VARIABLE REMOVED.                               CF120680
C --- TVALUE ARRAY CONTAINING THE T-VALUES OF THE INDEPENDENT           CF120690
C ---         VARIABLES IN THE FULL EQUATION.                           CF120700
C --- U   () ARRAY USED TO MODIFY Z ARRAY FOR VARIABLES ADDED AND       CF120710
C ---         DELETED.                                                  CF120720
C --- Z   () Z ARRAY OF SIMPLE CORRELATION COEFFICIENTS, AT START       CF120730
C ---          FROM FULL EQUATION, THEN MODIFIED AS VARIABLES ARE       CF120740
C ---          ADDED, SEE BROWNLEE SECTION 17.10, EQUATION 10.5.        CF120750
C --- ZMS    RMS CONVERTED TO UNITS OF SIMPLE CORRELATION COEFFICIENT,  CF120760
C ---            ZMS = RMS / (STDDEV(K)*STDDEV(K)*(NOOBSV-1)).          CF120770
C                                                                       CF120780
      IMPLICIT REAL*8(A-H,O-Z)                                          CF120790
C                                                                       CF120800
      DIMENSION NCP1(53)                                                CF120801
      DIMENSION AVAR(40), CP(1000), INOUT(40), IP(1000), IS(40),        CF120810
     1          IVAR(40), IVGT(40), IVLT(40), TVALUE(40)                CF120820
C *** TO MAKE A 50 VARIABLE, 2000 OBSERVATION PROGRAM, CHANGE THE       CF120830
C *** DIMENSIONS OF AVAR, INOUT, IVAR, IVGT, IVLT AND TVALUE TO 50.     CF120840
      COMMON /AAAAAA/ COM1(1000)                                        CF120850
      COMMON /BBBBBB/ COM2(186)                                         CF120860
      COMMON /CCCCCC/ COM3(240)                                         CF120870
      COMMON /DDDDDD/ COM4(3500)                                        CF120880
      COMMON /EEEEEE/ LSORT(1000)                                       CF120890
      COMMON /FORFIT/ RMS, YCMAX, YCMIN, YSS(10), MAXYSS, K411, NCP     CF120900
      COMMON /GGGGGG/ BI(65), EQU(144)                                  CF120910
      COMMON /HHHHHH/ BETA(41), C(40,40), Z(41,41), NNNN, MXSIZE        CF120920
      COMMON /JJJJJJ/ IDZB(1000)                                        CF120930
      COMMON /KKKKKK/ IQ(40), PR1, PR2, PR3, K, KFM, NODEP, NOIND,      CF120940
     1                NOOBSV, ICURY                                     CF120950
      COMMON /NNNNNN/ DEFR, XNOIND, NONONO, MXVRBT, MXVPBT, MXVRAT,     CF120960
     1                MXVPAT, MXOBSV, MAXIND, MAXOBS                    CF120970
      COMMON /QQQQQQ/ KTIN, KTOU, KTPCH, KKD, KOND, KTWD, MND, NFILE    CF120980
      COMMON /RRRRRR/ KTBIN1, KTBIN2, KTBIN3, KTBIN4, KTBIN5            CF120990
      COMMON /SSSSSS/ ICP(40), MAXICP, MAXLBS, MINLBS, MAXCPS, MINCPS   CF121000
C ---          EQUIVALENCE STATEMENTS IN CF 12 ALONE                    CF121010
      EQUIVALENCE (COM1(1),CP(1)), (COM2(1),INOUT(1)), (COM4(1),IS(1)), CF121020
     1 (COM3(1),AVAR(1)), (COM3(81),IVLT(1)), (COM3(161),IVGT(1)),      CF121030
     2 (COM3(161),IVAR(1)), (BETA(1),TVALUE(1)),  (IDZB(1),IP(1))       CF121040
C                                                                       CF121050
C                                                                       CF121060
C                                                                       CF121070
C                                                                       CF121080
C --                                                                    CF121090
C ---*******************************************************************CF121100
C --                                                                    CF121110
C ---      LIMITS THAT CAN BE SET BY THE INSTALLATION STATISTICIAN.     CF121120
C ---       FOR DEFINITIONS SEE THE GLOSSARY ABOVE.                     CF121130
C ---                                                                   CF121140
C --- MAX LEVEL OF CP TO SAVE NAMES OF VARIABLES. CAN BE CHANGED        CF121150
C ---  AT STATEMENT 300,  E.G. CPHI = CPMAX + 2.0       OR              CF121160
C ---  CPHI = (CPMAX + DFLOAT(MP) ) / 2.                                CF121170
C --- CPHI IS SET EQUAL TO CPHIGH AT START OF INTERNAL DO LOOP 5000.    CF121180
C --- CPHIGH IS RESET AT STATEMENT 92 TO CP VALUE OF LOWEST JCP         CF121190
C ---  EQUATIONS OUT OF LCP CANDIDATE EQUATIONS FOUND AT FIRST CPHI     CF121200
C ---  SETTING.                                                         CF121210
    1 JCP    =  20                                                      CF121220
      LCP    = 200                                                      CF121230
C ---                                                                   CF121240
C --- MAXCPS IS THE TOTAL NUMBER OF VARIABLES THAT CAN BE SEARCHED.     CF121250
C ---  EACH COMPUTER CENTER MAY WISH TO HAVE MORE THAN ONE PROGRAM      CF121260
C ---  COMPILED WITH DIFFERENT LEVELS OF MAXCPS AND MINCPS SET IN       CF121270
C ---  SUBROUTINE BASPGM.                                               CF121271
      MAXSRH = MINCPS                                                   CF121280
      IF(IQ(21).GT.MINCPS.AND.IQ(21).LE.MAXCPS) MAXSRH = IQ(21)         CF121290
C --- THE TOTAL NUMBER OF SEARCHES = 2**MAXSRH.                         CF121300
C ---    WHEN MAXSRH = 12, TOTAL =   4,096 SEARCHES,                    CF121310
C ---    WHEN MAXSRH = 14, TOTAL =  16,384 SEARCHES,                    CF121320
C ---    WHEN MAXSRH = 18, TOTAL = 256,144 SEARCHES.                    CF121330
C --- MAXSRH MUST NOT BE  LARGER THAN THE DIMENSIONS OF ICP IN BASPGM   CF121340
C ---  AND CPMAIN SUBROUTINES.  IS(40) IS DIMENSIONED TO HOLD MAXSRH=20 CF121350
      IBACK = 2                                                         CF121351
C --                                                                    CF121360
C ---*******************************************************************CF121370
C --                                                                    CF121380
      DATA BLANK/6H      /                                              CF121381
      IBZERO = 1                                                        CF121382
      IF(IQ(5).EQ.1) IBZERO = 0                                         CF121383
      L   = 0                                                           CF121390
      LE  = 0                                                           CF121400
      MP  = 0                                                           CF121410
      NGT = 0                                                           CF121420
      NLT = 0                                                           CF121430
      MAXCIP = MXOBSV                                                   CF121440
      LMORE = MAXCIP - LCP                                              CF121450
      NSRCH  = 1                                                        CF121460
      ISRCH  = IQ(25)                                                   CF121470
      NFCARD = IQ(26)                                                   CF121480
      NCP    = 1                                                        CF121490
      IF(NFCARD.GT.0) NCP = NFCARD                                      CF121500
      NF   = NOOBSV                                                     CF121510
      RMSE = RMS                                                        CF121520
      WRITE(KTOU,1000) PR1, PR2, PR3, ICURY, BI(K), NSRCH               CF121530
 1000 FORMAT(1H1,40X,40HCP VALUES FOR THE SELECTION OF VARIABLES//      CF121540
     1   1X, 3A6, 10H   DEP VAR, I2, 2H: , A6,4X,13HSEARCH NUMBER,I2/)  CF121550
C --- RMS CONVERTED TO UNITS OF SIMPLE CORRELATION COEFF. MATRIX BY     CF121560
C --  ZMS = RMS / (STDDEV(K)*STDDEV(K)*(NOOBSV-1))  IN MAIN.            CF121570
C --- CALCULATE  P FOR BASIC EQUATION, WITH OR WITHOUT BZERO.           CF121580
      IF(IBZERO.EQ.0) GO TO 3                                           CF121590
    2 MP = 1                                                            CF121600
    3 NP = NOOBSV - 2*MP                                                CF121610
      IPMAX = MP + NOIND                                                CF121620
      CPMAX = DFLOAT(IPMAX) + .005                                      CF121630
      CPHI = CPMAX                                                      CF121640
      IF(NFCARD.GT.0) GO TO 101                                         CF121650
C --- DEVELOP BASIC EQUATION FOR DIRECT SEARCH OF REMAINING VARIABLES.  CF121660
C --- PUT VARIABLES IN BASIC EQUATION WITH LARGEST T-VALUES FIRST,      CF121670
C --- THEN NEXT LARGEST T-VALUES UNTIL CP VALUE GOES THROUGH A MINIMUM. CF121680
      CALL SORT (NOIND, TVALUE, LSORT)                                  CF121690
      IC = NOIND                                                        CF121700
      JOY = LSORT(IC)                                                   CF121710
      SIGN = 1.                                                         CF121720
      CALL SWEEP (JOY, SIGN, NOIND, K)                                  CF121730
      NPS = NP - 2                                                      CF121740
      CP(  1) = (Z(K,K) / ZMS) - NPS                                    CF121750
      MGT = 1                                                           CF121760
      WRITE(KTOU,1001)                                                  CF121770
 1001 FORMAT(1H , 42HSELECTION OF VARIABLES FOR BASIC EQUATION   )      CF121780
      WRITE(KTOU,1002) CP(1), JOY, BI(JOY)                              CF121790
 1002 FORMAT(1H0, 4HCP =, F5.1, 18H,  VARIABLE ADDED ,I2, 2X, A6 )      CF121800
      DO 4 JAS = 2, NOIND                                               CF121810
      IC = IC -1                                                        CF121820
      JOY = LSORT(IC)                                                   CF121830
      CALL SWEEP (JOY, SIGN, NOIND, K)                                  CF121840
      NPS = NP - 2*JAS                                                  CF121850
      CP(JAS) = (Z(K,K) / ZMS) - NPS                                    CF121860
      WRITE(KTOU,1002) CP(JAS), JOY, BI(JOY)                            CF121870
C --- GET OUT OF DO LOOP WHEN NEXT CP VALUE IS LARGER                   CF121880
      IF(CP(JAS-1).LT.CP(JAS) ) GO TO 5                                 CF121890
      MGT = MGT + 1                                                     CF121900
    4 CONTINUE                                                          CF121910
C --- BACK UP IBACK VARIABLES FROM MINIMUM CP VALUE.                    CF121920
    5 MGT = MGT - IBACK                                                 CF121930
      IA = IC + IBACK                                                   CF121940
      IF(IA.GT.NOIND) IA = NOIND                                        CF121941
      IF(MGT.GT.0) GO TO 7                                              CF121950
      DO 6 I = 1, NOIND                                                 CF121960
      NLT = NLT + 1                                                     CF121970
    6 IVLT(NLT) = I                                                     CF121980
      GO TO 12                                                          CF121990
    7 DO 11 I = 1, NOIND                                                CF122000
      DO 9 J = 1, IA                                                    CF122010
      IF(I.NE.LSORT(J)) GO TO 9                                         CF122020
      NLT = NLT + 1                                                     CF122030
      IVLT(NLT) = I                                                     CF122040
    9 CONTINUE                                                          CF122050
   11 CONTINUE                                                          CF122060
C --- SAVE CP AND IP OF BASIC EQUATION FOR LATER PRINTOUT.              CF122070
      CP(1) = CP(MGT)                                                   CF122080
      IP(1) = MP + MGT                                                  CF122090
C --- REMOVE EFFECT OF LAST VARIABLE THAT ENTERED Z MATRIX              CF122100
   12 SIGN = -1.                                                        CF122110
      CALL SWEEP (JOY, SIGN, NOIND, K)                                  CF122120
      DO 8 J = 1, IBACK                                                 CF122121
      IC = IC + 1                                                       CF122122
      IF(IC.GT.NOIND) GO TO 13                                          CF122123
      JOY = LSORT(IC)                                                   CF122130
    8 CALL SWEEP (JOY, SIGN, NOIND, K)                                  CF122140
      GO TO 13                                                          CF122150
  101 IF(ICURY.LT.2) GO TO 102                                          CF122160
C                                                                       CF122170
C                                                                       CF122180
C ---      START SUBSEQUENT FACTORIAL SEARCHES HERE.                    CF122190
 9994 WRITE(KTOU,1000) PR1, PR2, PR3, ICURY, BI(K), NSRCH               CF122200
C --- THE NUMBER OF EACH VARIABLE TO BE INCLUDED IN EACH FACTORIAL      CF122210
C ---  SEARCH IS READ FIRST IN MAIN PROGRAM AND THEN AT END OF THIS     CF122220
C ---  SUBROUTINE IN ICP BY FORMAT 18(2X,I2).                           CF122230
  102 IC = MAXSRH                                                       CF122240
      IF(NOIND.LT.IC) IC = NOIND                                        CF122250
      IF(ICP(1).EQ.0) GO TO 146                                         CF122251
      DO 103 J = 1, IC                                                  CF122260
      IF(ICP(J).EQ.0) GO TO 144                                         CF122270
      IVLT(J) = ICP(J)                                                  CF122280
  103 NLT = NLT + 1                                                     CF122290
      GO TO 144                                                         CF122291
  104 NLT = NLT - 1                                                     CF122292
  144 IF(ICP(NLT).GT.NOIND) GO TO 104                                   CF122293
C                                                                       CF122300
C                                                                       CF122310
      DO 106 J = 1, NLT                                                 CF122320
      I = ICP(J)                                                        CF122330
  106 AVAR(J) = BI(I)                                                   CF122340
      KKK = 0                                                           CF122350
  128 IF(NLT - KKK) 13, 13, 130                                         CF122360
  130 KONE = KKK + 1                                                    CF122370
      IF(NLT - (KKK+12)) 134, 134, 132                                  CF122380
  132 KTWO = KKK + 12                                                   CF122390
      GO TO 136                                                         CF122400
  134 KTWO = NLT                                                        CF122410
  136 WRITE(KTOU, 248) ( ICP(J),J=KONE,KTWO)                            CF122420
  248 FORMAT(1H0,33HVARIABLES ON SELECTED SEARCH CARD,1X,12(2X,I6))     CF122421
      WRITE(KTOU,1018) (AVAR(J),J=KONE,KTWO)                            CF122430
      KKK = KKK + 12                                                    CF122440
      GO TO 128                                                         CF122450
   13 IC = 1                                                            CF122460
      JC = 1                                                            CF122470
      DO 15 J = 1, NLT                                                  CF122480
      DO 14 I = JC, NOIND                                               CF122490
      IC = IC + 1                                                       CF122500
      IF(I.EQ.IVLT(J)) GO TO 145                                        CF122510
      NGT = NGT + 1                                                     CF122520
      IVGT(NGT) = I                                                     CF122530
      AVAR(NGT) = BI(I)                                                 CF122540
   14 CONTINUE                                                          CF122550
  145 JC = IC                                                           CF122560
   15 CONTINUE                                                          CF122570
      IF(IC.GT.NOIND) GO TO 17                                          CF122580
      DO 16 I = IC, NOIND                                               CF122590
      NGT = NGT + 1                                                     CF122600
      IVGT(NGT) = I                                                     CF122610
   16 AVAR(NGT) = BI(I)                                                 CF122620
   17 CONTINUE                                                          CF122630
      NP = NP - 2*NGT                                                   CF122640
      MP = MP + NGT                                                     CF122650
      IP(1) = MP                                                        CF122660
  146 WRITE(KTOU,1006) NOIND, NLT, NGT                                  CF122670
 1006 FORMAT(1H0//37H NUMBER OF VARIABLES IN FULL EQUATION,    5X, I3/  CF122680
     235H NUMBER OF VARIABLES TO BE SEARCHED,   7X, I3/                 CF122690
     338H NUMBER OF VARIABLES IN BASIC EQUATION,   4X, I3// )           CF122700
C                                                                       CF122710
      IF(NLT.LT.1) GO TO 9999                                           CF122711
C --- PROBLEM HALTED IF NLT IS GREATER THAN MAXSRH                      CF122720
      IF(NLT.GT.MAXSRH) GO TO 9997                                      CF122730
C                                                                       CF122740
C                                                                       CF122750
C                                                                       CF122760
C                                                                       CF122770
C --- SKIP BASIC EQUATION IF NGT IS ZERO.                               CF122780
      IF(NGT.GT.0) GO TO 18                                             CF122790
      WRITE(KTOU,1110)                                                  CF122800
 1110 FORMAT(1H0,      25HNO BASIC SET OF VARIABLES )                   CF122810
      GO TO 237                                                         CF122820
C                                                                       CF122830
C ---      CALCULATE CP VALUE FOR FACTORIAL NGT VARIABLES               CF122840
C                                                                       CF122850
   18 IF(NFCARD.EQ.0) GO TO 21                                          CF122860
C ---    SETUP Z SIMPLE CORRELATION COEFFICIENTS TO CONTAIN             CF122870
C --- NGT FACTORIAL VARIABLES                                           CF122880
      SIGN =  1.                                                        CF122890
      DO 20 JAZ=1, NGT                                                  CF122900
      JOY = IVGT(JAZ)                                                   CF122910
      CALL SWEEP(JOY,SIGN,NOIND,K)                                      CF122920
   20 CONTINUE                                                          CF122930
      CP(1) = (Z(K,K) / ZMS) - NP                                       CF122940
   21 L = 1                                                             CF122950
      IF(NGT - 12) 22, 22, 24                                           CF122960
   22 KTWO = NGT                                                        CF122970
      GO TO 25                                                          CF122980
   24 KTWO = 12                                                         CF122990
   25 IF(CP(1).GT.CPMAX) L = 0                                          CF123000
C                                                                       CF123010
C                                                                       CF123020
C                                                                       CF123030
C                                                                       CF123040
      WRITE(KTOU,1012) (IVGT(I),I=1,KTWO)                               CF123050
 1012 FORMAT(1H0,22HBASIC SET OF VARIABLES,12X,12(2X,I6))               CF123060
C                                                                       CF123070
      WRITE(KTOU,1014)(AVAR(I),I=1, KTWO)                               CF123080
 1014 FORMAT(1H ,34X, 12(2X,A6) )                                       CF123090
      KKK = 12                                                          CF123100
   28 IF(NGT - KKK) 37, 37, 30                                          CF123110
   30 KONE = KKK + 1                                                    CF123120
      IF(NGT - (KKK+12)) 34, 34, 32                                     CF123130
   32 KTWO = KKK + 12                                                   CF123140
      GO TO 36                                                          CF123150
   34 KTWO = NGT                                                        CF123160
   36 WRITE(KTOU,1016) (IVGT(I), I=KONE,KTWO)                           CF123170
 1016 FORMAT(1H0,34X, 12(2X,I6) )                                       CF123180
      WRITE(KTOU,1018) (AVAR(I), I=KONE,KTWO)                           CF123190
 1018 FORMAT(1H ,34X, 12(2X,A6) )                                       CF123200
      KKK = KKK + 12                                                    CF123210
      GO TO 28                                                          CF123220
   37 DF   = NF - IP(1)                                                 CF123230
      RMSL = (CP(1) + DF - IP(1) )*RMS/DF                               CF123231
  237 WRITE(KTOU,38)                                                    CF123232
   38 FORMAT(1H0/1X,46HEQUATION   P   CP        RMS         VARIABLES,  CF123233
     * 12H IN EQUATION)                                                 CF123234
      IF(NGT.EQ.0) GO TO 40                                             CF123235
      IF(NFCARD.EQ.0) GO TO 39                                          CF123240
      WRITE(KTOU,666) IP(1), CP(1), RMSL                                CF123250
  666 FORMAT(1H0,2X,5HBASIC,I5,F6.1,2X,F12.5)                           CF123260
   39 IF(RMSL.GE.RMSE) GO TO 40                                         CF123270
      LE   = L                                                          CF123280
      RMSE = RMSL                                                       CF123290
   40 NLTP1 = NLT + 1                                                   CF123300
      IVLT(NLTP1) = K                                                   CF123310
C --- CONSTRUCT SMALLER MATRIX TO CONTAIN ONLY NLTP1 VARIABLES IN C().  CF123320
      DO 42 I = 1, NLTP1                                                CF123330
      IC = IVLT(I)                                                      CF123340
      DO 42 J = I, NLTP1                                                CF123350
      JC = IVLT(J)                                                      CF123360
   42 C(I,J) = Z(IC,JC)                                                 CF123370
C --- REPLACE Z MATRIX WITH NEW SMALLER BASIC MATRIX AND SAVE C TO      CF123380
C --- RESTORE THE Z MATRIX AFTER JRETRN SWEEPS.                         CF123390
      DO 44 I=1, NLTP1                                                  CF123400
      DO 44 J=I, NLTP1                                                  CF123410
   44 Z(I,J) = C(I,J)                                                   CF123420
C --- ZERO INOUT INDEX USED TO DETERMINE IF VARIABLE IS PRESENT IN      CF123430
C --- GARSIDE SEQUENCE.                                                 CF123440
      DO 46 I = 1, NLT                                                  CF123450
   46 INOUT(I) = 0                                                      CF123460
C --- DETERMINE SEQUENCE OF SWEEPS.                                     CF123470
      DO 4000 I = 1, NLT                                                CF123480
      IS(I)     = 2**(I-1)                                              CF123490
 4000 IS(I+20) = 2**I                                                   CF123500
C --- MAX NUMBER OF SWEEPS.                                             CF123510
      JMAX = 2**NLT - 1                                                 CF123520
C --- SETTING OF SIZE OF FIRST SWEEP.                                   CF123530
      KSEQ  = 2                                                         CF123540
      KSEQP1= 3                                                         CF123550
      IF(KSEQP1.GT.NLT) KSEQP1 = NLT                                    CF123560
      JSWEEP = 4                                                        CF123570
C --- SETTING FOR FIRST RETURN TO BASIC MATRIX.                         CF123580
      KRET   = 5                                                        CF123590
      JRETRN = 32                                                       CF123600
C                                                                       CF123610
C ---      CALCULATE CP VALUES OF REMAINING VARIABLE COMBINATIONS       CF123620
C                                                                       CF123630
C --- CPHIGH IS RESET AT STATEMENT 92 AT CP VALUE OF LOWEST JCP         CF123640
C ---  EQUATIONS OUT OF LCP CANDIDATE EQUATIONS FOUND AT FIRST CPHIGH   CF123650
C ---  SETTING.                                                         CF123660
      CPHIGH = CPHI                                                     CF123670
      JAZ = 0                                                           CF123680
 5000 JAZ = JAZ + 1                                                     CF123690
C --- SETTING OF SIZE OF EACH NEW GROUPS OF SWEEPS.                     CF123700
      IF(JAZ.LT.JSWEEP) GO TO 60                                        CF123710
      IF(JAZ.EQ.JRETRN) GO TO 52                                        CF123720
      JOY = KSEQ                                                        CF123730
      KSEQ  = KSEQ + 1                                                  CF123740
      KSEQP1= KSEQ + 1                                                  CF123750
      IF(KSEQP1.LE.NLT) GO TO 47                                        CF123760
      KSEQP1 = NLT                                                      CF123770
      GO TO 51                                                          CF123780
C ---      ADJUST THE NEW COLUMN VECTOR TO BE SWEPT (KSEQP1) BY THE     CF123790
C --- VARIABLE (JOY) WHOSE INFLUENCE REMAINS IN THE ALREADY SWEPT       CF123800
C --- MATRIX.  ALSO ADJUST THE ELEMENT OF THE COLUMN VECTOR OF THE      CF123810
C --- DEPENDENT VARIABLE ( Z(KSEQP1,NLTP1) ) FOR THE INFLUENCE OF       CF123820
C --- VARIABLE JOY.  (NLTP1 IS THE LOCATION OF THE DEPENDENT VARIABLE.) CF123830
C --- THIS IS ONLY DONE UNTIL JRETRN SWEEPS (MATRIX IS THEN REPLACED    CF123840
C --- BY THE BASIC MATRIX).                                             CF123850
   47 JOY1 = JOY - 1                                                    CF123860
      JOY2 = JOY + 1                                                    CF123870
      HAPPY = C(JOY,JOY)                                                CF123880
      USP1 = C(JOY,KSEQP1)                                              CF123890
      DO 48 I = 1, JOY1                                                 CF123900
   48 Z(I,KSEQP1) = C(I,KSEQP1) - (C(I,JOY)*USP1) / HAPPY               CF123910
      Z(JOY,KSEQP1) = USP1 / HAPPY                                      CF123920
      DO 50 I = JOY2, KSEQP1                                            CF123930
   50 Z(I,KSEQP1) = C(I,KSEQP1) - (C(JOY,I)*USP1) / HAPPY               CF123940
      Z(KSEQP1,NLTP1) = C(KSEQP1,NLTP1) - (USP1*C(JOY,NLTP1)) / HAPPY   CF123950
   51 JSWEEP = 2**KSEQ                                                  CF123960
      FSW = HAPPY                                                       CF123970
      GO TO 60                                                          CF123980
C --- RETURN TO BASIC MATRIX.                                           CF123990
   52 DO 54 I = 1, NLTP1                                                CF124000
      DO 54 IJ= I, NLTP1                                                CF124010
   54 Z(I,IJ) = C(I,IJ)                                                 CF124020
C --- REINSTATE KRET VARIABLE IN SCC MATRIX.                            CF124030
      JOY = KRET                                                        CF124040
      SIGN = 1.                                                         CF124050
      KSEQP1 = KRET + 2                                                 CF124060
      IF(KSEQP1.GT.NLT) KSEQP1 = NLT                                    CF124070
      CALL SWEEP(JOY,SIGN,KSEQP1,NLTP1)                                 CF124080
C --- SET CONTROLS FOR NEXT RETURN TO BASIC MATRIX.                     CF124090
      KRET   = KRET + 1                                                 CF124100
      JRETRN = 2**KRET                                                  CF124110
      JSWEEP = JRETRN                                                   CF124120
C --- MODIFY SCC MATRIX IN GARSIDE ORDER.                               CF124130
   60 DO 4002 I = 1, NLT                                                CF124140
      IF(MOD(JAZ-IS(I),IS(I+20)).EQ.0) GO TO 4003                       CF124150
 4002 CONTINUE                                                          CF124160
 4003 JOY = I                                                           CF124170
      IF(INOUT(JOY).EQ.0) GO TO 62                                      CF124180
      MP = MP - 1                                                       CF124190
      NP = NP + 2                                                       CF124200
      INOUT(JOY) = 0                                                    CF124210
      SIGN = -1.                                                        CF124220
      GO TO 64                                                          CF124230
   62 MP = MP + 1                                                       CF124240
      NP = NP - 2                                                       CF124250
      INOUT(JOY) = 1                                                    CF124260
      SIGN =  1.                                                        CF124270
   64 CALL SWEEP(JOY,SIGN,KSEQP1,NLTP1)                                 CF124280
      CCP   = (Z(NLTP1,NLTP1) / ZMS) - NP                               CF124290
      IF(CCP.GT.CPHIGH) GO TO 100                                       CF124300
      L = L + 1                                                         CF124310
C --- STOP WRITING EQUATIONS IF L BECOMES LARGER THAN DIMENSIONS OF CP  CF124320
      IF(L.GT.MAXCIP) GO TO 156                                         CF124330
      CP(L) = CCP                                                       CF124340
C ---      MERGE INDEXIES OF SELECTED AND BASIC EQUATIONS,              CF124350
      IN = 1                                                            CF124351
      KK = 1                                                            CF124352
      DO 904 JC = 1,NOIND                                               CF124353
      IF(KK.GT.NGT) GO TO 902                                           CF124360
      IF(IVGT(KK).NE.JC) GO TO 902                                      CF124361
      KONE = IVGT(KK)                                                   CF124370
      AVAR(JC) = BI(KONE)                                               CF124371
      KK = KK + 1                                                       CF124380
      GO TO 904                                                         CF124381
  902 IF(IN.GT.NLT) GO TO 903                                           CF124390
      KONE = IVLT(IN)                                                   CF124400
      IF(KONE.NE.JC) GO TO 903                                          CF124401
      IF(INOUT(IN).EQ.0) GO TO 901                                      CF124402
      AVAR(JC) = BI(KONE)                                               CF124410
      IN = IN + 1                                                       CF124411
      GO TO 904                                                         CF124412
  901 IN = IN + 1                                                       CF124420
  903 AVAR(JC) = BLANK                                                  CF124421
  904 CONTINUE                                                          CF124430
      IP(L) = MP                                                        CF124440
      DF   = NF - IP(L)                                                 CF124441
      RMSL = (CP(L) + NP)*RMS/DF                                        CF124442
      IF (NOIND - 12) 72, 72, 74                                        CF124450
   72 KTWO = NOIND                                                      CF124460
      GO TO 76                                                          CF124470
   74 KTWO = 12                                                         CF124480
   76 WRITE(KTOU,1020) L, IP(L), CP(L), RMSL, (AVAR(I),I=1,KTWO)        CF124490
 1020 FORMAT(1H0,3X, I4,I5,F6.1,2X,F12.5,2X,12(2X,A6) )                 CF124500
C                                                                       CF124510
C                                                                       CF124520
      KKK = 12                                                          CF124530
   78 IF(NOIND - KKK)  90,  90, 80                                      CF124540
   80 KONE = KKK + 1                                                    CF124550
      IF(NOIND - (KKK+12)) 84, 84, 82                                   CF124560
   82 KTWO = KKK + 12                                                   CF124570
      GO TO 86                                                          CF124580
   84 KTWO = NOIND                                                      CF124590
C                                                                       CF124600
   86 WRITE(KTOU,1018) (AVAR(I), I=KONE,KTWO)                           CF124610
C                                                                       CF124620
      KKK = KKK + 12                                                    CF124630
      GO TO 78                                                          CF124640
   90 IF(RMSL.GE.RMSE) GO TO 92                                         CF124650
      LE   = L                                                          CF124660
      RMSE = RMSL                                                       CF124670
C --- JCP, LCP AND LMORE ARE SET BEFORE DO LOOP 100.                    CF124680
   92 IF(L.NE.LCP) GO TO 100                                            CF124690
      IF((JMAX - L).LT.LMORE) GO TO 100                                 CF124700
      CALL SORT(L,CP,LSORT)                                             CF124710
      JC     = LSORT(JCP)                                               CF124720
      CPHIGH = CP(JC)                                                   CF124730
      WRITE(KTOU,1023) CPHIGH, JCP                                      CF124740
 1023 FORMAT(//1X,49HREMAINING CANDIDATE EQUATIONS PRINTED ONLY IF CP , CF124750
     1 18HVALUE IS LESS THAN , F5.1 / 1X, I4,                           CF124760
     2 41H EQUATIONS ALREADY HAVE SMALLER CP VALUES  // )               CF124770
  100 IF(JAZ.LT.JMAX) GO TO 5000                                        CF124780
 5001 CONTINUE                                                          CF124790
C                                                                       CF124800
C --- CHECK EFFECT OF SWEEPS ON ROUNDOFF ERROR.                         CF124810
      VK = Z(NLTP1,NLTP1)                                               CF124820
      DO 154 I = 1, NLTP1                                               CF124830
      DO 154 IJ= I, NLTP1                                               CF124840
  154 Z(I,IJ) = C(I,IJ)                                                 CF124850
C --- REINSTATE KRET VARIABLE IN SCC MATRIX.                            CF124860
      JOY = NLT                                                         CF124870
      SIGN = 1.                                                         CF124880
      CALL SWEEP(JOY,SIGN,KSEQP1,NLTP1)                                 CF124890
      DVK  = Z(NLTP1,NLTP1) - VK                                        CF124900
      WRITE(KTOU,3338) JAZ, DVK                                         CF124910
 3338 FORMAT(1H0,12HSWEEP NUMBER , I10, 18H,  DELTA Z(K,K) = ,1P1E7.0)  CF124920
      GO TO 158                                                         CF124930
  156 WRITE(KTOU,157) MAXCIP                                            CF124940
  157 FORMAT(1H0//// 53H SEARCH TERMINATED.  NUMBER OF EQUATIONS GREATERCF124950
     1 THAN , I5, 26H(DIMENSIONS OF CP AND IP).  )                      CF124960
      L = L - 1                                                         CF124970
      GO TO 5001                                                        CF124980
C ---                                                                   CF124990
  158 CALL CPPLOT(RMSE,IPMAX,CPMAX,L,LE)                                CF125000
C --- NOTE, CF125020 THROUGH CF126060 HAVE BEEN REPLACED BY CPPLOT      CF125010
C --- DETERMINE IF ADDITIONAL FACTORIAL SEARCHES HAVE BEEN REQUESTED.   CF126070
      IF(NSRCH.EQ.NCP) GO TO 9999                                       CF126080
      NSRCH = NSRCH + 1                                                 CF126090
      NOVAR = NOIND + NODEP                                             CF126100
      REWIND KTBIN1                                                     CF126110
      IF(IQ(24).EQ.0.OR.IQ(20).EQ.0) GO TO 9980                         CF126120
      READ(KTBIN1) ( DUM, I=1, NOVAR)                                   CF126130
 9980 DO 9982  I = 1, NOIND                                             CF126140
 9982 READ(KTBIN1) (C(I,J), J = I,NOIND)                                CF126150
      DO 9984 I = 1, NOVAR                                              CF126160
 9984 READ(KTBIN1)    (Z(I,J), J = I,NOVAR )                            CF126170
C ---      SQUARE Z MATRIX.                                             CF126180
      NOVM1 = NOVAR - 1                                                 CF126190
      DO 9986  I = 1, NOVM1                                             CF126200
      IPL1 = I + 1                                                      CF126210
      DO 9986 J = IPL1, NOVAR                                           CF126220
 9986 Z(J,I)= Z(I,J)                                                    CF126230
      READ(KTIN,9988) (ICP(I), I=1, MAXSRH)                             CF126240
 9988 FORMAT( 18(2X,I2) )                                               CF126250
      L   = 0                                                           CF126260
      LE  = 0                                                           CF126270
      MP  = 0                                                           CF126280
      NGT = 0                                                           CF126290
      NLT = 0                                                           CF126300
      NF   = NOOBSV                                                     CF126310
      RMSE = RMS                                                        CF126320
      IF(IQ(5).EQ.1) GO TO 9903                                         CF126330
      MP = 1                                                            CF126340
 9903 NP = NOOBSV - 2*MP                                                CF126350
      IPMAX = MP + NOIND                                                CF126360
      CPMAX = DFLOAT(IPMAX) + .005                                      CF126370
      GO TO 9994                                                        CF126380
 9997 WRITE(KTOU,9998) MAXCPS, MAXSRH, IQ(21), NLT                      CF126390
 9998 FORMAT(1H0//////1X,  40H******THIS VERSION OF PROGRAM LIMITED BY, CF126400
     2 56H MAXCPS IN SUBROUTINE BASPGM (TO SAVE TIME AND MONEY) TO/     CF126410
     31X,I3,30H STANDARD CP SEARCH VARIABLES,/1X,I3,                    CF126420
     4 30H MAXIMUM VARIABLES REQUESTED ,,I3,20H IN COLUMNS 43-44 OF,    CF126421
     5 14H CONTROL CARD,/1X,I3,32HVARIABLES REMAIN TO BE SEARCHED.//1X, CF126422
     6 59HINCREASE NUMBER REQUESTED IN COLUMNS 43-44 OR USE MODIFIED ,  CF126423
     7 58HLEAPS AND BOUNDS SEARCH, 4-6 IN COLUMN 49 OF CONTROL CARD.)   CF126424
 9999 RETURN                                                            CF126430
      END                                                               CF126440
      SUBROUTINE SWEEP(JOY,SIGN,KSEQP1,NVLTP1)                          CF130010
C ---    SUBROUTINE MODIFIES MATRIX WHEN VARIABLE JOY IS ADDED OR       CF130020
C --- DELETED.  SEE BROWNLEE SECTION 17.10, EQUATION 10.5.              CF130030
C --- SIGN   POSITIVE SIGN INDICATES VARIABLE ADDED, NEGATIVE SIGN      CF130040
C ---        INDICATES VARIABLE REMOVED.                                CF130050
C --- KSEQP1 SIZE OF SWEEP (K VARIABLES IN CURRENT SEQUENCE PLUS 1).    CF130060
C --- NVLTP1 NUMBER OF VARIABLES EVENTUALLY TO BE SWEPT WITH JOY        CF130070
C ---        PLUS 1 (VARIABLES REMAINING AFTER BASIC SET HAS BEEN       CF130080
C ---        CHOSEN).                                                   CF130090
      DOUBLE PRECISION BETA,C,HAPPY,SIGN,U,Z                            CF130100
      DIMENSION U(41)                                                   CF130110
      COMMON /HHHHHH/ BETA(41), C(40,40), Z(41,41), NNNN, MXSIZE        CF130120
      EQUIVALENCE (BETA(1),U(1))                                        CF130130
      JOY1=JOY-1                                                        CF130140
      JOY2=JOY+1                                                        CF130150
      HAPPY=Z(JOY,JOY)                                                  CF130160
      IF(JOY1)3,3,2                                                     CF130170
    2 DO 1000 I=1,JOY1                                                  CF130180
      U(I)=Z(I,JOY)                                                     CF130190
      Z(I,JOY)=0.0                                                      CF130200
 1000 CONTINUE                                                          CF130210
    3 U(JOY)=-SIGN                                                      CF130220
      Z(JOY,JOY)=0.0                                                    CF130230
      IF(JOY2-KSEQP1)4,4,5                                              CF130240
    4 DO 2000 I=JOY2,KSEQP1                                             CF130250
      U(I)=Z(JOY,I)                                                     CF130260
      Z(JOY,I)=0.0                                                      CF130270
 2000 CONTINUE                                                          CF130280
    5 DO 3000 I=1,KSEQP1                                                CF130290
      DO 3000 J=I,KSEQP1                                                CF130300
      Z(I,J)=Z(I,J)-(U(I)*U(J))/HAPPY                                   CF130310
 3000 CONTINUE                                                          CF130320
      U(NVLTP1) = Z(JOY,NVLTP1)                                         CF130330
      Z(JOY,NVLTP1) = 0.0                                               CF130340
      J = NVLTP1                                                        CF130350
      DO 4000 I = 1,KSEQP1                                              CF130360
      Z(I,J)=Z(I,J)-(U(I)*U(J))/HAPPY                                   CF130370
 4000 CONTINUE                                                          CF130380
      I = NVLTP1                                                        CF130390
      Z(I,J)=Z(I,J)-(U(I)*U(J))/HAPPY                                   CF130400
      RETURN                                                            CF130410
      END                                                               CF130420
      SUBROUTINE SORT(NOB, R, LSORT)                                    CF140010
C --- SUBROUTINE SORTS NOB OBSERVATIONS IN VECTOR R IN ASCENDING        CF140020
C --- ORDER AND PLACES THAT ORDER IN LSORT.                             CF140030
      IMPLICIT REAL*8(A-H,O-Z)                                          CF140040
      DIMENSION R(1),LSORT(1)                                           CF140050
      LSORT(1)  = 1                                                     CF140060
      DO 16 ISA = 2, NOB                                                CF140070
      TEMP = R(ISA)                                                     CF140080
      ISAX = ISA - 1                                                    CF140090
      DO 11 ISB = 1, ISAX                                               CF140100
      IBB  = LSORT(ISB)                                                 CF140110
      IF(TEMP - R(IBB) ) 12,12,11                                       CF140120
   11 CONTINUE                                                          CF140130
      LSORT(ISA) = ISA                                                  CF140140
      GO TO 16                                                          CF140150
   12 KSA  = ISA                                                        CF140160
   13 KSA  = KSA - 1                                                    CF140170
      LSORT(KSA + 1) = LSORT(KSA)                                       CF140180
      IF(KSA - ISB) 15,15,13                                            CF140190
   15 LSORT(ISB) = ISA                                                  CF140200
   16 CONTINUE                                                          CF140210
      RETURN                                                            CF140220
      END                                                               CF140230
      SUBROUTINE CCARD(MXFMTC, MXINFC, MNOMTC, MNIVOC, MXSRCD,          CF150010
     1   MAXLBS, MINLBS, MAXCPS, MINCPS)                                CF150011
C                                                                       CF150020
C --- THIS SUBROUTINE LISTS THE CONTROL CARD SELECTION, THE DIMENSION   CF150030
C ---   LIMITS AND THE ORDER OF CARDS FOR THIS VERSION OF LINWOOD.      CF150040
C                                                                       CF150050
      IMPLICIT REAL*8(A-H,O-Z)                                          CF150060
      COMMON /KKKKKK/ IQ(40), PR1, PR2, PR3, K, KFM, NODEP, NOIND,      CF150070
     1                NOOBSV, ICURY                                     CF150080
      COMMON /LLLLLL/ XEFMT, JOMIT(35), JIVOS(35), JIV(35), NOMIT,      CF150090
     1                NIVOS, NFOUND, JFOUND                             CF150100
      COMMON /NNNNNN/ DEFR, XNOIND, NOVM1, MXVRBT, MXVPBT, MXVRAT,      CF150110
     1                MXVPAT, MXOBSV, MAXIND, MAXOBS                    CF150120
      COMMON /OOOOOO/ KNODEP, KNOIND, KNOVAR, KNVP1, L, NOVAR           CF150130
      COMMON /QQQQQQ/ KTIN, KTOU, KTPCH, KKK, KONE, KTWO, MNO, NFILE    CF150140
C                                                                       CF150150
C ---        THE ORDER OF THE CARDS FOR THE LINWOOD PROGRAM.            CF150160
C --- NOTE***THE SECOND CARD WITH THE SAME CONTINUATION NUMBER GIVES    CF150170
C                                                                       CF150180
      WRITE(KTOU,10)                                                    CF150190
   10 FORMAT(1H0,25X, 24HCONTROL CARD INFORMATION,                      CF150200
     1 47X,14HORDER OF CARDS,                                           CF150210
     1//1X, 49HCOL.  INPUT MAX. ITEM   (NOTE: BLANK ON CARD = 0)     ,  CF150220
     2 29X,13HFIRST PROBLEM                                          )  CF150230
      WRITE(KTOU,12)                                                    CF150240
   12 FORMAT(1H ,5H 1-18,     12X,23HPROBLEM IDENTIFICATION.         ,  CF150250
     1 38X,17H 1  CONTROL CARD.                                      )  CF150260
      WRITE(KTOU,14) IQ(1)                                              CF150270
   14 FORMAT(1H ,5H19-20,I4,   8X,                                      CF150280
     1 39HNUMBER OF INDEPENDENT VARIABLES READ IN,                      CF150290
     1 22X,27H 2  FORMAT CARD(S), IF ANY.,                              CF150300
     2 /18X,36H  (ALLOW SPACE FOR TRANSFORMATIONS).                  ,  CF150310
     2 25X,40H 3  DELETE OBSERVATIONS CARD(S), IF ANY.               )  CF150320
      WRITE(KTOU,16) IQ(2)                                              CF150330
   16 FORMAT(1H ,5H21-22,I4,   8X,                                      CF150340
     1 40HNUMBER OF   DEPENDENT VARIABLES READ IN.                   ,  CF150350
     1 21X,52H 4  INDICATOR-VARIABLE-OBSERVATIONS CARD(S), IF ANY.   )  CF150360
      WRITE(KTOU,18) NOVAR, MXVRBT                                      CF150370
   18 FORMAT(1H ,5X,     I4,I6,2X,                                      CF150380
     1 59HTOTAL NUMBER OF VARIABLES (BEFORE TRANSFORMATIONS, IF ANY).,  CF150390
     1  2X,35H 5  TRANSFORMATION CARD(S), IF ANY.                    )  CF150400
      WRITE(KTOU,20) XEFMT                                              CF150410
   20 FORMAT(1H ,3X,2H24,3X,A1,8X,                                      CF150420
     1 40HE CAUSES Y, FITTED Y AND RESIDUALS TO BE,                     CF150430
     1 21X,45H 6  INFORMATION CARD(S) FOR PRINTOUT, IF ANY.,            CF150440
     2 / 22X,   41HLISTED WITH AN E RATHER THAN AN F FORMAT.         ,  CF150450
     2 16X,52H 7  NAMES OF VARIABLES CARD(S) FOR PRINTOUT, IF ANY.   )  CF150460
      WRITE(KTOU,22) IQ(3)                                              CF150470
   22 FORMAT(1H ,3X,2H25,I4,   8X,                                      CF150480
     1 21H1 DO TRANSFORMATIONS.                                      ,  CF150490
     1 40X,39H 8  CP SELECTED SEARCH CARD(S), IF ANY.                )  CF150500
      WRITE(KTOU,24) IQ(4)                                              CF150510
   24 FORMAT(1H ,3X,2H26,I4,   8X,                                      CF150520
     1 55H1 WEIGHT OBSERVATIONS. WEIGHT ENTERED IN LAST POSITION.,      CF150530
     1  6X,41H 9  DATA CARDS (IF NOT READ FROM A FILE).,                CF150540
     2 /18X,53H2 WEIGHT BY 1/VAR. OF OBSERVATION.  VARIANCE ENTERED. ,  CF150550
     2  8X,52H10  END CARD (END IN COLUMNS 1 - 3 OF IDENTIFICATION   )  CF150560
      WRITE(KTOU,26) IQ(5)                                              CF150570
   26 FORMAT(1H ,3X,2H27,I4,   8X,                                      CF150580
     1 54H1 LET B(0) = ZERO, OTHERWISE B(0) IS CALCULATED VALUE.     ,  CF150590
     1 12X,47HFIELD).  THE NUMBER OF END CARDS MUST EQUAL THE        )  CF150600
      WRITE(KTOU,28) IQ(6)                                              CF150610
   28 FORMAT(1H ,3X,2H28,I4,   8X,                                      CF150620
     1 36H1 CHECK OBSERVATION NUMBER SEQUENCE.                       ,  CF150630
     1 30X,43HNUMBER OF CARDS PER OBSERVATION. (END CARDS            )  CF150640
      WRITE(KTOU,30) IQ(7)                                              CF150650
   30 FORMAT(1H ,3X,2H29,I4,   8X,                                      CF150660
     1 43H1 CHECK SEQUENCE WITHIN OBSERVATION NUMBER.                ,  CF150670
     1 23X,45HARE NOT NEEDED IF DATA ARE READ FROM A FILE).          )  CF150680
      WRITE(KTOU,32) IQ(8)                                              CF150690
   32 FORMAT(1H ,3X,2H30,I4,   8X,                                      CF150700
     1 47H1 DO BACK TRANSFORMATION OF DEPENDENT VARIABLE.            ,  CF150710
     1 14X,50H11  ESTIMATE OF VARIANCE CARD(S), IF ANY, FOR EACH     )  CF150720
      WRITE(KTOU,34) IQ(9)                                              CF150730
   34 FORMAT(1H ,3X,2H31,I4,   8X,                                      CF150740
     1 45H1 PUNCH DATA FOR CONFIDENCE INTERVAL PROGRAM.              ,  CF150750
     1 16X,24H     DEPENDENT VARIABLE.                               )  CF150760
      WRITE(KTOU,36) IQ(10)                                             CF150770
   36 FORMAT(1H ,3X,2H32,I4,   8X,                                      CF150780
     1 22H0 LIST ALL INPUT DATA. ,                                      CF150790
     2 /18X, 28H1 LIST ONLY 1ST OBSERVATION. ,                          CF150800
     3 /18X, 29H2 DO NOT LIST ANY INPUT DATA.                        ,  CF150810
     3 32X,14HSECOND PROBLEM                                         )  CF150820
C                                                                       CF150830
      WRITE(KTOU,38) IQ(11)                                             CF150840
   38 FORMAT(1H ,3X,2H33,I4,   8X,                                      CF150850
     1 48H0 LIST TRANSFORMATIONS AND ALL TRANSFORMED DATA. ,            CF150860
     1 15X,38HIF DATA ARE REUSED FROM FIRST PROBLEM,  ,                 CF150870
     2 /18X,55H1 LIST TRANSFORMATIONS AND 1ST TRANSFORMED OBSERVATION., CF150880
     2 12X,38HDELETE THE FORMAT, DATA AND END CARDS.,                   CF150890
     3 /18X,50H2 DO NOT LIST TRANSFORMATIONS OR TRANSFORMED DATA.    ,  CF150900
     3 13X,20HIF NAMES ARE REUSED,                                   )  CF150910
      WRITE(KTOU,40) IQ(12)                                             CF150920
   40 FORMAT(1H ,3X,2H34,I4,   8X,                                      CF150930
     1 32H1 DO NOT LIST SUMS OF VARIABLES.                           ,  CF150940
     1 35X,22HDELETE THE NAME CARDS.                                 )  CF150950
      WRITE(KTOU,42) IQ(13)                                             CF150960
   42 FORMAT(1H ,3X,2H35,I4,   8X,                                      CF150970
     1 54H1 DO NOT LIST RAW SUMS AND CROSS PRODUCTS WHEN B(O)=O.     ,  CF150980
     1  9X,34HIF DIFFERENT INPUT DATA AND NAMES,                     )  CF150990
      WRITE(KTOU,44) IQ(14)                                             CF151000
   44 FORMAT(1H ,3X,2H36,I4,   8X,                                      CF151010
     1 47H1 DO NOT LIST RESIDUAL SUMS AND CROSS PRODUCTS.            ,  CF151020
     1 20X,20HREPEAT 1 - 11 ABOVE.                                   )  CF151030
      WRITE(KTOU,46) IQ(15)                                             CF151040
   46 FORMAT(1H ,3X,2H37,I4,   8X,                                      CF151050
     1 55H1 DO NOT LIST MEANS AND ROOT MEAN SQUARES OF VARIABLES.    )  CF151060
      WRITE(KTOU,48) IQ(16)                                             CF151070
   48 FORMAT(1H ,3X,2H38,I4,   8X,                                      CF151080
     1 55H1 DO NOT LIST SIMPLE CORRELATION COEFFICIENTS.             )  CF151090
      WRITE(KTOU,50) IQ(17)                                             CF151100
   50 FORMAT(1H ,3X,2H39,I4,   8X,                                      CF151110
     1 29H1 DO NOT LIST INVERSE MATRIX.                              )  CF151120
      WRITE(KTOU,52) IQ(18)                                             CF151130
   52 FORMAT(1H ,3X,2H40,I4,   8X,                                      CF151140
     1 47H1 DO NOT PRINT PLOTS OF RESIDUALS VS. FITTED Y. / 18X,        CF151150
     2 53H2 PLOT (A) RESIDUALS AND (B) COMPONENT AND COMPONENT- / 18X,  CF151160
     3 48H   PLUS-RESIDUALS VS. EACH INDEPENDENT VARIABLE. / 18X,       CF151170
     4 26H3 PLOT (A) RESIDUALS ONLY. / 18X,                             CF151180
     5 55H4 PLOT (B) COMPONENT AND COMPONENT-PLUS-RESIDUALS ONLY./18X,  CF151190
     6 46H5 PLOT (B) BUT EXPAND SCALE TO FILL EACH PLOT.        / 18X,  CF151200
     7 51HTO OMIT PLOTS OF SPECIFIC INDEPENDENT VARIABLES, ON / 18X,    CF151201
     8 53HTHE TRANSFFORMATION CARDS PUT A 2 IN THE OMIT COLUMNS / 18X,  CF151202
     9 19HOF THOSE VARIABLES.                                        )  CF151203
      WRITE(KTOU,54) IQ(19)                                             CF151210
   54 FORMAT(1H ,3X,2H41,I4,   8X,                                      CF151220
     1 54H0 READ DATA WITH STANDARD FORMAT (A6, I4, I2, 10F6.3). /18X,  CF151230
     2 59H1 READ DATA WITH FORMAT TO BE READ, 1 CARD (72COL) ASSUMED./  CF151240
     3 18X, 47H2 READ DATA WITH READ DATA (REDATA) SUBROUTINE.       )  CF151250
      WRITE(KTOU,56) IQ(20)                                             CF151260
   56 FORMAT(1H ,3X,2H42,I4,   8X,                                      CF151270
     1 36H0 DO NOT SAVE DATA FOR NEXT PROBLEM. / 18X,                   CF151280
     2 29H1 SAVE DATA FOR NEXT PROBLEM./ 18X,                           CF151290
     3 35H2 REUSE DATA FROM PREVIOUS PROBLEM.                        )  CF151300
      WRITE(KTOU,58) IQ(21), MINCPS, MAXCPS, MAXLBS                     CF151310
   58 FORMAT(1H ,5H43-44,I4,8X,                                         CF151320
     1 56HMAXIMUM NUMBER OF VARIABLES IN CP SEARCH IF GREATER THAN,     CF151330
     2 I3,1H./10X,I6,2X,                                                CF151331
     3 17H STANDARD SEARCH,                      /10X,I6,2X,            CF151332
     4 34H MODIFIED LEAPS AND BOUNDS SEARCH.)                           CF151333
      WRITE(KTOU,60) IQ(22), MXFMTC                                     CF151340
   60 FORMAT(1H ,3X,2H45,I4,I6,2X,                                      CF151350
     1 41HNUMBER OF FORMAT CARDS IF GREATER THAN 1.                  )  CF151360
      WRITE(KTOU,62) IQ(23), MXINFC                                     CF151370
   62 FORMAT(1H ,5H46-47,I4,I6,2X,                                      CF151380
     1 53HNUMBER OF INFORMATION CARDS TO BE READ FOR DISPLAY ON / 18X,  CF151390
     2 35H PRINTOUT IF DESIRED, 72 COL. EACH.                        )  CF151400
      WRITE(KTOU,64) IQ(24)                                             CF151410
   64 FORMAT(1H ,3X,2H48,I4,   8X,                                      CF151420
     1 50H1 READ NAMES OF VARIABLES FOR DISPLAY ON PRINTOUT. / 18X,     CF151430
     2 57H   NAMES IN SAME POSITIONS AS VARIABLES ON TRANSFORMATION/18X,CF151440
     3 43H   CARDS - COLS. 1-6, 11-16, - - - , 61-66.  / 18X,           CF151450
     4 47H   NAMES ARE NOT MOVED, ONLY LISTED OR DELETED.  / 18X,       CF151460
     5 49H2 REUSE NAMES OF VARIABLES FROM PREVIOUS PROBLEM.          )  CF151470
      WRITE(KTOU,66) IQ(25)                                             CF151480
   66 FORMAT(1H ,3X,2H49,I4,   8X,                                      CF151490
     1 48HCP SEARCH FOR CANDIDATE EQUATIONS.  USE ESTIMATE     / 17X,   CF151500
     2 25H  OF VARIANCE (RMS) FROM:  / 20X,                             CF151510
     3 16H1 FULL EQUATION,   / 20X,                                     CF151520
     4 44H2 SUBSET EQUATION WITH MINIMUM RMS VALUE, OR / 20X,           CF151530
     5 42H3 ESTIMATE OF VARIANCE CARD, F16.8 FORMAT.             /20X,  CF151540
     6 39HCP SEARCH BY MODIFIED LEAPS AND BOUNDS.                /20X,  CF151541
     7 28H4 ESTIMATE RMS FROM 1 ABOVE,                           /20X,  CF151542
     8 31H5 ESTIMATE RMS FROM 2 ABOVE, OR                        /20X,  CF151543
     9 28H6 ESTIMATE RMS FROM 3 ABOVE.                               )  CF151544
      WRITE(KTOU,68) IQ(26), MXSRCD                                     CF151550
   68 FORMAT(1H ,3X,2H50,I4,I6,2X,                                      CF151560
     1 46HNUMBER OF CP SELECTED SEARCH CARDS TO BE READ.     / 18X,     CF151570
     2 52H KEYPUNCH WITH A 18(2X,I2) FORMAT IN ASCENDING ORDER   / 18X, CF151580
     3 50H THE IDENTIFICATION NUMBER OF THE VARIABLES (AFTER     / 18X, CF151590
     4 44H TRANSFORMATIONS) TO BE USED IN THAT SEARCH.           / 18X, CF151600
     5 54H ALL OTHER VARIABLES WILL BE PLACED IN BASIC EQUATION. / 18X, CF151610
     6 51H IF THE TOTAL NUMBER OF VARIABLES TO BE SEARCHED IS    / 18X, CF151611
     7 36H LARGE, GIVE TOTAL IN COLUMNS 43-44.                       )  CF151612
      WRITE(KTOU,70) IQ(27)                                             CF151620
   70 FORMAT(1H ,3X,2H51,I4,   8X,                                      CF151630
     1 55H1 LIST COMPONENT-EFFECT TABLE, REQUIRED X(I) PRECISION,/ 18X, CF151640
     2 54H   ESTIMATE OF STANDARD DEVIATION FROM NEAR NEIGHBORS, / 18X, CF151650
     3 29H   AND FUNCTIONS OF FITTED Y.  / 18X,                         CF151660
     4 53H2 LIST ONLY ESTIMATE OF STD. DEVIATION AND FUNCTIONS.  / 18X, CF151670
     5 34H3 LIST ONLY FUNCTIONS OF FITTED Y.                         )  CF151680
      WRITE(KTOU,72) IQ(28)                                             CF151690
   72 FORMAT(1H ,5H52-53,I4,   8X,                                      CF151700
     1 51HNUMBER OF FILE IF DATA ARE READ FROM SEPARATE FILE,    / 18X, CF151710
     2 53H NO END CARD IF ONLY ONE SET OF DATA IS ON EACH FILE.      )  CF151720
      WRITE(KTOU,74) IQ(29)                                             CF151730
   74 FORMAT(1H ,5H54-55,I4,   8X,                                      CF151740
     1 51HNUMBER OF INDEPENDENT VARIABLES GREATER THAN THE 99    / 18X, CF151750
     2 23H ALLOWED IN COLS 19-20.                                    )  CF151760
      WRITE(KTOU,76) IQ(30)                                             CF151770
   76 FORMAT(1H ,5H56-58,I4,   8X,                                      CF151780
     1 42HTO REDUCE PRINTOUT WITH MANY OBSERVATIONS, / 18X,             CF151790
     2 49H NUMBER OF CENTRAL OBSERVATIONS AND RESIDUALS NOT      / 18X, CF151800
     3 46H TO BE PRINTED.  THIS REQUIRES AN E IN COL 24.             )  CF151810
      WRITE(KTOU,78) IQ(31)                                             CF151820
   78 FORMAT(1H ,3X,2H59,I4,   8X,                                      CF151830
     1 51HCROSS VERIFICATION OF MODEL AND COEFFICIENTS WITH A    / 17X, CF151840
     2 24H  SECOND SAMPLE OF DATA:                         / 20X,       CF151850
     3 45H1 WRITE B(0) AND B(I)S ON FILE IN ONE PROBLEM          / 20X, CF151860
     4 35H   (TRANSFORMATIONS ARE NOT SAVED).                    / 20X, CF151870
     5 48H2 READ  B(0) AND B(I)S FROM FILE IN NEXT PROBLEM / 20X,       CF151880
     6 34H  WITH SECOND SET OF OBSERVATIONS.                   )        CF151890
      WRITE(KTOU,80) IQ(32), MNOMTC                                     CF151900
   80 FORMAT(1H ,3X,2H60,I4,I6,2X,                                      CF151910
     1 46HNUMBER OF DELETE-OBSERVATIONS CARDS.  KEYPUNCH         / 18X, CF151920
     2 55H OBSERVATION NUMBER OF DATA TO BE DELETED IN ORDER READ/ 18X, CF151930
     3 35H BY COMPUTER USING 7(I4,6X) FORMAT.                        )  CF151940
      WRITE(KTOU,82) IQ(33), MNIVOC                                     CF151950
   82 FORMAT(1H ,3X,2H61,I4,I6,2X,                                      CF151960
     1 48HNUMBER OF INDICATOR-VARIABLE-OBSERVATIONS CARDS.       / 18X, CF151970
     2 52H USING A 7(I4,2X,I3,1X) FORMAT, KEYPUNCH OBSERVATION   / 18X, CF151980
     3 51H NUMBER (IN ORDER READ) AND VARIABLE NUMBER (BEFORE    / 18X, CF151990
     4 51H TRANSFORMATIONS) INTO WHICH A 1 IS TO BE INSERTED.        )  CF152000
C                                                                       CF152010
      RETURN                                                            CF152020
      END                                                               CF152030
      SUBROUTINE TRANPT                                                 CF160010
C                                                                       CF160020
C --- THIS SUBROUTINE PRINTS THE REQUESTED TRANSFORMATIONS PRIOR TO     CF160030
C --- PERFORMING THEM IN SUBROUTINE TRANSF.                             CF160040
C                                                                       CF160050
      IMPLICIT REAL*8(A-H,O-Z)                                          CF160060
      REAL*4 ARRAY, DRRAY, ERRAY, FRRAY, GRRAY, HRRAY                   CF160061
      DIMENSION AVATR(65), IOMIT(65), ITLOC(65)                         CF160070
      DIMENSION ARRAY(21,6), DRRAY(4), ERRAY(70)                        CF160080
      COMMON /AAAAAA/ COM1(1000)                                        CF160090
      COMMON /FFFFFF/ VARTR(65), ITRFM(65)                              CF160100
      COMMON /GGGGGG/ BI(65), EQU(144)                                  CF160110
      COMMON /PPPPPP/ JNOVAR, KCP, NRDLMT                               CF160120
      COMMON /QQQQQQ/ KTIN, KTOU, KTPCH, KKK, KONE, KTWO, MNO, NFILE    CF160130
C ---          EQUIVALENCE STATEMENTS IN CF 1, 2 AND 5                  CF160140
      EQUIVALENCE (COM1(1),AVATR(1)), (COM1(106),ITLOC(1)),             CF160150
     1            (COM1(321),IOMIT(1))                                  CF160160
C                                                                       CF160170
C        ARRAY PRINTS OUT THE FOLLOWING TRANSFORMATIONS                 CF160180
C        0         NONE                                                 CF160190
C        1         NATURAL LOG                                          CF160200
C        2         COMMON LOG                                           CF160210
C        3         ANTI-NATURAL LOG                                     CF160220
C        4         ANTI-COMMON LOG                                      CF160230
C        5         EXPONENTIATION BY CONST.                             CF160240
C        6         MULTIPLY BY CONSTANT                                 CF160250
C        7         DIVIDE BY CONSTANT                                   CF160260
C        8         ADD BY CONSTANT                                      CF160270
C        9         MULTIPLY POSITIONS,--X--                             CF160280
C       10         DIVIDE POSITIONS,  --/--                             CF160290
C       11         ADD POSITIONS,     --+--                             CF160300
C       12         SUBTRACT POSITIONS,-----                             CF160310
C       13         SINE, RADIANS                                        CF160320
C       14         COSINE, RADIANS                                      CF160330
C       15         C DIVIDED BY VARIABLE                                CF160340
C       16         LN(LN VARIABLE)                                      CF160350
C       17         LOG(LOG VARIABLE)                                    CF160360
C       18         LOG(VARIABLE PLUS C)                                 CF160370
C       19         ANTI(LN(LN VARIABLE))                                CF160380
C       20         ANTI(LOG(LOG VARIABLE))                              CF160390
C                                                                       CF160400
      DATA ARRAY/4HNONE,4HNATU,4HCOMM,4HANTI,4HANTI,4HEXPO,4HMULT,      CF160410
     A           4HDIVI,4HADD ,4H    ,4H    ,4H    ,4H    ,4HS1NE,      CF160420
     B           4HCOSI,4HC DI,4HLN(L,4HLOG(,4HLOG(,4HANTI,4HANTI,      CF160430
     C           4H    ,4HRAL ,4HON  ,4H-NAT,4H-COM,4HNENT,4HIPLY,      CF160440
     D           4HDE B,4HCONS,4HMULT,4HDIVI,4HADD ,4HSUBT,4H, RA,      CF160450
     E           4HNE, ,4HVIDE,4HN VA,4HLOG ,4HVARI,4H(LN(,4H(LOG,      CF160460
     F           4H    ,4HLOG ,4HLOG ,4HURAL,4HMON ,4HIATI,4H BY ,      CF160470
     G           4HY CO,4HTANT,4HIPLY,4HDE P,4HPOSI,4HRACT,4HDIAN,      CF160480
     H           4HRADI,4HD BY,4HRIAB,4HVARI,4HABLE,4HLN V,4H(LOG,      CF160490
     I           4H    ,4H    ,4H    ,4H LOG,4HLOG ,4HON B,4HCONS,      CF160500
     J           4HNSTA,4H    ,4H POS,4HOSIT,4HTION,4H POS,4HS   ,      CF160510
     K           4HANS ,4H VAR,4HLE) ,4HABLE,4H PLU,4HARIA,4H VAR,      CF160520
     L           4H    ,4H    ,4H    ,4H    ,4H    ,4HY CO,4HTANT,      CF160530
     M           4HNT  ,4H    ,4HITIO,4HIONS,4HS,  ,4HITIO,4H    ,      CF160540
     N           4H    ,4HIABL,4H    ,4H)   ,4HS C),4HBLE),4HIABL,      CF160550
     O           4H    ,4H    ,4H    ,4H    ,4H    ,4HNST.,4H    ,      CF160560
     P           4H    ,4H    ,4HNS, ,4H,   ,4H    ,4HNS, ,4H    ,      CF160570
     Q           4H    ,4HE   ,4H    ,4H    ,4H    ,4H)   ,4HE)) /      CF160580
C                                                                       CF160590
      DATA DRRAY/1HX,1H/,1H+,1H-/                                       CF160600
C                                                                       CF160610
C --- ARRAY OF NUMBERS FROM 1 TO 70                                     CF160620
C                                                                       CF160630
      DATA ERRAY/2H 1,2H 2,2H 3,2H 4,2H 5,2H 6,2H 7,2H 8,2H 9,2H10,     CF160640
     1           2H11,2H12,2H13,2H14,2H15,2H16,2H17,2H18,2H19,2H20,     CF160650
     2           2H21,2H22,2H23,2H24,2H25,2H26,2H27,2H28,2H29,2H30,     CF160660
     3           2H31,2H32,2H33,2H34,2H35,2H36,2H37,2H38,2H39,2H40,     CF160670
     4           2H41,2H42,2H43,2H44,2H45,2H46,2H47,2H48,2H49,2H50,     CF160680
     5           2H51,2H52,2H53,2H54,2H55,2H56,2H57,2H58,2H59,2H60,     CF160690
     6           2H61,2H62,2H63,2H64,2H65,2H66,2H67,2H68,2H69,2H70/     CF160700
C    7           2H71,2H72,2H73,2H74,2H75,2H76,2H77,2H78,2H79,2H80,     CF160710
C    8           2H81,2H82,2H83,2H84,2H85,2H86,2H87,2H88,2H89,2H90,     CF160720
C    9           2H91,2H92,2H93,2H94,2H95,2H96,2H97,2H98,2H99,3H100,    CF160730
C    1           3H101,3H102,3H103,3H104,3H105/                         CF160740
C                                                                       CF160750
C                                                                       CF160760
C          TRANSFORMED DATA LISTING                                     CF160770
      IDECM=MOD(IDEC,2)                                                 CF160771
      WRITE(KTOU,863)                                                   CF160780
      IF(IDECM.EQ.0) TYPE 863                                           CF160781
  863 FORMAT(21H0DATA TRANSFORMATIONS)                                  CF160790
C          LIST TRANSFORMATION CARDS                                    CF160800
      WRITE(KTOU,995)                                                   CF160810
      IF(IDECM.EQ.0) TYPE 995                                           CF160811
C          TITLE LINE FOR TRANSFORMATION CARD LISTING                   CF160820
  995 FORMAT(1H ,7X,8HPOSITION,3X,4HCODE,3X,9HOPERATION,17X,            CF160830
     1     8HCONSTANT,2X,8HLOCATION,2X,4HOMIT,2X,8HVARIABLE,2X,4HNAME)  CF160840
      MCOUNT = 0                                                        CF160850
      DO 1010 I=1, JNOVAR                                               CF160860
C                                                                       CF160870
C --- SIMPLIFY TRANSFORMATION SYMBOLS FOR PRINTOUT                      CF160880
C                                                                       CF160890
      IOPCDE=ITRFM(I)+1                                                 CF160900
C                                                                       CF160910
C --- PUT CODE SYMBOL IN F ARRAY VIA E ARRAY                            CF160920
C                                                                       CF160930
      NAAA = ITRFM(I)                                                   CF160940
      IF(ITRFM(I).EQ.0) GO TO 1001                                      CF160950
      FRRAY= ERRAY(NAAA)                                                CF160960
      GO TO 1002                                                        CF160970
 1001 FRRAY= ARRAY(10,1)                                                CF160980
 1002 NAAB = ITLOC(I)                                                   CF160990
C                                                                       CF161000
C --- PUT LOCATION SYMBOL IN G ARRAY VIA E ARRAY                        CF161010
C                                                                       CF161020
      IF(ITLOC(I).EQ.0) GO TO 1003                                      CF161030
      GRRAY=ERRAY(NAAB)                                                 CF161040
      GO TO 1004                                                        CF161050
 1003 GRRAY= ERRAY(I)                                                   CF161060
C                                                                       CF161070
C --- PUT VARIABLE IN H ARRAY VIA E ARRAY                               CF161080
C                                                                       CF161090
 1004 IF(IOMIT(I).EQ.1) GO TO 1005                                      CF161100
      MCOUNT = MCOUNT + 1                                               CF161110
      HRRAY  = ERRAY(MCOUNT)                                            CF161120
      GO TO 1006                                                        CF161130
 1005 HRRAY  = ARRAY(10,1)                                              CF161140
 1006 IF(ITRFM(I).GE.9.AND.ITRFM(I).LE.12) GO TO 1008                   CF161150
C                                                                       CF161160
C --- PRINTOUT OPERATIONS THAT USE CONSTANTS                            CF161170
C                                                                       CF161180
      WRITE(KTOU,1007)I,FRRAY,(ARRAY(IOPCDE,JZ),JZ=1,6),AVATR(I),       CF161190
     1     GRRAY, IOMIT(I), HRRAY, BI(I)                                CF161200
      IF(IDECM.EQ.0) TYPE 1007,I,FRRAY,(ARRAY(IOPCDE,JZ),JZ=1,6),       CF161201
     1                         AVATR(I),GRRAY,IOMIT(I),HRRAY,BI(I)      CF161202
C          OUTPUT FORMAT OF TRANSFORMATION CARD                         CF161210
 1007 FORMAT(1H , 9X,I3,7X,A2,4X,6A4,3X,A5,7X,A2,6X,I1,7X,A2,5X,A6)     CF161220
      GO TO 1010                                                        CF161230
C                                                                       CF161240
C --- PRINTOUT OPERATIONS THAT UTILIZE POSITIONS                        CF161250
C                                                                       CF161260
C                                                                       CF161270
C --- PUT POSITION CHANGES IN D ARRAY                                   CF161280
C                                                                       CF161290
 1008 JAA  = ITRFM(I) - 8                                               CF161300
      MA = IDINT(0.01*VARTR(I))                                         CF161310
      NA = IDINT(DMOD(VARTR(I),1.0D2))                                  CF161320
      WRITE(KTOU,1009) I,FRRAY,(ARRAY(IOPCDE,JZ),JZ=1,6), MA,DRRAY(JAA),CF161330
     1      NA, GRRAY, IOMIT(I), HRRAY, BI(I)                           CF161340
      IF(IDECM.EQ.0) TYPE 1009,I,FRRAY,(ARRAY(IOPCDE,JZ),JZ=1,6),MA,    CF161341
     1                         DRRAY(JAA),NA,GRRAY,IOMIT(I),HRRAY,BI(I) CF161342
C          OUTPUT FORMAT OF TRANSFORMATION CARD                         CF161350
 1009 FORMAT(1H , 9X,I3,7X,A2,6A4,I2,A1,I2,14X,A2,6X,I1,7X,A2,5X,A6)    CF161360
 1010 CONTINUE                                                          CF161370
      IDEC=IDEC+1                                                       CF161371
      RETURN                                                            CF161380
      END                                                               CF161390
      SUBROUTINE FALPHA(PAR,DEFR,FVALUE,PERCNT)                         CF170010
C                                                                       CF170020
C ---      SUBROUTINE CALCULATES THE ALPHA LEVEL OF THE F DISTRIBUTION  CF170030
C --- FOR GIVEN F VALUES.  SEE HANDBOOK OF MATHEMATICAL FUNCTIONS BY    CF170040
C --- M. ABRAMOWITZ AND I. A. STEGUN, NATIONAL BUREAU OF STANDARDS,     CF170050
C --- APPLIED MATH SERIES 55, 1964, X = PAGE 947 FORMULA 26.6.15,       CF170060
C --- ALPHA = PAGE 932 FORMULA 26.2.18.  WHEN FVALUE IS LESS THAN 1,    CF170070
C ---  USE PAGE 947 FORMULA 26.6.9.                                     CF170080
C                                                                       CF170090
      IMPLICIT REAL*8(A-H,O-Z)                                          CF170100
      DATA D1/196854.D-6/,D2/115194.D-6/,D3/344.D-6/,D4/19527.D-6/      CF170110
      FVAL = FVALUE                                                     CF170120
      V1 = PAR                                                          CF170130
      V2 = DEFR                                                         CF170140
      IF(FVALUE.GT.1.) GO TO 10                                         CF170150
      FVAL = 1./FVALUE                                                  CF170160
      V1 = DEFR                                                         CF170170
      V2 = PAR                                                          CF170180
   10 A = 2./(9.*V1)                                                    CF170190
      B = 2./(9.*V2)                                                    CF170200
      C1 = FVAL**(1./3.)                                                CF170210
      C2 = C1*C1                                                        CF170220
      X = (C1*(1.-A) - (1.-B))/DSQRT(B+C2*A)                            CF170230
      ALPHA = .5/(1.+X*(D1+X*(D2+X*(D3+D4*X))))**4                      CF170240
      IF(FVALUE.GT.1.) GO TO 20                                         CF170250
      PERCNT = ALPHA*100.                                               CF170260
      GO TO 30                                                          CF170270
   20 PERCNT = (1. - ALPHA)*100.                                        CF170280
   30 RETURN                                                            CF170290
      END                                                               CF170300
      SUBROUTINE CPPLOT(RMSE,IPMAX,CPMAX,L,LE)                          CF180010
C ---    SUBROUTINE MAKES CP VS. P PLOTS OF SUBSET EQUATIONS.           CF180020
C                                                                       CF180030
C --- CP  () ARRAY OF CP VALUES INDEXED BY L,  CP(L) = (ZSSL/ZMS) - NP. CF180040
C --- CPMAX  CP VALUE OF FULL EQUATION                                  CF180050
C --- IP  () INDEX OF P VARIABLES IN EQUATION L.                        CF180060
C --- IPMAX  NUMBER OF PARAMETERS IN FULL EQUATION.                     CF180070
C --- L      INDEX OF EQUATIONS USED IN CP CALCULATIONS.                CF180080
C --- LE     NUMBER OF SUBSET EQUATION WITH RMS LESS THAN FULL          CF180090
C ---         EQUATION.                                                 CF180100
C --- MAXNPR MAXIMUM NUMBER OF SORTED CP VALUES PRINTED.                CF180110
C --- RMSE   ESTIMATE OF RMS EITHER READ FROM CARD OR VALUE FOUND IN    CF180120
C ---         SUBSET EQUATION THAT IS SMALLER THAN RMS.                 CF180130
      IMPLICIT REAL*8(A-H,O-Z)                                          CF180140
      REAL*4 GRIDA(53,26), GRIDB(53,26)                                 CF180150
      DIMENSION CP(1000), IP(1000)                                      CF180160
      COMMON /AAAAAA/ COM1(1000)                                        CF180170
      COMMON /DDDDDD/ COM4(3500)                                        CF180180
      COMMON /EEEEEE/ LSORT(1000)                                       CF180190
      COMMON /FORFIT/ RMS, YCMAX, YCMIN, YSS(10), MAXYSS, K411, NCP     CF180200
      COMMON /GGGGGG/ BI(65), EQU(144)                                  CF180210
      COMMON /JJJJJJ/ IDZB(1000)                                        CF180220
      COMMON /KKKKKK/ IQ(40), PR1, PR2, PR3, K, KFM, NODEP, NOIND,      CF180230
     1                NOOBSV, ICURY                                     CF180240
      COMMON /QQQQQQ/ KTIN, KTOU, KTPCH, KKK, KONE, KTWO, MNO, NFILE    CF180250
      EQUIVALENCE (COM1(1),CP(1)), (IDZB(1),IP(1))                      CF180260
      EQUIVALENCE (COM4(1001),GRIDA(1)),(COM4(1691),GRIDB(1))           CF180270
      INTEGER NCP1(53)                                                  CF180280
      INTEGER NVALP(21)                                                 CF180290
      DATA IPLUS/4H++++/                                                CF180300
      DATA NCP1/26*4H    ,4HCP  ,26*4H    /                             CF180301
C --                                                                    CF180310
C ---*******************************************************************CF180320
C --                                                                    CF180330
C ---      LIMITS THAT CAN BE SET BY THE INSTALLATION STATISTICIAN.     CF180340
C ---       FOR DEFINITIONS SEE THE GLOSSARY ABOVE.                     CF180350
C ---                                                                   CF180360
      MAXNPR = 100                                                      CF180370
C --                                                                    CF180380
C ---*******************************************************************CF180390
C --                                                                    CF180400
      NF = NOOBSV                                                       CF180410
      WRITE(KTOU,200)                                                   CF180420
  200 FORMAT(1H1, 20HESTIMATE OF VARIANCE )                             CF180430
      FSW = (RMSE - RMS) / RMS                                          CF180440
      IF(DABS(FSW).LE.1.D-8) GO TO 204                                  CF180450
      FSW = 1.0                                                         CF180460
      WRITE(KTOU,202) RMS, LE, RMSE                                     CF180470
  202 FORMAT(1H0, 20HRMS OF FULL EQUATION, 6X, F16.8 /                  CF180480
     1        1X, 22HRMS OF SUBSET EQUATION, I4, F16.8 )                CF180490
      GO TO 201                                                         CF180500
  204 FSW = 0.0                                                         CF180510
      WRITE(KTOU,206)                                                   CF180520
  206 FORMAT(1H0,46HNO SMALLER RMS VALUE FOUND IN SUBSET EQUATIONS)     CF180530
  201 IF((IQ(25)-4).LT.0) GO TO 207                                     CF180531
      IF(IQ(25)-5) 208, 212, 231                                        CF180532
  231 WRITE(KTOU,233)                                                   CF180533
  233 FORMAT(1H ,46HESTIMATED VARIANCE USED TO CALCULATE CP VALUES)     CF180534
      GO TO 236                                                         CF180535
  207 IF(IQ(25) - 2) 208, 212, 216                                      CF180540
  208 WRITE(KTOU,210)                                                   CF180550
  210 FORMAT(1H0,50HRMS OF FULL EQUATION SELECTED BY USER TO CALCULATE, CF180560
     110H CP VALUES )                                                   CF180570
      GO TO 236                                                         CF180580
  212 IF(FSW.EQ.0.) GO TO 232                                           CF180590
      WRITE(KTOU,214)                                                   CF180600
  214 FORMAT(1H0,62HRMS OF SUBSET EQUATION USED TO RECALCULATE AND PLOT CF180610
     1CP VALUES. )                                                      CF180620
      GO TO 222                                                         CF180630
  216 READ(KTIN,218) RMSE                                               CF180640
  218 FORMAT(F16.8)                                                     CF180650
      WRITE(KTOU,220) RMSE                                              CF180660
  220 FORMAT(1H ,20HRMS PROVIDED BY USER, 6X, F16.8 // 1X,              CF180670
     1 58HESTIMATED VARIANCE USED TO RECALCULATE AND PLOT CP VALUES. )  CF180680
  222 RMSR = RMS/RMSE                                                   CF180690
      DP    = NF - 2*IPMAX                                              CF180700
      CPFULL = (CPMAX - .005 + DP)*RMSR - DP                            CF180710
      WRITE(KTOU,224) IPMAX, CPFULL                                     CF180720
  224 FORMAT(1H0,22X,6HP   CP/1X,13HFULL EQUATION,6X,I4,1X,F5.1)        CF180730
      IF(FSW.EQ.0.) GO TO 228                                           CF180740
      DP    = NF - 2*IP(LE)                                             CF180750
      CPFULL = (CP(LE) + DP)*RMSR - DP                                  CF180760
      WRITE(KTOU,226) LE, IP(LE), CPFULL                                CF180770
  226 FORMAT(1H , 15HSUBSET EQUATION, 2I4, 1X, F5.1)                    CF180780
  228 DO 230 J = 1, L                                                   CF180790
      DP    = NF - 2*IP(J)                                              CF180800
  230 CP(J) = (CP(J) + DP)*RMSR - DP                                    CF180810
      GO TO 236                                                         CF180820
  232 WRITE (KTOU,234)                                                  CF180830
  234 FORMAT(1H0,49HRMS OF FULL EQUATION USED TO CALCULATE CP VALUES.)  CF180840
  236 IF(L.EQ.1) GO TO 1034                                             CF180850
C --- ORDER EQUATIONS BY THEIR CP VALUES.                               CF180860
      CALL SORT (L, CP, LSORT)                                          CF180870
      WRITE(KTOU,238)                                                   CF180880
  238 FORMAT(1H0// 30H  SEQ  EQUATION  P  ORDERED CP  )                 CF180890
      IA = MAXNPR                                                       CF180900
      IF(L.LT.IA) IA = L                                                CF180910
      DO 240 IC = 1, IA                                                 CF180920
      JC = LSORT(IC)                                                    CF180930
  240 WRITE(KTOU,242) IC, JC, IP(JC), CP(JC)                            CF180940
  242 FORMAT(1H , I4, 4X, I4, 1X, I4, F9.1 )                            CF180950
      JC = LSORT(1)                                                     CF180960
      MINCP = IDINT(CP(JC))                                             CF180970
      IF(MINCP.GT.0) GO TO 243                                          CF180980
      ILESS = (((MINCP /5) - 1) * 5)                                    CF180990
      IPLESS = 0                                                        CF181000
      GO TO 244                                                         CF181010
  243 ILESS = (((MINCP + 99)/5)*5) - 100                                CF181020
      IPLESS = ILESS                                                    CF181030
  244 CLESS  = DFLOAT(ILESS)                                            CF181040
      L1 = 99                                                           CF181050
      ILEVEL = ILESS - 1                                                CF181060
      DO 1040 JZ=1,21                                                   CF181070
 1040 NVALP(JZ) = IPLESS + JZ - 1                                       CF181080
      ITYPE = 2                                                         CF181090
      CALL GRID(GRIDA,GRIDB,L1,ITYPE)                                   CF181100
      YTOP = 5.2D01/3.D0                                                CF181110
      YIW  = 1.D0/3.D0                                                  CF181120
      DO 118 IC = 1, L                                                  CF181130
      JC = LSORT(IC)                                                    CF181140
      IP(JC) = IP(JC) - IPLESS                                          CF181150
C --- TRAP TO KEEP PLOT FROM GOING OUTSIDE OF PLOT DIMENSIONS.          CF181160
      IF(IP(JC).LT.1.OR.IP(JC).GT.20) GO TO 118                         CF181170
      CP(JC) = CP(JC) - CLESS                                           CF181180
      CPTOP  = YTOP - CP(JC)                                            CF181190
C --- TRAP TO KEEP PLOT FROM GOING OUTSIDE OF PLOT DIMENSIONS.          CF181200
      IF(CPTOP.LT.0..OR.CPTOP.GT.17.) GO TO 118                         CF181210
      LINE = IDINT((( CPTOP       ) / YIW) + 5.D-01) + 1                CF181220
      LOCX2 = 5*IP(JC) + 5                                              CF181230
      LCHAR = MOD(LOCX2,4)                                              CF181240
      LWORD = LOCX2/4                                                   CF181250
      IF(LCHAR.NE.0) GO TO 117                                          CF181260
      LCHAR = 4                                                         CF181270
      LWORD = LWORD - 1                                                 CF181280
  117 CALL PACK(GRIDA(LINE,LWORD),LCHAR,IPLUS)                          CF181290
  118 CONTINUE                                                          CF181300
      WRITE(KTOU,1028) PR1, PR2, PR3, ICURY, BI(K), NVALP               CF181310
 1028 FORMAT(1H1,      1X, 3A6,  9H  DEP VAR , I2, 2H: , A6, 29X,       CF181320
     1  7HCP PLOT                            / 17X, 21I5 )              CF181330
      WRITE(KTOU,1029) NCP1( 1),    (GRIDA( 1,JZ),JZ=1,26)              CF181340
 1029 FORMAT(10X, A4, 7X,         25A4, A2)                             CF181350
      NI     = 0                                                        CF181360
      INDIA  = 2                                                        CF181370
      ILEVEL = 18 + ILESS                                               CF181380
      DO 1032 IA = 2,53                                                 CF181390
      IF(IA.EQ.INDIA) GO TO 1030                                        CF181400
      WRITE(KTOU,1029) NCP1(IA),    (GRIDA(IA,JZ),JZ=1,26)              CF181410
      GO TO 1032                                                        CF181420
 1030 NI = NI + 1                                                       CF181430
      NJ = ILEVEL - NI                                                  CF181440
      WRITE(KTOU,1031) NCP1(IA), NJ,(GRIDA(IA,JZ),JZ=1,26)              CF181450
 1031 FORMAT(10X, A4, 2X, I4, 1X, 25A4, A2)                             CF181460
      INDIA = INDIA + 3                                                 CF181470
 1032 CONTINUE                                                          CF181480
      WRITE(KTOU,1033) NVALP                                            CF181490
 1033 FORMAT(17X, 21I5 / 71X, 1HP)                                      CF181500
 1034 RETURN                                                            CF181510
      END                                                               CF181520
      SUBROUTINE LBMAIN                                                 CF190010
C ---  SUBROUTINE SETS THE DIMENSIONS FOR THE LEAPS AND BOUNDS          CF190020
C      CP SEARCHES.                                                     CF190030
C                      FRED WOOD VERSION  4/1/81                        CF190040
C  NOTE: TO SAVE ON DIMENSIONS OF LINWOOD PROGRAM WITH LEAPS AND        CF190050
C  NOTE: TO SAVE ON DIMENSIONS OF LINWOOD PROGRAM WITH LEAPS AND        CF190040
C        BOUNDS, SET ND AND NL AS SMALL AS POSSIBLE.  THESE CONTROL     CF190060
C        THE NUMBER OF VARIABLES IN THE FULL EQUATION TO BE SEARCHED.   CF190070
C        TO DO SO, IN THIS SUBROUTINE SET THE DIMENSIONS OF ILI, MD,    CF190080
C        AND XC EQUAL TO ND AND THE DIMENSION OF XI EQUAL TO NL.        CF190090
C        REDEFINE ND AND NL IN DATA BELOW BASED ON MX, THE MAXIMUM      CF190100
C        NUMBER OF INDEPENDENT VARIABLES TO BE SEARCHED.  TRAP IN       CF190110
C        LANDB WILL GIVE ERROR MESSAGE AND RETURN WITHOUT SEARCHING     CF190120
C        IF NOIND.GT.MX.  SET ND.LE.NF.  SUGGESTED DIMENSIONS:          CF190130
C  10 VARIABLE PROGRAM                                                  CF190131
C     DIMENSION ILI(10,10), MD(10,10), XC(10,10), XI(  275)             CF190132
C     DATA ND,NL/10,275/                                                CF190133
C  40 VARIABLE PROGRAM                                                  CF190134
C     DIMENSION ILI(31,31), MD(31,31), XC(31,31), XI( 9102)             CF190135
C     DATA ND,NL/31,5952/                                               CF190136
C  80 VARIABLE PROGRAM                                                  CF190140
C     DIMENSION ILI(41,41), MD(41,41), XC(41,41), XI(13202)             CF190141
C     DATA ND,NL/41,13202/                                              CF190142
C  OR DIMENSION ILI(51,51), MD(51,51), XC(51,51), XI(24752)             CF190143
C     DATA ND,NL/51,24752/                                              CF190144
C  OR DIMENSION ILI(61,61), MD(61,61), XC(61,61), XI(41602)             CF190145
C     DATA ND,NL/61,41602/                                              CF190146
C  OR DIMENSION ILI(71,71), MD(71,71), XC(71,71), XI(64752)             CF190147
C     DATA ND,NL/71,64752/                                              CF190148
C                                                                       CF190149
C  ORDER OF SUBROUTINES CALLED FROM MAIN                                CF190150
C        LBMAIN - LANDB - VARSET - SWEEP                                CF190160
C                       - STORE                                         CF190170
C                       - BACK                                          CF190180
C                       - COEF   - PIVOT                                CF190190
C                       - CPPLOT - SORT                                 CF190200
C                                - GRID                                 CF190210
C                                - PACK                                 CF190220
C                                                                       CF190230
C ---    DOUBLE PRECISION VARIABLES PASSED TO SUBROUTINE LANDB.         CF190240
      DOUBLE PRECISION AVAR,AVG,B,BI,C,CI,CL,CO,CP,PR1,PR2,PR3,RM,RMS,  CF190250
     * RR,SIGMA,XC,XI,XP,YI,YN,YSS,Z                                    CF190260
C                                                                       CF190270
C ---    DOUBLE PRECISION VARIABLES IN COMMON USED IN LBMAIN.           CF190280
      DOUBLE PRECISION COM1,COM2,COM3,COM4                              CF190290
C                                                                       CF190300
C ---    DOUBLE PRECISION VARIABLES IN COMMON BUT NOT USED IN LBMAIN.   CF190310
      DOUBLE PRECISION EQU,BETA,DEFR,XNOIND,YCMAX,YCMIN                 CF190320
C                                                                       CF190330
C ---    ARRAYS OF CP SEARCH, ND AND NL DIMENSIONS.                     CF190340
      DIMENSION ILI(31,31), MD(31,31), XC(31,31), XI( 5952)             CF190350
C                                                                       CF190360
C ---    ARRAYS IN LANDB WITH NF DIMENSIONS, NF.GE.MAXICP               CF190370
      DIMENSION CO(40), ID(40), INT(40),                                CF190380
     * IPI(40), IPN(40), NI(40), YI(40), YN(40)                         CF190390
C                                                                       CF190400
C ---    ARRAYS OF LOWER CP CANDIDATE EQUATIONS, KO DIMENSIONS.         CF190410
      DIMENSION CI(60), CL(60), CP(60), JP(60), RM(60)                  CF190420
C                                                                       CF190430
C ---    ARRAYS FROM SUBROUTINE STAT, MXVRAT DIMENSIONS.                CF190440
      DIMENSION AVG(40), B(40), SIGMA(40)                               CF190450
C                                                                       CF190460
C ---    ARRAYS IN LANDB WITH MXVRAT AND MXVPAT DIMENSIONS.             CF190461
      DIMENSION AVAR(40), IND(40), RR(41,41), XP(41,41)                 CF190462
C                                                                       CF190463
C ---    ARRAYS IN VARSET FOR SELECTED SEARCHES,                        CF190470
C               IVGT(MXVRAT), IVLT(MAXICP)                              CF190471
      DIMENSION IVGT(40), IVLT(40)                                      CF190480
C                                                                       CF190490
      COMMON /AAAAAA/ COM1(1000)                                        CF190500
      COMMON /BBBBBB/ COM2(186)                                         CF190510
      COMMON /CCCCCC/ COM3(240)                                         CF190520
      COMMON /DDDDDD/ COM4(3500)                                        CF190530
      COMMON /FORFIT/ RMS, YCMAX, YCMIN, YSS(10), MAXYSS, K411, NCP     CF190540
      COMMON /GGGGGG/ BI(65), EQU(144)                                  CF190550
      COMMON /HHHHHH/ BETA(41), C(40,40), Z(41,41), NNNN, MXSIZE        CF190560
      COMMON /JJJJJJ/ IDZB(1000)                                        CF190570
      COMMON /KKKKKK/ IQ(40), PR1, PR2, PR3, K, KFM, NODEP, NOIND,      CF190580
     1                NOOBSV, ICURY                                     CF190590
      COMMON /NNNNNN/ DEFR, XNOIND, NOVM1, MXVRBT, MXVPBT, MXVRAT,      CF190600
     1                MXVPAT, MXOBSV, MAXIND, MAXOBS                    CF190610
      COMMON /QQQQQQ/ KTIN, KTOU, KTPCH, KKK, KONE, KTWO, MNO, NFILE    CF190620
      COMMON /SSSSSS/ ICP(40), MAXICP, MAXLBS, MINLBS, MAXCPS, MINCPS   CF190630
C                                                                       CF190640
      EQUIVALENCE (COM1( 1), CP(1))                                     CF190650
      EQUIVALENCE (COM2(107), B(1))                                     CF190660
      EQUIVALENCE (COM3( 1),AVG(1)), (COM3( 81),SIGMA(1))               CF190670
      EQUIVALENCE (COM3(161),YI(1)), (COM3(201),YN(1))                  CF190680
      EQUIVALENCE (COM4( 1),AVAR(1)), (COM4( 41),CI(1))                 CF190690
      EQUIVALENCE (COM4(101),CO(1)), (COM4(141),CL(1))                  CF190700
      EQUIVALENCE (COM4(201),RM(1)), (COM4(261),MD(1,1))                CF190710
      EQUIVALENCE (COM4(1861),ILI(1,1))                                 CF190720
C ---    NOTE, JP IS NOT USED UNTIL ID, IND, AND INT ARE FINISHED.      CF190721
      EQUIVALENCE (IDZB(  1), JP(1)), (IDZB( 41), ID(1))                CF190730
      EQUIVALENCE (IDZB( 81),IND(1)), (IDZB(121),INT(1))                CF190740
      EQUIVALENCE (IDZB(161),IPI(1)), (IDZB(201),IPN(1))                CF190750
      EQUIVALENCE (IDZB(241), NI(1)), (IDZB(281),IVGT(1))               CF190760
      EQUIVALENCE (IDZB(321),IVLT(1))                                   CF190770
C                                                                       CF190780
      EQUIVALENCE (Z(1,1),RR(1,1))                                      CF190790
      EQUIVALENCE (XI(1),XC(1,1)), (XI(1),XP(1,1))                      CF190800
C                                                                       CF190810
C ******************************************************************** *CF190820
C                                                                      *CF190830
C  IQNUMB= DIMENSION SET IN COMMON /KKKKKK/, IQ(IQNUMB)                *CF190840
C  KO    =MAX MBST, THE DIMENSION OF CI, CL, CP, JP, AND RM IN LANDB.  *CF190850
C  MBST  =NUMBER OF CANDIDATE EQUATIONS WITH LOWEST CP VALUES.         *CF190860
C         (1.LE.MBST.LE.KO).                                           *CF190870
C  MAXLBS=MAX NUMBER OF VARIABLES ALLOWED IN CP LB SEARCH SET BY TIME  *CF190880
C         AND MONEY RESTRAINTS IN SUBROUTINE BASPGM.  MAXLBS.LE.MX     *CF190890
C  MAXICP=MAX NUMBER OF VARIABLES READ FOR SELECTED SEARCH,            *CF190891
C         SET IN SUBROUTINE BASPGM,  ICP(MAXICP).                      *CF190892
C  MAXYSS=MAX NUMBER OF DEPENDENT VARIABLES SEARCHED, SET IN BASPGM.   *CF190893
C         THE DIMENSION OF YSS.                                        *CF190894
C  MXVRAT= MAX VARIABLES IN FULL EQUATION AFTER TRANSFORMATIONS,       *CF190900
C          SET IN BASPGM.  THE DIMENSION OF AVAR, C, IND AND IVGT.     *CF190901
C  MXVRBT= MAX VARIABLES IN FULL EQUATION BEFORE TRANSFORMATIONS,      *CF190902
C          SET IN BASPGM.  THE DIMENSION OF BI, THE VARIABLE NAMES.    *CF190903
C  MXVPAT= MXVRAT PLUS 1.  THE DIMENSIONS OF BETA, RR, XP AND Z.       *CF190910
C  NCWCOF=NUMBER OF CANDIDATE EQUATIONS TO BE PRINTED WITH             *CF190920
C         COEFFICIENTS AND T-VALUES. (NCWCOF.LE.KO)                    *CF190930
C  ND    = MX + 1, MAX IND VARS SEARCHED PLUS ONE DEPENDENT VARIABLE,  *CF190940
C          DIMENSION OF ILI, MD AND XC, SET HERE IN LANDB. (ND.LE.NF)  *CF190950
C            NOTE THAT ND AND NL CAN BE VARIED TO SAVE CORE,           *CF190951
C            CONTROL OF RUN IS SET BY MAXLBS IN SUBROUTINE BASPGM.     *CF190952
C  NF    = MAXIMUM NUMBER OF INDEPENDENT VARIABLES SEARCHED + 1,       *CF190960
C          EITHER FROM THE FULL EQUATION OR A SELECTED SEARCH.         *CF190961
C          DIMENSION OF CO, ID, INT, IPI, IPN,                         *CF190970
C                NI, YI, AND YN, (ND.LE.NF).                           *CF190980
C  NL    = DIMENSION OF XI, I.E. XI(NL), NOTE MX = ND - 1,             *CF190990
C        = ((MX+2)*(MX+3)*(MX+4)/6)-(MX+2)                             *CF191000
C                                                                      *CF191010
C                  MX      ND       NL  2**MX SUBSET EQUATIONS         *CF191020
C                   9      10      275              512                *CF191030
C                  14      15      800           16,384                *CF191040
C                  19      20     1750          524,288                *CF191050
C                  20      21     2002        1,048,576                *CF191060
C                  21      22     2277        2,097,152                *CF191070
C                  22      23     2576        4,194,304                *CF191080
C                  23      24     2900        8,388,608                *CF191090
C                  24      25     3250       16,777,216                *CF191100
C                  25      26     3627       33,554,432                *CF191110
C                  26      27     4032       67,108,864                *CF191120
C                  27      28     4466      134,217,728                *CF191130
C                  28      29     4930      268,435,456                *CF191140
C                  29      30     5425      536,870,912                *CF191150
C                  30      31     5952    1,073,741,824                *CF191160
C                  35      36     9102    3.4(10**10)                  *CF191170
C                  40      41    13202    1.1(10**12)                  *CF191180
C                  50      51    24752    1.1(10**15)                  *CF191181
C                  60      61    41602    1.1(10**18)                  *CF191182
C                  70      71    64752    1.2(10**21)                  *CF191183
C                                                                      *CF191190
C ******************************************************************** *CF191200
C                                                                       CF191210
      DATA IQNUMB/40/                                                   CF191220
      DATA KO/60/, MBST/20/, NF/40/                                     CF191230
C                                                                       CF191240
C             SET ND.LE.NF                                              CF191250
      DATA ND,NL/31,5952/                                               CF191260
C                                                                       CF191270
      NCWCOF = MBST/2                                                   CF191280
            CALL LANDB(ND,ILI,MD,XC,NL,XI,NF,AVAR,CI,CO,ID,IND,INT,IPI, CF191290
     * IPN,NI,YI,YN,KO,CL,CP,JP,RM,MXVRAT,AVG,B,C,SIGMA,MXVPAT,RR,Z,    CF191300
     * MXVRBT,BI,MAXYSS,YSS,IQNUMB,IQ,MAXICP,ICP,IVGT,IVLT,ICURY,K,     CF191310
     * KTIN,KTOU,MAXLBS,MINLBS,MBST,NCWCOF,NODEP,NOIND,NOOBSV,PR1,      CF191320
     * PR2,PR3,RMS,XP)                                                  CF191330
      RETURN                                                            CF191340
      END                                                               CF191350
      SUBROUTINE LANDB(ND,ILI,MD,XC,NL,XI,NF,AVAR,CI,CO,ID,IND,INT,IPI, CF200010
     * IPN,NI,YI,YN,KO,CL,CP,JP,RM,MXVRAT,AVG,B,C,SIGMA,MXVPAT,RR,Z,    CF200020
     * MXVRBT,BI,MAXYSS,YSS,IQNUMB,IQ,MAXICP,ICP,IVGT,IVLT,ICURY,K,     CF200030
     * KTIN,KTOU,MAXLBS,MINLBS,MBST,NCWCOF,NODEP,NOIND,NOOBSV,PR1,      CF200040
     * PR2,PR3,RMS,XP)                                                  CF200050
      DOUBLE PRECISION AVAR,AVG,B,BI,BIG,BLANK,BOUND,C,CI,CL,CO,CP,     CF200060
     * CPMAX,CPNGT,DEF,FULL,ONE,PR1,PR2,PR3,RM,RMS,RMSE,RMSL,RMSNGT,    CF200070
     * RR,RS,SIG,SIGMA,SSY,TEMP1,TEMP2,TWO,VAR,XC,XI,XMI,XP,YI,YN,      CF200080
     * YSS,Z,ZIP                                                        CF200090
C     INTEGER*2 MD,ILI,IPI,NI,IND,INT,IPN                               CF200100
      DIMENSION ILI(ND,ND), MD(ND,ND), XC(ND,ND), XI(NL)                CF200110
      DIMENSION CO(NF), ID(NF), INT(NF),                                CF200120
     * IPI(NF), IPN(NF), NI(NF), YI(NF), YN(NF)                         CF200130
      DIMENSION CI(KO), CL(KO), CP(KO), JP(KO), RM(KO)                  CF200140
      DIMENSION AVAR(MXVRAT),AVG(MXVRAT),B(MXVRAT),C(MXVRAT,MXVRAT),    CF200150
     * IND(MXVRAT),SIGMA(MXVRAT)                                        CF200151
      DIMENSION RR(MXVPAT,MXVPAT),XP(MXVPAT,MXVPAT),Z(MXVPAT,MXVPAT)    CF200160
      DIMENSION BI(MXVRBT),YSS(MAXYSS),IQ(IQNUMB)                       CF200170
C          ARRAYS IN VARSET                                             CF200180
      DIMENSION ICP(MAXICP),IVGT(MXVRAT),IVLT(MAXICP)                   CF200190
C                                                                       CF200200
C ******************************************************************** *CF200210
C                                                                      *CF200220
C               CP SUBSET SELECTION BY LEAPS AND BOUNDS                *CF200230
C      A PROGRAM FOR FINDING THE BETTER SUBSET CANDIDATE EQUATIONS     *CF200240
C                     G.M.FURNIVAL AND R.W.WILSON                      *CF200250
C               YALE UNIVERSITY AND U.S. FOREST SERVICE                *CF200260
C                      FRED WOOD VERSION  4/1/81                       *CF200270
C                                                                      *CF200280
C      THIS VERSION REDUCES SEARCH TIME BY CONSIDERING EQUATIONS TO    *CF200290
C      BE CANDIDATES ONLY IF THEIR CP VALUES ARE LESS OR EQUAL TO      *CF200300
C      THE CP VALUE OF THE FULL EQUATION.  THIS BOUND CAN ALSO BE SET  *CF200310
C      BY AN ESTIMATE OF VARIANCE SUPPLIED BY THE USER.  SEARCH TIME   *CF200320
C      CAN BE FURTHER REDUCED BY CHOOSING SELECTED SEARCHES, I.E.      *CF200330
C      WHEN GIVEN VARIABLES ARE KNOWN TO BE NEEDED OR IN MIXTURE       *CF200340
C      PROBLEMS WHERE COMPONENTS HAVE TO EQUAL ONE AND SEARCHES ARE    *CF200350
C      MADE ON INTERACTIONS.                                           *CF200360
C                                                                      *CF200370
C                                                                      *CF200380
C  AVG  =MEAN VALUE OF EACH VARIABLE.  USED TO CALCULATE B(0) WHEN     *CF200390
C        IT=1.                                                         *CF200400
C  BIG  =TWO*RR(KZ,KZ), IS THE RS VALUE USED TO LOAD BOTH YI AND YN.   *CF200410
C  BOUND=SCALED RSS VALUE OF FULL EQUATION.  EQUATIONS ARE NOT         *CF200420
C        CONSIDERED AS CANDIDATES UNLESS THEIR RSS VALUES ARE LESS     *CF200430
C        OR EQUAL TO THE VALUE OF BOUND.                               *CF200440
C  C    =INVERSE MATRIX OF RR FROM SUBROUTINE FIT.                     *CF200450
C  DEF  =DEGREES OF FREEDOM OF FULL EQUATION, =NOOBSV - IT - KX        *CF200460
C  FULL =BOUND + (KX*SIG), IS USED TO SET RM, THE VALUE ALL SUBSETS    *CF200470
C        HAVE TO BE BETTER THAN.                                       *CF200480
C  ICURY=THE NUMBER OF THE DEPENDENT VARIABLE BEING PROCESSED (I.E.1,2)*CF200490
C  IT   =TYPE OF INPUT MATRIX (0=MOMENTS ABOUT ZERO, B0=0, OR          *CF200500
C        MOMENTS ABOUT MEAN, B0= CALCULATED VALUE)                     *CF200510
C  K    =POSITION OF DEPENDENT VARIABLE IN SIGMA, BI, AND AVG.         *CF200520
C  KO   =MAX MBST, THE DIMENSION OF CL, CP, JP, AND RM.                *CF200530
C  KX   =NUMBER OF INDEPENDENT VARIABLES (3.LE.KX.LE.(ND-1))           *CF200540
C  KZ   =POSITION OF DEPENDENT VARIABLE IN LEAPS AND BOUNDS.           *CF200550
C  KZS  =SMALLER POSITION OF KZ WITH SELECTED SEARCH, NGT.GT.0.        *CF200551
C  L    =INDEX FROM 1 TO MBST.                                         *CF200560
C  LS   =POSITION IN SINGLE ARRAY XI, LOADED FROM UPPER TRIANGLE OF    *CF200570
C        DOUBLE ARRAY XC.  CONTAINS INVERSE, COEFFICIENTS AND RSS OF   *CF200580
C        FULL EQUATION.                                                *CF200590
C MAXICP=MAX NUMBER OF VARIABLES IN CP SELECTED SEARCH.  ICP(MAXICP)   *CF200600
C MAXLBS=MAX NUMBER OF VARIABLES ALLOWED IN CP LB SEARCH SET BY TIME   *CF200610
C        AND MONEY RESTRAINTS IN SUBROUTINE BASPGM.  MAXLBS.LE.MX      *CF200620
C MAXYSS=MAX NUMBER OF DEPENDENT VARIABLES ALLOWED.  DIMENSION OF YSS  *CF200630
C  MBST =NUMBER OF CANDIDATE EQUATIONS WITH LOWEST CP VALUES.          *CF200640
C        (1.LE.MBST.LE.KO).                                            *CF200650
C  MDEF =DEGREES OF FREEDOM FOR RR, MDEF=NOOBSV-IT, (MDEF.GT.KX)       *CF200660
C MINLBS=MIN NUMBER OF VARIABLES IN CP SEARCH WITHOUT OVERRIDE OF TOTAL*CF200670
C        NUMBER OF VARIABLES GIVEN IN COLUMNS 43-44 OF CONTROL CARD.   *CF200680
C        LIMIT IS SET IN SUBROUTINE BASPGM.                            *CF200690
C                                                                      *CF200700
C                                                                      *CF200710
C MXVPAT=MAX NUMBER OF ALL VARIABLES AFTER TRANSFORMATIONS + 1         *CF200720
C        THE DIMENSION OF RR, XP, AND Z.                               *CF200721
C MXVRAT=MAX NUMBER OF ALL VARIABLES AFTER TRANSFORMATIONS             *CF200730
C        THE DIMENSION OF AVAR, AVG, B, C, IND, IVGT, AND SIGMA.       *CF200731
C MXVRBT=MAX NUMBER OF ALL VARIABLES BEFORE TRANSFORMATIONS            *CF200740
C        THE DIMENSION OF BI, THE NAMES OF VARIABLES.                  *CF200741
C NCWCOF=NUMBER OF CANDIDATE EQUATIONS TO BE PRINTED WITH              *CF200750
C        COEFFICIENTS AND T-VALUES. (NCWCOF.LE.MBST.LE.KO)             *CF200760
C  ND   =MAX IND. VAR PLUS ONE DEPENDENT VARIABLE IN LANDB SEARCH.     *CF200770
C        THE DIMENSION OF ILI(ND,ND), MD(ND,ND) AND XC(ND,ND).         *CF200780
C  NF   =MAXIMUM NUMBER OF KX INDEPENDENT VARIABLES + 1,               *CF200790
C        DIMENSION OF CI, CO, ID, INT, IPI, IPN, NI, YI,               *CF200800
C        AND YN, (ND.LE.NF).                                           *CF200810
C  NGT  =NOIND - NLT.  BASIC SET OF VARIABLES.  THOSE SELECTED BY      *CF200820
C        USER NOT TO BE SEARCHED.                                      *CF200830
C  NL   =((MX+2)*(MX+3)*(MX+4)/6)-(MX+2), THE DIMENSION OF XI(NL).     *CF200840
C  NLT  =NUMBER OF VARIABLES WHICH HAVE BEEN SELECTED BY USER TO BE    *CF200850
C        SEARCHED.  READ FROM VARIABLE SEARCH CARD.                    *CF200860
C  NR   =MAXVRAT, MAX NUMBER OF INDEPENDENT AND DEPENDENT VARIABLES    *CF200870
C        AFTER TRANSFORMATIONS IN FIT.  DIMENSION RR(NR.GT.KX)         *CF200880
C NSCARD=NUMBER OF SEARCH CARDS, INDICATED BY COL 50 OF CONTROL CARD.  *CF200890
C        VARIABLES TO BE SEARCHED ARE READ WITH 18(2X,I2) FORMAT       *CF200900
C  R2   =CP VALUE OF SUBSET EQUATION.                                  *CF200910
C  RM(L)=LOWEST RS VALUES.  AT START, RM IS LOADED WITH FULL, RS       *CF200920
C        VALUE OF FULL EQUATION.                                       *CF200930
C  RR   =UPPER TRIANGULAR PORTION OF (KX+1)*(KX+1) SIMPLE CORRELATION  *CF200940
C        COEFFICIENT MATRIX.  VARIABLE KX+1 IS THE DEPENDENT VARIABLE. *CF200950
C        THE FULL MATRIX IS USED FOR A FULL SEARCH AND A SMALLER       *CF200960
C        MATRIX FROM SUBROUTINE VARSET IS USED FOR SELECTED SEARCHES.  *CF200970
C  RS   =RX + SIG*(P-1), CODED RSS VALUE OF SUBSET EQUATIONS.  LOWEST  *CF200980
C        CP CANDIDATES ARE LOADED INTO RM(L).  CP=R2=2RS/SIG-          *CF200990
C        (NOOBSV-1-IT).                                                *CF201000
C  RX   =XI(LSMAX) AT START, SCALED RSS OF FULL EQUATION.  LATER,      *CF201010
C        SCALED RSS OF SUBSET EQUATIONS.  2RX*SSY=RESIDUAL SUM OF      *CF201020
C        SQUARES OF P PARAMETER SUBSET EQUATIONS.                      *CF201030
C  SIG  =TWO TIMES SCALED RMS OF FULL EQUATION.                        *CF201040
C  SIGMA=SCALED RESIDUAL ROOT MEAN SQUARE OF EACH VARIABLE.            *CF201050
C  SSY  =SUM OF SQUARES OF Y FROM SUBROUTINE STAT, =RAW SS WHEN        *CF201060
C        B(0)=0, IT=0, AND =CORRECTED FOR MEAN WHEN B(0)=CALCULATED,   *CF201070
C        IT=1.                                                         *CF201080
C  VAR  =VARIANCE ESTIMATE PROVIDED BY USER IF DESIRED.  OTHERWISE IT  *CF201090
C        IS SET EQUAL TO THE RESIDUAL MEAN SQUARE OF THE FULL MODEL    *CF201100
C        AND SCALED BY DIVIDING BY SSY.                                *CF201110
C YN(KZ)=SCALED VALUE OF TOTAL SUMS OF SQUARES FROM DIAGIONAL OF       *CF201120
C        SIMPLE CORRELATION COEFFICIENTS,  YN(KZ) SHOULD EQUAL ONE.    *CF201130
C                                                                      *CF201140
C  IN LEAPS AND BOUNDS, THE CALCULATIONS ARE SCALED SO THAT THE SUM    *CF201150
C  OF SQUARES OF Y = 1 AND THE COEFFICIENTS ARE STANDARDIZED.          *CF201160
C  TO UNSCALE : RMS=RMS*SSY, AND COEFFICIENTS=B(I)*SIGMA(K)/SIGMA(I).  *CF201170
C       THE RATIO 2*RM(P)/SIG(FULL EQUATION) FROM LEAPS AND BOUNDS =   *CF201180
C                  RSS(P)/RMS(FULL EQUATION) FROM SUBROUTINE FIT.      *CF201190
C                  CP = EITHER OF THESE RATIOS - (N-2P).               *CF201200
C                  RM(P)=RS(P) - SIG(FULL)*FLOAT(P - 1)                *CF201210
C                  SCALED RSS(P)=Z(KZ,KZ) IN SELECTED SEARCH AND       *CF201220
C                               =RR(KZ,KZ) OTHERWISE.                  *CF201230
C                  SCALED RMS(F)=RMS(F)/SSY=ZMS.                       *CF201240
C                  THUS, THE RATIO = Z(KZ,KZ)/ZMS.                     *CF201250
C                                                                      *CF201260
C ******************************************************************** *CF201270
C                                                                       CF201280
C*        ARRAY DICTIONARY                                              CF201290
C*                                                                      CF201300
C* AVAR=NAMES OF VARIABLES IN EACH CANDIDATE EQUATION.  LOADED FROM     CF201310
C*      BI WHICH CONTAINS NAMES OF VARIABLES IN FULL EQUATION.          CF201320
C* AVG =MEAN VALUE OF EACH VARIABLE.  USED TO CALCULATE B(0) WHEN       CF201330
C*      IT=1.                                                           CF201340
C* B =COEFFICIENTS OF FULL EQUATION FROM SUBROUTINE FIT.                CF201350
C* BI=NAMES OF VARIABLES IN FULL EQUATION.                              CF201360
C* C =INVERSE MATRIX OF FULL EQUATION FROM SUBROUTINE FIT.              CF201370
C* CI=BINARY IDENTIFICATION FOR SUBPROBLEM                              CF201380
C* CL=BINARY IDENTIFICATION OF LOWEST CP EQUATIONS                      CF201390
C* CO=BINARY LABELS FOR INDEPENDENT VARIABLES                           CF201400
C* CP=CP VALUES OF EQUATIONS WITH LOWEST CP VALUES IN ASCENDING ORDER   CF201410
C* ICP=SELECTED SEARCH VARIABLES THAT ARE READ FROM SELECTED SEARCH     CF201420
C*     CARDS, 18 VARIABLES/CARD IN CF1(BASPGM), ALSO USED IN CPMAIN.    CF201430
C* ID=POSITION IN XI OF SUBPROBLEM SUBMATRICES                          CF201440
C* ILI=MAP ARRAY SHOWING CHANGE IN ORDER OF VARIABLES FROM SOURCE       CF201450
C*     SUBPROBLEM TO DESCENDENT SUBPROBLEM                              CF201460
C* IND=MAP VECTOR SHOWING CURRENT ORDERING OF VARIABLES                 CF201470
C* INT=WORKING STORAGE FOR BACKTRACKING WITH CURRENT ORDERING           CF201480
C* IPN=LIST OF PRODUCT SUBPROBLEMS                                      CF201490
C* IPI=POINTS FROM DESCENDENT SUBPROBLEM TO SOURCE SUBPROBLEM           CF201500
C* IQ=CONTROL CARD VARIABLES FROM BSPGM.                                CF201510
C* IVGT=NGT VARIABLES IN BASIC EQUATION NOT SEARCHED BY REQUEST OF      CF201520
C*      USER.                                                           CF201530
C* IVLT=NLT VARIABLES TO BE SEARCHED AS REQUESTED BY USER.              CF201540
C* JP=P VALUES OF EQUATIONS WITH LOWEST CP VALUES, IN SAME ORDER AS     CF201550
C*      IN CP ARRAY.  IN SUBROUTINE CPPLOT, JP IS IP.                   CF201560
C* MD=INDIRECT ADDRESSES FOR ARRAY STORED AS VECTOR                     CF201570
C* NI=RIGHTMOST COLUMN SWEPT IN SUBPROBLEM SUBMATRIX                    CF201580
C* RM=VALUES OF SELECTION CRITERION, RS, FOR LOWEST CP EQUATIONS        CF201590
C* RR=SIMPLE CORRELATION COEFFICIENTS LOADED IN SUBROUTINE LANDB.       CF201600
C* SIGMA=SCALED RESIDUAL ROOT MEAN SQUARE OF EACH VARIABLE FROM         CF201610
C*       SUBROUTINE STAT.                                               CF201620
C* XC=WORK STORAGE FOR ORIGINAL INVERSION AND INVERSION OF SUBMATRICES  CF201630
C*    OF LOWEST CP EQUATIONS, DIMENSIONED BY ND,ND.                     CF201640
C* XI=WORKING STORAGE FOR SUBPROBLEM SUBMATRICES, DIMENSIONED BY NL     CF201650
C* XP=ORIGIONAL INVERSE MATRIX LOADED FROM RR IN COEF, THEN MODIFIED    CF201651
C*    IN PIVOT FOR SEARCHED AND NON-SEARCHED VARIABLES IN CANDIDATE     CF201652
C*    EQUATION, DIMENSIONED BY MXVPAT,MXVPAT.                           CF201653
C* YI=RESIDUAL SUMS OF SQUARES FOR INVERSE SUBPROBLEMS                  CF201660
C* YN=RESIDUAL SUM OF SQUARES FOR PRODUCT SUBPROBLEMS                   CF201670
C* YSS=SUM OF SQUARES OF Y, SSY, FOR EACH DEPENDENT VARIABLE FROM       CF201680
C*     SUBROUTINE STAT.                                                 CF201690
C* Z =SIMPLE CORRELATION COEFFICIENTS FROM SUBROUTINE FIT.              CF201700
C*                                                                      CF201710
C*  KO=MAX MBST             MX = MAX KX,  ND = MAX KX + 1               CF201720
C*  IN DIMENSION OF XI(NL), NL=((MX+2)*(MX+3)*(MX+4)/6)-(MX+2)          CF201730
C*                          NL=12300 WHEN MAX KX=39                     CF201740
C*                                                                      CF201750
C********************************************************************** CF201760
C                                                                       CF201770
      DATA ZIP,ONE,TWO/0.0D0,1.0D0,2.0D0/                               CF201780
      DATA BLANK/6H      /                                              CF201790
C                                                                       CF201800
      WRITE(KTOU,1000) PR1, PR2, PR3, ICURY, BI(K)                      CF201810
 1000 FORMAT(1H1,32X,47HCP VALUES FOR THE SELECTION OF CANDIDATE SUBSET,CF201820
     1 10H EQUATIONS//1X,3A6,10H   DEP VAR,I2,2H: ,A6)                  CF201830
      NSCARD = IQ(26)                                                   CF201840
      MAXSRH = MINLBS                                                   CF201850
      IF(IQ(21).GT.MINLBS.AND.IQ(21).LE.MAXLBS) MAXSRH = IQ(21)         CF201860
C --- NCWCOF CANNOT BE SET GREATER THAN MBST                            CF201870
      IF(NCWCOF.GT.MBST) NCWCOF = MBST                                  CF201880
      IF(NCWCOF.LT.0)    NCWCOF = 0                                     CF201890
      VAR = ZIP                                                         CF201900
C ---      READ ESTIMATE FROM VARIANCE CARD FOR EACH DEPENDENT VAR      CF201910
      IF(IQ(25).NE.6) GO TO 40                                          CF201920
      READ(KTIN,2) VAR                                                  CF201930
    2 FORMAT(F16.8)                                                     CF201940
      WRITE(KTOU,3) VAR                                                 CF201950
    3 FORMAT(1H0,49HESTIMATED VARIANCE USED TO CALCULATE CP VALUES = ,  CF201960
     * F16.8)                                                           CF201970
      GO TO 4                                                           CF201980
   40 WRITE(KTOU,41)                                                    CF201990
   41 FORMAT(1H0,48HRMS OF FULL EQUATION USED TO CALCULATE CP VALUES)   CF202000
    4 IF(ICURY.LE.MAXYSS) GO TO 6                                       CF202010
      WRITE(KTOU,5)  MAXYSS                                             CF202020
    5 FORMAT(1H1,54H******PRESENT VERSION OF LEAPS AND BOUNDS HAS LIMIT CF202030
     1OF,I3,26H DEPENDENT VARIABLES******)                              CF202040
      GO TO 9999                                                        CF202050
    6 IT=1                                                              CF202060
      IBZERO = 1                                                        CF202070
C        CHECK IF B(0)=0                                                CF202080
      IF(IQ(5).EQ.0) GO TO 1                                            CF202090
      IBZERO = 0                                                        CF202100
      IT     = 0                                                        CF202110
   1  NPRT   = 0                                                        CF202120
C                                                                       CF202130
      KX=NOIND                                                          CF202140
      KZ=KX+1                                                           CF202150
      MDEF = NOOBSV - IT                                                CF202160
      DEF  = DFLOAT(MDEF - KX)                                          CF202170
      JPFULL = KX + IT                                                  CF202171
      CPFULL = DFLOAT(JPFULL)                                           CF202172
C                             TEST INPUT                                CF202180
      IF(ND.LE.NF.AND.MDEF.GT.KX.AND.MBST.GT.0.AND.MBST.LE.KO.          CF202190
     *      AND.IT.GE.0.AND.IT.LE.1.AND.NCWCOF.LE.MBST)  GO TO 8        CF202200
         WRITE(KTOU,7)                                                  CF202210
    7 FORMAT(1H0,48HLANDB CP SEARCH INPUT PARAMETER(S) OUT OF BOUNDS)   CF202220
      GO TO 9999                                                        CF202230
C                             INITIALIZE                                CF202240
    8 NGT = 0                                                           CF202250
C ---      SET UP STATISTICS OF FULL EQUATION                           CF202260
      SSY  = YSS(ICURY)                                                 CF202270
      BOUND=RMS*DEF/SSY                                                 CF202280
      SIG=TWO*BOUND/DEF                                                 CF202290
      IF(VAR.NE.ZIP) SIG=TWO*VAR/SSY                                    CF202300
      DO 108 L=1,KX                                                     CF202310
  108 IVLT(L) = L                                                       CF202320
      IF(NSCARD.EQ.0) GO TO 78                                          CF202330
C ---      IF VARIABLES TO BE SEARCHED HAVE BEEN CHOSEN BY USER,        CF202340
C --- ADJUST SIMPLE CORRELATION COEFFICIENT MATRIX Z AND INVERST        CF202350
C --- MATRIX C  FOR BASIC SET OF VARIABLES AND CONSTRUCT SMALLER        CF202360
C -- SET OF UPPER TRIANGLE RR AND XC MATRICIES IN SUBROUTINE VARSET.    CF202370
            CALL VARSET(MAXICP,ICP,IVGT,IVLT,NF,AVAR,MXVRBT,BI,         CF202380
     *           MXVRAT,C,MXVPAT,RR,Z,ND,XC,K,KTOU,MAXSRH,NGT,NLT,KX)   CF202390
      IT = NGT + IT                                                     CF202400
      KX = KX - NGT                                                     CF202410
      KZ = KX + 1                                                       CF202420
C ---   STATISTICS ON BASIC EQUATION WITH NGT VARIABLES.                CF202430
C          TEMP1 = RATIO OF RSS(P)/ZMS, ZMS IS SCALED RMS OR RMS/SSY.   CF202440
C          TEMP1  = Z(KZ,KZ)/ZMS                                        CF202450
           TEMP1  = Z(KZ,KZ)/(RMS/SSY)                                  CF202460
      CPNGT  = TEMP1 - DFLOAT(NOOBSV-2*IT)                              CF202470
      JPNGT  = IT                                                       CF202480
      DEF    = DFLOAT(NOOBSV - IT)                                      CF202490
      RMSNGT = TEMP1*RMS/DEF                                            CF202500
C ---   TEST FOR NUMBER OF VARIABLES TO BE SEARCHED.                    CF202510
      IF(NLT.GT.0) GO TO 78                                             CF202520
      WRITE(KTOU,668)                                                   CF202530
  668 FORMAT(1H0,45HNO VARIABLES DESIGNATED ON SEARCH CARD TO BE ,      CF202540
     *  9HSEARCHED.)                                                    CF202550
      GO TO 9999                                                        CF202560
   78 IF(KX.GE.1) GO TO 9                                               CF202570
      WRITE(KTOU,200) KX                                                CF202580
  200 FORMAT(1H0,44H*****LEAPS AND BOUNDS CP SEARCH NOT RUN*****//1X,   CF202590
     1 33HNUMBER OF INDEPENDENT VARIABLES,,I3, 16H, IS LESS THAN 1)     CF202600
      GO TO 9999                                                        CF202610
    9 IF(KX.LT.NF) GO TO 10                                             CF202620
      WRITE(KTOU,202) KX, NF                                            CF202630
  202 FORMAT(1H0,44H*****LEAPS AND BOUNDS CP SEARCH NOT RUN*****//1X,   CF202640
     1 33HNUMBER OF INDEPENDENT VARIABLES,,I3, 17H, EXCEEDS CURRENT,    CF202650
     2  9H LIMIT OF,I3/44H USE LARGER VERSION OF L AND B.  DIMENSIONS , CF202660
     3 31HOF NF SET IN SUBROUTINE LBMAIN.)                              CF202670
      RETURN                                                            CF202680
C ---      RETURN IF VARIABLES TO BE SEARCHED IS GREATER THEN MAXSRH    CF202690
   10 IF(KX.GT.MAXSRH) GO TO 9997                                       CF202700
      IF(NGT.GT.0) GO TO 110                                            CF202710
      DO 11 L=1, KX                                                     CF202720
   11 RR( L,KZ) = Z(L,K)                                                CF202730
      RR(KZ,KZ) = Z(K,K)                                                CF202740
  110 IPMAX=KX-IT                                                       CF202750
      CPMAX= FLOAT(IPMAX)                                               CF202760
      CI(1)=ZIP                                                         CF202770
      CI(KZ)=ONE                                                        CF202780
      KZS = KZ                                                          CF202781
      DO 13 L=1,KZ                                                      CF202790
         ID(L)=((KZ-1)*KZ*(KZ+1)-(KZ-L)*(KZ-L+1)*(KZ-L+2))/6            CF202800
         CO(L)=TWO**(KZ-L)                                              CF202810
         ILI(1,L)=L                                                     CF202820
         CI(1)=CI(1)+CO(L)                                              CF202830
         ILI(KZ,L)=L                                                    CF202840
         IND(L)=L                                                       CF202850
   13 CONTINUE                                                          CF202860
      INDX1=ID(KZ)+KZ*(KZ+1)/2                                          CF202870
      INDX2=KZ*ND                                                       CF202880
      ID(KZ)=MAX0(INDX1,INDX2)                                          CF202890
      IPN(1)=KZ                                                         CF202900
      NI(1)=KX                                                          CF202910
C                                                                       CF202920
C          LOAD MATRIX XC FROM SUBROUTINE FIT                           CF202930
C   XC IS LOADED WITH (1) A=INVERSE OF RR, (2) B=BETAS, STANDARDIZED    CF202940
C   COEFFICIENTS FROM THE FITTED FULL EQUATION AND (3) RS=SCALED        CF202950
C   RESIDUAL SUM OF SQUARES OF FULL EQUATION.  SIGNS OF ELEMENTS OF     CF202960
C   INVERSE AND BETAS ARE REVERSED.                                     CF202970
C   ORDER FOR KX=2 IS XC(1,1)=-C(1,1), XC(1,2)=-C(1,2), XC(1,3)=-B(1),  CF202980
C   XC(2,2)=-C(2,2), XC(2,3)=-B(2), XC(3,3)=RS                          CF202990
C                                                                       CF203000
      DO 988 LL=1, KX                                                   CF203010
      IF(NGT.GT.0) GO TO 987                                            CF203020
      DO 989 M = LL, KX                                                 CF203030
  989 XC(LL,M) = - C(LL,M)                                              CF203040
  987 L = IVLT(LL)                                                      CF203050
  988 XC(LL,KZ) = - B(L)*SIGMA(L)/SIGMA(K)                              CF203060
C ---      SCALED RESIDUAL SUM OF SQUARES                               CF203070
      XC(KZ,KZ) = BOUND                                                 CF203080
C                      STORE MATRICES AS VECTORS                        CF203090
      INDX1=ID(KZ)                                                      CF203100
      LS=0                                                              CF203110
      DO 18 L=1,KZ                                                      CF203120
         DO 17 M=L,KZ                                                   CF203130
            LS=LS+1                                                     CF203140
            MD(L,M)=LS                                                  CF203150
            MD(M,L)=LS                                                  CF203160
            XI(LS)=XC(L,M)                                              CF203170
            INDX2=INDX1+LS                                              CF203180
            XI(INDX2)=RR(L,M)                                           CF203190
   17    CONTINUE                                                       CF203200
   18 CONTINUE                                                          CF203210
C ---      DEFINE CONTROLS FOR BOTH FULL AND SELECTED SEARCHES          CF203220
C          HERE FULL IS THE RM OF THE FULL EQUATION, KX IS THE NUMBER   CF203230
C          OF INDEPENDENT VARIABLES IN EITHER THE FULL OR SMALLER       CF203240
C          SELECTED VARIABLE MATRIX TO BE SEARCHED.                     CF203250
      KM=KX-1                                                           CF203260
      FULL=BOUND+FLOAT(KX)*SIG                                          CF203270
      BIG = TWO*RR(KZ,KZ)                                               CF203280
      YN(KZ)=BIG/TWO                                                    CF203290
C ---                         START SEARCH                              CF203300
      DO 19 M=1,MBST                                                    CF203310
         CL(M)=ZIP                                                      CF203320
         RM(M)=FULL                                                     CF203330
   19 CONTINUE                                                          CF203340
      CL(MBST)=CI(1)                                                    CF203350
      NREG=1                                                            CF203360
      MN=1                                                              CF203370
      IP=1                                                              CF203380
      IN=KZ                                                             CF203390
      LO=KX                                                             CF203400
C                             STAGE LOOP                                CF203410
   20 XMI=KM-IP+MN                                                      CF203420
      LX=IP                                                             CF203430
      JC=IP-1                                                           CF203440
      YI(IP)=BIG                                                        CF203450
C                   FITTED EQUATIONS FROM INVERSE MATRIX                CF203460
      NREG=NREG+LO-IP+1                                                 CF203470
      DO 23 LB=IP,LO                                                    CF203480
         LT=IND(LB)                                                     CF203490
         CALL BACK(LB,IPI,IP,ILI,JC,ID,XI,MD,NI,ND,KZ,NL,RS,BOUND,NF)   CF203500
      TEMP1=RS+XMI*SIG                                                  CF203510
      IF(TEMP1.GE.RM(1)) GO TO 101                                      CF203520
      TEMP2=CI(IP)-CO(LT)                                               CF203530
         CALL STORE(TEMP1,TEMP2,CL,RM,MBST)                             CF203540
C                         RE-ORDER VARIABLES                            CF203550
  101    M=LB                                                           CF203560
         LN=ILI(IN,LB)                                                  CF203570
   21    IF (RS.LE.YI(M)) GO TO 22                                      CF203580
            YI(M+1)=YI(M)                                               CF203590
            ILI(IP,M)=ILI(IP,M-1)                                       CF203600
            ILI(IN,M)=ILI(IN,M-1)                                       CF203610
            IND(M)=IND(M-1)                                             CF203620
            M=M-1                                                       CF203630
            GO TO 21                                                    CF203640
   22    ILI(IP,M)=LB                                                   CF203650
         ILI(IN,M)=LN                                                   CF203660
         IND(M)=LT                                                      CF203670
         YI(M+1)=RS                                                     CF203680
   23 CONTINUE                                                          CF203690
      IF(IP.EQ.KM) GO TO 27                                             CF203700
      LD=MIN0(LO-1,KM-1)                                                CF203710
C                           SHARPER BOUNDS                              CF203720
      DO 24 LB=IP,LD                                                    CF203730
         LC=LD-LB+IP                                                    CF203740
      TEMP1=YI(LC+2)+FLOAT(MN+LD-LB)*SIG                                CF203750
         IF(RM(1).GT.TEMP1) GO TO 25                                    CF203760
   24 CONTINUE                                                          CF203770
      GO TO 27                                                          CF203780
C                   FITTED EQUATIONS FROM PRODUCT MATRIX                CF203790
   25 JC=IP                                                             CF203800
      NREG=NREG+LC-IP+1                                                 CF203810
      DO 26 LB=IP,LC                                                    CF203820
         IS=LB+1                                                        CF203830
      CALL BACK(LB,IPI,IN,ILI,JC,ID,XI,MD,NI,ND,KZ,NL,YN(IS),YN(IN),NF) CF203840
         CI(IS)=CI(IN)+CO(IND(LB))                                      CF203850
      TEMP1=YN(IS)+FLOAT(MN)*SIG                                        CF203860
      IF(TEMP1.GE.RM(1)) GO TO 102                                      CF203870
         CALL STORE(TEMP1,CI(IS),CL,RM,MBST)                            CF203880
  102    MN=MN+1                                                        CF203890
         IPN(MN)=IS                                                     CF203900
         IPI(IS)=IN                                                     CF203910
         IN=IS                                                          CF203920
   26 CONTINUE                                                          CF203930
   27 IF(MN.EQ.1) GO TO 33                                              CF203940
      IP=IPN(MN)                                                        CF203950
      IPI(IP)=LX                                                        CF203960
      MN=MN-1                                                           CF203970
      IN=IPN(MN)                                                        CF203980
C                              BACKTRACK                                CF203990
      IF(IP.GT.LX) GO TO 30                                             CF204000
      IM=IN                                                             CF204010
      IPI(IP)=IPI(IP+1)                                                 CF204020
      DO 29 LB=IP,LX                                                    CF204030
         KK=NI(LB)                                                      CF204040
         DO 28 L=LB,KK                                                  CF204050
            INT(L)=ILI(IM,L)                                            CF204060
            M=ILI(LB,L)                                                 CF204070
            IF(M.LT.L) ILI(IM,L)=INT(M)                                 CF204080
            IF(M.GT.L) ILI(IM,L)=ILI(IM,M)                              CF204090
   28    CONTINUE                                                       CF204100
         IM=IPI(IP)                                                     CF204110
   29 CONTINUE                                                          CF204120
      LX=IP-1                                                           CF204130
C                        FIND LEAP FROM BOUNDS                          CF204140
   30 BOUND=YI(IP)                                                      CF204150
      DO 31 LB=IP,KM                                                    CF204160
         TEMP1 = BOUND+FLOAT(MN+KM-LB)*SIG                              CF204170
         IF(RM(1).GT.TEMP1) GO TO 32                                    CF204180
   31 CONTINUE                                                          CF204190
      GO TO 27                                                          CF204200
   32 LO=KX+IP-LB                                                       CF204210
      CI(IP)=CI(IPI(IP))-CO(IND(IP-1))                                  CF204220
      GO TO 20                                                          CF204230
C                               OUTPUT                                  CF204240
   33 RMSL=RMS                                                          CF204250
C ---      SAVE CL CODE IN CI TO DECODE TWICE, (1) FOR TABLE OF         CF204260
C ---      VARIABLES IN EACH EQUATION AND (2) FOR COEFFICIENTS.         CF204270
      DO 37 LA=1, MBST                                                  CF204280
   37 CI(LA) = CL(LA)                                                   CF204290
      IF(NGT.EQ.0) GO TO 38                                             CF204300
      WRITE(KTOU,337)                                                   CF204310
  337 FORMAT(1H0//1X,46HEQUATION   P   CP        RMS         VARIABLES, CF204320
     * 39H IN ADDITION TO THOSE IN BASIC EQUATION)                      CF204330
      WRITE(KTOU,666) JPNGT, CPNGT, RMSNGT                              CF204340
  666 FORMAT(1H0,2X,5HBASIC,I5,F6.1,2X,F12.5)                           CF204350
      GO TO 338                                                         CF204360
   38 WRITE(KTOU,39)                                                    CF204370
   39 FORMAT(1H0/1X,46HEQUATION   P   CP        RMS         VARIABLES,  CF204380
     * 12H IN EQUATION)                                                 CF204390
  338 DO 61 LA=1,MBST                                                   CF204400
         L=MBST-LA+1                                                    CF204410
C ---      DECODE LABELS IN CL AND CO FOR TABLE OF VARIABLES.           CF204420
         MP=1                                                           CF204430
         DO 34 I=1,KX                                                   CF204440
            IF(CL(L).LT.CO(I)) GO TO 340                                CF204450
            MP=MP+1                                                     CF204460
            NP=MP                                                       CF204470
            CL(L)=CL(L)-CO(I)                                           CF204480
      M = IVLT(I)                                                       CF204490
            AVAR( I)=BI(M)                                              CF204500
      GO TO 34                                                          CF204510
  340 AVAR( I)=BLANK                                                    CF204520
   34    CONTINUE                                                       CF204530
      IF(MP.EQ.1) GO TO 74                                              CF204540
      CP(LA)=TWO*RM(L)/SIG-FLOAT(MDEF-IT-NGT)                           CF204550
      IF(IBZERO.EQ.1) GO TO 35                                          CF204560
         NP=NP-1                                                        CF204570
         IP=NP + NGT                                                    CF204580
         RMSE= (RM(L)-(SIG*FLOAT(MP-1)))*SSY/FLOAT(NOOBSV-NP-NGT)       CF204590
         GO TO 36                                                       CF204600
   35    RMSE= (RM(L)-(SIG*FLOAT(MP-1)))*SSY/FLOAT(NOOBSV-MP-NGT)       CF204610
         IP=MP + NGT                                                    CF204620
   36 JP(LA)=IP                                                         CF204630
      YI(LA)=RMSE                                                       CF204640
      NPRT = NPRT + 1                                                   CF204650
      IF(KX-12) 42,42,44                                                CF204660
   42 KTWO=KX                                                           CF204670
      GO TO 46                                                          CF204680
   44 KTWO=12                                                           CF204690
   46   WRITE(KTOU, 48) LA, IP, CP(LA), RMSE, (AVAR(I),I=1,KTWO)        CF204700
   48 FORMAT(1H0,3X, I4,I5,F6.1,2X,F12.5,2X,12(2X,A6) )                 CF204710
      KKK=12                                                            CF204720
   50 IF(KX-KKK) 60,60,51                                               CF204730
   51 KONE=KKK+1                                                        CF204740
      IF(KX-(KKK+12)) 54,54,52                                          CF204750
   52 KTWO=KKK+12                                                       CF204760
      GO TO 56                                                          CF204770
   54 KTWO=KX                                                           CF204780
   56 WRITE(KTOU,57) (AVAR(I),I=KONE,KTWO)                              CF204790
   57 FORMAT(1H ,34X, 12(2X,A6) )                                       CF204800
      KKK=KKK+12                                                        CF204810
      GO TO 50                                                          CF204820
   60    IF(RM(L).EQ.FULL) GO TO 62                                     CF204830
      IF(RMSE.GT.RMSL) GO TO 61                                         CF204840
      LE  = LA                                                          CF204850
      RMSL=RMSE                                                         CF204860
   61 CONTINUE                                                          CF204870
C                    CALCULATE AND PRINT COEFFICIENTS                   CF204880
   62 IF(NCWCOF.EQ.0.OR.NPRT.LT.2) GO TO 72                             CF204890
      IF(NCWCOF.GT.NPRT) NCWCOF = NPRT                                  CF204900
      WRITE(KTOU,1000) PR1, PR2, PR3, ICURY, BI(K)                      CF204910
      WRITE(KTOU,63)                                                    CF204920
   63 FORMAT(1H0,28HEQUATION   P   CP        RMS)                       CF204930
      IF(ICURY.LT.2.AND.NGT.EQ.0) GO TO 204                             CF204931
      KX = KX + NGT                                                     CF204932
      KZ = KX + 1                                                       CF204933
      DO 203 L=1,KX                                                     CF204940
  203 RR(L,KZ) = Z(K,L)                                                 CF204950
  204 IF(NSCARD.EQ.0) GO TO 901                                         CF204960
C ---      REPLACE UPPER TRIANGULAR MATRIX WITH SAVED LOWER FULL        CF204970
C ---      MATRIX IF SELECTED SEARCH HAS BEEN MADE.                     CF204980
      IT = IT - NGT                                                     CF204990
      NOIM1 = KX - 1                                                    CF205000
      DO 104 L=1,NOIM1                                                  CF205010
      IPL1 = L + 1                                                      CF205020
      DO 104 M=IPL1,KX                                                  CF205030
  104 RR(L,M) = RR(M,L)                                                 CF205040
      DO 105 L=1,KZ                                                     CF205050
  105 RR(L,L) = ONE                                                     CF205060
      IF(NGT.EQ.0) GO TO 901                                            CF205070
      WRITE(KTOU,900) JPNGT, CPNGT, RMSNGT                              CF205080
  900 FORMAT(1H0,2X,5HBASIC,I5,F6.1,2X,F12.5)                           CF205090
      KKK = NGT + 1                                                     CF205100
      IVGT(KKK) = KZ                                                    CF205110
         CALL COEF(KKK,XP,RR,IVGT,MDEF,MXVRAT,MXVPAT,SIGMA,K,IBZERO,    CF205120
     * AVG,BI,KTOU,MXVRBT,ONE)                                          CF205130
  901 IF(MP.EQ.1) GO TO 72                                              CF205140
      DO 68 LA=1,NCWCOF                                                 CF205150
         L=MBST-LA+1                                                    CF205160
C ---      DECODE LABELS IN CI AND CO FOR DISPLAY OF COEFFICIENTS.      CF205170
         MP=0                                                           CF205180
         DO 64 I=1,KZS                                                  CF205190
            IF(CI(L).LT.CO(I)) GO TO 64                                 CF205200
            MP=MP+1                                                     CF205210
            IPN(MP)=I                                                   CF205220
            CI(L)=CI(L)-CO(I)                                           CF205230
   64    CONTINUE                                                       CF205240
        WRITE(KTOU,66) LA, JP(LA), CP(LA), YI(LA)                       CF205250
   66 FORMAT(1H0,3X, I4,I5,F6.1,2X,F12.5)                               CF205260
      IF(NSCARD.EQ.0) GO TO 910                                         CF205270
C ---      MERGE INDEXIES IF SELECTED SEARCH HAS BEEN MADE.             CF205280
      IN = 1                                                            CF205290
      KK = 1                                                            CF205300
       M = 1                                                            CF205310
      DO 904 JC=1,KX                                                    CF205320
      IF(KK.GT.NGT)      GO TO 902                                      CF205330
      IF(IVGT(KK).NE.JC) GO TO 902                                      CF205340
      IND(IN) = IVGT(KK)                                                CF205350
      IN = IN + 1                                                       CF205360
      KK = KK + 1                                                       CF205370
      GO TO 904                                                         CF205380
  902 IF(M.GT.MP) GO TO 904                                             CF205390
      INDX1 = IPN(M)                                                    CF205400
      INDX2 = IVLT(INDX1)                                               CF205410
      IF(INDX2.NE.JC) GO TO 904                                         CF205420
      IND(IN) = INDX2                                                   CF205430
      IN = IN + 1                                                       CF205440
       M =  M + 1                                                       CF205450
  904 CONTINUE                                                          CF205460
      IND(IN) = KZ                                                      CF205470
         CALL COEF( IN,XP,RR, IND,MDEF,MXVRAT,MXVPAT,SIGMA,K,IBZERO,    CF205480
     * AVG,BI,KTOU,MXVRBT,ONE)                                          CF205490
      GO TO 68                                                          CF205500
  910    CALL COEF( MP,XP,RR, IPN,MDEF,MXVRAT,MXVPAT,SIGMA,K,IBZERO,    CF205510
     * AVG,BI,KTOU,MXVRBT,ONE)                                          CF205520
   68 CONTINUE                                                          CF205530
   72 WRITE(KTOU,73) NREG                                               CF205540
   73 FORMAT(1H0//1X,8X,I10,17H FITTED EQUATIONS)                       CF205550
      IF(NPRT.LT.2) GO TO 74                                            CF205560
      IF(NPRT.GE.KO) GO TO 912                                          CF205570
C ---      LOAD P AND CP VALUES OF FULL EQUATION.                       CF205571
      IF(JP(NPRT).EQ.JPFULL) GO TO 911                                  CF205572
      NPRT = NPRT + 1                                                   CF205573
      JP(NPRT) = JPFULL                                                 CF205574
      CP(NPRT) = CPFULL                                                 CF205575
  911 IF(NGT.EQ.0.OR.CPNGT.GT.CPFULL.OR.NPRT.GE.KO) GO TO 912           CF205576
C ---      LOAD P AND CP VALUES OF BASIC EQUATION.                      CF205580
      NPRT = NPRT + 1                                                   CF205590
      JP(NPRT) = JPNGT                                                  CF205600
      CP(NPRT) = CPNGT                                                  CF205610
  912 CONTINUE                                                          CF205620
      CALL CPPLOT(RMSL,IPMAX,CPMAX,NPRT,LE)                             CF205630
      GO TO 9999                                                        CF205640
   74 WRITE(KTOU,75)                                                    CF205650
   75 FORMAT(1H0,30HTHERE ARE NO SUBSET EQUATIONS.)                     CF205660
      GO TO 9999                                                        CF205670
 9997 WRITE(KTOU,9998) MAXLBS, MAXSRH, IQ(21), KX                       CF205680
 9998 FORMAT(1H0//////1X,  40H******THIS VERSION OF PROGRAM LIMITED BY, CF205690
     2 56H MAXLBS IN SUBROUTINE BASPGM (TO SAVE TIME AND MONEY) TO/     CF205700
     31X,I3,47H MODIFIED LEAPS AND BOUNDS CP SEARCH VARIABLES,/1X,I3,   CF205710
     4 30H MAXIMUM VARIABLES REQUESTED ,,I3,20H IN COLUMNS 43-44 OF,    CF205720
     5 14H CONTROL CARD,/1X,I3,32HVARIABLES REMAIN TO BE SEARCHED.//1X, CF205730
     6 52HINCREASE NUMBER REQUESTED IN COLUMNS 43-44 OR USE CP,         CF205740
     7 55H SELECTED SEARCH OPTION, COLUMN 50 OF THE CONTROL CARD. )     CF205750
 9999 RETURN                                                            CF205760
      END                                                               CF205770
      SUBROUTINE BACK(LB,IPI,IM,ILI,JC,ID,XI,MD,NI,ND,KZ,NL,RS,BN,NF)   CF210010
C ---                 EXTENDS PRIOR PIVOTS,                             CF210020
C ---                 CALLED FROM SUBROUTINE LANDB.                     CF210030
      DOUBLE PRECISION B,BN,RS,XI                                       CF210040
C     INTEGER*2 MD,ILI,IPI,NI                                           CF210050
      DIMENSION ID(NF),XI(NL),MD(ND,ND),ILI(ND,ND),IPI(NF),NI(NF)       CF210060
C                         FIND SOURCE MATRIX                            CF210070
      IF(LB.EQ.JC.OR.JC.EQ.0) GO TO 14                                  CF210080
   10 IF(LB.LE.NI(JC)) GO TO 11                                         CF210090
      JC=JC-1                                                           CF210100
      GO TO 10                                                          CF210110
C                     ADJUST FOR PREVIOUS PIVOTS                        CF210120
   11 IL=JC+1                                                           CF210130
      DO 13 IS=IL,IM                                                    CF210140
         IN=IPI(IS)                                                     CF210150
         L=ILI(IN,LB)                                                   CF210160
         MM=ID(IN)                                                      CF210170
         IP=ILI(IN,IS-1)                                                CF210180
         INDX1= MM+MD(IP,L)                                             CF210190
         INDX2= MM+MD(IP,IP)                                            CF210200
         B=XI(INDX1)/XI(INDX2)                                          CF210210
         DO 12 KA=IS,LB                                                 CF210220
            KN=ILI(IN,KA)                                               CF210230
            INDX1=ID(IS)+MD(KA,LB)                                      CF210240
            INDX2=MM+MD(KN,L)                                           CF210250
            INDX3=MM+MD(KN,IP)                                          CF210260
            XI(INDX1)=XI(INDX2)-B*XI(INDX3)                             CF210270
   12    CONTINUE                                                       CF210280
            INDX1=ID(IS)+MD(LB,KZ)                                      CF210290
            INDX2=MM+MD(L,KZ)                                           CF210300
            INDX3=MM+MD(IP,KZ)                                          CF210310
            XI(INDX1)=XI(INDX2)-B*XI(INDX3)                             CF210320
         NI(IS)=LB                                                      CF210330
         ILI(IS,LB)=LB                                                  CF210340
   13 CONTINUE                                                          CF210350
C                            CURRENT PIVOT                              CF210360
   14 L=ILI(IM,LB)                                                      CF210370
      MM=ID(IM)                                                         CF210380
      INDX1=MM+MD(L,KZ)                                                 CF210390
      INDX2=MM+MD(L,L)                                                  CF210400
      RS=BN-XI(INDX1)*XI(INDX1)/XI(INDX2)                               CF210410
      RETURN                                                            CF210420
      END                                                               CF210430
      SUBROUTINE STORE(RSS,CAB,CL,RM,KO)                                CF220010
C             SAVES RSS'S AND LABELS OF LOWER CP VALUE EQUATIONS,       CF220020
C ---         CALLED FROM SUBROUTINE LANDB.                             CF220030
      DOUBLE PRECISION CAB,CL,RSS,RM                                    CF220040
      DIMENSION CL(KO),RM(KO)                                           CF220050
C     IF(RSS.GE.RM(1)) RETURN                                           CF220060
      IF(KO.EQ.1) GO TO 11                                              CF220070
      DO 10 L=2,KO                                                      CF220080
         IF(RSS.GT.RM(L)) GO TO 12                                      CF220090
         RM(L-1)=RM(L)                                                  CF220100
         CL(L-1)=CL(L)                                                  CF220110
   10 CONTINUE                                                          CF220120
   11 L=KO+1                                                            CF220130
   12 RM(L-1)=RSS                                                       CF220140
      CL(L-1)=CAB                                                       CF220150
      RETURN                                                            CF220160
      END                                                               CF220170
      SUBROUTINE COEF(MP,XP,RR,IND,MDEF,NR,NP,SIGMA,K,IT,AVG,BI,KTOU,   CF230010
     * MXVRBT,ONE)                                                      CF230020
C ---         COMPUTES STATISTICS OF CANDIDATE EQUATIONS,               CF230030
C ---         CALLED FROM SUBROUTINE LANDB.                             CF230040
C ---         NR = MXVRAT AND NP = MXVPAT IN CALL ARGUMENT OF LANDB.    CF230041
      DOUBLE PRECISION AVG,BI,BZERO,DBET,F,ONE,RISQRD,RR,SIGMA,VAR,XP   CF230050
C     INTEGER*2 IND                                                     CF230060
      DIMENSION RR(NP,NP),XP(NP,NP),IND(NR),SIGMA(NR),AVG(NR),BI(MXVRBT)CF230070
      WRITE(KTOU,10)                                                    CF230080
   10 FORMAT(1H0,36X,10HIND.VAR(I),3X,4HNAME,4X,9HCOEF.B(I),5X,         CF230090
     *7HT-VALUE,3X,8HR(I)SQRD)                                          CF230100
C                           FORM SUBMATRIX                              CF230110
      DO 12  I=1,MP                                                     CF230120
         DO 11 J=I,MP                                                   CF230130
      INDX1=IND(I)                                                      CF230140
      INDX2=IND(J)                                                      CF230150
            XP(I,J)=RR(INDX1,INDX2)                                     CF230160
   11    CONTINUE                                                       CF230170
   12 CONTINUE                                                          CF230180
C                          INVERT SUBMATRIX                             CF230190
      M=MP-1                                                            CF230200
      DO 13 N=1,M                                                       CF230210
         CALL PIVOT(XP,MP,N,NP)                                         CF230220
   13 CONTINUE                                                          CF230230
      VAR=XP(MP,MP)/FLOAT(MDEF-M)                                       CF230240
      IF(IT.EQ.1) BZERO=AVG(K)                                          CF230250
      DO 16  I=1,M                                                      CF230260
         DBET=-XP(I,MP)                                                 CF230270
         F=-DBET*DBET/(XP(I,I)*VAR)                                     CF230280
         F= DSQRT(F)                                                    CF230290
         RISQRD=ONE+(ONE/XP(I,I))                                       CF230300
         INDX1=IND(I)                                                   CF230310
         DBET=DBET*SIGMA(K)/SIGMA(INDX1)                                CF230320
      IF(IT.EQ.0) GO TO 14                                              CF230330
         BZERO=BZERO-DBET*AVG(INDX1)                                    CF230340
   14    WRITE(KTOU,15) INDX1, BI(INDX1), DBET, F, RISQRD               CF230350
   15 FORMAT(1H ,39X,I3,5X,A6,2X,1PE12.5,4X,0PF5.1,5X,F7.4)             CF230360
   16 CONTINUE                                                          CF230370
      IF(IT.EQ.1) WRITE(KTOU,17) BZERO                                  CF230380
   17 FORMAT(1H0,49X,4HB(0),2X,1PE12.5 )                                CF230390
      WRITE(KTOU,18)                                                    CF230400
   18 FORMAT(1H )                                                       CF230410
      RETURN                                                            CF230420
      END                                                               CF230430
      SUBROUTINE PIVOT(XP,KP,N,NP)                                      CF240010
C ---           SYMMETRIC PIVOT-RETURNS NEGATIVE INVERSE,               CF240020
C ---           CALLED FROM SUBROUTINE COEF.                            CF240030
C ---         NP = MXVPAT IN CALL COEF ARGUMENT IN LANDB.               CF240031
      DOUBLE PRECISION XP,B,ONE                                         CF240040
      DIMENSION XP(NP,NP)                                               CF240050
      DATA ONE/1.0D0/                                                   CF240060
      XP(N,N)=-ONE/XP(N,N)                                              CF240070
      DO 11 I=1,KP                                                      CF240080
         IF(I.EQ.N) GO TO 11                                            CF240090
         B=XP(N,I)*XP(N,N)                                              CF240100
         DO 10 J=I,KP                                                   CF240110
            IF(J.EQ.N) GO TO 10                                         CF240120
            XP(I,J)=XP(I,J)+B*XP(N,J)                                   CF240130
            XP(J,I)=XP(I,J)                                             CF240140
   10    CONTINUE                                                       CF240150
         XP(I,N)=B                                                      CF240160
         XP(N,I)=B                                                      CF240170
   11 CONTINUE                                                          CF240180
      RETURN                                                            CF240190
      END                                                               CF240200
      SUBROUTINE VARSET(MAXICP,ICP,IVGT,IVLT,NF,AVAR,MXVRBT,BI,         CF250010
     *          MXVRAT,C,MXVPAT,RR,Z,ND,XC,K,KTOU,MAXSRH,NGT,NLT,NOIND) CF250020
      DOUBLE PRECISION AVAR,BI,C,RR,SIGN,XC,Z                           CF250030
      DIMENSION ICP(MAXICP),IVGT(MXVRAT),IVLT(MAXICP)                   CF250040
      DIMENSION AVAR(MXVRAT),BI(MXVRBT)                                 CF250050
      DIMENSION C(MXVRAT,MXVRAT)                                        CF250060
      DIMENSION RR(MXVPAT,MXVPAT),XC(ND,ND),Z(MXVPAT,MXVPAT)            CF250070
C                                                                       CF250080
C ---          GLOSSARY OF VARSET PROGRAM TERMS                         CF250090
C --- AVAR() NAME OF VARIABLE IN ENGLISH.                               CF250100
C --- BI  () ARRAY OF ENGLISH NAMES OF VARIABLES IN FULL EQUATION.      CF250110
C --- HAPPY  ELEMENT C(JOY,JOY), USED TO SWEEP MATRIX.                  CF250120
C --- ICP () INDEX OF VARIABLES READ FROM INPUT CARD TO BE SEARCHED.    CF250130
C ---         OTHER VARIABLES IN FULL EQUATION ARE PLACED IN BASIC      CF250140
C ---         EQUATION.                                                 CF250150
C --- INOUT()INDEX OF VARIABLE POSITIONS USED TO DETERMINE WHICH        CF250160
C ---         VARIABLE IS IN EACH EQUATION.                             CF250170
C --- IVGT() INDEX OF VARIABLES IN BASIC EQUATION.                      CF250180
C --- IVLT() INDEX OF VARIABLES TO BE SEARCHED.                         CF250190
C --- K      THE POSITION OF THE DEPENDENT VARIABLE IN THE Z ARRAY.     CF250200
C --- NGT    NUMBER OF VARIABLES IN BASIC EQUATION.                     CF250210
C --- NLT    NUMBER OF VARIABLES TO BE SEARCHED.                        CF250220
C --- NOIND  NUMBER OF INDEPENDENT VARIABLES.                           CF250230
C --- Z   () Z ARRAY OF SIMPLE CORRELATION COEFFICIENTS, AT START       CF250240
C ---          FROM FULL EQUATION, THEN MODIFIED AS VARIABLES ARE       CF250250
C ---          ADDED, SEE BROWNLEE SECTION 17.10, EQUATION 10.5.        CF250260
C                                                                       CF250270
C ---      VARIABLES REQUESTED BY USER TO BE SEARCHED                   CF250280
      NGT = 0                                                           CF250290
      NLT = 0                                                           CF250300
      IF(ICP(1).EQ.0) GO TO 53                                          CF250310
      IC = NOIND                                                        CF250320
      DO 103 J = 1, IC                                                  CF250330
      IF(ICP(J).EQ.0) GO TO 144                                         CF250340
      IVLT(J) = ICP(J)                                                  CF250350
  103 NLT = NLT + 1                                                     CF250360
      GO TO 144                                                         CF250370
  104 NLT = NLT - 1                                                     CF250380
  144 IF(ICP(NLT).GT.NOIND) GO TO 104                                   CF250390
      DO 106 J = 1, NLT                                                 CF250400
      I = ICP(J)                                                        CF250410
  106 AVAR(J) = BI(I)                                                   CF250420
      IF(NLT-12) 242,242,244                                            CF250430
  242 KTWO = NLT                                                        CF250440
      GO TO 246                                                         CF250450
  244 KTWO = 12                                                         CF250460
  246 WRITE(KTOU,248) (ICP(J),J=1,KTWO)                                 CF250470
  248 FORMAT(1H0,33HVARIABLES ON SELECTED SEARCH CARD,1X,12(2X,I6))     CF250480
      WRITE(KTOU,249) (AVAR(J),J=1,KTWO)                                CF250490
  249 FORMAT(1H ,34X,12(2X,A6))                                         CF250500
      KKK = 12                                                          CF250510
  250 IF(NLT-KKK) 260,260,251                                           CF250520
  251 KONE = KKK + 1                                                    CF250530
      IF(NLT-(KKK+12)) 254,254,252                                      CF250540
  252 KTWO = KKK + 12                                                   CF250550
      GO TO 256                                                         CF250560
  254 KTWO = NLT                                                        CF250570
  256 WRITE(KTOU,1016) ( ICP(J),J=KONE,KTWO)                            CF250580
      WRITE(KTOU,1018) (AVAR(J),J=KONE,KTWO)                            CF250590
      KKK = KKK + 12                                                    CF250600
      GO TO 250                                                         CF250610
C ---      VARIABLES REMAINING IN BASIC EQUATION, NOT SEARCHED.         CF250620
  260 IC = 1                                                            CF250630
      JC = 1                                                            CF250640
      DO 15 J = 1, NLT                                                  CF250650
      DO 14 I = JC, NOIND                                               CF250660
      IC = IC + 1                                                       CF250670
      IF(I.EQ.IVLT(J)) GO TO 145                                        CF250680
      NGT = NGT + 1                                                     CF250690
      IVGT(NGT) = I                                                     CF250700
      AVAR(NGT) = BI(I)                                                 CF250710
   14 CONTINUE                                                          CF250720
  145 JC = IC                                                           CF250730
   15 CONTINUE                                                          CF250740
      IF(IC.GT.NOIND) GO TO 17                                          CF250750
      DO 16 I = IC, NOIND                                               CF250760
      NGT = NGT + 1                                                     CF250770
      IVGT(NGT) = I                                                     CF250780
   16 AVAR(NGT) = BI(I)                                                 CF250790
   17 CONTINUE                                                          CF250800
      WRITE(KTOU,1006) NOIND, NLT, NGT                                  CF250810
 1006 FORMAT(1H0//37H NUMBER OF VARIABLES IN FULL EQUATION,    5X, I3/  CF250820
     235H NUMBER OF VARIABLES TO BE SEARCHED,   7X, I3/                 CF250830
     338H NUMBER OF VARIABLES IN BASIC EQUATION,   4X, I3// )           CF250840
C --- RETURN IF NLT IS GREATER THAN MAXSRH.                             CF250841
      IF(NLT.GT.MAXSRH) GO TO 53                                        CF250842
C --- SKIP BASIC EQUATION IF NGT IS ZERO.                               CF250850
      IF(NGT.GT.0) GO TO 18                                             CF250860
      WRITE(KTOU,1110)                                                  CF250870
 1110 FORMAT(1H0, 19X, 25HNO BASIC SET OF VARIABLES )                   CF250880
      GO TO 53                                                          CF250890
C                                                                       CF250900
C ---    SETUP Z SIMPLE CORRELATION COEFFICIENTS TO CONTAIN             CF250910
C --- NGT FACTORIAL VARIABLES                                           CF250920
C                                                                       CF250930
   18 SIGN =  1.                                                        CF250940
      DO 20 JAZ=1, NGT                                                  CF250950
      JOY = IVGT(JAZ)                                                   CF250960
      CALL SWEEP(JOY,SIGN,NOIND,K)                                      CF250970
   20 CONTINUE                                                          CF250980
      IF(NGT - 12) 22, 22, 24                                           CF250990
   22 KTWO= NGT                                                         CF251000
      GO TO 25                                                          CF251010
   24 KTWO= 12                                                          CF251020
   25 WRITE(KTOU,1012) (IVGT(I),I=1,KTWO)                               CF251030
 1012 FORMAT(1H0,22HBASIC SET OF VARIABLES,12X,12(2X,I6))               CF251040
      WRITE(KTOU,1014)(AVAR(I),I=1, KTWO)                               CF251050
 1014 FORMAT(1H ,34X, 12(2X,A6) )                                       CF251060
      KKK = 12                                                          CF251070
   28 IF(NGT - KKK) 38, 38, 30                                          CF251080
   30 KONE = KKK + 1                                                    CF251090
      IF(NGT - (KKK+12)) 34, 34, 32                                     CF251100
   32 KTWO = KKK + 12                                                   CF251110
      GO TO 36                                                          CF251120
   34 KTWO = NGT                                                        CF251130
   36 WRITE(KTOU,1016) (IVGT(I), I=KONE,KTWO)                           CF251140
 1016 FORMAT(1H0,34X, 12(2X,I6) )                                       CF251150
      WRITE(KTOU,1018) (AVAR(I), I=KONE,KTWO)                           CF251160
 1018 FORMAT(1H ,34X, 12(2X,A6) )                                       CF251170
      KKK = KKK + 12                                                    CF251180
      GO TO 28                                                          CF251190
   38 NLTP1 = NLT + 1                                                   CF251200
      IVLT(NLTP1) = K                                                   CF251210
C --- CONSTRUCT SMALLER RR AND XC MATRIX TO CONTAIN ONLY NLTP1          CF251220
C --- VARIABLES FROM Z AND C MATRIX.  NOTE IN SUBROUTINE LANDB          CF251230
C --- VALUES IN XC ARE THE NEGATIVE VALUES OF C.                        CF251240
      DO 42 I = 1, NLTP1                                                CF251250
      IC = IVLT(I)                                                      CF251260
      DO 42 J = I, NLTP1                                                CF251270
      JC = IVLT(J)                                                      CF251280
      XC(I,J) = - C(IC,JC)                                              CF251290
   42 RR(I,J) = Z(IC,JC)                                                CF251300
   53 RETURN                                                            CF251310
      END                                                               CF251320
      SUBROUTINE OPNFLS                                                 CF990010
      DOUBLE PRECISION FILIN,FILOU                                      CF990020
      OPEN(UNIT=1,DEVICE='DSK',ACCESS='SEQINOUT',                       CF990030
     *  FILE='FT01.DAT',MODE='BINARY')                                  CF990040
      OPEN(UNIT=2,DEVICE='DSK',ACCESS='SEQINOUT',                       CF990050
     *FILE='FT02.DAT',MODE='BINARY')                                    CF990060
      OPEN(UNIT=3,DEVICE='DSK',ACCESS='SEQINOUT',                       CF990070
     *FILE='FT03.DAT',MODE='BINARY')                                    CF990080
      OPEN(UNIT=4,DEVICE='DSK',ACCESS='SEQINOUT',                       CF990090
     *FILE='FT04.DAT',MODE='BINARY')                                    CF990100
100   FORMAT(A10)                                                       CF990110
101   FORMAT(' INPUT THE NAME OF THE OUTPUT FILE')                      CF990120
102   FORMAT(' INPUT THE NAME OF THE INPUT FILE')                       CF990130
      TYPE 102                                                          CF990140
      ACCEPT100,FILIN                                                   CF990150
      TYPE 101                                                          CF990160
      ACCEPT 100,FILOU                                                  CF990170
      OPEN(UNIT=5,DEVICE='DSK:',ACCESS='SEQIN',FILE=FILIN)              CF990180
      OPEN(UNIT=6,ACCESS='SEQINOU',FILE=FILOU)                          CF990190
      RETURN                                                            CF990200
      END                                                               CF990210