SUBROUTINE GTMTIC (MSGUN,ITIM,MXNMJR,NMJR,PMJR,LBL,NLBC,NMNR) C This routine determines tick marks for time axis labelling. C It is set up to return the following options: C Tmax-Tmin Labelled ticks every Unlabelled: C ----------- -------------------- ---------------- C < 0 -> (error stop) C 0 -> 1 hr 1/4 hr (units=hr) 5 min (MINR_=2) C -> 2 hr 1/2 hr 5 min (MINR_=5) C -> 12 hr 1 hr 1/4 hr (MINR_=3) C -> 24 hr 2 hr 1 hr (MINR_=1) C -> 48 hr 4 hr 1 hr 3 C -> 72 hr 6 hr 1 hr 5 C -> 6 days 12 hr 2 hr 5 C -> 12 days 1 day (units=day) 1/4 day 3 C -> 24 days 2 day 1/2 day 3 C -> 48 days 4 day 1 day 3 C -> 96 days 8 day 2 day 3 C -> 1.5 yr 1st&15th of month none 0 C > 1.5 yr -> (error stop) C INPUTS: C MSGUN = Fortran unit number to print any error diagnostics C ITIM = Begin and end time (8 element integer array with C 4 elements for each, in form yyyy mmdd hhmm csec) C MXNMJR = Maximum number of labelled ticks allowed (array C dimension of PMJR and LBL). For most cases 13 C is sufficient, however, intervals longer than 96 C days use 2 per month (e.g., for 1 yr provide 24). C RETURNS: C NMJR = Number of computed major tick marks. C PMJR = Fractional positions (domain: 0. -> 1.) of computed C tick marks which are to be labelled. C LBL = Labels for major ticks. C NLBC = Maximum number of characters per label (2 or 4) C NMNR = Number of unlabelled ticks to be inserted between C major (labelled) ticks. C Declarations for formal arguments: DIMENSION PMJR(MXNMJR) , ITIM(8) CHARACTER*4 LBL(MXNMJR) C Local declarations: DOUBLE PRECISION IDT , IDCS , ITOTCS , ITHCS PARAMETER (MXYL=24) DIMENSION IOLDT(4), NEWT(4) , IYMD(MXYL) CHARACTER*4 LYMD(MXYL) CHARACTER*3 UNITS SAVE IYMD , LYMD DATA IYMD / 101 , 115 , 201 , 215 , 301 , 315 , 401 , 415 , + 501 , 515 , 601 , 615 , 701 , 715 , 801 , 815 , + 901 , 915 , 1001 ,1015 , 1101 ,1115 , 1201 ,1215 / DATA LYMD /'1Jan',' 15','1Feb',' 15','1Mar',' 15','1Apr',' 15', + '1May',' 15','1Jun',' 15','1Jul',' 15','1Aug',' 15', + '1Sep',' 15','1Oct',' 15','1Nov',' 15','1Dec',' 15'/ C Determine which option is to be used (IDIF and IDT are in C units of centiseconds) CALL TIMDIF (ITIM(1),ITIM(5),ITOTCS) IF (ITOTCS .LT. 0D0) THEN GO TO 9100 ELSEIF (ITOTCS .LE. 360000D0) THEN C 1 hr and 1/4 hr IDT = 90000D0 NMNR = 2 NLBC = 4 UNITS= 'qtr' ELSEIF (ITOTCS .LE. 720000D0) THEN C 2 hr and 1/2 hr IDT = 180000D0 NMNR = 5 NLBC = 4 UNITS= 'haf' ELSEIF (ITOTCS .LE. 4320000D0) THEN C 12 hr and 1 hr IDT = 360000D0 NMNR = 3 NLBC = 2 UNITS= 'hr ' ELSEIF (ITOTCS .LE. 8640000D0) THEN C 24 hr and 2 hr IDT = 720000D0 NMNR = 1 NLBC = 2 UNITS= 'hr ' ELSEIF (ITOTCS .LE. 17280000D0) THEN C 48 hr and 4 hr IDT = 1440000D0 NMNR = 3 NLBC = 2 UNITS= 'hr ' ELSEIF (ITOTCS .LE. 25920000D0) THEN C 72 hr and 6 hr IDT = 2160000D0 NMNR = 5 NLBC = 2 UNITS= 'hr ' ELSEIF (ITOTCS .LE. 51840000D0) THEN C 6 days and 12 hrs IDT = 4320000D0 NMNR = 5 NLBC = 2 UNITS= 'hr ' ELSEIF (ITOTCS .LE.103680000D0) THEN C 12 days and 1 day IDT = 8640000D0 NMNR = 3 NLBC = 2 UNITS= 'day' ELSEIF (ITOTCS .LE.207360000D0) THEN C 24 days and 2 day IDT = 17280000D0 NMNR = 3 NLBC = 2 UNITS= 'day' ELSEIF (ITOTCS .LE.414720000D0) THEN C 48 days and 1 day IDT = 34560000D0 NMNR = 3 NLBC = 2 UNITS= 'day' ELSEIF (ITOTCS .LE.829440000D0) THEN C 96 days and 2 day IDT = 69120000D0 NMNR = 3 NLBC = 2 UNITS= 'day' ELSEIF (ITOTCS .LE.4743360000D0) THEN C 1.5yr (549 days) and no minor ticks C IDT = __________ (not used) NMNR = 0 NLBC = 4 UNITS= 'yr' ELSE GO TO 9200 ENDIF C Process year differently because of varying time differences C between labels: IF (UNITS .EQ. 'yr') GO TO 1000 C Round up to find the value and position of the first label C To round up, start with a 00:00 UT of the begin date and C test that time against the begin time; if it is less C than the begin time, add IDT to it and test again. Continue C adding and testing until it is greater. IOLDT(1) = ITIM(1) IOLDT(2) = ITIM(2) IOLDT(3) = 0 IOLDT(4) = 0 NEWT (1) = ITIM(1) NEWT (2) = ITIM(2) NEWT (3) = 0 NEWT (4) = 0 CALL TIMDIF (IOLDT,ITIM,IDCS) IF (IDCS .LE. 0D0) GO TO 200 100 CALL NEWTIM (IOLDT,NEWT,IDT,MSGUN) CALL TIMDIF (NEWT,ITIM,IDCS) IF (IDCS .LE. 0D0) GO TO 200 DO 150 I=1,4 150 IOLDT(I) = NEWT(I) GO TO 100 200 IF (UNITS .EQ. 'qtr' .OR. UNITS .EQ. 'haf') THEN ILB = NEWT(3) WRITE (LBL(1),'(I4)') ILB ELSEIF (UNITS .EQ. 'hr ') THEN ILB = NEWT(3) / 100 WRITE (LBL(1),'(I2,2X)') ILB ELSEIF (UNITS .EQ. 'day') THEN ILB = NEWT(2) - (NEWT(2)/100) * 100 WRITE (LBL(1),'(I2,2X)') ILB ENDIF CALL TIMDIF (ITIM,NEWT,ITHCS) PMJR(1) = SNGL( ITHCS/ITOTCS ) NMJR = 1 C Build the rest of the labels DO 400 I=2,MXNMJR DO 300 J=1,4 300 IOLDT(J) = NEWT(J) CALL NEWTIM (IOLDT,NEWT,IDT,MSGUN) CALL TIMDIF (NEWT,ITIM(5),IDCS) IF (IDCS .LT. 0D0) GO TO 401 IF (UNITS .EQ. 'qtr' .OR. UNITS .EQ. 'haf') THEN ILB = NEWT(3) IF (ILB .EQ. 0) ILB = 2400 WRITE (LBL(I),'(I4)') ILB ELSEIF (UNITS .EQ. 'hr ') THEN ILB = NEWT(3) / 100 IF (ILB .EQ. 0) ILB = 24 WRITE (LBL(I),'(I2,2X)') ILB ELSEIF (UNITS .EQ. 'day') THEN ILB = NEWT(2) - (NEWT(2)/100) * 100 WRITE (LBL(I),'(I2,2X)') ILB ENDIF CALL TIMDIF (ITIM,NEWT,ITHCS) PMJR(I) = SNGL( ITHCS/ITOTCS ) NMJR = NMJR + 1 400 CONTINUE 401 CONTINUE RETURN C Build labels for year intervals 1000 IBMO = ITIM(2)/100 IBDA = ITIM(2) - IBMO*100 IF (IBMO .LT. 1 .OR. IBMO .GT. 12) GO TO 9300 C Find index for the first month/day label on or after begin date I = IBMO * 2 IF (IBDA .LT. 15) I = I - 1 IF (IBDA .EQ. 15 .AND. ITIM(3) .LT. 1200) I = I - 1 LBL(1) = LYMD(I) C Compute the fractional position of the first label IOLDT(1) = ITIM(1) IOLDT(2) = ITIM(2) IOLDT(3) = 0 IOLDT(4) = 0 NEWT (1) = ITIM(1) NEWT (2) = IYMD(I) NEWT (3) = 0 NEWT (4) = 0 CALL TIMDIF (IOLDT,ITIM,IDCS) IF (IDCS .LE. 0D0) IDCS = 0D0 PMJR(1) = SNGL( IDCS/ITOTCS ) NMJR = 1 C Build the rest of the labels 1100 DO 1110 J=1,4 1110 IOLDT(J) = NEWT(J) I = I + 1 IF (I .GT. MXYL) THEN I = 1 NEWT(1) = NEWT(1) + 1 ENDIF NEWT(2) = IYMD(I) CALL TIMDIF (NEWT,ITIM(5),IDCS) IF (IDCS .LT. 0D0) GO TO 1200 NMJR = NMJR + 1 IF (NMJR .GT. MXNMJR) GO TO 1200 CALL TIMDIF (ITIM,NEWT,ITHCS) PMJR(NMJR) = SNGL( ITHCS/ITOTCS ) LBL(NMJR) = LYMD(I) GO TO 1100 1200 CONTINUE RETURN C Error trap diagnostics: 9100 WRITE(MSGUN,9150)(ITIM(I),I=1,8) 9150 FORMAT(' GTMTIC is not smart enough to calculate ', + 'time tick marks for', + ' a reversed scale; Tbeg must be < Tend but',/, + ' Tbeg =',4I5,' and',/, + ' Tend =',4I5) STOP 9200 WRITE(MSGUN,9250)(ITIM(I),I=1,8) 9250 FORMAT(' GTMTIC is not smart enough to calculate ', + 'time tick marks when', + ' the range exceeds 1 1/2 yr; Tbeg =',4I5,' and',/, + ' Tend =',4I5) STOP 9300 WRITE (MSGUN,'('' GTMTIC: bogus dates input '',8I8)') ITIM STOP END