ESMF_AttPackType.F90 Source File


This file depends on

sourcefile~~esmf_attpacktype.f90~~EfferentGraph sourcefile~esmf_attpacktype.f90 ESMF_AttPackType.F90 sourcefile~esmf_initmacros.f90 ESMF_InitMacros.F90 sourcefile~esmf_attpacktype.f90->sourcefile~esmf_initmacros.f90 sourcefile~esmf_utiltypes.f90 ESMF_UtilTypes.F90 sourcefile~esmf_attpacktype.f90->sourcefile~esmf_utiltypes.f90 sourcefile~esmf_initmacros.f90->sourcefile~esmf_utiltypes.f90 sourcefile~esmf_logerr.f90 ESMF_LogErr.F90 sourcefile~esmf_initmacros.f90->sourcefile~esmf_logerr.f90 sourcefile~esmf_logerr.f90->sourcefile~esmf_utiltypes.f90 sourcefile~esmf_ioutil.f90 ESMF_IOUtil.F90 sourcefile~esmf_logerr.f90->sourcefile~esmf_ioutil.f90 sourcefile~esmf_utilstring.f90 ESMF_UtilString.F90 sourcefile~esmf_logerr.f90->sourcefile~esmf_utilstring.f90 sourcefile~esmf_ioutil.f90->sourcefile~esmf_utiltypes.f90

Files dependent on this one

sourcefile~~esmf_attpacktype.f90~~AfferentGraph sourcefile~esmf_attpacktype.f90 ESMF_AttPackType.F90 sourcefile~esmf_ioscrip.f90 ESMF_IOScrip.F90 sourcefile~esmf_ioscrip.f90->sourcefile~esmf_attpacktype.f90 sourcefile~esmf.f90 ESMF.F90 sourcefile~esmf.f90->sourcefile~esmf_ioscrip.f90 sourcefile~esmf_field_c.f90 ESMF_Field_C.F90 sourcefile~esmf_field_c.f90->sourcefile~esmf_ioscrip.f90 sourcefile~esmf_fieldregrid.f90 ESMF_FieldRegrid.F90 sourcefile~esmf_fieldregrid.f90->sourcefile~esmf_ioscrip.f90 sourcefile~esmf_fileregrid.f90 ESMF_FileRegrid.F90 sourcefile~esmf_fileregrid.f90->sourcefile~esmf_ioscrip.f90 sourcefile~esmf_grid.f90 ESMF_Grid.F90 sourcefile~esmf_grid.f90->sourcefile~esmf_ioscrip.f90 sourcefile~esmf_io_scrip_c.f90 ESMF_IO_Scrip_C.F90 sourcefile~esmf_io_scrip_c.f90->sourcefile~esmf_ioscrip.f90 sourcefile~esmf_iofiletypecheck.f90 ESMF_IOFileTypeCheck.F90 sourcefile~esmf_iofiletypecheck.f90->sourcefile~esmf_ioscrip.f90 sourcefile~esmf_ioutest.f90 ESMF_IOUTest.F90 sourcefile~esmf_ioutest.f90->sourcefile~esmf_ioscrip.f90 sourcefile~esmf_locstream.f90 ESMF_LocStream.F90 sourcefile~esmf_locstream.f90->sourcefile~esmf_ioscrip.f90 sourcefile~esmf_mesh.f90 ESMF_Mesh.F90 sourcefile~esmf_mesh.f90->sourcefile~esmf_ioscrip.f90 sourcefile~esmf_regrid.f90~2 ESMF_Regrid.F90 sourcefile~esmf_regrid.f90~2->sourcefile~esmf_ioscrip.f90 sourcefile~esmf_regridweightgen.f90 ESMF_RegridWeightGen.F90 sourcefile~esmf_regridweightgen.f90->sourcefile~esmf_ioscrip.f90 sourcefile~esmf_regridweightgen.f90~2 ESMF_RegridWeightGen.F90 sourcefile~esmf_regridweightgen.f90~2->sourcefile~esmf_ioscrip.f90 sourcefile~nuopc_auxiliary.f90 NUOPC_Auxiliary.F90 sourcefile~nuopc_auxiliary.f90->sourcefile~esmf_ioscrip.f90

Source Code

! $Id$
!
! Earth System Modeling Framework
! Copyright (c) 2002-2025, University Corporation for Atmospheric Research,
! Massachusetts Institute of Technology, Geophysical Fluid Dynamics
! Laboratory, University of Michigan, National Centers for Environmental
! Prediction, Los Alamos National Laboratory, Argonne National Laboratory,
! NASA Goddard Space Flight Center.
! Licensed under the University of Illinois-NCSA License.
!
!==============================================================================
!
#define ESMF_FILENAME "ESMF_AttPackType.F90"
!
!     ESMF Stagger Location
      module ESMF_AttPackTypeMod
!
!==============================================================================
!
! This file contains the Stagger Location subroutines
!
!------------------------------------------------------------------------------
! INCLUDES
#include "ESMF.h"
!==============================================================================
!BOPI
! !MODULE: ESMF_StaggerMod - Stagger class
!
! !DESCRIPTION:
!
! The code in this file implements some routines for interacting with the general stagger.
!
!------------------------------------------------------------------------------
! !USES:
      use ESMF_UtilTypesMod
      use ESMF_InitMacrosMod    ! ESMF base class

      implicit none

!------------------------------------------------------------------------------
! !PRIVATE TYPES:
      private

!------------------------------------------------------------------------------
!     ! ESMF_StaggerLoc
!

  type ESMF_AttPack
#ifndef ESMF_NO_SEQUENCE
  sequence
#endif
  !private
    type(ESMF_Pointer) :: this = ESMF_Pointer(0)
    ESMF_INIT_DECLARE
  end type




!------------------------------------------------------------------------------
!
! !PUBLIC TYPES:
  public ESMF_AttPack
  public ESMF_AttributeGetInit

!EOPI
!------------------------------------------------------------------------------
! The following line turns the CVS identifier string into a printable variable.
      character(*), parameter, private :: version = &
      '$Id$'


!==============================================================================

      contains


    function ESMF_AttributeGetInit(attpack)
      type(ESMF_AttPack), intent(in), optional :: attpack
      ESMF_INIT_TYPE :: ESMF_AttributeGetInit
    
      if (present(attpack)) then
          ESMF_AttributeGetInit=ESMF_INIT_GET(attpack)
      else
          ESMF_AttributeGetInit=ESMF_INIT_CREATED
      endif
    
    end function ESMF_AttributeGetInit

end module ESMF_AttPackTypeMod