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