C$Procedure EZPLOT C PROGRAM EZPLOT C C$ Log C C 15-Mar-1989 - Eric Cannell - creation C 23-Jun-1989 - Eric Cannell - added input SUMMRY C 14-FEB-1990 - Eric Cannell - lengthened DEVICE to 50 characters C 3-APR-1990 - Eric Cannell - added TX and TY inputs to $ZLINE C 4-APR-1990 - Eric Cannell - changed KX, TX, X, KY, TY, and Y to DP C Doesn't not effect function, only accuracy. C C$ Purpose C C EZPLOT allows the user to draw a single frame with an arbitrary C number of curves on it. C C******************************************************************************* C C Copyright (C) 1993, California Institute of Technology. U.S. C Government Sponsorhip under NASA Contract NAS7-918 is C acknowledged. C C******************************************************************************* C$ Namelist_Input C C $ZFRAME C ======= C C $ZFRAME defines the frame or box within which a set of curves will be C drawn. $ZFRAME does not define the curves, only the frame. Therefore, C only one $ZFRAME namelist will be read. C C Name Type Dim Default Units Description C ---------------------------------------------------------------------------- C CH R 1 .75 - PGPLOT character height of text C on frame C CI I 1 2 - PGPLOT color index for frame C DEVICE C*50 1 '/NULL' - PGPLOT plot device. If DEVICE = C '/null', then no plot is made. C OFILE C*20 1 'EZPLOT.LIS' - output list file name C SUMMRY L 1 T - if true, then summary of what EZPLOT C has plotted is written to OFILE C TITLE C*100 1 ' ' - frame title. PGPLOT escape codes C are available. Trailing blanks C are ignored. C VPORT R 4 4*-1.0 in PGPLOT viewport coordinates in C inches, left-x, right-x, bottom-y, C and top-y. If left-x is not changed C from default, then standard viewport C is used. C WINDO R 4 4*0.0 --> PGPLOT window boundaries in world C coordinates, left-x, right-x, C bottom-y, and top-y. C XOPT C*12 1 'BCNST' - x-axis options for call to PGBOX. C Consult PGPLOT User's Guide for C further details. C XSUB I 1 0 - number of subdivision twixt ticks C on x-axis. Zero tells PGPLOT to C figure it out. Consult PGPLOT User's C Guide for further details. C XTICK R 1 0.0 --> distance twixt ticks on x-axis. Zero C tells PGPLOT to figure it out. C Consult PGPLOT User's Guide for C further details. C XTITLE C*100 1 ' ' - title of x-axis. PGPLOT escape codes C are available. C YOPT C*12 1 'BCNST' - y-axis options for call to PGBOX. C Consult PGPLOT User's Guide for C further details. C YSUB I 1 0 - number of subdivision twixt ticks C on y-axis. Zero tells PGPLOT to C figure it out. Consult PGPLOT User's C Guide for further details. C YTICK R 1 0.0 --> distance twixt ticks on y-axis. Zero C tells PGPLOT to figure it out. C Consult PGPLOT User's Guide for C further details. C YTITLE C*100 1 ' ' - title of y-axis. PGPLOT escape codes C are available. C C $ZLINE C ====== C C $ZLINE defines a curve to be drawn within a frame already defined by C input namelist $ZFRAME. However, unlike $ZFRAME, $ZLINE can be defined C more than once. This allows an arbitrary number of curves to be plotted C on the frame. Keep in mind that any variable not redefined by a subsequent C $ZLINE namelist retains its value from the previous $ZLINE namelist. C C Although some inputs are double precision, they are ultimately converted C to single precision. The value of double precision inputs comes to light C when the TX or TY inputs are used to difference 2 very close double C precision numbers. For example, X = KX * X + TX, when TX ~= -X. In this C case, the computed difference will have many more significant digits C than if the difference was computed using single precision operands. C C Also, $ZLINE can be used to write a text string using the PGPLOT routine C PGPTEXT as: CALL PGPTEXT( XTXT , YTXT , ANGLE , FJUST , TEXT ). C C Name Type Dim Default Units Description C ---------------------------------------------------------------------------- C ANGLE R 1 0.0 deg angle at which to write TEXT, C counterclockwise from x-axis C CH R 1 .75 - PGPLOT character height of TEXT C CI I 1 2 - PGPLOT color index for line and TEXT C FJUST R 1 0.0 - horizontal justification for TEXT. C If FJUST is 0.0, then TEXT is left C justified. If FJUST is .5, then TEXT C is centered on (XTXT,YTXT). If FJUST C is 1.0, then TEXT is right justified. C KX DP 1 1D0 - scale the X data by a scalar constant; C i.e. KX=.001 will convert meters to km C KY DP 1 1D0 - scale the Y data by a scalar constant; C i.e. KY=86400 converts days to seconds C NPTS I 1 0 - number of points defined in X and Y C NPTS must be =< MAXPTS. C STYLE I 1 1 - controls how the drawn line appears. C Except for STYLE=0, STYLE functions C like PGPLOT line style: C 0 --> no line is drawn. Useful C if the user only wants to C plot graphics markers C 1 --> -------------- C 2 --> - - - - - - - C 3 --> .-.-.-.-.-.-.- C 4 --> .............. C 5 --> -...-...-...- C SYMBOL I 1 -2 - if SYMBOL is -1..127, then the C appropriate graphics marker is C drawn at all (X,Y)'s. See PGPLOT C User's Guide for further details. C TEXT C*100 1 ' ' - text to be written at (XTXT,YTXT). C May contain PGPLOT escape codes. C TX DP 1 0D0 - translate the X data by a scalar C constant after scale factor KX has been C applied; i.e. TX=-100 will subtract 100 C from every x value C TY DP 1 0D0 - translate the Y data by a scalar C constant after scale factor KY has been C applied; i.e. TY=66.33 will add 66.33 C to every y value C X DP MAXPTS MAXPTS*0D0 --> x-coordinates of the NPTS points in C units of the world coordinates C XTXT R 1 0.0 --> x-coordinate of TEXT in units of C the world coordinates C Y DP MAXPTS MAXPTS*0D0 --> y-coordinates of the NPTS points in C units of the world coordinates C YTXT R 1 0.0 --> x-coordinate of TEXT in units of C the world coordinates C units of the world coordinates C C$ Library_Links C C PGPLOT C C$ Files C C 7 - namelist input file C 8 - output list file C ? - PGPLOT plot file C C$ Parameters C INTEGER MAXPTS PARAMETER ( MAXPTS = 20000 ) C C$ Declarations_of_Input_and_Output_Arguments C REAL CH INTEGER CI CHARACTER*50 DEVICE CHARACTER*20 OFILE LOGICAL SUMMRY CHARACTER*100 TITLE REAL VPORT ( 4 ) REAL WINDO ( 4 ) CHARACTER*12 XOPT INTEGER XSUB REAL XTICK CHARACTER*100 XTITLE CHARACTER*12 YOPT INTEGER YSUB REAL YTICK CHARACTER*100 YTITLE REAL ANGLE REAL FJUST DOUBLE PRECISION KX DOUBLE PRECISION KY INTEGER NPTS INTEGER STYLE INTEGER SYMBOL CHARACTER*100 TEXT DOUBLE PRECISION TX DOUBLE PRECISION TY DOUBLE PRECISION X ( MAXPTS ) REAL XTXT DOUBLE PRECISION Y ( MAXPTS ) REAL YTXT C C$ Declarations_of_Local_Variables C LOGICAL ERROR CHARACTER*75 FGRPRT INTEGER IPT DOUBLE PRECISION XDP ( MAXPTS ) REAL XRL ( MAXPTS ) DOUBLE PRECISION YDP ( MAXPTS ) REAL YRL ( MAXPTS ) INTEGER ZCOUNT C C$ Namelists C NAMELIST / ZFRAME / CH , CI , DEVICE , OFILE , SUMMRY , & TITLE , VPORT , WINDO , XOPT , XSUB , & XTICK , XTITLE , YOPT , YSUB , YTICK , & YTITLE NAMELIST / ZLINE / ANGLE , CH , CI , FJUST , KX , & KY , NPTS , STYLE , SYMBOL , TEXT , & TX , TY , X , XTXT , Y , & YTXT C C$ Data_Statements C DATA CH / .75 / DATA CI / 2 / DATA DEVICE / '/NULL' / DATA OFILE / 'EZPLOT.LIS' / DATA SUMMRY / .TRUE. / DATA TITLE / ' ' / DATA VPORT / 4 * -1.0 / DATA WINDO / 4 * 0.0 / DATA XOPT / 'BCNST' / DATA XSUB / 0 / DATA XTICK / 0.0 / DATA XTITLE / ' ' / DATA YOPT / 'BCNST' / DATA YSUB / 0 / DATA YTICK / 0.0 / DATA YTITLE / ' ' / DATA ANGLE / 0.0 / DATA FJUST / 0.0 / DATA KX / 1D0 / DATA KY / 1D0 / DATA NPTS / 0 / DATA STYLE / 1 / DATA SYMBOL / -2 / DATA TEXT / ' ' / DATA TX / 0D0 / DATA TY / 0D0 / DATA X / MAXPTS * 0D0 / DATA XRL / MAXPTS * 0.0 / DATA XTXT / 0.0 / DATA Y / MAXPTS * 0D0 / DATA YRL / MAXPTS * 0.0 / DATA YTXT / 0.0 / DATA ZCOUNT / 0 / C C$ Method C-& C1> Use OPSFOR to open the input file. CALL OPSFOR ( 7 , 'IN_EZPLOT' , ERROR ) IF ( ERROR ) THEN WRITE(*,'(/1X,''EZPLOT: cannot open file IN_EZPLOT.'')') STOP END IF C1 Read the input namelist $ZFRAME. READ(7,ZFRAME,END=901) GO TO 902 901 CONTINUE WRITE(*,'(/1X,''EZPLOT: cannot find namelist $ZFRAME.'')') STOP 902 CONTINUE C1> Use OPSFN to open the output file, if SUMMRY is true. IF ( SUMMRY ) THEN CALL OPSFN ( 8 , OFILE , ERROR ) IF ( ERROR ) THEN WRITE(*,'(/1X,''EZPLOT: cannot open file '',A,''.'')') OFILE STOP END IF END IF C1 Print program header label and fingerprint if SUMMRY is true. IF ( SUMMRY ) THEN CALL PRTHDR ( 8 , 80, 'Program EZPLOT' ) CALL GETFPI ( 'EZPLOT' , FGRPRT ) WRITE(8,'(//1X,A75,///)') FGRPRT END IF C1 Echo the plot frame characteristics if SUMMRY is true. IF ( SUMMRY ) WRITE(8,301) TITLE(1:50), TITLE(51:100), & DEVICE, CH, CI, VPORT, WINDO 301 FORMAT(//,1X,'The Plot Frame Defined by $ZFRAME:' & //,5X,'title : "',A50,'"', & /,5X,'title, continued : "',A50,'"', & /,5X,'plot device : ',A50, & /,5X,'character height : ',F5.2, & /,5X,'color index : ',I3, & /,5X,'viewport : ',4F12.5, & /,5X,'window : ',4E12.5 ) IF ( SUMMRY ) WRITE(8,302) XTITLE( 1:50) , XTITLE(51:100) , & XOPT , XTICK , XSUB , & YTITLE( 1:50) , YTITLE(51:100) , & YOPT , YTICK , YSUB 302 FORMAT( /,5X,'x-axis title : "',A50,'"', & /,5X,'x-axis title : "',A50,'"', & /,5X,'x-axis options : ',A12, & /,5X,'x-axis tick dist : ',E15.8, & /,5X,'x-axis sub ticks : ',I2, & //,5X,'y-axis title : "',A50,'"', & /,5X,'y-axis title : "',A50,'"', & /,5X,'y-axis options : ',A12, & /,5X,'y-axis tick dist : ',E15.8, & /,5X,'y-axis sub ticks : ',I2 ) C1 Open PGPLOT. CALL PGBEGIN( 0 , DEVICE , 1 , 1 ) C1 Advance the frame to clear the display. CALL PGADVANCE C1 Define the viewport. IF ( VPORT(1) .EQ. -1.0 ) THEN CALL PGVSTAND ELSE CALL PGVSIZE( VPORT(1) , VPORT(2) , VPORT(3) , VPORT(4) ) END IF C1 Define the window. CALL PGWINDOW( WINDO(1) , WINDO(2) , WINDO(3) , WINDO(4) ) C1 Set the character height and color index. CALL PGSCH ( CH ) CALL PGSCI ( CI ) C1 Draw the frame. CALL PGBOX ( XOPT , XTICK , XSUB , YOPT , YTICK , YSUB ) C1 Label the frame. CALL PGLABEL ( XTITLE , YTITLE , TITLE ) C1 For each $ZLINE namelist in the input file, draw, the curve, C1 the text, and the graphics markers, but only if indicated. 903 CONTINUE READ(7,ZLINE,END=904) C2 Identify namelist. ZCOUNT = ZCOUNT + 1 C2 Echo summary only if SUMMRY is true. IF ( SUMMRY ) WRITE(8,303) ZCOUNT , CH , CI 303 FORMAT(//,1X,'The Line and Text Defined by $ZLINE #',I2,':', & //,5X,'character height : ',F5.2, & /,5X,'color index : ',I3 ) C2 Adjust character height and color index. CALL PGSCH ( CH ) CALL PGSCI ( CI ) C2 Write text if present. Echo is SUMMRY is true. IF ( TEXT .NE. ' ' ) THEN IF ( SUMMRY ) WRITE(8,304) TEXT(1:50), TEXT(51:100), & ANGLE , FJUST , XTXT , YTXT 304 FORMAT(//,5X,'text : "',A50,'"', & /,5X,'text, continued : "',A50,'"', & /,5X,'text angle : ',F8.3, & /,5X,'text justified : ',F8.3, & /,5X,'text x-coord : ',E12.5, & /,5X,'text y-coord : ',E12.5 ) CALL PGPTEXT ( XTXT , YTXT , ANGLE , FJUST , TEXT ) END IF C2 Draw curve. Echo status and data only if SUMMRY is true. IF ( NPTS .GT. MAXPTS ) THEN IF ( SUMMRY ) WRITE(8,305) NPTS , MAXPTS 305 FORMAT(//,5X,'NPTS (',I,') must be <= ',I,'.') GOTO 903 ELSE IF ( NPTS .GT. 0 .AND. NPTS .LE. MAXPTS ) THEN C3 Scale and translate both x-axis and y-axis data. DO 101 IPT = 1 , NPTS XDP( IPT ) = KX * X( IPT ) + TX YDP( IPT ) = KY * Y( IPT ) + TY 101 CONTINUE C3 Write summary data if flagged. IF ( SUMMRY ) WRITE(8,306) STYLE , SYMBOL , & KX , KY , & TX , TY , NPTS , & ( IPT , & XDP( IPT ) , & YDP( IPT ) , & IPT = 1 , NPTS & ) 306 FORMAT(//,5X,'line style : ',I5, & /,5X,'line marker : ',I5, & /,5X,'scaling of x-data : ',D24.16, & /,5X,'scaling of y-data : ',D24.16, & /,5X,'translate x-data : ',D24.16, & /,5X,'translate y-data : ',D24.16, & /,5X,'line points cntr : ',I5, & /,(5X,'line point (',I4,') : ',2D24.16 ) ) C3 Convert the double precision values to single precision. DO 102 IPT = 1 , NPTS XRL( IPT ) = SNGL( XDP( IPT ) ) YRL( IPT ) = SNGL( YDP( IPT ) ) 102 CONTINUE C3 Plot the line. IF ( STYLE .NE. 0 ) THEN CALL PGSLS ( STYLE ) CALL PGLINE ( NPTS , XRL , YRL ) END IF END IF C2 Draw the graphics markers. IF ( SYMBOL .GT. -2 .AND. SYMBOL .LT. 128 ) & CALL PGPOINT ( NPTS , XRL , YRL , SYMBOL ) C1 Go up and read another $ZLINE namelist. GO TO 903 904 CONTINUE C1 Close PGPLOT. CALL PGEND END C******************************************************************************* C C Copyright (C) 1993, California Institute of Technology. U.S. C Government Sponsorhip under NASA Contract NAS7-918 is C acknowledged. C C******************************************************************************* subroutine getfpi(PRONAM, FGRPRT) character PRONAM*(*), FGRPRT*(*) character curtim*20, lnktim*20 external lnktim call gettim(curtim) fgrprt = 'Enter '//PRONAM//' '//curtim//' linked '//lnktim() return end C******************************************************************************* C C Copyright (C) 1993, California Institute of Technology. U.S. C Government Sponsorhip under NASA Contract NAS7-918 is C acknowledged. C C******************************************************************************* subroutine gettim(curtim) character curtim*(*) character adate*9,atime*8 call date(adate) call time(atime) curtim = adate//' '//atime return end C******************************************************************************* C C Copyright (C) 1993, California Institute of Technology. U.S. C Government Sponsorhip under NASA Contract NAS7-918 is C acknowledged. C C******************************************************************************* C$ Procedure PRTHDR C SUBROUTINE PRTHDR ( UNIT , WIDTH , PNAME ) C C$ Log C C 27-Oct-1988 - Eric Cannell - creation C 25-JAN-1990 - Eric Cannell - added UNIT, WIDTH and variable PNAME length C C$ Purpose C C PRTHDR prints a header to the specified FORTRAN unit which includes the C string PNAME and a run time stamp. C C$ Input_Arguments C C Name Type Dim Units Description C ----------------------------------------------------------------------------- C UNIT I 1 - FORTRAN unit number of output file C WIDTH I 1 in columns columnal width of header. WIDTH must C in range of MINWID..MAXWID. C PNAME C*(*) 1 - header label, usually program name or C some other significant label. Length of C PNAME without trailing blanks must be C in range of 1..WIDTH-8. C C$ Restrictions C C 1] WIDTH must be in the range MINWID..MAXWID. C C 2] PNAME must have a length in the range of 1..WIDTH-8. C C$ Library_Links C C NAVSYS - navigation system library C C$ Files C C ? - UNIT - output unit number C C$ Parameters C INTEGER MINWID PARAMETER ( MINWID = 46 ) INTEGER MAXWID PARAMETER ( MAXWID = 132 ) C C$ Declarations_of_Input_and_Output_Arguments C INTEGER UNIT INTEGER WIDTH CHARACTER*(*) PNAME C C$ Declarations_of_Local_Variables C INTEGER I CHARACTER*132 L1 CHARACTER*132 L2 INTEGER L2ALEN CHARACTER*132 L3 CHARACTER*132 L4 CHARACTER*132 L5 INTEGER PNLEN CHARACTER*20 RUNTIM INTEGER WP4DIF C C$ Method C-& C1 Check that WIDTH is in the range of MINWID..MAXWID. IF ( WIDTH .LT. MINWID .OR. MAXWID .LT. WIDTH ) THEN WRITE(UNIT,301) WIDTH , MINWID , MAXWID 301 FORMAT(//,1X,'PRTHDR: WIDTH(',I,') is not in ',I3,'..',I3,'.') RETURN END IF C1 Determine length of PNAME without trailing blanks. PNLEN = 0 DO 101 I = LEN( PNAME ) , 1 , -1 IF ( PNAME(I:I) .NE. ' ' ) THEN PNLEN = I GOTO 901 END IF 101 CONTINUE 901 CONTINUE C1 Check that length of PNAME is in the range of 1..WIDTH-8. IF ( PNLEN .LT. 1 .OR. (WIDTH-8) .LT. PNLEN ) THEN WRITE(UNIT,302) PNLEN , WIDTH 302 FORMAT(//,1X, & 'PRTHDR: Length of PNAME(',I,') is not in 1..',I,'.') RETURN END IF C1 Print the first line. DO 102 I = 1 , 12 L1(11*(I-1)+1:11*I) = '***********' 102 CONTINUE WRITE(UNIT,303) L1(1:WIDTH) 303 FORMAT(1X,A) C1 Print the second line. WP4DIF = WIDTH - PNLEN - 4 L2ALEN = WP4DIF / 2 DO 103 I = 1 , L2ALEN L2(I:I) = '*' 103 CONTINUE L2(L2ALEN+1:L2ALEN+PNLEN+4+1) = ' ' // PNAME(1:PNLEN) // ' ' DO 104 I = L2ALEN+PNLEN+4+2 , WIDTH L2(I:I) = '*' 104 CONTINUE WRITE(UNIT,304) L2(1:WIDTH) 304 FORMAT(1X,A) C1 Print the third line. CALL GETTIM( RUNTIM ) L3(1:24) = '** Date: ' // RUNTIM(1:11) L3(WIDTH-20:WIDTH) = 'Time: ' // RUNTIM(13:20) // ' **' DO 105 I = 25 , WIDTH - 21 L3(I:I) = ' ' 105 CONTINUE WRITE(UNIT,305) L3(1:WIDTH) 305 FORMAT(1X,A) C1 Print the fourth line. L4( 1: 2) = '**' L4(WIDTH-1:WIDTH) = '**' DO 106 I = 3 , WIDTH - 2 L4(I:I) = '-' 106 CONTINUE WRITE(UNIT,306) L4(1:WIDTH) 306 FORMAT(1X,A) C1 Print the fifth and last line. L5( 1: 2) = '**' L5(WIDTH-1:WIDTH) = '**' DO 107 I = 3 , WIDTH - 2 L5(I:I) = ' ' 107 CONTINUE WRITE(UNIT,307) L5(1:WIDTH) 307 FORMAT(1X,A) RETURN END