subroutine ESMF_GridspecReadTile(filename, nx, ny, centerLon, centerLat, cornerLon, cornerLat, start, count, rc)
! !ARGUMENTS:
character(len=*), intent(in) :: filename
integer, intent(in) :: nx, ny
real(ESMF_KIND_R8), pointer :: centerLon(:,:)
real(ESMF_KIND_R8), pointer :: centerLat(:,:)
real(ESMF_KIND_R8), optional, pointer :: cornerLon(:,:)
real(ESMF_KIND_R8), optional, pointer :: cornerLat(:,:)
integer, optional, intent(in) :: start(2)
integer, optional, intent(in) :: count(2)
integer, optional, intent(out) :: rc
!EOPI
integer :: ncid, nvars, attlen, i
integer :: nx1, ny1
integer :: ncStatus
integer :: ndims, dimids(2)
character(len=128) :: attstr
integer :: start1(2), count1(2)
real(ESMF_KIND_R8), allocatable :: supercoord(:,:)
integer :: localrc
logical :: foundit
if (present(rc)) rc=ESMF_SUCCESS
call ESMF_VMGetCurrent(vm, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! set up local pet info
call ESMF_VMGet(vm, localPet=PetNo, petCount=PetCnt, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
#ifdef ESMF_NETCDF
foundit = .false.
ncStatus = nf90_open(path=filename, mode=nf90_nowrite, ncid=ncid)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE, &
filename, &
rc)) return
ncStatus = nf90_inquire(ncid, nVariables=nvars)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE, &
filename, &
rc)) return
do i=1,nvars
! Check its standard_name attribute
ncStatus = nf90_inquire_attribute(ncid, i, 'standard_name', len=attlen)
if (ncStatus == nf90_noerr) then
ncStatus = nf90_get_att(ncid, i, 'standard_name', values=attstr)
if (attstr(1:attlen) .eq. 'grid_tile_spec') then
! skip checking the attributes -- not sure which one should be set to what
! but makesure this dummy variable exists
foundit = .true.
#if 0
! check the projection attribute
ncStatus = nf90_inquire_attribute(ncid, i, 'projection', len=attlen)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE, &
"projection attribute does not exist", &
rc)) return
ncStatus = nf90_get_att(ncid, i, 'projection', values=attstr)
if (attstr(1:attlen) .ne. 'cube_gnomonic') then
call ESMF_LogSetError(rcToCheck=ESMF_FAILURE, &
msg="- Only Cube Gnomonic projection is currently supported", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
#endif
elseif (attstr(1:attlen) .eq. 'geographic_longitude' .or. &
attstr(1:attlen) .eq. 'geographic_latitude') then
! read the longitude or latitude variable
! First find the dimension of this variable
ncStatus = nf90_inquire_variable(ncid, i, ndims=ndims, dimids=dimids)
if (ndims /= 2) then
call ESMF_LogSetError(rcToCheck=ESMF_FAILURE, &
msg="- The longitude variable should have dimension 2", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! find out the dimenison size
ncStatus = nf90_inquire_dimension(ncid, dimids(1), len=nx1)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE, &
"contact dimension inquire", &
rc)) return
ncStatus = nf90_inquire_dimension(ncid, dimids(2), len=ny1)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE, &
"contact dimension inquire", &
rc)) return
if (nx1 /= (nx*2+1)) then
call ESMF_LogSetError(rcToCheck=ESMF_FAILURE, &
msg="- The x dimension of the tile does not match with the supergrid dimension", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (ny1 /= (ny*2+1)) then
call ESMF_LogSetError(rcToCheck=ESMF_FAILURE, &
msg="- The y dimension of the tile does not match with the supergrid dimension", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(start) .and. present(count)) then
! read a block instead of the entire array
count1=count*2+1
start1=start*2-1
if (.not. allocated(supercoord)) then
allocate(supercoord(count1(1), count1(2)))
endif
ncStatus = nf90_get_var(ncid, i, supercoord, start=start1, count=count1)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE, &
"error reading geographic longitude coordinates", &
rc)) return
! copy to the corner and center lat/lon arrays
if (attstr(1:attlen) .eq. 'geographic_latitude') then
if (present(cornerLat)) then
cornerLat=supercoord(1:count1(1):2, 1:count1(2):2)
endif
centerLat=supercoord(2:count1(1):2, 2:count1(2):2)
else
if (present(cornerLon)) then
cornerLon=supercoord(1:count1(1):2, 1:count1(2):2)
endif
centerLon=supercoord(2:count1(1):2, 2:count1(2):2)
endif
else
if (.not. allocated(supercoord)) then
allocate(supercoord(nx1, ny1))
endif
ncStatus = nf90_get_var(ncid, i, supercoord)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE, &
"error reading geographic longitude coordinates", &
rc)) return
! copy to the corner and center lat/lon arrays
if (attstr(1:attlen) .eq. 'geographic_latitude') then
if (present(cornerLat)) then
cornerLat=supercoord(1:nx1:2, 1:ny1:2)
endif
centerLat=supercoord(2:nx1:2, 2:ny1:2)
else
if (present(cornerLon)) then
cornerLon=supercoord(1:nx1:2, 1:ny1:2)
endif
centerLon=supercoord(2:nx1:2, 2:ny1:2)
endif
endif
endif
endif
enddo
ncStatus = nf90_close(ncid)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE, &
"close tile file", &
rc)) return
if (.not. foundit .and. present(rc)) rc=ESMF_FAILURE
return
#else
call ESMF_LogSetError(ESMF_RC_LIB_NOT_PRESENT, &
msg="- ESMF_NETCDF not defined when lib was compiled", &
ESMF_CONTEXT, rcToReturn=rc)
return
#endif
end subroutine ESMF_GridspecReadTile