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

C             GENERAL PLOT WITH HISTOGRAM            APRIL  1, 1966
C        THIS IS A SIFTED VERSION OF BMD05D ORIGINALLY WRITTEN IN
C        FORTRAN II. SOME MODIFICATIONS WERE MADE TO MAKE IT OPERABLE
C        AND SLIGHTLY MORE EFFICIENT THAN THE SIFTED VERSION.
C        IT WAS THEN CONVERTED TO 360 FORTRAN IV (H-LEVEL)
      DIMENSION FG(120),X(5000),NX(15),HEAD(54),XMI(500),XMA(500),
     1Z(15),NXX(15)
      COMMON SYM(15),XY(51,34),X,HEAD,Z
C
      EQUIVALENCE (FG,XMI)
      DOUBLE PRECISION A123,B123,C123,D123,TODE,SAME
C
 110  FORMAT ('1BMD05D GENERAL PLOT - INCLUDING HISTOGRAM',
     * ' - REVISED FEBRUARY 17, 1969'/
     241H HEALTH SCIENCES COMPUTING FACILITY, UCLA  /)
      DATA A123/6HFINISH/
      DATA B123/6HPROBLM/
      DATA C123/6HCRSVAR/
      DATA D123/6HSELECT/
      DATA YES/'YES'/
      DATA BLANK/'   '/
      DATA NO/' NO'/
      DATA RE / 'NO' /
      NTAPE=5
	CALL USAGEB('BMD05D')
5     READ(5,101) TODE,SAME,NV,NP,NG,NADD,REW,NTRAN,MTAPE,NCARD
  204 FORMAT(45H0CONTROL CARDS INCORRECTLY ORDERED OR PUNCHED)
      IF(TODE .NE. A123) GO TO 200
      GO TO 201
  800 PRINT 801, TODE
      GO TO 202
  802 PRINT 803
      GO TO 202
  804 PRINT 805
      GO TO 202
  806 PRINT 807
      GO TO 202
  808 PRINT 809
      GO TO 202
  810 PRINT 811
      GO TO 202
  812 PRINT 813
      GO TO 202
  814 PRINT 815, TODE
      GO TO 202
  816 PRINT 817
      GO TO 202
  818 PRINT 819
      GO TO 202
  820 PRINT 821, TODE
  202 WRITE (6,204)
 201  IF(NTAPE-5)308,308,307
 307  REWIND NTAPE
 308  CALL EXIT
 200  IF(TODE .NE. B123) GO TO 800
  203 IF (REW.NE.RE) CALL TPWD(MTAPE,NTAPE)
      IF (REW.EQ.RE) GO TO 3050
      GO TO 306
 3050 IF (MTAPE.EQ.BLANK) NTAPE = 5
      IF (MTAPE.NE.BLANK) NTAPE = MTAPE
 306  IF(NV*(NV-501))309,802,802
 309  IF((NP-1)*(NP-20001))205,804,804
  205 IF((NV+NADD)*NP-5000) 206,206,806
  206 IF(NCARD.GT.0.AND.NCARD.LE.10)GO TO 207
      NCARD=1
      WRITE(6,4000)
  207 WRITE (6,110)
      WRITE (6,210)SAME,NV,NP,NG,NADD,NTRAN,NCARD
      IF (REW.EQ.RE) WRITE(6,1210) NO
      IF (REW.NE.RE) WRITE(6,1210) YES
   71 NTOT=NP*NV-NP
      IF((NV+NADD)*(NV+NADD-501))1,808,808
    1 NCARD=NCARD*18
      READ (5,102)(FG(I),I=1,NCARD)
      PRINT 1031,(FG(I),I=1,NCARD)
 1031 FORMAT ('0',' VARIABLE FORMAT CARD(S)'/1X,18A4)
      NCARD=NTOT+NP
      DO 211 I=1,NCARD
 211  X(I)=0.0
   70 DO 3 I=1,NP
C      *****   READ IN THE RAW DATA AND TRANSPOSE THE MATRIX
      READ (NTAPE,FG)(XMA(J), J=1,NV)
       DO 3  J=1,NV
       K=NP*J-NP+I
 3     X(K)=XMA(J)
      IF(NTRAN) 810,22,21
   21 CALL TRANS(NP,NV,NTRAN)
      IF(NV) 812,812,22
   22 NPV=NP
      NV=NV+NADD
      K=1
      DO 63 I=1,NV
      XMI(I)=99999999.0
      XMA(I)=-99999999.0
      DO 64 J=K,NPV
      XMI(I)= AMIN1(X(J),XMI(I))
   64 XMA(I)= AMAX1(X(J),XMA(I))
      K=K+NP
   63 NPV=NPV+NP
      DO 50 JJ=1,NG
      READ (5,104)TODE,NH,NL,NC,NY,FN
      IF(TODE .NE. D123) GO TO 814
 209  IF(NH*(NH-3))215,816,816
 215  NH=NH*18
      READ (5,102)(HEAD(I),I=1,NH)
      IF(NC) 818,20,8
 8    NNC=(NC+6)/7
      IF(NNC-2)9,9,818
 9    NG2=0
      DO 150 I=1,NNC
      NG1=NG2+1
      NG2=NG2+7
      READ (5,105)TODE,(NX(J),SYM(J),J=NG1,NG2)
      IF(TODE .NE. C123) GO TO 820
 150  CONTINUE
      XMAX=-99999999.0
      XMIN=99999999.0
      IF(NC-1)20,11,12
   11 J=NX(1)
      XMAX=XMA(J)
      XMIN=XMI(J)
      GO TO 14
   12 DO 13 I=1,NC
      J=NX(I)
      XMAX= AMAX1(XMAX,XMA(J))
   13 XMIN= AMIN1(XMIN,XMI(J))
   14 NPV=0
   10 DO 65 I=1,NC
   65 NXX(I)=NX(I)*NP-NP
      NYY=NY*NP-NP
      IF(NL)23,23,24
   24 WRITE (6,110)
      IF(9-NC)242,249,249
  242 WRITE (6,108)NY,(NX(I),I=1,9)
      WRITE (6,112)
      WRITE (6,111)(NX(I),I=10,NC)
      GO TO 250
  249 WRITE (6,108)NY,(NX(I),I=1,NC)
  250 WRITE (6,112)
      DO 26 I=1,NP
      MY=NYY+I
      Y=X(MY)
      DO 25 J=1,NC
      MX=NXX(J)+I
   25 Z(J)=X(MX)
   26 WRITE (6,106)Y,(Z(K),K=1,NC)
   23 WRITE (6,110)
      WRITE (6,103)(HEAD(I),I=1,NH)
       WRITE (6,4444) NY, (NX(ICK),SYM(ICK),ICK=1,NC)
 4444  FORMAT (2X,'PLOT OF VARIABLE',I3, ' (VERTICAL AXIS) VERSUS VARIAB
     *LE(S)', I3,' (SYMBOL=', A1,'),', 7(I3,'(',A1,'),') /
     * 56X, 6(I3, '(',A1, '),'))
      NNP=FN
      YMAX=XMA(NY)
      YMIN=XMI(NY)
      DO 16 I=1,NP
      ASSIGN 155 TO ISKIP
      MY=NYY+I
      Y=X(MY)
      DO 15 J=1,NC
      MX=NXX(J)+I
   15 Z(J)=X(MX)
      GO TO ISKIP,(155,157)
 155  CALL PLOTR(Y,YMIN,YMAX,Z,SYM,XMIN,XMAX,NC,NNP)
      ASSIGN 157 TO ISKIP
      GO TO 16
 157  CALL PLOTR(Y,YMIN,YMAX,Z,SYM,XMIN,XMAX,NC,NNP)
   16 CONTINUE
      IF(NNP)31,32,32
   31 NC=-1
      GO TO 33
   32 NC=0
 33   CALL PLOTR(Y,YMIN,YMAX,Z,SYM,XMIN,XMAX,NC,NNP)
      GO TO 50
   20 NYT=NY*NP
      NYY=NYT-NP+1
      IF(NL)29,29,28
  28  WRITE (6,110)
      NNC=(NP+9)/10
      NG2=NYY-1
      WRITE (6,107)NY
      DO 285 I=1,NNC
      NG1=NG2+1
      NG2=NG2+10
      IF(NYT-NG2)283,284,284
 283  NG2=NYT
 284  WRITE (6,125)(X(J),J=NG1,NG2)
 285  CONTINUE
   29 WRITE (6,110)
      WRITE (6,103)(HEAD(I),I=1,NH)
       WRITE (6,707) NY
 707   FORMAT ('  HISTOGRAM OF VARIABLE ', I3)
      XMAX=XMA(NY)
      XMIN=XMI(NY)-.0000005
      IF((XMAX-XMIN)/FN-34.0)34,34,35
   35 FN=(XMAX-XMIN)/34.0
      WRITE (6,109)FN
   34 CALL HIST(NYY,NYT,XMIN,XMAX,FN,NP)
   50 CONTINUE
      GO TO 5
C
  101 FORMAT(2A6,I3,I5,I3,I4,36X,A2,I3,2I2)
 102  FORMAT(18A4)
  103 FORMAT(24X,18A4)
  104 FORMAT(A6,2I1,I2,I3,F11.0)
 105  FORMAT(A6,7(I3,A4,2X))
  106 FORMAT(1H 10(F10.4,1X))
  107 FORMAT(1H 23H HISTOGRAM OF VARIABLE I3//)
  108 FORMAT(14H BASE VARIABLE,38X, 16H CROSS VARIABLES/6X,10(I3,8X))
  109 FORMAT(1H ,54H THE VALUE GIVEN FOR THE INTERVAL WIDTH IS TOO SMALL
     1. /13H A NEW VALUE,F11.4,22H,HAS BEEN SUBSTITUTED.//)
  111 FORMAT(5X,5(I3,8X))
  112 FORMAT(1H )
 125  FORMAT(1H 10F11.4)
 210  FORMAT(14H PROBLEM CODE ,3(2H. ),1X,A6/18H NO. OF VARIABLES ,
     13(2H. ),I3/14H NO. OF CASES ,4(2H. ),I5/24H NO. OF SELECTION CARDS
     2 ,I3/24H NO.OF VARIABLES ADDED ,I3/22H NO. OF TRNGEN CARDS ,2H. ,
     3I3/22H NO. OF FORMAT CARDS ,2H. ,I3)
 1210 FORMAT (' REWIND INPUT TAPE .... ',A3)
  801 FORMAT(' PROGRAM EXPECTED PROBLM OR FINISH CARD INSTEAD READ THE
     1 FOLLOWING'/1X,A6)
  803 FORMAT(' NUMBER OF VARIABLES INCORRECTLY SPECIFIED')
  805 FORMAT(' NUMBER OF CASES INCORRECTLY SPECIFIED')
  807 FORMAT(' TOTAL DATA INPUT CANNOT EXCEED 20,000')
  809 FORMAT(' NUMBER OF VARIABLES AFTER TRANSGENERATION CANNOT EXCEED 5
     100')
  811 FORMAT(' PROBLM CARD ERROR'/' NUMBER OF TRANSGENERATION CARDS IS N
     1EGATIVE')
  813 FORMAT(' NUMBER OF VARIABLES AFTER TRANSGENERATION HAS BECOME LESS
     1 THAN OR EQUAL TO ZERO')
  815 FORMAT(' PROGRAM EXPECTED SELECT CARD INSTEAD READ THE FOLLOWING'/
     11X,A6)
  817 FORMAT(' NUMBER OF HEADING CARDS INCORRECTLY SPECIFIED')
  819 FORMAT(' NUMBER OF CROSS VARIABLES TO APPEAR ON GRAPH IS INCORRECT
     LY SPECIFIED'/' ERROR ON SELECT CARD')
  821 FORMAT(' PROGRAM EXPECTED CRSVAR CARD INSTEAD READ THE FOLLOWING'/
     11X,A6)
 4000 FORMAT(1H023X71HNUMBER OF VARIABLE FORMAT CARDS INCORRECTLY SPECIF
     1IED, ASSUMED TO BE 1.)
C
      END
C             SUBROUTINE HIST FOR BMD05D             APRIL  1, 1966
      SUBROUTINE HIST(NYY,NYT,XMIN,XMAX,SYMB,NP)
      COMMON SYM(15),XY(51,34),X,HEAD,Z
      DIMENSION X(5000),K000FX(35),XM(3),D(3),Z(15),BONE(3),CLAB(36)
C
      DATA TEMP1/3H   /
      DATA TEMP2/1H+/
      DATA TEMP3/1H./
      DATA TOPPER/3H---/,FILLER/3H111/
   23 FORMAT(1H F5.1,1X,A1,34A3,A1,1X,F5.1)
 101  FORMAT (5X,17(F5.1,1X),F5.1/8X,17(F5.1,1X)/8X,17('+++...'))
 102  FORMAT(8X,17('+++...')/5X,17(F5.1,1X),F5.1/8X,17(F5.1,1X))
 4000 FORMAT( 8H  MIN = ,F12.6,80X,7H MAX = ,F12.6)
      M=1
      WRITE (6,4000)XMIN,XMAX
      DO 50 I=1,35
   50 K000FX(I)=0
      DO 100 K=1,34
      DO 100 J=1,50
 100  XY(J,K) = TEMP1
      MINH=XMIN/SYMB
      TXMIN=XMIN/SYMB-1.0
      CLAB(1)=XMIN
       DO 16 I=2,35
   16 CLAB(I)=CLAB(I-1)+SYMB
       WRITE (6,101) (CLAB(I),I=1,35,2),(CLAB(J),J=2,34,2)
      DO 1 I=NYY,NYT
      K=X(I)/SYMB-TXMIN
      K000FX(K)=K000FX(K)+1
      IF(K000FX(M)-K000FX(K))8,1,1
    8 M=K
    1 CONTINUE
      YMAX=K000FX(M)
      SC=50.0
 32   IF(YMAX-SC)30,30,31
 31   SC=SC+50.0
      GO TO 32
C
 30   SC = 50.0 / SC
 15   DO 6 I=1,34
      XL = K000FX(I)
      L = XL * SC + 0.5
      IF(L) 5,6,5
 5    XY(L,I) = TOPPER
      L=L-1
      IF(L)11,6,11
   11 DO 10 K=1,L
 10   XY(K,I) = FILLER
    6 CONTINUE
      DO 7 K=1,50
      L=51-K
      R=L
      R=R/SC
      I=MOD(K,5)
      IF(I-1)2,3,2
 3    W = TEMP2
      GO TO 7
 2    W = TEMP3
    7 WRITE (6,23)R,W,(XY(L,M),M=1,34),W,R
       WRITE (6,102) (CLAB(I),I=1,35,2),(CLAB(J),J=2,34,2)
      RETURN
      END
      SUBROUTINE TPWD(NT1,NT2)
C        SUBROUTINE TPWD FOR BMD05D                  APRIL  1, 1966
      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   REWIND NT1
 24   NT2=NT1
 28   RETURN
 40   WRITE (6,49)
      STOP
 49   FORMAT(25H ERROR ON TAPE ASSIGNMENT)
      END
      SUBROUTINE TRANS(N,NJ,NTR)
C             SUBROUTINE TRANS FOR BMD05D            APRIL  1, 1966
C
       COMMON DUM(15),UJUNK(51,34),DATA(5000)
      DOUBLE PRECISION C123,TODE
      ASN(XX)=ATAN(XX/SQRT(1.0-XX**2))
C
      DATA C123/6HTRNGEN/
C
      ON=N+1
      MARY=0
      WRITE (6,1403)
      WRITE (6,1400)
      IERROR=0
      DO 1000 I=1,NTR
      READ (5,900)TODE,NE,NC,NV,CO
      IF(TODE .EQ. C123) GO TO 6
  300 NJ=-NJ
      RETURN
    6 WRITE (6,1402)I,NE,NC,NV,CO
      MA=N*NE-N
      MB=N*NV-N+1
      MC=MB+N-1
      IF(NC*(15-NC))1500,1500,2
 2    IF(NC-11) 4, 3, 3
    3 K=CO
      MD=N*K-N
    4 DO 210 J=MB,MC
      D1=DATA(J)
      MA=MA+1
      MD=MD+1
    5 CONTINUE
      GO TO (10,20,30,40,50,60,70,80,90,100,110,120,130,140),NC
   10 IF(D1)99,32,8
    8 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)99,99,14
   14 D2=ALOG10(D1)
      GO TO 200
   40 D2=EXP(D1)
      GO TO 200
   50 IF(D1)99,32,17
   17 IF(D1-1.0)18,19,99
   19 D2=3.14159265/2.0
      GO TO 200
   18 D2=ASN(SQRT(D1))
      GO TO 200
   60 A=D1/ON
      B=A+1.0/ON
      IF(A)99,23,24
   23 IF(B)99,32,27
   27 D2=ASN(SQRT(B))
      GO TO 200
   24 IF(B)99,28,29
   28 D2=ASN(SQRT(A))
      GO TO 200
   29 A=SQRT(A)
      B=SQRT(B)
      D2=ASN(A)+ASN(B)
      GO TO 200
   70 IF(D1)31,99,31
   31 D2=1.0/D1
      GO TO 200
   80 D2=D1+CO
      GO TO 200
   90 D2=D1*CO
      GO TO 200
  100 IF(D1)33,32,33
   32 D2=0.0
      GO TO 200
   33 D2=D1**CO
      GO TO 200
  110 D2=D1+DATA(MD)
      GO TO 200
  120 D2=D1-DATA(MD)
      GO TO 200
  130 D2=D1*DATA(MD)
      GO TO 200
  140 IF(DATA(MD))157,99,157
  157 D2=D1/DATA(MD)
      GO TO 200
   99 IF(MARY)43,44,44
   44 MARY=-999
      IERROR=-999
      WRITE (6,1404)I
   43 WRITE (6,1405)J
      GO TO 210
  200 DATA(MA)=D2
  210 CONTINUE
      MARY=0
 1000 CONTINUE
      IF(IERROR)42,1111,1111
   42 WRITE (6,1401)
 1111 RETURN
C
  900 FORMAT(A6,I3,I2,I3,F6.0)
 1500 WRITE (6,1406)
      GO TO 1000
C
 1400 FORMAT(46H0CARD    NEW     TRANS    ORIG.   ORIG. VAR(B)/45H  NO. 
     1VARIABLE   CODE    VAR(A)   OR CONSTANT)
 1401 FORMAT(78H VALUES OF VARIABLES OF WHICH AN ERROR WAS FOUND DURING
     1TRANS-GENERATION WILL /77H STILL BE INCLUDED IN THE GRAPHS. HOWEVE
     2R, THESE GRAPHS MAY BE MEANINGLESS   /54H SINCE SOME VALUES WILL B
     3E TRANSFORMED AND OTHERS NOT.)
 1402 FORMAT(2H  I2,I8,2I9,4X,F10.5)
 1403 FORMAT(1H06X,23HTRANS GENERATOR CARD(S))
 1404 FORMAT(55H0THE INSTRUCTIONS INDICATED ON TRANS GENERATOR CARD NO.I
     12,1X,3HRE-/60H SULTED IN THE VIOLATION OF A RESTRICTION FOR THIS T
     2RANSFOR-/59H MATION. THE VIOLATION OCCURRED FOR THE ITEMS LISTED B
     3ELOW.)
 1405 FORMAT(10H ITEM NO. I5)
 1406 FORMAT(107H0TRANSGENERATION CODE ON CARD LISTED ABOVE IS INCORRECT
     1. PROGRAM WILL PROCEED WITHOUT THIS TRANSGENERATION.)
C
      END
      SUBROUTINE PLOTR(X,ZMIN,ZMAX,Y,SYM,WMIN,WMAX,NC,NP)
C             SUBROUTINE PLOTR (IBM 360)              AUGUST 13, 1966
C
C     'PLOTR' IS A UTILITY SUBPROGRAM FOR THE BMD... PROGRAMS WHICH
C     PLOTS EITHER SINGLE-LINE OR WHOLE-PAGE GRAPHS AND SETS UP
C     APPROPRIATE SCALING.  THE CALLING PARAMETERS ARE AS FOLLOWS -
C
C     X - THE VALUE OF THE INDEPENDENT VARIABLE
C     ZMIN - THE MINIMUM VALUE OF X FOR THIS PLOT
C     ZMAX - THE MAXIMUM VALUE OF X FOR THIS PLOT
C     Y - THE ARRAY CONTAINING THE VALUES OF UP TO 15 DEPENDENT VAR.'S
C     SYM - THE ARRAY CONTAINING THE SYMBOLS TO BE PLOTTED
C     WMIN - THE MINIMUM VALUE OF ALL Y'S FOR THIS PLOT
C     WMAX - THE MAXIMUM VALUE OF ALL Y'S FOR THIS PLOT
C     NC - THE NUMBER OF DEPENDENT VARIABLES
C               NC=-1 CLOSES A SINGLE-LINE PLOT
C               NC= 0 PRINTS AND CLOSES A WHOLE-PAGE PLOT
C     NP - THE CONTROL VARIABLE
C               NP=-1 PRINTS A SINGLE LINE
C               NP=0 OR NP=1 SETS UP A WHOLE-PAGE PLOT
C
C     THE PLOTTING ROUTINE MUST BE CALLED ONCE FOR EACH VALUE OF THE
C     INDEPENDENT VARIABLE THAT IS TO BE PLOTTED NO MATTER WHETHER IN
C     THE SINGLE-LINE OR WHOLE-PAGE MODE
C
      DIMENSION Y(15),CLAB(12),GF(10),FMT(12),XY(51,101),SYM(15)
      INTEGER XY,BLANKS
      DATA TC,TP,BLANKS/1H.,1H+,1H /
      DATA GF/            4H 1X,,4H 2X,,4H 3X,,4H 4X,,4H 5X,,4H 6X,,
     14H 7X,,4H 8X,,4H 9X,,4H 10X/
      DATA FMT/'(17X',' ','5(F1','2.3,','8X)/','7X, ',' ','4(F1','2.3,',
     1'8X),','F12.','3)  '/
C
 100   FORMAT(1H 6X5(F12.3,8X),F12.3/17X,5(F12.3,8X))
 101  FORMAT(1H F12.3,1X,103A1,F12.3)
  102 FORMAT (1H 13X,103A1)
 1000 FORMAT(1H  14X,101A1)
 1001 FORMAT(15X,20(5H+....),1H+)
C
      DATA NCC/2/
C    'NCC' ON THE INITIAL ENTRY TO PLOTR IS NON-ZERO BECAUSE OF THE DATA
C    STATEMENT ABOVE.
C
C    'NCC' IS 0 WHILE A PLOT IS BEING MADE.  IT IS 1 OR 2 AT OTHER TIMES
C
      IF(NCC) 50,48,50
C
C    THE VARIABLE 'KL' CONTROLS THE FUNCTIONING OF THE OPENING AND
C    CLOSING  SECTIONS OF PLOTR.  KL=0 INDICATES OPENING OF THE GRAPH,
C    KL=1 INDICATES CLOSING.
C
   50 KL=0
      CALL SCALE(WMIN,WMAX,100.0,JY,YMIN,YMAX,YIJ)
      YR=YMAX-YMIN
  230 J=JY
      IF(J*(J-10))204,201,201
C
C     THE FOLLOWING SECTION OPENS OR CLOSES A PLOT IN FIXED FORMAT
C     UNDER CONTROL OF KL
C
  201 IF(KL)220,220,231
C
  231 WRITE (6,1001)
      IF(KL)250,250,220
C
  220 CLAB(1)= YMIN
      DO 222 I=2,11
  222 CLAB(I)=CLAB(I-1)+YIJ
      WRITE (6,100)(CLAB(I),I=1,11,2),(CLAB(J),J=2,10,2)
      IF(KL)231,231,14
C
C     THE FOLLOWING SECTION OPENS OR CLOSES A PLOT IN A VARIABLE
C     FORMAT UNDER CONTROL OF KL AND JY FROM 'SCALE'
C
  204 IF(J-5)205,221,207
  207 J=J-5
  205 JYT=5-J
  221 CONTINUE
  226 FMT(2)=GF(JY)
      IF (KL) 225,225,227
C
  225 FMT(7)=GF(JY)
      TT=JY
      TT=TT*YIJ/10.0
      CLAB(1)= YMIN+TT
      DO 223 I=2,10
  223 CLAB(I)=CLAB(I-1) +YIJ
      WRITE (6,FMT)(CLAB(I),I=2,10,2),(CLAB(I),I=1,9 ,2)
      IF(KL)227,227,14
C
  227 IF(JY-5)208,209,208
  208 WRITE(6,1000)(TC,I=1,J    ),(TP,(TC,I=1,4),K=1,19),TP,(TC,I=1,JYT)
      IF (KL) 250,250,225
C
  209 WRITE (6,1001)
      IF (KL) 250,250,225
C
  250 CONTINUE
      NCC=0
      IC=0
      IF(NP)80,11,11
C
C    THIS SECTION PREPARES FOR A FULL PAGE PLOT BY FILLING IN XY WITH
C     BLANKS AND SETTING UP SCALING FOR THE INDEPENDENT VARIABLE 'X'
C
   11 DO 1 I=1,51
       DO 1 J=1,101
   1  XY(I,J)=BLANKS
      CALL SCALE (ZMIN,ZMAX,50.0,JX,XMIN,XMAX,XIJ)
      XR=XMAX-XMIN
      GO TO 48
C
C
C     ENTRY TO PLOTS CAN BE USED ONLY AFTER THE CALLING PARAMETERS
C     HAVE BEEN TRANSFERRED BY A CALL ON PLOTR.  THE CALL ON PLOTS
C     IS IDENTICAL WITH ENTRY TO PLOTR BUT IT ALLOWS THE PROGRAMMER TO
C     CALL THE PLOTTING ROUTINE WITHOUT HAVING TO INCLUDE THE PARAMETERS
C
   48 IF(NC)52,13,49
   49 IF(NP)80,10,10
C    THE FOLLOWING SECTION SETS UP A FULL PAGE BUT DOES NO PRINTING.
C    THIS SECTION IS REACHED BY SPECIFYING NC POSITIVE AND NP POSITIVE.
C
   10 DO 9 N=1,NC
      SYMB=SYM(N)
      XDIFFR=XMAX-X
      IF(XDIFFR)105,106,106
  105 XDIFFR=0.0
  106 YDIFFR=YMAX-Y(N)
      IF(YDIFFR)107,108,108
  107 YDIFFR=0.0
  108 L=51.0-(50.0*XDIFFR)/XR+.5
      K=101.0-(100.0*YDIFFR)/YR+.5
      CALL FORM2(SYMB,XY(L,K))
 9     CONTINUE
      GO TO 15
C
C     THE FOLLOWING SECTION CONSTRUCTS AND PLOTS ONE LINE OF A MULTILINE
C     GRAPH.  LOCATION ALONG THE AXIS OF THE PAPER IS PRINTED AT EVERY
C     STEP.  THIS SECTION IS ACCESSIBLE BY SPECIFYING NC POSITIVE AND
C     NP NEGATIVE.
C
   80 DO 86 I=1,101
   86 XY(1,I)=BLANKS
       L=1
      DO 95 N=1,NC
      SYMB=SYM(N)
      YDIFFR=YMAX-Y(N)
      IF(YDIFFR)860,865,865
  860 YDIFFR=0.0
  865 K=101.0-(100.0*YDIFFR)/YR+.5
   95 CALL FORM2(SYMB,XY(L,K))
      IF(MOD(IC,5))97,96,97
   96 W=TP
      GO TO 98
   97 W=TC
   98 WRITE (6,101)X,W,(XY(1,N),N=1,101),W,X
      IC=IC+1
      GO TO 15
C
C    THIS SECTION PLOTS OUT THE PREVIOUSLY PREPARED WHOLE PAGE GRAPH.
C    IT PRINTS LOCATION ALONG THE PAPER'S AXIS EVERY FIFTH STEP.  THIS
C    SECTION IS ACCESSED BY SPECIFYING NC=0.
C
   13 M=6-JX
      LL=50+M
      T=JX
      IF(5-JX)131,131,135
  131 T=0.0
  135 RLAB=XMAX-(T*XIJ)/5.0
      W=TC
      K=52
      DO 31 L=M,LL
      K=K-1
      I=MOD(L,5)
      IF(I-1)2,3,2
    3 W=TP
      WRITE (6,101)RLAB,W,(XY(K,N),N=1,101),W,RLAB
      RLAB=RLAB-XIJ
      W=TC
      GO TO 31
    2 WRITE (6,102)W,(XY(K,N),N=1,101),W
   31 CONTINUE
C
   52 KL=1
      GO TO 230
C
   14 NCC=1
   15 RETURN
      END
      SUBROUTINE SCALE(YMIN,YMAX,YINT,JY,TYMIN,TYMAX,YIJ)
C             SUBROUTINE SCALE FOR PLOTR              JUNE 21, 1966
C
C     SUBROUTINE 'SCALE' CALCULATES THE SCALING FOR 'PLOTR'
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/
   50 YR=YMAX-YMIN
      TT=YR/YINT
      J = ALOG10(TT)+TEST
      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)
      DIMENSION TEST(18)
      DATA BLANK/'  '/,TEST/'2 ','3 ','4 ','5 ','6 ',
     1'7 ','8 ','9 ','A ','B ','C ','D ','E ','F ','G ','H ','I ','/ '/
      IF(XY.EQ.BLANK)GO TO 50
      DO 30 I=1,17
      IF(XY.NE.TEST(I))GO TO 30
C        PUT IN NEXT SYMBOL OF ARRAY FOR MULTIPLE POINTS
      XY=TEST(I+1)
      GO TO 100
   30 CONTINUE
      IF(XY.EQ.TEST(18))GO TO 100
C        IF OTHER THAN CHARACTERS IN ARRAY TEST PUT IN CHARACTER 2.
      XY=TEST(1)
      GO TO 100
C        IF BLANK, PUT IN SYMBOL
   50 XY=SYMB
  100 RETURN
      END