From e07156676170ca4a45cc166e0a45c25498bf9424 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Fri, 15 Oct 2021 16:58:45 -0400 Subject: [PATCH] Baby steps towards oomph. - Partial refactoring of old VarConnPoint. - Introduced gFTL VarConnVector - Split types into separate files. It can be hard to find the definitions of types when they are not tied to an obvious module/file. This is particularly true in light of some recent refactorings that left chaos in their wake. Current MAPL style guidelines points to a natural solution. - Introduced fine-grained specs. . Legacy VarSpecType has a long laundry list of components. Some rarely used; some never used. And worse, some that no one even recalls what they are for. . New specs are more targeted and hierarchical. E.g., DimsSpec has spec components for horizontal, vertical, and ungridded dimensions. . Mostl likely these new specs will be just "structs" with no methods. But at least one component (possibly otherwise unused) should remain private to prevent use of default constructors. . Legacy VarSpecType now has a FieldSpec component that is initialized during the VarSpecType component. - Consolidated new files in ./oomph - Also changed namespace to "oomph" from "mapl. --- CHANGELOG.md | 7 + CMakeLists.txt | 1 + MAPL/MAPL.F90 | 2 +- generic/CMakeLists.txt | 19 +- generic/GenericCplComp.F90 | 2 +- generic/MAPL_Generic.F90 | 137 +- generic/MAPL_VarSpecMod.F90 | 2271 -------------------- generic/MaplGeneric.F90 | 5 +- generic/StateSpecification.F90 | 2 +- generic/VarConn.F90 | 285 +++ generic/VarConnPoint.F90 | 48 + generic/VarConnType.F90 | 16 + generic/VarConnVector.F90 | 13 + generic/VarSpec.F90 | 1687 +++++++++++++++ generic/VarSpecMiscMod.F90 | 62 + generic/VarSpecPtr.F90 | 12 + generic/VarSpecType.F90 | 243 +++ generic/VarSpecVector.F90 | 18 +- generic/VariableSpecification.F90 | 77 +- gridcomps/History/MAPL_HistoryGridComp.F90 | 2 +- oomph/CMakeLists.txt | 34 + oomph/oomph.F90 | 10 + oomph/specs/AbstractStateItemSpec.F90 | 10 + oomph/specs/ConnectionPoint.F90 | 29 + oomph/specs/CouplingSpec.F90 | 30 + oomph/specs/DimSpec.F90 | 56 + oomph/specs/FieldSpec.F90 | 48 + oomph/specs/HorizontalStaggerLoc.F90 | 49 + oomph/specs/UngriddedDimSpec.F90 | 95 + oomph/specs/VerticalStaggerLoc.F90 | 43 + 30 files changed, 2888 insertions(+), 2425 deletions(-) delete mode 100644 generic/MAPL_VarSpecMod.F90 create mode 100644 generic/VarConn.F90 create mode 100644 generic/VarConnPoint.F90 create mode 100644 generic/VarConnType.F90 create mode 100644 generic/VarConnVector.F90 create mode 100644 generic/VarSpec.F90 create mode 100644 generic/VarSpecMiscMod.F90 create mode 100644 generic/VarSpecPtr.F90 create mode 100644 generic/VarSpecType.F90 create mode 100644 oomph/CMakeLists.txt create mode 100644 oomph/oomph.F90 create mode 100644 oomph/specs/AbstractStateItemSpec.F90 create mode 100644 oomph/specs/ConnectionPoint.F90 create mode 100644 oomph/specs/CouplingSpec.F90 create mode 100644 oomph/specs/DimSpec.F90 create mode 100644 oomph/specs/FieldSpec.F90 create mode 100644 oomph/specs/HorizontalStaggerLoc.F90 create mode 100644 oomph/specs/UngriddedDimSpec.F90 create mode 100644 oomph/specs/VerticalStaggerLoc.F90 diff --git a/CHANGELOG.md b/CHANGELOG.md index d4837b64da14..c179333ecc77 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -50,6 +50,13 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- OOMPH + - Introduced new oomph subdirectory + - Modified old MAPL_VarConnPoint to use new ConnectionPoint (partial). + - Introduced gFTL vector to replace CONN ptr arrays. + - Split types into separate files. + + - Moved newcfio modules from base into new griddedio directory - Renamed newCFIO modules and routines to GriddedIO - Refactored ExtData modules. Because of the dependencies, the following changes were also done: diff --git a/CMakeLists.txt b/CMakeLists.txt index b42f54599765..ec8d76154f1c 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -109,6 +109,7 @@ add_subdirectory (MAPL_cfio MAPL_cfio_r8) add_subdirectory (pfio) add_subdirectory (profiler) add_subdirectory (generic) +add_subdirectory (oomph) # temporary - will rename to generic when done add_subdirectory (shared) add_subdirectory (include) add_subdirectory (base) diff --git a/MAPL/MAPL.F90 b/MAPL/MAPL.F90 index 273abd261ed4..b8e6f7f9e368 100644 --- a/MAPL/MAPL.F90 +++ b/MAPL/MAPL.F90 @@ -3,7 +3,7 @@ module MAPL use MAPLBase_mod use MAPL_GenericMod - use MAPL_VarSpecMod + use MAPL_VarSpecMiscMod use MAPL_ExtDataGridCompMod, only: T_EXTDATA_STATE, EXTDATA_WRAP use ESMF_CFIOMod use pFIO diff --git a/generic/CMakeLists.txt b/generic/CMakeLists.txt index 534e4c4e5a72..b9399f767058 100644 --- a/generic/CMakeLists.txt +++ b/generic/CMakeLists.txt @@ -16,9 +16,19 @@ set (srcs DecoratorComponent.F90 StubComponent.F90 + # Specs + VarSpecType.F90 + VarSpec.F90 + VarSpecPtr.F90 + VarConnPoint.F90 + VarConnType.F90 VariableSpecification.F90 + VarSpecMiscMod.F90 VarSpecVector.F90 - MAPL_VarSpecMod.F90 + VarConnPoint.F90 + VarConnType.F90 + VarConnVector.F90 + VarConn.F90 StateSpecification.F90 ComponentSpecification.F90 MAPL_ServiceConnectionItemVector.F90 @@ -43,7 +53,12 @@ endif () find_package(GFTL REQUIRED) find_package(GFTL_SHARED REQUIRED) -esma_add_library(${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.profiler MAPL.base PFLOGGER::pflogger GFTL_SHARED::gftl-shared GFTL::gftl TYPE ${MAPL_LIBRARY_TYPE}) +esma_add_library(${this} + SRCS ${srcs} + DEPENDENCIES MAPL.oomph MAPL.shared MAPL.profiler MAPL.base + PFLOGGER::pflogger GFTL_SHARED::gftl-shared-v2 GFTL_SHARED::gftl-shared-v1 GFTL::gftl + TYPE ${MAPL_LIBRARY_TYPE} + ) target_include_directories (${this} PUBLIC $) target_link_libraries (${this} PUBLIC esmf NetCDF::NetCDF_Fortran) diff --git a/generic/GenericCplComp.F90 b/generic/GenericCplComp.F90 index e79afa96ee73..599d688e7b80 100644 --- a/generic/GenericCplComp.F90 +++ b/generic/GenericCplComp.F90 @@ -27,7 +27,7 @@ module MAPL_GenericCplCompMod use MAPL_CommsMod use MAPL_ProfMod use MAPL_SunMod - use MAPL_VarSpecMod + use MAPL_VarSpecMiscMod use MAPL_ExceptionHandling implicit none diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index ca613eeaf15b..2b6efd5c2c57 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -118,6 +118,7 @@ module MAPL_GenericMod use MAPL_Constants use MAPL_SunMod use mapl_MaplGrid + use mapl_VarSpecMod use MaplGeneric use MAPL_GenericCplCompMod use MAPL_LocStreamMod @@ -298,7 +299,6 @@ module MAPL_GenericMod module procedure MAPL_AddConnectivityRename module procedure MAPL_AddConnectivityRenameMany module procedure MAPL_AddConnectivityMany - ! module procedure MAPL_AddConnectivityOld end interface interface MAPL_GridCompGetFriendlies @@ -365,8 +365,8 @@ module MAPL_GenericMod type MAPL_Connectivity - type (MAPL_VarConn), pointer :: CONNECT(:) => null() - type (MAPL_VarConn), pointer :: DONOTCONN(:) => null() + type (VarConn) :: CONNECT + type (VarConn) :: DONOTCONN type (ServiceConnectionItemVector) :: ServiceConnectionItems end type MAPL_Connectivity @@ -448,7 +448,7 @@ module MAPL_GenericMod contains procedure :: get_ith_child - + procedure :: get_child_idx procedure :: get_child_gridcomp procedure :: get_child_import_state procedure :: get_child_export_state @@ -551,7 +551,7 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) type(ESMF_State), pointer :: STATE type(ESMF_VM) :: VM -type (MAPL_VarConn), pointer :: CONNECT(:) +type (VarConn), pointer :: CONNECT type (MAPL_VarSpec), pointer :: IM_SPECS(:) type (MAPL_VarSpec), pointer :: EX_SPECS(:) type (MAPL_VarSpecPtr), pointer :: ImSpecPtr(:) @@ -632,7 +632,7 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) ExSpecPtr(I)%Spec => EX_SPECS END DO - call MAPL_ConnCheckReq(CONNECT, ImSpecPtr, ExSpecPtr, rc=status) + call connect%checkReq(ImSpecPtr, ExSpecPtr, rc=status) _VERIFY(STATUS) deallocate (ImSpecPtr, ExSpecPtr) @@ -3373,6 +3373,8 @@ end subroutine MAPL_StateAddExportSpec_ !BOPI ! !IIROUTINE: MAPL_StateAddExportSpecFrmChld --- Add \texttt{EXPORT} spec from child + ! This is an odd procedure in that it not only adds an export spec, it also adds + ! a connectivity. !INTERFACE: subroutine MAPL_StateAddExportSpecFrmChld ( GC, SHORT_NAME, CHILD_ID, RC, TO_NAME ) @@ -3386,18 +3388,44 @@ subroutine MAPL_StateAddExportSpecFrmChld ( GC, SHORT_NAME, CHILD_ID, RC, TO_NAM !EOPI character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_StateAddExportSpecFrmChld" - integer :: STATUS + integer :: status + type(MAPL_MetaComp), pointer :: maplobj + + call MAPL_InternalStateRetrieve(gc, maplobj, _RC) + call MAPL_StateAddExportSpecFrmChldName(gc, short_name, maplobj%gcnamelist(child_id), _RC) + + _RETURN(ESMF_SUCCESS) + end subroutine MAPL_StateAddExportSpecFrmChld + !BOPI + ! !IIROUTINE: MAPL_StateAddExportSpecFrmChld --- Add \texttt{EXPORT} spec from child + + !INTERFACE: + subroutine MAPL_StateAddExportSpecFrmChldName ( GC, short_name, child_name, rc ) + + !ARGUMENTS: + type(ESMF_GridComp), intent(INOUT) :: GC + character (len=*) , intent(IN) :: short_name + character(*), intent(in) :: child_name + integer , optional , intent(OUT) :: rc + !EOPI + + character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_StateAddExportSpecFrmChld" + integer :: child_id + integer :: status + type(MAPL_MetaComp), pointer :: maplobj + + call MAPL_InternalStateRetrieve(gc, maplobj, _RC) + child_id = maplobj%get_child_idx(child_name) + call MAPL_AddConnectivityE2E ( GC, SHORT_NAME, & TO_NAME = TO_NAME, & SRC_ID = CHILD_ID, & - TO_EXPORT = MAPL_Self, RC=STATUS ) - _VERIFY(STATUS) - + TO_EXPORT = MAPL_Self, _RC) _RETURN(ESMF_SUCCESS) - end subroutine MAPL_StateAddExportSpecFrmChld + end subroutine MAPL_StateAddExportSpecFrmChldName !BOPI @@ -4922,34 +4950,6 @@ end function MAPL_AddChildFromDSO - subroutine MAPL_AddConnectivityOld ( GC, SHORT_NAME, TO_NAME, & - FROM_IMPORT, FROM_EXPORT, TO_IMPORT, TO_EXPORT, RC ) - - type(ESMF_GridComp), intent(INOUT) :: GC ! Gridded component - character (len=*) , intent(IN ) :: SHORT_NAME - character (len=*), optional, intent(IN ) :: TO_NAME - integer, optional, intent(IN ) :: FROM_IMPORT - integer, optional, intent(IN ) :: FROM_EXPORT - integer, optional, intent(IN ) :: TO_IMPORT - integer, optional, intent(IN ) :: TO_EXPORT - integer, optional, intent( OUT) :: RC ! Error code: - - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_AddConnectivity" - integer :: STATUS - type (MAPL_Connectivity), pointer :: conn - - - call MAPL_ConnectivityGet(gc, connectivityPtr=conn, RC=status) - _VERIFY(STATUS) - - call MAPL_VarConnCreate(CONN%CONNECT, SHORT_NAME, TO_NAME=TO_NAME, & - FROM_IMPORT=FROM_IMPORT, FROM_EXPORT=FROM_EXPORT, & - TO_IMPORT =TO_IMPORT, TO_EXPORT =TO_EXPORT, RC=STATUS ) - _VERIFY(STATUS) - - _RETURN(ESMF_SUCCESS) - end subroutine MAPL_AddConnectivityOld - subroutine MAPL_AddConnectivityE2E ( GC, SHORT_NAME, & SRC_ID, TO_EXPORT, TO_NAME, RC ) @@ -4964,14 +4964,10 @@ subroutine MAPL_AddConnectivityE2E ( GC, SHORT_NAME, & integer :: STATUS type (MAPL_Connectivity), pointer :: conn - call MAPL_ConnectivityGet(gc, connectivityPtr=conn, RC=status) - _VERIFY(STATUS) + call MAPL_ConnectivityGet(gc, connectivityPtr=conn, _RC) - call MAPL_VarConnCreate(CONN%CONNECT, SHORT_NAME, & - TO_NAME = TO_NAME, & - FROM_EXPORT=SRC_ID, & - TO_EXPORT=TO_EXPORT, RC=STATUS ) - _VERIFY(STATUS) + call conn%connect%append(SHORT_NAME, TO_NAME=TO_NAME, & + FROM_EXPORT=SRC_ID, TO_IMPORT=TO_EXPORT, _RC) _RETURN(ESMF_SUCCESS) end subroutine MAPL_AddConnectivityE2E @@ -5004,9 +5000,8 @@ subroutine MAPL_AddConnectivityRename ( GC, SRC_NAME, SRC_ID, & call MAPL_ConnectivityGet(gc, connectivityPtr=conn, RC=status) _VERIFY(STATUS) - call MAPL_VarConnCreate(CONN%CONNECT, SHORT_NAME=SRC_NAME, TO_NAME=DST_NAME, & - FROM_EXPORT=SRC_ID, TO_IMPORT=DST_ID, RC=STATUS ) - _VERIFY(STATUS) + call CONN%CONNECT%append(SHORT_NAME=SRC_NAME, TO_NAME=DST_NAME, & + FROM_EXPORT=SRC_ID, TO_IMPORT=DST_ID, _RC) _RETURN(ESMF_SUCCESS) end subroutine MAPL_AddConnectivityRename @@ -5093,9 +5088,7 @@ subroutine MAPL_DoNotConnect ( GC, SHORT_NAME, CHILD, RC ) call MAPL_ConnectivityGet(gc, connectivityPtr=conn, RC=status) _VERIFY(STATUS) - call MAPL_VarConnCreate(CONN%DONOTCONN, SHORT_NAME, & - FROM_IMPORT=CHILD, RC=STATUS ) - _VERIFY(STATUS) + call CONN%DONOTCONN%append(SHORT_NAME, TO_IMPORT=CHILD, _RC) _RETURN(ESMF_SUCCESS) @@ -5174,7 +5167,7 @@ subroutine MAPL_TerminateImportAllBut ( GC, SHORT_NAMES, CHILD_IDS, RC ) logical :: SKIP character(len=ESMF_MAXSTR), allocatable :: SNAMES(:) type (MAPL_Connectivity), pointer :: conn - type (MAPL_VarConn), pointer :: CONNECT(:) + type (VarConn), pointer :: CONNECT logical :: isConnected type(ESMF_GridComp), pointer :: gridcomp @@ -5196,7 +5189,7 @@ subroutine MAPL_TerminateImportAllBut ( GC, SHORT_NAMES, CHILD_IDS, RC ) _VERIFY(STATUS) do J=1 ,size(META_CHILD%component_spec%import%old_var_specs) call MAPL_VarSpecGet(META_CHILD%component_spec%import%old_var_specs(J),SHORT_NAME=SHORT_NAME,RC=STATUS) - isConnected = MAPL_VarIsConnected(connect,short_name,I,rc=status) + isConnected = connect%varIsConnected(short_name,I,rc=status) SKIP = ANY(SNAMES==TRIM(SHORT_NAME)) .and. (ANY(CHILD_IDS==I)) if ((.not.isConnected) .and. (.not.skip)) then call MAPL_DoNotConnect(GC, SHORT_NAME, I, RC=status) @@ -7030,8 +7023,8 @@ recursive subroutine MAPL_WireComponent(GC, RC) logical :: SATISFIED logical :: PARENTIMPORT type (MAPL_Connectivity), pointer :: conn - type (MAPL_VarConn), pointer :: CONNECT(:) - type (MAPL_VarConn), pointer :: DONOTCONN(:) + type (VarConn), pointer :: CONNECT + type (VarConn), pointer :: DONOTCONN type(ESMF_GridComp), pointer :: gridcomp ! Begin @@ -7089,8 +7082,8 @@ recursive subroutine MAPL_WireComponent(GC, RC) do K=1,size(EX_SPECS) call MAPL_VarSpecGet(EX_SPECS(K), SHORT_NAME=SHORT_NAME, RC=STATUS) - if (MAPL_VarIsConnected(CONNECT, SHORT_NAME=SHORT_NAME, & - FROM_EXPORT=I, TO_EXPORT=MAPL_Self, & + if (connect%varIsConnected(IMPORT_NAME=SHORT_NAME, & + export=I, import=MAPL_Self, & RC=STATUS)) then _VERIFY(STATUS) @@ -7113,7 +7106,7 @@ recursive subroutine MAPL_WireComponent(GC, RC) ! check "do not connect" list for PARENTIMPORT = .true. - if (MAPL_VarIsListed(DONOTCONN, SHORT_NAME="MAPL_AnyChildImport", & + if (DONOTCONN%varIsListed(SHORT_NAME="MAPL_AnyChildImport", & IMPORT=I, RC=STATUS)) then _VERIFY(STATUS) PARENTIMPORT = .false. @@ -7141,7 +7134,7 @@ recursive subroutine MAPL_WireComponent(GC, RC) #endif ! check "do not connect" list - if (MAPL_VarIsListed(DONOTCONN, SHORT_NAME=SHORT_NAME, & + if (DONOTCONN%varIsListed(SHORT_NAME=SHORT_NAME, & IMPORT=I, RC=STATUS)) then _VERIFY(STATUS) cycle @@ -7157,7 +7150,7 @@ recursive subroutine MAPL_WireComponent(GC, RC) do J=1,NC if(I==J) cycle ! then check if this is internally satisfied - if (MAPL_VarIsConnected(CONNECT, IMPORT_NAME=SHORT_NAME, & + if (connect%varIsConnected(IMPORT_NAME=SHORT_NAME, & IMPORT=I, EXPORT=J, RC=STATUS)) then _VERIFY(STATUS) @@ -7183,8 +7176,7 @@ recursive subroutine MAPL_WireComponent(GC, RC) ! then check if this is internally satisfied - if (MAPL_VarIsConnected(CONNECT, & - IMPORT_NAME=SHORT_NAME, EXPORT_NAME=ENAME, & + if (connect%varIsConnected(IMPORT_NAME=SHORT_NAME, EXPORT_NAME=ENAME, & IMPORT=I, EXPORT=J, RC=STATUS)) then ! If a match is found, add it to that coupler's src and dst specs ! ?? Mark the import satisfied and the export needed. @@ -8345,12 +8337,12 @@ recursive subroutine MAPL_GenericConnCheck(GC, RC) conn => state%connectList err = .false. - if (.not. MAPL_ConnCheckUnused(CONN%CONNECT)) then + if (.not. conn%connect%checkUnused()) then err = .true. CALL WRITE_PARALLEL("CONNECT ERRORS FOUND in " // trim(COMP_NAME)) end if - if (.not. MAPL_ConnCheckUnused(CONN%DONOTCONN)) then + if (.not. CONN%DONOTCONN%checkUnused()) then err = .true. CALL WRITE_PARALLEL("DO_NOT_CONNECT ERRORS FOUND in " // trim(COMP_NAME)) end if @@ -11371,6 +11363,21 @@ function get_ith_child(this, i) result(child) end function get_ith_child + integer function get_child_idx(this, child_name) result(idx) + class(MAPL_MetaComp), target, intent(in) :: this + character(*), intent(in) :: child_name + + integer :: i + + idx = -1 + do i = 1, this%get_num_children() + if (this%gcnamelist(i) == trim(child_name)) then + idx = i + return + end if + end do + end function get_child_idx + function get_child_gridcomp(this, i) result(gridcomp) diff --git a/generic/MAPL_VarSpecMod.F90 b/generic/MAPL_VarSpecMod.F90 deleted file mode 100644 index 41b11de6c289..000000000000 --- a/generic/MAPL_VarSpecMod.F90 +++ /dev/null @@ -1,2271 +0,0 @@ -#include "MAPL_ErrLog.h" - -!============================================================================= -!BOP - -! !MODULE: MAPL_VarSpecMod -- A class for manipulation variable specifications. - -! !INTERFACE: - -module MAPL_VarSpecMod - -! !USES: - - use ESMF - use pFlogger - use MAPL_Constants - use MAPL_ExceptionHandling - use mapl_VariableSpecification - use mapl_VarSpecVector - -! !PUBLIC MEMBER FUNCTIONS: - -implicit none -private - -public MAPL_VarSpecCreateInList -public MAPL_VarSpecGetIndex -public MAPL_VarSpecAddRefToList -public MAPL_VarSpecAddToList -public MAPL_VarSpecSet -public MAPL_VarSpecGet -public MAPL_VarSpecPrint -public MAPL_VarSpecPrintCSV -public MAPL_VarSpecDestroy -public MAPL_VarSpecAddChildName -public MAPL_VarSpecReconnect -public MAPL_VarConnCreate -public MAPL_VarConnGet -public MAPL_VarIsConnected -public MAPL_VarIsListed -public MAPL_ConnCheckUnused -public MAPL_ConnCheckReq -public MAPL_VarSpecSamePrec - -! Types - - public :: MAPL_VarSpec - public :: MAPL_VarSpecType - public :: MAPL_VarSpecPtr - public :: MAPL_VarConnPoint - public :: MAPL_VarConnType - public :: MAPL_VarConn - - -! !OVERLOADED INTERFACES: - -public operator(.eq.) -interface operator (.eq.) - module procedure MAPL_VarSpecEQ -end interface - -interface MAPL_VarSpecAddRefToList - module procedure MAPL_VarSpecAddRefFromItem - module procedure MAPL_VarSpecAddRefFromList -end interface - -interface MAPL_VarSpecAddToList - module procedure MAPL_VarSpecAddFromItem - module procedure MAPL_VarSpecAddFromList -end interface - -interface MAPL_VarSpecGetIndex - module procedure MAPL_VarSpecGetIndexByName - module procedure MAPL_VarSpecGetIndexOfItem -end interface - -interface MAPL_VarSpecGet - module procedure MAPL_VarSpecGetRegular - module procedure MAPL_VarSpecGetNew - module procedure MAPL_VarSpecGetFieldPtr - module procedure MAPL_VarSpecGetBundlePtr - module procedure MAPL_VarSpecGetStatePtr -end interface - -interface MAPL_VarSpecSet - module procedure MAPL_VarSpecSetRegular - module procedure MAPL_VarSpecSetNew - module procedure MAPL_VarSpecSetFieldPtr - module procedure MAPL_VarSpecSetBundlePtr - module procedure MAPL_VarSpecSetStatePtr -end interface - -interface MAPL_VarSpecDestroy - module procedure MAPL_VarSpecDestroy0 - module procedure MAPL_VarSpecDestroy1 -end interface - -interface MAPL_VarIsConnected - module procedure MAPL_VarIsConnectedEE - module procedure MAPL_VarIsConnectedIE - module procedure MAPL_VarIsConnectedName -end interface - -interface MAPL_VarSpecPrint - module procedure MAPL_VarSpecPrintOne - module procedure MAPL_VarSpecPrintMany -end interface MAPL_VarSpecPrint - -!EOP - -contains - - - - 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, & - 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 - 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=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 - - 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%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 - - - subroutine MAPL_VarSpecAddRefFromItem(SPEC, ITEM, ALLOW_DUPLICATES, RC) - - type (MAPL_VarSpec ), pointer :: SPEC(:) - type (MAPL_VarSpec ), intent(IN ) :: ITEM - logical, optional , intent(IN) :: ALLOW_DUPLICATES - integer, optional , intent(OUT) :: RC - - - - integer :: STATUS - - type (MAPL_VarSpec ), pointer :: TMP(:) => null() - integer :: I - logical :: usableALLOW_DUPLICATES - class(Logger), pointer :: lgr - - - if(present(ALLOW_DUPLICATES)) then - usableALLOW_DUPLICATES=ALLOW_DUPLICATES - else - usableALLOW_DUPLICATES=.FALSE. - endif - - - if(.not.associated(ITEM%SPECPtr)) then - _RETURN(ESMF_FAILURE) - endif - - if(associated(SPEC)) then - if (.not. usableALLOW_DUPLICATES) then - I = MAPL_VarSpecGetIndex(SPEC, ITEM, RC=STATUS) - _VERIFY(STATUS) - if(I /= -1) then - if (SPEC(I) == ITEM) THEN - if(present(RC)) then - RC=MAPL_DuplicateEntry - end if - return - else - lgr => logging%get_logger('MAPL.GENERIC') - call lgr%error("Duplicate SHORT_NAME %a with different attributes.", trim(ITEM%SPECPtr%short_name)) - call MAPL_VarSpecPrint(ITEM) - call MAPL_VarSpecPrint(SPEC(I)) - _RETURN(ESMF_FAILURE) - end if - endif - end if - else - allocate(SPEC(0),stat=STATUS) - _VERIFY(STATUS) - endif - - I = size(SPEC) - - allocate(TMP(I+1),stat=STATUS) - _VERIFY(STATUS) - - TMP(1:I) = SPEC - deallocate(SPEC) - - TMP(I+1)%SPECPtr => ITEM%SPECPtr - SPEC => TMP - - _RETURN(ESMF_SUCCESS) - - - end subroutine MAPL_VarSpecAddRefFromItem - - subroutine MAPL_VarSpecAddRefFromList(SPEC,ITEM,RC) - - type (MAPL_VarSpec ), pointer :: SPEC(:) - type (MAPL_VarSpec ), intent(IN ) :: ITEM(:) - integer, optional , intent(OUT) :: RC - - - - integer :: STATUS - - integer I - - do I=1,size(ITEM) - call MAPL_VarSpecAddRefFromItem(SPEC,ITEM(I),RC=STATUS) - IF (STATUS /= MAPL_DuplicateEntry) then - _VERIFY(STATUS) - END IF - enddo - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_VarSpecAddRefFromList - - - function MAPL_VarSpecGetIndexByName(SPEC, NAME, RC) result (INDEX) - type (MAPL_VarSpec ) , intent(in) :: SPEC(:) - character (len=*) , intent(IN) :: NAME - integer, optional , intent(OUT) :: RC - integer :: INDEX - - - integer :: I - - - do I = 1, size(SPEC) - if(.not.associated(SPEC(I)%SPECPtr)) then - _RETURN(ESMF_FAILURE) - endif - if (trim(SPEC(I)%SPECPtr%SHORT_NAME) == trim(NAME)) then - INDEX = I - _RETURN(ESMF_SUCCESS) - endif - enddo - - INDEX = -1 ! not found - _RETURN(ESMF_SUCCESS) - - end function MAPL_VarSpecGetIndexByName - - - - subroutine MAPL_VarSpecGetDataByName(SPEC, NAME, PTR1, PTR2, PTR3, RC) - type (MAPL_VarSpec ) , intent(INout):: SPEC(:) - character (len=*) , intent(IN) :: NAME - real, optional, pointer :: PTR1(:) - real, optional, pointer :: PTR2(:,:) - real, optional, pointer :: PTR3(:,:,:) - integer, optional , intent(OUT) :: RC - - - integer :: STATUS - - integer :: I - - do I = 1, size(SPEC) - if(.not.associated(SPEC(I)%SPECPtr)) then - _RETURN(ESMF_FAILURE) - endif - - if (trim(SPEC(I)%SPECPtr%SHORT_NAME) == trim(NAME)) then - call MAPL_VarSpecGetData(SPEC(I),PTR1,PTR2,PTR3,RC=STATUS) - _VERIFY(STATUS) - _RETURN(ESMF_SUCCESS) - endif - enddo - - _RETURN(ESMF_FAILURE) - - end subroutine MAPL_VarSpecGetDataByName - - - subroutine MAPL_VarSpecGetData(SPEC, PTR1, PTR2, PTR3, RC) - type (MAPL_VarSpec ) , intent(INout):: SPEC - real, optional, pointer :: PTR1(:) - real, optional, pointer :: PTR2(:,:) - real, optional, pointer :: PTR3(:,:,:) - integer, optional , intent(OUT) :: RC - - - integer :: STATUS - - type(ESMF_Array) :: ARRAY - - if(.not.associated(SPEC%SPECPtr)) then - _RETURN(ESMF_FAILURE) - endif - - call ESMF_FieldGet(SPEC%SPECPtr%FIELD,Array=ARRAY,rc=STATUS) - _VERIFY(STATUS) - - if (present(PTR1)) then - call ESMF_ArrayGet(ARRAY, localDE=0, farrayptr=PTR1, RC=STATUS) - _VERIFY(STATUS) - _ASSERT(.not.present(PTR2),'needs informative message') - _ASSERT(.not.present(PTR3),'needs informative message') - _RETURN(ESMF_SUCCESS) - endif - - if (present(PTR2)) then - call ESMF_ArrayGet(ARRAY, localDE=0, farrayptr=PTR2, RC=STATUS) - _VERIFY(STATUS) - _ASSERT(.not.present(PTR3),'needs informative message') - _RETURN(ESMF_SUCCESS) - endif - - if (present(PTR3)) then - call ESMF_ArrayGet(ARRAY, localDE=0, farrayptr=PTR3, RC=STATUS) - _VERIFY(STATUS) - _RETURN(ESMF_SUCCESS) - endif - - _RETURN(ESMF_FAILURE) - - end subroutine MAPL_VarSpecGetData - - function MAPL_VarSpecGetIndexOfItem(SPEC, ITEM, RC) result (INDEX) - type (MAPL_VarSpec ) , intent(in) :: SPEC(:) - type (MAPL_VarSpec ) , intent(in) :: ITEM - integer, optional , intent(OUT) :: RC - integer :: INDEX - - - - integer :: I - - do I = 1, size(SPEC) - if(.not.associated(SPEC(I)%SPECPtr)) then - _RETURN(ESMF_FAILURE) - endif - - if (trim(SPEC(I)%SPECPtr%SHORT_NAME) == trim(ITEM%SPECPtr%SHORT_NAME)) then - if (SPEC(I) == ITEM) then - INDEX = I - _RETURN(ESMF_SUCCESS) - end if - endif - enddo - - INDEX = -1 ! not found - _RETURN(ESMF_SUCCESS) - - end function MAPL_VarSpecGetIndexOfItem - - - subroutine MAPL_VarSpecAddFromItem(SPEC,ITEM,RC) - - type (MAPL_VarSpec ), pointer :: SPEC(:) - type (MAPL_VarSpec ), intent(IN ) :: ITEM - integer, optional , intent(OUT) :: RC - - - - integer :: STATUS - - - if(.not.associated(ITEM%SPECPtr)) then - _RETURN(ESMF_FAILURE) - endif - - call MAPL_VarSpecCreateInList(SPEC, & - SHORT_NAME = ITEM%SPECPTR%SHORT_NAME, & - LONG_NAME = ITEM%SPECPTR%LONG_NAME, & - UNITS = ITEM%SPECPTR%UNITS, & - DIMS = ITEM%SPECPTR%Dims, & - VLOCATION = ITEM%SPECPTR%Location, & - STAT = ITEM%SPECPTR%STAT, & - ACCMLT_INTERVAL = ITEM%SPECPTR%ACCMLT_INTERVAL, & - COUPLE_INTERVAL = ITEM%SPECPTR%COUPLE_INTERVAL, & - DEFAULT = ITEM%SPECPTR%DEFAULT, & - FIELD = ITEM%SPECPTR%FIELD, & - BUNDLE = ITEM%SPECPTR%BUNDLE, & - STATE = ITEM%SPECPTR%STATE, & - HALOWIDTH = ITEM%SPECPTR%HALOWIDTH, & - RESTART = ITEM%SPECPTR%RESTART, & - PRECISION = ITEM%SPECPTR%PRECISION, & - ATTR_INAMES = ITEM%SPECPTR%ATTR_INAMES, & - ATTR_RNAMES = ITEM%SPECPTR%ATTR_RNAMES, & - ATTR_IVALUES = ITEM%SPECPTR%ATTR_IVALUES, & - ATTR_RVALUES = ITEM%SPECPTR%ATTR_RVALUES, & - UNGRIDDED_DIMS = ITEM%SPECPTR%UNGRIDDED_DIMS, & - FIELD_TYPE = ITEM%SPECPTR%FIELD_TYPE, & - STAGGERING = ITEM%SPECPTR%STAGGERING, & - ROTATION = ITEM%SPECPTR%ROTATION, & - GRID = ITEM%SPECPTR%GRID, & - RC=STATUS ) - _VERIFY(STATUS) - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_VarSpecAddFromItem - - - subroutine MAPL_VarSpecAddFromList(SPEC,ITEM,RC) - - type (MAPL_VarSpec ), pointer :: SPEC(:) - type (MAPL_VarSpec ), intent(IN ) :: ITEM(:) - integer, optional , intent(OUT) :: RC - - - - integer :: STATUS - - integer I - - do I=1,size(ITEM) - call MAPL_VarSpecAddFromItem(SPEC,ITEM(I),RC=STATUS) - _VERIFY(STATUS) - enddo - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_VarSpecAddFromList - - - subroutine MAPL_VarSpecDestroy0(SPEC, RC ) - - type (MAPL_VarSpec ), intent(INOUT) :: SPEC - integer , optional , intent(OUT) :: RC - - - - - if(associated(SPEC%SPECPtr)) then - deallocate(SPEC%SPECPtr) - endif - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_VarSpecDestroy0 - - subroutine MAPL_VarSpecDestroy1(SPEC, RC ) - - type (MAPL_VarSpec ), pointer :: SPEC(:) - integer , optional , intent(OUT) :: RC - - - - integer :: i - - if (associated(SPEC)) then - do I=1,size(SPEC) - call MAPL_VarSpecDestroy0(spec(i)) - end do - deallocate(SPEC) - end if - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_VarSpecDestroy1 - - - subroutine MAPL_VarSpecSetRegular(SPEC, SHORT_NAME, LONG_NAME, UNITS, & - Dims, VLocation, FIELD, BUNDLE, STATE, & - STAT, ACCMLT_INTERVAL, COUPLE_INTERVAL, & - OFFSET, LABEL, & - FRIENDLYTO, & - FIELD_TYPE, & - STAGGERING, & - ROTATION, & - GRID, & - doNotAllocate, & - alwaysAllocate, & - RC ) - - type (MAPL_VarSpec ), intent(INOUT) :: SPEC - character(len=*) , optional , intent(IN) :: SHORT_NAME - character(len=*) , optional , intent(IN) :: LONG_NAME - character(len=*) , optional , intent(IN) :: UNITS - integer , optional , intent(IN) :: DIMS - integer , optional , intent(IN) :: VLOCATION - integer , optional , intent(IN) :: ACCMLT_INTERVAL - integer , optional , intent(IN) :: COUPLE_INTERVAL - integer , optional , intent(IN) :: OFFSET - integer , optional , intent(IN) :: STAT - integer , optional , intent(IN) :: LABEL - type(ESMF_Field) , optional , intent(IN) :: FIELD - type(ESMF_FieldBundle) , optional , intent(IN) :: BUNDLE - type(ESMF_State) , optional , intent(IN) :: STATE - character(len=*) , optional , intent(IN) :: FRIENDLYTO - 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) :: doNotAllocate - logical , optional , intent(IN) :: alwaysAllocate - integer , optional , intent(OUT) :: RC - - - - - if(.not.associated(SPEC%SPECPtr)) then - _RETURN(ESMF_FAILURE) - endif - - if(present(SHORT_NAME)) then - SPEC%SPECPtr%SHORT_NAME = SHORT_NAME - endif - - if(present(LONG_NAME)) then - SPEC%SPECPtr%LONG_NAME = LONG_NAME - endif - - if(present(UNITS)) then - SPEC%SPECPtr%UNITS = UNITS - endif - - if(present(FRIENDLYTO)) then - SPEC%SPECPtr%FRIENDLYTO = FRIENDLYTO - endif - - if(present(STAT)) then - SPEC%SPECPtr%STAT=STAT - endif - - if(present(DIMS)) then - SPEC%SPECPtr%DIMS=DIMS - endif - - if(present(VLOCATION)) then - SPEC%SPECPtr%LOCATION=VLOCATION - endif - - if(present(ACCMLT_INTERVAL)) then - SPEC%SPECPtr%ACCMLT_INTERVAL=ACCMLT_INTERVAL - endif - - if(present(COUPLE_INTERVAL)) then - SPEC%SPECPtr%COUPLE_INTERVAL=COUPLE_INTERVAL - endif - - if(present(OFFSET)) then - SPEC%SPECPtr%OFFSET=OFFSET - endif - - if(present(LABEL)) then - SPEC%SPECPtr%LABEL=LABEL - endif - - if(present(FIELD)) then - SPEC%SPECPtr%FIELD = FIELD - endif - - if(present(BUNDLE)) then - SPEC%SPECPtr%BUNDLE = BUNDLE - endif - - if(present(STATE)) then - SPEC%SPECPtr%STATE = STATE - endif - - if(present(GRID)) then - SPEC%SPECPtr%GRID = GRID - endif - - if(present(FIELD_TYPE)) then - SPEC%SPECPtr%FIELD_TYPE = FIELD_TYPE - endif - - if(present(STAGGERING)) then - SPEC%SPECPtr%STAGGERING = STAGGERING - endif - - if(present(ROTATION)) then - SPEC%SPECPtr%ROTATION = ROTATION - endif - - if(present(doNotAllocate)) then - SPEC%SPECPtr%doNotAllocate = doNotAllocate - endif - - if(present(alwaysAllocate)) then - SPEC%SPECPtr%alwaysAllocate = alwaysAllocate - endif - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_VarSpecSetRegular - - subroutine MAPL_VarSpecSetNew(SPEC, SHORT_NAME, LONG_NAME, UNITS, & - Dims, VLocation, FIELD, BUNDLE, STATE, & - STAT, ACCMLT_INTERVAL, COUPLE_INTERVAL, & - OFFSET, LABEL, & - FRIENDLYTO, & - FIELD_TYPE, & - STAGGERING, & - ROTATION, & - GRID, & - doNotAllocate, & - alwaysAllocate, & - RC ) - - type (MAPL_VarSpecType), intent(INOUT) :: SPEC - character(len=*) , optional , intent(IN) :: SHORT_NAME - character(len=*) , optional , intent(IN) :: LONG_NAME - character(len=*) , optional , intent(IN) :: UNITS - integer , optional , intent(IN) :: DIMS - integer , optional , intent(IN) :: VLOCATION - integer , optional , intent(IN) :: ACCMLT_INTERVAL - integer , optional , intent(IN) :: COUPLE_INTERVAL - integer , optional , intent(IN) :: OFFSET - integer , optional , intent(IN) :: STAT - integer , optional , intent(IN) :: LABEL - type(ESMF_Field) , optional , intent(IN) :: FIELD - type(ESMF_FieldBundle) , optional , intent(IN) :: BUNDLE - type(ESMF_State) , optional , intent(IN) :: STATE - character(len=*) , optional , intent(IN) :: FRIENDLYTO - 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) :: doNotAllocate - logical , optional , intent(IN) :: alwaysAllocate - integer , optional , intent(OUT) :: RC - - - - if(present(SHORT_NAME)) then - SPEC%SHORT_NAME = SHORT_NAME - endif - - if(present(LONG_NAME)) then - SPEC%LONG_NAME = LONG_NAME - endif - - if(present(UNITS)) then - SPEC%UNITS = UNITS - endif - - if(present(FRIENDLYTO)) then - SPEC%FRIENDLYTO = FRIENDLYTO - endif - - if(present(STAT)) then - SPEC%STAT=STAT - endif - - if(present(DIMS)) then - SPEC%DIMS=DIMS - endif - - if(present(VLOCATION)) then - SPEC%LOCATION=VLOCATION - endif - - if(present(ACCMLT_INTERVAL)) then - SPEC%ACCMLT_INTERVAL=ACCMLT_INTERVAL - endif - - if(present(COUPLE_INTERVAL)) then - SPEC%COUPLE_INTERVAL=COUPLE_INTERVAL - endif - - if(present(OFFSET)) then - SPEC%OFFSET=OFFSET - endif - - if(present(LABEL)) then - SPEC%LABEL=LABEL - endif - - if(present(FIELD)) then - SPEC%FIELD = FIELD - endif - - if(present(BUNDLE)) then - SPEC%BUNDLE = BUNDLE - endif - - if(present(STATE)) then - SPEC%STATE = STATE - endif - - if(present(GRID)) then - SPEC%GRID = GRID - endif - - if(present(FIELD_TYPE)) then - SPEC%FIELD_TYPE = FIELD_TYPE - endif - - if(present(STAGGERING)) then - SPEC%STAGGERING = STAGGERING - endif - - if(present(ROTATION)) then - SPEC%ROTATION = ROTATION - endif - - if(present(doNotAllocate)) then - SPEC%doNotAllocate = doNotAllocate - endif - - if(present(alwaysAllocate)) then - SPEC%alwaysAllocate = alwaysAllocate - endif - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_VarSpecSetNew - - - subroutine MAPL_VarSpecSetFieldPtr(SPEC, FIELDPTR, RC ) - - type (MAPL_VarSpec ), intent(INOUT) :: SPEC - type(ESMF_Field) , pointer :: FIELDPTR - integer , optional , intent( OUT) :: RC - - - - - if(.not.associated(SPEC%SPECPtr)) then - _RETURN(ESMF_FAILURE) - endif - - SPEC%SPECPtr%FIELD => FIELDPTR - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_VarSpecSetFieldPtr - - subroutine MAPL_VarSpecSetBundlePtr(SPEC, BUNDLEPTR, RC ) - - type (MAPL_VarSpec ), intent(INOUT) :: SPEC - type(ESMF_FieldBundle) , pointer :: BUNDLEPTR - integer , optional , intent( OUT) :: RC - - - - - if(.not.associated(SPEC%SPECPtr)) then - _RETURN(ESMF_FAILURE) - endif - - SPEC%SPECPtr%BUNDLE => BUNDLEPTR - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_VarSpecSetBundlePtr - - subroutine MAPL_VarSpecSetStatePtr(SPEC, STATEPTR, RC ) - - type (MAPL_VarSpec ), intent(INOUT) :: SPEC - type(ESMF_State) , pointer :: STATEPTR - integer , optional , intent( OUT) :: RC - - - - - if(.not.associated(SPEC%SPECPtr)) then - _RETURN(ESMF_FAILURE) - endif - - SPEC%SPECPtr%STATE => STATEPTR - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_VarSpecSetStatePtr - - - - subroutine MAPL_VarSpecGetRegular(SPEC, SHORT_NAME, LONG_NAME, UNITS, & - Dims, VLocation, FIELD, BUNDLE, STATE, & - NUM_SUBTILES, & - STAT, ACCMLT_INTERVAL, COUPLE_INTERVAL, & - OFFSET, LABEL, DEFAULT, defaultProvided, & - FRIENDLYTO, & - RESTART, & - HALOWIDTH, & - PRECISION, & - ATTR_RNAMES, ATTR_INAMES, & - ATTR_RVALUES, ATTR_IVALUES, & - UNGRIDDED_DIMS, & - UNGRIDDED_UNIT, & - UNGRIDDED_NAME, & - UNGRIDDED_COORDS, & - FIELD_TYPE, & - STAGGERING, & - ROTATION, & - GRID, & - doNotAllocate, & - alwaysAllocate, & - RC ) - - type (MAPL_VarSpec ), intent(IN ) :: SPEC - character(len=*) , optional , intent(OUT) :: SHORT_NAME - character(len=*) , optional , intent(OUT) :: LONG_NAME - character(len=*) , optional , intent(OUT) :: UNITS - integer , optional , intent(OUT) :: DIMS - integer , optional , intent(OUT) :: VLOCATION - integer , optional , intent(OUT) :: NUM_SUBTILES - integer , optional , intent(OUT) :: ACCMLT_INTERVAL - integer , optional , intent(OUT) :: COUPLE_INTERVAL - integer , optional , intent(OUT) :: OFFSET - integer , optional , intent(OUT) :: STAT - integer , optional , intent(OUT) :: LABEL - real , optional , intent(OUT) :: DEFAULT - logical , optional , intent(OUT) :: defaultProvided - type(ESMF_Field) , optional , intent(OUT) :: FIELD - type(ESMF_FieldBundle) , optional , intent(OUT) :: BUNDLE - type(ESMF_State) , optional , intent(OUT) :: STATE - character(len=*) , optional , intent(OUT) :: FRIENDLYTO - integer , optional , intent(OUT) :: HALOWIDTH - integer , optional , intent(OUT) :: PRECISION - integer , optional , intent(OUT) :: RESTART - character(len=ESMF_MAXSTR), optional, pointer :: ATTR_INAMES(:) - character(len=ESMF_MAXSTR), optional, pointer :: ATTR_RNAMES(:) - integer, optional, pointer :: ATTR_IVALUES(:) - real, optional, pointer :: ATTR_RVALUES(:) - integer, optional, pointer :: UNGRIDDED_DIMS(:) - character(len=*) , optional , intent(OUT) :: UNGRIDDED_UNIT - character(len=*) , optional , intent(OUT) :: UNGRIDDED_NAME - real, optional, pointer :: UNGRIDDED_COORDS(:) - integer, optional :: FIELD_TYPE - integer, optional :: STAGGERING - integer, optional :: ROTATION - type(ESMF_Grid) , optional , intent(OUT) :: GRID - logical , optional , intent(OUT) :: doNotAllocate - logical , optional , intent(OUT) :: alwaysAllocate - integer , optional , intent(OUT) :: RC - - - - - if(.not.associated(SPEC%SPECPtr)) then - _RETURN(ESMF_FAILURE) - endif - - if(present(STAT)) then - STAT = SPEC%SPECPtr%STAT - endif - - if(present(SHORT_NAME)) then - SHORT_NAME = SPEC%SPECPtr%SHORT_NAME - endif - - if(present(LONG_NAME)) then - LONG_NAME = SPEC%SPECPtr%LONG_NAME - endif - - if(present(UNITS)) then - UNITS = SPEC%SPECPtr%UNITS - endif - - if(present(FRIENDLYTO)) then - FRIENDLYTO = SPEC%SPECPtr%FRIENDLYTO - endif - - if(present(DIMS)) then - DIMS = SPEC%SPECPtr%DIMS - endif - - if(present(VLOCATION)) then - VLOCATION = SPEC%SPECPtr%LOCATION - endif - - if(present(NUM_SUBTILES)) then - NUM_SUBTILES = SPEC%SPECPtr%NUM_SUBTILES - endif - - if(present(ACCMLT_INTERVAL)) then - ACCMLT_INTERVAL = SPEC%SPECPtr%ACCMLT_INTERVAL - endif - - if(present(COUPLE_INTERVAL)) then - COUPLE_INTERVAL = SPEC%SPECPtr%COUPLE_INTERVAL - endif - - if(present(OFFSET)) then - OFFSET = SPEC%SPECPtr%OFFSET - endif - - if(present(LABEL)) then - LABEL = SPEC%SPECPtr%LABEL - endif - - if(present(DEFAULT)) then - DEFAULT = SPEC%SPECPtr%DEFAULT - endif - - if(present(defaultProvided)) then - defaultProvided= SPEC%SPECPtr%defaultProvided - endif - - if(present(FIELD)) then - FIELD = SPEC%SPECPtr%FIELD - endif - - if(present(BUNDLE)) then - BUNDLE = SPEC%SPECPtr%BUNDLE - endif - - if(present(STATE)) then - STATE = SPEC%SPECPtr%STATE - endif - - if(present(HALOWIDTH)) then - HALOWIDTH = SPEC%SPECPtr%HALOWIDTH - endif - - if(present(PRECISION)) then - PRECISION = SPEC%SPECPtr%PRECISION - endif - - if(present(RESTART)) then - RESTART = SPEC%SPECPtr%RESTART - endif - - if(present(ATTR_INAMES)) then - ATTR_INAMES => SPEC%SPECPtr%ATTR_INAMES - endif - - if(present(ATTR_RNAMES)) then - ATTR_RNAMES => SPEC%SPECPtr%ATTR_RNAMES - endif - - if(present(ATTR_IVALUES)) then - ATTR_IVALUES => SPEC%SPECPtr%ATTR_IVALUES - endif - - if(present(ATTR_RVALUES)) then - ATTR_RVALUES => SPEC%SPECPtr%ATTR_RVALUES - endif - - if(present(UNGRIDDED_DIMS)) then - UNGRIDDED_DIMS => SPEC%SPECPtr%UNGRIDDED_DIMS - endif - - if(present(UNGRIDDED_UNIT)) then - UNGRIDDED_UNIT = SPEC%SPECPtr%UNGRIDDED_UNIT - endif - - if(present(UNGRIDDED_NAME)) then - UNGRIDDED_NAME = SPEC%SPECPtr%UNGRIDDED_NAME - endif - - if(present(UNGRIDDED_COORDS)) then - UNGRIDDED_COORDS => SPEC%SPECPtr%UNGRIDDED_COORDS - endif - - if(present(FIELD_TYPE)) then - FIELD_TYPE = SPEC%SPECPtr%FIELD_TYPE - endif - - if(present(STAGGERING)) then - STAGGERING = SPEC%SPECPtr%STAGGERING - endif - - if(present(ROTATION)) then - ROTATION = SPEC%SPECPtr%ROTATION - endif - - if(present(GRID)) then - GRID = SPEC%SPECPtr%GRID - endif - - if(present(doNotAllocate)) then - doNotAllocate = SPEC%SPECPtr%doNotAllocate - endif - - if(present(alwaysAllocate)) then - alwaysAllocate = SPEC%SPECPtr%alwaysAllocate - endif - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_VarSpecGetRegular - - subroutine MAPL_VarSpecGetNew(SPEC, SHORT_NAME, LONG_NAME, UNITS, & - Dims, VLocation, FIELD, BUNDLE, STATE, & - NUM_SUBTILES, & - STAT, ACCMLT_INTERVAL, COUPLE_INTERVAL, & - OFFSET, LABEL, DEFAULT, defaultProvided, & - FRIENDLYTO, & - RESTART, & - HALOWIDTH, & - PRECISION, & - ATTR_RNAMES, ATTR_INAMES, & - ATTR_RVALUES, ATTR_IVALUES, & - UNGRIDDED_DIMS, & - UNGRIDDED_UNIT, & - UNGRIDDED_NAME, & - UNGRIDDED_COORDS, & - FIELD_TYPE, & - STAGGERING, & - ROTATION, & - GRID, & - doNotAllocate, & - alwaysAllocate, & - RC ) - - type (MAPL_VarSpecType), intent(IN ) :: SPEC - character(len=*) , optional , intent(OUT) :: SHORT_NAME - character(len=*) , optional , intent(OUT) :: LONG_NAME - character(len=*) , optional , intent(OUT) :: UNITS - integer , optional , intent(OUT) :: DIMS - integer , optional , intent(OUT) :: VLOCATION - integer , optional , intent(OUT) :: NUM_SUBTILES - integer , optional , intent(OUT) :: ACCMLT_INTERVAL - integer , optional , intent(OUT) :: COUPLE_INTERVAL - integer , optional , intent(OUT) :: OFFSET - integer , optional , intent(OUT) :: STAT - integer , optional , intent(OUT) :: LABEL - real , optional , intent(OUT) :: DEFAULT - logical , optional , intent(OUT) :: defaultProvided - type(ESMF_Field) , optional , intent(OUT) :: FIELD - type(ESMF_FieldBundle) , optional , intent(OUT) :: BUNDLE - type(ESMF_State) , optional , intent(OUT) :: STATE - character(len=*) , optional , intent(OUT) :: FRIENDLYTO - integer , optional , intent(OUT) :: HALOWIDTH - integer , optional , intent(OUT) :: PRECISION - integer , optional , intent(OUT) :: RESTART - character(len=ESMF_MAXSTR), optional, pointer :: ATTR_INAMES(:) - character(len=ESMF_MAXSTR), optional, pointer :: ATTR_RNAMES(:) - integer, optional, pointer :: ATTR_IVALUES(:) - real, optional, pointer :: ATTR_RVALUES(:) - integer, optional, pointer :: UNGRIDDED_DIMS(:) - character(len=*) , optional , intent(OUT) :: UNGRIDDED_UNIT - character(len=*) , optional , intent(OUT) :: UNGRIDDED_NAME - real, optional, pointer :: UNGRIDDED_COORDS(:) - integer, optional :: FIELD_TYPE - integer, optional :: STAGGERING - integer, optional :: ROTATION - type(ESMF_Grid) , optional , intent(OUT) :: GRID - logical , optional , intent(OUT) :: doNotAllocate - logical , optional , intent(OUT) :: alwaysAllocate - integer , optional , intent(OUT) :: RC - - - - - if(present(STAT)) then - STAT = SPEC%STAT - endif - - if(present(SHORT_NAME)) then - SHORT_NAME = SPEC%SHORT_NAME - endif - - if(present(LONG_NAME)) then - LONG_NAME = SPEC%LONG_NAME - endif - - if(present(UNITS)) then - UNITS = SPEC%UNITS - endif - - if(present(FRIENDLYTO)) then - FRIENDLYTO = SPEC%FRIENDLYTO - endif - - if(present(DIMS)) then - DIMS = SPEC%DIMS - endif - - if(present(VLOCATION)) then - VLOCATION = SPEC%LOCATION - endif - - if(present(NUM_SUBTILES)) then - NUM_SUBTILES = SPEC%NUM_SUBTILES - endif - - if(present(ACCMLT_INTERVAL)) then - ACCMLT_INTERVAL = SPEC%ACCMLT_INTERVAL - endif - - if(present(COUPLE_INTERVAL)) then - COUPLE_INTERVAL = SPEC%COUPLE_INTERVAL - endif - - if(present(OFFSET)) then - OFFSET = SPEC%OFFSET - endif - - if(present(LABEL)) then - LABEL = SPEC%LABEL - endif - - if(present(DEFAULT)) then - DEFAULT = SPEC%DEFAULT - endif - - if(present(defaultProvided)) then - defaultProvided= SPEC%defaultProvided - endif - - if(present(FIELD)) then - FIELD = SPEC%FIELD - endif - - if(present(BUNDLE)) then - BUNDLE = SPEC%BUNDLE - endif - - if(present(STATE)) then - STATE = SPEC%STATE - endif - - if(present(HALOWIDTH)) then - HALOWIDTH = SPEC%HALOWIDTH - endif - - if(present(PRECISION)) then - PRECISION = SPEC%PRECISION - endif - - if(present(RESTART)) then - RESTART = SPEC%RESTART - endif - - if(present(ATTR_INAMES)) then - ATTR_INAMES => SPEC%ATTR_INAMES - endif - - if(present(ATTR_RNAMES)) then - ATTR_RNAMES => SPEC%ATTR_RNAMES - endif - - if(present(ATTR_IVALUES)) then - ATTR_IVALUES => SPEC%ATTR_IVALUES - endif - - if(present(ATTR_RVALUES)) then - ATTR_RVALUES => SPEC%ATTR_RVALUES - endif - - if(present(UNGRIDDED_DIMS)) then - UNGRIDDED_DIMS => SPEC%UNGRIDDED_DIMS - endif - - if(present(UNGRIDDED_UNIT)) then - UNGRIDDED_UNIT = SPEC%UNGRIDDED_UNIT - endif - - if(present(UNGRIDDED_NAME)) then - UNGRIDDED_NAME = SPEC%UNGRIDDED_NAME - endif - - if(present(UNGRIDDED_COORDS)) then - UNGRIDDED_COORDS => SPEC%UNGRIDDED_COORDS - endif - - if(present(FIELD_TYPE)) then - FIELD_TYPE = SPEC%FIELD_TYPE - endif - - if(present(STAGGERING)) then - STAGGERING = SPEC%STAGGERING - endif - - if(present(ROTATION)) then - ROTATION = SPEC%ROTATION - endif - - if(present(GRID)) then - GRID = SPEC%GRID - endif - - if(present(doNotAllocate)) then - doNotAllocate = SPEC%doNotAllocate - endif - - if(present(alwaysAllocate)) then - alwaysAllocate = SPEC%alwaysAllocate - endif - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_VarSpecGetNew - - - subroutine MAPL_VarSpecGetFieldPtr(SPEC, FIELDPTR, RC ) - - type (MAPL_VarSpec ), intent(IN ) :: SPEC - type(ESMF_Field) , pointer :: FIELDPTR - integer , optional , intent(OUT) :: RC - - - - - if(.not.associated(SPEC%SPECPtr)) then - _RETURN(ESMF_FAILURE) - endif - - FIELDPTR => SPEC%SPECPtr%FIELD - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_VarSpecGetFieldPtr - - subroutine MAPL_VarSpecGetBundlePtr(SPEC, BundlePTR, RC ) - - type (MAPL_VarSpec ), intent(IN ) :: SPEC - type(ESMF_FieldBundle) , pointer :: BUNDLEPTR - integer , optional , intent(OUT) :: RC - - - - - if(.not.associated(SPEC%SPECPtr)) then - _RETURN(ESMF_FAILURE) - endif - - BUNDLEPTR => SPEC%SPECPtr%BUNDLE - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_VarSpecGetBundlePtr - - subroutine MAPL_VarSpecGetStatePtr(SPEC, StatePTR, RC ) - - type (MAPL_VarSpec ), intent(IN ) :: SPEC - type(ESMF_State) , pointer :: STATEPTR - integer , optional , intent(OUT) :: RC - - - - - - if(.not.associated(SPEC%SPECPtr)) then - _RETURN(ESMF_FAILURE) - endif - - STATEPTR => SPEC%SPECPtr%STATE - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_VarSpecGetStatePtr - - - subroutine MAPL_VarSpecAddChildName(SPEC,CN,RC) - - type (MAPL_VarSpec ), pointer :: SPEC(:) - character(len=ESMF_MAXSTR), intent(IN ) :: CN - integer, optional , intent(OUT) :: RC - - - - - integer K - - DO K=1,SIZE(SPEC) - SPEC(K)%SPECptr%LONG_NAME = trim(SPEC(K)%SPECptr%LONG_NAME) // trim(CN) - END DO - - - _RETURN(ESMF_SUCCESS) - END subroutine MAPL_VarSpecAddChildName - - - subroutine MAPL_VarSpecReconnect(SPEC,ITEM,RC) - - type (MAPL_VarSpec ), pointer :: SPEC(:) - type (MAPL_VarSpec ), intent(INOUT) :: ITEM - integer, optional , intent(OUT) :: RC - - - - integer :: STATUS - - type(ESMF_Field), pointer :: FIELD - type(ESMF_FieldBundle), pointer :: BUNDLE - type(ESMF_State), pointer :: STATE - integer I - - if(.not.associated(ITEM%SPECPtr)) then - _RETURN(ESMF_FAILURE) - endif - - if(.not.associated(SPEC)) then - _RETURN(ESMF_FAILURE) - endif - - I=MAPL_VarSpecGetIndex(SPEC, ITEM, RC=STATUS) - _VERIFY(STATUS) - - if (I == -1) then - _RETURN(ESMF_FAILURE) - endif - - if (associated(ITEM%SPECptr%FIELD)) then - deallocate(ITEM%SPECptr%FIELD, STAT=STATUS) - _VERIFY(STATUS) - end if - call MAPL_VarSpecGet(SPEC(I), FIELDPTR=FIELD, RC=STATUS) - _VERIFY(STATUS) - - call MAPL_VarSpecSet(ITEM, FIELDPTR=FIELD, RC=STATUS) - _VERIFY(STATUS) - - if (associated(ITEM%SPECptr%BUNDLE)) then - deallocate(ITEM%SPECptr%BUNDLE, STAT=STATUS) - _VERIFY(STATUS) - end if - call MAPL_VarSpecGet(SPEC(I), BUNDLEPTR=BUNDLE, RC=STATUS) - _VERIFY(STATUS) - - call MAPL_VarSpecSet(ITEM, BUNDLEPTR=BUNDLE, RC=STATUS) - _VERIFY(STATUS) - - if (associated(ITEM%SPECptr%STATE)) then - deallocate(ITEM%SPECptr%STATE, STAT=STATUS) - _VERIFY(STATUS) - end if - call MAPL_VarSpecGet(SPEC(I), STATEPTR=STATE, RC=STATUS) - _VERIFY(STATUS) - - call MAPL_VarSpecSet(ITEM, STATEPTR=STATE, RC=STATUS) - _VERIFY(STATUS) - -! deallocate(ITEM%SPECptr, stat=status) -! _VERIFY(STATUS) - -!! ITEM%SPECptr => SPEC(I)%SPECPtr - - _RETURN(ESMF_SUCCESS) - - - end subroutine MAPL_VarSpecReconnect - - function MAPL_VarSpecEQ(s1, s2) - type (MAPL_VarSpec ), intent(in) :: s1, s2 - logical :: MAPL_VarSpecEQ - - MAPL_VarSpecEQ = .FALSE. - - if (S1%SPECPtr%SHORT_NAME /= S2%SPECPtr%SHORT_NAME ) RETURN -!ALT: for now we do not compare LONG_NAME nor UNITS -!BMA: we also are not comparing FIELD_TYPE i.e. vector or scalar - if (S1%SPECPtr%DIMS /= S2%SPECPtr%DIMS ) RETURN - if (S1%SPECPtr%LOCATION /= S2%SPECPtr%LOCATION ) RETURN - if (S1%SPECPtr%HALOWIDTH /= S2%SPECPtr%HALOWIDTH ) RETURN - if (S1%SPECPtr%PRECISION /= S2%SPECPtr%PRECISION ) RETURN -#if 0 - if (IOR(S1%SPECPtr%STAT,MAPL_CplSATISFIED) & - /= IOR(S2%SPECPtr%STAT,MAPL_CplSATISFIED)) then - RETURN - end if -#endif - if (S1%SPECPtr%ACCMLT_INTERVAL /= 0 .and. & - S2%SPECPtr%ACCMLT_INTERVAL /= 0) then - - if (S1%SPECPtr%ACCMLT_INTERVAL /= S2%SPECPtr%ACCMLT_INTERVAL ) RETURN - if (S1%SPECPtr%COUPLE_INTERVAL /= S2%SPECPtr%COUPLE_INTERVAL ) RETURN - end if - - MAPL_VarSpecEQ = .TRUE. - RETURN - end function MAPL_VarSpecEQ - - function MAPL_VarSpecSamePrec(s1, s2) - type (MAPL_VarSpec ), intent(in) :: s1, s2 - logical :: MAPL_VarSpecSamePrec - - MAPL_VarSpecSamePrec = .FALSE. - - if (S1%SPECPtr%PRECISION /= S2%SPECPtr%PRECISION ) RETURN - - MAPL_VarSpecSamePrec = .TRUE. - RETURN - end function MAPL_VarSpecSamePrec - - subroutine MAPL_VarConnCreate(CONN, SHORT_NAME, TO_NAME, & - FROM_IMPORT, FROM_EXPORT, TO_IMPORT, TO_EXPORT, RC ) - - type (MAPL_VarConn ), pointer :: CONN(:) - character (len=*) , intent(IN ) :: SHORT_NAME - character (len=*), optional, intent(IN ) :: TO_NAME - integer, optional, intent(IN ) :: FROM_IMPORT - integer, optional, intent(IN ) :: FROM_EXPORT - integer, optional, intent(IN ) :: TO_IMPORT - integer, optional, intent(IN ) :: TO_EXPORT - integer, optional, intent( OUT) :: RC ! Error code: - - - - - integer :: STATUS - - type (MAPL_VarConn ), pointer :: TMP(:) => null() - - integer :: usableFROM_IMPORT - integer :: usableFROM_EXPORT - integer :: usableTO_IMPORT - integer :: usableTO_EXPORT - integer :: I - character(len=ESMF_MAXSTR) :: usableTONAME - - if(.not. associated(CONN)) then - allocate(CONN(0),stat=STATUS) - _VERIFY(STATUS) - else -!ALT: check for duplicates ??? - endif - - usableFROM_IMPORT=MAPL_ConnUnknown - usableFROM_EXPORT=MAPL_ConnUnknown - usableTO_IMPORT=MAPL_ConnUnknown - usableTO_EXPORT=MAPL_ConnUnknown - - if(present(TO_NAME)) then - usableTONAME = TO_NAME - else - usableTONAME = SHORT_NAME - endif - - if(present(FROM_IMPORT)) then - usableFROM_IMPORT=FROM_IMPORT - endif - if(present(FROM_EXPORT)) then - usableFROM_EXPORT=FROM_EXPORT - end if - if(present(TO_IMPORT)) then - usableTO_IMPORT=TO_IMPORT - end if - if(present(TO_EXPORT)) then - usableTO_EXPORT=TO_EXPORT - endif - - I = size(CONN) - - allocate(TMP(I+1),stat=STATUS) - _VERIFY(STATUS) - - TMP(1:I) = CONN - deallocate(CONN) - - allocate(TMP(I+1)%CONNPtr,stat=STATUS) - _VERIFY(STATUS) - - TMP(I+1)%CONNPtr%From = MAPL_VarConnPoint(SHORT_NAME, & - usableFROM_IMPORT, usableFROM_EXPORT) - - TMP(I+1)%CONNPtr%To = MAPL_VarConnPoint(usableTONAME, & - usableTO_IMPORT, usableTO_EXPORT) - - CONN => TMP - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_VarConnCreate - - subroutine MAPL_VarConnGet(CONN, SHORT_NAME, & - FROM_IMPORT, FROM_EXPORT, TO_IMPORT, TO_EXPORT, RC ) - - type (MAPL_VarConn ), pointer :: CONN - character (len=*), optional, intent(OUT) :: SHORT_NAME - integer, optional, intent(OUT) :: FROM_IMPORT - integer, optional, intent(OUT) :: FROM_EXPORT - integer, optional, intent(OUT) :: TO_IMPORT - integer, optional, intent(OUT) :: TO_EXPORT - integer, optional, intent(OUT) :: RC ! Error code: - - - - - - - if(.not.associated(CONN%CONNPtr)) then - _RETURN(ESMF_FAILURE) - endif - - if(present(SHORT_NAME)) then - SHORT_NAME = CONN%CONNPtr%FROM%SHORT_NAME - endif - - if(present(FROM_IMPORT)) then - FROM_IMPORT = CONN%CONNPtr%FROM%IMPORT - endif - - if(present(FROM_EXPORT)) then - FROM_EXPORT = CONN%CONNPtr%FROM%EXPORT - endif - - if(present(TO_IMPORT)) then - TO_IMPORT = CONN%CONNPtr%TO%IMPORT - endif - - if(present(TO_EXPORT)) then - TO_EXPORT = CONN%CONNPtr%TO%EXPORT - endif - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_VarConnGet - - logical function MAPL_VarIsConnectedEE(CONN, SHORT_NAME, & - FROM_EXPORT, TO_EXPORT, RC) - type (MAPL_VarConn ), pointer :: CONN(:) - character (len=*), intent(IN ) :: SHORT_NAME - integer, intent(IN ) :: FROM_EXPORT - integer, intent(IN ) :: TO_EXPORT - integer, intent( OUT) :: RC ! Error code: - - - - integer :: I - integer :: FI, TI, FE, TE - - if (.not. associated(CONN)) then - MAPL_VarIsConnectedEE = .false. - _RETURN(ESMF_SUCCESS) - end if - - - DO I = 1, size(CONN) - if (CONN(I)%CONNptr%FROM%SHORT_NAME /= SHORT_NAME) then - cycle - end if - FI = CONN(I)%CONNptr%FROM%IMPORT - FE = CONN(I)%CONNptr%FROM%EXPORT - TI = CONN(I)%CONNptr%TO%IMPORT - TE = CONN(I)%CONNptr%TO%EXPORT - -! check for a match - IF ((FE == FROM_EXPORT) .and. (TE == TO_EXPORT)) then -! check consistency - if (CONN(I)%CONNptr%TO%SHORT_NAME /= SHORT_NAME) then - MAPL_VarIsConnectedEE = .false. - _RETURN(ESMF_FAILURE) - end if - MAPL_VarIsConnectedEE = .true. - CONN(I)%CONNptr%used = .true. - _RETURN(ESMF_SUCCESS) - END IF - - IF(MIN(FI,TI) /= MAPL_ConnUnknown) then - MAPL_VarIsConnectedEE = .false. - _RETURN(ESMF_FAILURE) - end IF -! IF(MIN(FE,TE) /= MAPL_ConnUnknown) then -! MAPL_VarIsConnected = .false. -! _RETURN(ESMF_FAILURE) -! end IF - - END DO - - MAPL_VarIsConnectedEE = .false. - _RETURN(ESMF_SUCCESS) - end function MAPL_VarIsConnectedEE - - logical function MAPL_VarIsConnectedIE(CONN, IMPORT_NAME, EXPORT_NAME, & - IMPORT, EXPORT, RC) - type (MAPL_VarConn ), pointer :: CONN(:) - character (len=*), intent(IN ) :: IMPORT_NAME - character (len=*), optional, intent( OUT) :: EXPORT_NAME - integer, intent(IN ) :: IMPORT - integer, intent(IN ) :: EXPORT - integer, optional, intent( OUT) :: RC ! Error code: - - - - integer :: I - integer :: FI, TI, FE, TE - - MAPL_VarIsConnectedIE = .false. - - if (.not. associated(CONN)) then - _RETURN(ESMF_SUCCESS) - end if - - -! try to find a match with "FROM" - DO I = 1, size(CONN) - if (CONN(I)%CONNptr%FROM%SHORT_NAME /= IMPORT_NAME) then - cycle - end if - FI = CONN(I)%CONNptr%FROM%IMPORT - TE = CONN(I)%CONNptr%TO%EXPORT - - if (FI /= IMPORT) then - cycle - end if - - if (TE /= EXPORT) then - cycle - end if - - MAPL_VarIsConnectedIE = .true. - CONN(I)%CONNptr%used = .true. - if (present(EXPORT_NAME)) then - EXPORT_NAME = CONN(I)%CONNptr%TO%SHORT_NAME - end if - _RETURN(ESMF_SUCCESS) - END DO - -! try to find a match with "TO" - DO I = 1, size(CONN) - if (CONN(I)%CONNptr%TO%SHORT_NAME /= IMPORT_NAME) then - cycle - end if - TI = CONN(I)%CONNptr%TO%IMPORT - FE = CONN(I)%CONNptr%FROM%EXPORT - - if (TI /= IMPORT) then - cycle - end if - - if (FE /= EXPORT) then - cycle - end if - - MAPL_VarIsConnectedIE = .true. - CONN(I)%CONNptr%used = .true. - if (present(EXPORT_NAME)) then - EXPORT_NAME = CONN(I)%CONNptr%FROM%SHORT_NAME - end if - _RETURN(ESMF_SUCCESS) - END DO - - - MAPL_VarIsConnectedIE = .false. - _RETURN(ESMF_SUCCESS) - end function MAPL_VarIsConnectedIE - - logical function MAPL_VarIsConnectedName(CONN, IMPORT_NAME, import, RC) - type (MAPL_VarConn ), pointer :: CONN(:) - character (len=*), intent(IN ) :: IMPORT_NAME - integer, intent(in ) :: import - integer, optional, intent( OUT) :: RC ! Error code: - - - - integer :: I - integer :: TI - - MAPL_VarIsConnectedName = .false. - - if (.not. associated(CONN)) then - _RETURN(ESMF_SUCCESS) - end if - -! try to find a match with "TO" - DO I = 1, size(CONN) - if (CONN(I)%CONNptr%TO%SHORT_NAME /= IMPORT_NAME) then - cycle - end if - - TI = CONN(I)%CONNptr%TO%IMPORT - if (TI /= IMPORT) then - cycle - end if - - MAPL_VarIsConnectedName = .true. - _RETURN(ESMF_SUCCESS) - END DO - - - MAPL_VarIsConnectedName = .false. - _RETURN(ESMF_SUCCESS) - end function MAPL_VarIsConnectedName - - logical function MAPL_VarIsListed(CONN, SHORT_NAME, IMPORT, RC) - type (MAPL_VarConn ), pointer :: CONN(:) - character (len=*), intent(IN) :: SHORT_NAME - integer, intent(IN) :: IMPORT - integer, optional, intent(OUT) :: RC ! Error code: - - - - integer :: I - integer :: FI, TI, FE, TE - - if (.not. associated(CONN)) then - MAPL_VarIsListed = .false. - _RETURN(ESMF_SUCCESS) - end if - - DO I = 1, size(CONN) - if (CONN(I)%CONNptr%FROM%SHORT_NAME /= SHORT_NAME) then - cycle - end if - FI = CONN(I)%CONNptr%FROM%IMPORT - FE = CONN(I)%CONNptr%FROM%EXPORT - TI = CONN(I)%CONNptr%TO%IMPORT - TE = CONN(I)%CONNptr%TO%EXPORT -! first check consistency - IF(MIN(FI,TI) /= MAPL_ConnUnknown) then - MAPL_VarIsListed = .false. - _RETURN(ESMF_FAILURE) - end IF - IF(MIN(FE,TE) /= MAPL_ConnUnknown) then - MAPL_VarIsListed = .false. - _RETURN(ESMF_FAILURE) - end IF -! check for a match - IF(MAX(FI,TI) == IMPORT) then - MAPL_VarIsListed = .true. - CONN(I)%CONNptr%used = .true. - _RETURN(ESMF_SUCCESS) - END IF - END DO - - MAPL_VarIsListed = .false. - _RETURN(ESMF_SUCCESS) - end function MAPL_VarIsListed - - - subroutine MAPL_VarSpecPrintOne(SPEC, RC ) - - type (MAPL_VarSpec ), intent(IN ) :: SPEC - integer , optional , intent(OUT) :: RC - - class(Logger), pointer :: lgr - - if(.not.associated(SPEC%SPECPtr)) then - _RETURN(ESMF_FAILURE) - endif - - call lgr%info('NAME = %a~:%a~:%i3.3', & - trim(spec%specptr%short_name), trim(spec%specptr%long_name), spec%specptr%label) - call lgr%info('ACCUMT = %i0',SPEC%SPECPtr%ACCMLT_INTERVAL) - call lgr%info('COUPLE = %i0',SPEC%SPECPtr%COUPLE_INTERVAL) -!!$ call lgr%info('DIMS = %i0',SPEC%SPECPtr%DIMS) -!!$ call lgr%info('LOCATION = %dims = %i0',SPEC%SPECPtr%location) - - _RETURN(ESMF_SUCCESS) - end subroutine MAPL_VarSpecPrintOne - - subroutine MAPL_VarSpecPrintMany(SPEC, RC ) - - type (MAPL_VarSpec ), intent(IN ) :: SPEC(:) - integer , optional , intent(OUT) :: RC - - - - integer :: STATUS - integer :: I - -! if(.not.associated(SPEC)) then -! _RETURN(ESMF_FAILURE) -! endif - - DO I = 1, size(SPEC) - call MAPL_VarSpecPrint(Spec(I), RC=status) - _VERIFY(STATUS) - END DO - - _RETURN(ESMF_SUCCESS) - end subroutine MAPL_VarSpecPrintMany - - - subroutine MAPL_VarSpecPrint1CSV(SPEC, compName, RC ) - - type (MAPL_VarSpec ), intent(IN ) :: SPEC - character(len=*), intent(IN ) :: compName - integer , optional , intent(OUT) :: RC - - class(Logger), pointer :: lgr - - if(.not.associated(SPEC%SPECPtr)) then - _RETURN(ESMF_FAILURE) - endif - - lgr => logging%get_logger('MAPL.GENERIC') - call lgr%info('%a~, %a~, %a~, %i3', & - trim(compName), trim(spec%specptr%short_name), trim(spec%specptr%long_name), & - spec%specptr%dims) - - _RETURN(ESMF_SUCCESS) - end subroutine MAPL_VarSpecPrint1CSV - - subroutine MAPL_VarSpecPrintCSV(SPEC, compName, RC ) - - type (MAPL_VarSpec ), intent(IN ) :: SPEC(:) - character(len=*), intent(IN ) :: compName - integer , optional , intent(OUT) :: RC - - - - integer :: STATUS - integer :: I - - DO I = 1, size(SPEC) - call MAPL_VarSpecPrint1CSV(Spec(I), compName, RC=status) - _VERIFY(STATUS) - END DO - - _RETURN(ESMF_SUCCESS) - end subroutine MAPL_VarSpecPrintCSV - - logical function MAPL_ConnCheckUnused(CONN) - type (MAPL_VarConn ), pointer :: CONN(:) - - integer :: I - class(Logger), pointer :: lgr - - MAPL_ConnCheckUnused = .true. - if (.not. associated(CONN)) then - return - end if - - DO I = 1, size(CONN) - if (CONN(I)%CONNptr%notRequired) cycle - if (.not. CONN(I)%CONNptr%USED) then - MAPL_ConnCheckUnused = .false. - lgr => logging%get_logger('MAPL.GENERIC') - call lgr%error( & - 'SRC_NAME: <%a~> DST_NAME: <%a~> is not satisfied', & - trim(CONN(I)%CONNptr%FROM%SHORT_NAME),trim(CONN(I)%CONNptr%TO%SHORT_NAME)) - end if - end DO - - return - end function MAPL_ConnCheckUnused - - subroutine MAPL_ConnCheckReq(CONN, ImSpecPtr, ExSpecPtr, RC) - type (MAPL_VarConn), pointer :: CONN(:) - type (MAPL_VarSpecPtr), pointer :: ImSpecPtr(:) - type (MAPL_VarSpecPtr), pointer :: ExSpecPtr(:) - integer, optional, intent(OUT) :: RC - - - integer :: I, J - integer :: IMP - integer :: FI - integer :: TI - integer :: FE - integer :: TE - character(len=ESMF_MAXSTR) :: NAME - - if (.not. associated(CONN)) then - _RETURN(ESMF_SUCCESS) - end if - - do I = 1, size(CONN) - FI = CONN(I)%CONNptr%FROM%IMPORT - TI = CONN(I)%CONNptr%TO%IMPORT - - IMP = MAPL_ConnUnknown - if(FI /= MAPL_ConnUnknown) then - IMP = FI - NAME = CONN(I)%CONNptr%FROM%SHORT_NAME - else if (TI /= MAPL_ConnUnknown) then - IMP = TI - NAME = CONN(I)%CONNptr%TO%SHORT_NAME - end if - - if (IMP /= MAPL_ConnUnknown) then - ! check if the component has an import spec - if(.not. associated(ImSpecPtr(IMP)%Spec)) then - CONN(I)%CONNptr%notRequired = .true. - cycle - end if - if(MAPL_VarSpecGetIndex(ImSpecPtr(IMP)%Spec, NAME)==-1) then - - FE = CONN(I)%CONNptr%FROM%EXPORT - TE = CONN(I)%CONNptr%TO%EXPORT - - J = MAPL_ConnUnknown - if(FE /= MAPL_ConnUnknown) then - J = FE - NAME = CONN(I)%CONNptr%FROM%SHORT_NAME - else if (TE /= MAPL_ConnUnknown) then - J = TE - NAME = CONN(I)%CONNptr%TO%SHORT_NAME - end if - - if(MAPL_VarSpecGetIndex(ExSpecPtr(J)%Spec, NAME)/=-1) then -! Export does exist while import does not - we relax the requirement - CONN(I)%CONNptr%notRequired = .true. - end if - endif - end if - - end do - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_ConnCheckReq - -end module MAPL_VarSpecMod diff --git a/generic/MaplGeneric.F90 b/generic/MaplGeneric.F90 index 2fdd6916bb9e..772111c3cbff 100644 --- a/generic/MaplGeneric.F90 +++ b/generic/MaplGeneric.F90 @@ -4,8 +4,11 @@ module MaplGeneric use mapl_ComponentSpecification use mapl_VariableSpecification use mapl_StateSpecification + use mapl_VarSpecMiscMod use mapl_VarSpecVector - use mapl_VarSpecMod + use mapl_VarConnType + use mapl_VarConnVector + use mapl_VarConn use mapl_ServiceConnectionItemVector use mapl_ProvidedServiceItemVector use mapl_RequestedServiceItemVector diff --git a/generic/StateSpecification.F90 b/generic/StateSpecification.F90 index 26d328e07435..32dcc15a84d4 100644 --- a/generic/StateSpecification.F90 +++ b/generic/StateSpecification.F90 @@ -6,7 +6,7 @@ module mapl_StateSpecification use mapl_Constants use mapl_ErrorHandlingMod use mapl_VarSpecVector - use mapl_VarSpecMod + use mapl_VarSpecMiscMod use mapl_VariableSpecification implicit none diff --git a/generic/VarConn.F90 b/generic/VarConn.F90 new file mode 100644 index 000000000000..6558ef424530 --- /dev/null +++ b/generic/VarConn.F90 @@ -0,0 +1,285 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" +module mapl_VarConn + use ESMF + use MAPL_Constants, only: MAPL_ConnUnknown, MAPL_Self + use MAPL_VarSpecPtrMod + use MAPL_VarSpecMod + use MAPL_VarConnPoint + use MAPL_VarConnType + use MAPL_VarConnVector + use MAPL_ErrorHandlingMod + use pFlogger + implicit none + private + + public :: VarConn ! wraps VarConnVector (vector of VarConnType) + + ! A trivial wrapper to encapsulate management of + ! vector under the hood. + type VarConn +!!$ private + type(VarConnVector) :: conn_v + contains + procedure :: append + procedure :: checkReq + procedure :: checkUnused + procedure :: varIsConnected_IE + procedure :: varIsConnected_name + generic :: varIsConnected => varIsConnected_IE + generic :: varIsConnected => varIsConnected_name + procedure :: varIsListed + end type VarConn + +contains + + + subroutine append(CONN, SHORT_NAME, TO_NAME, & + FROM_EXPORT, TO_IMPORT, RC ) + + class (VarConn ), intent(inout) :: CONN + character (len=*) , intent(IN ) :: SHORT_NAME + character (len=*), optional, intent(IN ) :: TO_NAME + integer, optional, intent(IN ) :: FROM_EXPORT + integer, optional, intent(IN ) :: TO_IMPORT + integer, optional, intent( OUT) :: RC ! Error code: + + + integer :: usableFROM_EXPORT + integer :: usableTO_IMPORT + type(VarConnType), pointer :: new_conn + character(len=ESMF_MAXSTR) :: usableTONAME + + usableFROM_EXPORT=MAPL_ConnUnknown + usableTO_IMPORT=MAPL_ConnUnknown + + if(present(TO_NAME)) then + usableTONAME = TO_NAME + else + usableTONAME = SHORT_NAME + endif + + if(present(FROM_EXPORT)) then + usableFROM_EXPORT=FROM_EXPORT + end if + if(present(TO_IMPORT)) then + usableTO_IMPORT=TO_IMPORT + end if + + ! Push and then construct. + call conn%conn_v%resize(conn%conn_v%size()+1) + new_conn => CONN%conn_v%back() + new_conn%From = VarConnPoint(SHORT_NAME, gc_id=usableFROM_EXPORT) + new_conn%To = VarConnPoint(usableTONAME, gc_id=usableTO_IMPORT) + + _RETURN(ESMF_SUCCESS) + + end subroutine append + + subroutine checkReq(this, ImSpecPtr, ExSpecPtr, RC) + class (VarConn), target, intent(inout) :: this + type (MAPL_VarSpecPtr), pointer :: ImSpecPtr(:) + type (MAPL_VarSpecPtr), pointer :: ExSpecPtr(:) + integer, optional, intent(OUT) :: RC + + + type(VarConnType), pointer :: conn + integer :: I, J + integer :: IMP + integer :: FI + integer :: TI + integer :: FE + integer :: TE + character(len=ESMF_MAXSTR) :: NAME + + associate (conn_v => this%conn_v) + do I = 1, conn_v%size() + conn => conn_v%of(i) + + FI = MAPL_ConnUnknown + TI = conn%to%get_gc_id() + + IMP = MAPL_ConnUnknown + if(FI /= MAPL_ConnUnknown) then + IMP = FI + NAME = conn%FROM%get_short_name() + else if (TI /= MAPL_ConnUnknown) then + IMP = TI + NAME = conn%TO%get_short_name() + end if + + if (IMP /= MAPL_ConnUnknown .and. IMP /= MAPL_Self) then + ! check if the component has an import spec + if(.not. associated(ImSpecPtr(IMP)%Spec)) then + conn%notRequired = .true. + cycle + end if + if(MAPL_VarSpecGetIndex(ImSpecPtr(IMP)%Spec, NAME)==-1) then + + FE = conn%from%get_gc_id() + TE = MAPL_ConnUnknown + + J = MAPL_ConnUnknown + if(FE /= MAPL_ConnUnknown) then + J = FE + NAME = conn%FROM%get_short_name() + else if (TE /= MAPL_ConnUnknown) then + J = TE + NAME = conn%TO%get_short_name() + end if + + if(MAPL_VarSpecGetIndex(ExSpecPtr(J)%Spec, NAME)/=-1) then + ! Export does exist while import does not - we relax the requirement + conn%notRequired = .true. + end if + endif + end if + + end do + end associate + _RETURN(ESMF_SUCCESS) + + end subroutine CheckReq + + logical function checkUnused(this) + class(VarConn), target, intent(inout) :: this + + integer :: I + class(Logger), pointer :: lgr + type(VarConnType), pointer :: conn + + associate (conn_v => this%conn_v) + checkUnused = .true. + + do I = 1, conn_v%size() + conn => conn_v%of(i) + if (conn%notRequired) cycle + if (.not. conn%USED) then + checkUnused = .false. + lgr => logging%get_logger('MAPL.GENERIC') + call lgr%error( & + 'SRC_NAME: <%a~> DST_NAME: <%a~> is not satisfied', & + trim(conn%FROM%get_short_name()),trim(conn%TO%get_short_name())) + end if + end do + end associate + return + + end function CheckUnused + + logical function varIsConnected_IE(this, IMPORT_NAME, EXPORT_NAME, & + import, EXPORT, RC) + class(VarConn), target, intent(inout) :: this + character (len=*), intent(IN ) :: IMPORT_NAME + character (len=*), optional, intent( OUT) :: EXPORT_NAME + integer, intent(IN ) :: IMPORT + integer, intent(IN ) :: EXPORT + integer, optional, intent( OUT) :: RC ! Error code: + + + + integer :: I + integer :: TI, FE + type(VarConnType), pointer :: conn + + varIsConnected_IE = .false. + + ! try to find a match with "TO" + associate (conn_v => this%conn_v) + do I = 1, conn_v%size() + conn => conn_v%of(i) + if (conn%TO%get_short_name() /= IMPORT_NAME) then + cycle + end if + TI = conn%to%get_gc_id() + FE = conn%from%get_gc_id() + + if (TI /= import) then + cycle + end if + + if (FE /= EXPORT) then + cycle + end if + + varIsConnected_IE = .true. + conn%used = .true. + if (present(EXPORT_NAME)) then + EXPORT_NAME = conn%FROM%get_short_name() + end if + _RETURN(ESMF_SUCCESS) + end do + end associate + varIsConnected_IE = .false. + + _RETURN(ESMF_SUCCESS) + end function VarIsConnected_IE + + logical function varIsConnected_name(this, IMPORT_NAME, import, RC) + class(VarConn), target, intent(inout):: this + character (len=*), intent(IN ) :: IMPORT_NAME + integer, intent(in ) :: import + integer, optional, intent( OUT) :: RC ! Error code: + + + integer :: I + integer :: TI + type(VarConnType), pointer :: conn + + varIsConnected_name = .false. + + associate (conn_v => this%conn_v) + ! try to find a match with "TO" + do I = 1, conn_v%size() + conn => conn_v%of(i) + if (conn%to%get_short_name() /= IMPORT_NAME) then + cycle + end if + + TI = conn%to%get_gc_id() + if (TI /= import) then + cycle + end if + + varIsConnected_name = .true. + _RETURN(ESMF_SUCCESS) + end do + end associate + + varIsConnected_name = .false. + + _RETURN(ESMF_SUCCESS) + end function VarIsConnected_Name + + logical function varIsListed(this, SHORT_NAME, import, RC) + class(VarConn ), target, intent(inout):: this + character (len=*), intent(IN) :: SHORT_NAME + integer, intent(IN) :: IMPORT + integer, optional, intent(OUT) :: RC ! Error code: + + type(VarConnType), pointer :: conn + integer :: I + integer :: TI + + associate (conn_v => this%conn_v) + do I = 1, conn_v%size() + conn => conn_v%of(i) + if (conn%FROM%get_short_name() /= SHORT_NAME) then + cycle + end if + TI = conn%to%get_gc_id() + ! check for a match + if(TI == import) then + varIsListed = .true. + conn%used = .true. + _RETURN(ESMF_SUCCESS) + end if + end do + end associate + + varIsListed = .false. + _RETURN(ESMF_SUCCESS) + end function VarIsListed + + +end module mapl_VarConn diff --git a/generic/VarConnPoint.F90 b/generic/VarConnPoint.F90 new file mode 100644 index 000000000000..a51e47c47b94 --- /dev/null +++ b/generic/VarConnPoint.F90 @@ -0,0 +1,48 @@ +module MAPL_VarConnPoint + use ESMF, only: ESMF_MAXSTR + use oomph, only: ConnectionPoint + implicit none + private + + public :: VarConnPoint + + type VarConnPoint + private + type(ConnectionPoint) :: new_connection_point + character(len=ESMF_MAXSTR) :: short_name + integer :: gc_id + contains + procedure :: get_short_name + procedure :: get_gc_id + end type VarConnPoint + + interface VarConnPoint + module procedure new_VarConnPoint + end interface VarConnPoint + +contains + + function new_VarConnPoint(short_name, gc_id) result(conn_point) + use MAPL_KeywordEnforcerMod + type(VarConnPoint) :: conn_point + character(*), intent(in) :: short_name + integer, intent(in) :: gc_id + + conn_point%new_connection_point%state_item = trim(short_name) + conn_point%gc_id = gc_id + end function new_VarConnPoint + + function get_short_name(this) result(short_name) + class(VarConnPoint), intent(in) :: this + character(:), allocatable :: short_name + + short_name = this%new_connection_point%state_item + end function get_short_name + + integer function get_gc_id(this) result(gc_id) + class(VarConnPoint), intent(in) :: this + gc_id = this%gc_id + end function get_gc_id + + +end module MAPL_VarConnPoint diff --git a/generic/VarConnType.F90 b/generic/VarConnType.F90 new file mode 100644 index 000000000000..288c8b0abc18 --- /dev/null +++ b/generic/VarConnType.F90 @@ -0,0 +1,16 @@ +module mapl_VarConnType + use mapl_VarConnPoint + implicit none + private + + public :: VarConnType + + type VarConnType +!!$ private + type (VarConnPoint) :: FROM + type (VarConnPoint) :: TO + logical :: used = .false. + logical :: notRequired = .false. + end type VarConnType + +end module mapl_VarConnType diff --git a/generic/VarConnVector.F90 b/generic/VarConnVector.F90 new file mode 100644 index 000000000000..b3b29d906fe9 --- /dev/null +++ b/generic/VarConnVector.F90 @@ -0,0 +1,13 @@ +module mapl_VarConnVector + use mapl_VarConnType, only: VarConnType + +#define T VarConnType +#define Vector VarConnVector +#define VectorIterator VarConnVectorIterator + +#include "vector/template.inc" + +#undef VectorIterator +#undef Vector +#undef T +end module mapl_VarConnVector diff --git a/generic/VarSpec.F90 b/generic/VarSpec.F90 new file mode 100644 index 000000000000..080cce7fff9f --- /dev/null +++ b/generic/VarSpec.F90 @@ -0,0 +1,1687 @@ +#include "MAPL_ErrLog.h" +module MAPL_VarSpecMod + use ESMF + use MAPL_VarSpecTypeMod + use MAPL_ErrorHandlingMod + use MAPL_Constants + use pFlogger + implicit none + private + + public :: MAPL_VarSpec + + public :: MAPL_VarSpecCreateInList + public :: MAPL_VarSpecAddToList + public :: MAPL_VarSpecSet + public :: MAPL_VarSpecGet + public :: MAPL_VarSpecDestroy + public :: MAPL_VarSpecAddChildName + public :: MAPL_VarSpecReconnect + public :: MAPL_VarSpecGetIndex + public :: MAPL_VarSpecAddRefToList + public :: MAPL_VarSpecPrint + public :: MAPL_VarSpecPrintCSV + public MAPL_VarSpecSamePrec + + public operator(==) + + type :: MAPL_VarSpec +!!$ private + type(MAPL_VarSpecType), pointer :: SpecPtr => null() + end type MAPL_VarSpec + + + interface MAPL_VarSpecAddToList + module procedure MAPL_VarSpecAddFromItem + module procedure MAPL_VarSpecAddFromList + end interface MAPL_VarSpecAddToList + + interface MAPL_VarSpecDestroy + module procedure MAPL_VarSpecDestroy0 + module procedure MAPL_VarSpecDestroy1 + end interface MAPL_VarSpecDestroy + + interface MAPL_VarSpecSet + module procedure MAPL_VarSpecSetRegular + module procedure MAPL_VarSpecSetFieldPtr + module procedure MAPL_VarSpecSetBundlePtr + module procedure MAPL_VarSpecSetStatePtr + end interface MAPL_VarSpecSet + + interface MAPL_VarSpecGet + module procedure MAPL_VarSpecGetRegular + module procedure MAPL_VarSpecGetNew + module procedure MAPL_VarSpecGetFieldPtr + module procedure MAPL_VarSpecGetBundlePtr + module procedure MAPL_VarSpecGetStatePtr + end interface MAPL_VarSpecGet + + interface MAPL_VarSpecPrint + module procedure MAPL_VarSpecPrintOne + module procedure MAPL_VarSpecPrintMany + end interface MAPL_VarSpecPrint + + interface MAPL_VarSpecAddRefToList + module procedure MAPL_VarSpecAddRefFromItem + module procedure MAPL_VarSpecAddRefFromList + end interface MAPL_VarSpecAddRefToList + + interface MAPL_VarSpecGetIndex + module procedure MAPL_VarSpecGetIndexByName + module procedure MAPL_VarSpecGetIndexOfItem + end interface MAPL_VarSpecGetIndex + + + + interface operator (==) + module procedure MAPL_VarSpecEQ + end interface operator (==) + +contains + + + 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, & + 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 + 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=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 + + 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%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 + + + subroutine MAPL_VarSpecAddFromItem(SPEC,ITEM,RC) + + type (MAPL_VarSpec ), pointer :: SPEC(:) + type (MAPL_VarSpec ), intent(IN ) :: ITEM + integer, optional , intent(OUT) :: RC + + + + integer :: STATUS + + + if(.not.associated(ITEM%SPECPtr)) then + _RETURN(ESMF_FAILURE) + endif + + call MAPL_VarSpecCreateInList(SPEC, & + SHORT_NAME = ITEM%SPECPTR%SHORT_NAME, & + LONG_NAME = ITEM%SPECPTR%LONG_NAME, & + UNITS = ITEM%SPECPTR%UNITS, & + DIMS = ITEM%SPECPTR%Dims, & + VLOCATION = ITEM%SPECPTR%Location, & + STAT = ITEM%SPECPTR%STAT, & + ACCMLT_INTERVAL = ITEM%SPECPTR%ACCMLT_INTERVAL, & + COUPLE_INTERVAL = ITEM%SPECPTR%COUPLE_INTERVAL, & + DEFAULT = ITEM%SPECPTR%DEFAULT, & + FIELD = ITEM%SPECPTR%FIELD, & + BUNDLE = ITEM%SPECPTR%BUNDLE, & + STATE = ITEM%SPECPTR%STATE, & + HALOWIDTH = ITEM%SPECPTR%HALOWIDTH, & + RESTART = ITEM%SPECPTR%RESTART, & + PRECISION = ITEM%SPECPTR%PRECISION, & + ATTR_INAMES = ITEM%SPECPTR%ATTR_INAMES, & + ATTR_RNAMES = ITEM%SPECPTR%ATTR_RNAMES, & + ATTR_IVALUES = ITEM%SPECPTR%ATTR_IVALUES, & + ATTR_RVALUES = ITEM%SPECPTR%ATTR_RVALUES, & + UNGRIDDED_DIMS = ITEM%SPECPTR%UNGRIDDED_DIMS, & + FIELD_TYPE = ITEM%SPECPTR%FIELD_TYPE, & + STAGGERING = ITEM%SPECPTR%STAGGERING, & + ROTATION = ITEM%SPECPTR%ROTATION, & + GRID = ITEM%SPECPTR%GRID, & + RC=STATUS ) + _VERIFY(STATUS) + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_VarSpecAddFromItem + + + subroutine MAPL_VarSpecAddFromList(SPEC,ITEM,RC) + + type (MAPL_VarSpec ), pointer :: SPEC(:) + type (MAPL_VarSpec ), intent(IN ) :: ITEM(:) + integer, optional , intent(OUT) :: RC + + + + integer :: STATUS + + integer I + + do I=1,size(ITEM) + call MAPL_VarSpecAddFromItem(SPEC,ITEM(I),RC=STATUS) + _VERIFY(STATUS) + enddo + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_VarSpecAddFromList + + + subroutine MAPL_VarSpecDestroy0(SPEC, RC ) + + type (MAPL_VarSpec ), intent(INOUT) :: SPEC + integer , optional , intent(OUT) :: RC + + + + + if(associated(SPEC%SPECPtr)) then + deallocate(SPEC%SPECPtr) + endif + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_VarSpecDestroy0 + + subroutine MAPL_VarSpecDestroy1(SPEC, RC ) + + type (MAPL_VarSpec ), pointer :: SPEC(:) + integer , optional , intent(OUT) :: RC + + + + integer :: i + + if (associated(SPEC)) then + do I=1,size(SPEC) + call MAPL_VarSpecDestroy0(spec(i)) + end do + deallocate(SPEC) + end if + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_VarSpecDestroy1 + + + subroutine MAPL_VarSpecSetRegular(SPEC, SHORT_NAME, LONG_NAME, UNITS, & + Dims, VLocation, FIELD, BUNDLE, STATE, & + STAT, ACCMLT_INTERVAL, COUPLE_INTERVAL, & + OFFSET, LABEL, & + FRIENDLYTO, & + FIELD_TYPE, & + STAGGERING, & + ROTATION, & + GRID, & + doNotAllocate, & + alwaysAllocate, & + RC ) + + type (MAPL_VarSpec ), intent(INOUT) :: SPEC + character(len=*) , optional , intent(IN) :: SHORT_NAME + character(len=*) , optional , intent(IN) :: LONG_NAME + character(len=*) , optional , intent(IN) :: UNITS + integer , optional , intent(IN) :: DIMS + integer , optional , intent(IN) :: VLOCATION + integer , optional , intent(IN) :: ACCMLT_INTERVAL + integer , optional , intent(IN) :: COUPLE_INTERVAL + integer , optional , intent(IN) :: OFFSET + integer , optional , intent(IN) :: STAT + integer , optional , intent(IN) :: LABEL + type(ESMF_Field) , optional , intent(IN) :: FIELD + type(ESMF_FieldBundle) , optional , intent(IN) :: BUNDLE + type(ESMF_State) , optional , intent(IN) :: STATE + character(len=*) , optional , intent(IN) :: FRIENDLYTO + 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) :: doNotAllocate + logical , optional , intent(IN) :: alwaysAllocate + integer , optional , intent(OUT) :: RC + + + + + if(.not.associated(SPEC%SPECPtr)) then + _RETURN(ESMF_FAILURE) + endif + + if(present(SHORT_NAME)) then + SPEC%SPECPtr%SHORT_NAME = SHORT_NAME + endif + + if(present(LONG_NAME)) then + SPEC%SPECPtr%LONG_NAME = LONG_NAME + endif + + if(present(UNITS)) then + SPEC%SPECPtr%UNITS = UNITS + endif + + if(present(FRIENDLYTO)) then + SPEC%SPECPtr%FRIENDLYTO = FRIENDLYTO + endif + + if(present(STAT)) then + SPEC%SPECPtr%STAT=STAT + endif + + if(present(DIMS)) then + SPEC%SPECPtr%DIMS=DIMS + endif + + if(present(VLOCATION)) then + SPEC%SPECPtr%LOCATION=VLOCATION + endif + + if(present(ACCMLT_INTERVAL)) then + SPEC%SPECPtr%ACCMLT_INTERVAL=ACCMLT_INTERVAL + endif + + if(present(COUPLE_INTERVAL)) then + SPEC%SPECPtr%COUPLE_INTERVAL=COUPLE_INTERVAL + endif + + if(present(OFFSET)) then + SPEC%SPECPtr%OFFSET=OFFSET + endif + + if(present(LABEL)) then + SPEC%SPECPtr%LABEL=LABEL + endif + + if(present(FIELD)) then + SPEC%SPECPtr%FIELD = FIELD + endif + + if(present(BUNDLE)) then + SPEC%SPECPtr%BUNDLE = BUNDLE + endif + + if(present(STATE)) then + SPEC%SPECPtr%STATE = STATE + endif + + if(present(GRID)) then + SPEC%SPECPtr%GRID = GRID + endif + + if(present(FIELD_TYPE)) then + SPEC%SPECPtr%FIELD_TYPE = FIELD_TYPE + endif + + if(present(STAGGERING)) then + SPEC%SPECPtr%STAGGERING = STAGGERING + endif + + if(present(ROTATION)) then + SPEC%SPECPtr%ROTATION = ROTATION + endif + + if(present(doNotAllocate)) then + SPEC%SPECPtr%doNotAllocate = doNotAllocate + endif + + if(present(alwaysAllocate)) then + SPEC%SPECPtr%alwaysAllocate = alwaysAllocate + endif + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_VarSpecSetRegular + + subroutine MAPL_VarSpecSetFieldPtr(SPEC, FIELDPTR, RC ) + + type (MAPL_VarSpec ), intent(INOUT) :: SPEC + type(ESMF_Field) , pointer :: FIELDPTR + integer , optional , intent( OUT) :: RC + + + + + if(.not.associated(SPEC%SPECPtr)) then + _RETURN(ESMF_FAILURE) + endif + + SPEC%SPECPtr%FIELD => FIELDPTR + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_VarSpecSetFieldPtr + + subroutine MAPL_VarSpecSetBundlePtr(SPEC, BUNDLEPTR, RC ) + + type (MAPL_VarSpec ), intent(INOUT) :: SPEC + type(ESMF_FieldBundle) , pointer :: BUNDLEPTR + integer , optional , intent( OUT) :: RC + + + + + if(.not.associated(SPEC%SPECPtr)) then + _RETURN(ESMF_FAILURE) + endif + + SPEC%SPECPtr%BUNDLE => BUNDLEPTR + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_VarSpecSetBundlePtr + + subroutine MAPL_VarSpecSetStatePtr(SPEC, STATEPTR, RC ) + + type (MAPL_VarSpec ), intent(INOUT) :: SPEC + type(ESMF_State) , pointer :: STATEPTR + integer , optional , intent( OUT) :: RC + + + + + if(.not.associated(SPEC%SPECPtr)) then + _RETURN(ESMF_FAILURE) + endif + + SPEC%SPECPtr%STATE => STATEPTR + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_VarSpecSetStatePtr + + + + subroutine MAPL_VarSpecGetRegular(SPEC, SHORT_NAME, LONG_NAME, UNITS, & + Dims, VLocation, FIELD, BUNDLE, STATE, & + NUM_SUBTILES, & + STAT, ACCMLT_INTERVAL, COUPLE_INTERVAL, & + OFFSET, LABEL, DEFAULT, defaultProvided, & + FRIENDLYTO, & + RESTART, & + HALOWIDTH, & + PRECISION, & + ATTR_RNAMES, ATTR_INAMES, & + ATTR_RVALUES, ATTR_IVALUES, & + UNGRIDDED_DIMS, & + UNGRIDDED_UNIT, & + UNGRIDDED_NAME, & + UNGRIDDED_COORDS, & + FIELD_TYPE, & + STAGGERING, & + ROTATION, & + GRID, & + doNotAllocate, & + alwaysAllocate, & + RC ) + + type (MAPL_VarSpec ), intent(IN ) :: SPEC + character(len=*) , optional , intent(OUT) :: SHORT_NAME + character(len=*) , optional , intent(OUT) :: LONG_NAME + character(len=*) , optional , intent(OUT) :: UNITS + integer , optional , intent(OUT) :: DIMS + integer , optional , intent(OUT) :: VLOCATION + integer , optional , intent(OUT) :: NUM_SUBTILES + integer , optional , intent(OUT) :: ACCMLT_INTERVAL + integer , optional , intent(OUT) :: COUPLE_INTERVAL + integer , optional , intent(OUT) :: OFFSET + integer , optional , intent(OUT) :: STAT + integer , optional , intent(OUT) :: LABEL + real , optional , intent(OUT) :: DEFAULT + logical , optional , intent(OUT) :: defaultProvided + type(ESMF_Field) , optional , intent(OUT) :: FIELD + type(ESMF_FieldBundle) , optional , intent(OUT) :: BUNDLE + type(ESMF_State) , optional , intent(OUT) :: STATE + character(len=*) , optional , intent(OUT) :: FRIENDLYTO + integer , optional , intent(OUT) :: HALOWIDTH + integer , optional , intent(OUT) :: PRECISION + integer , optional , intent(OUT) :: RESTART + character(len=ESMF_MAXSTR), optional, pointer :: ATTR_INAMES(:) + character(len=ESMF_MAXSTR), optional, pointer :: ATTR_RNAMES(:) + integer, optional, pointer :: ATTR_IVALUES(:) + real, optional, pointer :: ATTR_RVALUES(:) + integer, optional, pointer :: UNGRIDDED_DIMS(:) + character(len=*) , optional , intent(OUT) :: UNGRIDDED_UNIT + character(len=*) , optional , intent(OUT) :: UNGRIDDED_NAME + real, optional, pointer :: UNGRIDDED_COORDS(:) + integer, optional :: FIELD_TYPE + integer, optional :: STAGGERING + integer, optional :: ROTATION + type(ESMF_Grid) , optional , intent(OUT) :: GRID + logical , optional , intent(OUT) :: doNotAllocate + logical , optional , intent(OUT) :: alwaysAllocate + integer , optional , intent(OUT) :: RC + + + + + if(.not.associated(SPEC%SPECPtr)) then + _RETURN(ESMF_FAILURE) + endif + + if(present(STAT)) then + STAT = SPEC%SPECPtr%STAT + endif + + if(present(SHORT_NAME)) then + SHORT_NAME = SPEC%SPECPtr%SHORT_NAME + endif + + if(present(LONG_NAME)) then + LONG_NAME = SPEC%SPECPtr%LONG_NAME + endif + + if(present(UNITS)) then + UNITS = SPEC%SPECPtr%UNITS + endif + + if(present(FRIENDLYTO)) then + FRIENDLYTO = SPEC%SPECPtr%FRIENDLYTO + endif + + if(present(DIMS)) then + DIMS = SPEC%SPECPtr%DIMS + endif + + if(present(VLOCATION)) then + VLOCATION = SPEC%SPECPtr%LOCATION + endif + + if(present(NUM_SUBTILES)) then + NUM_SUBTILES = SPEC%SPECPtr%NUM_SUBTILES + endif + + if(present(ACCMLT_INTERVAL)) then + ACCMLT_INTERVAL = SPEC%SPECPtr%ACCMLT_INTERVAL + endif + + if(present(COUPLE_INTERVAL)) then + COUPLE_INTERVAL = SPEC%SPECPtr%COUPLE_INTERVAL + endif + + if(present(OFFSET)) then + OFFSET = SPEC%SPECPtr%OFFSET + endif + + if(present(LABEL)) then + LABEL = SPEC%SPECPtr%LABEL + endif + + if(present(DEFAULT)) then + DEFAULT = SPEC%SPECPtr%DEFAULT + endif + + if(present(defaultProvided)) then + defaultProvided= SPEC%SPECPtr%defaultProvided + endif + + if(present(FIELD)) then + FIELD = SPEC%SPECPtr%FIELD + endif + + if(present(BUNDLE)) then + BUNDLE = SPEC%SPECPtr%BUNDLE + endif + + if(present(STATE)) then + STATE = SPEC%SPECPtr%STATE + endif + + if(present(HALOWIDTH)) then + HALOWIDTH = SPEC%SPECPtr%HALOWIDTH + endif + + if(present(PRECISION)) then + PRECISION = SPEC%SPECPtr%PRECISION + endif + + if(present(RESTART)) then + RESTART = SPEC%SPECPtr%RESTART + endif + + if(present(ATTR_INAMES)) then + ATTR_INAMES => SPEC%SPECPtr%ATTR_INAMES + endif + + if(present(ATTR_RNAMES)) then + ATTR_RNAMES => SPEC%SPECPtr%ATTR_RNAMES + endif + + if(present(ATTR_IVALUES)) then + ATTR_IVALUES => SPEC%SPECPtr%ATTR_IVALUES + endif + + if(present(ATTR_RVALUES)) then + ATTR_RVALUES => SPEC%SPECPtr%ATTR_RVALUES + endif + + if(present(UNGRIDDED_DIMS)) then + UNGRIDDED_DIMS => SPEC%SPECPtr%UNGRIDDED_DIMS + endif + + if(present(UNGRIDDED_UNIT)) then + UNGRIDDED_UNIT = SPEC%SPECPtr%UNGRIDDED_UNIT + endif + + if(present(UNGRIDDED_NAME)) then + UNGRIDDED_NAME = SPEC%SPECPtr%UNGRIDDED_NAME + endif + + if(present(UNGRIDDED_COORDS)) then + UNGRIDDED_COORDS => SPEC%SPECPtr%UNGRIDDED_COORDS + endif + + if(present(FIELD_TYPE)) then + FIELD_TYPE = SPEC%SPECPtr%FIELD_TYPE + endif + + if(present(STAGGERING)) then + STAGGERING = SPEC%SPECPtr%STAGGERING + endif + + if(present(ROTATION)) then + ROTATION = SPEC%SPECPtr%ROTATION + endif + + if(present(GRID)) then + GRID = SPEC%SPECPtr%GRID + endif + + if(present(doNotAllocate)) then + doNotAllocate = SPEC%SPECPtr%doNotAllocate + endif + + if(present(alwaysAllocate)) then + alwaysAllocate = SPEC%SPECPtr%alwaysAllocate + endif + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_VarSpecGetRegular + + subroutine MAPL_VarSpecGetNew(SPEC, SHORT_NAME, LONG_NAME, UNITS, & + Dims, VLocation, FIELD, BUNDLE, STATE, & + NUM_SUBTILES, & + STAT, ACCMLT_INTERVAL, COUPLE_INTERVAL, & + OFFSET, LABEL, DEFAULT, defaultProvided, & + FRIENDLYTO, & + RESTART, & + HALOWIDTH, & + PRECISION, & + ATTR_RNAMES, ATTR_INAMES, & + ATTR_RVALUES, ATTR_IVALUES, & + UNGRIDDED_DIMS, & + UNGRIDDED_UNIT, & + UNGRIDDED_NAME, & + UNGRIDDED_COORDS, & + FIELD_TYPE, & + STAGGERING, & + ROTATION, & + GRID, & + doNotAllocate, & + alwaysAllocate, & + RC ) + + type (MAPL_VarSpecType), intent(IN ) :: SPEC + character(len=*) , optional , intent(OUT) :: SHORT_NAME + character(len=*) , optional , intent(OUT) :: LONG_NAME + character(len=*) , optional , intent(OUT) :: UNITS + integer , optional , intent(OUT) :: DIMS + integer , optional , intent(OUT) :: VLOCATION + integer , optional , intent(OUT) :: NUM_SUBTILES + integer , optional , intent(OUT) :: ACCMLT_INTERVAL + integer , optional , intent(OUT) :: COUPLE_INTERVAL + integer , optional , intent(OUT) :: OFFSET + integer , optional , intent(OUT) :: STAT + integer , optional , intent(OUT) :: LABEL + real , optional , intent(OUT) :: DEFAULT + logical , optional , intent(OUT) :: defaultProvided + type(ESMF_Field) , optional , intent(OUT) :: FIELD + type(ESMF_FieldBundle) , optional , intent(OUT) :: BUNDLE + type(ESMF_State) , optional , intent(OUT) :: STATE + character(len=*) , optional , intent(OUT) :: FRIENDLYTO + integer , optional , intent(OUT) :: HALOWIDTH + integer , optional , intent(OUT) :: PRECISION + integer , optional , intent(OUT) :: RESTART + character(len=ESMF_MAXSTR), optional, pointer :: ATTR_INAMES(:) + character(len=ESMF_MAXSTR), optional, pointer :: ATTR_RNAMES(:) + integer, optional, pointer :: ATTR_IVALUES(:) + real, optional, pointer :: ATTR_RVALUES(:) + integer, optional, pointer :: UNGRIDDED_DIMS(:) + character(len=*) , optional , intent(OUT) :: UNGRIDDED_UNIT + character(len=*) , optional , intent(OUT) :: UNGRIDDED_NAME + real, optional, pointer :: UNGRIDDED_COORDS(:) + integer, optional :: FIELD_TYPE + integer, optional :: STAGGERING + integer, optional :: ROTATION + type(ESMF_Grid) , optional , intent(OUT) :: GRID + logical , optional , intent(OUT) :: doNotAllocate + logical , optional , intent(OUT) :: alwaysAllocate + integer , optional , intent(OUT) :: RC + + + + + if(present(STAT)) then + STAT = SPEC%STAT + endif + + if(present(SHORT_NAME)) then + SHORT_NAME = SPEC%SHORT_NAME + endif + + if(present(LONG_NAME)) then + LONG_NAME = SPEC%LONG_NAME + endif + + if(present(UNITS)) then + UNITS = SPEC%UNITS + endif + + if(present(FRIENDLYTO)) then + FRIENDLYTO = SPEC%FRIENDLYTO + endif + + if(present(DIMS)) then + DIMS = SPEC%DIMS + endif + + if(present(VLOCATION)) then + VLOCATION = SPEC%LOCATION + endif + + if(present(NUM_SUBTILES)) then + NUM_SUBTILES = SPEC%NUM_SUBTILES + endif + + if(present(ACCMLT_INTERVAL)) then + ACCMLT_INTERVAL = SPEC%ACCMLT_INTERVAL + endif + + if(present(COUPLE_INTERVAL)) then + COUPLE_INTERVAL = SPEC%COUPLE_INTERVAL + endif + + if(present(OFFSET)) then + OFFSET = SPEC%OFFSET + endif + + if(present(LABEL)) then + LABEL = SPEC%LABEL + endif + + if(present(DEFAULT)) then + DEFAULT = SPEC%DEFAULT + endif + + if(present(defaultProvided)) then + defaultProvided= SPEC%defaultProvided + endif + + if(present(FIELD)) then + FIELD = SPEC%FIELD + endif + + if(present(BUNDLE)) then + BUNDLE = SPEC%BUNDLE + endif + + if(present(STATE)) then + STATE = SPEC%STATE + endif + + if(present(HALOWIDTH)) then + HALOWIDTH = SPEC%HALOWIDTH + endif + + if(present(PRECISION)) then + PRECISION = SPEC%PRECISION + endif + + if(present(RESTART)) then + RESTART = SPEC%RESTART + endif + + if(present(ATTR_INAMES)) then + ATTR_INAMES => SPEC%ATTR_INAMES + endif + + if(present(ATTR_RNAMES)) then + ATTR_RNAMES => SPEC%ATTR_RNAMES + endif + + if(present(ATTR_IVALUES)) then + ATTR_IVALUES => SPEC%ATTR_IVALUES + endif + + if(present(ATTR_RVALUES)) then + ATTR_RVALUES => SPEC%ATTR_RVALUES + endif + + if(present(UNGRIDDED_DIMS)) then + UNGRIDDED_DIMS => SPEC%UNGRIDDED_DIMS + endif + + if(present(UNGRIDDED_UNIT)) then + UNGRIDDED_UNIT = SPEC%UNGRIDDED_UNIT + endif + + if(present(UNGRIDDED_NAME)) then + UNGRIDDED_NAME = SPEC%UNGRIDDED_NAME + endif + + if(present(UNGRIDDED_COORDS)) then + UNGRIDDED_COORDS => SPEC%UNGRIDDED_COORDS + endif + + if(present(FIELD_TYPE)) then + FIELD_TYPE = SPEC%FIELD_TYPE + endif + + if(present(STAGGERING)) then + STAGGERING = SPEC%STAGGERING + endif + + if(present(ROTATION)) then + ROTATION = SPEC%ROTATION + endif + + if(present(GRID)) then + GRID = SPEC%GRID + endif + + if(present(doNotAllocate)) then + doNotAllocate = SPEC%doNotAllocate + endif + + if(present(alwaysAllocate)) then + alwaysAllocate = SPEC%alwaysAllocate + endif + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_VarSpecGetNew + + + subroutine MAPL_VarSpecGetFieldPtr(SPEC, FIELDPTR, RC ) + + type (MAPL_VarSpec ), intent(IN ) :: SPEC + type(ESMF_Field) , pointer :: FIELDPTR + integer , optional , intent(OUT) :: RC + + + + + if(.not.associated(SPEC%SPECPtr)) then + _RETURN(ESMF_FAILURE) + endif + + FIELDPTR => SPEC%SPECPtr%FIELD + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_VarSpecGetFieldPtr + + subroutine MAPL_VarSpecGetBundlePtr(SPEC, BundlePTR, RC ) + + type (MAPL_VarSpec ), intent(IN ) :: SPEC + type(ESMF_FieldBundle) , pointer :: BUNDLEPTR + integer , optional , intent(OUT) :: RC + + + + + if(.not.associated(SPEC%SPECPtr)) then + _RETURN(ESMF_FAILURE) + endif + + BUNDLEPTR => SPEC%SPECPtr%BUNDLE + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_VarSpecGetBundlePtr + + subroutine MAPL_VarSpecGetStatePtr(SPEC, StatePTR, RC ) + + type (MAPL_VarSpec ), intent(IN ) :: SPEC + type(ESMF_State) , pointer :: STATEPTR + integer , optional , intent(OUT) :: RC + + + + + + if(.not.associated(SPEC%SPECPtr)) then + _RETURN(ESMF_FAILURE) + endif + + STATEPTR => SPEC%SPECPtr%STATE + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_VarSpecGetStatePtr + + + subroutine MAPL_VarSpecAddChildName(SPEC,CN,RC) + + type (MAPL_VarSpec ), pointer :: SPEC(:) + character(len=ESMF_MAXSTR), intent(IN ) :: CN + integer, optional , intent(OUT) :: RC + + + + + integer K + + DO K=1,SIZE(SPEC) + SPEC(K)%SPECptr%LONG_NAME = trim(SPEC(K)%SPECptr%LONG_NAME) // trim(CN) + END DO + + + _RETURN(ESMF_SUCCESS) + END subroutine MAPL_VarSpecAddChildName + + + subroutine MAPL_VarSpecReconnect(SPEC,ITEM,RC) + + type (MAPL_VarSpec ), pointer :: SPEC(:) + type (MAPL_VarSpec ), intent(INOUT) :: ITEM + integer, optional , intent(OUT) :: RC + + + + integer :: STATUS + + type(ESMF_Field), pointer :: FIELD + type(ESMF_FieldBundle), pointer :: BUNDLE + type(ESMF_State), pointer :: STATE + integer I + + if(.not.associated(ITEM%SPECPtr)) then + _RETURN(ESMF_FAILURE) + endif + + if(.not.associated(SPEC)) then + _RETURN(ESMF_FAILURE) + endif + + I=MAPL_VarSpecGetIndex(SPEC, ITEM, RC=STATUS) + _VERIFY(STATUS) + + if (I == -1) then + _RETURN(ESMF_FAILURE) + endif + + if (associated(ITEM%SPECptr%FIELD)) then + deallocate(ITEM%SPECptr%FIELD, STAT=STATUS) + _VERIFY(STATUS) + end if + call MAPL_VarSpecGet(SPEC(I), FIELDPTR=FIELD, RC=STATUS) + _VERIFY(STATUS) + + call MAPL_VarSpecSet(ITEM, FIELDPTR=FIELD, RC=STATUS) + _VERIFY(STATUS) + + if (associated(ITEM%SPECptr%BUNDLE)) then + deallocate(ITEM%SPECptr%BUNDLE, STAT=STATUS) + _VERIFY(STATUS) + end if + call MAPL_VarSpecGet(SPEC(I), BUNDLEPTR=BUNDLE, RC=STATUS) + _VERIFY(STATUS) + + call MAPL_VarSpecSet(ITEM, BUNDLEPTR=BUNDLE, RC=STATUS) + _VERIFY(STATUS) + + if (associated(ITEM%SPECptr%STATE)) then + deallocate(ITEM%SPECptr%STATE, STAT=STATUS) + _VERIFY(STATUS) + end if + call MAPL_VarSpecGet(SPEC(I), STATEPTR=STATE, RC=STATUS) + _VERIFY(STATUS) + + call MAPL_VarSpecSet(ITEM, STATEPTR=STATE, RC=STATUS) + _VERIFY(STATUS) + + ! deallocate(ITEM%SPECptr, stat=status) + ! _VERIFY(STATUS) + + !! ITEM%SPECptr => SPEC(I)%SPECPtr + + _RETURN(ESMF_SUCCESS) + + + end subroutine MAPL_VarSpecReconnect + + function MAPL_VarSpecEQ(s1, s2) + type (MAPL_VarSpec ), intent(in) :: s1, s2 + logical :: MAPL_VarSpecEQ + + MAPL_VarSpecEQ = .FALSE. + + if (S1%SPECPtr%SHORT_NAME /= S2%SPECPtr%SHORT_NAME ) RETURN + !ALT: for now we do not compare LONG_NAME nor UNITS + !BMA: we also are not comparing FIELD_TYPE i.e. vector or scalar + if (S1%SPECPtr%DIMS /= S2%SPECPtr%DIMS ) RETURN + if (S1%SPECPtr%LOCATION /= S2%SPECPtr%LOCATION ) RETURN + if (S1%SPECPtr%HALOWIDTH /= S2%SPECPtr%HALOWIDTH ) RETURN + if (S1%SPECPtr%PRECISION /= S2%SPECPtr%PRECISION ) RETURN +#if 0 + if (IOR(S1%SPECPtr%STAT,MAPL_CplSATISFIED) & + /= IOR(S2%SPECPtr%STAT,MAPL_CplSATISFIED)) then + RETURN + end if +#endif + if (S1%SPECPtr%ACCMLT_INTERVAL /= 0 .and. & + S2%SPECPtr%ACCMLT_INTERVAL /= 0) then + + if (S1%SPECPtr%ACCMLT_INTERVAL /= S2%SPECPtr%ACCMLT_INTERVAL ) RETURN + if (S1%SPECPtr%COUPLE_INTERVAL /= S2%SPECPtr%COUPLE_INTERVAL ) RETURN + end if + + MAPL_VarSpecEQ = .TRUE. + RETURN + end function MAPL_VarSpecEQ + + function MAPL_VarSpecSamePrec(s1, s2) + type (MAPL_VarSpec ), intent(in) :: s1, s2 + logical :: MAPL_VarSpecSamePrec + + MAPL_VarSpecSamePrec = .FALSE. + + if (S1%SPECPtr%PRECISION /= S2%SPECPtr%PRECISION ) RETURN + + MAPL_VarSpecSamePrec = .TRUE. + RETURN + end function MAPL_VarSpecSamePrec + + subroutine MAPL_VarSpecPrintOne(SPEC, RC ) + + type (MAPL_VarSpec ), intent(IN ) :: SPEC + integer , optional , intent(OUT) :: RC + + class(Logger), pointer :: lgr + + if(.not.associated(SPEC%SPECPtr)) then + _RETURN(ESMF_FAILURE) + endif + + call lgr%info('NAME = %a~:%a~:%i3.3', & + trim(spec%specptr%short_name), trim(spec%specptr%long_name), spec%specptr%label) + call lgr%info('ACCUMT = %i0',SPEC%SPECPtr%ACCMLT_INTERVAL) + call lgr%info('COUPLE = %i0',SPEC%SPECPtr%COUPLE_INTERVAL) +!!$ call lgr%info('DIMS = %i0',SPEC%SPECPtr%DIMS) +!!$ call lgr%info('LOCATION = %dims = %i0',SPEC%SPECPtr%location) + + _RETURN(ESMF_SUCCESS) + end subroutine MAPL_VarSpecPrintOne + + subroutine MAPL_VarSpecPrintMany(SPEC, RC ) + + type (MAPL_VarSpec ), intent(IN ) :: SPEC(:) + integer , optional , intent(OUT) :: RC + + + + integer :: STATUS + integer :: I + + ! if(.not.associated(SPEC)) then + ! _RETURN(ESMF_FAILURE) + ! endif + + DO I = 1, size(SPEC) + call MAPL_VarSpecPrint(Spec(I), RC=status) + _VERIFY(STATUS) + END DO + + _RETURN(ESMF_SUCCESS) + end subroutine MAPL_VarSpecPrintMany + + + subroutine MAPL_VarSpecPrintCSV(SPEC, compName, RC ) + + type (MAPL_VarSpec ), intent(in ) :: spec(:) + character(len=*), intent(in ) :: compName + integer , optional , intent(out) :: RC + + integer :: status + integer :: i + + do I = 1, size(spec) + call MAPL_VarSpecPrint1CSV(Spec(I), compName, RC=status) + _VERIFY(status) + end do + + _RETURN(ESMF_SUCCESS) + end subroutine MAPL_VarSpecPrintCSV + + subroutine MAPL_VarSpecPrint1CSV(spec, compName, rc ) + use pFlogger + type (MAPL_VarSpec ), intent(in ) :: spec + character(len=*), intent(in ) :: compName + integer , optional , intent(out) :: RC + + class(Logger), pointer :: lgr + + if(.not.associated(SPEC%SPECPtr)) then + _RETURN(ESMF_FAILURE) + endif + + lgr => logging%get_logger('MAPL.GENERIC') + call lgr%info('%a~, %a~, %a~, %i3', & + trim(compName), trim(spec%specptr%short_name), trim(spec%specptr%long_name), & + spec%specptr%dims) + + _RETURN(ESMF_SUCCESS) + end subroutine MAPL_VarSpecPrint1CSV + + subroutine MAPL_VarSpecAddRefFromItem(SPEC, ITEM, ALLOW_DUPLICATES, RC) + + type (MAPL_VarSpec ), pointer :: SPEC(:) + type (MAPL_VarSpec ), intent(IN ) :: ITEM + logical, optional , intent(IN) :: ALLOW_DUPLICATES + integer, optional , intent(OUT) :: RC + + + + integer :: STATUS + + type (MAPL_VarSpec ), pointer :: TMP(:) => null() + integer :: I + logical :: usableALLOW_DUPLICATES + class(Logger), pointer :: lgr + + + if(present(ALLOW_DUPLICATES)) then + usableALLOW_DUPLICATES=ALLOW_DUPLICATES + else + usableALLOW_DUPLICATES=.FALSE. + endif + + + if(.not.associated(ITEM%SPECPtr)) then + _RETURN(ESMF_FAILURE) + endif + + if(associated(SPEC)) then + if (.not. usableALLOW_DUPLICATES) then + I = MAPL_VarSpecGetIndex(SPEC, ITEM, RC=STATUS) + _VERIFY(STATUS) + if(I /= -1) then + if (SPEC(I) == ITEM) THEN + if(present(RC)) then + RC=MAPL_DuplicateEntry + end if + return + else + lgr => logging%get_logger('MAPL.GENERIC') + call lgr%error("Duplicate SHORT_NAME %a with different attributes.", trim(ITEM%SPECPtr%short_name)) + call MAPL_VarSpecPrint(ITEM) + call MAPL_VarSpecPrint(SPEC(I)) + _RETURN(ESMF_FAILURE) + end if + endif + end if + else + allocate(SPEC(0),stat=STATUS) + _VERIFY(STATUS) + endif + + I = size(SPEC) + + allocate(TMP(I+1),stat=STATUS) + _VERIFY(STATUS) + + TMP(1:I) = SPEC + deallocate(SPEC) + + TMP(I+1)%SPECPtr => ITEM%SPECPtr + SPEC => TMP + + _RETURN(ESMF_SUCCESS) + + + end subroutine MAPL_VarSpecAddRefFromItem + + subroutine MAPL_VarSpecAddRefFromList(SPEC,ITEM,RC) + + type (MAPL_VarSpec ), pointer :: SPEC(:) + type (MAPL_VarSpec ), intent(IN ) :: ITEM(:) + integer, optional , intent(OUT) :: RC + + + + integer :: STATUS + + integer I + + do I=1,size(ITEM) + call MAPL_VarSpecAddRefFromItem(SPEC,ITEM(I),RC=STATUS) + IF (STATUS /= MAPL_DuplicateEntry) then + _VERIFY(STATUS) + END IF + enddo + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_VarSpecAddRefFromList + + + function MAPL_VarSpecGetIndexByName(SPEC, NAME, RC) result (INDEX) + type (MAPL_VarSpec ) , intent(in) :: SPEC(:) + character (len=*) , intent(IN) :: NAME + integer, optional , intent(OUT) :: RC + integer :: INDEX + + + integer :: I + + + do I = 1, size(SPEC) + if(.not.associated(SPEC(I)%SPECPtr)) then + _RETURN(ESMF_FAILURE) + endif + if (trim(SPEC(I)%SPECPtr%SHORT_NAME) == trim(NAME)) then + INDEX = I + _RETURN(ESMF_SUCCESS) + endif + enddo + + INDEX = -1 ! not found + _RETURN(ESMF_SUCCESS) + + end function MAPL_VarSpecGetIndexByName + + + + subroutine MAPL_VarSpecGetDataByName(SPEC, NAME, PTR1, PTR2, PTR3, RC) + type (MAPL_VarSpec ) , intent(INout):: SPEC(:) + character (len=*) , intent(IN) :: NAME + real, optional, pointer :: PTR1(:) + real, optional, pointer :: PTR2(:,:) + real, optional, pointer :: PTR3(:,:,:) + integer, optional , intent(OUT) :: RC + + + integer :: STATUS + + integer :: I + + do I = 1, size(SPEC) + if(.not.associated(SPEC(I)%SPECPtr)) then + _RETURN(ESMF_FAILURE) + endif + + if (trim(SPEC(I)%SPECPtr%SHORT_NAME) == trim(NAME)) then + call MAPL_VarSpecGetData(SPEC(I),PTR1,PTR2,PTR3,RC=STATUS) + _VERIFY(STATUS) + _RETURN(ESMF_SUCCESS) + endif + enddo + + _RETURN(ESMF_FAILURE) + + end subroutine MAPL_VarSpecGetDataByName + + + subroutine MAPL_VarSpecGetData(SPEC, PTR1, PTR2, PTR3, RC) + type (MAPL_VarSpec ) , intent(INout):: SPEC + real, optional, pointer :: PTR1(:) + real, optional, pointer :: PTR2(:,:) + real, optional, pointer :: PTR3(:,:,:) + integer, optional , intent(OUT) :: RC + + + integer :: STATUS + + type(ESMF_Array) :: ARRAY + + if(.not.associated(SPEC%SPECPtr)) then + _RETURN(ESMF_FAILURE) + endif + + call ESMF_FieldGet(SPEC%SPECPtr%FIELD,Array=ARRAY,rc=STATUS) + _VERIFY(STATUS) + + if (present(PTR1)) then + call ESMF_ArrayGet(ARRAY, localDE=0, farrayptr=PTR1, RC=STATUS) + _VERIFY(STATUS) + _ASSERT(.not.present(PTR2),'needs informative message') + _ASSERT(.not.present(PTR3),'needs informative message') + _RETURN(ESMF_SUCCESS) + endif + + if (present(PTR2)) then + call ESMF_ArrayGet(ARRAY, localDE=0, farrayptr=PTR2, RC=STATUS) + _VERIFY(STATUS) + _ASSERT(.not.present(PTR3),'needs informative message') + _RETURN(ESMF_SUCCESS) + endif + + if (present(PTR3)) then + call ESMF_ArrayGet(ARRAY, localDE=0, farrayptr=PTR3, RC=STATUS) + _VERIFY(STATUS) + _RETURN(ESMF_SUCCESS) + endif + + _RETURN(ESMF_FAILURE) + + end subroutine MAPL_VarSpecGetData + + function MAPL_VarSpecGetIndexOfItem(SPEC, ITEM, RC) result (INDEX) + type (MAPL_VarSpec ) , intent(in) :: SPEC(:) + type (MAPL_VarSpec ) , intent(in) :: ITEM + integer, optional , intent(OUT) :: RC + integer :: INDEX + + + + integer :: I + + do I = 1, size(SPEC) + if(.not.associated(SPEC(I)%SPECPtr)) then + _RETURN(ESMF_FAILURE) + endif + + if (trim(SPEC(I)%SPECPtr%SHORT_NAME) == trim(ITEM%SPECPtr%SHORT_NAME)) then + if (SPEC(I) == ITEM) then + INDEX = I + _RETURN(ESMF_SUCCESS) + end if + endif + enddo + + INDEX = -1 ! not found + _RETURN(ESMF_SUCCESS) + + end function MAPL_VarSpecGetIndexOfItem + +end module MAPL_VarSpecMod diff --git a/generic/VarSpecMiscMod.F90 b/generic/VarSpecMiscMod.F90 new file mode 100644 index 000000000000..49e95d70008e --- /dev/null +++ b/generic/VarSpecMiscMod.F90 @@ -0,0 +1,62 @@ +#include "MAPL_ErrLog.h" + +!============================================================================= +!BOP + +! !MODULE: MAPL_VarSpecMiscMod -- A class for manipulation variable specifications. + +! !INTERFACE: + +module MAPL_VarSpecMiscMod + +! !USES: + + use ESMF + use pFlogger + use MAPL_Constants + use MAPL_ExceptionHandling + use mapl_VariableSpecification + use mapl_VarSpecVector + use mapl_VarConnVector + use MAPL_VarSpecTypeMod + use MAPL_VarSpecMod + use MAPL_VarSpecPtrMod + use MAPL_VarConnPoint + use MAPL_VarConnType + use MAPL_VarConn +! !PUBLIC MEMBER FUNCTIONS: + +implicit none +private + + +! re export + public :: MAPL_VarSpecType + public :: MAPL_VarSpec + public :: MAPL_VarSpecPtr + public :: VarConnPoint + public :: VarConnType + + public :: MAPL_VarSpecCreateInList + public :: MAPL_VarSpecAddToList + public :: MAPL_VarSpecSet + public :: MAPL_VarSpecGet + public :: MAPL_VarSpecDestroy + public :: MAPL_VarSpecAddChildName + public :: MAPL_VarSpecReconnect + public :: MAPL_VarSpecGetIndex + public :: MAPL_VarSpecAddRefToList + public :: MAPL_VarSpecPrint + public :: MAPL_VarSpecPrintCSV + public :: operator(==) + +!EOP + +contains + + + + + + +end module MAPL_VarSpecMiscMod diff --git a/generic/VarSpecPtr.F90 b/generic/VarSpecPtr.F90 new file mode 100644 index 000000000000..67011ff3e1d5 --- /dev/null +++ b/generic/VarSpecPtr.F90 @@ -0,0 +1,12 @@ +module Mapl_VarSpecPtrMod + use MAPL_VarSpecMod + implicit none + private + + public :: MAPL_VarSpecPtr + + type :: MAPL_VarSpecPtr + type(MAPL_VarSpec), pointer :: Spec(:) => null() + end type MAPL_VarSpecPtr + +end module Mapl_VarSpecPtrMod diff --git a/generic/VarSpecType.F90 b/generic/VarSpecType.F90 new file mode 100644 index 000000000000..e0e0313c2b2c --- /dev/null +++ b/generic/VarSpecType.F90 @@ -0,0 +1,243 @@ +! This type should be private to generic layer. + +#include "MAPL_ErrLog.h" + +module MAPL_VarSpecTypeMod + use ESMF, only: ESMF_MAXSTR, ESMF_SUCCESS + use ESMF, only: ESMF_Grid + use ESMF, only: ESMF_Field, ESMF_FieldBundle, ESMF_State + use mapl_ErrorHandlingMod + + use oomph, only: HorizontalStaggerLoc + use oomph, only: VerticalStaggerLoc + use oomph, only: UngriddedDimSpec + use oomph, only: DimsSpec + use oomph, only: FieldSpec + implicit none + private + + public :: MAPL_VarSpecType + public :: MAPL_VarSpecSet + + type :: MAPL_VarSpecType + ! new + type(FieldSpec) :: field_spec + + ! legacy + character(len=ESMF_MAXSTR) :: SHORT_NAME + character(len=ESMF_MAXSTR) :: LONG_NAME + character(len=ESMF_MAXSTR) :: UNITS + character(len=ESMF_MAXSTR) :: FRIENDLYTO + character(len=ESMF_MAXSTR) :: VECTOR_PAIR + character(len=ESMF_MAXSTR), pointer :: ATTR_INAMES(:) => null() + character(len=ESMF_MAXSTR), pointer :: ATTR_RNAMES(:) => null() + integer, pointer :: ATTR_IVALUES(:) => null() + real, pointer :: ATTR_RVALUES(:) => null() + integer, pointer :: UNGRIDDED_DIMS(:) => null() + character(len=ESMF_MAXSTR) :: UNGRIDDED_UNIT + character(len=ESMF_MAXSTR) :: UNGRIDDED_NAME + real, pointer :: UNGRIDDED_COORDS(:) + integer :: DIMS + integer :: LOCATION + integer :: NUM_SUBTILES + integer :: STAT + integer :: ACCMLT_INTERVAL + integer :: COUPLE_INTERVAL + integer :: OFFSET + integer :: LABEL + integer :: HALOWIDTH + integer :: PRECISION + integer :: FIELD_TYPE + integer :: VECTOR_ORDER + integer :: STAGGERING + integer :: ROTATION + integer :: RESTART + logical :: defaultProvided + logical :: doNotAllocate + logical :: alwaysAllocate ! meant for export specs + real :: DEFAULT + type(ESMF_Field), pointer :: FIELD => null() + type(ESMF_FieldBundle), pointer :: BUNDLE => null() + type(ESMF_State), pointer :: STATE => null() + type(ESMF_Grid) :: GRID + contains + procedure :: MAPL_VarSpecSetNew + generic :: MAPL_VarSpecSet => MAPL_VarSpecSetNew + end type MAPL_VarSpecType + + interface MAPL_VarSpecSet + module procedure MAPL_VarSpecSetNew + end interface MAPL_VarSpecSet + +contains + + subroutine MAPL_VarSpecSetNew(spec, short_name, long_name, units, & + dims, vlocation, field, bundle, state, & + stat, accmlt_interval, couple_interval, & + offset, label, & + friendlyto, & + field_type, & + staggering, & + rotation, & + grid, & + donotallocate, & + alwaysallocate, & + rc ) + + class(mapl_varspectype), intent(inout) :: spec + character(len=*) , optional , intent(in) :: short_name + character(len=*) , optional , intent(in) :: long_name + character(len=*) , optional , intent(in) :: units + integer , optional , intent(in) :: dims + integer , optional , intent(in) :: vlocation + integer , optional , intent(in) :: accmlt_interval + integer , optional , intent(in) :: couple_interval + integer , optional , intent(in) :: offset + integer , optional , intent(in) :: stat + integer , optional , intent(in) :: label + type(ESMF_field) , optional , intent(in) :: field + type(ESMF_fieldbundle) , optional , intent(in) :: bundle + type(ESMF_state) , optional , intent(in) :: state + character(len=*) , optional , intent(in) :: friendlyto + 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) :: donotallocate + logical , optional , intent(in) :: alwaysallocate + integer , optional , intent(out) :: rc + + + + if(present(short_name)) then + spec%short_name = short_name + endif + + if(present(long_name)) then + spec%long_name = long_name + endif + + if(present(units)) then + spec%units = units + endif + + if(present(friendlyto)) then + spec%friendlyto = friendlyto + endif + + if(present(stat)) then + spec%stat=stat + endif + + if(present(dims)) then + spec%dims=dims + endif + + if(present(vlocation)) then + spec%location=vlocation + endif + + if(present(accmlt_interval)) then + spec%accmlt_interval=accmlt_interval + endif + + if(present(couple_interval)) then + spec%couple_interval=couple_interval + endif + + if(present(offset)) then + spec%offset=offset + endif + + if(present(label)) then + spec%label=label + endif + + if(present(field)) then + spec%field = field + endif + + if(present(bundle)) then + spec%bundle = bundle + endif + + if(present(state)) then + spec%state = state + endif + + if(present(grid)) then + spec%grid = grid + endif + + if(present(field_type)) then + spec%field_type = field_type + endif + + if(present(staggering)) then + spec%staggering = staggering + endif + + if(present(rotation)) then + spec%rotation = rotation + endif + + if(present(donotallocate)) then + spec%donotallocate = donotallocate + endif + + if(present(alwaysallocate)) then + spec%alwaysallocate = alwaysallocate + endif + + associate( & + horz_spec => create_horz_stagger_spec(spec), & + vert_spec => create_vert_stagger_spec(spec), & + ungr_spec => create_ungridded_dim_specs(spec), & + tk_spec => create_tk_spec(spec)) + associate( dims_spec => DimsSpec(horz_spec, vert_spec, ungr_spec, spec%halowidth)) + + spec%field_spec = FieldSpec(spec%long_name, dims_spec, tk_spec) + + end associate + end associate + + _RETURN(ESMF_SUCCESS) + + contains + + function create_horz_stagger_spec(this) result(horz_spec) + type(HorizontalStaggerLoc) :: horz_spec + type(MAPL_VarSpecType), intent(in) :: this + end function create_horz_stagger_spec + + function create_vert_stagger_spec(this) result(vert_spec) + type(VerticalStaggerLoc) :: vert_spec + type(MAPL_VarSpecType), intent(in) :: this + end function create_vert_stagger_spec + + function create_ungridded_dim_specs(this) result(ungr_spec) + type(UngriddedDimSpec), allocatable :: ungr_spec(:) + type(MAPL_VarSpecType), intent(in) :: this + end function create_ungridded_dim_specs + + function create_tk_spec(this) result(tk_spec) + use esmf, only: ESMF_KIND_R4, ESMF_KIND_R8 + use esmf, only: ESMF_TYPEKIND_R4, ESMF_TYPEKIND_R8 + use esmf, only: ESMF_TYPEKIND_FLAG + type(ESMF_TypeKind_Flag) :: tk_spec + type(MAPL_VarSpecType), intent(in) :: this + + select case (this%precision) + case (ESMF_KIND_R4) + tk_spec = ESMF_TYPEKIND_R4 + case (ESMF_KIND_R8) + tk_spec = ESMF_TYPEKIND_R8 + case default + error stop + end select + + end function create_tk_spec + + end subroutine MAPL_VarSpecSetNew + +end module MAPL_VarSpecTypeMod diff --git a/generic/VarSpecVector.F90 b/generic/VarSpecVector.F90 index 6887d3491932..4da9a1e072ae 100644 --- a/generic/VarSpecVector.F90 +++ b/generic/VarSpecVector.F90 @@ -1,12 +1,14 @@ module mapl_VarSpecVector - use mapl_VariableSpecification, only: MAPL_VarSpec + use mapl_VarSpecMod, only: MAPL_VarSpec -#define _type type(MAPL_VarSpec) -#define _vector VarSpecVector -#define _iterator VarSpecVectorIterator -#include "templates/vector.inc" -#undef _iterator -#undef _vector -#undef _type +#define T MAPL_VarSpec +#define Vector VarSpecVector +#define VectorIterator VarSpecVectorIterator + +#include "vector/template.inc" + +#undef VectorIterator +#undef Vector +#undef T end module mapl_VarSpecVector diff --git a/generic/VariableSpecification.F90 b/generic/VariableSpecification.F90 index c2ff9fa7e4ac..5ec659374a70 100644 --- a/generic/VariableSpecification.F90 +++ b/generic/VariableSpecification.F90 @@ -1,81 +1,10 @@ module mapl_VariableSpecification use ESMF + use MAPL_VarSpecTypeMod + use MAPL_VarSpecMod + use MAPL_VarSpecPtrMod implicit none private - public :: MAPL_VarSpec - public :: MAPL_VarSpecType - public :: MAPL_VarSpecPtr - public :: MAPL_VarConnPoint - public :: MAPL_VarConnType - public :: MAPL_VarConn - - type :: MAPL_VarSpec -!!$ private - type(MAPL_VarSpecType), pointer :: SpecPtr => null() - end type MAPL_VarSpec - - type :: MAPL_VarSpecPtr - type(MAPL_VarSpec), pointer :: Spec(:) => null() - end type MAPL_VarSpecPtr - - type :: MAPL_VarSpecType - character(len=ESMF_MAXSTR) :: SHORT_NAME - character(len=ESMF_MAXSTR) :: LONG_NAME - character(len=ESMF_MAXSTR) :: UNITS - character(len=ESMF_MAXSTR) :: FRIENDLYTO - character(len=ESMF_MAXSTR) :: VECTOR_PAIR - character(len=ESMF_MAXSTR), pointer :: ATTR_INAMES(:) => null() - character(len=ESMF_MAXSTR), pointer :: ATTR_RNAMES(:) => null() - integer, pointer :: ATTR_IVALUES(:) => null() - real, pointer :: ATTR_RVALUES(:) => null() - integer, pointer :: UNGRIDDED_DIMS(:) => null() - character(len=ESMF_MAXSTR) :: UNGRIDDED_UNIT - character(len=ESMF_MAXSTR) :: UNGRIDDED_NAME - real, pointer :: UNGRIDDED_COORDS(:) - integer :: DIMS - integer :: LOCATION - integer :: NUM_SUBTILES - integer :: STAT - integer :: ACCMLT_INTERVAL - integer :: COUPLE_INTERVAL - integer :: OFFSET - integer :: LABEL - integer :: HALOWIDTH - integer :: PRECISION - integer :: FIELD_TYPE - integer :: VECTOR_ORDER - integer :: STAGGERING - integer :: ROTATION - integer :: RESTART - logical :: defaultProvided - logical :: doNotAllocate - logical :: alwaysAllocate ! meant for export specs - real :: DEFAULT - type(ESMF_Field), pointer :: FIELD => null() - type(ESMF_FieldBundle), pointer :: BUNDLE => null() - type(ESMF_State), pointer :: STATE => null() - type(ESMF_Grid) :: GRID - end type MAPL_VarSpecType - - type MAPL_VarConnPoint -!!$ private - character(len=ESMF_MAXSTR) :: SHORT_NAME - integer :: IMPORT - integer :: EXPORT - end type MAPL_VarConnPoint - - type MAPL_VarConnType -!!$ private - type (MAPL_VarConnPoint) :: FROM - type (MAPL_VarConnPoint) :: TO - logical :: used = .false. - logical :: notRequired = .false. - end type MAPL_VarConnType - - type :: MAPL_VarConn -!!$ private - type(MAPL_VarConnType), pointer :: ConnPtr => null() - end type MAPL_VarConn end module mapl_VariableSpecification diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 867204b157ae..2f06bcaf21ad 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -12,7 +12,7 @@ module MAPL_HistoryGridCompMod use ESMF use ESMFL_Mod use MAPL_BaseMod - use MAPL_VarSpecMod + use MAPL_VarSpecMiscMod use MAPL_Constants use MAPL_IOMod use MAPL_CommsMod diff --git a/oomph/CMakeLists.txt b/oomph/CMakeLists.txt new file mode 100644 index 000000000000..3d0da8cebf74 --- /dev/null +++ b/oomph/CMakeLists.txt @@ -0,0 +1,34 @@ +esma_set_this (OVERRIDE MAPL.oomph) + +set (srcs + oomph.F90 + specs/UngriddedDimSpec.F90 + specs/VerticalStaggerLoc.F90 + specs/HorizontalStaggerLoc.F90 + specs/DimSpec.F90 + specs/CouplingSpec.F90 + specs/AbstractStateItemSpec.F90 + specs/FieldSpec.F90 + specs/ConnectionPoint.F90 + +# specs/DimensionsSpec.F90 +# +# specs/StateItemSpec.F90 +# specs/FieldSpec.F90 +# specs/BundleSpec.F90 +# specs/ServiceSpec.F90 +# specs/StateItemSpecMap.F90 +# +# specs/ConnectionPoint.F90 +# specs/ConnectionSpec.F90 +# specs/ConnectionSpecVector.F90 +# +# specs/ComponentSpec.F90 +# specs/ComponentSpecMap.F90 + ) + + +esma_add_library(${this} + SRCS ${srcs} + DEPENDENCIES MAPL.base GFTL_SHARED::gftl-shared-v2 GFTL::gftl-v2 TYPE ${MAPL_LIBRARY_TYPE} + ) diff --git a/oomph/oomph.F90 b/oomph/oomph.F90 new file mode 100644 index 000000000000..4c52993a0182 --- /dev/null +++ b/oomph/oomph.F90 @@ -0,0 +1,10 @@ +module oomph + use oomph_HorizontalStaggerLoc + use oomph_VerticalStaggerLoc + use oomph_UngriddedDimSpec + use oomph_DimsSpec + use oomph_AbstractStateItemSpec + use oomph_FieldSpec + + use oomph_ConnectionPoint +end module oomph diff --git a/oomph/specs/AbstractStateItemSpec.F90 b/oomph/specs/AbstractStateItemSpec.F90 new file mode 100644 index 000000000000..3624f2fe179a --- /dev/null +++ b/oomph/specs/AbstractStateItemSpec.F90 @@ -0,0 +1,10 @@ +module oomph_AbstractStateItemSpec + implicit none + private + + public :: AbstractStateItemSpec + + type, abstract :: AbstractStateItemSpec + end type AbstractStateItemSpec + +end module oomph_AbstractStateItemSpec diff --git a/oomph/specs/ConnectionPoint.F90 b/oomph/specs/ConnectionPoint.F90 new file mode 100644 index 000000000000..fc61413180e5 --- /dev/null +++ b/oomph/specs/ConnectionPoint.F90 @@ -0,0 +1,29 @@ +module oomph_ConnectionPoint + implicit none + private + + public :: ConnectionPoint + + type :: ConnectionPoint + character(:), allocatable :: component + character(:), allocatable :: state_item + end type ConnectionPoint + + interface ConnectionPoint + module procedure :: new_ConnectionPoint + end interface ConnectionPoint + +contains + + function new_ConnectionPoint(component, state_item) result(connection_point) + type(ConnectionPoint) :: connection_point + character(*), intent(in) :: component + character(*), intent(in) :: state_item + + connection_point%component = component + connection_point%state_item = state_item + + end function new_ConnectionPoint + + +end module oomph_ConnectionPoint diff --git a/oomph/specs/CouplingSpec.F90 b/oomph/specs/CouplingSpec.F90 new file mode 100644 index 000000000000..37c2030a399e --- /dev/null +++ b/oomph/specs/CouplingSpec.F90 @@ -0,0 +1,30 @@ +module oomph_CouplingSpec + implicit none + private + + public :: CouplingSpec + + ! In multiples of component heartbeat + type :: CouplingSpec + private + integer :: accumulatate_interval + integer :: coupling_interval + integer :: offset + end type CouplingSpec + + interface CouplingSpec + module procedure new_CouplingSpec_empty + end interface CouplingSpec + +contains + + pure function new_CouplingSpec_empty() result(coupling_spec) + type(CouplingSpec) :: coupling_spec + + coupling_spec%accumulatate_interval = 1 + coupling_spec%coupling_interval = 1 + coupling_spec%offset = 0 + + end function new_CouplingSpec_empty + +end module oomph_CouplingSpec diff --git a/oomph/specs/DimSpec.F90 b/oomph/specs/DimSpec.F90 new file mode 100644 index 000000000000..ca7f246daaf5 --- /dev/null +++ b/oomph/specs/DimSpec.F90 @@ -0,0 +1,56 @@ +module oomph_DimsSpec + use oomph_UngriddedDimSpec + use oomph_HorizontalStaggerLoc + use oomph_VerticalStaggerLoc + implicit none + + private + + public :: DimsSpec + type :: DimsSpec + type(HorizontalStaggerLoc) :: horz_stagger_loc ! NONE, CENTER, TILE + type(VerticalStaggerLoc) :: vert_stagger_loc + type(UngriddedDimSpec), allocatable :: ungridded_dim_specs(:) + integer :: halo_width + end type DimsSpec + + interface DimsSpec + module procedure new_DimsSpec_simple + module procedure new_DimsSpec_w_ungridded + module procedure new_DimsSpec_w_halo + end interface DimsSpec + +contains + + pure function new_DimsSpec_simple(horz_stagger_loc, vert_stagger_loc) result(spec) + type(DimsSpec) :: spec + type(HorizontalStaggerLoc), intent(in) :: horz_stagger_loc + type(VerticalStaggerLoc) , intent(in) :: vert_stagger_loc + type(UngriddedDimSpec) :: no_ungridded(0) + spec = DimsSpec(horz_stagger_loc, vert_stagger_loc, ungridded_dim_specs=no_ungridded, halo_width=0) + end function new_DimsSpec_simple + + + pure function new_DimsSpec_w_ungridded(horz_stagger_loc, vert_stagger_loc, ungridded_dim_specs) result(spec) + type(DimsSpec) :: spec + type(HorizontalStaggerLoc), intent(in) :: horz_stagger_loc + type(VerticalStaggerLoc) , intent(in) :: vert_stagger_loc + type(UngriddedDimSpec), intent(in) :: ungridded_dim_specs(:) + spec = DimsSpec(horz_stagger_loc, vert_stagger_loc, ungridded_dim_specs, halo_width=0) + end function new_DimsSpec_w_ungridded + + + pure function new_DimsSpec_w_halo(horz_stagger_loc, vert_stagger_loc, ungridded_dim_specs, halo_width) result(spec) + type(DimsSpec) :: spec + type(HorizontalStaggerLoc), intent(in) :: horz_stagger_loc + type(VerticalStaggerLoc) , intent(in) :: vert_stagger_loc + type(UngriddedDimSpec), intent(in) :: ungridded_dim_specs(:) + integer, intent(in) :: halo_width + spec%horz_stagger_loc = horz_stagger_loc + spec%vert_stagger_loc = vert_stagger_loc + spec%ungridded_dim_specs = ungridded_dim_specs + spec%halo_width = halo_width + end function new_DimsSpec_w_halo + +end module oomph_DimsSpec + diff --git a/oomph/specs/FieldSpec.F90 b/oomph/specs/FieldSpec.F90 new file mode 100644 index 000000000000..1ac2a72689f5 --- /dev/null +++ b/oomph/specs/FieldSpec.F90 @@ -0,0 +1,48 @@ +module oomph_FieldSpec + use oomph_AbstractStateItemSpec + use oomph_DimsSpec + use oomph_CouplingSpec + use ESMF, only: ESMF_TYPEKIND_FLAG + implicit none + private + + public :: FieldSpec + + type, extends(AbstractStateItemSpec) :: FieldSpec + private + character(:), allocatable :: standard_name + type(DimsSpec) :: dims_spec + type(ESMF_TYPEKIND_FLAG) :: typekind + type(CouplingSpec) :: coupling_spec + +!!$ ! Override default allocation behavior +!!$ logical :: do_not_allocate +!!$ logical :: always_allocate +!!$ +!!$ ! Uncategorized initialization aspects +!!$ integer :: restart +!!$ class(*), allocatable :: default_value +!!$ + + end type FieldSpec + + interface FieldSpec + module procedure new_FieldSpec + end interface FieldSpec + +contains + + pure function new_FieldSpec(standard_name, dims_spec, typekind) result(field_spec) + type(FieldSpec) :: field_spec + character(*), intent(in) :: standard_name + type(DimsSpec), intent(in) :: dims_spec + type(ESMF_TYPEKIND_FLAG), intent(in) :: typekind + + field_spec%standard_name = standard_name + field_spec%dims_spec = dims_spec + field_spec%typekind = typekind + + field_spec%coupling_spec = CouplingSpec() + end function new_FieldSpec + +end module oomph_FieldSpec diff --git a/oomph/specs/HorizontalStaggerLoc.F90 b/oomph/specs/HorizontalStaggerLoc.F90 new file mode 100644 index 000000000000..fce8ed8be3af --- /dev/null +++ b/oomph/specs/HorizontalStaggerLoc.F90 @@ -0,0 +1,49 @@ +module oomph_HorizontalStaggerLoc + implicit none + private + + public :: HorizontalStaggerLoc + public :: H_STAGGER_LOC_NONE + public :: H_STAGGER_LOC_CENTER + public :: H_STAGGER_LOC_TILE + + integer, parameter :: INVALID = -1 + + ! Users should not be able to invent their own staggering, but we + ! need to be able to declare type components of this type, so we + ! cannot simply make the type private. Instead we give it a + ! default value that is invalid. This class does not check the + ! value, but higher level logic should check that returned values + ! are of one of the defined parameters. + + type :: HorizontalStaggerLoc + private + integer :: i = INVALID + contains + procedure :: equal_to + procedure :: not_equal_to + generic :: operator(==) => equal_to + generic :: operator(/=) => not_equal_to + end type HorizontalStaggerLoc + + type(HorizontalStaggerLoc) :: H_STAGGER_LOC_NONE = HorizontalStaggerLoc(0) + type(HorizontalStaggerLoc) :: H_STAGGER_LOC_CENTER = HorizontalStaggerLoc(2) + type(HorizontalStaggerLoc) :: H_STAGGER_LOC_TILE = HorizontalStaggerLoc(3) + +contains + + + pure logical function equal_to(this, other) + class(HorizontalStaggerLoc), intent(in) :: this + type(HorizontalStaggerLoc), intent(in) :: other + equal_to = this%i == other%i + end function equal_to + + pure logical function not_equal_to(this, other) + class(HorizontalStaggerLoc), intent(in) :: this + type(HorizontalStaggerLoc), intent(in) :: other + not_equal_to = .not. (this == other) + end function not_equal_to + + +end module oomph_HorizontalStaggerLoc diff --git a/oomph/specs/UngriddedDimSpec.F90 b/oomph/specs/UngriddedDimSpec.F90 new file mode 100644 index 000000000000..1f400e87571e --- /dev/null +++ b/oomph/specs/UngriddedDimSpec.F90 @@ -0,0 +1,95 @@ +module oomph_UngriddedDimSpec + implicit none + private + + public :: UngriddedDimSpec + public :: UNKNOWN_DIM_NAME + public :: UNKNOWN_DIM_UNITS + + type :: UngriddedDimSpec + private + character(:), allocatable :: name + character(:), allocatable :: units + real, allocatable :: coordinates(:) + contains + procedure :: get_extent + procedure :: get_name + procedure :: get_units + procedure :: get_coordinates + end type UngriddedDimSpec + + interface UngriddedDimSpec + module procedure new_UngriddedDimSpec_extent + module procedure new_UngriddedDimSpec_name_and_coords + module procedure new_UngriddedDimSpec_name_units_and_coords + end interface UngriddedDimSpec + + character(*), parameter :: UNKNOWN_DIM_NAME = 'unknown dim name' + character(*), parameter :: UNKNOWN_DIM_UNITS = 'unknown_dim_units' + +contains + + pure function new_UngriddedDimSpec_extent(extent) result(spec) + integer, intent(in) :: extent + type(UngriddedDimSpec) :: spec + + spec = UngriddedDimSpec(UNKNOWN_DIM_NAME, UNKNOWN_DIM_UNITS, default_coords(extent)) + end function new_UngriddedDimSpec_extent + + + pure function default_coords(extent) result(coords) + real, allocatable :: coords(:) + integer, intent(in) :: extent + + integer :: i + coords = [(i, i=1, extent)] + + end function default_coords + + + pure function new_UngriddedDimSpec_name_and_coords(name, coordinates) result(spec) + type(UngriddedDimSpec) :: spec + character(*), intent(in) :: name + real, intent(in) :: coordinates(:) + + spec = UngriddedDimSpec(name, UNKNOWN_DIM_UNITS, coordinates) + + end function new_UngriddedDimSpec_name_and_coords + + pure function new_UngriddedDimSpec_name_units_and_coords(name, units, coordinates) result(spec) + type(UngriddedDimSpec) :: spec + character(*), intent(in) :: name + character(*), intent(in) :: units + real, intent(in) :: coordinates(:) + + spec%name = name + spec%units = units + spec%coordinates = coordinates + + end function new_UngriddedDimSpec_name_units_and_coords + + pure integer function get_extent(this) result(extent) + class(UngriddedDimSpec), intent(in) :: this + extent = size(this%coordinates) + end function get_extent + + pure function get_name(this) result(name) + character(:), allocatable :: name + class(UngriddedDimSpec), intent(in) :: this + name = this%name + end function get_name + + pure function get_units(this) result(units) + character(:), allocatable :: units + class(UngriddedDimSpec), intent(in) :: this + units = this%units + end function get_units + + ! Default coordinates are: [1., 2., ...] + pure function get_coordinates(this) result(coordinates) + real, allocatable :: coordinates(:) + class(UngriddedDimSpec), intent(in) :: this + coordinates = this%coordinates + end function get_coordinates + +end module oomph_UngriddedDimSpec diff --git a/oomph/specs/VerticalStaggerLoc.F90 b/oomph/specs/VerticalStaggerLoc.F90 new file mode 100644 index 000000000000..27bef534623c --- /dev/null +++ b/oomph/specs/VerticalStaggerLoc.F90 @@ -0,0 +1,43 @@ +module oomph_VerticalStaggerLoc + implicit none + private + + public :: VerticalStaggerLoc + public :: V_STAGGER_LOC_NONE + public :: V_STAGGER_LOC_EDGE + public :: V_STAGGER_LOC_CENTER + + integer, parameter :: INVALID = -1 + + type :: VerticalStaggerLoc + private + integer :: i = INVALID + contains + procedure :: equal_to + procedure :: not_equal_to + generic :: operator(==) => equal_to + generic :: operator(/=) => not_equal_to + end type VerticalStaggerLoc + + type(VerticalStaggerLoc) :: V_STAGGER_LOC_NONE = VerticalStaggerLoc(0) + type(VerticalStaggerLoc) :: V_STAGGER_LOC_EDGE = VerticalStaggerLoc(1) + type(VerticalStaggerLoc) :: V_STAGGER_LOC_CENTER = VerticalStaggerLoc(2) + + +contains + + + pure logical function equal_to(this, other) + class(VerticalStaggerLoc), intent(in) :: this + type(VerticalStaggerLoc), intent(in) :: other + equal_to = this%i == other%i + end function equal_to + + pure logical function not_equal_to(this, other) + class(VerticalStaggerLoc), intent(in) :: this + type(VerticalStaggerLoc), intent(in) :: other + not_equal_to = .not. (this == other) + end function not_equal_to + + +end module oomph_VerticalStaggerLoc