2      SUBROUTINE GRAPHIT (IQ,XX,YY,ZZ,NP ,IW,IERR)LC_TITLE  GRAPHIT  Generalized plotting routine, interfaces to the XG system.C_ARGUMENTS,	INTEGER IQ        ![In] Input control code.,	REAL*4 XX(*) 	  ![In] X label ASCII string.	REAL*4 YY(*)	  ![In] Y label	REAL*4 ZZ(*)	  ![In] Z labelC	INTEGER NP	  ![In] Number of longwords needed for working storage.A	INTEGER IW(9)	  ![In] For IQ=1 and 2, is an input parameter set.)	INTEGER IERR	  ![Out] Error return code.5C Arguments have change of meaning with different IQ.&C IQ is always the input control code.CC IW(*); for IQ =1 & 2, is an input parameter set for IQ = 3,4,5 ; 1C scratch working area available to this routine.&C IERR is always an error return code.C  0 = Normal successful return
C -* = ????C  Other arguments described for each IQ below, or are ignored.BC***  IQ =1 ***   Define a Graph, Get all user defined parameters."C Input	XX = X label ASCII string.C	YY = Y labelC	ZZ = Z label0C	IW: The first 9 items are identical to NCAR_1.6C           Program must set items 1-3 (logical units)@C	    this routine sets item 4 (default) and item 5 (execution).-C	IW(1) = LUN for plot input or control file.C	IW(2) = LUN for prompt&C	IW(4) = Prompt flag: 0 = batch mode.C	IW(5) = LUN for log file.'C	IW(10) = LUN Input for XX parameters.0C	IW(11) = X label length, number of characters.0C	IW(12) = Y label length, number of characters.0C	IW(13) = Z label length, number of characters.0C	IW( ) = Max number of points in a single call.BC	IW( ) = Max number of points in repeated calls to the same page.=C Output NP = number of longwords needed for working storage.DC*** IQ=2 ***	Initiate a curve, initiate new page, change line type.C6C Input	IW(1) = Flag to get new curve type definition.>C	IW(3) = Number of characters in title for page (up to 6 willC	be used for a curve title).GC	XX(1,2) = Minimum,maximum of X to use for plot_auto-scale [not impl].GC	YY(1,2) = Minimum,maximum of Y to use for plot_auto-scale [not impl].'C	ZZ(1- ) = Title of curve,and of page..C	NP = PAGE FLAG; 1 = New page, 0 = same page.	'C*** IQ = 3 ***   Plot a set of points.	C Input	XX(*) = X data pointsC	YY(*) = Y data pointsC	NP = number of points<C*** IQ=4 ***	Stop curve (if open) and stop frame (if open).	C*** IQ=5 ***	End the plot job.HC_DESCRIPTION  The program GRAPHIT.FOR is a generalized plotting routineHC designed to interface to the XG database system.  GRAPHIT is the main JC plotting module used to invoke a sequence of modules necessary to create&C an XY plot in the given projection.  EC      The philosophy used in these programs was intended to give theJC      user as much flexibility as possible.  Below is a brief summary of !C      the conventions used here.EC	1) GRAPHIT is called from a user supplied program.  Generally thereLC          will be at least five calls to GRAPHIT, based on the value of IQ.?C	2) With minimal modification these routines should be easily 5C	   transformed into a generalized plotting package.DC This module is Controlled by subroutine XGUSER in subroutine PLOT.OC This module is called 5 times from XGUSER, on every call there is a differentAC operational mode, with different definitions for the arguments.HC_CALLS  B2B  DATIME  PWRIT1  SET1  POINTS  FRSTPT  VECTOR  PWRIT  FRAMEC QISORT9C_HISTORY  85Nov06 R.Gurule, U.S.G.S, Flagstaff AZ. 86001C_END4	PARAMETER (NANN=7)	        ! Number of annotations.@	PARAMETER (LENANN=40)		! Maximum length of an annotation string%	LOGICAL PFLG,START,POINT,COPEN,FOPEN	BYTE LAB(LENANN,NANN),TPROJ(4)3	REAL*4  PARMAP(8),DATIM(5),RA(8),XY(2),XW(4),XS(4)>	INTEGER*4 LTYPE,KON(10),XYCOORD(14),IXYLAB(2),MA(4),XYCOR(14)3	INTEGER*2 IT(3),ICL(3),IXL(3),IYL(3),ITEMP,LENC(7)	CHARACTER*1 TEMP,PCHAR,LINEQ)        CHARACTER*12 IFMTX,IFMTY,CPROJ *42 	CHARACTER ANS*1, NT*2, PFILE*16, PROMPT(NANN)*10"        CHARACTER*40 LABEL, DUM*40&	DIMENSION IP(7,NANN),X(4),Y(4),MAJ(7)#	DIMENSION ITL(3),LLCODE(2),IGRD(7)$	INCLUDE 'RAD$INC:TAEBAS.INC/NOLIST'	=	DATA NX,NY/6,6/, ISIZX,ISIZY/0,0/, IXDEC,IYDEC/0,0/, IXOR/0/<	DATA PROMPT/'X-AXIS','Y-AXIS', 'Z-AXIS','TITLE','DAY_TIME',!     1	'FRAME','ZOFFSET'/,NUMZ/6/=        DATA START/.FALSE./,NXCHAR,NYCHAR,NTITLE/3*6/,NLAB/5/!        DATA NFRAME/0/,ICHAR/'*'/%        DATA PARMAP/8 * 0.0/,LTYPE/1/+        DATA IFMTX,IFMTY/'(F6.1)','(F6.1)'/         DATA IGRD/5,0,5,0,1,1,5/	DATA IP /	2     & 500,  10,  40,   1,   1,   0,  -1,	! x-axis2     &  10, 500,  40,   1,   1,  90,  -1,	! y-axis1     &  5,  50,  40,   1,   1,   0,  -1,	! z-axis2     &  20, 1000,   0,   1,   1,   0,  -1,	! title5     & 700, 1000,   0,  20,   1,   0,  -1,	! day_time)     & 850, 50,   40,   1,   1,   0,  -1,:     &  10,   0,   0,   1,   1,   0,  -1/	! z-value offset
	IERR = 0            IJ=0        KJ=0 	GO TO (100,200,300,400,500) ,IQ"!-----Prompt for any user options. 100    CONTINUE1	LOG = IW(5)                                     !-------Save all labels.=	CALL B2B (%REF(' '),LAB,-NANN*LENANN)	!Blank all annotation.%	IP(4,1) = 6				!IW(1)= X axis label. 	CALL B2B (XX, LAB(1,1),IP(4,1))	IP(4,2) = 6				!IW(2)= Y axis. 	CALL B2B (YY, LAB(1,2),IP(4,2))$ 	IP(4,3) = IW(3) 			!IW(3)= Z axis. 	CALL B2B (ZZ, LAB(1,3),IP(4,3))6        IP(4,4) = 1				!Curve Title (defined at IQ=2).	IP(4,5) = 20				!Day-Time.	CALL DATIME (DATIM)	CALL B2B (DATIM,LAB(1,5),20)	IP(4,6) = 8				!Frame number.&	CALL B2B(%REF(' FRAME 0'),LAB(1,6),8)!--- Initialize the projection.      L10=10:      CALL XRSTR(BLOCK, 'IFMTX',1,IFMTX,LCN6,ICNT6,ISTAT6):      CALL XRSTR(BLOCK, 'IFMTY',1,IFMTY,LCN7,ICNT7,ISTAT7)F!-----Decode the arguments field width from a Fortran format statement !     e.g., F5.1, extract the 5.      TEMP = IFMTX(3:3)#      DECODE(1,4000,IFMTX(3:3))NUMX 4000 FORMAT(I1)      TEMP = IFMTY(3:3)#      DECODE(1,4000,IFMTY(3:3))NUMY$!-----Fetch general NCAR parameters.4      CALL XRREAL(BLOCK, 'WCOORD',4,XW,ICNT8,ISTAT8)4      CALL XRREAL(BLOCK, 'SCOORD',4,XS,ICNT9,ISTAT9)4      CALL XRINTG(BLOCK, 'ISIZX',1,ISIZX,ICNT,ISTAT)4      CALL XRINTG(BLOCK, 'ISIZY',1,ISIZY,ICNT,ISTAT)4      CALL XRINTG(BLOCK, 'IXDEC',1,IXDEC,ICNT,ISTAT)4      CALL XRINTG(BLOCK, 'IYDEC',1,IYDEC,ICNT,ISTAT)4      CALL XRINTG(BLOCK, 'IXOR',1,IXOR, ICNT, ISTAT)!-----Fetch gridal parameters.1      CALL XRINTG(BLOCK, 'MAJRX',4,MA,ICNT,ISTAT)6      CALL XRINTG(BLOCK, 'IXYLAB',2,IXYLAB,ICNT,ISTAT)2      CALL XRINTG(BLOCK, 'IGPH',1,IGPH,ICNT,ISTAT).      CALL XRREAL(BLOCK, 'XY',2,XY,ICNT,ISTAT)!-----Fetch pwrit1 parameters.      N = NLAB*2      N1= NLAB*46      CALL XRSTR(BLOCK,'LINEQ',1,LINEQ,LEN,ICNT,ISTAT)      IPEN=0      START=.TRUE.2      NP=0					!We won't request any core for now.'      FOPEN=.FALSE.				!frame open flag@!-------Prompt for the labels.	Converting to uppercase as we go.		DO I=1,3		DO K=1,6<	 IF(LAB(K,I).GE.97.AND.LAB(K,I).LE.122)LAB(K,I)=LAB(K,I)-32	ENDDO
	ENDDO       !	WRITE(LOG,1000) PFILE,DATIM,NVAR3 1000	FORMAT('0 THE INPUT FILE IS ',A14,'  ',5A4,/,2	1      ' THE NUMBER OF VARIABLES PLOTTED =',I1,/) 	RETURNL!---------------------------------------------------------------------------A!	Initiate a curve, new page, and draw the graph, and the labels.L!---------------------------------------------------------------------------200   CONTINUEL                                                                            	KON(10)=2         NCUR = NCUR + 1	NPF=NPF+NP9	IF(NP.EQ.1.AND.COPEN) THEN	        !Close curve if open.	  WRITE(LOG,1050)NCUR,NP 	  COPEN=.FALSE.	ENDIF0       IF (FOPEN) THEN				!Close any open frame.          NFRAME = NFRAME + 1(          WRITE(LOG,1420)NFRAME,NCUR,NPF9 1420     FORMAT(' FRAME, # CURVES, #POINTS TOTAL=',3I4/)
	  CALL FRAME	  FOPEN=.FALSE.
	  NPF = 0	  NCUR = 0	ENDIF2220	NTITLE = MIN(IW(3),LENANN)		!Save curve title.	IP(4,4) = NTITLE	CALL B2B (ZZ,LAB(1,4),NTITLE)>	WRITE(LOG,'(A,40A1)')' CURVE TITLE = ', (LAB(I,4),I=1,NTITLE)>	IF(NP.EQ.1 .OR. .NOT.START) THEN	!IF NP=1 THEN START NEW PAGE	  FOPEN=.TRUE.+          COPEN=.FALSE.				!curve open flagc?	  WRITE(LOG,1060)NFRAME                                       *) 1060     FORMAT('   FRAME NUMBER ',I3,/)[	  LAB(8,6) = LAB(8,6) + 1=!---------Do we need to check the number of points per frame.I      IF(NPF.NE.0)THENE      CALL SET(XS(1),XS(2),XS(3),XS(4),XW(1),XW(2),XW(3),XW(4),LTYPE)e4      CALL LABMOD(%REF(IFMTX),%REF(IFMTY),NUMX,NUMY,$     1 ISIZX,ISIZY,IXDEC,IYDEC,IXOR)C      CALL GRIDAL(MA(1),MA(2),MA(3),MA(4),IXYLAB(1),IXYLAB(2),IGPH,3     1   XY(1),XY(2))k      ENDIFl      NPF=0	          !-----Plot the labels.F!-----Encode the label from integer to character type before plotting.      DO J=1,NLABe#!	ENCODE(6,4001,LAB(1,J))LABEL(1:6)*!4001    FORMAT(3I2)	IF(IP(4,J).NE.0)THENn(	  WRITE(DUM,4001)(LAB(L,J),L=1,IP(4,J)) 4001     FORMAT(40A1)          READ(DUM,4002)LABEL  4002     FORMAT(A<IP(4,J)>)          IF(J .NE. 1)THEN            KJ=KJ+2(          ENDIF	7        CALL PWRIT(IP(1,J),IP(2,J),%REF(LABEL),IP(4,J),i      1	IP(5,J),IP(6,J),IP(7,J) )	ENDIF%      ENDDO            !End plotting.      ENDIFm      RETURN            !---- Plot a set of points.	 300	NPTS=NP					r	IF(NPTS.LT.1) RETURN1H!---- Flag for keeping the last point of the array and calling FRSTPT on1!     the before plotting the next set of points.         IF(.NOT.COPEN)then	   CFLG=0          	ELSEc
	   CFLG=1	ENDIF	 C	COPEN = .TRUE.                                                    b	NCUR = NCUR + 1!---- Plot the path.	ICHAR = '.'			IF(LINEQ.EQ.'Y')THENa	  DO I=1,NP(	    IF(I.EQ.1) CALL FRSTPT(XX(1),YY(1))	    CALL VECTOR(XX(I),YY(I))o	  ENDDO	ELSEb)	  IF(CFLG.EQ.1) CALL FRSTPT(XLAST,YLAST) $	  CALL POINTS (XX,YY,NP,ICHAR,IPEN)	  XLAST = XX(NP),	  YLAST = YY(NP) 	ENDIF
      RETURN	tJ!=========================================================================<  400   CONTINUE		!If user calls with IQ=4 then end of page.)  	IF(COPEN) THEN		!Close any open curve. 	  NPF = NPF + NPTOT	  WRITE(LOG,1050)NCUR,NPTOTC 1050     FORMAT('     CURVE NUMBER ',I3,' HAS ',I5,' DATA POINTS')	  COPEN = .FALSE.	ENDIF)	IF (FOPEN) THEN				!Close any open frameI!	  WRITE(LOG,1420)NFRAME,NCUR,NPFC
	  CALL FRAMEo	  FOPEN=.FALSE.
	  NPF = 0	  NCUR = 0r	ENDIF	RETURNd1!-------If user calls with IQ=5 then end GRAPHIT.t  500   CALL FRAME			RETURNt	END