CBMD03V ANALYSIS OF COVARIANCE JULY 22, 1965 DOUBLE PRECISION ON,ONR,PROBLM,FINISH,TRNGEN,CONSTS,BNEW, 1Q000HL,Q001HL,Q002HL,Q003HL DIMENSION X(500,9),SCALE(9),AV(9),L(6),LL(6),N(6),M(6),MM(7), 1K5(7),KM(6),S(65,9,9),T(9,9),PQ(64),A(64),B(90),R(64,8),KV(9), 2KW(9),MD(6),CON(8),NEWA(64),LCODE(64),LVA(64),BNEW(64) COMMON ON,B,R COMMON X , SCALE , AV , L , LL , N COMMON M , MM , K5 , KM , S , T COMMON PQ , NV , NR , NT , NI , NVM COMMON I5 , MARK , JW , Z , IJK , KK COMMON KZ , NN , NW , A COMMON KV , KW , NY , NZ , CON , ONNN EQUIVALENCE (R(1),BNEW(1)),(R(65),NEWA),(R(129),LVA), 1(R(193),LCODE) C 902 FORMAT('1BMD03V - ANALYSIS OF COVARIANCE - REVISED ', 1'AUGUST 7, 1968'/ 241H HEALTH SCIENCES COMPUTING FACILITY, UCLA/) C MTAPE=5 CALL USAGEB('BMD03V') REWIND 2 4 READ (5,900)ON,PROB,NV,NR,NI,NVM,NJ,JW,(L(I),I=1,6), NTAPE,IJK DATA Q000HL/6HPROBLM/ KZZZ=0 ONR=(+Q000HL) IF(ON.EQ.ONR) GO TO 6 DATA Q001HL/6HFINISH/ 5 IF (ON.NE.Q001HL) GO TO 990 GO TO 1000 6 IF(NTAPE-2)8,991,8 8 CALL TPWD(NTAPE,MTAPE) 9 WRITE (6,902) WRITE (6,903)PROB IF(NV*(NV-7)) 6001,992,992 6001 IF(NI*(NI-9)) 6002,993,993 6002 IF((NJ+8)*(NJ-8)) 6003,994,994 6003 IF((NI+NJ)*(NI+NJ-9)) 6004,995,995 6004 IF(NVM-64) 6005,6005,996 6005 IF(IJK*(IJK-6)) 6006,997,997 6006 KZ=0 NTT=NI+1 NI=NI+NJ NT=NTT+NJ IF(NR) 41, 41, 42 41 NR=1 42 WRITE (6,904)NV,NR,NI WRITE (6,908) DO 7 I=1,NV 7 WRITE (6,909)I,L(I) IF(NVM)410,410,400 400 WRITE (6,912) WRITE (6,914) DATA Q002HL/6HTRNGEN/ ONR=(+Q002HL) DO 405 I=1,NVM READ (5,911)ON,NEWA(I),LCODE(I),LVA(I),BNEW(I) IF(ON.NE.ONR) GO TO 403 401 IF(LCODE(I)*(LCODE(I)-15))404,402,402 402 WRITE (6,910)I GO TO 4035 403 WRITE (6,906)ON 4035 KZ=-9 WRITE (6,916) GO TO 405 404 WRITE (6,913)I,NEWA(I),LCODE(I),LVA(I),BNEW(I) 405 CONTINUE 410 DO 10 I=1,NT 10 AV(I)=0.0 IF(JW) 432, 432, 435 432 DO 433 I=1,NI 433 CON(I)=0.0 GO TO 413 435 READ (5,901)ON,(CON(I), I=1,NI) DATA Q003HL/6HCONSTS/ ONR=(+Q003HL) IF(ON.EQ.ONR) GO TO 413 411 WRITE (6,915) GO TO 1000 1003 WRITE(6,1013) 1013 FORMAT(44H0VIOLATING LIMITATION (4) ON PAGE 511 OF BMD) GO TO 1000 991 WRITE(6,1991) 1991 FORMAT(63H02 CAN NOT BE SPECIFIED AS DATA INPUT TAPE UNIT FOR THIS 1PROBLEM) GO TO 1000 992 WRITE(6,1992) 1992 FORMAT(55H0TOO MANY NUMBER OF ANALYSIS OF VARIANCE CLASSIFICATION) GO TO 1000 993 WRITE(6,1993) 1993 FORMAT(51H0THE BUMBER OF ORIGINAL COVARIATES CAN NOT EXCEED 8) GO TO 1000 994 WRITE(6,1994) 1994 FORMAT(41H0ILLEGAL NUMBER OF COVARIATES TO BE ADDED) GO TO 1000 995 WRITE(6,1995) 1995 FORMAT(51H0ILLEGAL NUMBER OF COVARIATES AFTER TRANSGENERATION) GO TO 1000 996 WRITE(6,1996) 1996 FORMAT(31H0TOO MANY TRANSGENERATION CARDS) GO TO 1000 997 WRITE(6,1997) 1997 FORMAT(31H0TOO MANY VARIABLE FORMAT CARDS) GO TO 1000 413 CALL VFCHCK(IJK) IJK=IJK*18 WRITE(6,970) READ (5,907)(B(I), I=1,IJK) WRITE(6,999)(B(I),I=1,IJK) 999 FORMAT(1X,18A4) 11 NN=1 DO 12 I=1,NV 12 NN=NN*L(I) IF(NN.GT.1000)GO TO 1003 ON=NN ONR=NR ONN=ON*ONR ONNN=ONN+1.0 NW=2**NV-1 NY=NW+1 NZ=NY+1 DO 25 I=1,64 DO 25 J=1,NT DO 25 K=1,NT 25 S(I,J,K)=0.0 IF(NR-1) 13, 13, 17 13 MARK=1 DO 14 I=1,NN READ (MTAPE,B)(T(1,J),J=1,NTT) IF(KZ) 14, 418, 418 418 IF(NVM)420,420,415 415 CALL TRANZ 420 DO 75 J=1,NT X(I,J)=T(1,J) 75 AV(J)=AV(J)+X(I,J) 14 CONTINUE IF(KZ) 4, 79, 79 79 DO 15 J=1,NT 15 AV(J)=AV(J)/ON DO 16 I=1,NN DO 16 J=1,NT 16 X(I,J)=X(I,J)-AV(J) DO 81 I=1,NN DO 81 J=1,NT DO 81 K=J,NT 81 S(NZ,J,K)=S(NZ,J,K)+X(I,J)*X(I,K) GO TO 26 17 DO 18 I=1,NN DO 18 J=1,NT 18 X(I,J)=0.0 DO 20 I=1,NR MARK=I DO 20 J=1,NN READ (MTAPE,B)(T(1,K),K=1,NTT) IF(KZ) 20, 440, 440 440 IF(NVM) 90, 90, 430 430 CALL TRANZ 90 DO 99 K=1,NT AV(K)=AV(K)+T(1,K) 99 X(J,K)=X(J,K)+T(1,K) KZZZ=1 WRITE(2)(T(1,K),K=1,NT) 20 CONTINUE IF(KZZZ.EQ.0) GO TO 445 END FILE 2 REWIND 2 IF(KZ) 4, 445, 445 445 DO 21 I=1,NN DO 21 J=1,NT 21 X(I,J)=X(I,J)/ONR DO 22 J=1,NT 22 AV(J)=AV(J)/ONN DO 24 I=1,NR DO 24 J=1,NN READ(2)(T(1,K),K=1,NT) DO 23 K=1,NT T(2,K)=T(1,K)-AV(K) 23 T(1,K)=T(1,K)-X(J,K) DO 24 JA=1,NT DO 24 JB=JA,NT S(NY,JA,JB)=S(NY,JA,JB)+T(1,JA)*T(1,JB) 24 S(NZ,JA,JB)=S(NZ,JA,JB)+T(2,JA)*T(2,JB) REWIND 2 DO 38 J=1,NT AV(J)=AV(J)*ONR DO 38 I=1,NN X(I,J)=X(I,J)*ONR 38 X(I,J)=X(I,J)-AV(J) 26 NVM=NV-1 I5=(6-NV)+1 DO 32 I=1,NVM LL(I)=1 I1=I+1 DO 32 J=I1,NV 32 LL(I)=LL(I)*L(J) LL(NV)=1 DO 40 I=1,NV I1=I-1 I2=NV-I1 I3=6-I1 40 L(I3)=L(I2) KZ=0 DO 45 I=1,64 45 PQ(I)=0.0 DO 231 IJ=1,NVM MARK=0 IJK=IJ JW=NVM-(IJ-1) DO 51 I=I5,6 51 M(I)=0 J1=I5+(NVM-JW) DO 52 I=I5,J1 52 M(I)=1 Z=1.0 70 CALL TABLE (M,I5,Z,MARK,IJK) IF(MARK) 205, 205, 231 205 KZ=KZ+1 CALL XLOCAT NDF=1 MDF=1 I6=I5+(IJ-1) DO 206 I=I5,I6 NDF=NDF*MM(I) 206 MDF=MDF*(MM(I)+1) FNDF=NDF DF=MDF FACT=DF/ONN DO 200 I=1,NT DO 200 J=1,NT 200 S(KZ,I,J)=S(KZ,I,J)*FACT A(KZ)=FNDF IF(NVM)2232,2232,2231 2231 DO 204 I=1,IJK I4=I5+(I-1) ROSE=K5(I4) 204 PQ(KZ)=(PQ(KZ)+ROSE)*10.0 PQ(KZ)=PQ(KZ)/10.0 I7=I6-I5 IF(I7-1) 70, 207, 207 207 DO 208 J=1,NT DO 208 K=J,NT 208 T(J,K)=0.0 DO 220 JK=1,I7 ICE=0 KL=JK DO 209 I=I5,6 209 MD(I)=0 I8=6-I7 I9=I8+(JK-1) DO 210 I=I8,I9 210 MD(I)=1 Y=1.0 211 CALL PARTS(MD,I8,Y,ICE,KL) IF(ICE) 212, 212, 220 212 FISH=0.0 KK=0 DO 215 I=I8,6 KK=KK+1 IF(MD(I)) 215, 215, 213 213 I4=I5+(KK-1) ROSE=K5(I4) FISH=(FISH+ROSE)*10.0 215 CONTINUE FISH=FISH/10.0 DO 217 I=1, 64 IF(PQ(I)-FISH) 217, 216, 211 216 DO 222 J=1,NT DO 222 K=J,NT 222 T(J,K)=T(J,K)+S(I,J,K) GO TO 211 217 CONTINUE 220 CONTINUE DO 223 J=1,NT DO 223 K=J,NT 223 S(KZ,J,K)=S(KZ,J,K)-T(J,K) GO TO 70 231 CONTINUE 2232 DO 236 I=1,KZ DO 236 J=1,NT DO 236 K=J,NT 236 S(NW,J,K)=S(NW,J,K)+S(I,J,K) IF(NR-1) 238, 238, 250 238 DO 237 J=1,NT DO 237 K=J,NT 237 S(NW,J,K)=S(NZ,J,K)-S(NW,J,K) GO TO 360 250 DO 255 I=1,NT DO 255 J=I,NT 255 S(NW,I,J)=S(NZ,I,J)-S(NY,I,J)-S(NW,I,J) 360 CALL FINAL CALL ANOVA GO TO 4 900 FORMAT(A6,A4,I2,I3,4I2,6I3,27X,I2,I2) 901 FORMAT(A6,9F6.0) 903 FORMAT(14H0PROBLEM NO. A4) 904 FORMAT(17H0NO. OF VARIABLESI5/18H NO. OF REPLICATESI4/18H NO. OF C 1OVARIATESI4) 905 FORMAT(58H0PROBLM IS PUNCHED WRONG OR INPUT DECK IS SET UP INCORRE 1CT) 906 FORMAT(54H0CONTROL CARD ERROR. A TRNGEN CARD WAS EXPECTED BUT A , 1A6,16H CARD WAS FOUND.) 907 FORMAT(18A4) 908 FORMAT(27H0VARIABLE NO. OF LEVELS) 909 FORMAT(I6,11X,I4) 910 FORMAT(45H0ILLEGAL TRANSGENERATION CODE ON CARD NUMBER ,I2) 911 FORMAT(A6,I3,I2,I3,F6.0) 912 FORMAT(1H06X,22HTRANS-GENERATION CARDS) 913 FORMAT(2H I2,I8,2I9,4X,F10.5) 914 FORMAT(46H0CARD NEW TRANS ORIG. ORIG. VAR(B)/45H NO. 1VARIABLE CODE VAR(A) OR CONSTANT) 915 FORMAT(24H0ERROR ON CONSTANTS CARD) 916 FORMAT(64H PROGRAM WILL GO TO THE NEXT PROBLEM CARD, IF ANY, OR TE 1RMINATE.) 920 FORMAT(25H ERROR ON TAPE ASSIGNMENT) 970 FORMAT(///16H0VARIABLE FORMAT) 9876 FORMAT(20A4) 990 WRITE (6,905) 1000 IF(MTAPE-5)1002,1002,1001 1001 REWIND MTAPE 1002 STOP END CANOVA SUBROUTINE ANOVA FOR BMD03V JULY 22, 1965 SUBROUTINE ANOVA DOUBLE PRECISION ON,BNEW,Q000HL,Q001HL,Q002HL,Q003HL,Q004HL, 1Q005HL,Q006HL,Q007HL DIMENSION X(500,9),SCALE(9),AV(9),L(6),LL(6),N(6),M(6),MM(7), 1K5(7),KM(6),S(65,9,9),T(9,9),PQ(64),A(64),B(90),R(64,8),KV(9), 2KW(9),MD(6),CON(8),NEWA(64),LCODE(64),LVA(64),BNEW(64) COMMON ON,B,R COMMON X , SCALE , AV , L , LL , N COMMON M , MM , K5 , KM , S , T COMMON PQ , NV , NR , NT , NI , NVM COMMON I5 , MARK , JW , Z , IJK , KK COMMON KZ , NN , NW , A COMMON KV , KW , NY , NZ , CON , ONNN EQUIVALENCE (R(1),BNEW(1)),(R(65),NEWA),(R(129),LVA), 1(R(193),LCODE) DATA Q000HL/6H( / BNEW(1)=(+Q000HL) DATA Q001HL/6H1H / BNEW(2)=(+Q001HL) DATA Q002HL/6H1X, / DO 250 I=3,8 250 BNEW(I)=(+Q002HL) DATA Q003HL/6H9X,I8,/ BNEW(9)=(+Q003HL) DATA Q004HL/6HF22.5,/ BNEW(10)=(+Q004HL) DATA Q005HL/6HF17.5,/ BNEW(11)=(+Q005HL) DATA Q006HL/6H) / BNEW(12)=(+Q006HL) WRITE (6,914) WRITE (6,907) WRITE (6,908) IF(NR-1) 270, 270, 275 270 LZ=NW-1 GO TO 280 275 LZ=NW 280 DO 300 I=1,LZ LL(1)=PQ(I) DO 281 J=1,NV LL(2)=LL(1) LL(2)=LL(2)/10 LL(3)=LL(2) LL(2)=LL(2)*10 LY=NV-(J-1) N(LY)=LL(1)-LL(2) 281 LL(1)=LL(3) LY=0 KZ=2 DO 285 J=1,NV IF(N(J)) 285, 285, 282 282 LY=LY+1 LL(LY)=N(J) KZ=KZ+1 DATA Q007HL/6HI1, / BNEW(KZ)=(+Q007HL) 285 CONTINUE SQM=B(I)/A(I) NDF=A(I) 300 WRITE (6,BNEW)(LL(J), J=1,LY), NDF,B(I),SQM IF(NR-1) 310, 310, 320 310 SQM=B(NW)/A(NW) NDF=A(NW) WRITE (6,911)NDF,B(NW),SQM GO TO 330 320 SQM=B(NY)/A(NY) NDF=A(NY) WRITE (6,913)NDF,B(NY),SQM 907 FORMAT(59H0SOURCE OF DEGREES OF SUMS OF M 1EAN) 908 FORMAT(61H VARIATION FREEDOM SQUARES SQ 1UARES/) 911 FORMAT(18H RESIDUAL I6,F22.5,F17.5) 912 FORMAT(18H TOTAL I6,F22.5) 913 FORMAT(18H WITHIN REPLICATESI6,F22.5,F17.5) 914 FORMAT(1H0) 330 RETURN END CFINAL SUBROUTINE FINAL FOR BMD03V JULY 12, 1963 SUBROUTINE FINAL DOUBLE PRECISION ON,BNEW DIMENSION X(500,9),SCALE(9),AV(9),L(6),LL(6),N(6),M(6),MM(7), 1K5(7),KM(6),S(65,9,9),T(9,9),PQ(64),A(64),B(90),R(64,8),KV(9), 2KW(9),MD(6),CON(8),NEWA(64),LCODE(64),LVA(64),BNEW(64),TT(9,9) COMMON ON,B,R COMMON X , SCALE , AV , L , LL , N COMMON M , MM , K5 , KM , S , T COMMON PQ , NV , NR , NT , NI , NVM COMMON I5 , MARK , JW , Z , IJK , KK COMMON KZ , NN , NW , A COMMON KV , KW , NY , NZ , CON , ONNN EQUIVALENCE (R(1),BNEW(1)),(R(65),NEWA),(R(129),LVA), 1(R(193),LCODE) IF(NR-1) 4, 4, 6 4 DF=0.0 DO 5 I=1,KZ 5 DF=DF+A(I) DDF=ON-1.0 DNI=NI A(NW)=DDF-DF-DNI LZ=NW-1 GO TO 13 6 ANW=1.0 DO 7 I=1,NV 7 ANW=ANW*A(I) A(NW)=ANW NDF=NR*NN-NN A(NY)=NDF-NI PQ(NW)=0.0 DO 3 I=1,NV DF=I 3 PQ(NW)=PQ(NW)*10.0+DF LZ=NW 13 LP=LZ+1 ASSIGN 21 TO NNY ASSIGN 25 TO NNW ASSIGN 60 TO NNX NF=1 15 DO 50 K=NF,LZ DO 16 I=1,NI DO 16 J=I,NI T(I,J)=S(K,I+1,J+1) 16 T(J,I)=S(K,I+1,J+1) WRITE (6,903) GO TO NNY, (21,22) 21 LL(1)=PQ(K) DO 17 I=1,NV LL(2)=LL(1) LL(2)=LL(2)/10 LL(3)=LL(2) LL(2)=LL(2)*10 LY=NV-(I-1) N(LY)=LL(1)-LL(2) 17 LL(1)=LL(3) LY=0 DO 20 I=1,NV IF(N(I)) 20, 20, 18 18 LY=LY+1 LL(LY)=N(I) 20 CONTINUE WRITE (6,901)(LL(I), I=1,LY) GO TO 23 22 WRITE (6,908) 23 WRITE (6,902) WRITE (6,907)(S(K,1,J), J=1,NT) WRITE (6,913) CALL REPORT GO TO NNW, (25,30) 25 DO 27 I=1,NI DO 27 J=I,NI 27 T(I,J)=T(I,J)+S(LP,I+1,J+1) IM=NI-1 DO 28 I=1,IM IN=I+1 DO 28 J=IN,NI 28 T(J,I)=T(I,J) DO 29 I=1,NI 29 AV(I)=S(K,1,I+1)+S(LP,1,I+1) DF=S(K,1,1)+S(LP,1,1) WRITE (6,905) WRITE (6,904) WRITE (6,902) WRITE (6,907)DF,(AV(I), I=1,NI) WRITE (6,913) CALL REPORT GO TO 32 30 DO 31 I=1,NI 31 AV(I)=S(LP,1,I+1) DF=S(LP,1,1) 32 DO 315 I=1,NI DO 315 J=I,NI TT(I,J)=T(I,J) TT(J,I)=T(I,J) 315 CONTINUE IF(NI-1) 33,33,34 33 T(1,1)=1.0/T(1,1) GO TO 36 34 CALL INVERT (T,NI,DET,KV,KW) 36 WRITE (6,905) WRITE (6,909) CALL REPORT DO 35 I=1,NI R(K,I)=0.0 DO 35 J=1,NI 35 R(K,I)=R(K,I)+T(I,J)*AV(J) WRITE (6,906) WRITE (6,915)(R(K,I), I=1,NI) B(K)=0.0 DO 40 I=1,NI 40 B(K)=B(K)+AV(I)*R(K,I) B(K)=DF-B(K) 50 CONTINUE GO TO NNX, (60,65) 60 ASSIGN 22 TO NNY ASSIGN 30 TO NNW ASSIGN 65 TO NNX IF(NR-1) 61, 61, 62 61 NF=NW LZ=NW GO TO 15 62 NF=NY LZ=NY GO TO 15 65 DO 70 I=1,NI 70 AV(I)=R(LZ,I)/SQRT(T(I,I)) SCALE(1)=B(LZ)/A(LZ) SCALE(2)=SQRT(SCALE(1)) DO 67 I=1,NI 67 AV(I)=AV(I)/SCALE(2) LZZ=LZ-1 DO 71 I=1,LZZ 71 B(I)=B(I)-B(LZ) WRITE (6,903) WRITE (6,910) WRITE (6,915)(AV(I), I=1,NI) WRITE (6,911)SCALE(1) WRITE (6,912)SCALE(2) DF=NI DF=A(LZ)/DF DO 72 I=1,NI 72 AV(I)=R(LZ,I)-CON(I) DO 73 I=1,NI SCALE(I)=0.0 DO 73 J=1,NI 73 SCALE(I)=SCALE(I)+AV(J)*TT(J,I) DD=0.0 DO 74 I=1,NI 74 DD=DD+SCALE(I)*AV(I) DF=(DF*DD)/B(LZ) NDF=A(LZ) WRITE (6,916)NI,NDF,DF WRITE (6,914) WRITE (6,902) WRITE (6,907)(S(NZ,1,I), I=1,NT) DO 75 I=1,NI DO 75 J=I,NI 75 T(I,J)=S(NZ,I+1,J+1) WRITE (6,913) CALL REPORT 901 FORMAT(33H0TABLE OF VARIATION FOR VARIABLE I2,5I2) 902 FORMAT(8H VARIATE) 903 FORMAT(1H0) 904 FORMAT(41H0TABLE OF VARIATION ADJUSTED BY RESIDUALS) 905 FORMAT(1H ) 906 FORMAT(24H0REGRESSION COEFFICIENTS) 907 FORMAT(1X,9F14.5) 908 FORMAT(33H0TABLE OF VARIATION FOR RESIDUALS) 909 FORMAT(29H0INVERSE OF COVARIATES MATRIX) 910 FORMAT(18H0COMPUTED T VALUES) 911 FORMAT(21H0RESIDUAL MEAN SQUAREF17.5) 912 FORMAT(25H SQRT. OF RESID. MEAN SQ.F13.5) 913 FORMAT(11H COVARIATES) 914 FORMAT(29H0TABLE OF VARIATION FOR TOTAL) 915 FORMAT(13X,8F13.5) 916 FORMAT(4H0F (I2,1H,I4,3H) =F13.5//) RETURN END CNVERT SUBROUTINE INVERT FOR BMD03V JULY 12, 1963 SUBROUTINE INVERT(A,NN,D,ID,DUMY) DOUBLE PRECISION B DIMENSION A(9,9),ID(9) N=NN D=0.0 DO 60 I=1,N B=0.0 II=0 DO 10 J=I,N IF(DABS(B).GE.ABS(A(J,I)))GO TO 10 II=J B=A(J,I) 10 CONTINUE IF(II.GT.0) GO TO 20 PRINT 200 RETURN 20 ID(I)=II DO 30 J=1,N T=A(II,J)/B A(II,J)=A(I,J) 30 A(I,J)=T DO 40 II=1,N T=A(II,I) DO 40 JJ=1,N IF(JJ.EQ.I.OR.II.EQ.I) GO TO 40 A(II,JJ)=A(II,JJ)-A(I,JJ)*T 40 CONTINUE DO 50 II=1,N 50 A(II,I)=-A(II,I)/B D=D*B A(I,I)=1.0/B 60 CONTINUE DO 80 JJ=1,N J=N+1-JJ II=ID(J) IF(II.EQ.J) GO TO 80 DO 70 I=1,N T=A(I,J) A(I,J)=A(I,II) 70 A(I,II)=T 80 CONTINUE RETURN 200 FORMAT(//34H MATRIX TO BE INVERTED IS SINGULAR ) END CPART SUBROUTINE PART FOR BMD03V JULY 12, 1963 SUBROUTINE PARTS(J,IP,Q,ICE,KL) DOUBLE PRECISION ON,BNEW DIMENSION J(6) GO TO (71,72,73,74), KL 71 IF(Q-1.0) 61, 60, 61 60 KA=IP GO TO 299 61 IF(KA-6) 109, 200, 200 72 IF(Q-1.0) 63, 62, 63 62 KB=IP KA=IP+1 GO TO 299 63 IF(KA-6) 109, 93, 93 93 IF(KB-5) 108, 200, 200 73 IF(Q-1.0) 65, 64, 65 64 KC=IP KB=IP+1 KA=IP+2 GO TO 299 65 IF(KA-6) 109, 97, 97 97 IF(KB-5) 108, 98, 98 98 IF(KC-4) 107, 200, 200 74 IF(Q-1.0) 67, 66, 67 66 KD=IP KC=IP+1 KB=IP+2 KA=IP+3 GO TO 299 67 IF(KA-6) 109, 103, 103 103 IF(KB-5) 108, 104, 104 104 IF(KC-4) 107, 105, 105 105 IF(KD-3) 106, 200, 200 106 DO 113 I=KD,6 113 J(I)=0 KD=KD+1 J(KD)=1 KC=KD+1 J(KC)=1 10 KB=KC+1 J(KB)=1 20 KA=KB+1 J(KA)=1 GO TO 300 107 DO 112 I=KC,6 112 J(I)=0 KC=KC+1 J(KC)=1 GO TO 10 108 DO 111 I=KB,6 111 J(I)=0 KB=KB+1 J(KB)=1 GO TO 20 109 DO 110 I=KA,6 110 J(I)=0 KA=KA+1 J(KA)=1 GO TO 300 200 ICE=1 GO TO 300 299 Q=0.0 300 RETURN END CREPORT SUBROUTINE REPORT FOR BMD03V JULY 22, 1963 SUBROUTINE REPORT DOUBLE PRECISION ON,BNEW,FM1,FMT DIMENSION X(500,9),SCALE(9),AV(9),L(6),LL(6),N(6),M(6),MM(7), 1K5(7),KM(6),S(65,9,9),T(9,9),PQ(64),A(64),B(90),R(64,8),KV(9), 2KW(9),MD(6),CON(8),NEWA(64),LCODE(64),LVA(64),BNEW(64) COMMON ON,B,R COMMON X , SCALE , AV , L , LL , N COMMON M , MM , K5 , KM , S , T COMMON PQ , NV , NR , NT , NI , NVM COMMON I5 , MARK , JW , Z , IJK , KK COMMON KZ , NN , NW , A COMMON KV , KW , NY , NZ , CON , ONNN EQUIVALENCE (R(1),BNEW(1)),(R(65),NEWA),(R(129),LVA), 1(R(193),LCODE) DIMENSION FM1(9),FMT(2) DATA FM1/' (15X,8',' (29X,7',' (43X,6',' (57X,5',' (71X,4', 1' (85X,3',' (99X,2',' (113X,','F14.5) '/ DO 20 I=1,NI FMT(1)=FM1(I) FMT(2)=FM1(9) 20 WRITE(6,FMT)(T(I,J),J=I,NI) RETURN END CTABLE SUBROUTINE TABLE FOR BMD03V JULY 12, 1963 SUBROUTINE TABLE (M,I5,Z,MARK,IJK) DIMENSION M(6) GO TO (71,72,73,74,75),IJK 71 IF(Z-1.0) 61, 60, 61 60 KA=I5 GO TO 299 61 IF(KA-6) 118, 200, 200 72 IF(Z-1.0) 63, 62, 63 62 KB=I5 KA=I5+1 GO TO 299 63 IF(KA-6) 118, 93, 93 93 IF(KB-5) 117, 200, 200 73 IF(Z-1.0) 65, 64, 65 64 KC=I5 KB=I5+1 KA=I5+2 GO TO 299 65 IF(KA-6) 118, 97, 97 97 IF(KB-5) 117, 98, 98 98 IF(KC-4) 116, 200, 200 74 IF(Z-1.0) 67, 66, 67 66 KD=I5 KC=I5+1 KB=I5+2 KA=I5+3 GO TO 299 67 IF(KA-6) 118, 103, 103 103 IF(KB-5) 117, 104, 104 104 IF(KC-4) 116, 105, 105 105 IF(KD-3) 115, 200, 200 75 IF(Z-1.0) 69,68,69 68 KE=I5 KD=I5+1 KC=I5+2 KB=I5+3 KA=I5+4 GO TO 299 69 IF(KA-6) 118, 110, 110 110 IF(KB-5) 117, 111, 111 111 IF(KC-4) 116, 112, 112 112 IF(KD-3) 115, 113, 113 113 IF(KE-2) 114, 200, 200 114 DO 123 I=KE,6 123 M(I)=0 KE=KE+1 M(KE)=1 KD=KE+1 M(KD)=1 10 KC=KD+1 M(KC)=1 20 KB=KC+1 M(KB)=1 30 KA=KB+1 M(KA)=1 GO TO 300 115 DO 122 I=KD,6 122 M(I)=0 KD=KD+1 M(KD)=1 GO TO 10 116 DO 121 I=KC,6 121 M(I)=0 KC=KC+1 M(KC)=1 GO TO 20 117 DO 120 I=KB,6 120 M(I)=0 KB=KB+1 M(KB)=1 GO TO 30 118 DO 119 I=KA,6 119 M(I)=0 KA=KA+1 M(KA)=1 GO TO 300 200 MARK=1 GO TO 300 299 Z=0.0 300 RETURN END CTPWD SUBROUTINE TPWD FOR BMD03V VERSION OF SEPT. 26, 1963 SUBROUTINE TPWD(NT1,NT2) IF(NT1)40,10,12 10 NT1=5 12 IF(NT1-NT2)14,19,14 14 IF(NT2-5)15,19,15 15 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) STOP 49 FORMAT(25H ERROR ON TAPE ASSIGNMENT) END CTRANZ SUBROUTINE TRANZ FOR BMD03V JUNE 30, 1964 SUBROUTINE TRANZ DOUBLE PRECISION ON,BNEW DIMENSION X(500,9),SCALE(9),AV(9),L(6),LL(6),N(6),M(6),MM(7), 1K5(7),KM(6),S(65,9,9),T(9,9),PQ(64),D(64),E(90),R(64,8),KV(9), 2KW(9),MD(6),CON(8),NEWA(64),LCODE(64),LVA(64),BNEW(64) COMMON ON,E,R COMMON X , SCALE , AV , L , LL , N COMMON M , MM , K5 , KM , S , T COMMON PQ , NV , NR , NT , NI , NVM COMMON I5 , MARK , JW , Z , IJK , KK COMMON KZ , NN , NW , D COMMON KV , KW , NY , NZ , CON , ONNN EQUIVALENCE (R(1),BNEW(1)),(R(65),NEWA),(R(129),LVA), 1(R(193),LCODE) ASN(Q000FL)=ATAN(Q000FL/SQRT(1.0-Q000FL**2)) 6003 DO 200 I=1,NVM J=NEWA(I) IJK=LCODE(I) K=LVA(I) IF(IJK-11)5,7,7 5 POWER=BNEW(I) GO TO 8 7 II=BNEW(I) 8 GO TO(10,20,30,40,50,60,70,80,90,100,110,120,130,140),IJK 10 IF(T(1,K))99,32,9 9 T(1,J)=SQRT(T(1,K)) GO TO 200 20 IF(T(1,K))99,11,12 11 T(1,J)=1.0 GO TO 200 12 T(1,J)=SQRT(T(1,K))+SQRT(T(1,K)+1.0) GO TO 200 30 IF(T(1,K))99,99,14 14 T(1,J)=ALOG10(T(1,K)) GO TO 200 40 T(1,J)=EXP(T(1,K)) GO TO 200 50 IF(T(1,K))99,32,17 17 IF(T(1,K)-1.0)18,19,99 19 T(1,J)=3.14159265/2.0 GO TO 200 18 A=SQRT(T(1,K)) T(1,J)=ASN(A) GO TO 200 60 A=T(1,K)/ONNN B=A+1.0/ONNN IF(A)99,23,24 23 IF(B)99,32,27 27 T(1,J)=ASN(SQRT(B)) GO TO 200 24 IF(B)99,28,29 28 T(1,J)=ASN(SQRT(A)) GO TO 200 29 A=SQRT(A) B=SQRT(B) T(1,J)=ASN(A)+ASN(B) GO TO 200 70 IF(T(1,K))31,99,31 31 T(1,J)=1.0/T(1,K) GO TO 200 80 T(1,J)=T(1,K)+POWER GO TO 200 90 T(1,J)=T(1,K)*POWER GO TO 200 100 IF(T(1,K))33,32,33 32 T(1,J)=0.0 GO TO 200 33 T(1,J)=T(1,K)**POWER GO TO 200 110 T(1,J)=T(1,K)+T(1,II) GO TO 200 120 T(1,J)=T(1,K)-T(1,II) GO TO 200 130 T(1,J)=T(1,K)*T(1,II) GO TO 200 140 IF(T(1,II))34,99,34 34 T(1,J)=T(1,K)/T(1,II) GO TO 200 99 WRITE (6,900)I,MARK,T(1,K) KZ=-99 GO TO 250 200 CONTINUE 900 FORMAT(51H0ERROR OCCURRED DURING TRANS-GENERATION PASS NUMBERI3, 120H, REPLICATION NUMBERI5,1H./26H VALUE OF THIS REPLICATE =F15.5,2 2H. 36HTHIS IS THE FIRST ERROR ENCOUNTERED./41H PROGRAM WILL GO TO 3NEXT PROBLEM, IF ANY.) 250 RETURN END CVFCHCK SUBROUTINE TO CHECK FOR PROPER NUMBER OF VARIABLE FORMAT CRDS SUBROUTINE VFCHCK(NVF) IF(NVF.GT.0.AND.NVF.LE.5) RETURN 10 WRITE (6,4000) NVF=1 50 RETURN 4000 FORMAT(1H023X71HNUMBER OF VARIABLE FORMAT CARDS INCORRECTLY SPECIF 1IED, ASSUMED TO BE 1.) END CXLOCAT SUBROUTINE XLOCAT FOR BMD03V JULY 12, 1963 SUBROUTINE XLOCAT DOUBLE PRECISION ON,BNEW DIMENSION X(500,9),SCALE(9),AV(9),L(6),LL(6),N(6),M(6),MM(7), 1K5(7),KM(6),S(65,9,9),T(9,9),PQ(64),A(64),B(90),R(64,8),KV(9), 2KW(9),MD(6),CON(8),NEWA(64),LCODE(64),LVA(64),BNEW(64) COMMON ON,B,R COMMON X , SCALE , AV , L , LL , N COMMON M , MM , K5 , KM , S , T COMMON PQ , NV , NR , NT , NI , NVM COMMON I5 , MARK , JW , Z , IJK , KK COMMON KZ , NN , NW , A COMMON KV , KW , NY , NZ , CON , ONNN EQUIVALENCE (R(1),BNEW(1)),(R(65),NEWA),(R(129),LVA), 1(R(193),LCODE) DO 300 I=1,6 300 N(I)=0 KI=0 K=1 DO 302 I=I5,6 KI=KI+1 IF(M(I)) 301, 301, 302 301 N(K)=KI K=K+1 302 CONTINUE DO 303 I=I5,6 303 MM(I)=L(I)-1 DO 305 I=1,NV K=I5+(I-1) 305 K5(K)=I DO 310 I=1,JW DO 309 J=I5,6 IF(N(I)-K5(J)) 309, 306, 309 306 K5(7)=K5(J) MM(7)=MM(J) DO 307 J2=J,6 K5(J2)=K5(J2+1) 307 MM(J2)=MM(J2+1) GO TO 310 309 CONTINUE 310 CONTINUE DO 320 J=1,NT 320 AV(J)=0.0 351 N(1)=0 352 N(2)=0 353 N(3)=0 354 N(4)=0 355 N(5)=0 356 N(6)=0 359 DO 360 J=I5,6 KK=K5(J) 360 KM(KK)=N(J) LX=1 DO 361 J=1,NV 361 LX=LX+KM(J)*LL(J) DO 200 J=1,NT 200 AV(J)=AV(J)+X(LX,J) IF(N(6)-MM(6)) 362, 363, 363 362 N(6)=N(6)+1 GO TO 359 363 IF(JW-1) 212, 364, 370 364 DO 210 I=1,NT DO 210 J=I,NT 210 S(KZ,I,J)=S(KZ,I,J)+AV(I)*AV(J) DO 211 I=1,NT 211 AV(I)=0.0 212 IF(NV-1) 70, 70, 370 370 IF(N(5)-MM(5)) 371, 372, 372 371 N(5)=N(5)+1 GO TO 356 372 IF(JW-2) 232, 373, 381 373 DO 230 I=1,NT DO 230 J=I,NT 230 S(KZ,I,J)=S(KZ,I,J)+AV(I)*AV(J) DO 231 I=1,NT 231 AV(I)=0.0 232 IF(NV-2) 70, 70, 381 381 IF(N(4)-MM(4)) 382, 383, 383 382 N(4)=N(4)+1 GO TO 355 383 IF(JW-3) 242, 384, 394 384 DO 240 I=1,NT DO 240 J=I,NT 240 S(KZ,I,J)=S(KZ,I,J)+AV(I)*AV(J) DO 241 I=1,NT 241 AV(I)=0.0 242 IF(NV-3) 70, 70, 394 394 IF(N(3)-MM(3)) 395, 396, 396 395 N(3)=N(3)+1 GO TO 354 396 IF(JW-4) 252, 397, 407 397 DO 250 I=1,NT DO 250 J=I,NT 250 S(KZ,I,J)=S(KZ,I,J)+AV(I)*AV(J) DO 251 I=1,NT 251 AV(I)=0.0 252 IF(NV-4) 70, 70, 407 407 IF(N(2)-MM(2)) 408, 409, 409 408 N(2)=N(2)+1 GO TO 353 409 IF(JW-5) 262, 410, 420 410 DO 260 I=1,NT DO 260 J=I,NT 260 S(KZ,I,J)=S(KZ,I,J)+AV(I)*AV(J) DO 261 I=1,NT 261 AV(I)=0.0 262 IF(NV-5) 70, 70, 420 420 IF(N(1)-MM(1)) 444, 70, 70 444 N(1)=N(1)+1 GO TO 352 70 RETURN END