Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
C PROGRAM WAS CONVERTED FROM FORTRAN 2 TO 7090 FORTRAN 4
C IT WAS THEN CONVERTED TO 360 FORTRAN IV (H-LEVEL)
C DATA PATTERNS FOR DICHOTOMIES JUNE 9, 1966
C THIS IS A SIFTED VERSION OF BMD10D ORIGINALLY WRITTEN IN
C FORTRAN II. SOME MODIFICATIONS WERE MADE TO MAKE IT OPERABLE
C AND SLIGHTLY MORE EFFICIENT THAN THE SIFTED VERSION.
DIMENSION TD(30),NDATA(400,20),L(15),IPRNT(30),
1NSUM(400,3),TM(180),NUMBER(400),ITEM(400)
COMMON NUMBER
COMMON NDATA , NSUM , ITEM , IPRNT , L , NJ
COMMON N , NPRINT , II
DATA A2,FINISH/4HPROB,4HFINI/
C
EQUIVALENCE(NUMBER(1),TM),(NUMBER(121),TD)
C
920 FORMAT(53H1BMD10D - DATA PATTERNS FOR DICHOTOMIES - VERSION OF
118HJUNE 9, 1966 ,/
241H HEALTH SCIENCES COMPUTING FACILITY, UCLA)
C
NTAPE=5
CALL USAGEB('BMD10D')
L(1)=2
DO 30 I=2,15
30 L(I)=L(I-1)+L(I-1)
20 READ (5,902)A1,PROB,NJ,N,TESMIS,NPRINT,ICODE,MTAPE,MAT
IF(A1 .EQ. A2) GO TO 25
21 IF(A1 .EQ. FINISH) GO TO 1000
22 WRITE (6,901)
GO TO 1000
25 CALL TPWD(MTAPE,NTAPE)
31 WRITE (6,920)
WRITE (6,907)PROB
IF(NJ*(31-NJ)) 22,22,6001
6001 IF(N*(701-N)) 22,22,6002
6002 WRITE (6,908)N,NJ
DO32I=1,N
32 NSUM(I,3)=0
IF(NJ-15)35,35,36
35 ASSIGN 200 TO NAME
ASSIGN 455 TO KSKIP
DO33I=1,N
33 NSUM(I,2)=0
GOTO39
C
36 ASSIGN 210 TO NAME
ASSIGN 410 TO KSKIP
39 IF(MAT.GT.0.AND.MAT.LE.10) GO TO 40
MAT=1
WRITE(6,4000)
40 MAT=MAT*18
READ (5,910)(TM(I), I=1,MAT)
55 DO111I=1,N
READ (NTAPE,TM)(TD(K), K=1,NJ)
DO 95 J=1,NJ
IF(TD(J)-TESMIS)80,90,80
80 NDATA(I,J)=1
GOTO95
90 NDATA(I,J)=0
95 CONTINUE
111 CONTINUE
DO 200 I=1,N
GO TO NAME,(200,210)
210 NSUM(I,2)=NDATA(I,16)
200 NSUM(I,1)=NDATA(I,1)
220 II=0
CALL PATTEN
310 IF(ICODE) 20, 20, 330
330 DO500II=1,NJ
WRITE (6,900)II
DO460I=1,N
NSUM(I,1)=NDATA(I,1)
GO TO KSKIP,(410,455)
410 NSUM(I,2)=NDATA(I,16)
GO TO 460
C
455 NSUM(I,2)=0
460 NSUM(I,3)=0
CALL PATTEN
500 CONTINUE
550 GOTO20
C
900 FORMAT(11H1VARIABLE (I2,16H) IS ELIMINATED.)
901 FORMAT(22H0ERROR ON PROBLEM CARD)
902 FORMAT(A4,2X,A2,I2,I3,F3.0,3I2,48X,I2)
907 FORMAT(14H0PROBLEM NO. A2)
908 FORMAT(12H0SAMPLE SIZEI4/20H NUMBER OF VARIABLESI4)
910 FORMAT(18A4)
4000 FORMAT(1H023X71HNUMBER OF VARIABLE FORMAT CARDS INCORRECTLY SPECIF
1IED, ASSUMED TO BE 1.)
C
1000 IF(NTAPE-5)1002,1002,1001
1001 REWIND NTAPE
1002 STOP
END
C SUBROUTINE PATTEN FOR BMD10D JUNE 9, 1966
SUBROUTINE PATTEN
DIMENSION TD(30),NDATA(400,20),L(15),IPRNT(30),
1NSUM(400,3),TM(120),NUMBER(400),ITEM(400)
COMMON NUMBER
COMMON NDATA , NSUM , ITEM , IPRNT , L , NJ
COMMON N , NPRINT , IA
EQUIVALENCE(NUMBER(1),TM),(NUMBER(121),TD)
C
IF(IA)1,1,2
1 NJK=NJ
GO TO 3
C
2 NJK=NJ-1
3 IF(NJ-15)50,50,96
50 KV=NJ
GOTO98
96 KV=15
98 DO 19 J=1,NJ
IF(J-IA)15,19,15
15 DO20I=1,N
NSUM(I,3)=NSUM(I,3)+NDATA(I,J)
20 CONTINUE
19 CONTINUE
IF(NJ-16)30,35,25
25 DO 29 J=17,NJ
IF(J-IA)26,29,26
26 JJ=J-16
DO 28 I=1,N
NSUM(I,2)=NSUM(I,2)+NDATA(I,J)*L(JJ)
28 CONTINUE
29 CONTINUE
30 IF(KV-1)35,35,32
32 DO 36 I=1,N
36 NSUM(I,1) = 0
DO 34 J=2,KV
IF(J-IA)33,345,33
33 JJ=J-1
DO 34 I=1,N
NSUM(I,1)=NSUM(I,1)+NDATA(I,J)*L(JJ)
34 CONTINUE
345 CONTINUE
35 DO250K=1,NJK
NFL=NJK-K
ID=0
DO140I=1,N
IF(NSUM(I,3)+99)120,140,120
120 IF(NSUM(I,3)-K)140,130,140
130 ID=ID+1
NUMBER(ID)=I
NSUM(I,3)=-99
140 CONTINUE
IF(ID)250,250,150
150 WRITE (6,890)
WRITE (6,900)NFL
WRITE (6,901)ID
405 WRITE (6,902)(NUMBER(KK),KK=1,ID)
300 IF(ID-1)310,310,320
310 IV=NUMBER(1)
J=0
DO 315 I=1,NJ
IF(I-IA)311,315,311
311 J=J+1
IPRNT(J)=NDATA(IV,I)
315 CONTINUE
WRITE (6,903)(IPRNT(I),I=1,NJK)
GOTO250
C
320 IDT=ID-1
DO202M=1,IDT
JUNK=NUMBER(M)
IF(NSUM(JUNK,1)+99)155,202,155
155 IT=1
ITEM(IT)=JUNK
II=M+1
DO160LM=II,ID
JAX=NUMBER(LM)
IF(NSUM(JAX,1)+99)165,160,165
165 IF(NSUM(JUNK,1)-NSUM(JAX,1))160,171,160
171 IF(NSUM(JUNK,2)-NSUM(JAX,2))160,181,160
181 NSUM(JAX,1)=-99
IT=IT+1
ITEM(IT)=JAX
160 CONTINUE
NSUM(JUNK,1)=-99
J=0
DO 175 I=1,NJ
IF(I-IA)174,175,174
174 J=J+1
IPRNT(J)=NDATA(JUNK,I)
175 CONTINUE
WRITE (6,903)(IPRNT(I),I=1,NJK)
IF(IT-1)90,90,95
90 WRITE (6,913)
GOTO425
95 WRITE (6,912)IT
425 WRITE (6,904)(ITEM(LL),LL=1,IT)
202 CONTINUE
IX=NUMBER(ID)
IF(NSUM(IX,1)+99)230,250,230
230 J=0
DO 240 I=1,NJ
IF(I-IA)235,240,235
235 J=J+1
IPRNT(J)=NDATA(IX,I)
240 CONTINUE
WRITE (6,903)(IPRNT(I),I=1,NJK)
WRITE (6,913)
WRITE (6,904)IX
250 CONTINUE
ID=0
DO270I=1,N
IF(NSUM(I,3))270,260,270
260 ID=ID+1
NUMBER(ID)=I
270 CONTINUE
IF(ID)280,280,285
285 WRITE (6,900)NJK
IX=NUMBER(ID)
J=0
DO 295 I=1,NJ
IF(I-IA)292,295,292
292 J=J+1
IPRNT(J)=NDATA(IX,I)
295 CONTINUE
WRITE (6,903)(IPRNT(I),I=1,NJK)
IF(ID-1)450,450,455
450 WRITE (6,913)
GO TO 435
455 WRITE (6,912)ID
435 WRITE (6,904)(NUMBER(KK),KK=1,ID)
280 IF(NPRINT-1)500,286,500
286 WRITE (6,914)
NJJ=NJK+1
DO 2865 I=1,NJJ
2865 NUMBER(I)=I
IF(-IA)287,290,290
287 WRITE (6,915)IA
DO 2875 I=1,NJJ
IF(I-IA)2875,2874,2874
2874 NUMBER(I)=NUMBER(I+1)
2875 CONTINUE
290 WRITE (6,910)(NUMBER(I),I=1,NJK)
WRITE (6,905)
DO305I=1,N
J=0
DO 304 II=1,NJ
IF(II-IA)303,304,303
303 J=J+1
IPRNT(J)=NDATA(I,II)
304 CONTINUE
305 WRITE (6,911)I,(IPRNT(J),J=1,NJK)
GOTO500
C
890 FORMAT(1H0//)
900 FORMAT(1H0/25H NUMBER OF MISSING VALUESI5)
901 FORMAT(16H NUMBER OF ITEMS I6)
902 FORMAT(12H ITEM NUMBER14X,23I4,(/26X23I4))
903 FORMAT(1H04X,15HPATTERN OF DATA8X,30I2)
904 FORMAT(1H 4X,11HITEM NUMBER10X,23I4,(/26X23I4))
905 FORMAT(1H )
910 FORMAT(12H ITEM NUMBER10X15HVARIABLE NUMBER/16X30I3)
911 FORMAT(1H 4X,I3,8X,30I3)
912 FORMAT(1H 7X,I4,1X,5HITEMS)
913 FORMAT(1H 10X,6H1 ITEM)
914 FORMAT(1H115X27HDATA PATTERNS FOR ALL ITEMS)
915 FORMAT(11H VARIABLE (I2,16H) IS ELIMINATED.//)
C
500 RETURN
END
C SUBROUTINE TPWD FOR BMD10D JUNE 9, 1966
SUBROUTINE TPWD(NT1,NT2)
IF(NT1)40,10,12
10 NT1=5
12 IF(NT1-NT2)14,19,14
14 IF(NT2.EQ.5)GO TO 18
17 REWIND NT2
19 IF(NT1-5)18,24,18
18 IF(NT1-6)22,40,22
22 REWIND NT1
24 NT2=NT1
28 RETURN
40 WRITE (6,49)
49 FORMAT(25H ERROR ON TAPE ASSIGNMENT)
STOP
END