subroutine MAPL_VarSpecCreateInList(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, &
RC )
type (MAPL_VarSpec ), pointer :: 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
integer , optional , intent(OUT) :: RC
integer :: STATUS
type (MAPL_VarSpec ), pointer :: TMP(:) => null()
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()
INTEGER :: I
integer :: szINAMES, szRNAMES, szIVALUES, szRVALUES
integer :: szUNGRD
logical :: defaultProvided
if(associated(SPEC)) then
if(MAPL_VarSpecGetIndex(SPEC, SHORT_NAME)/=-1) then
_RETURN(ESMF_FAILURE)
endif
else
allocate(SPEC(0),stat=STATUS)
_VERIFY(STATUS)
endif
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
! 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
I = size(SPEC)
allocate(TMP(I+1),stat=STATUS)
_VERIFY(STATUS)
TMP(1:I) = SPEC
deallocate(SPEC)
allocate(TMP(I+1)%SPECPtr,stat=STATUS)
_VERIFY(STATUS)
TMP(I+1)%SPECPtr%SHORT_NAME = SHORT_NAME
TMP(I+1)%SPECPtr%LONG_NAME = usableLONG
TMP(I+1)%SPECPtr%UNITS = usableUNIT
TMP(I+1)%SPECPtr%DIMS = usableDIMS
TMP(I+1)%SPECPtr%LOCATION = usableVLOC
TMP(I+1)%SPECPtr%NUM_SUBTILES = usableNUM_SUBTILES
TMP(I+1)%SPECPtr%STAT = usableSTAT
TMP(I+1)%SPECPtr%ACCMLT_INTERVAL = usableACCMLT
TMP(I+1)%SPECPtr%COUPLE_INTERVAL = usableCOUPLE
TMP(I+1)%SPECPtr%OFFSET = usableOFFSET
TMP(I+1)%SPECPtr%LABEL = 0
TMP(I+1)%SPECPtr%DEFAULT = usableDEFAULT
TMP(I+1)%SPECPtr%defaultProvided = defaultProvided
TMP(I+1)%SPECPtr%FIELD => usableFIELD
TMP(I+1)%SPECPtr%BUNDLE => usableBUNDLE
TMP(I+1)%SPECPtr%STATE => usableSTATE
TMP(I+1)%SPECPtr%GRID = usableGRID
TMP(I+1)%SPECPtr%FRIENDLYTO = usableFRIENDLYTO
TMP(I+1)%SPECPtr%HALOWIDTH = usableHALOWIDTH
TMP(I+1)%SPECPtr%RESTART = usableRESTART
TMP(I+1)%SPECPtr%PRECISION = usablePRECISION
TMP(I+1)%SPECPtr%FIELD_TYPE = usableFIELD_TYPE
TMP(I+1)%SPECPtr%UNGRIDDED_UNIT = useableUngrd_Unit
TMP(I+1)%SPECPtr%UNGRIDDED_NAME = useableUngrd_Name
TMP(I+1)%SPECPtr%STAGGERING = usableSTAGGERING
TMP(I+1)%SPECPtr%ROTATION = usableROTATION
TMP(I+1)%SPECPtr%doNotAllocate = .false.
TMP(I+1)%SPECPtr%alwaysAllocate = .false.
if(associated(usableATTR_IVALUES)) then
TMP(I+1)%SPECPtr%ATTR_IVALUES => usableATTR_IVALUES
else
NULLIFY(TMP(I+1)%SPECPtr%ATTR_IVALUES)
endif
if(associated(usableATTR_RVALUES)) then
TMP(I+1)%SPECPtr%ATTR_RVALUES => usableATTR_RVALUES
else
NULLIFY(TMP(I+1)%SPECPtr%ATTR_RVALUES)
endif
if(associated(usableUNGRIDDED_DIMS)) then
TMP(I+1)%SPECPtr%UNGRIDDED_DIMS => usableUNGRIDDED_DIMS
else
NULLIFY(TMP(I+1)%SPECPtr%UNGRIDDED_DIMS)
endif
if(associated(usableUNGRIDDED_COORDS)) then
TMP(I+1)%SPECPtr%UNGRIDDED_COORDS => usableUNGRIDDED_COORDS
else
NULLIFY(TMP(I+1)%SPECPtr%UNGRIDDED_COORDS)
endif
if(associated(usableATTR_RNAMES)) then
TMP(I+1)%SPECPtr%ATTR_RNAMES=> usableATTR_RNAMES
else
NULLIFY(TMP(I+1)%SPECPtr%ATTR_RNAMES)
endif
if(associated(usableATTR_INAMES)) then
TMP(I+1)%SPECPtr%ATTR_INAMES=> usableATTR_INAMES
else
NULLIFY(TMP(I+1)%SPECPtr%ATTR_INAMES)
endif
SPEC => TMP
_RETURN(ESMF_SUCCESS)
end subroutine MAPL_VarSpecCreateInList