SUBROUTINE GETIMF(MSGUN,ITIME,BXGSM,BYGSM,BZGSM,BYGSE,BZGSE, + SWDEN,SWSPD,IQL, ISTAT, IWRK,IBLK,IUNPK,LREC) C This routine returns OMNI tape hourly IMF and Solar Wind data C from the vsn, IMF631127A. If not available for a requested C time, value(s) are returned as "-32767." (the standard missing C data code) except for the IMF/Solar Wind Qualifier. Although C the standard time format is input as ITIME, only the year, C month, day and hour which are used here. It is assumed that C any minute of the hour is a request for the same hourly mean C value. (Centiseconds are ignored): C 0000 - 0059 returns same value C 0100 - 0159 " " " C . . . . C 2300 - 2400* " " " C * When ITIME(3)=2400, this is considered to be an "end" time C and the last index of the day is returned. Although one C could argue this is inconsistant, it is easy enough to C input 0000 on the next date for the next hours indicies. C INPUTS: 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 MSGUN = Fortran unit number to print diagnostic messages 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 = 4 => Nothing available for requested date C BXGSM = X-component IMF(Geocentric Solar Magnetospheric) C BYGSM = Y-component IMF GSM Coordinates C BXGSM = Z-component IMF GSM C BYGSE = Y-component IMF Geocentric Solar Ecliptic C BZGSE = Z-component IMF GSE C (Note Bx GSE is not explicitly returned since C it is equivalent to Bx GSM) C IQL = IMF/Solar Wind Qualifier, code 2236, contains C satellite id codes for the measurement of the IMF C and solar wind: The 1000's and 100's digit C comprise the IMF id and the 10's and 1's digit is C the solar wind id. Id codes follow: C ---Satellite Name --- --- ID --- C no measurement 0 C IMP 1 (Expl 18) 18 C IMP 3 (Expl 28) 28 C IMP 4 (Expl 34) 34 C IMP 5 (Expl 41) 41 C IMP 6 (Expl 43) 43 C IMP 7 (Expl 47) 47 C IMP 8 (Expl 50) 50 C AIMP 1 (Expl 33) 33 C AIMP 2 (Expl 35) 35 C HEOS 1 and HEOS 2 1 C VELA 3 3 C OGO 5 5 C Merged LANL VELA speeds (7/64-3/71) 99 C Merged LANL IMP T,N,V (including 98 C all IMP 8 LANL plasma) C ISEE 1 11 C ISEE 2 12 C ISEE 3 13 C Prognoz10 10 DIMENSION ITIME(4) , IWRK(*) , IBLK(*) , IUNPK(*) , LREC(*) C Local declarations: DOUBLE PRECISION IDIF , IOLDIF , JDIF , I1DA PARAMETER (MPAR=12 , MISS=-32767 , RMISS=-32767., I1DA=8640000D0, + NOPRT=99999) DIMENSION IT(4) , LBEGT(4) , IOLDB(4) LOGICAL ATBEGN SAVE ATBEGN,LBEGT,IOLDB,ISTRD DATA ATBEGN,LBEGT,IOLDB,ISTRD + /.TRUE. , 1940,0101,0,0 , 1940,0101,0,0 , 0/ C Initialize returned values to missing: BXGSM = RMISS BYGSM = RMISS BZGSM = RMISS BYGSE = RMISS BZGSE = RMISS SWDEN = RMISS SWSPD = RMISS IQL = 0 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: IT(1) = ITIME(1) IT(2) = ITIME(2) IT(3) = 0 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,2), + (LREC(J),J=5,6) ISTAT = 3 RETURN ENDIF C Already read past the request date IF(ATBEGN)THEN IF(ISTAT .NE. NOPRT)WRITE(MSGUN,9200)(IT(I),I=1,2), + (LREC(J),J=5,6) ISTAT = 2 RETURN ENDIF C Maybe no data are available for request date CALL TIMDIF(IOLDB,LBEGT,IOLDIF) C IOLDIF = time of last lrec read - previous one IF(IOLDIF .GT. I1DA)THEN IF(ISTAT .NE. NOPRT)WRITE(MSGUN,9300)(IT(I),I=1,2) ISTAT = 4 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 IOLDB(1) = LBEGT(1) IOLDB(2) = LBEGT(2) LBEGT(1) = LREC(5) LBEGT(2) = LREC(6) CALL TIMDIF(LBEGT,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)(IT(I),I=1,2), + (LREC(J),J=5,6) ISTAT = 3 RETURN ELSEIF (JDIF .LT. 0D0) THEN C Already read past the request date IF(ATBEGN)THEN IF(ISTAT .NE. NOPRT)WRITE(MSGUN,9200)(IT(I),I=1,2), + (LREC(J),J=5,6) ISTAT = 2 ELSE IF(ISTAT .NE. NOPRT)WRITE(MSGUN,9300)(IT(I),I=1,2) ISTAT = 4 ENDIF RETURN ENDIF C Determine offset into LREC appropriate for assigning values C for beginning hour, IHR 1000 IHR = ITIME(3)/100 IF(IHR .EQ. 24)IHR = 23 IOFF = 33 + MPAR*IHR IF(LREC(IOFF) .NE. MISS) BXGSM = FLOAT(LREC(IOFF))/100. IOFF = IOFF + 1 IF(LREC(IOFF) .NE. MISS) BYGSM = FLOAT(LREC(IOFF))/100. IOFF = IOFF + 1 IF(LREC(IOFF) .NE. MISS) BZGSM = FLOAT(LREC(IOFF))/100. IOFF = IOFF + 1 IF(LREC(IOFF) .NE. MISS) BYGSE = FLOAT(LREC(IOFF))/100. IOFF = IOFF + 1 IF(LREC(IOFF) .NE. MISS) BZGSE = FLOAT(LREC(IOFF))/100. IOFF = IOFF + 1 IF(LREC(IOFF) .NE. MISS) SWDEN = FLOAT(LREC(IOFF))*100000. IOFF = IOFF + 1 IF(LREC(IOFF) .NE. MISS) SWSPD = FLOAT(LREC(IOFF))*100. IOFF = IOFF + 1 IQL = LREC(IOFF) ISTAT = 0 RETURN C Error trap messages: 9000 FORMAT('0GETIMF: Bad time input; time =',4I5) 9100 FORMAT('0GETIMF: Requested date',2I5,' is after last available: ' +,2I5) 9200 FORMAT('0GETIMF: Requested date',2I5,' is before first available: + ',2I5) 9300 FORMAT('0GETIMF: No data available for date',2I5) END