PDP-10 Archive: decus/20-0137/bmd/bmd05v.for from decuslib20-05

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0137/bmd/bmd05v.for
There is 1 other file named bmd05v.for in the archive. Click here to see a list.
C             GENERAL LINEAR HYPOTHESIS               JUNE 24, 1966
C        THIS IS A SIFTED VERSION OF BMD05V ORIGINALLY WRITTEN IN
C        FORTRAN II. SOME MODIFICATIONS WERE MADE TO MAKE IT OPERABLE
C        AND SLIGHTLY MORE EFFICIENT THAN THE SIFTED VERSION.
      DIMENSION S(41,43),ND(41),T(41,43),A(43),B(41),MP(41),MA(41,44),
     1SUM(44),ID(44),X(41,43),IFF(2,44),COE(41,44),P(1060),SU(44),
     2AM(41,44),FMT(90),NEWA(44),LCODE(41),LVA(41),BNEW(41)
      DOUBLE PRECISION AA1,AA2,AA3,AA4,AA5,AA6
      COMMON  FMT    , AM     , COE    , MA     , IFF
      COMMON  X      , P      , SU     , N      , NP     , NH
      COMMON  S      , T      , A      , MP     , SUM    , ID
      COMMON  NO     , CON    , JUNK   , NCO    , NR
      EQUIVALENCE (LCODE,SU),(LVA,AM),(BNEW,COE),(NEWA,MA,NV),(IFF(1),
     1ND),(IFF(59),B)
C
  901 FORMAT(49H1BMD05V - GENERAL LINEAR HYPOTHESIS - VERSION OF      
     118HJUNE 24, 1966     ,/
     241H HEALTH SCIENCES COMPUTING FACILITY, UCLA//)
C
      DATA BLANK/'    '/
      DATA AA2,AA3,AA4,AA5,AA6/6HPROBLM,6HDESIGN,6HHYPOTH,6HFINISH,
     16HTRNGEN/
      DATA Q005HL/4H(I6,/
      DATA Q006HL/4H 6X,/
      DATA Q007HL/4HF18./
      DATA Q008HL/4H5  )/
      DATA Q009HL/4HI2, /
      DATA Q010HL/4H2I,//
      MTAPE = 5
	CALL USAGEB('BMD05V')
      CON=1.0E-6
      REWIND 2
 5    ID(1)=0
      IX=1
      MP(1)=0
      NVG=0
      ASSIGN 130 TO NAB
      READ (5,900)AA1,PROB,N,NP,NCO,NH,NVG,ONNN,NA,NTAPE,L1
      KZZZ=0
      IF(AA1  .EQ.  AA2)     GO TO 9
    6  IF(AA1.EQ.AA5)GO TO 500
      WRITE(6,945)
945   FORMAT(87H0PEOBLM OR FINISH IS PUNCHED WRONG ON THE PROPER CARD OR
     1 EITHER CARD IS OUT OF SEQUENCE)
      GO TO 500
  551 WRITE(6,951)IJ
  951 FORMAT(43H0THE NUMBER OF REPLICATES ILLEGAL IN NUMBER,I4,12H DESIG
     1N CARD)
      GO TO 500
  552 WRITE(6,952)
  952 FORMAT(45H0THE NUMBER OF TRNGEN CARDS CAN NOT EXCEED 60)
      GO TO 500
  553 WRITE(6,953)
  953 FORMAT(39H0ILLEGAL NUMBER OF SETS OF DESIGN CARDS)
      GO TO 500
 7001 WRITE (6,940)
      GO TO 500
 7002 WRITE(6,941)
      GO TO 500
 7003 WRITE(6,942)
      GO TO 500
 7004 WRITE(6,943)
      GO TO 500
    9 IF(N-1)553,10,10
   10 IF(NP*(NP-41)) 6001,7001,7001
 6001 IF((NCO+NP)*(NCO+NP-41)) 6002,7002,7002
 6002 IF(NH*(NH-58)) 6004,7003,7003
 6004 IF(NTAPE-2) 8,7004,8
 8    CALL TPWD(NTAPE,MTAPE)
      WRITE (6,901)
      WRITE (6,902)PROB,N
      NCN=NCO+1
      IF(NVG) 11, 11, 310
 310  WRITE (6,937)
      WRITE (6,938)
      NTRGOF=0
      IF(NVG.GT.40)GO TO 552
      DO 313 I=1,NVG
      READ (5,936)AA1,NEWA(I),LCODE(I),LVA(I),BNEW(I)
      IF(  AA1  .EQ.  AA6)     GO TO 6313
  311 WRITE (6,905)I
      GO TO 6008
 6313 IF(LCODE(I)*(LCODE(I)-15))6315,6315,6006
 6315 WRITE (6,939)I,NEWA(I),LCODE(I),LVA(I),BNEW(I)
      IF(NCO)312,312,313
  312 IF(-((NEWA(I)-1)*(LVA(I)-1)))6005,3125,6005
 6005 WRITE (6,920)
      NEWA(I)=1
      LVA(I)=1
      GO TO 313
 3125 IF(10-LCODE(I))3126,313,313
 3126 BNEW(I)=1.0
      GO TO 313
 6006 WRITE (6,6007)I
 6008 NTRGOF=NTRGOF+1
      WRITE (6,915)
  313 CONTINUE
      IF(NTRGOF) 11,11,500
 11   NP1=NP
      ONNN=ONNN+1.0
      KM=NP+1
      N1=KM+NCO
      NP=N1-1
      NPP=NP
      IF(L1.GT.0.AND.L1.LE.5)GO TO 12
      L1=1
      WRITE(6,4000)
 12   L1=18*L1
      READ (5,931)(FMT(I), I=1,L1)
      WRITE (6,903)NP
      WRITE (6,929)
      WRITE(6,932)(FMT(I),I=1,L1)
      JX=NH+3
      DO 370 J=1,JX
 370  SUM(J)=0.0
      N2=N1+1
      DO 15 J=1,N1
      DO 15 I=1,NP
 15   S(I,J)=0.0
      WRITE (6,933)
      L1=N1
      IERROR=0
      N5=21
      IF(NP1-21)163,165,165
  163 N5=NP1
  165 DO 35 IJ=1,N
      N4=N5
      READ (5,904)AA1,A(1),(P(I),I=1,N4)
  334 IF(AA1.NE.AA3)GO TO 550
      IF((A(1)-1.0)*(99.0-A(1)))551,335,335
  335 IF(N4-NP1)337,339,339
  337 N3=N4+1
      N4=N4+22
      IF(NP1-N4)338,3385,3385
  338 N4=NP1
 3385 READ (5,904)AA1,(P(I),I=N3,N4)
      GO TO 334
 339  IF(IERROR)345,340,340
 340  DO 36 I=1,NP1
 36   ND(I)=P(I)
      IF(NP1-30)37,37,38
 37   WRITE (6,934)IJ, (ND(I), I=1,NP1)
      GO TO 39
   38 WRITE (6,934)IJ,(ND(I),I=1,30)
      WRITE (6,935)(ND(I),I=31,NP1)
 39   NR=A(1)
      KZZZ=1
      WRITE(2)NR
      ID(1)=ID(1)+NR
 345  IF(NCO) 17, 17, 22
 17   L2=NP+NR
      READ (MTAPE,FMT)(P(I),I=L1,L2)
      IF(IERROR)35,350,350
  350 IF(-NVG)18,2005,2005
   18 DO 19 I=L1,L2
      T(1,1) =P(I)
      CALL TRANS(NVG,ONNN,IJ,IERROR)
   19 P(I)=T(1,1)
      KZZZ=1
 2005 WRITE(2)(P(I),I=L1,L2)
      DO 21 I=L1,L2
 21   SUM(1)=SUM(1)+P(I)*P(I)
      DO 25 J=1,NP
      DO 25 I=1,NP
 25   S(I,J)=S(I,J)+(P(I)*P(J))*A(1)
      DO 30 I=L1,L2
      DO 30 J=1,NP
 30   S(J,N1)=S(J,N1)+P(J)*P(I)
      GO TO 35
 22   DO 34 IK=1,NR
      READ (MTAPE,FMT)(P(I),I=KM,L1)
      IF(IERROR)34,355,355
 355  NO=0
      DO 24 I=KM,L1
      NO=NO+1
 24   T(1,NO)=P(I)
      IF(NVG)375,375,26
 26   CALL TRANS(NVG,ONNN,IJ,IERROR)
      NO=0
      DO 23 I=KM,L1
      NO=NO+1
 23   P(I)=T(1,NO)
 375  CONTINUE
      KZZZ=1
      WRITE(2)(P(I),I=KM,L1)
      SUM(1)=SUM(1)+P(L1)*P(L1)
      DO 32 J=1,NP
      DO 32 I=1,NP
 32   S(I,J)=S(I,J)+P(I)*P(J)
      DO 33 J=1,NP
 33   S(J,N1)=S(J,N1)+P(J)*P(L1)
 34   CONTINUE
 35   CONTINUE
      IF(KZZZ)358,358,359
  359 END FILE 2
      REWIND 2
  358 IF(IERROR)360,380,380
 360  DO 365 J=1,NH
 365  READ (5,907)AA1,(MP(I), I=1,NPP)
      GO TO 5
 380  DO 13 J=1,JX
      SU(J)=0.0
      DO 13 I=1,NP
      AM(I,J)=0.0
 13   COE(I,J)=0.0
      DO 40 I=1,NP
 40   S(I,N2)=S(I,N1)
      DO 45 J=1,N2
      DO 45 I=1,NP
 45   T(I,J)=S(I,J)
      DO 46 I=1,NP
      DO 46 J=1,N1
 46   X(I,J)=T(I,J)
      L1 = NPP + 4
      DO 48  I = 1,L1
 48   FMT(I)=BLANK
      FMT(1)=Q005HL
      FMT(2)=Q006HL
      L1=NPP+3
      FMT(L1)=Q007HL
      L1=L1+1
      FMT(L1)=Q008HL
      CALL MATRIX (N1,N2)
      IF(-NP)80,80,360
   80 CALL PUNCH
      DO 85 I=1,NP
 85   MP(I)=0
      ASSIGN 86 TO NNN
      GO TO 157
 86   DO 87 I=1,NP
 87   MP(I)=1
      ASSIGN 121 TO NNN
      M1=N1
      M2=N2
      NT=0
      GO TO 99
 90   NT=NT+1
      NO=NPP
      READ (5,907)AA1,(MP(I), I=1,NO)
      IF(AA1.EQ.AA4)GO TO 70
 336  WRITE (6,909)AA4,NT
      GO TO 500
 70   NP=0
      DO 72 I=1,NO
      IF(MP(I)) 72, 72, 71
 71   NP=NP+1
      ND(NP)=I
 72   CONTINUE
      M1=NP+1
      ND(M1)=N1
      DO 75 J=1,M1
      KK=ND(J)
      DO 75 I=1,NP
      MM=ND(I)
 75   T(I,J)=S(MM,KK)
      M2=M1+1
      DO 77 I=1,NP
 77   T(I,M2)=T(I,M1)
      DO 79 J=1,M1
      DO 79 I=1,NP
 79   X(I,J)=T(I,J)
      CALL MATRIX (M1,M2)
 99   IX=IX+1
      DO 100 I=1,NP
 100  SU(IX)=SU(IX)+B(I)*X(I,M1)
      SUM(IX)=SUM(1)-SU(IX)
      ID(IX)=ID(1)-(NP-JUNK)
      IF(NA) 145, 145, 116
 116  DO 140 I=1,NP
      A(I)=0.0
      DO 140 J=1,NP
 140  A(I)=A(I)+X(I,J)*B(J)
      DO 141 I=1,NP
 141  A(I)=A(I)-X(I,M1)
 145  KK=0
      DO 152 I=1,NPP
      IF(MP(I)) 152, 152, 151
 151  KK=KK+1
      AM(I,IX)=A(KK)
      COE(I,IX)=B(KK)
 152  CONTINUE
 157  DO 158 I=1,NPP
 158  MA(I,IX)=MP(I)
      GO TO NNN, (86,121)
 121  IF(NT-NH) 90, 125, 125
 125  GO TO NAB, (130, 200)
 130  ASSIGN 200 TO NAB
      DO 135 J=2,NPP
 135  MP(J)=0
      MP(1)=1
      NP=1
      T(1,1)=S(1,1)
      M1=2
      M2=3
      T(1,M1)=S(1,N1)
      T(1,M2)=S(1,N2)
      X(1,1)=T(1,1)
      X(1,2)=T(1,2)
      CALL MATRIX (M1,M2)
      GO TO 99
 200   A2=ID(2)
      DO 205 I=3,IX
      IFF(1,I)=ID(I)-ID(2)
      IFF(2,I)=ID(2)
       A1=IFF(1,I)
 205  P(I)=( A2/ A1)*((SUM(I)-SUM(2))/SUM(2))
      WRITE (6,925)
      WRITE (6,908)
      DO 207 I=1,NPP
      FMT(I+2)=Q009HL
      IF(MOD(I,50).EQ.0)FMT(I+2)=Q010HL
207   CONTINUE
      DO 210 I=1,IX
 210  WRITE (6,FMT)I, (MA(J,I),J=1,NPP),SU(I)
      WRITE (6,925)
      WRITE (6,910)
      L1=1
      L2=0
      JK=IX
 216  IF(JK-6) 220, 220, 225
 220  L2=L2+JK
      GO TO 230
 225  L2=L2+6
 230  WRITE (6,912)( I, I=L1,L2)
      WRITE (6,913)
      DO 235 I=1,NPP
 235  WRITE (6,911)I, (COE(I,J), J=L1,L2)
      WRITE (6,914)(SUM(I), I=L1,L2)
      WRITE (6,916)
      WRITE (6,917)(ID(J), J=L1,L2)
      WRITE (6,918)
      IF(L1-1) 240, 240, 243
 240  WRITE (6,919)(P(J), J=3,L2)
      GO TO 245
 243  WRITE (6,926)(P(J), J=L1,L2)
 245  WRITE (6,916)
      IF(L1-1) 250, 250, 253
 250  WRITE (6,921)(IFF(1,I),IFF(2,I), I=3,L2)
      GO TO 260
 253  WRITE (6,927)(IFF(1,I),IFF(2,I), I=L1,L2)
 260  WRITE (6,922)
      JK=JK-6
      IF(JK) 270, 270, 265
 265  L1=L1+6
      GO TO 216
 270  IF(NA) 5, 5, 275
 275  WRITE (6,923)
      L1=1
      L2=0
      JK=IX
 276  IF(JK-6) 280, 280, 285
 280  L2=L2+JK
      GO TO 290
 285  L2=L2+6
 290  IF(L1-1) 295, 295, 300
 295  DO 296 I=1,NPP
 296  WRITE (6,924)I, (AM(I,J), J=2,L2)
      GO TO 303
 300  DO 301 I=1,NPP
 301  WRITE (6,930)I, (AM(I,J), J=L1,L2)
 303  JK=JK-6
      IF(JK) 5, 5, 305
 305  L1=L1+6
      WRITE (6,925)
      GO TO 276
 550  WRITE (6,909)AA3,IJ
      GO TO 500
 900  FORMAT(A6,A2,I3,4I2,F6.0,I2,41X,I2,I2)
 902  FORMAT(17H0PROBLEM NUMBER  A2//27H NUMBER OF DESIGN CARD SETSI6)
  903 FORMAT(32H0NUMBER OF INDEPENDENT VARIABLES I6//)
  904 FORMAT(A6,22F3.0)
 905  FORMAT(31H0ERROR ON TRANS-GENERATION CARDI4)
 906  FORMAT(72I1)
 907  FORMAT(A6,66I1)
 908  FORMAT(55H0HYPOTHESES AND SUMS OF SQUARES EXPLAINED BY HYPOTHESES/
     1/)
 909  FORMAT(1H0,24X,A6,5H CARD,I4,52H MISPUNCHED OR OUT OF ORDER. PROGR
     1AM CANNOT PROCEED.)
 910  FORMAT(26H0ESTIMATES OF COEFFICIENTS/35X,19HH Y P O T H E S I S)
 911  FORMAT(I6,4X6F16.5)
 912  FORMAT(1H04X6I16/(5X6I16))
 913  FORMAT(9H VARIABLE)
 914  FORMAT(9H0RESIDUAL/9H SUM SQS.F17.5,5F16.5)
  915 FORMAT(24H0PROGRAM WILL TERMINATE.)
 916  FORMAT(11H0DEGREES OF)
 917  FORMAT(11H FREEDOM OFI10,5I16)
 918  FORMAT(10H RESIDUALS)
 919  FORMAT(10H0F TESTS  32X,4F16.5)
  920 FORMAT(1H0,23X,71HALL TRANSGENERATION CARD VARIABLES MUST BE 1 FOR
     1 THE NO COVARIATE CASE./26X,66HTHE ABOVE CARD IS INCORRECT. THE VA
     2RIABLES WILL BE SET EQUAL TO 1.)
  921 FORMAT(11H FREEDOM OF32X,4(I9,1H ,I4,2H  ))
 922  FORMAT(8H F TESTS/1H0)
 923  FORMAT(25H0ACCURACY OF COEFFICIENTS)
 924  FORMAT(I6,20X,5F16.7)
 925  FORMAT(1H0)
 926  FORMAT(10H0F TESTS  6F16.5)
 927  FORMAT(11H FREEDOM OF6(I9,1H I4,2H  ))
  929 FORMAT(24H0VARIABLE FORMAT CARD(S))
 930  FORMAT(I6,4X,6F16.7)
931   FORMAT(18A4)
932   FORMAT(1X,18A4)
 933  FORMAT(///7H0DESIGN)
  934 FORMAT(1X,I4,3X,30I3)
  935 FORMAT(8X,30I3)
 936  FORMAT(A6,I3,I2,I3,F6.0)
 937  FORMAT(1H06X,21HTRANS-GENERATION CARD)
 938  FORMAT(46H0CARD    NEW     TRANS    ORIG.   ORIG. VAR(B)/45H  NO. 
     1VARIABLE   CODE    VAR(A)   OR CONSTANT)
 939  FORMAT(2H  I2,I8,2I9,4X,F10.5)
  940 FORMAT(38H0NUMBER OF DESIGN VARIABLES IS TOO BIG)
  941 FORMAT(32H0NUMBER OF COVARIATES IS TOO BIG)
  942 FORMAT(38H0NUMBER OF HYPOTHESIS CARDS IS TOO BIG)
  943 FORMAT(47H0TAPE UNIT 2 CAN NOT BE SPECIFIED AS INPUT UNIT)
 4000 FORMAT(1H023X71HNUMBER OF VARIABLE FORMAT CARDS INCORRECTLY SPECIF
     1IED, ASSUMED TO BE 1.)
 6007 FORMAT(47H0ILLEGAL TRANSGENERATION CODE SPECIFIED ON CARD,I3)
 9876 FORMAT(20A4)
 500  IF(MTAPE-5)503,504,503
  503 REWIND MTAPE
  504 STOP
      END
C             SUBROUTINE MATRIX FOR BMD05V            JUNE 24, 1966
      SUBROUTINE MATRIX (N1,N2)
      DIMENSION S(41,43),ND(41),T(41,43),A(43),B(41),MP(41),MA(41,44),
     1SUM(44),ID(44),X(41,43),IFF(2,44),COE(41,44),P(1060),SU(44),
     2AM(41,44),FMT(90),NEWA(44),LCODE(41),LVA(41),BNEW(41)
      COMMON  FMT    , AM     , COE    , MA     , IFF
      COMMON  X      , P      , SU     , N      , NP     , NH
      COMMON  S      , T      , A      , MP     , SUM    , ID
      COMMON  NO     , CON    , JUNK   , NCO    , NR
      EQUIVALENCE (LCODE,SU),(LVA,AM),(BNEW,COE),(NEWA,MA,NV),(IFF(1),
     1ND),(IFF(59),B)
      JUNK=0
      DO 12 I=1,NP
 12   B(I)=0.0
      IJ=0
      NM=NP-1
 46   IJ=IJ+1
      IF(NP-IJ)465,467,467
  465 WRITE (6,4000)
      NP=-NP
      GO TO 90
  467 NO=IJ
      BIG=ABS(T(IJ,IJ))
      DO 50 I=IJ,NP
      IF(BIG-ABS(T(I,IJ))) 47, 50, 50
 47   NO=I
      BIG=ABS(T(I,IJ))
 50   CONTINUE
      IF(BIG-CON) 51, 51, 63
 51   B(IJ)=1.0
      JUNK=JUNK+1
      GO TO 46
 49   JUNK=JUNK+1
 52   K=NP
      KM=K-1
      DO 55 I=1,KM
      SUK=0.0
      KP=K-I
      IF(B(KP)-1.0) 53, 56, 56
 56   B(KP)=0.0
      GO TO 55
 53   KQ=KP+1
      DO 54 J=KQ,K
 54   SUK=SUK+T(KP,J)*B(J)
      B(KP)=T(KP,N1)-SUK
 55   CONTINUE
      GO TO 90
 63   IF(NO-IJ) 66, 66, 64
 64   DO 65 J=IJ,N2
      AA=T(IJ,J)
      T(IJ,J)=T(NO,J)
 65   T(NO,J)=AA
 66   POV=T(IJ,IJ)
      IF(NP.EQ.1)GO TO 82
      DO 70 J=IJ,N1
 70   T(IJ,J)=T(IJ,J)/POV
      K=IJ+1
      DO 75 I=K,NP
      DO 75 J=K,N1
 75   T(I,J)=T(I,J)-T(I,IJ)*T(IJ,J)
      IF(IJ-NM) 46, 80, 80
 80   IF(ABS(T(NP,NP))-CON) 49, 49, 85
 85   B(NP)=T(NP,N1)/T(NP,NP)
      GO TO 52
   82 B(1)=T(1,2)/POV
 90   RETURN
 4000 FORMAT(1H0,9X,100H** ERROR ** SINGULAR DESIGN MATRIX. PROGRAM CANN
     1OT CONTINUE AND GOES TO NEXT PROBLEM OR FINISH CARD.)
      END
C             SUBROUTINE PUNCH FOR BMD05V             JUNE 24, 1966
      SUBROUTINE PUNCH
      DIMENSION S(41,43),ND(41),T(41,43),A(43),B(41),MP(41),MA(41,44),
     1SUM(44),ID(44),X(41,43),IFF(2,44),COE(41,44),P(1060),SU(44),
     2AM(41,44),FMT(90),NEWA(44),LCODE(41),LVA(41),BNEW(41)
      COMMON  FMT    , AM     , COE    , MA     , IFF
      COMMON  X      , P      , SU     , N      , NP     , NH
      COMMON  S      , T      , A      , MP     , SUM    , ID
      COMMON  NO     , CON    , JUNK   , NCO    , NR
      EQUIVALENCE (LCODE,SU),(LVA,AM),(BNEW,COE),(NEWA,MA,NV),(IFF(1),
     1ND),(IFF(59),B)
      IF(NCO) 10, 10, 40
 10   WRITE (6,900)
      DO 35 IJ=1,N
      READ(2)NR
      READ(2) (P(I),I=1,NR)
      IF(NR-1) 15, 15, 20
 15   A(3)=P(1)
      A(4)=0.0
      GO TO 30
 20   A(1)=0.0
      A(2)=0.0
      Q000FL=NR
      DO 25 I=1,NR
      A(1)=A(1)+P(I)
 25   A(2)=A(2)+P(I)**2
      A(3)=A(1)/Q000FL
      A(4)=SQRT((Q000FL*A(2)-A(1)**2)/(Q000FL*(Q000FL-1.0)))
 30   WRITE (6,903)IJ,NR,A(3),A(4)
 35   CONTINUE
      GO TO 120
 40   NNCO=NCO+1
      WRITE (6,902)(I,I=1,NCO)
      DO 115 IJ=1,N
      MCO=NCO
      DO 45 I=1,NCO
 45   T(I,1)=0.0
      A(1)=0.0
      A(2)=0.0
      READ(2)NR
      DO 55 I=1,NR
      READ(2)(P(J),J=1,NNCO)
      DO 50 J=1,NCO
 50   T(J,1)=T(J,1)+P(J)
      A(1)=A(1)+P(NNCO)
 55   A(2)=A(2)+P(NNCO)**2
      IF(NR-1) 60, 60, 65
 60   A(3)=A(1)
      A(4)=0.0
      GO TO 75
 65   Q000FL=NR
      DO 70 I=1,NCO
 70   T(I,1)=T(I,1)/Q000FL
      A(3)=A(1)/Q000FL
      A(4)=SQRT((Q000FL*A(2)-A(1)**2)/(Q000FL*(Q000FL-1.0)))
 75   L1=1
      L2=0
 78   IF(MCO-5) 80, 80, 85
 80   L2=L2+MCO
      GO TO 90
 85   L2=L2+5
 90   IF(L1-1) 95, 95, 100
 95   WRITE (6,903)IJ,NR,A(3),A(4),(T(I,1), I=L1,L2)
      GO TO 105
 100  WRITE (6,904)(T(I,1), I=L1,L2)
 105  MCO=MCO-5
      IF(MCO) 115, 115, 110
 110  L1=L1+5
      GO TO 78
 115  CONTINUE
 120  REWIND 2
 900  FORMAT(1H0/7H0DESIGN3X6HNO. OF8X4HMEAN9X9HSTD. DEV./11X4HREPS11X
     1,1HY14X,1HY)
 902  FORMAT(1H0/7H0DESIGN3X6HNO. OF8X4HMEAN9X9HSTD. DEV.10X19HMEANS OF
     1COVARIATES/11X4HREPS11X1HY14X1HY4X5I14/(46X5I14))
 903  FORMAT(1H I4,5X,I4,F17.5,F15.5,F17.5,4F14.5)
 904  FORMAT(1H 45X,F17.5,4F14.5)
 9876 FORMAT(20A4)
      RETURN
      END
C        SUBROUTINE TPWD FOR BMD05V                   JUNE 24, 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 18
   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)
 49   FORMAT(76H ERROR ON TAPE ASSIGNMENT, IT CAN NEITHER BE NEGATIVE NO
     1R BE 6 (THE PRINTER))
      STOP
      END
C             SUBROUTINE TRANS FOR BMD05V             JUNE 24, 1966
      SUBROUTINE TRANS (NVG,ONNN,IR,IERROR)
      DIMENSION S(41,43),ND(41),T(41,43),A(43),B(41),MP(41),MA(41,44),
     1SUM(44),ID(44),X(41,43),IFF(2,44),COE(41,44),P(1060),SU(44),
     2AM(41,44),FMT(90),NEWA(44),LCODE(41),LVA(41),BNEW(41)
      COMMON  FMT    , AM     , COE    , MA     , IFF
      COMMON  X      , P      , SU     , N      , NP     , NH
      COMMON  S      , T      , A      , MP     , SUM    , ID
      COMMON  NO     , CON    , JUNK   , NCO    , NR
      ASN(XX)=ATAN(XX/SQRT(1.0-XX**2))
      EQUIVALENCE (LCODE,SU),(LVA,AM),(BNEW,COE),(NEWA,MA,NV),(IFF(1),
     1ND),(IFF(59),B)
      IERROR=0
      DO 2000 I=1,NVG
      J=NEWA(I)
      NTR=LCODE(I)
      K=LVA(I)
      D1=T(1,K)
      IF(NTR*(NTR-15)) 4,99,99
    4 IF(NTR-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),NTR
   10 IF(-D1)9,32,99
    9 D2=SQRT(D1)
      GO TO 200
   20 IF(D1)99,11,12
   11 D2=1.0
      GO TO 200
   12 D2=SQRT(D1)+SQRT(D1+1.0)
      GO TO 200
   30 IF(-D1)14,99,99
   14 D2=ALOG10(D1)
      GO TO 200
   40 D2=EXP(D1)
      GO TO 200
   50 IF(-D1)17,32,99
   17 IF(D1-1.0)18,19,99
   18 D2=ASN(SQRT(D1))
      GO TO 200
   19 D2=3.14159/2.0
      GO TO 200
   60 D=T(1,K)/ONNN
      E=D+1.0/ONNN
      IF(D)99,23,24
   23 IF(-E)27,32,99
   27 D2=ASN(SQRT(E))
      GO TO 200
   24 IF(E)99,28,29
   28 D2=ASN(SQRT(D))
      GO TO 200
   29 D2=ASN(SQRT(D))+ASN(SQRT(E))
      GO TO 200
   70 IF(D1)31,99,31
   31 D2=1.0/D1
      GO TO 200
   80 D2=D1+POWER
      GO TO 200
   90 D2=D1*POWER
      GO TO 200
  100 IF(D1)33,32,33
   33 D2=D1**POWER
      GO TO 200
   32 D2=0.0
      GO TO 200
  110 D2=D1+T(1,II)
      GO TO 200
  120 D2=D1-T(1,II)
      GO TO 200
  130 D2=D1*T(1,II)
      GO TO 200
  140 IF(T(1,II))34,99,34
   34 D2=D1/T(1,II)
      GO TO 200
   99 WRITE (6,900)I,IR,D1
      IERROR=-99
      GO TO 2000
  200 T(1,J)=D2
 2000 CONTINUE
  900 FORMAT(51H0ERROR OCCURRED DURING TRANS-GENERATION PASS NUMBERI3,
     115H, DESIGN NUMBERI5,1H./15H THIS VALUE IS F15.5,2H. 
     2/41H PROGRAM WILL GO TO NEXT PROBLEM, IF ANY.)
  250 RETURN
      END