Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0100/lincur.for
There are no other files named lincur.for in the archive.
C LINEAR LEAST-SQUARES CURVE FITTING PROGRAM CF0 0010
C 1/79 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 LINCUR-10-257). PROGRAM CF0 0181
C ADAPTED FOR INTERACTIVE USE BY E. R. ZIEGEL AT STANDARD OIL (IND) CF0 0182
C CF0 0190
C PROGRAM CONVERTED AT UNIV. WISCONSIN BY J. D. MURAT AND CF0 0191
C T. R. ZEISLER FOR BURROUGHS 4700 AND 6700 SYSTEM COMPUTERS (CUBE CF0 0192
C LIBRARY PROGRAM NUMBER WIS/LINWOOD). THE PROJECT WAS INITIATED CF0 0193
C BY D. S. RUMSEY OF BURROUGHS. CF0 0194
C CF0 0200
C PROGRAM CONVERTED AT JOHNSON SPACE CENTER BY J. E. KEITH CF0 0201
C FOR UNIVAC 1108 COMPUTERS (PROGRAM NUMBER LINWOOD). CF0 0202
C CF0 0203
C PROGRAM CONVERTED AT U.S. NAVAL AVIONICS FACILITY, CF0 0210
C INDIANAPOLIS, IND. BY D. F. ZARNOW FOR HONEYWELL 60000/600/66 CF0 0211
C COMPUTERS (HLSUA LIBRARY PROGRAM NUMBER GES-1206). . CF0 0212
C CF0 0213
C FOR GLOSSARY OF TERMS, DEFINITIONS OF STATISTICS AND CF0 0220
C INTERPRETATION OF RESULTS SEE USER'S MANUAL IN BOOK "FITTING CF0 0230
C EQUATIONS TO DATA" BY C. DANIEL AND F. S. WOOD WITH ASSISTANCE CF0 0240
C OF J. W. GORMAN, 2ED EDITION, WILEY 1979. CF0 0250
C CF0 0260
C CF0 0270
C --- AUXILIARY EQUIPMENT NEEDED TO RUN PROGRAM (DEFINED IN CF0 0280
C --- SUBROUTINE BASPGM, CF1) CF0 0290
C CF0 0300
C --- CARD READER (UNIT 5), PRINTER (6), 4 SCRATCH FILES (1 TO 4) CF0 0310
C --- AND CARD PUNCH (7) IF DESIRED. CF0 0320
C CF0 0330
C CF0 0340
C --- ORDER OF CARDS FOR EACH PROBLEM CF0 0350
C CF0 0360
C --- 1 CONTROL CARD. CF0 0370
C --- 2 FORMAT CARD(S), IF ANY. CF0 0380
C --- 3 DELETE OBSERVATIONS CARD(S), IF ANY. CF0 0381
C --- 4 INDICATOR-VARIABLE-OBSERVATIONS CARD(S), IF ANY. CF0 0382
C --- 5 TRANSFORMATION CARD(S), IF ANY. CF0 0390
C --- 6 INFORMATION CARD(S) FOR PRINTOUT, IF ANY. CF0 0400
C --- 7 NAMES OF VARIABLES CARD(S) FOR PRINTOUT, IF ANY. CF0 0410
C --- 8 CP FACTORIAL SEARCH CARD, IF ANY. CF0 0420
C --- 9 DATA CARDS (IF NOT READ FROM A FILE). CF0 0430
C ---10 END CARD (END IN COL 1-3 OF IDENTIFICATION FIELD). THE NUMBER CF0 0440
C --- OF END CARDS MUST EQUAL THE NUMBER OF CARDS PER OBSERVATION. CF0 0450
C --- END CARDS ARE NOT NEEDED IF DATA ARE READ FROM A FILE. CF0 0451
C ---11 ESTIMATE OF VARIANCE CARD, IF ANY. CF0 0460
C ---12 ADDITIONAL CP FACTORIAL SEARCH AND ESTIMATE OF VARIANCE CARDS, CF0 0470
C --- IF ANY. CF0 0480
C --- CF0 0490
C --- NOTE: FORMAT, DATA, END AND NAME CARDS ARE NOT NEEDED IN CF0 0500
C --- SUBSEQUENT PROBLEMS IF SAME INPUT DATA ARE REUSED. CF0 0510
C CF0 0520
C CF0 0530
C --- GLOSSARY OF CONTROL CARD CF0 0540
C CF0 0550
C --- COL. Q(I) DESCRIPTION (NOTE: BLANKS = 0) CF0 0560
C --- 1-18 PROBLEM IDENTIFICATION. CF0 0570
C ---19-20 1 NUMBER OF INDEPENDENT VARIABLES READ IN. CF0 0580
C ---21-22 2 NUMBER OF DEPENDENT VARIABLES READ IN. CF0 0590
C --- 24 E CAUSES RESIDUALS, Y AND FITTED Y TO TO BE CF0 0600
C --- LISTED WITH E FORMAT RATHER THAN F FORMAT. CF0 0610
C --- 25 3 1 DO TRANSFORMATIONS. CF0 0620
C --- 26 4 1 WEIGHT OBSERVATIONS. WEIGHT ENTERED IN LAST POSITION. CF0 0630
C --- 2 WEIGHT BY 1/VAR. OF OBSERVATION. VARIANCE ENTERED. CF0 0631
C --- 27 5 1 LET B(0) = ZERO, OTHERWISE B(0) IS CALCULATED VALUE. CF0 0640
C --- 28 6 1 CHECK OBSERVATION NUMBER SEQUENCE. CF0 0650
C --- 29 7 1 CHECK SEQUENCE WITHIN OBSERVATION NUMBER. CF0 0660
C --- 30 8 1 DO BACK TRANSFORMATION OF DEPENDENT VARIABLE. CF0 0670
C --- 31 9 1 PUNCH DATA FOR CONFIDENCE INTERVAL PROGRAM. CF0 0680
C --- 32 10 0 (OR BLANK) LIST ALL INPUT DATA. CF0 0690
C --- 1 LIST ONLY 1ST OBSERVATION. CF0 0700
C --- 2 DO NOT LIST ANY INPUT DATA. CF0 0710
C --- 33 11 0 LIST TRANSFORMATIONS AND ALL TRANSFORMED DATA. CF0 0720
C --- 1 LIST TRANSFORMATIONS AND 1ST TRANSFORMED OBSERVATION. CF0 0730
C --- 2 DO NOT LIST TRANSFORMATIONS OR TRANSFORMED DATA. CF0 0740
C --- 34 12 1 DO NOT LIST SUMS OF VARIABLES. CF0 0750
C --- 35 13 1 DO NOT LIST RAW SUMS AND CROSS PRODUCTS WHEN B(O)=O. CF0 0760
C --- 36 14 1 DO NOT LIST RESIDUAL SUMS AND CROSS PRODUCTS. CF0 0770
C --- 37 15 1 DO NOT LIST MEANS AND ROOT MEAN SQUARES OF VARIABLES. CF0 0780
C --- 38 16 1 DO NOT LIST SIMPLE CORRELATION COEFFICIENTS. CF0 0790
C --- 39 17 1 DO NOT LIST INVERSE MATRIX. CF0 0800
C --- 40 18 1 DO NOT PRINT PLOTS OF RESIDUALS VS. FITTED Y. CF0 0810
C --- 2 PLOT (A) RESIDUALS AND (B) COMPONENT AND COMPONENT- CF0 0820
C --- PLUS-RESIDUALS VS. EACH INDEPENDENT VARIABLE. CF0 0830
C --- 3 PLOT (A) RESIDUALS ONLY. CF0 0840
C --- 4 PLOT (B) COMPONENT AND COMPONENT-PLUS-RESIDUALS ONLY. CF0 0850
C --- 5 PLOT (B) BUT EXPAND SCALE TO FILL EACH PLOT. CF0 0860
C --- 41 19 0 READ DATA WITH STANDARD FORMAT (A6, I4, I2, 10F6.3). CF0 0870
C --- 1 READ DATA WITH FORMAT TO BE READ, 1CARD(72COL)ASSUMED.CF0 0880
C --- 2 READ DATA WITH READ DATA (REDATA) SUBROUTINE. CF0 0890
C --- 42 20 0 DO NOT SAVE DATA FOR NEXT PROBLEM. CF0 0900
C --- 1 SAVE DATA FOR NEXT PROBLEM. CF0 0910
C --- 2 REUSE DATA FROM PREVIOUS PROBLEM. CF0 0920
C ---43-44 21 NUMBER OF VARIABLES IN CP SEARCH IF GREATER THAN 12. CF0 0930
C --- 45 22 NUMBER OF FORMAT CARDS IF GREATER THAN 1. (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 SEARCH FOR CANDIDATE EQUATIONS VIA CP. USE ESTIMATE CF0 1040
C --- OF VARIANCE (RMS) FROM CF0 1050
C --- 1 FULL EQUATION, CF0 1060
C --- 2 SUBSET EQUATION WITH MINIMUM RMS VALUE, OR CF0 1070
C --- 3 ESTIMATE OF VARIANCE CARD, F16.8 FORMAT. CF0 1080
C --- 50 26 NUMBER OF CP FACTORIAL SEARCH CARDS TO BE READ PER CF0 1090
C --- IDENTIFING NUMBER OF THE VARIABLES (AFTER TRANSFOR- CF0 1110
C --- MATIONS) TO BE USED IN THAT SEARCH, 18(2X,I2) FORMAT. CF0 1120
C --- ALL OTHER VARIABLES WILL BE PLACED IN BASIC EQUATION. CF0 1130
C --- 51 27 1 LIST COMPONENT-EFFECT TABLE, REQUIRED X(I) PRECISION, CF0 1140
C --- ESTIMATE OF STANDARD DEVIATION FROM NEAR NEIGHBORS, CF0 1150
C --- AND FUNCTIONS OF FITTED Y. CF0 1160
C --- 2 LIST ONLY ESTIMATE OF STD. DEVIATION AND FUNCTIONS. CF0 1170
C --- 3 LIST ONLY FUNCTIONS OF FITTED Y. CF0 1171
C ---52-53 28 NUMBER OF FILE IF DATA ARE READ FROM SEPARATE FILE, CF0 1180
C --- NO END CARD IF ONLY ONE SET OF DATA IS ON EACH FILE. CF0 1190
C ---54-55 29 NUMBER OF INDEPENDENT VARIABLES GREATER THAN THE 99 CF0 1200
C --- ALLOWED IN COLS 19-20. CF0 1210
C ---56-58 30 TO REDUCE PRINTOUT WITH MANY OBSERVATIONS, CF0 1220
C --- NUMBER OF CENTRAL OBSERVATIONS AND RESIDUALS NOT CF0 1230
C --- TO BE PRINTED WITH E IN COL 24. CF0 1240
C --- 59 31 CROSS VERIFICATION OF MODEL AND COEFFICIENTS WITH A CF0 1250
C --- SECOND SAMPLE OF DATA. CF0 1260
C --- 1 WRITE B(0) AND B(I)S ON FILE KTIN5 IN ONE PROBLEM CF0 1270
C --- (TRANSFORMATIONS ARE NOT SAVED). CF0 1280
C --- 2 READ B(0) AND B(I)S ON FILE KTIN5 IN NEXT PROBLEM CF0 1290
C --- WITH SECOND SET OF OBSERVATIONS. CF0 1300
C --- 60 32 NUMBER OF DELETE OBSERVATION CARDS. KEYPUNCH CF0 1301
C --- OBSERVATION NUMBER OF DATA TO BE DELETED IN ORDER READ CF0 1302
C --- BY COMPUTER USING 7(I4,6X) FORMAT. 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 CF0 1310
C ROUTINES CF1 THROUGH CF16 ARE WRITTEN IN USASI FORTRAN IV CF0 1320
C CF0 1330
C CF0 1340
C *** DIMENSION STATEMENTS TO MAKE CF0 1350
C *** A 50 VARIABLE, 2000 OBSERVATION PROGRAM CF0 1360
C *** DOUBLE PRECISION IDZA(2000), IDENT, IEND, LIEND CF0 1370
C *** DIMENSION AMAX(50), AMIN(50), AVATR( 75), AVG(50), B(50), CF0 1380
C ***1 BETA(50), C(50,50), DATA( 76), DELTA(2000), FMT(144), CF0 1390
C ***2 IDZB(2000), IOMIT( 75), IQ(40), ITLOC( 75), ITRFM( 75), CF0 1400
C ***3 LSORT(2000), SIGMA(50), STDDEV(50), VAR(50), VARTR( 75), CF0 1410
C ***4 W1(50), YRESID(50), YYCC(2000), YYIN(2000), Z(51,51) CF0 1420
C *** DIMENSION A(50,50), LP(50), C(50) (IN SUBROUTINE CF6) CF0 1430
C CF0 1440
C *** DIMENSION STATEMENTS TO MAKE CF0 1450
C *** A 80 VARIABLE, 1000 OBSERVATION PROGRAM CF0 1460
C *** DOUBLE PRECISION IDZA(1000), IDENT, IEND, LIEND CF0 1470
C *** DIMENSION AMAX(80), AMIN(80), AVATR(105), AVG(80), B(80), CF0 1480
C ***1 BETA(80), C(80,80), DATA(106), DELTA(1000), FMT(144), CF0 1490
C ***2 IDZB(1000), IOMIT(105), IQ(40), ITLOC(105), ITRFM(105), CF0 1500
C ***3 LSORT(1000), SIGMA(80), STDDEV(80), VAR(80), VARTR(105), CF0 1510
C ***4 W1(80), YRESID(80), YYCC(1000), YYIN(1000), Z(81,81) CF0 1520
C *** DIMENSION A(80,80), LP(80), C(80) (IN SUBROUTINE CF6) CF0 1530
C CF0 1540
C CF0 1550
C --- LOCATION AND DIMENSIONS OF COMMON STATEMENTS * CF0 1560
C --- A USED IN CF 1-5,9,12, DIM=MAX OBSERVATIONS CF0 1570
C --- 16 CF0 1571
C --- B USED IN CF 1-5,12 DIM=(MAX TRANSFORMATIONS+1)+MAX VARIABLES CF0 1580
C --- C USED IN CF 1-4,12 DIM=3*MAX VARIABLES OR 36 MIN. CF0 1590
C --- D USED IN CF 3,4,9,12 IN CF 4 AVAILABLE FOR REDATA CALCULATIONS CF0 1600
C --- D IN CF 3 DIM=3*(MAX OBSV.) + INTERGER MAX OBSV. CF0 1610
C --- D IN CF 9 DIM=GRIDA+GRIDB+2*(MAX OBSV.)+MAX VAR CF0 1620
C --- D IN CF 12 DIM=IS(20+K) WHERE K=18 OR MAX VAR, + CF0 1630
C --- GRIDA(1378)+GRIDB(1378) CF0 1631
C --- IN DOUBLE PRECISION PROGRAMS GRIDA, GRIDB ARE SINGLE PRECISION CF0 1632
C --- E USED IN CF 3,4,6,9,12 DIM=MAX OBSERVATIONS CF0 1640
C --- F USED IN CF 1-5,8,16 DIM=2*MAX TRANSFORMATIONS CF0 1650
C --- G USED IN CF 1-4,9,12, DIM=MAX VAR BEFORE TRANS+144(12CARDSX12A6)CF0 1660
C --- 16 CF0 1661
C --- H USED IN CF 1-4,6,9, DIM=(MAX VAR+1) + (MAX VAR * MAX VAR) + CF0 1670
C --- 12 AND 13 (MAX VAR+1 * MAX VAR+1) CF0 1680
C --- J USED IN CF 3,4,12 DIM=MAX OBSERVATIONS CF0 1690
C --- K USED IN CF 1-5,8,9, DIM=40 CONTROL CARD SWITCHES CF0 1700
C --- 12,15 CF0 1701
C --- L USED IN CF 1-3,15 DIM=MAX OBSERVATIONS DELETED, 7*MNOMTC, + CF0 1701
C --- MAX INDICATOR VAR. OBSVS., 14*MNIVOC. CF0 1702
C --- S USED IN CF 1,12 DIM=18 OR MXVRAT CF0 1710
C --- CF0 1720
C --- * DEFINITION OF SUBROUTINES: CF0=MAIN, 1=BASPGM, 2=STAT, 3=FIT, CF0 1730
C --- 4=REDATA, 5=TRANSF, 6=INV, 7=MINMAX, 8=YBACK, 9=PITCHA, CF0 1740
C --- 10=GRID, 11=PACK, 12=CPMAIN, 13=SWEEP, 14=SORT, 15=CCARD, CF0 1750
C --- 16=TRANPT CF0 1751
C -- CF0 1760
C ---*************************************************************** CF0 1770
C -- CF0 1780
C --- LIMIT TRAP THAT CAN BE SET BY INSTALLATION STATISTICIAN CF0 1790
C --- CF0 1800
C --- MAXSRH, THE TOTAL NUMBER OF VARIABLES THAT CAN BE SEARCHED, IS CF0 1810
C --- SET IN CPMAIN, CF12. EACH COMPUTER CENTER MAY WISH TO HAVE CF0 1820
C --- MORE THAN ONE PROGRAM COMPILED WITH DIFFERENT LEVELS OF MAXSRH CF0 1830
C --- LIMITS. CF0 1840
C --- THE TOTAL NUMBER OF SEARCHES = 2**MAXSRH. CF0 1850
C --- WHEN MAXSRH = 12, TOTAL = 4,096 SEARCHES, CF0 1860
C --- WHEN MAXSRH = 14, TOTAL = 16,384 SEARCHES, CF0 1870
C --- WHEN MAXSRH = 18, TOTAL = 256,144 SEARCHES. CF0 1880
C -- CF0 1890
C ---*************************************************************** CF0 1900
C -- CF0 1910
C -- CF0 1920
C --- ROOT SEGMENT OF THE OVERLAY PROGRAM CF0 1930
C CF0 1940
C CF0 1950
C SUSGESTED OVERLAY CARDS TO BE INCLUDED IN THE LINK STEP CF0 1960
C CF0 1970
C --- OVERLAY AAA CF0 1980
C --- INSERT BASPGM,CCARD CF0 1990
C --- OVERLAY AAA CF0 2000
C --- INSERT STAT,REDATA,TRANSF CF0 2001
C --- OVERLAY AAA CF0 2010
C --- INSERT FIT,INV,YBACK,MINMAX,FALPHA CF0 2020
C --- OVERLAY AAA CF0 2030
C --- INSERT PITCHA CF0 2040
C --- OVERLAY AAA CF0 2050
C --- INSERT CPMAIN,SWEEP CF0 2060
C --- CF0 2070
C -- CF0 2080
C ---*************************************************************** CF0 2090
C -- CF0 2100
C --- VARIABLE DEFINITION FOR THE ROOT SEGMENT CF0 2110
C -- CF0 2120
C --- K 411 : INDICATOR VARIABLE FOR CALL TO FIT. IF K411 = 411 CF0 2130
C --- TRANSFER IS MADE IN FIT TO STATEMENT 411. CF0 2140
C --- OTHERWISE THE ENTRY IS AT THE BEGINNING OF FIT. CF0 2150
C --- THE TEST FOR TRANSFER TO 411 IS MADE IN FIT. CF0 2160
C -- CF0 2170
C -- CF0 2180
C --- N77 : INDICATOR VARIABLE FOR BASIC PROGRAM CALL. (BASPGM) CF0 2190
C --- IF N77 = 77 CONTROL IS SENT TO STATEMENT 77. THIS CALL CF0 2200
C --- IS THE RESULT OF A RETURN TO &77 FROM STAT. CF0 2210
C -- CF0 2220
C --- CF0 2230
C --- M 10 : INDICATOR VARIABLE FOR BASIC PROGRAM CALL. (BASPGM) CF0 2240
C --- IF M10=10 CONTROL IS SENT TO STATEMENT 10 IN BASPGM. CF0 2250
C --- THIS CALL IS THE RESULT OF A RETURN TO &10 FROM STAT. CF0 2260
C -- CF0 2270
C -- CF0 2280
C --- SET K411 TO 0. WHEN K411 = 411, CALLS TO FIT WILL RESULT IN CF0 2290
C --- STARTING AT STATEMENT 411 IN FIT. CF0 2300
C -- CF0 2310
IMPLICIT REAL*8(A-H,O-Z) CF0 2320
C --- IN SINGLE PRECISION PROGRAMS NSIZE = ISIZE AT STATEMENT 144 CF0 2321
C --- IN DOUBLE PRECISION PROGRAMS NSIZE = 2*ISIZE CF0 2322
DIMENSION STDDEV(40) CF0 2330
DOUBLE PRECISION IDENT,IEND CF0 2331
COMMON /CCCCCC/ COM3(240) CF0 2340
COMMON /FORFIT/ RMS, YCMAX, YCMIN, INTDUM, 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
1 K411 = 0 CF0 2420
C --- SET N77 TO 0. IF N77 = 77, THEN BASIC PROGRAM WILL START AT CF0 2430
C --- STATEMENT 77 . CF0 2440
CALL OPNFLS CF0 2441
N77=0 CF0 2450
C --- SET M10 TO 0. IF M10 = 10, THEN BASIC PROGRAM WILL START AT CF0 2460
C --- STATEMENT 10. CF0 2470
M10 = 0 CF0 2480
GO TO 12 CF0 2490
77 N77=77 CF0 2500
M10=0 CF0 2510
GO TO 12 CF0 2520
10 M10=0 CF0 2530
12 CONTINUE CF0 2540
C --- CALL THE BASIC LINEAR LEAST-SQUARES CURVE-FITTING PROGRAM CF0 2550
C --- WITH THE APPROPRIATE INDICATOR VARIABLES. CF0 2560
ITON=0 CF0 2561
CALL BASPGM(N77,M10,ITON) CF0 2570
IF(ITON.EQ.1)GO TO 9999 CF0 2571
145 CALL STAT(ISIZE,IRTRN) CF0 2580
GO TO(77,10,144), IRTRN CF0 2590
144 NSIZE = 2*ISIZE CF0 2591
CALL FIT(C,MAXINF,NOOBSV,NSIZE,IRTRN) CF0 2600
GO TO(10,1250), IRTRN CF0 2601
1250 IF(IQ(18).EQ.1.OR.IQ(8).EQ.1) GO TO 481 CF0 2610
C -- CF0 2620
C --- DO PLOTTING CF0 2630
C -- CF0 2640
CALL PITCHA(YCMAX,YCMIN,C,MAXINF,NOOBSV,ISIZE) CF0 2650
481 IF(IQ(9)-1) 485,482,485 CF0 2660
482 WRITE(KTOU,484) PR1,PR2,PR3 CF0 2670
484 FORMAT(1H1,3A6//35H PUNCH-OUTS FOR CONFIDENCE INTERVAL , CF0 2680
1 19H PROGRAM REQUESTED. ) CF0 2690
C --- CALCULATE CPS FOR SELECTION OF VARIABLES IF DESIRED. CF0 2700
485 IF(NCP.LT.1 .OR. NOIND .EQ. 1) GO TO 487 CF0 2710
ZMS=RMS/(STDDEV(K)*STDDEV(K)*(NOOBSV-1)) CF0 2720
CALL CPMAIN(ZMS) CF0 2730
489 CONTINUE CF0 2740
487 K = K+1 CF0 2750
C --- CHECK TO SEE IF ALL DEPENDENT VARIABLES HAVE BEEN RUN. IF NOT CF0 2760
C --- RE-ENTER FIT AT STATEMENT 411. IF ALL HAVE BEEN RUN. GO BACK AND CF0 2770
C --- READ IN THE NEXT PROBLEM. CF0 2780
IF(K-NOVAR) 411,411,10 CF0 2790
411 K411 = 411 CF0 2800
GO TO 144 CF0 2810
9999 STOP CF0 2811
END CF0 2820
SUBROUTINE BASPGM(N77,M10,ITON) CF1 0010
C SUBROUTINE READS CONTROL CARD, (FORMAT AND TRANSFORMATION CF1 0020
C CARDS IF SO INDICATED ON CONTROL CARD) DATA CARDS AND END CARD(S).CF1 0030
C CHECKS FOR BZERO, E FORMAT OF PRINTOUT, CONFIDENCE INTERVAL CF1 0040
C CALCULATION, WEIGHTING FACTORS, INDEX OF CARDS AND SEQUENCE(IF CF1 0050
C DESIRED). CF1 0060
C CF1 0070
C *** DEFINES DIMENSION LIMITS IN MXVRBT, MXVPBT, MXVRAT, MXVPAT, CF1 0080
C *** MXOBS, MXSIZE, MXFMTC AND MXFMTD FOR ERROR TRAPS. CF1 0090
C CF1 0100
IMPLICIT REAL*8(A-H,O-Z) CF1 0110
DOUBLE PRECISION IDENT, IEND, LIEND CF1 0120
DIMENSION AVATR( 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 /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(20) 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 --- MAXSRH = MAX CP SEARCH. SET IN CPMAIN BY TRAP TO = 18. CF1 0753
MAXSRH = 18 CF1 0754
C CF1 0750
C *** DEFINITION OF SCRATCH, INPUT AND OUTPUT FILES CF1 0760
C (FORMATS: KTBIN1-5=VARIABLE BLOCKED, KTIN AND KTOU=FIXED BLOCKED) CF1 0770
C CF1 0780
C --- KTBIN1 STORES ENGLISH NAMES OF VARIABLES WHEN IQ(24) = 1 CF1 0790
C --- AND STORES SIMPLE CORRELATION COEFFICIENTS AND INVERSE CF1 0800
C --- MATRIX WHEN IQ(25), IQ(26) OR IQ(27) = 1. CF1 0810
KTBIN1 = 1 CF1 0820
C --- KTBIN2 STORES CROSS PRODUCTS OF INDEPENDENT AND DEPENDENT VARABLESCF1 0830
KTBIN2 = 2 CF1 0840
C --- KTBIN3 STORES TRANSFORMED DATA WHEN IQ(3)=1. CF1 0850
KTBIN3 = 3 CF1 0860
C --- KTBIN5 STORES DATA READ FROM CARDS FOR LATER USE WHEN IQ(20)=1. CF1 0870
KTBIN5 = 4 CF1 0880
C --- KTIN READS CARDS IN CF1 0890
KTIN = 5 CF1 0900
C --- KTOU WRITES PRINT-OUT CF1 0910
KTOU = 6 CF1 0920
C --- KTPCH PUNCHES CARDS WHEN IQ(9) = 1. CF1 0930
KTPCH = 7 CF1 0940
C CF1 0950
C *** READ CONTROL CARD CF1 0960
C CF1 0970
10 READ(KTIN,800,END=3000) CF1 0980
1 PR1,PR2,PR3,IQ(1),IQ(2),XEFMT,(IQ(JZ),JZ=3,40) CF1 0990
800 FORMAT(3A6,2I2,1X,A1,18I1,I2,I1,I2,4I1,2I2,I3,10I1) CF1 1000
C CF1 1010
C --- WRITE PROBLEM IDENTIFICATION ON OUTPUT FILE CF1 1020
C CF1 1030
TYPE 3999, PR1, PR2, PR3,MXVRAT,MXOBSV CF1 1031
3999 FORMAT(//27H0LINWOOD - DEC VERSION 1979/22H0LINEAR LEAST-SQUARES ,CF1 1032
1 21HCURVE-FITTING PROGRAM //1H0 3A6/ CF1 1033
2 1H0,I5,10H VARIABLE,,I5,20H OBSERVATION PROGRAM//) CF1 1034
WRITE(KTOU,805) MXVRAT, MXOBSV, PR1, PR2, PR3 CF1 1040
805 FORMAT(1H1,44X,42HLINEAR LEAST-SQUARES CURVE-FITTING PROGRAM// CF1 1050
1 28H 1979 VERSION OF THE LINWOOD,I3,10H VARIABLE,,I5, CF1 1060
2 20H OBSERVATION PROGRAM// CF1 1061
3 55H REFER TO FITTING EQUATIONS TO DATA BY DANIEL AND WOOD,, CF1 1062
4 33H SECOND EDITION, WILEY PUBLISHER,/ CF1 1063
5 49H FOR GLOSSARY OF TERMS, USER'S MANUAL, DETAILS OF, CF1 1064
6 44H CALCULATIONS AND INTERPRETATION OF RESULTS.// 1H0,3A6/) CF1 1065
C CF1 1070
C --- CALCULATE NUMBER OF VARIABLES FROM CONTROL CARD VALUES CF1 1080
C CF1 1090
IF(IQ(1).LT.99) GO TO 2 CF1 1091
IQ(1) = IQ(1) + IQ(29) CF1 1100
2 NOIND=IQ(1) CF1 1110
NODEP=IQ(2) CF1 1120
NOVAR=IQ(1)+IQ(2) CF1 1130
NVP1=NOVAR+1 CF1 1140
CALL CCARD(MXFMTC, MXINFC, MNOMTC, MNIVOC, MAXSRH) CF1 1141
IF(NOVAR.LE.MXVRBT) GO TO 6 CF1 1150
WRITE(KTOU,5) MXVRBT, NOVAR CF1 1160
5 FORMAT( 1H0//////1X, 45H******THIS VERSION OF PROGRAM DIMENSIONED CF1 1170
1FOR,I3,11H VARIABLES,,I3,34H REQUESTED. ALL PROBLEMS FLUSHED.) CF1 1180
TYPE 5,MXVRBT,NOVAR CF1 1181
CALL EXIT CF1 1190
C CF1 1200
C --- INITIALIZE INPUT STORAGE AREAS, SWITCHES, AND FILES CF1 1210
C CF1 1220
6 MVP1 = NVP1 CF1 1230
IF(MVP1.GT.MXVPAT) MVP1 = MXVPAT CF1 1240
NFILE = KTIN CF1 1250
IF(IQ(28).GT.0) NFILE=IQ(28) CF1 1260
DO 15 J=1,MVP1 CF1 1270
DO 15 I=1,MVP1 CF1 1280
Z(I,J)=0. CF1 1290
15 CONTINUE CF1 1300
C CF1 1310
C --- CONTROL ON CP PUNCH CF1 1320
KCP=2 CF1 1330
IF(IQ(9).EQ.2) KCP=1 CF1 1340
KFM = IQ(22) CF1 1350
IF(IQ(20).EQ.2) GO TO 18 CF1 1351
IF(IQ(31).GT.0) IQ(20) = 0 CF1 1360
18 IF(IQ(20)) 21,20,20 CF1 1370
20 REWIND KTBIN5 CF1 1380
21 REWIND KTBIN3 CF1 1390
REWIND KTBIN2 CF1 1400
REWIND KTBIN1 CF1 1410
KNOIND=NOIND CF1 1420
KNODEP=NODEP CF1 1430
KNOVAR=NOVAR CF1 1440
KNVP1 =NVP1 CF1 1450
JNOIND=NOIND CF1 1460
JNODEP=NODEP CF1 1470
JNOVAR=NOVAR CF1 1480
C CF1 1490
C CF1 1500
C --- DETERMINE NUMBER OF EQUATIONS IN PROBLEM AND FORMAT OF INPUT DATA CF1 1510
C CF1 1520
IQF=IQ(19)+1 CF1 1530
IQE=IQ(20)+1 CF1 1540
IF(IQE.GE.1.AND.IQE.LE.3) GO TO 26 CF1 1550
WRITE(KTOU,24) IQ(20) CF1 1560
24 FORMAT(1H0,36HBAD VALUE FOR MODEL CONTROL. VALUE =,I2) CF1 1570
CALL EXIT CF1 1580
26 GO TO (28,32,36),IQE CF1 1590
28 WRITE(KTOU,30) CF1 1600
30 FORMAT(1H0,24HPROBLEM HAS ONE EQUATION) CF1 1610
GO TO 38 CF1 1620
32 NOEQ=1 CF1 1630
WRITE(KTOU,34) NOEQ CF1 1640
34 FORMAT(1H0, 9HEQUATION ,I2,28H OF A MULTI-EQUATION PROBLEM) CF1 1650
GO TO 38 CF1 1660
36 NOEQ=NOEQ+1 CF1 1670
WRITE(KTOU,34) NOEQ CF1 1680
GO TO 80 CF1 1690
38 IF(IQF.GE.1.AND.IQF.LE.3) GO TO 42 CF1 1700
WRITE(KTOU,40) IQ(19) CF1 1710
40 FORMAT(1H0,37HBAD VALUE FOR FORMAT CONTROL. VALUE =,I2) CF1 1720
CALL EXIT CF1 1730
C CF1 1740
C --- READ DATA VIA STD. OR SPECIAL FORMAT, OR READ DATA SUBROUTINE. CF1 1750
C CF1 1760
42 GO TO (44,52,72),IQF CF1 1770
44 WRITE(KTOU,50) CF1 1780
50 FORMAT(1H0,51HDATA READ WITH STANDARD FORMAT (A6, I4, I2, 10F6.3))CF1 1790
GO TO 80 CF1 1800
52 WRITE(KTOU,53) CF1 1810
53 FORMAT(1H0,29HDATA READ WITH SPECIAL FORMAT) CF1 1820
IF(KFM.LE.MXFMTC) GO TO 56 CF1 1830
WRITE(KTOU,57) MXFMTC, KFM CF1 1840
57 FORMAT(1H0, 27H****PROGRAM DIMENSIONED FOR, I2, CF1 1850
1 14H FORMAT CARDS., I3, 27HREQUESTED. PROBLEM FLUSHED. ) CF1 1860
CALL EXIT CF1 1870
56 IF(KFM.LE.0) KFM=1 CF1 1880
FMT(1)=BLANK CF1 1890
DO 62 I=2, MXFMTD CF1 1900
FMT(I)=FMT(1) CF1 1910
62 CONTINUE CF1 1920
DO 2022 I=1,KFM CF1 1930
KZ=18*I CF1 1940
LZ=KZ-17 CF1 1950
READ(KTIN,1030) (FMT(JZ),JZ=LZ,KZ) CF1 1960
1030 FORMAT(18A4) CF1 1970
WRITE(KTOU,64) I,(FMT(JZ),JZ=LZ,KZ) CF1 1980
64 FORMAT(1H0,11HFORMAT CARD,I2,1X,18A4) CF1 1990
2022 CONTINUE CF1 2000
GO TO 80 CF1 2010
72 WRITE(KTOU,74) CF1 2020
74 FORMAT(1H0,32HDATA READ WITH SUBROUTINE REDATA ) CF1 2030
C CF1 2040
C --- INDICATE ON OUTPUT FILE IF BZERO =0, OR BZERO = CALCULATED VALUE CF1 2050
C CF1 2060
80 IF(IQ(5)) 17,17,16 CF1 2070
16 BZRO=0. CF1 2080
WRITE(KTOU,980) CF1 2090
980 FORMAT(10H0BZERO = 0) CF1 2100
GO TO 86 CF1 2110
17 BZRO=1. CF1 2120
WRITE(KTOU,985) CF1 2130
985 FORMAT(25H0BZERO = CALCULATED VALUE) CF1 2140
C CF1 2150
C --- PUNCH CONTROL CARDS FOR CONFIDENCE INTERVAL CALCULATIONS**********CF1 2151
86 IF(IQ(9)-1) 47,46,47 CF1 2152
46 CONTINUE CF1 2153
C 46 WRITE(KTPCH,801)PR1,PR2,PR3,(IQ(JZ),JZ=1,8) CF1 2154
801 FORMAT(3A6,2I2,2X,6I1,35HPUNCH-OUTS FOR CONFIDENCE INTERVAL , CF1 2155
1 7HPROGRAM ) CF1 2156
C CF1 2157
C --- READ DELETE OBSERVATION CARDS. CF1 2158
C CF1 2159
47 NOMIT = 0 CF1 2160
IF(IQ(32).EQ.0) GO TO 168 CF1 2170
JC = MNOMTC CF1 2171
NOMITC = IQ(32) CF1 2172
IF(NOMITC.LE.JC) JC = NOMITC CF1 2173
DO 160 J = 1, JC CF1 2174
NOMIT = NOMIT + 7 CF1 2175
J1 = NOMIT - 6 CF1 2176
160 READ(KTIN,161) (JOMIT(I),I=J1,NOMIT) CF1 2177
161 FORMAT( 7(I4,6X) ) CF1 2178
162 IF(JOMIT(NOMIT).NE.0) GO TO 164 CF1 2179
NOMIT = NOMIT - 1 CF1 2180
IF(NOMIT.NE.0) GO TO 162 CF1 2190
WRITE(KTOU,163) NOMITC CF1 2191
163 FORMAT(1H0//1X,6H******,I2, 32H DELETE CARD(S) WITH (7(I4,6X)) , CF1 2192
1 48HFORMAT REQUESTED, NO OBSERVATION NUMBERS FOUND. ,6H******//) CF1 2193
164 WRITE(KTOU,264) CF1 2194
264 FORMAT(1H0,26HOBSERVATIONS TO BE DELETED ) CF1 2195
WRITE(KTOU,265) (JOMIT(I),I=1,NOMIT) CF1 2196
265 FORMAT(1H ,10X, 7(I4,8X) / (11X, 7(I4,8X)) ) CF1 2197
IF(NOMITC.LE.MNOMTC) GO TO 168 CF1 2198
WRITE(KTOU,165) MNOMTC, NOMITC CF1 2199
165 FORMAT(1H0//////1X, 45H******THIS VERSION OF PROGRAM DIMENSIONED CF1 2200
1FOR,I2,26H DELETE OBSERVATION CARDS,,I2, 42H REQUESTED. NOT ALL CF1 2210
2OBSERVATIONS DELETED.,6H******//////) CF1 2211
JC = JC + 1 CF1 2212
DO 166 J = JC, NOMITC CF1 2213
166 READ(KTIN,167) DUMMY CF1 2214
167 FORMAT(A4) CF1 2215
168 NFOUND = 0 CF1 2216
C CF1 2217
C --- READ INDICATOR VARIABLE OBSERVATION CARDS. CF1 2218
C CF1 2219
NIVOS = 0 CF1 2220
IF(IQ(33).EQ.0) GO TO 178 CF1 2230
JC = MNIVOC CF1 2231
NIVOC = IQ(33) CF1 2232
IF(NIVOC.LE.JC) JC=NIVOC CF1 2233
DO 170 J=1, JC CF1 2234
NIVOS = NIVOS + 7 CF1 2235
J1 = NIVOS - 6 CF1 2236
170 READ(KTIN,171) (JIVOS(I), JIV(I), I=J1,NIVOS) CF1 2237
171 FORMAT( 7(I4,2X,I3,1X) ) CF1 2238
172 IF(JIVOS(NIVOS).NE.0) GO TO 174 CF1 2239
NIVOS = NIVOS - 1 CF1 2240
IF(NIVOS.NE.0) GO TO 172 CF1 2250
WRITE(KTOU,173) NIVOC CF1 2251
173 FORMAT(1H0//1X,6H******,I2,33H INDICATOR VARIABLE CARD(S) WITH , CF1 2252
1 57H(7(I4,2X,I3,1X) FORMAT REQUESTED, NO OBSERVATION NUMBERS , CF1 2253
2 14HFOUND. ******/) CF1 2254
174 WRITE(KTOU,266) CF1 2255
266 FORMAT(1H0,50HOBSERVATIONS AND INDICATOR VARIABLES INTO WHICH A , CF1 2256
1 19H1 IS TO BE INSERTED ) CF1 2257
WRITE(KTOU,268) (JIVOS(I), JIV(I), I=1,NIVOS) CF1 2258
268 FORMAT(1H ,10X, 7(I4,1X,I3,4X) / (11X, 7(I4,1X,I3,4X)) ) CF1 2259
IF(NIVOC.LE.MNIVOC) GO TO 178 CF1 2260
WRITE(KTOU,175) MNIVOC, NIVOC CF1 2261
175 FORMAT(1H0//////1X, 45H******THIS VERSION OF PROGRAM DIMENSIONED CF1 2262
1FOR,I2,39H INDICATOR-VARIABLE-OBSERVATIONS CARDS.,I3, CF1 2263
2 33H REQUESTED. NOT ALL OBSERVATIONS/7X, CF1 2264
3 33HHAVE INDICATOR VARIABLES. ******//////) CF1 2265
JC = JC + 1 CF1 2266
DO 176 J = JC, NIVOC CF1 2267
176 READ(KTIN,177) DUMMY CF1 2268
177 FORMAT(A4) CF1 2269
178 JFOUND = 0 CF1 2270
C CF1 2271
C --- CHECK FOR TRANSFORMATION CARD INDICATOR + READ IN CF1 2272
IF(IQ(3) ) 54, 54, 48 CF1 2273
48 NOBSP =NOVAR/7 CF1 2274
IF(MOD(NOVAR,7)) 6001,6001,6003 CF1 2275
6001 NOBSP = NOBSP + 1 CF1 2276
6003 J2 = 0 CF1 2277
6002 J2 = J2 + 7 CF1 2280
J1 = J2 - 6 CF1 2290
IF(J2.GT.NOVAR) J2 = NOVAR CF1 2291
READ(KTIN,975)(ITRFM(JZ),VARTR(JZ),ITLOC(JZ),IOMIT(JZ), CF1 2300
1 AVATR(JZ),JZ=J1,J2 ) CF1 2310
975 FORMAT(I2,F5.0,I2,I1, T1,2X,A5,3X, I2,F5.0,I2,I1, T11,2X,A5,3X, CF1 2320
1 I2,F5.0,I2,I1, T21,2X,A5,3X, I2,F5.0,I2,I1, T31,2X,A5,3X, CF1 2321
2 I2,F5.0,I2,I1, T41,2X,A5,3X, I2,F5.0,I2,I1, T51,2X,A5,3X, CF1 2322
3 I2,F5.0,I2,I1, T61,2X,A5,3X) CF1 2323
C***** NOTE THE T FORMAT IS AN IBM 360 METHOD USED TO GO BACK CF1 2330
C TO COLUMN 1 (T1) AND REREAD THE TRANSFORMATION CARD WITH THE CF1 2340
C FORMAT THAT FOLLOWS. IN THE IBM 7044 READ 18 IS USED TO REREAD CF1 2350
C 80 COLUMNS WITH A DIFFERENT FORMAT. THE CARDS USED ARE CF1 2360
C READ(KTIN,975)(ITRFM(JZ),VARTR(JZ),ITLOC(JZ),IOMIT(JZ),JZ= J1,J2) CF1 2370
C 975 FORMAT(7(I2, F5.0, I2, I1)) CF1 2380
C READ(18,990) (AVATR(JZ),JZ=J1,J2 ) CF1 2390
C 990 FORMAT(7(2X,A5,3X)) CF1 2400
C***** CF1 2410
IF(J2.LT.NOVAR) GO TO 6002 CF1 2420
C PUNCH FOR CONFIDENCE INTERVAL CALCULATIONS*******************CF1 2430
IF(IQ(9) - 1 ) 54, 58, 54 CF1 2440
58 WRITE(KTPCH,992) (ITRFM(JZ),AVATR(JZ),ITLOC(JZ),IOMIT(JZ), JZ=1, CF1 2450
1 NOVAR ) CF1 2460
C CARD OUTPUT FOR TRANSFORMATIONS IF CONFIDENCE INTVL PUNCH-OUTCF1 2470
992 FORMAT(7(I2, A5, I2, I1)) CF1 2480
C CF1 2490
C --- READ EQUATION AND NAMES OF VARIABLES FOR DISPLAY ON PRINTOUT CF1 2500
C --- IF DESIRED CF1 2510
C CF1 2520
54 IF(IQ(23).EQ.0) GO TO 11 CF1 2530
IF(IQ(23).LE.MXINFC) GO TO 12 CF1 2531
WRITE(KTOU,803) MXINFC, IQ(23) CF1 2532
803 FORMAT(1H0//////1X, 45H******THIS VERSION OF PROGRAM DIMENSIONED CF1 2533
1FOR,I3,19H INFORMATION CARDS,,I3,26H REQUESTED. ALL PROBLEMS , CF1 2534
2 8HFLUSHED.) CF1 2535
CALL EXIT CF1 2536
12 NEQU = IQ(23)*12 CF1 2540
READ(KTIN,802)(EQU(I),I=1,NEQU) CF1 2550
802 FORMAT( 12A6 ) CF1 2560
WRITE(KTOU,270) CF1 2561
270 FORMAT(1H0,17HINFORMATION CARDS ) CF1 2562
WRITE(KTOU,272) (EQU(I), I=1,NEQU) CF1 2563
272 FORMAT(1H ,10X, 12A6 / (11X, 12A6) ) CF1 2564
11 IF(IQ(24) - 1) 600, 602, 604 CF1 2570
600 DO 601 I = 1, NOVAR CF1 2580
601 BI(I) = EBLANK CF1 2590
IQ(24) = 1 CF1 2591
GO TO 13 CF1 2600
602 READ(KTIN,603) (BI(I), I=1,NOVAR) CF1 2610
603 FORMAT( 7(A6,4X) ) CF1 2620
C --- SAVE NAMES OF VARIABLES CF1 2630
13 WRITE(KTBIN1) (BI(I), I=1,NOVAR) CF1 2640
GO TO 614 CF1 2650
604 READ(KTBIN1) (BI(I), I=1,NOVAR) CF1 2660
REWIND KTBIN1 CF1 2670
WRITE(KTBIN1) (BI(I), I=1,NOVAR) CF1 2680
614 IF(IQ(24).EQ.0) GO TO 154 CF1 2681
IF(IQ(3).EQ.1) GO TO 154 CF1 2682
WRITE(KTOU,273) CF1 2683
273 FORMAT(1H0,18HNAMES OF VARIABLES ) CF1 2684
WRITE(KTOU,274) (BI(I),I=1,NOVAR) CF1 2685
274 FORMAT(1H ,10X, 10(A6,6X) / (11X, 10(A6,6X)) ) CF1 2686
154 IF(IQ(3).EQ.0) GO TO 155 CF1 2687
C --- LIST TRANSFORMATIONS CF1 2688
CALL TRANPT CF1 2689
155 IF(IQ(26).EQ.0) GO TO 14 CF1 2700
C --- READ VARIABLES TO BE SEARCHED IN CP SUBROUTINE CF1 2710
J1 = 12 CF1 2720
IF(IQ(21).GT.12) J1 = IQ(21) CF1 2730
READ(KTIN,152) (ICP(I),I=1,J1) CF1 2740
152 FORMAT( 18(2X,I2) ) CF1 2750
WRITE(KTOU,278) CF1 2751
278 FORMAT(1H0,43HVARIABLES ON FIRST CP FACTORIAL SEARCH CARD ) CF1 2752
605 IF(ICP(J1).NE.0) GO TO 606 CF1 2753
J1 = J1 - 1 CF1 2754
IF(J1.NE.0) GO TO 605 CF1 2755
606 WRITE(KTOU,279) (ICP(I),I=1,J1) CF1 2756
279 FORMAT(1H ,10X, 10(I4,8X) / (11X, 10(I4,8X)) ) CF1 2760
14 WRITE(KTOU,280) CF1 2761
280 FORMAT(1H0) CF1 2762
RETURN CF1 2770
3000 CONTINUE CF1 2780
ITON=1 CF1 2781
RETURN CF1 2782
END CF1 2800
SUBROUTINE STAT(ISIZE,IRTRN) CF2 0010
C CF2 0020
C SUBROUTINE LISTS OBSERVED AND TRANSFORMED DATA, CALCULATES CF2 0030
C DEGREES OF FREEDOM, SUMS OF VARIABLES, RAW AND RESIDUAL SUMS OF CF2 0040
C SQUARES AND CROSS PRODUCTS, RANGE OF VARIABLES, MEANS AND CF2 0050
C STANDARD DEVIATION OF VARIABLES, SIMPLE CORRELATION COEFFICIENTS, CF2 0060
C AND PUNCHES CARDS FOR CONFIDENCE INTERVAL AND CP PROGRAMS. CF2 0070
C CF2 0080
IMPLICIT REAL*8(A-H,O-Z) CF2 0090
DOUBLE PRECISION IDENT, IEND CF2 0100
DIMENSION AMAX(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, INTDUM, 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, KKK, KONE, KTWO, MNO, NFILE CF2 0320
COMMON /RRRRRR/ KTBIN1, KTBIN2, KTBIN3, KTBIN4, KTBIN5 CF2 0330
C --- EQUIVALENCE STATEMENTS IN CF 1, 2 AND 5 (IOMIT ALSO IN 3)CF2 0340
EQUIVALENCE (COM1(1),AVATR(1)), (COM1(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
71 IF(IQ(20) -2 ) 83, 144, 83 CF2 0920
83 IF(IQ(19) - 1 ) 78, 73, 84 CF2 0930
84 CALL REDATA CF2 0940
GO TO 82 CF2 0950
73 READ(NFILE,FMT,END=124) IDENT,IOBSV,ISEQ, (DATA(JZ), JZ = N,M ) CF2 0960
GO TO 82 CF2 0970
78 READ(NFILE,820,END=124) IDENT,IOBSV,ISEQ, (DATA(JZ), JZ = N,M ) CF2 0980
C DATA CARD INPUT CF2 0990
820 FORMAT(1A6, I4, I2, 10F6.3) CF2 1000
82 IF(IDENT - IEND) 85,242,85 CF2 1010
242 IF(M - NRDLMT) 241,142,142 CF2 1020
241 N = N + MP CF2 1030
M = M + MP CF2 1040
READ(NFILE,820,END=124) IDENT,IOBSV,ISEQ, (DATA(JZ), JZ = N,M ) CF2 1050
GO TO 242 CF2 1060
C CHECK OBSERVATION NO. SEQUENCE IF DESIRED CF2 1070
85 IF( IQ(6) ) 125, 125, 100 CF2 1080
C CHECK IF FIRST CARD OF OBSERVATION HAS OBSERVATION NO. CF2 1090
C LARGER THAN PREVIOUS OBSERVATION NO. CF2 1100
100 GO TO (105, 115), KSL1 CF2 1110
105 KSL1 = 2 CF2 1120
IF( IOBSV - JOBSV) 110, 110, 125 CF2 1130
C COUNT ERROR CF2 1140
110 NOERR= NOERR +1 CF2 1150
C WRITE ERROR MESSAGE CF2 1160
WRITE(KTOU,840) IOBSV,JOBSV CF2 1170
C ERROR MSG IF OBSV. NO. NOT IN ASCENDING SEQUENCE CF2 1180
840 FORMAT(11H0OBSV. NO. I4,41H IS NOT IN ASCENDING SEQUENCE W/OBSV. NCF2 1190
1O I4) CF2 1200
GO TO 125 CF2 1210
C CHECK IF CARDS WITHIN OBSERVATION HAVE SAME OBSERVATION CF2 1220
C NO. CF2 1230
115 IF(IOBSV-JOBSV)120,125,120 CF2 1240
120 NOERR=NOERR + 1 CF2 1250
WRITE(KTOU,835) JOBSV CF2 1260
C ERROR MSG IF DATA CARDS W/IN OBSV. HAVE INCORRECT OBSV. NO. CF2 1270
835 FORMAT(23H0DATA CARDS W/IN OBSV. I4, 25H HAVE INCORRECT OBSV. NO.)CF2 1280
C CHECK IF SEQUENCE NO. WITHIN OBSERVATION IS ONE + PREVIOUS CF2 1290
124 IF(NFILE.NE.KTIN) REWIND NFILE CF2 1300
IDENT = IEND CF2 1310
125 IF(IQ(7)) 140, 140, 130 CF2 1320
130 IF(ISEQ-JSEQ-1)135,140,135 CF2 1330
135 NOERR=NOERR +1 CF2 1340
C WRITE ERROR MESSAGE CF2 1350
WRITE(KTOU,845) IOBSV CF2 1360
C ERROR MSG IF SEQ. NO. OF OBSV. NOT 1 GREATER THAN PREVIOUS CF2 1370
845 FORMAT(25H0SEQ. NO. W/IN OBSV. NO. I4,10H INCORRECT) CF2 1380
C INCREMENT SEQUENCE NO. IF PRESENT ONE IN ERROR CF2 1390
ISEQ =ISEQ + 1 CF2 1400
C MAKE CURRENT SEQUENCE NO. = PREVIOUS SEQUENCE NO. CF2 1410
C MAKE CURRENT OBSV. NO = PREVIOUS OBSV. NO CF2 1420
140 JSEQ = ISEQ CF2 1430
JOBSV= IOBSV CF2 1440
IF(M - NRDLMT)141,142,142 CF2 1450
C INCREMENT COUNTERS FOR VARIABLES ON NEXT DATA CARD CF2 1460
141 N=N+MP CF2 1470
M=M+MP CF2 1480
GO TO 83 CF2 1490
142 IF(IQ(20)) 145, 145, 143 CF2 1500
143 WRITE(KTBIN5) IDENT,IOBSV,ISEQ, (DATA(JZ), JZ = 1, NRDLMT) CF2 1510
GO TO 145 CF2 1520
144 READ (KTBIN5) IDENT,IOBSV,ISEQ, (DATA(JZ), JZ = 1, NRDLMT) CF2 1530
C CF2 1540
C CHECK FOR CARD WITH WORD END IN FIRST 6 COLUMNS FOR LAST OBSVCF2 1550
145 IF(IDENT-IEND) 45,250,45 CF2 1560
45 IF((NOMIT - NFOUND).EQ.0) GO TO 146 CF2 1570
C --- DELETE KOMIT OBSERVATIONS IF REQUESTED CF2 1580
J = NFOUND + 1 CF2 1590
IF(JOMIT(J).NE.IOBSV) GO TO 146 CF2 1600
NFOUND = NFOUND + 1 CF2 1610
GO TO 247 CF2 1620
146 IF((NIVOS - JFOUND).EQ.0) GO TO 46 CF2 1630
C --- PUT 1.0 IN SPECIFIED INDICATOR VARIABLE BEFORE TRANSFORMATIONS. CF2 1640
J = JFOUND + 1 CF2 1650
IF(JIVOS(J).NE.IOBSV) GO TO 46 CF2 1660
JFOUND = JFOUND + 1 CF2 1670
JA = JIV(J) CF2 1680
IF(JA.GT.0.AND.JA.LE.NOVAR) GO TO 42 CF2 1690
WRITE(KTOU,40) IOBSV, JA CF2 1700
40 FORMAT(1H0,49H******INDICATOR VARIABLE ASSIGNED FOR OBSERVATION, CF2 1710
1I4,12H FOUND TO BE,I3,38H. A VALUE LESS THAN 1 OR GREATER THAN, CF2 1720
2 17H THE TOTAL NUMBER/7X,54HOF VARIABLES NOT ALLOWED. ASSIGNMENT CF2 1730
3SKIPPED. ****** /) CF2 1740
GO TO 46 CF2 1750
42 DATA(JA)= 1.0D0 CF2 1760
WRITE(KTOU,44) JA, IOBSV CF2 1770
44 FORMAT(1H ,42HA VALUE OF 1.0 HAS BEEN PLACED IN VARIABLE, I3, CF2 1780
1 15H OF OBSERVATION, I7) CF2 1790
C CF2 1800
C --- LIST DATA IF DESIRED CF2 1810
46 IF(IQ(10)) 147, 147, 149 CF2 1820
147 ISEQ=0 CF2 1830
C INCLUDE OBSERVATION NO. IF FIRST CARD OF OBSERVATION CF2 1840
C DATA CARD LISTING-CARD 1 OF THE OBSERVATION CF2 1850
WRITE(KTOU,825) IOBSV,ISEQ, (DATA(JZ), JZ = 1,MNO ) CF2 1860
825 FORMAT(1H I4, I6, 10F11.3) CF2 1870
IF(IQ(10).EQ.0) IQ(10) = 1 CF2 1880
KKK=10 CF2 1890
170 IF(NRDLMT - KKK)149,149,148 CF2 1900
148 KONE=KKK+1 CF2 1910
IF(NRDLMT - (KKK+10))166,166,165 CF2 1920
165 KTWO=KKK+10 CF2 1930
GO TO 167 CF2 1940
166 KTWO=NRDLMT CF2 1950
167 ISEQ=ISEQ+1 CF2 1960
WRITE(KTOU,830) ISEQ, (DATA(JZ), JZ = KONE, KTWO ) CF2 1970
C DATA CARD LISTING-CARDS OTHER THAN 1ST OF THE OBSERVATION CF2 1980
830 FORMAT(5X, I6, 10F11.3) CF2 1990
KKK=KKK+10 CF2 2000
GO TO 170 CF2 2010
C END OF LOOP WHICH READS ONE OBSERVATION CF2 2020
C CF2 2030
C INCREMENT NO. OF OBSERVATIONS COUNTER CF2 2040
149 NOOBSV = NOOBSV + 1 CF2 2050
C AFTER READING + CHECKING ALL VARIABLES, CHECK IF ANY SEQUEN- CF2 2060
C CING ERRORS OCCURRED. IF NONE OCCUR, CONTINUE PROCESSING THE CF2 2070
C OBSERVATION. IF THE NO. OF ERRORS IS LESS THAN FIVE, CONTINUECF2 2080
C READING DATA + CHECKING THE SEQUENCE W/O PROCESSING. WHEN THECF2 2090
C NO. OF ERRORS REACHES FIVE, CONTINUE READING DATA BUT DISCON-CF2 2100
C TINUE CHECKING SEQUENCING + PROCESSING. PRINTER MESSAGES CF2 2110
C NOTIFY USER OF THESE ALTERNATIVES. CF2 2120
IF(NOERR)150, 185, 150 CF2 2130
150 IF(NOERR-5)247,155, 155 CF2 2140
155 GO TO (160,77), KSL2 CF2 2150
160 KSL2 = 2 CF2 2160
INSQOB = 0 CF2 2170
INSQCD = 0 CF2 2180
INTRFM = 0 CF2 2190
WRITE (KTOU,855) PR1,PR2,PR3 CF2 2200
C ERROR MSG IF MORE THAN 5 ERRORS FOUND IN SEQ CHECKING DATA CF2 2210
855 FORMAT(9H0PROBLEM 3A6,91H HAS 5 ERRORS IN SEQUENCING OF DATA. PROBCF2 2220
1LEM SKIPPED AT THIS POINT. NO FURTHER DATA CHECKS.) CF2 2230
GO TO 77 CF2 2240
C DO ALGEBRAIC TRANSFORMATIONS ON SCALED DATA CF2 2250
185 IF(IQ(3) ) 230,230,190 CF2 2260
190 CALL TRANSF CF2 2270
C CHECK IF ANY SPILLS IN DOING TRANSFORMATIONS CF2 2280
C COMPUTE RAW SUMS + CROSS PRODUCTS, WEIGHTED OR UNWEIGHTED CF2 2290
230 IF(KNVP1.GT.MXVPAT) GO TO 77 CF2 2300
IF(IQ(4) ) 235,235,240 CF2 2310
235 DATA(NVP1) = 1.0 CF2 2320
C --- WEIGHT OBSERVATION BY 1/(VARIANCE OF OBSERVATION) CF2 2330
240 IF(IQ(4).EQ.2) DATA(NVP1)=1.0/ DATA(NVP1) CF2 2340
DO 243 J=1, KNOVAR CF2 2350
243 Z(J, KNVP1) = Z(J, KNVP1) + DATA (J) * DATA(NVP1) CF2 2360
IF(IQ(5).EQ.0) GO TO 246 CF2 2370
DO 245 J=1, KNOVAR CF2 2380
DO 245 M=J, KNOVAR CF2 2390
245 Z(J,M) = Z(J, M) + DATA(J) * DATA (M) * DATA (NVP1) CF2 2400
C CHECK FOR SPILLS CF2 2410
246 KNVP1 = KNVP1 CF2 2420
Z(KNVP1, KNVP1) = Z(KNVP1, KNVP1) + DATA(NVP1) CF2 2430
C WRITE OBSERVATION ON BINARY TAPE -FOR LATER USE- CF2 2440
DATA(KNVP1) = DATA(NVP1) CF2 2450
WRITE(KTBIN3) IDENT,IOBSV, (DATA(JZ), JZ = 1, KNVP1 ) CF2 2460
247 JOBSV=IOBSV CF2 2470
C END OF LOOP FOR READING ALL OBSERVATIONS CF2 2480
GO TO 77 CF2 2490
250 IF((NIVOS - JFOUND).EQ.0) GO TO 254 CF2 2500
WRITE(KTOU,251) NIVOS, JFOUND CF2 2510
251 FORMAT(1H0//1X,6H******,I3,29H OBSERVATIONS WITH INDICATOR , CF2 2520
1 21HVARIABLES REQUESTED. ,I3,15H FOUND. ******/) CF2 2530
254 IF(NOERR) 255, 265, 255 CF2 2540
255 WRITE(KTOU,860) PR1,PR2,PR3, NOERR CF2 2550
C ERROR MSG IF LESS THAN 5 ERRORS FOUND AFTER ALL SEQ CHECKS CF2 2560
C COMPLETED. CF2 2570
860 FORMAT(9H0PROBLEM 3A6,10H SKIPPED. I2,93H ERRORS. IF THE NO. OF ERCF2 2580
1RORS IS LESS THAN 5, ALL THE OBSERVATIONS HAVE BEEN SEQUENCE CHECKCF2 2590
2ED) CF2 2600
C --- READ REMAINING CP SEARCH CARDS AND ESTIMATE OF VARIANCE CARDS, IF CF2 2610
C --- ANY, AND THEN RETURN TO READ NEXT CONTROL CARD. CF2 2620
9010 JC = 0 CF2 2630
IF(IQ(25).EQ.3) JC = 1 CF2 2640
I = NOVAR - NOIND CF2 2650
JC = (JC + IQ(26))*I CF2 2660
IF(JC.LT.2) GO TO 9014 CF2 2670
DO 9012 J = 2, JC CF2 2680
9012 READ(KTIN,9013) DUMMY CF2 2690
9013 FORMAT(A4) CF2 2700
9014 IRTRN=2 CF2 2710
RETURN CF2 2720
C FINALIZE THE NO. VARIABLE QUANTITIES CF2 2730
265 NOVAR = KNOVAR CF2 2740
NOIND = KNOIND CF2 2750
NODEP = KNODEP CF2 2760
NVP1 = KNVP1 CF2 2770
C CALCULATE DEGREES OF FREEDOM + CHECK CF2 2780
XNOOBS = Z(NVP1, NVP1) CF2 2790
XNOVAR = NOVAR CF2 2800
XNOIND = NOIND CF2 2810
RNOOBS = NOOBSV CF2 2820
DEFR = RNOOBS - XNOIND - BZRO CF2 2830
IF(KNOIND+KNODEP-MXVRAT)299,299,296 CF2 2840
296 WRITE(KTOU,297) MXVRAT CF2 2850
TYPE 297,MXVRAT CF2 2851
297 FORMAT(1H0///94H0AFTER PERFORMING TRANSFORMATIONS, THE NUMBER OF CF2 2860
1INDEPENDENT PLUS DEPENDENT VARIABLES EXCEEDS ,I3/17H0PROBLEM SKIPPCF2 2870
2ED. ) CF2 2880
GO TO 9010 CF2 2890
299 IF(DEFR) 266, 266, 267 CF2 2900
266 WRITE(KTOU,935) DEFR CF2 2910
TYPE 935, DEFR CF2 2911
C PRINTER + TAPE MSG IF DEGREES OF FREEDOM ZERO OR NEGATIVE CF2 2920
935 FORMAT(40H0THE CALCULATED DEGREES OF FREEDOM ARE F5.0,39H NO FURTCF2 2930
1HER CALCULATIONS. NEXT PROBLEM.) CF2 2940
GO TO 9010 CF2 2950
C PUNCH XNOBS, DEGREES OF FREEDOM, KNOIND + KNODEP FOR CONFDNCECF2 2960
C INTERVAL CALCULATIONS. CF2 2970
267 IF(IQ(9) - 1 ) 269, 268, 269 CF2 2980
268 CONTINUE CF2 2981
C 268 WRITE (KTPCH,1020) XNOOBS, DEFR, KNOIND, KNODEP CF2 2990
C HEXADECIMAL PUNCHOUT FOR CONFIDENCE INTERVAL PROGRAM***********CF2 3000
C 1020 FORMAT(5Z16) CF2 3010
C LIST TRANSFORMED DATA IF DESIRED CF2 3020
269 REWIND KTBIN3 CF2 3030
IQ(11) = IQ(11) - 1 CF2 3040
IF(IQ(3)) 3032,3032,263 CF2 3050
C CF2 3060
263 IF(IQ(11).EQ.2) GO TO 264 CF2 3070
CALL TRANPT CF2 3080
264 IF(KNOIND)282,282,281 CF2 3090
281 IF(KNODEP)283,283,284 CF2 3100
282 WRITE(KTOU,286) CF2 3110
TYPE 286 CF2 3111
286 FORMAT(1H0///74H0AFTER PERFORMING THE TRANSFORMATIONS, THERE ARE NCF2 3120
1O INDEPENDENT VARIABLES./17H0PROBLEM SKIPPED.) CF2 3130
GO TO 9010 CF2 3140
283 WRITE(KTOU,287) CF2 3150
TYPE 287 CF2 3151
287 FORMAT(1H0///72H0AFTER PERFORMING THE TRANSFORMATIONS, THERE ARE NCF2 3160
1O DEPENDENT VARIABLES./17H0PROBLEM SKIPPED.) CF2 3170
GO TO 9010 CF2 3180
C CF2 3190
284 IF(IQ(11)) 1014, 1012, 2000 CF2 3200
1012 WRITE(KTOU,1013) KNOIND, KNODEP CF2 3210
1013 FORMAT(40H0FIRST OBSERVATION AFTER TRANSFORMATIONS , 6X, CF2 3220
1 24HTHE FITTED EQUATION HAS ,I2, CF2 3230
224H INDEPENDENT VARIABLES, I2,22H DEPENDENT VARIABLE(S) / ) CF2 3240
GO TO 2000 CF2 3250
1014 WRITE(KTOU,864) KNOIND, KNODEP CF2 3260
864 FORMAT(27H0DATA AFTER TRANSFORMATIONS, 6X, CF2 3270
1 24HTHE FITTED EQUATION HAS ,I2, CF2 3280
224H INDEPENDENT VARIABLES, I2,22H DEPENDENT VARIABLE(S) / ) CF2 3290
2000 IF(IQ(24).EQ.0) GO TO 2014 CF2 3300
C --- PRINT NAMES OF VARIABLES IF DESIRED CF2 3310
JA = 0 CF2 3320
DO 606 J = 1, JNOVAR CF2 3330
IF(IOMIT(J).EQ.1) GO TO 606 CF2 3340
JA = JA + 1 CF2 3350
BI(JA) = BI(J) CF2 3360
606 CONTINUE CF2 3370
IF(IQ(11)) 2011,2011,3032 CF2 3380
2011 WRITE(KTOU,2012) (BI(I), I=1,NOVAR) CF2 3390
2012 FORMAT(1H ,11X,A6,9(6X,A6)/ ( 12X,A6,9(6X,A6)) ) CF2 3400
2014 WRITE(KTOU,862) CF2 3410
862 FORMAT(126H OBSV. 1-11-21 2-12-22 3-13-23 4-14-24 CF2 3420
1 5-15-25 6-16-26 7-17-27 8-18-28 9-19-29 10-CF2 3430
220-30 ) CF2 3440
C AMAX( ) AND AMIN( ) ARE LOCATIONS FOR MAX + MIN OF VARIABLES CF2 3450
3032 DO 3000 I=1,NOVAR CF2 3460
AMIN(I)=1D32 CF2 3470
AMAX(I)=-AMIN(I) CF2 3480
3000 CONTINUE CF2 3490
TYPE 1015, KNOIND, KNODEP CF2 3491
1015 FORMAT(25H0THE FITTED EQUATION HAS ,I2,23H INDEPENDENT VARIABLES,,CF2 3492
1 I3,22H DEPENDENT VARIABLE(S) /) CF2 3493
DO 275 I=1, NOOBSV CF2 3500
READ (KTBIN3) IDENT,IOBSV, (DATA(JZ), JZ = 1, NOVAR ) CF2 3510
DO 3008 JZ=1,NOVAR CF2 3520
IF(DATA(JZ)-AMIN(JZ)) 3002,3004,3004 CF2 3530
3002 AMIN(JZ)=DATA(JZ) CF2 3540
3004 IF(DATA(JZ)-AMAX(JZ)) 3008,3008,3006 CF2 3550
3006 AMAX(JZ)=DATA(JZ) CF2 3560
3008 CONTINUE CF2 3570
IF(IQ(3)) 275,275,3034 CF2 3580
3034 IF(IQ(11)) 2002,3036,275 CF2 3590
3036 IF(IQ(11).EQ.0) IQ(11) = 1 CF2 3600
2002 WRITE(KTOU,865)IOBSV,(DATA(JZ),JZ=1,NOVAR) CF2 3610
C 865 FORMAT(1H ,I4,1X,1P10E12.5/( 6X,1P10E12.5)) CF2 3620
865 FORMAT(1H ,I4, (T7,1P10E12.5) ) CF2 3630
275 CONTINUE CF2 3640
C --- W1( ) IS THE LOCATION FOR THE RANGE OF VARIABLES CF2 3650
DO 3010 JZ=1,NOVAR CF2 3660
W1(JZ)=AMAX(JZ)-AMIN(JZ) CF2 3670
3010 CONTINUE CF2 3680
C LIST SUMS OF VARIABLES IF DESIRED CF2 3690
280 IF(IQ(12) ) 305,285,305 CF2 3700
285 WRITE(KTOU,870) CF2 3710
TYPE 870 CF2 3711
C SUM OF VARIABLES LISTING CF2 3720
870 FORMAT(18H0SUMS OF VARIABLES) CF2 3730
WRITE(KTOU,875) (Z(I,NVP1), I =1,NOVAR) CF2 3740
TYPE 875, (Z(I,NVP1), I=1,NOVAR) CF2 3741
875 FORMAT(6X, 1P10E12.5) CF2 3750
C --- CALCULATE MEAN CF2 3760
305 DO 2040 I=1, NOVAR CF2 3770
AVG(I)= Z(I,NVP1)/Z(NVP1,NVP1) CF2 3780
2040 Z(I,KNVP1) = 0. CF2 3790
C SAVE Z(1,1) IF JOINT CONFIDENCE INTERVAL PUNCH OUT RQSTD CF2 3800
B(30) = Z(1,1) CF2 3810
IF(IQ(5)) 307,307,290 CF2 3820
C LIST RAW SUMS OF SQUARES + CROSS PRODUCTS IF DESIRED + B0=0 CF2 3830
290 IF(IQ(13)) 306,295,306 CF2 3840
295 WRITE(KTOU,885) CF2 3850
C HEADING LINE FOR RAW SUMS OF SQUARES + CROSS PRODUCTS CF2 3860
885 FORMAT(37H0RAW SUMS OF SQUARES + CROSS PRODUCTS/126H 1-1CF2 3870
11-21 2-12-22 3-13-23 4-14-24 5-15-25 6-16-26 CF2 3880
2 7-17-27 8-18-28 9-19-29 10-20-30 ) CF2 3890
DO 300 J=1, NOVAR CF2 3900
WRITE(KTOU,865) J, (Z(JZ,J), JZ = 1,J ) CF2 3910
300 CONTINUE CF2 3920
C PUNCH RAW SUMS + CROSS PRODUCTS, TRIANGULAR, IF CONFIDENCE CF2 3930
C INTERVAL DATA NEEDED + BZERO = 0. CF2 3940
306 IF(IQ(9) - 1 ) 325,308,325 CF2 3950
C HEXADECIMAL PUNCHOUT FOR CONFIDENCE INTERVAL PROGRAM CF2 3960
308 CONTINUE CF2 3961
C 308 WRITE(KTPCH,1020)((Z(JZA,JZB),JZB=1,KNOIND),JZA=1,KNOIND) CF2 3970
GO TO 325 CF2 3980
C --- CF2 3990
C --- TAKE MEAN OUT OF EACH OBSERVATION OF INDEPENDENT VARIABLES CF2 4000
C --- CF2 4010
307 REWIND KTBIN3 CF2 4020
DO 2038 I = 1, KNOVAR CF2 4030
DO 2038 M = I, KNOVAR CF2 4040
2038 Z(I,M) = 0. CF2 4050
DO 2035 J = 1, NOOBSV CF2 4060
READ (KTBIN3) IDENT,IOBSV, (DATA(JZ), JZ = 1, KNVP1 ) CF2 4070
DO 2036 I = 1, KNOVAR CF2 4080
2036 DATA(I) = DATA(I) - AVG(I) CF2 4090
C --- COMPUTE RAW SUMS AND CROSS PRODUCTS - WITH MEAN REMOVED CF2 4100
C --- THEY EQUAL THE RESIDUAL SUMS AND CROSS PRODUCTS. CF2 4110
C --- THESE VALUES ARE USED TO CALCULATE INVERSE MATRIX CF2 4120
DO 2037 I=1, KNOVAR CF2 4130
DO 2037 M = I, KNOVAR CF2 4140
2037 Z(I,M) = Z(I, M) + DATA(I) * DATA (M) * DATA (KNVP1) CF2 4150
2035 CONTINUE CF2 4160
C PUNCH RESIDUALS IF CONFIDENCE INTERVAL DATA NEEDED + BZERO CF2 4170
C NOT EQUAL TO 0. CF2 4180
IF(IQ(9) - 1 ) 314, 312, 314 CF2 4190
C HEXADECIMAL PUNCHOUT FOR CONFIDENCE INTERVAL PROGRAM***********CF2 4200
312 CONTINUE CF2 4201
C 312 WRITE(KTPCH,1020)((Z(JZA,JZB),JZB=1,KNOIND),JZA=1,KNOIND) CF2 4210
C LIST RESIDUALS IF DESIRED CF2 4220
314 IF(IQ(14) ) 325,315,325 CF2 4230
315 WRITE(KTOU,895) CF2 4240
C RESIDUAL SUMS CF2 4250
895 FORMAT(42H0RESIDUAL SUMS OF SQUARES + CROSS PRODUCTS) CF2 4260
DO 320 J=1, NOVAR CF2 4270
320 WRITE(KTOU,865) J, (Z(JZ,J), JZ = 1,J ) CF2 4280
C CHECK DIAGONALS OF RESIDUALS CF2 4290
325 NOVM1 =NOVAR-1 CF2 4300
DO 350 I=1, NOVAR CF2 4310
IF(Z(I,I).GT.1.0D-07) GO TO 340 CF2 4320
335 WRITE(KTOU,905) I CF2 4330
TYPE 905, I CF2 4331
905 FORMAT(34H0RESIDUAL DIFFERENCE FOR VARIABLE I2,31H IS ZERO. VARIABCF2 4340
1LE IS CONSTANT.) CF2 4350
C **** PROGRAM GIVES UP IF Z(I,I) = 0 CF2 4360
WRITE (KTOU,906) CF2 4370
TYPE 906 CF2 4371
906 FORMAT(16H PROBLEM SKIPPED) CF2 4380
GO TO 9010 CF2 4390
340 SIGMA(I) = DSQRT(Z(I,I)) CF2 4400
350 Z(I,I) = 1. CF2 4410
C SAVE DEPENDENT VARIABLE PORTION ABOVE DIAGONAL OF THE RESIDU-CF2 4420
C AL MATRIX FOR STATISTICAL COMPUTATIONS TO COME. CF2 4430
L=NOIND+1 CF2 4440
DO 353J=L, NOVAR CF2 4450
WRITE(KTBIN2) (Z(JZ,J), JZ = 1,NOIND ) CF2 4460
353 CONTINUE CF2 4470
C --- CALCULATE ROOT MEAN SQUARE OF VARIABLE CF2 4480
IF(Z(NVP1,NVP1).GT.RNOOBS) GO TO 355 CF2 4490
354 RTDEFR = DSQRT(RNOOBS - 1.0) CF2 4500
GO TO 356 CF2 4510
355 RTDEFR = DSQRT(Z(NVP1,NVP1)-1.0) CF2 4520
356 DO 360 I=1, NOVAR CF2 4530
360 STDDEV(I)=SIGMA(I)/RTDEFR CF2 4540
C LIST CALCULATED MEANS + ROOT MEAN SQUARES IF DESIRED CF2 4550
IF(IQ(15) ) 365,362,365 CF2 4560
C --- LIST DELETED OBSERVATIONS, IF ANY. CF2 4570
362 IF(NOMIT.EQ.0) GO TO 364 CF2 4580
IF(NFOUND.EQ.0) GO TO 909 CF2 4590
WRITE(KTOU,907) CF2 4600
907 FORMAT(21H0OBSERVATIONS DELETED) CF2 4610
WRITE(KTOU,908) (JOMIT(JZ),JZ=1,NFOUND) CF2 4620
908 FORMAT(2X, 10I12) CF2 4630
IF((NOMIT-NFOUND).EQ.0) GO TO 364 CF2 4640
909 WRITE(KTOU,910) CF2 4650
910 FORMAT(23H0OBSERVATIONS NOT FOUND ) CF2 4660
J = NFOUND + 1 CF2 4670
WRITE(KTOU,908) (JOMIT(JZ),JZ=J,NOMIT) CF2 4680
364 WRITE(KTOU,911) CF2 4690
TYPE 911 CF2 4691
911 FORMAT(19H0MEANS OF VARIABLES) CF2 4700
WRITE(KTOU,875) (AVG(JZ), JZ = 1, NOVAR ) CF2 4710
TYPE 875, (AVG(JZ),JZ=1,NOVAR) CF2 4711
WRITE(KTOU,915) CF2 4720
TYPE 915 CF2 4721
915 FORMAT(31H0ROOT MEAN SQUARES OF VARIABLES ) CF2 4730
WRITE(KTOU,875) (STDDEV(JZ), JZ = 1,NOVAR ) CF2 4740
TYPE 875, (STDDEV(JZ), JZ = 1,NOVAR ) CF2 4741
C CF2 4750
C PUNCHOUTS FOR SEPARATE CP PROGRAM CF2 4760
365 GO TO(3305,369), KCP CF2 4770
3305 CONTINUE CF2 4771
C3305 WRITE(KTPCH,3307) PR1,PR2,PR3,NOVAR,NOOBSV CF2 4780
C3307 FORMAT(6HCPCPCP,3A6,2Z8) CF2 4790
C WRITE(KTPCH,1020)(STDDEV(JZ),JZ=1,NOVAR) CF2 4800
369 ISIZE = MXSIZE/NOOBSV CF2 4810
IRTRN=3 CF2 4820
RETURN CF2 4830
END CF2 4840
SUBROUTINE FIT(DE,MAXINF,NBSV,ISIZE,IRTRN) CF3 0010
C CF3 0020
C SUBROUTINE CALCULATES COEFFICIENTS OF EACH INDEPENDENT CF3 0030
C VARIABLE, CALCULATES AND LISTS STATISTICS OF FIT, CALCULATES CF3 0040
C FITTED Y VALUES AND RESIDUALS, AND ORDERS RESIDUALS, CALCULATES CF3 0050
C COMPONENT EFFECTS TABLE AND ESTIMATES ERROR FROM NEAR NEIGHBORS. CF3 0060
C CF3 0070
IMPLICIT REAL*8(A-H,O-Z) CF3 0080
DOUBLE PRECISION IDZA(1000) CF3 0090
REAL*4 DE(NBSV,ISIZE), STDRES(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 SIGMA(40), STDDEV(40), TVALUE(40), VAR(40), W1(40), CF3 0130
4 XXIN(1000), YRESID(40), YYCC(1000), YYIN(1000) CF3 0140
C --- THE DIMENSIONS OF DE(NOOBSV,ISIZE) ARE SET IN CALL FIT IN CF2. CF3 0150
C --- ISIZE = MXSIZE/NOOBSV. MXSIZE = THE DIMENSIONS OF C AND Z. CF3 0160
COMMON /AAAAAA/ COM1(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, INTDUM, 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)) CF3 0381
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)), (COM1(426),RELINF(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(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/1HE/ CF3 0510
C1020 FORMAT(5Z16) CF3 0520
IF(K411.EQ.411) GO TO 411 CF3 0530
DO 370 I = 1, NOVM1 CF3 0540
IPL1 =I+1 CF3 0550
DO 370 J=IPL1, NOVAR CF3 0560
Z(I,J)=Z(I,J)/(SIGMA(I)*SIGMA(J)) CF3 0570
C SQUARE THE TRIANGULAR R(I,J) MATRIX CF3 0580
370 Z(J,I)= Z(I,J) CF3 0590
C CHECK FOR SPILLS CF3 0600
C PUNCH R(I,J) VALUES, TRIANGULAR, IF CONFIDENCE INTERVAL DATA CF3 0610
C NEEDED. CF3 0620
IF(IQ(9) -1) 373, 372,373 CF3 0630
C HEXADECIMAL PUNCHOUT FOR CONFIDENCE INTERVAL PROGRAM***********CF3 0640
372 CONTINUE CF3 0641
C 372 WRITE(KTPCH,1020)((Z(JZA,JZB),JZB=1,KNOIND),JZA=1,KNOIND) CF3 0650
C LIST THE SIMPLE CORRELATION COEFFICIENTS IF DESIRED CF3 0660
373 IF(IQ(16) ) 385,375,385 CF3 0670
375 WRITE(KTOU,920) CF3 0680
920 FORMAT(1H0,45HSIMPLE CORRELATION COEFFICIENTS, R(I,I PRIME)) CF3 0690
DO 149 J=1, NOVAR CF3 0700
149 WRITE(KTOU,3040) J, (Z(JZ,J),JZ=1,J) CF3 0710
C INVERT INDEPENDENT VARIABLE PORTION OF THE SIMPLE CORRELATIONCF3 0720
C COEFFICIENT MATRIX, R(I,J), I=J=NO. IND. VARIABLES CF3 0730
385 GO TO(3315,386), KCP CF3 0740
C CP PUNCH CF3 0750
3315 DO 3317 J = 1, NOVAR CF3 0760
3317 CONTINUE CF3 0761
C3317 WRITE(KTPCH,1020)(Z(J,JZ),JZ=1,NOVAR) CF3 0770
C ---STORE MATRIX TO BE INVERTED IN C. ORIGINAL MATRIX IN Z IS CF3 0780
C ---PRESERVED CF3 0790
386 DO 8338 I=1,NOIND CF3 0800
DO 8338 J=1,NOIND CF3 0810
8338 C(I,J)=Z(I,J) CF3 0820
NNNN=NOIND CF3 0830
IQPLOT = IQ(18) CF3 0831
CALL INV CF3 0840
C AFTER INVERTING, THE INVERSE IS C(I,J) CF3 0850
C CHECK FOR SPILLS CF3 0860
IF(NNNN.NE.999) GO TO 388 CF3 0870
WRITE(KTOU,387) CF3 0880
TYPE 387 CF3 0881
387 FORMAT(1H0,49H*******MATRIX OF SIMPLE CORRELATION COEFFICIENTS , CF3 0890
1 44HIS SINGULAR. MATRIX WILL NOT INVERT.******* ) CF3 0900
IRTRN=1 CF3 0910
RETURN CF3 0911
C LIST INVERSE IF DESIRED CF3 0920
388 IF(IQ(17) ) 400,390,400 CF3 0930
390 WRITE(KTOU,925) CF3 0940
C INVERSE LISTING CF3 0950
925 FORMAT(1H0,21HINVERSE, C(I,I PRIME)) CF3 0960
DO 395 I=1, NOIND CF3 0970
395 WRITE(KTOU,3040) I, (C(I,JZ),JZ=1,I) CF3 0980
C --- ***NORMAL FORMAT CF3 0990
C3040 FORMAT(1H ,I4, 1X,10(F12.3)/( 6X, 10F12.3) ) CF3 1000
C --- ***FORMAT USED TO CHECK PRECISION OF CALCULATIONS CF3 1010
C3040 FORMAT(1H ,I4, 1X, 6(1PE18.11, 2X)/ ( 6X, 6(1PE18.11, 2X)) ) CF3 1020
C --- *** CF3 1030
3040 FORMAT(1H ,I4, (T7,10F12.3) ) CF3 1040
C BEGIN CALCULATIONS FOR EACH DEPENDENT VARIABLE CF3 1050
400 REWIND KTBIN2 CF3 1060
C PUNCH REMAINDER OF NON-REPITITIVE DATA FOR CONFIDENCE INTER- CF3 1070
C VAL CALCULATIONS. CF3 1080
IF(IQ(9) -1 ) 401,510,401 CF3 1090
C PUNCH MEANS OF THE INDEPENDENT VARIABLES CF3 1100
C HEXADECIMAL PUNCHOUT FOR CONFIDENCE INTERVAL PROGRAM***********CF3 1110
510 CONTINUE CF3 1111
C 510 WRITE(KTPCH,1020)(AVG(JZ),JZ=1,KNOIND) CF3 1120
C PUNCH INVERSE OF R(I,J) MATRIX CF3 1130
C HEXADECIMAL PUNCHOUT FOR CONFIDENCE INTERVAL PROGRAM***********CF3 1140
C WRITE(KTPCH,1020)((C(JZA,JZB),JZB=1,KNOIND),JZA=1,KNOIND) CF3 1150
C REARRANGE TRFMTN INFO IF BACK TRANSFORMING DEPENDENT VARIABLECF3 1160
401 IF(IQ(3) ) 406,406,402 CF3 1170
402 IF(IQ(8) ) 406,406,403 CF3 1180
403 K=1 CF3 1190
DO 405 I=1, JNOVAR CF3 1200
IF(IOMIT(I)) 404, 404, 405 CF3 1210
404 ITRFM(K) = ITRFM(I) CF3 1220
VARTR(K) = VARTR(I) CF3 1230
K =K+1 CF3 1240
405 CONTINUE CF3 1250
406 NCP = IQ(25) + IQ(26) CF3 1260
WNOBS = Z(KNVP1,KNVP1) CF3 1261
J = NOVAR - NOIND CF3 1270
IF(NCP.LT.1.AND.IQ(27).LT.1.AND.J.EQ.1.AND.IQ(18).LT.2) GO TO 410 CF3 1280
C --- STORE SIMPLE CORR. COEFS. AND INVERSE WHEN IQ(25) AND IQ(26)=1 CF3 1290
407 DO 408 I = 1, NOIND CF3 1300
408 WRITE(KTBIN1) (C(I,J), J = I,NOIND) CF3 1310
DO 409 I = 1, NOVAR CF3 1320
409 WRITE(KTBIN1) (Z(I,J), J = I,NOVAR ) CF3 1330
WRITE(KTBIN1) (AMAX(J), J=1,NOVAR) CF3 1340
WRITE(KTBIN1) (AMIN(J), J=1,NOVAR) CF3 1350
WRITE(KTBIN1) (AVG(J), J=1,NOVAR) CF3 1360
WRITE(KTBIN1) (SIGMA(J), J=1,NOVAR) CF3 1370
WRITE(KTBIN1) (STDDEV(J),J=1,NOVAR) CF3 1380
WRITE(KTBIN1) (W1(J), J=1,NOVAR) CF3 1390
WRITE(KTBIN1) WNOBS CF3 1391
C SET LOOP TO CALCULATE STATISTICS FOR EACH DEPENDENT VARIABLE CF3 1400
410 K = L CF3 1410
411 RSQD = 0.0 CF3 1420
K411 = 0 CF3 1430
BZERO =0.0 CF3 1440
SUMB =0.0 CF3 1450
REWIND KTBIN3 CF3 1460
YYMIN = 1E32 CF3 1470
YCMIN =1E32 CF3 1480
YYMAX = -YYMIN CF3 1490
YCMAX = -YCMIN CF3 1500
ICURY = K - NOIND CF3 1510
C READ RESIDUAL VALUES FOR DEPENDENT VARIABLES CF3 1520
READ(KTBIN2) (YRESID(JZ), JZ =1,NOIND ) CF3 1530
IF(ICURY.EQ.1) GO TO 418 CF3 1540
C --- READ SIMPLE CORR. COEFS. AND INVERSE WHEN IQ(25) AND IQ(26)=1 CF3 1550
REWIND KTBIN1 CF3 1560
IF(IQ(24).EQ.0) GO TO 412 CF3 1570
READ(KTBIN1) ( DUM, I=1, NOVAR) CF3 1580
412 DO 413 I = 1, NOIND CF3 1590
413 READ(KTBIN1) (C(I,J), J = I,NOIND) CF3 1600
C SQUARE C MATRIX. CF3 1610
NOIM1 = NOIND - 1 CF3 1620
DO 414 I = 1, NOIM1 CF3 1630
IPL1 =I+1 CF3 1640
DO 414 J = IPL1, NOIND CF3 1650
414 C(J,I)= C(I,J) CF3 1660
DO 416 I = 1, NOVAR CF3 1670
416 READ(KTBIN1) (Z(I,J), J = I,NOVAR ) CF3 1680
READ(KTBIN1) (AMAX(J), J=1,NOVAR) CF3 1690
READ(KTBIN1) (AMIN(J), J=1,NOVAR) CF3 1700
READ(KTBIN1) (AVG(J), J=1,NOVAR) CF3 1710
READ(KTBIN1) (SIGMA(J), J=1,NOVAR) CF3 1720
READ(KTBIN1) (STDDEV(J),J=1,NOVAR) CF3 1730
READ(KTBIN1) (W1(J), J=1,NOVAR) CF3 1740
READ(KTBIN1) WNOBS CF3 1741
C SQUARE Z MATRIX. CF3 1750
DO 417 I = 1, NOVM1 CF3 1760
IPL1 = I + 1 CF3 1770
DO 417 J = IPL1, NOVAR CF3 1780
417 Z(J,I)= Z(I,J) CF3 1790
C WRITE HEADING LINE FOR STATISTICS CF3 1800
418 WRITE(KTOU,5101) PR1,PR2,PR3,ICURY,BI(K), AMIN(K), AMAX(K), W1(K) CF3 1810
5101 FORMAT(1H1,38X,42HLINEAR LEAST-SQUARES CURVE-FITTING PROGRAM// CF3 1820
1 1X, 3A6,9H DEP VAR,I2,2H: ,A6, 22X,8HMIN Y = , CF3 1830
2 1PE10.3,2X,8HMAX Y = ,1PE10.3,2X,10HRANGE Y = ,1PE10.3/ ) CF3 1840
TYPE 5100,PR1,PR2,PR3,ICURY,BI(K),AMIN(K),AMAX(K),W1(K) CF3 1841
5100 FORMAT(//1H ,3A6,9H DEP VAR,I2,2H: ,A6,22X,8HMIN Y = ,1PE10.3,2X,CF3 1842
1 8HMAX Y = ,1PE10.3,2X,10HRANGE Y = ,1PE10.3/) CF3 1843
IF(IQ(23).LT.1) GO TO 942 CF3 1850
NEQU = IQ(23)*12 CF3 1860
WRITE(KTOU,943) (EQU(I), I=1, NEQU ) CF3 1870
943 FORMAT(1H , 18X, 12A6 ) CF3 1880
942 IF(NOMIT.EQ.0) GO TO 944 CF3 1881
IF(NFOUND.EQ.0) GO TO 909 CF3 1882
WRITE(KTOU,907) (JOMIT(JZ),JZ=1,NFOUND) CF3 1883
907 FORMAT(19X,22HOBSERVATIONS DELETED: ,8(I4,2X),7(/41X,8(I4,2X))) CF3 1884
IF((NOMIT-NFOUND).EQ.0) GO TO 944 CF3 1885
J = NFOUND + 1 CF3 1886
909 WRITE(KTOU,910) (JOMIT(JZ),JZ=J,NOMIT) CF3 1887
910 FORMAT(19X,24HOBSERVATIONS NOT FOUND: ,8(I4,2X),7(/43X,8(I4,2X))) CF3 1888
944 WRITE(KTOU,945) CF3 1889
TYPE 945 CF3 1890
945 FORMAT(1H0,10HIND.VAR(I),3X,4HNAME,4X,9HCOEF.B(I),6X, CF3 1900
110HS.E. COEF.,3X,7HT-VALUE,3X,8HR(I)SQRD,4X,8HMIN X(I),7X, CF3 1910
28HMAX X(I),6X,10HRANGE X(I),2X,12HREL.INF.X(I) ) CF3 1920
C CALCULATE BETA VALUES CF3 1930
DO 420 I=1, NOIND CF3 1940
BETA(I) = 0.0 CF3 1950
DO 419 J=1, NOIND CF3 1960
C --- K IS THE POSITION OF THE DEPENDENT VARIABLE CF3 1970
419 BETA(I)=BETA(I)+C(I,J)*Z(J,K) CF3 1980
C CALCULATE B(I), COEFFICIENTS OF EQUATION CF3 1990
B(I) =BETA(I)*SIGMA(K)/SIGMA(I) CF3 2000
C CALCULATE B(I)*X(I) FOR BZERO CALCULATIONS CF3 2010
BZERO = BZERO +(B(I)*AVG(I)) CF3 2020
C CALCULATE R ZERO SQ, OVER-ALL MULT. CORREL. COEFF. CF3 2030
420 RSQD=RSQD + BETA(I)*Z(I,K) CF3 2040
C CALC BZERO CF3 2050
BZERO =AVG(K)-BZERO CF3 2060
C CALCULATE CONSTANT TERM FOR SIGMA BETA CALC CF3 2070
FACTOR = DSQRT((1.0 - RSQD)/DEFR) CF3 2080
C CALCULATE STATISTICS + LIST FOR EACH IND. VARIABLE CF3 2090
IF(IQ(5).EQ.1) GO TO 521 CF3 2100
520 WRITE(KTOU,3012) BZERO CF3 2110
TYPE 3012, BZERO CF3 2111
C --- ***NORMAL FORMAT CF3 2120
C3012 FORMAT(1H ,5X,1H0,13X,1PE12.5) CF3 2130
C --- ***FORMAT USED TO CHECK PRECISION OF CALCULATIONS CF3 2140
C3012 FORMAT(1H ,5X,1H0,12X,1PD18.11) CF3 2150
C --- *** CF3 2160
3012 FORMAT(1H ,5X,1H0,13X,1PE12.5) CF3 2170
GO TO 523 CF3 2180
521 WRITE(KTOU,522) CF3 2190
TYPE 522 CF3 2191
522 FORMAT(1H ,5X,1H0,14X,8HB(0) = 0 ) CF3 2200
523 DO 425 I=1, NOIND CF3 2210
C CALCULATE STANDARD DEV. OF BETA CF3 2220
SGBETA = DSQRT(C(I,I)) * FACTOR CF3 2230
C CALCULATE T-VALUE AND PLACE IN BETA FOR USE IN CPMAIN. CF3 2240
TVALUE(I) = DABS(BETA(I)/SGBETA) CF3 2250
C CALCULATE SIGMA B CF3 2260
SIGB =SGBETA*SIGMA(K)/SIGMA(I) CF3 2270
RELINF(I) = DABS(B(I)*W1(I)/W1(K)) CF3 2280
RISQRD = 1. - (1./C(I,I) ) CF3 2290
C WRITE THESE VALUES CF3 2300
WRITE(KTOU,950) I, BI(I), B(I), SIGB, TVALUE(I), RISQRD, AMIN(I), CF3 2310
1 AMAX(I), W1(I), RELINF(I) CF3 2320
TYPE 950,I,BI(I),B(I),SIGB,TVALUE(I),RISQRD,AMIN(I),AMAX(I),W1(I),CF3 2321
1 RELINF(I) CF3 2322
C --- ***NORMAL FORMAT CF3 2330
C 950 FORMAT(1H ,4X,I2,5X,A6, 2X,1PE12.5, 5X,1PE9.2,4X,0PF5.1,5X, CF3 2340
C --- ***FORMAT USED TO CHECK PRECISION OF CALCULATIONS CF3 2350
C 950 FORMAT(1H ,4X,I2,5X,A6, 1X, 1PE18.11, 1PE9.2,4X,0PF5.1,5X, CF3 2360
C --- *** CF3 2370
950 FORMAT(1H ,4X,I2,5X,A6, 2X,1PE12.5, 5X,1PE9.2,4X,0PF5.1,5X, CF3 2380
1F7.4,1PE14.3,1PE15.3,5X,1PE10.3,4X,0PF6.2 ) CF3 2390
D(I) = SIGB*SIGB CF3 2391
425 SUMB=SUMB+(B(I)*YRESID(I)) CF3 2400
C CHECK FOR SPILLS CF3 2410
C PERFORM F RATIO TEST ON OVERALL REGRESSION CF3 2420
FRATIO =RSQD*DEFR/(XNOIND*(1.0-RSQD)) CF3 2430
C CALCULATE TOTAL SUM OF SQUARES, SSYT CF3 2440
SSYT=SIGMA(K)*SIGMA(K) CF3 2450
C CALCULATE RESIDUAL SUM OF SQUARES, RSS CF3 2460
RSS = SSYT - SUMB CF3 2470
C CALCULATE RESIDUAL MEAN SQUARE, RMS CF3 2480
RMS = RSS/DEFR CF3 2490
C CALCULATE RESIDUAL ROOT MEAN SQUARE, RRMS CF3 2500
RRMS = DSQRT(RMS) CF3 2510
C LIST THE STATISTICS COMPUTED CF3 2520
IF(IQ(5).EQ.0) GO TO 421 CF3 2530
C --- REDEFINE RSQD IF B0 = ZERO CF3 2540
FACTOR = AVG(K)*AVG(K)*WNOBS CF3 2550
SSYT = SSYT - FACTOR CF3 2560
SUMB = SUMB - FACTOR CF3 2570
RSQD = SUMB/SSYT CF3 2580
421 XNOBS = DFLOAT(NOOBSV) CF3 2590
XNOIND= DFLOAT(NOIND) CF3 2591
WRITE(KTOU,3014) NOOBSV CF3 2592
TYPE 3014, NOOBSV CF3 2593
3014 FORMAT(1H0,19HNO. OF OBSERVATIONS,11X,I5) CF3 2600
WRITE(KTOU,3016) NOIND CF3 2610
3016 FORMAT(1H ,21HNO. OF IND. VARIABLES,10X,I4) CF3 2620
NDEFR=DEFR+0.01 CF3 2630
WRITE(KTOU,3018) NDEFR CF3 2640
3018 FORMAT(1H , 27HRESIDUAL DEGREES OF FREEDOM,4X,I4) CF3 2650
IF(IQ(5).EQ.1) GO TO 422 CF3 2660
WRITE(KTOU,3020) FRATIO CF3 2670
3020 FORMAT(1H ,7HF-VALUE,22X,F8.1) CF3 2680
422 WRITE(KTOU,3022) RRMS CF3 2690
3022 FORMAT(1H ,25HRESIDUAL ROOT MEAN SQUARE,3X,F16.8) CF3 2700
WRITE(KTOU,3024) RMS CF3 2710
3024 FORMAT(1H ,20HRESIDUAL MEAN SQUARE,8X,F16.8) CF3 2720
WRITE(KTOU,3026) RSS CF3 2730
TYPE 3026, RSS CF3 2731
3026 FORMAT(1H ,23HRESIDUAL SUM OF SQUARES,5X,F16.8) CF3 2740
TYPE 3028, SSYT CF3 2751
WRITE(KTOU,3028) SSYT CF3 2750
3028 FORMAT(1H ,20HTOTAL SUM OF SQUARES,6X,F18.8) CF3 2760
WRITE(KTOU,3030) RSQD CF3 2770
3030 FORMAT(1H ,27HMULT. CORREL. COEF. SQUARED,8X,F5.4) CF3 2780
C ADJRSQ = 1.-(RMS/(SSYT/DFLOAT(NOOBSV-1))) CF3 2781
C WRITE(KTOU,3031) ADJRSQ CF3 2782
C3031 FORMAT(' ADJ. MULT. CORR. COEF. SQUARED',5X,F5.4) CF3 2783
999 FORMAT(//52H0 *** PRINT OUTPUT FILE FOR COMPLETE INFORMATION ***/)CF3 2785
TYPE 999 CF3 2786
PAR = XNOBS - DEFR CF3 2787
C --- TO CALCULATE FIT AND RESIDUALS USING COEFFICIENTS SAVED FROM CF3 2790
C --- PREVIOUS RUN. CF3 2800
C --- CONTROL CARD COL 59, IQ(31)=1, WRITE B(0)AND B(I)'S ON KTBIN5 CF3 2810
C --- IQ(31)=2, READ B(0)AND B(I)'S ON KTBIN5 CF3 2820
NEWOBS = IQ(31) CF3 2821
IF(NEWOBS.EQ.0) GO TO 6901 CF3 2830
REWIND KTBIN5 CF3 2840
IF(NEWOBS.EQ.2) GO TO 6001 CF3 2850
IF(IQ(5).EQ.1) BZERO = 0.0 CF3 2860
WRITE(KTBIN5) BZERO, (B(J),J=1,NOVAR) CF3 2870
DO 6018 I = 1, NOIND CF3 2871
6018 WRITE(KTBIN5) (C(I,J),J=1,NOIND) CF3 2872
WRITE(KTBIN5) (SIGMA(J),J=1,NOIND),(AVG(J),J=1,NOIND),RRMS,WNOBS, CF3 2873
1 DEFR, PAR CF3 2874
WRITE(KTOU,6020) CF3 2880
6020 FORMAT(1H0, 39H*** COEFFICIENTS SAVED AS REQUESTED *** ) CF3 2890
GO TO 6901 CF3 2900
6001 READ(KTBIN5) BZERO, (B(J),J=1,NOVAR) CF3 2910
DO 6022 I = 1, NOIND CF3 2911
6022 READ(KTBIN5) (C(I,J),J=1,NOIND) CF3 2912
READ(KTBIN5) (SIGMA(J),J=1,NOIND),(AVG(J),J=1,NOIND),VRRMS,VNOBS, CF3 2913
1 VDEFR, VPAR CF3 2914
C SQUARE C MATRIX. CF3 2915
NOIM1 = NOIND - 1 CF3 2916
DO 6023 I = 1, NOIM1 CF3 2917
IPL1 =I+1 CF3 2918
DO 6023 J = IPL1, NOIND CF3 2919
6023 C(J,I)= C(I,J) CF3 2920
WRITE(KTOU,946) CF3 2921
946 FORMAT(1H0,10HIND.VAR(I),3X,4HNAME,4X,9HCOEF.B(I),41X, CF3 2930
18HMIN X(I),7X,8HMAX X(I),6X,10HRANGE X(I),2X,12HREL.INF.X(I) ) CF3 2940
WRITE(KTOU,6030) CF3 2950
6030 FORMAT(1H0, 38H*** COEFFICIENTS FROM PREVIOUS FIT *** ) CF3 2960
WRITE(KTOU,3012) BZERO CF3 2970
DO 6425 I=1, NOIND CF3 2980
RELINF(I) = DABS(B(I)*W1(I)/W1(K)) CF3 2990
6425 WRITE(KTOU,951) I,BI(I),B(I),AMIN(I),AMAX(I),W1(I),RELINF(I) CF3 3000
951 FORMAT(1H ,4X,I2,5X,A6, 2X,1PE12.5, 35X, CF3 3010
1 1PE14.3,1PE15.3,5X,1PE10.3,4X,0PF6.2 ) CF3 3020
RSS = 0.0 CF3 3030
6901 CALL SORT(NOIND, RELINF, LSORT ) CF3 3040
IF(NOIND.EQ.1) LSORT(1) = 1 CF3 3050
MAXINF = LSORT(NOIND) CF3 3060
NTABLE = IQ(27) CF3 3061
IF(NOOBSV.LE.MXOBSV) GO TO 3034 CF3 3070
WRITE(KTOU,3032) MXOBSV CF3 3080
3032 FORMAT(1H0//1X, 36HNUMBER OF OBSERVATIONS GREATER THAN ,I4, CF3 3090
1 36H. CALCULATIONS OF RESIDUALS SKIPPED. ) CF3 3100
GO TO 481 CF3 3110
3034 IF(NTABLE.LT.1.OR.NTABLE.GT.2) GO TO 426 CF3 3120
IF(NTABLE.GT.1) GO TO 4444 CF3 3130
C CF3 3140
C --- SET LIMIT OF EFFECT OF REQUIRED X(I) PRECISION CF3 3141
PI = 1.0 CF3 3142
PI = PI/XNOIND CF3 3143
DUM = XNOBS/(RMS*PI*12.) CF3 3144
WRITE(KTOU,2040) CF3 3145
2040 FORMAT(1H0,71X,23HREQUIRED X(I) PRECISION, /67X, 7H(DIGIT CF3 3146
126HRIGHT OF DECIMAL POSITIVE,/75X,25HLEFT OF DECIMAL NEGATIVE) ) CF3 3147
WRITE(KTOU,2042) CF3 3148
2042 FORMAT(1H0, 73X,10HIND.VAR(I),4X,5HDIGIT ) CF3 3149
DO 221 I=1,NOIND CF3 3150
D(I) = D(I)*DUM CF3 3151
IF(D(I).LE.0.) D(I)=1.0E-10 CF3 3152
DNP = DLOG10(D(I)) CF3 3153
IF(DNP.LE.0.) GO TO 876 CF3 3154
DNP = DNP/2. CF3 3155
GO TO 878 CF3 3156
876 DNP = (DNP/2.) - 1. CF3 3157
878 NP = DNP + DSIGN(.5D0,DNP) CF3 3158
IF(NP.EQ.0) NP= 1 CF3 3159
IF(AMAX(I).EQ.1.0.AND.W1(I).EQ.1.0) NP = -1 CF3 3160
IF(W1(I).EQ.0.0) NP = -1 CF3 3161
221 WRITE(KTOU,2044) I, NP CF3 3162
2044 FORMAT(1H , 77X, I2, 8X, I3 ) CF3 3163
C --- ******TRAP NOT TO EXEED DIMENTIONS OF DE(NOOBSV,ISIZE))***********CF3 3164
4444 IF(NOIND.LE.2*ISIZE) GO TO 4 CF3 3165
C --- IN SINGLE PRECISION, J=MXSIZE, IN DOUBLE J=2*MXSIZE. CF3 3166
J = 2*MXSIZE CF3 3167
WRITE(KTOU,3) J CF3 3170
3 FORMAT(1H0//48H NUMBER OF OBSERVATIONS X NUMBER OF INDEPENDENT , CF3 3180
1 17HVARIABLES EXCEEDS/1X,31HCURRENT DIMENSIONS OF COMPONENT, CF3 3190
2 39H EFFECT OR NEAR NEIGHBOR CALCULATIONS (, I5, 1H) ) CF3 3200
GO TO 426 CF3 3210
4 IF(NTABLE.GT.1) GO TO 102 CF3 3220
C --- CALCULATE COMPONENT EFFECT TABLE. CF3 3221
C --- LOAD JSORT WITH RELINF IN DECENDING ORDER. CF3 3230
NT = NOIND + 1 CF3 3240
DO 2 IA = 1, NOIND CF3 3250
JA = NT - IA CF3 3260
IB = LSORT(JA) CF3 3270
RELINF(IA) = BI(IB) CF3 3280
2 JSORT(IA) = IB CF3 3290
WRITE(KTOU,5102) CF3 3300
5102 FORMAT(1H1,38X,42HLINEAR LEAST-SQUARES CURVE FITTING PROGRAM) CF3 3310
WRITE(KTOU,5104) PR1,PR2,PR3,ICURY,BI(K) CF3 3320
5104 FORMAT(1H0, 3A6,9H DEP VAR,I2,2H: ,A6) CF3 3330
WRITE(KTOU,8) CF3 3340
8 FORMAT(1H0, 42HCOMPONENT EFFECT OF EACH VARIABLE ON EACH , CF3 3350
1 27HOBSERVATION (IN UNITS OF Y) CF3 3360
2/ 52H (VARIABLES ORDERED BY THEIR RELATIVE INFLUENCE --- , CF3 3370
363HOBSERVATIONS ORDERED BY INFLUENCE OF MOST INFLUENTIAL VARIABLE)CF3 3380
5//1X,5H SEQ., 6H OBSV., 8X, 9HVARIABLES) CF3 3390
WRITE(KTOU,9) (JSORT(I),I = 1, NOIND) CF3 3400
9 FORMAT(1H , 11X, 14(4X,I4), 5(/12X,14(4X,I4)) ) CF3 3410
WRITE(KTOU,11) (RELINF(I), I=1,NOIND) CF3 3420
11 FORMAT( 1H , 11X, 14(2X,A6), 5(/12X,14(2X,A6)) ) CF3 3430
C --- CALCULATIONS USED IN BOTH COMPONENT EFFECT AND NEAR NEIGHBORS. CF3 3431
102 DO 6 IA = 1, NOOBSV CF3 3440
READ(KTBIN3) DUM, IDZB(IA), (VAR(JZ), JZ = 1, NOVAR ) CF3 3450
YYIN(IA) = VAR(K) CF3 3460
YCALC = BZERO CF3 3470
DO 5 IB = 1, NOIND CF3 3480
YCALC = YCALC + B(IB)*VAR(IB) CF3 3490
5 DE(IA,IB) = B(IB)*(VAR(IB) - AVG(IB)) CF3 3500
6 YYCC(IA) = YCALC CF3 3510
DO 7 IC = 1, NOOBSV CF3 3520
DELTA(IC) = YYIN(IC) - YYCC(IC) CF3 3530
7 XXIN(IC) = DE(IC,MAXINF) CF3 3540
REWIND KTBIN3 CF3 3550
NTP = NOOBSV + 1 CF3 3560
NTL = NOOBSV CF3 3570
IF(NTABLE.GT.1) GO TO 103 CF3 3580
C --- MORE COMPONENT EFFECT TABLE CALCULATIONS. CF3 3581
CALL SORT(NOOBSV, XXIN, LSORT) CF3 3590
DO 12 IA = 1, NTL CF3 3600
JB = NTP - IA CF3 3610
JA = LSORT(JB) CF3 3620
DO 10 I = 1, NOIND CF3 3621
JC = JSORT(I) CF3 3622
10 XXIN(I) = DE(JA,JC) CF3 3623
12 WRITE(KTOU,13) IA, IDZB(JA), ( XXIN(I), I=1,NOIND) CF3 3630
13 FORMAT(1H , I4, 2X, I4, 2X, 14(F8.2), 5(/13X,14(F8.2)) ) CF3 3640
103 CALL SORT(NOOBSV, YYCC, LSORT) CF3 3650
JC = 4 CF3 3660
14 J = NTL*JC CF3 3670
IF(J.LE.MXOBSV) GO TO 15 CF3 3680
JC = JC - 1 CF3 3690
GO TO 14 CF3 3700
15 IC = 0 CF3 3710
DO 17 JD = 1, JC CF3 3720
NTL = NTL - 1 CF3 3730
DO 17 IA = 1, NTL CF3 3740
JA1 = LSORT(IA) CF3 3750
JB = IA + JD CF3 3760
JA2 = LSORT(JB) CF3 3770
SSD = 0.0 CF3 3780
DO 16 IB = 1, NOIND CF3 3790
ADJAY = DE(JA1,IB) - DE(JA2,IB) CF3 3800
16 SSD = SSD + (ADJAY*ADJAY) CF3 3810
IC = IC + 1 CF3 3820
DELSD(IC) = SSD/RMS CF3 3830
17 DELYN(IC) = DABS(DELTA(JA1) - DELTA(JA2) ) CF3 3840
NTL = NOOBSV CF3 3850
IC = 0 CF3 3860
DO 117 JD = 1, JC CF3 3870
NTL = NTL - 1 CF3 3880
DO 117 IA = 1, NTL CF3 3890
JA1 = LSORT(IA) CF3 3900
JB = IA + JD CF3 3910
JA2 = LSORT(JB) CF3 3920
IC = IC + 1 CF3 3930
IDRS1(IC) = IDZB(JA1) CF3 3940
117 IDRS2(IC) = IDZB(JA2) CF3 3950
WRITE(KTOU,5102) CF3 3960
WRITE(KTOU,5106) PR1,PR2,PR3,ICURY,BI(K),RRMS CF3 3970
5106 FORMAT(1H0, 3A6,9H DEP VAR,I2,2H: ,A6, 9X, CF3 3980
1 45HRESIDUAL ROOT MEAN SQUARE OF FITTED EQUATION:, F10.2 ) CF3 3990
WRITE(KTOU,18) JC CF3 4000
18 FORMAT(1H0, 47HSTANDARD DEVIATION ESTIMATED FROM RESIDUALS OF , CF3 4010
1 44HNEIGHBORING OBSERVATIONS (OBSERVATIONS 1 TO ,I1, 7H APART , CF3 4020
2 19HIN FITTED Y ORDER).//36H CUMULATIVE ---------ORDER, CF3 4030
3 59HED BY WSSD---------- ---------ORDERED BY FITTED Y--------- / CF3 4040
4 58H NO. STD DEV WSSD OBSV. OBSV. DEL RESIDUALS , CF3 4050
5 45HWSSD DEL RESIDUALS FITTED Y OBSV. SEQ. ) CF3 4060
CALL SORT( IC, DELSD, JSORT) CF3 4070
SUMDLY = 0.0 CF3 4080
XDEFR = DFLOAT(NDEFR) CF3 4090
XNOBS = DFLOAT(NOOBSV) CF3 4100
ADJAY = 1.128*DSQRT(XDEFR/XNOBS) CF3 4110
NTL = NOOBSV CF3 4111
IF(JC.EQ.1) NTL = NTL - 1 CF3 4112
DO 19 IA = 1, NTL CF3 4120
JA = JSORT(IA) CF3 4130
IC = LSORT(IA) CF3 4140
SUMDLY = SUMDLY + DELYN(JA) CF3 4150
STDDLY = SUMDLY / ( DFLOAT(IA)*ADJAY) CF3 4160
19 WRITE(KTOU,20)IA,STDDLY,DELSD(JA),IDRS1(JA),IDRS2(JA),DELYN(JA), CF3 4170
1 DELSD(IA),DELYN(IA),YYCC(IC), IDZB(IC), IA CF3 4180
20 FORMAT(1H ,I3, 2X,F8.2,4X,F8.2,2(3X,I4),3X,F8.2,3X,F8.2,2X,F8.2, CF3 4190
1 F13.2, 5X, I4, 4X, I4 ) CF3 4200
C CF3 4210
C CF3 4220
C --- CF3 4230
REWIND KTBIN1 CF3 4240
C --- REPLACE Z AND C MATRIX IF CP SEARCH IS DESIRED. CF3 4250
IF(IQ(24).EQ.0) GO TO 22 CF3 4260
READ(KTBIN1) ( DUM, I=1, NOVAR) CF3 4270
22 DO 23 I = 1, NOIND CF3 4280
23 READ(KTBIN1) (C(I,J), J = I,NOIND) CF3 4290
DO 24 I = 1, NOVAR CF3 4300
24 READ(KTBIN1) (Z(I,J), J = I,NOVAR ) CF3 4310
C --- SQUARE C AND Z MATRIX. CF3 4320
NOVM1 = NOVAR - 1 CF3 4330
DO 26 I = 1, NOVM1 CF3 4340
IPL1 = I + 1 CF3 4350
DO 26 J = IPL1, NOVAR CF3 4360
C(J,I)= C(I,J) CF3 4361
26 Z(J,I)= Z(I,J) CF3 4370
C CALCULATE FITTED Y AND LIST WITH RESIDUALS CF3 4380
C INITIALIZE B ZERO WITH ZERO IF YCALC HAS BZERO = 0 CF3 4390
426 IF(IQ(5)) 428,428,427 CF3 4400
427 BZERO = 0.0 CF3 4410
428 IF(IQ(9).NE.1) GO TO 438 CF3 4411
C HEXADECIMAL PUNCHOUT FOR CONFIDENCE INTERVAL PROGRAM***********CF3 4412
C WRITE(KTPCH,1020)RMS,BZERO,(B(JZ),JZ=1,KNOIND) CF3 4420
438 JBACK = 1 CF3 4421
IF(IQ(8).EQ.1) GO TO 430 CF3 4422
JBACK = 0 CF3 4423
C *****NOTE IF FUNCTION TABLE IS DESIRED AT ALL TIMES, PUT A C IN COL 1 CF3 4424
C *****OF IF(NTABLE---) GO TO 429, 475 AND 6903 SWITCH CARDS.********** CF3 4425
IF(NTABLE.LT.1) GO TO 429 CF3 4426
WRITE(KTOU,5102) CF3 4427
WRITE(KTOU,5104) PR1,PR2,PR3,ICURY,BI(K) CF3 4428
WRITE(KTOU,5108) CF3 4429
5108 FORMAT(1H0,46HFUNCTIONS RELATED TO THE VARIANCE OF FITTED Y., CF3 4430
1 41H OBSERVATIONS ORDERED BY COMPUTER INPUT.) CF3 4431
WRITE(KTOU,5110) CF3 4432
5110 FORMAT(1H0,26X,11HSTUDENTIZED,32X,13HDELETE-EFFECT,/1X,6HIDENT., CF3 4433
1 7H OBSV.,4X,41HRESIDUAL RESIDUAL V(Y)/RMS V(R)/RMS , CF3 4434
2 25HV(Y)/V(R) VALUE PERCENT ) CF3 4435
429 IF(NEWOBS.EQ.2) DELETE = 0.0 CF3 4440
INTER = 1 CF3 4441
IF(IQ(5).EQ.1) INTER = 0 CF3 4442
430 PAR = XNOBS - DEFR CF3 4443
IF(NEWOBS.NE.2) GO TO 439 CF3 4444
RRMS = VRRMS CF3 4445
WNOBS = VNOBS CF3 4446
PAR = VPAR CF3 4447
DEFR = VDEFR CF3 4448
C --- SET MIN VALUE OF DELETE-EFFECT FVALUE TO CALCULATE PERCENT EFFECT.CF3 4449
439 DEMIN = 0.47 CF3 4450
IF(PAR.GT.4) DEMIN = 0.90 CF3 4451
DO 475 IB = 1, NOOBSV CF3 4452
COVTY = 0. CF3 4453
READ(KTBIN3) IDZA(IB),IDZB(IB), (VAR(JZ), JZ = 1,NOVAR), WEIGHT CF3 4460
YCALC = BZERO CF3 4470
DO 440 J=1, NOIND CF3 4480
440 YCALC = YCALC + B(J) * VAR(J) CF3 4490
C INITIALIZE BACK-TRANSFORMATION ROUTINE CF3 4500
IF(JBACK ) 470,470,445 CF3 4510
445 CALL YBACK(K,YCALC) CF3 4520
CALL YBACK(K,VAR(K) ) CF3 4530
STDRES(IB) = 0.0 CF3 4531
470 DIFF = VAR(K)- YCALC CF3 4540
DELTA(IB) = DIFF CF3 4550
YYIN(IB) = VAR(K) CF3 4560
YYCC(IB) = YCALC CF3 4570
CALL MINMAX(YCMIN, YCMAX, YCALC ) CF3 4580
RSS = RSS + (DIFF * DIFF) CF3 4581
IF(JBACK.EQ.1) GO TO 475 CF3 4590
C --- COMPUTATION FOR THE COVARIANCE CONTRIBUTION TO THE STANDARD ERROR CF3 4591
C --- OF THE PREDICTED Y (COVTY) AND THE RESIDUAL (COVTR). CF3 4592
C --- CF3 4593
DO 444 J=1,NOIND CF3 4594
DO 442 I=1,NOIND CF3 4595
C --- NOTE : : : C MATRIX CONTAINS (X'X) INVERSE CF3 4596
C --- COVTY IS THE COVARIANCE CONTRIBUTION TO CF3 4597
C --- THE STANDARD ERROR OF PREDICTED Y. CF3 4598
C --- COVTR = 1. - COVTY, FOR NEW Y OBS. COVTR = 1. + COVTY. CF3 4599
COVTY=COVTY + CF3 4600
1((VAR(J)-AVG(J))*(VAR(I)-AVG(I))*C(I,J)/(SIGMA(I)*SIGMA(J))) CF3 4601
442 CONTINUE CF3 4602
444 CONTINUE CF3 4603
C --- ADD 1/SUM OF WEIGHTED OBSERVATIONS. IF NOT WEIGHTED L.S., WNOBS=N.CF3 4604
COVTY=COVTY+(1.D0 / WNOBS) CF3 4605
C --- CF3 4606
C --- COVTY IS TERM REQUIRED FOR TOLERENCE INTERVAL CALCULATIONS, CF3 4607
C --- I.E. COVAR TERM FOR PREDICTED Y. CF3 4608
COVTR = (1.D0 / WEIGHT) - COVTY CF3 4609
IF(NEWOBS.EQ.2) COVTR = (1.D0 / WEIGHT) + COVTY CF3 4610
IF(DABS(DELTA(IB)).LT.1.0D-06) DELTA(IB) = 0.0D0 CF3 4620
C --- STDRES = STANDARDIZED RESIDUAL CF3 4621
STDRES(IB) = DELTA(IB)/(DSQRT(DABS(COVTR))*RRMS) CF3 4622
IF(NTABLE.LT.1) GO TO 475 CF3 4623
C --- CALCULATE DELETE EFFECT, SEE COOK, TECHNOMETRICS, FEB. 1977. CF3 4624
VRATIO = COVTY/COVTR CF3 4625
IF(NEWOBS.EQ.2) GO TO 451 CF3 4626
DELETE = STDRES(IB)*STDRES(IB)*VRATIO/PAR CF3 4627
C --- UNLESS FVALUE(DELETE) GT DEMIN, DO NOT CALCULATE % PROBILITY. CF3 4628
IF(DELETE.LT.DEMIN) GO TO 451 CF3 4629
CALL FALPHA(PAR,DEFR,DELETE,PERCNT) CF3 4630
450 WRITE(KTOU,5112) IDZA(IB),IDZB(IB),DELTA(IB),STDRES(IB),COVTY, CF3 4640
1 COVTR,VRATIO,DELETE,PERCNT CF3 4641
5112 FORMAT(1H ,A6,I6,F13.3,3X,F5.1,5X,F7.4,3X,F7.4,4X,F5.1,5X,F5.1, CF3 4642
1 3X, F4.0 ) CF3 4643
GO TO 475 CF3 4644
451 WRITE(KTOU,5112) IDZA(IB),IDZB(IB),DELTA(IB),STDRES(IB),COVTY, CF3 4645
1 COVTR,VRATIO,DELETE CF3 4646
475 CONTINUE CF3 4647
C --- CF3 4650
IF(NEWOBS.NE.2) GO TO 6902 CF3 4660
RMS = RSS/DEFR CF3 4661
RRMS = DSQRT(RMS) CF3 4662
WRITE(KTOU,5102) CF3 4663
WRITE(KTOU,5104) PR1,PR2,PR3,ICURY,BI(K) CF3 4664
WRITE(KTOU,5114) CF3 4665
5114 FORMAT(1H0,45HFIT OF SECOND SAMPLE USING COEFFICIENTS FROM , CF3 4666
1 20HFIRST SAMPLE OF DATA) CF3 4667
WRITE(KTOU,3014) NOOBSV CF3 4668
NPAR= NOOBSV - NDEFR CF3 4670
WRITE(KTOU,3015) NPAR CF3 4680
3015 FORMAT(1H ,17HNO. OF PARAMETERS,14X,I4) CF3 4681
WRITE(KTOU,3018) NDEFR CF3 4682
RSQD = (SSYT - RSS - FACTOR) / SSYT CF3 4683
WRITE(KTOU,3022) RRMS CF3 4684
WRITE(KTOU,3024) RMS CF3 4685
WRITE(KTOU,3026) RSS CF3 4686
WRITE(KTOU,3028) SSYT CF3 4687
IF(IQ(5).EQ.1) GO TO 6902 CF3 4690
WRITE(KTOU,3030) RSQD CF3 4700
C --- ORDER RESIDUALS CF3 4710
6902 CALL SORT(NOOBSV, DELTA, LSORT) CF3 4720
NT = NOOBSV + 1 CF3 4730
IF(NTABLE.LT.1) GO TO 6903 CF3 4731
WRITE(KTOU,5102) CF3 4732
WRITE(KTOU,5104) PR1,PR2,PR3,ICURY,BI(K) CF3 4733
6903 IF(XEFMT.EQ.EFORMT) GO TO 1230 CF3 4734
C CF3 4740
REWIND KTBIN3 CF3 4750
WRITE(KTOU,1015) CF3 4760
1015 FORMAT(1H0,61H-----------------ORDERED BY COMPUTER INPUT--------- CF3 4770
1---------,3X,62H---------------------ORDERED BY RESIDUALS---------CF3 4780
2------------/1X, 6HIDENT.,2X,5HOBSV.,1X,12HWSS DISTANCE,1X,6HOBS.CF3 4790
3 Y,5X,8HFITTED Y, 5X,10HRESIDUAL ,1X,5HOBSV.,6X,6HOBS. Y, CF3 4800
45X,8HFITTED Y, 2X,14HORDERED RESID.,13H STUD.RESID. , 3HSEQ ) CF3 4810
C CF3 4820
C--- CALCULATE SQUARED STANDARDIZED DISTANCE OF EACH OBSERVATION CF3 4830
C--- FROM CENTROID OF ALL OBSERVATIONS OF INDEPENDENT VARIABLES. CF3 4840
DO 1220 IC = 1, NOOBSV CF3 4850
SSD = 0. CF3 4860
IA = NT - IC CF3 4870
JC = LSORT(IA) CF3 4880
READ(KTBIN3) IDZA(IC),IDZB(IC), (VAR(JZ), JZ = 1,NOVAR ) CF3 4890
DO 2031 J=1, NOIND CF3 4900
SDX = ( VAR(J) - AVG(J)) CF3 4910
SSDX= SDX*SDX*B(J)*B(J) CF3 4920
2031 SSD = SSD + SSDX CF3 4930
SSD = SSD/RMS CF3 4940
2032 CONTINUE CF3 4950
WRITE(KTOU,1219) IDZA(IC),IDZB(IC),SSD,YYIN(IC),YYCC(IC), CF3 4960
1DELTA(IC),IDZB(JC),YYIN(JC),YYCC(JC),DELTA(JC),STDRES(JC),IC CF3 4970
1219 FORMAT(1H ,A6, I6,2X,F6.0,3F13.3, 1X,I6,3F13.3,6X,F5.1,4X,I4) CF3 4980
1220 CONTINUE CF3 4990
GO TO 1241 CF3 5000
1230 WRITE(KTOU,1232) CF3 5010
1232 FORMAT(1H0,54H--------------ORDERED BY COMPUTER INPUT-------------CF3 5020
1--,4X,65H----------------------ORDERED BY RESIDUALS---------------CF3 5030
2--------/1X,6HIDENT.,1X,8HOBS. NO.,5X,6HOBS. Y,6X,8HFITTED Y,6X, CF3 5040
310HRESIDUAL ,2X,8HOBS. NO.,5X,6HOBS. Y,6X,8HFITTED Y,2X, CF3 5050
414HORDERED RESID.,13H STUD.RESID. , 3HSEQ) CF3 5060
IF(IQ(30).GT.NOOBSV) IQ(30) = 0 CF3 5070
NSTOP = (NOOBSV - IQ(30))/2 CF3 5080
DO 1240 IC = 1, NSTOP CF3 5090
IA = NT - IC CF3 5100
JC = LSORT(IA) CF3 5110
WRITE(KTOU,1234) IDZA(IC),IDZB(IC),YYIN(IC),YYCC(IC),DELTA(IC), CF3 5120
1IDZB(JC),YYIN(JC),YYCC(JC),DELTA(JC),STDRES(JC),IC CF3 5130
1234 FORMAT(1H ,A6,I6,3(3X,1PE11.4),3X,I6,3(3X,1PE11.4),5X,0PF5.1, CF3 5140
1 4X,I4) CF3 5141
1240 CONTINUE CF3 5150
C --- ROUND UP WHEN (NOOBSV - IQ(30) ) IS ODD NUMBER CF3 5151
NSTOP = (NOOBSV - IQ(30) + 1)/2 CF3 5152
NSTOP = NOOBSV - NSTOP + 1 CF3 5160
DO 2240 IC = NSTOP, NOOBSV CF3 5170
IA = NT - IC CF3 5180
JC = LSORT(IA) CF3 5190
2240 WRITE(KTOU,1234) IDZA(IC),IDZB(IC),YYIN(IC),YYCC(IC),DELTA(IC), CF3 5200
1IDZB(JC),YYIN(JC),YYCC(JC),DELTA(JC),STDRES(JC),IC CF3 5210
1241 IF(IQ(8).EQ.0) GO TO 1250 CF3 5220
WRITE(KTOU,1242) CF3 5230
1242 FORMAT(1H0, // 1X, 81H******OBSERVED AND FITTED Y VALUES BACK TRANCF3 5240
1SFORMED, RESIDUAL PLOTS DELETED****** ) CF3 5250
GO TO 481 CF3 5260
1250 IF(IQPLOT.LT.6) GO TO 481 CF3 5270
IF(IQPLOT.EQ.6) IQ(18)=0 CF3 5271
IF(IQPLOT.EQ.7) IQ(18)=2 CF3 5272
IF(IQPLOT.EQ.8) IQ(18)=3 CF3 5273
IF(IQPLOT.EQ.9) IQ(18)=4 CF3 5274
DO 1252 IC = 1, NOOBSV CF3 5275
1252 DELTA(IC) = DBLE(STDRES(IC))*RRMS CF3 5276
CALL SORT(NOOBSV,DELTA,LSORT) CF3 5277
481 CONTINUE CF3 5280
IRTRN=2 CF3 5290
RETURN CF3 5291
END CF3 5300
SUBROUTINE REDATA CF4 0010
C CF4 0020
C --- SUBROUTINE TO READ DATA. CAN BE REVISED TO SUIT SPECIAL NEEDS. CF4 0030
C CF4 0040
C --- CONTROL CARD SHOULD INDICATE THE NUMBER OF INDEPENDENT CF4 0050
C VARIABLES BEING RETURNED IN ARRAY LABELLED DATA(106). CF4 0060
C IDENTIFICATION CAN BE RETURNED USING A6 FORMAT IN IDENT. CF4 0070
C --- NUMBER OF OBSERVATIONS (NOOBSV) ARE COUNTED IN CF2. CF4 0080
C THE OBSERVATION NUMBER CAN BE RETURNED USING I4 FORMAT IN IOBSV. CF4 0090
C THE SEQUENCE NUMBER CAN BE RETURNED USING I2 FORMAT IN ISEQ IF CF4 0100
C DESIRED. CF4 0110
C --- DATA CAN BE READ FROM NFILE SPECIFIED IN COLUMNS 52-53 OF CF4 0120
C --- CONTROL CARD. CF4 0130
C --- ARRAYS THAT CAN BE USED IN REDATA TO SAVE COMPUTER CORE SPACE CF4 0140
C ARE COM4, LSORT AND IDZB, E.G. CF4 0150
C EQUIVALENCE (COM4,NEWARY) WHERE NEWARY IS USED IN REDATA. CF4 0160
C --- KSL2 CAN BE USED AS A SWITCH. KSL2 IS SET = 1 IN MAIN AFTER CF4 0170
C CONTROL CARD IS READ. IF KSL2 IS SET = 2 IN REDATA AFTER READING CF4 0180
C FIRST OBSERVATION, SUBSEQUENT OBSERVATIONS CAN BE READ IN CF4 0190
C DIFFERENT MANNER USING KSL2 AS A SWITCH. CF4 0200
C CF4 0210
IMPLICIT REAL*8(A-H,O-Z) CF4 0220
DOUBLE PRECISION IDENT, IEND CF4 0230
DIMENSION AVATR( 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) .NE. 0) GO TO 115 CF5 1200
DATA(KNO) = DATA(IA) CF5 1210
KNO = KNO + 1 CF5 1220
115 CONTINUE CF5 1230
KNOIND = KNO -1 CF5 1240
DO 125 IA = L, NOVAR CF5 1250
IF( IOMIT(IA) .NE. 0) GO TO 125 CF5 1260
DATA(KNO) = DATA(IA) CF5 1270
KNO = KNO +1 CF5 1280
125 CONTINUE CF5 1290
KNVP1 = KNO CF5 1300
KNOVAR= KNO -1 CF5 1310
KNODEP= KNOVAR -KNOIND CF5 1320
RETURN CF5 1330
END CF5 1340
SUBROUTINE INV CF6 0010
C CF6 0020
C SUBROUTINE INVERTS MATRIX BY THE GAUSS-JORDAN METHOD OF CF6 0030
C REDUCTION AS DESCRIBED IN MATHEMATICAL METHODS FOR DIGITAL CF6 0040
C COMPUTERS, WILEY PUB. COMMON USERS GROUP PROGRAM NO 5.0.039 CF6 0050
C CF6 0060
C LS = 0 TO OBTAIN INVERSE. CF6 0070
C LS = 1 TO OBTAIN PRODUCT FORM OF THE INVERSE. CF6 0080
C LS = 2 WHEN THE MATRIX IS SINGULAR. CF6 0090
C CF6 0100
C N IS THE NUMBER OF INDEPENDENT VARIABLES. CF6 0110
C DETT HAS THE VALUE OF THE DETERMINANT. CF6 0120
C LEXP IS THE EXPONENT OF THE DETERMINANT. CF6 0130
C INCOMING MATRIX A (C IN MAIN LINE) IS DESTROYED AND REPLACED BY CF6 0140
C THE INVERSE MATRIX. CF6 0150
C CF6 0160
IMPLICIT REAL*8(A-H,O-Z) CF6 0170
DIMENSION C(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 0430
100 IF(BETT-1.0D-30)103,102,102 CF6 0460
101 DETT=DETT/1.0D+30 CF6 0470
LEXP=LEXP+30 CF6 0480
GO TO 102 CF6 0490
103 DETT=DETT/1.0D-30 CF6 0300
LEXP=LEXP-30 CF6 0510
102 M2=M1 CF6 0520
C --- ************* TRAP IF MATRIX IS SINGULAR. THE DEFINITION OF CF6 0530
C --- ************* SINGULAR IS MACHINE DEPENDENT. CF6 0531
IF (DABS(BIG).LE.(1.D-14)) GO TO 999 CF6 0540
6 LP(M1)=L1 CF6 0550
IF(NN-1)50,51,50 CF6 0560
50 DO 8 I=2,NN CF6 0570
8 A(L1,I-1)=A(L1,I)/BIG CF6 0580
IF(L1-1)9,10,9 CF6 0590
10 LN=2 CF6 0600
13 LM=N CF6 0610
GO TO 15 CF6 0620
9 LM=L1-1 CF6 0630
LN=1 CF6 0640
15 DO 11 I=LN,LM CF6 0650
C(I)=-A(I,1) CF6 0660
IF(C(I))12,111,12 CF6 0670
111 DO 112 J=2,NN CF6 0680
112 A(I,J-1)=A(I,J) CF6 0690
GO TO 11 CF6 0700
12 DO 65 J=2,NN CF6 0710
65 A(I,J-1)=C(I)*A(L1,J-1)+A(I,J) CF6 0720
11 CONTINUE CF6 0730
IF(LN-1)19,18,19 CF6 0740
18 LN=LN+L1 CF6 0750
IF(LN-N)13,13,19 CF6 0760
19 C(L1)=1. CF6 0770
DO 77 I=1,N CF6 0780
77 A(I,NN)=C(I)/BIG CF6 0790
1 NN=NN-LS CF6 0800
55 DO 34 K=1,N CF6 0810
DO 16 J=1,N CF6 0820
16 C(J)=A(J,K) CF6 0830
DO 34 J=1,N CF6 0840
L=LP(J) CF6 0850
IF(K-J)56,34,34 CF6 0860
56 IF(LP(K)-L)34,34,57 CF6 0870
57 DETT=-DETT CF6 0880
34 A(J,K)=C(L) CF6 0890
IF(LS)70,71,70 CF6 0900
71 DO 20 J=1,N CF6 0910
DO 21 K=1,N CF6 0920
21 C(K)=A(J,K) CF6 0930
DO 20 K=1,N CF6 0940
L=LP(K) CF6 0950
20 A(J,L)=C(K) CF6 0960
RETURN CF6 0970
51 A(L1,1)=-1. CF6 0980
DO 52 I=1,N CF6 0990
52 A(I,1)=-A(I,1)/BIG CF6 1000
GO TO 55 CF6 1010
70 DO 83 I=1,N CF6 1020
J=N+1-I CF6 1030
83 A(I,J)=A(I,J)-1. CF6 1040
RETURN CF6 1050
999 N = 999 CF6 1060
RETURN CF6 1070
END CF6 1080
SUBROUTINE MINMAX(TMIN,TMAX,T ) CF7 0010
C CF7 0020
C SUBROUTINE TO FIND MINIMUM AND MAXIMUM OF ANY GIVEN ARRAY CF7 0030
C CF7 0040
IMPLICIT REAL*8(A-H,O-Z) CF7 0050
IF (T-TMIN) 2,3,3 CF7 0060
2 TMIN = T CF7 0070
3 IF (T-TMAX) 5,5,4 CF7 0080
4 TMAX = T CF7 0090
5 RETURN CF7 0100
END CF7 0110
SUBROUTINE YBACK (KQ, ZBAK) CF8 0010
C CF8 0020
C SUBROUTINE TO PREFORM BACK TRANSFORMATION OF VARIABLES CF8 0030
C CF8 0040
IMPLICIT REAL*8(A-H,O-Z) CF8 0050
COMMON /FFFFFF/ VARTR( 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
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
1 XIW=(1.005D0*(YCMAX-YCMIN))/101. CF9 0590
IF(YCMAX.EQ.YCMIN) XIW=0.0001 CF9 0600
IF(DELTA(IIC).LT.0.0.AND.DELP.GT.0.0) GO TO 3 CF9 0610
WRITE(KTOU,5) CF9 0620
5 FORMAT(1H0//60H **** PLOTS DELETED, ALL RESIDUALS ARE POSITIVE OR CF9 0621
1NEGATIVE.) CF9 0622
RETURN CF9 0623
3 DLEV = DELP CF9 0630
DO 2 IA=1, 51 CF9 0640
DLEV = DLEV - YIW CF9 0650
IF(DLEV.GT.0.) GO TO 2 CF9 0660
L1 = IA + 1 CF9 0670
GO TO 4 CF9 0680
2 CONTINUE CF9 0690
4 CALL GRID(GRIDA,GRIDB,L1,ITYPE) CF9 0700
DO 30 IA=1,NOOBSV CF9 0710
JAC=LSORT(IA) CF9 0720
LINE = IDINT((DELP-DELTA(JAC))/YIW)+2 CF9 0730
IF(LINE.LT.2.OR.LINE.GT.52) GO TO 30 CF9 0740
LOCX1=IDINT((YYCC(JAC)-YCMIN)/XIW)+1 CF9 0750
IF(LOCX1.LT.1.OR.LOCX1.GT.101) GO TO 10 CF9 0760
IF(LOCX1.EQ.1) LOCX1=2 CF9 0770
LOCX2=LOCX1+4 CF9 0780
LCHAR=MOD(LOCX2,4) CF9 0790
LWORD=LOCX2/4 CF9 0800
IF(LCHAR) 8,6,8 CF9 0810
6 LCHAR=4 CF9 0820
LWORD=LWORD-1 CF9 0830
8 CALL PACK(GRIDA(LINE,LWORD),LCHAR,IPLUS) CF9 0840
10 PRLOC=(IA-0.5)/XNP CF9 0850
IF(PRLOC-0.5) 12,12,18 CF9 0860
12 DO 14 IB=1,51 CF9 0870
IF(PRLOC-PRAX(IB)) 16,16,14 CF9 0880
14 CONTINUE CF9 0890
IB=51 CF9 0900
16 LOCP1=IB CF9 0910
GO TO 24 CF9 0920
18 DO 20 IB=1,51 CF9 0930
IC=52-IB CF9 0940
IF(PRLOC+PRAX(IC)-1.) 22,22,20 CF9 0950
20 CONTINUE CF9 0960
22 LOCP1=IB+50 CF9 0970
24 LOCP2=LOCP1+4 CF9 0980
LCHAR=MOD(LOCP2,4) CF9 0990
LWORD=LOCP2/4 CF9 1000
IF(LCHAR) 28,26,28 CF9 1010
26 LCHAR=4 CF9 1020
LWORD=LWORD-1 CF9 1030
28 CALL PACK(GRIDB(LINE,LWORD),LCHAR,IPLUS) CF9 1040
30 CONTINUE CF9 1050
WRITE(KTOU,34) PR1,PR2,PR3,ICURY,BI(K) CF9 1060
34 FORMAT(1H1, 1X,3A6, 9H DEP VAR ,I2,2H: ,A6,16X, CF9 1070
136HCUMULATIVE DISTRIBUTION OF RESIDUALS) CF9 1080
WRITE(KTOU,36) CF9 1090
36 FORMAT(1H ,17X,101H.0002 .001 .005 .01 .02 .05 .1 .2 .3CF9 1100
1 .4 .5 .6 .7 .8 .9 .95 .98 .99 .995 .999) CF9 1110
WRITE(KTOU,38) ((GRIDB(IA,JZ),JZ=1,26),IA=1,3) CF9 1120
38 FORMAT(1H ,19X,25A4,A2) CF9 1130
WRITE(KTOU,40) (POS(IA-3),(GRIDB(IA,JZ),JZ=1,26),IA=4,11) CF9 1140
40 FORMAT(1H ,17X,A1,1X,25A4,A2) CF9 1150
DO 46 IA=12,22 CF9 1160
IF(IA.EQ.L1) GO TO 42 CF9 1170
WRITE(KTOU,38) (GRIDB(IA,JZ),JZ=1,26) CF9 1180
GO TO 46 CF9 1190
42 WRITE(KTOU,44) (GRIDB(IA,JZ),JZ=1,26) CF9 1200
44 FORMAT(1H ,17X,1H0,1X,25A4,A2) CF9 1210
46 CONTINUE CF9 1220
DO 54 IA=23,31 CF9 1230
IF(IA.EQ.L1) GO TO 50 CF9 1240
WRITE(KTOU,48) RESID(IA-22),(GRIDB(IA,JZ),JZ=1,26) CF9 1250
48 FORMAT(1H ,5X,A1,13X,25A4,A2) CF9 1260
GO TO 54 CF9 1270
50 WRITE(KTOU,52) RESID(IA-22),(GRIDB(IA,JZ),JZ=1,26) CF9 1280
52 FORMAT(1H ,5X,A1,11X,1H0,1X,25A4,A2) CF9 1290
54 CONTINUE CF9 1300
DO 58 IA=32,42 CF9 1310
IF(IA.EQ.L1) GO TO 56 CF9 1320
WRITE(KTOU,38) (GRIDB(IA,JZ),JZ=1,26) CF9 1330
GO TO 58 CF9 1340
56 WRITE(KTOU,44) (GRIDB(IA,JZ),JZ=1,26) CF9 1350
58 CONTINUE CF9 1360
WRITE(KTOU,40) (NEG(IA-42),(GRIDB(IA,JZ),JZ=1,26),IA=43,50) CF9 1370
WRITE(KTOU,38) ((GRIDB(IA,JZ),JZ=1,26),IA=51,53) CF9 1380
WRITE(KTOU,36) CF9 1390
WRITE(KTOU,60) CF9 1400
60 FORMAT(1H ,54X,33HCUMULATIVE FREQUENCY, NORMAL GRID) CF9 1410
IF(YCMAX.EQ.YCMIN) GO TO 300 CF9 1411
WRITE(KTOU,62) PR1,PR2,PR3,ICURY,BI(K) CF9 1420
62 FORMAT(1H1, 1X,3A6, 9H DEP VAR ,I2,2H: ,A6,22X,21HRESIDUAL VSCF9 1430
1. FITTED Y ) CF9 1440
YCAVG = (YCMAX + YCMIN) / 2. CF9 1450
WRITE(KTOU,64) YCMIN, YCAVG, YCMAX CF9 1460
64 FORMAT(1H ,13X, F10.3, 40X, F10.3, 40X, F10.3) CF9 1470
WRITE(KTOU,38) ((GRIDA(IA,JZ),JZ=1,26),IA=1,3) CF9 1480
WRITE(KTOU,40) (POS(IA-3),(GRIDA(IA,JZ),JZ=1,26),IA=4,11) CF9 1490
DO 68 IA=12,22 CF9 1500
IF(IA.EQ.L1) GO TO 66 CF9 1510
WRITE(KTOU,38) (GRIDA(IA,JZ),JZ=1,26) CF9 1520
GO TO 68 CF9 1530
66 WRITE(KTOU,44) (GRIDA(IA,JZ),JZ=1,26) CF9 1540
68 CONTINUE CF9 1550
DO 72 IA=23,31 CF9 1560
IF(IA.EQ.L1) GO TO 70 CF9 1570
WRITE(KTOU,48) RESID(IA-22),(GRIDA(IA,JZ),JZ=1,26) CF9 1580
GO TO 72 CF9 1590
70 WRITE(KTOU,52) RESID(IA-22),(GRIDA(IA,JZ),JZ=1,26) CF9 1600
72 CONTINUE CF9 1610
DO 76 IA=32,42 CF9 1620
IF(IA.EQ.L1) GO TO 74 CF9 1630
WRITE(KTOU,38) (GRIDA(IA,JZ),JZ=1,26) CF9 1640
GO TO 76 CF9 1650
74 WRITE(KTOU,44) (GRIDA(IA,JZ),JZ=1,26) CF9 1660
76 CONTINUE CF9 1670
WRITE(KTOU,40) (NEG(IA-42),(GRIDA(IA,JZ),JZ=1,26),IA=43,50) CF9 1680
WRITE(KTOU,38) ((GRIDA(IA,JZ),JZ=1,26),IA=51,53) CF9 1690
WRITE(KTOU,64) YCMIN, YCAVG, YCMAX CF9 1700
WRITE(KTOU,78) CF9 1710
78 FORMAT(1H ,66X,8HFITTED Y) CF9 1720
IF(IQ(18).EQ.0) GO TO 300 CF9 1730
C --- PLOT RESIDUALS AND COMPONENT-PLUS-RESIDUALS VS IND. VARIABLES. CF9 1740
80 REWIND KTBIN1 CF9 1750
ITYPE = 3 CF9 1760
IF(IQ(24).EQ.0) GO TO 81 CF9 1770
READ(KTBIN1) ( DUM, I=1, NOVAR) CF9 1780
81 IA = NOIND + NOVAR CF9 1790
DO 82 J=1,IA CF9 1800
82 READ(KTBIN1) CF9 1810
READ(KTBIN1) (AMAX(I),I=1,NOVAR) CF9 1820
READ(KTBIN1) (AMIN(I),I=1,NOVAR) CF9 1830
NTIME = 2 CF9 1840
IF(IQ(18).EQ.3.OR.IQ(18).EQ.5) GO TO 83 CF9 1850
IF(MAXINF.EQ.1) NTIME=1 CF9 1860
IF(NTIME.EQ.1) GO TO 83 CF9 1870
REWIND KTBIN3 CF9 1880
IF(MAXINF.EQ.NOIND) GO TO 146 CF9 1890
IDONE1 = MAXINF - 1 CF9 1900
IREAD = MAXINF + 1 CF9 1910
DO 143 J = 1, NOOBSV CF9 1920
143 READ(KTBIN3) DUM,IDUM,(DUM,I=1,IDONE1), X(J,1), CF9 1930
1 (DUM,I=IREAD,NOIND) CF9 1940
GO TO 150 CF9 1950
146 IDONE1 = MAXINF - 1 CF9 1960
DO 147 J = 1, NOOBSV CF9 1970
147 READ(KTBIN3) DUM,IDUM,(DUM,I=1,IDONE1), X(J,1) CF9 1980
150 YCMIN = 1.0E+32 CF9 1990
YCMAX = - YCMIN CF9 2000
AMID = ( AMAX(MAXINF) + AMIN(MAXINF) )/ 2.0 CF9 2010
DO 251 J = 1, NOOBSV CF9 2020
YC = B(MAXINF)*(X(J,1) - AMID ) CF9 2030
RC = YC + DELTA(J) CF9 2040
IF(YC.LT.YCMIN) YCMIN=YC CF9 2050
IF(RC.LT.YCMIN) YCMIN=RC CF9 2060
IF(YC.GT.YCMAX) YCMAX=YC CF9 2070
251 IF(RC.GT.YCMAX) YCMAX=RC CF9 2080
YIY = (1.0005D0*(YCMAX - YCMIN))/51. CF9 2090
YYMAX = YCMAX CF9 2100
83 REWIND KTBIN3 CF9 2110
C --- READ INDEPENDENT VARIABLES FROM KTBIN3 IN GROUPS OF ISIZE. CF9 2120
IDONE = 1 CF9 2130
IOVER = NOIND - ISIZE CF9 2140
IF(IOVER.GT.0) GO TO 85 CF9 2150
IPLOT = NOIND CF9 2160
DO 84 J = 1, NOOBSV CF9 2170
84 READ(KTBIN3) DUM,IDUM,(X(J,I),I=1,NOIND) CF9 2180
GO TO 95 CF9 2190
85 IREAD = ISIZE + 1 CF9 2200
IPLOT = ISIZE CF9 2210
DO 86 J = 1, NOOBSV CF9 2220
86 READ(KTBIN3) DUM,IDUM,(X(J,I),I=1,ISIZE),(DUM,I=IREAD,NOIND) CF9 2230
GO TO 95 CF9 2240
87 IDONE = IDONE + ISIZE CF9 2250
IDONE1 = IDONE - 1 CF9 2260
IOVER = IOVER - ISIZE CF9 2270
IF(IOVER.GT.0) GO TO 89 CF9 2280
IPLOT = NOIND CF9 2290
DO 88 J = 1, NOOBSV CF9 2300
IREAD = NOIND - IDONE1 CF9 2310
88 READ(KTBIN3) DUM,IDUM,(DUM,I=1,IDONE1),(X(J,I),I=1,IREAD) CF9 2320
GO TO 95 CF9 2330
89 IPLOT = IDONE1+ ISIZE CF9 2340
IREAD = IPLOT + 1 CF9 2350
DO 90 J = 1, NOOBSV CF9 2360
90 READ(KTBIN3) DUM,IDUM,(DUM,I=1,IDONE1),(X(J,I),I=1,ISIZE), CF9 2370
1 (DUM,I=IREAD,NOIND) CF9 2380
95 M = 0 CF9 2390
DO 290 I = IDONE, IPLOT CF9 2400
M = M + 1 CF9 2410
IF(AMAX(I).EQ.AMIN(I) ) GO TO 290 CF9 2411
IF(IQ(18).GT.3) GO TO 201 CF9 2420
C --- PLOT RESIDUALS VS. EACH INDEPENDENT VARIABLE. CF9 2430
YIW=(1.0005D0*(DELP-DELTA(IIC)))/51. CF9 2440
XMAX = AMAX(I) CF9 2450
XMIN = AMIN(I) CF9 2460
IF(XMAX.GT.0.0) GO TO 96 CF9 2470
XIW=(1.0005D0*(XMAX-XMIN))/101. CF9 2480
GO TO 97 CF9 2490
96 XIW=(1.0005*XMAX-XMIN) / 101. CF9 2500
97 CALL GRID(GRIDA,GRIDB,L1,ITYPE) CF9 2510
DO 130 IA=1,NOOBSV CF9 2520
JAC=LSORT(IA) CF9 2530
LINE = IDINT((DELP-DELTA(JAC))/YIW)+2 CF9 2540
IF(LINE.LT.2.OR.LINE.GT.52) GO TO 130 CF9 2550
LOCX1=IDINT((X(JAC,M)-XMIN)/XIW)+1 CF9 2560
IF(LOCX1.LT.1.OR.LOCX1.GT.101) GO TO 130 CF9 2570
IF(LOCX1.EQ.1) LOCX1=2 CF9 2580
LOCX2=LOCX1+4 CF9 2590
LCHAR=MOD(LOCX2,4) CF9 2600
LWORD=LOCX2/4 CF9 2610
IF(LCHAR) 108,106,108 CF9 2620
106 LCHAR=4 CF9 2630
LWORD=LWORD-1 CF9 2640
108 CALL PACK(GRIDA(LINE,LWORD),LCHAR,IPLUS) CF9 2650
130 CONTINUE CF9 2660
WRITE(KTOU,162) PR1,PR2,PR3,ICURY,BI(K),I,BI(I) CF9 2670
162 FORMAT(1H1, 1X,3A6, 9H DEP VAR ,I2,2H: ,A6, 9X,34HRESIDUALS VCF9 2680
1S. INDEPENDENT VARIABLE, I2, 2H: , A6 ) CF9 2690
XAVG = (XMAX + XMIN)/ 2. CF9 2700
XUQ = (XMAX + XAVG)/ 2. CF9 2710
XLQ = (XMIN + XAVG)/ 2. CF9 2720
WRITE(KTOU,164) XMIN,XLQ,XAVG,XUQ,XMAX CF9 2730
164 FORMAT(1H ,13X,F10.3,14X,F10.3,16X,F10.3,14X,F10.3,16X,F10.3) CF9 2740
WRITE(KTOU,38) ((GRIDA(IA,JZ),JZ=1,26),IA=1,3) CF9 2750
WRITE(KTOU,40) (POS(IA-3),(GRIDA(IA,JZ),JZ=1,26),IA=4,11) CF9 2760
DO 168 IA=12,22 CF9 2770
IF(IA.EQ.L1) GO TO 166 CF9 2780
WRITE(KTOU,38) (GRIDA(IA,JZ),JZ=1,26) CF9 2790
GO TO 168 CF9 2800
166 WRITE(KTOU,44) (GRIDA(IA,JZ),JZ=1,26) CF9 2810
168 CONTINUE CF9 2820
DO 172 IA=23,31 CF9 2830
IF(IA.EQ.L1) GO TO 170 CF9 2840
WRITE(KTOU,48) RESID(IA-22),(GRIDA(IA,JZ),JZ=1,26) CF9 2850
GO TO 172 CF9 2860
170 WRITE(KTOU,52) RESID(IA-22),(GRIDA(IA,JZ),JZ=1,26) CF9 2870
172 CONTINUE CF9 2880
DO 176 IA=32,42 CF9 2890
IF(IA.EQ.L1) GO TO 174 CF9 2900
WRITE(KTOU,38) (GRIDA(IA,JZ),JZ=1,26) CF9 2910
GO TO 176 CF9 2920
174 WRITE(KTOU,44) (GRIDA(IA,JZ),JZ=1,26) CF9 2930
176 CONTINUE CF9 2940
WRITE(KTOU,40) (NEG(IA-42),(GRIDA(IA,JZ),JZ=1,26),IA=43,50) CF9 2950
WRITE(KTOU,38) ((GRIDA(IA,JZ),JZ=1,26),IA=51,53) CF9 2960
WRITE(KTOU,164) XMIN,XLQ,XAVG,XUQ,XMAX CF9 2970
WRITE(KTOU,178) I, BI(I) CF9 2980
178 FORMAT(1H0,55X,20HINDEPENDENT VARIABLE, I2, 2H: , A6 ) CF9 2990
IF(IQ(18).EQ.3) GO TO 290 CF9 3000
C --- CALCULATE COMPONENT AND COMPONENT PLUS RESIDUAL FOR EACH OBSV. CF9 3010
201 L2 = 99 CF9 3020
AMID = ( AMAX(I) + AMIN(I) )/ 2.0 CF9 3030
YCMIN = 1.0E+32 CF9 3040
YCMAX = - YCMIN CF9 3050
DO 202 J = 1, NOOBSV CF9 3060
YC = B(I)*(X(J,M) - AMID ) CF9 3070
RC = YC + DELTA(J) CF9 3080
YYCC(J) = YC CF9 3090
COMPR(J) = RC CF9 3100
IF(YC.LT.YCMIN) YCMIN=YC CF9 3110
IF(RC.LT.YCMIN) YCMIN=RC CF9 3120
IF(YC.GT.YCMAX) YCMAX=YC CF9 3130
202 IF(RC.GT.YCMAX) YCMAX=RC CF9 3140
XMAX=AMAX(I) CF9 3150
XMIN=AMIN(I) CF9 3160
IF(XMAX.GT.0.0) GO TO 204 CF9 3170
XIW=(1.0005D0*(XMAX-XMIN))/101. CF9 3180
GO TO 206 CF9 3190
204 XIW=(1.0005D0*(XMAX-XMIN))/101. CF9 3200
206 IF(IQ(18).EQ.5) GO TO 208 CF9 3210
IF(NTIME.EQ.2) GO TO 210 CF9 3220
208 YIY = (1.0005D0*(YCMAX - YCMIN))/51. CF9 3230
YYMAX = YCMAX CF9 3240
NTIME = 2 CF9 3250
210 CALL GRID(GRIDA,GRIDB,L2,ITYPE) CF9 3260
C --- FIND THE CHARACTER NUMBER (ABSCISSA) (1 TO 101) CF9 3270
NOP = 0 CF9 3280
DO 220 J=1, NOOBSV CF9 3290
LOCX1=IDINT((X(J,M)-XMIN)/XIW)+1 CF9 3300
IF(LOCX1.LT.1.OR.LOCX1.GT.101) GO TO 220 CF9 3310
212 IF(LOCX1.EQ.1) LOCX1=2 CF9 3320
LOCX2 = LOCX1 + 4 CF9 3330
LCHAR = MOD(LOCX2,4) CF9 3340
C --- FIND WORD NUMBER (1 TO 26 AT 6 CHARACTERS PER WORD) CF9 3350
LWORD = LOCX2/4 CF9 3360
IF(LCHAR) 216, 214, 216 CF9 3370
214 LCHAR = 4 CF9 3380
LWORD = LWORD - 1 CF9 3390
216 LINE = IDINT((YYMAX-YYCC(J))/YIY)+2 CF9 3400
C --- DONT PRINT IF LINE IS TOO LARGE. CF9 3410
IF(LINE.LT.2.OR.LINE.GT.52) GO TO 220 CF9 3420
C --- PLACE PLOTTING CHARACTER IN POSITION LCHAR OF GRIDA(LINE,WORD) CF9 3430
CALL PACK(GRIDA(LINE,LWORD),LCHAR,ICOMPT) CF9 3440
LINE2 = IDINT((YYMAX-COMPR(J))/YIY)+2 CF9 3450
IF(LINE2.LT.2.OR.LINE2.GT.52) GO TO 119 CF9 3460
ISYM = IPLUS CF9 3470
IF(LINE2.EQ.LINE) ISYM=ISAME CF9 3480
CALL PACK(GRIDA(LINE2,LWORD),LCHAR,ISYM) CF9 3490
GO TO 220 CF9 3500
119 NOP = NOP + 1 CF9 3510
220 CONTINUE CF9 3520
WRITE(KTOU,230) PR1,PR2,PR3,ICURY,BI(K),I,BI(I) CF9 3530
230 FORMAT(1H1, 1X,3A6, 9H DEP VAR ,I2,2H: ,A6, 9X, 49HCOMPONENT CF9 3540
1WITH RESIDUALS VS. INDEPENDENT VARIABLE , I2, 2H: , A6/ CF9 3550
2 49X, 42HC = COMPONENT, + = WITH RESIDUAL, * = BOTH ) CF9 3560
XAVG = (XMAX + XMIN)/ 2. CF9 3570
XUQ = (XMAX + XAVG)/ 2. CF9 3580
XLQ = (XMIN + XAVG)/ 2. CF9 3590
WRITE(KTOU,164) XMIN,XLQ,XAVG,XUQ,XMAX CF9 3600
WRITE(KTOU,38) ((GRIDA(IA,JZ),JZ=1,26),IA=1,15) CF9 3610
WRITE(KTOU,231) (ICPR(IA-15),(GRIDA(IA,JZ),JZ=1,26),IA=16,22) CF9 3620
231 FORMAT(1H ,13X, A1,5X,25A4,A2) CF9 3630
WRITE(KTOU,232) (ICOMP(IA-22),ICPR(IA-15), CF9 3640
1 (GRIDA(IA,JZ),JZ=1,26),IA=23,25) CF9 3650
232 FORMAT(1H ,5X,A1,7X, A1,5X,25A4,A2) CF9 3660
WRITE(KTOU,233) (ICOMP(IA-22),IAND(IA-25), ICPR(IA-15), CF9 3670
1 (GRIDA(IA,JZ),JZ=1,26),IA=26,28) CF9 3680
233 FORMAT(1H ,5X,A1,3X,A1,3X,A1,5X,25A4,A2) CF9 3690
WRITE(KTOU,232) (ICOMP(IA-22),ICPR(IA-15), CF9 3700
1 (GRIDA(IA,JZ),JZ=1,26),IA=29,31) CF9 3710
WRITE(KTOU,231) (ICPR(IA-15),(GRIDA(IA,JZ),JZ=1,26),IA=32,39) CF9 3720
WRITE(KTOU,38) ((GRIDA(IA,JZ),JZ=1,26),IA=40,53) CF9 3730
WRITE(KTOU,164) XMIN,XLQ,XAVG,XUQ,XMAX CF9 3740
WRITE(KTOU,178) I, BI(I) CF9 3750
WRITE(KTOU,234) NOP CF9 3760
234 FORMAT(1H , I3, 26H RESIDUALS OUTSIDE OF PLOT ) CF9 3770
290 CONTINUE CF9 3780
IF(IOVER.LE.0) GO TO 291 CF9 3790
REWIND KTBIN3 CF9 3800
GO TO 87 CF9 3810
C --- REPLACE Z AND C MATRIX IF CP SEARCH IS DESIRED. CF9 3820
291 IF(IQ(25).EQ.0.AND.IQ(26).EQ.0) GO TO 300 CF9 3830
REWIND KTBIN1 CF9 3840
IF(IQ(24).EQ.0) GO TO 292 CF9 3850
READ(KTBIN1) ( DUM, I=1, NOVAR) CF9 3860
292 DO 293 I = 1, NOIND CF9 3870
293 READ(KTBIN1) (C(I,J), J = I,NOIND) CF9 3880
DO 294 I = 1, NOVAR CF9 3890
294 READ(KTBIN1) (Z(I,J), J = I,NOVAR ) CF9 3900
C --- SQUARE Z MATRIX. CF9 3910
NOVM1 = NOVAR - 1 CF9 3920
DO 296 I = 1, NOVM1 CF9 3930
IPL1 = I + 1 CF9 3940
DO 296 J = IPL1, NOVAR CF9 3950
296 Z(J,I)= Z(I,J) CF9 3960
300 RETURN CF9 3970
END CF9 3980
SUBROUTINE GRID(GRIDA,GRIDB,L1,ITYPE) CF100010
C CF100020
C SUBROUTINE MAKES GRIDA FOR RESIDUALS VS. FITTED Y. CF100030
C SUBROUTINE MAKES GRIDB FOR CUMULATIVE DISTRIBUTION OF RESIDUALS. CF100040
C --- GRIDA IS ALSO USED TO PLOT COMPONENT-PLUS RESIDUALS VS EACH CF100050
C --- INDEPENDENT VARIABLE AND IS USED TO MAKE THE CP VS P PLOTS. CF100060
C --- WHEN ITYPE = 1, BOTH GRIDA AND GRIDB PLOTS ARE MADE. CF100070
C --- WHEN ITYPE = 2, GRIDA ALONE IS MADE. CF100080
C --- WHEN ITYPE = 3, THE PLOT AREA IS BLANKED OUT, REUSING THE CF100090
C --- OUTLINE FROM A PREVIOUS PLOT. CF100100
C --- L1 IS THE LINE AT WHICH THE RESIDUALS CROSS 0. WHEN L1=99, CF100110
C --- THE ZERO LINE IS NOT PLOTTED. CF100120
C CF100130
C CF100140
DIMENSION GRIDA(53,26),GRIDB(53,26),GRDA(7),GRDB(4) CF100150
DATA GRDA/4H*---,4H-*--,4H--*-,4H---*,4H----,2H*-,2H--/ CF100160
DATA GRDB/4HI ,2H I,4HI---,2H-I/ CF100170
DATA BLANK/4H /,BLINK/4H '/ CF100180
GO TO (1,21,23), ITYPE CF100190
1 DO 2 IA=1,5 CF100200
DO 2 IB=1,5 CF100210
IC=(IA-1)*5+IB CF100220
GRIDA(1,IC)=GRDA(IB) CF100230
2 GRIDA(53,IC)=GRDA(IB) CF100240
GRIDA(1,26)=GRDA(6) CF100250
GRIDA(53,26)=GRDA(6) CF100260
GRIDB(1, 1)=GRDA(1) CF100270
GRIDB(1, 2)=GRDA(3) CF100280
GRIDB(1, 3)=GRDA(5) CF100290
GRIDB(1, 4)=GRDA(3) CF100300
GRIDB(1, 5)=GRDA(2) CF100310
GRIDB(1, 6)=GRDA(2) CF100320
GRIDB(1, 7)=GRDA(4) CF100330
GRIDB(1, 8)=GRDA(5) CF100340
GRIDB(1, 9)=GRDA(1) CF100350
GRIDB(1,10)=GRDA(3) CF100360
GRIDB(1,11)=GRDA(4) CF100370
GRIDB(1,12)=GRDA(4) CF100380
GRIDB(1,13)=GRDA(4) CF100390
GRIDB(1,14)=GRDA(4) CF100400
GRIDB(1,15)=GRDA(4) CF100410
GRIDB(1,16)=GRDA(5) CF100420
GRIDB(1,17)=GRDA(1) CF100430
GRIDB(1,18)=GRDA(3) CF100440
GRIDB(1,19)=GRDA(4) CF100450
GRIDB(1,20)=GRDA(5) CF100460
GRIDB(1,21)=GRDA(2) CF100470
GRIDB(1,22)=GRDA(2) CF100480
GRIDB(1,23)=GRDA(1) CF100490
GRIDB(1,24)=GRDA(5) CF100500
GRIDB(1,25)=GRDA(1) CF100510
GRIDB(1,26)=GRDA(7) CF100520
DO 4 IA=1,26 CF100530
4 GRIDB(53,IA)=GRIDB(1,IA) CF100540
DO 8 IA=2,52 CF100550
DO 6 IB=2,25 CF100560
GRIDA(IA,IB)=BLANK CF100570
GRIDB(IA,IB)=BLANK CF100580
6 CONTINUE CF100590
GRIDB(IA,13)=BLINK CF100600
8 CONTINUE CF100610
DO 10 IA=2,52 CF100620
GRIDA(IA,1)=GRDB(1) CF100630
GRIDA(IA,26)=GRDB(2) CF100640
GRIDB(IA,1)=GRDB(1) CF100650
10 GRIDB(IA,26)=GRDB(2) CF100660
DO 12 IA=2,25 CF100670
GRIDA(L1,IA)=GRDA(5) CF100680
12 GRIDB(L1,IA)=GRDA(5) CF100690
GRIDA(L1,1)=GRDB(3) CF100700
GRIDA(L1,26)=GRDB(4) CF100710
GRIDB(L1,1)= GRDB(3) CF100720
GRIDB(L1,26)=GRDB(4) CF100730
RETURN CF100740
21 DO 22 IA=1,5 CF100750
DO 22 IB=1,5 CF100760
IC=(IA-1)*5+IB CF100770
GRIDA(1,IC)=GRDA(IB) CF100780
22 GRIDA(53,IC)=GRDA(IB) CF100790
GRIDA(1,26)=GRDA(6) CF100800
GRIDA(53,26)=GRDA(6) CF100810
23 DO 24 IA=2,52 CF100820
DO 24 IB=2,25 CF100830
24 GRIDA(IA,IB)=BLANK CF100840
IF(L1.NE.99) GO TO 28 CF100850
DO 26 IA=2,52 CF100860
GRIDA(IA,1)=GRDB(1) CF100870
26 GRIDA(IA,26)=GRDB(2) CF100880
RETURN CF100890
28 DO 29 IA=2,52 CF100900
GRIDA(IA,1)=GRDB(1) CF100910
29 GRIDA(IA,26)=GRDB(2) CF100920
DO 30 IA=2,25 CF100930
30 GRIDA(L1,IA)=GRDA(5) CF100940
GRIDA(L1,1)=GRDB(3) CF100950
GRIDA(L1,26)=GRDB(4) CF100960
RETURN CF100970
END CF100980
SUBROUTINE PACK(X,N,C) CF110010
C CF110020
C SUBROUTINE PLACES THE APPROPRIATE SYMBOLS ON THE PLOTS CF110030
C CHARACTER C IS PLACED IN BYTE N OF WORD X, WHERE WORD X IS CF110031
C A SIMULATE BYTE IBM 360 WORD, WITH BYTES NUMBERED FROM THE LEFT. CF110032
C N TAKES VALUES OF 1, 2, 3 OR 4. PACK IS CALLED FROM PITCHA CF110033
C AND CPMAIN. CF110034
C CF110040
Y=X CF110080
CALL DEPSIT(C,N,Y) CF110090
X=Y CF110110
RETURN CF110120
END CF110130
SUBROUTINE CPMAIN(ZMS) CF120010
C --- SUBROUTINE SETS UP AND CONTROLS CP CALCULATIONS, PRINTOUTS, CF120020
C AND PLOTS. CP MAIN AND ASSOC. SUBROUTINES WRITTEN BY F.S.WOOD. CF120030
C CF120040
C --- GLOSSARY OF CP PROGRAM TERMS CF120050
C --- AVAR() NAME OF VARIABLE IN ENGLISH. CF120060
C --- BI () ARRAY OF ENGLISH NAMES OF VARIABLES IN FULL EQUATION. CF120070
C --- C () C ARRAY OF SIMPLE CORRELATION COEFFICIENTS OF BASIC CF120080
C --- EQUATION. CF120090
C --- CP () ARRAY OF CP VALUES INDEXED BY L, CP(L) = (ZSSL/ZMS) - NP. CF120100
C --- CPHI FIRST SETTING OF CPHIGH. CF120110
C --- CPHIGH MAXIMUM CP VALUE OF EQUATION PRINTED IN CP SEARCH. THE CF120120
C --- LEVEL IS RESET AFTER LCP CANDIDATES HAVE BEEN FOUND TO CF120130
C --- THE CP VALUE OF THE LOWEST JCP EQUATION. CF120140
C --- CPTOP LARGEST CP VALUE USED IN THE CP VS. P PLOT. CF120150
C --- HAPPY ELEMENT C(JOY,JOY), USED TO SWEEP MATRIX. CF120160
C --- IBACK IN T DIRECTED SEARCH, NUMBER OF VARIABLES BACK FROM MIN CF120161
C --- CP. USED TO SET BASIC SET OF VARIABLES. CF120162
C --- IC COUNTER. CF120170
C --- ICP () INDEX OF VARIABLES READ FROM INPUT CARD TO BE SEARCHED. CF120180
C --- OTHER VARIABLES IN FULL EQUATION ARE PLACED IN BASIC CF120190
C --- EQUATION. CF120200
C --- ICURY THE NUMBER OF THE DEPENDENT VARIABLE. CF120210
C --- IN NUMBER OF VARIABLES IN EACH EQUATION. CF120220
C --- INOUT()INDEX OF VARIABLE POSITIONS USED TO DETERMINE WHICH CF120230
C --- VARIABLE IS IN EACH EQUATION. CF120240
C --- IP () INDEX OF P VARIABLES IN EQUATION L. CF120250
C --- IS () ARRAY USED TO GENERATE THE GARSIDE SEQUENCE FOR ADDING CF120260
C --- AND DELEATING VARIABLES. CF120270
C --- ISRCH INDICATION THAT CP SEARCH HAS BEEN REQUESTED IF=1, IQ(25). CF120280
C --- IVGT() INDEX OF VARIABLES IN BASIC EQUATION. CF120290
C --- IVLT() INDEX OF VARIABLES TO BE SEARCHED. CF120300
C --- JCP NUMBER OF LOWEST CP EQUATIONS IN FIRST LCP EQUATIONS. CF120310
C --- JMAX MAXIMUM NUMBER OF SWEEPS. CF120320
C --- JOY NAME OF VARIABLE USED TO SWEEP Z ARRAY, SOMETIMES FSW. CF120330
C --- JRETRN COUNT OF SWEEPS BEFORE RETURNING TO BASIC SCC MATRIX C. CF120340
C --- JSWEEP COUNT OF SWEEPS BEFORE CHANGING SIZE OF SWEEP. CF120350
C --- K THE POSITION OF THE DEPENDENT VARIABLE IN THE Z ARRAY. CF120360
C --- KRET NUMBER OF VARIABLES PRESENT BEFORE RETURNING TO BASIC SCC CF120370
C --- MATRIX C. CF120380
C --- KSEQ COUNT OF K VARIABLES IN CURRENT SWEEP. CF120390
C --- KSEQP1 SIZE OF SWEEP (K VARIABLES IN CURRENT SEQUENCE PLUS 1). CF120400
C --- L INDEX OF EQUATIONS USED IN CP CALCULATIONS. CF120410
C --- LCP NUMBER OF EQUATIONS FOUND BEFORE RESETTING CPHIGH. CF120420
C --- LE NUMBER OF SUBSET EQUATION WITH RMS LESS THAN FULL CF120430
C --- EQUATION. CF120440
C --- LMORE MAXCIP - LCP CF120450
C --- MAXCIP TRAP FOR MAXIMUM DIMENSIONS OF CP AND IP. CF120460
C --- MAXNPR MAXIMUM NUMBER OF SORTED CP VALUES PRINTED. CF120470
C --- MAXSRH TRAP FOR MAXIMUM NUMBER OF VARIABLES TO BE SEARCHED. CF120480
C --- MP VALUE OF P DEPENDING IF NGT IS ZERO OR NOT. CF120490
C --- NCP NUMBER OF CP AND FACTORIAL SEARCHES. CF120500
C --- NFCARD NUMBER OF FACTORIAL SEARCH CARDS, IQ(26),COL52. CF120510
C --- NGT NUMBER OF VARIABLES IN BASIC EQUATION, NO. OF VARIABLES CF120520
C --- WITH THE GREATER T-VALUES. CF120530
C --- NLT NUMBER OF VARIABLES TO BE SEARCHED, NO. OF VARIABLES CF120540
C --- WITH THE LOWER T-VALUES. CF120550
C --- NODEP NUMBER OF DEPENDENT VARIABLES. CF120560
C --- NOIND NUMBER OF INDEPENDENT VARIABLES. CF120570
C --- NOVAR NUMBER OF VARIABLES, DEPENDENT AND INDEPENDENT. CF120580
C --- NP = N - 2P, UPDATED AND USED IN EACH CP CALCULATION. CF120590
C --- NSRCH NUMBER OF THAT PARTICULAR SEARCH. CF120600
C --- P NUMBER OF VARIABLES IN EQUATION COUNTING BZERO. CF120610
C --- RMS RESIDUAL MEAN SQUARE OF FULL EQUATION, TAKEN AS THE CF120620
C --- ESTIMATED VARIANCE OF Y FOR THE CP CALCULATION. CF120630
C --- RMSE ESTIMATE OF RMS EITHER READ FROM CARD OR VALUE FOUND IN CF120640
C --- SUBSET EQUATION THAT IS SMALLER THAN RMS. CF120650
C --- RMSR RATIO OF RMS/RMSE. CF120660
C --- SIGN POSITIVE SIGN INDICATES VARIABLE ADDED, NEGATIVE SIGN CF120670
C --- INDICATES VARIABLE REMOVED. CF120680
C --- TVALUE ARRAY CONTAINING THE T-VALUES OF THE INDEPENDENT CF120690
C --- VARIABLES IN THE FULL EQUATION. CF120700
C --- U () ARRAY USED TO MODIFY Z ARRAY FOR VARIABLES ADDED AND CF120710
C --- DELETED. CF120720
C --- Z () Z ARRAY OF SIMPLE CORRELATION COEFFICIENTS, AT START CF120730
C --- FROM FULL EQUATION, THEN MODIFIED AS VARIABLES ARE CF120740
C --- ADDED, SEE BROWNLEE SECTION 17.10, EQUATION 10.5. CF120750
C --- ZMS RMS CONVERTED TO UNITS OF SIMPLE CORRELATION COEFFICIENT, CF120760
C --- ZMS = RMS / (STDDEV(K)*STDDEV(K)*(NOOBSV-1)). CF120770
C CF120780
IMPLICIT REAL*8(A-H,O-Z) CF120790
REAL*4 GRIDA(53,26), GRIDB(53,26) CF120800
INTEGER NVALP(21) CF121070
DIMENSION NCP1(53) CF120801
DIMENSION AVAR(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, INTDUM, 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, KKK, KONE, KTWO, MNO, NFILE CF120980
COMMON /RRRRRR/ KTBIN1, KTBIN2, KTBIN3, KTBIN4, KTBIN5 CF120990
COMMON /SSSSSS/ ICP(20) 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
EQUIVALENCE (COM4(1001),GRIDA(1)),(COM4(1691),GRIDB(1)) CF121050
DATA NCP1/26*4H ,4HCP ,26*4H / CF121060
DATA IPLUS/4H++++/ CF121080
C -- CF121090
C ---*******************************************************************CF121100
C -- CF121110
C --- LIMITS THAT CAN BE SET BY THE INSTALLATION STATISTICIAN. CF121120
C --- FOR DEFINITIONS SEE THE GLOSSARY ABOVE. CF121130
C --- CF121140
C --- MAX LEVEL OF CP TO SAVE NAMES OF VARIABLES. CAN BE CHANGED CF121150
C --- AT STATEMENT 300, E.G. CPHI = CPMAX + 2.0 OR CF121160
C --- CPHI = (CPMAX + DFLOAT(MP) ) / 2. CF121170
C --- CPHI IS SET EQUAL TO CPHIGH AT START OF INTERNAL DO LOOP 5000. CF121180
C --- CPHIGH IS RESET AT STATEMENT 92 TO CP VALUE OF LOWEST JCP CF121190
C --- EQUATIONS OUT OF LCP CANDIDATE EQUATIONS FOUND AT FIRST CPHI CF121200
C --- SETTING. CF121210
1 JCP = 20 CF121220
LCP = 200 CF121230
MAXNPR = 100 CF121240
C --- MAXSRH IS THE TOTAL NUMBER OF VARIABLES THAT CAN BE SEARCHED. CF121250
C --- EACH COMPUTER CENTER MAY WISH TO HAVE MORE THAN ONE PROGRAM CF121260
C --- COMPILED WITH DIFFERENT LEVELS OF MAXSRH LIMITS. CF121270
MAXSRH = 12 CF121280
IF(IQ(21).GT.12.AND.IQ(21).LT.19) MAXSRH = IQ(21) CF121290
C --- THE TOTAL NUMBER OF SEARCHES = 2**MAXSRH. CF121300
C --- WHEN MAXSRH = 12, TOTAL = 4,096 SEARCHES, CF121310
C --- WHEN MAXSRH = 14, TOTAL = 16,384 SEARCHES, CF121320
C --- WHEN MAXSRH = 18, TOTAL = 256,144 SEARCHES. CF121330
C --- MAXSRH MUST NOT BE LARGER THAN THE DIMENSIONS OF ICP IN BASPGM CF121340
C --- AND CPMAIN SUBROUTINES. IS(40) IS DIMENSIONED TO HOLD MAXSRH=20 CF121350
IBACK = 2 CF121351
C -- CF121360
C ---*******************************************************************CF121370
C -- CF121380
L = 0 CF121390
LE = 0 CF121400
MP = 0 CF121410
NGT = 0 CF121420
NLT = 0 CF121430
MAXCIP = MXOBSV CF121440
LMORE = MAXCIP - LCP CF121450
NSRCH = 1 CF121460
ISRCH = IQ(25) CF121470
NFCARD = IQ(26) CF121480
NCP = 1 CF121490
IF(NFCARD.GT.0) NCP = NFCARD CF121500
NF = NOOBSV CF121510
RMSE = RMS CF121520
WRITE(KTOU,1000) PR1, PR2, PR3, ICURY, BI(K), NSRCH CF121530
1000 FORMAT(1H1,40X,40HCP VALUES FOR THE SELECTION OF VARIABLES// CF121540
1 1X, 3A6, 10H DEP VAR, I2, 2H: , A6,4X,13HSEARCH NUMBER,I2/) CF121550
C --- RMS CONVERTED TO UNITS OF SIMPLE CORRELATION COEFF. MATRIX BY CF121560
C -- ZMS = RMS / (STDDEV(K)*STDDEV(K)*(NOOBSV-1)) IN MAIN. CF121570
C --- CALCULATE P FOR BASIC EQUATION, WITH OR WITHOUT BZERO. CF121580
IF(IQ(5).EQ.1) GO TO 3 CF121590
2 MP = 1 CF121600
3 NP = NOOBSV - 2*MP CF121610
IPMAX = MP + NOIND CF121620
CPMAX = DFLOAT(IPMAX) + .005 CF121630
300 CPHI = CPMAX CF121640
IF(NFCARD.GT.0) GO TO 101 CF121650
C --- DEVELOP BASIC EQUATION FOR DIRECT SEARCH OF REMAINING VARIABLES. CF121660
C --- PUT VARIABLES IN BASIC EQUATION WITH LARGEST T-VALUES FIRST, CF121670
C --- THEN NEXT LARGEST T-VALUES UNTIL CP VALUE GOES THROUGH A MINIMUM. CF121680
CALL SORT (NOIND, TVALUE, LSORT) CF121690
IC = NOIND CF121700
JOY = LSORT(IC) CF121710
SIGN = 1. CF121720
CALL SWEEP (JOY, SIGN, NOIND, K) CF121730
NPS = NP - 2 CF121740
CP( 1) = (Z(K,K) / ZMS) - NPS CF121750
MGT = 1 CF121760
WRITE(KTOU,1001) CF121770
1001 FORMAT(1H , 42HSELECTION OF VARIABLES FOR BASIC EQUATION ) CF121780
WRITE(KTOU,1002) CP(1), JOY, BI(JOY) CF121790
1002 FORMAT(1H0, 4HCP =, F5.1, 18H, VARIABLE ADDED ,I2, 2X, A6 ) CF121800
DO 4 JAS = 2, NOIND CF121810
IC = IC -1 CF121820
JOY = LSORT(IC) CF121830
CALL SWEEP (JOY, SIGN, NOIND, K) CF121840
NPS = NP - 2*JAS CF121850
CP(JAS) = (Z(K,K) / ZMS) - NPS CF121860
WRITE(KTOU,1002) CP(JAS), JOY, BI(JOY) CF121870
C --- GET OUT OF DO LOOP WHEN NEXT CP VALUE IS LARGER CF121880
IF(CP(JAS-1).LT.CP(JAS) ) GO TO 5 CF121890
MGT = MGT + 1 CF121900
4 CONTINUE CF121910
C --- BACK UP IBACK VARIABLES FROM MINIMUM CP VALUE. CF121920
5 MGT = MGT - IBACK CF121930
IA = IC + IBACK CF121940
IF(IA.GT.NOIND) IA = NOIND CF121941
IF(MGT.GT.0) GO TO 7 CF121950
DO 6 I = 1, NOIND CF121960
NLT = NLT + 1 CF121970
6 IVLT(NLT) = I CF121980
GO TO 12 CF121990
7 DO 11 I = 1, NOIND CF122000
DO 9 J = 1, IA CF122010
IF(I.NE.LSORT(J)) GO TO 9 CF122020
10 NLT = NLT + 1 CF122030
IVLT(NLT) = I CF122040
9 CONTINUE CF122050
11 CONTINUE CF122060
C --- SAVE CP AND IP OF BASIC EQUATION FOR LATER PRINTOUT. CF122070
CP(1) = CP(MGT) CF122080
IP(1) = MP + MGT CF122090
C --- REMOVE EFFECT OF LAST VARIABLE THAT ENTERED Z MATRIX CF122100
12 SIGN = -1. CF122110
CALL SWEEP (JOY, SIGN, NOIND, K) CF122120
DO 8 J = 1, IBACK CF122121
IC = IC + 1 CF122122
IF(IC.GT.NOIND) GO TO 13 CF122123
JOY = LSORT(IC) CF122130
8 CALL SWEEP (JOY, SIGN, NOIND, K) CF122140
GO TO 13 CF122150
101 IF(ICURY.LT.2) GO TO 102 CF122160
READ(KTIN,9988) (ICP(I), I=1,MAXSRH ) CF122170
GO TO 102 CF122180
C --- START SUBSEQUENT FACTORIAL SEARCHES HERE. CF122190
9994 WRITE(KTOU,1000) PR1, PR2, PR3, ICURY, BI(K), NSRCH CF122200
C --- THE NUMBER OF EACH VARIABLE TO BE INCLUDED IN EACH FACTORIAL CF122210
C --- SEARCH IS READ FIRST IN MAIN PROGRAM AND THEN AT END OF THIS CF122220
C --- SUBROUTINE IN ICP BY FORMAT 18(2X,I2). CF122230
102 IC = MAXSRH CF122240
IF(NOIND.LT.IC) IC = NOIND CF122250
DO 103 J = 1, IC CF122260
IF(ICP(J).EQ.0) GO TO 104 CF122270
IVLT(J) = ICP(J) CF122280
103 NLT = NLT + 1 CF122290
104 WRITE(KTOU,1004) CF122300
1004 FORMAT(1H , 29HVARIABLES IN FACTORIAL SEARCH ) CF122310
DO 106 J = 1, NLT CF122320
I = ICP(J) CF122330
106 AVAR(J) = BI(I) CF122340
KKK = 0 CF122350
128 IF(NLT - KKK) 13, 13, 130 CF122360
130 KONE = KKK + 1 CF122370
IF(NLT - (KKK+12)) 134, 134, 132 CF122380
132 KTWO = KKK + 12 CF122390
GO TO 136 CF122400
134 KTWO = NLT CF122410
136 WRITE(KTOU,1016) ( ICP(J),J=KONE,KTWO) CF122420
WRITE(KTOU,1018) (AVAR(J),J=KONE,KTWO) CF122430
KKK = KKK + 12 CF122440
GO TO 128 CF122450
13 IC = 1 CF122460
JC = 1 CF122470
DO 15 J = 1, NLT CF122480
DO 14 I = JC, NOIND CF122490
IC = IC + 1 CF122500
IF(I.EQ.IVLT(J)) GO TO 145 CF122510
NGT = NGT + 1 CF122520
IVGT(NGT) = I CF122530
AVAR(NGT) = BI(I) CF122540
14 CONTINUE CF122550
145 JC = IC CF122560
15 CONTINUE CF122570
IF(IC.GT.NOIND) GO TO 17 CF122580
DO 16 I = IC, NOIND CF122590
NGT = NGT + 1 CF122600
IVGT(NGT) = I CF122610
16 AVAR(NGT) = BI(I) CF122620
17 CONTINUE CF122630
NP = NP - 2*NGT CF122640
MP = MP + NGT CF122650
IP(1) = MP CF122660
WRITE(KTOU,1006) NOOBSV, NOIND, NGT, NLT CF122670
1006 FORMAT(1H0//1X,22HNUMBER OF OBSERVATIONS, 18X, I4/ CF122680
137H NUMBER OF VARIABLES IN FULL EQUATION, 5X, I3/ CF122690
238H NUMBER OF VARIABLES IN BASIC EQUATION, 4X, I3/ CF122700
338H REMAINDER OF VARIABLES TO BE SEARCHED, 4X, I3// ) CF122710
IF(NLT.LT.1) GO TO 9999 CF122711
C --- PROBLEM HALTED IF NLT IS GREATER THAN MAXSRH CF122720
IF(NLT.GT.MAXSRH) GO TO 9997 CF122730
WRITE(KTOU,1008) CF122740
1008 FORMAT(1H0, 42HEQUATION P CP VARIABLES IN EQUATION ) CF122750
WRITE(KTOU,1009) IPMAX, CPMAX CF122760
1009 FORMAT(1H0,8X,I3,1X,F5.1,2X,13HFULL EQUATION ) CF122770
C --- SKIP BASIC EQUATION IF NGT IS ZERO. CF122780
IF(NGT.GT.0) GO TO 18 CF122790
WRITE(KTOU,1110) CF122800
1110 FORMAT(1H0, 19X, 25HNO BASIC SET OF VARIABLES ) CF122810
GO TO 40 CF122820
C CF122830
C --- CALCULATE CP VALUE FOR FACTORIAL NGT VARIABLES CF122840
C CF122850
18 IF(NFCARD.EQ.0) GO TO 21 CF122860
C --- SETUP Z SIMPLE CORRELATION COEFFICIENTS TO CONTAIN CF122870
C --- NGT FACTORIAL VARIABLES CF122880
SIGN = 1. CF122890
DO 20 JAZ=1, NGT CF122900
JOY = IVGT(JAZ) CF122910
CALL SWEEP(JOY,SIGN,NOIND,K) CF122920
20 CONTINUE CF122930
CP(1) = (Z(K,K) / ZMS) - NP CF122940
21 L = 1 CF122950
IF(NGT - 10) 22, 22, 24 CF122960
22 MNO = NGT CF122970
GO TO 25 CF122980
24 MNO = 10 CF122990
25 IF(CP(1).GT.CPMAX) GO TO 26 CF123000
WRITE(KTOU,1010) L, IP(L), CP(L), (IVGT(I),I=1,MNO) CF123010
1010 FORMAT(1H0,4X,I3,1X,I3,1X,F5.1,2X,22HBASIC SET OF VARIABLES, CF123020
1 10(2X,I6) ) CF123030
GO TO 27 CF123040
26 WRITE(KTOU,1012) IP(L), CP(L), (IVGT(I),I=1,MNO) CF123050
1012 FORMAT(1H0,8X,I3,1X,F5.1,2X,22HBASIC SET OF VARIABLES,10(2X,I6)) CF123060
L = 0 CF123070
27 WRITE(KTOU,1014)(AVAR(I),I=1, MNO) CF123080
1014 FORMAT(1H ,41X, 12(2X,A6) ) CF123090
KKK = 10 CF123100
28 IF(NGT - KKK) 38, 38, 30 CF123110
30 KONE = KKK + 1 CF123120
IF(NGT - (KKK+12)) 34, 34, 32 CF123130
32 KTWO = KKK + 12 CF123140
GO TO 36 CF123150
34 KTWO = NGT CF123160
36 WRITE(KTOU,1016) (IVGT(I), I=KONE,KTWO) CF123170
1016 FORMAT(1H0,17X, 13(2X,I6) ) CF123180
WRITE(KTOU,1018) (AVAR(I), I=KONE,KTWO) CF123190
1018 FORMAT(1H ,17X, 13(2X,A6) ) CF123200
KKK = KKK + 12 CF123210
GO TO 28 CF123220
38 DF = NF - IP(1) CF123230
RMSL = (CP(1) + DF - IP(1) )*RMS/DF CF123240
WRITE(KTOU,1011) RMSL CF123250
1011 FORMAT(20X, 5HRMS =, F11.5) CF123260
IF(RMSL.GE.RMSE) GO TO 40 CF123270
LE = L CF123280
RMSE = RMSL CF123290
40 NLTP1 = NLT + 1 CF123300
IVLT(NLTP1) = K CF123310
C --- CONSTRUCT SMALLER MATRIX TO CONTAIN ONLY NLTP1 VARIABLES IN C(). CF123320
DO 42 I = 1, NLTP1 CF123330
IC = IVLT(I) CF123340
DO 42 J = I, NLTP1 CF123350
JC = IVLT(J) CF123360
42 C(I,J) = Z(IC,JC) CF123370
C --- REPLACE Z MATRIX WITH NEW SMALLER BASIC MATRIX AND SAVE C TO CF123380
C --- RESTORE THE Z MATRIX AFTER JRETRN SWEEPS. CF123390
DO 44 I=1, NLTP1 CF123400
DO 44 J=I, NLTP1 CF123410
44 Z(I,J) = C(I,J) CF123420
C --- ZERO INOUT INDEX USED TO DETERMINE IF VARIABLE IS PRESENT IN CF123430
C --- GARSIDE SEQUENCE. CF123440
DO 46 I = 1, NLT CF123450
46 INOUT(I) = 0 CF123460
C --- DETERMINE SEQUENCE OF SWEEPS. CF123470
DO 4000 I = 1, NLT CF123480
IS(I) = 2**(I-1) CF123490
4000 IS(I+20) = 2**I CF123500
C --- MAX NUMBER OF SWEEPS. CF123510
JMAX = 2**NLT - 1 CF123520
C --- SETTING OF SIZE OF FIRST SWEEP. CF123530
KSEQ = 2 CF123540
KSEQP1= 3 CF123550
IF(KSEQP1.GT.NLT) KSEQP1 = NLT CF123560
JSWEEP = 4 CF123570
C --- SETTING FOR FIRST RETURN TO BASIC MATRIX. CF123580
KRET = 5 CF123590
JRETRN = 32 CF123600
C CF123610
C --- CALCULATE CP VALUES OF REMAINING VARIABLE COMBINATIONS CF123620
C CF123630
C --- CPHIGH IS RESET AT STATEMENT 92 AT CP VALUE OF LOWEST JCP CF123640
C --- EQUATIONS OUT OF LCP CANDIDATE EQUATIONS FOUND AT FIRST CPHIGH CF123650
C --- SETTING. CF123660
CPHIGH = CPHI CF123670
JAZ = 0 CF123680
5000 JAZ = JAZ + 1 CF123690
C --- SETTING OF SIZE OF EACH NEW GROUPS OF SWEEPS. CF123700
IF(JAZ.LT.JSWEEP) GO TO 60 CF123710
IF(JAZ.EQ.JRETRN) GO TO 52 CF123720
JOY = KSEQ CF123730
KSEQ = KSEQ + 1 CF123740
KSEQP1= KSEQ + 1 CF123750
IF(KSEQP1.LE.NLT) GO TO 47 CF123760
KSEQP1 = NLT CF123770
GO TO 51 CF123780
C --- ADJUST THE NEW COLUMN VECTOR TO BE SWEPT (KSEQP1) BY THE CF123790
C --- VARIABLE (JOY) WHOSE INFLUENCE REMAINS IN THE ALREADY SWEPT CF123800
C --- MATRIX. ALSO ADJUST THE ELEMENT OF THE COLUMN VECTOR OF THE CF123810
C --- DEPENDENT VARIABLE ( Z(KSEQP1,NLTP1) ) FOR THE INFLUENCE OF CF123820
C --- VARIABLE JOY. (NLTP1 IS THE LOCATION OF THE DEPENDENT VARIABLE.) CF123830
C --- THIS IS ONLY DONE UNTIL JRETRN SWEEPS (MATRIX IS THEN REPLACED CF123840
C --- BY THE BASIC MATRIX). CF123850
47 JOY1 = JOY - 1 CF123860
JOY2 = JOY + 1 CF123870
HAPPY = C(JOY,JOY) CF123880
USP1 = C(JOY,KSEQP1) CF123890
DO 48 I = 1, JOY1 CF123900
48 Z(I,KSEQP1) = C(I,KSEQP1) - (C(I,JOY)*USP1) / HAPPY CF123910
Z(JOY,KSEQP1) = USP1 / HAPPY CF123920
DO 50 I = JOY2, KSEQP1 CF123930
50 Z(I,KSEQP1) = C(I,KSEQP1) - (C(JOY,I)*USP1) / HAPPY CF123940
Z(KSEQP1,NLTP1) = C(KSEQP1,NLTP1) - (USP1*C(JOY,NLTP1)) / HAPPY CF123950
51 JSWEEP = 2**KSEQ CF123960
FSW = HAPPY CF123970
GO TO 60 CF123980
C --- RETURN TO BASIC MATRIX. CF123990
52 DO 54 I = 1, NLTP1 CF124000
DO 54 IJ= I, NLTP1 CF124010
54 Z(I,IJ) = C(I,IJ) CF124020
C --- REINSTATE KRET VARIABLE IN SCC MATRIX. CF124030
JOY = KRET CF124040
SIGN = 1. CF124050
KSEQP1 = KRET + 2 CF124060
IF(KSEQP1.GT.NLT) KSEQP1 = NLT CF124070
CALL SWEEP(JOY,SIGN,KSEQP1,NLTP1) CF124080
C --- SET CONTROLS FOR NEXT RETURN TO BASIC MATRIX. CF124090
KRET = KRET + 1 CF124100
JRETRN = 2**KRET CF124110
JSWEEP = JRETRN CF124120
C --- MODIFY SCC MATRIX IN GARSIDE ORDER. CF124130
60 DO 4002 I = 1, NLT CF124140
4001 IF(MOD(JAZ-IS(I),IS(I+20)).EQ.0) GO TO 4003 CF124150
4002 CONTINUE CF124160
4003 JOY = I CF124170
IF(INOUT(JOY).EQ.0) GO TO 62 CF124180
MP = MP - 1 CF124190
NP = NP + 2 CF124200
INOUT(JOY) = 0 CF124210
SIGN = -1. CF124220
GO TO 64 CF124230
62 MP = MP + 1 CF124240
NP = NP - 2 CF124250
INOUT(JOY) = 1 CF124260
SIGN = 1. CF124270
64 CALL SWEEP(JOY,SIGN,KSEQP1,NLTP1) CF124280
CCP = (Z(NLTP1,NLTP1) / ZMS) - NP CF124290
IF(CCP.GT.CPHIGH) GO TO 100 CF124300
66 L = L + 1 CF124310
C --- STOP WRITING EQUATIONS IF L BECOMES LARGER THAN DIMENSIONS OF CP CF124320
152 IF(L.GT.MAXCIP) GO TO 156 CF124330
CP(L) = CCP CF124340
C --- DETERMINE WHICH VARIABLES ARE IN EQUATION L. CF124350
IN = 0 CF124360
DO 70 I = 1, NLT CF124370
IF(INOUT(I).EQ.0) GO TO 70 CF124380
IN = IN + 1 CF124390
JC = IVLT(I) CF124400
IVAR(IN) = JC CF124410
AVAR(IN) = BI(JC) CF124420
70 CONTINUE CF124430
IP(L) = MP CF124440
IF (IN - 12) 72, 72, 74 CF124450
72 MNO = IN CF124460
GO TO 76 CF124470
74 MNO = 12 CF124480
76 WRITE(KTOU,1020) L, IP(L), CP(L), (IVAR(I),I=1,MNO) CF124490
1020 FORMAT(1H0,3X,2I4,1X,F5.1,2X,14HBASIC SET PLUS,12(2X,I6)) CF124500
WRITE(KTOU, 1022) (AVAR(I),I=1,MNO) CF124510
1022 FORMAT(1H ,33X, 12(2X,A6) ) CF124520
KKK = 12 CF124530
78 IF(IN - KKK) 90, 90, 80 CF124540
80 KONE = KKK + 1 CF124550
IF( IN - (KKK+12)) 84, 84, 82 CF124560
82 KTWO = KKK + 12 CF124570
GO TO 86 CF124580
84 KTWO = IN CF124590
86 WRITE(KTOU,1016) (IVAR(I), I=KONE,KTWO) CF124600
WRITE(KTOU,1018) (AVAR(I), I=KONE,KTWO) CF124610
90 DF = NF - IP(L) CF124620
RMSL = (CP(L) + NP)*RMS/DF CF124630
WRITE(KTOU,1011) RMSL CF124640
IF(RMSL.GE.RMSE) GO TO 92 CF124650
LE = L CF124660
RMSE = RMSL CF124670
C --- JCP, LCP AND LMORE ARE SET BEFORE DO LOOP 100. CF124680
92 IF(L.NE.LCP) GO TO 100 CF124690
IF((JMAX - L).LT.LMORE) GO TO 100 CF124700
CALL SORT(L,CP,LSORT) CF124710
JC = LSORT(JCP) CF124720
CPHIGH = CP(JC) CF124730
WRITE(KTOU,1023) CPHIGH, JCP CF124740
1023 FORMAT(//1X,49HREMAINING CANDIDATE EQUATIONS PRINTED ONLY IF CP , CF124750
1 18HVALUE IS LESS THAN , F5.1 / 1X, I4, CF124760
2 41H EQUATIONS ALREADY HAVE SMALLER CP VALUES // ) CF124770
100 IF(JAZ.LT.JMAX) GO TO 5000 CF124780
5001 CONTINUE CF124790
C CF124800
C --- CHECK EFFECT OF SWEEPS ON ROUNDOFF ERROR. CF124810
VK = Z(NLTP1,NLTP1) CF124820
DO 154 I = 1, NLTP1 CF124830
DO 154 IJ= I, NLTP1 CF124840
154 Z(I,IJ) = C(I,IJ) CF124850
C --- REINSTATE KRET VARIABLE IN SCC MATRIX. CF124860
JOY = NLT CF124870
SIGN = 1. CF124880
CALL SWEEP(JOY,SIGN,KSEQP1,NLTP1) CF124890
DVK = Z(NLTP1,NLTP1) - VK CF124900
WRITE(KTOU,3338) JAZ, DVK CF124910
3338 FORMAT(1H0,12HSWEEP NUMBER , I10, 18H, DELTA Z(K,K) = ,1P1E7.0) CF124920
GO TO 158 CF124930
156 WRITE(KTOU,157) MAXCIP CF124940
157 FORMAT(1H0//// 53H SEARCH TERMINATED. NUMBER OF EQUATIONS GREATERCF124950
1 THAN , I5, 26H(DIMENSIONS OF CP AND IP). ) CF124960
L = L - 1 CF124970
GO TO 5001 CF124980
C --- CF124990
158 WRITE(KTOU,200) CF125000
200 FORMAT(1H1, 20HESTIMATE OF VARIANCE ) CF125010
FSW = (RMSE - RMS) / RMS CF125020
IF(DABS(FSW).LE.1.D-8) GO TO 204 CF125030
FSW = 1.0 CF125040
WRITE(KTOU,202) RMS, LE, RMSE CF125050
202 FORMAT(1H0, 20HRMS OF FULL EQUATION, 6X, F16.8 / CF125060
1 1X, 22HRMS OF SUBSET EQUATION, I4, F16.8 ) CF125070
GO TO 207 CF125080
204 FSW = 0.0 CF125090
WRITE(KTOU,206) CF125100
206 FORMAT(1H0,46HNO SMALLER RMS VALUE FOUND IN SUBSET EQUATIONS) CF125110
207 IF(IQ(25) - 2) 208, 212, 216 CF125120
208 WRITE(KTOU,210) CF125130
210 FORMAT(1H0,50HRMS OF FULL EQUATION SELECTED BY USER TO CALCULATE, CF125140
110H CP VALUES ) CF125150
GO TO 236 CF125160
212 IF(FSW.EQ.0.) GO TO 232 CF125170
WRITE(KTOU,214) CF125180
214 FORMAT(1H0,62HRMS OF SUBSET EQUATION USED TO RECALCULATE AND PLOT CF125190
1CP VALUES. ) CF125200
GO TO 222 CF125210
216 READ(KTIN,218) RMSE CF125220
218 FORMAT(F16.8) CF125230
WRITE(KTOU,220) RMSE CF125240
220 FORMAT(1H ,20HRMS PROVIDED BY USER, 6X, F16.8 // 1X, CF125250
1 58HESTIMATED VARIANCE USED TO RECALCULATE AND PLOT CP VALUES. ) CF125260
222 RMSR = RMS/RMSE CF125270
DP = NF - 2*IPMAX CF125280
CPFULL = (CPMAX - .005 + DP)*RMSR - DP CF125290
WRITE(KTOU,224) IPMAX, CPFULL CF125300
224 FORMAT(1H0,22X,6HP CP/1X,13HFULL EQUATION,6X,I4,1X,F5.1) CF125310
IF(FSW.EQ.0.) GO TO 228 CF125320
DP = NF - 2*IP(LE) CF125330
CPFULL = (CP(LE) + DP)*RMSR - DP CF125340
WRITE(KTOU,226) LE, IP(LE), CPFULL CF125350
226 FORMAT(1H , 15HSUBSET EQUATION, 2I4, 1X, F5.1) CF125360
228 DO 230 J = 1, L CF125370
DP = NF - 2*IP(J) CF125380
230 CP(J) = (CP(J) + DP)*RMSR - DP CF125390
GO TO 236 CF125400
232 WRITE (KTOU,234) CF125410
234 FORMAT(1H0,49HRMS OF FULL EQUATION USED TO CALCULATE CP VALUES.) CF125420
236 IF(L.EQ.1) GO TO 1034 CF125430
C --- ORDER EQUATIONS BY THEIR CP VALUES. CF125440
CALL SORT (L, CP, LSORT) CF125450
WRITE(KTOU,238) CF125460
238 FORMAT(1H0// 30H SEQ EQUATION P ORDERED CP ) CF125470
IA = MAXNPR CF125480
IF(L.LT.IA) IA = L CF125490
DO 240 IC = 1, IA CF125500
JC = LSORT(IC) CF125510
240 WRITE(KTOU,242) IC, JC, IP(JC), CP(JC) CF125520
242 FORMAT(1H , I4, 4X, I4, 1X, I4, F9.1 ) CF125530
ILESS = 0 CF125540
IF(IPMAX.GT.17.AND.IPMAX.LT.28) ILESS = 10 CF125550
IF(IPMAX.GT.27.AND.IPMAX.LT.38) ILESS = 20 CF125560
IF(IPMAX.GT.37.AND.IPMAX.LT.48) ILESS = 30 CF125570
IF(IPMAX.GT.47.AND.IPMAX.LT.58) ILESS = 40 CF125580
IF(IPMAX.GT.57.AND.IPMAX.LT.68) ILESS = 50 CF125590
IF(IPMAX.GT.67) ILESS = 60 CF125600
CLESS = DFLOAT(ILESS) CF125610
L1 = 99 CF125620
ILEVEL = ILESS - 1 CF125630
DO 1040 JZ=1,21 CF125640
1040 NVALP(JZ) = ILEVEL + JZ CF125650
ITYPE = 2 CF125660
CALL GRID(GRIDA,GRIDB,L1,ITYPE) CF125670
YTOP = 5.2D01/3.D0 CF125680
YIW = 1.D0/3.D0 CF125690
DO 118 IC = 1, L CF125700
JC = LSORT(IC) CF125710
IP(JC) = IP(JC) - ILESS CF125720
IF(IP(JC).LT.1) GO TO 118 CF125730
CP(JC) = CP(JC) - CLESS CF125740
CPTOP = YTOP - CP(JC) CF125750
C --- TRAP TO KEEP PLOT FROM GOING OUTSIDE OF PLOT DIMENSIONS. CF125760
IF(CPTOP.LT.0.) GO TO 118 CF125770
LINE = IDINT((( CPTOP ) / YIW) + 5.D-01) + 1 CF125780
LOCX2 = 5*IP(JC) + 5 CF125790
LCHAR = MOD(LOCX2,4) CF125800
LWORD = LOCX2/4 CF125810
IF(LCHAR.NE.0) GO TO 117 CF125820
LCHAR = 4 CF125830
LWORD = LWORD - 1 CF125840
117 CALL PACK(GRIDA(LINE,LWORD),LCHAR,IPLUS) CF125850
118 CONTINUE CF125860
WRITE(KTOU,1028) PR1, PR2, PR3, ICURY, BI(K), NSRCH, NVALP CF125870
1028 FORMAT(1H1, 1X, 3A6, 9H DEP VAR , I2, 2H: , A6, 29X, CF125880
1 7HCP PLOT, 33X, 13HSEARCH NUMBER, I2 / 20X, 21(I2,3X) ) CF125890
WRITE(KTOU,1029) NCP1( 1), (GRIDA( 1,JZ),JZ=1,26) CF125900
1029 FORMAT(10X, A4, 7X, 25A4, A2) CF125910
NI = 0 CF125920
INDIA = 2 CF125930
ILEVEL = 18 + ILESS CF125940
DO 1032 IA = 2,53 CF125950
IF(IA.EQ.INDIA) GO TO 1030 CF125960
WRITE(KTOU,1029) NCP1(IA), (GRIDA(IA,JZ),JZ=1,26) CF125970
GO TO 1032 CF125980
1030 NI = NI + 1 CF125990
NJ = ILEVEL - NI CF126000
WRITE(KTOU,1031) NCP1(IA), NJ,(GRIDA(IA,JZ),JZ=1,26) CF126010
1031 FORMAT(10X, A4, 2X, I4, 1X, 25A4, A2) CF126020
INDIA = INDIA + 3 CF126030
1032 CONTINUE CF126040
WRITE(KTOU,1033) NVALP CF126050
1033 FORMAT(20X, 21(I2,3X) / 71X, 1HP) CF126060
C --- DETERMINE IF ADDITIONAL FACTORIAL SEARCHES HAVE BEEN REQUESTED. CF126070
1034 IF(NSRCH.EQ.NCP) GO TO 9999 CF126080
NSRCH = NSRCH + 1 CF126090
NOVAR = NOIND + NODEP CF126100
REWIND KTBIN1 CF126110
IF(IQ(24).EQ.0.OR.IQ(20).EQ.0) GO TO 9980 CF126120
READ(KTBIN1) ( DUM, I=1, NOVAR) CF126130
9980 DO 9982 I = 1, NOIND CF126140
9982 READ(KTBIN1) (C(I,J), J = I,NOIND) CF126150
DO 9984 I = 1, NOVAR CF126160
9984 READ(KTBIN1) (Z(I,J), J = I,NOVAR ) CF126170
C --- SQUARE Z MATRIX. CF126180
NOVM1 = NOVAR - 1 CF126190
DO 9986 I = 1, NOVM1 CF126200
IPL1 = I + 1 CF126210
DO 9986 J = IPL1, NOVAR CF126220
9986 Z(J,I)= Z(I,J) CF126230
9987 READ(KTIN,9988) (ICP(I), I=1, MAXSRH) CF126240
9988 FORMAT( 18(2X,I2) ) CF126250
9990 L = 0 CF126260
LE = 0 CF126270
MP = 0 CF126280
NGT = 0 CF126290
NLT = 0 CF126300
NF = NOOBSV CF126310
RMSE = RMS CF126320
IF(IQ(5).EQ.1) GO TO 9903 CF126330
9902 MP = 1 CF126340
9903 NP = NOOBSV - 2*MP CF126350
IPMAX = MP + NOIND CF126360
CPMAX = DFLOAT(IPMAX) + .005 CF126370
GO TO 9994 CF126380
9997 WRITE(KTOU,9998) MAXSRH CF126390
9998 FORMAT(1H0, 48HNUMBER OF VARIABLES REMAINING TO BE SEARCHED IS , CF126400
1 13HGREATER THAN ,I2/ 36H USE FRACTIONAL FACTORIAL OPTION TO , CF126410
2 14HSOLVE PROBLEM. ) CF126420
9999 RETURN CF126430
END CF126440
SUBROUTINE SWEEP(JOY,SIGN,KSEQP1,NVLTP1) CF130010
C --- SUBROUTINE MODIFIES MATRIX WHEN VARIABLE JOY IS ADDED OR CF130020
C --- DELETED. SEE BROWNLEE SECTION 17.10, EQUATION 10.5. CF130030
C --- SIGN POSITIVE SIGN INDICATES VARIABLE ADDED, NEGATIVE SIGN CF130040
C --- INDICATES VARIABLE REMOVED. CF130050
C --- KSEQP1 SIZE OF SWEEP (K VARIABLES IN CURRENT SEQUENCE PLUS 1). CF130060
C --- NVLTP1 NUMBER OF VARIABLES EVENTUALLY TO BE SWEPT WITH JOY CF130070
C --- PLUS 1 (VARIABLES REMAINING AFTER BASIC SET HAS BEEN CF130080
C --- CHOSEN). CF130090
IMPLICIT REAL*8(A-H,O-Z) CF130100
DIMENSION U(41) CF130110
COMMON /HHHHHH/ BETA(41), C(40,40), Z(41,41), NNNN, MXSIZE CF130120
EQUIVALENCE (BETA(1),U(1)) CF130130
1 JOY1=JOY-1 CF130140
JOY2=JOY+1 CF130150
HAPPY=Z(JOY,JOY) CF130160
IF(JOY1)3,3,2 CF130170
2 DO 1000 I=1,JOY1 CF130180
U(I)=Z(I,JOY) CF130190
Z(I,JOY)=0.0 CF130200
1000 CONTINUE CF130210
3 U(JOY)=-SIGN CF130220
Z(JOY,JOY)=0.0 CF130230
IF(JOY2-KSEQP1)4,4,5 CF130240
4 DO 2000 I=JOY2,KSEQP1 CF130250
U(I)=Z(JOY,I) CF130260
Z(JOY,I)=0.0 CF130270
2000 CONTINUE CF130280
5 DO 3000 I=1,KSEQP1 CF130290
DO 3000 J=I,KSEQP1 CF130300
Z(I,J)=Z(I,J)-(U(I)*U(J))/HAPPY CF130310
3000 CONTINUE CF130320
U(NVLTP1) = Z(JOY,NVLTP1) CF130330
Z(JOY,NVLTP1) = 0.0 CF130340
J = NVLTP1 CF130350
6 DO 4000 I = 1,KSEQP1 CF130360
Z(I,J)=Z(I,J)-(U(I)*U(J))/HAPPY CF130370
4000 CONTINUE CF130380
7 I = NVLTP1 CF130390
Z(I,J)=Z(I,J)-(U(I)*U(J))/HAPPY CF130400
RETURN CF130410
END CF130420
SUBROUTINE SORT(NOB, R, LSORT) CF140010
C --- SUBROUTINE SORTS NOB OBSERVATIONS IN VECTOR R IN ASCENDING CF140020
C --- ORDER AND PLACES THAT ORDER IN LSORT. CF140030
IMPLICIT REAL*8(A-H,O-Z) CF140040
DIMENSION R(1),LSORT(1) CF140050
LSORT(1) = 1 CF140060
DO 16 ISA = 2, NOB CF140070
TEMP = R(ISA) CF140080
ISAX = ISA - 1 CF140090
DO 11 ISB = 1, ISAX CF140100
IBB = LSORT(ISB) CF140110
IF(TEMP - R(IBB) ) 12,12,11 CF140120
11 CONTINUE CF140130
LSORT(ISA) = ISA CF140140
GO TO 16 CF140150
12 KSA = ISA CF140160
13 KSA = KSA - 1 CF140170
LSORT(KSA + 1) = LSORT(KSA) CF140180
IF(KSA - ISB) 15,15,13 CF140190
15 LSORT(ISB) = ISA CF140200
16 CONTINUE CF140210
RETURN CF140220
END CF140230
SUBROUTINE CCARD(MXFMTC, MXINFC, MNOMTC, MNIVOC, MAXSRH) CF150010
C CF150020
C --- THIS SUBROUTINE LISTS THE CONTROL CARD SELECTION, THE DIMENSION CF150030
C --- LIMITS AND THE ORDER OF CARDS FOR THIS VERSION OF LINWOOD. CF150040
C CF150050
IMPLICIT REAL*8(A-H,O-Z) CF150060
COMMON /KKKKKK/ IQ(40), PR1, PR2, PR3, K, KFM, NODEP, NOIND, CF150070
1 NOOBSV, ICURY CF150080
COMMON /LLLLLL/ XEFMT, JOMIT(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,37H 8 CP FACTORIAL SEARCH CARD, IF ANY. ) CF150500
WRITE(KTOU,24) IQ(4) CF150510
24 FORMAT(1H ,3X,2H26,I4, 8X, CF150520
1 55H1 WEIGHT OBSERVATIONS. WEIGHT ENTERED IN LAST POSITION., CF150530
1 6X,41H 9 DATA CARDS (IF NOT READ FROM A FILE)., CF150540
2 /18X,53H2 WEIGHT BY 1/VAR. OF OBSERVATION. VARIANCE ENTERED. , CF150550
2 8X,52H10 END CARD (END IN COLUMNS 1 - 3 OF IDENTIFICATION ) CF150560
WRITE(KTOU,26) IQ(5) CF150570
26 FORMAT(1H ,3X,2H27,I4, 8X, CF150580
1 54H1 LET B(0) = ZERO, OTHERWISE B(0) IS CALCULATED VALUE. , CF150590
1 12X,47HFIELD). THE NUMBER OF END CARDS MUST EQUAL THE ) CF150600
WRITE(KTOU,28) IQ(6) CF150610
28 FORMAT(1H ,3X,2H28,I4, 8X, CF150620
1 36H1 CHECK OBSERVATION NUMBER SEQUENCE. , CF150630
1 30X,43HNUMBER OF CARDS PER OBSERVATION. (END CARDS ) CF150640
WRITE(KTOU,30) IQ(7) CF150650
30 FORMAT(1H ,3X,2H29,I4, 8X, CF150660
1 43H1 CHECK SEQUENCE WITHIN OBSERVATION NUMBER. , CF150670
1 23X,45HARE NOT NEEDED IF DATA ARE READ FROM A FILE). ) CF150680
WRITE(KTOU,32) IQ(8) CF150690
32 FORMAT(1H ,3X,2H30,I4, 8X, CF150700
1 47H1 DO BACK TRANSFORMATION OF DEPENDENT VARIABLE. , CF150710
1 14X,38H11 ESTIMATE OF VARIANCE CARD, IF ANY. ) CF150720
WRITE(KTOU,34) IQ(9) CF150730
34 FORMAT(1H ,3X,2H31,I4, 8X, CF150740
1 45H1 PUNCH DATA FOR CONFIDENCE INTERVAL PROGRAM. , CF150750
1 16X,50H12 ADDITIONAL CP FACTORIAL SEARCH AND ESTIMATE OF ) CF150760
WRITE(KTOU,36) IQ(10) CF150770
36 FORMAT(1H ,3X,2H32,I4, 8X, CF150780
1 22H0 LIST ALL INPUT DATA. , CF150790
1 44X,23HVARIANCE CARDS, IF ANY., CF150800
2 /18X, 28H1 LIST ONLY 1ST OBSERVATION. , CF150810
3 /18X, 29H2 DO NOT LIST ANY INPUT DATA. , CF150820
3 32X,14HSECOND PROBLEM ) CF150830
WRITE(KTOU,38) IQ(11) CF150840
38 FORMAT(1H ,3X,2H33,I4, 8X, CF150850
1 48H0 LIST TRANSFORMATIONS AND ALL TRANSFORMED DATA. , CF150860
1 15X,38HIF DATA ARE REUSED FROM FIRST PROBLEM, , CF150870
2 /18X,55H1 LIST TRANSFORMATIONS AND 1ST TRANSFORMED OBSERVATION., CF150880
2 12X,38HDELETE THE FORMAT, DATA AND END CARDS., CF150890
3 /18X,50H2 DO NOT LIST TRANSFORMATIONS OR TRANSFORMED DATA. , CF150900
3 13X,20HIF NAMES ARE REUSED, ) CF150910
WRITE(KTOU,40) IQ(12) CF150920
40 FORMAT(1H ,3X,2H34,I4, 8X, CF150930
1 32H1 DO NOT LIST SUMS OF VARIABLES. , CF150940
1 35X,22HDELETE THE NAME CARDS. ) CF150950
WRITE(KTOU,42) IQ(13) CF150960
42 FORMAT(1H ,3X,2H35,I4, 8X, CF150970
1 54H1 DO NOT LIST RAW SUMS AND CROSS PRODUCTS WHEN B(O)=O. , CF150980
1 9X,34HIF DIFFERENT INPUT DATA AND NAMES, ) CF150990
WRITE(KTOU,44) IQ(14) CF151000
44 FORMAT(1H ,3X,2H36,I4, 8X, CF151010
1 47H1 DO NOT LIST RESIDUAL SUMS AND CROSS PRODUCTS. , CF151020
1 20X,20HREPEAT 1 - 12 ABOVE. ) CF151030
WRITE(KTOU,46) IQ(15) CF151040
46 FORMAT(1H ,3X,2H37,I4, 8X, CF151050
1 55H1 DO NOT LIST MEANS AND ROOT MEAN SQUARES OF VARIABLES. ) CF151060
WRITE(KTOU,48) IQ(16) CF151070
48 FORMAT(1H ,3X,2H38,I4, 8X, CF151080
1 55H1 DO NOT LIST SIMPLE CORRELATION COEFFICIENTS. ) CF151090
WRITE(KTOU,50) IQ(17) CF151100
50 FORMAT(1H ,3X,2H39,I4, 8X, CF151110
1 29H1 DO NOT LIST INVERSE MATRIX. ) CF151120
WRITE(KTOU,52) IQ(18) CF151130
52 FORMAT(1H ,3X,2H40,I4, 8X, CF151140
1 47H1 DO NOT PRINT PLOTS OF RESIDUALS VS. FITTED Y. / 18X, CF151150
2 53H2 PLOT (A) RESIDUALS AND (B) COMPONENT AND COMPONENT- / 18X, CF151160
3 48H PLUS-RESIDUALS VS. EACH INDEPENDENT VARIABLE. / 18X, CF151170
4 26H3 PLOT (A) RESIDUALS ONLY. / 18X, CF151180
5 55H4 PLOT (B) COMPONENT AND COMPONENT-PLUS-RESIDUALS ONLY./18X, CF151190
6 46H5 PLOT (B) BUT EXPAND SCALE TO FILL EACH PLOT. ) CF151200
WRITE(KTOU,54) IQ(19) CF151210
54 FORMAT(1H ,3X,2H41,I4, 8X, CF151220
1 54H0 READ DATA WITH STANDARD FORMAT (A6, I4, I2, 10F6.3). /18X, CF151230
2 59H1 READ DATA WITH FORMAT TO BE READ, 1 CARD (72COL) ASSUMED./ CF151240
3 18X, 47H2 READ DATA WITH READ DATA (REDATA) SUBROUTINE. ) CF151250
WRITE(KTOU,56) IQ(20) CF151260
56 FORMAT(1H ,3X,2H42,I4, 8X, CF151270
1 36H0 DO NOT SAVE DATA FOR NEXT PROBLEM. / 18X, CF151280
2 29H1 SAVE DATA FOR NEXT PROBLEM./ 18X, CF151290
3 35H2 REUSE DATA FROM PREVIOUS PROBLEM. ) CF151300
WRITE(KTOU,58) IQ(21), MAXSRH CF151310
58 FORMAT(1H ,5H43-44,I4,I6,2X, CF151320
1 52HNUMBER OF VARIABLES IN CP SEARCH IF GREATER THAN 12. ) CF151330
WRITE(KTOU,60) IQ(22), MXFMTC CF151340
60 FORMAT(1H ,3X,2H45,I4,I6,2X, CF151350
1 41HNUMBER OF FORMAT CARDS IF GREATER THAN 1. ) CF151360
WRITE(KTOU,62) IQ(23), MXINFC CF151370
62 FORMAT(1H ,5H46-47,I4,I6,2X, CF151380
1 53HNUMBER OF INFORMATION CARDS TO BE READ FOR DISPLAY ON / 18X, CF151390
2 35H PRINTOUT IF DESIRED, 72 COL. EACH. ) CF151400
WRITE(KTOU,64) IQ(24) CF151410
64 FORMAT(1H ,3X,2H48,I4, 8X, CF151420
1 50H1 READ NAMES OF VARIABLES FOR DISPLAY ON PRINTOUT. / 18X, CF151430
2 57H NAMES IN SAME POSITIONS AS VARIABLES ON TRANSFORMATION/18X,CF151440
3 43H CARDS - COLS. 1-6, 11-16, - - - , 61-66. / 18X, CF151450
4 47H NAMES ARE NOT MOVED, ONLY LISTED OR DELETED. / 18X, CF151460
5 49H2 REUSE NAMES OF VARIABLES FROM PREVIOUS PROBLEM. ) CF151470
WRITE(KTOU,66) IQ(25) CF151480
66 FORMAT(1H ,3X,2H49,I4, 8X, CF151490
1 52HSEARCH FOR CANDIDATE EQUATIONS VIA CP. USE ESTIMATE / 18X, CF151500
2 25H OF VARIANCE (RMS) FROM: / 18X, CF151510
3 16H1 FULL EQUATION, / 18X, CF151520
4 44H2 SUBSET EQUATION WITH MINIMUM RMS VALUE, OR / 18X, CF151530
5 42H3 ESTIMATE OF VARIANCE CARD, F16.8 FORMAT. ) CF151540
WRITE(KTOU,68) IQ(26) CF151550
68 FORMAT(1H ,3X,2H50,I4, 8X, CF151560
1 50HNUMBER OF CP FACTORIAL SEARCH CARDS TO BE READ PER / 18X, CF151570
2 53H DEPENDENT VARIABLE. KEYPUNCH IN ASCENDING ORDER THE / 18X, CF151580
3 52H IDENTIFING NUMBER OF THE VARIABLES (AFTER TRANSFOR- / 18X, CF151590
4 54H MATIONS) TO BE USED IN THAT SEARCH, 18(2X,I2) FORMAT. / 18X, CF151600
5 54H ALL OTHER VARIABLES WILL BE PLACED IN BASIC EQUATION. ) CF151610
WRITE(KTOU,70) IQ(27) CF151620
70 FORMAT(1H ,3X,2H51,I4, 8X, CF151630
1 55H1 LIST COMPONENT-EFFECT TABLE, REQUIRED X(I) PRECISION,/ 18X, CF151640
2 54H ESTIMATE OF STANDARD DEVIATION FROM NEAR NEIGHBORS, / 18X, CF151650
3 29H AND FUNCTIONS OF FITTED Y. / 18X, CF151660
4 53H2 LIST ONLY ESTIMATE OF STD. DEVIATION AND FUNCTIONS. / 18X, CF151670
5 34H3 LIST ONLY FUNCTIONS OF FITTED Y. ) CF151680
WRITE(KTOU,72) IQ(28) CF151690
72 FORMAT(1H ,5H52-53,I4, 8X, CF151700
1 51HNUMBER OF FILE IF DATA ARE READ FROM SEPARATE FILE, / 18X, CF151710
2 53H NO END CARD IF ONLY ONE SET OF DATA IS ON EACH FILE. ) CF151720
WRITE(KTOU,74) IQ(29) CF151730
74 FORMAT(1H ,5H54-55,I4, 8X, CF151740
1 51HNUMBER OF INDEPENDENT VARIABLES GREATER THAN THE 99 / 18X, CF151750
2 23H ALLOWED IN COLS 19-20. ) CF151760
WRITE(KTOU,76) IQ(30) CF151770
76 FORMAT(1H ,5H56-58,I4, 8X, CF151780
1 42HTO REDUCE PRINTOUT WITH MANY OBSERVATIONS, / 18X, CF151790
2 49H NUMBER OF CENTRAL OBSERVATIONS AND RESIDUALS NOT / 18X, CF151800
3 46H TO BE PRINTED. THIS REQUIRES AN E IN COL 24. ) CF151810
WRITE(KTOU,78) IQ(31) CF151820
78 FORMAT(1H ,3X,2H59,I4, 8X, CF151830
1 51HCROSS VERIFICATION OF MODEL AND COEFFICIENTS WITH A / 18X, CF151840
2 24H SECOND SAMPLE OF DATA: / 18X, CF151850
3 45H1 WRITE B(0) AND B(I)S ON FILE IN ONE PROBLEM / 18X, CF151860
4 35H (TRANSFORMATIONS ARE NOT SAVED). / 18X, CF151870
5 48H2 READ B(0) AND B(I)S FROM FILE IN NEXT PROBLEM / 18X, CF151880
6 34H WITH SECOND SET OF OBSERVATIONS. ) CF151890
WRITE(KTOU,80) IQ(32), MNOMTC CF151900
80 FORMAT(1H ,3X,2H60,I4,I6,2X, CF151910
1 46HNUMBER OF DELETE-OBSERVATIONS CARDS. KEYPUNCH / 18X, CF151920
2 55H OBSERVATION NUMBER OF DATA TO BE DELETED IN ORDER READ/ 18X, CF151930
3 35H BY COMPUTER USING 7(I4,6X) FORMAT. ) CF151940
WRITE(KTOU,82) IQ(33), MNIVOC CF151950
82 FORMAT(1H ,3X,2H61,I4,I6,2X, CF151960
1 48HNUMBER OF INDICATOR-VARIABLE-OBSERVATIONS CARDS. / 18X, CF151970
2 52H USING A 7(I4,2X,I3,1X) FORMAT, KEYPUNCH OBSERVATION / 18X, CF151980
3 51H NUMBER (IN ORDER READ) AND VARIABLE NUMBER (BEFORE / 18X, CF151990
4 51H TRANSFORMATIONS) INTO WHICH A 1 IS TO BE INSERTED. ) CF152000
C CF152010
RETURN CF152020
END CF152030
SUBROUTINE TRANPT CF160010
C CF160020
C --- THIS SUBROUTINE PRINTS THE REQUESTED TRANSFORMATIONS PRIOR TO CF160030
C --- PERFORMING THEM IN SUBROUTINE TRANSF. CF160040
C CF160050
IMPLICIT REAL*8(A-H,O-Z) CF160060
REAL*4 ARRAY, DRRAY, ERRAY, FRRAY, GRRAY, HRRAY CF160061
DIMENSION AVATR(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
270 WRITE(KTOU,863) CF160780
IF(IDECM.EQ.0) TYPE 863 CF160781
863 FORMAT(21H0DATA TRANSFORMATIONS) CF160790
C LIST TRANSFORMATION CARDS CF160800
WRITE(KTOU,995) CF160810
IF(IDECM.EQ.0) TYPE 995 CF160811
C TITLE LINE FOR TRANSFORMATION CARD LISTING CF160820
995 FORMAT(1H ,7X,8HPOSITION,3X,4HCODE,3X,9HOPERATION,17X, CF160830
1 8HCONSTANT,2X,8HLOCATION,2X,4HOMIT,2X,8HVARIABLE,2X,4HNAME) CF160840
MCOUNT = 0 CF160850
DO 1010 I=1, JNOVAR CF160860
C CF160870
C --- SIMPLIFY TRANSFORMATION SYMBOLS FOR PRINTOUT CF160880
C CF160890
272 IOPCDE=ITRFM(I)+1 CF160900
C CF160910
C --- PUT CODE SYMBOL IN F ARRAY VIA E ARRAY CF160920
C CF160930
NAAA = ITRFM(I) CF160940
IF(ITRFM(I).EQ.0) GO TO 1001 CF160950
FRRAY= ERRAY(NAAA) CF160960
GO TO 1002 CF160970
1001 FRRAY= ARRAY(10,1) CF160980
1002 NAAB = ITLOC(I) CF160990
C CF161000
C --- PUT LOCATION SYMBOL IN G ARRAY VIA E ARRAY CF161010
C CF161020
IF(ITLOC(I).EQ.0) GO TO 1003 CF161030
GRRAY=ERRAY(NAAB) CF161040
GO TO 1004 CF161050
1003 GRRAY= ERRAY(I) CF161060
C CF161070
C --- PUT VARIABLE IN H ARRAY VIA E ARRAY CF161080
C CF161090
1004 IF(IOMIT(I).EQ.1) GO TO 1005 CF161100
MCOUNT = MCOUNT + 1 CF161110
HRRAY = ERRAY(MCOUNT) CF161120
GO TO 1006 CF161130
1005 HRRAY = ARRAY(10,1) CF161140
1006 IF(ITRFM(I).GE.9.AND.ITRFM(I).LE.12) GO TO 1008 CF161150
C CF161160
C --- PRINTOUT OPERATIONS THAT USE CONSTANTS CF161170
C CF161180
WRITE(KTOU,1007)I,FRRAY,(ARRAY(IOPCDE,JZ),JZ=1,6),AVATR(I), CF161190
1 GRRAY, IOMIT(I), HRRAY, BI(I) CF161200
IF(IDECM.EQ.0) TYPE 1007,I,FRRAY,(ARRAY(IOPCDE,JZ),JZ=1,6), CF161201
1 AVATR(I),GRRAY,IOMIT(I),HRRAY,BI(I) CF161202
C OUTPUT FORMAT OF TRANSFORMATION CARD CF161210
1007 FORMAT(1H , 9X,I3,7X,A2,4X,6A4,3X,A5,7X,A2,6X,I1,7X,A2,5X,A6) CF161220
GO TO 1010 CF161230
C CF161240
C --- PRINTOUT OPERATIONS THAT UTILIZE POSITIONS CF161250
C CF161260
C CF161270
C --- PUT POSITION CHANGES IN D ARRAY CF161280
C CF161290
1008 JAA = ITRFM(I) - 8 CF161300
MA = IDINT(0.01*VARTR(I)) CF161310
NA = IDINT(DMOD(VARTR(I),1.0D2)) CF161320
WRITE(KTOU,1009) I,FRRAY,(ARRAY(IOPCDE,JZ),JZ=1,6), MA,DRRAY(JAA),CF161330
1 NA, GRRAY, IOMIT(I), HRRAY, BI(I) CF161340
IF(IDECM.EQ.0) TYPE 1009,I,FRRAY,(ARRAY(IOPCDE,JZ),JZ=1,6),MA, CF161341
1 DRRAY(JAA),NA,GRRAY,IOMIT(I),HRRAY,BI(I) CF161342
C OUTPUT FORMAT OF TRANSFORMATION CARD CF161350
1009 FORMAT(1H , 9X,I3,7X,A2,6A4,I2,A1,I2,14X,A2,6X,I1,7X,A2,5X,A6) CF161360
1010 CONTINUE CF161370
IDEC=IDEC+1 CF161371
RETURN CF161380
END CF161390
SUBROUTINE FALPHA(PAR,DEFR,FVALUE,PERCNT) CF170010
C CF170020
C --- SUBROUTINE CALCULATES THE ALPHA LEVEL OF THE F DISTRIBUTION CF170030
C --- FOR GIVEN F VALUES. SEE HANDBOOK OF MATHEMATICAL FUNCTIONS BY CF170040
C --- M. ABRAMOWITZ AND I. A. STEGUN, NATIONAL BUREAU OF STANDARDS, CF170050
C --- APPLIED MATH SERIES 55, 1964, X = PAGE 947 FORMULA 26.6.15, CF170060
C --- ALPHA = PAGE 932 FORMULA 26.2.18. WHEN FVALUE IS LESS THAN 1, CF170070
C --- USE PAGE 947 FORMULA 26.6.9. CF170080
C CF170090
IMPLICIT REAL*8(A-H,O-Z) CF170100
DATA D1/196854.D-6/,D2/115194.D-6/,D3/344.D-6/,D4/19527.D-6/ CF170110
FVAL = FVALUE CF170120
V1 = PAR CF170130
V2 = DEFR CF170140
IF(FVALUE.GT.1.) GO TO 10 CF170150
FVAL = 1./FVALUE CF170160
V1 = DEFR CF170170
V2 = PAR CF170180
10 A = 2./(9.*V1) CF170190
B = 2./(9.*V2) CF170200
C1 = FVAL**(1./3.) CF170210
C2 = C1*C1 CF170220
X = (C1*(1.-A) - (1.-B))/DSQRT(B+C2*A) CF170230
ALPHA = .5/(1.+X*(D1+X*(D2+X*(D3+D4*X))))**4 CF170240
IF(FVALUE.GT.1.) GO TO 20 CF170250
PERCNT = ALPHA*100. CF170260
GO TO 30 CF170270
20 PERCNT = (1. - ALPHA)*100. CF170280
30 RETURN CF170290
END CF170300
SUBROUTINE OPNFLS CF180010
DOUBLE PRECISION FILIN,FILOU CF180020
OPEN(UNIT=1,DEVICE='DSK',ACCESS='SEQINOUT', CF180030
* FILE='FT01.DAT',MODE='BINARY') CF180040
OPEN(UNIT=2,DEVICE='DSK',ACCESS='SEQINOUT', CF180050
*FILE='FT02.DAT',MODE='BINARY') CF180060
OPEN(UNIT=3,DEVICE='DSK',ACCESS='SEQINOUT', CF180070
*FILE='FT03.DAT',MODE='BINARY') CF180080
OPEN(UNIT=4,DEVICE='DSK',ACCESS='SEQINOUT', CF180090
*FILE='FT04.DAT',MODE='BINARY') CF180100
100 FORMAT(A10) CF180110
101 FORMAT(' INPUT THE NAME OF THE OUTPUT FILE') CF180120
102 FORMAT(' INPUT THE NAME OF THE INPUT FILE') CF180130
TYPE 102 CF180140
ACCEPT100,FILIN CF180150
TYPE 101 CF180160
ACCEPT 100,FILOU CF180170
OPEN(UNIT=5,DEVICE='DSK:',ACCESS='SEQIN',FILE=FILIN) CF180180
OPEN(UNIT=6,ACCESS='SEQINOU',FILE=FILOU) CF180190
RETURN CF180200
END CF180210