MAPL_VarSpecCreateInListNew Subroutine

public 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)

Arguments

Type IntentOptional Attributes Name
type(StateSpecification), intent(inout) :: SPEC
character(len=*), intent(in) :: SHORT_NAME
character(len=*), intent(in), optional :: LONG_NAME
character(len=*), intent(in), optional :: UNITS
integer, intent(in), optional :: DIMS
integer, intent(in), optional :: VLOCATION
type(ESMF_Field), intent(in), optional, target :: FIELD
type(ESMF_FieldBundle), intent(in), optional, target :: BUNDLE
type(ESMF_State), intent(in), optional, target :: STATE
integer, intent(in), optional :: NUM_SUBTILES
integer, intent(in), optional :: STAT
integer, intent(in), optional :: ACCMLT_INTERVAL
integer, intent(in), optional :: COUPLE_INTERVAL
integer, intent(in), optional :: OFFSET
real, intent(in), optional :: DEFAULT
character(len=*), intent(in), optional :: FRIENDLYTO
integer, intent(in), optional :: HALOWIDTH
integer, intent(in), optional :: PRECISION
integer, intent(in), optional :: RESTART
character(len=*), intent(in), optional :: ATTR_RNAMES(:)
character(len=*), intent(in), optional :: ATTR_INAMES(:)
real, intent(in), optional :: ATTR_RVALUES(:)
integer, intent(in), optional :: ATTR_IVALUES(:)
integer, intent(in), optional :: UNGRIDDED_DIMS(:)
character(len=*), intent(in), optional :: UNGRIDDED_UNIT
character(len=*), intent(in), optional :: UNGRIDDED_NAME
real, intent(in), optional :: UNGRIDDED_COORDS(:)
integer, intent(in), optional :: FIELD_TYPE
integer, intent(in), optional :: STAGGERING
integer, intent(in), optional :: ROTATION
type(ESMF_Grid), intent(in), optional :: GRID
character(len=*), intent(in), optional :: DEPENDS_ON(:)
logical, intent(in), optional :: DEPENDS_ON_CHILDREN
character(len=*), intent(in), optional :: positive
integer, intent(out), optional :: RC

Calls

proc~~mapl_varspeccreateinlistnew~~CallsGraph proc~mapl_varspeccreateinlistnew MAPL_VarSpecCreateInListNew interface~mapl_assert MAPL_Assert proc~mapl_varspeccreateinlistnew->interface~mapl_assert none~push_back~57 VarSpecVector%push_back proc~mapl_varspeccreateinlistnew->none~push_back~57 none~update_legacy StateSpecification%update_legacy proc~mapl_varspeccreateinlistnew->none~update_legacy proc~mapl_return MAPL_Return proc~mapl_varspeccreateinlistnew->proc~mapl_return proc~mapl_verify MAPL_Verify proc~mapl_varspeccreateinlistnew->proc~mapl_verify none~capacity~337 VarSpecVector%capacity none~push_back~57->none~capacity~337 none~resize~114 VarSpecVector%resize none~push_back~57->none~resize~114 none~of~104 VarSpecVector%of none~update_legacy->none~of~104 at at proc~mapl_return->at insert insert proc~mapl_return->insert proc~mapl_throw_exception MAPL_throw_exception proc~mapl_return->proc~mapl_throw_exception proc~mapl_verify->proc~mapl_throw_exception none~of_size_kind~5 VarSpecVector%of_size_kind none~of~104->none~of_size_kind~5 none~resize_size_kind~5 VarSpecVector%resize_size_kind none~resize~114->none~resize_size_kind~5 none~reserve~114 VarSpecVector%reserve none~resize_size_kind~5->none~reserve~114

Source Code

  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