C+ C NAME: C ReadGIPS8 C PURPOSE: C Read Cambridge IPS g-level data into arrays C CATEGORY: C I/O C CALLING SEQUENCE: C call ReadGIPS8(cDat,nCar,JDCar, C & iEdt,bAuto,bForeCast, C & XCtst1,XCtst2,MJDref,MJDfrst,MJDlast, C & Radius,Speed,Power,XElow,XEhigh,iEorW,XRlim, C & NLmax,NL, C & iXP,iYP,iMJD,iYRS,DOYS8,XDS,XLS,XLL,XDL,XCE,XE,XC,YL,VV,GG, C & NSmax,iXPsav,iYPsav,iMJDsav,iYRSsav,DOYSsav8,XDSsav,XLSsav, C & XLLsav,XDLsav,XCEsav,XEsav,XCsav,YLsav,VVsav,GGsav) C C INPUTS: C ReadVIPS: C iReadVIPSn8 external integer function C iProcessVIPSn external integer function C external functions control data file access C cWildVIPS character*(*) wildcard used to locate data files; C the wildcard must contain the substring C '%%' C nCar integer dimension of JDCar C JDCar(nCar) integer start times (Julian days) of Carrington rotations C bAuto logical C XCtest1 real modified Carrington variable for start of search C XCtest2 real modified Carrington variable for end of search C NCoff integer JDCar(I) is the start of rotation NCoff+I C MJDref real*8 if not equal 0, only data prior to C modified Julian day MJDref are used C Radius real reference distance (AU) C C XElow real C XEhigh real C iEorW integer C XRlim real C C NLmax integer max. # points read into arrays C XC,YL,VV,GG, XCsav,YLsav,VVsav,GGsav C NSmax integer C C OUTPUTS: C NL integer # valid data points in arrays XC,YL,VV,GG C SRC(NLmax) character*8 Character Source identifier C IYRF(NLmax) integer year of file from which observation was extracted (should be same as IYRS) C IREC(NLmax) integer record number on file IYRF C DOYS8(NLmax) real*8 time of observation: day of year (incl. fraction for time of day) C XDS (NLmax) real Sun-Earth distance C XLS (NLmax) real geocentric ecliptic longitude Sun C XLL (NLmax) real geocentric ecliptic lng(P)-lng(Sun) (deg) C XDL (NLmax) real geocentric ecliptic lat(P) (deg) C XCE (NLmax) real modified Carrington variable of sub-Earth point on Sun C XE (NLmax) real elongation (deg) (>0: East of Sun; <0: West of Sun) C XC (NLmax) real modified Carrington variable point P after traceback to C heliocentric distance Radius at speed VV C YL(NLmax) real heliographic latitude point P C VV(NLmax) real IPS velocity (km/s) C GG(NLmax) real IPS disturbance factor C NSmax integer # data points saved in XCsav,YLsav,VVsav C SRCsav(NSmax) character scratch arrays (used internally only), C IYRFsav(NSmax) integer C IRECsav(NSmax) integer C IYRSsav(NSmax) integer C DOYSsav(NSmax) real*8 C XDSsav (NSmax) real C XLLsav (NSmax) real C XDLsav (NSmax) real C XCEsav (NSmax) real C XEsav (NSmax) real C XCsav (NSmax) real C YLsav (NSmax) real C VVsav (NSmax) real C GGsav (NSmax) real C RESTRICTIONS: C Data files are read using a logical unit number assigned by iGetLun. C Since a data file may be left open on return, there is a potential C danger if the same unit is used somewhere. Assign unit numbers C with iGetLun to make sure this doesn't happen. C FUNCTIONS/SUBROUTINES: C bOpenFile, itrim, SunNewcomb, iSetFileSpec, iGetFileSpec, Julian C EXTERNAL: C INCLUDE: C include 'filparts.h' C include 'sun.h' C COMMON BLOCKS: C SIDE EFFECTS: C PROCEDURE: C > All points in the range [XCtest1,XCtest2] are extracted from the data files C >!!!! The modified Carrington variables are in units offset by NCoff from C the regular Carrington rotation number (i.e. in units which can be C used as index to JDCar) C > Two external user-defined are needed to read the data files. C External functions exist for reading the Nagoya and the UCSD velocity C IPS data: iReadNagoyan8, iProcessNagoyan8 C iReadUCSDn8 , iProcessUCSDn8 C iReadOotyn8 , iProcessOotyn8 C These are programmed in the form: C C function iReadNagoyan8(iU,iFirst) C ... ( read a record from the data file ) ... C return C entry iProcessNagoyan8(iRec,nCar,JDCar,NCoff,Radius, C cSrc,nYr,Doy8,XCsc,XCobs,xLat,xVV,xGG,dRA, C rLngSun,rLngP,rLatP,rEloP ) C ... ( process the record to produce the output values ... C ... nYr,Doy8,XCsc,XCobs,xLat,xVV,xGG,dRA, ... C ... rLngSun,rLngP,rLatP,rEloP ) C return C end C C Input values to iReadVIPSn C iU integer logical unit number assigned by bOpenFile C iFirst integer 1 : initializes record counter C (used when reading 1st record of file) C 0 : adds one to record counter C Output values of iProcessVIPSn: C iRec integer record # on file C cSrc character Source name C nYr integer year and .. C Doy real .. day of year of observation C XCsc real modified Carington variable for sub-SC point C (NCoff already subtracted) C XCobs real modified Carrington variable of point P after C trace-back to distance Radius (NCoff already subtracted) C xLat real heliographic latitude point P (deg) C xVV real IPS velocity (km/s) C xGG real IPS disturbance factor C dRA real RA(point P)-RA(Sun) (deg) C rLngSun real geocentric ecliptic longitude Sun (deg) C rLngP real geocentric ecliptic longitude of point P (deg) C (relative to Sun) C rLatP real geocentric ecliptic latitude of point P (deg) C rEloP real geocentric source elongation (deg) C NOTE: the sign is used to indicate East/West of Sun C rEloP>0: East of Sun; rEloP<0: West of Sun C MODIFICATION HISTORY: C JUN-1994, Paul Hick (UCSD) subroutine ReadGIPS8(cDat,nCar,JDCar, & iEdt,bAuto,bForeCast, & XCtst1,XCtst2,MJDref,MJDfrst,MJDlast, & Radius,Speed,Power, & XElow,XEhigh,iEorW,XRlim, & NLmax,NL, & iXP,iYP,iMJD,iYRS,DOYS8,XDS,XLS,XLL,XDL,XCE,XE,XC,YL,VV,GG, & NSmax,iXPsav,iYPsav,iMJDsav,iYRSsav,DOYSsav8,XDSsav,XLSsav, & XLLsav,XDLsav,XCEsav,XEsav,XCsav,YLsav,VVsav,GGsav) character cDat*(*) integer nCar real*8 JDCar(nCar) integer iEdt logical bAuto logical bForeCast real XCtst1 real XCtst2 real*8 MJDref integer MJDfrst integer MJDlast real Radius real Speed real Power real XElow real XEhigh integer iEorW real XRlim integer NLmax integer NL !------- ! Output and save arrays ! If not in auto mode (bAuto=.FALSE.) then NS=0. Then these arrays are ! not accessed. I.e. if the save option is not needed set bAuto=.FALSE. ! and NSmax=1 to save memory. integer iXP (NLmax) integer iYP (NLmax) integer iMJD(NLmax) integer iYRS(NLmax) real*8 DOYS8(NLmax) real*8 DOYSsav8(NSmax) real XDS (NLmax) real XLS (NLmax) real XLL (NLmax) real XDL (NLmax) real XCE (NLmax) real XE (NLmax) real XC (NLmax) real YL (NLmax) real VV (NLmax) real GG (NLmax) integer NSmax integer iXPsav (NSmax) ! Array indices from daily maps integer iYPsav (NSmax) integer iMJDsav(NSmax) ! Original MJD of daily maps integer iYRSsav(NSmax) ! Time: year real XDSsav (NSmax) ! Sun-Earth distance real XLSsav (NSmax) ! Ecliptic longitude Sun real XLLsav (NSmax) real XDLsav (NSmax) real XCEsav (NSmax) real XEsav (NSmax) real XCsav (NSmax) ! Carrington variable of Point P real YLsav (NSmax) ! Heliographic latitude of Point P real VVsav (NSmax) ! Solar wind velocity (km/s) real GGsav (NSmax) ! G-factor !------- ! Arrays passed to ReadG to read the Cambridge data files. ! All, except XR_t, are copied into output arrays. XR_t is used internally only for ! selection of data points. parameter (NTIME = 72) parameter (NDEC = 14) integer iYRS_t(NTIME,NDEC) real DOYS_t(NTIME,NDEC) real XDS_t (NTIME,NDEC) real XLS_t (NTIME,NDEC) real XLL_t (NTIME,NDEC) real XDL_t (NTIME,NDEC) real XCE_t (NTIME,NDEC) real XE_t (NTIME,NDEC) real XC_t (NTIME,NDEC) real YL_t (NTIME,NDEC) real XV_t (NTIME,NDEC) real XG_t (NTIME,NDEC) real XR_t (NTIME,NDEC) character cError(-1:0) /'E','W'/ character cStr*120 character cSay*8 /'ReadGIPS'/ integer NS /0/ save MJDsav, NS Bad = BadR4() !------- ! Check the save scratch arrays for valid data points. ! NS can only be unequal zero in AUTO mode. In AUTO mode only XCtst1 ! and XCtst2 change. All other data selection criteria remain the same. NL = 0 ! Initialize counter for data points if (NS .eq. 0) then ! Not in AUTO mode or first map MJDstop = MJDfrst ! Stop at earliest available MJD else !------- ! Scan the save arrays. Only points with XC >= XCtst1 are needed for ! subsequent maps. Discard points with XC < XCtst1. N = 0 do I=1,NS if (XCtst1 .le. XCsav(I)) then N = N+1 iMJDsav(N) = iMJDsav(I) iXPsav (N) = iXPsav (I) iYPsav (N) = iYPsav (I) iYRSsav(N) = iYRSsav(I) DOYSsav8(N) = DOYSsav8(I) XDSsav (N) = XDSsav (I) XLSsav (N) = XLSsav (I) XLLsav (N) = XLLsav (I) XDLsav (N) = XDLsav (I) XCEsav (N) = XCEsav (I) XEsav (N) = XEsav (I) XCsav (N) = XCsav (I) YLsav (N) = YLsav (I) VVsav (N) = VVsav (I) GGsav (N) = GGsav (I) endif end do NS = N !-------- ! Pick up all points in the save arrays which are needed for the current ! map. Since all points with XC < XCtst1 have just been discarded, the ! points are only tested for XC <= XCtst2. This takes care for all MJD's ! until the current MJDsav value. Only MJD's later than this (i.e. starting ! at MJDstop = MJDsav+1 have to be scanned for additional points; ! Remember files are scanned backward in time, so MJDstop is the last file ! to be scanned for the current map. do I=1,NS if (XCsav(I) .le. XCtst2) then NL = NL+1 iMJD(NL) = iMJDsav(I) iXP (NL) = iXPsav (I) iYP (NL) = iYPsav (I) iYRS(NL) = iYRSsav(I) DOYS8(NL) = DOYSsav8(I) XDS (NL) = XDSsav (I) XLS (NL) = XLSsav (I) XLL (NL) = XLLsav (I) XDL (NL) = XDLsav (I) XCE (NL) = XCEsav (I) XE (NL) = XEsav (I) XC (NL) = XCsav (I) YL (NL) = YLsav (I) VV (NL) = VVsav (I) GG (NL) = GGsav (I) endif end do MJDstop = MJDsav+1 ! Earlier files are processed .. ! .. and stored in save arrays endif MJD = min(MJDlast,int(MJDref)) ! MJDlast is latest day available if (MJD .lt. MJDstop) return ! Check whether any files ... ! .. have to be scanned !------- ! Read first IPS data file call ReadG(cDat,nCar,JDCar,MJD,iEdt,Radius,Speed,Power,iOK,XCmin,XCmax, & iYRS_t,DOYS_t, XDS_t,XLS_t,XLL_t,XDL_t,XCE_t, XC_t,YL_t,XE_t,XR_t,XV_t,XG_t,cStr,.TRUE.) if (iOK .ne. 0 .and. .not. bForeCast) then !------- ! Make sure not to miss any data. ! Data points are collected going from large to small XC values (i.e. backwards ! in time. Point with XC in [XCtst1,XCtst2] are needed. ! First scan forward in time to find an MJD for which the range ! [XCmin,XCmax] lies entirely above [XCtst1,XCtst2], i.e. XCmin > XCtst2. MJDsav = MJD do while (MJD .lt. MJDlast .and. iOK .ne. 0 .and. (iOK .eq. 3 .or. XCmin .le. XCtst2)) MJD = MJD+1 I = iOK call ReadG(cDat,nCar,JDCar,MJD,iEdt,Radius,Speed,Power,iOK,XCmin,XCmax, & iYRS_t,DOYS_t, XDS_t,XLS_t,XLL_t,XDL_t,XCE_t, XC_t,YL_t,XE_t,XR_t,XV_t,XG_t,cStr,.TRUE.) end do if (iOK .eq. 0) then MJD = MJD-1 iOK = I end if if (MJD .ne. MJDsav) then write (cStr(itrim(cStr)+1:),'(2(A,I5))') '; MJD upward adjusted: ',MJDsav,' --> ',MJD call Say(' ',' ',' ',cStr) end if !------- ! Now scan backwards until the first MJD with data inside the range ! [XCtst1,XCtst2] is found, i.e. until XCmin <= XCtst2 (if the previous ! DO WHILE loop was entered this will the day before the current MJD. ! (This loop isn't strictly necessary, but it doesn't hurt either.) MJDsav = MJD do while (MJD .gt. MJDstop .and. iOK .ne. 0 .and. (iOK .eq. 3 .or. XCmin .gt. XCtst2)) MJD = MJD-1 call ReadG(cDat,nCar,JDCar,MJD,iEdt,Radius,Speed,Power,iOK,XCmin,XCmax, & iYRS_t,DOYS_t, XDS_t,XLS_t,XLL_t,XDL_t,XCE_t, XC_t,YL_t,XE_t,XR_t,XV_t,XG_t,cStr,.TRUE.) end do if (MJD .ne. MJDsav) then write (cStr(itrim(cStr)+1:),'(2(A,I5))') '; MJD downward adjusted: ',MJDsav,' --> ',MJD call Say(' ',' ',' ',cStr) end if end if !------- ! If ReadG returned with a false iOK, then stop (if in AUTO mode) or go back ! for new prompts (if not in AUTO mode) if (iOK .eq. 0) then I = 0 if (bAuto) I = -1 call Say(cSay,cError(I),'RDERR','error reading MJD '//cStr(:Int2Str(MJD,cStr))) NL = 0 return end if MJDsav = MJD ! Used as MJDstop for next map in AUTO mode !------- ! Read into arrays XC,YL,V until ! - low end XCtst1 is reached, or ! - no more files available ! - arrays are full ! Only points in range [XCtst1,XCtst2] are accepted do while (iOK .eq. 3 .or. XCmax .ge. XCtst1) if (iOK .eq. 1) then ! Data points available NLtemp = NL ! do I=1,NTIME do I=NTIME,1,-1 do J=1,NDEC if (iEorW .eq. 0) then ! All XE (East+West) Rdum = abs(XE_t(I,J)) else Rdum = iEorW*XE_t(I,J) ! Only positive XE (East) or end if ! only negative XE (West) if (XC_t(I,J) .ne. Bad .and. & XElow .le. Rdum .and. Rdum .le. XEhigh .and. & abs(XR_t(I,J)) .le. XRlim) then if (XCtst1 .le. XC_t(I,J)) then !------- ! In AUTO mode the next map will be for points in a range ! [XCtst1+XCincr,XCtst2+XCincr], i.e. shifted to higher XC values ! relative to the current range [XCtst1,XCtst2]. ! Collect all points that may be needed for subsequent maps (XC_t >= XCtst1) ! in the save scratch arrays. Note that this includes points with ! XC_t > XCtst2, which are not used in the current map. if (bAuto) then if (NS .ge. NSmax) return NS = NS+1 iMJDsav(NS) = MJD iXPsav (NS) = I iYPsav (NS) = J iYRSsav(NS) = iYRS_t(I,J) DOYSsav8(NS) = DOYS_t(I,J) XDSsav (NS) = XDS_t (I,J) XLSsav (NS) = XLS_t (I,J) XLLsav (NS) = XLL_t (I,J) XDLsav (NS) = XDL_t (I,J) XCEsav (NS) = XCE_t (I,J) XEsav (NS) = XE_t (I,J) XCsav (NS) = XC_t (I,J) YLsav (NS) = YL_t (I,J) VVsav (NS) = XV_t (I,J) GGsav (NS) = XG_t (I,J) end if !------- ! Pick up all points inside [XCtst1,XCtst2] for the current map. if (XC_t(I,J) .le. XCtst2) then if (NL .ge. NLmax) return NL = NL+1 iMJD(NL) = MJD iXP (NL) = I iYP (NL) = J iYRS(NL) = iYRS_t(I,J) DOYS8(NL) = DOYS_t(I,J) XDS (NL) = XDS_t (I,J) XLS (NL) = XLS_t (I,J) XLL (NL) = XLL_t (I,J) XDL (NL) = XDL_t (I,J) XCE (NL) = XCE_t (I,J) XE (NL) = XE_t (I,J) XC (NL) = XC_t (I,J) YL (NL) = YL_t (I,J) VV (NL) = XV_t (I,J) GG (NL) = XG_t (I,J) end if end if end if end do end do write (cStr(itrim(cStr)+1:),'(A,I4,A)') '; ',NL-NLtemp,' used' call Say(' ',' ',' ',cStr) end if if (MJD .eq. MJDstop) return ! All files scanned MJD = MJD-1 ! Next data file iOK = -1 ! Suppress messages call ReadG(cDat,nCar,JDCar,MJD,iEdt,Radius,Speed,Power,iOK,XCmin,XCmax, & iYRS_t,DOYS_t, XDS_t,XLS_t,XLL_t,XDL_t,XCE_t, XC_t,YL_t,XE_t,XR_t,XV_t,XG_t,cStr,.FALSE.) !------- ! If ReadG returned with a false iOK, then stop (if in AUTO mode) or go back ! for new prompts (if not in AUTO mode) if (iOK .eq. 0) then I = 0 if (bAuto) I = -1 call Say(cSay,cError(I),'RDERR','error reading MJD '//cStr(:Int2Str(MJD,cStr))) call AskWhat('Cancel, Skip to next day, Plot map$0',I) if (I .eq. 0) NL = 0 if (I .eq. 0 .or. I .eq. 2) return end if end do !------- ! Number of points read is now NL call Say(cSay,'I','nobs',cStr(:Int2Str(NL,cStr))//' source observations') return end