module m_ec_bccollect use m_ec_parameters use m_ec_typedefs use m_ec_bcreader use m_ec_support use m_ec_message use m_ec_instance use m_alloc use multi_file_io implicit none private public :: ecCollectBCBlocks interface ecCollectBCBlocks module procedure collectbc end interface ecCollectBCBlocks contains !============================================================================================================================ ! Collectloop: Scan a bc-file, being given QUANTITY and LOCATION. ! For each match, create a file reader, add it to the list of file readers in the instance integer function collectbc(instancePtr, fname, quantity, location, iostat) result (count) implicit none type (tEcInstance), pointer, intent(in) :: instancePtr !< EC Instance, overall structure for the EC-module character(len=*), intent(in) :: fname !< file name (bc-format) character(len=*), intent(in) :: quantity !< quantity name character(len=*), intent(in) :: location !< location ! quantity+location = search key integer, intent(out) :: iostat integer (kind=8) :: fhandle character*(255) :: rec integer :: reclen integer :: commentpos character*(1000) :: keyvaluestr ! all key-value pairs in one header integer :: posfs integer :: nfld integer :: nq logical :: jablock, jaheader integer :: reallocstat integer :: lineno integer (kind=8) :: savepos integer :: iostatloc type (tEcBCBlock), pointer :: bcBlockPtr type (tEcFileReader), pointer :: fileReaderPtr integer :: bcBlockId, fileReaderId iostat = EC_UNKNOWN_ERROR lineno = 0 savepos = 0 if (.not.ecSupportOpenExistingFileGnu(fhandle, fname)) then iostat = EC_DATA_NOTFOUND return end if count = 0 do while (.not.mf_eof(fhandle)) call mf_read(fhandle,rec,savepos) iostatloc = 0 ! mf_read always ok? if (iostatloc /= 0) then iostat = iostatloc return ! beter break? endif lineno = lineno + 1 reclen = len_trim(rec) ! deal with various comment delimiters commentpos = index(rec,'//') if (commentpos>0) reclen = min(reclen,commentpos-1) commentpos = index(rec,'%') if (commentpos>0) reclen = min(reclen,commentpos-1) commentpos = index(rec,'#') if (commentpos>0) reclen = min(reclen,commentpos-1) commentpos = index(rec,'*') if (commentpos>0) reclen = min(reclen,commentpos-1) commentpos = index(rec,'!') if (commentpos>0) reclen = min(reclen,commentpos-1) if (len_trim(rec(1:reclen))>0) then ! skip empty lines if (index(rec,'[forcing]')>0) then ! new boundary chapter jaheader = .true. ! switching to header mode keyvaluestr = ',' jablock=.false. nfld = 0 ! count the number of fields in this header block nq = 0 ! count the (maximum) number of quantities in this block else if (jaheader) then posfs = index(rec(1:reclen),'=') ! key value pair ? if (posfs>0) then call replace_char(rec,9,32) ! replace tabs by spaces, header key-value pairs only nfld = nfld + 1 ! count the number of lines in the header file ! Create a lengthy string of ',key,value,key,value.....' call str_upper(rec(1:posfs-1)) ! all keywords uppercase , not case sensitive if (index(rec(1:posfs-1),'QUANTITY')>0) then nq = nq + 1 endif keyvaluestr = trim(keyvaluestr)//''''// (trim(adjustl(rec(1:posfs-1))))//''',''' & //(trim(adjustl(rec(posfs+1:reclen))))//''',' endif else ! switch to datamode call str_upper(keyvaluestr,len(trim(keyvaluestr))) ! case insensitive format if (jakeyvalue(keyvaluestr,'NAME',trim(location))) then if (jakeyvalue(keyvaluestr,'FUNCTION','ASTRONOMIC').or.jakeyvalue(keyvaluestr,'FUNCTION','ASTROCOR')) then ! Check for harmonic or astronomic components jablock = .true. jablock = jablock .and. jakeyvalue(keyvaluestr,'QUANTITY','ASTRONOMIC COMPONENT') jablock = jablock .and. jakeyvalue(keyvaluestr,'QUANTITY',trim(quantity)//' '//'AMPLITUDE') jablock = jablock .and. jakeyvalue(keyvaluestr,'QUANTITY',trim(quantity)//' '//'PHASE') elseif (jakeyvalue(keyvaluestr,'FUNCTION','HARMONIC').or.jakeyvalue(keyvaluestr,'FUNCTION','HARMCOR')) then ! Check for harmonic or harmonic components jablock = .true. jablock = jablock .and. jakeyvalue(keyvaluestr,'QUANTITY','HARMONIC COMPONENT') jablock = jablock .and. jakeyvalue(keyvaluestr,'QUANTITY',trim(quantity)//' '//'AMPLITUDE') jablock = jablock .and. jakeyvalue(keyvaluestr,'QUANTITY',trim(quantity)//' '//'PHASE') elseif (jakeyvalue(keyvaluestr,'FUNCTION','QH')) then ! Check for qh jablock = .true. jablock = jablock .and. jakeyvalue(keyvaluestr,'QUANTITY',trim(quantity)//' '//'WATERLEVEL') jablock = jablock .and. jakeyvalue(keyvaluestr,'QUANTITY',trim(quantity)//' '//'DISCHARGE') elseif (jakeyvalue(keyvaluestr,'FUNCTION','T3D')) then ! Check for timeseries on sigma- or z-levels jablock = jakeyvalue(keyvaluestr,'QUANTITY',quantity) elseif (jakeyvalue(keyvaluestr,'FUNCTION','TIMESERIES')) then ! Check for timeseries jablock = jakeyvalue(keyvaluestr,'QUANTITY',quantity) endif if (jablock) then ! block confirmed, Create a filereader and initialize a bc-Block bcBlockId = ecInstanceCreateBCBlock(InstancePtr) bcBlockPtr=>ecSupportFindBCBlock(instancePtr, bcBlockId) fileReaderId = ecInstanceCreateFileReader(InstancePtr) fileReaderPtr = ecSupportFindFileReader(instancePtr, fileReaderID) fileReaderPtr%bc => bcBlockPtr call processhdr(bcBlockPtr,nfld,nq,keyvaluestr) ! dumb translation of bc-object metadata call checkhdr(bcBlockPtr) ! check on the contents of the bc-object bcBlockPtr%fname = fname if (ecSupportOpenExistingFileGnu(bcBlockPtr%fhandle, fname)) then call mf_backspace(bcBlockPtr%fhandle, savepos) ! set newly opened file to the appropriate position count = count + 1 iostat = EC_NOERR else call mf_close(bcBlockPtr%fhandle) iostat = EC_DATA_NOTFOUND end if else ! location was found, but not all required meta data was present iostat = EC_METADATA_INVALID endif ! Right quantity else ! location was found, but data was missing/invalid iostat = EC_DATA_NOTFOUND endif ! Right label jaheader = .false. ! No, we are NOT reading a header if (jablock) then ! Yes, we are in the bc-block of interest endif ! found matching block endif ! in header mode (data lines are ignored) endif ! not a new '[forcing]' item endif ! non-empty string enddo ! read/scan loop, ended when we reached end-of-file iostat = EC_EOF end function collectbc !============================================================================================================================ end module m_ec_bccollect