Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0137/bmd/bmd03v.for
There is 1 other file named bmd03v.for in the archive. Click here to see a list.
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