Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0137/bmd/bmd02v.for
There is 1 other file named bmd02v.for in the archive. Click here to see a list.
C        ANALYSIS OF VARIANCE FOR FACTORIAL DESIGN   MARCH 15, 1966
C        THIS IS A SIFTED VERSION OF BMD02V ORIGINALLY WRITTEN IN
C        FORTRAN II. SOME MODIFICATIONS WERE MADE TO MAKE IT OPERABLE
C        AND SLIGHTLY MORE EFFICIENT THAN THE SIFTED VERSION.
      DIMENSION X(7000),L(9),TEMP(12),LO(8),LM(9),LL(8),K5(9),N(8)
     1,KM(8),MM(9),MI(8),ST(6,9,9),ST1(4,9),M(8),TSUM(255),PQ(255),MD(8)
     2,NORD(4),NSIZE(4),LF(8),C(9,9),CO(9,8,9),D(9,9),FMT(36)
      DOUBLE PRECISION Q0,Q010HL
      DOUBLE PRECISION Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9,Q10,Q11,Q12,Q13,Q14
      DOUBLE PRECISION OK,ONR,ONF,FISH,SUM
      DOUBLE PRECISION TEMP,FMT
      DOUBLE PRECISION QRZ,QRY
      DOUBLE PRECISION TSUM,PQ
      DOUBLE PRECISION BLNK8
      DATA BLNK8/'        '/
      COMMON  TEMP   , SUM    , TSUM   , PQ     , LO     , LM     , LL
      COMMON  ST1    , M      , X      , L      , MD     , NORD
      COMMON  NSIZE  , LF     , C      , CO     , D
      COMMON  K5     , N      , KM     , MM     , MI     , ST
      COMMON  NV     , NR     , NK     , NX     , NVM    , I5
      COMMON  MT     , MT1    , MARK   , JW     , Z      , TRASH
      COMMON  TRA    , IJK    , NO     , IN     , I2     , I3
      COMMON  NDF    , TOTAL  , NO1    , NO2    , KB1    , KB2
C
      DATA Q1/6H(     /
      DATA Q2/6H1H    /
      DATA Q3/6H1X,   /
      DATA Q4/6H1X,   /
      DATA Q5/6H1X,   /
      DATA Q6/6H1X,   /
      DATA Q7/6H1X,   /
      DATA Q8/6H1X,   /
      DATA Q9/6H1X,   /
      DATA Q10/6H1X,   /
      DATA Q11/6H9X,I6,/
      DATA Q12/6HF22.5,/
      DATA Q13/6HF17.5,/
      DATA Q14/6H)     /
      DATA Q0/6HSPECTG/
      DATA Q010HL/6HI1,   /
      DATA QRZ/6HPROBLM/
      DATA QRY/6HFINISH/
 904  FORMAT('1BMD02V - ANALYSIS OF VARIANCE FOR FACTORIAL DESIGN ',
     1'- REVISED JUNE 24, 1969'/
     241H HEALTH SCIENCES COMPUTING FACILITY, UCLA//)
	CALL USAGEB('BMD02V')
      DO 1 I=1,36
    1 FMT(I)=BLNK8
      MTAPE=5
      CALL CONSTN
 100  READ (5,900)OK,PROB,NR,NV,NDF,MEAN,MT,NO,(NORD(I),I=1, 4),(L(J),J=
     11,8),NTAPE,KL
      IF(NO.LE.0)GO TO 803
      DO 800 I=1,NO
      IF(L(NORD(I)).GT.9)GO TO 801
  800 CONTINUE
      GO TO 803
  801 WRITE(6,802)NORD(I),L(NORD(I))
  802 FORMAT('1VARIABLE',I2,' WITH MORE THAN 9 LEVELS IS NOT ALLOWED AS
     *AN ORTHOGONAL BREAKDOWN ONE, PROBLEM WILL BE IGNORED')
      GO TO 400
  803 ONR=QRZ
      ONF=QRY
       IF(ONR.EQ.OK) GO TO 3
  290 IF(OK.EQ.ONF)GO TO 400
      WRITE(6,1005) OK
 1005 FORMAT(' PROGRAM EXPECTED PROBLEM OR FINISH CARD INSTEAD READ THE
     1 FOLLOWING'/1X,A6)
 291  WRITE (6,929)
      GO TO 400
    3 IF(NV*(NV-9)) 6001,1006,1006
 6001 IF(KL*(KL-3)) 6002,1022,1022
 1006 WRITE(6,1002)
      GO TO 291
 1022 WRITE(6,1003)
      GO TO 291
 1008 WRITE(6,1004)
      GO TO 291
 1024 WRITE(6,1025)
      GO TO 291
 1026 WRITE(6,1027)
      GO TO 291
 6002 IF(NTAPE.EQ.2.OR.NTAPE.EQ.1)GO TO 1008
 8    CALL TPWD(NTAPE,MTAPE)
 2    WRITE (6,904)
      WRITE (6,905)PROB,NV
      REWIND 2
      REWIND 1
      IERROR=0
      IF(NR) 41, 41, 42
 41   NR=1
 42   WRITE (6,919)NR
      WRITE (6,924)
      DO 43 I=1,NV
 43   WRITE (6,925)I,L(I)
      DO 4 I=1,NV
      LF(I)=L(I)
 4    LO(I)=I
      IF(NO) 7, 7, 5
    5 IF(NO-4)  6005,6005,1024
 6005 DO 6  I=1,NO
      I1=NORD(I)
      NSIZE(I)=L(I1)
 6    LO(I1)=LO(I1)+100
 7    ONR=NR
      NK=1
      DO 10 I=1,NV
 10   NK=NK*L(I)
      IF(NK.GT.7000) GO TO 7000
      OK=NK
      DF=MT
      OK1=SNGL(OK)/DF
      NK1=NK/MT
      OK2=NK1
      IF(OK1-OK2) 11,11,12
 7000 WRITE(6,7001)
      GO TO 291
 11   NCARD=NK1
      GO TO 13
 12   NCARD=NK1+1
 13   TMEAN=0.0
      ONNN=SNGL(OK*ONR)+1.0
      TOTAL=0.0
      IF(NDF) 303, 303, 300
  300 READ (5,926)FISH,NT,(N(I),TEMP(I),I=1,NT)
      SUM=Q0
      IF(SUM.EQ.FISH) GO TO 579
 578  WRITE (6,931)
      GO TO 400
 579  WRITE (6,930)
      WRITE (6,927)
      DO 301 I=1,NT
      IF(N(I)*(N(I)-11)) 301,578,578
  301 WRITE (6,928)I,N(I),TEMP(I)
  303 IF(KL.GT.0.AND.KL.LE.2)GO TO 304
      WRITE(6,4000)
      KL=1
  304 KL=KL*18
      READ (5,932)(FMT(I), I=1,KL)
      WRITE(6,1023) (FMT(I), I=1,KL)
      IF(NTAPE)479,479,480
 479  NTAPE=5
 480  IF(NR-1)14,14,17
 14   READ (NTAPE,FMT)(X(I),I=1,NK)
      IF(NDF) 580, 580, 591
 580  DO 585 I=1,NK
 585  TMEAN=TMEAN+X(I)
      GO TO 15
 591  DO 595 I=1,NK
      DO 305 II=1,NT
      DF=X(I)
      NDF=N(II)
      CONST=TEMP(II)
      CALL TRANS (DF,NDF,CONST,ONNN,IERROR,1,II)
      IF(IERROR) 100, 305, 305
 305  X(I)=DF
 595  TMEAN=TMEAN+X(I)
   15 IF(MEAN.LE.0)GO TO 695
  690 IF(MEAN-2) 6004,6004,1026
 6004  IF (NK.GT.128) GO TO 6665
	WRITE(1) (X(I),I=1,NK)
	GO TO 695
6665	NFRI=(NK+127)/128
	IF (NFRI.LE.1) GO TO 6667
	DO 6666 I=1,NFRI-1
	NSEPT=(I-1)*128+1
	NOCT=I*128
6666	WRITE(1)(X(NOVE),NOVE=NSEPT,NOCT)
6667	NSEPT=(NFRI-1)*128+1
	WRITE(1)(X(I),I=NSEPT,NK)
 695  TMEAN=TMEAN/SNGL(OK)
      DO 16 I=1,NK
      X(I)=X(I)-TMEAN
 16   TOTAL=TOTAL+X(I)*X(I)
      GO TO 30
 17   DO 18 I=1,NK
 18   X(I)=0.0
      ASSIGN 635 TO NPT
      IF(NDF.GT.0)GO TO 633
 630  ASSIGN 317 TO NPT
 633  DO 21 I=1,NR
      NX=1
      DO 20 J=1,NCARD
      READ (NTAPE,FMT)(TSUM(K),K=1,MT)
      DO 19 K=1,MT
      GO TO NPT, (317,635)
 635  DO 318 II=1,NT
      DF=TSUM(K)
      NDF=N(II)
      CONST=TEMP(II)
      CALL TRANS(DF,NDF,CONST,ONNN,IERROR,I,II)
      IF(IERROR.LT.0)GO TO 350
  318 TSUM(K)=DF
 19   CONTINUE
317	IF (MT.GT.64) GO TO 3177
	WRITE(2)(TSUM(K),K=1,MT)
	GO TO 3178
3177	NFRI=(MT+63)/64
	IF (NFRI.LE.1) GO TO 3179
	DO 3180 K=1,NFRI-1
	NSEPT=(K-1)*64+1
	NOCT=K*64
3180	WRITE(2)(TSUM(NOVE),NOVE=NSEPT,NOCT)
3179	NSEPT=(NFRI-1)*64+1
	WRITE(2)(TSUM(K),K=NSEPT,MT)
3178      DO 20 K=1,MT
      X(NX)=X(NX)+SNGL(TSUM(K))
      IF(NK-NX) 21, 21, 20
 20   NX=NX+1
 21   CONTINUE
      END FILE 2
      REWIND 2
      DO 22 I=1,NK
      TMEAN=TMEAN+X(I)
 22   X(I)=X(I)/SNGL(ONR)
      IF(MEAN) 720, 720, 710
710	IF (NK.GT.128) GO TO 71000
	WRITE(1)(X(I),I=1,NK)
	GO TO 720
71000	NFRI=(NK+127)/128
	IF (NFRI.LE.1) GO TO 71001
	DO 71002 I=1,NFRI-1
	NSEPT=(I-1)*128+1
	NOCT=I*128
71002	WRITE(1)(X(NOVE),NOVE=NSEPT,NOCT)
71001	NSEPT=(NFRI-1)*128+1
	WRITE(1)(X(I),I=NSEPT,NK)
 720  TMEAN=TMEAN/SNGL(OK*ONR)
      WITHIN=0.0
      DO 25 I=1,NR
      NX=1
      DO 24 J=1,NCARD
	IF (MT.GT.64) GO TO 2444
	READ(2)(TSUM(K),K=1,MT)
	GO TO 2445
2444	NFRI=(MT+63)/64
	IF (NFRI.LE.1) GO TO 2446
	DO 2447 K=1,NFRI-1
	NSEPT=(K-1)*64+1
	NOCT=K*64
2447	READ(2)(TSUM(NOVE),NOVE=NSEPT,NOCT)
2446	NSEPT=(NFRI-1)*64+1
	READ(2)(TSUM(K),K=NSEPT,MT)
2445      DO 24 K=1,MT
      WITHIN=WITHIN+(SNGL(TSUM(K))-X(NX))**2
      TOTAL =TOTAL +(SNGL(TSUM(K))-TMEAN)**2
      IF(NK.LE.NX)GO TO 25
 24   NX=NX+1
 25   CONTINUE
      REWIND 2
 23   DO 26 I=1,NK
 26   X(I)=X(I)-TMEAN
 30   WRITE (6,915)
      WRITE (6,910)TMEAN
      TEMP(1)=TMEAN
      IF(NV-1) 33, 33, 39
 33   SUM=TOTAL-WITHIN
      NDF=L(1)-1
      DF=NDF
      SMEAN=SNGL(SUM)/DF
      WRITE (6,921)NDF,SUM,SMEAN
      NDFZ=L(1)*NR-1
      NDF=NDFZ-NDF
      DF=NDF
      SMEAN=WITHIN/DF
      WRITE (6,922)NDF,WITHIN,SMEAN
      WRITE (6,917)NDFZ,TOTAL
      IF(NO) 730, 730, 34
 730  IF(MEAN) 100, 100, 255
 34   NDF=L(1)
      DO 35 I=1,NDF
 35   ST1(1,I)=X(I)
      GO TO 251
 39   NVM=NV-1
      FMT(1)=Q1
      FMT(2)=Q2
      FMT(3)=Q3
      FMT(4)=Q4
      FMT(5)=Q5
      FMT(6)=Q6
      FMT(7)=Q7
      FMT(8)=Q8
      FMT(9)=Q9
      FMT(10)=Q10
      FMT(11)=Q11
      FMT(12)=Q12
      FMT(13)=Q13
      FMT(14)=Q14
      DO 31 I=1,255
      TSUM(I)=0.0
 31   PQ(I)=0.0
      I5=(8-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=8-I1
      L(I3)=L(I2)
 40   LO(I3)=LO(I2)
      K9=0
      NDFZ=0
      GSUM=0.0
      WRITE (6,911)
      WRITE (6,912)
      DO 48 I=1,8
 48   MI(I)=0
      MT=1
      MT1=1
      DO 231 IJ=1,NVM
      FMT(IJ+2)=Q010HL
      MARK=0
      IJK=IJ
      JW=NVM-(IJ-1)
 50   DO 51 I=I5,8
 51   M(I)=0
      J1=I5+(NVM-JW)
      DO 52 I=I5,J1
 52   M(I)=1
      Z=1.0
 70   CALL TABLE
      IF(MARK) 205,205,231
 205  CALL XLOCAT (MEAN)
      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
      SUM=ONR*DF*SUM/OK
      K9=K9+1
      DO 204 I=1,IJK
      I4=I5+(I-1)
      ROSE=K5(I4)
 204  PQ(K9)=(PQ(K9)+ROSE)*10.0
      PQ(K9)=PQ(K9)/10.0
      I7=I6-I5
      IF(I7-1) 229, 207, 207
 207  TTSUM=0.0
      DO 220 JK=1,I7
      ICE=0
      KL=JK
      DO 209 I=I5,8
 209  MD(I)=0
      I8=8-I7
      I9=I8+(JK-1)
      DO 210 I=I8,I9
 210  MD(I)=1
      Y=1.0
 211  CALL PART (MD,I8,Y,ICE,KL)
      IF(ICE) 212, 212, 220
 212  FISH=0.0
      K=0
      DO 215 I=I8,8
      K=K+1
      IF(MD(I).LE.0)GO TO 215
 213  I4=I5+(K-1)
      ROSE=K5(I4)
      FISH=(FISH+ROSE)*10.0
 215  CONTINUE
      FISH=FISH/10.0
      DO 217 I=1, 255
      IF(PQ(I)-FISH) 217, 216, 211
 216  TTSUM=TTSUM+SNGL(TSUM(I))
      GO TO 211
 217  CONTINUE
 220  CONTINUE
      SUM=SUM-TTSUM
 229  SMEAN=SNGL(SUM)/FNDF
      WRITE (6,FMT)(K5(I),I=I5,I6),NDF,SUM,SMEAN
      NDFZ=NDFZ+NDF
      GSUM=GSUM+SNGL(SUM)
      TSUM(K9)=SUM
      GO TO 70
 231  CONTINUE
      IF(NR-1) 235, 235, 240
 235  SUM=TOTAL-GSUM
      NKDF=NK-1
      NDF=NKDF-NDFZ
      DF=NDF
      SMEAN=SNGL(SUM)/DF
      WRITE (6,916)NDF,SUM,SMEAN
      WRITE (6,917)NKDF,TOTAL
      GO TO 252
 240  NDF=1
      DO 241 I=I5,8
 241  NDF=NDF*MM(I)
      DF=NDF
      SUM=TOTAL-WITHIN-GSUM
      SMEAN=SNGL(SUM)/DF
      DO 250 I=1,NV
 250  N(I)=I
      I=NV+2
      FMT(I)=Q010HL
      WRITE (6,FMT)(N(I),I=1,NV),NDF,SUM,SMEAN
      DF=SNGL(ONR*OK-OK)
      NDF=DF
      SMEAN=WITHIN/DF
      WRITE (6,920)NDF,WITHIN,SMEAN
      DF=SNGL(ONR*OK)-1.0
      NDF=DF
      WRITE (6,917)NDF,TOTAL
 252  IF(NO) 254, 254, 251
 251  CALL FINISH
 254  IF(MEAN) 100, 100, 255
 255  CALL MEANS(PROB,TMEAN,MEAN)
      GO TO 100
 350  IF(J-NCARD)351,353,353
 351  J=J+1
      DO 352 JXX=J,NCARD
  352 READ (NTAPE,FMT)(TSUM(K),K=1,MT)
 353  IF(I-NR)354,100,100
 354  I=I+1
      DO 355 IXX=I,NR
      DO 355 JXX=1,NCARD
  355 READ (NTAPE,FMT)(TSUM(K),K=1,MT)
      GO TO 100
 900  FORMAT(A6,A2,I3,3I1,I2,5I1,8I3,23X,I2,I2)
 905  FORMAT(13H0PROBLEM NO. A2///20H NUMBER OF VARIABLESI6)
 909  FORMAT(I6,F21.5,F17.5)
 910  FORMAT(11H0GRAND MEANF20.5///)
 911  FORMAT(59H0SOURCE OF        DEGREES OF          SUMS OF          M
     1EAN)
 912  FORMAT(61H VARIATION         FREEDOM            SQUARES         SQ
     1UARES//)
 915  FORMAT(1H )
 916  FORMAT(18H RESIDUAL         I6,F22.5,F17.5)
 917  FORMAT(18H TOTAL            I6,F22.5)
 919  FORMAT(21H NUMBER OF REPLICATESI5)
 920  FORMAT(18H WITHIN REPLICATESI6,F22.5,F17.5)
 921  FORMAT(18H MEANS            I6,F22.5,F17.5)
 922  FORMAT(18H WITHIN           I6,F22.5,F17.5)
 924  FORMAT(27H0VARIABLE     NO. OF LEVELS)
 925  FORMAT(I6,11X,I4)
  926 FORMAT(A6,I1,8(I2,F6.0))
 927  FORMAT(35H0CARD NO.    TRANS CODE    CONSTANT)
 928  FORMAT(1H I5,11X,I2,8X,F10.5)
 929  FORMAT(22H0ERROR ON PROBLEM CARD)
 930  FORMAT(1H06X,21HTRANS-GENERATION CARD)
 931  FORMAT(31H0ERROR ON TRANS-GENERATION CARD)
  932 FORMAT(18A4)
 1002 FORMAT(' NUMBER OF VARIABLES INCORRECTLY SPECIFIED')
 1003 FORMAT(' NUMBER OF VARIABLE FORMAT CARDS INCORRECTLY SPECIFIED')
 1004 FORMAT(' DATA INPUT CANNOT BE FROM TAPE UNITS 1 OR 2')
 1023 FORMAT(' VARIABLE FORMAT CARD(S)'/1X,18A4)
 1025 FORMAT(' NUMBER OF VARIABLES FOR WHICH AN ORTHOGONAL BREAKDOWN IS
     1 DESIRED CANNOT EXCEED 4')
 1027 FORMAT(' COLUMN 14 OF PROBLM CARD MUST CONTAIN A 1 OR A 2 OR BE BL
     1ANK')
 4000 FORMAT(1H023X71HNUMBER OF VARIABLE FORMAT CARDS INCORRECTLY SPECIF
     1IED, ASSUMED TO BE 1.)
 7001 FORMAT('    PRODUCT OF THE CATEGORIES OR LEVELS OF ALL THE VARIAB
     1LES CANNOT EXCEED 7000.')
 9998 FORMAT(20A4)
 400  IF(MTAPE-5)402,402,401
 9999 FORMAT(10A8)
  401 REWIND MTAPE
  402 STOP
      END
C        SUBROUTINE  CONSTN FOR BMD02V               MARCH 15, 1966
      SUBROUTINE CONSTN
      DIMENSION X(7000),L(9),TEMP(12),LO(8),LM(9),LL(8),K5(9),N(8)
     1,KM(8),MM(9),MI(8),ST(6,9,9),ST1(4,9),M(8),TSUM(255),PQ(255),MD(8)
     2,NORD(4),NSIZE(4),LF(8),C(9,9),CO(9,8,9),D(9,9)
      DOUBLE PRECISION TEMP
      DOUBLE PRECISION SUM
      DOUBLE PRECISION TSUM,PQ
      COMMON  TEMP   , SUM    , TSUM   , PQ     , LO     , LM     , LL
      COMMON  ST1    , M      , X      , L      , MD     , NORD
      COMMON  NSIZE  , LF     , C      , CO     , D
      COMMON  K5     , N      , KM     , MM     , MI     , ST
      COMMON  NV     , NR     , NK     , NX     , NVM    , I5
      COMMON  MT     , MT1    , MARK   , JW     , Z      , TRASH
      COMMON  TRA    , IJK    , NO     , IN     , I2     , I3
      COMMON  NDF    , TOTAL  , NO1    , NO2    , KB1    , KB2
      DIMENSION Z1(10),Z2(10),Z3(10)
      DO 1 I=2,9
      I1=I-1
      DO 1 J=1,I1
      CALL ORTH(Z1,Z2,Z3,J,I,OK)
      DO 1 K=1,I
 1    CO(I,J,K)=Z1(K)
      RETURN
      END
      SUBROUTINE ORTH(X,W,F,N,NP,OK)
C  COMPUTES ORTHOGONAL POLYNOMIAL OF ORDER N ON NP EQUALLY SPACED POINTS
C  W(N+1)  F(N+1)  X(NP)  RESULTS IN X
      DIMENSION X(1),F(1),W(1)
      LOGICAL OK
      DATA JJKL/1/
      IF(JJKL.EQ.0) GO TO 35
      JJKL=0
      BIG=16**6-1
C BIG IS THE LARGEST ALLOWED FLOATING POINT INTEGER
C WITHOUT RISKING TRUNCATION ERROR
 35   OK=.TRUE.
      W(1)=1.
      F(1)=1.
      IF(N.LE.0) GO TO 4
      A=1.
      B=NP-1
      C=N
      D=C+1.
      DO 1 I=1,N
      AN=C*D
      AD=A*B
      A=A+1.
      B=B-1.
      C=C-1.
      D=D+1.
      F1=AD/ GCD(AD,W(I))
      F(I+1)=F1/ GCD(AN,F1)
      F1=AD/F(I+1)
      F2= GCD(W(I),F1)
 1    W(I+1)=(W(I)/F2)*(AN/(F1/F2))
      FF=F(N+1)
      N2=MOD(N,2)
      IF(N2.EQ.0) FF=-FF
      IF(N2.EQ.1) W(N+1)=-W(N+1)
      K=N
      DO 2 I=1,N
      W(K)=W(K)*FF
      FF=-FF*F(K)
 2    K=K-1
      NPM1=NP-1
      D=0.
      DO 3 I=1,NPM1
      X(I)=W(1)
      D=D+W(1)*W(1)
      NL=MIN0(N,NP-I)
      DO 3 J=1,NL
      W(J)=W(J)+W(J+1)
 3    IF(W(J).GT.BIG) OK=.FALSE.
      X(NP)=W(1)
      D=D+W(1)*W(1)
      D= SQRT(D)
      DO 101 I=1,NP
 101  X(I)=X(I)/D
      RETURN
 4    D=1./SQRT(FLOAT(NP))
      DO 5 I=1,NP
 5    X(I)=D
      RETURN
      END
      FUNCTION GCD(AA,BB)
      A=AA
      B=BB
 1    B=AMOD(B,A)
      IF(B.EQ.0.) GO TO 2
      A=AMOD(A,B)
      IF(A.NE.0.) GO TO 1
 2    GCD=A+B
      RETURN
      END
C            SUBROUTINE FINISH FOR BMD02V            MARCH 15, 1966
      SUBROUTINE FINISH
      DIMENSION X(7000),L(9),TEMP(12),LO(8),LM(9),LL(8),K5(9),N(8)
     1,KM(8),MM(9),MI(8),ST(6,9,9),ST1(4,9),M(8),TSUM(255),PQ(255),MD(8)
     2,NORD(4),NSIZE(4),LF(8),C(9,9),CO(9,8,9),D(9,9)
      DOUBLE PRECISION TEMP
      DOUBLE PRECISION SUM
      DOUBLE PRECISION TSUM,PQ
      COMMON  TEMP   , SUM    , TSUM   , PQ     , LO     , LM     , LL
      COMMON  ST1    , M      , X      , L      , MD     , NORD
      COMMON  NSIZE  , LF     , C      , CO     , D
      COMMON  K5     , N      , KM     , MM     , MI     , ST
      COMMON  NV     , NR     , NK     , NX     , NVM    , I5
      COMMON  MT     , MT1    , MARK   , JW     , Z      , TRASH
      COMMON  TRA    , IJK    , NO     , IN     , I2     , I3
      COMMON  NDF    , TOTAL  , NO1    , NO2    , KB1    , KB2
      WRITE (6,935)
      WRITE (6,936)(NORD(J), J=1,NO)
      Q000FL=NR
      DO 270 I=1,NO
      WRITE (6,935)
      K=NORD(I)
      KL=LF(K)
      KI=KL-1
      DO 253 M1=1,KI
      C(M1,1)=0.0
      DO 253 M2=1,KL
 253  C(M1,1)=C(M1,1)+CO(KL,M1,M2)*ST1(I,M2)
      NDF=NK/KL
      DF=NDF
      DO 257 J=1,KI
 257  C(J,1)=C(J,1)*C(J,1)*Q000FL/DF
      DO 267 J=1,KI
      GO TO (261, 262, 263, 264), J
 261  WRITE (6,930)K, C(1,1)
      IF(KI-2) 268, 267, 267
 262  WRITE (6,931)K,C(2,1)
      IF(KI-3) 268, 267, 267
 263  WRITE (6,932)K,C(3,1)
      IF(KI-4) 268, 267, 267
 264  REM=0.0
      DO 265 M1=4,KI
 265  REM=REM+C(M1,1)
      WRITE (6,933)K, REM
      GO TO 268
 267  CONTINUE
 268  RES=0.0
      DO 269 J=1,KI
 269  RES=RES+C(J,1)
      WRITE (6,934)K,RES
 270  CONTINUE
      IF(NO-2) 100, 360, 369
 360  I2=NSIZE(1)
      I3=NSIZE(2)
      NO1=NORD(1)
      NO2=NORD(2)
      KB1=1
      KB2=2
      IN=1
      IF(NV-2) 362, 362, 367
 362  K=0
      DO 365 I=1,I2
      DO 365 J=1,I3
      K=K+1
 365  ST(1,I,J)=X(K)
 367  CALL MATRIX
      CALL REPORT
      GO TO 100
 369  IF(NO-3) 100, 370, 379
 370  I2=NSIZE(1)
      I3=NSIZE(2)
      NO1=NORD(1)
      NO2=NORD(2)
      KB1=1
      KB2=2
      IN=1
      CALL MATRIX
      CALL REPORT
      I3=NSIZE(3)
      NO2=NORD(3)
      KB2=3
      IN=2
      CALL MATRIX
      CALL REPORT
      I2=NSIZE(2)
      NO1=NORD(2)
      KB1=2
      IN=3
      CALL MATRIX
      CALL REPORT
      GO TO 100
 379  I2=NSIZE(1)
      I3=NSIZE(2)
      NO1=NORD(1)
      NO2=NORD(2)
      KB1=1
      KB2=2
      IN=1
      CALL MATRIX
      CALL REPORT
      I3=NSIZE(3)
      NO2=NORD(3)
      KB2=3
      IN=2
      CALL MATRIX
      CALL REPORT
      I3=NSIZE(4)
      NO2=NORD(4)
      KB2=4
      IN=3
      CALL MATRIX
      CALL REPORT
      I2=NSIZE(2)
      I3=NSIZE(3)
      NO1=NORD(2)
      NO2=NORD(3)
      KB1=2
      KB2=3
      IN=4
      CALL MATRIX
      CALL REPORT
      I3=NSIZE(4)
      NO2=NORD(4)
      KB2=4
      IN=5
      CALL MATRIX
      CALL REPORT
      I2=NSIZE(3)
      NO1=NORD(3)
      KB1=3
      IN=6
      CALL MATRIX
      CALL REPORT
 930  FORMAT(I6,8H  LINEARF20.5)
 931  FORMAT(I6,11H  QUADRATICF17.5)
 932  FORMAT(I6,7H  CUBICF21.5)
 933  FORMAT(I6,11H  REMAINDERF17.5)
 934  FORMAT(I6,16H  TOTAL         F24.5)
 935  FORMAT(1H0)
 936  FORMAT(21H ORDERED VARIABLES...4I3)
 100  RETURN
      END
C            SUBROUTINE MATRIX FOR BMD02V            MARCH 15, 1966
      SUBROUTINE MATRIX
      DIMENSION X(7000),L(9),TEMP(12),LO(8),LM(9),LL(8),K5(9),N(8)
     1,KM(8),MM(9),MI(8),ST(6,9,9),ST1(4,9),M(8),TSUM(255),PQ(255),MD(8)
     2,NORD(4),NSIZE(4),LF(8),C(9,9),CO(9,8,9),D(9,9)
      DOUBLE PRECISION TEMP
      DOUBLE PRECISION SUM
      DOUBLE PRECISION TSUM,PQ
      COMMON  TEMP   , SUM    , TSUM   , PQ     , LO     , LM     , LL
      COMMON  ST1    , M      , X      , L      , MD     , NORD
      COMMON  NSIZE  , LF     , C      , CO     , D
      COMMON  K5     , N      , KM     , MM     , MI     , ST
      COMMON  NV     , NR     , NK     , NX     , NVM    , I5
      COMMON  MT     , MT1    , MARK   , JW     , Z      , TRASH
      COMMON  TRA    , IJK    , NO     , IN     , I2     , I3
      COMMON  NDF    , TOTAL  , NO1    , NO2    , KB1    , KB2
      I4=I2-1
      I5=I3-1
      DO 5 I=1,9
      DO 5 J=1,9
      C(I,J)=0.0
 5    D(I,J)=0.0
      DO 10 I=1,I4
      DO 10 J=1,I3
      DO 10 K=1,I2
 10   C(I,J)=C(I,J)+CO(I2,I,K)*ST(IN,K,J)
      DO 16 I=1,I4
      DO 16 J=1,I5
      DO 15 K=1,I3
 15   D(I,J)=D(I,J)+C(I,K)*CO(I3,J,K)
 16   D(I,J)=D(I,J)*D(I,J)
      KL=NK/(I2*I3)
      DIV=KL
      Q000FL=NR
      DIV=DIV/Q000FL
      DO 30 I=1,I4
      DO 30 J=1,I5
 30   D(I,J)=D(I,J)/DIV
      WRITE (6,908)
      WRITE (6,900)NO2
      WRITE (6,901)
      WRITE (6,902)NO1
      TOTAL=0.0
      DO 40 J=1,I5
 40   TOTAL=TOTAL+D(1,J)
      C(1,9)=TOTAL-D(1,1)-D(1,2)-D(1,3)
      WRITE (6,903)D(1,1),D(1,2),D(1,3),C(1,9),TOTAL
      TOTAL=0.0
      DO 41 J=1,I5
 41   TOTAL=TOTAL+D(2,J)
      C(2,9)=TOTAL-D(2,1)-D(2,2)-D(2,3)
      WRITE (6,904)D(2,1),D(2,2),D(2,3),C(2,9),TOTAL
      TOTAL=0.0
      DO 42 J=1,I5
 42   TOTAL=TOTAL+D(3,J)
      C(3,9)=TOTAL-D(3,1)-D(3,2)-D(3,3)
      WRITE (6,905)D(3,1),D(3,2),D(3,3),C(3,9),TOTAL
      TOTAL=0.0
      DO 46 J=1,3
      C(1,J)=0.0
       DO 45 I=1,I4
 45   C(1,J)=C(1,J)+D(I,J)
      C(2,J)=C(1,J)-D(1,J)-D(2,J)-D(3,J)
   46 TOTAL=TOTAL+C(2,J)
      C(4,9)=0.0
      IF(I5-3) 48,48,464
  464 IF(I4-3) 48,48,465
  465 DO 47 J=4,I5
      DO 47 I=4,I4
 47   C(4,9)=C(4,9)+D(I,J)
   48 TOTAL=TOTAL+C(4,9)
      WRITE (6,906)C(2,1),C(2,2),C(2,3),C(4,9),TOTAL
      C(1,4)=C(1,9)+C(2,9)+C(3,9)+C(4,9)
      TOTAL=C(1,1)+C(1,2)+C(1,3)+C(1,4)
      WRITE (6,907)C(1,1),C(1,2),C(1,3),C(1,4),TOTAL
 900  FORMAT(1H047X,8HVARIABLEI3,9H  ORDERED)
 901  FORMAT(28X,6HLINEAR7X,9HQUADRATIC9X,5HCUBIC7X,9HREMAINDER9X,5HTOTA
     1L)
 902  FORMAT(9H VARIABLEI3,9H  ORDERED)
 903  FORMAT(8X,12HLINEAR      5F15.5)
 904  FORMAT(8X,12HQUADRATIC   5F15.5)
 905  FORMAT(8X,12HCUBIC       5F15.5)
 906  FORMAT(8X,12HREMAINDER   5F15.5)
 907  FORMAT(8X,12HTOTAL       5F15.5)
 908  FORMAT(1H0)
      RETURN
      END
C             SUBROUTINE MEANS FOR BMD02V            MARCH 15, 1966
      SUBROUTINE MEANS(PROB,TMEAN,MEAN)
      DIMENSION X(7000),L(9),TEMP(12),LO(8),LM(9),LL(8),K5(9),N(8)
     1,KM(8),MM(9),MI(8),ST(6,9,9),ST1(4,9),M(8),TSUM(255),PQ(255),MD(8)
     2,NORD(4),NSIZE(4),LF(8),C(9,9),CO(9,8,9),D(9,9)
      DOUBLE PRECISION TEMP,Q17,Q18,Q19,Q20
      DOUBLE PRECISION Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9,Q10,Q11,Q12,
     1 Q13,Q14,Q15,Q16
      DOUBLE PRECISION SUM
      DOUBLE PRECISION TSUM,PQ
      COMMON  TEMP   , SUM    , TSUM   , PQ     , LO     , LM     , LL
      COMMON  ST1    , M      , X      , L      , MD     , NORD
      COMMON  NSIZE  , LF     , C      , CO     , D
      COMMON  K5     , N      , KM     , MM     , MI     , ST
      COMMON  NV     , NR     , NK     , NX     , NVM    , I5
      COMMON  MT     , MT1    , MARK   , JW     , Z      , TRASH
      COMMON  TRA    , IJK    , NO     , IN     , I2     , I3
      COMMON  NDF    , TOTAL  , NO1    , NO2    , KB1    , KB2
      END FILE 1
      REWIND 1
      WRITE (6,900)PROB
      IF(MEAN-1)300,4,3
 3    WRITE (6,901)
      DATA Q1/6HI3,   /
    4 TSUM(1)=Q1
      DATA Q2/6H2I3,  /
      TSUM(2)=Q2
      DATA Q3/6H3I3,  /
      TSUM(3)=Q3
      DATA Q4/6H4I3,  /
      TSUM(4)=Q4
      DATA Q5/6H5I3,  /
      TSUM(5)=Q5
      DATA Q6/6H6I3,  /
      TSUM(6)=Q6
      DATA Q7/6H7I3,  /
      TSUM(7)=Q7
      DATA Q8/6H8I3,  /
      TSUM(8)=Q8
      DATA Q9/6H22X,  /
      PQ(1)=Q9
      DATA Q10/6H19X,  /
      PQ(2)=Q10
      DATA Q11/6H16X,  /
      PQ(3)=Q11
      DATA Q12/6H13X,  /
      PQ(4)=Q12
      DATA Q13/6H10X,  /
      PQ(5)=Q13
      DATA Q14/6H7X,   /
      PQ(6)=Q14
      DATA Q15/6H4X,   /
      PQ(7)=Q15
      DATA Q16/6H1X,   /
      PQ(8)=Q16
      DATA Q17/6H(     /
      TEMP(1)=Q17
      DATA Q18/6H1H    /
      TEMP(2)=Q18
      TEMP(3)=TSUM(NV)
      TEMP(4)=PQ(NV)
      DATA Q19/6HF19.5,/
      TEMP(5)=Q19
      DATA Q20/6H)     /
      TEMP(6)=Q20
      IN=9-NV
      DO 5 I=1,NV
      MM(IN)=LF(I)
 5    IN=IN+1
      IN=9-NV
	IF (NK.GT.128) GO TO 1000
	READ(1)(X(I),I=1,NK)
	GO TO 1001
1000	NFRI=(NK+127)/128
	IF (NFRI.LE.1) GO TO 1002
	DO 1003 I=1,NFRI-1
	NSEPT=(I-1)*128+1
	NOCT=I*128
1003	READ(1)(X(NOVE),NOVE=NSEPT,NOCT)
1002	NSEPT=(NFRI-1)*128+1
	READ(1)(X(I),I=NSEPT,NK)
1001      I3=0
 10   N(1)=1
 20   N(2)=1
 30   N(3)=1
 40   N(4)=1
 50   N(5)=1
 60   N(6)=1
 70   N(7)=1
 80   N(8)=1
 90   I3=I3+1
      IF(MEAN-1)300,93,92
 92   WRITE (6,TEMP)(N(I), I=IN,8),X(I3)
 93   IF(N(8)-MM(8)) 110, 120, 120
 110  N(8)=N(8)+1
      GO TO 90
 120  IF(IN-8) 121, 200, 200
 121  IF(N(7)-MM(7)) 122, 130, 130
 122  N(7)=N(7)+1
      GO TO 80
 130  IF(IN-7) 131, 200, 200
 131  IF(N(6)-MM(6)) 132, 140, 140
 132  N(6)=N(6)+1
      GO TO 70
 140  IF(IN-6) 141, 200, 200
 141  IF(N(5)-MM(5)) 142, 150, 150
 142  N(5)=N(5)+1
      GO TO 60
 150  IF(IN-5) 151, 200, 200
 151  IF(N(4)-MM(4)) 152, 160, 160
 152  N(4)=N(4)+1
      GO TO 50
 160  IF(IN-4) 161, 200, 200
 161  IF(N(3)-MM(3)) 162, 170, 170
 162  N(3)=N(3)+1
      GO TO 40
 170  IF(IN-3) 171, 200, 200
 171  IF(N(2)-MM(2)) 172, 180, 180
 172  N(2)=N(2)+1
      GO TO 30
 180  IF(IN-2) 181, 200, 200
 181  IF(N(1)-MM(1)) 182, 200, 200
 182  N(1)=N(1)+1
      GO TO 20
 200  IF(NV-1) 300, 300, 205
 205  WRITE (6,902)
      WRITE (6,903)
      I2=1
      DO 220 I=1,NV
      IN=LF(I)
      SUM=NK/IN
      TRASH=SNGL(SUM)*TMEAN
      READ(1)TRA
      TRA=(TRA+TRASH)/SNGL(SUM)
      WRITE (6,904)I,I2,TRA
      DO 210 J=2,IN
      READ(1)TRA
      TRA=(TRA+TRASH)/SUM
 210  WRITE (6,905)J, TRA
      WRITE (6,906)
 220  CONTINUE
 300  REWIND 1
 900  FORMAT(13H1PROBLEM NO. A2//)
 901  FORMAT(25H0 C E L L   N U M B E R S11X,9HM E A N S)
 902  FORMAT(1H0/29H0 M A R G I N A L   M E A N S)
 903  FORMAT(23H VARIABLES   CATEGORIES13X,9HM E A N S)
 904  FORMAT(1H I6,6X,I6,7X,F19.5)
 905  FORMAT(1H 12X,I6,7X,F19.5)
 906  FORMAT(1H )
 9998 FORMAT(20A4)
      RETURN
      END
C           SUBROUTINE PART FOR BMD02V               MARCH 15, 1966
      SUBROUTINE PART (M,I5,Z,MARK,IJK)
      DIMENSION M(8)
      GO TO (71,72,73,74,75,76),IJK
   71 IF(Z.NE.1.0)GO TO 61
 60   KA=I5
      GO TO 299
 61   IF(KA-8) 130, 200, 200
   72 IF(Z.NE.1.0)GO TO 63
 62   KB=I5
      KA=I5+1
      GO TO 299
   63 IF(KA.LT.8) GO TO 130
 93   IF(KB-7) 129, 200, 200
   73 IF(Z.NE.1.0)GO TO 65
 64   KC=I5
      KB=I5+1
      KA=I5+2
      GO TO 299
   65 IF(KA.LT.8) GO TO 130
   97 IF(KB.LT.7)GO TO 129
 98   IF(KC-6) 128, 200, 200
   74 IF(Z.NE.1.0)GO TO 67
 66   KD=I5
      KC=I5+1
      KB=I5+2
      KA=I5+3
      GO TO 299
   67 IF(KA.LT.8) GO TO 130
  103 IF(KB.LT.7)GO TO 129
  104 IF(KC.LT.6)GO TO 128
 105  IF(KD-5) 127, 200, 200
   75 IF(Z.NE.1.0)GO TO 69
 68   KE=I5
      KD=I5+1
      KC=I5+2
      KB=I5+3
      KA=I5+4
      GO TO 299
   69 IF(KA.LT.8) GO TO 130
  110 IF(KB.LT.7)GO TO 129
  111 IF(KC.LT.6)GO TO 128
  112 IF(KD.LT.5)GO TO 127
 113  IF(KE-4) 126, 200, 200
   76 IF(Z.NE.1.0)GO TO 81
 80   KF=I5
      KE=I5+1
      KD=I5+2
      KC=I5+3
      KB=I5+4
      KA=I5+5
      GO TO 299
   81 IF(KA.LT.8) GO TO 130
  120 IF(KB.LT.7)GO TO 129
  121 IF(KC.LT.6)GO TO 128
  122 IF(KD.LT.5)GO TO 127
      IF(KE.LT.4) GO TO 126
      IF(KF.GE.3)GO TO 200
 125  DO 136 I=KF,8
 136  M(I)=0
      KF=KF+1
      M(KF)=1
      KE=KF+1
      M(KE)=1
 10   KD=KE+1
      M(KD)=1
 20   KC=KD+1
      M(KC)=1
 30   KB=KC+1
      M(KB)=1
 40   KA=KB+1
      M(KA)=1
      GO TO 300
 126  DO 135 I=KE,8
 135  M(I)=0
      KE=KE+1
      M(KE)=1
      GO TO 10
 127  DO 134 I=KD,8
 134  M(I)=0
      KD=KD+1
      M(KD)=1
      GO TO 20
 128  DO 133 I=KC,8
 133  M(I)=0
      KC=KC+1
      M(KC)=1
      GO TO 30
 129  DO 132 I=KB,8
 132  M(I)=0
      KB=KB+1
      M(KB)=1
      GO TO 40
 130  DO 131 I=KA,8
 131  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
C        SUBROUTINE REPORT FOR BMD02V                MARCH 15, 1966
      SUBROUTINE REPORT
      DIMENSION X(7000),L(9),TEMP(12),LO(8),LM(9),LL(8),K5(9),N(8)
     1,KM(8),MM(9),MI(8),ST(6,9,9),ST1(4,9),M(8),TSUM(255),PQ(255),MD(8)
     2,NORD(4),NSIZE(4),LF(8),C(9,9),CO(9,8,9),D(9,9)
     3,ZZ(9,9),C1(9),C2(9)
      DOUBLE PRECISION TEMP
      DOUBLE PRECISION SUM
      DOUBLE PRECISION TSUM,PQ
      COMMON  TEMP   , SUM    , TSUM   , PQ     , LO     , LM     , LL
      COMMON  ST1    , M      , X      , L      , MD     , NORD
      COMMON  NSIZE  , LF     , C      , CO     , D
      COMMON  K5     , N      , KM     , MM     , MI     , ST
      COMMON  NV     , NR     , NK     , NX     , NVM    , I5
      COMMON  MT     , MT1    , MARK   , JW     , Z      , TRASH
      COMMON  TRA    , IJK    , NO     , IN     , I2     , I3
      COMMON  NDF    , TOTAL  , NO1    , NO2    , KB1    , KB2
      M1=NK/I2
      M2=NK/I3
      M3=NK/(I2*I3)
      A1=M1
      A2=M2
      A3=M3
      DO 10 I=1,I2
      DO 10 J=1,I3
 10   ST(IN,I,J)=ST(IN,I,J)/A3
      DO 15 I=1,I2
 15   C(1,I)=ST1(KB1,I)/A1
      DO 16 I=1,I3
 16   C(2,I)=ST1(KB2,I)/A2
      TOTAL=TEMP(1)
      DO 20 J=1,I3
      DO 20 I=1,I2
 20   ST(IN,I,J)=ST(IN,I,J)-C(2,J)-C(1,I)
      WRITE (6,900)
      WRITE (6,901)NO1
      WRITE (6,902)NO2
      WRITE (6,920)
      DO 29 K=1,I2
 29   WRITE (6,904)(ST(IN,K,J), J=1,I3), C(1,K)
      WRITE (6,920)
      WRITE (6,904)(C(2,J), J=1,I3), TOTAL
 900  FORMAT(26H0TABLE OF INTERACTIONS FOR)
 901  FORMAT(13H     VARIABLEI2,7H  (ROW))
 902  FORMAT(13H     VARIABLEI2,10H  (COLUMN))
 904  FORMAT(F11.5,9F12.5/(10F12.5))
 920  FORMAT(1H )
      DO 31 I=1,I2
      DO 30 J=1,I3
 30   ZZ(I,J)=ST(IN,I,J)+C(2,J)+C(1,I)+TOTAL
 31   C1(I)=C(1,I)+TOTAL
      DO 40 J=1,I3
 40   C2(J)=C(2,J)+TOTAL
      WRITE (6,905)
 905  FORMAT(15H0TABLE OF MEANS)
      WRITE (6,920)
      DO 50 I=1,I2
 50   WRITE (6,904)(ZZ(I,J),J=1,I3),C1(I)
      WRITE (6,920)
      WRITE (6,904)(C2(J),J=1,I3),TOTAL
      RETURN
      END
C           SUBROUTINE TABLE FOR BMD02V              MARCH 15, 1966
      SUBROUTINE TABLE
      DIMENSION X(7000),L(9),TEMP(12),LO(8),LM(9),LL(8),K5(9),N(8)
     1,KM(8),MM(9),MI(8),ST(6,9,9),ST1(4,9),M(8),TSUM(255),PQ(255),MD(8)
     2,NORD(4),NSIZE(4),LF(8),C(9,9),CO(9,8,9),D(9,9)
      DOUBLE PRECISION TEMP
      DOUBLE PRECISION SUM
      DOUBLE PRECISION TSUM,PQ
      COMMON  TEMP   , SUM    , TSUM   , PQ     , LO     , LM     , LL
      COMMON  ST1    , M      , X      , L      , MD     , NORD
      COMMON  NSIZE  , LF     , C      , CO     , D
      COMMON  K5     , N      , KM     , MM     , MI     , ST
      COMMON  NV     , NR     , NK     , NX     , NVM    , I5
      COMMON  MT     , MT1    , MARK   , JW     , Z      , TRASH
      COMMON  TRA    , IJK    , NO     , IN     , I2     , I3
      COMMON  NDF    , TOTAL  , NO1    , NO2    , KB1    , KB2
      GO TO (71,72,73,74,75,76,77),IJK
   71 IF(Z.NE.1.0)GO TO 61
 60   KA=I5
      GO TO 299
 61   IF(KA-8) 143, 200, 200
   72 IF(Z.NE.1.0)GO TO 63
 62   KB=I5
      KA=I5+1
      GO TO 299
   63 IF(KA.LT.8) GO TO 143
 93   IF(KB-7) 142, 200, 200
   73 IF(Z.NE.1.0)GO TO 65
 64   KC=I5
      KB=I5+1
      KA=I5+2
      GO TO 299
   65 IF(KA.LT.8) GO TO 143
   97 IF(KB.LT.7)GO TO 142
 98   IF(KC-6) 141, 200, 200
   74 IF(Z.NE.1.0)GO TO 67
 66   KD=I5
      KC=I5+1
      KB=I5+2
      KA=I5+3
      GO TO 299
   67 IF(KA.LT.8) GO TO 143
  103 IF(KB.LT.7)GO TO 142
  104 IF(KC.LT.6)GO TO 141
 105  IF(KD-5) 140, 200, 200
   75 IF(Z.NE.1.0)GO TO 69
 68   KE=I5
      KD=I5+1
      KC=I5+2
      KB=I5+3
      KA=I5+4
      GO TO 299
   69 IF(KA.LT.8) GO TO 143
  110 IF(KB.LT.7)GO TO 142
      IF(KC.LT.6)GO TO 141
      IF(KD.LT.5)GO TO 140
 113  IF(KE-4) 139, 200, 200
   76 IF(Z.NE.1.0)GO TO 81
 80   KF=I5
      KE=I5+1
      KD=I5+2
      KC=I5+3
      KB=I5+4
      KA=I5+5
      GO TO 299
   81 IF(KA.LT.8) GO TO 143
      IF(KB.LT.7)GO TO 142
      IF(KC.LT.6)GO TO 141
      IF(KD.LT.5)GO TO 140
      IF(KE.LT.4)GO TO 139
 124  IF(KF-3) 138, 200, 200
   77 IF(Z.NE.1.0)GO TO 83
 82   KG=I5
      KF=I5+1
      KE=I5+2
      KD=I5+3
      KC=I5+4
      KB=I5+5
      KA=I5+6
      GO TO 299
   83 IF(KA.LT.8) GO TO 143
      IF(KB.LT.7)GO TO 142
      IF(KC.LT.6)GO TO 141
      IF(KD.LT.5)GO TO 140
      IF(KE.LT.4)GO TO 139
      IF(KF.LT.3)GO TO 138
 136  IF(KG-2) 137, 200, 200
 137  DO 150 I=KG,8
 150  M(I)=0
      KG=KG+1
      M(KG)=1
      KF=KG+1
      M(KF)=1
 10   KE=KF+1
      M(KE)=1
 20   KD=KE+1
      M(KD)=1
 30   KC=KD+1
      M(KC)=1
 40   KB=KC+1
      M(KB)=1
 50   KA=KB+1
      M(KA)=1
      GO TO 300
 138  DO 149 I=KF,8
 149  M(I)=0
      KF=KF+1
      M(KF)=1
      GO TO 10
 139  DO 148 I=KE,8
 148  M(I)=0
      KE=KE+1
      M(KE)=1
      GO TO 20
 140  DO 147 I=KD,8
 147  M(I)=0
      KD=KD+1
      M(KD)=1
      GO TO 30
 141  DO 146 I=KC,8
 146  M(I)=0
      KC=KC+1
      M(KC)=1
      GO TO 40
 142  DO 145 I=KB,8
 145  M(I)=0
      KB=KB+1
      M(KB)=1
      GO TO 50
  143 DO 144 I=KA,8
 144  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
C        SUBROUTINE TPWD FOR BMD02V                  MARCH 15, 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 19
   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
C           SUBROUTINE TRANS FOR BMD02V              MARCH 15, 1966
      SUBROUTINE TRANS (DF,NDF,CONST,ONNN,IERROR,I,II)
      ASN(XX)=ATAN(XX/SQRT(1.0-XX**2))
      IERROR=0
      GO TO (10,20,30,40,50,60,70,80,90,100),NDF
   10 IF(DF)99,32,8
    8 DF=SQRT(DF)
      GO TO 200
   20 IF(DF)99,11,12
   11 DF=1.0
      GO TO 200
   12 DF=SQRT(DF)+SQRT(DF+1.0)
      GO TO 200
   30 IF(DF)99,99,14
   14 DF=ALOG10(DF)
      GO TO 200
   40 DF=EXP(DF)
      GO TO 200
   50 IF(DF)99,32,17
   17 IF(DF-1.0)18,19,99
   19 DF=3.14159/2.0
      GO TO 200
   18 A=SQRT(DF)
      DF=ASN(A)
      GO TO 200
   60 A=DF/(ONNN+1.0)
      B=A+1.0/(ONNN+1.0)
      IF(A)99,23,24
   23 IF(B)99,32,27
   27 DF=ASN(SQRT(B))
      GO TO 200
   24 IF(B)99,28,29
   28 DF=ASN(SQRT(A))
      GO TO 200
   29 A=SQRT(A)
      B=SQRT(B)
      DF=ASN(A)+ASN(B)
      GO TO 200
   70 IF(DF)31,99,31
   31 DF=1.0/DF
      GO TO 200
   80 DF=DF+CONST
      GO TO 200
   90 DF=DF*CONST
      GO TO 200
  100 IF(DF)33,32,33
   32 DF=0.0
      GO TO 200
   33 DF=DF**CONST
      GO TO 200
   99 WRITE (6,900)II,I,DF
      IERROR=-99
  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.)
  200 RETURN
      END
C            SUBROUTINE XLOCAT FOR BMD02V            MARCH 15, 1966
      SUBROUTINE XLOCAT (MEAN)
      DIMENSION X(7000),L(9),TEMP(12),LO(8),LM(9),LL(8),K5(9),N(8)
     1,KM(8),MM(9),MI(8),ST(6,9,9),ST1(4,9),M(8),TSUM(255),PQ(255),MD(8)
     2,NORD(4),NSIZE(4),LF(8),C(9,9),CO(9,8,9),D(9,9)
      DOUBLE PRECISION SUM
      DOUBLE PRECISION TEMP
      DOUBLE PRECISION TSUM,PQ
      COMMON  TEMP   , SUM    , TSUM   , PQ     , LO     , LM     , LL
      COMMON  ST1    , M      , X      , L      , MD     , NORD
      COMMON  NSIZE  , LF     , C      , CO     , D
      COMMON  K5     , N      , KM     , MM     , MI     , ST
      COMMON  NV     , NR     , NK     , NX     , NVM    , I5
      COMMON  MT     , MT1    , MARK   , JW     , Z      , TRASH
      COMMON  TRA    , IJK    , NO     , IN     , I2     , I3
      COMMON  NDF    , TOTAL  , NO1    , NO2    , KB1    , KB2
      DO 300 I=1,8
 300  N(I)=0
      KI=0
      K=1
      DO 302 I=I5,8
      KI=KI+1
      IF(M(I)) 301, 301, 302
 301  N(K)=KI
      K=K+1
 302  CONTINUE
      DO 303 I=I5,8
      MM(I)=L(I)-1
 303  LM(I)=LO(I)
      DO 305 I=1,NV
      K=I5+(I-1)
 305  K5(K)=I
      DO 310 I=1,JW
      DO 309 J=I5,8
      IF(N(I).NE.K5(J))GO TO 309
 306  K5(9)=K5(J)
      LM(9)=LM(J)
      MM(9)=MM(J)
      DO 307 J2=J,8
      K5(J2)=K5(J2+1)
      LM(J2)=LM(J2+1)
 307  MM(J2)=MM(J2+1)
      GO TO 310
 309  CONTINUE
 310  CONTINUE
      SUM=0.0
      TRASH=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
 357  N(7)=0
 358  N(8)=0
 359  DO 360 J=I5,8
      KK=K5(J)
 360  KM(KK)=N(J)
      LX=1
      DO 361 J=1,NV
 361  LX=LX+KM(J)*LL(J)
      TRASH=TRASH+X(LX)
      IF(N(8).GE.MM(8))GO TO 363
 362  N(8)=N(8)+1
      GO TO 359
 363  IF(JW-1) 364,364,370
 364  SUM=SUM+TRASH*TRASH
      TRA=TRASH
      TRASH=0.0
      IF(MEAN.LE.0.OR.JW.NE.NVM)GO TO 705
  702 WRITE(1)TRA
 705  IF(NV-3) 365, 367, 370
  365 IF(LM(7).LE.100)GO TO 370
 366  N1=N(7)+1
      ST1(MT1,N1)=TRA
      MI(1)=1
      GO TO 370
  367 IF(LM(6).LE.100.OR.LM(7).LE.100)GO TO 370
 369  N1=N(6)+1
      N2=N(7)+1
      ST(MT,N1,N2)=TRA
      MI(1)=2
 370  IF(N(7)-MM(7)) 371,372,372
 371  N(7)=N(7)+1
      GO TO 358
 372  IF(JW-2) 373,375,381
 373  SUM=SUM+TRASH*TRASH
      IF(MI(1)-1) 501, 374, 381
 501  IF(NV-2) 70, 70, 381
 374  MI(1)=0
      MT1=MT1+1
      GO TO 70
 375  SUM=SUM+TRASH*TRASH
      TRA=TRASH
      TRASH=0.0
      IF(MEAN.LE.0.OR.JW.NE.NVM)GO TO 715
712	WRITE(1) TRA
 715  IF(NV-4) 376,378,381
  376 IF(LM(6).LE.100)GO TO 381
 377  N1=N(6)+1
      ST1(MT1,N1)=TRA
      MI(2)=1
      GO TO 381
  378 IF(LM(5).LE.100.OR.LM(6).LE.100)GO TO 381
 380  N1=N(5)+1
      N2=N(6)+1
      ST(MT,N1,N2)=TRA
      MI(2)=2
 381  IF(N(6)-MM(6)) 382,383, 383
 382  N(6)=N(6)+1
      GO TO 357
 383  IF(JW-3) 384, 388, 394
 384  SUM=SUM+TRASH*TRASH
      IF(MI(1)-2) 385, 387, 387
 385  IF(MI(2)-1) 502, 386, 394
 502  IF(NV-3) 70, 70, 394
 386  MI(2)=0
      MT1=MT1+1
      GO TO 70
 387  MI(1)=0
      MT=MT+1
      GO TO 70
 388  SUM=SUM+TRASH*TRASH
      TRA=TRASH
      TRASH=0.0
      IF(MEAN.LE.0.OR.JW.NE.NVM)GO TO 725
  722 WRITE(1)TRA
 725  IF(NV-5) 389, 391,394
  389 IF(LM(5).LE.100)GO TO 394
 390  N1=N(5)+1
      ST1(MT1,N1)=TRA
      MI(3)=1
      GO TO 394
  391 IF(LM(4).LE.100.OR.LM(5).LE.100)GO TO 394
 393  N1=N(4)+1
      N2=N(5)+1
      ST(MT,N1,N2)=TRA
      MI(3)=2
 394  IF(N(5)-MM(5)) 395,396,396
 395  N(5)=N(5)+1
      GO TO 356
 396  IF(JW-4) 397, 401, 407
 397  SUM=SUM+TRASH*TRASH
      IF(MI(2)-2) 398,400, 400
 398  IF(MI(3)-1) 503, 399, 407
 503  IF(NV-4) 70, 70, 407
 399  MI(3)=0
      MT1=MT1+1
      GO TO 70
 400  MI(2)=0
      MT=MT+1
      GO TO 70
 401  SUM=SUM+TRASH*TRASH
      TRA=TRASH
      TRASH=0.0
      IF(MEAN.LE.0.OR.JW.NE.NVM)GO TO 735
  732 WRITE(1)TRA
 735  IF(NV-6) 402, 404, 407
  402 IF(LM(4).LE.100)GO TO 407
 403  N1=N(4)+1
      ST1(MT1,N1)=TRA
      MI(4)=1
      GO TO 407
  404 IF(LM(3).LE.100.OR.LM(4).LE.100)GO TO 407
 406  N1=N(3)+1
      N2=N(4)+1
      ST(MT,N1,N2)=TRA
      MI(4)=2
 407  IF(N(4)-MM(4)) 408,409,409
 408  N(4)=N(4)+1
      GO TO 355
 409  IF(JW-5) 410,414,420
 410  SUM=SUM+TRASH*TRASH
      IF(MI(3)-2) 411,413,413
 411  IF(MI(4)-1) 504, 412, 420
 504  IF(NV-5) 70, 70, 420
 412  MI(4)=0
      MT1=MT1+1
      GO TO 70
 413  MI(3)=0
      MT=MT+1
      GO TO 70
 414  SUM=SUM+TRASH*TRASH
      TRA=TRASH
      TRASH=0.0
      IF(MEAN.LE.0.OR.JW.NE.NVM)GO TO 745
  742 WRITE(1)TRA
 745  IF(NV-7) 415, 417, 420
  415 IF(LM(3).LE.100)GO TO 420
 416  N1=N(3)+1
      ST1(MT1,N1)=TRA
      MI(5)=1
      GO TO 420
  417 IF(LM(2).LE.100.OR.LM(3).LE.100)GO TO 420
 419  N1=N(2)+1
      N2=N(3)+1
      ST(MT,N1,N2)=TRA
      MI(5)=2
 420  IF(N(3)-MM(3)) 421,422,422
 421  N(3)=N(3)+1
      GO TO 354
 422  IF(JW-6) 423,427,433
 423  SUM=SUM+TRASH*TRASH
      IF(MI(4)-2) 424,426,426
 424  IF(MI(5)-1) 505, 425, 433
 505  IF(NV-6) 70, 70, 433
 425  MI(5)=0
      MT1=MT1+1
      GO TO 70
 426  MI(4)=0
      MT=MT+1
      GO TO 70
 427  SUM=SUM+TRASH*TRASH
      TRA=TRASH
      TRASH=0.0
      IF(MEAN.LE.0.OR.JW.NE.NVM)GO TO 755
  752 WRITE(1)TRA
 755  IF(NV-8) 428,430,430
  428 IF(LM(2).LE.100)GO TO 433
 429  N1=N(2)+1
      ST1(MT1,N1)=TRA
      MI(6)=1
      GO TO 433
  430 IF(LM(1).LE.100.OR.LM(2).LE.100)GO TO 433
 432  N1=N(1)+1
      N2=N(2)+1
      ST(MT,N1,N2)=TRA
      MI(6)=2
 433  IF(N(2)-MM(2)) 434,435,435
 434  N(2)=N(2)+1
      GO TO 353
 435  IF(JW-7) 436,440,440
 436  SUM=SUM+TRASH*TRASH
      IF(MI(5)-2) 437,439,439
 437  IF(MI(6)-1) 506, 438, 443
 506  IF(NV-7) 70, 70, 443
 438  MI(6)=0
      MT1=MT1+1
      GO TO 70
 439  MI(5)=0
      MT=MT+1
      GO TO 70
 440  SUM=SUM+TRASH*TRASH
      TRA=TRASH
      TRASH=0.0
      IF(MEAN.LE.0.OR.JW.NE.NVM)GO TO 765
  762 WRITE(1)TRA
  765 IF(NV.LT.8)GO TO 70
      IF(LM(1).LE.100)GO TO 443
 442  N1=N(1)+1
      ST1(MT1,N1)=TRA
      MI(7)=1
 443  IF(N(1)-MM(1)) 444,445,445
 444  N(1)=N(1)+1
      GO TO 352
 445  IF(MI(6)-2) 446,448,448
  446 IF(MI(7).LT.1)GO TO 70
 447  MI(7)=0
      MT1=MT1+1
      GO TO 70
 448  MI(6)=0
      MT=MT+1
 70   RETURN
 9998 FORMAT(20A4)
      END