Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

C             CORRELATION WITH TRANSGENERATION       APRIL 20, 1966
C        THIS IS A SIFTED VERSION OF BMD02D ORIGINALLY WRITTEN IN
C        FORTRAN II WITH SOME MODIFICATIONS TO MAKE IT OPERABLE.
C        IT WAS THEN CONVERTED TO 360 FORTRAN IV (H-LEVEL)
      COMMON CON(135),DATA(135),NEW(150),JUMP(150),NA(150),BN(150)
     1,NSUB(36),REL(36),AMIN(135),OP(36),INDEX(36),SX(135),SX2(135)
     2,AMAX(135),C(255),FMT(180),SXY(50,50)
      DIMENSION Q(135)
      EQUIVALENCE(Q,SX2)
      DOUBLE PRECISION A123,B123,C123,D123,TODE, CODE,CON
C
      ICDCNT = 0
 100  FORMAT ('1BMD02D CORRELATION WITH TRANSGENERATION',
     1' - REVISED MAY 5, 1969'/
     240H HEALTH SCIENCES COMPUTING FACILITY,UCLA//
     314H PROBLEM CODE A6,/
     421H NUMBER OF VARIABLES I3,/
     517H NUMBER OF CASES I5,//)
C
      DATA PC7/2HNO/
      DATA A123/6HFINISH/
      DATA C123/6HTRNGEN/
      DATA B123/6HPROBLM/
      DATA D123/6HPLOTSL/
      DATA ASK/2H**/
      DATA A1/1HV/
      NTAPE=5
      IT1=1
	CALL USAGEB('BMD02D')
 998  READ (5,102)TODE,CODE,NVAR,NSAM,NSEL,NADD,NBOOL,PQ1,PQ2,PQ3,NTG,MT
     1APE,KVR
      GO TO 996
 999  REWIND IT1
      WRITE (IT1,1000) (DATA(K), K=1,14)
      REWIND IT1
      READ  (IT1,102) TODE,CODE,NVAR,NSAM,NSEL,NADD,NBOOL,PQ1,PQ2,PQ3,
     1NTG,MTAPE,KVR
  996 REWIND IT1
      IF(TODE .EQ. A123) GO TO 701
 700  IF(TODE .EQ. B123) GO TO 703
      TYPE 5001, TODE,CODE
 5001 FORMAT(' PROGRAM EXPECTED PROBLM OR FINISH CARD INSTEAD READ THE
     1 FOLLOWING'/1X,2A6)
  702 WRITE (6,704)
  701 IF(NTAPE.LE.5)GO TO 742
 741  REWIND NTAPE
 742  CALL EXIT
      STOP
 6000 TYPE 6001
 6001 FORMAT(' DATA INPUT CANNOT BE FROM LOGICAL TAPES 1,5, OR 6.')
      GO TO 702
 6002 TYPE 6003
 6003 FORMAT(' NUMBER OF VARIABLES CANNOT EXCEED 135')
      GO TO 702
 6004 TYPE 6005
 6005 FORMAT(' NUMBER OF CASES MUST BE GREATER THAN 1.')
      GO TO 702
 6006 TYPE 6007
 6007 FORMAT(' NUMBER OF VARIABLES AFTER TRANSGENERATION CANNOT EXCEED 1
     135')
      GO TO 702
 6008 TYPE 6009
 6009 FORMAT(' NUMBER OF CASE SELECTION CARDS MUST BE 9 OR LESS')
      GO TO 702
 8000 TYPE 8001
 8001 FORMAT(' NUMBER OF TRANSGENERATION CARDS CANNOT EXCEED 150')
      GO TO 702
 8002 TYPE 8003, TODE
 8003 FORMAT(' PROGRAM EXPECTED TRNGEN CARD INSTEAD READ THE FOLLOWING'/
     11X,A6)
      GO TO 702
 6010 TYPE 6011
 6011 FORMAT(' NUMBER OF PLOT SELECTION CARDS INCORRECTLY SPECIFIED')
      GO TO 702
  703 IF(MTAPE.EQ.IT1)GO TO 6000
 773  CALL TPWD(MTAPE,NTAPE,PQ3)
      IF((NVAR-1)*(136-NVAR))6002,6002,1008
 1008 IF(NSAM.LE.1)GO TO 6004
 1002 IF((NVAR+NADD-1)*(136-NVAR-NADD))6006,6006,705
  705 IF(IABS(NBOOL)-9) 706,706,6008
  706 IF(KVR.GT.0.AND.KVR.LE.10)GO TO 3
      KVR=1
      WRITE (6,4002)
    3 WRITE (6,100)CODE,NVAR,NSAM
      IF(NTG.GT.150)GO TO 8000
 1003 IF(NTG)8000,401,402
  402 WRITE (6,403)
      WRITE (6,404)
      DO 707 I=1,NTG
      READ (5,406)TODE,NEW(I),JUMP(I),NA(I),BN(I)
      IF(TODE .NE. C123) GO TO 8002
  405 WRITE (6,447)I,NEW(I),JUMP(I),NA(I),BN(I)
      IF(JUMP(I)-41)2000,707,2005
 2000 IF(JUMP(I)*(17-JUMP(I)))2005,2005,707
 2005 WRITE (6,4001)
      JUMP(I)=99
  707 CONTINUE
  401 IF(NBOOL) 411,412,411
  411 KK=IABS(NBOOL)*4
      WRITE (6,413)
      READ (5,414)(NSUB(I),REL(I),CON(I),OP(I),I=1,KK)
      WRITE (6,415)
      DO 416 I=1,KK
      KK1=I
      WRITE (6,417)NSUB(I),REL(I),CON(I),OP(I)
      IF(ASK .EQ. OP(I)) GO TO 1234
  416 CONTINUE
 1234 DO 438 I=1,KK1
  438 INDEX(I)=0
      DO 437 I=1,KK1
      REWIND IT1
      WRITE (IT1,439) CON(I)
      REWIND IT1
      READ  (IT1,709) PUS
      REWIND IT1
      IF(A1 .NE. PUS) GO TO 710
 711  READ  (IT1,712) CON(I)
  712 FORMAT(2X,F3.0)
      INDEX(I)=1
      GO TO 437
 710  READ  (IT1,713) CON(I)
  713 FORMAT(F6.0)
  437 CONTINUE
      REWIND IT1
  412 IF(NTG*NBOOL) 423,418,425
  418 IF(NTG)8000,419,424
 419  IF(NBOOL)422,421,422
  421 JESUS=1
      GO TO 7
  422 JESUS=2
      NOB=0
      GO TO 7
  424 JESUS=3
      GO TO 7
  425 JESUS=4
      NOB=0
      GO TO 7
  423 JESUS=5
      NOB=0
    7 REWIND 20
      M=0
      LCASE=0
      LEFT=NSAM
      NVAR1=NVAR+NADD
      DO 4 I=1,NVAR1
      AMIN(I)=10.0**10
      AMAX(I)=-AMIN(I)
      SX(I)=0.0
      SX2(I)=0.0
      DO 4 J=1,NVAR1
    4 SXY(I,J)=0.0
      KL=0
      H=0.0
 6    KVR=KVR*18
      READ (5,103)(FMT(I),I=1,KVR)
      TYPE 5000, (FMT(I), I=1,KVR)
 5000 FORMAT(' VARIABLE FORMAT CARD(S)'/10(1X,18A4/))
C     THE CODING USING THE MOD FUNCTION IS USED TO ALLOW THE TOTAL
C     NUMBER OF CASES TO BE GREATER THAN 2**15 -1 (32767).
      NSAM1=NSAM
   77 NSAM2=MOD(NSAM1,32767)
      IF(NSAM2.EQ.0)NSAM2=NSAM1
9876  FORMAT(2I10)
      DO 600 II=1,NSAM2
      READ (NTAPE,FMT)(DATA(I),I=1,NVAR)
      GO TO (407,427,428,429,430),JESUS
 427  CALL COOL(NTEST,KK1,A123,B123,D123,NTAPE)
      GO TO (600,431,999,701),NTEST
  431 NOB=NOB+1
      GO TO 407
 428  CALL TRNGEN(NVAR,NTG,NSAM,LEFT,LCASE,M,II)
      IF(LCASE) 409,407,407
  409 LCASE=0
      GO TO 600
 429  CALL TRNGEN(NVAR,NTG,NSAM,LEFT,LCASE,M,II)
      IF(LCASE) 409,433,433
 433  CALL COOL(NTEST,KK1,A123,B123,D123,NTAPE)
      GO TO (600,431,999,701),NTEST
 430  CALL COOL(NTEST,KK1,A123,B123,D123,NTAPE)
      GO TO (600,435,999,701),NTEST
  435 NOB=NOB+1
      CALL TRNGEN(NVAR,NTG,NSAM,LEFT,LCASE,M,II)
      IF(LCASE) 409,407,407
 407  H=H+1.0
      HH = 0.0
      IF((H-1.0) .NE. 0.0) HH = H / (H-1.0)
      DO 8 I=1,NVAR1
      KL=KL+1
      IF(KL-255)1004,1004,1005
1005  WRITE(20)(C(IJK),IJK=1,255)
 5005 FORMAT(20A4)
      KL=1
 1004 C(KL)=DATA(I)
      AMAX(I)=AMAX1(AMAX(I),DATA(I))
      AMIN(I)=AMIN1(AMIN(I),DATA(I))
      SX(I)=SX(I)+DATA(I)
      Q(I)=DATA(I)
      IF(H.NE.0.0)Q(I)=Q(I)-SX(I)/H
      QQ=Q(I)*HH
      DO 8 J=1,I
 8    SXY(I,J)=SXY(I,J)+Q(J)*QQ
  600 CONTINUE
      NSAM1=NSAM1-NSAM2
      IF(NSAM1.GT.0)GO TO 77
 1011 DO 1012 I=1,NVAR1
      SX2(I)=SXY(I,I)
      DO 1012 J=1,I
 1012 SXY(J,I)=SXY(I,J)
      WRITE(20)(C(IJK),IJK=1,255)
      GO TO (508,505,506,505,507),JESUS
  505 NSAM=NOB
      GO TO 508
  506 NSAM=LEFT
      GO TO 508
  507 NSAM=NOB-(NSAM-LEFT)
  508 NVAR=NVAR1
      WRITE (6,502)NSAM
      IF(NSAM)500,500,501
  500 WRITE (6,503)
 610  IF(NSEL)998,998,615
 615  DO 620 I=1,NSEL
 620  READ (5,112)TODE
      GO TO 998
  501 END FILE 20
      REWIND 20
      WRITE (6,104)
      WRITE (6,105)(SX(I),I=1,NVAR)
      WRITE (6,108)
      FN=NSAM
      DO 10 I=1,NVAR
   10 DATA(I)=SX(I)/FN
      WRITE (6,105)(DATA(I),I=1,NVAR)
      IF(PQ1-PC7) 50,51,50
 50   WRITE (6,106)
      CALL PATTY(NVAR)
 51   IF(1.0-FN) 305,350,350
 305  WRITE (6,109)
      DO 11 I=1,NVAR
      DATA(I)=SX2(I)/(FN-1.0)
   11 DATA(I)=SQRT(DATA(I))
      WRITE (6,105)(DATA(I),I=1,NVAR)
      DO 12 I=1,NVAR
      DO 12 J=1,NVAR
   12 SXY(I,J)=SXY(I,J)/(FN-1.0)
      IF(PQ2-PC7) 52,53,52
 52   WRITE (6,110)
      CALL PATTY(NVAR)
 53   WRITE (6,111)
      DO 15 I=1,NVAR
      DO 15 J=1,NVAR
      IF((DATA(I).NE.0.0).AND.(DATA(J).NE.0.0))GO TO 14
      SXY(I,J)=99.
      GO TO 15
   14 SXY(I,J)=SXY(I,J)/(DATA(I)*DATA(J))
   15 CONTINUE
      CALL PATTY(NVAR)
 325  NPAGE=0
      IF(NSEL)6010,998,201
 201  CALL PLUT(NVAR,NSAM,NSEL,ICDCNT)
      GO TO 998
C
 350  WRITE (6,4000)
      GO TO 325
C
 102  FORMAT(2A6,I3,I5,I2,I4,I2,3A2   ,31X,I3,2I2)
 103  FORMAT(18A4)
  104 FORMAT(5H0SUMS//)
  105 FORMAT(1H 8F14.4)
  106 FORMAT(25H0CROSS PRODUCT DEVIATIONS)
  108 FORMAT(6H0MEANS//)
  109 FORMAT(20H0STANDARD DEVIATIONS//)
  110 FORMAT(27H0VARIANCE-COVARIANCE MATRIX//)
  111 FORMAT(19H0CORRELATION MATRIX//)
 112  FORMAT(A6,I3,I2,20I3)
  403 FORMAT(1H06X,23HTRANS GENERATOR CARD(S))
  404 FORMAT(46H0CARD    NEW     TRANS    ORIG.   ORIG. VAR(B)/45H  NO. 
     1VARIABLE   CODE    VAR(A)   OR CONSTANT)
  406 FORMAT(A6,I3,I2,I3,F6.0)
  413 FORMAT(//21H CASE SELECTION CARDS//)
  414 FORMAT(4(3X,I3,1X,A2,A6,1X,A2))
  415 FORMAT(22H A CASE IS ACCEPTED IF)
  417 FORMAT(6H (VAR(,I3,2H) ,A2,1X,A6,2H) ,A2)
  439 FORMAT(A6)
  442 FORMAT(F6.0)
  443 FORMAT(2X,F3.0)
  447 FORMAT(1H ,I3,I8,2I9,F14.4)
  502 FORMAT(23H0REMAINING SAMPLE SIZE=I5)
  503 FORMAT(18H0NO CASES ACCEPTED)
  704 FORMAT(45H0CONTROL CARDS INCORRECTLY ORDERED OR PUNCHED)
  709 FORMAT(A1)
 1000 FORMAT(13A6,A2)
 4000 FORMAT(115H0THE STANDARD DEVIATIONS, VARIANCE-COVARIANCE MATRIX AN
     1D CORRELATION MATRIX ARE UNDEFINED FOR A SAMPLE SIZE OF ONE.)
 4001 FORMAT(97H0INCORRECT TRANSGENERATION CODE ON CARD ABOVE. PROGRAM W
     1ILL PROCEED WITHOUT THIS TRANSGENERATION.)
 4002 FORMAT(1H023X71HNUMBER OF VARIABLE FORMAT CARDS INCORRECTLY SPECIF
     1IED, ASSUMED TO BE 1.)
C
      END
      SUBROUTINE COOL(NTEST,KK1,A123,B123,D123,NTAPE)
C              SUBROUTINE COOL FOR BMD02D         FEBRUARY  1, 1966
C              REWRITTEN BY DU BOIS     3-25-64
C     DEFINITION OF NTEST
C     NTEST=1 IF CASE FAILS BOOLEAN TEST
C     NTEST=2 IF CASE SATISFIES BOOLEAN TEST
C     NTEST=3 IF NEW PROBLEM CARD IS DETECTED
C     NTEST=4 IF FINISH CARD IS DETECTED
C
      COMMON CON(135),DATA(135),NEW(150),JUMP(150),NA(150),BN(150)
     1,NSUB(36),REL(36),AMIN(135),OP(36),INDEX(36),SX(135),SX2(135)
     2,AMAX(135),C(255),FMT(180),SXY(50,50)
      DIMENSION WK(8),IN(37)
      DOUBLE PRECISION A123,B123,D123,CON
C
      DATA            WK/2HGT,2HGE,2HLT,2HLE,2HEQ,2HNE,2HOR,2HAN/
      DO 100 I=1,KK1
      IS=NSUB(I)
C
C     EXAMINE BOOLEAN EXPRESSION FOR GT, GE, LT, LE, EQ, NE
C
      DO 55 J=1,6
      IF(REL(I) .EQ. WK(J)) GO TO 26
   55 CONTINUE
      GO TO 311
   26 IF(INDEX(I)) 27,27,28
   27 CC=CON(I)
      GO TO 29
   28 K=CON(I)
      CC=DATA(K)
   29 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
      GO TO 100
   50 IN(I)=0
  100 CONTINUE
      NTEST=IN(1)
      KK=KK1-1
      IF(KK)500,500,501
C
C     EXAMINE BOOLEAN OPERATOR FOR OR/AN
C
 501  DO 200 I=1,KK
      IF(OP(I) .NE. WK(7)) GO TO 222
  191 IF(NTEST) 199,199,321
  199 NTEST=IN(I+1)
      GO TO 200
 222  IF(OP(I) .NE. WK(8)) GO TO 301
  223 NTEST=NTEST*IN(I+1)
  200 CONTINUE
 500  IF(NTEST)320,320,321
  321 NTEST=2
      GO TO 333
  320 NTEST=1
      GO TO 333
C
C     ERROR LOOK FOR NEXT PROBLEM OR FINISH CARD
C     A123=6HFINISH
C     B123=6HPROBLM
C     D123=6HPLOTSL
C
  311 X=REL(I)
      GO TO 313
  301 X=OP(I)
  313 WRITE (6,2000)X
      IF(NTAPE-5) 302,302,304
  302 J=NTAPE
  312 READ (J,1000)(DATA(K),K=1,14)
      IF(DATA(1) .EQ. D123) GO TO 312
 305  IF(DATA(1) .EQ. B123) GO TO 306
 307  IF(DATA(1) .EQ. A123) GO TO 309
      GO TO 312
  306 NTEST=3
      GO TO 333
  309 NTEST=4
      GO TO 3333
  304 REWIND NTAPE
      J=5
      GO TO 312
 3333 TYPE 3000
 3000 FORMAT(' FINISH CARD ENCOUNTERED')
 1000 FORMAT(13A6,A2)
 2000 FORMAT(31H1ILLEGAL OPERATOR OR RELATION  ,A2,58H  IN CASE SELECTIO
     1N CARD. PROGRAM SKIPPED TO NEXT PROBLEM.)
  333 RETURN
      END
      SUBROUTINE PATTY(N)
C              SUBROUTINE PATTY FOR BMD02D        FEBRUARY  1, 1966
      COMMON CON(135),DATA(135),NEW(150),JUMP(150),NA(150),BN(150)
     1,NSUB(36),REL(36),AMIN(135),OP(36),INDEX(36),SX(135),SX2(135)
     2,AMAX(135),C(255),FMT(180),A(50,50)
      DIMENSION NN(8)
      DOUBLE PRECISION CON
      EQUIVALENCE (NN,SX)
C
      IT=1
      KK=0
      K1=IT
      K2=MIN0(8,N)
    5 KK=KK+8
      IF(N-KK)3,3,4
    4 IT=IT+1
      GO TO 5
    3 DO 50 JX=1,IT
      LLL=K2-K1+1
      LL=0
      DO 40 JJ=K1,K2
      LL=LL+1
   40 NN(LL)=JJ
      WRITE (6,300)(NN(II),II=1,LLL)
      DO 10 I=1,N
   10 WRITE (6,20)I,(A(I,J),J=K1,K2)
      K1=K2+1
      K2=K1+7
      K2=MIN0(K2,N)
   20 FORMAT(1H I3,F11.4,7F14.4)
  300 FORMAT(1H08X,4HCOL.7(10X,4HCOL.),/8X,I3,7( 11X,I3),/4H ROW//)
   50 CONTINUE
      RETURN
      END
      SUBROUTINE PLUT(NV,NO,NPL,ICDCNT)
C             SUBROUTINE PLUT FOR BMD02D          FEBRUARY  1, 1966
      COMMON BC(135),DATA(135),IX(150),IY(150),NA(150),X(150),JC(36)
     1,REL(36),AMIN(135),T(36),MM(36),SX(135),SX2(135),R(135),C(255)
     2,FMT(180),SXY(50,50)
      DOUBLE PRECISION BC,Z,PL
      INTEGER XY(51,101),SYM,BLANK
      DATA PL/6HPLOTSL/,P/1H./,C4/1H+/,BLANK/2H  /,SYM/1H1/
C
      NV1=NV+1
      DO 800 I=1,NV
      CALL SCALE(AMIN(I),R(I),100.0,JJJJ,AMIN(I),R(I),HHH)
 800  R(I)=R(I)-AMIN(I)
      IT=1
 94   REWIND 20
      K=0
9876  FORMAT(2I10)
      DO 570 II=1,NPL
C
C
C
C
      ICDCNT = ICDCNT + 1
      READ (5,2)Z,LL,N,(MM(I1), I1=1,20)
 2    FORMAT(A6,I3,I2,20I3)
      IF(LL*(NV1-LL))3,3,77
 77   IF(Z .EQ. PL) GO TO 5
    3 WRITE(6,10)ICDCNT,Z,LL,N,(MM(KK),KK=1,20)
   10 FORMAT('0ERROR ON PLOT SELECTION CARD',I4,2X,A6,I3,I2,20I3)
      GO TO 570
 5    DO 6 I=1,20
      IF((NV -MM(I))*MM(I))1,7,7
    1 WRITE(6,10)ICDCNT,Z,LL,N,(MM(KK),KK=1,20)
      WRITE(6,11) ICDCNT,I,NV
 11   FORMAT(' PLOTSL CARD',I4,'DESIGNATES AN INCORRECT CROSS-PLOT SELEC
     1TION IN POSITION',I4,'SHOULDN''NT EXCEED',I4)
      GO TO 570
 7    IF(MM(I))770,770,8
 8    K=K+1
      IX(K)=MM(I)
 6    IY(K)=LL
  770 IF((II-NPL)*(K-100))570,600,600
 600  KN=K
      LEFF=0
  505 LEFF=LEFF+1
      DO 295 I1=1,51
      DO 295 I2=1,101
  295 XY(I1,I2)=BLANK
      KIX=IX(LEFF)
      KIY=IY(LEFF)
C
      KL=255
      DO 13 JJ=1,NO
 301  DO 12 J=1,NV
      KL=KL+1
      IF(KL-255) 12,12,14
   14 READ(20)(C(IJK),IJK=1,255)
      KL=1
 12   X(J)=C(KL)
C
      L=KIX
      M=KIY
      L=51.5-(X(L)-AMIN(L))/R(L)*50.0
      IF((52-L)*L)13,13,70
 70   M=(X(M)-AMIN(M))/R(M)*100.0+1.5
      IF((102-M)*M)13,13,71
   71 CALL FORM2(SYM,XY(L,M))
 13   CONTINUE
 701  REWIND 20
      DO 40 N=1,101
 40   C(N)=P
      DO 41 N=1,101,5
 41   C(N)=C4
C
      L=KIX
      M=KIY
      Q=AMIN(M)
      D=R(M)/10.0
      DO 51 N=1,11
      T(N)=Q
 51   Q=Q+D
      Q=AMIN(L)+R(L)
      D=R(L)/50.0
      DO 52 N=1,51
      X(N)=Q
 52   Q=Q-D
 50   WRITE (6,54)M,L,(T(N),N=1,11,2),(T(N),N=2,10,2),(C(N),N=1,101),(X(
     1K00),C(K00),(XY(K00,N),N=1,101),C(K00),X(K00),K00=1,51),(C(N),N
     2=1,101),(T(N),N=1,11,2),(T(N),N=2,10,2)
 54   FORMAT(11H1  VARIABLE48X,8HVARIABLEI3/I7/2X,F15.3,
     1    5F20.3/7X,5F20.3/13X,101A1,51(/1X,F10.3,1X,103A1        ,F10.3
     2)/13X,101A1/2X,F15.3,5F20.3/7X,5F20.3)
      IF(LEFF-KN)505,580,580
 580  K=0
 570  CONTINUE
 900  RETURN
      END
      SUBROUTINE SCALE(YMIN,YMAX,YINT,JY,TYMIN,TYMAX,YIJ)
C
      DIMENSION C(10)
      DATA C           /1.0,1.5,2.0,3.0,4.0,5.0,7.5,10.0,15.0,20.0/
        DATA TEST / 0.76293945E-05/
C
   50 YR=YMAX-YMIN
      TT=YR/YINT
      J=TEST
      IF(TT.GT.0.0)J=J+ALOG10(TT)
      E=10.0**J
      TT=TT/E
      I=0
      IF(TT-1.0+TEST)205,201,201
  205 TT=TT*10.0
      E=E/10.0
 201  I=I+1
      IF(9-I)1,2,2
    1 E=E*10.0
      I=1
    2 IF(TT-C(I))233,202,201
  233 YIJ=C(I)*E
      GO TO 203
  202 Y=YMIN/C(I)
      J=Y
      T=J
      IF(0.0001-ABS(T-Y))204,233,233
  204 YIJ=C(I+1)*E
  203 X=((YMAX+YMIN)/YIJ-YINT )/2.0+.00001
      K=X
      IF(K)235,240,240
  235 Y=K
      IF(X-Y)236,240,236
  236 K=K-1
  240 TYMIN=K
      TYMIN=YIJ*TYMIN
      TYMAX=TYMIN+YINT*YIJ
      IF (YMAX-TYMAX-TEST)11,11,201
   11 YIJJ=C(I)*E
      XT=((YMAX+YMIN)/YIJJ-YINT)/2.0+.00001
      KT=XT
      IF (KT) 1235,1240,1240
 1235 YT=KT
      IF (XT.NE.YT) KT=KT-1
 1240 TYMINT=KT
      TYMINT=YIJJ*TYMINT
      TYMAXT=TYMINT+YINT*YIJJ
      IF (YMAX-TYMAXT.GT.TEST) GO TO 10
      TYMIN=TYMINT
      TYMAX=TYMAXT
      YIJ=YIJJ
      K=KT
   10 TT=YINT/10.0
      JY=TT+.000001
      YIJ=YINT*(YIJ/10.0)
      J=TYMIN/ YIJ
      IF (K)242,241,241
  242 J=J-1
  241 J=J*JY+JY-K
      JY=J
      RETURN
      END
      SUBROUTINE FORM2(SYMB,XY)
      INTEGER XY,SYMB,SYM(63)
      INTEGER BLANK
      DATA BLANK/2H  /
      DATA SYM           /        1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9,1HA,
     11HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,1HK,1HL,1HM,1HN,1HO,1HP,1HQ,
     21HR,1HS,1HT,1HU,1HV,1HW,1HX,1HY,1HZ,6*1H-,6*1H+,7*1H*,8*1H$,2*1H//
      IF (XY.EQ.BLANK ) GO TO 50
      DO 30 I=1,62
      IF (XY.NE.SYM(I)) GO TO 30
      XY=SYM(I+1)
      GO TO 100
   30 CONTINUE
      IF (XY.EQ.SYM(63) ) GO TO 100
      XY=SYM(1)
      GO  TO 100
   50 XY=SYMB
  100 RETURN
      END
      SUBROUTINE TPWD(NT1,NT2,PQ3)
C             SUBROUTINE TPWD FOR BMD02D          FEBRUARY  1, 1966
      DATA P/2HNO/
      IF(NT1)40,10,12
 10   NT1=5
 12   IF(NT1-NT2)14,19,14
   14 IF(NT2.EQ.5)GO TO 18
 17   REWIND NT2
   19 IF(NT1-5)18,24,18
 18   IF(NT1-6)22,40,22
 22   IF(P-PQ3)1,24,1
 1    REWIND NT1
 24   NT2=NT1
 28   RETURN
 40   WRITE (6,49)
      CALL EXIT
      STOP
 49   FORMAT(25H ERROR ON TAPE ASSIGNMENT)
      END
      SUBROUTINE TRNGEN(IND,NVG,NODATA,ISAMP,LCASE,MERRY,N)
C             SUBROUTINE TRNGEN FOR BMD02D           APRIL 20, 1966
C
      COMMON CON(135),DATA(135),NNEWA(150),LLCODE(150),LLVA(150),
     1 BBNEW(150),NSUB(36),REL(36),AMIN(135),OP(36),INDEX(36),SX(135),
     2 SX2(135),AMAX(135),C(255),FMT(180),VECTOR(50,50)
      DOUBLE PRECISION CON
      EXTERNAL SIGN
      ASN(XX)=ATAN(XX /SQRT(1.0-XX**2))
C
      ITEM=N
      SAMP=NODATA
      DO 3 J=1,NVG
  305 NEWA=NNEWA(J)
      LCODE=LLCODE(J)
 310  LVA=LLVA(J)
      BNEW=BBNEW(J)
  315 IF(LCODE.LE.10)GO TO 4
    5 NEWB=BNEW
    4 D=DATA(LVA)
      IF(LCODE-41)500,170,3
  500 GO TO (10,20,30,40,50,60,70,80,90,100,110,120,130,140,
     1150,160),LCODE
   10 IF(D)99,7,8
    7 DATA(NEWA)=0.0
      GO TO 3
    8 DATA(NEWA)=SQRT(D)
      GO TO 3
   20 IF(D)99,11,12
   11 DATA(NEWA)=1.0
      GO TO 3
   12 DATA(NEWA)=SQRT(D)+SQRT(D+1.0)
      GO TO 3
   30 IF(D.LE.0.0)GO TO 99
 14   DATA(NEWA) = ALOG10(D)
      GO TO 3
   40 DATA(NEWA)=EXP(D)
      GO TO 3
   50 IF(D)99,7,17
   17 IF(D-1.0)18,19,99
   19 DATA(NEWA)=3.14159265/2.0
      GO TO 3
   18 A=SQRT(D)
      DATA(NEWA)=ASN(A)
      GO TO 3
   60 A=D/(SAMP+1.0)
      B=A+1.0/(SAMP+1.0)
      IF(A)99,23,24
   23 IF(B)99,7,27
   27 DATA(NEWA)=ASN(SQRT(B))
      GO TO 3
   24 IF(B)99,28,29
   28 DATA(NEWA)=ASN(SQRT(A))
      GO TO 3
   29 A=SQRT(A)
      B=SQRT(B)
      DATA(NEWA)=ASN(A)+ASN(B)
      GO TO 3
   70 IF(D.EQ.0.0)GO TO 99
   31 DATA(NEWA)=1.0/D
      GO TO 3
   80 DATA(NEWA)=D+BNEW
      GO TO 3
   90 DATA(NEWA)=D*BNEW
      GO TO 3
  100 IF(D.EQ.0.0)GO TO 7
   33 DATA(NEWA)=D**BNEW
      GO TO 3
  110 DATA(NEWA)=D+DATA(NEWB)
      GO TO 3
  120 DATA(NEWA)=D-DATA(NEWB)
      GO TO 3
  130 DATA(NEWA)=D*DATA(NEWB)
      GO TO 3
  140 IF(DATA(NEWB).EQ.0.0)GO TO 99
   34 DATA(NEWA)=D/DATA(NEWB)
      GO TO 3
  150 IF(D-BNEW)7,11,11
  160 IF(D-DATA(NEWB))7,11,11
  170 IF(D.NE.0.0)GO TO 3
  503 IF(SIGN(10.0,D)) 504,3,3
  504 DATA(NEWA)=BNEW
    3 CONTINUE
      GO TO 42
   99 LCASE=-999
      IF(MERRY-J) 402,401,402
  402 MERRY=J
      WRITE (6,1404)J
  401 WRITE (6,1405)ITEM
      WRITE (6,1408)
      ISAMP=ISAMP-1
   42 RETURN
 1404 FORMAT(30H0THE INSTRUCTIONS INDICATED ON/25H TRANS GENERATOR CARD 
     1NO.I2,4H RE-/29H SULTED IN THE VIOLATION OF A/31H RESTRICTION FOR 
     2THIS TRANSFOR-/31H MATION. THE VIOLATION OCCURRED/27H FOR THE CASE
     3 LISTED BELOW./)
 1405 FORMAT( 9H CASE NO.I5)
1408  FORMAT(45H0THIS CASE WILL BE DELETED FOR ALL VARIABLES )
C
      END