subroutine MAPL_CFIOCreateFromFile(MCFIO,bundlein,RegridMethod,hw,only_vars,rc)
type(MAPL_CFIO ), intent(INOUT) :: MCFIO
type(ESMF_FieldBundle), optional, intent(INOUT) :: BundleIn
integer, optional, intent(IN ) :: RegridMethod
integer, optional, intent(IN ) :: hw
character(len=*), optional, intent(IN ) :: only_vars
integer, optional, intent( OUT) :: RC
type(ESMF_CFIOGrid), pointer :: CFIOGRID => null()
type(ESMF_GRID) :: ESMFGRID
type(ESMF_CFIOGrid) :: varsGrid
type(ESMF_CFIOVarInfo), pointer :: VARS(:) => null()
type(ESMF_VM) :: vm
integer :: i,k,kv
integer :: im,jm,lm,nvars,fvars,bvars,img,jmg,lt,num2dvars,num3dvars
logical :: twoD,fillbundle
character(len=ESMF_MAXSTR) :: units,cfiovarname,long_name,bundlevarname,ctemp1,ctemp2
integer :: regridMethod_
integer, allocatable :: gridToFieldMap(:)
integer :: hw_, gridrank, dims(3), counts(3), halowidth(3)
real, pointer :: ptr2(:,:)
real, pointer :: ptr3(:,:,:)
type(ESMF_Field) :: field
integer :: status
logical :: found
logical :: isPresent
real, pointer :: lonsfile(:) => null()
real, pointer :: latsfile(:) => null()
real, pointer :: levsfile(:) => null()
type(ESMF_CFIO), pointer :: cfiop
type(CFIOCollection), pointer :: collection
call ESMF_VMGetCurrent(vm,rc=status)
_VERIFY(STATUS)
call ESMF_VMGet(vm,localPet=mcfio%myPE,rc=status)
_VERIFY(STATUS)
collection => collections%at(mcfio%collection_ID)
cfiop => collection%find(mcfio%fname, _RC)
call ESMF_CFIOGet (cfiop, grid=CFIOGRID, RC=STATUS)
_VERIFY(STATUS)
call ESMF_CFIOGridGet (CFIOGRID, IM=IM, JM=JM, KM=LM, RC=STATUS)
_VERIFY(STATUS)
call ESMF_CFIOGridGet (CFIOGRID, LON=LONSFILE, LAT=LATSFILE, RC=STATUS)
_VERIFY(STATUS)
deallocate(CFIOGRID)
call ESMF_CFIOGet (cfiop,varObjs=VARS, nVars=fVars, RC=STATUS)
_VERIFY(STATUS)
if (present(hw)) then
hw_=hw
else
hw_=0
end if
haloWidth = (/hw_,hw_,0/)
mcfio%kreverse = .false.
mcfio%xshift = .false.
if (JM /= 6*IM) then
mcfio%xshift = abs(LONSfile(1)+180._REAL64) .GT. abs(LONSfile(2)-LONSfile(1))
end if
call ESMF_FieldbundleGet(bundlein,grid=esmfgrid,rc=status)
_VERIFY(status)
call MAPL_GridGet(esmfgrid, globalCellCountPerDim=COUNTS, &
localCellCountPerDim=DIMS, RC=STATUS)
img=counts(1)
jmg=counts(2)
! Get the number of variables we will be reading
call ESMF_FieldBundleGet(bundlein,fieldCount=bvars,rc=status)
_VERIFY(status)
if (bvars>0) then
fillbundle=.false.
nvars=bvars
else
fillbundle=.true.
nvars=0
do i=1,fVars
if ( present(ONLY_VARS) ) then
if ( index(','//trim(ONLY_VARS) //',', &
','//trim(CFIOVARNAME)//',') < 1 ) cycle
endif
nvars=nvars+1
end do
end if
allocate(MCFIO%VarDims(NVars), stat=STATUS)
_VERIFY(STATUS)
allocate(MCFIO%VarName(NVars), stat=STATUS)
_VERIFY(STATUS)
allocate(MCFIO%VarID(NVars), stat=STATUS)
_VERIFY(STATUS)
if (.not.fillbundle) then
do i=1,nvars
call ESMF_FieldBundleGet(bundlein,i,field,rc=status)
_VERIFY(status)
call ESMF_FieldGet(field,name=bundlevarname,rc=status)
_VERIFY(status)
found=.false.
do k=1,fvars
call ESMF_CFIOVarInfoGet(VARS(K),vname=CFIOVARNAME,twoDimVar=twoD,RC=STATUS)
_VERIFY(STATUS)
ctemp1 = ESMF_UtilStringLowerCase(cfiovarname,rc=status)
_VERIFY(STATUS)
ctemp2 = ESMF_UtilStringLowerCase(bundlevarname,rc=status)
_VERIFY(STATUS)
if (trim(ctemp1)==trim(ctemp2)) then
found=.true.
kv=k
exit
endif
enddo
_ASSERT(found, 'search failed')
mcfio%varname(i)=bundleVarName
if (twoD) then
mcfio%vardims(i)=2
else
mcfio%vardims(i)=3
call ESMF_CFIOVarinfoGet(Vars(kv),grid=varsgrid,rc=status)
_VERIFY(STATUS)
call ESMF_CFIOGridGet (varsGrid, lev=levsfile, rc=status)
_VERIFY(STATUS)
if (levsfile(1) > levsfile(lm)) mcfio%kreverse = .true.
end if
status = nf90_inq_varid(cfiop%fid,cfiovarname,mcfio%varid(i))
_VERIFY(STATUS)
call ESMF_FieldGet(FIELD, Grid=ESMFGRID, RC=STATUS)
_VERIFY(STATUS)
call MAPL_GridGet(ESMFGRID, globalCellCountPerDim=COUNTS, RC=STATUS)
_VERIFY(STATUS)
_ASSERT( LM==0 .or. counts(3) == 0 .or. LM==counts(3) .or. lm == (counts(3)+1), 'incompatible file and bundle' )
enddo
else
nVars=0
do i=1,fvars
call ESMF_CFIOVarInfoGet(VARS(i),vname=CFIOVARNAME, vtitle=LONG_NAME, vunits=UNITS, twoDimVar=twoD, RC=STATUS)
_VERIFY(STATUS)
if ( present(ONLY_VARS) ) then
if ( index(','//trim(ONLY_VARS) //',', &
','//trim(CFIOVARNAME)//',') < 1 ) cycle
endif
nvars=nvars+1
MCFIO%VarName(nvars) = cfiovarname
if (twoD) then
MCFIO%VarDims(nvars) = 2
allocate(PTR2(1-hw_:DIMS(1)+hw_,1-hw_:DIMS(2)+hw_),stat=STATUS)
_VERIFY(STATUS)
PTR2 = 0.0
call ESMF_GridGet(esmfgrid, dimCount=gridRank, rc=status)
_VERIFY(STATUS)
allocate(gridToFieldMap(gridRank), stat=status)
_VERIFY(STATUS)
if(gridRank == 2) then
gridToFieldMap(1) = 1
gridToFieldMap(2) = 2
else if (gridRank == 3) then
gridToFieldMap(1) = 1
gridToFieldMap(2) = 2
gridToFieldMap(3) = 0
else
_RETURN(ESMF_FAILURE)
end if
FIELD = ESMF_FieldCreate(grid=esmfgrid, &
datacopyFlag = ESMF_DATACOPY_REFERENCE, &
farrayPtr=PTR2, gridToFieldMap=gridToFieldMap, &
name=CFIOVARNAME, &
totalLWidth=haloWidth(1:2), &
totalUWidth=haloWidth(1:2), &
rc = status)
_VERIFY(STATUS)
deallocate(gridToFieldMap)
call ESMF_AttributeSet(FIELD, NAME='LONG_NAME', VALUE=LONG_NAME, RC=STATUS)
_VERIFY(STATUS)
call ESMF_AttributeSet(FIELD, NAME='UNITS', VALUE=UNITS, RC=STATUS)
_VERIFY(STATUS)
call ESMF_AttributeSet(FIELD, NAME='DIMS', VALUE=MAPL_DimsHorzOnly, RC=STATUS)
_VERIFY(STATUS)
call ESMF_AttributeSet(FIELD, NAME='VLOCATION', &
VALUE=MAPL_VLocationNone, RC=STATUS)
_VERIFY(STATUS)
else
call ESMF_CFIOVarinfoGet(Vars(i),grid=varsgrid,rc=status)
_VERIFY(STATUS)
call ESMF_CFIOGridGet (varsGrid, lev=levsfile, rc=status)
_VERIFY(STATUS)
if (levsfile(1) > levsfile(lm)) mcfio%kreverse = .true.
MCFIO%VarDims(nvars) = 3
if (lm == counts(3)) then
allocate(PTR3(1-hw_:DIMS(1)+hw_,1-hw_:DIMS(2)+hw_,LM),stat=STATUS)
_VERIFY(STATUS)
else if (lm == (counts(3)+1)) then
allocate(PTR3(1-hw_:DIMS(1)+hw_,1-hw_:DIMS(2)+hw_,0:LM-1),stat=STATUS)
_VERIFY(STATUS)
endif
PTR3 = 0.0
FIELD = ESMF_FieldCreate(grid=esmfgrid, &
datacopyFlag = ESMF_DATACOPY_REFERENCE, &
farrayPtr=PTR3, name=CFIOVARNAME, &
totalLWidth=haloWidth(1:2), &
totalUWidth=haloWidth(1:2), &
rc = status)
_VERIFY(STATUS)
!ALT: for now we add only HorzVert (no tiles)
call ESMF_AttributeSet(FIELD, NAME='LONG_NAME', VALUE=LONG_NAME, RC=STATUS)
_VERIFY(STATUS)
call ESMF_AttributeSet(FIELD, NAME='UNITS', VALUE=UNITS, RC=STATUS)
_VERIFY(STATUS)
call ESMF_AttributeSet(FIELD, NAME='DIMS', VALUE=MAPL_DimsHorzVert, RC=STATUS)
_VERIFY(STATUS)
if (lm == counts(3)) then
call ESMF_AttributeSet(FIELD, NAME='VLOCATION', &
VALUE=MAPL_VLocationCenter, RC=STATUS)
else if (lm == (counts(3)+1)) then
call ESMF_AttributeSet(FIELD, NAME='VLOCATION', &
VALUE=MAPL_VLocationEdge, RC=STATUS)
end if
_VERIFY(STATUS)
end if
call MAPL_FieldBundleAdd(bundlein,field,rc=status)
_VERIFY(STATUS)
status = nf90_inq_varid(cfiop%fid,cfiovarname,mcfio%varid(i))
_VERIFY(STATUS)
enddo
end if
! Fill in MCFIO object
mcfio%grid = esmfgrid
mcfio%bundle = bundlein
mcfio%im = im
mcfio%jm = jm
mcfio%lm = lm
Num2DVars = count(MCFIO%VarDims==2)
Num3DVars = count(MCFIO%VarDims==3)
LT = Num2DVars + Num3DVars*LM
allocate( MCFIO%reqs (LT),stat=STATUS)
_VERIFY(STATUS)
allocate( MCFIO%Krank(LT),stat=STATUS)
_VERIFY(STATUS)
mcfio%krank = -1
allocate( MCFIO%pairList(LT),stat=STATUS)
_VERIFY(STATUS)
if (present(regridmethod)) then
regridmethod_=regridmethod
else
regridmethod_=REGRID_METHOD_BILINEAR
endif
mcfio%regrid_type=-1
if ( (img /= im .or. jmg /= jm) .and. (regridMethod_ /= -1) ) then
if (regridmethod_==REGRID_METHOD_VOTE .or. regridmethod_==REGRID_METHOD_CONSERVE .or. regridmethod_==REGRID_METHOD_FRACTION) then
mcfio%regridConservative = .true.
mcfio%regridder => make_regridder(esmfgrid,regridMethod_,lonsfile,latsfile,im,jm,counts(3),.false.,localTiles=.false.,rc=status)
_VERIFY(status)
else if (regridmethod_==REGRID_METHOD_BILINEAR) then
mcfio%regridder => make_regridder(ESMFGRID, regridMethod_, LONSfile, LATSfile, IM, JM, counts(3), .false., rc=status)
_VERIFY(status)
end if
mcfio%regrid_type=regridmethod_
end if
!check for vector pairs, right now limit to 1
block
character(len=ESMF_MAXSTR) :: vectorlist(2)
logical :: found
integer :: j
integer :: rotation,gridstagger,rotation1,rotation2,gridStagger1,gridStagger2
type(ESMF_Field) :: field1,field2
allocate(mCFIO%needVar(size(mCFIO%varname)),stat=status)
_VERIFY(status)
mCFIO%needVar=0
call ESMF_AttributeGet(bundlein,name="VectorList:",isPresent=isPresent,rc=status)
_VERIFY(STATUS)
if (isPresent) then
call ESMF_AttributeGet(bundlein,name="VectorList:",valuelist=vectorlist,rc=status)
_VERIFY(STATUS)
do i=1,size(mCFIO%varname)
if (mCFIO%varname(i) == vectorList(1)) then
found=.false.
do j=1,size(mCFIO%varname)
if (trim(mCFIO%varName(J)) == vectorlist(2)) then
found = .true.
exit
end if
end do
_ASSERT(found, 'search failed')
mCFIO%needvar(i)=j
else if (mCFIO%varname(i) == vectorList(2)) then
found=.false.
do j=1,size(mCFIO%varname)
if (trim(mCFIO%varName(J)) == vectorlist(1)) then
found = .true.
exit
end if
end do
_ASSERT(found, 'search failed')
mCFIO%needvar(i)=-j
end if
end do
call ESMF_FieldBundleGet(MCFIO%BUNDLE, trim(vectorList(1)), field=FIELD1,RC=STATUS)
_VERIFY(STATUS)
call ESMF_FieldBundleGet(MCFIO%BUNDLE, trim(vectorList(2)), field=FIELD2,RC=STATUS)
_VERIFY(STATUS)
mCFIO%doRotate=.false.
call ESMF_AttributeGet(field1,name='ROTATION',value=rotation1,rc=status)
call ESMF_AttributeGet(field1,name='STAGGERING',value=gridStagger1,rc=status)
call ESMF_AttributeGet(field2,name='ROTATION',value=rotation2,rc=status)
call ESMF_AttributeGet(field2,name='STAGGERING',value=gridStagger2,rc=status)
_ASSERT(rotation1==rotation2,'rotation does not match')
_ASSERT(gridStagger1==gridStagger2,'stagger does not match')
rotation=rotation1
gridStagger=gridStagger1
if (gridStagger == MAPL_AGrid) then
if (rotation == MAPL_RotateLL) then
mCFIO%doRotate = .false.
else if (rotation == MAPL_RotateCube) then
mCFIO%doRotate = .true.
end if
else if (gridStagger == MAPL_DGrid) then
if (rotation /= MAPL_RotateCube) then
_FAIL('must rotate LL')
else
mCFIO%doRotate = .false.
end if
else if (gridStagger == MAPL_CGrid) then
if (rotation /= MAPL_RotateCube) then
_FAIL('must rotate LL')
else
mCFIO%doRotate = .false.
end if
end if
end if
end block
!@ call ESMF_CFIOVarInfoDestroy(vars, _RC)
deallocate(vars)
deallocate(LONSfile,LATSfile)
if (associated(levsfile)) then
deallocate(levsfile)
nullify(levsfile)
end if
mCFIO%PartSize=-1
mCFIO%root=-1
_RETURN(ESMF_SUCCESS)
end subroutine MAPL_CFIOCreateFromFile