subroutine MAPL_VarSpecCreateInListNew(SPEC, SHORT_NAME, LONG_NAME, &
UNITS, Dims, VLocation, FIELD, BUNDLE, STATE, &
NUM_SUBTILES, &
STAT, ACCMLT_INTERVAL, COUPLE_INTERVAL, OFFSET, &
DEFAULT, FRIENDLYTO, &
HALOWIDTH, PRECISION, &
RESTART, &
ATTR_RNAMES, ATTR_INAMES, &
ATTR_RVALUES, ATTR_IVALUES, &
UNGRIDDED_DIMS, &
UNGRIDDED_UNIT, &
UNGRIDDED_NAME, &
UNGRIDDED_COORDS, &
FIELD_TYPE, &
STAGGERING, &
ROTATION, &
GRID, &
DEPENDS_ON, DEPENDS_ON_CHILDREN, &
POSITIVE, &
RC )
type (StateSpecification), intent(inout):: SPEC
character (len=*) , intent(IN) :: SHORT_NAME
character (len=*) , optional , intent(IN) :: LONG_NAME
character (len=*) , optional , intent(IN) :: UNITS
character (len=*) , optional , intent(IN) :: FRIENDLYTO
integer , optional , intent(IN) :: DIMS
integer , optional , intent(IN) :: VLOCATION
integer , optional , intent(IN) :: NUM_SUBTILES
integer , optional , intent(IN) :: ACCMLT_INTERVAL
integer , optional , intent(IN) :: COUPLE_INTERVAL
integer , optional , intent(IN) :: OFFSET
integer , optional , intent(IN) :: STAT
real , optional , intent(IN) :: DEFAULT
type(ESMF_Field) , optional , intent(IN), target :: FIELD
type(ESMF_FieldBundle) , optional , intent(IN), target :: BUNDLE
type(ESMF_State) , optional , intent(IN), target :: STATE
integer , optional , intent(IN) :: HALOWIDTH
integer , optional , intent(IN) :: PRECISION
integer , optional , intent(IN) :: RESTART
character (len=*) , optional , intent(IN) :: ATTR_INAMES(:)
character (len=*) , optional , intent(IN) :: ATTR_RNAMES(:)
integer , optional , intent(IN) :: ATTR_IVALUES(:)
real , optional , intent(IN) :: ATTR_RVALUES(:)
integer , optional , intent(IN) :: UNGRIDDED_DIMS(:)
character (len=*) , optional , intent(IN) :: UNGRIDDED_UNIT
character (len=*) , optional , intent(IN) :: UNGRIDDED_NAME
real , optional , intent(IN) :: UNGRIDDED_COORDS(:)
integer , optional , intent(IN) :: FIELD_TYPE
integer , optional , intent(IN) :: STAGGERING
integer , optional , intent(IN) :: ROTATION
type(ESMF_Grid) , optional , intent(IN) :: GRID
logical , optional , intent(IN) :: DEPENDS_ON_CHILDREN
character (len=*) , optional , intent(IN) :: DEPENDS_ON(:)
character(len=*) , optional , intent(IN) :: positive
integer , optional , intent(OUT) :: RC
integer :: STATUS
type (MAPL_VarSpec) :: TMP
integer :: usableDIMS
integer :: usableVLOC
integer :: usableACCMLT
integer :: usableCOUPLE
integer :: usableOFFSET
integer :: usableSTAT
integer :: usableNUM_SUBTILES
integer :: usableHALOWIDTH
integer :: usablePRECISION
integer :: usableFIELD_TYPE
integer :: usableSTAGGERING
integer :: usableROTATION
integer :: usableRESTART
character(len=ESMF_MAXSTR) :: usableLONG
character(len=ESMF_MAXSTR) :: usableUNIT
character(len=ESMF_MAXSTR) :: usableFRIENDLYTO
character(len=ESMF_MAXSTR), pointer :: usableATTR_INAMES(:) => NULL()
character(len=ESMF_MAXSTR), pointer :: usableATTR_RNAMES(:) => NULL()
integer , pointer :: usableATTR_IVALUES(:) => NULL()
real , pointer :: usableATTR_RVALUES(:) => NULL()
integer , pointer :: usableUNGRIDDED_DIMS(:) => null()
real :: usableDEFAULT
type(ESMF_Grid) :: usableGRID
type(ESMF_Field), pointer :: usableFIELD => null()
type(ESMF_FieldBundle), pointer :: usableBUNDLE => null()
type(ESMF_State), pointer :: usableSTATE => null()
character(len=ESMF_MAXSTR) :: useableUngrd_Unit
character(len=ESMF_MAXSTR) :: useableUngrd_Name
real , pointer :: usableUNGRIDDED_COORDS(:) => NULL()
logical :: usableDEPENDS_ON_CHILDREN
character(len=positive_length) :: usablePositive
! character (len=:), allocatable :: usableDEPENDS_ON(:)
INTEGER :: I
integer :: szINAMES, szRNAMES, szIVALUES, szRVALUES
integer :: szUNGRD
logical :: defaultProvided
if(present(STAT)) then
usableSTAT=STAT
else
usableSTAT=MAPL_FieldItem !ALT: not sure if needs special attn for bundles
endif
if(present(ACCMLT_INTERVAL)) then
usableACCMLT=ACCMLT_INTERVAL
else
usableACCMLT=0
endif
if(present(COUPLE_INTERVAL)) then
usableCOUPLE=COUPLE_INTERVAL
else
usableCOUPLE=0
endif
if(present(OFFSET)) then
usableOFFSET=OFFSET
else
usableOFFSET=0
endif
if(present(LONG_NAME)) then
usableLONG=LONG_NAME
else
usableLONG=SHORT_NAME
endif
if(present(UNITS)) then
usableUNIT=UNITS
else
usableUNIT=""
endif
if(present(FRIENDLYTO)) then
usableFRIENDLYTO=FRIENDLYTO
if (LEN(TRIM(FRIENDLYTO)) /= 0) then
usableSTAT = ior(usableSTAT,MAPL_FriendlyVariable)
end if
else
usableFRIENDLYTO=""
endif
if(present(DIMS)) then
usableDIMS=DIMS
else
usableDIMS=MAPL_DimsUnknown
endif
if(present(VLOCATION)) then
usableVLOC=VLOCATION
else
usableVLOC=MAPL_VLocationNone
endif
if(present(NUM_SUBTILES)) then
usableNUM_SUBTILES=NUM_SUBTILES
else
usableNUM_SUBTILES=0
endif
if(present(DEFAULT)) then
defaultProvided=.true.
usableDEFAULT=DEFAULT
else
defaultProvided=.false.
usableDEFAULT=0.0 ! ALT: this could be NaN
! usableDEFAULT=Z'7F800001' ! DSK: set to NaN, dies in FV Init
! usableDEFAULT=-999. ! DSK
endif
if (present(FIELD_TYPE)) then
usableFIELD_TYPE=FIELD_TYPE
else
usableFIELD_TYPE=MAPL_ScalarField
endif
if (present(STAGGERING)) then
usableSTAGGERING=STAGGERING
else
usableSTAGGERING=MAPL_AGrid
endif
if (present(ROTATION)) then
usableROTATION=ROTATION
else
usableROTATION=MAPL_RotateLL
endif
if(present(GRID)) then
usableGRID=GRID
else
! usableGRID = ESMF_GridEmptyCreate(RC=STATUS)
! _VERIFY(STATUS)
! call ESMF_GridDestroy(usableGRID) !ALT we do not need RC
! Initialize this grid object as invalid
usableGrid%this = ESMF_NULL_POINTER
endif
if(present(FIELD)) then
usableFIELD=>FIELD
else
allocate(usableFIELD, STAT=STATUS)
_VERIFY(STATUS)
! usableFIELD = ESMF_FieldEmptyCreate(NAME=SHORT_NAME,RC=STATUS)
! _VERIFY(STATUS)
! call ESMF_FieldDestroy(usableFIELD) !ALT we do not need RC
! Initialize this field object as invalid
usableField%ftypep => NULL()
endif
if(present(BUNDLE)) then
usableBUNDLE=>BUNDLE
else
allocate(usableBUNDLE, STAT=STATUS)
_VERIFY(STATUS)
! usableBUNDLE = ESMF_FieldBundleCreate(NAME=SHORT_NAME,RC=STATUS)
! _VERIFY(STATUS)
! call ESMF_FieldBundleDestroy(usableBUNDLE) !ALT we do not need RC
! Initialize this fieldBundle object as invalid
usableBundle%this => NULL()
endif
if(present(STATE)) then
usableSTATE=>STATE
else
allocate(usableSTATE, STAT=STATUS)
_VERIFY(STATUS)
! usableSTATE = ESMF_StateCreate(NAME=SHORT_NAME,RC=STATUS)
! _VERIFY(STATUS)
! call ESMF_StateDestroy(usableSTATE) !ALT we do not need RC
! Initialize this state object as invalid
usableState%statep => NULL()
endif
if(present(HALOWIDTH)) then
usableHALOWIDTH=HALOWIDTH
else
usableHALOWIDTH=0
endif
if(present(RESTART)) then
usableRESTART=RESTART
else
usableRESTART=MAPL_RestartOptional ! default
endif
if(present(PRECISION)) then
usablePRECISION=PRECISION
else
usablePRECISION=kind(0.0) ! default "real" kind
endif
usableDEPENDS_ON_CHILDREN = .false.
if(present(DEPENDS_ON_CHILDREN)) then
usableDEPENDS_ON_CHILDREN = DEPENDS_ON_CHILDREN
end if
! Sanity checks
if (usablePRECISION /= ESMF_KIND_R4 .AND. usablePRECISION /= ESMF_KIND_R8) then
! only those 2 values are allowed
_RETURN(ESMF_FAILURE)
end if
szRNAMES = 0
if (present(ATTR_RNAMES)) then
szRNAMES = size(ATTR_RNAMES)
allocate(usableATTR_RNAMES(szRNAMES), stat=status)
_VERIFY(STATUS)
usableATTR_RNAMES = ATTR_RNAMES
end if
szINAMES = 0
if (present(ATTR_INAMES)) then
szINAMES = size(ATTR_INAMES)
allocate(usableATTR_INAMES(szINAMES), stat=status)
_VERIFY(STATUS)
usableATTR_INAMES = ATTR_INAMES
end if
szRVALUES = 0
if (present(ATTR_RVALUES)) then
szRVALUES = size(ATTR_RVALUES)
allocate(usableATTR_RVALUES(szRVALUES), stat=status)
_VERIFY(STATUS)
usableATTR_RVALUES = ATTR_RVALUES
end if
szIVALUES = 0
if (present(ATTR_IVALUES)) then
szIVALUES = size(ATTR_INAMES)
allocate(usableATTR_IVALUES(szIVALUES), stat=status)
_VERIFY(STATUS)
usableATTR_IVALUES = ATTR_IVALUES
end if
_ASSERT(szIVALUES == szINAMES,'needs informative message')
_ASSERT(szRVALUES == szRNAMES,'needs informative message')
szUNGRD = 0
if (present(UNGRIDDED_DIMS)) then
szUNGRD = size(UNGRIDDED_DIMS)
allocate(usableUNGRIDDED_DIMS(szUNGRD), stat=status)
_VERIFY(STATUS)
usableUNGRIDDED_DIMS = UNGRIDDED_DIMS
else
NULLIFY(usableUNGRIDDED_DIMS)
end if
if (present(UNGRIDDED_UNIT)) then
useableUngrd_Unit = UNGRIDDED_UNIT
else
useableUngrd_Unit = "level" ! ALT: we are changing the default from "N/A" to "level" to make GrADS happy
end if
if (present(UNGRIDDED_NAME)) then
useableUngrd_NAME = UNGRIDDED_NAME
else
useableUngrd_NAME = "N/A"
end if
szUNGRD = 0
if (present(UNGRIDDED_COORDS)) then
szUNGRD = size(UNGRIDDED_COORDS)
allocate(usableUNGRIDDED_COORDS(szUNGRD), stat=status)
_VERIFY(STATUS)
usableUNGRIDDED_COORDS = UNGRIDDED_COORDS
end if
if (present(POSITIVE)) then
usablePositive = positive
else
usablePositive = 'down'
end if
I = spec%var_specs%size()
allocate(tmp%specptr)
TMP%SPECPTR%SHORT_NAME = SHORT_NAME
TMP%SPECPTR%LONG_NAME = usableLONG
TMP%SPECPTR%UNITS = usableUNIT
TMP%SPECPTR%DIMS = usableDIMS
TMP%SPECPTR%LOCATION = usableVLOC
TMP%SPECPTR%NUM_SUBTILES = usableNUM_SUBTILES
TMP%SPECPTR%STAT = usableSTAT
TMP%SPECPTR%ACCMLT_INTERVAL = usableACCMLT
TMP%SPECPTR%COUPLE_INTERVAL = usableCOUPLE
TMP%SPECPTR%OFFSET = usableOFFSET
TMP%SPECPTR%LABEL = 0
TMP%SPECPTR%DEFAULT = usableDEFAULT
TMP%SPECPTR%defaultProvided = defaultProvided
TMP%SPECPTR%FIELD => usableFIELD
TMP%SPECPTR%BUNDLE => usableBUNDLE
TMP%SPECPTR%STATE => usableSTATE
TMP%SPECPTR%GRID = usableGRID
TMP%SPECPTR%FRIENDLYTO = usableFRIENDLYTO
TMP%SPECPTR%HALOWIDTH = usableHALOWIDTH
TMP%SPECPTR%RESTART = usableRESTART
TMP%SPECPTR%PRECISION = usablePRECISION
TMP%SPECPTR%FIELD_TYPE = usableFIELD_TYPE
TMP%SPECPTR%UNGRIDDED_UNIT = useableUngrd_Unit
TMP%SPECPTR%UNGRIDDED_NAME = useableUngrd_Name
TMP%SPECPTR%STAGGERING = usableSTAGGERING
TMP%SPECPTR%ROTATION = usableROTATION
TMP%SPECPTR%doNotAllocate = .false.
TMP%SPECPTR%alwaysAllocate = .false.
TMP%SPECPTR%positive = usablePositive
if(associated(usableATTR_IVALUES)) then
TMP%SPECPTR%ATTR_IVALUES => usableATTR_IVALUES
else
NULLIFY(TMP%SPECPTR%ATTR_IVALUES)
endif
if(associated(usableATTR_RVALUES)) then
TMP%SPECPTR%ATTR_RVALUES => usableATTR_RVALUES
else
NULLIFY(TMP%SPECPTR%ATTR_RVALUES)
endif
if(associated(usableUNGRIDDED_DIMS)) then
TMP%SPECPTR%UNGRIDDED_DIMS => usableUNGRIDDED_DIMS
else
NULLIFY(TMP%SPECPTR%UNGRIDDED_DIMS)
endif
if(associated(usableUNGRIDDED_COORDS)) then
TMP%SPECPTR%UNGRIDDED_COORDS => usableUNGRIDDED_COORDS
else
NULLIFY(TMP%SPECPTR%UNGRIDDED_COORDS)
endif
if(associated(usableATTR_RNAMES)) then
TMP%SPECPTR%ATTR_RNAMES=> usableATTR_RNAMES
else
NULLIFY(TMP%SPECPTR%ATTR_RNAMES)
endif
if(associated(usableATTR_INAMES)) then
TMP%SPECPTR%ATTR_INAMES=> usableATTR_INAMES
else
NULLIFY(TMP%SPECPTR%ATTR_INAMES)
endif
if(present(DEPENDS_ON)) then
TMP%SPECPTR%DEPENDS_ON = DEPENDS_ON
end if
TMP%SPECPTR%DEPENDS_ON_CHILDREN = usableDEPENDS_ON_CHILDREN
call spec%var_specs%push_back(tmp)
call spec%update_legacy()
_RETURN(ESMF_SUCCESS)
end subroutine MAPL_VarSpecCreateInListNew