; PLOTSM.SUB - COMMAND FILE TO CATALOG PLOTSM SUBROUTINE. .SETF TSTP .OPEN PLOTSM.FTN .ENABLE DATA ! ADD SOURCE FOR SUBROUTINE AFTER THIS CARD C THIS SPECIAL VERSION ALTERED FOR PDP FROM IBM; FLAGGED: ! PDP ADD C ! PDP ADD C@SD@ PLOTSM CA C PROGRAM ID: PLOTSM C C PROGRAMMER: MAJOR CARL S. ZIMMERMAN / AD C C CREATED ON: 13 FEBRUARY 1980 FOR PROJECT 210312 C AS OF: 6 NOV 81 (CORRECTED ERROR IN FORMAT 9284) C 3 MAY 82 (UPDATED DOCUMENTATION) C C DESCRIPTION: C C SUBROUTINE 'PLOTSM' PROVIDES, THROUGH ITS ENTRY POINTS, A MEANS C OF SIMULATING THE EFFECT OF A STANDARD PLOTTER SUBROUTINE PACKAGE C ON A COMPUTER SYSTEM WHICH DOES NOT ACTUALLY HAVE SUCH A PACKAGE. C THIS IS DONE BY WRITING A CARD-IMAGE TAPE WHICH CAN BE TRANS- C FERRED TO A COMPUTER SYSTEM WHICH HAS BOTH A STANDARD PLOTTER C SUBROUTINE PACKAGE AND AN INTERFACE PROGRAM DESIGNED TO READ THE C TRANSFER TAPE. C C AT USAFETAC, 'PLOTSM' IS USABLE ON THE IBM 4341; THE TRANSFER C PROGRAM 'PLOTTR' RUNS ON THE DEC PDP-11/45 UNDER RSX-11M TO DRIVE C THE VERSATEC PLOTTER. 'PLOTSM' IS ALSO USABLE ON THE PDP-11/45 ! PDP ADD C IF A USER NEEDS THE 'WINDOW' CAPABILITY DESCRIBED BELOW. ! PDP ADD C OTHERWISE IT IS TOO INEFFICIENT IN COMPARISON TO DIRECT CALLS. ! PDP ADD C 'PLOTSM' IS ALSO USABLE AT BBNB, WHERE IT IS LOCATED IN ! PDP ADD C GENLIB. (WARNING: AT BBNB A MAXIMUM OF 4 CHARACTERS PER! PDP ADD C WORD WILL BE DISPLAYED FOR TEXT ARGUMENTS TO "AXIS" AND "SYMBOL". ! PDP ADD C THEREFORE DO NOT USE LITERAL ARGUMENTS FOR LONG TEXT STRINGS.) ! PDP ADD C FOR THE PDP AND BBNB SYSTEMS, READ "DISK FILE" WHEREVER "TAPE" ! PDP ADD C APPEARS BELOW. ! PDP ADD C C MOST SUBROUTINE CALLS WHICH ARE STANDARD IN 'CALCOMP' OR C 'VERSAPLOT-7' PLOTTER SOFTWARE ARE AVAILABLE TO THE USER. THE C EXCEPTION IS 'WHERE', WHICH CANNOT BE USED BECAUSE PLOTTING C LOCATION IS NOT COMPUTED AT INTERFACE TIME. ALL ACTUAL PARAME- C TERS IN CALLING SEQUENCES MUST BE FORTRAN STANDARD LENGTH (E.G. C REAL*4). C C INPUT/OUTPUT: C C INPUT DATA IS PASSED FROM CALLING PROGRAM AS SUBROUTINE C ARGUMENTS, AS FOLLOWS: C CALL AXIS(X,Y,LABEL,NCHAR,AXLEN,ANGLE,FVAL,DV) C CALL FACTOR(FACT) C CALL LINE(X,Y,NPTS,INC,LINTYP,INTEQ) C CALL NEWPEN(INP) C CALL NUMBER(X,Y,HEIGHT,FPN,ANGLE,NDEC) C CALL OFFSET(XOFF,XFAC,YOFF,YFAC) C CALL PLOT(X,Y,IPEN) C CALL PLOTS(IBUF,NLOC,LDEV) C *** AT USAFETAC, 'PLOTS' DOES NOT SERVE TO PERFORM C *** INITIALIZATION (WHICH IS DONE BY THE CALL TO 'PLOTSM' C *** AS DESCRIBED BELOW). IF 'PLOTS' IS CALLED, IT MUST C *** BE WITH C *** IBUF = 3 C *** NLOC = MAX PLOT SIZE, X-DIRECTION (INCHES) C *** LDEV = MAX PLOT SIZE, Y-DIRECTION (INCHES) C *** OTHERWISE DEFAULT PLOT LIMITS ARE 18X18 INCHES. C CALL SCALE(ARRAY,AXLEN,NPTS,INC) C CALL SETMSG(MSGLVL) C CALL SYMBOL(X,Y,HEIGHT,ITEXT,ANGLE,NC) C CALL WHERE(XNOW,YNOW,DFACT) *** CANNOT BE USED *** C CALL GRID(X,Y,NX,XD,NY,YD,MASK) C CALL TONE(X,Y,IPATNE,NTPNA) C THERE ARE NO LIMITS ON THE LENGTHS OF TEXT STRINGS OR SIZE OF C ARRAYS WHICH CAN BE PASSED THROUGH THIS SUBROUTINE TO THE C TRANSFER TAPE. HOWEVER, THERE WILL BE LIMITATIONS ON THE LENGTHS C OF TEXT STRINGS AND SIZES OF ARRAYS WHICH CAN BE ACCEPTED FROM C THE TRANSFER TAPE BY THE DESTINATION COMPUTER. C (AT USAFETAC, SEE DOCUMENTATION FOR PDP-11/45 PROGRAM 'PLOTTR'.) C C SPECIAL WINDOW CAPABILITY: C CALL OPWNDO('FILENAME') C CALL CLWNDO C CALL INWNDO('FILENAME') C ENTRY 'OPWNDO' OPENS A STORAGE WINDOW IN THE TARGET COMPUTER, C SO THAT ALL SUBSEQUENT PLOT CALLS ARE DIVERTED TO THE SPECIFIED C FILE UNTIL A CALL ON 'CLWNDO' CLOSES THAT WINDOW. IF THE FILENAME C IS BLANK THEN A TEMPORARY FILE WILL BE USED, WHICH WILL EXIST C ONLY FOR THE DURATION OF A SINGLE PLOTTING JOB. IF A NON-BLANK C FILENAME IS SUPPLIED, IT MUST BE IN THE CORRECT FORMAT FOR A C FILENAME ON THE TARGET COMPUTER. (AT USAFETAC, IT MUST BE C APPROPRIATE FOR RSX-11M ON THE PDP-11/45.) C ENTRY 'INWNDO' CAUSES THE PLOT CALLS STORED IN THE SPECIFIED C FILE TO BE INCLUDED IN THE PLOT AT THE POINT WHERE THIS ENTRY C IS CALLED. THE INCLUDED PLOT CALLS WILL ALL BE MADE RELATIVE C TO THE CURRENT PLOTTING ORIGIN AT THE TIME THE INCLUSION C OCCURS. IF THE FILENAME IS BLANK THEN THE LATEST TEMPORARY C WINDOW FILE WILL BE INCLUDED. IF A NON-BLANK FILENAME IS C SPECIFIED, THAT CATALOGUED FILE FROM THE TARGET COMPUTER C WILL BE INCLUDED. C A BLANK FILENAME MUST HAVE AT LEAST 4 BLANKS. A NON-BLANK C FILENAME MAY CONTAIN UP TO 40 CHARACTERS INCLUDING A TERMINATING C BLANK. C ANY NUMBER OF TEMPORARY AND/OR PERMANENT PLOT STORAGE WINDOWS C MAY BE CREATED AND/OR ACCESSED IN A SINGLE JOB. HOWEVER, C CREATION OR INCLUSION OF A PERMANENT WINDOW ERASES ANY C PREVIOUSLY-CREATED TEMPORARY WINDOW. THUS IF SEVERAL TEMPORARIES C ARE CREATED, ONLY THE LATEST ONE MAY BE INCLUDED AT ANY POINT. C NEITHER WINDOW CREATION NOR WINDOW INCLUSION MAY BE NESTED. C C ALMOST NO CHECKING OF ARGUMENTS IS DONE AT INTERFACE TIME. C THE ONLY CHECKS MADE ARE THOSE NECESSARY TO BE ABLE TO CON- C STRUCT A TRANSFER FILE IN CORRECT FORMAT. ALL DETAILED ARGU- C MENT CHECKING IS DONE BY THE ACTUAL PLOT ROUTINES ON THE C TARGET MACHINE. C C OUTPUT FILE: A MAGNETIC TAPE OF 80-CHARACTER (CARD-IMAGE) C RECORDS, LOGICALLY SUBDIVIDED INTO GROUPS. EACH GROUP BEGINS C WITH A RECORD CONTAINING THE NAME OF A PLOT SUBROUTINE LEFT- C JUSTIFIED AND BLANK-FILLED. THIS NAME RECORD IS FOLLOWED BY ONE C OR MORE DATA RECORDS CONTAINING THE ACTUAL ARGUMENTS OF THAT C SUBROUTINE (INCLUDING ARRAYS OR TEXT STRINGS). THE FORMAT OF C THESE DATA RECORDS DEPENDS ON THE SUBROUTINE TO WHICH THEY C BELONG. THIS MAGNETIC TAPE IS DESIGNED TO BE USED AS AN INPUT C TAPE TO PROGRAM 'PLOTTR', RUNNING ON SOME OTHER COMPUTER AND C DRIVING A CALCOMP/VERSATEC-TYPE PLOTTER THERE. C C ON THE IBM 4341 AT USAFETAC, THIS OUTPUT FILE SHOULD BE ASSIGNED C TO A 9-TRACK TAPE DRIVE AT 800 BPI. FOR EXAMPLE, C // TLBL IJSYS05 C // ASSGN SYS005,X'1A0',X'C8' SYS005 = FORT DSN 8 C WOULD USE FORTRAN DATA SET NUMBER 8. DSNS IN THE RANGE 4-14 C (INCLUSIVE) ARE ACCEPTABLE. ON THE PDP OR BBNB SYSTEMS AT C USAFETAC, THIS OUTPUT FILE SHOULD GO TO DISK, FROM WHICH IT CAN C BE PASSED (DIRECTLY OR AFTER "FTP" FROM BBNB) TO 'PLOTTR'. C C THE USUAL END-OF-PLOTTING CALL "CALL PLOT(0.,0.,999)" AUTOMATIC- C ALLY CAUSES THE PLOT TAPE TO BE CLOSED, REWOUND AND UNLOADED. C C SEE ALSO LOCAL OPERATING INSTRUCTIONS. C -------------------------------------------------------------------- C C C ****** PART ONE - INITIALIZATION ********************************** C C THE FOLLOWING PRIMARY ENTRY POINT MUST BE CALLED BEFORE ANY OTHER C ENTRY, TO PROVIDE THE DATA SET REFERENCE NUMBER USED BY ALL C OTHER ENTRY POINTS. IT NEED NOT BE CALLED AGAIN UNLESS SUBSE- C QUENT PLOTS PRODUCED BY THE SAME PROGRAM ARE TO BE PLACED ON A C DIFFERENT TRANSFER TAPE. C SUBROUTINE PLOTSM(NTAPE,TITLE) C C NTAPE = FULLWORD INTEGER SPECIFYING THE DATA SET REFERENCE C NUMBER USED FOR THE TRANSFER TAPE. IT MUST HAVE BEEN C ASSIGNED PREVIOUSLY BY THE USER, AS SHOWN ABOVE. C TITLE = ARRAY OF 3 FULLWORDS CONTAINING 12 CHARACTERS TO BE USED C FOR LABELING THE PLOT OUTPUT. ONLY THE FIRST 9 MAY BE C DISPLAYED. C ON THE IBM 4341 AT USAFETAC, USE THE IBM JOBNAME FOR THIS TITLE. C C C************************************************************************ C* * C* THIS SOFTWARE IS RELEASED FOR PUBLIC USE UNDER THE PROVISIONS * C* OF AIR FORCE REGULATION 300-6, MAC SUPPLEMENT 1, PARA.11-7, * C* BY USAFETAC/ADW, SCOTT AFB, IL 62225. THIS SOFTWARE IS * C* RELEASED "AS-IS"; THE U. S. AIR FORCE HAS NO WARRANTY * C* RESPONSIBILITY OR LIABILITY FOR THE OPERATION OR USE OF * C* SOFTWARE RELEASED UNDER THIS POLICY. * C* * C* RELEASE OF THIS SOFTWARE IS BEING DONE THROUGH DECUS, SO * C* ALL USUAL DECUS DISCLAIMERS APPLY AS WELL. * C* * C* UNDER THE PROVISIONS OF THE REGULATION CITED ABOVE, NO * C* CONTRACTOR MAY CHARGE THE GOVERNMENT FOR THE USE OF THIS * C* SOFTWARE DURING THE PERFORMANCE OF ANY CONTRACT WITH THE * C* GOVERNMENT. * C* * C* USERS WHO OBTAIN THIS SOFTWARE THROUGH DECUS DISTRIBUTION * C* ARE WELCOME TO SEND COMMENTS TO THE AUTHOR, AS FOLLOWS: * C* USAFETAC/ADW * C* ATTN: MAJOR CARL S. ZIMMERMAN * C* SCOTT AFB, IL 62225 * C* GIVEN THE EXIGENCIES OF MILITARY SERVICE, A REPLY TO YOUR * C* COMMENTS CANNOT BE GUARANTEED. * C* * C************************************************************************ C C@ED@ C* C C DEFINE DATA SET REFERENCE NUMBER FOR STANDARD PRINTER: INTEGER PTR ! PDP MOD INTEGER*4 ITEXT ! PDP ADD C DUMMY DIMENSIONING FOR ARGUMENT ARRAYS DIMENSION LMASK(1),XD(1),YD(1),X4(1),Y4(1) DIMENSION ITEXT(1),LABEL(1) DIMENSION IPATNE(1),X7(1),Y7(1) DIMENSION ARRAY(1),UNITS(7) DIMENSION TITLE(3) DATA IZRO/0/ ! PDP MOV DATA PTR/3/ ! PDP ADD DATA UNITS/1.,2.,4.,5.,8.,10.,20./ DATA LONE/1/ DATA WOPEN,WINCLU/'OP ','IN '/ ! PDP ADD DATA MSGLVL/0/ C DEFINE INITIAL 'PREVIOUS PEN SETTING' AS ILLEGAL VALUE DATA LASTNP/0/ C C 'NT' = DATA SET REFERENCE NUMBER FOR TRANSFER TAPE (INTEGER*4) NT = NTAPE WRITE (PTR,91) NT 91 FORMAT('0PLOTSM INITIALIZED FOR VERSATEC TRANSFER TAPE ON UNIT',I4 *) C C 'TITLE' = ALPHAMERIC IDENTIFICATION OF PLOT (REAL*4)(3) WRITE(NT,911) TITLE 911 FORMAT(3A4,28X) NRECS = 1 MAXA = 0 MAXT = 0 NPLOTS = 0 RETURN C ! PDP ADD C* ! PDP ADD C* ****** PART TWO - WINDOW FEATURE ENTRY POINTS ********************! PDP ADD C* ! PDP ADD ENTRY OPWNDO(ITEXT) ! PDP ADD C 'ITEXT' = WINDOW FILE NAME (40 CHARACTERS) ! PDP ADD WORD = WOPEN ! PDP ADD GO TO 17 ! PDP ADD C ! PDP ADD ENTRY CLWNDO ! PDP ADD WRITE (NT,916) ! PDP ADD 916 FORMAT('CLWNDO',34X) ! PDP ADD RETURN ! PDP ADD C ! PDP ADD ENTRY INWNDO(ITEXT) ! PDP ADD WORD = WINCLU ! PDP ADD 17 KWIND = 0 ! PDP ADD IF (ITEXT(1).NE.' ') KWIND = 1 ! PDP ADD WRITE (NT,917) WORD, KWIND ! PDP ADD 917 FORMAT(A2,'WNDO',3X,I5,26X) ! PDP ADD IF (KWIND.EQ.0) RETURN ! NO FILENAME SUPPLIED ! PDP ADD WRITE (NT,918) (ITEXT(I),I=1,10) ! WINDOW FILE NAME ! PDP ADD 918 FORMAT(10A4) ! PDP ADD RETURN ! PDP ADD C C* C* ****** PART THREE - CALCOMP-TYPE STANDARD ENTRY POINTS ************** C* ENTRY PLOTS(IBUF,NLOC,LDEV) WRITE(NT,922) IBUF,NLOC,LDEV 922 FORMAT('PLOTS',35X/3I15,35X) NRECS = NRECS + 2 RETURN C ENTRY PLOT(X1,Y1,IPEN) WRITE(NT,928) IPEN,X1,Y1 928 FORMAT('PLOT',5X,I5,2E13.5) NRECS = NRECS + 1 IF (IPEN.EQ.999) GO TO 285 IF (IPEN.NE.-999) RETURN C STANDARD END-OF-CURRENT-PLOT SIGNAL FORCES STATUS MESSAGE NPLOTS = NPLOTS + 1 WRITE (PTR,9284) NPLOTS, NRECS 9284 FORMAT('0CALL PLOT(X,Y,-999) FOR PLOT',I3,' OCCURRED AT RECORD', * I6,' OF VERSATEC TRANSFER TAPE.'//) RETURN C THE STANDARD END-OF-ALL-PLOTS SIGNAL AUTOMATICALLY FORCES C CLOSEOUT OF THE TRANSFER TAPE. 285 ENDFILE NT REWIND NT IF (NT.GT.3.AND.NT.LT.15) CALL UNLOAD(NT) IF (NRECS.GT.3) CALL ASKEM('H065A - VERSATEC TRANSFER TAPE COMPLE *TED',40) WRITE(PTR,929) NT,NRECS,MAXT,MAXA 929 FORMAT('0PLOTSM CLOSED VERSATEC TRANSFER TAPE ON UNIT',I4,'. FILE * CONTAINS',I6,' PHYSICAL RECORDS.'/' MAXIMUM TEXT LENGTH =',I5,' B $YTES'/' MAXIMUM ARRAY LENGTH =',I4,' VALUES'//) C FORCE 'NT' TO INVALID NUMBER, TO PREVENT USE WITHOUT C RE-INITIALIZATION. NT = 0 LASTNP = 0 RETURN C ENTRY OFFSET(XOFF,XFAC,YOFF,YFAC) WRITE(NT,932) XOFF,XFAC,YOFF,YFAC 932 FORMAT('OFFSET',34X/4E15.5,20X) NRECS = NRECS + 2 RETURN C ENTRY FACTOR(FACT) WRITE(NT,938) FACT 938 FORMAT('FACTOR',8X,E13.5,13X) NRECS = NRECS + 1 RETURN C ENTRY NEWPEN(INP) IF (INP.EQ.LASTNP) RETURN LASTNP = INP WRITE(NT,942) INP 942 FORMAT('NEWPEN',3X,I5,26X) NRECS = NRECS + 1 RETURN C ENTRY WHERE(XNOW,YNOW,DFACT) WRITE(PTR,948) 948 FORMAT(' ROUTINE ''WHERE''CALLED--NO RESULT RETURNABLE--LOG(0) TAK *EN TO FORCE ERROR RETURN.') C CREATE AN ERROR RETURN A=ALOG(0.) ! PDP MOD CALL QUIT ! PDP ADD C ENTRY SYMBOL(X2,Y2,HEIGHT,ITEXT,ANGLE,NC) DATA BLANKS/4H / IF (NC.LT.0) GO TO 53 MAXT = MAX0(MAXT,NC,1) C COMPUTE NUMBER OF WORDS IN 'ITEXT' NWORDS = (MAX0(NC,1)+3)/4 C COMPUTE NUMBER OF BLANK WORDS NEEDED TO PAD TAPE BLOCK TO FULL LE NBLANK = 20 - MOD(NWORDS,20) NRECS = NRECS + 2 + (NWORDS+19)/20 IF (NBLANK-20) 518,512,512 C TEXT FILLS LINE--NO PAD NEEDED 512 WRITE(NT,952) X2,Y2,HEIGHT,ANGLE,NC,(ITEXT(I),I=1,NWORDS) RETURN C TEXT DOES NOT FILL LINE--PAD IT OUT 518 WRITE(NT,952) X2,Y2,HEIGHT,ANGLE,NC,(ITEXT(I),I=1,NWORDS) *,(BLANKS,I=1,NBLANK) 952 FORMAT('SYMBOL',34X/4E15.5,I15,5X/(20A4)) RETURN C PASS INTEGER SYMBOL NUMBER 53 WRITE (NT,953) X2,Y2,HEIGHT,ANGLE,NC,ITEXT(1) 953 FORMAT('SYMBL1',34X/4E15.5,I15,I5) NRECS = NRECS + 2 RETURN C ENTRY NUMBER(X3,Y3,HEIGHT,FPN,ANGLE1,NDEC) WRITE(NT,958) X3,Y3,HEIGHT,FPN,ANGLE1,NDEC 958 FORMAT('NUMBER',34X/5E13.5,I15) NRECS = NRECS + 2 RETURN C ENTRY SCALE(ARRAY,AXLEN,NPTS1,INC2) C FOLLOWING TEXT MODIFIED SLIGHTLY FROM ETAC-OWNED COPY OF C VERSATEC SOFTWARE. K = IABS(INC2) J = NPTS1*K ARMIN = ARRAY(1) ARMAX = ARMIN DO 10 I=1,J,K ARMIN = AMIN1(ARMIN,ARRAY(I)) ARMAX = AMAX1(ARMAX,ARRAY(I)) 10 CONTINUE DVA = (ARMAX-ARMIN)/AXLEN IF (DVA.GT.0) GO TO 20 DVA = ABS((ARMIN+ARMIN)/AXLEN) + 1. 20 A = 10.**(INT(ALOG10(DVA)+1000.)-1000) DVA = DVA/A - 0.01 DO 30 I=1,6 IF (UNITS(I).GE.DVA) GO TO 40 30 CONTINUE 40 TMIN = ARMIN SGNF = 0.01 IF (ARMIN.LT.0) SGNF = -0.99 50 DVA = UNITS(I)*A TMIN = DVA*AINT(ARMIN/DVA+SGNF) IF((TMIN+(AXLEN+0.01)*DVA).GE.ARMAX) GO TO 60 TMIN = AINT(ARMIN/A+SGNF)*A IF ((TMIN+(AXLEN+0.01)*DVA).GE.ARMAX) GO TO 60 I = I+1 GO TO 50 60 TMIN = TMIN - DVA*AINT((AXLEN+(TMIN-ARMAX)/DVA)/2.) IF (ARMIN*TMIN.LE.0.0) TMIN = 0.0 IF (INC2.GT.0) GO TO 70 TMIN = TMIN + DVA*AINT(AXLEN+0.5) DVA = -DVA 70 J = J+1 ARRAY(J) = TMIN ARRAY(J+K) = DVA RETURN C ENTRY LINE(X4,Y4,NPTS,INC,LINTYP,INTEQ) C COMPUTE INDEXES OF SCALING PARAMETERS N1 = NPTS*INC + 1 N2 = N1 + INC C COMPUTE INDEX OF LAST POINT TO OUTPUT NPTL = N1 - INC C COMPUTE NUMBER OF VALUES OUTPUT PER ARRAY NPTS2 = NPTS + 2 MAXA = MAX0(MAXA,NPTS2) C COMPUTE NUMBER OF ZEROS NEEDED TO PAD TAPE BLOCKS TO FULL NDUMMY = 6 - 2*MOD(NPTS2,3) NRECS = NRECS + 2 + (2*NPTS2+5)/6 IF (NDUMMY-6) 685,681,681 C ARRAY FILLS LINE--NO PAD NEEDED 681 WRITE(NT,968) NPTS2,INC,LINTYP,INTEQ * , (X4(I),Y4(I),I=1,NPTL,INC),X4(N1),Y4(N1),X4(N2),Y4(N2) 968 FORMAT('LINE',36X/4I15,20X/(6E13.5,2X)) RETURN C ARRAY DOES NOT FILL LINE--PAD IT OUT WITH DUMMIES 685 WRITE(NT,968) NPTS2,INC,LINTYP,INTEQ * , (X4(I),Y4(I),I=1,NPTL,INC),X4(N1),Y4(N1),X4(N2),Y4(N2) $, (UNITS(1),I=1,NDUMMY) RETURN C ENTRY AXIS(X5,Y5,LABEL,NCHAR,AXLEN,ANGLE,FVAL,DV) MAXT = MAX0(MAXT,IABS(NCHAR)) C COMPUTE NUMBER OF WHOLE WORDS (4-BYTE) IN 'LABEL' NWORDS = (IABS(NCHAR)+3)/4 C COMPUTE NUMBER OF BLANKS WORDS NEEDED TO PAD TAPE BLOCK TO FULL NBLANK = 20 - MOD(NWORDS,20) NRECS = NRECS + 3 + (NWORDS+19)/20 IF (NBLANK-20) 718,712,712 C TEXT FILLS LINE--NO PAD NEEDED 712 WRITE(NT,972)X5,Y5,AXLEN,ANGLE,FVAL,DV,NCHAR,(LABEL(I),I=1,NWORDS) RETURN C TEXT DOES NOT FILL LINE--PAD IT OUT 718 WRITE(NT,972)X5,Y5,AXLEN,ANGLE,FVAL,DV,NCHAR,(LABEL(I),I=1,NWORDS) *,(BLANKS,I=1,NBLANK) 972 FORMAT('AXIS',36X/5E15.5,5X/E15.5,I15,50X/(20A4)) RETURN C ENTRY SETMSG(LVLMSG) MSGLVL = LVLMSG WRITE(NT,978) MSGLVL 978 FORMAT('SETMSG',34X/I15,65X) NRECS = NRECS + 2 RETURN C C* C* ***** PART FOUR - VERSAPLOT-UNIQUE ENTRY POINTS ***************** C* ENTRY PLTS WRITE (PTR,98) 98 FORMAT('0USERS ARE NOT ALLOWED TO CALL PLTS THROUGH PLOTSM INTERFA *CE'/' LOG(0) TAKEN TO FORCE ERROR TERMINATION.') A=ALOG(0.) ! PDP MOD CALL QUIT ! PDP ADD C ENTRY GRID(X6,Y6,NX,XD,NY,YD,LMASK) WRITE (NT,982) X6,Y6,NX,NY,LMASK C *** DE-COMMENT WHICHEVER OF THE FOLLOWING FORMAT STATEMENTS WILL ! PDP ADD C *** COMPILE CORRECTLY ON SOURCE COMPUTER. PROGRAM "PLOTTR" ON ! PDP ADD C *** TARGET MACHINE ACCEPTS BOTH FORMATS. ! PDP ADD C982 FORMAT('GRID',36X/2E15.5,2I15,Z15,5X) ! PDP MOD 982 FORMAT('GRID',9X,'1',26X/2E15.5,2I15,O15,5X) ! PDP ADD NRECS = NRECS + 2 IF (NX.LT.0) GO TO 825 NWORDS = 1 IF (NX.LT.1000) GO TO 822 C CONVERT FLAGGED ARRAY COUNT TO ACTUAL COUNT NWORDS = NX - 1000 822 MAXA = MAX0(MAXA,NWORDS) NRECS = NRECS + (NWORDS+5)/6 NDUMMY = 6-MOD(NWORDS,6) IF (NDUMMY-6) 824,823,823 823 WRITE(NT,983) (XD(I),I=1,NWORDS) GO TO 825 824 WRITE(NT,983) (XD(I),I=1,NWORDS) *, (UNITS(1),I=1,NDUMMY) 825 IF (NY.LT.0) RETURN NWORDS = 1 IF (NY.LT.1000) GO TO 83 C CONVERT FLAGGED ARRAY COUNT TO ACTUAL COUNT NWORDS = NY - 1000 83 MAXA = MAX0(MAXA,NWORDS) NRECS = NRECS + (NWORDS+5)/6 NDUMMY = 6-MOD(NWORDS,6) IF (NDUMMY-6) 834,833,833 833 WRITE(NT,983) (YD(I),I=1,NWORDS) RETURN 983 FORMAT(6E13.5,2X) 834 WRITE(NT,983) (YD(I),I=1,NWORDS) *, (UNITS(1),I=1,NDUMMY) RETURN C ENTRY TONE(X7,Y7,IPATNE,NTPNA) IF (NTPNA) 86,85,88 C ERROR--INVALID ARGUMENT 85 PRINT 985 985 FORMAT('0ERROR: ZERO VALUE GIVEN FOR NTP:NA ON CALL TO TONE.'/' LO *G(0) TAKEN TO FORCE ERROR TERMINATION.') A=ALOG(0.) ! PDP MOD CALL QUIT ! PDP ADD C FORM 1 - SET TONE PATTERN ARRAY (ASSUME 16 WORDS) 86 NTP = NTPNA WRITE(NT,986) NTP,(IPATNE(I),I=1,16) C *** DE-COMMENT WHICHEVER OF THE FOLLOWING FORMAT STATEMENTS WILL ! PDP ADD C *** COMPILE CORRECTLY ON SOURCE COMPUTER. PROGRAM "PLOTTR" ON ! PDP ADD C *** TARGET MACHINE ACCEPTS BOTH FORMATS. ! PDP ADD C986 FORMAT('TONE1',35X/I15,1X,8Z8/16X,8Z8) ! PDP MOD 986 FORMAT('TONE1',8X,'1',26X/I15,1X,8O8/16X,8O8) ! PDP ADD NRECS = NRECS + 3 RETURN C FORM 2 - TONE AREA(S) 88 NWORDS = 0 NA = NTPNA C COMPUTE TOTAL NUMBER OF WORDS IN X AND Y ARRAYS DO 881 I=1,NA 881 NWORDS = NWORDS + IPATNE(I) MAXA = MAX0(MAXA,NWORDS,NA) NRECS = NRECS + 2 + (NWORDS+2)/3 + (NA+4)/5 NDUMMY = 5 - MOD(NA,5) IF (NDUMMY-5) 883,882,882 882 WRITE(NT,9882) NA,NWORDS,(IPATNE(I),I=1,NA) 9882 FORMAT('TONE2',35X/2I15,50X/(5I15,5X)) GO TO 884 883 WRITE(NT,9882) NA,NWORDS,(IPATNE(I),I=1,NA) *, (IZRO,I=1,NDUMMY) 884 NDUMMY = 6 - 2*MOD(NWORDS,3) IF (NDUMMY-6) 886,885,885 885 WRITE(NT,983) (X7(I),Y7(I),I=1,NWORDS) RETURN 886 WRITE(NT,983) (X7(I),Y7(I),I=1,NWORDS) *, (UNITS(1),I=1,NDUMMY) RETURN C END .DISABLE DATA .CLOSE F4P PLOTSM,ADSPLOTSM.DMP/-SP=PLOTSM PIP PLOTSM.FTN;*/DE .ASK CMPA DID IT COMPILE OK .IFF CMPA .GOTO 500 .IFF TSTP .GOTO 400 .OPEN TSTPLOTSM.FTN .ENABLE DATA ! ADD TEST PROGRAM SOURCE AFTER THIS CARD .DISABLE DATA .CLOSE F4P TSTPLOTSM,TSTPLOTSM/-SP=TSTPLOTSM PIP ADSPLOTSM.DMP=TSTPLOTSM.LST/AP PIP TSTPLOTSM.FTN;*/DE,TSTPLOTSM.LST;* .ASK ANST DO YOU WANT TO TASK BUILD .IFF ANST .GOTO 400 .OPEN TSTPLOTSM.CMD .ENABLE DATA TSTPLOTSM,TSTPLOTSM/-SP=TSTPLOTSM,PLOTSM / LIBR=F4PRES:RO // .DISABLE DATA .CLOSE TKB @TSTPLOTSM PIP ADSPLOTSM.DMP=TSTPLOTSM.MAP/AP,TSTPLOTSM.CMD/AP PIP TSTPLOTSM.CMD;*/DE,TSTPLOTSM.MAP;*,TSTPLOTSM.OBJ;* .400: .SETS USER .SETS COMA USER[3:3] .IF COMA NE "," .GOTO 500 .ASK ANSC DO YOU WANT THIS INSERTED IN SYSLIB.OLB .IFF ANSC .GOTO 500 .ASK ANSL DO YOU WANT A LISTING OF NEW SYSLIB.OLB .IFNINS LBR INS $LBR .IFF ANSL LBR [1,1]SYSLIB/RP=PLOTSM .IFT ANSL LBR [1,1]SYSLIB/RP,SYSLIB.DMP/SP/FU=PLOTSM .IFINS LBR REM LBR PIP PLOTSM.OBJ;*/DE .500: PIP ADSPLOTSM.DMP/SP ; PLOTSM.SUB - FINISHED.