MAPL_VarSpecCreateInList Subroutine

public 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, positive, RC)

Arguments

Type IntentOptional Attributes Name
type(MAPL_VarSpec), pointer :: 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=positive_length), intent(in), optional :: positive
integer, intent(out), optional :: RC

Calls

proc~~mapl_varspeccreateinlist~~CallsGraph proc~mapl_varspeccreateinlist MAPL_VarSpecCreateInList interface~mapl_assert MAPL_Assert proc~mapl_varspeccreateinlist->interface~mapl_assert interface~mapl_varspecgetindex MAPL_VarSpecGetIndex proc~mapl_varspeccreateinlist->interface~mapl_varspecgetindex proc~mapl_return MAPL_Return proc~mapl_varspeccreateinlist->proc~mapl_return proc~mapl_verify MAPL_Verify proc~mapl_varspeccreateinlist->proc~mapl_verify 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

Called by

proc~~mapl_varspeccreateinlist~~CalledByGraph proc~mapl_varspeccreateinlist MAPL_VarSpecCreateInList proc~test_add_spec_grows_container test_add_spec_grows_container proc~test_add_spec_grows_container->proc~mapl_varspeccreateinlist proc~test_simple_constructor test_simple_constructor proc~test_simple_constructor->proc~mapl_varspeccreateinlist

Source Code

   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, &
        positive, &
        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
      character(len=positive_length), optional, intent(in) :: positive
      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=positive_length) :: usablePositive
      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

      if (present(positive)) then
         usablePositive = positive
      else
         usablePositive = 'down'
      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%positive=  usablePositive
      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