C BMDX77 - TRANSGENERATION - MAIN PROGRAM APRIL , 1967 DOUBLE PRECISION DATE(2),FIN,PROB,P,PC DIMENSION F1(162),F2(162),A(8000),LIST(3000),YX(3000) DIMENSION KHALI(16) DATA DATE/'APRIL 14',', 1969 '/ DATA KHALI/16*0/ DATA ONO,FIN,YES,PROB/2HNO,6HFINISH,3HYES,6HPROBLM/ LOGICAL BL INTEGER OT,OT1 KPNTM=0 CALL USAGEB('BMDX77') NPR=0 OT1=0 100 NPR=NPR+1 READ (5,1) P,PC,NC,NV,NVA,IT,OT,NF1,NF2,ON1,ON2,PRNT,EAN,VSL,BLK 1 FORMAT(2A6,7I6,4X,A2,4X,A2,4A3) IF(IT.EQ.0) IT=5 C IF(IT.EQ.5) ON1=ONO IF(OT.EQ.0.OR.OT.EQ.6) ON2=ONO IF(OT1.EQ.0) GO TO 437 IF(OT.NE.OT1 .AND. NPR.GT.1 .AND. OT1.NE.6) GO TO 436 GO TO 437 436 ENDFILE OT1 REWIND OT1 437 OT1=OT IF(P.EQ.FIN) GO TO 1000 IF(P.NE.PROB) GO TO 181 NFB1=0 NFB2=0 IF(NF1.LT.0)NFB1=-1 IF(NF2.LT.0)NFB2=-1 NF1=18*MAX0(1,NF1) NF2=18*MAX0(1,NF2) IF(ON1.NE.ONO) REWIND IT IF(ON2.NE.ONO) REWIND OT 8765 FORMAT(I) IF(NFB1.EQ.0)READ(5,10)(F1(I),I=1,NF1) IF(NFB2.EQ.0.AND.OT.NE.0) READ(5,10) (F2(I),I=1,NF2) 10 FORMAT(18A4) IF(EAN.NE.YES) EAN=ONO IF(BLK.NE.YES) BLK=ONO IF(ON1.NE.ONO) ON1=YES IF(ON2.NE.ONO) ON2=YES IF(PRNT.NE.YES.OR.OT.EQ.6) PRNT=ONO IF(VSL.NE.YES) VSL=ONO WRITE(6,2) DATE,PC,NC,NV,NVA,IT,OT,ON1,ON2,PRNT 2 FORMAT(37H1BMDX77 - 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/ X34H0PRINT SELECTIONS A6) WRITE (6,8) EAN,VSL,BLK 8 FORMAT(34H0MEANS AND S. DEVS. USED A6/ X34H0VARIABLES ARE SELECTED A6/ X34H0BLANKS TREATED AS MISSING 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)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)WRITE(6,222) IF(NFB2.LT.0)WRITE(6,203) 222 FORMAT(20H0INPUT IS BINARY ) 203 FORMAT(20H0OUTPUT IS BINARY ) 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) L1=1+NVO C C C C C IF(VSL.EQ.YES) GO TO 71 DO 72 I=1,NVP 72 LIST(I)=I ITEM=NVP 71 L2=L1+NV L3=L2+NV L5=L3+NV-1 L6=L5+ITEM L7=L6+ITEM L4=L7+ITEM+1 MXT=(8000-L4)/NVP-1 L8=L5+1 L9=L4-1 IF(MXT.LE.1) GO TO 188 8766 FORMAT(' ',12A5) DO 42 J=L8,L9 42 A(J)=0 IF(ITEM.GT.3000) GO TO 188 MMM=0 LL=1 C 8002 FORMAT(16I5) IF(EAN.NE.YES) GO TO 40 LL=3 REWIND 1 CALL PASS1(A,A(L1),A(L2),A(L3),A(L4),NV,NC,IT,F1,MXT,BLK,NFB1) REWIND 1 C 40 DO 41 J=1,NC SELECT=1. CALL READ (A,A(L4),IT,F1,NV,J,LL,MXT,NFB1) CALL TRANS(A,A(L1),A(L2),A(L3),J,NPR,NVO,SELECT) 213 FORMAT(1H0,'CASE NO. ',I7,' IS NOT SELECTED IN THIS PASS,BUT PRINT XED BELOW') IF(SELECT.EQ.0.AND.OT.EQ.6) WRITE(6,213) J IF(SELECT.NE.0.0.OR.OT.EQ.6) MMM=MMM+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(NFB2.EQ.0.AND.OT.NE.0.AND.OT.NE.6) WRITE(OT,F2)(YX(I),I=1,ITEM) IF(NFB2.LT.0.AND.OT.NE.6)WRITE(OT )(YX(I),I=1,ITEM) IF(PRNT.EQ.YES)WRITE(6,200)J,MMM,(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 666 IF(BL(YX(I))) GO TO 141 666 A(L5+I)=A(L5+I)+1 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 141 CONTINUE 41 CONTINUE DO 44 I=1,ITEM IF(A(L5+I).LE.1) GO TO 44 A(L7+I)=SQRT(A(L7+I)/(A(L5+I)-1.)) 44 CONTINUE WRITE(6,57) 57 FORMAT( 65H1 VARIABLE INDEX COUNT OF MEAN STANDARD DE 1VIATION /34H NEW OLD CASES USED /) 56 FORMAT(I5,6X,I5,8X,F4.0,5X,F10.4,8X,F10.4) WRITE(6,56)(I,LIST(I),A(L5+I),A(L6+I),A(L7+I),I=1,ITEM) IF(OT.NE.0) WRITE(6,55) MMM,OT 55 FORMAT(1H0,I5,27H CASES WERE WRITTEN ON TAPEI3) KPNTM=KPNTM+1 IF(KPNTM.LE.16) KHALI(KPNTM)=MMM REWIND 1 C C GO TO 100 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 1000 WRITE(1,8002) (KHALI(J),J=1,16) STOP END C SUBROUTINE PASS1 FOR BMDX77 JANUARY 15, 1966 SUBROUTINE PASS1(X,U,S,C,T,NV,NC,IT,F,MXT,BLK,NFB1) 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 U(I)=0. C(I)=0. 1 S(I)=0. 8765 FORMAT(G) DO 3 J=1,NC 8766 FORMAT(' ',12A4) CALL READ(X,T,IT,F,NV,J,2,MXT,NFB1) 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) H1=H*(H-1.) D=(X(I)-U(I))/H U(I)=U(I)+D S(I)=S(I)+D*D*H1 3 CONTINUE DO 5 I=1,NV 5 S(I)=SQRT(S(I)/(C(I)-1.)) RETURN END C SUBROUTINE READ FOR BMDX77 JANUARY 15, 1966 SUBROUTINE READ(X,T,IT,F,NV,I,LL,MXT,NFB1) DIMENSION T(NV,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,NV 4 T(J,I)=X(J) RETURN 3 WRITE(1)(X(J),J=1,NV) RETURN 2 IF(I.GT.MXT) GO TO 5 DO 6 J=1,NV 6 X(J)=T(J,I) RETURN 5 READ(1)(X(J),J=1,NV) 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 CHCK,CHK1 DATA NINE,IPERD,IBLANK,MINUS,KOMMA,ISLASH/1H9,1H.,1H ,1H-,1H,,1H// DATA CHCK/8HVARSEL / 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) CHK1,(IN(KOL),KOL=1,72) 100 FORMAT(A6,72A1) IF(CHK1.NE.CHCK) GO TO 50 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 50 WRITE(6,51) CHK1 51 FORMAT(1H0,'THE PROGRAM EXPECTED VARSEL CARD.INSTEAD IT FOUND',2X, XA6,'. PLEASE CHECK THE DECK SETUP.') ITEM=9999 RETURN END SUBROUTINE TRANS(X,U,S,C,NC,NPR,NV,SELECT) DIMENSION X(NV),U(NV),S(NV),C(NV) LOGICAL BL C C