subroutine read_descriptor_files(srcPath, numRecords,rcrd,rc)
!-------------------------------------------------------------------------------
!
! !ARGUMENTS:
character(len=*), intent(in) :: srcPath
integer, intent(in) :: numRecords
type(problem_descriptor_records), pointer :: rcrd(:)
integer, intent(out) :: rc
!
! !DESCRIPTION:
! This routine takes the problem descriptor file names specified in the top
! level config file "test_harness.rc" and extracts from a config table the
! "problem descriptor string" and all the "problem specifier files." These
! helper files are divided into groups by flags preceeded by a dash. The
! "-c" flag (currently not implemented) indicates file(s) containing the CLASS
! specific settings. The "-d" flag indicates the file(s) containing an ensemble
! of distribution configurations to be run with the specific "problem descriptor
! string." Likewise the "-g" flag indicates the file(s) containing an ensemble
! of grid configurations to be run with the specific "problem descriptor string."
! This routine only extracts the information from the configuration file,
! additional processing occurs in a later routine.
!
! Upon completion, the routine returns the values to a public record
! har%rcrd(n)%numStrings number of problem descriptor strings in
! the n'th problem descriptor file.
! har%rcrd(n)%str(k)%pds k'th problem descriptor from the n'th
! problem descriptor file.
!
! har%rcrd(n)%str(k)%nDfiles number of distribution specifier files
! har%rcrd(n)%str(k)%Dfiles(l)%filename filename string for
! the l'th distribution specifier file
! associated with the k'th problem descriptor
! string, located in the n'th problem
! descriptor file.
!
! har%rcrd(n)%str(k)%nGfiles number of grid specifier files
!
! har%rcrd(n)%str(k)%Gfile(l)%filename filename string for
! the l'th grid specifier file associated
! with the k'th problem descriptor string
! located in the n'th problem descriptor
! file.
!===============================================================================
! local ESMF types
type(ESMF_Config) :: localcf
! local parameters
character(THARN_MAXSTR), parameter :: descriptor_label &
= "problem_descriptor_string::"
! local character types
type (sized_char_array), allocatable :: ltmpstring(:), lstring(:)
! local character strings
character(THARN_MAXSTR) :: lfilename
character(THARN_MAXSTR) :: ltmp
character(THARN_MAXSTR) :: lchar, lchar1, lchar2
logical :: flag
! local integer variables
integer :: n, nn, k, pos, kcol, ncount, npds, ntmp
integer :: kfile, kstr, pstring
integer :: cpos, dpos, gpos, csize, dsize, gsize
integer, allocatable :: kcount(:), ncolumns(:), nstrings(:)
integer, allocatable :: pds_loc(:), pds_flag(:)
integer :: localrc
integer :: allocRcToTest
! local logical variable
logical :: endflag
logical :: cflag, dflag, gflag
! initialize return flag
localrc = ESMF_RC_NOT_IMPL
rc = ESMF_RC_NOT_IMPL
!-----------------------------------------------------------------------------
! open each problem descriptor and extract the contents of the table
! containing the problem descriptor strings and the specifier filenames
!-----------------------------------------------------------------------------
allocate( nstrings(numRecords), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer array "// &
" nstrings in read_descriptor_files", rcToReturn=rc)) then
endif
do kfile=1,numRecords
!---------------------------------------------------------------------------
! create a new config handle for reading problem descriptor strings
!---------------------------------------------------------------------------
localcf = ESMF_ConfigCreate(rc=localrc)
if( ESMF_LogFoundError(localrc, msg="cannot create config object", &
rcToReturn=rc) ) return
!---------------------------------------------------------------------------
! load file holding the problem descriptor strings
!---------------------------------------------------------------------------
lfilename = trim(adjustL(rcrd(kfile)%filename))
call ESMF_ConfigLoadFile(localcf, trim(adjustL(lfilename)), rc=localrc )
if( CheckError(checkpoint, __LINE__, __FILE__, localrc, "cannot load config file " // &
trim(adjustL(lfilename)), rcToReturn=rc) ) return
!---------------------------------------------------------------------------
! Search for the problem descriptor string table
!---------------------------------------------------------------------------
call ESMF_ConfigFindLabel(localcf, trim(adjustL(descriptor_label)), &
rc=localrc )
if( CheckError(checkpoint, __LINE__, __FILE__, localrc, "cannot find config label " // &
trim(adjustL(descriptor_label)), rcToReturn=rc) ) return
!---------------------------------------------------------------------------
! determine the number of entries
!---------------------------------------------------------------------------
call ESMF_ConfigGetDim(localcf, nstrings(kfile), ntmp, &
label=trim(adjustL(descriptor_label)), rc=localrc)
if( CheckError(checkpoint, __LINE__, __FILE__, localrc, "cannot get descriptor table size in " &
// "file " // trim(adjustL(lfilename)), rcToReturn=rc) ) return
!---------------------------------------------------------------------------
! determine that the table has entries before preceeding
!---------------------------------------------------------------------------
if( nstrings(kfile) .le. 0 ) then
call ESMF_LogSetError( ESMF_FAILURE, msg="problem descriptor table empty" &
// " in file " // trim(adjustL(lfilename)), rcToReturn=rc)
return
endif
!---------------------------------------------------------------------------
! extract column lengths of the table to determine the number of specifier files
!---------------------------------------------------------------------------
call ESMF_ConfigFindLabel(localcf, trim(adjustL(descriptor_label)), &
rc=localrc )
if( CheckError(checkpoint, __LINE__, __FILE__, localrc, "cannot find config label" // &
trim(adjustL(descriptor_label)), rcToReturn=rc) ) return
allocate( ncolumns(nstrings(kfile)), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer array "// &
" nstrings in read_descriptor_files", rcToReturn=rc)) then
endif
allocate ( ltmpstring(nstrings(kfile)), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="type "// &
" ltmpstring in read_descriptor_files", rcToReturn=rc)) then
endif
do kstr=1,nstrings(kfile)
call ESMF_ConfigNextLine(localcf, tableEnd=flag , rc=localrc)
if( CheckError(checkpoint, __LINE__, __FILE__, localrc, "cannot advance to the next line of" &
//" the table "// trim(adjustL(descriptor_label)) // " in file " &
// trim(adjustL(lfilename)), rcToReturn=rc) ) return
ncolumns(kstr) = ESMF_ConfigGetLen(localcf, rc=localrc)
if (localrc .ne. ESMF_SUCCESS .or. ncolumns(kstr) .lt. 1 ) then
write(lchar,"(i5)") kstr
call ESMF_LogSetError( ESMF_FAILURE, msg="problem reading line " // &
trim(adjustL(lchar)) // " of table in file " // &
trim(adjustL(lfilename)), rcToReturn=rc)
return
endif
!-------------------------------------------------------------------------
! allocate tempory storage so that the file needs to be read only once
!-------------------------------------------------------------------------
allocate ( ltmpstring(kstr)%tag( ncolumns(kstr) ), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="type "// &
" ltmpstring in read_descriptor_files", rcToReturn=rc)) then
endif
ltmpstring(kstr)%tagsize = ncolumns(kstr)
enddo ! end string
!---------------------------------------------------------------------------
! Starting again at the top of the table, extract the table contents into
! a local character array structure for later processing
!---------------------------------------------------------------------------
call ESMF_ConfigFindLabel(localcf, trim(adjustL(descriptor_label)), &
rc=localrc )
if( CheckError(checkpoint, __LINE__, __FILE__, localrc, &
"cannot find config label " // trim(adjustL(descriptor_label)), &
rcToReturn=rc) ) return
do kstr=1,nstrings(kfile)
!---------------------------------------------------------------------------
! copy the table into a character array
!---------------------------------------------------------------------------
call ESMF_ConfigNextLine(localcf, tableEnd=flag , rc=localrc)
if( CheckError(checkpoint, __LINE__, __FILE__, localrc, "cannot advance to the next line " // &
"of table " // trim(adjustL(descriptor_label)) // " in file " // &
trim(adjustL(lfilename)), rcToReturn=rc) ) return
do kcol=1, ncolumns(kstr)
call ESMF_ConfigGetAttribute(localcf, ltmp, rc=localrc)
write(lchar,"(i5)") kstr
if( CheckError(checkpoint, __LINE__, __FILE__, localrc, "cannot get table entry from line " &
// trim(adjustl(lchar)) // " column " // char(kcol) // &
"of file " // trim(adjustL(lfilename)), &
rcToReturn=rc) ) return
ltmpstring(kstr)%tag(kcol)%string = trim( ltmp )
enddo ! end col
enddo ! end string
!---------------------------------------------------------------------------
! count the number of actual problem descriptor strings & continuation lines
!---------------------------------------------------------------------------
ncount = 0
npds = 0
allocate( pds_flag(nstrings(kfile)), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="type "// &
" pdf_flag in read_descriptor_files", rcToReturn=rc)) then
endif
do kstr=1,nstrings(kfile)
if( trim(adjustL(ltmpstring(kstr)%tag(1)%string)) /= "&") then
pds_flag(kstr) = 1
npds = npds + 1
else
ncount = ncount + 1
pds_flag(kstr) = 0
endif
enddo ! end string
! sanity check
if( (npds + ncount) /= nstrings(kfile) ) then
write(lchar,"(i5)") nstrings(kfile)
write(lchar1,"(i5)") npds
write(lchar2,"(i5)") ncount
call ESMF_LogSetError( ESMF_FAILURE, msg="number of rows " // &
trim(adjustl(lchar)) // " in the table" // &
" does not match the sum of strings " // trim(adjustl(lchar1)) &
// " and continuation lines " // trim(adjustl(lchar2)) // &
" of file " // trim(adjustL(lfilename)), rcToReturn=rc)
return
endif
rcrd(kfile)%numStrings = npds
!---------------------------------------------------------------------------
! save the addresses of the non-continuation lines
!---------------------------------------------------------------------------
k = 0
allocate( pds_loc(npds), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="type "// &
" pds_loc in read_descriptor_files", rcToReturn=rc)) then
endif
do kstr=1,nstrings(kfile)
if( pds_flag(kstr) == 1 ) then
k = k + 1
pds_loc(k) = kstr
endif
enddo ! end string
! sanity check
if( npds .ne. k ) then
write(lchar,"(i5)") nstrings(kfile)
write(lchar1,"(i5)") npds
write(lchar2,"(i5)") ncount
call ESMF_LogSetError( ESMF_FAILURE, msg="number of rows " // &
trim(adjustl(lchar)) // " in the table" // &
" does not match the sum of strings "//trim(adjustl(lchar1)) &
// " and continuation lines " // trim(adjustl(lchar2)) // &
" of file " // trim(adjustL(lfilename)), rcToReturn=rc)
return
endif
!---------------------------------------------------------------------------
! to simplify the later search algorithm, reshape the input table from a
! series of lines with a PDS plus optional continuations lines, to a single
! line with everything on it. Count the total number of elements on both
! type of lines to that we can allocate enough memory to store the whole
! specification.
!---------------------------------------------------------------------------
allocate( kcount(npds), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "// &
" kcount in read_descriptor_files", rcToReturn=rc)) then
endif
do k=1,npds
if( trim( ltmpstring( pds_loc(k) )%tag(1)%string ) == "&") then
write(lchar,"(i5)") pds_loc(k)
call ESMF_LogSetError( ESMF_FAILURE, &
msg="no problem descriptor string on line " // &
trim(adjustl(lchar)) // " of file " // &
trim(adjustL(lfilename)),rcToReturn=rc)
return
else ! at new PDS
kcount(k) = ncolumns(pds_loc(k))
pstring = pds_loc(k)
21 continue
!-----------------------------------------------------------------------
! if not end of table, look for additional continuation lines
!-----------------------------------------------------------------------
if(pstring < nstrings(kfile)) then
pstring = pstring + 1
!---------------------------------------------------------------------
! if find a continuation line add additional elements (minus the
! continuation symbol "&")
!---------------------------------------------------------------------
if( trim( ltmpstring(pstring)%tag(1)%string ) == "&" ) then
kcount(k) = kcount(k) + ncolumns(pstring) -1
goto 21
endif
endif
endif
enddo ! k
!---------------------------------------------------------------------------
! create reshaped workspace to hold the problem descriptor table contents
!---------------------------------------------------------------------------
allocate ( lstring(npds), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="type "// &
" lstring in read_descriptor_files", rcToReturn=rc)) then
endif
do k=1, npds
allocate ( lstring(k)%tag(kcount(k)), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="type "// &
" lstring tag in read_descriptor_files", rcToReturn=rc)) then
endif
do n=1,ncolumns(pds_loc(k))
lstring(k)%tag(n)%string = trim( ltmpstring(pds_loc(k))%tag(n)%string )
enddo ! n
pstring = pds_loc(k)
nn = ncolumns(pds_loc(k))+1
22 continue
!-------------------------------------------------------------------------
! if not end of table, look for additional continuation lines
!-------------------------------------------------------------------------
if(pstring < nstrings(kfile)) then
pstring = pstring + 1
!-----------------------------------------------------------------------
! if find a continuation line, and add to the line length (minus the
! continuation symbol)
!-----------------------------------------------------------------------
if( trim( ltmpstring(pstring)%tag(1)%string ) == "&" ) then
do n=2,ncolumns(pstring)
lstring(k)%tag(nn)%string = trim(ltmpstring(pstring)%tag(n)%string )
nn = nn + 1
enddo ! n
goto 22
endif
endif
enddo ! k
!---------------------------------------------------------------------------
! mine the table entries for the problem descriptor strings
!---------------------------------------------------------------------------
allocate( rcrd(kfile)%str(npds), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="type "// &
" rcrd string in read_descriptor_files", rcToReturn=rc)) then
endif
do k=1,npds
rcrd(kfile)%str(k)%pds = trim( lstring(k)%tag(1)%string )
enddo ! k
!---------------------------------------------------------------------------
! mine the table entries for the names of the specifier files
!---------------------------------------------------------------------------
do k=1,npds
pos = 2
endflag = .true.
! drs debug
cflag = .true. ! set to true so that it doesn't look for a "-c" argument
! drs debug
dflag = .false.
gflag = .false.
!-------------------------------------------------------------------------
! loop through the specifiers for each of the problem desriptor strings
!-------------------------------------------------------------------------
do while(endflag)
ltmp = trim( lstring(k)%tag(pos)%string )
select case ( trim(adjustL(ltmp)) )
!----------------------------------------------------------------------
! class descriptor file
!----------------------------------------------------------------------
case('-c')
if( cflag ) then
write(lchar,"(i5)") k
call ESMF_LogSetError( ESMF_FAILURE, msg="the -c specifier flag" &
// " is used more than once on the " // &
trim(adjustl(lchar))//"th string of the problem " // &
"descriptor table in file" // trim(lfilename), &
rcToReturn=rc)
return
endif
! starting position
cpos = pos
11 continue
! if not at the end of the row, then check next element
if( pos < kcount(k) ) then
pos = pos + 1
ltmp = trim(adjustL( lstring(k)%tag(pos)%string ))
! if not a flag, repeat until a flag
if( ltmp(1:1) /= '-' ) goto 11
csize = pos-1-cpos
endflag = .true.
else ! at end of row
csize = pos-cpos
endflag = .false.
endif
allocate( rcrd(kfile)%str(k)%classfile%tag(csize), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="type "// &
" rcrd tag in read_descriptor_files", rcToReturn=rc)) then
endif
rcrd(kfile)%str(k)%classfile%tagsize = csize
do n=1,csize
rcrd(kfile)%str(k)%classfile%tag(n)%string = &
trim(adjustL( lstring(k)%tag(cpos+n)%string ))
enddo ! n
cflag = .true.
!----------------------------------------------------------------------
! distribution descriptor file
!----------------------------------------------------------------------
case('-d')
if( dflag ) then
write(lchar,"(i5)") k
call ESMF_LogSetError( ESMF_FAILURE, msg="the -d specifier flag" &
// " is used more than once on the " // &
trim(adjustl(lchar))//"th string of the problem " // &
"descriptor table in file" // trim(adjustL(lfilename)), &
rcToReturn=rc)
return
endif
! starting position
dpos = pos
12 continue
! if not at the end of the row, then check next element
if( pos < kcount(k) ) then
pos = pos + 1
ltmp = trim(adjustL( lstring(k)%tag(pos)%string ))
! if not a flag, repeat until a flag
if( ltmp(1:1) /= '-' ) goto 12
dsize = pos-1-dpos
endflag =.true.
else ! at end of row
dsize = pos-dpos
endflag =.false.
endif
allocate( rcrd(kfile)%str(k)%Dfiles(dsize), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="type "// &
" rcrd Dfiles in read_descriptor_files", rcToReturn=rc)) then
endif
rcrd(kfile)%str(k)%nDfiles = dsize
do n=1,dsize
! build complete filename icluding source path
lfilename = trim(srcPath) // "/" // trim(adjustL(lstring(k)%tag(dpos+n)%string))
rcrd(kfile)%str(k)%Dfiles(n)%filename = lfilename
!rcrd(kfile)%str(k)%Dfiles(n)%filename = &
! trim(adjustL( lstring(k)%tag(dpos+n)%string ))
enddo ! n
dflag = .true.
!----------------------------------------------------------------------
! grid descriptor file
!----------------------------------------------------------------------
case('-g')
if( gflag ) then
write(lchar,"(i5)") k
call ESMF_LogSetError( ESMF_FAILURE, msg="the -g specifier flag" // &
" is used more than once on the " // trim(adjustl(lchar)) &
//"th string of the problem descriptor table in file " // &
trim(adjustL(lfilename)), rcToReturn=rc)
return
endif
! starting position
gpos = pos
13 continue
! if not at the end of the row, then check next element
if( pos < kcount(k) ) then
pos = pos + 1
ltmp = trim(adjustL( lstring(k)%tag(pos)%string ))
! if not a flag, repeat until a flag
if( ltmp(1:1) /= '-' ) goto 13
gsize = pos-1-gpos
endflag = .true.
else ! at end of row
gsize = pos-gpos
endflag = .false.
endif
allocate( rcrd(kfile)%str(k)%Gfiles(gsize), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="type "// &
" rcrd Gfiles in read_descriptor_files", rcToReturn=rc)) then
endif
rcrd(kfile)%str(k)%nGfiles = gsize
do n=1,gsize
! build complete filename icluding source path
lfilename = trim(srcPath) // "/" // trim(adjustL(lstring(k)%tag(gpos+n)%string))
rcrd(kfile)%str(k)%Gfiles(n)%filename = lfilename
!rcrd(kfile)%str(k)%Gfiles(n)%filename = &
!trim(adjustL(lstring(k)%tag(gpos+n)%string))
enddo ! n
gflag = .true.
!----------------------------------------------------------------------
! syntax error - entry after pds should be a flag
!----------------------------------------------------------------------
case default
write(lchar,"(i5)") pds_loc(k)
call ESMF_LogSetError( ESMF_FAILURE, &
msg="no specifier flag on line " // trim(adjustl(lchar)) // &
" of file " //trim(lfilename), rcToReturn=rc)
return
end select ! specifier flag type
end do ! while
enddo ! k
!---------------------------------------------------------------------------
! finish cleaning up workspace before opening new file
!---------------------------------------------------------------------------
do k=1, npds
deallocate ( lstring(k)%tag )
enddo
do kstr=1,nstrings(kfile)
deallocate ( ltmpstring(kstr)%tag )
enddo
deallocate( ncolumns, kcount )
deallocate( ltmpstring, lstring )
deallocate( pds_loc, pds_flag )
!---------------------------------------------------------------------------
! clean up CF
!---------------------------------------------------------------------------
call ESMF_ConfigDestroy(localcf, rc=localrc)
if( CheckError(checkpoint, __LINE__, __FILE__, localrc, "cannot destroy config file " // &
trim(adjustL(lfilename)), rcToReturn=rc) ) return
enddo ! file
!-----------------------------------------------------------------------------
! final deallocation
!-----------------------------------------------------------------------------
deallocate( nstrings )
!-----------------------------------------------------------------------------
! if I've gotten this far without an error, then the routine has succeeded.
!-----------------------------------------------------------------------------
rc = ESMF_SUCCESS
!-----------------------------------------------------------------------------
end subroutine read_descriptor_files