SUBROUTINE GETEHP(MSGUN,IBEGT,IENDT,MXNPWR, + NVALS,ITIM,HPWR,NDX,IQL,ISTAT, + IWRK,IBLK,IUNPK,LREC) C This routine returns Dave Evans hemispheric power input data C from the vsn, EHP781102A. NVALS values for the time interval C IBEGT to IENDT are returned in arrays ITIM, HPWR, NDX and IQL. C INPUTS: C MSGUN = Fortran unit number to print diagnostic msgs C IBEGT(1) = Begin UT year, four digits C IBEGT(2) = Begin UT month and day, e.g. 31 Jan is 0131 C IBEGT(3) = Begin UT hour and minute (0000 to 2400) C IBEGT(4) = Begin UT centi-second C IENDT(1-4)= End date and time of interval for which C parameters are returned C MXNPWR = Dimension of arrays provided to this routine, C IY, IMD, ITIM , HPWR, NDX, and IQL C ISTAT = 99999 on input, implies only fatal errors C will cause diagnostic messages to be printed, C nonfatal errors will be signified only by the C returned value of ISTAT (thus allowing user C control of most diagnostic print messages). C SEE ALSO RETURN ISTAT values below. C IWRK = Work array for RDBLK6 (dimensioned to 17) C IBLK = Block array for RDBLK6 (see RDBLK6 for dim) C IUNPK = Unpacked version of IBLK for RDBLK6 C LREC = Current lrec array for RDBLK6 C RETURNS: C NVALS = Number of values found C ITIM = U.T. Date and time (same 4 integer format as IBEGT) C HPWR = Hemispheric power input (units = GWatts) C NDX = Dave Evans hemispheric power index C IQL = HPWR qualifier; contains the measurement C satellite ID in the tens digit and the C hemisphere of measurement in the units digit: C if the tens digit is 0, TIROS-N made the C measurement, otherwise the digit is the number C of the NOAA satellite; if the units digit is 0, C the northern hemisphere was sampled, if the C the units digit is 1 it is the southern C hemisphere; e.g., 61 => NOAA-6 in Southern Hem. C ISTAT = Status flag C = 0 => ok C = 1 => Bad time input C = 2 => Request time before first available C = 3 => Request time after last available C Formal parameter argument declarations: DIMENSION ITIM(4,MXNPWR), HPWR(MXNPWR), NDX(MXNPWR), IQL(MXNPWR), + IBEGT(4), IENDT(4) , + IWRK(*), IBLK(*) , IUNPK(*) , LREC(*) C Local declarations DOUBLE PRECISION IDIF , I1DA PARAMETER (MISS=-32767 , MXNDAZ=40 , MXNVLD=200 , I1DA=8640000D0 , + NOPRT=99999) C MXNDAZ = Maximum number of different dates (yr/mm/dd) C MXNVLD = Maximum number of values per day DIMENSION IYI(MXNDAZ) , IMDI(MXNDAZ) , IT(4) , JT(4) , + ITIMD(MXNVLD),HPWRD(MXNVLD),NDXD(MXNVLD),IQLD(MXNVLD) C (arrays with D suffix hold a days worth of values) NVALS = 0 C Check input time NOK = 0 IF(IBEGT(1) .LT. 1940 .OR. IBEGT(1) .GT. 2100)NOK = 1 IF(IBEGT(2) .LT. 0101 .OR. IBEGT(2) .GT. 1231)NOK = 1 IF(IBEGT(3) .LT. 0 .OR. IBEGT(3) .GT. 2400)NOK = 1 IF(IBEGT(4) .LT. 0 .OR. IBEGT(4) .GT. 5999)NOK = 1 IF(IENDT(1) .LT. 1940 .OR. IENDT(1) .GT. 2100)NOK = 1 IF(IENDT(2) .LT. 0101 .OR. IENDT(2) .GT. 1231)NOK = 1 IF(IENDT(3) .LT. 0 .OR. IENDT(3) .GT. 2400)NOK = 1 IF(IENDT(4) .LT. 0 .OR. IENDT(4) .GT. 5999)NOK = 1 IF(NOK .GT. 0)THEN IF(ISTAT .NE. NOPRT)WRITE(MSGUN,9100)(IBEGT(I),I=1,4), + (IENDT(J),J=1,4) ISTAT = 1 RETURN ENDIF C Check that input end time is later than begin time: CALL TIMDIF(IBEGT,IENDT,IDIF) IF(IDIF .LT. 0D0)THEN IF(ISTAT .NE. NOPRT)WRITE(MSGUN,9100)(IBEGT(I),I=1,4), + (IENDT(J),J=1,4) ISTAT = 1 RETURN ENDIF C Determine how many different dates are requested and build C year, IYI, and month/day, IMDI, arrays NDATES = 1 IYI(1) = IBEGT(1) IMDI(1) = IBEGT(2) IT(1) = IBEGT(1) IT(2) = IBEGT(2) IT(3) = 0 IT(4) = 0 IF(IDIF .LE. I1DA .AND. IBEGT(2) .EQ. IENDT(2))GO TO 100 10 CALL NEWTIM(IT,JT,I1DA,MSGUN) NDATES = NDATES + 1 IF(NDATES .GT. MXNDAZ)GO TO 9200 IYI (NDATES) = JT(1) IMDI(NDATES) = JT(2) IF(JT(1).EQ.IENDT(1) .AND. JT(2).EQ.IENDT(2))GO TO 100 IT(1) = JT(1) IT(2) = JT(2) GO TO 10 C Loop once for each unique date requested 100 JST = 0 DO 1000 I=1,NDATES C Get a day's worth of data: IF(IWRK(7) .EQ. 1) GO TO 200 IF(IYI(I) .EQ. LREC(5) .AND. IMDI(I) .EQ. LREC(6))GO TO 300 200 JSTAT = ISTAT CALL GETHPD(MSGUN,IYI(I),IMDI(I),NVALSD,ITIMD,HPWRD,NDXD,IQLD, + JSTAT,IWRK,IBLK,IUNPK,LREC) IF(JSTAT .NE. 0)JST = JSTAT IF(NVALSD .GT. MXNVLD)GO TO 9300 C Assign the fraction of the days data needed 300 IF(I .EQ. 1)THEN C This is first date requested; do not assign values before C requested begin time (hour and minute) DO 350 J=1,NVALSD IF(ITIMD(J) .GE. IBEGT(3))GO TO 400 350 CONTINUE GO TO 1000 400 ISKP = J - 1 NVALS = NVALSD - ISKP IF(NDATES .EQ. 1)THEN C Only one date to fill, so must also check end time and omit C assignment of any values after the end time: DO 450 J=NVALSD,1,-1 IF(ITIMD(J) .LE. IENDT(3))GO TO 500 450 CONTINUE GO TO 9300 500 NOMIT = NVALSD - J NVALS = NVALS - NOMIT ENDIF DO 600 J=1,NVALS ITIM(1,J) = IYI (I) ITIM(2,J) = IMDI(I) ITIM(3,J) = ITIMD(ISKP + J) ITIM(4,J) = 0 HPWR(J) = HPWRD(ISKP + J) NDX (J) = NDXD (ISKP + J) 600 IQL (J) = IQLD (ISKP + J) ELSEIF(I .NE. NDATES)THEN C Not first or last date requested, so assign the whole day DO 700 J=1,NVALSD ITIM(1,J+NVALS) = IYI (I) ITIM(2,J+NVALS) = IMDI(I) ITIM(3,J+NVALS) = ITIMD(J) ITIM(4,J+NVALS) = 0 HPWR(J+NVALS) = HPWRD(J) NDX (J+NVALS) = NDXD (J) 700 IQL (J+NVALS) = IQLD (J) NVALS = NVALS + NVALSD ELSE C This is the last date requested; do not assign values after C requested end time (hour and minute) DO 750 J=NVALSD,1,-1 IF(ITIMD(J) .LT. IENDT(3))GO TO 800 750 CONTINUE GO TO 1000 800 LASTOK = J DO 900 J=1,LASTOK ITIM(1,J+NVALS) = IYI (I) ITIM(2,J+NVALS) = IMDI(I) ITIM(3,J+NVALS) = ITIMD(J) ITIM(4,J+NVALS) = 0 HPWR(J+NVALS) = HPWRD(J) NDX (J+NVALS) = NDXD (J) 900 IQL (J+NVALS) = IQLD (J) NVALS = NVALS + LASTOK ENDIF 1000 CONTINUE ISTAT = JST RETURN C Error trap messages 9100 FORMAT('0GETEHP: Bad time input; begin time =',4I5,/, + ' end time =',4I5) 9200 WRITE(MSGUN,'(''0GETEHP: Dimension exceeded, increase MXNDAZ '', + ''to at least '',I7)')NDATES STOP 9300 WRITE(MSGUN,'(''0GETEHP: Dimension exceeded, increase MXNVLD '', + ''to at least '',I5)')NVALSD STOP END