Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0137/bmd/bmdx70.for
There is 1 other file named bmdx70.for in the archive. Click here to see a list.
C             T PROGRAM -- MAIN PROGRAM               JUNE 20, 1966
C        THIS IS A SIFTED VERSION OF BMDX70 ORIGINALLY WRITTEN IN
C        FORTRAN II. SOME MODIFICATIONS WERE MADE TO MAKE IT OPERABLE
C        AND SLIGHTLY MORE EFFICIENT THAN THE SIFTED VERSION.
      DOUBLE PRECISION FINISH,CODE,TODE
      DOUBLE PRECISION PROBLM
      DATA FINISH,PROBLM/'FINISH','PROBLM'/
      DIMENSION FMT(180),X(200),N(70,2,15),SUM(70,2,15),NTOTL(20),
     1SUMSQ(70,2,15),NUSE(100),CAT(20),ICAT(20),NVAL(100)
     2,F(3),XM1(3),XM2(3),P(3),ROWNO(20)
      COMMON  X      , NTRG   , NADVAR , NI     , ROWNO  , FAIL
      COMMON  MISCRD , ERROR  , NOW    , VALS   , NTVAR  , NOCASE
      COMMON  BADVAL , ROWS   , NROWS  , VARG   , CTOT   , XL1
      COMMON  XL2    , F      , XM1    , XM2    , P
      DATA BLANK/' '/,YES/'YES'/
	CALL USAGEB('BMDX70')
      XM1(2)=1.0
      XM1(3)=1.0
   80 READ (5,100)CODE,TODE,NCASE,NVAR,NTRG,NADVAR,MISCRD, NROWS,NWRITE,
     1NCARDS,YESP,NIT,NVFC
  100 FORMAT (2A6,I5,2I3,I4,3I3,I2,A3,27X,2I2)
      P(1)=-0.0
      P(2)=-0.0
      P(3)=-0.0
      IF(CODE.EQ.PROBLM)GO TO 1
      IF(CODE.EQ.FINISH)GO TO 900
      PRINT 500,CODE
  500 FORMAT(' PROGRAM EXPECTED PROBLM OR FINISH CARD INSTEAD READ THE
     1FOLLOWING'/1X,A6)
      STOP
    1 NI=0
      NTVAR=NVAR+NADVAR
      DO 25 L=1,15
      NTOTL(L)=0
      DO 24 K=1,2
      DO 23 J=1,70
      N(J,K,L)=0
      SUM(J,K,L)=0.0
      SUMSQ(J,K,L)=0.0
   23 CONTINUE
   24 CONTINUE
   25 CONTINUE
      WRITE (6,1000)
 1000 FORMAT ('1BMDX70 T PROGRAM',
     1' - REVISED JUNE 30, 1969')
      WRITE (6,1001)
 1001 FORMAT (40H HEALTH SCIENCES COMPUTING FACILITY,UCLA  )
      WRITE (6,819)TODE
  819 FORMAT (9H0PROBLEM  ,A6)
      WRITE (6,820)NCASE,NROWS
  820 FORMAT (26H NUMBER OF CASES..........,   I6,3X,    20HNO. OF SUB-P
     1ROBLEMS.  ,I2)
      WRITE (6,821)NVAR,NWRITE
  821 FORMAT (29H NUMBER OF PUNCHED VARIABLES.,I3,3X,20HTAPE TO WRITE...
     1....,I2)
      WRITE (6,822)NTRG,NIT
  822 FORMAT (29H NUMBER OF TRANSGENERATIONS..,I3,3X,20HINPUT TAPE NUMBE
     1R...,I2)
      WRITE (6,823)NADVAR
  823 FORMAT (29H NUMBER OF VARIABLES ADDED...,I3,3X,18HNUMBER OF VARIAB
     1LE )
      WRITE (6,824)MISCRD,NVFC
  824 FORMAT (29H NUMBER OF MISVAL CARDS......,I3,3X,20HFORMAT CARDS....
     1....,I2)
      ERROR=0.0
      IF(NVAR-200)810,810,501
  810 IF(NTRG-100)811,811,503
  811 IF(NVAR+NADVAR-100)812,812,505
  812 IF(MISCRD-100)813,813,507
  813 IF(NROWS-20)814,814,509
  814 IF(NVFC.GE.1.AND.NVFC.LE.10)GO TO 816
      PRINT 511
  511 FORMAT(' NUMBER OF VARIABLE FORMAT CARDS INCORRECTLY SPECIFIED, AS
     1SUMED TO BE 1')
      NFVC=1
  816 IF(NCASE-32000)815,815,513
  501 PRINT 502
  502 FORMAT(' NUMBER OF ORIGINAL VARIABLES IS GREATER THAN 200')
      GO TO 899
  503 PRINT 504
  504 FORMAT(' NUMBER OF TRANSGENERATION CARDS IS GREATER THAN 100')
      GO TO 899
  505 PRINT 506
  506 FORMAT(' NUMBER OF VARIABLES OUTPUT IS GREATER THAN 100')
      GO TO 899
  507 PRINT 508
  508 FORMAT(' NUMBER OF MISVAL CARDS IS GREATER THAN 100')
      GO TO 899
  509 PRINT 510
  510 FORMAT(' NUMBER OF SUBPROBLM CARDS IS INCORRECTLY SPECIFIED')
      GO TO 899
  513 PRINT 514
  514 FORMAT(' NUMBER OF CASES IS GREATER THAN 32,000')
  899 WRITE (6,898)
  898 FORMAT (44H0PROBLEM CARD ERROR..PROGRAM CANNOT CONTINUE  )
      GO TO 900
  815 DO 26 J=1,200
      X(J)=0.0
   26 CONTINUE
      NOMEET=0
       BADVAL = 0
      IF(MISCRD)5,5,4
    4 CALL MISVAL
    5 IF(NTRG)6,6,55
   55 CALL TRANS
    6 IF(NROWS)509,7,56
   56 CALL BOLSEL
    7 READ (5,101)(ICAT(L),CAT(L),L=1,NROWS)
  101 FORMAT (8(I3,F6.0))
      NI=1
      NVFF=NVFC*18
      READ (5,102)(FMT(J),J=1,NVFF)
  102 FORMAT (18A4)
      WRITE (6,122)
  122 FORMAT (20H0    VARIABLE FORMAT  )
      WRITE (6,123)(FMT(J),J=1,NVFF)
  123 FORMAT (1X,18A4)
      IF(NIT)84,84,85
   85 IF(NIT.NE.6)GO TO 81
      PRINT 515
  515 FORMAT(' INPUT TAPE CANNOT BE ON UNIT 6')
      GO TO 899
   83 PRINT 516
  516 FORMAT(' IT IS ILLEGAL TO WRITE ON TAPE UNITS 5 OR 6')
      GO TO 899
   84 NIT=5
   81 IF(NIT-5)2,70,2
    2 REWIND NIT
   70 IF(NWRITE.EQ.5.OR.NWRITE.EQ.6)GO TO 83
      IF(NWRITE.LE.0)GO TO 71
      REWIND NWRITE
      DO 74 K=1,NCARDS
      DO 73 L=1,NCASE
      READ (NIT,300)(NUSE(J),J=1,16)
  300 FORMAT (16A5)
      WRITE (NWRITE,300)(NUSE(J),J=1,16)
   73 CONTINUE
   74 CONTINUE
      END FILE NWRITE
      REWIND NWRITE
      NIT=NWRITE
   71 DO 110 JKL=1,NCASE
      NOCASE=JKL
   75 READ (NIT,FMT)(X(J),J=1,NVAR)
      IF(MISCRD)756,756,755
  755 CALL MISVAL
  756 IF(NTRG)77,77,76
   76 IF(NADVAR)765,765,761
  761 NZER=NVAR+1
      DO 764 NZERO=NZER,NTVAR
      X(NZERO)=0.0
  764 CONTINUE
  765 CALL TRANS
   77 IF(NROWS)79,78,79
   78 ROWS=1.0
      ROWNO(1)=1.0
      GO TO 757
   79 CALL BOLSEL
      IF(ROWS)14,14,757
   14 NOMEET=NOMEET+1
      GO TO 110
  757 NNROWS=ROWS+.5
6543  FORMAT(10F7.2)
      DO 790 M=1,NNROWS
      L=ROWNO(M)+.5
   15 ICATL=ICAT(L)
      NTOTL(L)=NTOTL(L)+1
      IF(X(ICATL)-CAT(L))12,11,11
   11 K=1
      GO TO 3
   12 K=2
    3 DO 103 J=1,NTVAR
      IF(X(J).EQ.BLANK)GO TO 103
   16 N(J,K,L)=N(J,K,L)+1
      SUM(J,K,L)=SUM(J,K,L)+X(J)
      SUMSQ(J,K,L)=SUMSQ(J,K,L)+(X(J)*X(J))
  103 CONTINUE
  790 CONTINUE
  110 CONTINUE
      DO 200 L=1,NROWS
      IF(NTOTL(L))700,700,111
  700 WRITE (6,112)L,NTOTL(L)
  112 FORMAT (19H1SUB-PROBLEM NUMBER  ,I3,9H CONTAINS  ,I6,6H CASES,29X,
     159H*  POOLED VARIANCE ESTIMATE   *  SEPARATE VARIANCE ESTIMATE  )
      GO TO 200
  111 KOUNT=8
      DO 199 J=1,NTVAR
      XN1=N(J,1,L)
      XN2=N(J,2,L)
      XBAR=0.
      VARX=0.
      VAXBAR=0.
      YBAR=0.
      VARY=0.
      VAYBAR=0.
      IF(XN1.LE.0.)GO TO 1111
      XBAR=SUM(J,1,L)/XN1
      IF(XN1.LT.2.)GO TO 1111
      VARX=(SUMSQ(J,1,L)-((SUM(J,1,L)*SUM(J,1,L))/XN1))/(XN1-1.0)
      SS=SUMSQ(J,1,L)*.00001
      IF(SS.GT.VARX)VARX=0.
      VAXBAR=VARX/XN1
 1111 IF(XN2.LE.0.)GO TO 1112
      YBAR=SUM(J,2,L)/XN2
      IF(XN2.LT.2.)GO TO 1112
      VARY=(SUMSQ(J,2,L)-((SUM(J,2,L)*SUM(J,2,L))/XN2))/(XN2-1.0)
      SS=SUMSQ(J,2,L)*.00001
      IF(SS.GT.VARY)VARY=0.
      VAYBAR=VARY/XN2
 1112 IF(VARX-VARY)114,113,113
  113 FXY=0.
      IF(VARY.GT.0.)FXY=VARX/VARY
      XM1(1)=0.0
      XM2(1)=0.0
      IF(XN1.GT.0.)XM1(1)=XN1-1.
      IF(XN2.GT.0.)XM2(1)=XN2-1.
      GO TO 115
  114 FXY=0.
      IF(VARX.GT.0.)FXY=VARY/VARX
      XM1(1)=0.0
      XM2(1)=0.0
      IF(XN2.GT.0.)XM1(1)=XN2-1.
      IF(XN1.GT.0.)XM2(1)=XN1-1.
  115 SDX=SQRT(VARX)
      SDY=SQRT(VARY)
      SEXBAR=SQRT(VAXBAR)
      SEYBAR=SQRT(VAYBAR)
      DENOM=XM1(1)+XM2(1)
      TERM2=0.
      IF(DENOM.GT.0.)
     1TERM2=((VARX*(XN1-1.0))+((XN2-1.0)*VARY))/DENOM
      RECIP1=0.
      IF(XN1.GT.0.)RECIP1=1./XN1
      RECIP2=0.
      IF(XN2.GT.0.)RECIP2=1./XN2
      DENOM=         SQRT(((RECIP1 )+(RECIP2 ))*TERM2)
      TP=0.
      IF(DENOM.GT.0.)TP=(XBAR-YBAR)/DENOM
      DENOM=         SQRT(VAXBAR+VAYBAR)
      TS=0.
      IF(DENOM.GT.0.)TS=(XBAR-YBAR)/DENOM
      NDEGP=N(J,1,L)+N(J,2,L)-2
      IF(N(J,1,L).LE.0)NDEGP=N(J,2,L)-1
      IF(N(J,2,L).LE.0)NDEGP=N(J,1,L)-1
      IF(N(J,1,L).LE.0.AND.N(J,2,L).LE.0)NDEGP=0
      DEGS=0.
      IF(VAXBAR.LE.0..AND.VAYBAR.LE.0.)GO TO 2060
      DEGX=0.
      IF(VAXBAR.GT.0.)
     1DEGX=(1.0/(XN1-1.0))*(VAXBAR/(VAXBAR+VAYBAR))*(VAXBAR/(VAXBAR+VAYB
     2AR))
      DEGY=0.
      IF(VAYBAR.GT.0.)
     1DEGY=(1.0/(XN2-1.0))*(VAYBAR/(VAXBAR+VAYBAR))*(VAYBAR/(VAXBAR+VAYB
     2AR))
      DEGS=1.0/(DEGX+DEGY)
 2060 IF(YES.NE.YESP)GO TO 208
  207 XM2(2)=NDEGP
      XM2(3)=DEGS
      NM = N(J,1,L) - 1
      NN = N(J,2,L) - 1
      IF(FXY) 30,30,31
   30 P(1) = 1.0
      GO TO 1031
   31 P(1)=(1-FCDF(FXY,NM,NN))*2
 1031 IF(TP) 33,32,33
   32 P(2) = 1.0
      GO TO 1033
   33 P(2) = (1-TCDF(ABS(TP),NDEGP))*2
 1033 IF(TS) 35,34,35
   34 P(3) = 1.0
      GO TO 208
   35 NDEGS = DEGS
      P(3) = (1-TCDF(ABS(TS),NDEGS))*2
C
C
  208 KOUNT=KOUNT+1
      IF(KOUNT-8 )210,210,209
  209 WRITE (6,112)L,NTOTL(L)
      WRITE (6,120)
      WRITE (6,920)
  920 FORMAT(131H VARIABLE    NUMBER              STANDARD    STANDARD  
     1*    F      P    *    T       DEGREES     P    *    T       DEGREE
     2S       P  )
      KOUNT=1
      WRITE (6,201)
  201 FORMAT(132H   INDEX    OF CASES     MEAN   DEVIATION      ERROR
     1*  VALUE  VALUE  *  VALUE   OF FREEDOM  VALUE  *  VALUE   OF FREED
     2OM    VALUE   )
      WRITE (6,202)
  202 FORMAT (1X,131(1H*))
  210 WRITE (6,120)
      WRITE (6,120)
  120 FORMAT (55X,1H*,16X,1H*,29X,1H*)
      SDX=CKZER(SDX)
      SEXBAR=CKZER(SEXBAR)
      WRITE (6,203)N(J,1,L),XBAR,SDX,SEXBAR
  203 FORMAT (1H ,8X,1HX,2X,I5,1X,F12.4,1X,F10.3,1X,F10.3,3X,1H*,16X,1H*
     129X,1H*)
      FXY=CKZER(FXY)
      TP=CKZER(TP)
      TS=CKZER(TS)
      DEGS=CKZER(DEGS)
       IF (YESP.NE.YES) P(1)=9.0E30
      WRITE (6,104)J,FXY,P(1),TP,NDEGP,P(2),TS,DEGS,P(3)
  104 FORMAT (3X,I3,49X,2H* ,F6.2,2X,  F5.3 ,2X,1H*,F7.2,5X,I5,5X,  F5.3
     1 ,2X,1H*,F7.2,4X,F8.2,5X,  F5.3 )
      SDY=CKZER(SDY)
      SEYBAR=CKZER(SEYBAR)
      WRITE (6,105)N(J,2,L),YBAR,SDY,SEYBAR
  105 FORMAT (1H ,8X,1HY,2X,I5,1X,F12.4,1X,F10.3,1X,F10.3,3X,1H*,16X,1H*
     129X,1H*)
      WRITE (6,120)
      WRITE (6,121)
  121 FORMAT (1X,131(1H-))
  199 CONTINUE
  200 CONTINUE
      WRITE (6,108)NOMEET
  108 FORMAT (57H1NUMBER OF CASES NOT INCLUDED IN DESIGNATED SUB-PROBLEM
     1S= ,I5)
      NBAD=BADVAL+.5
      WRITE (6,600)NBAD
  600 FORMAT (74H NUMBER OF INSTANCES IN WHICH TRANSGENERATION RESTRICTI
     1ONS WERE VIOLATED =  ,I5)
      IF(NIT-5)901,902,901
  901 REWIND NIT
  902 IF(NWRITE)80,80,903
  903 REWIND NWRITE
  904 GO TO 80
  900 STOP
      END
C             SUBROUTINE BOLSEL OF BMDX70             JUNE 20, 1966
      SUBROUTINE BOLSEL
      DOUBLE PRECISION CON(20,8)
      DIMENSION X(200),DATA(200),NBOOL(20),ROWNO(20),NSUB(20,8),REL(20,8
     1),          OP(20,8),IN(9),WK(9)
     2,F(3),XM1(3),XM2(3),P(3)
      COMMON  X
      COMMON  NTRG   , NADVAR , NI     , ROWNO  , FAIL   , MISCRD
      COMMON  ERROR  , NOW    , VALS   , NTVAR  , NOCASE , BADVAL
      COMMON  ROWS   , NROWS  , VARG   , CTOT   , XL1    , XL2
      COMMON  F      , XM1    , XM2    , P
      EQUIVALENCE (X,DATA)
      DATA A1,WK           ,ASK/1HV,2HGT,2HGE,2HLT,2HLE,2HEQ,2HNE,
     1'ERR.','OR','AN','**'/
      DATA BLANK /' '/
      IF(NI-1)399,502,502
  399 DO 500 NB=1,NROWS
      NERROR=0
      NBGIN=1
      NFIN=4
 4000 READ (5,401)(NSUB(NB,I),REL(NB,I),CON(NB,I),OP(NB,I),I=NBGIN,NFIN)
  401 FORMAT (4(3X,I3,1X,A2,   A6,1X,A2))
      DO 4004 I=NBGIN,NFIN
      INOW=I
  415 IF(OP(NB,I).EQ.WK(8))GO TO 4004
  416 IF(OP(NB,I).EQ.WK(9))GO TO 4004
  417 IF(OP(NB,I).EQ.ASK)GO TO 418
  400 NERROR=1
 4004 CONTINUE
      IF(NFIN-4)4001,4001,4003
 4001 NBGIN=5
      NFIN=8
      GO TO 4000
 4003 WRITE (6,4002)NB
 4002 FORMAT (49H NO ** OPERATION WAS ENCOUNTERED FOR SUB-PROBLEM ,I2,
     151H...PROGRAM WILL READ TWO CARDS FOR THIS SUB-PROBLEM  )
  418 NBOOL(NB)=INOW
      IF(INOW-4)4081,4081,4082
 4081 KK=INOW
      GO TO 4083
 4082 KK=4
 4083 WRITE (6,404)NB,(NSUB(NB,I),REL(NB,I),CON(NB,I),OP(NB,I),I=1,KK)
  404 FORMAT (37H0CASE WILL BE INCLUDED IN SUB-PROBLEM  ,I3,3H IF,
     14(2HV(,I3,1H)1X,A2,1X,A6,1X,A2,1X))
      IF(INOW-4)4088,4088,4086
 4086 KK=INOW
      WRITE (6,4041)(NSUB(NB,I),REL(NB,I),CON(NB,I),OP(NB,I),I=5,KK)
 4041 FORMAT (43X,4(2HV(,I3,1H),1X,A2, 1X,A6,1X,A2,1X))
 4088 DO 420 I=1,KK
      REWIND 1
      WRITE (1,405)CON(NB,I)
  405 FORMAT (A6)
      REWIND 1
      READ (1,406)PUS
  406 FORMAT (A1)
      REWIND 1
      IF(A1.NE.PUS)GO TO 409
  407 READ (5,408)CON(NB,I)
  408 FORMAT (3X,F3.0)
      IF(CON(NB,I)-200.0)411,411,421
  411 CON(NB,I)=CON(NB,I)+100000.0
      GO TO 412
  409 READ (1,410)CON(NB,I)
  410 FORMAT (F6.0)
  412 IF(NSUB(NB,I)-200)413,413,421
  413 DO 414 J=1,6
      IF(REL(NB,I).EQ.WK(J))GO TO 420
  414 CONTINUE
      GO TO 421
  420 CONTINUE
      IF(ERROR)500,500,421
  421 DO 422 I=1,KK
      REL(NB,I)=WK(7)
  422 CONTINUE
      WRITE (6,423)
  423 FORMAT (91H BOOLEAN SELECTION CARD(S) FOR ABOVE SUB-PROBLEM HAS ER
     1ROR(S)...SUB-PROBLEM WILL BE SKIPPED  )
  500 CONTINUE
      RETURN
  502 M=0
      DO 600 NB=1,NROWS
      KK=NBOOL(NB)
      DO 100 I=1,KK
      IS=NSUB(NB,I)
      DO 55 J=1,6
      IF(REL(NB,I).EQ.WK(J))GO TO 26
   55 CONTINUE
      GO TO 600
   26 CONNB=SNGL(CON(NB,I))
      IF(CONNB-100000.0)27,27,28
   27 CC=CONNB
      GO TO 29
   28 K=CONNB-100000.0+.5
      CC=DATA(K)
   29 CONTINUE
7654  FORMAT(2F15.2)
      GO TO (1,2,3,4,5,6),J
    1 IF(DATA(IS)-CC) 50,50,20
    2 IF(DATA(IS)-CC) 50,20,20
    3 IF(DATA(IS)-CC) 20,50,50
    4 IF(DATA(IS)-CC) 20,20,50
    5 IF(DATA(IS)-CC) 50,20,50
    6 IF(DATA(IS)-CC) 20,50,20
   20 IN(I)=1
      IGOOD=I
      GO TO 100
   50 IN(I)=0
      IGOOD=I
100   CONTINUE
      IN(IGOOD+1)=0
      NTEST=IN(1)
C
C     EXAMINE BOOLEAN OPERATOR FOR OR/AN
C
      DO 200 I=1,KK
      IF(OP(NB,I).EQ.WK(9))GO TO 223
  191 IF(NTEST) 199,199,321
  199 NTEST=IN(I+1)
      GO TO 200
  223 NTEST=NTEST*IN(I+1)
  200 CONTINUE
      IF(NTEST)600,600,321
  321 M=M+1
      ROWNO(M)=NB
  600 CONTINUE
8765  FORMAT(I3)
      ROWS=M
      RETURN
      END
C        FUNCTION CKZER FOR BMDX70                    JUNE 20 1966
C        IF THE ARGUMENT IS ZERO IT IS FORCED POSITIVE ZERO.
      FUNCTION CKZER(X)
      IF(X.NE.0.0)GO TO 10
      CKZER=0.0
      GO TO 15
   10 CKZER=X
   15 RETURN
      END
C             SUBROUTINE MISVAL FOR BMDX70            JUNE 20, 1966
      SUBROUTINE MISVAL
      EXTERNAL SIGN
      DIMENSION X(200),NVAR(200),NV(200),VAL(200,10),ROWNO(20),AVAL(10)
     1,F(3),XM1(3),XM2(3),P(3)
      COMMON  X      , NTRG   , NADVAR , NI     , ROWNO  , FAIL
      COMMON  MISCRD , ERROR  , NOW    , VALS   , NTVAR  , NOCASE
      COMMON  BADVAL , ROWS   , NROWS  , VARG   , CTOT   , XL1
      COMMON  XL2    , F      , XM1    , XM2    , P
      IF(NI)1,1,3
    1 WRITE (6,800)
  800 FORMAT (20H0 MISSING  NUMBER OF  )
      WRITE (6,801)
  801 FORMAT (111H VARIABLE   VALUES    VALUE 1  VALUE 2  VALUE 3  VALUE
     1 4  VALUE 5  VALUE 6  VALUE 7  VALUE 8  VALUE 9  VALUE 10  )
      DATA BLANK/' '/
      NTOT=NTVAR-NADVAR
      DO 10 M=1,MISCRD
      READ (5,100)NVAR(M),NV(M),(VAL(M,J),J=1,10)
  100 FORMAT (2I4,10F6.0)
      IF(NV(M)-10)700,700,701
  701 NV(M)=10
      PRINT 400
  400 FORMAT(' NUMBER OF MISSING VALUES IS INCORRECTLY SPECIFIED, ASSUME
     1D TO BE 10')
  700 NVV=NV(M)
      WRITE (6,802)NVAR(M),NV(M),(VAL(M,J),J=1,NVV)
  802 FORMAT (1H0,2X,I3,9X,I2,5X,10(F8.2,1X))
      IF(NVAR(M).LE.199)GO TO 41
      PRINT 401
  401 FORMAT(' VARIABLE INDEX IS GREATER THAN 199')
  900 WRITE (6,901)
  901 FORMAT (66H ABOVE MISSING VALUE CARD CONTAINS AN ERROR...CARD WILL
     1 BE IGNORED  )
      NVAR(M)=200
      GO TO 10
   41 IF(NVAR(M))18,18,10
   18 IF(MISCRD-1)20,20,900
   10 CONTINUE
      RETURN
   20 DO 25 K=1,NTOT
      NV(K)=NV(1)
      NVAR(K)=K
      NVALL=NV(1)
      DO 24 J=1,NVALL
      VAL(K,J)=VAL(1,J)
   24 CONTINUE
   25 CONTINUE
      MISCRD=NTOT
      RETURN
    3 DO 90 M=1,MISCRD
      NOW=NVAR(M)
      NVNVAR=NV(M)
      DO 30 J=1,NVNVAR
   14 IF(X(NOW)-VAL(M,J))30,15,30
   15 IF(VAL(M,J))80,12,80
   12 IF(SIGN(1.0,VAL(M,J)))11,90,13
   11 IF(SIGN(1.0,X(NOW)))80,90,30
   13 IF(SIGN(1.0,X(NOW)))30,90,80
   30 CONTINUE
      GO TO 90
   80 X(NOW)=BLANK
   90 CONTINUE
      RETURN
      END
C             FUNCTION FCDF FOR BMDX70 OCT.2,1968
      FUNCTION   FCDF(FR,M,N)
      F  CDF=0.
      CON=1.
      IF((M-M/2*2).EQ.0)GO TO 80
      IF((N-N/2*2).EQ.0)GO TO 60
       IF(N.NE.1)GO TO 5
      THETA=ATAN(SQRT(N/(M*FR)))
      J=M/2
      GO TO 7
5     THETA=ATAN(SQRT(M*FR/N))
      J=N/2
7     SINE=SIN(THETA)
      SINSQ=SINE*SINE
      COSQ=1-SINSQ
      COSN=SQRT(COSQ)
      IF((M.EQ.1).AND.(N.EQ.1))GO TO 50
      DO 10 I=1,J
      F  CDF=F  CDF+CON
      TWI=2*I
10    CON=CON*TWI*COSQ/(TWI+1)
50    FCDF=1.-2.*(FCDF*SINE*COSN+THETA)/3.14159
      IF(N.EQ.1)RETURN
      F  CDF=1.-F  CDF
      IF(M.EQ.1)RETURN
      FCTR=CON
      CON=1.
      PFP=0.
      NM1=N-1
      J=M/2
      DO 20 I=1,J
      PFP=PFP+CON
      TWI=2*I
20    CON=CON*(NM1+TWI)*SINSQ/(TWI+1)
      FCDF=FCDF-2.*N*FCTR*SINE*COSN*PFP/3.14159
      RETURN
60    X=N/(N+M*FR)
      J=N/2
      MS2=M-2
      GO TO 85
80    X=M*FR/(N+M*FR)
      J=M/2
      MS2=N-2
85    OWX=1.-X
      DO 90 I=1,J
      F  CDF=F  CDF+CON
      TWI=2*I
90    CON=CON*(MS2+TWI)*X/TWI
      IF(M-M/2*2)100,95,100
95    FCDF=1.-OWX**(N/2.)*FCDF
      RETURN
100   FCDF=OWX**(M/2.)*FCDF
      RETURN
         END
C             FUNCTION TCDF FOR BMDX70 OCT.2,1968
      FUNCTION TCDF(STT,N)
      IF(STT.NE.0.)GO TO 1
      TCDF=.5
      RETURN
    1 T=ABS(STT)
      B=N
      THETA=ATAN(T/SQRT(B))
          C=SIN(THETA)
      COSN=COS(THETA)
      COSQ=COSN*COSN
      TCDF=0.
      IF(N.EQ.1)GO TO 20
      A=N/2.
      NUM=N-N/2*2+1
   10 TCDF=TCDF+C
      A=A-1.
      D=NUM+1.
      C=C*NUM*COSQ/D
      NUM=NUM+2
      IF(A-0.5)30,20,10
   20 TCDF  =(THETA+TCDF  *COSN)/1.570796
   30 TCDF=.5+SIGN(.5*TCDF,STT)
      RETURN
      END
C             SUBROUTINE TRANS FOR BMDX70             JUNE 20, 1966
      SUBROUTINE TRANS
      DOUBLE PRECISION LTRAN
      EXTERNAL SIGN
      DIMENSION CONS(100,7),CONST(100),X(200),KODE(100),NCON40(100),
     1NTRAN(100),NOTRAN(100),DATA(200),ROWNO(20)
     2,F(3),XM1(3),XM2(3),P(3)
      COMMON  X
      COMMON  NTRG   , NADVAR , NI     , ROWNO  , FAIL   , MISCRD
      COMMON  ERROR  , NOW    , VALS   , NTVAR  , NOCASE , BADVAL
      COMMON  ROWS   , NROWS  , VARG   , CTOT   , XL1    , XL2
      COMMON  F      , XM1    , XM2    , P
      ASN(XX)=ATAN(XX/SQRT(1.0-XX**2))
      EQUIVALENCE (X,DATA)
      IF(NI)200,200,299
  200 WRITE (6,301)
  301 FORMAT (43H0 NEW           OLD     B VAR.    NUMBER OF  )
      WRITE (6,302)
  302 FORMAT (68H  VAR.   CODE   VAR.   OR CONST.  CONSTANTS        TYPE
     1 40 CONSTANTS  )
      DATA BLANK/' '/
      DO 210 I=1,NTRG
      READ (5,300)LTRAN,NTRAN(I),KODE(I),NOTRAN(I),CONST(I), NCON40(I),(
     1CONS(I,J),J=1,7)
  300 FORMAT (A6,I3,I2,I3,F6.0,5X,I1,7F6.0)
      IF(NCON40(I))307,307,306
  306 ICON40=NCON40(I)
      WRITE (6,303)NTRAN(I),KODE(I),NOTRAN(I),CONST(I),NCON40(I),(CONS(I
     1,J),J=1,ICON40)
  303 FORMAT (2X,I3,2(4X,I3),5X,F8.2,7X,I1,8X,7(F8.2,1X))
      GO TO 309
  307 WRITE (6,308)NTRAN(I),KODE(I),NOTRAN(I),CONST(I)
  308 FORMAT(2X,I3,2(4X,I3),5X,F8.2)
  309 IF(NTRAN(I)-200)304,304,801
  304 IF(NOTRAN(I)-200)305,305,803
  305 IF(NCON40(I)-7)310,310,805
  801 PRINT 802
  802 FORMAT(' INDEX OF NEW VARIABLE  IS GREATER THAN 200')
      GO TO 800
  803 PRINT 804
  804 FORMAT(' INDEX OF OLD VARIABLE IS GREATER THAN 200')
      GO TO 800
  805 PRINT 806
  806 FORMAT(' NUMBER OF CONSTANTS IS GREATER THAN 7')
      GO TO 800
  310 IF(KODE(I)-41)311,311,399
  311 K=KODE(I)
      GO TO(210,210,210,210,210,399,210,210,210,210,320,320,320,320,
     1210,320,210,399,399,210,210,210,320,210,399,399,399,399,399,399,
     2399,399,399,399,399,399,399,399,399,210,210 ),K
  320 IF(CONST(I)-200.0)210,210,807
  807 PRINT 808
  808 FORMAT(' INDEX OF VARIABLE B IS GREATER THAN 200')
      GO TO 800
  399 WRITE (6,398)
  398 FORMAT(' ABOVE TRANSGENERATION CARD HAS AN ILLEGAL CODE FOR THIS
     1PROBLEM')
      GO TO 397
  800 WRITE (6,850)
  850 FORMAT(' ABOVE TRANSGENERATION CARD HAS AN ERROR')
  397 KODE(I)=42
  210 CONTINUE
      BADVAL=0.0
      RETURN
  299 DO 1000 I=1,NTRG
      N=NOTRAN(I)
      M=NTRAN(I)
      K=KODE(I)
      D1=DATA(N)
      IF(D1.NE.BLANK)GO TO 700
  600 D2=D1
      GO TO 100
  700 GO TO(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,
     124,197,197,197,197,197,197,197,197,197,197,197,197,197,197,197,40,
     241,1000),K
    1 IF(D1)198,107,108
  107 D2=0.0
      GOTO100
  108 D2=SQRT(D1)
      GOTO100
    2 IF(D1)198,111,112
  111 D2=1.0
      GOTO100
  112 D2=SQRT(D1)+SQRT(D1+1.0)
      GOTO100
    3 IF(-D1)114,198,198
  114 D2=ALOG10(D1)
      GOTO100
    4 D2=EXP(D1)
      GOTO100
    5 IF(-D1)117,107,198
  117 IF(D1-1.0)118,119,119
  118 D2=ASN(SQRT(D1))
      GOTO100
  119 D2=3.14159265/2.0
      GOTO100
    6 GO TO 197
    7 IF(D1)131,198,131
  131 D2=1.0/D1
      GOTO100
    8 D2=D1+CONST(I)
      GOTO100
    9 D2=D1*CONST(I)
      GOTO100
   10 IF(-D1)133,107,198
  133 D2=D1**CONST(I)
      GOTO100
   11 NEWB=CONST(I)
      D2=D1+DATA(NEWB)
      GO TO 205
   12 NEWB=CONST(I)
      D2=D1-DATA(NEWB)
      GO TO 205
   13 NEWB=CONST(I)
      D2=D1*DATA(NEWB)
      GO TO 205
   14 NEWB=CONST(I)
      IF(DATA(NEWB))134,605,134
  134 D2=D1/DATA(NEWB)
      GO TO 205
   15 IF(D1-CONST(I))107,111,111
   16 NEWB=CONST(I)
      IF(DATA(NEWB).EQ.BLANK)GO TO 601
  602 IF(D1-DATA(NEWB))107,111,111
   17 IF(-D1)163,198,198
  163 D2=ALOG(D1)
      GO TO 100
   18 GO TO 197
   19 GO TO 197
   20 D2=SIN(D1)
      GO TO 100
   21 D2=COS(D1)
      GO TO 100
   22 D2=ATAN(D1)
      GO TO 100
   23 NEWB=CONST(I)
      IF(-D1)188,198,198
  188 D2=D1**DATA(NEWB)
  205 IF(DATA(NEWB).EQ.BLANK)GO TO 601
      GO TO 100
   24 IF(CONST(I)) 198,198,189
  189 D2=CONST(I)**D1
      GO TO 100
   40 L=NCON40(I)
      DO 166 J=1,L
      IF(D1-CONS(I,J))166,165,166
  165 C=SIGN(1.0,D1)
      D=SIGN(1.0,CONS(I,J ))
      IF(C+D) 167,166,167
  166 CONTINUE
      GO TO 1000
   41 IF(D1)1000,168,1000
  168 C=SIGN(1.0,D1)
      D=1.0
      IF(C+D)1000,167,1000
  167 D2=CONST(I)
      GO TO 100
  197 GO TO 1000
  605 N=NEWB
  198 IF(BADVAL-100.0)606,607,607
  606 WRITE (6,201)N,NOCASE,K
  201 FORMAT (16H VARIABLE NUMBER,I3,8H OF CASE,I5,45H VIOLATED RESTRICT
     1ION OF TRANSGENERATION CODE ,I2)
  607 BADVAL=BADVAL+1.0
  601 D2=BLANK
  100 DATA(M)=D2
 1000 CONTINUE
      RETURN
      END