C+ C NAME: C BListAll C PURPOSE: C Collect information about group of magnetic source surface files C CALLING SEQUENCE: integer function BListAll(ID, cWild, BListFnc, NCoff, VarBeg,VarEnd, & nFile, cFile,TFile,XCFileBeg,XCFileEnd,WFile,Nr,R0,Scale) C INPUTS: C ID integer 0: Check for maps containing part of Carrington range C [VarBeg,VarEnd] (used by corotating tomography) C 1: Check for maps covering time range [VarBeg,VarEnd] C An attempt is made to bracket the time range C (used by time-dependent tomography) C BListFnc integer external function C C cWild*(*) character wild card for locating source surface files C NCoff integer C VarBeg real start Carrington variable or time C VarEnd end Carrington variable or time C nFile integer max # of files returned C OUTPUTS: C BListAll integer actual number of files returned C cFile(*)*(*) character fully-qualified file names C TFile(*) real times for all files C XCFileBeg(*) real start Carrington variable for all files C XCFileEnd(*) real end Carrington variables for all files C WFile(*) real weights assigned to each file C Nr(*) real version number for each file C R0 real source surface distance in AU C Scale real conversion factor to be multiplied into C fnc values read by BReadFnc C CALLS: C Str2Str, Flt2Str, Say, FileSelection, iSearch, IndexR4, ArrR4Copy C INCLUDE: include 'dirspec.h' C EXPLICIT: integer BListFnc C EXTERNAL: external BListFnc C RESTRICTIONS: C The test for version numbers of files (higher version numbers are supposed C to replace lower version numbers) is less than perfect. C It is based on the assumption that the start longitude and end longitude C does not change with version numbers. A previous version tested for the C time associated with each file, but this does change with version number C for the WSO_NOAA files. C MODIFICATION HISTORY: C MAY-2002, Paul Hick (UCSD/CASS) C SEP-2002, Paul Hick (UCSD/CASS; pphick@ucsd.edu) C Changed test for newer version numbers from a test on file times C to a test on start longitude. This makes more sense since for the C WSO files the start longitude is coded into the file name. For the C WSO_NOAA files it is actually the end longitude, but since there C is exactly one rotation in each file that amounts to the same thing. C- integer ID character cWild*(*) real VarBeg real VarEnd integer nFile character cFile (*)*(*) real TFile (*) real XCFileBeg(*) real XCFileEnd(*) real WFile (*) integer Nr (*) real R0 real Scale character cSay*8 /'BListAll'/ character cSearch*256 character cFound *256 parameter (nMax=1000) ! Scratch array size integer iTmp(nMax) real rTmp(nMax) character cTmp(nMax)*256 character cXCvarFormat*9 character cID(0:1)*11 /'overlap','bracket'/ call Say(cSay,'I',cID(ID),'['//cXCvarFormat(NCoff,VarBeg)//','//cXCvarFormat(NCoff,VarEnd)//']') iBelow = 0 ! ID=1 only: Earliest time >= VarEnd iAbove = 0 ! ID=1 only: Latest time <= VarBeg !------- ! Process the wild card for file search call FileSelection(cWild,cSearch) !------- ! Search for all files matching the wildcard. nF = 0 I = 1 do while (iSearch(I,cSearch,cFound) .eq. 1) !----- ! Determine time and start/end Carrington variable, and version number. ! (this information could be derived from the file name, ! or might have determined by reading the file. if (BListFnc(cFound,NCoff,TFound,XCFoundBeg,XCFoundEnd,NrFound,R0,Scale) .eq. 1) then !------- ! Compare times. If TFound is already on the list TFile then it could ! be a more recent version. I = 1 !do while (I .le. nF .and. TFound .ne. TFile(I)) ! DOESN'T WORK do while (I .le. nF .and. XCFoundBeg .ne. XCFileBeg(I)) I = I+1 end do !------ ! Check whether the file needs to be stored. Note that the condition ! I = nFile+1 is used to reject the file. if (I .le. nF) then ! File already on list, check version number !------- ! Only more recent versions (with higher version number) are accepted if (NrFound .le. Nr(I)) I = nFile+1 else if (ID .eq. 0) then ! File not on list yet: I = nF+1 !------ ! Check whether [XCFoundBeg,XCFoundEnd] overlaps with [XCBeg,XCEnd] ! If not then reject the file if (VarBeg .gt. XCFoundEnd .or. VarEnd .le. XCFoundBeg) I = nFile+1 else if (ID .eq. 1) then ! File not on list yet: I = nF+1 !------ ! Only the latest time before VarBeg and the earliest time later than ! VarEnd are needed. if (TFound .le. VarBeg) then if (iBelow .eq. 0) then ! First time <= VarBeg iBelow = I ! Remember where time is stored else if (TFound .gt. TFile(iBelow)) then I = iBelow ! TFound closer to VarBeg: overwrite iBelow else ! TFound not closer: reject I = nFile+1 end if else if (TFound .ge. VarEnd) then if (iAbove .eq. 0) then ! First time >= VarEnd iAbove = I ! Remember where time is stored else if (TFound .lt. TFile(iAbove)) then I = iAbove ! TFound closer to VarEnd: overwrite iAbove else ! TFound not closer: reject I = nFile+1 end if endif end if !------- ! A new map is added at position I if there is still room ! We can't terminate the outer 'while' loop when the arrays are full, ! because more recent versions for some of the synoptic maps may show up ! We may be overwriting previous entries in the list, when a more recent ! version is found, or (ID=1 only) when the iBelow or iAbove entries are updated. if (I .le. nFile) then cFile (I) = cFound TFile (I) = TFound XCFileBeg(I) = XCFoundBeg XCFileEnd(I) = XCFoundEnd WFile (I) = 1.0 Nr (I) = NrFound if (I .gt. nF) nF = I ! Update map counter only when adding to list end if end if I = 0 ! Continues iSearch with same wildcard end do !------- ! Sort the files into chronological order if (nF .gt. nMax) then call Say(cSay,'E','nMax','parameter too small') else if (nF .le. 0) then ! No files read R0 = BadR4() Scale = BadR4() else call IndexR4(1,nF,1,nF,TFile,iTmp) ! Get index array for TFile do I=1,nF ! Sort cFile cTmp(I) = cFile(iTmp(I)) end do do I=1,nF cFile(I) = cTmp(I) end do do I=1,nF ! Sort TFile rTmp(I) = TFile(iTmp(I)) end do call ArrR4Copy(nF,rTmp,TFile) do I=1,nF ! Sort XCFileBeg rTmp(I) = XCFileBeg(iTmp(I)) end do call ArrR4Copy(nF,rTmp,XCFileBeg) do I=1,nF ! Sort XCFileEnd rTmp(I) = XCFileEnd(iTmp(I)) end do call ArrR4Copy(nF,rTmp,XCFileEnd) do I=1,nF ! Sort WFile rTmp(I) = WFile(iTmp(I)) end do call ArrR4Copy(nF,rTmp,WFile) end if BListAll = nF return end