Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0137/ptplot/ptplot.for
There are 2 other files named ptplot.for in the archive. Click here to see a list.
C WESTERN MICHIGAN UNIVERSITY
C PTPLOT.FOR (FILE NAME ON LIBRARY DECTAPE)
C PTPLOT.FOR IS A SUBROUTINE GENERATOR FOR PUPLOT.F4
C PTPLOT, 7.1.1 (CALLING NAME, SUBLST. #)
C INTEGRATED POINT PLOTTING PACKAGE
C PTPLOT WAS PROGRAMMED BY R.R. BARR III
C LIBRARY DECTAPE PROGRAMS USED: USAGE.MAC
C FORWMU PROGS. USED: GETPPN, RUNUUO, DEVCHR, EXISTS, EXIST
C GES. JOBNUM, PRINTS
C APLB10 PROGS. USED: IO
C INTERNAL PROGS. USED: EQUA
C PTPLOT.FOR GENERATES FORTRAN SUBR. PVPLOT, PWPLOT, PXPLOT
C AND STORES THEM ON DISK.
C THESE 3 SUBR. ARE USED AS EXTERNAL SUBR. BY PUPLOT.FOR
C ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG
C
DIMENSION IFMT(48),ID(16)
DOUBLE PRECISION NAMI,DEVNAM
COMMON/IOB/LEFBK,IRTBK,IALT,MAXPAG,IPAGE,IPAGCT,IDLG,IRSP,II,
#OUTDV
DATA IDLG,IRSP,NDEVI,NDEVO,IOUT/-1,-4,4,6,1/
NE=0
ITRN=' '
C---------------IDLG DEFINED IN DATA STATEMENT ABOVE
WRITE(IDLG,100)
100 FORMAT(' ---WMU PLOTTING PACKAGE---',//)
C CALL USAGE('PTPLOT')
104 WRITE(IDLG,108)
108 FORMAT(' TYPE:',/,' 1 FOR DATA PLOTTING',/,
1 ' 2 FOR FUNCTION PLOTTING',/)
OPEN(UNIT=IOUT,ACCESS='SEQOUT',FILE='PVPLOT.',MODE='ASCII')
READ(IRSP,112)ITYPE
112 FORMAT(I)
IF(ITYPE.EQ.1.OR.ITYPE.EQ.2)GO TO 120
WRITE(IDLG,116)
116 FORMAT(' ?RESPONSE ERROR',/)
GO TO 104
120 WRITE(IDLG,122)
122 FORMAT(' TYPE:',/,' 1 FOR X-Y PLOT',/,' 2 FOR POLAR PLOT',/)
READ(IRSP,112)JTYPE
IF(JTYPE.EQ.1.OR.JTYPE.EQ.2)GO TO 130
WRITE(IDLG,116)
GO TO 120
130 WRITE(IDLG,124)
124 FORMAT(' ENTER IDENTIFICATION IF DESIRED, ELSE <RETURN>',/)
READ(IRSP,126)ID
126 FORMAT(16A5)
IF(ITYPE.EQ.1)GO TO 246
C
C FUNCTION PLOTTING COMBINED
C
150 CONTINUE
200 WRITE(IDLG,202)
202 FORMAT(' HOW MANY CURVES ON THE PLOT? ',$)
READ(IRSP,204)NE
204 FORMAT(I)
IF(NE.GE.1.AND.NE.LE.10)GO TO 206
WRITE(IDLG,116)
GO TO 200
206 IF(JTYPE.EQ.1)WRITE(IDLG,208)
IF(JTYPE.EQ.2)WRITE(IDLG,212)
208 FORMAT(' ENTER THE DEPENDENT VARIABLE(X OR Y) ',$)
212 FORMAT(' ENTER THE DEPENDENT VARIABLE(RADIUS OR THETA) ',$)
READ(IRSP,216)DEPVAR
216 FORMAT(A1)
IF(JTYPE.EQ.1.AND.(DEPVAR.EQ.'X'.OR.DEPVAR.EQ.'Y'))GO TO 220
IF(JTYPE.EQ.2.AND.(DEPVAR.EQ.'R'.OR.DEPVAR.EQ.'T'))GO TO 220
WRITE(IDLG,116)
GO TO 206
220 INDVAR='Y'
IF(DEPVAR.EQ.'Y')INDVAR='X'
IF(DEPVAR.EQ.'R')INDVAR='T'
IF(DEPVAR.EQ.'T')INDVAR='R'
C---------------SUBR. PWPLOT, PVPLOT ARE WRITTEN ON DISK INTO
C--------------- A FILE CALLED PVPLOT. SEE ST. 108+2 AND ST. 100-4
WRITE(1,224)ITYPE,JTYPE,NE,INDVAR,IVAR,ITRN,INDVAR,DEPVAR,DEPVAR
224 FORMAT(' SUBROUTINE PWPLOT',/,
1 ' COMMON ITYPE,JTYPE,NE,INDVAR,IVAR,ITRN',/,
1 ' ITYPE=',I1,/,' JTYPE=',I1,/,
1 ' NE=',I2,/,' INDVAR=1H',A1,/,
1 ' IVAR=',I1,/,' ITRN=',1H',A3,1H',/,
1 ' RETURN',/,' END',/,
1 ' SUBROUTINE PVPLOT(',A1,',',A1,')',/,
1 ' COMMON ITYPE,JTYPE,NE,INDVAR',/,
1 ' DIMENSION ',A1,'(10)',/,
1 ' PI=3.141592654')
C---------------UP TO HERE ONLY PART OF SUBR. PVPLOT IS GENERATED.
C--------------- THE REST IS GEN. BY ST. 273+1 AND ST. 282.
WRITE(IDLG,241)
241 FORMAT(' EQUATION INPUT? (TYPE HELP IF NEEDED)--',$)
CALL IO(-2,NDEVI,DEVNAM,IDVI,NAMI,IPROJ,IPROG,IBNK)
IF(IDVI.EQ.'TTY')WRITE(IDLG,242)
242 FORMAT(' ENTER EQUATIONS')
IF(IDVI.NE.'TTY')WRITE(IDLG,240),IDVI
240 FORMAT(' EQUATIONS ARE BEING READ FROM ',A5,//)
IF(IDVI.EQ.'TTY')WRITE(IDLG,238)DEPVAR,INDVAR
238 FORMAT(' E.G. ',A1,'(2)=',A1,'**2.',//)
CALL EQUA(NDEVI,IOUT,IDVI,IERR)
IF(IERR.EQ.0)GO TO 280
WRITE(IDLG,244)
244 FORMAT(' ?EQUATION FILE ERROR',/)
GO TO 200
C
C DATA PLOTTING COMBINED
C
246 IF(JTYPE.EQ.1)GO TO 262
C
C DATA/POLAR ONLY
C
248 WRITE(IDLG,250)
250 FORMAT(' WHAT FIELD IS THE RADIUS?(1 OR 2) ',/)
GO TO 267
C
C DATA/X-Y ONLY
C
262 WRITE(IDLG,266)
266 FORMAT(' WHAT FIELD IS THE HORIZONTAL VARIABLE?(1 OR 2) ',/)
C
C DATA PLOTTING COMBINED
C
267 INDVAR='R'
DEPVAR='T'
READ(IRSP,112)IVAR
IF(IVAR.EQ.1.OR.IVAR.EQ.2)GO TO 274
WRITE(IDLG,116)
GO TO 246
274 WRITE(IDLG,268)
268 FORMAT(' DO YOU WISH TO TRANSFORM THE DATA?(YES OR NO) ',$)
READ(IRSP,269)ITRN
269 FORMAT(A3)
WRITE(1,224)ITYPE,JTYPE,NE,INDVAR,IVAR,ITRN,INDVAR,DEPVAR,DEPVAR
IF(ITRN.NE.'YES')GO TO 280
WRITE(IDLG,272)
272 FORMAT(' TRANSFORMATION INPUT?(TYPE HELP IF NEEDED--',$)
CALL IO(-2,NDEVI,DEVNAM,IDVI,NAMI,IPROJ,IPROG,IBNK)
IF(IDVI.EQ.'TTY')WRITE(IDLG,271)
271 FORMAT(' ENTER TRANSFORMATIONS')
IF(IDVI.NE.'TTY')WRITE(IDLG,270)IDVI
270 FORMAT(' TRANSFORMATIONS ARE BEING READ FROM ',A5,//)
WRITE(IDLG,273)DEPVAR,DEPVAR
273 FORMAT(' E.G. ',A1,'(2)=1.+',A1,'(2)',//)
CALL EQUA(NDEVI,IOUT,IDVI,IERR)
IF(IERR.EQ.0)GO TO 280
WRITE(IDLG,244)
GO TO 200
C
C ALL COMBINE HERE TO RUNUUO
C
C---------------SUBR. PXPLOT IS WRITTEN ON DISK INTO FILE CALLED
C---------------PVPLOT. SEE ST. 108+2 AND ST. 100-4.
280 WRITE(1,282)ID
282 FORMAT(' RETURN',/,' END',/,
1 ' SUBROUTINE PXPLOT(I)',/,' WRITE(I,1)',/,
1 '1 FORMAT(/,',2H' ,8A5,2H',,/,
1 ' 1 ',1H'8A5,4H',/),/,
1 ' RETURN',/,' END')
WRITE(IDLG,254)
254 FORMAT(/)
CALL RELEAS(1)
C---------------/FOROTS IS NO LONGER NECESSARY. THE MAIN PROG.
C--------------- IN THE COMPILED RESULT IS PUPLOT.
302 CALL RUNUUO('EX/FOROTS/F10 REL:PUPLOT,DSK:PVPLOT,
1 REL:APLB10/LIB')
C RUNUUO FOR DISTRIBUTION
C CALL RUNUUO('EX/FOROTS/F10 PUPLOT,PVPLOT,FORGEN,IO,FORWMU/LIB ')
END
C
C
C EQUA - A ROUTINE TO ALLOW ENTRY AND EDITING OF
C FORTRAN FORM STATEMENTS.
C WRITTEN FOR USE IN CREATING SUBROUTINES FROM
C A FORTRAN PROGRAM
C
C ARGUMENTS:
C IRSP - USER RESPONSE CHANNEL(USUALLY -4)
C IOUT - OUTPUT CHANNEL FOR EQUATIONS
C IDEVI - USER RESPONSE DEVICE
C IERR - 0 IF NO FATAL ERRORS HAVE OCCURED
C 1 IF ERROR(S)
C
C
C WRITTEN BY RUSS BARR III
C DATE: FEB 1973
C
C
C---------------EQUA ALLOWS USER TO ENTER AND MODIFY EQUATIONS.
C--------------- IRSP, IOUT, IDEVI ARE INPUT. IERR OUTPUT.
SUBROUTINE EQUA(IRSP,IOUT,IDEVI,IERR)
DIMENSION IN(15,51),INA(15)
DATA IDLG,ITAB/-1,' '/
ITTY=-4
IL=0
400 READ(IRSP,402,END=408,ERR=824)(IN(I,IL+1),I=1,15)
402 FORMAT(A1,14A5)
IF(IL.GE.50)GO TO 404
IF(IN(1,IL+1).EQ.' '.AND.IN(2,IL+1).EQ.' '.AND.IN(3,IL+1)
1 .EQ.' ')GO TO 408
IL=IL+1
GO TO 400
404 WRITE(IDLG,406)
406 FORMAT(' ?TOO MANY LINES')
IF(IDEVI.NE.'TTY')GO TO 824
WRITE(IDLG,822)
408 IF(IL.EQ.0)GO TO 712
DO 708 IX=1,IL
DO 410 J=15,1,-1
410 IF(IN(J,IX).NE.' ')GO TO 707
707 IF(IDEVI.EQ.'TTY')WRITE(IDLG,704)IX,(IN(I,IX),I=1,J)
704 FORMAT(1X,I2,':',A1,14A5)
708 CONTINUE
712 IF(IDEVI.NE.'TTY')GO TO 800
WRITE(IDLG,714)
714 FORMAT(/,' OK?(YES OR NO) ',$)
READ(ITTY,716)ANS
716 FORMAT(A3)
IF(ANS.EQ.'YES')GO TO 800
719 WRITE(IDLG,718)
718 FORMAT(' ENTER LINE NUMBER,LINE(E.G. 3,IX=1)',/)
721 READ(ITTY,720)IX,(INA(I),I=1,15)
720 FORMAT(I,A1,14A5)
IF(IX.LE.0)GO TO 712
IF(IX.GT.IL+1)GO TO 818
IF(IX.GT.50)GO TO 816
IF(IX.GT.IL)IL=IL+1
DO 722 J=15,1,-1
IF(INA(J).NE.' ')GO TO 724
722 CONTINUE
724 DO 723 I=1,15
723 IN(I,IX)=INA(I)
WRITE(IDLG,704)IX,(IN(I,IX),I=1,J)
WRITE(IDLG,702)
702 FORMAT(/)
GO TO 721
800 DO 810 IZ=1,IL
DO 802 J=15,1,-1
802 IF(IN(J,IZ).NE.' ')GO TO 906
906 IF(IN(1,IZ).EQ.' ')GO TO 910
IF(IN(1,IZ).GE.'1'.AND.IN(1,IZ).LE.'9')GO TO 910
IF(IN(1,IZ).EQ.ITAB)GO TO 910
WRITE(IOUT,908)(IN(I,IZ),I=1,J)
908 FORMAT(6X,A1,14A5)
GO TO 810
910 WRITE(IOUT,912)(IN(I,IZ),I=1,J)
912 FORMAT(A1,14A5)
810 CONTINUE
RETURN
812 WRITE(IDLG,814)
814 FORMAT(' ?ERROR IN LINE')
IF(IDEVI.NE.'TTY')GO TO 824
WRITE(IDLG,822)
822 FORMAT(' ?LAST LINE IGNORED',/)
GO TO 719
816 WRITE(IDLG,406)
IF(IDEVI.NE.'TTY')GO TO 824
WRITE(IDLG,822)
GO TO 719
818 IF(IDEVI.NE.'TTY')GO TO 824
IQ=IX-1
WRITE(IDLG,820)IQ
820 FORMAT(' ?LINE #',I2,' NEVER ENTERED-LAST LINE IGNORED')
IF(IDEVI.NE.'TTY')GO TO 824
GO TO 719
824 IERR=1
RETURN
END