ESMF_InitMacros.F90 Source File


This file depends on

sourcefile~~esmf_initmacros.f90~~EfferentGraph sourcefile~esmf_initmacros.f90 ESMF_InitMacros.F90 sourcefile~esmf_logerr.f90 ESMF_LogErr.F90 sourcefile~esmf_initmacros.f90->sourcefile~esmf_logerr.f90 sourcefile~esmf_utiltypes.f90 ESMF_UtilTypes.F90 sourcefile~esmf_initmacros.f90->sourcefile~esmf_utiltypes.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

ESMF_InitMacros.F90wESMF.F90
w
wESMF_Alarm.F90
w
wESMF_Array.F90
w
wESMF_ArrayBundle.F90
w
wESMF_ArrayHa.F90
w
wESMF_ArraySpec.F90
w
wESMF_AttachMethods.F90
w
wESMF_AttPackType.F90
w
wESMF_Attribute.F90
w
wESMF_Base.F90
w
wESMF_Calendar.F90
w
wESMF_Clock.F90
w
wESMF_Comp.F90
w
wESMF_Comp_C.F90
w
wESMF_Config.F90
w
wESMF_Container.F90
w
wESMF_CplComp.F90
w
wESMF_DELayout.F90
w
wESMF_DistGrid.F90
w
wESMF_DistGridConnection.F90
w
wESMF_DistGridRegDecomp.F90
w
wESMF_DynamicMask.F90
w
wESMF_Field.F90
w
wESMF_FieldGetAllocBounds.F90
w
wESMF_FieldHalo.F90
w
wESMF_FieldPr.F90
w
wESMF_FieldRedist.F90
w
wESMF_FieldSet.F90
w
wESMF_FieldSMM.F90
w
wESMF_FieldWr.F90
w
wESMF_Fraction.F90
w
wESMF_Geom.F90
w
wESMF_Grid.F90
w
wESMF_GridComp.F90
w
wESMF_GridUtil.F90
w
wESMF_HConfig.F90
w
wESMF_Info.F90
w
wESMF_InfoCache.F90
w
wESMF_InfoDescribe.F90
w
wESMF_InfoSync.F90
w
wESMF_InitMacrosUTest.F90
w
wESMF_InternalState.F90
w
wESMF_IO.F90
w
wESMF_IO.F90
w
wESMF_IO_NetCDF.F90
w
wESMF_IO_YAML.F90
w
wESMF_IOFileTypeCheck.F90
w
wESMF_IOGridmosaic.F90
w
wESMF_IOGridspec.F90
w
wESMF_IOScrip.F90
w
wESMF_IOUGrid.F90
w
wESMF_LocStream.F90
w
wESMF_Mapper.F90
w
wESMF_MapperRunSeqUtil.F90
w
wESMF_MapperUtil.F90
w
wESMF_Mesh.F90
w
wESMF_NamedAlias.F90
w
wESMF_PointList.F90
w
wESMF_RHandle.F90
w
wESMF_SciComp.F90
w
wESMF_StateContainer.F90
w
wESMF_StateItem.F90
w
wESMF_StateReconcile.F90
w
wESMF_StateSet.F90
w
wESMF_StateTypes.F90
w
wESMF_StateVa.F90
w
wESMF_StateWr.F90
w
wESMF_Time.F90
w
wESMF_TimeInterval.F90
w
wESMF_Util.F90
w
wESMF_UtilCubedSphere.F90
w
wESMF_UtilRWG.F90
w
wESMF_VM.F90
w
wESMF_XGrid.F90
w
wESMF_XGridCreate.F90
w
wESMF_XGridGeomBase.F90
w
wESMF_XGridGet.F90
w

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.
!
!==============================================================================
!
!     ESMF InitMacro Module
      module ESMF_InitMacrosMod


!
!==============================================================================
!
! This file contains funtions to support the Initialization Macros
!
!------------------------------------------------------------------------------
! INCLUDES
#include "ESMF.h"

!------------------------------------------------------------------------------
!
! !USES:
    ! inherit from ESMF base class
    use ESMF_LogErrMod
    use ESMF_UtilTypesMod

    implicit none
    private

! !PUBLIC MEMBER FUNCTIONS:
    public ESMF_IMErr
    public ESMF_IMErrS
    public ESMF_InitPrint

contains



!--------------------------------------------------------------------------
#undef  ESMF_METHOD
#define ESMF_METHOD "ESMF_InitCheckDeep"
!BOPI
! !IROUTINE: ESMF_InitCheckDeep - Translate isInit value to return code

! !INTERFACE:
recursive function ESMF_InitCheckDeep(isInit) result (InitCheckDeep)
!
! !RETURN VALUE:
        integer                                 :: InitCheckDeep
! !ARGUMENTS:
!       
        ESMF_INIT_TYPE, intent(in)              :: isInit
        
! !DESCRIPTION:
!      This function takes a classes' isInit component (declared by
!      the initialization macros) and returns an error return code.
!
!      The arguments are:
!      \begin{description}
!       
!      \item [isInit]
!            Initialization macro defined type component.
!      \end{description}
!
!EOPI
        
    ! base return code on isInit value
    if (isInit .eq. ESMF_INIT_CREATED) then
        InitCheckDeep=ESMF_SUCCESS
    else if (isInit .eq. ESMF_INIT_DELETED) then
        InitCheckDeep=ESMF_RC_OBJ_DELETED
    else
        InitCheckDeep=ESMF_RC_OBJ_NOT_CREATED
    endif       

end function ESMF_InitCheckDeep

!--------------------------------------------------------------------------
#undef  ESMF_METHOD
#define ESMF_METHOD "ESMF_IMErr"
!BOPI
! !IROUTINE: ESMF_IMErr - Init Macros Error Handling for Deep classes

! !INTERFACE:
recursive function ESMF_IMErr(isInit, line, file, method, rc) result (IMErr)
!
! !RETURN VALUE:
        logical                                         :: IMErr
! !ARGUMENTS:
!       
        ESMF_INIT_TYPE, intent(in)              :: isInit
        integer, intent(in), optional                   :: line
        character(len=*), intent(in), optional          :: file
        character(len=*), intent(in), optional          :: method
        integer, intent(out),optional                   :: rc
        

! !DESCRIPTION:
!      This function returns a logical true for ESMF initialization
!      codes that indicate an error.  A predefined error message will
!      be added to the {\tt ESMF\_Log} along with
!      a user added {\tt line}, {\tt file} and {\tt method}.
!      Additionally, {\tt rc} will be set to an appropriate return code.
!
!      The arguments are:
!      \begin{description}
!       
!      \item [isInit]
!            Initialization code to check.
!      \item [{[line]}]
!            Integer source line number.  Expected to be set by
!            using the preprocessor macro {\tt \_\_LINE\_\_} macro.
!      \item [{[file]}]
!            User-provided source file name.
!      \item [{[method]}]
!            User-provided method string.
!      \item [{[rc]}]
!            If specified, put the return code into {\tt rc}.
!            This is not the return code for this function; it allows
!            the calling code to do an assignment of the error code
!            at the same time it is testing the value.
!            of the default Log.
!
!      \end{description}
!
!EOPI

    ! Initialize return code; assume routine not imlemented
    if (present(rc)) rc = ESMF_RC_NOT_IMPL

    IMErr=ESMF_LogFoundError(ESMF_InitCheckDeep(isInit), &
                                     msg="Bad Object", &
                                     line=line, file=file, method=method, &
                                     rcToReturn=rc)

end function ESMF_IMErr




!--------------------------------------------------------------------------
#undef  ESMF_METHOD
#define ESMF_METHOD "ESMF_InitCheckShallow"
!BOPI
! !IROUTINE: ESMF_InitCheckShallow - Translate isInit value to return code

! !INTERFACE:
recursive function ESMF_InitCheckShallow(isInit) result (InitCheckShallow)
!
! !RETURN VALUE:
        integer                                 :: InitCheckShallow
! !ARGUMENTS:
!       
        ESMF_INIT_TYPE, intent(in)              :: isInit
        
! !DESCRIPTION:
!      This function takes a classes' isInit component (declared by
!      the initialization macros) and returns an error return code.
!
!      The arguments are:
!      \begin{description}
!       
!      \item [isInit]
!            Initialization macro defined type component.
!      \end{description}
!
!EOPI
        
    ! base return code on isInit value
    if (isInit .eq. ESMF_INIT_DEFINED) then
        InitCheckShallow=ESMF_SUCCESS
    else
        InitCheckShallow=ESMF_RC_OBJ_INIT
    endif       

end function ESMF_InitCheckShallow

!--------------------------------------------------------------------------
#undef  ESMF_METHOD
#define ESMF_METHOD "ESMF_IMErr"
!BOPI
! !IROUTINE: ESMF_IMErr - Init Macros Error Handling for shallow classes

! !INTERFACE:
recursive function ESMF_IMErrS(isInit, line, file, method, rc) result (IMErrS)
!
! !RETURN VALUE:
        logical                                         :: IMErrS
! !ARGUMENTS:
!       
        ESMF_INIT_TYPE, intent(in)              :: isInit
        integer, intent(in), optional                   :: line
        character(len=*), intent(in), optional          :: file
        character(len=*), intent(in), optional          :: method
        integer, intent(out),optional                   :: rc
        

! !DESCRIPTION:
!      This function returns a logical true for ESMF initialization
!      codes that indicate an error.  A predefined error message will
!      be added to the {\tt ESMF\_Log} along with
!      a user added {\tt line}, {\tt file} and {\tt method}.
!      Additionally, {\tt rc} will be set to an appropriate return code.
!
!      The arguments are:
!      \begin{description}
!       
!      \item [isInit]
!            Initialization code to check.
!      \item [{[line]}]
!            Integer source line number.  Expected to be set by
!            using the preprocessor macro {\tt \_\_LINE\_\_} macro.
!      \item [{[file]}]
!            User-provided source file name.
!      \item [{[method]}]
!            User-provided method string.
!      \item [{[rc]}]
!            If specified, put the return code into {\tt rc}.
!            This is not the return code for this function; it allows
!            the calling code to do an assignment of the error code
!            at the same time it is testing the value.
!            of the default Log.
!
!      \end{description}
!
!EOPI

    ! Initialize return code; assume routine not imlemented
    if (present(rc)) rc = ESMF_RC_NOT_IMPL

    IMErrS=ESMF_LogFoundError(ESMF_InitCheckShallow(isInit), &
                                     msg="Object not Initialized", &
                                     line=line, file=file, method=method, &
                                     rcToReturn=rc)

end function ESMF_IMErrS


!--------------------------------------------------------------------------
#undef  ESMF_METHOD
#define ESMF_METHOD "ESMF_InitPrint"
!BOPI
! !IROUTINE: ESMF_InitPrint - Print initialization status of object

! !INTERFACE:
  subroutine ESMF_InitPrint (isInit, rc)

! !ARGUMENTS:
!
    ESMF_INIT_TYPE, intent(in)            :: isInit
    integer,        intent(out), optional :: rc

! !DESCRIPTION:
!
!  Print the status of the isInit flag.
!
!      The arguments are:
!      \begin{description}
!
!      \item [isInit]
!            Initialization value to print.
!      \item [{[rc]}]
!            Return code
!
!      \end{description}
!
!EOPI

    ! Initialize return code; assume routine not imlemented
    if (present(rc)) rc = ESMF_RC_NOT_IMPL

    select case (isInit)
    case(ESMF_INIT_UNDEFINED)
      print *, 'Object is UNDEFINED'
    case (ESMF_INIT_DEFINED)
      print *, 'Object is DEFINED'
    case (ESMF_INIT_CREATED)
      print *, 'Object has been CREATED'
    case (ESMF_INIT_DELETED)
      print *, 'Object has been DELETED'
    case default
      print *, 'Object is in unknown state'
    end select

    if (present (rc)) rc = ESMF_SUCCESS

  end subroutine ESMF_InitPrint

end module ESMF_InitMacrosMod