SUBROUTINE GETAE(MSGUN,ITIME,IPARCOD,VALS, ISTAT , + IWRK,IBLK,IUNPK,LREC) C GETAE returns 1-minute or hourly Ae, Al, Au, or Ao for the C requested time. The A_ indicies are read from the I.S. C data base vsn, AEI780101A. If not available for a requested C time, value(s) are returned as "-32767." (the standard missing C data code). Although the standard time format is input as C ITIME, the minute and centisecond are ignored; i.e., any C minute of the hour is interpreted as a request for that hours C value(s). If 1-minute samples are requested, 60 values will C be returned but a request for an hourly average results in C only one returned value: C 0000 - 0059 returns same hourly value(s) C 0100 - 0159 " " " " C . . . . . C 2300 - 2400* " " " " C * When ITIME(3)=2400, this is considered to be an "end" time C and the last value(s) of the day are returned. Although C one could argue this is inconsistant, it is easy enough to C input 0000 on the next date for the next hours indicies. C C INPUTS: C MSGUN = Fortran unit to print diagnostic messages; see C also ISTAT. C ITIME(1) = Year, four digits Universal time C ITIME(2) = Month and day, e.g. 31 Jan is 0131 C ITIME(3) = Hour and minute of day C ITIME(4) = Centisecond (hundredth second of minute) C IPARCOD = The parameter code for the desired index; C recognized codes include: C 320 = Ae Index (1 or 2.5 min sample*) C 321 = Al Index (1 or 2.5 min sample*) C 322 = Au Index (1 or 2.5 min sample*) C 323 = Ao Index (1 or 2.5 min sample*) C 324 = Ae Index (hourly mean) C 325 = Al Index (hourly mean) C 326 = Au Index (hourly mean) C 327 = Ao Index (hourly mean) C * Always 1 minute samples after 1977 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 used by RDBLK6 (contains fortran unit C to read indicies, etc - see RDBLK6) C IBLK = Packed physical record buffer - see RDBLK6. C IUNPK = Unpacked block buffer - see RDBLK6. C LREC = Logical record - see RDBLK6. C RETURNS: 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 = 5 => Bad parameter code input C = 6 => Indicies dataset corrupted; should be C continuos, yet somehow read past ITIME C VALS = The index value(s) for IPARCOD at ITIME; units C are nT (nanoTeslas) or gammas. C Formal parameter declarations: DIMENSION ITIME(4) , VALS(60) , IWRK(*),IBLK(*),IUNPK(*),LREC(*) C Local declarations: PARAMETER (RMISS=-32767. , NOPRT=99999) DIMENSION LBEGT(4) , IT(4) DOUBLE PRECISION IDIF , JDIF LOGICAL ATBEGN SAVE ATBEGN,LBEGT,ISTRD DATA ATBEGN,LBEGT,ISTRD/.TRUE. , 1940,0101,0000,0000 , 0/ C Initialize returned values array to missing DO 10 I=1,60 10 VALS(I) = RMISS C Check input time NOK = 0 IF(ITIME(1) .LT. 1940 .OR. ITIME(1) .GT. 2100)NOK = 1 IF(ITIME(2) .LT. 0101 .OR. ITIME(2) .GT. 1231)NOK = 1 IF(ITIME(3) .LT. 0 .OR. ITIME(3) .GT. 2400)NOK = 1 IF(NOK .GT. 0)THEN IF(ISTAT .NE. NOPRT)WRITE(MSGUN,9000)(ITIME(I),I=1,4) ISTAT = 1 RETURN ENDIF C See if already read past the requested date and hour: IT(1) = ITIME(1) IT(2) = ITIME(2) IT(3) = (ITIME(3)/100) * 100 IF (IT(3) .EQ. 2400) IT(3) = 2300 IT(4) = 0 CALL TIMDIF(LBEGT,IT,IDIF) IF (IDIF .EQ. 0D0) GO TO 1000 IF (IDIF .GT. 0D0) THEN C Must read more but first see if already at EOD IF(ISTRD .NE. 3)GO TO 100 IF(ISTAT .NE. NOPRT)WRITE(MSGUN,9100)(ITIME(I),I=1,3), + (LREC(J),J=5,6) ISTAT = 3 RETURN ENDIF CALL REWBLK(IWRK) IWRK(7) = 1 ATBEGN = .TRUE. C Read a new lrec, compute & test the new difference 100 CALL RDBLK6(IWRK,LREC,IBLK,IUNPK,ISTRD) IF(ISTRD .EQ. 0 .AND. LREC(2) .NE. 1002)GO TO 100 LBEGT(1) = LREC(5) LBEGT(2) = LREC(6) LBEGT(3) = LREC(7) CALL TIMDIF(LREC(5),IT,JDIF) IF (JDIF .GT. 0D0) THEN C must read more ATBEGN = .FALSE. IF(ISTRD .NE. 3)GO TO 100 IF(ISTAT .NE. NOPRT)WRITE(MSGUN,9100)(ITIME(I),I=1,3), + (LREC(J),J=5,6) ISTAT = 3 RETURN ELSEIF (JDIF .LT. 0D0) THEN C after request time IF(ATBEGN)THEN IF(ISTAT .NE. NOPRT)WRITE(MSGUN,9200)(ITIME(I),I=1,3), + (LREC(J),J=5,6) ISTAT = 2 ELSE IF(ISTAT .NE. NOPRT)WRITE(MSGUN,9500)(ITIME(I),I=1,3) ISTAT = 6 ENDIF RETURN ENDIF C Assign value(s) for requested parameter code 1000 IOFF = 0 IF(IPARCOD .EQ. 320)IOFF = 31 IF(IPARCOD .EQ. 321)IOFF = 32 IF(IPARCOD .EQ. 322)IOFF = 33 IF(IPARCOD .EQ. 323)IOFF = 34 IF(IPARCOD .EQ. 324)IOFF = 14 IF(IPARCOD .EQ. 325)IOFF = 15 IF(IPARCOD .EQ. 326)IOFF = 16 IF(IPARCOD .EQ. 327)IOFF = 17 IF(IOFF .EQ. 0)THEN IF(ISTAT .NE. NOPRT)WRITE(MSGUN,9400)IPARCOD ISTAT = 5 RETURN ENDIF NVALS = 1 IF(IPARCOD .LT. 324)NVALS = 60 DO 1100 I=1,NVALS IOFF = IOFF + 8 1100 VALS(I) = FLOAT( LREC(IOFF) ) ISTAT = 0 RETURN C Error trap messages 9000 FORMAT('0GETAE: Bad time input; time =',4I5) 9100 FORMAT('0GETAE: Requested time',3I5,' is after last available: ', + 2I5) 9200 FORMAT('0GETAE: Requested time',3I5,' is before first available: +',2I5) 9400 FORMAT('0GETAE: Does not recognize parameter code:',I7,/, + ' Known parameter codes include:',/, + ' 320 = Ae Index (1 or 2.5 min sample*) ',/, + ' 321 = Al Index (1 or 2.5 min sample*) ',/, + ' 322 = Au Index (1 or 2.5 min sample*) ',/, + ' 323 = Ao Index (1 or 2.5 min sample*) ',/, + ' 324 = Ae Index (hourly mean) ',/, + ' 325 = Al Index (hourly mean) ',/, + ' 326 = Au Index (hourly mean) ',/, + ' 327 = Ao Index (hourly mean) ',/, + ' * Always 1 minute samples after 1977 ') 9500 FORMAT('0GETAE: Indicies dataset corrupted? Data should be', + ' continuous yet',/, + ' somehow read past requested time',3I5) END