$JOB DASCR[30,30]
$FORTRAN DASCR
C DASC 10
C ..................................................................DASC 20
C DASC 30
C SAMPLE MAIN PROGRAM FOR DATA SCREENING - DASCR DASC 40
C DASC 50
C PURPOSE DASC 60
C PERFORM DATA SCREENING CALCULATIONS ON A SET OF OBSERVATIONSDASC 70
C DASC 80
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED DASC 90
C SUBST DASC 100
C TAB1 DASC 110
C LOC DASC 120
C BOOL DASC 130
C HIST DASC 140
C MATIN DASC 150
C DASC 160
C METHOD DASC 170
C DERIVE A SUBSET OF OBSERVATIONS SATISFYING CERTAIN DASC 180
C CONDITIONS ON THE VARIABLES. FOR THIS SUBSET, THE FREQUENCY DASC 190
C OF A SELECTED VARIABLE OVER GIVEN CLASS INTERVALS IS DASC 200
C OBTAINED. THIS IS PLOTTED IN THE FORM OF A HISTOGRAM. DASC 210
C TOTAL, AVERAGE, STANDARD DEVIATION, MINIMUM, AND MAXIMUM DASC 220
C ARE ALSO CALCULATED. DASC 230
C DASC 240
C ..................................................................DASC 250
C DASC 260
DIMENSION A(1000),C(63),UBO(3),S(200),R(21),FREQ(20), DASC 270
1PCT(20),STATS(5) DASC 280
EXTERNAL BOOL DASC 290
10 FORMAT(1H1,22HDATA SCREENING PROBLEM,I3) DASC 300
11 FORMAT(1H0,44HDIMENSIONED AREA TOO SMALL FOR INPUT MATRIX ,I4) DASC 310
12 FORMAT(1H0,20HEXECUTION TERMINATED) DASC 320
13 FORMAT(1H0,42HINCORRECT NUMBER OF DATA CARDS FOR MATRIX ,I4) DASC 330
14 FORMAT(1H0,18HGO ON TO NEXT CASE) DASC 340
15 FORMAT(1H0,11HEND OF CASE) DASC 350
16 FORMAT(7(F2.0,F1.0,F7.0)) DASC 360
17 FORMAT(3F10.0) DASC 370
18 FORMAT(1H0,13HSUBSET VECTOR,///) DASC 380
19 FORMAT(1H ,I3,F5.0) DASC 390
20 FORMAT(1H1,32HSUMMARY STATISTICS FOR VARIABLE ,I3) DASC 400
21 FORMAT(1H0,7HTOTAL =,F10.3,2X,9HAVERAGE =,F10.3,2X,20HSTANDARD DEVDASC 410
1IATION =,F10.3,2X,9HMINIMUM =,F10.3,2X,9HMAXIMUM =,F10.3) DASC 420
22 FORMAT(2I2) DASC 430
C DASC 440
KC=0 DASC 450
24 KC=KC+1 DASC 460
CALL MATIN(ICOD,A,1000,NO,NV,MS,IER) DASC 470
IF(NO) 25,50,25 DASC 480
25 IF(IER-1) 40,30,35 DASC 490
30 WRITE(6,11) ICOD DASC 500
WRITE(6,14) DASC 510
GO TO 24 DASC 520
35 WRITE(6,13) DASC 530
WRITE(6,12) DASC 540
GO TO 50 DASC 550
40 READ(5,22)NC,NOVAR DASC 560
JC=NC*3 DASC 570
READ(5,16)(C(I),I=1,JC) DASC 580
READ(5,17)(UBO(I),I=1,3) DASC 590
CALL SUBST(A,C,R,BOOL,S,NO,NV,NC) DASC 600
WRITE(6,10)KC DASC 610
WRITE(6,18) DASC 620
WRITE(6,19) (I,S(I),I=1,NO) DASC 630
CALL TAB1(A,S,NOVAR,UBO,FREQ,PCT,STATS,NO,NV) DASC 640
WRITE(6,20) NOVAR DASC 650
WRITE(6,21)(STATS(I),I=1,5) DASC 660
JZ=UBO(2) DASC 670
CALL HIST(KC,FREQ,JZ) DASC 680
WRITE(6,15) DASC 690
GO TO 24 DASC 700
50 RETURN DASC 710
END DASC 720
$FORTRAN BOOL
C BOOL 10
C ..................................................................BOOL 20
C BOOL 30
C USER-SUPPLIED SPECIAL SUBROUTINE - BOOL BOOL 40
C BOOL 50
C THIS SPECIAL SUBROUTINE ILLUSTRATES AN EXTERNAL SUBROUTINE BOOL 60
C CALLED BY SUBROUTINE SUBST. BOOL 70
C BOOL 80
C IF DIFFERENT PROPOSITIONS ARE USED FOR DIFFERENT PROBLEMS IN BOOL 90
C THE SAME RUN, DIFFERENT SUBROUTINES WITH APPROPRIATE PROPOSI- BOOL 100
C TIONS MUST BE COMPILED UNDER DIFFERENT NAMES. IF SO, THESE BOOL 110
C SUBROUTINE NAMES MUST BE DEFINED BY AN EXTERNAL STATEMENT BOOL 120
C APPEARING IN THE MAIN PROGRAM WHICH CALLS SUBST. THEN, FOR BOOL 130
C EACH PROBLEM, SUBST IS CALLED WITH A PROPER SUBROUTINE NAME BOOL 140
C IN ITS ARGUMENT LIST. BOOL 150
C BOOL 160
C ..................................................................BOOL 170
C BOOL 180
SUBROUTINE BOOL(R,T) BOOL 190
DIMENSION R(1) BOOL 200
C BOOL 210
T=R(1)*R(2) BOOL 220
C BOOL 230
RETURN BOOL 240
END BOOL 250
$FORTRAN HIST
C HIST 10
C ..................................................................HIST 20
C HIST 30
C SUBROUTINE HIST HIST 40
C HIST 50
C PURPOSE HIST 60
C PRINT A HISTOGRAM OF FREQUENCIES VERSUS INTERVALS HIST 70
C HIST 80
C USAGE HIST 90
C CALL HIST(NU,FREQ,IN) HIST 100
C HIST 110
C DESCRIPTION OF PARAMETERS HIST 120
C NU - HISTOGRAM NUMBER (3 DIGITS MAXIMUM) HIST 130
C FREQ - VECTOR OF FREQUENCIES HIST 140
C IN - NUMBER OF INTERVALS AND LENGTH OF FREQ (MAX IS 20) HIST 150
C NORMALLY, FREQ(1) CONTAINS THE FREQUENCY SMALLER THANHIST 160
C THE LOWER BOUND AND FREQ(IN) CONTAINS THE FREQUENCY HIST 170
C LARGER THAN THE UPPER BOUND HIST 180
C HIST 190
C REMARKS HIST 200
C FREQUENCIES MUST BE POSITIVE NUMBERS HIST 210
C HIST 220
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED HIST 230
C NONE HIST 240
C HIST 250
C METHOD HIST 260
C THE LARGEST FREQUENCY IS DETERMINED AND SCALING IS USED HIST 270
C IF REQUIRED HIST 280
C HIST 290
C ..................................................................HIST 300
C HIST 310
SUBROUTINE HIST(NU,FREQ,IN) HIST 320
DIMENSION JOUT(20),FREQ(20) HIST 330
C HIST 340
1 FORMAT(6H EACH ,A1,8H EQUALS ,I2,7H POINTS,/) HIST 350
2 FORMAT(I6,4X,20(4X,A1)) HIST 360
3 FORMAT(9H0INTERVAL,4X,19(I2,3X),I2) HIST 370
4 FORMAT(1H1,47X,11H HISTOGRAM ,I3) HIST 380
5 FORMAT(10H0FREQUENCY,20I5) HIST 390
6 FORMAT(6H CLASS) HIST 400
7 FORMAT(113H ----------------------------------------------------HIST 410
1----------------------------------------------------------) HIST 420
8 FORMAT(1H ) HIST 430
9 FORMAT(A1) HIST 440
10 FORMAT(1H*) HIST 450
C HIST 460
REWIND 13 HIST 470
WRITE(13,10) HIST 480
REWIND 13 HIST 490
READ(13,9) K HIST 500
REWIND 13 HIST 510
WRITE(13,8) HIST 520
REWIND 13 HIST 530
READ(13,9) NOTH HIST 540
REWIND 13 HIST 550
C HIST 560
C PRINT TITLE AND FREQUENCY VECTOR HIST 570
C HIST 580
WRITE(6,4) NU HIST 590
DO 12 I=1,IN HIST 600
12 JOUT(I)=FREQ(I) HIST 610
WRITE(6,5)(JOUT(I),I=1,IN) HIST 620
WRITE(6,7) HIST 630
C HIST 640
C FIND LARGEST FREQUENCY HIST 650
C HIST 660
FMAX=0.0 HIST 670
DO 20 I=1,IN HIST 680
IF(FREQ(I)-FMAX) 20,20,15 HIST 690
15 FMAX=FREQ(I) HIST 700
20 CONTINUE HIST 710
C HIST 720
C SCALE IF NECESSARY HIST 730
C HIST 740
JSCAL=1 HIST 750
IF(FMAX-50.0) 40,40,30 HIST 760
30 JSCAL=(FMAX+49.0)/50.0 HIST 770
WRITE(6,1)K,JSCAL HIST 780
C HIST 790
C CLEAR OUTPUT AREA TO BLANKS HIST 800
C HIST 810
40 DO 50 I=1,IN HIST 820
50 JOUT(I)=NOTH HIST 830
C HIST 840
C LOCATE FREQUENCIES IN EACH INTERVAL HIST 850
C HIST 860
MAX=FMAX/FLOAT(JSCAL) HIST 870
DO 80 I=1,MAX HIST 880
X=MAX-(I-1) HIST 890
DO 70 J=1,IN HIST 900
IF(FREQ(J)/FLOAT(JSCAL)-X) 70,60,60 HIST 910
60 JOUT(J)=K HIST 920
70 CONTINUE HIST 930
IX=X*FLOAT(JSCAL) HIST 940
C HIST 950
C PRINT LINE OF FREQUENCIES HIST 960
C HIST 970
80 WRITE(6,2)IX,(JOUT(J),J=1,IN) HIST 980
C HIST 990
C GENERATE CONSTANTS HIST1000
C HIST1010
DO 90 I=1,IN HIST1020
90 JOUT(I)=I HIST1030
C HIST1040
C PRINT INTERVAL NUMBERS HIST1050
C HIST1060
WRITE(6,7) HIST1070
WRITE(6,3)(JOUT(J),J=1,IN) HIST1080
WRITE(6,6) HIST1090
RETURN HIST1100
END HIST1110
$FORTRAN MATIN
C MATI 10
C ..................................................................MATI 20
C MATI 30
C SUBROUTINE MATIN MATI 40
C MATI 50
C PURPOSE MATI 60
C READS CONTROL CARD AND MATRIX DATA ELEMENTS FROM LOGICAL MATI 70
C UNIT 5 MATI 80
C MATI 90
C USAGE MATI 100
C CALL MATIN(ICODE,A,ISIZE,IROW,ICOL,IS,IER) MATI 110
C MATI 120
C DESCRIPTION OF PARAMETERS MATI 130
C ICODE-UPON RETURN, ICODE WILL CONTAIN FOUR DIGIT MATI 140
C IDENTIFICATION CODE FROM MATRIX PARAMETER CARD MATI 150
C A -DATA AREA FOR INPUT MATRIX MATI 160
C ISIZE-NUMBER OF ELEMENTS DIMENSIONED BY USER FOR AREA A MATI 170
C IROW -UPON RETURN, IROW WILL CONTAIN ROW DIMENSION FROM MATI 180
C MATRIX PARAMETER CARD MATI 190
C ICOL -UPON RETURN, ICOL WILL CONTAIN COLUMN DIMENSION FROM MATI 200
C MATRIX PARAMETER CARD MATI 210
C IS -UPON RETURN, IS WILL CONTAIN STORAGE MODE CODE FROM MATI 220
C MATRIX PARAMETER CARD WHERE MATI 230
C IS=0 GENERAL MATRIX MATI 240
C IS=1 SYMMETRIC MATRIX MATI 250
C IS=2 DIAGONAL MATRIX MATI 260
C IER -UPON RETURN, IER WILL CONTAIN AN ERROR CODE WHERE MATI 270
C IER=0 NO ERROR MATI 280
C IER=1 ISIZE IS LESS THAN NUMBER OF ELEMENTS IN MATI 290
C INPUT MATRIX MATI 300
C IER=2 INCORRECT NUMBER OF DATA CARDS MATI 310
C MATI 320
C REMARKS MATI 330
C NONE MATI 340
C MATI 350
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED MATI 360
C LOC MATI 370
C MATI 380
C METHOD MATI 390
C SUBROUTINE ASSUMES THAT INPUT MATRIX CONSISTS OF PARAMETER MATI 400
C CARD FOLLOWED BY DATA CARDS MATI 410
C PARAMETER CARD HAS THE FOLLOWING FORMAT MATI 420
C COL. 1- 2 BLANK MATI 430
C COL. 3- 6 UP TO FOUR DIGIT IDENTIFICATION CODE MATI 440
C COL. 7-10 NUMBER OF ROWS IN MATRIX MATI 450
C COL.11-14 NUMBER OF COLUMNS IN MATRIX MATI 460
C COL.15-16 STORAGE MODE OF MATRIX WHERE MATI 470
C 0 - GENERAL MATRIX MATI 480
C 1 - SYMMETRIC MATRIX MATI 490
C 2 - DIAGONAL MATRIX MATI 500
C DATA CARDS ARE ASSUMED TO HAVE SEVEN FIELDS OF TEN COLUMNS MATI 510
C EACH. DECIMAL POINT MAY APPEAR ANYWHERE IN A FIELD. IF NO MATI 520
C DECIMAL POINT IS INCLUDED, IT IS ASSUMED THAT THE DECIMAL MATI 530
C POINT IS AT THE END OF THE 10 COLUMN FIELD. NUMBER IN EACH MATI 540
C FIELD MAY BE PRECEDED BY BLANKS. DATA ELEMENTS MUST BE MATI 550
C PUNCHED BY ROW. A ROW MAY CONTINUE FROM CARD TO CARD. MATI 560
C HOWEVER EACH NEW ROW MUST START IN THE FIRST FIELD OF THE MATI 570
C NEXT CARD. ONLY THE UPPER TRIANGULAR PORTION OF A SYMMETRICMATI 580
C OR THE DIAGONAL ELEMENTS OF A DIAGONAL MATRIX ARE CONTAINED MATI 590
C ON DATA CARDS. THE FIRST ELEMENT OF EACH NEW ROW WILL BE MATI 600
C THE DIAGONAL ELEMENT FOR A MATRIX WITH SYMMETRIC OR MATI 610
C DIAGONAL STORAGE MODE. COLUMNS 71-80 OF DATA CARDS MAY BE MATI 620
C USED FOR IDENTIFICATION, SEQUENCE NUMBERING, ETC.. MATI 630
C THE LAST DATA CARD FOR ANY MATRIX MUST BE FOLLOWED BY A CARDMATI 640
C WITH A 9 PUNCH IN COLUMN 1. MATI 650
C MATI 660
C.......................................................................MATI 670
C MATI 680
SUBROUTINE MATIN(ICODE, A,ISIZE,IROW,ICOL,IS,IER) MATI 690
DIMENSION A(1) MATI 700
DIMENSION CARD(8) MATI 710
1 FORMAT(7F10.0) MATI 720
2 FORMAT(I6,2I4,I2) MATI 730
C MATI 740
IDC=7 MATI 750
IER=0 MATI 760
READ( 5,2,END=999)ICODE,IROW,ICOL,IS MATI 770
CALL LOC(IROW,ICOL,ICNT,IROW,ICOL,IS) MATI 780
IF(ISIZE-ICNT)6,7,7 MATI 790
6 IER=1 MATI 800
7 IF (ICNT)38,38,8 MATI 810
8 ICOLT=ICOL MATI 820
IROCR=1 MATI 830
C MATI 840
C COMPUTE NUMBER OF CARDS FOR THIS ROW MATI 850
C MATI 860
11 IRCDS=(ICOLT-1)/IDC+1 MATI 870
IF(IS-1)15,15,12 MATI 880
12 IRCDS=1 MATI 890
C MATI 900
C SET UP LOOP FOR NUMBER OF CARDS IN ROW MATI 910
C MATI 920
15 DO 31 K=1,IRCDS MATI 930
READ(5,1)(CARD(I),I=1,IDC) MATI 940
C MATI 950
C SKIP THROUGH DATA CARDS IF INPUT AREA TOO SMALL MATI 960
C MATI 970
IF(IER)16,16,31 MATI 980
16 L=0 MATI 990
C MATI1000
C COMPUTE COLUMN NUMBER FOR FIRST FIELD IN CURRENT CARD MATI1010
C MATI1020
JS=(K-1)*IDC+ICOL-ICOLT+1 MATI1030
JE=JS+IDC-1 MATI1040
IF(IS-1)19,19,17 MATI1050
17 JE=JS MATI1060
C MATI1070
C SET UP LOOP FOR DATA ELEMENTS WITHIN CARD MATI1080
C MATI1090
19 DO 30 J=JS,JE MATI1100
IF(J-ICOL)20,20,31 MATI1110
20 CALL LOC(IROCR ,J,IJ,IROW,ICOL,IS) MATI1120
L=L+1 MATI1130
30 A(IJ)=CARD(L) MATI1140
31 CONTINUE MATI1150
IROCR=IROCR+1 MATI1160
IF(IROW-IROCR) 38,35,35 MATI1170
35 IF(IS-1)37,36,36 MATI1180
36 ICOLT=ICOLT-1 MATI1190
37 GO TO 11 MATI1200
38 READ(5,1,END=999) CARD(1) MATI1210
IF(CARD(1)-9.E9)39,40,39 MATI1220
39 IER=2 MATI1230
40 RETURN MATI1240
999 STOP
END MATI1250
$DECK DAS.CDR
000101000004 20
46. 64. 173. 12. 30
24. 72. 170. 8. 40
32. 71. 154. 16. 50
41. 68. 129. 10. 60
50. 65. 192. 9. 70
63. 75. 203. 12. 80
29. 70. 122. 14. 90
28. 64. 136. 13. 100
52. 77. 147. 11. 110
36. 67. 153. 18. 120
31. 68. 165. 9. 130
72. 70. 178. 10. 140
53. 71. 205. 14. 150
21. 65. 219. 12. 160
49. 63. 150. 6. 170
28. 62. 160. 16. 180
53. 72. 161. 13. 190
47. 73. 142. 15. 200
37. 67. 193. 18. 210
64. 68. 156. 14. 220
65. 60. 114. 10. 230
62. 64. 153. 12. 240
19. 68. 225. 9. 250
46. 67. 158. 11. 260
33. 72. 121. 4. 270
37. 65. 132. 13. 280
41. 76. 148. 16. 290
52. 71. 123. 16. 300
29. 68. 128. 14. 310
32. 65. 155. 17. 320
24. 72. 172. 16. 330
56. 73. 163. 10. 340
63. 65. 158. 11. 350
67. 69. 146. 2. 360
58. 66. 171. 9. 370
41. 65. 153. 12. 380
49. 66. 165. 14. 390
52. 72. 172. 16. 400
23. 78. 183. 15. 410
56. 71. 195. 16. 420
52. 68. 118. 7. 430
40. 66. 165. 14. 440
39. 68. 215. 16. 450
23. 71. 154. 12. 460
56. 65. 149. 10. 470
25. 65. 162. 16. 480
37. 68. 152. 16. 490
46. 70. 159. 15. 500
41. 69. 137. 14. 510
62. 3071. 163. 12. 520
29. 72. 191. 4. 530
19. 68. 168. 10. 540
46. 63. 158. 16. 550
37. 64. 139. 18. 560
34. 68. 156. 10. 570
64. 67. 153. 12. 580
57. 67. 141. 13. 590
32. 68. 157. 17. 600
29. 70. 183. 15. 610
53. 72. 164. 18. 620
47. 72. 156. 18. 630
56. 73. 160. 16. 640
61. 74. 169. 12. 650
21. 68. 161. 10. 660
25. 76. 178. 11. 670
23. 72. 157. 16. 680
29. 68. 186. 16. 690
39. 70. 159. 14. 700
42. 70. 154. 10. 710
56. 62. 159. 12. 720
63. 70. 177. 12. 730
51. 71. 161. 9. 740
41. 66. 158. 10. 750
33. 69. 158. 16. 760
37. 68. 157. 16. 770
25. 70. 163. 15. 780
63. 68. 159. 12. 790
53. 71. 202. 6. 800
51. 72. 167. 14. 810
47. 73. 164. 14. 820
39. 75. 151. 12. 830
28. 68. 166. 10. 840
64. 69. 156. 16. 850
55. 67. 144. 16. 860
51. 66. 177. 10. 870
46. 65. 157. 12. 880
72. 66. 125. 10. 890
66. 65. 131. 12. 900
28. 74. 149. 18. 910
27. 71. 168. 11. 920
23. 72. 158. 12. 930
23. 72. 163. 12. 940
60. 68. 157. 9. 950
30. 66. 142. 10. 960
39. 67. 162. 16. 970
46. 74. 154. 16. 980
50. 68. 158. 10. 990
61. 66. 161. 14. 1000
36. 64. 157. 15. 1010
32. 71. 156. 16. 1020
9 1030
0203 1040
12 65. 46 8. 1050
120. 20. 210. 1060
1070
$EOD
.ASSIGN CDR 5
.ASSIGN LPT 6
.SET CDR DAS
.EXECUTE/REL DASCR,BOOL,HIST,MATIN,WES:SSP/LIB
%FIN::
.DELETE DAS.CDR