subroutine read_redistribution_grid(lfilename, ngrids, grid, tmp_grid, rc)
!-----------------------------------------------------------------------------
! routine to read the grid specifier file for a redistribution test. The
! routine reads the single grid specification needed by the redistribution
! test.
!
! the grid specification takes the form of a table with row entries
! (0) grid rank
! and (5 * grid rank) remaining entries consisting of cycles of
! (1) grid type
! (2) grid size
! (3) grid minimum range
! (4) grid maximum range
! (5) grid units
! Acceptable values for the units are: DEGREE(S), DEGREE(S)_EAST,
! DEGREE(S)_NORTH, DEG, DEG_E, DEG_N, RADIANS, RAD, METERS, M, KILOMETERS, KM.
!
! NOTES:
! Both the grid type and units should be enclosed by either single or double
! quotes to insure proper parsing by the ESMF_Config calls.
!
!-----------------------------------------------------------------------------
! arguments
character(THARN_MAXSTR), intent(in ) :: lfilename
type(grid_specification_record), pointer :: grid(:) ! source grid spec
type(grid_specification_record), pointer :: tmp_grid(:) ! duplicate copy of
! the grid specifier for
! the destination grid
integer, intent( out) :: ngrids
integer, intent(inout) :: rc
! local parameters
character(THARN_MAXSTR), parameter :: descriptor_label = "map_redist::"
! local esmf types
type(ESMF_Config) :: localcf
! local character strings
character(THARN_MAXSTR) :: ltmp, lchar
character(THARN_MAXSTR) :: gtype, gunits
logical :: flag
! local integer variables
integer :: ntmp, grank, gsize
integer :: irow, krow, nrows, igrid, ngrid, irank, kelements
integer, allocatable :: ncolumns(:), new_row(:)
integer :: localrc ! local error status
integer :: allocRcToTest
! local real variables
real(ESMF_KIND_R8) :: gmin, gmax
! initialize return flag
localrc = ESMF_RC_NOT_IMPL
rc = ESMF_RC_NOT_IMPL
!-----------------------------------------------------------------------------
! open the grid file
!-----------------------------------------------------------------------------
localcf = ESMF_ConfigCreate(rc=localrc)
if( ESMF_LogFoundError(localrc, msg="cannot create config object", &
rcToReturn=rc) ) return
call ESMF_ConfigLoadFile(localcf, trim( lfilename ), rc=localrc )
if( ESMF_LogFoundError(localrc, &
msg="cannot load config file " // trim( lfilename ), &
rcToReturn=rc) ) return
!-----------------------------------------------------------------------------
! extract the grid type specifier as sanity check
!-----------------------------------------------------------------------------
call ESMF_ConfigFindLabel(localcf, 'map_type:', rc=localrc )
if( ESMF_LogFoundError(localrc, &
msg="cannot find config label map_type", rcToReturn=rc) ) return
call ESMF_ConfigGetAttribute(localcf, ltmp, rc=localrc)
if( ESMF_LogFoundError(localrc, &
msg="cannot find config label map_type:", &
rcToReturn=rc) ) return
if( trim(adjustL( ltmp )) /= 'REDISTRIBUTION' ) then
call ESMF_LogSetError( &
ESMF_FAILURE, msg="Wrong grid type for redist test in file " // &
trim( lfilename ), rcToReturn=rc)
return
endif
!-----------------------------------------------------------------------------
! search for the grid specifier table
!-----------------------------------------------------------------------------
call ESMF_ConfigFindLabel(localcf, trim(descriptor_label), rc=localrc )
if (localrc .ne. ESMF_SUCCESS) print*,' find descriptor label failed'
if( ESMF_LogFoundError(localrc, &
msg="cannot find config label " // trim(descriptor_label), &
rcToReturn=rc) ) return
!-----------------------------------------------------------------------------
! determine the total number of table rows, continue only if not empty
! NOTE: the number of table rows >= number of grid entries due to the
! possibility of continued lines.
!-----------------------------------------------------------------------------
call ESMF_ConfigGetDim(localcf, nrows, ntmp, label=trim(descriptor_label), &
rc=localrc)
if( ESMF_LogFoundError(localrc, &
msg="cannot get descriptor table size in file " // trim(lfilename), &
rcToReturn=rc) ) return
if( nrows .le. 0 ) then
call ESMF_LogSetError( ESMF_FAILURE, &
msg="grid specifier table is empty in file " //trim(lfilename), &
rcToReturn=rc)
return
endif
!-----------------------------------------------------------------------------
! extract the table column lengths of this file
!-----------------------------------------------------------------------------
call ESMF_ConfigFindLabel(localcf, trim(descriptor_label), rc=localrc )
if( ESMF_LogFoundError(localrc, &
msg="cannot find config label " // trim(descriptor_label), &
rcToReturn=rc) ) return
allocate( ncolumns(nrows), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer array ncolumns in "// &
" read_redistribution_grid", rcToReturn=rc)) then
endif
do krow=1,nrows
call ESMF_ConfigNextLine(localcf, tableEnd=flag , rc=localrc)
if( ESMF_LogFoundError(localrc, &
msg="cannot advance to next line of table " // &
trim(descriptor_label) // " in file " // trim(lfilename), &
rcToReturn=rc) ) return
ncolumns(krow) = ESMF_ConfigGetLen(localcf, rc=localrc)
if (localrc .ne. ESMF_SUCCESS .or. ncolumns(krow) .lt. 6 ) then
write(lchar,"(i5)") krow
call ESMF_LogSetError( ESMF_FAILURE, &
msg="problem reading line " // trim(adjustl(lchar)) // &
" of table in file " // trim(lfilename), rcToReturn=rc)
return
endif
enddo ! end krow
!-----------------------------------------------------------------------------
! determine the actual number of grids specified in the file by counting
! lines not starting with the continuation symbol '&'. The number of actual
! grid specifications in the table is less than or equal to 'nrows' the number
! of rows in the table. A new grid entry in a particular row is indicated by
! a non-zero value in 'new_row'. A value of zero in the array indicates that
! that that row starts with a continiued line. The non-zero value indicates
! the number of the current grid being read.
!-----------------------------------------------------------------------------
call ESMF_ConfigFindLabel(localcf, trim(descriptor_label), rc=localrc )
if( ESMF_LogFoundError(localrc, &
msg="cannot find config label " // trim(descriptor_label), &
rcToReturn=rc) ) return
allocate( new_row(nrows), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer array new_row "// &
" in read_redistribution_grid", rcToReturn=rc)) then
endif
!-----------------------------------------------------------------------------
! count the number of actual grids (less than or equal to number of table rows)
!-----------------------------------------------------------------------------
ngrid = 0
do krow=1,nrows
call ESMF_ConfigNextLine(localcf, tableEnd=flag , rc=localrc)
call ESMF_ConfigGetAttribute(localcf, ltmp, rc=localrc)
if( trim(adjustL(ltmp)) == "&" ) then
! continuation line
new_row(krow) = 0
else
ngrid = ngrid + 1
new_row(krow) = ngrid
endif
enddo ! end krow
ngrids = ngrid
!-----------------------------------------------------------------------------
! allocate storage for the grid information, based on the calculated number of
! separate grid entries
!-----------------------------------------------------------------------------
allocate( grid(ngrid), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer array ncolumns in "// &
" read_redistribution_grid", rcToReturn=rc)) then
endif
allocate( tmp_grid(ngrid), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer array ncolumns in "// &
" read_redistribution_grid", rcToReturn=rc)) then
endif
!-----------------------------------------------------------------------------
! Read the grid specifications from the table:
! (1) start at the top of the table.
! (2) read the row elements until the end of the row is reached.
! (3) determine if all the elements are read;
! (a) if not advance to the next line and continue to read elements until
! the end of the line is reached - repeat (3)
! (b) if all the elements read, skip to next row and repeat (2)
!-----------------------------------------------------------------------------
call ESMF_ConfigFindLabel(localcf, trim(descriptor_label), rc=localrc )
if( ESMF_LogFoundError(localrc, &
msg="cannot find config label " // trim(descriptor_label), &
rcToReturn=rc) ) return
!-----------------------------------------------------------------------------
! move to the next line in the table and confirm that (1) the line doesn't
! start with a continuation symbol, and (2) that the line isn't empty.
!-----------------------------------------------------------------------------
igrid= 0
do krow=1,nrows
! drs debug print*,'krow',krow,' new row columns',new_row(krow),ncolumns(krow)
! new grid specification - not continuation symbol and not end of row
if( new_row(krow) /= 0 .and. ncolumns(krow) > 0 ) then
call ESMF_ConfigNextLine(localcf, tableEnd=flag , rc=localrc)
if (ESMF_LogFoundError(localrc, &
msg="unable to go to next line in table " // trim(descriptor_label), &
rcToReturn=rc)) return
! extract rank of current grid
call ESMF_ConfigGetAttribute(localcf, grank, rc=localrc)
if (ESMF_LogFoundError(localrc, msg="unable to get grank", &
rcToReturn=rc)) return
irank = 1 ! grid element being read (<= rank)
kelements = 1 ! row element just read
irow = krow
igrid = igrid +1 ! new grid description
if( igrid > ngrid ) then
call ESMF_LogSetError( ESMF_FAILURE, &
msg="attempting to access a higher index grid than exists.", &
rcToReturn=rc)
return
endif
! allocate workspace
grid(igrid)%grank = grank
allocate( grid(igrid)%gtype(grank), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="char array "// &
" gtype in read_redistribution_grid", rcToReturn=rc)) then
endif
allocate( grid(igrid)%gunits(grank), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="char array "// &
" gunits in read_redistribution_grid", rcToReturn=rc)) then
endif
allocate( grid(igrid)%gsize(grank), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer array "// &
" gsize in read_redistribution_grid", rcToReturn=rc)) then
endif
allocate( grid(igrid)%grange(grank,2), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="real array "// &
" grange in read_redistribution_grid", rcToReturn=rc)) then
endif
tmp_grid(igrid)%grank = grank
allocate( tmp_grid(igrid)%gtype(grank), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="char array "// &
" gtype in read_redistribution_grid", rcToReturn=rc)) then
endif
allocate( tmp_grid(igrid)%gunits(grank), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="char array "// &
" gunits in read_redistribution_grid", rcToReturn=rc)) then
endif
allocate( tmp_grid(igrid)%gsize(grank), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer array "// &
" gsize in read_redistribution_grid", rcToReturn=rc)) then
endif
allocate( tmp_grid(igrid)%grange(grank,2), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="real array "// &
" grange in read_redistribution_grid", rcToReturn=rc)) then
endif
! print*,'irow',irow
! read row elements until grid rank is reached
do while ( irank <= grank )
! print*,'irank/grank',irank,grank
! if haven't reached end of line, read grid type
call read_table_string(gtype, &
kelements, irow, nrows, ncolumns, new_row, &
lfilename, descriptor_label, localcf, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
rcToReturn=rc)) return
grid(igrid)%gtype(irank)%string = gtype
tmp_grid(igrid)%gtype(irank)%string = gtype
!--------------------------------------------------------------------
! read grid size
!--------------------------------------------------------------------
call read_table_integer(gsize, &
kelements, irow, nrows, ncolumns, new_row, &
lfilename, descriptor_label, localcf, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
rcToReturn=rc)) return
! sanity check - specification size of grid dimensions must be
! positive, but not huge.
if( (gsize <= 0).or.(gsize > Harness_Max_Size) ) then
localrc = ESMF_FAILURE
write(ltmp,"(i9)") gsize
call ESMF_LogSetError(ESMF_FAILURE,msg="grid specifier size "// &
"is not within acceptable range " // ltmp, &
rcToReturn=rc)
return
endif
grid(igrid)%gsize(irank) = gsize
tmp_grid(igrid)%gsize(irank) = gsize
!--------------------------------------------------------------------
! read minimum grid range
!--------------------------------------------------------------------
call read_table_real(gmin, &
kelements, irow, nrows, ncolumns, new_row, &
lfilename, descriptor_label, localcf, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
rcToReturn=rc)) return
grid(igrid)%grange(irank,1) = gmin
tmp_grid(igrid)%grange(irank,1) = gmin
!--------------------------------------------------------------------
! read maximum grid range
!--------------------------------------------------------------------
call read_table_real(gmax, &
kelements, irow, nrows, ncolumns, new_row, &
lfilename, descriptor_label, localcf, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
rcToReturn=rc)) return
grid(igrid)%grange(irank,2) = gmax
tmp_grid(igrid)%grange(irank,2) = gmax
!--------------------------------------------------------------------
! read grid units
!--------------------------------------------------------------------
call read_table_string(gunits, &
kelements, irow, nrows, ncolumns, new_row, &
lfilename, descriptor_label, localcf, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
rcToReturn=rc)) return
grid(igrid)%gunits(irank)%string = gunits
tmp_grid(igrid)%gunits(irank)%string = gunits
!--------------------------------------------------------------------
! increment grid rank and loop
!--------------------------------------------------------------------
irank = irank + 1
end do ! while
endif !
!--------------------------------------------------------------------------
! move to next row
!--------------------------------------------------------------------------
enddo ! end krow
!-----------------------------------------------------------------------------
! deallocate workspace
!-----------------------------------------------------------------------------
deallocate( ncolumns )
!-----------------------------------------------------------------------------
! clean up CF
!-----------------------------------------------------------------------------
call ESMF_ConfigDestroy(localcf, rc=localrc)
if( ESMF_LogFoundError(localrc, msg="cannot destroy config object", &
rcToReturn=rc) ) return
!-----------------------------------------------------------------------------
! set error code to SUCCESS
!-----------------------------------------------------------------------------
rc = ESMF_SUCCESS
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
end subroutine read_redistribution_grid