Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap4_198111 - decus/20-0100/lin10.for
There are no other files named lin10.for in the archive.
C              LINEAR LEAST-SQUARES CURVE FITTING PROGRAM               CF0 0010
C                               1/79                                    CF0 0020
C ***       PROGRAM CURRENTLY DIMENSIONED FOR 35 MAX VARIABLES          CF0 0030
C --- BEFORE TRANSFORMATIONS, 10 VARIABLES AFTER TRANSFORMATIONS,       CF0 0040
C --- 200 OBSERVATIONS,  COMPONENT EFFECTS TABLE = (VARIABLES X         CF0 0050
C --- OBSERVATIONS) = 442, 2 FORMAT CARDS, 2 DELETE OBSERVATIONS        CF0 0060
C --- CARDS AND 2 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 LINCUR-10-257).  PROGRAM  CF0 0181
C     ADAPTED FOR INTERACTIVE USE BY E. R. ZIEGEL AT STANDARD OIL (IND) CF0 0182
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 (HLSUA LIBRARY PROGRAM NUMBER GES-1206).           .    CF0 0212
C                                                                       CF0 0213
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, 2ED EDITION, WILEY 1979.                         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 FACTORIAL SEARCH CARD, 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, IF ANY.                             CF0 0460
C ---12  ADDITIONAL CP FACTORIAL SEARCH AND ESTIMATE OF VARIANCE CARDS, CF0 0470
C ---     IF ANY.                                                       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 ---   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  NUMBER OF VARIABLES IN CP SEARCH IF GREATER THAN 12.    CF0 0930
C ---   45  22  NUMBER OF FORMAT CARDS IF GREATER THAN 1. (2 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  SEARCH FOR CANDIDATE EQUATIONS VIA CP.  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 ---   50  26  NUMBER OF CP FACTORIAL SEARCH CARDS TO BE READ PER      CF0 1090
C ---            IDENTIFING NUMBER OF THE VARIABLES (AFTER TRANSFOR-    CF0 1110
C ---            MATIONS) TO BE USED IN THAT SEARCH, 18(2X,I2) FORMAT.  CF0 1120
C ---            ALL OTHER VARIABLES WILL BE PLACED IN BASIC EQUATION.  CF0 1130
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.  2 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                                                                       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                                                   CF0 1571
C --- B USED IN CF 1-5,12     DIM=(MAX TRANSFORMATIONS+1)+MAX VARIABLES CF0 1580
C --- C USED IN CF 1-4,12     DIM=3*MAX VARIABLES OR 36 MIN.            CF0 1590
C --- D USED IN CF 3,4,9,12   IN CF 4 AVAILABLE FOR REDATA CALCULATIONS CF0 1600
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 3,4,6,9,12 DIM=MAX OBSERVATIONS                      CF0 1640
C --- F USED IN CF 1-5,8,16   DIM=2*MAX TRANSFORMATIONS                 CF0 1650
C --- G USED IN CF 1-4,9,12,  DIM=MAX VAR BEFORE TRANS+144(12CARDSX12A6)CF0 1660
C ---              16                                                   CF0 1661
C --- H USED IN CF 1-4,6,9,   DIM=(MAX VAR+1) + (MAX VAR * MAX VAR) +   CF0 1670
C ---              12 AND 13      (MAX VAR+1 * MAX VAR+1)               CF0 1680
C --- J USED IN CF 3,4,12     DIM=MAX OBSERVATIONS                      CF0 1690
C --- K USED IN CF 1-5,8,9,   DIM=40 CONTROL CARD SWITCHES              CF0 1700
C ---              12,15                                                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 --- S USED IN CF 1,12       DIM=18 OR MXVRAT                          CF0 1710
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                                                       CF0 1751
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,SWEEP                                              CF0 2060
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(10)                                              CF0 2330
      DOUBLE PRECISION IDENT,IEND                                       CF0 2331
      COMMON /CCCCCC/ COM3( 36)                                         CF0 2340
      COMMON /FORFIT/ RMS, YCMAX, YCMIN, INTDUM, K411, NCP              CF0 2350
      COMMON /HHHHHH/ BETA(11), C(10,10), Z(11,11), 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( 21),STDDEV(1))                                 CF0 2410
    1  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
  145 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
      ZMS=RMS/(STDDEV(K)*STDDEV(K)*(NOOBSV-1))                          CF0 2720
      CALL CPMAIN(ZMS)                                                  CF0 2730
 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( 35), DATA( 36), FMT( 36), IOMIT( 35), ITLOC( 35) CF1 0130
C ---                                                                   CF1 0140
      COMMON /AAAAAA/ COM1( 200)                                        CF1 0150
      COMMON /BBBBBB/ COM2( 47)                                         CF1 0160
      COMMON /CCCCCC/ COM3( 36)                                         CF1 0170
      COMMON /DDDDDD/ COM4(1578)                                        CF1 0180
      COMMON /EEEEEE/ LSORT( 200)                                       CF1 0190
      COMMON /FFFFFF/ VARTR( 35), ITRFM( 35)                            CF1 0200
      COMMON /GGGGGG/ BI(35), EQU(144)                                  CF1 0210
      COMMON /HHHHHH/ BETA(11), C(10,10), Z(11,11), 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(14), JIVOS(14), JIV(14), 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(10)                                           CF1 0340
C ---          EQUIVALENCE STATEMENTS IN CF 1, 2 AND 5 (IOMIT ALSO IN 3)CF1 0350
      EQUIVALENCE (COM1(1),AVATR(1)), (COM1( 36),ITLOC(1)),             CF1 0360
     1            (COM1( 71),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 = 35                                                       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 = 200                                                      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 = 2                                                        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 = 2                                                        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 = 2                                                        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 --- MAXSRH = MAX CP SEARCH.  SET IN CPMAIN BY TRAP TO = 18.           CF1 0753
      MAXSRH =  0                                                       CF1 0754
C                                                                       CF1 0750
C ***    DEFINITION OF SCRATCH, INPUT AND OUTPUT FILES                  CF1 0760
C     (FORMATS: KTBIN1-5=VARIABLE BLOCKED, KTIN AND KTOU=FIXED BLOCKED) CF1 0770
C                                                                       CF1 0780
C --- KTBIN1 STORES ENGLISH NAMES OF VARIABLES WHEN IQ(24) = 1          CF1 0790
C ---        AND STORES SIMPLE CORRELATION COEFFICIENTS AND INVERSE     CF1 0800
C ---        MATRIX WHEN IQ(25), IQ(26) OR IQ(27) = 1.                  CF1 0810
      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 1979/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 1979 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, MAXSRH)                CF1 1141
      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
      J1 = 10                                                           CF1 2720
C     IF(IQ(21).GT.12) J1 = IQ(21)                                      CF1 2730
      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,43HVARIABLES ON FIRST CP FACTORIAL SEARCH CARD )       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) / (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(10), AMIN(10), AVATR( 35), AVG(10), B(10),         CF2 0110
     1          DATA( 36), FMT( 36), IOMIT( 35), ITLOC( 35),            CF2 0120
     2          SIGMA(10), STDDEV(10), W1(10)                           CF2 0130
C                                                                       CF2 0140
      COMMON /AAAAAA/ COM1( 200)                                        CF2 0150
      COMMON /BBBBBB/ COM2( 47)                                         CF2 0160
      COMMON /CCCCCC/ COM3( 36)                                         CF2 0170
      COMMON /FFFFFF/ VARTR( 35), ITRFM( 35)                            CF2 0180
      COMMON /FORFIT/ RMS, YCMAX, YCMIN, INTDUM, K411, NCP              CF2 0190
      COMMON /GGGGGG/ BI(35), EQU(144)                                  CF2 0200
      COMMON /HHHHHH/ BETA(11), C(10,10), Z(11,11), 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(14), JIVOS(14), JIV(14), 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, KKK, KONE, KTWO, MNO, NFILE    CF2 0320
      COMMON /RRRRRR/ KTBIN1, KTBIN2, KTBIN3, KTBIN4, KTBIN5            CF2 0330
C ---          EQUIVALENCE STATEMENTS IN CF 1, 2 AND 5 (IOMIT ALSO IN 3)CF2 0340
      EQUIVALENCE (COM1(1),AVATR(1)), (COM1( 36),ITLOC(1)),             CF2 0350
     1            (COM1( 71),IOMIT(1))                                  CF2 0360
C ---          EQUIVALENCE STATEMENTS IN CF 1 AND 2                     CF2 0370
      EQUIVALENCE (COM2(1),DATA(1)), (COM2( 37),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(11),AMIN(1)),                CF2 0410
     1        (COM1( 21),W1(1))                                         CF2 0420
      EQUIVALENCE (COM3(1),AVG(1)), (COM3(11),SIGMA(1)),                CF2 0430
     1            (COM3( 21),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
   71 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
  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
  280 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,290                                            CF2 3820
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
C          PUNCH RESIDUALS IF CONFIDENCE INTERVAL DATA NEEDED + BZERO   CF2 4170
C            NOT EQUAL TO 0.                                            CF2 4180
      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
  335 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
  354 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( 200)                                       CF3 0090
      REAL*4 DE(NBSV,ISIZE), STDRES( 200)                               CF3 0091
      DIMENSION AMAX(10), AMIN(10), AVG(10), B(10), D(10),              CF3 0100
     1          DELSD( 200), DELTA( 200), DELYN( 200), IDRS1( 200),     CF3 0110
     2          IDRS2( 200), IOMIT( 35), JSORT( 200), RELINF(10),       CF3 0120
     3          SIGMA(10), STDDEV(10), TVALUE(10), VAR(10), W1(10),     CF3 0130
     4          XXIN( 200), YRESID(10), YYCC( 200), YYIN( 200)          CF3 0140
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( 200)                                        CF3 0170
      COMMON /BBBBBB/ COM2( 47)                                         CF3 0180
      COMMON /CCCCCC/ COM3( 36)                                         CF3 0190
      COMMON /DDDDDD/ COM4(1578)                                        CF3 0200
      COMMON /EEEEEE/ LSORT( 200)                                       CF3 0210
      COMMON /FFFFFF/ VARTR( 35), ITRFM( 35)                            CF3 0220
      COMMON /FORFIT/ RMS, YCMAX, YCMIN, INTDUM, K411, NCP              CF3 0230
      COMMON /GGGGGG/ BI(35), EQU(144)                                  CF3 0240
      COMMON /HHHHHH/ BETA(11), C(10,10), Z(11,11), NNNN, MXSIZE        CF3 0250
      COMMON /JJJJJJ/ IDZB( 200)                                        CF3 0260
      COMMON /KKKKKK/ IQ(40), PR1, PR2, PR3, K, KFM, NODEP, NOIND,      CF3 0270
     1                NOOBSV, ICURY                                     CF3 0280
      COMMON /LLLLLL/ XEFMT, JOMIT(14), JIVOS(14), JIV(14), 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(11),AMIN(1)),                CF3 0370
     1            (COM1( 21),W1(1)), (COM1( 31),D(1)),                  CF3 0380
     2            (COM1( 71),IOMIT(1))                                  CF3 0381
      EQUIVALENCE (COM3(1),AVG(1)), (COM3(11),SIGMA(1)),                CF3 0390
     1            (COM3( 21),STDDEV(1))                                 CF3 0400
C ---          EQUIVALENCE STATEMENTS IN CF 3 ALONE                     CF3 0410
      EQUIVALENCE (BETA(1),TVALUE(1)), (COM1( 66),RELINF(1))            CF3 0420
      EQUIVALENCE (COM2(1),YRESID(1)), (COM2(1),VAR(1)),                CF3 0430
     1            (COM2( 37),B(1)),      (COM4( 601),STDRES(1))         CF3 0440
      EQUIVALENCE (COM4( 601),JSORT(1)), (COM4( 201),XXIN(1)),          CF3 0450
     1            (COM4( 201),IDZA(1)),  (COM4( 401),YYIN(1)),          CF3 0460
     2            (COM4( 201),DELYN(1)), (COM4( 401),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/1HE/                                                  CF3 0510
C1020 FORMAT(5Z16)                                                      CF3 0520
      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)) 404, 404, 405                                        CF3 1210
  404 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
  407 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 = 0.0                                                        CF3 1420
      K411 = 0                                                          CF3 1430
      BZERO =0.0                                                        CF3 1440
      SUMB  =0.0                                                        CF3 1450
      REWIND KTBIN3                                                     CF3 1460
      YYMIN = 1E32                                                      CF3 1470
      YCMIN =1E32                                                       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) = 0.0                                                     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((1.0 - RSQD)/DEFR)                                 CF3 2080
C          CALCULATE STATISTICS + LIST FOR EACH IND. VARIABLE           CF3 2090
      IF(IQ(5).EQ.1) GO TO 521                                          CF3 2100
  520 WRITE(KTOU,3012) BZERO                                            CF3 2110
      TYPE 3012, BZERO                                                  CF3 2111
C --- ***NORMAL FORMAT                                                  CF3 2120
C3012 FORMAT(1H ,5X,1H0,13X,1PE12.5)                                    CF3 2130
C --- ***FORMAT USED TO CHECK PRECISION OF CALCULATIONS                 CF3 2140
C3012 FORMAT(1H ,5X,1H0,12X,1PD18.11)                                   CF3 2150
C --- ***                                                               CF3 2160
 3012 FORMAT(1H ,5X,1H0,13X,1PE12.5)                                    CF3 2170
      GO TO 523                                                         CF3 2180
  521 WRITE(KTOU,522)                                                   CF3 2190
      TYPE 522                                                          CF3 2191
  522 FORMAT(1H ,5X,1H0,14X,8HB(0) = 0 )                                CF3 2200
  523 DO 425 I=1, NOIND                                                 CF3 2210
C          CALCULATE STANDARD DEV. OF BETA                              CF3 2220
      SGBETA = DSQRT(C(I,I)) * FACTOR                                   CF3 2230
C          CALCULATE T-VALUE AND PLACE IN BETA FOR USE IN CPMAIN.       CF3 2240
      TVALUE(I) = DABS(BETA(I)/SGBETA)                                  CF3 2250
C          CALCULATE SIGMA B                                            CF3 2260
      SIGB  =SGBETA*SIGMA(K)/SIGMA(I)                                   CF3 2270
      RELINF(I) = DABS(B(I)*W1(I)/W1(K))                                CF3 2280
      RISQRD = 1. - (1./C(I,I) )                                        CF3 2290
C          WRITE THESE VALUES                                           CF3 2300
      WRITE(KTOU,950) I, BI(I), B(I), SIGB, TVALUE(I), RISQRD, AMIN(I), CF3 2310
     1 AMAX(I), W1(I), RELINF(I)                                        CF3 2320
      TYPE 950,I,BI(I),B(I),SIGB,TVALUE(I),RISQRD,AMIN(I),AMAX(I),W1(I),CF3 2321
     1         RELINF(I)                                                CF3 2322
C --- ***NORMAL FORMAT                                                  CF3 2330
C 950 FORMAT(1H ,4X,I2,5X,A6,   2X,1PE12.5, 5X,1PE9.2,4X,0PF5.1,5X,     CF3 2340
C --- ***FORMAT USED TO CHECK PRECISION OF CALCULATIONS                 CF3 2350
C 950 FORMAT(1H ,4X,I2,5X,A6, 1X,  1PE18.11,   1PE9.2,4X,0PF5.1,5X,     CF3 2360
C --- ***                                                               CF3 2370
  950 FORMAT(1H ,4X,I2,5X,A6,   2X,1PE12.5, 5X,1PE9.2,4X,0PF5.1,5X,     CF3 2380
     1F7.4,1PE14.3,1PE15.3,5X,1PE10.3,4X,0PF6.2 )                       CF3 2390
      D(I) = SIGB*SIGB                                                  CF3 2391
  425 SUMB=SUMB+(B(I)*YRESID(I))                                        CF3 2400
C          CHECK FOR SPILLS                                             CF3 2410
C          PERFORM F RATIO TEST ON OVERALL REGRESSION                   CF3 2420
      FRATIO =RSQD*DEFR/(XNOIND*(1.0-RSQD))                             CF3 2430
C          CALCULATE TOTAL SUM OF SQUARES, SSYT                         CF3 2440
      SSYT=SIGMA(K)*SIGMA(K)                                            CF3 2450
C          CALCULATE RESIDUAL SUM OF SQUARES, RSS                       CF3 2460
      RSS   = SSYT - SUMB                                               CF3 2470
C          CALCULATE RESIDUAL MEAN SQUARE, RMS                          CF3 2480
      RMS = RSS/DEFR                                                    CF3 2490
C          CALCULATE RESIDUAL ROOT MEAN SQUARE, RRMS                    CF3 2500
      RRMS = DSQRT(RMS)                                                 CF3 2510
C          LIST THE STATISTICS COMPUTED                                 CF3 2520
      IF(IQ(5).EQ.0) GO TO 421                                          CF3 2530
C ---      REDEFINE RSQD IF B0 = ZERO                                   CF3 2540
      FACTOR = AVG(K)*AVG(K)*WNOBS                                      CF3 2550
      SSYT = SSYT - FACTOR                                              CF3 2560
      SUMB = SUMB - FACTOR                                              CF3 2570
      RSQD = SUMB/SSYT                                                  CF3 2580
  421 XNOBS = DFLOAT(NOOBSV)                                            CF3 2590
      XNOIND= DFLOAT(NOIND)                                             CF3 2591
      WRITE(KTOU,3014) NOOBSV                                           CF3 2592
      TYPE 3014, NOOBSV                                                 CF3 2593
 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(IQ(5).EQ.1) 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
      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
      WRITE(KTOU,3030) RSQD                                             CF3 2770
 3030 FORMAT(1H ,27HMULT. CORREL. COEF. SQUARED,8X,F5.4)                CF3 2780
C     ADJRSQ = 1.-(RMS/(SSYT/DFLOAT(NOOBSV-1)))                         CF3 2781
C     WRITE(KTOU,3031) ADJRSQ                                           CF3 2782
C3031 FORMAT(' ADJ. MULT. CORR. COEF. SQUARED',5X,F5.4)                 CF3 2783
  999 FORMAT(//52H0 *** PRINT OUTPUT FILE FOR COMPLETE INFORMATION ***/)CF3 2785
      TYPE 999                                                          CF3 2786
      PAR = XNOBS - DEFR                                                CF3 2787
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(IQ(5).EQ.1) BZERO = 0.0                                        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,3012) 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 = 0.0                                                         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 = 1.0                                                          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.0.) D(I)=1.0E-10                                       CF3 3152
      DNP = DLOG10(D(I))                                                CF3 3153
      IF(DNP.LE.0.) GO TO 876                                           CF3 3154
      DNP = DNP/2.                                                      CF3 3155
      GO TO 878                                                         CF3 3156
  876 DNP = (DNP/2.) - 1.                                               CF3 3157
  878 NP  = DNP + DSIGN(.5D0,DNP)                                       CF3 3158
      IF(NP.EQ.0) NP= 1                                                 CF3 3159
      IF(AMAX(I).EQ.1.0.AND.W1(I).EQ.1.0) NP = -1                       CF3 3160
      IF(W1(I).EQ.0.0) 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.2*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)                             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
      JB = NTP - IA                                                     CF3 3610
      JA = LSORT(JB)                                                    CF3 3620
      DO 10 I = 1, NOIND                                                CF3 3621
      JC = JSORT(I)                                                     CF3 3622
   10 XXIN(I) = DE(JA,JC)                                               CF3 3623
   12 WRITE(KTOU,13) IA, IDZB(JA), ( XXIN(I), I=1,NOIND)                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 = 0.0                                                         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 = 0.0                                                      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 4310
C ---      SQUARE C AND Z MATRIX.                                       CF3 4320
      NOVM1 = NOVAR - 1                                                 CF3 4330
      DO 26  I = 1, NOVM1                                               CF3 4340
      IPL1 = I + 1                                                      CF3 4350
      DO 26 J = IPL1, NOVAR                                             CF3 4360
      C(J,I)= C(I,J)                                                    CF3 4361
   26 Z(J,I)= Z(I,J)                                                    CF3 4370
C          CALCULATE FITTED Y AND LIST WITH RESIDUALS                   CF3 4380
C          INITIALIZE B ZERO WITH ZERO IF YCALC HAS BZERO = 0           CF3 4390
  426 IF(IQ(5)) 428,428,427                                             CF3 4400
  427 BZERO = 0.0                                                       CF3 4410
  428 IF(IQ(9).NE.1) GO TO 438                                          CF3 4411
C        HEXADECIMAL PUNCHOUT FOR CONFIDENCE INTERVAL PROGRAM***********CF3 4412
C     WRITE(KTPCH,1020)RMS,BZERO,(B(JZ),JZ=1,KNOIND)                    CF3 4420
  438 JBACK = 1                                                         CF3 4421
      IF(IQ(8).EQ.1) GO TO 430                                          CF3 4422
      JBACK = 0                                                         CF3 4423
C *****NOTE IF FUNCTION TABLE IS DESIRED AT ALL TIMES, PUT A C IN COL 1 CF3 4424
C *****OF IF(NTABLE---) GO TO 429, 475 AND 6903 SWITCH CARDS.********** CF3 4425
      IF(NTABLE.LT.1) GO TO 429                                         CF3 4426
      WRITE(KTOU,5102)                                                  CF3 4427
      WRITE(KTOU,5104) PR1,PR2,PR3,ICURY,BI(K)                          CF3 4428
      WRITE(KTOU,5108)                                                  CF3 4429
 5108 FORMAT(1H0,46HFUNCTIONS RELATED TO THE VARIANCE OF FITTED Y.,     CF3 4430
     1 41H  OBSERVATIONS ORDERED BY COMPUTER INPUT.)                    CF3 4431
      WRITE(KTOU,5110)                                                  CF3 4432
 5110 FORMAT(1H0,26X,11HSTUDENTIZED,32X,13HDELETE-EFFECT,/1X,6HIDENT.,  CF3 4433
     1 7H  OBSV.,4X,41HRESIDUAL  RESIDUAL   V(Y)/RMS  V(R)/RMS  ,       CF3 4434
     2 25HV(Y)/V(R)  VALUE  PERCENT )                                   CF3 4435
  429 IF(NEWOBS.EQ.2) DELETE = 0.0                                      CF3 4440
      INTER = 1                                                         CF3 4441
      IF(IQ(5).EQ.1) INTER = 0                                          CF3 4442
  430 PAR = XNOBS - DEFR                                                CF3 4443
      IF(NEWOBS.NE.2) GO TO 439                                         CF3 4444
      RRMS = VRRMS                                                      CF3 4445
      WNOBS = VNOBS                                                     CF3 4446
      PAR = VPAR                                                        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 = 0.                                                        CF3 4453
      READ(KTBIN3) IDZA(IB),IDZB(IB), (VAR(JZ), JZ = 1,NOVAR), WEIGHT   CF3 4460
      YCALC = BZERO                                                     CF3 4470
      DO 440 J=1, NOIND                                                 CF3 4480
  440 YCALC = YCALC + B(J) * VAR(J)                                     CF3 4490
C          INITIALIZE BACK-TRANSFORMATION ROUTINE                       CF3 4500
      IF(JBACK ) 470,470,445                                            CF3 4510
  445 CALL YBACK(K,YCALC)                                               CF3 4520
      CALL YBACK(K,VAR(K) )                                             CF3 4530
      STDRES(IB) = 0.0                                                  CF3 4531
  470 DIFF  = VAR(K)- YCALC                                             CF3 4540
      DELTA(IB) = DIFF                                                  CF3 4550
      YYIN(IB)  = VAR(K)                                                CF3 4560
      YYCC(IB)  = YCALC                                                 CF3 4570
      CALL MINMAX(YCMIN, YCMAX, YCALC )                                 CF3 4580
      RSS = RSS + (DIFF * DIFF)                                         CF3 4581
      IF(JBACK.EQ.1) GO TO 475                                          CF3 4590
C --- COMPUTATION FOR THE COVARIANCE CONTRIBUTION TO THE STANDARD ERROR CF3 4591
C --- OF THE PREDICTED Y (COVTY) AND THE RESIDUAL (COVTR).              CF3 4592
C ---                                                                   CF3 4593
      DO 444 J=1,NOIND                                                  CF3 4594
      DO 442 I=1,NOIND                                                  CF3 4595
C ---    NOTE : : :  C MATRIX CONTAINS (X'X) INVERSE                    CF3 4596
C --- COVTY IS THE COVARIANCE CONTRIBUTION TO                           CF3 4597
C --- THE STANDARD ERROR OF PREDICTED Y.                                CF3 4598
C ---    COVTR = 1. - COVTY, FOR NEW Y OBS. COVTR = 1. + COVTY.         CF3 4599
      COVTY=COVTY +                                                     CF3 4600
     1((VAR(J)-AVG(J))*(VAR(I)-AVG(I))*C(I,J)/(SIGMA(I)*SIGMA(J)))      CF3 4601
  442 CONTINUE                                                          CF3 4602
  444 CONTINUE                                                          CF3 4603
C --- ADD 1/SUM OF WEIGHTED OBSERVATIONS. IF NOT WEIGHTED L.S., WNOBS=N.CF3 4604
      COVTY=COVTY+(1.D0 / WNOBS)                                        CF3 4605
C ---                                                                   CF3 4606
C --- COVTY IS TERM REQUIRED FOR TOLERENCE INTERVAL CALCULATIONS,       CF3 4607
C ---    I.E.  COVAR TERM FOR PREDICTED Y.                              CF3 4608
      COVTR = (1.D0 / WEIGHT) - COVTY                                   CF3 4609
      IF(NEWOBS.EQ.2) COVTR = (1.D0 / WEIGHT) + COVTY                   CF3 4610
      IF(DABS(DELTA(IB)).LT.1.0D-06) DELTA(IB) = 0.0D0                  CF3 4620
C --- STDRES = STANDARDIZED RESIDUAL                                    CF3 4621
      STDRES(IB) = DELTA(IB)/(DSQRT(DABS(COVTR))*RRMS)                  CF3 4622
      IF(NTABLE.LT.1) GO TO 475                                         CF3 4623
C --- CALCULATE DELETE EFFECT, SEE COOK, TECHNOMETRICS, FEB. 1977.      CF3 4624
      VRATIO = COVTY/COVTR                                              CF3 4625
      IF(NEWOBS.EQ.2) GO TO 451                                         CF3 4626
      DELETE = STDRES(IB)*STDRES(IB)*VRATIO/PAR                         CF3 4627
C --- UNLESS FVALUE(DELETE) GT DEMIN, DO NOT CALCULATE % PROBILITY.     CF3 4628
      IF(DELETE.LT.DEMIN) GO TO 451                                     CF3 4629
      CALL FALPHA(PAR,DEFR,DELETE,PERCNT)                               CF3 4630
  450 WRITE(KTOU,5112) IDZA(IB),IDZB(IB),DELTA(IB),STDRES(IB),COVTY,    CF3 4640
     1 COVTR,VRATIO,DELETE,PERCNT                                       CF3 4641
 5112 FORMAT(1H ,A6,I6,F13.3,3X,F5.1,5X,F7.4,3X,F7.4,4X,F5.1,5X,F5.1,   CF3 4642
     1 3X, F4.0 )                                                       CF3 4643
      GO TO 475                                                         CF3 4644
  451 WRITE(KTOU,5112) IDZA(IB),IDZB(IB),DELTA(IB),STDRES(IB),COVTY,    CF3 4645
     1 COVTR,VRATIO,DELETE                                              CF3 4646
  475 CONTINUE                                                          CF3 4647
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 SQUARED STANDARDIZED DISTANCE OF EACH OBSERVATION  CF3 4830
C---       FROM CENTROID OF ALL OBSERVATIONS OF INDEPENDENT VARIABLES.  CF3 4840
      DO 1220 IC = 1, NOOBSV                                            CF3 4850
      SSD = 0.                                                          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
 2032 CONTINUE                                                          CF3 4950
      WRITE(KTOU,1219) IDZA(IC),IDZB(IC),SSD,YYIN(IC),YYCC(IC),         CF3 4960
     1DELTA(IC),IDZB(JC),YYIN(JC),YYCC(JC),DELTA(JC),STDRES(JC),IC      CF3 4970
 1219 FORMAT(1H ,A6,   I6,2X,F6.0,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),STDRES(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),STDRES(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)=0                                          CF3 5271
      IF(IQPLOT.EQ.7) IQ(18)=2                                          CF3 5272
      IF(IQPLOT.EQ.8) IQ(18)=3                                          CF3 5273
      IF(IQPLOT.EQ.9) IQ(18)=4                                          CF3 5274
      DO 1252 IC = 1, NOOBSV                                            CF3 5275
 1252 DELTA(IC) = DBLE(STDRES(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( 35), DATA( 36), FMT( 36), IOMIT( 35), ITLOC( 35) CF4 0240
      COMMON /AAAAAA/ COM1( 200)                                        CF4 0250
      COMMON /BBBBBB/ COM2( 47)                                         CF4 0260
      COMMON /CCCCCC/ COM3( 36)                                         CF4 0270
      COMMON /DDDDDD/ COM4(1578)                                        CF4 0280
      COMMON /EEEEEE/ LSORT( 200)                                       CF4 0290
      COMMON /FFFFFF/ VARTR( 35), ITRFM( 35)                            CF4 0300
      COMMON /GGGGGG/ BI(35), EQU(144)                                  CF4 0310
      COMMON /HHHHHH/ BETA(11), C(10,10), Z(11,11), NNNN, MXSIZE        CF4 0320
      COMMON /JJJJJJ/ IDZB( 200)                                        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( 36),ITLOC(1)),             CF4 0430
     1            (COM1( 71),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( 35), DATA( 36), IOMIT( 35), ITLOC( 35)           CF5 0060
      COMMON /AAAAAA/ COM1( 200)                                        CF5 0070
      COMMON /BBBBBB/ COM2( 47)                                         CF5 0080
      COMMON /FFFFFF/ VARTR( 35), ITRFM( 35)                            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( 36),ITLOC(1)),             CF5 0140
     1            (COM1( 71),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) .NE. 0) 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) .NE. 0) 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(10), LP(10)                                           CF6 0180
      COMMON /EEEEEE/ LSORT( 200)                                       CF6 0190
      COMMON /HHHHHH/ BETA(11), A(10,10), Z(11,11), 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( 21),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 0430
  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 0300
      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
    6 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( 35), ITRFM( 35)                            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(10), AMIN(10), B(10), COMPR( 200), DELTA( 200),    CF9 0090
     1          RESID(9),    X(NBSV,ISIZE), YYCC( 200), ICOMP(9),       CF9 0100
     2          NEG(8), POS(8), PRAX(51), IAND(3), ICPR(24)             CF9 0110
      COMMON /AAAAAA/ COM1( 200)                                        CF9 0120
      COMMON /BBBBBB/ COM2( 47)                                         CF9 0130
      COMMON /DDDDDD/ COM4(1578)                                        CF9 0140
      COMMON /EEEEEE/ LSORT( 200)                                       CF9 0150
      COMMON /GGGGGG/ BI(10), EQU(144)                                  CF9 0160
      COMMON /HHHHHH/ BETA(11), C(10,10), Z(11,11), 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
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( 201),GRIDA(1)),(COM4( 890),GRIDB(1))           CF9 0280
      EQUIVALENCE (COM2(1),AMAX(1)), (COM2( 37),B(1)),                  CF9 0290
     1            (COM2(  11),AMIN(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
    1 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
   80 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(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
  212 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 --- MAXNPR MAXIMUM NUMBER OF SORTED CP VALUES PRINTED.                CF120470
C --- MAXSRH TRAP FOR MAXIMUM NUMBER OF VARIABLES TO BE SEARCHED.       CF120480
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
      REAL*4 GRIDA(53,26), GRIDB(53,26)                                 CF120800
      INTEGER NVALP(21)                                                 CF121070
      DIMENSION NCP1(53)                                                CF120801
      DIMENSION AVAR(10), CP( 200), INOUT(10), IP( 200), IS(40),        CF120810
     1          IVAR(10), IVGT(10), IVLT(10), TVALUE(10)                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( 200)                                        CF120850
      COMMON /BBBBBB/ COM2( 47)                                         CF120860
      COMMON /CCCCCC/ COM3( 36)                                         CF120870
      COMMON /DDDDDD/ COM4(1578)                                        CF120880
      COMMON /EEEEEE/ LSORT( 200)                                       CF120890
      COMMON /FORFIT/ RMS, YCMAX, YCMIN, INTDUM, K411, NCP              CF120900
      COMMON /GGGGGG/ BI(35), EQU(144)                                  CF120910
      COMMON /HHHHHH/ BETA(11), C(10,10), Z(11,11), NNNN, MXSIZE        CF120920
      COMMON /JJJJJJ/ IDZB( 200)                                        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, KKK, KONE, KTWO, MNO, NFILE    CF120980
      COMMON /RRRRRR/ KTBIN1, KTBIN2, KTBIN3, KTBIN4, KTBIN5            CF120990
      COMMON /SSSSSS/ ICP(10)                                           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(11),IVLT(1)), (COM3( 21),IVGT(1)),      CF121030
     2 (COM3( 31),IVAR(1)), (BETA(1),TVALUE(1)),  (IDZB(1),IP(1))       CF121040
      EQUIVALENCE  (COM4( 201),GRIDA(1)),(COM4( 890),GRIDB(1))          CF121050
      DATA NCP1/26*4H    ,4HCP  ,26*4H    /                             CF121060
      DATA IPLUS/4H++++/                                                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    =  10                                                      CF121220
      LCP    = 100                                                      CF121230
      MAXNPR = 100                                                      CF121240
C --- MAXSRH 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 MAXSRH LIMITS.                 CF121270
      MAXSRH =  10                                                      CF121280
C     IF(IQ(21).GT.12.AND.IQ(21).LT.19) 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
      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(IQ(5).EQ.1) GO TO 3                                            CF121590
    2 MP = 1                                                            CF121600
    3 NP = NOOBSV - 2*MP                                                CF121610
      IPMAX = MP + NOIND                                                CF121620
      CPMAX = DFLOAT(IPMAX) + .005                                      CF121630
  300 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
   10 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
      READ(KTIN,9988) (ICP(I), I=1,MAXSRH )                             CF122170
      GO TO 102                                                         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
      DO 103 J = 1, IC                                                  CF122260
      IF(ICP(J).EQ.0) GO TO 104                                         CF122270
      IVLT(J) = ICP(J)                                                  CF122280
  103 NLT = NLT + 1                                                     CF122290
  104 WRITE(KTOU,1004)                                                  CF122300
 1004 FORMAT(1H , 29HVARIABLES IN FACTORIAL SEARCH )                    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,1016) ( ICP(J),J=KONE,KTWO)                            CF122420
      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
      WRITE(KTOU,1006) NOOBSV, NOIND, NGT, NLT                          CF122670
 1006 FORMAT(1H0//1X,22HNUMBER OF OBSERVATIONS,    18X, I4/             CF122680
     137H NUMBER OF VARIABLES IN FULL EQUATION,    5X, I3/              CF122690
     238H NUMBER OF VARIABLES IN BASIC EQUATION,   4X, I3/              CF122700
     338H REMAINDER OF VARIABLES TO BE SEARCHED,   4X, I3// )           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
      WRITE(KTOU,1008)                                                  CF122740
 1008 FORMAT(1H0, 42HEQUATION  P   CP    VARIABLES IN EQUATION )        CF122750
      WRITE(KTOU,1009) IPMAX, CPMAX                                     CF122760
 1009 FORMAT(1H0,8X,I3,1X,F5.1,2X,13HFULL EQUATION )                    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, 19X, 25HNO BASIC SET OF VARIABLES )                   CF122810
      GO TO 40                                                          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 - 10) 22, 22, 24                                           CF122960
   22 MNO = NGT                                                         CF122970
      GO TO 25                                                          CF122980
   24 MNO = 10                                                          CF122990
   25 IF(CP(1).GT.CPMAX) GO TO 26                                       CF123000
      WRITE(KTOU,1010) L, IP(L), CP(L), (IVGT(I),I=1,MNO)               CF123010
 1010 FORMAT(1H0,4X,I3,1X,I3,1X,F5.1,2X,22HBASIC SET OF VARIABLES,      CF123020
     1  10(2X,I6)   )                                                   CF123030
      GO TO 27                                                          CF123040
   26 WRITE(KTOU,1012) IP(L), CP(L), (IVGT(I),I=1,MNO)                  CF123050
 1012 FORMAT(1H0,8X,I3,1X,F5.1,2X,22HBASIC SET OF VARIABLES,10(2X,I6))  CF123060
      L = 0                                                             CF123070
   27 WRITE(KTOU,1014)(AVAR(I),I=1, MNO)                                CF123080
 1014 FORMAT(1H ,41X, 12(2X,A6) )                                       CF123090
      KKK = 10                                                          CF123100
   28 IF(NGT - KKK) 38, 38, 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,17X, 13(2X,I6) )                                       CF123180
      WRITE(KTOU,1018) (AVAR(I), I=KONE,KTWO)                           CF123190
 1018 FORMAT(1H ,17X, 13(2X,A6) )                                       CF123200
      KKK = KKK + 12                                                    CF123210
      GO TO 28                                                          CF123220
   38 DF   = NF - IP(1)                                                 CF123230
      RMSL = (CP(1) + DF - IP(1) )*RMS/DF                               CF123240
      WRITE(KTOU,1011) RMSL                                             CF123250
 1011 FORMAT(20X, 5HRMS =, F11.5)                                       CF123260
      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
 4001 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
   66 L = L + 1                                                         CF124310
C --- STOP WRITING EQUATIONS IF L BECOMES LARGER THAN DIMENSIONS OF CP  CF124320
  152 IF(L.GT.MAXCIP) GO TO 156                                         CF124330
      CP(L) = CCP                                                       CF124340
C --- DETERMINE WHICH VARIABLES ARE IN EQUATION L.                      CF124350
      IN = 0                                                            CF124360
      DO 70 I = 1, NLT                                                  CF124370
      IF(INOUT(I).EQ.0) GO TO 70                                        CF124380
      IN = IN + 1                                                       CF124390
      JC = IVLT(I)                                                      CF124400
      IVAR(IN) = JC                                                     CF124410
      AVAR(IN) = BI(JC)                                                 CF124420
   70 CONTINUE                                                          CF124430
      IP(L) = MP                                                        CF124440
      IF (IN - 12) 72, 72, 74                                           CF124450
   72 MNO = IN                                                          CF124460
      GO TO 76                                                          CF124470
   74 MNO = 12                                                          CF124480
   76 WRITE(KTOU,1020) L, IP(L), CP(L), (IVAR(I),I=1,MNO)               CF124490
 1020 FORMAT(1H0,3X,2I4,1X,F5.1,2X,14HBASIC SET PLUS,12(2X,I6))         CF124500
      WRITE(KTOU, 1022) (AVAR(I),I=1,MNO)                               CF124510
 1022 FORMAT(1H ,33X, 12(2X,A6) )                                       CF124520
      KKK = 12                                                          CF124530
   78 IF(IN - KKK)  90,  90, 80                                         CF124540
   80 KONE = KKK + 1                                                    CF124550
      IF( IN - (KKK+12)) 84, 84, 82                                     CF124560
   82 KTWO = KKK + 12                                                   CF124570
      GO TO 86                                                          CF124580
   84 KTWO = IN                                                         CF124590
   86 WRITE(KTOU,1016) (IVAR(I), I=KONE,KTWO)                           CF124600
      WRITE(KTOU,1018) (AVAR(I), I=KONE,KTWO)                           CF124610
   90 DF   = NF - IP(L)                                                 CF124620
      RMSL = (CP(L) + NP)*RMS/DF                                        CF124630
      WRITE(KTOU,1011) RMSL                                             CF124640
      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 WRITE(KTOU,200)                                                   CF125000
  200 FORMAT(1H1, 20HESTIMATE OF VARIANCE )                             CF125010
      FSW = (RMSE - RMS) / RMS                                          CF125020
      IF(DABS(FSW).LE.1.D-8) GO TO 204                                  CF125030
      FSW = 1.0                                                         CF125040
      WRITE(KTOU,202) RMS, LE, RMSE                                     CF125050
  202 FORMAT(1H0, 20HRMS OF FULL EQUATION, 6X, F16.8 /                  CF125060
     1        1X, 22HRMS OF SUBSET EQUATION, I4, F16.8 )                CF125070
      GO TO 207                                                         CF125080
  204 FSW = 0.0                                                         CF125090
      WRITE(KTOU,206)                                                   CF125100
  206 FORMAT(1H0,46HNO SMALLER RMS VALUE FOUND IN SUBSET EQUATIONS)     CF125110
  207 IF(IQ(25) - 2) 208, 212, 216                                      CF125120
  208 WRITE(KTOU,210)                                                   CF125130
  210 FORMAT(1H0,50HRMS OF FULL EQUATION SELECTED BY USER TO CALCULATE, CF125140
     110H CP VALUES )                                                   CF125150
      GO TO 236                                                         CF125160
  212 IF(FSW.EQ.0.) GO TO 232                                           CF125170
      WRITE(KTOU,214)                                                   CF125180
  214 FORMAT(1H0,62HRMS OF SUBSET EQUATION USED TO RECALCULATE AND PLOT CF125190
     1CP VALUES. )                                                      CF125200
      GO TO 222                                                         CF125210
  216 READ(KTIN,218) RMSE                                               CF125220
  218 FORMAT(F16.8)                                                     CF125230
      WRITE(KTOU,220) RMSE                                              CF125240
  220 FORMAT(1H ,20HRMS PROVIDED BY USER, 6X, F16.8 // 1X,              CF125250
     1 58HESTIMATED VARIANCE USED TO RECALCULATE AND PLOT CP VALUES. )  CF125260
  222 RMSR = RMS/RMSE                                                   CF125270
      DP    = NF - 2*IPMAX                                              CF125280
      CPFULL = (CPMAX - .005 + DP)*RMSR - DP                            CF125290
      WRITE(KTOU,224) IPMAX, CPFULL                                     CF125300
  224 FORMAT(1H0,22X,6HP   CP/1X,13HFULL EQUATION,6X,I4,1X,F5.1)        CF125310
      IF(FSW.EQ.0.) GO TO 228                                           CF125320
      DP    = NF - 2*IP(LE)                                             CF125330
      CPFULL = (CP(LE) + DP)*RMSR - DP                                  CF125340
      WRITE(KTOU,226) LE, IP(LE), CPFULL                                CF125350
  226 FORMAT(1H , 15HSUBSET EQUATION, 2I4, 1X, F5.1)                    CF125360
  228 DO 230 J = 1, L                                                   CF125370
      DP    = NF - 2*IP(J)                                              CF125380
  230 CP(J) = (CP(J) + DP)*RMSR - DP                                    CF125390
      GO TO 236                                                         CF125400
  232 WRITE (KTOU,234)                                                  CF125410
  234 FORMAT(1H0,49HRMS OF FULL EQUATION USED TO CALCULATE CP VALUES.)  CF125420
  236 IF(L.EQ.1) GO TO 1034                                             CF125430
C --- ORDER EQUATIONS BY THEIR CP VALUES.                               CF125440
      CALL SORT (L, CP, LSORT)                                          CF125450
      WRITE(KTOU,238)                                                   CF125460
  238 FORMAT(1H0// 30H  SEQ  EQUATION  P  ORDERED CP  )                 CF125470
      IA = MAXNPR                                                       CF125480
      IF(L.LT.IA) IA = L                                                CF125490
      DO 240 IC = 1, IA                                                 CF125500
      JC = LSORT(IC)                                                    CF125510
  240 WRITE(KTOU,242) IC, JC, IP(JC), CP(JC)                            CF125520
  242 FORMAT(1H , I4, 4X, I4, 1X, I4, F9.1 )                            CF125530
      ILESS = 0                                                         CF125540
      IF(IPMAX.GT.17.AND.IPMAX.LT.28) ILESS = 10                        CF125550
      IF(IPMAX.GT.27.AND.IPMAX.LT.38) ILESS = 20                        CF125560
      IF(IPMAX.GT.37.AND.IPMAX.LT.48) ILESS = 30                        CF125570
      IF(IPMAX.GT.47.AND.IPMAX.LT.58) ILESS = 40                        CF125580
      IF(IPMAX.GT.57.AND.IPMAX.LT.68) ILESS = 50                        CF125590
      IF(IPMAX.GT.67)           ILESS = 60                              CF125600
      CLESS  = DFLOAT(ILESS)                                            CF125610
      L1 = 99                                                           CF125620
      ILEVEL = ILESS - 1                                                CF125630
      DO 1040 JZ=1,21                                                   CF125640
 1040 NVALP(JZ) = ILEVEL + JZ                                           CF125650
      ITYPE = 2                                                         CF125660
      CALL GRID(GRIDA,GRIDB,L1,ITYPE)                                   CF125670
      YTOP = 5.2D01/3.D0                                                CF125680
      YIW  = 1.D0/3.D0                                                  CF125690
      DO 118 IC = 1, L                                                  CF125700
      JC = LSORT(IC)                                                    CF125710
      IP(JC) = IP(JC) - ILESS                                           CF125720
      IF(IP(JC).LT.1) GO TO 118                                         CF125730
      CP(JC) = CP(JC) - CLESS                                           CF125740
      CPTOP  = YTOP - CP(JC)                                            CF125750
C --- TRAP TO KEEP PLOT FROM GOING OUTSIDE OF PLOT DIMENSIONS.          CF125760
      IF(CPTOP.LT.0.) GO TO 118                                         CF125770
      LINE = IDINT((( CPTOP       ) / YIW) + 5.D-01) + 1                CF125780
      LOCX2 = 5*IP(JC) + 5                                              CF125790
      LCHAR = MOD(LOCX2,4)                                              CF125800
      LWORD = LOCX2/4                                                   CF125810
      IF(LCHAR.NE.0) GO TO 117                                          CF125820
      LCHAR = 4                                                         CF125830
      LWORD = LWORD - 1                                                 CF125840
  117 CALL PACK(GRIDA(LINE,LWORD),LCHAR,IPLUS)                          CF125850
  118 CONTINUE                                                          CF125860
      WRITE(KTOU,1028) PR1, PR2, PR3, ICURY, BI(K), NSRCH, NVALP        CF125870
 1028 FORMAT(1H1,      1X, 3A6,  9H  DEP VAR , I2, 2H: , A6, 29X,       CF125880
     1  7HCP PLOT, 33X, 13HSEARCH NUMBER, I2 / 20X, 21(I2,3X) )         CF125890
      WRITE(KTOU,1029) NCP1( 1),    (GRIDA( 1,JZ),JZ=1,26)              CF125900
 1029 FORMAT(10X, A4, 7X,         25A4, A2)                             CF125910
      NI     = 0                                                        CF125920
      INDIA  = 2                                                        CF125930
      ILEVEL = 18 + ILESS                                               CF125940
      DO 1032 IA = 2,53                                                 CF125950
      IF(IA.EQ.INDIA) GO TO 1030                                        CF125960
      WRITE(KTOU,1029) NCP1(IA),    (GRIDA(IA,JZ),JZ=1,26)              CF125970
      GO TO 1032                                                        CF125980
 1030 NI = NI + 1                                                       CF125990
      NJ = ILEVEL - NI                                                  CF126000
      WRITE(KTOU,1031) NCP1(IA), NJ,(GRIDA(IA,JZ),JZ=1,26)              CF126010
 1031 FORMAT(10X, A4, 2X, I4, 1X, 25A4, A2)                             CF126020
      INDIA = INDIA + 3                                                 CF126030
 1032 CONTINUE                                                          CF126040
      WRITE(KTOU,1033) NVALP                                            CF126050
 1033 FORMAT(20X, 21(I2,3X) / 71X, 1HP)                                 CF126060
C --- DETERMINE IF ADDITIONAL FACTORIAL SEARCHES HAVE BEEN REQUESTED.   CF126070
 1034 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
 9987 READ(KTIN,9988) (ICP(I), I=1, MAXSRH)                             CF126240
 9988 FORMAT( 18(2X,I2) )                                               CF126250
 9990 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
 9902 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) MAXSRH                                           CF126390
 9998 FORMAT(1H0, 48HNUMBER OF VARIABLES REMAINING TO BE SEARCHED IS ,  CF126400
     1 13HGREATER THAN ,I2/ 36H USE FRACTIONAL FACTORIAL OPTION TO ,    CF126410
     2 14HSOLVE PROBLEM. )                                              CF126420
 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
      IMPLICIT REAL*8(A-H,O-Z)                                          CF130100
      DIMENSION U(11)                                                   CF130110
      COMMON /HHHHHH/ BETA(11), C(10,10), Z(11,11), NNNN, MXSIXE        CF130120
      EQUIVALENCE (BETA(1),U(1))                                        CF130130
    1 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
    6 DO 4000 I = 1,KSEQP1                                              CF130360
      Z(I,J)=Z(I,J)-(U(I)*U(J))/HAPPY                                   CF130370
 4000 CONTINUE                                                          CF130380
    7 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, MAXSRH)          CF150010
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(14), JIVOS(14), JIV(14), 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,37H 8  CP FACTORIAL SEARCH CARD, 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,38H11  ESTIMATE OF VARIANCE CARD, IF ANY.                 )  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,50H12  ADDITIONAL CP FACTORIAL SEARCH AND ESTIMATE OF     )  CF150760
      WRITE(KTOU,36) IQ(10)                                             CF150770
   36 FORMAT(1H ,3X,2H32,I4,   8X,                                      CF150780
     1 22H0 LIST ALL INPUT DATA. ,                                      CF150790
     1 44X,23HVARIANCE CARDS, IF ANY.,                                  CF150800
     2 /18X, 28H1 LIST ONLY 1ST OBSERVATION. ,                          CF150810
     3 /18X, 29H2 DO NOT LIST ANY INPUT DATA.                        ,  CF150820
     3 32X,14HSECOND PROBLEM                                         )  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 - 12 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.             )  CF151200
      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), MAXSRH                                     CF151310
   58 FORMAT(1H ,5H43-44,I4,I6,2X,                                      CF151320
     1 52HNUMBER OF VARIABLES IN CP SEARCH IF GREATER THAN 12.       )  CF151330
      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 52HSEARCH FOR CANDIDATE EQUATIONS VIA CP.  USE ESTIMATE / 18X,   CF151500
     2 25H  OF VARIANCE (RMS) FROM:  / 18X,                             CF151510
     3 16H1 FULL EQUATION,   / 18X,                                     CF151520
     4 44H2 SUBSET EQUATION WITH MINIMUM RMS VALUE, OR / 18X,           CF151530
     5 42H3 ESTIMATE OF VARIANCE CARD, F16.8 FORMAT.                 )  CF151540
      WRITE(KTOU,68) IQ(26)                                             CF151550
   68 FORMAT(1H ,3X,2H50,I4,   8X,                                      CF151560
     1 50HNUMBER OF CP FACTORIAL SEARCH CARDS TO BE READ PER / 18X,     CF151570
     2 53H DEPENDENT VARIABLE.  KEYPUNCH IN ASCENDING ORDER THE  / 18X, CF151580
     3 52H IDENTIFING NUMBER OF THE VARIABLES (AFTER TRANSFOR- / 18X,   CF151590
     4 54H MATIONS) TO BE USED IN THAT SEARCH, 18(2X,I2) FORMAT. / 18X, CF151600
     5 54H ALL OTHER VARIABLES WILL BE PLACED IN BASIC EQUATION.     )  CF151610
      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    / 18X, CF151840
     2 24H  SECOND SAMPLE OF DATA:                         / 18X,       CF151850
     3 45H1 WRITE B(0) AND B(I)S ON FILE IN ONE PROBLEM          / 18X, CF151860
     4 35H   (TRANSFORMATIONS ARE NOT SAVED).                    / 18X, CF151870
     5 48H2 READ  B(0) AND B(I)S FROM FILE IN NEXT PROBLEM / 18X,       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( 35), IOMIT( 35), ITLOC( 35)                      CF160070
      DIMENSION ARRAY(21,6), DRRAY(4), ERRAY( 40)                       CF160080
      COMMON /AAAAAA/ COM1( 200)                                        CF160090
      COMMON /FFFFFF/ VARTR( 35), ITRFM( 35)                            CF160100
      COMMON /GGGGGG/ BI(35), 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( 36),ITLOC(1)),             CF160150
     1            (COM1( 71),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 40.                                    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
C    4           2H41,2H42,2H43,2H44,2H45,2H46,2H47,2H48,2H49,2H50,     CF160680
C    5           2H51,2H52,2H53,2H54,2H55,2H56,2H57,2H58,2H59,2H60,     CF160690
C    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
  270 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
  272 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 OPNFLS                                                 CF180010
      DOUBLE PRECISION FILIN,FILOU                                      CF180020
      OPEN(UNIT=1,DEVICE='DSK',ACCESS='SEQINOUT',                       CF180030
     *  FILE='FT01.DAT',MODE='BINARY')                                  CF180040
      OPEN(UNIT=2,DEVICE='DSK',ACCESS='SEQINOUT',                       CF180050
     *FILE='FT02.DAT',MODE='BINARY')                                    CF180060
      OPEN(UNIT=3,DEVICE='DSK',ACCESS='SEQINOUT',                       CF180070
     *FILE='FT03.DAT',MODE='BINARY')                                    CF180080
      OPEN(UNIT=4,DEVICE='DSK',ACCESS='SEQINOUT',                       CF180090
     *FILE='FT04.DAT',MODE='BINARY')                                    CF180100
100   FORMAT(A10)                                                       CF180110
101   FORMAT(' INPUT THE NAME OF THE OUTPUT FILE')                      CF180120
102   FORMAT(' INPUT THE NAME OF THE INPUT FILE')                       CF180130
      TYPE 102                                                          CF180140
      ACCEPT100,FILIN                                                   CF180150
      TYPE 101                                                          CF180160
      ACCEPT 100,FILOU                                                  CF180170
      OPEN(UNIT=5,DEVICE='DSK:',ACCESS='SEQIN',FILE=FILIN)              CF180180
      OPEN(UNIT=6,ACCESS='SEQINOU',FILE=FILOU)                          CF180190
      RETURN                                                            CF180200
      END                                                               CF180210