ReadMosaicField Subroutine

public subroutine ReadMosaicField(field, inputfile, mosaic, rank, dims, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_Field), intent(in) :: field
character(len=*), intent(in) :: inputfile
type(ESMF_Mosaic), intent(in) :: mosaic
integer, intent(in) :: rank
integer, intent(in) :: dims(:)
integer, intent(out), optional :: rc

Source Code

subroutine ReadMosaicField(field, inputfile, mosaic, rank, dims, rc)

   type(ESMF_Field), intent(in)   :: field
   character(*), intent(in)       :: inputfile
   type(ESMF_Mosaic), intent(in)  :: mosaic
   integer, intent(in)            :: rank
   integer,  intent(in)           :: dims(:)
   integer, optional, intent(out) :: rc

   ! -- local variables
    integer :: localrc
    integer :: localDe, localDeCount
    integer :: de, deCount, dimCount, tile, tileCount
    integer, dimension(:), allocatable :: deToTileMap, localDeToDeMap
    integer, dimension(:,:), allocatable :: minIndexPDe, maxIndexPDe
    integer, dimension(:,:), allocatable :: minIndexPTile, maxIndexPTile
    type(ESMF_Grid)     :: grid
    type(ESMF_DistGrid) :: distgrid
    type(ESMF_Array) :: array
    type(ESMF_VM) :: vm
    integer       :: PetNo
    type(ESMF_StaggerLoc)         :: staggerloc
    character(len=ESMF_MAXPATHLEN):: fileName
    character(len=MAXNAMELEN):: fieldName
    real(ESMF_KIND_R8), pointer   :: fptr2d(:,:), fptr3d(:,:,:), fptr4d(:,:,:,:)
    integer :: start2(2), count2(2), start3(3), count3(3), start4(4), count4(4)
    integer :: lncid, varId, ncStatus

#ifdef ESMF_NETCDF
    rc = ESMF_FAILURE

     call ESMF_VMGetCurrent(vm, rc=localrc)
     if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out
     call ESMF_VMGet(vm, localPet = PetNo, rc=localrc)
     if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out
     call ESMF_FieldGet(field, grid=grid, &
        staggerloc=staggerloc, localDeCount=localDeCount, rc=localrc)

     if (localDeCount == 0) then
        rc = ESMF_SUCCESS
        return
     endif
       ! -- get domain decomposition
      call ESMF_GridGet(grid, staggerloc, distgrid=distgrid, rc=localrc)
      if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      call ESMF_DistGridGet(distgrid, deCount=deCount, dimCount=dimCount, &
        tileCount=tileCount, rc=localrc)
      if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      allocate(minIndexPDe(dimCount, deCount), maxIndexPDe(dimCount, deCount),  &
        minIndexPTile(dimCount, tileCount), maxIndexPTile(dimCount, tileCount), &
        deToTileMap(deCount), localDeToDeMap(localDeCount), stat=localrc)
      if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      call ESMF_DistGridGet(distgrid, &
        minIndexPDe=minIndexPDe, maxIndexPDe=maxIndexPDe, &
        minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, &
        rc=localrc)
      if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      call ESMF_FieldGet(field, name = fieldName, array=array, rc=localrc)
      if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
           ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      call ESMF_ArrayGet(array, deToTileMap=deToTileMap, &
        localDeToDeMap=localDeToDeMap, rc=localrc)
      if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      do localDe = 0, localDeCount-1
        de   = localDeToDeMap(localDe+1) + 1
        tile = deToTileMap(de)

        filename = trim(mosaic%tileDirectory)//trim(inputfile)//"."//trim(mosaic%tilenames(tile))//".nc"

        ncStatus = nf90_open(path=trim(fileName), mode=NF90_NOWRITE, ncid=lncid)
        if (ESMF_LogFoundNetCDFError(ncerrToCheck=ncStatus, &
             msg="Error opening file "//trim(fileName), &
             ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

         ncStatus = nf90_inq_varid(lncid, trim(fieldName), varId)
         if (ESMF_LogFoundNetCDFError(ncerrToCheck=ncStatus, &
              msg="Error inquiring variable "//trim(fieldName)//" in "//trim(fileName), &
              ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

        if (rank==2) then
             start2(:)=minIndexPDe(:,de)
             count2(:)=maxIndexPDe(:,de)-minIndexPDe(:,de)+1
             call ESMF_FieldGet(field, localDe=localDe, farrayPtr=fptr2d, &
                      rc=localrc)
!                      exclusiveLBound=elb, exclusiveUBound=eub, rc=localrc)
             ncStatus = nf90_get_var(lncid, varId, fptr2d, start=start2, count=count2)
             if (ESMF_LogFoundNetCDFError(ncerrToCheck=ncStatus, &
                 msg="Error reading "//trim(fieldName)//" in "//trim(fileName), &
                 ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out
        elseif (rank==3) then
             start3(1:2)=minIndexPDe(:,de)
             count3(1:2)=maxIndexPDe(:,de)-minIndexPDe(:,de)+1
             start3(3) = 1
             count3(3) = dims(3)
              call ESMF_FieldGet(field, localDe=localDe, farrayPtr=fptr3d, &
                      rc=localrc)
!                      exclusiveLBound=elb, exclusiveUBound=eub, rc=localrc)
             ncStatus = nf90_get_var(lncid, varId, fptr3d, start=start3, count=count3)
             if (ESMF_LogFoundNetCDFError(ncerrToCheck=ncStatus, &
                 msg="Error reading "//trim(fieldName)//" in "//trim(fileName), &
                 ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out
        elseif (rank==4) then
             start4(1:2)=minIndexPDe(:,de)
             count4(1:2)=maxIndexPDe(:,de)-minIndexPDe(:,de)+1
             start4(3:4) = 1
             count4(3:4) = dims(3:4)
              call ESMF_FieldGet(field, localDe=localDe, farrayPtr=fptr4d, &
                      rc=localrc)
!                      exclusiveLBound=elb, exclusiveUBound=eub, rc=localrc)
             ncStatus = nf90_get_var(lncid, varId, fptr4d, start=start4, count=count4)
             if (ESMF_LogFoundNetCDFError(ncerrToCheck=ncStatus, &
                 msg="Error reading "//trim(fieldName)//" in "//trim(fileName), &
                 ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out
         endif
      enddo
        
      ncStatus = nf90_close(lncid)
      if (ESMF_LogFoundNetCDFError(ncerrToCheck=ncStatus, &
        msg="Error closing NetCDF data set", &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out
      
      rc=ESMF_SUCCESS
      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 ReadMosaicField