PDP-10 Archive: decus/20-0137/ptplot/ptplot.for from decus_20tap5

Trailing-Edge - PDP-10 Archives - decus_20tap5_198111 - 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