subroutine IONCCreate(IOComp, fileName, keywordEnforcer, filePath, &
fieldList, localDe, rc)
type(ESMF_GridComp), intent(inout) :: IOComp
character(len=*), intent(in) :: fileName
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
character(len=*), intent(in), optional :: filePath
type(ESMF_Field), intent(in), optional :: fieldList(:)
integer, intent(in), optional :: localDe
integer, intent(out), optional :: rc
! -- local variables
integer :: localrc
integer :: dimCount, item, sloc
integer :: ncid, ncStatus, varId, xtype
integer :: de, dimLen, tile, staggerlocCount, tileCount
character(len=ESMF_MAXSTR) :: dimName, fieldName
character(len=ESMF_MAXPATHLEN) :: fullName
logical, dimension(:), allocatable :: staggerlocList
integer, dimension(:,:), allocatable :: dimIds
integer, dimension(:,:), allocatable :: minIndexPTile, maxIndexPTile
type(ioWrapper) :: is
type(ESMF_Grid) :: grid
type(ESMF_DistGrid) :: distgrid
type(ESMF_StaggerLoc) :: staggerloc
type(ESMF_TypeKind_Flag) :: typekind
! -- begin
if (present(rc)) rc = ESMF_SUCCESS
if (.not.ESMF_GridCompIsPetLocal(IOComp)) return
#ifdef ESMF_NETCDF
de = 0
if (present(localDe)) de = localDe
call ESMF_GridCompGetInternalState(IOComp, is, localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
if (.not.is % IO % IOLayout(de) % localIOflag) return
call ESMF_GridCompGet(IOComp, grid=grid, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
call ESMF_GridGet(grid, dimCount=dimCount, &
staggerlocCount=staggerlocCount, tileCount=tileCount, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
if (tileCount > 1) then
call IOFilenameGet(fullName, fileName, filePath=filePath, &
tile=is % IO % IOLayout(de) % tile)
else
call IOFilenameGet(fullName, fileName, filePath=filePath)
end if
! -- collect staggerloc values
allocate(staggerlocList(0:staggerlocCount-1), stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
staggerlocList = .false.
if (present(fieldList)) then
do item = 1, size(fieldList)
call ESMF_FieldGet(fieldList(item), staggerloc=staggerloc, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
staggerlocList(staggerloc % staggerloc) = .true.
end do
else
! -- set default staggerloc as ESMF_STAGGERLOC_CENTER
staggerlocList(ESMF_STAGGERLOC_CENTER % staggerloc) = .true.
end if
ncStatus = nf90_create(trim(fullName), NF90_CLOBBER, ncid)
if (ESMF_LogFoundNetCDFError(ncerrToCheck=ncStatus, &
msg="Error opening NetCDF data set: "//trim(fullName), &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
allocate(dimIds(dimCount, 0:staggerlocCount-1), stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, &
msg="Unable to allocate internal memory for IOCreate", &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
! -- define dimensions
dimIds = 0
do sloc = 0, staggerlocCount-1
if (staggerlocList(sloc)) then
call ESMF_GridGet(grid, staggerloc=ESMF_StaggerLoc(sloc), &
distgrid=distgrid, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
call ESMF_DistgridGet(distgrid, dimCount=dimCount, &
tileCount=tileCount, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
allocate(minIndexPTile(dimCount, tileCount), &
maxIndexPTile(dimCount, tileCount), stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, &
maxIndexPTile=maxIndexPTile, rc=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
do item = 1, dimCount
tile = is % IO % IOLayout(de) % tile
dimLen = maxIndexPTile(item, tile) - minIndexPTile(item, tile) + 1
dimName = ""
write(dimName, '("x",2i0)') sloc, item
ncStatus = nf90_def_dim(ncid, trim(dimName), dimLen, dimIds(item,sloc))
if (ESMF_LogFoundNetCDFError(ncerrToCheck=ncStatus, &
msg="Error defining dimension "//trim(dimName), &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
end do
deallocate(minIndexPTile, maxIndexPTile, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
end if
end do
deallocate(staggerlocList, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
! -- define Field variables
if (present(fieldList)) then
do item = 1, size(fieldList)
call ESMF_FieldGet(fieldList(item), name=fieldName, &
staggerloc=staggerloc, typekind=typekind, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
if (typekind == ESMF_TYPEKIND_I4) then
xtype = NF90_INT
else if (typekind == ESMF_TYPEKIND_R4) then
xtype = NF90_FLOAT
else if (typekind == ESMF_TYPEKIND_R8) then
xtype = NF90_DOUBLE
else
call ESMF_LogSetError(ESMF_RC_NOT_IMPL, &
msg="Field: "//trim(fieldName)//" - typekind not supported", &
ESMF_CONTEXT, rcToReturn=rc)
return ! bail out
end if
ncStatus = nf90_def_var(ncid, trim(fieldName), xtype, &
dimIds(:, staggerloc % staggerloc), varId)
if (ESMF_LogFoundNetCDFError(ncerrToCheck=ncStatus, &
msg="Error defining NetCDF variable: "//trim(fieldName), &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
end do
end if
ncStatus = nf90_enddef(ncid)
if (ESMF_LogFoundNetCDFError(ncerrToCheck=ncStatus, &
msg="Error defining NetCDF data set: "//trim(fullName), &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
deallocate(dimIds, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, &
msg="Unable to deallocate internal memory for IONCCreate", &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
is % IO % IOLayout(de) % ncid = ncid
#else
call ESMF_LogSetError(rcToCheck=ESMF_RC_LIB_NOT_PRESENT, &
msg="- ESMF_NETCDF not defined when lib was compiled", &
ESMF_CONTEXT, rcToReturn=rc)
#endif
end subroutine IONCCreate