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