Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
C BMDX94 - TRANSGENERATION - MAIN PROGRAM MARCH 26, 1968
DOUBLE PRECISION DATE(2),FIN,PROB,P,PC,PASS,PAS
DIMENSION F1(162),F2(162),A(8000),LIST(1000),YX(1000)
DIMENSION ADUM(1000),BDUM(1000)
DIMENSION KHALI(16)
DATA KHALI/16*0/
DATA DATE/' MAY 1, ','1969 '/
DATA PASS/8HPSDATA /
DATA ONO,FIN,YES,PROB/2HNO,6HFINISH,3HYES,6HPROBLM/
DATA BLANK/' '/
LOGICAL BL
INTEGER OT,OT1
KPNTR=0
CALL USAGEB('BMDX94')
NPR=0
100 NPR=NPR+1
READ(5,1) P,PC,NC,NV,NVA,NF1,IT,NF2,OT,ON1,ON2,EAN1,EAN2,VSL,PRNT,
XBLK,NPASS,NGEN
1 FORMAT(2A6,3I6,4I3,2A2,5A3,3X,2I3)
SAME=ONO
IPASS=0
NPASS=NPASS+1
NCHECK=NPASS
NVR=NV
INDTEM=1
NF4=NF2
LL=1
IF(IT.EQ.0) IT=5
IF(IT.EQ.5) ON1=ONO
IF(P.EQ.FIN) GO TO 8001
IF(P.NE.PROB) GO TO 181
NFB1=0
NFB2=0
IF(NF1.LT.0)NFB1=-1
NF1=18*MAX0(1,NF1)
IF(ON1.NE.ONO) REWIND IT
IF(NFB1.EQ.0)READ(5,10)(F1(I),I=1,NF1)
10 FORMAT(18A4)
IF(ON1.NE.ONO) ON1=YES
IF(EAN1.NE.YES) EAN1=ONO
IF(EAN2.NE.YES) EAN2=ONO
IF(VSL.NE.YES) VSL=ONO
IF(PRNT.NE.YES) PRNT=ONO
IF(BLK.NE.YES) BLK=ONO
301 IF(IPASS.EQ.0) GO TO 300
READ(5,900)PAS,NF3,OT,ON2,EAN1,EAN2,VSL,PRNT,NGEN
900 FORMAT(A6,30X,2I3,2X,A2,4A3,9X,I3)
IF(PASS.NE.PAS) GO TO 400
IF(NF3.EQ.0.AND.OT.NE.0) SAME=YES
IF(SAME.EQ.YES) NF3=NF4
NF2=NF3
NF4=NF2
300 CONTINUE
IF(OT.EQ.6.OR.OT.EQ.0) ON2=ONO
IF(ON2.NE.ONO) REWIND OT
IF(ON2.NE.ONO) ON2=YES
IF(IPASS.EQ.0) WRITE(6,2) DATE,PC,NC,NV,NVA,IT,OT,ON1,ON2
2 FORMAT(46H1BMDX94 - MULTI-PASS TRANSGENERATION - REVISED,2A8/
X41H0HEALTH SCIENCES COMPUTING FACILITY, UCLA//
X31H0PROBLEM CODE A6/
X31H0NUMBER OF CASES I6/
X31H0NUMBER OF VARIABLES READ IN I6/
X31H0NUMBER OF VARIABLES ADDED I6/
X31H0INPUT TAPE NUMBER I6/
X31H0OUTPUT TAPE NUMBER I6/
X34H0REWIND INPUT TAPE A6/
X34H0REWIND OUTPUT TAPE ,A6/)
IF(EAN1.NE.YES) EAN1=ONO
IF(EAN2.NE.YES) EAN2=ONO
IF(VSL.NE.YES) VSL=ONO
IF(PRNT.NE.YES.OR.OT.EQ.6) PRNT=ONO
IF(BLK.NE.YES) BLK=ONO
303 IF(NF2.LT.0) NFB2=-1
NF2=18*MAX0(1,NF2)
IF(NFB2.LT.0) GO TO 307
IF(IPASS.NE.0.AND.SAME.EQ.YES) GO TO 307
IF(OT.NE.0) READ(5,10) (F2(I),I=1,NF2)
307 IPASS=IPASS+1
WRITE(6,302) IPASS
302 FORMAT(1H1,45X,8(2H *),2X,'P A S S ',I3,2X,8(2H *) ,1X//)
WRITE(6,304) EAN1,EAN2,VSL,PRNT,BLK
304 FORMAT(40H0MEANS AND STD. DEVS. USED ,A6/
X40H0GEOM. AND HARMO. MEANS USED ,A6/
X40H0VARIABLES ARE SELECTED ,A6/
X40H0SELECTIONS ARE PRINTED ,A6/
X40H0BLANKS ARE TREATED AS MISSING ,A6/)
IF(IPASS.NE.1) WRITE(6,902) OT,ON2
902 FORMAT(19H0REWIND OUTPUT TAPE,3X,I2,17X,A6)
IF(VSL.NE.YES)GO TO 70
CALL VARSEL(LIST,ITEM)
IF(ITEM.EQ.9999) STOP
WRITE(6,201)ITEM
201 FORMAT(14H0THE FOLLOWING I5, 25H VARIABLES ARE SELECTED /)
WRITE(6,202)(I,LIST(I),I=1,ITEM)
202 FORMAT(10(2H (I3,2H) I3,3H, ))
70 CONTINUE
IF(NFB1.EQ.0.AND.IPASS.EQ.1) WRITE(6,22) (F1(I),I=1,NF1)
IF(NFB2.EQ.0.AND.OT.NE.0) WRITE(6,3) (F2(I),I=1,NF2)
22 FORMAT(31H0INPUT FORMAT 18A4/(31X,18A4))
3 FORMAT(31H0OUTPUT FORMAT 18A4/(31X,18A4))
IF(NFB1.LT.0.AND.IPASS.EQ.1) WRITE(6,222)
IF(NFB2.LT.0.AND.OT.NE.0) WRITE(6,203)
222 FORMAT(20H0INPUT IS BINARY )
203 FORMAT(20H0OUTPUT IS BINARY )
C
IF(PRNT.EQ.YES)WRITE(6,211)
211 FORMAT(40H1SELECTED CASES AND VARIABLES PRINTED )
IF(OT.EQ.6) WRITE(6,212)
212 FORMAT(1H0,'ALL CASES FOR SELECTED VARIABLES ARE PRINTED')
NVP=NV+NVA
NVO=MAX0(NV,NVP)
L4=16*NVO+1
L17=13*NVO+1
L18=14*NVO+2
C
C
C
C
C
IF(VSL.EQ.YES) GO TO 71
ITEM=NVR+NGEN
DO 72 I=1,ITEM
72 LIST(I)=I
71 IF(IPASS-1) 326,325,326
325 JET=NV
JY=NV
GO TO 327
326 JET=ITEMPR
JY=ITEM
327 L1=1+NVO
L2=L1+JET
L3=L2+JET
L10=L3+JET
L11=L10+JET
IF(IPASS.EQ.1) GO TO 328
K12=L6+1
K11=L6-L1+1
DO 330 K=K12,L7
330 A(K-K11)=A(K)
K12=L7+1
K11=L7-L2+1
DO 331 K=K12,L12
331 A(K-K11)=A(K)
K12=L12+1
K11=L12-L10+1
DO 334 K=K12,L14
334 A(K-K11)=A(K)
K12=L14+1
K1=L14+ITEMPR
K11=L14-L11+1
DO 339 K=K12,K1
339 A(K-K11)=A(K)
K12=L5+1
K11=L5-L3+1
DO 340 K=K12,L6
340 A(K-K11)=A(K)
328 L5=L11+JET -1
L6=L5+ITEM
L7=L6+ITEM
L12=L7+ITEM
L14=L12+ITEM
L15=L14+ITEM
L16=L15+JY
L8=L5+1
L9=L4-1
MXT=(8000-L4)/NVP-1
IF(MXT.LE.1) GO TO 188
KK1=L9
IF(IPASS.NE.1) KK1=L16+ITEM
DO 42 J=L8,KK1
42 A(J)=0
999 IF(ITEM.GT.3000) GO TO 188
MMMMMM=0
IDELET=0
C
IF(EAN1.EQ.EAN2) GO TO 500
IF(EAN1.EQ.YES) GO TO 501
IDELET=3
GO TO 502
500 IF(EAN1.NE.YES) GO TO 40
IDELET=1
GO TO 502
501 IDELET=2
502 CONTINUE
IF(IPASS.NE.1) GO TO 40
LL=3
REWIND 1
M1=L15+1
M2=L16+1
M3=L17+1
M4=L18+1
CALL PASS1(A,A(L1),A(L2),A(L3),A(L10),A(L11),A(M1),A(M2),A(M3),A(M
14),A(L4),NV,NC,IT,F1,MXT,BLK,NFB1,IDELET,NVP,NVR,INDTEM)
REWIND 1
C
IF(NCHECK.EQ.1.OR.ITEM.GT.NV) L16=L15+ITEM
40 IF(NCHECK.EQ.IPASS) IDELET=1
M3=L17+1
M4=L18+1
IF(INDTEM.EQ.1)INDKOL=2
IF(INDTEM.EQ.2) INDKOL=1
DO 41 J=1,NC
SELECT=1.
CALL READ (A,A(L4),IT,F1,NV,J,LL,MXT,NFB1,NVP,NVR,INDTEM)
LLL=NVR+NGEN
LOW=NVR+1
IF(LOW.GT.LLL) GO TO 256
DO 2000 KZ11= LOW,LLL
2000 A(KZ11)=BLANK
256 CONTINUE
CALL TRANS
1 (A,A(L1),A(L2),A(L3),A(L10),A(L11),A(M3),J,NVR,NPR,
2IPASS,SELECT)
KKK=1
KTEST=(J-1)*NVP
IF(J.GT.MXT) GO TO 1051
DO 1050 MMM=KKK,LLL
1050 A(L4+MMM+KTEST-1)=A(MMM)
GO TO 1052
1051 WRITE(INDKOL)(A(NNN),NNN=KKK,LLL)
8000 FORMAT(20A4)
1052 IF(SELECT.EQ.0.AND.OT.EQ.6) WRITE(6,213) J
213 FORMAT(1H0,'CASE NO. ',I7,'IS NOT SELECTED IN THIS PASS BUT PRINTE
1D BELOW.')
IF(SELECT.NE.0.0.OR.OT.EQ.6) MMMMMM=MMMMMM+1
DO 60 I=1,ITEM
II=LIST(I)
60 YX(I)=A(II)
IF(OT.EQ.6) WRITE(6,F2) (YX(I),I=1,ITEM)
IF(SELECT.EQ.0) GO TO 41
IF(OT.NE.0.AND.OT.NE.6.AND.NFB2.EQ.0) WRITE(OT,F2)(YX(I),I=1,ITEM)
IF(NFB2.LT.0.AND.OT.NE.6)WRITE(OT )(YX(I),I=1,ITEM)
1082 IF(PRNT.EQ.YES) WRITE(6,200) J,MMMMMM,(YX(I),I=1,ITEM)
200 FORMAT(16H0INPUT CASE NO. I6,18H, OUTPUT CASE NO. I6/(1X,10F12
1.4))
DO 141 I=1,ITEM
IF(BLK.NE.YES) GO TO 1059
IF(BL(YX(I))) GO TO 141
1059 IF(IDELET.EQ.0) GO TO 41
IF(IDELET.EQ.3) GO TO 611
A(L5+I)=A(L5+I)+1.0
H=A(L5+I)
H1=H*(H-1.)
D=(YX(I)-A(L6+I))/H
A(L6+I)=A(L6+I)+D
A(L7+I)=A(L7+I)+D*D*H1
IF(A(L5+I).EQ.1.0) ADUM(I)=YX(I)
IF(A(L5+I).EQ.1.0) BDUM(I)=YX(I)
ADUM(I)=AMIN1(ADUM(I),YX(I))
BDUM(I)=AMAX1(BDUM(I),YX(I))
IF(IDELET.EQ.2) GO TO 141
611 IF(YX(I))622,622,623
623 A(L15+I)=A(L15+I)+1.0
D=(ALOG(YX(I))-A(L12+I))/(A(L15+I))
A(L12+I)=A(L12+I)+D
621 A(L16+I)=A(L16+I)+1.0
A(L14+I)=A(L14+I)+(1.0/YX(I))
622 CONTINUE
141 CONTINUE
41 CONTINUE
DO 44 I=1,ITEM
IF(A(L15+I).GT.0.)A(L12+I)=EXP(A(L12+I))
IF(A(L15+I).GT.0.0)A(L14+I)=A(L15+I)/A(L14+I)
IF(A(L5+I).LE.1) GO TO 44
A(L7+I)=SQRT(A(L7+I)/(A(L5+I)-1.))
44 CONTINUE
IF(IDELET.EQ.0) GO TO 625
GO TO (626,626,627),IDELET
626 WRITE(6,57)
57 FORMAT( 65H1 VARIABLE INDEX COUNT OF MEAN STANDARD DE
1VIATION ,3X,11HMAX. VALUES,4X,11HMIN. VALUES/
2 34H NEW OLD CASES USED )
56 FORMAT(I5,6X,I5,8X,F4.0,5X,F10.4,8X,F10.4,5X,F10.4,5X,F10.4)
WRITE(6,56)(I,LIST(I),A(L5+I),A(L6+I),A(L7+I),BDUM(I),ADUM(I),I=1,
1ITEM)
WRITE(6,1071)
1071 FORMAT(1H0,3X////)
IF(IDELET.EQ.2) GO TO 625
627 WRITE(6,59)
59 FORMAT( 74H0 VARIABLE INDEX COUNT OF GEOM. MEAN HARM
X. MEAN ,1X/61H NEW OLD CASES USED
X /)
WRITE(6,61) (I,LIST(I),A(L15+I),A(L12+I),A(L14+I),I=1,ITEM)
C
61 FORMAT(I5,6X,I5,7X,F5.0,5X,F10.4,7X,F10.4)
625 IF(OT.NE.0) WRITE(6,55) MMMMMM,OT
55 FORMAT(1H0,I5,27H CASES WERE WRITTEN ON TAPEI3)
LL=3
ITEMPR=ITEM
NPASS=NPASS-1
IF(((OT-6)*OT).NE.0) ENDFILE OT
K12=L15+1
K11=L15+ITEM
K1=M3-L15-1
DO 1003 K=K12,K11
ADUM(K-L15)=0.0
BDUM(K-L15)=0.0
1003 A(K+K1)=A(K)
C
KPNTR=KPNTR+1
IF(KPNTR.LE.16) KHALI(KPNTR)=MMMMMM
C
8002 FORMAT(16I5)
IF(NPASS.EQ.0) GO TO 100
DO 1010 K=M3,L9
1010 A(K)=0.0
K12=L16+1
K11=L16+ITEM
K1=M4-L16-1
DO 1004 K=K12,K11
1004 A(K+K1)=A(K)
NVR=NVR+NGEN
INDTEM=INDKOL
REWIND 1
REWIND 2
NFB2=0
SAME=ONO
GO TO 301
181 WRITE (6,182)
182 FORMAT(45H0PROBLEM CARD INCORRECTLY ORDERED OR PUNCHED)
STOP
188 WRITE (6,199)
199 FORMAT(26H0THIS PROBLEM IS TOO LARGE)
STOP
400 WRITE(6,401) PAS
401 FORMAT(1H0,5X,'THE PROGRAM EXPECTED PSDATA CARD',3X/
X1H0,'WHEREAS IT FOUND',A6,'PLEASE CHECK THE CONTROL CARDS')
STOP
8001 WRITE(1,8002) (KHALI(IZ),IZ=1,16)
STOP
END
SUBROUTINE PASS1(X,U,S,C,GM,HM,GC,HC,GS,HS,T,NV,NC,IT,F,MXT,BLK,
XNFB1,ID,NVP,NVR,INDTEM)
DIMENSION GS(2),HS(2)
DIMENSION HM(2),GM(2),GC(2),HC(2)
DIMENSION X(2),U(2),S(2),C(2),T(NV,2),F(162)
LOGICAL BL
C
DATA YES/3HYES/
DO 1 I=1,NV
GC(I)=0.0
HC(I)=0.0
U(I)=0.
C(I)=0.
HM(I)=0.0
GM(I)=0.0
1 S(I)=0.
DO 3 J=1,NC
CALL READ(X,T,IT,F,NV,J,2,MXT,NFB1,NVP,NVR,INDTEM)
DO 3 I=1,NV
IF(BLK.NE.YES) GO TO 4
IF(BL(X(I))) GO TO 3
4 C(I)=C(I)+1.
H=C(I)
GO TO (11,11,31),ID
11 H1=H*(H-1.)
D=(X(I)-U(I))/H
U(I)=U(I)+D
S(I)=S(I)+D*D*H1
IF(ID.EQ.2) GO TO 3
31 IF(X(I)) 622,622,623
623 GC(I)=GC(I)+1.0
D=(ALOG(X(I))-GM(I))/GC(I)
GM(I)=GM(I)+D
621 HC(I)=HC(I)+1.0
HM(I)=HM(I)+(1.0/X(I))
622 CONTINUE
3 CONTINUE
DO 5 I=1,NV
IF(ID.EQ.2) GO TO 5
GM(I)=EXP(GM(I))
IF (HM(I).NE.0.0) HM(I)=GC(I)/HM(I)
GS(I)=GC(I)
HS(I)=HC(I)
GC(I)=0.0
HC(I)=0.0
5 S(I)=SQRT(S(I)/(C(I)-1.))
RETURN
END
C SUBROUTINE READ FOR BMDX94 JANUARY 15, 1966
SUBROUTINE READ(X,T,IT,F,NV,I,LL,MXT,NFB1,NVP,NVR,INDTEM)
DIMENSION T(NVP,2),X(2),F(162)
GO TO (1,1,2),LL
1 IF(NFB1.EQ.0) READ(IT,F)(X(J),J=1,NV)
IF(NFB1.LT.0) READ(IT )(X(J),J=1,NV)
IF(LL.EQ.1) RETURN
IF(I.GT.MXT) GO TO 3
DO 4 J=1,NVR
4 T(J,I)=X(J)
RETURN
3 WRITE(1) (X(J),J=1,NVR)
RETURN
2 IF(I.GT.MXT) GO TO 5
DO 6 J=1,NVR
6 X(J)=T(J,I)
RETURN
5 READ(INDTEM) (X(J),J=1,NVR)
8000 FORMAT(20A4)
RETURN
END
LOGICAL FUNCTION BL(X)
EXTERNAL SIGN
BL=.FALSE.
IF(X.EQ.0.0.AND.SIGN(1.,X).NE.1.) BL=.TRUE.
RETURN
END
SUBROUTINE VARSEL(LIST,ITEM)
DIMENSION LIST(1000)
DIMENSION IN(72),K(10)
DOUBLE PRECISION CHECK,CHCK
DATA CHCK /8HVARSEL /
DATA NINE,IPERD,IBLANK,MINUS,KOMMA,ISLASH/1H9,1H.,1H ,1H-,1H,,1H//
DATA K/'0','1','2','3','4','5','6','7','8','9'/
ITEM =0
C---- LIST IS THE NAME OF THE ARRAY OF VARIABLE NUMBERS.
C---- ITEM IS THE NUMBER OF VARIABLES SELECTED. (LESS THAN 1001)
INC=1
IEND=NINE
NUMBER=0
ISTEP=NINE
IDASH=NINE
LAST=KOMMA
1 READ(5,100) CHECK,(IN(KOL),KOL=1,72)
100 FORMAT(A6,72A1)
IF(CHECK.NE.CHCK) GO TO 51
DO 10 KOL=1,73
IF(KOL.EQ.73) GO TO 1
IF(IN(KOL).EQ.IBLANK) GO TO 10
M=-1
DO 201 I=1,10
M=M+1
IF(IN(KOL).EQ.K(I))GO TO 200
201 CONTINUE
GO TO 2
200 IN(KOL)=M
NUMBER=IN(KOL)+10*NUMBER
LAST=NINE
GO TO 10
2 IF(IN(KOL).NE.KOMMA) GO TO 5
21 IF(LAST.NE.NINE) GO TO 101
IF(IDASH.EQ.MINUS) GO TO 3
IDASH = NINE
ITEM=ITEM+1
LIST(ITEM)=NUMBER
LAST=KOMMA
NUMBER=0
IF(IEND.EQ.IPERD) RETURN
GO TO 10
3 IF(ISTEP.NE.ISLASH) GO TO 30
INC=NUMBER
ISTEP=NINE
GO TO 31
30 NLAST=NUMBER
NLAST=NUMBER
31 IF(NFIRST.GT.NLAST) GO TO 102
IDASH = NINE
DO 4 I=NFIRST,NLAST,INC
ITEM=ITEM+1
4 LIST(ITEM)=I
LAST=KOMMA
NUMBER=0
INC=1
IF(IEND.EQ.IPERD) RETURN
GO TO 10
5 IF(IN(KOL).NE.MINUS) GO TO 6
IF(LAST.NE.NINE) GO TO 103
NFIRST=NUMBER
IDASH=MINUS
LAST=MINUS
NUMBER=0
GO TO 10
6 IF(IN(KOL).NE. IPERD) GO TO 7
IEND=IPERD
GO TO 21
7 IF(IN(KOL).NE.ISLASH) GO TO 104
IF(LAST.NE.NINE) GO TO 105
IF(IDASH.NE.MINUS) GO TO 106
ISTEP=ISLASH
LAST=ISLASH
NLAST=NUMBER
NUMBER=0
10 CONTINUE
101 WRITE(6,1001) KOL
1001 FORMAT(18H THE COMMA IN COL. ,I3, 27H MUST BE PRECEEDED BY A NO.)
RETURN
102 WRITE(6,1002) KOL
1002 FORMAT(25H THE FIELD ENDING IN COL. ,I3,22H HAS NUMBERS REVERSED.)
RETURN
103 WRITE(6,1003) KOL
1003 FORMAT(17H THE DASH IN COL. ,I3,27H MUST BE PRECEEDED BY A NO. )
RETURN
104 WRITE(6,1004) IN(KOL),KOL
1004 FORMAT(16H THE CHARACTER ' ,A1,9H' IN COL. ,I3,12H IS ILLEGAL. )
RETURN
105 WRITE(6,1005)
1005 FORMAT(40H / MUST BE ASSOCIATED WITH N-M/I FIELD. )
RETURN
106 WRITE(6,1006)
1006 FORMAT(40H / MUST BE PRECEEDED BY A NUMBER. )
RETURN
51 ITEM=9999
WRITE(6,52)
52 FORMAT(73H0THE PROGRAM DIDNOT FIND VARSEL CARD AS EXPECTED.PLEASE
1CHECK DECK SET UP)
RETURN
END
SUBROUTINE TRANS(X,U,S,C,GMN,HMN,GMC,NC,NVR,NPR,NPS,
1SELECT)
DIMENSION X(NVR),U(NVR),S(NVR),GMN(NVR),HMN(NVR),GMC(NVR)
DIMENSION C(NVR)
LOGICAL BL
C
C THE FOLLOWING CARDS ARE USED WITH THE HSCF TEST DECK,
C THEY ARE NORMALLY SUPPLIED BY THE USER.
C
C FIRST, IF ANY VARIABLE IS BLANK WE SUBSTITUTE THE MEAN OF THAT VARIA
DO 1 I=1,NVR
IF (BL(X(I))) X(I)=U(I)
1 CONTINUE
C VARIABLE 6 IS VARIABLE 1 TIMES THE INVERSE OF VARIABLE 2
X(6)=X(1)*(1./X(2))
C VARIABLE 7 IS THE STANDARD SCORE FOR VARIBLE 3, AND THE CASE IS PRIN
C IF IT IS OUTSIDE 4 STANDARD DEVIATIONS FROM THE0MEAN.
X(7)=(X(3)-U(3))/S(3)
IF (ABS(X(7)).GT.4.) PRINT 3,NC,(X(I),I=1,NVR)
3 FORMAT (' CASE NO.=',I5,' A VALUE OF X(7) WAS MORE THAN FOUR STAND
1ARD DEVIATIONS OUT'/7F12.3)
RETURN
END