ESMF_Init_C.F90 Source File


This file depends on

sourcefile~~esmf_init_c.f90~~EfferentGraph sourcefile~esmf_init_c.f90 ESMF_Init_C.F90 sourcefile~esmf_calendar.f90 ESMF_Calendar.F90 sourcefile~esmf_init_c.f90->sourcefile~esmf_calendar.f90 sourcefile~esmf_comp.f90 ESMF_Comp.F90 sourcefile~esmf_init_c.f90->sourcefile~esmf_comp.f90 sourcefile~esmf_init.f90 ESMF_Init.F90 sourcefile~esmf_init_c.f90->sourcefile~esmf_init.f90 sourcefile~esmf_logerr.f90 ESMF_LogErr.F90 sourcefile~esmf_init_c.f90->sourcefile~esmf_logerr.f90 sourcefile~esmf_utiltypes.f90 ESMF_UtilTypes.F90 sourcefile~esmf_init_c.f90->sourcefile~esmf_utiltypes.f90 sourcefile~esmf_calendar.f90->sourcefile~esmf_logerr.f90 sourcefile~esmf_calendar.f90->sourcefile~esmf_utiltypes.f90 sourcefile~esmf_base.f90 ESMF_Base.F90 sourcefile~esmf_calendar.f90->sourcefile~esmf_base.f90 sourcefile~esmf_initmacros.f90 ESMF_InitMacros.F90 sourcefile~esmf_calendar.f90->sourcefile~esmf_initmacros.f90 sourcefile~esmf_ioutil.f90 ESMF_IOUtil.F90 sourcefile~esmf_calendar.f90->sourcefile~esmf_ioutil.f90 sourcefile~esmf_comp.f90->sourcefile~esmf_calendar.f90 sourcefile~esmf_comp.f90->sourcefile~esmf_logerr.f90 sourcefile~esmf_comp.f90->sourcefile~esmf_utiltypes.f90 sourcefile~esmf_comp.f90->sourcefile~esmf_base.f90 sourcefile~esmf_clock.f90 ESMF_Clock.F90 sourcefile~esmf_comp.f90->sourcefile~esmf_clock.f90 sourcefile~esmf_config.f90 ESMF_Config.F90 sourcefile~esmf_comp.f90->sourcefile~esmf_config.f90 sourcefile~esmf_grid.f90 ESMF_Grid.F90 sourcefile~esmf_comp.f90->sourcefile~esmf_grid.f90 sourcefile~esmf_hconfig.f90 ESMF_HConfig.F90 sourcefile~esmf_comp.f90->sourcefile~esmf_hconfig.f90 sourcefile~esmf_comp.f90->sourcefile~esmf_initmacros.f90 sourcefile~esmf_comp.f90->sourcefile~esmf_ioutil.f90 sourcefile~esmf_locstream.f90 ESMF_LocStream.F90 sourcefile~esmf_comp.f90->sourcefile~esmf_locstream.f90 sourcefile~esmf_mesh.f90 ESMF_Mesh.F90 sourcefile~esmf_comp.f90->sourcefile~esmf_mesh.f90 sourcefile~esmf_state.f90 ESMF_State.F90 sourcefile~esmf_comp.f90->sourcefile~esmf_state.f90 sourcefile~esmf_statetypes.f90 ESMF_StateTypes.F90 sourcefile~esmf_comp.f90->sourcefile~esmf_statetypes.f90 sourcefile~esmf_util.f90 ESMF_Util.F90 sourcefile~esmf_comp.f90->sourcefile~esmf_util.f90 sourcefile~esmf_vm.f90 ESMF_VM.F90 sourcefile~esmf_comp.f90->sourcefile~esmf_vm.f90 sourcefile~esmf_xgrid.f90 ESMF_XGrid.F90 sourcefile~esmf_comp.f90->sourcefile~esmf_xgrid.f90 sourcefile~esmf_init.f90->sourcefile~esmf_calendar.f90 sourcefile~esmf_init.f90->sourcefile~esmf_logerr.f90 sourcefile~esmf_init.f90->sourcefile~esmf_utiltypes.f90 sourcefile~esmf_init.f90->sourcefile~esmf_base.f90 sourcefile~esmf_init.f90->sourcefile~esmf_config.f90 sourcefile~esmf_delayout.f90 ESMF_DELayout.F90 sourcefile~esmf_init.f90->sourcefile~esmf_delayout.f90 sourcefile~esmf_init.f90->sourcefile~esmf_hconfig.f90 sourcefile~esmf_init.f90->sourcefile~esmf_ioutil.f90 sourcefile~esmf_trace.f90 ESMF_Trace.F90 sourcefile~esmf_init.f90->sourcefile~esmf_trace.f90 sourcefile~esmf_init.f90->sourcefile~esmf_util.f90 sourcefile~esmf_init.f90->sourcefile~esmf_vm.f90 sourcefile~esmf_logerr.f90->sourcefile~esmf_utiltypes.f90 sourcefile~esmf_logerr.f90->sourcefile~esmf_ioutil.f90 sourcefile~esmf_utilstring.f90 ESMF_UtilString.F90 sourcefile~esmf_logerr.f90->sourcefile~esmf_utilstring.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.
!
!==============================================================================
!
! F77 interface files for C++ layer calling into F90 implementation layer.
!  This cannot use any F90 syntax, including modules, or allocatable 
!   arrays, or ...
!
!==============================================================================
!
!------------------------------------------------------------------------------
! INCLUDES
#include "ESMF.h"
!==============================================================================
!------------------------------------------------------------------------------
! The following line turns the CVS identifier string into a printable variable.
!      character(*), parameter, private :: version = &
!      '$Id$'
!==============================================================================

!------------------------------------------------------------------------------
!BOP
!  !DESCRIPTION:
! 
! The code in this file implements the interface code between C++ and F90
!  for the Framework-wide Initialization and Finalization methods.
! 
!EOP
!------------------------------------------------------------------------------
   subroutine f_esmf_frameworkinitialize(lang, configFileName, &
                                        defaultCalKind, defaultLogFileName, &
                                        logkindflag, rc)
       use ESMF_LogErrMod
       use ESMF_CalendarMod
       use ESMF_CompMod
       use ESMF_InitMod
       
       implicit none

       integer :: lang
       character(len=*) :: configFileName
       type(ESMF_CalKind_Flag) :: defaultCalKind
       character(len=*) :: defaultLogFileName
       type(ESMF_LogKind_Flag) :: logkindflag
       integer :: rc

       call ESMF_FrameworkInternalInit(lang=lang, &
         configFilename=configFileName, &
         defaultCalKind=defaultCalKind,defaultLogFileName=defaultLogFileName,&
         logkindflag=logkindflag, rc=rc)

   end subroutine f_esmf_frameworkinitialize

   subroutine f_esmf_frameworkfinalize(rc, endFlag)
       use ESMF_CompMod
       use ESMF_InitMod
       use ESMF_UtilTypesMod

       implicit none

       integer :: rc
       type(ESMF_End_Flag) :: endFlag

       call ESMF_Finalize(endflag=endFlag, rc=rc)

   end subroutine f_esmf_frameworkfinalize