SUBROUTINE PLTYVT(HDR,YLBL,Y,IT,MXNY,NY,YMIN,YMAX,ITMIN,ITMAX) C Plot Y versus T, time. Uses GKS version of NCAR Graphics, C and, therefore, writes plot metacode to FT02, also called C "GMETA". OPNGKS and CLSGKS must be done before the first C and after the last call to this routine. C INPUTS: C HDR = Header label; will be centered above plot on a C single line (no longer than 80 characters). C YLBL = Y-axis label; will be centered on Y-axis with C text runnning from bottom to top on a single line C Y = Y array, of values to be plotted. Missing points C are excluded; missing values = -32767. C IT = X, or time, array. Uses standard I.S. 4 integers C notation: yr, moda, hrmn, centisec. C MXNY = True dimension of Y and second dimension of T. C NY = Number of assigned values in Y and T; must be C less than or equal to MXNY. C YMIN = Minimum Y value to be plotted. It does not need C to be a "nice" value since rounding will be done C to accomodate nice labels. Ymin may not equal C the actual minimum, thus, allowing multiple C frames to be produced with the same Y-axis labels C labels. If YMIN is set to standard missing code, C -32767., YMIN will be selected from the Y array. C YMAX = Maximum Y value to be plotted (see YMIN). If C YMAX is set to standard missing code, YMAX will C selected from the Y array. C ITMIN = Time (X) axis min value (in standard I.S. four C integer notation. May be earlier than IT array C first time C ITMAX = Time (X) axis max value (in standard I.S. four C integer notation. May be later than IT array C last time. C Formal argument declarations: CHARACTER*(*) HDR,YLBL DIMENSION Y(MXNY) , IT(4,MXNY) , ITMIN(4) , ITMAX(4) C Local declarations: PARAMETER (MISS=-32767 , MSGUN=6) PARAMETER(YTOP=1.00 , YTPLT=0.85 , YBPLT=0.15 , YBTIC=0.10 , + YBOT=0.00 , YTTIC=0.90 , + XLFT=0.00 , XLTIC=0.05 , XLPLT=0.15 , XRPLT=0.88 , + XRTIC=1.00 , XRHT=1.00 ) C Parameters delineating the various fractions of the frame to C be used: C YTOP = Top of frame C YTPLT = Top of plot rectangle in frame C YBPLT = Bot of plot rectangle in frame C YBTIC = Bot of tick mark area for X axis labeling (area C below plot rectangle - for labelled time ticks) C YBOT = Bot of frame. C YTTIC = Top of tick mark area for X axis labeling (area C above plot rectangle - for unlabelled time ticks) C XLFT = Left edge of frame C XLTIC = Left edge tick mark area to left of plot area. This C side includes numeric discriptions of "major" ticks C XLPLT = Left edge of plot area. C XRPLT = Right edge of plot area. C XRTIC = Right edge of tick mark area to right of plot area C (no numeric values) C XRHT = Right edge of frame. PARAMETER(IBIGC=18 , BIGTL=17. , GAP=5. , WSML = 12. , + ISMLC=12 , SMLTL=10. , HSML = 24. ,RES=1024.) C IBIGC = Large character size (1024 resolution) C ISMLC = Small character size C BIGTL = Length of labelled tick marks C SMLTL = Length of unlabelled tick marks C GAP = Distance from tick mark to edge of label C WSML = Width of small character C HSML = Height of small charcter C RES = Resolution of entire plot frame C Define arrays for holding the position of labelled tick marks C and their labels PARAMETER (MXNMJRY=16 , MXNMJRT=13) DIMENSION PMJRY(MXNMJRY) , PMJRT(MXNMJRT) , LLBLY(MXNMJRY) CHARACTER*14 LBLY(MXNMJRY) CHARACTER*4 LBLT(MXNMJRT) C Definitions for building the time (X) axis labels and C day crossover plot lines DOUBLE PRECISION I1DA , I1MIN , IDIF , DBEGT,DENDT , DTJ,DTK,DTDC C PARAMETER (MXNDCH=300 , I1DA=8640000D0 , I1MIN=6000D0) PARAMETER (MXNDCH=1000 , I1DA=8640000D0 , I1MIN=6000D0) DIMENSION IRNDT(8) , ITMP(4) , ITP2(4) , TDC(MXNDCH) CHARACTER *41 HDRT CHARACTER *3 MON(12) DATA MON /'Jan' , 'Feb' , 'Mar' , 'Apr' , 'May' , 'Jun' , 'Jul', + 'Aug' , 'Sep' , 'Oct' , 'Nov' , 'Dec' / C Define the two RGB color triples to be used: C Color for index 0 is black C Color for index 1 is white PARAMETER (NCLR = 2) DIMENSION NDXC(NCLR) , RGB(3,NCLR) DATA NDXC/ 0 , 1 / DATA RGB / 0.000 , 0.000 , 0.000 , + 1.000 , 1.000 , 1.000 / C See if Ymin must be determined IF (INT(YMIN) .EQ. MISS) THEN YMIN = Y(1) DO 1 I=2,NY IF(Y(I) .LT. YMIN)YMIN = Y(I) 1 CONTINUE ENDIF C See if Ymax must be determined IF (INT(YMAX) .EQ. MISS) THEN YMAX = Y(1) DO 5 I=2,NY IF(Y(I) .GT. YMAX)YMAX = Y(I) 5 CONTINUE ENDIF C Shut off clipping CALL GSCLIP(0) C Assign each color and its index DO 10 J=1,NCLR 10 CALL GSCR(1,NDXC(J),RGB(1,J),RGB(2,J),RGB(3,J)) C Build and write header label above the plot area CALL SET(XLPLT,XRPLT,YTTIC,YTOP,0.,1.,0.,1., 1) C Write main label first NC = LEN(HDR) L = MIN(80,NC) DO 100 I=L,1,-1 IF(HDR(I:I) .NE. ' ')GO TO 101 100 NC = NC - 1 101 IF (NC .GT. 0) CALL WTSTR(0.5,0.60,HDR(1:NC),IBIGC,0,0) C Write Y-axis label: CALL SET(XLFT,XLTIC,YBPLT,YTPLT,0.,1.,0.,1., 1) NC = LEN(YLBL) L = MIN(80,NC) DO 150 I=L,1,-1 IF(YLBL(I:I) .NE. ' ')GO TO 151 150 NC = NC - 1 151 IF (NC .GT. 0) CALL WTSTR(0.5,0.5,YLBL(1:NC),ISMLC,90,0) C Y-axis ticks will bound YMIN and YMAX such that nice C labels are possible. CALL GAXTIC(MSGUN,YMIN,YMAX,MXNMJRY,NMJRY,PMJRY,LBLY,LLBLY,NMNRY) C Write Y-axis tick marks to left of plot area CALL SET(XLTIC,XLPLT,YBPLT,YTPLT,0.,1.,0.,1., 1) C Establish fractional positions of: SCLX = 1. / ( RES * (XLPLT-XLTIC) ) C PRED = right edge of all Y-axis ticks C PLTL = labelled tick left edge C PUTL = unlabelled tick left edge C PLBR = label right edge PRED = 1. PLTL = PRED - BIGTL * SCLX PUTL = PRED - SMLTL * SCLX PLBR = PLTL - GAP * SCLX C Write any unlabelled ticks before first label on the Y-axis DMJRY = PMJRY(2) - PMJRY(1) IF (NMJRY .EQ. 1) DMJRY = PMJRY(1) DMNRY = DMJRY / REAL(NMNRY + 1) NBOT = INT( PMJRY(1)/DMNRY ) PMNRY0= PMJRY(1) - REAL(NBOT+1) * DMNRY PMNRY = PMNRY0 DO 200 I=1,NBOT PMNRY = PMNRY + DMNRY 200 CALL LINE (PUTL,PMNRY,PRED,PMNRY) C Write labelled tick marks and labels for the Y-axis DO 400 I=1,NMJRY CALL LINE (PLTL,PMJRY(I),PRED,PMJRY(I)) CALL WTSTR(PLBR,PMJRY(I),LBLY(I)(1:LLBLY(I)),ISMLC,0,1) C Write unlabelled tick marks which are between labelled ticks: IF (I .LT. NMJRY) THEN PMNRY = PMJRY(I) DO 300 J=1,NMNRY PMNRY = PMNRY + DMNRY 300 CALL LINE (PUTL,PMNRY,PRED,PMNRY) ENDIF 400 CONTINUE C Write any unlabelled ticks after the last label on the Y-axis: NTOP = INT( (1. - PMJRY(NMJRY)) / DMNRY ) IF (PMJRY(NMJRY)+REAL(NTOP+1)*DMNRY .LE. 1.00001) NTOP = NTOP+1 PMNRY = PMJRY(NMJRY) DO 500 I=1,NTOP PMNRY = PMNRY + DMNRY CALL LINE (PUTL,PMNRY,PRED,PMNRY) 500 CONTINUE C Write Y-axis tick marks to right of plot area - omit labels CALL SET(XRPLT,XRTIC,YBPLT,YTPLT,0.,1.,0.,1., 1) C Establish fractional positions of: SCLX = 1. / ( RES * (XRTIC-XRPLT) ) C PLED = left edge of right side Y tick marks C PLTR = labelled tick right edge C PUTR = unlabelled tick right edge PLED = 0. PLTR = BIGTL * SCLX PUTR = SMLTL * SCLX C Write any unlabelled ticks before first label PMNRY = PMNRY0 DO 510 I=1,NBOT PMNRY = PMNRY + DMNRY 510 CALL LINE (PLED,PMNRY,PUTR,PMNRY) C Write labelled tick marks and labels for the Y-axis - omit lb DO 530 I=1,NMJRY CALL LINE (PLED,PMJRY(I),PLTR,PMJRY(I)) C Write unlabelled tick marks which are between labelled ticks: IF (I .LT. NMJRY) THEN PMNRY = PMJRY(I) DO 520 J=1,NMNRY PMNRY = PMNRY + DMNRY 520 CALL LINE (PLED,PMNRY,PUTR,PMNRY) ENDIF 530 CONTINUE C Write any unlabelled ticks after the last label on the Y-axis: PMNRY = PMJRY(NMJRY) DO 540 I=1,NTOP PMNRY = PMNRY + DMNRY CALL LINE (PLED,PMNRY,PUTR,PMNRY) 540 CONTINUE C Build and write X-axis label: CALL SET(XLPLT,XRPLT,YBOT,YBTIC,0.,1.,0.,1., 1) C Truncate UT begin time down to next even minute DO 700 I=1,3 700 IRNDT(I) = ITMIN(I) IRNDT(4) = 0 C Truncate UT end time up to next even minute DO 800 I=5,8 800 IRNDT(I) = ITMAX(I-4) IF (IRNDT(8) .GT. 0) THEN CALL NEWTIM(ITMAX,IRNDT(5),I1MIN,MSGUN) IRNDT(8) = 0000 ENDIF C If begin time is 24:00, express it as 00:00 (of next day) IF (IRNDT(3) .EQ. 2400) THEN DO 850 I=1,4 850 ITMP(I) = IRNDT(I) CALL NEWTIM(ITMP,IRNDT(1),I1MIN,MSGUN) IRNDT(3) = 2400 ENDIF C If end time is 00:00, express it as 24:00 (of previous day) IF (IRNDT(7) .EQ. 0) THEN DO 900 I=1,4 900 ITMP(I) = IRNDT(I+4) CALL NEWTIM(ITMP,IRNDT(5),-I1MIN,MSGUN) IRNDT(7) = 2400 ENDIF MONB = IRNDT(2)/100 IDAB = IRNDT(2) - MONB*100 IHRB = IRNDT(3)/100 MINB = IRNDT(3) - IHRB*100 MONE = IRNDT(6)/100 IDAE = IRNDT(6) - MONE*100 IHRE = IRNDT(7)/100 MINE = IRNDT(7) - IHRE*100 WRITE(HDRT,1100)IRNDT(1),MON(MONB),IDAB,IHRB,MINB, + IRNDT(5),MON(MONE),IDAE,IHRE,MINE 1100 FORMAT(I4,1X,A3,2I3,':',I2,' to ',I4,1X,A3,2I3,':',I2,' UT') IF (HDRT(13:13) .EQ. ' ') HDRT(13:13) = '0' IF (HDRT(16:16) .EQ. ' ') HDRT(16:16) = '0' IF (HDRT(34:34) .EQ. ' ') HDRT(34:34) = '0' IF (HDRT(37:37) .EQ. ' ') HDRT(37:37) = '0' CALL WTSTR(0.5,0.5,HDRT(1:41),ISMLC,0,0) C Determine appropriate X-axis tick marks CALL GTMTIC(MSGUN,IRNDT,MXNMJRT,NMJRT,PMJRT,LBLT,NLBLTC,NMNRT) C Write X-axis tick marks below plot area: CALL SET(XLPLT,XRPLT,YBTIC,YBPLT,0.,1.,0.,1., 1) C Establish fractional positions of: SCLY = 1. / ( RES * (YBPLT-YBTIC) ) SCLX = 1. / ( RES * (XRPLT-XLPLT) ) C PTED = top edge of all ticks C PLTB = lbld tick bottom edge C PUTB = unlbld tick bottom edge C PLCY = label center (vertically) PTED = 1. PLTB = PTED - BIGTL * SCLY PUTB = PTED - SMLTL * SCLY PLCY = PLTB - (GAP+0.5*HSML)*SCLY C Write any unlabelled ticks before first label on the X-axis IF (NMJRT .LE. 1) GO TO 1201 DMJRT = PMJRT(2) - PMJRT(1) DMNRT = DMJRT / FLOAT(NMNRT + 1) NLFT = IFIX( PMJRT(1)/DMNRT ) PMNRT0= PMJRT(1) - FLOAT(NLFT+1) * DMNRT PMNRT = PMNRT0 DO 1200 I=1,NLFT PMNRT = PMNRT + DMNRT 1200 CALL LINE (PMNRT,PTED,PMNRT,PUTB) 1201 CONTINUE C Write labelled tick marks and labels for the X-axis DO 1400 I=1,NMJRT CALL LINE (PMJRT(I),PTED,PMJRT(I),PLTB) C If lbl has only one character must shift to left OFSET = 0. IF (LBLT(I)(1:1) .EQ. ' ') OFSET = 0.5*WSML * SCLX IF (LBLT(I)(1:2) .EQ. ' ') OFSET = WSML * SCLX PLCX = PMJRT(I) - OFSET CALL WTSTR(PLCX,PLCY,LBLT(I)(1:NLBLTC),ISMLC,0,0) C Write unlabelled tick marks which are between labelled ticks: IF (I .LT. NMJRT) THEN PMNRT = PMJRT(I) DO 1300 J=1,NMNRT PMNRT = PMNRT + DMNRT 1300 CALL LINE (PMNRT,PTED,PMNRT,PUTB) ENDIF 1400 CONTINUE C Write any unlabelled ticks after the last label on the X-axis: IF (NMJRT .LE. 1) GO TO 1501 NRHT = INT( (1. - PMJRT(NMJRT)) / DMNRT ) IF (PMJRT(NMJRT)+REAL(NRHT+1)*DMNRT .LE. 1.00001) NRHT = NRHT+1 PMNRT = PMJRT(NMJRT) DO 1500 I=1,NRHT PMNRT = PMNRT + DMNRT CALL LINE (PMNRT,PTED,PMNRT,PUTB) 1500 CONTINUE 1501 CONTINUE C Write time X-axis ticks on top of plot area C (omitting labeling the ticks on the top of the plot area) CALL SET(XLPLT,XRPLT,YTPLT,YTTIC,0.,1.,0.,1., 1) C Establish fractional positions of: SCLY = 1. / ( RES * (YTTIC-YTPLT) ) SCLX = 1. / ( RES * (XRPLT-XLPLT) ) C PBED = bot edge of all ticks C PLTT = lbld tick top edge C PUTT = unlbld tick top edge C PLCY = label center (vertically) PBED = 0. PLTT = BIGTL * SCLY PUTT = SMLTL * SCLY PLCY = PLTT + (GAP+0.5*HSML)*SCLY C Write any unlabelled ticks before first label on the X-axis C (omitting labeling the ticks on the top of the plot area) IF (NMJRT .LE. 1) GO TO 1601 PMNRT = PMNRT0 DO 1600 I=1,NLFT PMNRT = PMNRT + DMNRT 1600 CALL LINE (PMNRT,PBED,PMNRT,PUTT) 1601 CONTINUE C Write labelled tick marks and labels for the X-axis C (omitting labeling the ticks on the top of the plot area) DO 1800 I=1,NMJRT CALL LINE (PMJRT(I),PBED,PMJRT(I),PLTT) C Write unlabelled tick marks which are between labelled ticks: C (omit labeling the ticks on the top of the plot area) IF (I .LT. NMJRT) THEN PMNRT = PMJRT(I) DO 1700 J=1,NMNRT PMNRT = PMNRT + DMNRT 1700 CALL LINE (PMNRT,PBED,PMNRT,PUTT) ENDIF 1800 CONTINUE C Write any unlabelled ticks after the last label on the X-axis: C (omitting labeling the ticks on the top of the plot area) IF (NMJRT .LE. 1) GO TO 1901 PMNRT = PMJRT(NMJRT) DO 1900 I=1,NRHT PMNRT = PMNRT + DMNRT CALL LINE (PMNRT,PBED,PMNRT,PUTT) 1900 CONTINUE 1901 CONTINUE C Plot Y vs X. While doing so, it is necessary to convert C time units from 4 integers to a single real YDIF = 0. CALL CVTI2R(MSGUN,DBEGT,IRNDT(1)) CALL CVTI2R(MSGUN,DENDT,IRNDT(5)) BEGT = SNGL (DBEGT) ENDT = SNGL (DENDT) IB1000 = INT (BEGT) / 1000 IXOVR = INT (ENDT) / 1000 - IB1000 IF (IXOVR .GT. 0) THEN C A year has been crossed over. Must change ENDT for set call C Check that never more than one year crossed over IF(IXOVR .GT. 1)STOP YDIF = 635. IF(MOD(IRNDT(1),4) .EQ. 0)YDIF = 634. ENDT = ENDT - YDIF ENDIF CALL SET(XLPLT,XRPLT,YBPLT,YTPLT,BEGT,ENDT,YMIN,YMAX,1) C Draw line(s) connecting adjacent non-missing values; if a C good value is isolated, just draw a plus J = 0 2100 J = J+1 I = J-1 K = J+1 IF (J .GT. NY) GO TO 2200 IF (INT(Y(J)) .EQ. MISS) GO TO 2100 IF (NY .EQ. 1) GO TO 2180 IF (NY .GT. 2) GO TO 2150 IF (J .EQ. 2) GO TO 2180 IF (INT(Y(2)) .EQ. MISS) GO TO 2180 2150 CONTINUE IF (J .EQ. 1 .AND. INT(Y(K)) .EQ. MISS) GO TO 2180 IF (J .EQ. NY .AND. INT(Y(I)) .EQ. MISS) GO TO 2180 IF (I .GT. 0 .AND. INT(Y(I)) .EQ. MISS .AND. + K .LE. NY .AND. INT(Y(K)) .EQ. MISS) GO TO 2180 IF (K .LE. NY .AND. INT(Y(K)) .EQ. MISS) GO TO 2100 CALL CVTI2R(MSGUN,DTJ,IT(1,J)) CALL CVTI2R(MSGUN,DTK,IT(1,K)) TJ = SNGL (DTJ) TK = SNGL (DTK) IF (INT(TJ)/1000 .GT. IB1000) TJ = TJ - YDIF IF (INT(TK)/1000 .GT. IB1000) TK = TK - YDIF CALL LINE( TJ,Y(J) , TK,Y(K) ) GO TO 2190 2180 CALL CVTI2R(MSGUN,DTJ,IT(1,J)) TJ = SNGL (DTJ) IF (INT(TJ)/1000 .GT. IB1000) TJ = TJ - YDIF CALL POINTS( TJ,Y(J),1,-2,0) 2190 IF (K .LT. NY) GO TO 2100 2200 CONTINUE C Draw vertical lines delineating multiple days on the plot if C there are more than 1 day changes. Build times of the day C changes and count how many there are, before deciding to draw. C Note that day changes at the left and right side of the plot C are excluded from this count. NDC = 0 ITMP(1) = IRNDT(1) ITMP(2) = IRNDT(2) ITMP(3) = 2400 ITMP(4) = 0 2210 NDC = NDC + 1 IF (NDC .GT. MXNDCH) GO TO 9100 CALL CVTI2R(MSGUN,DTDC,ITMP) TDC(NDC) = SNGL (DTDC) IF(INT(TDC(NDC))/1000 .GT. IB1000)TDC(NDC) = TDC(NDC) - YDIF DO 2220 I=1,4 2220 ITP2(I) = ITMP(I) CALL NEWTIM(ITP2,ITMP,I1DA,MSGUN) CALL TIMDIF(ITMP,IRNDT(5),IDIF) IF (IDIF .GT. 0D0) GO TO 2210 c IF (NDC .GT. 1) THEN c DO 2230 I=1,NDC c2230 CALL LINE( TDC(I),YMIN , TDC(I),YMAX ) c ENDIF C If the range of Y values includes 0., draw the zero line IF (YMIN .LT. 0. .AND. YMAX .GT. 0.) CALL LINE(BEGT,0. , ENDT,0.) C Draw a perimeter around the plot area CALL SET(XLPLT,XRPLT,YBPLT,YTPLT,0.,1.,0.,1.,1) CALL LINE(0.,0.,0.,1.) CALL LINE(0.,1.,1.,1.) CALL LINE(1.,1.,1.,0.) CALL LINE(1.,0.,0.,0.) C Advance frame CALL FRAME RETURN C Error trap diagnostics 9100 WRITE(MSGUN,'('' Dimension exceeded. Increase MXNDCH!'')') STOP END