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) 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