From b2b20a6436eca810a052cf90f0494e66642f4e1a Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Wed, 22 Dec 2021 12:05:12 -0500 Subject: [PATCH 001/300] AT: This fixes a long-standing bug for E2E connections to always allocate such exports --- generic/MAPL_Generic.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 105d9343d958..93bdf5344aae 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -6298,8 +6298,13 @@ subroutine MAPL_StateCreateFromSpecNew(STATE,SPEC,DEFER,range, RC) isCreated = ESMF_FieldIsCreated(SPEC_FIELD, rc=status) _VERIFY(STATUS) if (isCreated) then - call MAPL_AllocateCoupling( SPEC_FIELD, RC=STATUS ) ! if 'DEFER' this allocates the data - _VERIFY(STATUS) + if (.not. deferAlloc) then + call MAPL_AllocateCoupling( SPEC_FIELD, RC=STATUS ) ! if 'DEFER' this allocates the data + _VERIFY(STATUS) + else + field = spec_field + goto 20 + end if !ALT we are creating new field so that we can optionally change the name of the field; @@ -6413,6 +6418,7 @@ subroutine MAPL_StateCreateFromSpecNew(STATE,SPEC,DEFER,range, RC) _VERIFY(STATUS) end if end if +20 continue else ! Create the appropriate ESMF FIELD From 7455c3ebea2c144f860b1e6dc373410b166ca5c2 Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Thu, 23 Dec 2021 12:59:23 -0500 Subject: [PATCH 002/300] Restricted E2E deferred export fix only for same name --- generic/MAPL_Generic.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 93bdf5344aae..f141e9583f75 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -6170,6 +6170,7 @@ subroutine MAPL_StateCreateFromSpecNew(STATE,SPEC,DEFER,range, RC) integer :: range_(2) type(MAPL_VarSpec), pointer :: varspec + character(len=ESMF_MAXSTR) :: fname if (present(range)) then range_ = range @@ -6298,7 +6299,8 @@ subroutine MAPL_StateCreateFromSpecNew(STATE,SPEC,DEFER,range, RC) isCreated = ESMF_FieldIsCreated(SPEC_FIELD, rc=status) _VERIFY(STATUS) if (isCreated) then - if (.not. deferAlloc) then + call ESMF_FieldGet(SPEC_FIELD, name=fname, __RC__) + if (.not. deferAlloc .or. short_name/=fname) then call MAPL_AllocateCoupling( SPEC_FIELD, RC=STATUS ) ! if 'DEFER' this allocates the data _VERIFY(STATUS) else From 17c20390df4d1dcbc1a0ed799bf2e98ed909bbca Mon Sep 17 00:00:00 2001 From: bzhao Date: Mon, 27 Dec 2021 11:32:17 -0500 Subject: [PATCH 003/300] turned on new interpolation code --- base/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/base/CMakeLists.txt b/base/CMakeLists.txt index aea0fae2c3cd..a83eb669937d 100644 --- a/base/CMakeLists.txt +++ b/base/CMakeLists.txt @@ -70,7 +70,7 @@ endif () if(DISABLE_GLOBAL_NAME_WARNING) target_compile_options (${this} PRIVATE $<$:${DISABLE_GLOBAL_NAME_WARNING}>) endif() -target_compile_definitions (${this} PRIVATE TWO_SIDED_COMM MAPL_MODE) +target_compile_definitions (${this} PRIVATE TWO_SIDED_COMM MAPL_MODE NEW_INTERP_CODE) target_include_directories (${this} PUBLIC $) From 3a6d0a7cf7388a52c628bc86f9e52d8847d014c6 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Sun, 6 Feb 2022 14:42:20 -0500 Subject: [PATCH 004/300] more infomation if get_var fails --- pfio/NetCDF4_get_var.H | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pfio/NetCDF4_get_var.H b/pfio/NetCDF4_get_var.H index d6bd62a76984..8cc776edb692 100644 --- a/pfio/NetCDF4_get_var.H +++ b/pfio/NetCDF4_get_var.H @@ -26,7 +26,7 @@ status = nf90_inq_varid(this%ncid, name=var_name, varid=varid) !$omp end critical - _VERIFY(status) + _ASSERT(status==0,"Variable not found: "//trim(var_name)) !$omp critical #if (_RANK == 0) status = nf90_get_var(this%ncid, varid, values) From 3de41e56bbf40a4f1d259b4b39282672eabf3841 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 8 Feb 2022 19:48:32 -0500 Subject: [PATCH 005/300] New generic set_services is now in place with the legacy interface being just a deprecated stub. --- CHANGELOG.md | 12 + base/ApplicationSupport.F90 | 3 +- base/MAPL_MemUtils.F90 | 2 +- generic/CMakeLists.txt | 1 + generic/MAPL_Generic.F90 | 429 +++++++++++---------- generic/SetServicesWrapper.F90 | 84 ++++ gridcomps/Cap/MAPL_Cap.F90 | 2 +- gridcomps/Cap/MAPL_CapGridComp.F90 | 298 +++++++++----- gridcomps/History/MAPL_HistoryGridComp.F90 | 3 +- profiler/BaseProfiler.F90 | 6 +- 10 files changed, 537 insertions(+), 303 deletions(-) create mode 100644 generic/SetServicesWrapper.F90 diff --git a/CHANGELOG.md b/CHANGELOG.md index fc284367bb8b..92e738924669 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,10 +9,15 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Fixed failures to fully trap errors in + . History GC + . MemUtils + . `register_generic_entry_points` - Fixed issue in `CMakePresets.json` where Ninja presets were broken - Fixed io profiler report format - Fixed issue on macOS where enabling memutils caused crash + ### Added - Option to force integer time variable in History output via the History.rc file (IntegerTime: .true./.false. default .false.) rather than the default float time variable if allowed by frequency of output @@ -23,6 +28,13 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Major refactoring of GenericSetServices + Work is not completed, but a new layer is introduced with the intent that the user SetServices is called + from with in the new layer as opposed to the previous mechanism that obligated user SetServices to call + generic. That call is now deprecated. Significant cleanup remains. +- Improved diagnostic message for profiler imbalances at end of run. + Now gives the name of the timer that has not been stopped when + finalizing a profiler. - A small performance improvement. cycle => exit in MAPL_Generic.F90 - Made history global metadata configurable. This can be done in two ways 1. Globally for all collections by setting `COMMENT:`, `CONTACT:`, `CONVENTION:`, `INSTITUTION:`, `REFERENCES:`, and `SOURCE:` at the top of `HISTORY.rc` like `EXPDSC:` diff --git a/base/ApplicationSupport.F90 b/base/ApplicationSupport.F90 index 0eac83a95c43..8e23c82619ae 100644 --- a/base/ApplicationSupport.F90 +++ b/base/ApplicationSupport.F90 @@ -61,8 +61,7 @@ subroutine MAPL_Finalize(unusable,comm,rc) else comm_world=MPI_COMM_WORLD end if - call stop_global_time_profiler(rc=status) - _VERIFY(status) + call stop_global_time_profiler(_RC) call report_global_profiler(comm=comm_world) call finalize_profiler() call finalize_pflogger() diff --git a/base/MAPL_MemUtils.F90 b/base/MAPL_MemUtils.F90 index 42f90a72d156..f87445e55d1d 100755 --- a/base/MAPL_MemUtils.F90 +++ b/base/MAPL_MemUtils.F90 @@ -395,7 +395,7 @@ subroutine MAPL_MemUtilsWriteComm( text, comm, always, RC ) #if defined(__sgi) || defined(__aix) || defined(__SX) m = memuse()*1e-3 #else - call mem_dump(mhwm, mrss, memused, swapused, commitlimit, committed_as) + call mem_dump(mhwm, mrss, memused, swapused, commitlimit, committed_as, _RC) #endif call MPI_Comm_Size(comm_,npes,status) if (MAPL_MemUtilsMode == MAPL_MemUtilsModeFull) then diff --git a/generic/CMakeLists.txt b/generic/CMakeLists.txt index 643fc9bcf985..5c9b8d77574a 100644 --- a/generic/CMakeLists.txt +++ b/generic/CMakeLists.txt @@ -42,6 +42,7 @@ set (srcs GenericCplComp.F90 + SetServicesWrapper.F90 MaplGeneric.F90 MAPL_Generic.F90 diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index b9fb5f3d5b01..f548d0a38337 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -126,6 +126,7 @@ module MAPL_GenericMod use MAPL_ExceptionHandling use MAPL_KeywordEnforcerMod use MAPL_StringTemplate + use MAPL_SetServicesWrapper use mpi use netcdf use pFlogger, only: logging, Logger @@ -143,6 +144,7 @@ module MAPL_GenericMod private public MAPL_GenericSetServices + public new_generic_setservices public MAPL_GenericInitialize public MAPL_GenericRunChildren public MAPL_GenericFinalize @@ -391,13 +393,14 @@ module MAPL_GenericMod !BOP !BOC type, extends(MaplGenericComponent) :: MAPL_MetaComp - private +! private ! Move to Base ? character(len=ESMF_MAXSTR) :: COMPNAME type (ESMF_Config ) :: CF character(:), allocatable :: full_name ! Period separated list of ancestor names real :: HEARTBEAT + class(AbstractSetServicesWrapper), allocatable, public :: user_setservices_wrapper ! Move to decorator? type (DistributedProfiler), public :: t_profiler @@ -548,203 +551,18 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) ! Create the generic state, intializing its configuration and grid. !---------------------------------------------------------- call MAPL_InternalStateRetrieve( GC, meta, __RC__) - - call meta%t_profiler%start('generic',__RC__) - - call register_generic_entry_points(gc, __RC__) +!!$ +!!$ call meta%t_profiler%start('generic',__RC__) +!!$ +!!$ call register_generic_entry_points(gc, __RC__) call MAPL_GetRootGC(GC, meta%rootGC, __RC__) - call setup_children(meta, __RC__) - - call meta%t_profiler%stop('generic',__RC__) +!!$ call meta%t_profiler%stop('generic',__RC__) +!!$ _RETURN(ESMF_SUCCESS) contains - subroutine register_generic_entry_points(gc, rc) - type(ESMF_GridComp), intent(inout) :: gc - integer, optional, intent(out) :: rc - - integer :: status - - if (.not. associated(meta%phase_init)) then - call MAPL_GridCompSetEntrypoint(GC, ESMF_METHOD_INITIALIZE, MAPL_GenericInitialize, __RC__) - endif - - if (.not. associated(meta%phase_run)) then - call MAPL_GridCompSetEntrypoint(GC, ESMF_METHOD_RUN, MAPL_GenericRunChildren, __RC__) - endif - - - if (.not. associated(meta%phase_final)) then - call MAPL_GridCompSetEntrypoint(GC, ESMF_METHOD_FINALIZE, MAPL_GenericFinalize, __RC__) - endif - - !ALT check record!!! - if (.not. associated(meta%phase_record)) then - call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_WRITERESTART, MAPL_GenericRecord, __RC__) - end if - _ASSERT(size(meta%phase_record)==1,'needs informative message') !ALT: currently we support only 1 record - - if (.not.associated(meta%phase_coldstart)) then - !ALT: this part is not supported yet - ! call MAPL_GridCompSetEntryPoint(GC, ESMF_METHOD_READRESTART, & - ! MAPL_Coldstart, __RC__) - endif - end subroutine register_generic_entry_points - -#define LOWEST_(c) m=0; do while (m /= c) ;\ - m = c; c=label(c);\ - enddo - - ! Complex algorithm - difficult to explain - recursive subroutine setup_children(meta, rc) - type (MAPL_MetaComp), target, intent(inout) :: meta - integer, optional, intent(out) :: rc - - integer :: nc - integer :: i - integer :: ts - integer :: lbl, k, m - type (VarConn), pointer :: connect - type(StateSpecification) :: specs - type (MAPL_VarSpec), pointer :: im_specs(:) - type (MAPL_VarSpec), pointer :: ex_specs(:) - type (MAPL_VarSpecPtr), pointer :: ImSpecPtr(:) - type (MAPL_VarSpecPtr), pointer :: ExSpecPtr(:) - type(ESMF_Field), pointer :: field - type(ESMF_FieldBundle), pointer :: bundle - type(ESMF_State), pointer :: state - integer :: fLBL, tLBL - integer :: good_label, bad_label - integer, pointer :: label(:) - - NC = meta%get_num_children() - CHILDREN: if(nc > 0) then - - do I=1,NC - call MAPL_GenericStateClockAdd(GC, name=trim(meta%GCNameList(I)), __RC__) - end do - - - ! The child should've been already created by MAPL_AddChild - ! and set his services should've been called. - ! ------------------------------------- - - ! Create internal couplers and composite - ! component's Im/Ex specs. - !--------------------------------------- - - call MAPL_WireComponent(GC, __RC__) - - ! Relax connectivity for non-existing imports - if (NC > 0) then - - CONNECT => meta%connectList%CONNECT - - allocate (ImSpecPtr(NC), ExSpecPtr(NC), __STAT__) - - DO I = 1, NC - gridcomp => meta%get_child_gridcomp(i) - call MAPL_GridCompGetVarSpecs(gridcomp, & - IMPORT=IM_SPECS, EXPORT=EX_SPECS, __RC__) - ImSpecPtr(I)%Spec => IM_SPECS - ExSpecPtr(I)%Spec => EX_SPECS - END DO - - call connect%checkReq(ImSpecPtr, ExSpecPtr, __RC__) - - deallocate (ImSpecPtr, ExSpecPtr) - - end if - - ! If I am root call Label from here; everybody else - ! will be called recursively from Label - !-------------------------------------------------- - ROOT: if (.not. associated(meta%parentGC)) then - - call MAPL_GenericConnCheck(GC, __RC__) - - ! Collect all IMPORT and EXPORT specs in the entire tree in one list - !------------------------------------------------------------------- - call MAPL_GenericSpecEnum(GC, SPECS, __RC__) - - ! Label each spec by its place on the list--sort of. - !-------------------------------------------------- - - TS = SPECS%var_specs%size() - allocate(LABEL(TS), __STAT__) - - do I = 1, TS - LABEL(I)=I - end do - - ! For each spec... - !----------------- - - do I = 1, TS - - ! Get the LABEL attribute on the spec - !------------------------------------- - call MAPL_VarSpecGet(SPECS%old_var_specs(I), LABEL=LBL, __RC__) - _ASSERT(LBL > 0, "GenericSetServices :: Expected LBL > 0.") - - ! Do something to sort labels??? - !------------------------------- - LOWEST_(LBL) - - good_label = min(lbl, i) - bad_label = max(lbl, i) - label(bad_label) = good_label - - - end do - - if (associated(meta%LINK)) then - do I = 1, size(meta%LINK) - fLBL = MAPL_LabelGet(meta%LINK(I)%ptr%FROM, __RC__) - tLBL = MAPL_LabelGet(meta%LINK(I)%ptr%TO, __RC__) - LOWEST_(fLBL) - LOWEST_(tLBL) - - if (fLBL < tLBL) then - good_label = fLBL - bad_label = tLBL - else - good_label = tLBL - bad_label = fLBL - end if - label(bad_label) = good_label - end do - end if - - K=0 - do I = 1, TS - LBL = LABEL(I) - LOWEST_(LBL) - - if (LBL == I) then - K = K+1 - else - call MAPL_VarSpecGet(SPECS%old_var_specs(LBL), FIELDPTR = FIELD, __RC__) - call MAPL_VarSpecSet(SPECS%old_var_specs(I), FIELDPTR = FIELD, __RC__) - call MAPL_VarSpecGet(SPECS%old_var_specs(LBL), BUNDLEPTR = BUNDLE, __RC__ ) - call MAPL_VarSpecSet(SPECS%old_var_specs(I), BUNDLEPTR = BUNDLE, __RC__ ) - call MAPL_VarSpecGet(SPECS%old_var_specs(LBL), STATEPTR = STATE, __RC__ ) - call MAPL_VarSpecSet(SPECS%old_var_specs(I), STATEPTR = STATE, __RC__ ) - end if - - call MAPL_VarSpecSet(SPECS%old_var_specs(I), LABEL=LBL, __RC__) - end do - - deallocate(LABEL, __STAT__) - - end if ROOT - - end if CHILDREN ! Setup children - end subroutine setup_children -#undef LOWEST_ - end subroutine MAPL_GenericSetServices !============================================================================= @@ -4549,8 +4367,9 @@ recursive integer function AddChildFromMeta(META, NAME, GRID, & call child_meta%t_profiler%start('SetService',__RC__) !!$ gridcomp => META%GET_CHILD_GRIDCOMP(I) - call ESMF_GridCompSetServices ( child_meta%gridcomp, SS, userRC=userRC, __RC__ ) - _VERIFY(userRC) + child_meta%user_setservices_wrapper = ProcSetServicesWrapper(SS) +!!$ call ESMF_GridCompSetServices ( child_meta%gridcomp, SS, userRC=userRC, __RC__ ) +!!$ _VERIFY(userRC) call child_meta%t_profiler%stop('SetService',__RC__) call child_meta%t_profiler%stop(__RC__) @@ -4801,10 +4620,11 @@ recursive integer function AddChildFromDSO(gc, name, userRoutine, grid, sharedOb end if shared_object_library_to_load = adjust_dso_name(sharedObj) - call ESMF_GridCompSetServices ( child_meta%gridcomp, userRoutine, & - sharedObj=shared_object_library_to_load,userRC=userRC,__RC__) - _VERIFY(userRC) +!!$ call ESMF_GridCompSetServices ( child_meta%gridcomp, userRoutine, & +!!$ sharedObj=shared_object_library_to_load,userRC=userRC,__RC__) +!!$ _VERIFY(userRC) + child_meta%user_setservices_wrapper = DSO_SetServicesWrapper(sharedObj, userRoutine) call child_meta%t_profiler%stop('SetService',__RC__) call child_meta%t_profiler%stop(__RC__) call t_p%stop(trim(name),__RC__) @@ -11300,4 +11120,219 @@ subroutine warn_empty(string, MPL, rc) _RETURN(ESMF_SUCCESS) end subroutine warn_empty + ! Interface mandated by ESMF + recursive subroutine new_generic_setservices(gc, rc) + type(ESMF_GridComp), intent(inout) :: gc + integer, intent(out) :: rc + + type(MAPL_MetaComp), pointer :: meta + integer :: status + + call MAPL_InternalStateGet (gc, meta, _RC) + call meta%t_profiler%start(_RC) + + call meta%user_setservices_wrapper%run(gc, _RC) + ! TODO: Fix this is a terrible kludge. + if (meta%compname /= 'CAP') then + call register_generic_entry_points(gc, _RC) + end if + call run_children_generic_setservices(meta,_RC) + + ! TODO: Fix this is a terrible kludge. + if (meta%compname /= 'CAP') then + call process_connections(meta,_RC) ! needs better name + end if + + call meta%t_profiler%stop(_RC) + + _RETURN(_SUCCESS) + contains + +#define LOWEST_(c) m=0; do while (m /= c) ; m = c; c=label(c); enddo + + recursive subroutine run_children_generic_setservices(meta, rc) + type(MAPL_MetaComp), pointer :: meta + integer, intent(out) :: rc + + integer :: status, i + type(ESMF_GridComp), pointer :: child_gc + + do i = 1, meta%get_num_children() + child_gc => meta%get_child_gridcomp(i) + call new_generic_setservices(child_gc, _RC) + end do + + _RETURN(_SUCCESS) + end subroutine run_children_generic_setservices + + recursive subroutine process_connections(meta, rc) + type(MAPL_MetaComp), pointer :: meta + integer, intent(out) :: rc + + integer :: status + integer :: i, m, k + integer :: ts + integer :: fLBL, tLBL, lbl + integer :: good_label, bad_label + integer, pointer :: label(:) + type(StateSpecification) :: specs + type(ESMF_Field), pointer :: field + type(ESMF_FieldBundle), pointer :: bundle + type(ESMF_State), pointer :: state + type (MAPL_VarSpec), pointer :: im_specs(:) + type (MAPL_VarSpec), pointer :: ex_specs(:) + type (MAPL_VarSpecPtr), pointer :: ImSpecPtr(:) + type (MAPL_VarSpecPtr), pointer :: ExSpecPtr(:) + type (VarConn), pointer :: connect + type(ESMF_GridComp), pointer :: child_gc + integer :: nc + nc = meta%get_num_children() + + call MAPL_WireComponent(gc, _RC) + + nc = meta%get_num_children() + + ! Relax connectivity for non-existing imports + CONNECT => meta%connectList%CONNECT + + allocate (ImSpecPtr(nc), ExSpecPtr(nc), __STAT__) + + do I = 1, nc + child_gc => meta%get_child_gridcomp(i) + call MAPL_GridCompGetVarSpecs(child_gc, & + import=IM_SPECS, EXPORT=EX_SPECS, __RC__) + ImSpecPtr(I)%Spec => IM_SPECS + ExSpecPtr(I)%Spec => EX_SPECS + end do + + call connect%checkReq(ImSpecPtr, ExSpecPtr, __RC__) + + deallocate (ImSpecPtr, ExSpecPtr) + + + + + ! If I am root call Label from here; everybody else + ! will be called recursively from Label + !-------------------------------------------------- + ROOT: if (.not. associated(meta%parentGC)) then + + call MAPL_GenericConnCheck(GC, __RC__) + + ! Collect all IMPORT and EXPORT specs in the entire tree in one list + !------------------------------------------------------------------- + call MAPL_GenericSpecEnum(GC, SPECS, __RC__) + + ! Label each spec by its place on the list--sort of. + !-------------------------------------------------- + + TS = SPECS%var_specs%size() + allocate(LABEL(TS), __STAT__) + + do I = 1, TS + LABEL(I)=I + end do + + ! For each spec... + !----------------- + + do I = 1, TS + + ! Get the LABEL attribute on the spec + !------------------------------------- + call MAPL_VarSpecGet(SPECS%old_var_specs(I), LABEL=LBL, __RC__) + _ASSERT(LBL > 0, "GenericSetServices :: Expected LBL > 0.") + + ! Do something to sort labels??? + !------------------------------- + LOWEST_(LBL) + + good_label = min(lbl, i) + bad_label = max(lbl, i) + label(bad_label) = good_label + + + end do + + if (associated(meta%LINK)) then + do I = 1, size(meta%LINK) + fLBL = MAPL_LabelGet(meta%LINK(I)%ptr%FROM, __RC__) + tLBL = MAPL_LabelGet(meta%LINK(I)%ptr%TO, __RC__) + LOWEST_(fLBL) + LOWEST_(tLBL) + + if (fLBL < tLBL) then + good_label = fLBL + bad_label = tLBL + else + good_label = tLBL + bad_label = fLBL + end if + label(bad_label) = good_label + end do + end if + + K=0 + do I = 1, TS + LBL = LABEL(I) + LOWEST_(LBL) + + if (LBL == I) then + K = K+1 + else + call MAPL_VarSpecGet(SPECS%old_var_specs(LBL), FIELDPTR = FIELD, __RC__) + call MAPL_VarSpecSet(SPECS%old_var_specs(I), FIELDPTR = FIELD, __RC__) + call MAPL_VarSpecGet(SPECS%old_var_specs(LBL), BUNDLEPTR = BUNDLE, __RC__ ) + call MAPL_VarSpecSet(SPECS%old_var_specs(I), BUNDLEPTR = BUNDLE, __RC__ ) + call MAPL_VarSpecGet(SPECS%old_var_specs(LBL), STATEPTR = STATE, __RC__ ) + call MAPL_VarSpecSet(SPECS%old_var_specs(I), STATEPTR = STATE, __RC__ ) + end if + + call MAPL_VarSpecSet(SPECS%old_var_specs(I), LABEL=LBL, __RC__) + end do + + deallocate(LABEL, __STAT__) + + end if ROOT + + _RETURN(_SUCCESS) + end subroutine process_connections +#undef LOWEST_ + + + subroutine register_generic_entry_points(gc, rc) + type(ESMF_GridComp), intent(inout) :: gc + integer, optional, intent(out) :: rc + + integer :: status + + if (.not. associated(meta%phase_init)) then + call MAPL_GridCompSetEntrypoint(GC, ESMF_METHOD_INITIALIZE, MAPL_GenericInitialize, __RC__) + endif + + if (.not. associated(meta%phase_run)) then + call MAPL_GridCompSetEntrypoint(GC, ESMF_METHOD_RUN, MAPL_GenericRunChildren, __RC__) + endif + + + if (.not. associated(meta%phase_final)) then + call MAPL_GridCompSetEntrypoint(GC, ESMF_METHOD_FINALIZE, MAPL_GenericFinalize, __RC__) + endif + + if (.not. associated(meta%phase_record)) then + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_WRITERESTART, MAPL_GenericRecord, __RC__) + end if + _ASSERT(size(meta%phase_record)==1,'Currently, only 1 record is supported.') + + if (.not.associated(meta%phase_coldstart)) then + ! not supported + endif + _RETURN(_SUCCESS) + end subroutine register_generic_entry_points + + + + end subroutine new_generic_setservices + + end module MAPL_GenericMod diff --git a/generic/SetServicesWrapper.F90 b/generic/SetServicesWrapper.F90 new file mode 100644 index 000000000000..379bd25a0a3f --- /dev/null +++ b/generic/SetServicesWrapper.F90 @@ -0,0 +1,84 @@ +#include "MAPL_ErrLog.h" +module mapl_SetServicesWrapper + use ESMF + use MAPL_KeywordEnforcerMod + use mapl_ErrorHandlingMod + implicit none + private + + public :: AbstractSetServicesWrapper + public :: DSO_SetServicesWrapper + public :: ProcSetServicesWrapper + + + type, abstract :: AbstractSetServicesWrapper + contains + procedure(I_Run), deferred :: run + end type AbstractSetServicesWrapper + + type, extends(AbstractSetServicesWrapper) :: DSO_SetServicesWrapper + character(:), allocatable :: sharedObj + character(:), allocatable :: userRoutine + contains + procedure :: run => run_dso + end type DSO_SetServicesWrapper + + type, extends(AbstractSetServicesWrapper) :: ProcSetServicesWrapper + procedure(I_SetServices), nopass, pointer :: userRoutine + contains + procedure :: run => run_proc + end type ProcSetServicesWrapper + + abstract interface + subroutine I_Run(this, gc, unusable, rc) + use ESMF + use MAPL_KeywordEnforcerMod + import AbstractSetServicesWrapper + class(AbstractSetServicesWrapper), intent(in) :: this + type(ESMF_GridComp), intent(inout) :: gc + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + end subroutine I_Run + + subroutine I_SetServices(gc, rc) + use ESMF + type(ESMF_GridComp) :: gc + integer, intent(out) :: rc + end subroutine I_SetServices + + end interface + +contains + + recursive subroutine run_dso(this, gc, unusable, rc) + class(DSO_SetServicesWrapper), intent(in) :: this + type(ESMF_GridComp), intent(inout) :: gc + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + integer :: status, userRC + + call ESMF_GridCompSetServices(gc, this%userRoutine, sharedObj=this%sharedObj, userRC=userRC, _RC) + _VERIFY(userRC) + + _RETURN(_SUCCESS) + _UNUSED_DUMMY(unusable) + end subroutine run_dso + + + recursive subroutine run_proc(this, gc, unusable, rc) + class(ProcSetServicesWrapper), intent(in) :: this + type(ESMF_GridComp), intent(inout) :: gc + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + integer :: status, userRC + + call ESMF_GridCompSetServices(gc, this%userRoutine, userRC=userRC, _RC) + _VERIFY(userRC) + + _RETURN(_SUCCESS) + _UNUSED_DUMMY(unusable) + end subroutine run_proc + +end module mapl_SetServicesWrapper diff --git a/gridcomps/Cap/MAPL_Cap.F90 b/gridcomps/Cap/MAPL_Cap.F90 index 5feeeeb6eb21..fcb79cbc36ac 100644 --- a/gridcomps/Cap/MAPL_Cap.F90 +++ b/gridcomps/Cap/MAPL_Cap.F90 @@ -315,7 +315,7 @@ subroutine initialize_cap_gc(this, unusable, n_run_phases, rc) _UNUSED_DUMMY(unusable) call MAPL_CapGridCompCreate(this%cap_gc, this%set_services, this%get_cap_rc_file(), & - this%name, this%get_egress_file(), n_run_phases=n_run_phases, rc=status) + this%name, this%get_egress_file(), this%comm_world, n_run_phases=n_run_phases, rc=status) _VERIFY(status) _RETURN(_SUCCESS) end subroutine initialize_cap_gc diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index 029356c9c8b6..d83090c2afeb 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -103,12 +103,15 @@ module MAPL_CapGridCompMod contains - subroutine MAPL_CapGridCompCreate(cap, root_set_services, cap_rc, name, final_file, unusable, n_run_phases, rc) + subroutine MAPL_CapGridCompCreate(cap, root_set_services, cap_rc, name, final_file, comm_world, unusable, n_run_phases, rc) + use MAPL_SetServicesWrapper use mapl_StubComponent + use mapl_profiler type(MAPL_CapGridComp), intent(out), target :: cap procedure() :: root_set_services character(*), intent(in) :: cap_rc, name character(len=*), optional, intent(in) :: final_file + integer, intent(in) :: comm_world class(KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(in) :: n_run_phases integer, optional, intent(out) :: rc @@ -137,8 +140,16 @@ subroutine MAPL_CapGridCompCreate(cap, root_set_services, cap_rc, name, final_fi meta => null() call MAPL_InternalStateCreate(cap%gc, meta, __RC__) + + meta%t_profiler = DistributedProfiler(trim(cap_name), MpiTimerGauge(), comm=comm_world) + meta%user_setservices_wrapper = ProcSetServicesWrapper(set_services_gc) call MAPL_Set(meta, CF=cap%config, __RC__) + block + character(ESMF_MAXSTR) :: root_name + call MAPL_GetResource(meta, root_name, "ROOT_NAME:", default = "ROOT", _RC) + end block + call MAPL_Set(meta, name=cap_name, component=stub_component, __RC__) cap_wrapper%ptr => cap @@ -375,10 +386,6 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call MAPL_GetResource(MAPLOBJ, ROOT_CF, "ROOT_CF:", default = "ROOT.rc", rc = status) _VERIFY(status) - ! !RESOURCE_ITEM: string :: Name to assign to the ROOT component - call MAPL_GetResource(MAPLOBJ, ROOT_NAME, "ROOT_NAME:", default = "ROOT", rc = status) - _VERIFY(status) - ! !RESOURCE_ITEM: string :: Name of HISTORY's config file call MAPL_GetResource(MAPLOBJ, HIST_CF, "HIST_CF:", default = "HIST.rc", rc = status) _VERIFY(status) @@ -391,11 +398,6 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call MAPL_GetResource(MAPLOBJ, enableTimers, "MAPL_ENABLE_TIMERS:", default = 'NO', rc = status) _VERIFY(status) - ! !RESOURCE_ITEM: string :: Control Memory Diagnostic Utility - call MAPL_GetResource(MAPLOBJ, enableMemUtils, "MAPL_ENABLE_MEMUTILS:", default='NO', rc = status) - _VERIFY(status) - call MAPL_GetResource(MAPLOBJ, MemUtilsMode, "MAPL_MEMUTILS_MODE:", default = MAPL_MemUtilsModeBase, rc = status) - _VERIFY(status) !EOR enableTimers = ESMF_UtilStringUpperCase(enableTimers, rc = status) _VERIFY(status) @@ -412,18 +414,8 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) _VERIFY(STATUS) end if - cap%started_loop_timer=.false. - enableMemUtils = ESMF_UtilStringUpperCase(enableMemUtils, rc=STATUS) - _VERIFY(STATUS) - - if (enableMemUtils /= 'YES') then - call MAPL_MemUtilsDisable( rc=STATUS ) - _VERIFY(STATUS) - else - call MAPL_MemUtilsInit( mode=MemUtilsMode, rc=STATUS ) - _VERIFY(STATUS) - end if + cap%started_loop_timer=.false. call MAPL_GetResource( MAPLOBJ, cap%printSpec, label='PRINTSPEC:', default = 0, rc=STATUS ) _VERIFY(STATUS) @@ -465,21 +457,6 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) ! Add EXPID and EXPDSC from HISTORY.rc to AGCM.rc !------------------------------------------------ - cap%cf_hist = ESMF_ConfigCreate(rc=STATUS ) - _VERIFY(STATUS) - call ESMF_ConfigLoadFile(cap%cf_hist, HIST_CF, rc=STATUS ) - _VERIFY(STATUS) - - call MAPL_ConfigSetAttribute(cap%cf_hist, value=HIST_CF, Label="HIST_CF:", rc=status) - _VERIFY(STATUS) - - call ESMF_ConfigGetAttribute(cap%cf_hist, value=EXPID, Label="EXPID:", default='', rc=status) - _VERIFY(STATUS) - call ESMF_ConfigGetAttribute(cap%cf_hist, value=EXPDSC, Label="EXPDSC:", default='', rc=status) - _VERIFY(STATUS) - - call MAPL_ConfigSetAttribute(cap%cf_hist, value=heartbeat_dt, Label="RUN_DT:", rc=status) - _VERIFY(STATUS) call MAPL_ConfigSetAttribute(cap%cf_root, value=EXPID, Label="EXPID:", rc=status) _VERIFY(STATUS) @@ -523,64 +500,64 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) ! Create Root child !------------------- - call MAPL_Set(MAPLOBJ, CF=CAP%CF_ROOT, RC=STATUS) - _VERIFY(STATUS) - +!!$ call MAPL_Set(MAPLOBJ, CF=CAP%CF_ROOT, RC=STATUS) +!!$ _VERIFY(STATUS) +!!$ root_set_services => cap%root_set_services call t_p%start('SetService') - cap%root_id = MAPL_AddChild(MAPLOBJ, name = root_name, SS = root_set_services, rc = status) - _VERIFY(status) - root_gc => maplobj%get_child_gridcomp(cap%root_id) - call MAPL_GetObjectFromGC(root_gc, root_obj, rc=status) - _ASSERT(cap%n_run_phases <= SIZE(root_obj%phase_run),"n_run_phases in cap_gc should not exceed n_run_phases in root") - - ! Create History child - !---------------------- - - call MAPL_Set(MAPLOBJ, CF=CAP%CF_HIST, RC=STATUS) - _VERIFY(STATUS) - - cap%history_id = MAPL_AddChild( MAPLOBJ, name = 'HIST', SS = HIST_SetServices, rc = status) - _VERIFY(status) - - - ! Create ExtData child - !---------------------- - cap%cf_ext = ESMF_ConfigCreate(rc=STATUS ) - _VERIFY(STATUS) - call ESMF_ConfigLoadFile(cap%cf_ext, EXTDATA_CF, rc=STATUS ) - _VERIFY(STATUS) - - call ESMF_ConfigGetAttribute(cap%cf_ext, value=RUN_DT, Label="RUN_DT:", rc=status) - if (STATUS == ESMF_SUCCESS) then - if (heartbeat_dt /= run_dt) then - call lgr%error('inconsistent values of HEARTBEAT_DT (%g0) and ExtData RUN_DT (%g0)', heartbeat_dt, run_dt) - _FAIL('inconsistent values of HEARTBEAT_DT and RUN_DT') - end if - else - call MAPL_ConfigSetAttribute(cap%cf_ext, value=heartbeat_dt, Label="RUN_DT:", rc=status) - _VERIFY(STATUS) - endif - - call MAPL_Set(MAPLOBJ, CF=CAP%CF_EXT, RC=STATUS) - _VERIFY(STATUS) - - cap%extdata_id = MAPL_AddChild (MAPLOBJ, name = 'EXTDATA', SS = ExtData_SetServices, rc = status) - _VERIFY(status) +!!$ cap%root_id = MAPL_AddChild(MAPLOBJ, name = root_name, SS = root_set_services, rc = status) +!!$ _VERIFY(status) +!!$ root_gc => maplobj%get_child_gridcomp(cap%root_id) +!!$ call MAPL_GetObjectFromGC(root_gc, root_obj, rc=status) +!!$ _ASSERT(cap%n_run_phases <= SIZE(root_obj%phase_run),"n_run_phases in cap_gc should not exceed n_run_phases in root") +!!$ +!!$ ! Create History child +!!$ !---------------------- +!!$ +!!$ call MAPL_Set(MAPLOBJ, CF=CAP%CF_HIST, RC=STATUS) +!!$ _VERIFY(STATUS) +!!$ +!!$ cap%history_id = MAPL_AddChild( MAPLOBJ, name = 'HIST', SS = HIST_SetServices, rc = status) +!!$ _VERIFY(status) +!!$ +!!$ +!!$ ! Create ExtData child +!!$ !---------------------- +!!$ cap%cf_ext = ESMF_ConfigCreate(rc=STATUS ) +!!$ _VERIFY(STATUS) +!!$ call ESMF_ConfigLoadFile(cap%cf_ext, EXTDATA_CF, rc=STATUS ) +!!$ _VERIFY(STATUS) +!!$ +!!$ call ESMF_ConfigGetAttribute(cap%cf_ext, value=RUN_DT, Label="RUN_DT:", rc=status) +!!$ if (STATUS == ESMF_SUCCESS) then +!!$ if (heartbeat_dt /= run_dt) then +!!$ call lgr%error('inconsistent values of HEARTBEAT_DT (%g0) and ExtData RUN_DT (%g0)', heartbeat_dt, run_dt) +!!$ _FAIL('inconsistent values of HEARTBEAT_DT and RUN_DT') +!!$ end if +!!$ else +!!$ call MAPL_ConfigSetAttribute(cap%cf_ext, value=heartbeat_dt, Label="RUN_DT:", rc=status) +!!$ _VERIFY(STATUS) +!!$ endif +!!$ +!!$ call MAPL_Set(MAPLOBJ, CF=CAP%CF_EXT, RC=STATUS) +!!$ _VERIFY(STATUS) +!!$ +!!$ cap%extdata_id = MAPL_AddChild (MAPLOBJ, name = 'EXTDATA', SS = ExtData_SetServices, rc = status) +!!$ _VERIFY(status) call t_p%stop('SetService') - - ! Add NX and NY from AGCM.rc to ExtData.rc as well as name of ExtData rc file - call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", rc=status) - _VERIFY(STATUS) - call ESMF_ConfigGetAttribute(cap%cf_root, value = NY, Label="NY:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_ext, value=NX, Label="NX:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_ext, value=NY, Label="NY:", rc=status) - _VERIFY(STATUS) - call MAPL_ConfigSetAttribute(cap%cf_ext, value=EXTDATA_CF, Label="CF_EXTDATA:", rc=status) - _VERIFY(STATUS) +!!$ +!!$ ! Add NX and NY from AGCM.rc to ExtData.rc as well as name of ExtData rc file +!!$ call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", rc=status) +!!$ _VERIFY(STATUS) +!!$ call ESMF_ConfigGetAttribute(cap%cf_root, value = NY, Label="NY:", rc=status) +!!$ _VERIFY(STATUS) +!!$ call MAPL_ConfigSetAttribute(cap%cf_ext, value=NX, Label="NX:", rc=status) +!!$ _VERIFY(STATUS) +!!$ call MAPL_ConfigSetAttribute(cap%cf_ext, value=NY, Label="NY:", rc=status) +!!$ _VERIFY(STATUS) +!!$ call MAPL_ConfigSetAttribute(cap%cf_ext, value=EXTDATA_CF, Label="CF_EXTDATA:", rc=status) +!!$ _VERIFY(STATUS) ! Query MAPL for the the children's for GCS, IMPORTS, EXPORTS !------------------------------------------------------------- @@ -880,18 +857,139 @@ subroutine set_services_gc(gc, rc) integer :: status, phase type(MAPL_CapGridComp), pointer :: cap + type(MAPL_MetaComp), pointer :: meta, root_meta + class(BaseProfiler), pointer :: t_p + + type (ESMF_GridComp), pointer :: root_gc + character(len=ESMF_MAXSTR) :: ROOT_NAME + procedure(), pointer :: root_set_services + class(Logger), pointer :: lgr + character(len=ESMF_MAXSTR) :: HIST_CF, ROOT_CF, EXTDATA_CF + integer :: RUN_DT + integer :: heartbeat_dt + integer :: NX, NY + integer :: MemUtilsMode + character(len=ESMF_MAXSTR) :: enableMemUtils + character(len=ESMF_MAXSTR) :: enableTimers + type(ESMF_GridComp), pointer :: child_gc + type(MAPL_MetaComp), pointer :: child_meta + character(len=ESMF_MAXSTR) :: EXPID + character(len=ESMF_MAXSTR) :: EXPDSC + logical :: cap_clock_is_present + type(ESMF_TimeInterval) :: Frequency cap => get_CapGridComp_from_gc(gc) - call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_INITIALIZE, userRoutine = initialize_gc, rc = status) - _VERIFY(status) + call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_INITIALIZE, userRoutine = initialize_gc, _RC) do phase = 1, cap%n_run_phases - call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_RUN, userRoutine = run_gc, rc = status) - _VERIFY(status) + call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_RUN, userRoutine = run_gc, _RC) enddo - call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_FINALIZE, userRoutine = finalize_gc, rc = status) - _VERIFY(status) + call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_FINALIZE, userRoutine = finalize_gc, _RC) + + call ESMF_GridCompGet(gc, clockIsPresent=cap_clock_is_present, _RC) + + if (cap_clock_is_present) then + call ESMF_ClockGet(cap%clock, timeStep=frequency, _RC) + call ESMF_TimeIntervalGet(frequency, s=heartbeat_dt, _RC) + else + call ESMF_ConfigGetAttribute(cap%config, value = heartbeat_dt, Label = "HEARTBEAT_DT:", _RC) + call ESMF_TimeIntervalSet(frequency, s = heartbeat_dt, _RC) + end if + + cap%heartbeat_dt = heartbeat_dt + + ! Register the children with MAPL + !-------------------------------- + + ! Create Root child + !------------------- + call MAPL_InternalStateRetrieve(gc, meta, _RC) +!!$ call MAPL_Set(meta, CF=CAP%CF_ROOT, _RC) + call MAPL_GetLogger(gc, lgr, _RC) + + t_p => get_global_time_profiler() + call t_p%start('SetService') + + ! !RESOURCE_ITEM: string :: Name to assign to the ROOT component + call MAPL_GetResource(meta, root_name, "ROOT_NAME:", default = "ROOT", _RC) + call MAPL_GetResource(meta, ROOT_CF, "ROOT_CF:", default = "ROOT.rc", _RC) + root_set_services => cap%root_set_services + cap%root_id = MAPL_AddChild(meta, name = root_name, SS=root_set_services, configFile=ROOT_CF, _RC) + + child_gc => meta%get_child_gridcomp(cap%root_id) + call MAPL_InternalStateRetrieve(child_gc, child_meta, _RC) + call MAPL_Get(child_meta, cf=cap%cf_root, _RC) + ! Add NX and NY from ROOT config to ExtData config + call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", _RC) + call ESMF_ConfigGetAttribute(cap%cf_root, value = NY, Label="NY:", _RC) + call ESMF_ConfigSetAttribute(cap%cf_root, value = heartbeat_dt, Label="RUN_DT:", _RC) + + ! Create History child + !---------------------- + + ! !RESOURCE_ITEM: string :: Name of HISTORY's config file + call MAPL_GetResource(meta, HIST_CF, "HIST_CF:", default = "HIST.rc", _RC) + cap%history_id = MAPL_AddChild( meta, name='HIST', SS=HIST_SetServices, configFile=HIST_CF, _RC) + + child_gc => meta%get_child_gridcomp(cap%history_id) + call MAPL_InternalStateRetrieve(child_gc, child_meta, _RC) + call MAPL_Get(child_meta, cf=cap%cf_hist, _RC) + call ESMF_ConfigLoadFile(cap%cf_hist, HIST_CF, _RC) + + call MAPL_ConfigSetAttribute(cap%cf_hist, value=HIST_CF, Label="HIST_CF:", _RC) + call ESMF_ConfigGetAttribute(cap%cf_hist, value=EXPID, Label="EXPID:", default='', _RC) + call ESMF_ConfigGetAttribute(cap%cf_hist, value=EXPDSC, Label="EXPDSC:", default='', _RC) + call MAPL_ConfigSetAttribute(cap%cf_root, value=EXPID, Label="EXPID:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_root, value=EXPDSC, Label="EXPDSC:", _RC) + + call MAPL_ConfigSetAttribute(cap%cf_hist, value=heartbeat_dt, Label="RUN_DT:", _RC) + + call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", _RC) + call ESMF_ConfigGetAttribute(cap%cf_root, value = NY, Label="NY:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_hist, value = NX, Label="NX:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_hist, value = NY, Label="NY:", _RC) + + ! Create ExtData child + !---------------------- + cap%cf_ext = ESMF_ConfigCreate(_RC) + call MAPL_GetResource(meta, EXTDATA_CF, "EXTDATA_CF:", default = "ExtData.rc", _RC) + call ESMF_ConfigLoadFile(cap%cf_ext, EXTDATA_CF, _RC) + + + cap%extdata_id = MAPL_AddChild (meta, name='EXTDATA', SS=ExtData_SetServices, configFile=EXTDATA_CF, _RC) + child_gc => meta%get_child_gridcomp(cap%extdata_id) + call MAPL_InternalStateRetrieve(child_gc, child_meta, _RC) + call MAPL_Get(child_meta, cf=cap%cf_ext, _RC) + call MAPL_ConfigSetAttribute(cap%cf_ext, value=NX, Label="NX:", _RC) + call MAPL_ConfigSetAttribute(cap%cf_ext, value=NY, Label="NY:", _RC) + + call ESMF_ConfigGetAttribute(cap%cf_ext, value=RUN_DT, Label="RUN_DT:", rc=status) + if (status == ESMF_SUCCESS) then + if (heartbeat_dt /= run_dt) then + call lgr%error('inconsistent values of heartbeat_dt (%g0) and ExtData RUN_DT (%g0)', heartbeat_dt, run_dt) + _FAIL('inconsistent values of heartbeat_dt and RUN_DT') + end if + else + call MAPL_ConfigSetAttribute(cap%cf_ext, value=heartbeat_dt, Label="RUN_DT:", _RC) + endif + call MAPL_ConfigSetAttribute(cap%cf_ext, value=EXTDATA_CF, Label="CF_EXTDATA:", _RC) + + + call t_p%stop('SetService') + + + ! !RESOURCE_ITEM: string :: Control Memory Diagnostic Utility + call MAPL_GetResource(meta, enableMemUtils, "MAPL_ENABLE_MEMUTILS:", default='NO', _RC) + call MAPL_GetResource(meta, MemUtilsMode, "MAPL_MEMUTILS_MODE:", default = MAPL_MemUtilsModeBase, _RC) + enableMemUtils = ESMF_UtilStringUpperCase(enableMemUtils, _RC) + + if (enableMemUtils /= 'YES') then + call MAPL_MemUtilsDisable(_RC) + else + call MAPL_MemUtilsInit( mode=MemUtilsMode, _RC) + end if + _RETURN(ESMF_SUCCESS) end subroutine set_services_gc @@ -902,8 +1000,9 @@ subroutine set_services(this, rc) integer, optional, intent(out) :: rc integer :: status - call ESMF_GridCompSetServices(this%gc, set_services_gc, rc = status) - _VERIFY(status) + call new_generic_setservices(this%gc, _RC) +!!$ call ESMF_GridCompSetServices(this%gc, set_services_gc, rc = status) +!!$ _VERIFY(status) _RETURN(ESMF_SUCCESS) end subroutine set_services @@ -1115,8 +1214,7 @@ subroutine run_MAPL_GridComp(gc, phase, rc) call cap%increment_step_counter() - call MAPL_MemUtilsWrite(cap%vm, 'MAPL_Cap:TimeLoop', rc = status) - _VERIFY(status) + call MAPL_MemUtilsWrite(cap%vm, 'MAPL_Cap:TimeLoop', _RC) if (.not.cap%lperp) then done = ESMF_ClockIsStopTime(cap%clock_hist, rc = status) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index ba766119c54e..9d0f15bcbd6c 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -923,7 +923,8 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) if (old_fields_style) then field_set_name = trim(string) // 'fields' allocate(field_set) - call parse_fields(cfg, trim(field_set_name), field_set, list(n)%items, rc=status) + print*,__FILE__,__LINE__,'looking for ', trim(field_set_name) + call parse_fields(cfg, trim(field_set_name), field_set, list(n)%items, _RC) end if list(n)%field_set => field_set diff --git a/profiler/BaseProfiler.F90 b/profiler/BaseProfiler.F90 index 1743e7039e8d..7866c3aa0566 100644 --- a/profiler/BaseProfiler.F90 +++ b/profiler/BaseProfiler.F90 @@ -179,7 +179,11 @@ subroutine stop_self(this, rc) class(AbstractMeterNode), pointer :: node if (this%stack%size()/= 1) this%status = INCORRECTLY_NESTED_METERS - _ASSERT_RC(this%stack%size()== 1,"Stack not empty when timer stopped.",INCORRECTLY_NESTED_METERS) + if (this%stack%size() /= 1) then + node_ptr => this%stack%back() + node => node_ptr%ptr + _ASSERT_RC(this%stack%size()== 1,"Stack not empty when timer stopped. Active timer: " // node%get_name(),INCORRECTLY_NESTED_METERS) + end if node_ptr => this%stack%back() node => node_ptr%ptr From 365691be17c69de3210533e3efd2977a1487be80 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Mon, 14 Feb 2022 11:31:56 -0500 Subject: [PATCH 006/300] Update gridcomps/History/MAPL_HistoryGridComp.F90 Co-authored-by: Matthew Thompson --- gridcomps/History/MAPL_HistoryGridComp.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 9d0f15bcbd6c..0a90b226add9 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -923,7 +923,6 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) if (old_fields_style) then field_set_name = trim(string) // 'fields' allocate(field_set) - print*,__FILE__,__LINE__,'looking for ', trim(field_set_name) call parse_fields(cfg, trim(field_set_name), field_set, list(n)%items, _RC) end if From 497e0078f633020e217975f8e903169c31edf113 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 15 Feb 2022 12:58:06 -0500 Subject: [PATCH 007/300] Added new gauge for memory profiling. Instrument MAPL Generic and Cap with these and added a report at the end of the run. --- CHANGELOG.md | 4 ++ base/ApplicationSupport.F90 | 48 ++++++++++++++-- generic/MAPL_Generic.F90 | 30 +++++++++- gridcomps/Cap/MAPL_CapGridComp.F90 | 15 ++++- profiler/CMakeLists.txt | 1 + profiler/MAPL_Profiler.F90 | 2 + profiler/MallocGauge.F90 | 74 +++++++++++++++++++++++++ profiler/MemoryProfiler.F90 | 20 ++++--- profiler/TimeProfiler.F90 | 2 +- profiler/reporting/MemoryTextColumn.F90 | 5 +- 10 files changed, 183 insertions(+), 18 deletions(-) create mode 100644 profiler/MallocGauge.F90 diff --git a/CHANGELOG.md b/CHANGELOG.md index fc284367bb8b..68cbe3a5137e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,6 +15,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +- New gauge for measuring memory allocation based upon mallinfo(). + MAPL is now instrumented with this memory profiler and it produces + reasonable results. Should nicely complement other tools that + measure HWM. - Option to force integer time variable in History output via the History.rc file (IntegerTime: .true./.false. default .false.) rather than the default float time variable if allowed by frequency of output - Added mapl_StubComponent to MAPL package - Updates to CircleCI diff --git a/base/ApplicationSupport.F90 b/base/ApplicationSupport.F90 index 0eac83a95c43..5c0fe49690df 100644 --- a/base/ApplicationSupport.F90 +++ b/base/ApplicationSupport.F90 @@ -23,9 +23,17 @@ subroutine MAPL_Initialize(unusable,comm,logging_config,rc) character(:), allocatable :: logging_configuration_file integer :: comm_world,status + class (BaseProfiler), pointer :: m_p _UNUSED_DUMMY(unusable) + call initialize_profiler(comm=comm_world) + call start_global_time_profiler(_RC) + call start_global_memory_profiler(_RC) + + m_p => get_global_memory_profiler() + call m_p%start('init pflogger', _RC) + if (present(logging_config)) then logging_configuration_file=logging_config else @@ -36,15 +44,15 @@ subroutine MAPL_Initialize(unusable,comm,logging_config,rc) else comm_world=MPI_COMM_WORLD end if + + #ifdef BUILD_WITH_PFLOGGER call initialize_pflogger(comm=comm_world,logging_config=logging_configuration_file,rc=status) _VERIFY(status) #endif - call initialize_profiler(comm=comm_world) - call start_global_time_profiler(rc=status) - _VERIFY(status) - _RETURN(_SUCCESS) + call m_p%stop('init pflogger', _RC) + _RETURN(_SUCCESS) end subroutine MAPL_Initialize subroutine MAPL_Finalize(unusable,comm,rc) @@ -158,6 +166,7 @@ subroutine report_global_profiler(unusable,comm,rc) integer :: npes, my_rank, ierror character(1) :: empty(0) class (BaseProfiler), pointer :: t_p + class (BaseProfiler), pointer :: m_p _UNUSED_DUMMY(unusable) if (present(comm)) then @@ -166,6 +175,7 @@ subroutine report_global_profiler(unusable,comm,rc) world_comm=MPI_COMM_WORLD end if t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() reporter = ProfileReporter(empty) call reporter%add_column(NameColumn(50, separator= " ")) @@ -191,8 +201,38 @@ subroutine report_global_profiler(unusable,comm,rc) write(*,'(a)') report_lines(i) end do end if + +#if (!defined(sysDarwin) && (defined(__INTEL_COMPILER) || defined(__GFORTRAN))) + reporter = ProfileReporter(empty) + call reporter%add_column(NameColumn(50, separator= " ")) + + inclusive = MultiColumn(['Inclusive'], separator='=') + call inclusive%add_column(MemoryTextColumn([' MEM '],'(i4,1x,a2)', 9, InclusiveColumn(), separator='-')) +!!$ call inclusive%add_column(FormattedTextColumn(' % ','(f6.2)', 6, PercentageColumn(InclusiveColumn()), separator='-')) + call reporter%add_column(inclusive) + + exclusive = MultiColumn(['Exclusive'], separator='=') + call exclusive%add_column(MemoryTextColumn([' MEM '],'(i4,1x,a2)', 9, ExclusiveColumn(), separator='-')) + call exclusive%add_column(FormattedTextColumn(' MEM (KB)','(-3p,f9.3, 0p)', 9, ExclusiveColumn(), separator='-')) +!!$ call exclusive%add_column(FormattedTextColumn(' % ','(f6.2)', 6, PercentageColumn(ExclusiveColumn()), separator='-')) + call reporter%add_column(exclusive) + + call MPI_Comm_size(world_comm, npes, ierror) + call MPI_Comm_Rank(world_comm, my_rank, ierror) + + if (my_rank == 0) then + report_lines = reporter%generate_report(m_p) + write(*,'(a,1x,i0)')'Report on process: ', my_rank + do i = 1, size(report_lines) + write(*,'(a)') report_lines(i) + end do + end if +#endif + call MPI_Barrier(world_comm, ierror) + _RETURN(_SUCCESS) + end subroutine report_global_profiler end module MAPL_ApplicationSupport diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index b9fb5f3d5b01..a217fed12bb4 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -846,6 +846,7 @@ recursive subroutine MAPL_GenericInitialize ( GC, import, EXPORT, CLOCK, RC ) type(ESMF_State), pointer :: child_export_state type(ESMF_GridComp), pointer :: gridcomp type(ESMF_State), pointer :: internal_state + class(BaseProfiler), pointer :: m_p !============================================================================= ! Begin... @@ -1031,16 +1032,25 @@ recursive subroutine MAPL_GenericInitialize ( GC, import, EXPORT, CLOCK, RC ) !!$ call MAPL_TimerOff(STATE,"generic",__RC__) + m_p => get_global_memory_profiler() + call m_p%start('children') call initialize_children_and_couplers(_RC) + call m_p%stop('children') call MAPL_TimerOn(STATE,"generic") + call m_p%start('import vars') call create_import_and_initialize_state_variables(__RC__) + call m_p%stop('import vars') call ESMF_AttributeSet(import,'POSITIVE',trim(positive),__RC__) + call m_p%start('internal vars') call create_internal_and_initialize_state_variables(__RC__) + call m_p%stop('internal vars') + call m_p%start('export vars') call create_export_state_variables(__RC__) + call m_p%stop('export vars') ! Create forcing state STATE%FORCING = ESMF_StateCreate(name = trim(comp_name) // "_FORCING", & @@ -1699,6 +1709,7 @@ recursive subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) type(ESMF_Method_Flag) :: method type(ESMF_VM) :: VM class(BaseProfiler), pointer :: t_p + class(BaseProfiler), pointer :: m_p character(1) :: char_phase character(len=12), pointer :: timers(:) => NULL() @@ -1735,7 +1746,9 @@ recursive subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) ! TIMERS on t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() call t_p%start(trim(state%compname),__RC__) + call m_p%start(trim(state%compname),__RC__) phase_ = MAPL_MAX_PHASES+phase ! this is the "actual" phase, i.e. the one user registered @@ -1812,6 +1825,7 @@ recursive subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) call state%t_profiler%stop(__RC__) end if call t_p%stop(trim(state%compname),__RC__) + call m_p%stop(trim(state%compname),__RC__) endif @@ -1987,6 +2001,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: ens_id_width type(ESMF_Time) :: CurrTime class(BaseProfiler), pointer :: t_p + class(BaseProfiler), pointer :: m_p type(ESMF_GridComp), pointer :: gridcomp type(ESMF_State), pointer :: child_import_state type(ESMF_State), pointer :: child_export_state @@ -2012,6 +2027,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! --------------------- t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() NC = STATE%get_num_children() allocate(CHLDMAPL(NC), stat=status) @@ -2151,6 +2167,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) end if call t_p%stop(trim(state%compname),__RC__) + call m_p%stop(trim(state%compname),__RC__) ! Clean-up !--------- @@ -2268,7 +2285,7 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: K logical :: ftype(0:1) - class(BaseProfiler), pointer :: t_p + class(BaseProfiler), pointer :: t_p, m_p type(ESMF_GridComp), pointer :: gridcomp type(ESMF_State), pointer :: child_import_state type(ESMF_State), pointer :: child_export_state @@ -2288,6 +2305,7 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) _VERIFY(status) t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() call state%t_profiler%start(__RC__) call state%t_profiler%start('Record',__RC__) @@ -2492,6 +2510,7 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=4) :: extension integer :: hdr class(BaseProfiler), pointer :: t_p + class(BaseProfiler), pointer :: m_p type(ESMF_GridComp), pointer :: gridcomp type(ESMF_State), pointer :: child_import_state type(ESMF_State), pointer :: child_export_state @@ -2510,7 +2529,6 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_InternalStateRetrieve(GC, STATE, RC=status) _VERIFY(status) - t_p => get_global_time_profiler() call state%t_profiler%start(__RC__) call state%t_profiler%start('Refresh',__RC__) @@ -4532,6 +4550,7 @@ recursive integer function AddChildFromMeta(META, NAME, GRID, & integer :: I type(MAPL_MetaComp), pointer :: child_meta class(BaseProfiler), pointer :: t_p + class(BaseProfiler), pointer :: m_p integer :: userRC if (.not.allocated(META%GCNameList)) then @@ -4544,7 +4563,9 @@ recursive integer function AddChildFromMeta(META, NAME, GRID, & call AddChild_preamble(meta, I, name, grid=grid, configfile=configfile, parentGC=parentgc, petList=petlist, child_meta=child_meta, __RC__) t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() call t_p%start(trim(NAME),__RC__) + call m_p%start(trim(NAME),__RC__) call child_meta%t_profiler%start(__RC__) call child_meta%t_profiler%start('SetService',__RC__) @@ -4555,6 +4576,7 @@ recursive integer function AddChildFromMeta(META, NAME, GRID, & call child_meta%t_profiler%stop('SetService',__RC__) call child_meta%t_profiler%stop(__RC__) call t_p%stop(trim(NAME),__RC__) + call m_p%stop(trim(NAME),__RC__) _VERIFY(status) @@ -4769,6 +4791,7 @@ recursive integer function AddChildFromDSO(gc, name, userRoutine, grid, sharedOb integer :: I type(MAPL_MetaComp), pointer :: child_meta class(BaseProfiler), pointer :: t_p + class(BaseProfiler), pointer :: m_p class(Logger), pointer :: lgr character(len=:), allocatable :: shared_object_library_to_load @@ -4787,7 +4810,9 @@ recursive integer function AddChildFromDSO(gc, name, userRoutine, grid, sharedOb call AddChild_preamble(meta, I, name, grid=grid, configfile=configfile, parentGC=gc, petList=petlist, child_meta=child_meta, __RC__) t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() call t_p%start(trim(name),__RC__) + call m_p%start(trim(name),__RC__) call child_meta%t_profiler%start(__RC__) call child_meta%t_profiler%start('SetService',__RC__) @@ -4808,6 +4833,7 @@ recursive integer function AddChildFromDSO(gc, name, userRoutine, grid, sharedOb call child_meta%t_profiler%stop('SetService',__RC__) call child_meta%t_profiler%stop(__RC__) call t_p%stop(trim(name),__RC__) + call m_p%stop(trim(name),__RC__) _RETURN(ESMF_SUCCESS) end function AddChildFromDSO diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index 029356c9c8b6..c5e705d4b277 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -208,6 +208,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) procedure(), pointer :: root_set_services type(MAPL_CapGridComp), pointer :: cap class(BaseProfiler), pointer :: t_p + class(BaseProfiler), pointer :: m_p class(Logger), pointer :: lgr type(ESMF_Clock) :: cap_clock @@ -220,6 +221,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) _VERIFY(status) t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() call ESMF_GridCompGet(gc, vm = cap%vm, rc = status) _VERIFY(status) @@ -529,6 +531,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) root_set_services => cap%root_set_services call t_p%start('SetService') + call m_p%start('SetService') cap%root_id = MAPL_AddChild(MAPLOBJ, name = root_name, SS = root_set_services, rc = status) _VERIFY(status) root_gc => maplobj%get_child_gridcomp(cap%root_id) @@ -569,6 +572,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) cap%extdata_id = MAPL_AddChild (MAPLOBJ, name = 'EXTDATA', SS = ExtData_SetServices, rc = status) _VERIFY(status) call t_p%stop('SetService') + call m_p%stop('SetService') ! Add NX and NY from AGCM.rc to ExtData.rc as well as name of ExtData rc file call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", rc=status) @@ -611,6 +615,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) !---------------------------------------- call t_p%start('Initialize') + call m_p%start('Initialize') call ESMF_GridCompInitialize(cap%gcs(cap%root_id), importState = cap%child_imports(cap%root_id), & exportState = cap%child_exports(cap%root_id), clock = cap%clock, userRC = status) _VERIFY(status) @@ -637,6 +642,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) ExtData_internal_state%expState = CAP%CHILD_EXPORTS(cap%extdata_id) end if call t_p%stop('Initialize') + call m_p%stop('Initialize') end if @@ -780,14 +786,16 @@ subroutine run_gc(gc, import, export, clock, rc) integer, intent(out) :: RC ! Error code: integer :: status, phase - class (BaseProfiler), pointer :: t_p + class (BaseProfiler), pointer :: t_p, m_p _UNUSED_DUMMY(import) _UNUSED_DUMMY(export) _UNUSED_DUMMY(clock) t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() call t_p%start('Run') + call m_p%start('Run') call ESMF_GridCompGet( gc, currentPhase=phase, RC=status ) VERIFY_(status) @@ -796,6 +804,7 @@ subroutine run_gc(gc, import, export, clock, rc) _VERIFY(status) call t_p%stop('Run') + call m_p%stop('Run') _RETURN(ESMF_SUCCESS) @@ -813,6 +822,7 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) type(MAPL_CapGridComp), pointer :: cap type(MAPL_MetaComp), pointer :: maplobj class (BaseProfiler), pointer :: t_p + class (BaseProfiler), pointer :: m_p _UNUSED_DUMMY(import_state) _UNUSED_DUMMY(export_state) @@ -823,7 +833,9 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) _VERIFY(status) t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() call t_p%start('Finalize') + call m_p%start('Finalize') if (.not. cap%printspec > 0) then @@ -869,6 +881,7 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) end if call t_p%stop('Finalize') + call m_p%stop('Finalize') _RETURN(ESMF_SUCCESS) end subroutine finalize_gc diff --git a/profiler/CMakeLists.txt b/profiler/CMakeLists.txt index 7d3e6dfc41b6..a1b8705fa81f 100644 --- a/profiler/CMakeLists.txt +++ b/profiler/CMakeLists.txt @@ -13,6 +13,7 @@ set (srcs MpiTimerGauge.F90 FortranTimerGauge.F90 RssMemoryGauge.F90 + MallocGauge.F90 VmstatMemoryGauge.F90 AdvancedMeter.F90 diff --git a/profiler/MAPL_Profiler.F90 b/profiler/MAPL_Profiler.F90 index a6c09631db65..60a3631582bf 100644 --- a/profiler/MAPL_Profiler.F90 +++ b/profiler/MAPL_Profiler.F90 @@ -44,10 +44,12 @@ module mapl_Profiler subroutine initialize(comm) integer, optional, intent(in) :: comm call initialize_global_time_profiler(comm = comm) + call initialize_global_memory_profiler() !comm = comm) end subroutine initialize subroutine finalize() call finalize_global_time_profiler() + call finalize_global_memory_profiler() end subroutine finalize end module mapl_Profiler diff --git a/profiler/MallocGauge.F90 b/profiler/MallocGauge.F90 new file mode 100644 index 000000000000..096871fe6bb5 --- /dev/null +++ b/profiler/MallocGauge.F90 @@ -0,0 +1,74 @@ +#include "unused_dummy.H" + +module MAPL_MallocGauge + use, intrinsic :: iso_fortran_env, only: REAL64, INT64 + use, intrinsic :: iso_c_binding, only : C_INT + use MAPL_AbstractGauge + implicit none + private + + public :: MallocGauge + + type, extends(AbstractGauge) :: MallocGauge + private + integer(kind=INT64) :: baseline = 0 + contains + procedure :: get_measurement + end type MallocGauge + + interface MallocGauge + module procedure :: new_MallocGauge + end interface MallocGauge + + type, bind(C) :: mallinfo_t + integer(C_INT) :: arena ! Non-mmapped space allocated (bytes) + integer(C_INT) :: ordblks ! Number of free chunks + integer(C_INT) :: smblks ! Number of free fastbin blocks + integer(C_INT) :: hblks ! Number of mmapped regions + integer(C_INT) :: hblkhd ! Space allocated in mmapped regions (bytes) + integer(C_INT) :: usmblks ! See below + integer(C_INT) :: fsmblks ! Space in freed fastbin blocks (bytes) + integer(C_INT) :: uordblks ! Total allocated space (bytes) + integer(C_INT) :: fordblks ! Total free space (bytes) + integer(C_INT) :: keepcost ! Top-most, releasable space (bytes) + end type mallinfo_t + +#if (!defined(sysDarwin) && (defined(__INTEL_COMPILER) || defined(__GFORTRAN))) + interface + function mallinfo() result(info) bind(C,name="mallinfo") + import mallinfo_t + type(mallinfo_t) :: info + end function mallinfo + end interface +#endif + +contains + + + function new_MallocGauge() result(gauge) + type (MallocGauge) :: gauge + + gauge%baseline = 0 + + end function new_MallocGauge + + + function get_measurement(this) result(mem_use) + class (MallocGauge), intent(inout) :: this + real(kind=REAL64) :: mem_use + + type(Mallinfo_t) :: info + + info = mallinfo() + mem_use = info%uordblks + + end function get_measurement + +#if !(!defined(sysDarwin) && (defined(__INTEL_COMPILER) || defined(__GFORTRAN))) + function mallinfo() result(info) + type(mallinfo_t) :: info + info %uordblks = 0 + end function mallinfo +#endif +end module MAPL_MallocGauge + diff --git a/profiler/MemoryProfiler.F90 b/profiler/MemoryProfiler.F90 index e0034e12da58..f52d00a27164 100644 --- a/profiler/MemoryProfiler.F90 +++ b/profiler/MemoryProfiler.F90 @@ -1,8 +1,9 @@ -#include "unused_dummy.H" +#include "MAPL_ErrLog.h" module MAPL_MemoryProfiler_private use MAPL_BaseProfiler, only: BaseProfiler use MAPL_BaseProfiler, only: MemoryProfilerIterator => BaseProfilerIterator + use MAPL_MallocGauge use MAPL_RssMemoryGauge use MAPL_VmstatMemoryGauge use MAPL_AdvancedMeter @@ -39,7 +40,6 @@ function new_MemoryProfiler(name, comm_world) result(prof) call prof%set_comm_world(comm_world = comm_world) call prof%set_node(MeterNode(name, prof%make_meter())) - call prof%start() end function new_MemoryProfiler @@ -47,9 +47,9 @@ function make_meter(this) result(meter) class(AbstractMeter), allocatable :: meter class(MemoryProfiler), intent(in) :: this + meter = AdvancedMeter(MallocGauge()) + _UNUSED_DUMMY(this) - meter = AdvancedMeter(RssMemoryGauge()) -!!$ meter = AdvancedMeter(VmstatMemoryGauge()) end function make_meter @@ -77,6 +77,8 @@ end module MAPL_MemoryProfiler_private module MAPL_MemoryProfiler use MAPL_BaseProfiler use MAPL_MemoryProfiler_private + use mapl_KeywordEnforcerMod + use mapl_ErrorHandlingMod implicit none private @@ -118,14 +120,18 @@ subroutine finalize_global_memory_profiler() end subroutine finalize_global_memory_profiler - subroutine start_global_memory_profiler(name) - character(*), intent(in) :: name + subroutine start_global_memory_profiler(unusable, rc) + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + integer :: status type(MemoryProfiler), pointer :: memory_profiler memory_profiler => get_global_memory_profiler() - call memory_profiler%start(name) + call memory_profiler%start(_RC) + _RETURN(_SUCCESS) + _UNUSED_DUMMY(unusable) end subroutine start_global_memory_profiler diff --git a/profiler/TimeProfiler.F90 b/profiler/TimeProfiler.F90 index 260239a03818..a1960c12b7d1 100644 --- a/profiler/TimeProfiler.F90 +++ b/profiler/TimeProfiler.F90 @@ -70,7 +70,7 @@ module mapl_TimeProfiler use mapl_BaseProfiler use mapl_TimeProfiler_private use mapl_KeywordEnforcerMod - use mapl_ExceptionHandling + use mapl_ErrorHandlingMod implicit none private diff --git a/profiler/reporting/MemoryTextColumn.F90 b/profiler/reporting/MemoryTextColumn.F90 index dab784351192..1ff6fe6cc484 100644 --- a/profiler/reporting/MemoryTextColumn.F90 +++ b/profiler/reporting/MemoryTextColumn.F90 @@ -125,7 +125,7 @@ function get_suffix(x) result(suffix) integer(kind=INT64) :: ix integer(kind=INT64) :: KB = 1024 - ix = ceiling(abs(x)) + ix = ceiling(abs(x),kind=INT64) if (ix < KB) then suffix = ' B' elseif (ix < KB**2) then @@ -147,8 +147,7 @@ function convert(x) result(ix) integer(kind=INT64) :: KB = 1024 - ix = ceiling(abs(x)) - + ix = ceiling(abs(x), kind=INT64) if (ix < KB) then ix = ix elseif (ix < KB**2) then From 4eeaeeb559247b63096d7124ee72042182311244 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 15 Feb 2022 16:00:49 -0500 Subject: [PATCH 008/300] Removed unused block of code. --- gridcomps/Cap/MAPL_CapGridComp.F90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index d83090c2afeb..47c7fce2e040 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -145,11 +145,6 @@ subroutine MAPL_CapGridCompCreate(cap, root_set_services, cap_rc, name, final_fi meta%user_setservices_wrapper = ProcSetServicesWrapper(set_services_gc) call MAPL_Set(meta, CF=cap%config, __RC__) - block - character(ESMF_MAXSTR) :: root_name - call MAPL_GetResource(meta, root_name, "ROOT_NAME:", default = "ROOT", _RC) - end block - call MAPL_Set(meta, name=cap_name, component=stub_component, __RC__) cap_wrapper%ptr => cap From eaa2bc0d9098fbc239693e5d12793c05efb5b3dd Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 16 Feb 2022 15:11:11 -0500 Subject: [PATCH 009/300] Fix up changelog --- CHANGELOG.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index bb55b008dec4..db9721a892c2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,9 +10,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed - Fixed failures to fully trap errors in - . History GC - . MemUtils - . `register_generic_entry_points` + - History GC + - MemUtils + - `register_generic_entry_points` - Fixed issue in `CMakePresets.json` where Ninja presets were broken - Fixed io profiler report format - Fixed issue on macOS where enabling memutils caused crash From af13518b7cf5f3fed849eda5508ec25aca13d1a9 Mon Sep 17 00:00:00 2001 From: Amidu Oloso Date: Thu, 17 Feb 2022 09:01:16 -0500 Subject: [PATCH 010/300] Increased format width of the last column of memory use report --- base/ApplicationSupport.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/base/ApplicationSupport.F90 b/base/ApplicationSupport.F90 index 5c0fe49690df..092c455afe28 100644 --- a/base/ApplicationSupport.F90 +++ b/base/ApplicationSupport.F90 @@ -213,7 +213,7 @@ subroutine report_global_profiler(unusable,comm,rc) exclusive = MultiColumn(['Exclusive'], separator='=') call exclusive%add_column(MemoryTextColumn([' MEM '],'(i4,1x,a2)', 9, ExclusiveColumn(), separator='-')) - call exclusive%add_column(FormattedTextColumn(' MEM (KB)','(-3p,f9.3, 0p)', 9, ExclusiveColumn(), separator='-')) + call exclusive%add_column(FormattedTextColumn(' MEM (KB)','(-3p,f15.3, 0p)', 15, ExclusiveColumn(), separator='-')) !!$ call exclusive%add_column(FormattedTextColumn(' % ','(f6.2)', 6, PercentageColumn(ExclusiveColumn()), separator='-')) call reporter%add_column(exclusive) From b0de8ca4e60db7b5d5087d75fa197bfd2393ef51 Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Thu, 17 Feb 2022 16:58:06 -0500 Subject: [PATCH 011/300] Fixes 1379. Limited the duration of the clock --- CHANGELOG.md | 1 + gridcomps/Cap/MAPL_CapGridComp.F90 | 4 ++++ 2 files changed, 5 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index db9721a892c2..2487798a4cce 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Fixed duration of the clock to be the smaller of the user specified duration and (END_DATE - currTime) - Fixed failures to fully trap errors in - History GC - MemUtils diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index 47c7fce2e040..58ed86032537 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -1666,6 +1666,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) type(ESMF_Time) :: CurrTime ! Current Current Time of Experiment type(ESMF_TimeInterval) :: timeStep ! HEARTBEAT type(ESMF_TimeInterval) :: duration + type(ESMF_TimeInterval) :: maxDuration type(ESMF_Calendar) :: cal character(ESMF_MAXSTR) :: calendar @@ -1917,6 +1918,9 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) rc = STATUS ) _VERIFY(STATUS) + maxDuration = EndTime - currTime + if (duration > maxDuration) duration = maxDuration + stopTime = currTime + duration ! initialize model time step From d7abf08e22e345e74bbc2ca648666daeb4c937d7 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 18 Feb 2022 09:09:05 -0500 Subject: [PATCH 012/300] Fixes #1382. Update NRL solar table read code --- CHANGELOG.md | 3 +- base/MAPL_sun_uc.F90 | 405 +++++++++++++++++++----------------------- include/MAPL_ErrLog.h | 12 +- 3 files changed, 197 insertions(+), 223 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e2e11e028613..34158b431a79 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,7 +17,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Fixed io profiler report format - Fixed issue on macOS where enabling memutils caused crash - ### Added - New gauge for measuring memory allocation based upon mallinfo(). @@ -29,9 +28,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Updates to CircleCI - Added GEOSadas CI ifort build test - Add "like-UFS" build to CI. This is no FLAP and pFlogger, and static build +- Added new `_STAT` and `_IOSTAT` macros a la `_RC` ### Changed +- Updated `MAPL_SunGetSolarConstantFromNRLFile` to open NRL Solar Table file only on root and broadcast the tables to all processes. Now all processes do interpolation. - Major refactoring of GenericSetServices Work is not completed, but a new layer is introduced with the intent that the user SetServices is called from with in the new layer as opposed to the previous mechanism that obligated user SetServices to call diff --git a/base/MAPL_sun_uc.F90 b/base/MAPL_sun_uc.F90 index 0773fe2cede3..2cd7f26452b9 100644 --- a/base/MAPL_sun_uc.F90 +++ b/base/MAPL_sun_uc.F90 @@ -2475,54 +2475,45 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis CREATE_TABLE: if (.not. TableCreated) then - ! Open the file - ! ------------- - - filename = trim(filename_in) - - ! Does the file exist? - inquire( FILE=filename, EXIST=found ) - _ASSERT( found ,'Could not find NRL data file '//trim(filename) ) - - UNIT = GETFILE(filename, DO_OPEN=0, form="formatted", rc=status) - _VERIFY(STATUS) - - open(unit=unit, file=filename) + ! First we open the file on root to get the + ! number of lines so we can allocate our tables + ! --------------------------------------------- if (amIRoot) then + ! Open the file + ! ------------- + filename = trim(filename_in) + open(newunit=unit, file=filename, form="formatted", status="old", iostat=status) + _ASSERT(status==0,'Could not find NRL data file '// filename ) + ! Determine length of file ! ------------------------ - call lgr%debug("Scanning the Solar Table to determine number of data points") - numlines = num_lines_in_file(UNIT) - call lgr%debug("Solar Table Data Points: %i0", numlines) - ! Allocate our arrays - ! ------------------- - - allocate(yearTable(numlines), source=0, stat=status) - _VERIFY(STATUS) + ! Broadcast the number of lines + ! ----------------------------- + call MAPL_CommsBcast(vm, DATA=numlines, N=1, ROOT=0, _RC) - allocate(doyTable(numlines), source=0, stat=status) - _VERIFY(STATUS) + end if - allocate(tsi(numlines), source=0.0, stat=status) - _VERIFY(STATUS) + ! Allocate our arrays on all processes + ! ------------------------------------ - allocate(mgindex(numlines), source=0.0, stat=status) - _VERIFY(STATUS) + allocate(yearTable(numlines), source=0, _STAT) + allocate(doyTable(numlines), source=0, _STAT) + allocate(tsi(numlines), source=0.0, _STAT) + allocate(mgindex(numlines), source=0.0, _STAT) + allocate(sbindex(numlines), source=0.0, _STAT) - allocate(sbindex(numlines), source=0.0, stat=status) - _VERIFY(STATUS) + ! Back to root to read in the values + ! ---------------------------------- - ! Read in arrays - ! -------------- + if (amIRoot) then call lgr%debug("Reading the Solar Table") - i = 1 do read(unit,'(A)',iostat=stat) line @@ -2536,221 +2527,195 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis ! Belt and suspenders check that all data was read _ASSERT(size(yearTable) == numlines,"Inconsistency in NRL number of lines") + call close(unit, _IOSTAT) + end if - ! Close the file - ! -------------- + ! Broadcast the tables + ! -------------------- - call FREE_FILE(UNIT) + call MAPL_CommsBcast(vm, DATA=yearTable, N=numlines, ROOT=0, _RC) + call MAPL_CommsBcast(vm, DATA=doyTable, N=numlines, ROOT=0, _RC) + call MAPL_CommsBcast(vm, DATA=tsi, N=numlines, ROOT=0, _RC) + call MAPL_CommsBcast(vm, DATA=mgindex, N=numlines, ROOT=0, _RC) + call MAPL_CommsBcast(vm, DATA=sbindex, N=numlines, ROOT=0, _RC) TableCreated = .TRUE. end if CREATE_TABLE - ON_ROOT: if (amIRoot) then - - ! Now we need to find the two bracketing days - ! ------------------------------------------- - - ! Get current time - ! ---------------- - call ESMF_ClockGet(CLOCK, CURRTIME=currentTime, RC=STATUS) - _VERIFY(STATUS) + ! Now we need to find the two bracketing days + ! ------------------------------------------- - call ESMF_TimeGet( currentTime, YY = currentYear, & - MM = currentMon, & - DD = currentDay, & - dayOfYear = currentDOY, & - RC = STATUS ) - _VERIFY(STATUS) + ! Get current time + ! ---------------- + call ESMF_ClockGet(CLOCK, CURRTIME=currentTime, _RC) - ! Test if current time is outside our file - ! ---------------------------------------- + call ESMF_TimeGet( currentTime, YY = currentYear, & + MM = currentMon, & + DD = currentDay, & + dayOfYear = currentDOY, _RC) - outOfTable = .FALSE. + ! Test if current time is outside our file + ! ---------------------------------------- - ! First is current year higher than last in file... - if ( currentYear > yearTable(numlines) ) then - outOfTable = .TRUE. - ! ...or if a partial year, are we near the end - else if ( currentYear == yearTable(numlines) .and. currentDOY >= doyTable(numlines)) then - outOfTable = .TRUE. - end if + outOfTable = .FALSE. - ! If we are out of the table and not persisting, we must - ! recenter our day to be based on the last complete Solar Cycle - ! ------------------------------------------------------------- - OUT_OF_TABLE_AND_CYCLE: if ( outOfTable .and. (.not. PersistSolar_) ) then - - ! Create an ESMF_Time at start of Cycle 24 - ! ---------------------------------------- - call ESMF_TimeSet( startCycle24, YY = 2008, & - MM = 12, & - DD = 1, & - H = 12, & - M = 00, & - S = 00, & - RC = STATUS ) - _VERIFY(STATUS) - - ! Create an ESMF_Time at start of Cycle 25 - ! ---------------------------------------- - call ESMF_TimeSet( startCycle25, YY = 2019, & - MM = 12, & - DD = 1, & - H = 12, & - M = 00, & - S = 00, & - RC = STATUS ) - _VERIFY(STATUS) - - ! Create TimeInterval based on interval - ! from start of latest Cycle 25 - ! ------------------------------------- - - timeSinceStartOfCycle25 = currentTime - startCycle25 + ! First is current year higher than last in file... + if ( currentYear > yearTable(numlines) ) then + outOfTable = .TRUE. + ! ...or if a partial year, are we near the end + else if ( currentYear == yearTable(numlines) .and. currentDOY >= doyTable(numlines)) then + outOfTable = .TRUE. + end if - ! Make a new time based on that - ! interval past start of Cycle 24 - ! ------------------------------- + ! If we are out of the table and not persisting, we must + ! recenter our day to be based on the last complete Solar Cycle + ! ------------------------------------------------------------- + OUT_OF_TABLE_AND_CYCLE: if ( outOfTable .and. (.not. PersistSolar_) ) then - timeBasedOnCycle24 = startCycle24 + timeSinceStartOfCycle25 + ! Create an ESMF_Time at start of Cycle 24 + ! ---------------------------------------- + call ESMF_TimeSet( startCycle24, YY = 2008, & + MM = 12, & + DD = 1, & + H = 12, & + M = 00, & + S = 00, _RC) + + ! Create an ESMF_Time at start of Cycle 25 + ! ---------------------------------------- + call ESMF_TimeSet( startCycle25, YY = 2019, & + MM = 12, & + DD = 1, & + H = 12, & + M = 00, & + S = 00, _RC) + + ! Create TimeInterval based on interval + ! from start of latest Cycle 25 + ! ------------------------------------- - ! Store our original time just in case - ! ------------------------------------ - origTime = currentTime - originalYear = currentYear - originalMon = currentMon - originalDay = currentDay - origDOY = currentDOY + timeSinceStartOfCycle25 = currentTime - startCycle25 - ! Make our "current" time the one calculated above - ! ------------------------------------------------ - currentTime = timeBasedOnCycle24 + ! Make a new time based on that + ! interval past start of Cycle 24 + ! ------------------------------- - ! Get new currentYear, currentMon, currentDay - ! ------------------------------------------- + timeBasedOnCycle24 = startCycle24 + timeSinceStartOfCycle25 - call ESMF_TimeGet( currentTime, YY = currentYear, & - MM = currentMon, & - DD = currentDay, & - dayOfYear = currentDOY, & - RC = STATUS ) - _VERIFY(STATUS) + ! Store our original time just in case + ! ------------------------------------ + origTime = currentTime + originalYear = currentYear + originalMon = currentMon + originalDay = currentDay + origDOY = currentDOY + ! Make our "current" time the one calculated above + ! ------------------------------------------------ + currentTime = timeBasedOnCycle24 - ! Debugging Prints - ! ---------------- - call lgr%debug('Off the end of table, moving into last complete cycle') - call lgr%debug(' Original Year-Mon-Day to Find: %i0.4~-%i0.2~-%i0.2', originalYear,originalMon,originalDay) - call lgr%debug(' Original Day of Year: %i0', origDOY) - call lgr%debug(' New Year-Mon-Day to Find: %i0.4~-%i0.2~-%i0.2', currentYear,currentMon,currentDay) - call lgr%debug(' New Day of Year: %i0', currentDOY) - - end if OUT_OF_TABLE_AND_CYCLE - - ! Create an ESMF_Time on noon of current day - ! ------------------------------------------ - call ESMF_TimeSet( noonCurrentDay, YY = currentYear, & - MM = currentMon, & - DD = currentDay, & - H = 12, & - M = 00, & - S = 00, & - RC = STATUS ) - _VERIFY(STATUS) + ! Get new currentYear, currentMon, currentDay + ! ------------------------------------------- - ! Figure out bracketing days for interpolation - ! NOTE: nextNoon is mainly for debugging purposes - ! ----------------------------------------------- - call ESMF_TimeIntervalSet(oneDayInterval, D=1, rc=status) - if (currentTime <= noonCurrentDay) then - prevNoon = noonCurrentDay - oneDayInterval - nextNoon = noonCurrentDay - else - prevNoon = noonCurrentDay - nextNoon = noonCurrentDay + oneDayInterval - end if + call ESMF_TimeGet( currentTime, YY = currentYear, & + MM = currentMon, & + DD = currentDay, & + dayOfYear = currentDOY, _RC) - ! Get the DOYs - ! ------------ - call ESMF_TimeGet( prevNoon, YY = prevNoonYear, dayOfYear = prevDOY, rc = status ) - call ESMF_TimeGet( nextNoon, YY = nextNoonYear, dayOfYear = nextDOY, rc = status ) + call lgr%debug('Off the end of table, moving into last complete cycle') + call lgr%debug(' Original Year-Mon-Day to Find: %i0.4~-%i0.2~-%i0.2', originalYear,originalMon,originalDay) + call lgr%debug(' Original Day of Year: %i0', origDOY) + call lgr%debug(' New Year-Mon-Day to Find: %i0.4~-%i0.2~-%i0.2', currentYear,currentMon,currentDay) + call lgr%debug(' New Day of Year: %i0', currentDOY) - ! Our interpolation factor is based of when we are compared to the next noon - ! -------------------------------------------------------------------------- - intToNextNoon = nextNoon-currentTime + end if OUT_OF_TABLE_AND_CYCLE - ! The FAC for interpolating is just the real version - ! of the size of the timeinterval to the next noon - ! -------------------------------------------------- - call ESMF_TimeIntervalGet(intToNextNoon, d_r8=days_r8, rc=STATUS) - _VERIFY(STATUS) - FAC = real(days_r8) - - ! Use our find_file_index function to get the index for previous noon - ! ------------------------------------------------------------------- - INDX1 = find_file_index(numlines, yearTable, prevNoonYear, prevDOY) - INDX2 = INDX1 + 1 - - ! If we are outOfTable and we have the PersistSolar - ! option we just use the last value in the table... - ! ------------------------------------------------- - OUT_OF_TABLE_AND_PERSIST: if ( outOfTable .and. PersistSolar_) then - - SC = tsi(numlines) - MG = mgindex(numlines) - SB = sbindex(numlines) - - ! Debugging Prints - ! ---------------- - call lgr%debug('Off the end of table, persisting last values') - call lgr%debug(' tsi at end of table: %F8.3', tsi(numlines)) - call lgr%debug(' mgindex at end of table: %F8.6', mgindex(numlines)) - call lgr%debug(' sbindex at end of table: %F9.4', sbindex(numlines)) - - ! Otherwise we interpolate to the table - ! ------------------------------------- - else + ! Create an ESMF_Time on noon of current day + ! ------------------------------------------ + call ESMF_TimeSet( noonCurrentDay, YY = currentYear, & + MM = currentMon, & + DD = currentDay, & + H = 12, & + M = 00, & + S = 00, _RC) + + ! Figure out bracketing days for interpolation + ! NOTE: nextNoon is mainly for debugging purposes + ! ----------------------------------------------- + call ESMF_TimeIntervalSet(oneDayInterval, D=1, _RC) + if (currentTime <= noonCurrentDay) then + prevNoon = noonCurrentDay - oneDayInterval + nextNoon = noonCurrentDay + else + prevNoon = noonCurrentDay + nextNoon = noonCurrentDay + oneDayInterval + end if - ! Linear Interpolation to the given day-of-month - ! ---------------------------------------------- - - SC = tsi(INDX1)*FAC + tsi(INDX2)*(1.0-FAC) - MG = mgindex(INDX1)*FAC + mgindex(INDX2)*(1.0-FAC) - SB = sbindex(INDX1)*FAC + sbindex(INDX2)*(1.0-FAC) - - ! Debugging Prints - ! ---------------- - call lgr%debug(' First DOY to Find: %i3', prevDOY) - call lgr%debug(' file_index for date: %i6', INDX1) - call lgr%debug(' yearTable(date): %i4', yearTable(INDX1)) - call lgr%debug(' doyTable(date): %i3', doyTable(INDX1)) - call lgr%debug(' tsi(date): %f8.3', tsi(INDX1)) - call lgr%debug(' mgindex(date): %f8.6', mgindex(INDX1)) - call lgr%debug(' sbindex(date): %f9.4', sbindex(INDX1)) - - call lgr%debug(' Second DOY to Find: %i3', nextDOY) - call lgr%debug(' file_index for date: %i6', INDX2) - call lgr%debug(' yearTable(date): %i4', yearTable(INDX2)) - call lgr%debug(' doyTable(date): %i3', doyTable(INDX2)) - call lgr%debug(' tsi(date): %f8.3', tsi(INDX2)) - call lgr%debug(' mgindex(date): %f8.6', mgindex(INDX2)) - call lgr%debug(' sbindex(date): %f9.4', sbindex(INDX2)) - - call lgr%debug(' Interpolation Factor: %f8.6', FAC) - end if OUT_OF_TABLE_AND_PERSIST - end if ON_ROOT - - ! Broadcast the values - ! -------------------- + ! Get the DOYs + ! ------------ + call ESMF_TimeGet( prevNoon, YY = prevNoonYear, dayOfYear = prevDOY, _RC) + call ESMF_TimeGet( nextNoon, YY = nextNoonYear, dayOfYear = nextDOY, _RC) + + ! Our interpolation factor is based of when we are compared to the next noon + ! -------------------------------------------------------------------------- + intToNextNoon = nextNoon-currentTime + + ! The FAC for interpolating is just the real version + ! of the size of the timeinterval to the next noon + ! -------------------------------------------------- + call ESMF_TimeIntervalGet(intToNextNoon, d_r8=days_r8, _RC) + FAC = real(days_r8) + + ! Use our find_file_index function to get the index for previous noon + ! ------------------------------------------------------------------- + INDX1 = find_file_index(numlines, yearTable, prevNoonYear, prevDOY) + INDX2 = INDX1 + 1 + + ! If we are outOfTable and we have the PersistSolar + ! option we just use the last value in the table... + ! ------------------------------------------------- + OUT_OF_TABLE_AND_PERSIST: if ( outOfTable .and. PersistSolar_) then + + SC = tsi(numlines) + MG = mgindex(numlines) + SB = sbindex(numlines) + + call lgr%debug('Off the end of table, persisting last values') + call lgr%debug(' tsi at end of table: %F8.3', tsi(numlines)) + call lgr%debug(' mgindex at end of table: %F8.6', mgindex(numlines)) + call lgr%debug(' sbindex at end of table: %F9.4', sbindex(numlines)) + + ! Otherwise we interpolate to the table + ! ------------------------------------- + else - call MAPL_CommsBcast(vm, DATA=SC, N=1, ROOT=0, RC=status) - _VERIFY(STATUS) - call MAPL_CommsBcast(vm, DATA=MG, N=1, ROOT=0, RC=status) - _VERIFY(STATUS) - call MAPL_CommsBcast(vm, DATA=SB, N=1, ROOT=0, RC=status) - _VERIFY(STATUS) + ! Linear Interpolation to the given day-of-month + ! ---------------------------------------------- + + SC = tsi(INDX1)*FAC + tsi(INDX2)*(1.0-FAC) + MG = mgindex(INDX1)*FAC + mgindex(INDX2)*(1.0-FAC) + SB = sbindex(INDX1)*FAC + sbindex(INDX2)*(1.0-FAC) + + call lgr%debug(' First DOY to Find: %i3', prevDOY) + call lgr%debug(' file_index for date: %i6', INDX1) + call lgr%debug(' yearTable(date): %i4', yearTable(INDX1)) + call lgr%debug(' doyTable(date): %i3', doyTable(INDX1)) + call lgr%debug(' tsi(date): %f8.3', tsi(INDX1)) + call lgr%debug(' mgindex(date): %f8.6', mgindex(INDX1)) + call lgr%debug(' sbindex(date): %f9.4', sbindex(INDX1)) + + call lgr%debug(' Second DOY to Find: %i3', nextDOY) + call lgr%debug(' file_index for date: %i6', INDX2) + call lgr%debug(' yearTable(date): %i4', yearTable(INDX2)) + call lgr%debug(' doyTable(date): %i3', doyTable(INDX2)) + call lgr%debug(' tsi(date): %f8.3', tsi(INDX2)) + call lgr%debug(' mgindex(date): %f8.6', mgindex(INDX2)) + call lgr%debug(' sbindex(date): %f9.4', sbindex(INDX2)) + + call lgr%debug(' Interpolation Factor: %f8.6', FAC) + end if OUT_OF_TABLE_AND_PERSIST _RETURN(ESMF_SUCCESS) diff --git a/include/MAPL_ErrLog.h b/include/MAPL_ErrLog.h index 36e8bb9a69fe..6c5dacb8a597 100644 --- a/include/MAPL_ErrLog.h +++ b/include/MAPL_ErrLog.h @@ -2,7 +2,7 @@ ! The error logging may eventually evolve into a module based ! on the ESMF logger. For now these macros provide simple -! traceback capability. +! traceback capability. #ifndef MAPL_ErrLog_DONE @@ -44,6 +44,12 @@ # ifdef _RC # undef _RC # endif +# ifdef _STAT +# undef _STAT +# endif +# ifdef _IOSTAT +# undef _IOSTAT +# endif # ifdef __return # undef __return # endif @@ -55,7 +61,7 @@ # ifdef I_AM_MAIN # define __return call MAPL_abort() -# define __rc(rc) +# define __rc(rc) # else # define __return return # define __rc(rc) ,rc @@ -92,6 +98,8 @@ # define _RC_(rc,status) rc=status);_VERIFY(status # define _RC _RC_(rc,status) +# define _STAT _RC_(stat,status) +# define _IOSTAT _RC_(iostat,status) # define _ASSERT_MSG_AND_LOC_AND_RC(A,msg,stat,file,line,rc) if(MAPL_Assert(A,msg,stat,file,line __rc(rc))) __return From 52358209775ff1147343688512e94cbce5450c1b Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 18 Feb 2022 09:56:00 -0500 Subject: [PATCH 013/300] close is not a subroutine but a function --- base/MAPL_sun_uc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/base/MAPL_sun_uc.F90 b/base/MAPL_sun_uc.F90 index 2cd7f26452b9..904ebbcea971 100644 --- a/base/MAPL_sun_uc.F90 +++ b/base/MAPL_sun_uc.F90 @@ -2527,7 +2527,7 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis ! Belt and suspenders check that all data was read _ASSERT(size(yearTable) == numlines,"Inconsistency in NRL number of lines") - call close(unit, _IOSTAT) + close(unit, _IOSTAT) end if From e85cff31aec0134a64cbf4c7b3b3c8e49524400a Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 18 Feb 2022 10:07:28 -0500 Subject: [PATCH 014/300] Bcast on all processes --- base/MAPL_sun_uc.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/base/MAPL_sun_uc.F90 b/base/MAPL_sun_uc.F90 index 904ebbcea971..66b62a6089f8 100644 --- a/base/MAPL_sun_uc.F90 +++ b/base/MAPL_sun_uc.F90 @@ -2493,12 +2493,12 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis numlines = num_lines_in_file(UNIT) call lgr%debug("Solar Table Data Points: %i0", numlines) - ! Broadcast the number of lines - ! ----------------------------- - call MAPL_CommsBcast(vm, DATA=numlines, N=1, ROOT=0, _RC) - end if + ! Broadcast the number of lines + ! ----------------------------- + call MAPL_CommsBcast(vm, DATA=numlines, N=1, ROOT=0, _RC) + ! Allocate our arrays on all processes ! ------------------------------------ From 2428a99e8311495a5b1d9340ff4821358d271028 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 18 Feb 2022 10:46:32 -0500 Subject: [PATCH 015/300] Add Asserts suggested by Peter Norris --- base/MAPL_sun_uc.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/base/MAPL_sun_uc.F90 b/base/MAPL_sun_uc.F90 index 66b62a6089f8..7e387cbdf6c5 100644 --- a/base/MAPL_sun_uc.F90 +++ b/base/MAPL_sun_uc.F90 @@ -2671,7 +2671,9 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis ! Use our find_file_index function to get the index for previous noon ! ------------------------------------------------------------------- INDX1 = find_file_index(numlines, yearTable, prevNoonYear, prevDOY) + _ASSERT(INDX1 /= YEAR_NOT_FOUND, 'dropped off end of NRL table v1') INDX2 = INDX1 + 1 + _ASSERT(INDX2 <= numlines, 'dropped off end of NRL table v2') ! If we are outOfTable and we have the PersistSolar ! option we just use the last value in the table... From f9c36ce50e322261e7998a33b93530f5f855dc84 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 18 Feb 2022 13:05:23 -0500 Subject: [PATCH 016/300] Last asserts were in wrong place. Remove for now --- base/MAPL_sun_uc.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/base/MAPL_sun_uc.F90 b/base/MAPL_sun_uc.F90 index 7e387cbdf6c5..66b62a6089f8 100644 --- a/base/MAPL_sun_uc.F90 +++ b/base/MAPL_sun_uc.F90 @@ -2671,9 +2671,7 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis ! Use our find_file_index function to get the index for previous noon ! ------------------------------------------------------------------- INDX1 = find_file_index(numlines, yearTable, prevNoonYear, prevDOY) - _ASSERT(INDX1 /= YEAR_NOT_FOUND, 'dropped off end of NRL table v1') INDX2 = INDX1 + 1 - _ASSERT(INDX2 <= numlines, 'dropped off end of NRL table v2') ! If we are outOfTable and we have the PersistSolar ! option we just use the last value in the table... From 9c54e213b5994cd48f881c7400f3612d0e931ddd Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 18 Feb 2022 13:09:37 -0500 Subject: [PATCH 017/300] Update base/MAPL_sun_uc.F90 Co-authored-by: Tom Clune --- base/MAPL_sun_uc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/base/MAPL_sun_uc.F90 b/base/MAPL_sun_uc.F90 index 66b62a6089f8..ef4271aa1da5 100644 --- a/base/MAPL_sun_uc.F90 +++ b/base/MAPL_sun_uc.F90 @@ -2485,7 +2485,7 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis ! ------------- filename = trim(filename_in) open(newunit=unit, file=filename, form="formatted", status="old", iostat=status) - _ASSERT(status==0,'Could not find NRL data file '// filename ) + _ASSERT(status==0,'Could not find NRL data file '// trim(filename )) ! Determine length of file ! ------------------------ From b6cefa509d194c3597e3bb19507d202e88d963a2 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 22 Feb 2022 13:18:58 -0500 Subject: [PATCH 018/300] Reloop code per Peter Norris --- base/MAPL_sun_uc.F90 | 204 ++++++++++++++++++++++--------------------- 1 file changed, 105 insertions(+), 99 deletions(-) diff --git a/base/MAPL_sun_uc.F90 b/base/MAPL_sun_uc.F90 index ef4271aa1da5..14b9d7166a6f 100644 --- a/base/MAPL_sun_uc.F90 +++ b/base/MAPL_sun_uc.F90 @@ -2569,68 +2569,93 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis outOfTable = .TRUE. end if - ! If we are out of the table and not persisting, we must - ! recenter our day to be based on the last complete Solar Cycle - ! ------------------------------------------------------------- - OUT_OF_TABLE_AND_CYCLE: if ( outOfTable .and. (.not. PersistSolar_) ) then - - ! Create an ESMF_Time at start of Cycle 24 - ! ---------------------------------------- - call ESMF_TimeSet( startCycle24, YY = 2008, & - MM = 12, & - DD = 1, & - H = 12, & - M = 00, & - S = 00, _RC) - - ! Create an ESMF_Time at start of Cycle 25 - ! ---------------------------------------- - call ESMF_TimeSet( startCycle25, YY = 2019, & - MM = 12, & - DD = 1, & - H = 12, & - M = 00, & - S = 00, _RC) - - ! Create TimeInterval based on interval - ! from start of latest Cycle 25 - ! ------------------------------------- - - timeSinceStartOfCycle25 = currentTime - startCycle25 - - ! Make a new time based on that - ! interval past start of Cycle 24 - ! ------------------------------- - - timeBasedOnCycle24 = startCycle24 + timeSinceStartOfCycle25 - - ! Store our original time just in case - ! ------------------------------------ - origTime = currentTime - originalYear = currentYear - originalMon = currentMon - originalDay = currentDay - origDOY = currentDOY + ! If we are out of the table... + ! ----------------------------- + + OUT_OF_TABLE: if ( outOfTable ) then + + PERSIST_SOLAR: if ( PersistSolar_ ) then - ! Make our "current" time the one calculated above - ! ------------------------------------------------ - currentTime = timeBasedOnCycle24 + ! If we are outOfTable and we have the PersistSolar + ! option we just use the last value in the table... + ! ------------------------------------------------- - ! Get new currentYear, currentMon, currentDay - ! ------------------------------------------- + SC = tsi(numlines) + MG = mgindex(numlines) + SB = sbindex(numlines) - call ESMF_TimeGet( currentTime, YY = currentYear, & - MM = currentMon, & - DD = currentDay, & - dayOfYear = currentDOY, _RC) + call lgr%debug('Off the end of table, persisting last values') + call lgr%debug(' tsi at end of table: %F8.3', tsi(numlines)) + call lgr%debug(' mgindex at end of table: %F8.6', mgindex(numlines)) + call lgr%debug(' sbindex at end of table: %F9.4', sbindex(numlines)) - call lgr%debug('Off the end of table, moving into last complete cycle') - call lgr%debug(' Original Year-Mon-Day to Find: %i0.4~-%i0.2~-%i0.2', originalYear,originalMon,originalDay) - call lgr%debug(' Original Day of Year: %i0', origDOY) - call lgr%debug(' New Year-Mon-Day to Find: %i0.4~-%i0.2~-%i0.2', currentYear,currentMon,currentDay) - call lgr%debug(' New Day of Year: %i0', currentDOY) + _RETURN(ESMF_SUCCESS) + + else - end if OUT_OF_TABLE_AND_CYCLE + ! If we are out of the table and not persisting, we must + ! recenter our day to be based on the last complete Solar Cycle + ! ------------------------------------------------------------- + + ! Create an ESMF_Time at start of Cycle 24 + ! ---------------------------------------- + call ESMF_TimeSet( startCycle24, YY = 2008, & + MM = 12, & + DD = 1, & + H = 12, & + M = 00, & + S = 00, _RC) + + ! Create an ESMF_Time at start of Cycle 25 + ! ---------------------------------------- + call ESMF_TimeSet( startCycle25, YY = 2019, & + MM = 12, & + DD = 1, & + H = 12, & + M = 00, & + S = 00, _RC) + + ! Create TimeInterval based on interval + ! from start of latest Cycle 25 + ! ------------------------------------- + + timeSinceStartOfCycle25 = currentTime - startCycle25 + + ! Make a new time based on that + ! interval past start of Cycle 24 + ! ------------------------------- + + timeBasedOnCycle24 = startCycle24 + timeSinceStartOfCycle25 + + ! Store our original time just in case + ! ------------------------------------ + origTime = currentTime + originalYear = currentYear + originalMon = currentMon + originalDay = currentDay + origDOY = currentDOY + + ! Make our "current" time the one calculated above + ! ------------------------------------------------ + currentTime = timeBasedOnCycle24 + + ! Get new currentYear, currentMon, currentDay + ! ------------------------------------------- + + call ESMF_TimeGet( currentTime, YY = currentYear, & + MM = currentMon, & + DD = currentDay, & + dayOfYear = currentDOY, _RC) + + call lgr%debug('Off the end of table, moving into last complete cycle') + call lgr%debug(' Original Year-Mon-Day to Find: %i0.4~-%i0.2~-%i0.2', originalYear,originalMon,originalDay) + call lgr%debug(' Original Day of Year: %i0', origDOY) + call lgr%debug(' New Year-Mon-Day to Find: %i0.4~-%i0.2~-%i0.2', currentYear,currentMon,currentDay) + call lgr%debug(' New Day of Year: %i0', currentDOY) + + end if PERSIST_SOLAR + + end if OUT_OF_TABLE ! Create an ESMF_Time on noon of current day ! ------------------------------------------ @@ -2673,49 +2698,30 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis INDX1 = find_file_index(numlines, yearTable, prevNoonYear, prevDOY) INDX2 = INDX1 + 1 - ! If we are outOfTable and we have the PersistSolar - ! option we just use the last value in the table... - ! ------------------------------------------------- - OUT_OF_TABLE_AND_PERSIST: if ( outOfTable .and. PersistSolar_) then - - SC = tsi(numlines) - MG = mgindex(numlines) - SB = sbindex(numlines) - - call lgr%debug('Off the end of table, persisting last values') - call lgr%debug(' tsi at end of table: %F8.3', tsi(numlines)) - call lgr%debug(' mgindex at end of table: %F8.6', mgindex(numlines)) - call lgr%debug(' sbindex at end of table: %F9.4', sbindex(numlines)) - - ! Otherwise we interpolate to the table - ! ------------------------------------- - else + ! Linear Interpolation to the given day-of-month + ! ---------------------------------------------- - ! Linear Interpolation to the given day-of-month - ! ---------------------------------------------- - - SC = tsi(INDX1)*FAC + tsi(INDX2)*(1.0-FAC) - MG = mgindex(INDX1)*FAC + mgindex(INDX2)*(1.0-FAC) - SB = sbindex(INDX1)*FAC + sbindex(INDX2)*(1.0-FAC) - - call lgr%debug(' First DOY to Find: %i3', prevDOY) - call lgr%debug(' file_index for date: %i6', INDX1) - call lgr%debug(' yearTable(date): %i4', yearTable(INDX1)) - call lgr%debug(' doyTable(date): %i3', doyTable(INDX1)) - call lgr%debug(' tsi(date): %f8.3', tsi(INDX1)) - call lgr%debug(' mgindex(date): %f8.6', mgindex(INDX1)) - call lgr%debug(' sbindex(date): %f9.4', sbindex(INDX1)) - - call lgr%debug(' Second DOY to Find: %i3', nextDOY) - call lgr%debug(' file_index for date: %i6', INDX2) - call lgr%debug(' yearTable(date): %i4', yearTable(INDX2)) - call lgr%debug(' doyTable(date): %i3', doyTable(INDX2)) - call lgr%debug(' tsi(date): %f8.3', tsi(INDX2)) - call lgr%debug(' mgindex(date): %f8.6', mgindex(INDX2)) - call lgr%debug(' sbindex(date): %f9.4', sbindex(INDX2)) - - call lgr%debug(' Interpolation Factor: %f8.6', FAC) - end if OUT_OF_TABLE_AND_PERSIST + SC = tsi(INDX1)*FAC + tsi(INDX2)*(1.0-FAC) + MG = mgindex(INDX1)*FAC + mgindex(INDX2)*(1.0-FAC) + SB = sbindex(INDX1)*FAC + sbindex(INDX2)*(1.0-FAC) + + call lgr%debug(' First DOY to Find: %i3', prevDOY) + call lgr%debug(' file_index for date: %i6', INDX1) + call lgr%debug(' yearTable(date): %i4', yearTable(INDX1)) + call lgr%debug(' doyTable(date): %i3', doyTable(INDX1)) + call lgr%debug(' tsi(date): %f8.3', tsi(INDX1)) + call lgr%debug(' mgindex(date): %f8.6', mgindex(INDX1)) + call lgr%debug(' sbindex(date): %f9.4', sbindex(INDX1)) + + call lgr%debug(' Second DOY to Find: %i3', nextDOY) + call lgr%debug(' file_index for date: %i6', INDX2) + call lgr%debug(' yearTable(date): %i4', yearTable(INDX2)) + call lgr%debug(' doyTable(date): %i3', doyTable(INDX2)) + call lgr%debug(' tsi(date): %f8.3', tsi(INDX2)) + call lgr%debug(' mgindex(date): %f8.6', mgindex(INDX2)) + call lgr%debug(' sbindex(date): %f9.4', sbindex(INDX2)) + + call lgr%debug(' Interpolation Factor: %f8.6', FAC) _RETURN(ESMF_SUCCESS) From 32d5900701baefd91f41d106575fe443f3d1174b Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 25 Feb 2022 08:39:28 -0500 Subject: [PATCH 019/300] Revert "Added new gauge for memory profiling." --- CHANGELOG.md | 4 -- base/ApplicationSupport.F90 | 48 ++-------------- generic/MAPL_Generic.F90 | 30 +--------- gridcomps/Cap/MAPL_CapGridComp.F90 | 14 +---- profiler/CMakeLists.txt | 1 - profiler/MAPL_Profiler.F90 | 2 - profiler/MallocGauge.F90 | 74 ------------------------- profiler/MemoryProfiler.F90 | 20 +++---- profiler/TimeProfiler.F90 | 2 +- profiler/reporting/MemoryTextColumn.F90 | 5 +- 10 files changed, 18 insertions(+), 182 deletions(-) delete mode 100644 profiler/MallocGauge.F90 diff --git a/CHANGELOG.md b/CHANGELOG.md index 86c1fc950907..e5e33403fd2b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -41,10 +41,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added -- New gauge for measuring memory allocation based upon mallinfo(). - MAPL is now instrumented with this memory profiler and it produces - reasonable results. Should nicely complement other tools that - measure HWM. - Option to force integer time variable in History output via the History.rc file (IntegerTime: .true./.false. default .false.) rather than the default float time variable if allowed by frequency of output - Added mapl_StubComponent to MAPL package - Updates to CircleCI diff --git a/base/ApplicationSupport.F90 b/base/ApplicationSupport.F90 index 32e554658f98..8e23c82619ae 100644 --- a/base/ApplicationSupport.F90 +++ b/base/ApplicationSupport.F90 @@ -23,17 +23,9 @@ subroutine MAPL_Initialize(unusable,comm,logging_config,rc) character(:), allocatable :: logging_configuration_file integer :: comm_world,status - class (BaseProfiler), pointer :: m_p _UNUSED_DUMMY(unusable) - call initialize_profiler(comm=comm_world) - call start_global_time_profiler(_RC) - call start_global_memory_profiler(_RC) - - m_p => get_global_memory_profiler() - call m_p%start('init pflogger', _RC) - if (present(logging_config)) then logging_configuration_file=logging_config else @@ -44,15 +36,15 @@ subroutine MAPL_Initialize(unusable,comm,logging_config,rc) else comm_world=MPI_COMM_WORLD end if - - #ifdef BUILD_WITH_PFLOGGER call initialize_pflogger(comm=comm_world,logging_config=logging_configuration_file,rc=status) _VERIFY(status) #endif - call m_p%stop('init pflogger', _RC) - + call initialize_profiler(comm=comm_world) + call start_global_time_profiler(rc=status) + _VERIFY(status) _RETURN(_SUCCESS) + end subroutine MAPL_Initialize subroutine MAPL_Finalize(unusable,comm,rc) @@ -165,7 +157,6 @@ subroutine report_global_profiler(unusable,comm,rc) integer :: npes, my_rank, ierror character(1) :: empty(0) class (BaseProfiler), pointer :: t_p - class (BaseProfiler), pointer :: m_p _UNUSED_DUMMY(unusable) if (present(comm)) then @@ -174,7 +165,6 @@ subroutine report_global_profiler(unusable,comm,rc) world_comm=MPI_COMM_WORLD end if t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() reporter = ProfileReporter(empty) call reporter%add_column(NameColumn(50, separator= " ")) @@ -200,38 +190,8 @@ subroutine report_global_profiler(unusable,comm,rc) write(*,'(a)') report_lines(i) end do end if - -#if (!defined(sysDarwin) && (defined(__INTEL_COMPILER) || defined(__GFORTRAN))) - reporter = ProfileReporter(empty) - call reporter%add_column(NameColumn(50, separator= " ")) - - inclusive = MultiColumn(['Inclusive'], separator='=') - call inclusive%add_column(MemoryTextColumn([' MEM '],'(i4,1x,a2)', 9, InclusiveColumn(), separator='-')) -!!$ call inclusive%add_column(FormattedTextColumn(' % ','(f6.2)', 6, PercentageColumn(InclusiveColumn()), separator='-')) - call reporter%add_column(inclusive) - - exclusive = MultiColumn(['Exclusive'], separator='=') - call exclusive%add_column(MemoryTextColumn([' MEM '],'(i4,1x,a2)', 9, ExclusiveColumn(), separator='-')) - call exclusive%add_column(FormattedTextColumn(' MEM (KB)','(-3p,f15.3, 0p)', 15, ExclusiveColumn(), separator='-')) -!!$ call exclusive%add_column(FormattedTextColumn(' % ','(f6.2)', 6, PercentageColumn(ExclusiveColumn()), separator='-')) - call reporter%add_column(exclusive) - - call MPI_Comm_size(world_comm, npes, ierror) - call MPI_Comm_Rank(world_comm, my_rank, ierror) - - if (my_rank == 0) then - report_lines = reporter%generate_report(m_p) - write(*,'(a,1x,i0)')'Report on process: ', my_rank - do i = 1, size(report_lines) - write(*,'(a)') report_lines(i) - end do - end if -#endif - call MPI_Barrier(world_comm, ierror) - _RETURN(_SUCCESS) - end subroutine report_global_profiler end module MAPL_ApplicationSupport diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index a1a36e12cb6c..f548d0a38337 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -664,7 +664,6 @@ recursive subroutine MAPL_GenericInitialize ( GC, import, EXPORT, CLOCK, RC ) type(ESMF_State), pointer :: child_export_state type(ESMF_GridComp), pointer :: gridcomp type(ESMF_State), pointer :: internal_state - class(BaseProfiler), pointer :: m_p !============================================================================= ! Begin... @@ -850,25 +849,16 @@ recursive subroutine MAPL_GenericInitialize ( GC, import, EXPORT, CLOCK, RC ) !!$ call MAPL_TimerOff(STATE,"generic",__RC__) - m_p => get_global_memory_profiler() - call m_p%start('children') call initialize_children_and_couplers(_RC) - call m_p%stop('children') call MAPL_TimerOn(STATE,"generic") - call m_p%start('import vars') call create_import_and_initialize_state_variables(__RC__) - call m_p%stop('import vars') call ESMF_AttributeSet(import,'POSITIVE',trim(positive),__RC__) - call m_p%start('internal vars') call create_internal_and_initialize_state_variables(__RC__) - call m_p%stop('internal vars') - call m_p%start('export vars') call create_export_state_variables(__RC__) - call m_p%stop('export vars') ! Create forcing state STATE%FORCING = ESMF_StateCreate(name = trim(comp_name) // "_FORCING", & @@ -1527,7 +1517,6 @@ recursive subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) type(ESMF_Method_Flag) :: method type(ESMF_VM) :: VM class(BaseProfiler), pointer :: t_p - class(BaseProfiler), pointer :: m_p character(1) :: char_phase character(len=12), pointer :: timers(:) => NULL() @@ -1564,9 +1553,7 @@ recursive subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) ! TIMERS on t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() call t_p%start(trim(state%compname),__RC__) - call m_p%start(trim(state%compname),__RC__) phase_ = MAPL_MAX_PHASES+phase ! this is the "actual" phase, i.e. the one user registered @@ -1643,7 +1630,6 @@ recursive subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) call state%t_profiler%stop(__RC__) end if call t_p%stop(trim(state%compname),__RC__) - call m_p%stop(trim(state%compname),__RC__) endif @@ -1819,7 +1805,6 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: ens_id_width type(ESMF_Time) :: CurrTime class(BaseProfiler), pointer :: t_p - class(BaseProfiler), pointer :: m_p type(ESMF_GridComp), pointer :: gridcomp type(ESMF_State), pointer :: child_import_state type(ESMF_State), pointer :: child_export_state @@ -1845,7 +1830,6 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! --------------------- t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() NC = STATE%get_num_children() allocate(CHLDMAPL(NC), stat=status) @@ -1985,7 +1969,6 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) end if call t_p%stop(trim(state%compname),__RC__) - call m_p%stop(trim(state%compname),__RC__) ! Clean-up !--------- @@ -2103,7 +2086,7 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: K logical :: ftype(0:1) - class(BaseProfiler), pointer :: t_p, m_p + class(BaseProfiler), pointer :: t_p type(ESMF_GridComp), pointer :: gridcomp type(ESMF_State), pointer :: child_import_state type(ESMF_State), pointer :: child_export_state @@ -2123,7 +2106,6 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) _VERIFY(status) t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() call state%t_profiler%start(__RC__) call state%t_profiler%start('Record',__RC__) @@ -2328,7 +2310,6 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=4) :: extension integer :: hdr class(BaseProfiler), pointer :: t_p - class(BaseProfiler), pointer :: m_p type(ESMF_GridComp), pointer :: gridcomp type(ESMF_State), pointer :: child_import_state type(ESMF_State), pointer :: child_export_state @@ -2347,6 +2328,7 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_InternalStateRetrieve(GC, STATE, RC=status) _VERIFY(status) + t_p => get_global_time_profiler() call state%t_profiler%start(__RC__) call state%t_profiler%start('Refresh',__RC__) @@ -4368,7 +4350,6 @@ recursive integer function AddChildFromMeta(META, NAME, GRID, & integer :: I type(MAPL_MetaComp), pointer :: child_meta class(BaseProfiler), pointer :: t_p - class(BaseProfiler), pointer :: m_p integer :: userRC if (.not.allocated(META%GCNameList)) then @@ -4381,9 +4362,7 @@ recursive integer function AddChildFromMeta(META, NAME, GRID, & call AddChild_preamble(meta, I, name, grid=grid, configfile=configfile, parentGC=parentgc, petList=petlist, child_meta=child_meta, __RC__) t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() call t_p%start(trim(NAME),__RC__) - call m_p%start(trim(NAME),__RC__) call child_meta%t_profiler%start(__RC__) call child_meta%t_profiler%start('SetService',__RC__) @@ -4395,7 +4374,6 @@ recursive integer function AddChildFromMeta(META, NAME, GRID, & call child_meta%t_profiler%stop('SetService',__RC__) call child_meta%t_profiler%stop(__RC__) call t_p%stop(trim(NAME),__RC__) - call m_p%stop(trim(NAME),__RC__) _VERIFY(status) @@ -4610,7 +4588,6 @@ recursive integer function AddChildFromDSO(gc, name, userRoutine, grid, sharedOb integer :: I type(MAPL_MetaComp), pointer :: child_meta class(BaseProfiler), pointer :: t_p - class(BaseProfiler), pointer :: m_p class(Logger), pointer :: lgr character(len=:), allocatable :: shared_object_library_to_load @@ -4629,9 +4606,7 @@ recursive integer function AddChildFromDSO(gc, name, userRoutine, grid, sharedOb call AddChild_preamble(meta, I, name, grid=grid, configfile=configfile, parentGC=gc, petList=petlist, child_meta=child_meta, __RC__) t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() call t_p%start(trim(name),__RC__) - call m_p%start(trim(name),__RC__) call child_meta%t_profiler%start(__RC__) call child_meta%t_profiler%start('SetService',__RC__) @@ -4653,7 +4628,6 @@ recursive integer function AddChildFromDSO(gc, name, userRoutine, grid, sharedOb call child_meta%t_profiler%stop('SetService',__RC__) call child_meta%t_profiler%stop(__RC__) call t_p%stop(trim(name),__RC__) - call m_p%stop(trim(name),__RC__) _RETURN(ESMF_SUCCESS) end function AddChildFromDSO diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index 5a908e8b1e7f..58ed86032537 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -214,7 +214,6 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) procedure(), pointer :: root_set_services type(MAPL_CapGridComp), pointer :: cap class(BaseProfiler), pointer :: t_p - class(BaseProfiler), pointer :: m_p class(Logger), pointer :: lgr type(ESMF_Clock) :: cap_clock @@ -227,7 +226,6 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) _VERIFY(status) t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() call ESMF_GridCompGet(gc, vm = cap%vm, rc = status) _VERIFY(status) @@ -503,7 +501,6 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) root_set_services => cap%root_set_services call t_p%start('SetService') - !!$ cap%root_id = MAPL_AddChild(MAPLOBJ, name = root_name, SS = root_set_services, rc = status) !!$ _VERIFY(status) !!$ root_gc => maplobj%get_child_gridcomp(cap%root_id) @@ -586,7 +583,6 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) !---------------------------------------- call t_p%start('Initialize') - call m_p%start('Initialize') call ESMF_GridCompInitialize(cap%gcs(cap%root_id), importState = cap%child_imports(cap%root_id), & exportState = cap%child_exports(cap%root_id), clock = cap%clock, userRC = status) _VERIFY(status) @@ -613,7 +609,6 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) ExtData_internal_state%expState = CAP%CHILD_EXPORTS(cap%extdata_id) end if call t_p%stop('Initialize') - call m_p%stop('Initialize') end if @@ -757,16 +752,14 @@ subroutine run_gc(gc, import, export, clock, rc) integer, intent(out) :: RC ! Error code: integer :: status, phase - class (BaseProfiler), pointer :: t_p, m_p + class (BaseProfiler), pointer :: t_p _UNUSED_DUMMY(import) _UNUSED_DUMMY(export) _UNUSED_DUMMY(clock) t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() call t_p%start('Run') - call m_p%start('Run') call ESMF_GridCompGet( gc, currentPhase=phase, RC=status ) VERIFY_(status) @@ -775,7 +768,6 @@ subroutine run_gc(gc, import, export, clock, rc) _VERIFY(status) call t_p%stop('Run') - call m_p%stop('Run') _RETURN(ESMF_SUCCESS) @@ -793,7 +785,6 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) type(MAPL_CapGridComp), pointer :: cap type(MAPL_MetaComp), pointer :: maplobj class (BaseProfiler), pointer :: t_p - class (BaseProfiler), pointer :: m_p _UNUSED_DUMMY(import_state) _UNUSED_DUMMY(export_state) @@ -804,9 +795,7 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) _VERIFY(status) t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() call t_p%start('Finalize') - call m_p%start('Finalize') if (.not. cap%printspec > 0) then @@ -852,7 +841,6 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) end if call t_p%stop('Finalize') - call m_p%stop('Finalize') _RETURN(ESMF_SUCCESS) end subroutine finalize_gc diff --git a/profiler/CMakeLists.txt b/profiler/CMakeLists.txt index a1b8705fa81f..7d3e6dfc41b6 100644 --- a/profiler/CMakeLists.txt +++ b/profiler/CMakeLists.txt @@ -13,7 +13,6 @@ set (srcs MpiTimerGauge.F90 FortranTimerGauge.F90 RssMemoryGauge.F90 - MallocGauge.F90 VmstatMemoryGauge.F90 AdvancedMeter.F90 diff --git a/profiler/MAPL_Profiler.F90 b/profiler/MAPL_Profiler.F90 index 60a3631582bf..a6c09631db65 100644 --- a/profiler/MAPL_Profiler.F90 +++ b/profiler/MAPL_Profiler.F90 @@ -44,12 +44,10 @@ module mapl_Profiler subroutine initialize(comm) integer, optional, intent(in) :: comm call initialize_global_time_profiler(comm = comm) - call initialize_global_memory_profiler() !comm = comm) end subroutine initialize subroutine finalize() call finalize_global_time_profiler() - call finalize_global_memory_profiler() end subroutine finalize end module mapl_Profiler diff --git a/profiler/MallocGauge.F90 b/profiler/MallocGauge.F90 deleted file mode 100644 index 096871fe6bb5..000000000000 --- a/profiler/MallocGauge.F90 +++ /dev/null @@ -1,74 +0,0 @@ -#include "unused_dummy.H" - -module MAPL_MallocGauge - use, intrinsic :: iso_fortran_env, only: REAL64, INT64 - use, intrinsic :: iso_c_binding, only : C_INT - use MAPL_AbstractGauge - implicit none - private - - public :: MallocGauge - - type, extends(AbstractGauge) :: MallocGauge - private - integer(kind=INT64) :: baseline = 0 - contains - procedure :: get_measurement - end type MallocGauge - - interface MallocGauge - module procedure :: new_MallocGauge - end interface MallocGauge - - type, bind(C) :: mallinfo_t - integer(C_INT) :: arena ! Non-mmapped space allocated (bytes) - integer(C_INT) :: ordblks ! Number of free chunks - integer(C_INT) :: smblks ! Number of free fastbin blocks - integer(C_INT) :: hblks ! Number of mmapped regions - integer(C_INT) :: hblkhd ! Space allocated in mmapped regions (bytes) - integer(C_INT) :: usmblks ! See below - integer(C_INT) :: fsmblks ! Space in freed fastbin blocks (bytes) - integer(C_INT) :: uordblks ! Total allocated space (bytes) - integer(C_INT) :: fordblks ! Total free space (bytes) - integer(C_INT) :: keepcost ! Top-most, releasable space (bytes) - end type mallinfo_t - -#if (!defined(sysDarwin) && (defined(__INTEL_COMPILER) || defined(__GFORTRAN))) - interface - function mallinfo() result(info) bind(C,name="mallinfo") - import mallinfo_t - type(mallinfo_t) :: info - end function mallinfo - end interface -#endif - -contains - - - function new_MallocGauge() result(gauge) - type (MallocGauge) :: gauge - - gauge%baseline = 0 - - end function new_MallocGauge - - - function get_measurement(this) result(mem_use) - class (MallocGauge), intent(inout) :: this - real(kind=REAL64) :: mem_use - - type(Mallinfo_t) :: info - - info = mallinfo() - mem_use = info%uordblks - - end function get_measurement - -#if !(!defined(sysDarwin) && (defined(__INTEL_COMPILER) || defined(__GFORTRAN))) - function mallinfo() result(info) - type(mallinfo_t) :: info - info %uordblks = 0 - end function mallinfo -#endif -end module MAPL_MallocGauge - diff --git a/profiler/MemoryProfiler.F90 b/profiler/MemoryProfiler.F90 index f52d00a27164..e0034e12da58 100644 --- a/profiler/MemoryProfiler.F90 +++ b/profiler/MemoryProfiler.F90 @@ -1,9 +1,8 @@ -#include "MAPL_ErrLog.h" +#include "unused_dummy.H" module MAPL_MemoryProfiler_private use MAPL_BaseProfiler, only: BaseProfiler use MAPL_BaseProfiler, only: MemoryProfilerIterator => BaseProfilerIterator - use MAPL_MallocGauge use MAPL_RssMemoryGauge use MAPL_VmstatMemoryGauge use MAPL_AdvancedMeter @@ -40,6 +39,7 @@ function new_MemoryProfiler(name, comm_world) result(prof) call prof%set_comm_world(comm_world = comm_world) call prof%set_node(MeterNode(name, prof%make_meter())) + call prof%start() end function new_MemoryProfiler @@ -47,9 +47,9 @@ function make_meter(this) result(meter) class(AbstractMeter), allocatable :: meter class(MemoryProfiler), intent(in) :: this - meter = AdvancedMeter(MallocGauge()) - _UNUSED_DUMMY(this) + meter = AdvancedMeter(RssMemoryGauge()) +!!$ meter = AdvancedMeter(VmstatMemoryGauge()) end function make_meter @@ -77,8 +77,6 @@ end module MAPL_MemoryProfiler_private module MAPL_MemoryProfiler use MAPL_BaseProfiler use MAPL_MemoryProfiler_private - use mapl_KeywordEnforcerMod - use mapl_ErrorHandlingMod implicit none private @@ -120,18 +118,14 @@ subroutine finalize_global_memory_profiler() end subroutine finalize_global_memory_profiler - subroutine start_global_memory_profiler(unusable, rc) - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc + subroutine start_global_memory_profiler(name) + character(*), intent(in) :: name - integer :: status type(MemoryProfiler), pointer :: memory_profiler memory_profiler => get_global_memory_profiler() - call memory_profiler%start(_RC) + call memory_profiler%start(name) - _RETURN(_SUCCESS) - _UNUSED_DUMMY(unusable) end subroutine start_global_memory_profiler diff --git a/profiler/TimeProfiler.F90 b/profiler/TimeProfiler.F90 index a1960c12b7d1..260239a03818 100644 --- a/profiler/TimeProfiler.F90 +++ b/profiler/TimeProfiler.F90 @@ -70,7 +70,7 @@ module mapl_TimeProfiler use mapl_BaseProfiler use mapl_TimeProfiler_private use mapl_KeywordEnforcerMod - use mapl_ErrorHandlingMod + use mapl_ExceptionHandling implicit none private diff --git a/profiler/reporting/MemoryTextColumn.F90 b/profiler/reporting/MemoryTextColumn.F90 index 1ff6fe6cc484..dab784351192 100644 --- a/profiler/reporting/MemoryTextColumn.F90 +++ b/profiler/reporting/MemoryTextColumn.F90 @@ -125,7 +125,7 @@ function get_suffix(x) result(suffix) integer(kind=INT64) :: ix integer(kind=INT64) :: KB = 1024 - ix = ceiling(abs(x),kind=INT64) + ix = ceiling(abs(x)) if (ix < KB) then suffix = ' B' elseif (ix < KB**2) then @@ -147,7 +147,8 @@ function convert(x) result(ix) integer(kind=INT64) :: KB = 1024 - ix = ceiling(abs(x), kind=INT64) + ix = ceiling(abs(x)) + if (ix < KB) then ix = ix elseif (ix < KB**2) then From 32f1bc86fd9df0019b3b9baf0b4b7a4da13fcd46 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 25 Feb 2022 09:21:58 -0500 Subject: [PATCH 020/300] Reverts the changes from PR #1359 --- CHANGELOG.md | 12 - base/ApplicationSupport.F90 | 3 +- base/MAPL_MemUtils.F90 | 2 +- generic/CMakeLists.txt | 1 - generic/MAPL_Generic.F90 | 429 ++++++++++----------- generic/SetServicesWrapper.F90 | 84 ---- gridcomps/Cap/MAPL_Cap.F90 | 2 +- gridcomps/Cap/MAPL_CapGridComp.F90 | 293 +++++--------- gridcomps/History/MAPL_HistoryGridComp.F90 | 2 +- profiler/BaseProfiler.F90 | 6 +- 10 files changed, 303 insertions(+), 531 deletions(-) delete mode 100644 generic/SetServicesWrapper.F90 diff --git a/CHANGELOG.md b/CHANGELOG.md index e5e33403fd2b..a1c370d70355 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,23 +10,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed - Fixed duration of the clock to be the smaller of the user specified duration and (END_DATE - currTime) -- Fixed failures to fully trap errors in - - History GC - - MemUtils - - `register_generic_entry_points` ### Added ### Changed -- Major refactoring of GenericSetServices - Work is not completed, but a new layer is introduced with the intent that the user SetServices is called - from with in the new layer as opposed to the previous mechanism that obligated user SetServices to call - generic. That call is now deprecated. Significant cleanup remains. -- Improved diagnostic message for profiler imbalances at end of run. - Now gives the name of the timer that has not been stopped when - finalizing a profiler. - ### Removed ### Deprecated diff --git a/base/ApplicationSupport.F90 b/base/ApplicationSupport.F90 index 8e23c82619ae..0eac83a95c43 100644 --- a/base/ApplicationSupport.F90 +++ b/base/ApplicationSupport.F90 @@ -61,7 +61,8 @@ subroutine MAPL_Finalize(unusable,comm,rc) else comm_world=MPI_COMM_WORLD end if - call stop_global_time_profiler(_RC) + call stop_global_time_profiler(rc=status) + _VERIFY(status) call report_global_profiler(comm=comm_world) call finalize_profiler() call finalize_pflogger() diff --git a/base/MAPL_MemUtils.F90 b/base/MAPL_MemUtils.F90 index f87445e55d1d..42f90a72d156 100755 --- a/base/MAPL_MemUtils.F90 +++ b/base/MAPL_MemUtils.F90 @@ -395,7 +395,7 @@ subroutine MAPL_MemUtilsWriteComm( text, comm, always, RC ) #if defined(__sgi) || defined(__aix) || defined(__SX) m = memuse()*1e-3 #else - call mem_dump(mhwm, mrss, memused, swapused, commitlimit, committed_as, _RC) + call mem_dump(mhwm, mrss, memused, swapused, commitlimit, committed_as) #endif call MPI_Comm_Size(comm_,npes,status) if (MAPL_MemUtilsMode == MAPL_MemUtilsModeFull) then diff --git a/generic/CMakeLists.txt b/generic/CMakeLists.txt index 5c9b8d77574a..643fc9bcf985 100644 --- a/generic/CMakeLists.txt +++ b/generic/CMakeLists.txt @@ -42,7 +42,6 @@ set (srcs GenericCplComp.F90 - SetServicesWrapper.F90 MaplGeneric.F90 MAPL_Generic.F90 diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index f548d0a38337..b9fb5f3d5b01 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -126,7 +126,6 @@ module MAPL_GenericMod use MAPL_ExceptionHandling use MAPL_KeywordEnforcerMod use MAPL_StringTemplate - use MAPL_SetServicesWrapper use mpi use netcdf use pFlogger, only: logging, Logger @@ -144,7 +143,6 @@ module MAPL_GenericMod private public MAPL_GenericSetServices - public new_generic_setservices public MAPL_GenericInitialize public MAPL_GenericRunChildren public MAPL_GenericFinalize @@ -393,14 +391,13 @@ module MAPL_GenericMod !BOP !BOC type, extends(MaplGenericComponent) :: MAPL_MetaComp -! private + private ! Move to Base ? character(len=ESMF_MAXSTR) :: COMPNAME type (ESMF_Config ) :: CF character(:), allocatable :: full_name ! Period separated list of ancestor names real :: HEARTBEAT - class(AbstractSetServicesWrapper), allocatable, public :: user_setservices_wrapper ! Move to decorator? type (DistributedProfiler), public :: t_profiler @@ -551,18 +548,203 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) ! Create the generic state, intializing its configuration and grid. !---------------------------------------------------------- call MAPL_InternalStateRetrieve( GC, meta, __RC__) -!!$ -!!$ call meta%t_profiler%start('generic',__RC__) -!!$ -!!$ call register_generic_entry_points(gc, __RC__) + + call meta%t_profiler%start('generic',__RC__) + + call register_generic_entry_points(gc, __RC__) call MAPL_GetRootGC(GC, meta%rootGC, __RC__) + call setup_children(meta, __RC__) + + call meta%t_profiler%stop('generic',__RC__) -!!$ call meta%t_profiler%stop('generic',__RC__) -!!$ _RETURN(ESMF_SUCCESS) contains + subroutine register_generic_entry_points(gc, rc) + type(ESMF_GridComp), intent(inout) :: gc + integer, optional, intent(out) :: rc + + integer :: status + + if (.not. associated(meta%phase_init)) then + call MAPL_GridCompSetEntrypoint(GC, ESMF_METHOD_INITIALIZE, MAPL_GenericInitialize, __RC__) + endif + + if (.not. associated(meta%phase_run)) then + call MAPL_GridCompSetEntrypoint(GC, ESMF_METHOD_RUN, MAPL_GenericRunChildren, __RC__) + endif + + + if (.not. associated(meta%phase_final)) then + call MAPL_GridCompSetEntrypoint(GC, ESMF_METHOD_FINALIZE, MAPL_GenericFinalize, __RC__) + endif + + !ALT check record!!! + if (.not. associated(meta%phase_record)) then + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_WRITERESTART, MAPL_GenericRecord, __RC__) + end if + _ASSERT(size(meta%phase_record)==1,'needs informative message') !ALT: currently we support only 1 record + + if (.not.associated(meta%phase_coldstart)) then + !ALT: this part is not supported yet + ! call MAPL_GridCompSetEntryPoint(GC, ESMF_METHOD_READRESTART, & + ! MAPL_Coldstart, __RC__) + endif + end subroutine register_generic_entry_points + +#define LOWEST_(c) m=0; do while (m /= c) ;\ + m = c; c=label(c);\ + enddo + + ! Complex algorithm - difficult to explain + recursive subroutine setup_children(meta, rc) + type (MAPL_MetaComp), target, intent(inout) :: meta + integer, optional, intent(out) :: rc + + integer :: nc + integer :: i + integer :: ts + integer :: lbl, k, m + type (VarConn), pointer :: connect + type(StateSpecification) :: specs + type (MAPL_VarSpec), pointer :: im_specs(:) + type (MAPL_VarSpec), pointer :: ex_specs(:) + type (MAPL_VarSpecPtr), pointer :: ImSpecPtr(:) + type (MAPL_VarSpecPtr), pointer :: ExSpecPtr(:) + type(ESMF_Field), pointer :: field + type(ESMF_FieldBundle), pointer :: bundle + type(ESMF_State), pointer :: state + integer :: fLBL, tLBL + integer :: good_label, bad_label + integer, pointer :: label(:) + + NC = meta%get_num_children() + CHILDREN: if(nc > 0) then + + do I=1,NC + call MAPL_GenericStateClockAdd(GC, name=trim(meta%GCNameList(I)), __RC__) + end do + + + ! The child should've been already created by MAPL_AddChild + ! and set his services should've been called. + ! ------------------------------------- + + ! Create internal couplers and composite + ! component's Im/Ex specs. + !--------------------------------------- + + call MAPL_WireComponent(GC, __RC__) + + ! Relax connectivity for non-existing imports + if (NC > 0) then + + CONNECT => meta%connectList%CONNECT + + allocate (ImSpecPtr(NC), ExSpecPtr(NC), __STAT__) + + DO I = 1, NC + gridcomp => meta%get_child_gridcomp(i) + call MAPL_GridCompGetVarSpecs(gridcomp, & + IMPORT=IM_SPECS, EXPORT=EX_SPECS, __RC__) + ImSpecPtr(I)%Spec => IM_SPECS + ExSpecPtr(I)%Spec => EX_SPECS + END DO + + call connect%checkReq(ImSpecPtr, ExSpecPtr, __RC__) + + deallocate (ImSpecPtr, ExSpecPtr) + + end if + + ! If I am root call Label from here; everybody else + ! will be called recursively from Label + !-------------------------------------------------- + ROOT: if (.not. associated(meta%parentGC)) then + + call MAPL_GenericConnCheck(GC, __RC__) + + ! Collect all IMPORT and EXPORT specs in the entire tree in one list + !------------------------------------------------------------------- + call MAPL_GenericSpecEnum(GC, SPECS, __RC__) + + ! Label each spec by its place on the list--sort of. + !-------------------------------------------------- + + TS = SPECS%var_specs%size() + allocate(LABEL(TS), __STAT__) + + do I = 1, TS + LABEL(I)=I + end do + + ! For each spec... + !----------------- + + do I = 1, TS + + ! Get the LABEL attribute on the spec + !------------------------------------- + call MAPL_VarSpecGet(SPECS%old_var_specs(I), LABEL=LBL, __RC__) + _ASSERT(LBL > 0, "GenericSetServices :: Expected LBL > 0.") + + ! Do something to sort labels??? + !------------------------------- + LOWEST_(LBL) + + good_label = min(lbl, i) + bad_label = max(lbl, i) + label(bad_label) = good_label + + + end do + + if (associated(meta%LINK)) then + do I = 1, size(meta%LINK) + fLBL = MAPL_LabelGet(meta%LINK(I)%ptr%FROM, __RC__) + tLBL = MAPL_LabelGet(meta%LINK(I)%ptr%TO, __RC__) + LOWEST_(fLBL) + LOWEST_(tLBL) + + if (fLBL < tLBL) then + good_label = fLBL + bad_label = tLBL + else + good_label = tLBL + bad_label = fLBL + end if + label(bad_label) = good_label + end do + end if + + K=0 + do I = 1, TS + LBL = LABEL(I) + LOWEST_(LBL) + + if (LBL == I) then + K = K+1 + else + call MAPL_VarSpecGet(SPECS%old_var_specs(LBL), FIELDPTR = FIELD, __RC__) + call MAPL_VarSpecSet(SPECS%old_var_specs(I), FIELDPTR = FIELD, __RC__) + call MAPL_VarSpecGet(SPECS%old_var_specs(LBL), BUNDLEPTR = BUNDLE, __RC__ ) + call MAPL_VarSpecSet(SPECS%old_var_specs(I), BUNDLEPTR = BUNDLE, __RC__ ) + call MAPL_VarSpecGet(SPECS%old_var_specs(LBL), STATEPTR = STATE, __RC__ ) + call MAPL_VarSpecSet(SPECS%old_var_specs(I), STATEPTR = STATE, __RC__ ) + end if + + call MAPL_VarSpecSet(SPECS%old_var_specs(I), LABEL=LBL, __RC__) + end do + + deallocate(LABEL, __STAT__) + + end if ROOT + + end if CHILDREN ! Setup children + end subroutine setup_children +#undef LOWEST_ + end subroutine MAPL_GenericSetServices !============================================================================= @@ -4367,9 +4549,8 @@ recursive integer function AddChildFromMeta(META, NAME, GRID, & call child_meta%t_profiler%start('SetService',__RC__) !!$ gridcomp => META%GET_CHILD_GRIDCOMP(I) - child_meta%user_setservices_wrapper = ProcSetServicesWrapper(SS) -!!$ call ESMF_GridCompSetServices ( child_meta%gridcomp, SS, userRC=userRC, __RC__ ) -!!$ _VERIFY(userRC) + call ESMF_GridCompSetServices ( child_meta%gridcomp, SS, userRC=userRC, __RC__ ) + _VERIFY(userRC) call child_meta%t_profiler%stop('SetService',__RC__) call child_meta%t_profiler%stop(__RC__) @@ -4620,11 +4801,10 @@ recursive integer function AddChildFromDSO(gc, name, userRoutine, grid, sharedOb end if shared_object_library_to_load = adjust_dso_name(sharedObj) -!!$ call ESMF_GridCompSetServices ( child_meta%gridcomp, userRoutine, & -!!$ sharedObj=shared_object_library_to_load,userRC=userRC,__RC__) -!!$ _VERIFY(userRC) + call ESMF_GridCompSetServices ( child_meta%gridcomp, userRoutine, & + sharedObj=shared_object_library_to_load,userRC=userRC,__RC__) + _VERIFY(userRC) - child_meta%user_setservices_wrapper = DSO_SetServicesWrapper(sharedObj, userRoutine) call child_meta%t_profiler%stop('SetService',__RC__) call child_meta%t_profiler%stop(__RC__) call t_p%stop(trim(name),__RC__) @@ -11120,219 +11300,4 @@ subroutine warn_empty(string, MPL, rc) _RETURN(ESMF_SUCCESS) end subroutine warn_empty - ! Interface mandated by ESMF - recursive subroutine new_generic_setservices(gc, rc) - type(ESMF_GridComp), intent(inout) :: gc - integer, intent(out) :: rc - - type(MAPL_MetaComp), pointer :: meta - integer :: status - - call MAPL_InternalStateGet (gc, meta, _RC) - call meta%t_profiler%start(_RC) - - call meta%user_setservices_wrapper%run(gc, _RC) - ! TODO: Fix this is a terrible kludge. - if (meta%compname /= 'CAP') then - call register_generic_entry_points(gc, _RC) - end if - call run_children_generic_setservices(meta,_RC) - - ! TODO: Fix this is a terrible kludge. - if (meta%compname /= 'CAP') then - call process_connections(meta,_RC) ! needs better name - end if - - call meta%t_profiler%stop(_RC) - - _RETURN(_SUCCESS) - contains - -#define LOWEST_(c) m=0; do while (m /= c) ; m = c; c=label(c); enddo - - recursive subroutine run_children_generic_setservices(meta, rc) - type(MAPL_MetaComp), pointer :: meta - integer, intent(out) :: rc - - integer :: status, i - type(ESMF_GridComp), pointer :: child_gc - - do i = 1, meta%get_num_children() - child_gc => meta%get_child_gridcomp(i) - call new_generic_setservices(child_gc, _RC) - end do - - _RETURN(_SUCCESS) - end subroutine run_children_generic_setservices - - recursive subroutine process_connections(meta, rc) - type(MAPL_MetaComp), pointer :: meta - integer, intent(out) :: rc - - integer :: status - integer :: i, m, k - integer :: ts - integer :: fLBL, tLBL, lbl - integer :: good_label, bad_label - integer, pointer :: label(:) - type(StateSpecification) :: specs - type(ESMF_Field), pointer :: field - type(ESMF_FieldBundle), pointer :: bundle - type(ESMF_State), pointer :: state - type (MAPL_VarSpec), pointer :: im_specs(:) - type (MAPL_VarSpec), pointer :: ex_specs(:) - type (MAPL_VarSpecPtr), pointer :: ImSpecPtr(:) - type (MAPL_VarSpecPtr), pointer :: ExSpecPtr(:) - type (VarConn), pointer :: connect - type(ESMF_GridComp), pointer :: child_gc - integer :: nc - nc = meta%get_num_children() - - call MAPL_WireComponent(gc, _RC) - - nc = meta%get_num_children() - - ! Relax connectivity for non-existing imports - CONNECT => meta%connectList%CONNECT - - allocate (ImSpecPtr(nc), ExSpecPtr(nc), __STAT__) - - do I = 1, nc - child_gc => meta%get_child_gridcomp(i) - call MAPL_GridCompGetVarSpecs(child_gc, & - import=IM_SPECS, EXPORT=EX_SPECS, __RC__) - ImSpecPtr(I)%Spec => IM_SPECS - ExSpecPtr(I)%Spec => EX_SPECS - end do - - call connect%checkReq(ImSpecPtr, ExSpecPtr, __RC__) - - deallocate (ImSpecPtr, ExSpecPtr) - - - - - ! If I am root call Label from here; everybody else - ! will be called recursively from Label - !-------------------------------------------------- - ROOT: if (.not. associated(meta%parentGC)) then - - call MAPL_GenericConnCheck(GC, __RC__) - - ! Collect all IMPORT and EXPORT specs in the entire tree in one list - !------------------------------------------------------------------- - call MAPL_GenericSpecEnum(GC, SPECS, __RC__) - - ! Label each spec by its place on the list--sort of. - !-------------------------------------------------- - - TS = SPECS%var_specs%size() - allocate(LABEL(TS), __STAT__) - - do I = 1, TS - LABEL(I)=I - end do - - ! For each spec... - !----------------- - - do I = 1, TS - - ! Get the LABEL attribute on the spec - !------------------------------------- - call MAPL_VarSpecGet(SPECS%old_var_specs(I), LABEL=LBL, __RC__) - _ASSERT(LBL > 0, "GenericSetServices :: Expected LBL > 0.") - - ! Do something to sort labels??? - !------------------------------- - LOWEST_(LBL) - - good_label = min(lbl, i) - bad_label = max(lbl, i) - label(bad_label) = good_label - - - end do - - if (associated(meta%LINK)) then - do I = 1, size(meta%LINK) - fLBL = MAPL_LabelGet(meta%LINK(I)%ptr%FROM, __RC__) - tLBL = MAPL_LabelGet(meta%LINK(I)%ptr%TO, __RC__) - LOWEST_(fLBL) - LOWEST_(tLBL) - - if (fLBL < tLBL) then - good_label = fLBL - bad_label = tLBL - else - good_label = tLBL - bad_label = fLBL - end if - label(bad_label) = good_label - end do - end if - - K=0 - do I = 1, TS - LBL = LABEL(I) - LOWEST_(LBL) - - if (LBL == I) then - K = K+1 - else - call MAPL_VarSpecGet(SPECS%old_var_specs(LBL), FIELDPTR = FIELD, __RC__) - call MAPL_VarSpecSet(SPECS%old_var_specs(I), FIELDPTR = FIELD, __RC__) - call MAPL_VarSpecGet(SPECS%old_var_specs(LBL), BUNDLEPTR = BUNDLE, __RC__ ) - call MAPL_VarSpecSet(SPECS%old_var_specs(I), BUNDLEPTR = BUNDLE, __RC__ ) - call MAPL_VarSpecGet(SPECS%old_var_specs(LBL), STATEPTR = STATE, __RC__ ) - call MAPL_VarSpecSet(SPECS%old_var_specs(I), STATEPTR = STATE, __RC__ ) - end if - - call MAPL_VarSpecSet(SPECS%old_var_specs(I), LABEL=LBL, __RC__) - end do - - deallocate(LABEL, __STAT__) - - end if ROOT - - _RETURN(_SUCCESS) - end subroutine process_connections -#undef LOWEST_ - - - subroutine register_generic_entry_points(gc, rc) - type(ESMF_GridComp), intent(inout) :: gc - integer, optional, intent(out) :: rc - - integer :: status - - if (.not. associated(meta%phase_init)) then - call MAPL_GridCompSetEntrypoint(GC, ESMF_METHOD_INITIALIZE, MAPL_GenericInitialize, __RC__) - endif - - if (.not. associated(meta%phase_run)) then - call MAPL_GridCompSetEntrypoint(GC, ESMF_METHOD_RUN, MAPL_GenericRunChildren, __RC__) - endif - - - if (.not. associated(meta%phase_final)) then - call MAPL_GridCompSetEntrypoint(GC, ESMF_METHOD_FINALIZE, MAPL_GenericFinalize, __RC__) - endif - - if (.not. associated(meta%phase_record)) then - call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_WRITERESTART, MAPL_GenericRecord, __RC__) - end if - _ASSERT(size(meta%phase_record)==1,'Currently, only 1 record is supported.') - - if (.not.associated(meta%phase_coldstart)) then - ! not supported - endif - _RETURN(_SUCCESS) - end subroutine register_generic_entry_points - - - - end subroutine new_generic_setservices - - end module MAPL_GenericMod diff --git a/generic/SetServicesWrapper.F90 b/generic/SetServicesWrapper.F90 deleted file mode 100644 index 379bd25a0a3f..000000000000 --- a/generic/SetServicesWrapper.F90 +++ /dev/null @@ -1,84 +0,0 @@ -#include "MAPL_ErrLog.h" -module mapl_SetServicesWrapper - use ESMF - use MAPL_KeywordEnforcerMod - use mapl_ErrorHandlingMod - implicit none - private - - public :: AbstractSetServicesWrapper - public :: DSO_SetServicesWrapper - public :: ProcSetServicesWrapper - - - type, abstract :: AbstractSetServicesWrapper - contains - procedure(I_Run), deferred :: run - end type AbstractSetServicesWrapper - - type, extends(AbstractSetServicesWrapper) :: DSO_SetServicesWrapper - character(:), allocatable :: sharedObj - character(:), allocatable :: userRoutine - contains - procedure :: run => run_dso - end type DSO_SetServicesWrapper - - type, extends(AbstractSetServicesWrapper) :: ProcSetServicesWrapper - procedure(I_SetServices), nopass, pointer :: userRoutine - contains - procedure :: run => run_proc - end type ProcSetServicesWrapper - - abstract interface - subroutine I_Run(this, gc, unusable, rc) - use ESMF - use MAPL_KeywordEnforcerMod - import AbstractSetServicesWrapper - class(AbstractSetServicesWrapper), intent(in) :: this - type(ESMF_GridComp), intent(inout) :: gc - class(KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - end subroutine I_Run - - subroutine I_SetServices(gc, rc) - use ESMF - type(ESMF_GridComp) :: gc - integer, intent(out) :: rc - end subroutine I_SetServices - - end interface - -contains - - recursive subroutine run_dso(this, gc, unusable, rc) - class(DSO_SetServicesWrapper), intent(in) :: this - type(ESMF_GridComp), intent(inout) :: gc - class(KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - - integer :: status, userRC - - call ESMF_GridCompSetServices(gc, this%userRoutine, sharedObj=this%sharedObj, userRC=userRC, _RC) - _VERIFY(userRC) - - _RETURN(_SUCCESS) - _UNUSED_DUMMY(unusable) - end subroutine run_dso - - - recursive subroutine run_proc(this, gc, unusable, rc) - class(ProcSetServicesWrapper), intent(in) :: this - type(ESMF_GridComp), intent(inout) :: gc - class(KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - - integer :: status, userRC - - call ESMF_GridCompSetServices(gc, this%userRoutine, userRC=userRC, _RC) - _VERIFY(userRC) - - _RETURN(_SUCCESS) - _UNUSED_DUMMY(unusable) - end subroutine run_proc - -end module mapl_SetServicesWrapper diff --git a/gridcomps/Cap/MAPL_Cap.F90 b/gridcomps/Cap/MAPL_Cap.F90 index fcb79cbc36ac..5feeeeb6eb21 100644 --- a/gridcomps/Cap/MAPL_Cap.F90 +++ b/gridcomps/Cap/MAPL_Cap.F90 @@ -315,7 +315,7 @@ subroutine initialize_cap_gc(this, unusable, n_run_phases, rc) _UNUSED_DUMMY(unusable) call MAPL_CapGridCompCreate(this%cap_gc, this%set_services, this%get_cap_rc_file(), & - this%name, this%get_egress_file(), this%comm_world, n_run_phases=n_run_phases, rc=status) + this%name, this%get_egress_file(), n_run_phases=n_run_phases, rc=status) _VERIFY(status) _RETURN(_SUCCESS) end subroutine initialize_cap_gc diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index 58ed86032537..b66a31d9a93e 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -103,15 +103,12 @@ module MAPL_CapGridCompMod contains - subroutine MAPL_CapGridCompCreate(cap, root_set_services, cap_rc, name, final_file, comm_world, unusable, n_run_phases, rc) - use MAPL_SetServicesWrapper + subroutine MAPL_CapGridCompCreate(cap, root_set_services, cap_rc, name, final_file, unusable, n_run_phases, rc) use mapl_StubComponent - use mapl_profiler type(MAPL_CapGridComp), intent(out), target :: cap procedure() :: root_set_services character(*), intent(in) :: cap_rc, name character(len=*), optional, intent(in) :: final_file - integer, intent(in) :: comm_world class(KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(in) :: n_run_phases integer, optional, intent(out) :: rc @@ -140,9 +137,6 @@ subroutine MAPL_CapGridCompCreate(cap, root_set_services, cap_rc, name, final_fi meta => null() call MAPL_InternalStateCreate(cap%gc, meta, __RC__) - - meta%t_profiler = DistributedProfiler(trim(cap_name), MpiTimerGauge(), comm=comm_world) - meta%user_setservices_wrapper = ProcSetServicesWrapper(set_services_gc) call MAPL_Set(meta, CF=cap%config, __RC__) call MAPL_Set(meta, name=cap_name, component=stub_component, __RC__) @@ -381,6 +375,10 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call MAPL_GetResource(MAPLOBJ, ROOT_CF, "ROOT_CF:", default = "ROOT.rc", rc = status) _VERIFY(status) + ! !RESOURCE_ITEM: string :: Name to assign to the ROOT component + call MAPL_GetResource(MAPLOBJ, ROOT_NAME, "ROOT_NAME:", default = "ROOT", rc = status) + _VERIFY(status) + ! !RESOURCE_ITEM: string :: Name of HISTORY's config file call MAPL_GetResource(MAPLOBJ, HIST_CF, "HIST_CF:", default = "HIST.rc", rc = status) _VERIFY(status) @@ -393,6 +391,11 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call MAPL_GetResource(MAPLOBJ, enableTimers, "MAPL_ENABLE_TIMERS:", default = 'NO', rc = status) _VERIFY(status) + ! !RESOURCE_ITEM: string :: Control Memory Diagnostic Utility + call MAPL_GetResource(MAPLOBJ, enableMemUtils, "MAPL_ENABLE_MEMUTILS:", default='NO', rc = status) + _VERIFY(status) + call MAPL_GetResource(MAPLOBJ, MemUtilsMode, "MAPL_MEMUTILS_MODE:", default = MAPL_MemUtilsModeBase, rc = status) + _VERIFY(status) !EOR enableTimers = ESMF_UtilStringUpperCase(enableTimers, rc = status) _VERIFY(status) @@ -409,9 +412,19 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) _VERIFY(STATUS) end if - cap%started_loop_timer=.false. + enableMemUtils = ESMF_UtilStringUpperCase(enableMemUtils, rc=STATUS) + _VERIFY(STATUS) + + if (enableMemUtils /= 'YES') then + call MAPL_MemUtilsDisable( rc=STATUS ) + _VERIFY(STATUS) + else + call MAPL_MemUtilsInit( mode=MemUtilsMode, rc=STATUS ) + _VERIFY(STATUS) + end if + call MAPL_GetResource( MAPLOBJ, cap%printSpec, label='PRINTSPEC:', default = 0, rc=STATUS ) _VERIFY(STATUS) @@ -452,6 +465,21 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) ! Add EXPID and EXPDSC from HISTORY.rc to AGCM.rc !------------------------------------------------ + cap%cf_hist = ESMF_ConfigCreate(rc=STATUS ) + _VERIFY(STATUS) + call ESMF_ConfigLoadFile(cap%cf_hist, HIST_CF, rc=STATUS ) + _VERIFY(STATUS) + + call MAPL_ConfigSetAttribute(cap%cf_hist, value=HIST_CF, Label="HIST_CF:", rc=status) + _VERIFY(STATUS) + + call ESMF_ConfigGetAttribute(cap%cf_hist, value=EXPID, Label="EXPID:", default='', rc=status) + _VERIFY(STATUS) + call ESMF_ConfigGetAttribute(cap%cf_hist, value=EXPDSC, Label="EXPDSC:", default='', rc=status) + _VERIFY(STATUS) + + call MAPL_ConfigSetAttribute(cap%cf_hist, value=heartbeat_dt, Label="RUN_DT:", rc=status) + _VERIFY(STATUS) call MAPL_ConfigSetAttribute(cap%cf_root, value=EXPID, Label="EXPID:", rc=status) _VERIFY(STATUS) @@ -495,64 +523,64 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) ! Create Root child !------------------- -!!$ call MAPL_Set(MAPLOBJ, CF=CAP%CF_ROOT, RC=STATUS) -!!$ _VERIFY(STATUS) -!!$ + call MAPL_Set(MAPLOBJ, CF=CAP%CF_ROOT, RC=STATUS) + _VERIFY(STATUS) + root_set_services => cap%root_set_services call t_p%start('SetService') -!!$ cap%root_id = MAPL_AddChild(MAPLOBJ, name = root_name, SS = root_set_services, rc = status) -!!$ _VERIFY(status) -!!$ root_gc => maplobj%get_child_gridcomp(cap%root_id) -!!$ call MAPL_GetObjectFromGC(root_gc, root_obj, rc=status) -!!$ _ASSERT(cap%n_run_phases <= SIZE(root_obj%phase_run),"n_run_phases in cap_gc should not exceed n_run_phases in root") -!!$ -!!$ ! Create History child -!!$ !---------------------- -!!$ -!!$ call MAPL_Set(MAPLOBJ, CF=CAP%CF_HIST, RC=STATUS) -!!$ _VERIFY(STATUS) -!!$ -!!$ cap%history_id = MAPL_AddChild( MAPLOBJ, name = 'HIST', SS = HIST_SetServices, rc = status) -!!$ _VERIFY(status) -!!$ -!!$ -!!$ ! Create ExtData child -!!$ !---------------------- -!!$ cap%cf_ext = ESMF_ConfigCreate(rc=STATUS ) -!!$ _VERIFY(STATUS) -!!$ call ESMF_ConfigLoadFile(cap%cf_ext, EXTDATA_CF, rc=STATUS ) -!!$ _VERIFY(STATUS) -!!$ -!!$ call ESMF_ConfigGetAttribute(cap%cf_ext, value=RUN_DT, Label="RUN_DT:", rc=status) -!!$ if (STATUS == ESMF_SUCCESS) then -!!$ if (heartbeat_dt /= run_dt) then -!!$ call lgr%error('inconsistent values of HEARTBEAT_DT (%g0) and ExtData RUN_DT (%g0)', heartbeat_dt, run_dt) -!!$ _FAIL('inconsistent values of HEARTBEAT_DT and RUN_DT') -!!$ end if -!!$ else -!!$ call MAPL_ConfigSetAttribute(cap%cf_ext, value=heartbeat_dt, Label="RUN_DT:", rc=status) -!!$ _VERIFY(STATUS) -!!$ endif -!!$ -!!$ call MAPL_Set(MAPLOBJ, CF=CAP%CF_EXT, RC=STATUS) -!!$ _VERIFY(STATUS) -!!$ -!!$ cap%extdata_id = MAPL_AddChild (MAPLOBJ, name = 'EXTDATA', SS = ExtData_SetServices, rc = status) -!!$ _VERIFY(status) + cap%root_id = MAPL_AddChild(MAPLOBJ, name = root_name, SS = root_set_services, rc = status) + _VERIFY(status) + root_gc => maplobj%get_child_gridcomp(cap%root_id) + call MAPL_GetObjectFromGC(root_gc, root_obj, rc=status) + _ASSERT(cap%n_run_phases <= SIZE(root_obj%phase_run),"n_run_phases in cap_gc should not exceed n_run_phases in root") + + ! Create History child + !---------------------- + + call MAPL_Set(MAPLOBJ, CF=CAP%CF_HIST, RC=STATUS) + _VERIFY(STATUS) + + cap%history_id = MAPL_AddChild( MAPLOBJ, name = 'HIST', SS = HIST_SetServices, rc = status) + _VERIFY(status) + + + ! Create ExtData child + !---------------------- + cap%cf_ext = ESMF_ConfigCreate(rc=STATUS ) + _VERIFY(STATUS) + call ESMF_ConfigLoadFile(cap%cf_ext, EXTDATA_CF, rc=STATUS ) + _VERIFY(STATUS) + + call ESMF_ConfigGetAttribute(cap%cf_ext, value=RUN_DT, Label="RUN_DT:", rc=status) + if (STATUS == ESMF_SUCCESS) then + if (heartbeat_dt /= run_dt) then + call lgr%error('inconsistent values of HEARTBEAT_DT (%g0) and ExtData RUN_DT (%g0)', heartbeat_dt, run_dt) + _FAIL('inconsistent values of HEARTBEAT_DT and RUN_DT') + end if + else + call MAPL_ConfigSetAttribute(cap%cf_ext, value=heartbeat_dt, Label="RUN_DT:", rc=status) + _VERIFY(STATUS) + endif + + call MAPL_Set(MAPLOBJ, CF=CAP%CF_EXT, RC=STATUS) + _VERIFY(STATUS) + + cap%extdata_id = MAPL_AddChild (MAPLOBJ, name = 'EXTDATA', SS = ExtData_SetServices, rc = status) + _VERIFY(status) call t_p%stop('SetService') -!!$ -!!$ ! Add NX and NY from AGCM.rc to ExtData.rc as well as name of ExtData rc file -!!$ call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", rc=status) -!!$ _VERIFY(STATUS) -!!$ call ESMF_ConfigGetAttribute(cap%cf_root, value = NY, Label="NY:", rc=status) -!!$ _VERIFY(STATUS) -!!$ call MAPL_ConfigSetAttribute(cap%cf_ext, value=NX, Label="NX:", rc=status) -!!$ _VERIFY(STATUS) -!!$ call MAPL_ConfigSetAttribute(cap%cf_ext, value=NY, Label="NY:", rc=status) -!!$ _VERIFY(STATUS) -!!$ call MAPL_ConfigSetAttribute(cap%cf_ext, value=EXTDATA_CF, Label="CF_EXTDATA:", rc=status) -!!$ _VERIFY(STATUS) + + ! Add NX and NY from AGCM.rc to ExtData.rc as well as name of ExtData rc file + call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", rc=status) + _VERIFY(STATUS) + call ESMF_ConfigGetAttribute(cap%cf_root, value = NY, Label="NY:", rc=status) + _VERIFY(STATUS) + call MAPL_ConfigSetAttribute(cap%cf_ext, value=NX, Label="NX:", rc=status) + _VERIFY(STATUS) + call MAPL_ConfigSetAttribute(cap%cf_ext, value=NY, Label="NY:", rc=status) + _VERIFY(STATUS) + call MAPL_ConfigSetAttribute(cap%cf_ext, value=EXTDATA_CF, Label="CF_EXTDATA:", rc=status) + _VERIFY(STATUS) ! Query MAPL for the the children's for GCS, IMPORTS, EXPORTS !------------------------------------------------------------- @@ -852,139 +880,18 @@ subroutine set_services_gc(gc, rc) integer :: status, phase type(MAPL_CapGridComp), pointer :: cap - type(MAPL_MetaComp), pointer :: meta, root_meta - class(BaseProfiler), pointer :: t_p - - type (ESMF_GridComp), pointer :: root_gc - character(len=ESMF_MAXSTR) :: ROOT_NAME - procedure(), pointer :: root_set_services - class(Logger), pointer :: lgr - character(len=ESMF_MAXSTR) :: HIST_CF, ROOT_CF, EXTDATA_CF - integer :: RUN_DT - integer :: heartbeat_dt - integer :: NX, NY - integer :: MemUtilsMode - character(len=ESMF_MAXSTR) :: enableMemUtils - character(len=ESMF_MAXSTR) :: enableTimers - type(ESMF_GridComp), pointer :: child_gc - type(MAPL_MetaComp), pointer :: child_meta - character(len=ESMF_MAXSTR) :: EXPID - character(len=ESMF_MAXSTR) :: EXPDSC - logical :: cap_clock_is_present - type(ESMF_TimeInterval) :: Frequency cap => get_CapGridComp_from_gc(gc) - call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_INITIALIZE, userRoutine = initialize_gc, _RC) + call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_INITIALIZE, userRoutine = initialize_gc, rc = status) + _VERIFY(status) do phase = 1, cap%n_run_phases - call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_RUN, userRoutine = run_gc, _RC) + call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_RUN, userRoutine = run_gc, rc = status) + _VERIFY(status) enddo - call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_FINALIZE, userRoutine = finalize_gc, _RC) - - call ESMF_GridCompGet(gc, clockIsPresent=cap_clock_is_present, _RC) - - if (cap_clock_is_present) then - call ESMF_ClockGet(cap%clock, timeStep=frequency, _RC) - call ESMF_TimeIntervalGet(frequency, s=heartbeat_dt, _RC) - else - call ESMF_ConfigGetAttribute(cap%config, value = heartbeat_dt, Label = "HEARTBEAT_DT:", _RC) - call ESMF_TimeIntervalSet(frequency, s = heartbeat_dt, _RC) - end if - - cap%heartbeat_dt = heartbeat_dt - - ! Register the children with MAPL - !-------------------------------- - - ! Create Root child - !------------------- - call MAPL_InternalStateRetrieve(gc, meta, _RC) -!!$ call MAPL_Set(meta, CF=CAP%CF_ROOT, _RC) - call MAPL_GetLogger(gc, lgr, _RC) - - t_p => get_global_time_profiler() - call t_p%start('SetService') - - ! !RESOURCE_ITEM: string :: Name to assign to the ROOT component - call MAPL_GetResource(meta, root_name, "ROOT_NAME:", default = "ROOT", _RC) - call MAPL_GetResource(meta, ROOT_CF, "ROOT_CF:", default = "ROOT.rc", _RC) - root_set_services => cap%root_set_services - cap%root_id = MAPL_AddChild(meta, name = root_name, SS=root_set_services, configFile=ROOT_CF, _RC) - - child_gc => meta%get_child_gridcomp(cap%root_id) - call MAPL_InternalStateRetrieve(child_gc, child_meta, _RC) - call MAPL_Get(child_meta, cf=cap%cf_root, _RC) - ! Add NX and NY from ROOT config to ExtData config - call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", _RC) - call ESMF_ConfigGetAttribute(cap%cf_root, value = NY, Label="NY:", _RC) - call ESMF_ConfigSetAttribute(cap%cf_root, value = heartbeat_dt, Label="RUN_DT:", _RC) - - ! Create History child - !---------------------- - - ! !RESOURCE_ITEM: string :: Name of HISTORY's config file - call MAPL_GetResource(meta, HIST_CF, "HIST_CF:", default = "HIST.rc", _RC) - cap%history_id = MAPL_AddChild( meta, name='HIST', SS=HIST_SetServices, configFile=HIST_CF, _RC) - - child_gc => meta%get_child_gridcomp(cap%history_id) - call MAPL_InternalStateRetrieve(child_gc, child_meta, _RC) - call MAPL_Get(child_meta, cf=cap%cf_hist, _RC) - call ESMF_ConfigLoadFile(cap%cf_hist, HIST_CF, _RC) - - call MAPL_ConfigSetAttribute(cap%cf_hist, value=HIST_CF, Label="HIST_CF:", _RC) - call ESMF_ConfigGetAttribute(cap%cf_hist, value=EXPID, Label="EXPID:", default='', _RC) - call ESMF_ConfigGetAttribute(cap%cf_hist, value=EXPDSC, Label="EXPDSC:", default='', _RC) - call MAPL_ConfigSetAttribute(cap%cf_root, value=EXPID, Label="EXPID:", _RC) - call MAPL_ConfigSetAttribute(cap%cf_root, value=EXPDSC, Label="EXPDSC:", _RC) - - call MAPL_ConfigSetAttribute(cap%cf_hist, value=heartbeat_dt, Label="RUN_DT:", _RC) - - call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", _RC) - call ESMF_ConfigGetAttribute(cap%cf_root, value = NY, Label="NY:", _RC) - call MAPL_ConfigSetAttribute(cap%cf_hist, value = NX, Label="NX:", _RC) - call MAPL_ConfigSetAttribute(cap%cf_hist, value = NY, Label="NY:", _RC) - - ! Create ExtData child - !---------------------- - cap%cf_ext = ESMF_ConfigCreate(_RC) - call MAPL_GetResource(meta, EXTDATA_CF, "EXTDATA_CF:", default = "ExtData.rc", _RC) - call ESMF_ConfigLoadFile(cap%cf_ext, EXTDATA_CF, _RC) - - - cap%extdata_id = MAPL_AddChild (meta, name='EXTDATA', SS=ExtData_SetServices, configFile=EXTDATA_CF, _RC) - child_gc => meta%get_child_gridcomp(cap%extdata_id) - call MAPL_InternalStateRetrieve(child_gc, child_meta, _RC) - call MAPL_Get(child_meta, cf=cap%cf_ext, _RC) - call MAPL_ConfigSetAttribute(cap%cf_ext, value=NX, Label="NX:", _RC) - call MAPL_ConfigSetAttribute(cap%cf_ext, value=NY, Label="NY:", _RC) - - call ESMF_ConfigGetAttribute(cap%cf_ext, value=RUN_DT, Label="RUN_DT:", rc=status) - if (status == ESMF_SUCCESS) then - if (heartbeat_dt /= run_dt) then - call lgr%error('inconsistent values of heartbeat_dt (%g0) and ExtData RUN_DT (%g0)', heartbeat_dt, run_dt) - _FAIL('inconsistent values of heartbeat_dt and RUN_DT') - end if - else - call MAPL_ConfigSetAttribute(cap%cf_ext, value=heartbeat_dt, Label="RUN_DT:", _RC) - endif - call MAPL_ConfigSetAttribute(cap%cf_ext, value=EXTDATA_CF, Label="CF_EXTDATA:", _RC) - - - call t_p%stop('SetService') - - - ! !RESOURCE_ITEM: string :: Control Memory Diagnostic Utility - call MAPL_GetResource(meta, enableMemUtils, "MAPL_ENABLE_MEMUTILS:", default='NO', _RC) - call MAPL_GetResource(meta, MemUtilsMode, "MAPL_MEMUTILS_MODE:", default = MAPL_MemUtilsModeBase, _RC) - enableMemUtils = ESMF_UtilStringUpperCase(enableMemUtils, _RC) - - if (enableMemUtils /= 'YES') then - call MAPL_MemUtilsDisable(_RC) - else - call MAPL_MemUtilsInit( mode=MemUtilsMode, _RC) - end if - + call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_FINALIZE, userRoutine = finalize_gc, rc = status) + _VERIFY(status) _RETURN(ESMF_SUCCESS) end subroutine set_services_gc @@ -995,9 +902,8 @@ subroutine set_services(this, rc) integer, optional, intent(out) :: rc integer :: status - call new_generic_setservices(this%gc, _RC) -!!$ call ESMF_GridCompSetServices(this%gc, set_services_gc, rc = status) -!!$ _VERIFY(status) + call ESMF_GridCompSetServices(this%gc, set_services_gc, rc = status) + _VERIFY(status) _RETURN(ESMF_SUCCESS) end subroutine set_services @@ -1209,7 +1115,8 @@ subroutine run_MAPL_GridComp(gc, phase, rc) call cap%increment_step_counter() - call MAPL_MemUtilsWrite(cap%vm, 'MAPL_Cap:TimeLoop', _RC) + call MAPL_MemUtilsWrite(cap%vm, 'MAPL_Cap:TimeLoop', rc = status) + _VERIFY(status) if (.not.cap%lperp) then done = ESMF_ClockIsStopTime(cap%clock_hist, rc = status) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 2de7d9da0b8c..4c4d0bf1aec2 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -926,7 +926,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) if (old_fields_style) then field_set_name = trim(string) // 'fields' allocate(field_set) - call parse_fields(cfg, trim(field_set_name), field_set, list(n)%items, _RC) + call parse_fields(cfg, trim(field_set_name), field_set, list(n)%items, rc=status) end if list(n)%field_set => field_set diff --git a/profiler/BaseProfiler.F90 b/profiler/BaseProfiler.F90 index 7866c3aa0566..1743e7039e8d 100644 --- a/profiler/BaseProfiler.F90 +++ b/profiler/BaseProfiler.F90 @@ -179,11 +179,7 @@ subroutine stop_self(this, rc) class(AbstractMeterNode), pointer :: node if (this%stack%size()/= 1) this%status = INCORRECTLY_NESTED_METERS - if (this%stack%size() /= 1) then - node_ptr => this%stack%back() - node => node_ptr%ptr - _ASSERT_RC(this%stack%size()== 1,"Stack not empty when timer stopped. Active timer: " // node%get_name(),INCORRECTLY_NESTED_METERS) - end if + _ASSERT_RC(this%stack%size()== 1,"Stack not empty when timer stopped.",INCORRECTLY_NESTED_METERS) node_ptr => this%stack%back() node => node_ptr%ptr From 774b18b4c6e44fbdfda57ddc8d8d46be43c42fd8 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 25 Feb 2022 15:37:02 -0500 Subject: [PATCH 021/300] exposes new MAPL field bundle methods when doing use MAPL --- MAPL/MAPL.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/MAPL/MAPL.F90 b/MAPL/MAPL.F90 index 6022c41e7dd3..0ee5398fe839 100644 --- a/MAPL/MAPL.F90 +++ b/MAPL/MAPL.F90 @@ -9,6 +9,8 @@ module MAPL use pFIO use MAPL_GridCompsMod use mapl_StubComponent + use MAPL_ESMFFieldBundleRead + use MAPL_ESMFFieldBundleWrite implicit none end module MAPL From faa133937a433948202c51f7d2b22b26ddb0d94f Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 25 Feb 2022 15:39:20 -0500 Subject: [PATCH 022/300] updated changelog --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index a1c370d70355..ac75e1b7390b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +- MAPL_ESMFFieldBundleRead/Write modules are now available in when using MAPL + ### Changed ### Removed From 5adc0115becf034a4743938220fc499b64b8afd2 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 16 Feb 2022 15:29:21 -0500 Subject: [PATCH 023/300] Improve error handling to catch missing untemplated files --- CHANGELOG.md | 1 + gridcomps/ExtData/ExtDataGridCompMod.F90 | 5 +++++ 2 files changed, 6 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0bc2f7908057..5e25cf6e45f0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -51,6 +51,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Updated `components.yaml`. These changes are to support using Spack to build MAPL - ESMA_cmake v3.10.0 (add `FindESMF.cmake` from NOAA-EMC) - ecbuild geos/v1.2.0 (updat `FindNetCDF.cmake` to that from NOAA-EMC) +- File not found error handling in ExtData improved for non-templated filenames ## [2.17.2] - 2022-02-16 diff --git a/gridcomps/ExtData/ExtDataGridCompMod.F90 b/gridcomps/ExtData/ExtDataGridCompMod.F90 index c728b2e77cbc..06a553f7c5ad 100644 --- a/gridcomps/ExtData/ExtDataGridCompMod.F90 +++ b/gridcomps/ExtData/ExtDataGridCompMod.F90 @@ -1889,6 +1889,7 @@ subroutine CreateTimeInterval(item,clock,rc) character(len=ESMF_MAXSTR) :: creffTime, ctInt integer :: status + logical :: found creffTime = '' ctInt = '' @@ -1933,6 +1934,10 @@ subroutine CreateTimeInterval(item,clock,rc) else ! couldn't find any tokens so all the data must be on one file call ESMF_TimeIntervalSet(item%frequency,__RC__) + + ! check if non-token file exists + inquire(file=trim(item%file),EXIST=found) + _ASSERT(found,'File ' // trim(item%file) // ' not found') end if else ! Reference time should look like: From 98af4c97b5031c584770878bbc40b386c60ae306 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 28 Feb 2022 11:37:57 -0500 Subject: [PATCH 024/300] Move call to CreateTimeInterval While looking at https://github.com/GEOS-ESM/MAPL/pull/1377 by @lizziel, it was found that her check was a bit too powerful for GEOS in that we have some bugs in our ExtData files. But, @bena-nasa looked at the code and found that we were doing `CreateTimeInterval` at the wrong time. Previously, we were doing it during the phase of ExtData when the *entire* `ExtData.rc` file is processed. Instead, we move the call to the loop where ExtData works on the actual Imports it will be handling. --- gridcomps/ExtData/ExtDataGridCompMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/gridcomps/ExtData/ExtDataGridCompMod.F90 b/gridcomps/ExtData/ExtDataGridCompMod.F90 index 06a553f7c5ad..7a04692b301a 100644 --- a/gridcomps/ExtData/ExtDataGridCompMod.F90 +++ b/gridcomps/ExtData/ExtDataGridCompMod.F90 @@ -675,10 +675,6 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) primary%item(totalPrimaryEntries)%cyclic='n' end if - - if ( primary%item(totalPrimaryEntries)%isConst .eqv. .false. ) then - call CreateTimeInterval(primary%item(totalPrimaryEntries),clock,__RC__) - end if end if enddo ! Derived Exports @@ -911,6 +907,10 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call lgr%debug('ExtData Initialize_(): PrimaryLoop: ') + if ( .not. item%isConst ) then + call CreateTimeInterval(item,clock,__RC__) + end if + item%pfioCollection_id = MAPL_DataAddCollection(item%file,use_file_coords=self%use_file_coords) ! parse refresh template to see if we have a time shift during constant updating From 9f13db4e02acbf0bf9b901de1122a8dda02b1c1b Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 28 Feb 2022 13:30:19 -0500 Subject: [PATCH 025/300] Update CHANGELOG.md --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5e25cf6e45f0..3a7233c8fbf4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -51,7 +51,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Updated `components.yaml`. These changes are to support using Spack to build MAPL - ESMA_cmake v3.10.0 (add `FindESMF.cmake` from NOAA-EMC) - ecbuild geos/v1.2.0 (updat `FindNetCDF.cmake` to that from NOAA-EMC) -- File not found error handling in ExtData improved for non-templated filenames +- Improved file-not-found error handling in ExtData for non-templated filenames ## [2.17.2] - 2022-02-16 From 7291cfe036a127b9e2c0345172ce7a72ca83d9f8 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 28 Feb 2022 14:20:36 -0500 Subject: [PATCH 026/300] add ExtData2G with a USE_EXTDATA2G argument to cmake for user request --- CMakeLists.txt | 13 +- MAPL/CMakeLists.txt | 4 +- MAPL/MAPL.F90 | 6 +- Tests/CMakeLists.txt | 1 + Tests/ExtDataDriverGridComp.F90 | 4 + base/FileMetadataUtilities.F90 | 2 + gridcomps/CMakeLists.txt | 1 + gridcomps/Cap/CMakeLists.txt | 4 +- gridcomps/Cap/MAPL_CapGridComp.F90 | 5 + gridcomps/ExtData2G/CMakeLists.txt | 32 + .../ExtData2G/ExtDataAbstractFileHandler.F90 | 166 ++ gridcomps/ExtData2G/ExtDataBracket.F90 | 269 ++ .../ExtData2G/ExtDataClimFileHandler.F90 | 281 ++ gridcomps/ExtData2G/ExtDataConfig.F90 | 200 ++ gridcomps/ExtData2G/ExtDataConstants.F90 | 12 + gridcomps/ExtData2G/ExtDataDerived.F90 | 90 + gridcomps/ExtData2G/ExtDataFileStream.F90 | 208 ++ gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 2301 +++++++++++++++++ gridcomps/ExtData2G/ExtDataLgr.F90 | 8 + gridcomps/ExtData2G/ExtDataNode.F90 | 73 + .../ExtData2G/ExtDataOldTypesCreator.F90 | 204 ++ gridcomps/ExtData2G/ExtDataRule.F90 | 158 ++ gridcomps/ExtData2G/ExtDataSample.F90 | 114 + .../ExtData2G/ExtDataSimpleFileHandler.F90 | 162 ++ gridcomps/ExtData2G/ExtDataTypeDef.F90 | 80 + gridcomps/ExtData2G/ExtDataUpdatePointer.F90 | 106 + gridcomps/ExtData2G/ExtData_IOBundleMod.F90 | 127 + .../ExtData2G/ExtData_IOBundleVectorMod.F90 | 10 + gridcomps/ExtData2G/TimeStringConversion.F90 | 232 ++ 29 files changed, 4869 insertions(+), 4 deletions(-) create mode 100644 gridcomps/ExtData2G/CMakeLists.txt create mode 100644 gridcomps/ExtData2G/ExtDataAbstractFileHandler.F90 create mode 100644 gridcomps/ExtData2G/ExtDataBracket.F90 create mode 100644 gridcomps/ExtData2G/ExtDataClimFileHandler.F90 create mode 100644 gridcomps/ExtData2G/ExtDataConfig.F90 create mode 100644 gridcomps/ExtData2G/ExtDataConstants.F90 create mode 100644 gridcomps/ExtData2G/ExtDataDerived.F90 create mode 100644 gridcomps/ExtData2G/ExtDataFileStream.F90 create mode 100644 gridcomps/ExtData2G/ExtDataGridCompNG.F90 create mode 100644 gridcomps/ExtData2G/ExtDataLgr.F90 create mode 100644 gridcomps/ExtData2G/ExtDataNode.F90 create mode 100644 gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 create mode 100644 gridcomps/ExtData2G/ExtDataRule.F90 create mode 100644 gridcomps/ExtData2G/ExtDataSample.F90 create mode 100644 gridcomps/ExtData2G/ExtDataSimpleFileHandler.F90 create mode 100644 gridcomps/ExtData2G/ExtDataTypeDef.F90 create mode 100644 gridcomps/ExtData2G/ExtDataUpdatePointer.F90 create mode 100644 gridcomps/ExtData2G/ExtData_IOBundleMod.F90 create mode 100644 gridcomps/ExtData2G/ExtData_IOBundleVectorMod.F90 create mode 100644 gridcomps/ExtData2G/TimeStringConversion.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index a1f4437572dd..86d6bf799d37 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -84,8 +84,19 @@ endif() if(NOT TARGET FARGPARSE::fargparse) find_package(FARGPARSE QUIET) endif() + + +option(USE_EXTDATA2G "Use ExtData2G" OFF) if(NOT TARGET YAFYAML::yafyaml) - find_package(YAFYAML QUIET) + if(USE_EXTDATA2G) + set (EXTDATA_TARGET "MAPL.ExtData2G" CACHE STRING "ExtData Target") + find_package(YAFYAML REQUIRED) + message (STATUS "Building with ExtData2G") + else() + set (EXTDATA_TARGET "MAPL.ExtData" CACHE STRING "ExtData Target") + find_package(YAFYAML QUIET) + message (STATUS "Building with ExtData1G") + endif() endif() option(BUILD_WITH_PFLOGGER "Build MAPL with pFlogger library support" ON) diff --git a/MAPL/CMakeLists.txt b/MAPL/CMakeLists.txt index d91f0081f870..a7d0f97de35d 100644 --- a/MAPL/CMakeLists.txt +++ b/MAPL/CMakeLists.txt @@ -3,11 +3,13 @@ esma_set_this() esma_add_library (${this} SRCS MAPL.F90 - DEPENDENCIES MAPL.base MAPL.generic MAPL.pfio MAPL_cfio_r4 MAPL.gridcomps MAPL.orbit MAPL.griddedio + DEPENDENCIES MAPL.base MAPL.generic MAPL.pfio MAPL_cfio_r4 MAPL.gridcomps MAPL.orbit MAPL.griddedio ${EXTDATA_TARGET} esmf NetCDF::NetCDF_Fortran MPI::MPI_Fortran $<$:FLAP::FLAP> TYPE ${MAPL_LIBRARY_TYPE} ) +target_compile_definitions (${this} PRIVATE $<$:BUILD_WITH_EXTDATA2G>) + target_include_directories (${this} PUBLIC $) diff --git a/MAPL/MAPL.F90 b/MAPL/MAPL.F90 index 6022c41e7dd3..be1702de556d 100644 --- a/MAPL/MAPL.F90 +++ b/MAPL/MAPL.F90 @@ -4,7 +4,11 @@ module MAPL use MAPLBase_mod use MAPL_GenericMod use MAPL_VarSpecMiscMod - use MAPL_ExtDataGridCompMod, only: T_EXTDATA_STATE, EXTDATA_WRAP +#if defined(BUILD_WITH_EXTDATA2G) + use MAPL_ExtDataGridCompNG, only : T_EXTDATA_STATE, EXTDATA_WRAP +#else + use MAPL_ExtDataGridCompMod, only : T_EXTDATA_STATE, EXTDATA_WRAP +#endif use ESMF_CFIOMod use pFIO use MAPL_GridCompsMod diff --git a/Tests/CMakeLists.txt b/Tests/CMakeLists.txt index e3e9ae8c9808..bba1dbb97aa7 100644 --- a/Tests/CMakeLists.txt +++ b/Tests/CMakeLists.txt @@ -17,6 +17,7 @@ if (BUILD_WITH_FLAP) target_link_libraries(ExtDataDriver.x PRIVATE OpenMP::OpenMP_Fortran) endif () set_target_properties(ExtDataDriver.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) + target_compile_definitions (ExtDataDriver.x PRIVATE $<$:BUILD_WITH_EXTDATA2G>) ecbuild_add_executable (TARGET pfio_MAPL_demo.x SOURCES pfio_MAPL_demo.F90) target_link_libraries (pfio_MAPL_demo.x PRIVATE MAPL FLAP::FLAP esmf) diff --git a/Tests/ExtDataDriverGridComp.F90 b/Tests/ExtDataDriverGridComp.F90 index f93681785932..930fadf9cbb0 100644 --- a/Tests/ExtDataDriverGridComp.F90 +++ b/Tests/ExtDataDriverGridComp.F90 @@ -4,7 +4,11 @@ module ExtData_DriverGridCompMod use ESMF use MAPL +#if defined(BUILD_WITH_EXTDATA2G) + use MAPL_ExtDataGridCompNG, only : ExtData_SetServices => SetServices +#else use MAPL_ExtDataGridCompMod, only : ExtData_SetServices => SetServices +#endif use MAPL_HistoryGridCompMod, only : Hist_SetServices => SetServices use MAPL_Profiler, only : get_global_time_profiler, BaseProfiler diff --git a/base/FileMetadataUtilities.F90 b/base/FileMetadataUtilities.F90 index 13e9e503569d..64428d1a29ad 100644 --- a/base/FileMetadataUtilities.F90 +++ b/base/FileMetadataUtilities.F90 @@ -417,6 +417,7 @@ subroutine get_time_info(this,startTime,startyear,startmonth,startday,starthour, allocate(timeVector,source=tVec,stat=status) _VERIFY(status) end if + _RETURN(_SUCCESS) end subroutine get_time_info @@ -516,6 +517,7 @@ subroutine get_coordinate_info(this,coordinate_name,coordSize,coordUnits,coords, _ASSERT(.false.,"unsupported coordel variable type") end select end if + _RETURN(_SUCCESS) end subroutine get_coordinate_info diff --git a/gridcomps/CMakeLists.txt b/gridcomps/CMakeLists.txt index 3a29088ffec6..00e0b99e9158 100644 --- a/gridcomps/CMakeLists.txt +++ b/gridcomps/CMakeLists.txt @@ -17,3 +17,4 @@ add_subdirectory(Cap) add_subdirectory(History) add_subdirectory(Orbit) add_subdirectory(ExtData) +add_subdirectory(ExtData2G) diff --git a/gridcomps/Cap/CMakeLists.txt b/gridcomps/Cap/CMakeLists.txt index c0ab60db408e..96b5fc9347e3 100644 --- a/gridcomps/Cap/CMakeLists.txt +++ b/gridcomps/Cap/CMakeLists.txt @@ -11,10 +11,12 @@ endif() esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.profiler MAPL.history - MAPL.ExtData TYPE ${MAPL_LIBRARY_TYPE}) + ${EXTDATA_TARGET} TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran $<$:FLAP::FLAP>) +target_compile_definitions (${this} PRIVATE $<$:BUILD_WITH_EXTDATA2G>) + # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index b66a31d9a93e..1baa30d6e4f5 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -17,8 +17,13 @@ module MAPL_CapGridCompMod use MAPL_ShmemMod use MAPL_HistoryGridCompMod, only : Hist_SetServices => SetServices use MAPL_HistoryGridCompMod, only : HISTORY_ExchangeListWrap +#if defined(BUILD_WITH_EXTDATA2G) + use MAPL_ExtDataGridCompNG, only : ExtData_SetServices => SetServices + use MAPL_ExtDataGridCompNG, only : T_EXTDATA_STATE, EXTDATA_WRAP +#else use MAPL_ExtDataGridCompMod, only : ExtData_SetServices => SetServices use MAPL_ExtDataGridCompMod, only : T_EXTDATA_STATE, EXTDATA_WRAP +#endif use MAPL_ConfigMod use MAPL_DirPathMod use MAPL_KeywordEnforcerMod diff --git a/gridcomps/ExtData2G/CMakeLists.txt b/gridcomps/ExtData2G/CMakeLists.txt new file mode 100644 index 000000000000..7fc9dd79da0f --- /dev/null +++ b/gridcomps/ExtData2G/CMakeLists.txt @@ -0,0 +1,32 @@ +esma_set_this (OVERRIDE MAPL.ExtData2G) + +set (srcs + ExtDataFileStream.F90 + ExtDataRule.F90 + ExtDataDerived.F90 + ExtDataConfig.F90 + ExtDataGridCompNG.F90 + TimeStringConversion.F90 + ExtDataTypeDef.F90 + ExtDataOldTypesCreator.F90 + ExtDataBracket.F90 + ExtDataUpdatePointer.F90 + ExtDataAbstractFileHandler.F90 + ExtDataClimFileHandler.F90 + ExtDataSimpleFileHandler.F90 + ExtDataNode.F90 + ExtDataLgr.F90 + ExtDataConstants.F90 + ExtDataSample.F90 + ExtData_IOBundleMod.F90 + ExtData_IOBundleVectorMod.F90 + ) + + +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.base MAPL.generic MAPL.griddedio TYPE SHARED) +target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran + PRIVATE MPI::MPI_Fortran) +target_include_directories (${this} PUBLIC ${INC_ESMF} ${INC_NETCDF} + $) + +set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) diff --git a/gridcomps/ExtData2G/ExtDataAbstractFileHandler.F90 b/gridcomps/ExtData2G/ExtDataAbstractFileHandler.F90 new file mode 100644 index 000000000000..1dd10c79c3cc --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataAbstractFileHandler.F90 @@ -0,0 +1,166 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" +#include "unused_dummy.H" +module MAPL_ExtdataAbstractFileHandler + use ESMF + use yafYaml + use MAPL_KeywordEnforcerMod + use MAPL_ExceptionHandling + use MAPL_ExtDataBracket + use MAPL_ExtDataFileStream + use MAPL_ExtDataFileStreamMap + use MAPL_DataCollectionMod + use MAPL_CollectionVectorMod + use MAPL_ExtDataConstants + use MAPL_DataCollectionManagerMod + use MAPL_FileMetadataUtilsMod + use MAPL_TimeStringConversion + use MAPL_StringTemplate + implicit none + private + public :: ExtDataAbstractFileHandler + + type, abstract :: ExtDataAbstractFileHandler + character(:), allocatable :: file_template + type(ESMF_TimeInterval) :: frequency + type(ESMF_Time) :: reff_time + integer :: collection_id + type(ESMF_Time), allocatable :: valid_range(:) + logical :: persist_closest + contains + procedure :: initialize + procedure :: make_metadata + procedure :: get_time_on_file + procedure(get_file_bracket), deferred :: get_file_bracket + end type + + abstract interface + subroutine get_file_bracket(this, input_time, source_time, bracket, rc) + use ESMF + use MAPL_ExtDataBracket + import ExtDataAbstractFileHandler + class(ExtDataAbstractFileHandler), intent(inout) :: this + type(ESMF_Time), intent(in) :: input_time + type(ESMF_Time), intent(in) :: source_time(:) + type(ExtDataBracket), intent(inout) :: bracket + integer, optional, intent(out) :: rc + end subroutine get_file_bracket + + end interface + +contains + + subroutine initialize(this,file_series,persist_closest,unusable,rc) + class(ExtDataAbstractFileHandler), intent(inout) :: this + type(ExtDataFileStream), intent(in) :: file_series + class(KeywordEnforcer), optional, intent(in) :: unusable + logical, optional, intent(in) :: persist_closest + integer, optional, intent(out) :: rc + + integer :: status + + _UNUSED_DUMMY(unusable) + + this%file_template = file_series%file_template + this%frequency = file_series%frequency + this%reff_time = file_series%reff_time + allocate(this%valid_range,source=file_series%valid_range) + this%collection_id = file_series%collection_id + if (present(persist_closest)) then + this%persist_closest = persist_closest + else + this%persist_closest = .false. + end if + + end subroutine initialize + + subroutine get_time_on_file(this,filename,target_time,bracketside,time_index,output_time,unusable,wrap,rc) + class(ExtdataAbstractFileHandler), intent(inout) :: this + character(len=*), intent(inout) :: filename + type(ESMF_Time), intent(in) :: target_time + character(len=*), intent(in) :: bracketside + integer, intent(Out) :: time_index + type(ESMF_Time), intent(out) :: output_time + class (KeywordEnforcer), optional, intent(out) :: unusable + integer, optional, intent(inout) :: wrap + integer, optional, intent(out) :: rc + integer :: status + + type(FileMetadataUtils), pointer :: file_metadata + type(ESMF_Time), allocatable :: time_series(:) + logical :: in_bounds, found_time, wrap_ + integer :: i,num_times + + _UNUSED_DUMMY(unusable) + if (present(wrap)) then + wrap_= .true. + else + wrap_=.false. + end if + time_index=time_not_found + + call this%make_metadata(filename,file_metadata,__RC__) + call file_metadata%get_time_info(timeVector=time_series,__RC__) + num_times = size(time_series) + found_time = .false. + if (bracketside == 'L') then + in_bounds = .not.(target_time < time_series(1)) + if (in_bounds) then + do i=num_times,1,-1 + if (target_time >= time_series(i)) then + output_time = time_series(i) + time_index = i + found_time = .true. + exit + end if + enddo + else + if (wrap_) then + output_time=time_series(num_times) + time_index = num_times + found_time = .true. + wrap = -1 + end if + end if + else if (bracketside == 'R') then + in_bounds = .not.(target_time >= time_series(num_times)) + if (in_bounds) then + do i=1,num_times + if (target_time < time_series(i)) then + output_time = time_series(i) + time_index = i + found_time = .true. + exit + end if + enddo + else + if (wrap_) then + output_time=time_series(1) + time_index = 1 + found_time = .true. + wrap = 1 + end if + end if + else + _ASSERT(.false.,"unknown bracket side") + end if + + _RETURN(_SUCCESS) + + end subroutine get_time_on_file + + subroutine make_metadata(this,file,metadata,rc) + class(ExtdataAbstractFileHandler), intent(inout) :: this + character(len=*), intent(in ) :: file + type(FileMetadataUtils), pointer, intent(inout) :: metadata + integer, optional, intent(out ) :: rc + type(MAPLDataCollection), pointer :: collection => null() + + Collection => DataCollections%at(this%collection_id) + metadata => collection%find(file) + _RETURN(_SUCCESS) + + end subroutine make_metadata + + +end module MAPL_ExtdataAbstractFileHandler diff --git a/gridcomps/ExtData2G/ExtDataBracket.F90 b/gridcomps/ExtData2G/ExtDataBracket.F90 new file mode 100644 index 000000000000..ab5f84e7fe70 --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataBracket.F90 @@ -0,0 +1,269 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" +module MAPL_ExtDataBracket + use ESMF + use MAPL_KeywordEnforcerMod + use MAPL_ExceptionHandling + use MAPL_BaseMod, only: MAPL_UNDEF + use MAPL_ExtDataNode + implicit none + private + + public :: ExtDataBracket + + type ExtDataBracket + type(ExtDataNode) :: left_node + type(ExtDataNode) :: right_node + real :: scale_factor = 0.0 + real :: offset = 0.0 + logical :: disable_interpolation = .false. + logical :: intermittent_disable = .false. + logical :: new_file_right + logical :: new_file_left + contains + procedure :: interpolate_to_time + procedure :: time_in_bracket + procedure :: set_parameters + procedure :: get_parameters + procedure :: set_node + procedure :: get_node + procedure :: swap_node_fields + procedure :: reset + end type ExtDataBracket + +contains + + subroutine reset(this) + class(ExtDataBracket), intent(inout) :: this + this%new_file_right=.false. + this%new_file_left =.false. + end subroutine reset + + logical function time_in_bracket(this,time) + class(ExtDataBracket), intent(in) :: this + type(ESMF_Time), intent(in) :: time + + time_in_bracket = (this%left_node%time <=time) .and. (time < this%right_node%time) + + end function time_in_bracket + + subroutine set_node(this, bracketside, unusable, field, file, time, time_index, was_set, rc) + class(ExtDataBracket), intent(inout) :: this + character(len=*), intent(in) :: bracketside + class(KeywordEnforcer), optional, intent(in) :: unusable + type(ESMF_Field), optional, intent(in) :: field + character(len=*), optional, intent(in) :: file + integer, optional, intent(in) :: time_index + type(ESMF_Time), optional, intent(in) :: time + logical, optional, intent(in) :: was_set + integer, optional, intent(out) :: rc + + _UNUSED_DUMMY(unusable) + if (bracketside=='L') then + if (present(field)) this%left_node%field=field + if (present(time)) this%left_node%time=time + if (present(time_index)) this%left_node%time_index=time_index + if (present(file)) this%left_node%file=file + if (present(was_set)) this%left_node%was_set=was_set + else if (bracketside=='R') then + if (present(field)) this%right_node%field=field + if (present(time)) this%right_node%time=time + if (present(time_index)) this%right_node%time_index=time_index + if (present(file)) this%right_node%file=file + if (present(was_set)) this%right_node%was_set=was_set + else + _ASSERT(.false.,'wrong bracket side') + end if + _RETURN(_SUCCESS) + + end subroutine set_node + + subroutine get_node(this, bracketside, unusable, field, file, time, time_index, was_set, rc) + class(ExtDataBracket), intent(inout) :: this + character(len=*), intent(in) :: bracketside + class(KeywordEnforcer), optional, intent(in) :: unusable + type(ESMF_Field), optional, intent(out) :: field + character(len=*), optional, intent(out) :: file + integer, optional, intent(out) :: time_index + type(ESMF_Time), optional, intent(out) :: time + logical, optional, intent(out) :: was_set + integer, optional, intent(out) :: rc + + _UNUSED_DUMMY(unusable) + if (bracketside=='L') then + if (present(field)) field=this%left_node%field + if (present(time)) time=this%left_node%time + if (present(time_index)) time_index=this%left_node%time_index + if (present(file)) file=this%left_node%file + if (present(was_set)) was_set=this%left_node%was_set + else if (bracketside=='R') then + if (present(field)) field=this%right_node%field + if (present(time)) time=this%right_node%time + if (present(time_index)) time_index=this%right_node%time_index + if (present(file)) file=this%right_node%file + if (present(was_set)) was_set=this%right_node%was_set + else + _ASSERT(.false.,'wrong bracket side') + end if + _RETURN(_SUCCESS) + + end subroutine get_node + + + subroutine set_parameters(this, unusable, linear_trans, disable_interpolation, left_field, right_field, intermittent_disable, rc) + class(ExtDataBracket), intent(inout) :: this + class(KeywordEnforcer), optional, intent(in) :: unusable + real, optional, intent(in) :: linear_trans(2) + logical, optional, intent(in) :: disable_interpolation + type(ESMF_Field), optional, intent(in) :: left_field + type(ESMF_Field), optional, intent(in) :: right_field + logical, optional, intent(in) :: intermittent_disable + integer, optional, intent(out) :: rc + + _UNUSED_DUMMY(unusable) + if (present(linear_trans)) then + this%offset=linear_trans(1) + this%scale_factor=linear_trans(2) + end if + if (present(disable_interpolation)) this%disable_interpolation = disable_interpolation + if (present(left_field)) this%left_node%field=left_field + if (present(right_field)) this%right_node%field=right_field + if (present(intermittent_disable)) this%intermittent_disable = intermittent_disable + _RETURN(_SUCCESS) + + end subroutine set_parameters + + subroutine get_parameters(this, bracket_side, unusable, field, file, time, time_index, update, rc) + class(ExtDataBracket), intent(inout) :: this + character(len=*), intent(in) :: bracket_side + class(KeywordEnforcer), optional, intent(in) :: unusable + type(ESMF_Field), optional, intent(out) :: field + character(len=*), optional, intent(out) :: file + type(ESMF_Time), optional, intent(out) :: time + integer, optional, intent(out) :: time_index + logical, optional, intent(out) :: update + integer, optional, intent(out) :: rc + + _UNUSED_DUMMY(unusable) + if (bracket_side == 'L') then + if (present(field)) field = this%left_node%field + if (present(file)) file = trim(this%left_node%file) + if (present(time)) time = this%left_node%time + if (present(time_index)) time_index = this%left_node%time_index + if (present(update)) update = this%new_file_left + else if (bracket_side == 'R') then + if (present(field)) field = this%right_node%field + if (present(file)) file = trim(this%right_node%file) + if (present(time)) time = this%right_node%time + if (present(time_index)) time_index = this%right_node%time_index + if (present(update)) update = this%new_file_right + else + _ASSERT(.false.,'invalid bracket side!') + end if + _RETURN(_SUCCESS) + + end subroutine get_parameters + + subroutine interpolate_to_time(this,field,time,rc) + class(ExtDataBracket), intent(inout) :: this + type(ESMF_Field), intent(inout) :: field + type(ESMF_Time), intent(in) :: time + integer, optional, intent(out) :: rc + + type(ESMF_TimeInterval) :: tinv1, tinv2 + real :: alpha + real, pointer :: var2d(:,:) => null() + real, pointer :: var3d(:,:,:) => null() + real, pointer :: var2d_left(:,:) => null() + real, pointer :: var2d_right(:,:) => null() + real, pointer :: var3d_left(:,:,:) => null() + real, pointer :: var3d_right(:,:,:) => null() + integer :: field_rank + integer :: status + + call ESMF_FieldGet(field,dimCount=field_rank,__RC__) + alpha = 0.0 + if ( (.not.this%disable_interpolation) .and. (.not.this%intermittent_disable)) then + tinv1 = time - this%left_node%time + tinv2 = this%right_node%time - this%left_node%time + alpha = tinv1/tinv2 + end if + if (field_rank==2) then + call ESMF_FieldGet(field,localDE=0,farrayPtr=var2d,__RC__) + call ESMF_FieldGet(this%right_node%field,localDE=0,farrayPtr=var2d_right,__RC__) + call ESMF_FieldGet(this%left_node%field,localDE=0,farrayPtr=var2d_left,__RC__) + if (time == this%left_node%time .or. this%disable_interpolation) then + var2d = var2d_left + else if (time == this%right_node%time) then + var2d = var2d_right + else + where( (var2d_left /= MAPL_UNDEF) .and. (var2d_right /= MAPL_UNDEF)) + var2d = var2d_left + alpha*(var2d_right-var2d_left) + elsewhere + var2d = MAPL_UNDEF + endwhere + end if + + if (this%scale_factor == 0.0 .and. this%offset /= 0.0) then + where(var2d /= MAPL_UNDEF) var2d=var2d+this%offset + end if + if (this%scale_factor /= 0.0 .and. this%offset == 0.0) then + where(var2d /= MAPL_UNDEF) var2d=var2d*this%scale_factor + end if + if (this%scale_factor /= 0.0 .and. this%offset /= 0.0) then + where(var2d /= MAPL_UNDEF) var2d=var2d*this%scale_factor+this%offset + end if + + else if (field_rank==3) then + call ESMF_FieldGet(field,localDE=0,farrayPtr=var3d,__RC__) + call ESMF_FieldGet(this%right_node%field,localDE=0,farrayPtr=var3d_right,__RC__) + call ESMF_FieldGet(this%left_node%field,localDE=0,farrayPtr=var3d_left,__RC__) + if (time == this%left_node%time .or. this%disable_interpolation) then + var3d = var3d_left + else if (time == this%right_node%time) then + var3d = var3d_right + else + where( (var3d_left /= MAPL_UNDEF) .and. (var3d_right /= MAPL_UNDEF)) + var3d = var3d_left + alpha*(var3d_right-var3d_left) + elsewhere + var3d = MAPL_UNDEF + endwhere + end if + + if (this%scale_factor == 0.0 .and. this%offset /= 0.0) then + where(var3d /= MAPL_UNDEF) var3d=var3d+this%offset + end if + if (this%scale_factor /= 0.0 .and. this%offset == 0.0) then + where(var3d /= MAPL_UNDEF) var3d=var3d*this%scale_factor + end if + if (this%scale_factor /= 0.0 .and. this%offset /= 0.0) then + where(var3d /= MAPL_UNDEF) var3d=var3d*this%scale_factor+this%offset + end if + + end if + _RETURN(_SUCCESS) + + end subroutine interpolate_to_time + + subroutine swap_node_fields(this,rc) + class(ExtDataBracket), intent(inout) :: this + integer, optional, intent(out) :: rc + integer :: status + integer :: field_rank + real, pointer :: var3d_left(:,:,:),var3d_right(:,:,:) + real, pointer :: var2d_left(:,:),var2d_right(:,:) + + call ESMF_FieldGet(this%left_node%field,dimCount=field_rank,__RC__) + if (field_rank == 2) then + call ESMF_FieldGet(this%right_node%field,localDE=0,farrayPtr=var2d_right,__RC__) + call ESMF_FieldGet(this%left_node%field,localDE=0,farrayPtr=var2d_left,__RC__) + var2d_left = var2d_right + else if (field_rank ==3) then + call ESMF_FieldGet(this%right_node%field,localDE=0,farrayPtr=var3d_right,__RC__) + call ESMF_FieldGet(this%left_node%field,localDE=0,farrayPtr=var3d_left,__RC__) + var3d_left = var3d_right + end if + _RETURN(_SUCCESS) + end subroutine swap_node_fields + +end module MAPL_ExtDataBracket diff --git a/gridcomps/ExtData2G/ExtDataClimFileHandler.F90 b/gridcomps/ExtData2G/ExtDataClimFileHandler.F90 new file mode 100644 index 000000000000..21cddb092810 --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataClimFileHandler.F90 @@ -0,0 +1,281 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" +module MAPL_ExtdataClimFileHandler + use ESMF + use MAPL_ExtDataAbstractFileHandler + use MAPL_KeywordEnforcerMod + use MAPL_ExceptionHandling + use MAPL_ExtDataFileStream + use MAPL_ExtDataFileStreamMap + use MAPL_DataCollectionMod + use MAPL_CollectionVectorMod + use MAPL_DataCollectionManagerMod + use MAPL_FileMetadataUtilsMod + use MAPL_TimeStringConversion + use MAPL_StringTemplate + use MAPL_ExtDataBracket + use MAPL_ExtDataConstants + implicit none + private + public ExtDataClimFileHandler + + integer, parameter :: CLIM_NULL = -1 + type, extends(ExtDataAbstractFileHandler) :: ExtDataClimFileHandler + integer :: clim_year = CLIM_NULL + contains + procedure :: get_file_bracket + procedure :: get_file + end type + +contains + + subroutine get_file_bracket(this, input_time, source_time, bracket, rc) + class(ExtdataClimFileHandler), intent(inout) :: this + type(ESMF_Time), intent(in) :: input_time + type(ESMF_Time), intent(in) :: source_time(:) + type(ExtDataBracket), intent(inout) :: bracket + integer, optional, intent(out) :: rc + + type(ESMF_Time) :: time + integer :: time_index + character(len=ESMF_MAXPATHLEN) :: file + integer :: status + type(ESMF_TimeInterval) :: zero + type(ESMF_Time) :: target_time + + integer :: target_year, original_year,clim_shift,valid_years(2) + integer, allocatable :: source_years(:) + + + if (bracket%time_in_bracket(input_time)) then + _RETURN(_SUCCESS) + end if + + target_time=input_time + _ASSERT(size(this%valid_range) == 2, 'Valid time is not defined so can not do any extrapolation or climatology') + call ESMF_TimeGet(this%valid_range(1),yy=valid_years(1),__RC__) + call ESMF_TimeGet(this%valid_range(2),yy=valid_years(2),__RC__) + if (size(source_time)==2) then + allocate(source_years(2)) + call ESMF_TimeGet(source_time(1),yy=source_years(1),__RC__) + call ESMF_TimeGet(source_time(2),yy=source_years(2),__RC__) + _ASSERT(source_years(1) >= valid_years(1),'source time outide valid range') + _ASSERT(source_years(1) <= valid_years(2),'source time outide valid range') + _ASSERT(source_years(2) >= valid_years(1),'source time outide valid range') + _ASSERT(source_years(2) <= valid_years(2),'source time outide valid range') + end if + + ! shift target year to request source time if specified + ! is TS1 < TM < TS2, if not then extrapolate beyond that + call ESMF_TimeGet(target_time,yy=target_year,__RC__) + original_year=target_year + + if (size(source_years)>0) then + if (target_year < source_years(1)) then + target_year = source_years(1) + this%clim_year = target_year + else if (target_year >= source_years(2)) then + target_year = source_years(2) + this%clim_year = target_year + end if + call swap_year(target_time,target_year,__RC__) + else + if (target_year < valid_years(1)) then + target_year = valid_years(1) + this%clim_year = target_year + call swap_year(target_time,target_year,__RC__) + else if (target_year >= valid_years(2)) then + target_year = valid_years(2) + this%clim_year = target_year + call swap_year(target_time,target_year,__RC__) + end if + end if + + ! the target time is contained in the dataset and we are not extrapolating outside of source time selection based on available data + if (this%clim_year == CLIM_NULL) then + + call ESMF_TimeIntervalSet(zero,__RC__) + if (this%frequency == zero) then + file = this%file_template + call this%get_time_on_file(file,input_time,'L',time_index,time,__RC__) + _ASSERT(time_index/=time_not_found,"Time not found on file") + call bracket%set_node('L',file=file,time_index=time_index,time=time,__RC__) + if (bracket%left_node == bracket%right_node) then + call bracket%swap_node_fields(rc=status) + _VERIFY(status) + else + bracket%new_file_left=.true. + end if + call this%get_time_on_file(file,input_time,'R',time_index,time,__RC__) + _ASSERT(time_index/=time_not_found,"Time not found on file") + call bracket%set_node('R',file=file,time_index=time_index,time=time,__RC__) + bracket%new_file_right=.true. + else + call this%get_file(file,target_time,0,__RC__) + call this%get_time_on_file(file,target_time,'L',time_index,time,rc=status) + if (time_index == time_not_found) then + call this%get_file(file,target_time,-1,__RC__) + call this%get_time_on_file(file,target_time,'L',time_index,time,__RC__) + _ASSERT(time_index/=time_not_found,"Time not found on file") + end if + call bracket%set_node('L',file=file,time_index=time_index,time=time,__RC__) + if (bracket%left_node == bracket%right_node) then + call bracket%swap_node_fields(rc=status) + _VERIFY(status) + else + bracket%new_file_left=.true. + end if + + call this%get_file(file,target_time,0,__RC__) + call this%get_time_on_file(file,target_time,'R',time_index,time,rc=status) + if (time_index == time_not_found) then + call this%get_file(file,target_time,1,__RC__) + call this%get_time_on_file(file,target_time,'R',time_index,time,__RC__) + _ASSERT(time_index/=time_not_found,"Time not found on file") + end if + call bracket%set_node('R',file=file,time_index=time_index,time=time,__RC__) + bracket%new_file_right=.true. + end if + + ! the target time has been specified to be a climatology for the year; either we + ! are outside the dataset or we have requested a source time range and are on + ! or outside either end + else + + call ESMF_TimeIntervalSet(zero,__RC__) + if (this%frequency == zero) then + file = this%file_template + clim_shift=0 + call this%get_time_on_file(file,target_time,'L',time_index,time,wrap=clim_shift,__RC__) + _ASSERT(time_index/=time_not_found,"Time not found on file") + call swap_year(time,original_year+clim_shift,__RC__) + call bracket%set_node('L',file=file,time_index=time_index,time=time,__RC__) + if (bracket%left_node == bracket%right_node) then + call bracket%swap_node_fields(rc=status) + _VERIFY(status) + else + bracket%new_file_left=.true. + end if + + clim_shift=0 + call this%get_time_on_file(file,target_time,'R',time_index,time,wrap=clim_shift,__RC__) + _ASSERT(time_index/=time_not_found,"Time not found on file") + call swap_year(time,original_year+clim_shift,__RC__) + call bracket%set_node('R',file=file,time_index=time_index,time=time,__RC__) + bracket%new_file_right=.true. + + else + + call this%get_file(file,target_time,0,__RC__) + call this%get_time_on_file(file,target_time,'L',time_index,time,rc=status) + if (time_index == time_not_found) then + call this%get_file(file,target_time,-1,__RC__) + call this%get_time_on_file(file,target_time,'L',time_index,time,__RC__) + _ASSERT(time_index/=time_not_found,"Time not found on file") + call ESMF_TimeGet(target_time,yy=target_year,__RC__) + if (target_year > this%clim_year) then + call swap_year(time,original_year-1,__RC__) + else + call swap_year(time,original_year,__RC__) + end if + else + call swap_year(time,original_year,__RC__) + end if + if (bracket%left_node == bracket%right_node) then + call bracket%swap_node_fields(rc=status) + _VERIFY(status) + else + bracket%new_file_left=.true. + end if + call bracket%set_node('L',file=file,time_index=time_index,time=time,__RC__) + + call this%get_file(file,target_time,0,__RC__) + call this%get_time_on_file(file,target_time,'R',time_index,time,rc=status) + if (time_index == time_not_found) then + call this%get_file(file,target_time,1,__RC__) + call this%get_time_on_file(file,target_time,'R',time_index,time,__RC__) + _ASSERT(time_index/=time_not_found,"Time not found on file") + call ESMF_TimeGet(target_time,yy=target_year,__RC__) + if (target_year < this%clim_year) then + call swap_year(time,original_year+1,__RC__) + else + call swap_year(time,original_year,__RC__) + end if + else + call swap_year(time,original_year,__RC__) + end if + call bracket%set_node('R',file=file,time_index=time_index,time=time,__RC__) + bracket%new_file_right=.true. + + end if + + end if + + _RETURN(_SUCCESS) + + end subroutine get_file_bracket + + subroutine get_file(this,filename,target_time,shift,rc) + class(ExtdataClimFileHandler), intent(inout) :: this + character(len=*), intent(out) :: filename + type(ESMF_Time) :: target_time + integer, intent(in) :: shift + integer, intent(out), optional :: rc + + type(ESMF_Time) :: ftime + integer :: n,status + logical :: file_found + integer :: new_year + integer(ESMF_KIND_I8) :: interval_seconds + + + call ESMF_TimeIntervalGet(this%frequency,s_i8=interval_seconds) + if (interval_seconds==0) then + ! time is not representable as absolute time interval (month, year etc...) do this + ! brute force way. Not good but ESMF leaves no choice + ftime=this%reff_time + do while (ftime < target_time) + ftime = ftime + this%frequency + enddo + ftime=ftime -this%frequency + shift*this%frequency + else + n = (target_time-this%reff_time)/this%frequency + ftime = this%reff_time+(n+shift)*this%frequency + end if + if (this%clim_year /= CLIM_NULL) then + call ESMF_TimeGet(ftime,yy=new_year,__RC__) + if (new_year/=this%clim_year) then + call swap_year(ftime,this%clim_year,__RC__) + if (shift > 0) then + call swap_year(target_time,this%clim_year-shift) + else if (shift < 0) then + call swap_year(target_time,this%clim_year+shift) + end if + end if + end if + call fill_grads_template(filename,this%file_template,time=ftime,__RC__) + inquire(file=trim(filename),exist=file_found) + _ASSERT(file_found,"get_file did not file a file using: "//trim(this%file_template)) + _RETURN(_SUCCESS) + + end subroutine get_file + + subroutine swap_year(time,year,rc) + type(ESMF_Time), intent(inout) :: time + integer, intent(in) :: year + integer, optional, intent(out) :: rc + logical :: is_leap_year + type(ESMF_Calendar) :: calendar + integer :: status, month, day, hour, minute, second + + is_leap_year=.false. + call ESMF_TimeGet(time,mm=month,dd=day,h=hour,m=minute,s=second,calendar=calendar,__RC__) + if (day==29 .and. month==2) then + is_leap_year = ESMF_CalendarIsLeapYear(calendar,year,__RC__) + if (.not.is_leap_year) day=28 + end if + call ESMF_TimeSet(time,yy=year,mm=month,dd=day,h=hour,m=minute,s=second,__RC__) + _RETURN(_SUCCESS) + end subroutine + +end module MAPL_ExtdataClimFileHandler diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 new file mode 100644 index 000000000000..4f3d0dcc7212 --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -0,0 +1,200 @@ +#include "MAPL_ErrLog.h" +module MAPL_ExtDataConfig + use ESMF + use yaFyaml + use gFTL_StringVector + use MAPL_KeywordEnforcerMod + use MAPL_ExceptionHandling + use MAPL_ExtDataFileStream + use MAPL_ExtDataFileStreamMap + use MAPL_ExtDataRule + use MAPL_ExtDataRuleMap + use MAPL_ExtDataDerived + use MAPL_ExtDataDerivedMap + use MAPL_ExtDataConstants + use MAPL_ExtDataTimeSample + use MAPL_ExtDataTimeSampleMap + implicit none + private + + type, public :: ExtDataConfig + integer :: debug + type(ExtDataRuleMap) :: rule_map + type(ExtDataDerivedMap) :: derived_map + type(ExtDataFileStreamMap) :: file_stream_map + type(ExtDataTimeSampleMap) :: sample_map + + contains + procedure :: get_item_type + procedure :: get_debug_flag + procedure :: new_ExtDataConfig_from_yaml + end type + +contains + + recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_time,unusable,rc) + class(ExtDataConfig), intent(inout), target :: ext_config + character(len=*), intent(in) :: config_file + type(ESMF_Time), intent(in) :: current_time + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + type(Parser) :: p + type(Configuration) :: config, subcfg, ds_config, rule_config, derived_config, sample_config + type(ConfigurationIterator) :: iter + character(len=:), allocatable :: key + type(ExtDataFileStream) :: ds + type(ExtDataDerived) :: derived + type(ExtDataRule) :: rule,ucomp,vcomp + type(ExtDataTimeSample) :: ts + integer :: status, semi_pos + character(len=:), allocatable :: uname,vname + type(FileStream) :: fstream + + type(ExtDataFileStream), pointer :: temp_ds + type(ExtDataTimeSample), pointer :: temp_ts + type(ExtDataRule), pointer :: temp_rule + type(ExtDataDerived), pointer :: temp_derived + + type(Configuration) :: subconfigs + character(len=:), allocatable :: sub_file + integer :: i + + type(ExtDataTimeSample), pointer :: ts_grr + + _UNUSED_DUMMY(unusable) + + p = Parser('core') + fstream=FileStream(config_file) + config = p%load(fstream) + call fstream%close() + + if (config%has("subconfigs")) then + subconfigs = config%at("subconfigs") + _ASSERT(subconfigs%is_sequence(),'subconfigs is not a sequence') + do i=1,subconfigs%size() + sub_file = subconfigs%of(i) + call new_ExtDataConfig_from_yaml(ext_config,sub_file,current_time,rc=status) + _VERIFY(status) + end do + end if + + if (config%has("Samplings")) then + sample_config = config%of("Samplings") + iter = sample_config%begin() + do while (iter /= sample_config%end()) + call iter%get_key(key) + temp_ts => ext_config%sample_map%at(key) + _ASSERT(.not.associated(temp_ts),"defined duplicate named sample key") + call iter%get_value(subcfg) + ts = ExtDataTimeSample(subcfg,_RC) + _VERIFY(status) + call ext_config%sample_map%insert(trim(key),ts) + call iter%next() + enddo + end if + + if (config%has("Collections")) then + ds_config = config%of("Collections") + iter = ds_config%begin() + do while (iter /= ds_config%end()) + call iter%get_key(key) + temp_ds => ext_config%file_stream_map%at(key) + _ASSERT(.not.associated(temp_ds),"defined duplicate named collection") + call iter%get_value(subcfg) + ds = ExtDataFileStream(subcfg,current_time,_RC) + call ext_config%file_stream_map%insert(trim(key),ds) + call iter%next() + enddo + end if + + if (config%has("Exports")) then + rule_config = config%of("Exports") + iter = rule_config%begin() + do while (iter /= rule_config%end()) + call rule%set_defaults(rc=status) + _VERIFY(status) + call iter%get_key(key) + call iter%get_value(subcfg) + rule = ExtDataRule(subcfg,ext_config%sample_map,key,_RC) + semi_pos = index(key,";") + if (semi_pos > 0) then + call rule%split_vector(key,ucomp,vcomp,rc=status) + uname = key(1:semi_pos-1) + vname = key(semi_pos+1:len_trim(key)) + temp_rule => ext_config%rule_map%at(trim(uname)) + _ASSERT(.not.associated(temp_rule),"duplicated export entry key") + call ext_config%rule_map%insert(trim(uname),ucomp) + temp_rule => ext_config%rule_map%at(trim(vname)) + _ASSERT(.not.associated(temp_rule),"duplicated export entry key") + call ext_config%rule_map%insert(trim(vname),vcomp) + else + temp_rule => ext_config%rule_map%at(trim(key)) + _ASSERT(.not.associated(temp_rule),"duplicated export entry key") + call ext_config%rule_map%insert(trim(key),rule) + end if + call iter%next() + enddo + end if + + if (config%has("Derived")) then + derived_config = config%at("Derived") + iter = derived_config%begin() + do while (iter /= derived_config%end()) + call derived%set_defaults(rc=status) + _VERIFY(status) + call iter%get_key(key) + call iter%get_value(subcfg) + derived = ExtDataDerived(subcfg,_RC) + temp_derived => ext_config%derived_map%at(trim(uname)) + _ASSERT(.not.associated(temp_derived),"duplicated derived entry key") + call ext_config%derived_map%insert(trim(key),derived) + call iter%next() + enddo + end if + + if (config%has("debug")) then + call config%get(ext_config%debug,"debug",rc=status) + _VERIFY(status) + end if + ts_grr =>ext_config%sample_map%at('sample_0') + + _RETURN(_SUCCESS) + end subroutine new_ExtDataConfig_from_yaml + + function get_item_type(this,item_name,unusable,rc) result(item_type) + class(ExtDataConfig), intent(inout) :: this + character(len=*), intent(in) :: item_name + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + integer :: item_type + type(ExtDataRule), pointer :: rule + type(ExtDataDerived), pointer :: derived + + _UNUSED_DUMMY(unusable) + item_type=ExtData_not_found + rule => this%rule_map%at(trim(item_name)) + if (associated(rule)) then + if (allocated(rule%vector_component)) then + if (rule%vector_component=='EW') then + item_type=Primary_Type_Vector_comp2 + else if (rule%vector_component=='NS') then + item_type=Primary_Type_Vector_comp1 + end if + else + item_type=Primary_Type_scalar + end if + end if + derived => this%derived_map%at(trim(item_name)) + if (associated(derived)) then + item_type=derived_type + end if + _RETURN(_SUCCESS) + end function get_item_type + + integer function get_debug_flag(this) + class(ExtDataConfig), intent(inout) :: this + get_debug_flag=this%debug + end function get_debug_flag + +end module MAPL_ExtDataConfig diff --git a/gridcomps/ExtData2G/ExtDataConstants.F90 b/gridcomps/ExtData2G/ExtDataConstants.F90 new file mode 100644 index 000000000000..dd711bf12b74 --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataConstants.F90 @@ -0,0 +1,12 @@ +module MAPL_ExtDataConstants +implicit none +private + + integer, parameter, public :: ExtData_Not_Found = 0 + integer, parameter, public :: Primary_Type_Scalar = 1 + integer, parameter, public :: Primary_Type_Vector_comp1 = 2 + integer, parameter, public :: Primary_Type_Vector_comp2 = 3 + integer, parameter, public :: Derived_TYpe = 4 + integer, parameter, public :: time_not_found = -1 + +end module MAPL_ExtDataConstants diff --git a/gridcomps/ExtData2G/ExtDataDerived.F90 b/gridcomps/ExtData2G/ExtDataDerived.F90 new file mode 100644 index 000000000000..c8ae79b79e4e --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataDerived.F90 @@ -0,0 +1,90 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" +module MAPL_ExtDataDerived + use yaFyaml + use MAPL_KeywordEnforcerMod + use MAPL_ExceptionHandling + implicit none + private + + type, public :: ExtDataDerived + character(:), allocatable :: expression + character(:), allocatable :: sample_key + contains + procedure :: display + procedure :: set_defaults + end type + + interface ExtDataDerived + module procedure new_ExtDataDerived + end interface + +contains + + function new_ExtDataDerived(config,unusable,rc) result(rule) + type(Configuration), intent(in) :: config + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + type(ExtDataDerived) :: rule + logical :: is_present + integer :: status + character(len=:), allocatable :: tempc + _UNUSED_DUMMY(unusable) + + + if (allocated(tempc)) deallocate(tempc) + is_present = config%has("function") + _ASSERT(is_present,"no expression found in derived entry") + call config%get(tempc,"function",rc=status) + _VERIFY(status) + rule%expression=tempc + + if (allocated(tempc)) deallocate(tempc) + is_present = config%has("sample") + if (is_present) then + call config%get(tempc,"sample",rc=status) + _VERIFY(status) + rule%sample_key=tempc + end if + + _RETURN(_SUCCESS) + end function new_ExtDataDerived + + + subroutine set_defaults(this,unusable,rc) + class(ExtDataDerived), intent(inout), target :: this + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + _UNUSED_DUMMY(unusable) + this%expression='' + _RETURN(_SUCCESS) + end subroutine set_defaults + + subroutine display(this) + class(ExtDataDerived) :: this + write(*,*)"function: ",trim(this%expression) + end subroutine display + +end module MAPL_ExtDataDerived + +module MAPL_ExtDataDerivedMap + use MAPL_ExtDataDerived + +#include "types/key_deferredLengthString.inc" +#define _value type(ExtDataDerived) +#define _alt + +#define _map ExtDataDerivedMap +#define _iterator ExtDataDerivedMapIterator + +#include "templates/map.inc" + +#undef _iterator +#undef _map + +#undef _alt +#undef _value + +end module MAPL_ExtDataDerivedMap diff --git a/gridcomps/ExtData2G/ExtDataFileStream.F90 b/gridcomps/ExtData2G/ExtDataFileStream.F90 new file mode 100644 index 000000000000..9f84e4639e4b --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataFileStream.F90 @@ -0,0 +1,208 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" +module MAPL_ExtDataFileStream + use ESMF + use yaFyaml + use MAPL_KeywordEnforcerMod + use MAPL_ExceptionHandling + use MAPL_TimeStringConversion + use MAPL_DataCollectionMod + use MAPL_CollectionVectorMod + use MAPL_DataCollectionManagerMod + use MAPL_FileMetadataUtilsMod + use MAPL_StringTemplate + implicit none + private + + type, public :: ExtDataFileStream + character(:), allocatable :: file_template + type(ESMF_TimeInterval) :: frequency + type(ESMF_Time) :: reff_time + integer :: collection_id + type(ESMF_Time), allocatable :: valid_range(:) + type(FileMetaData) :: metadata + contains + procedure :: detect_metadata + end type + + interface ExtDataFileStream + module procedure new_ExtDataFileStream + end interface ExtDataFileStream +contains + + function new_ExtDataFileStream(config,current_time,unusable,rc) result(data_set) + type(Configuration), intent(in) :: config + type(ESMF_Time), intent(in) :: current_time + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + type(ExtDataFileStream) :: data_set + integer :: status + integer :: last_token + integer :: iyy,imm,idd,ihh,imn,isc,idx + character(len=2) :: token + character(len=:), allocatable :: file_frequency, file_reff_time,range_str + logical :: is_present + + _UNUSED_DUMMY(unusable) + + if (config%is_scalar()) then + + else if (config%is_mapping()) then + is_present = config%has("template") + _ASSERT(is_present,"no file template in the collection") + if (is_present) then + call config%get(data_set%file_template,"template",rc=status) + _VERIFY(status) + file_frequency = get_string_with_default(config,"freq") + file_reff_time = get_string_with_default(config,"ref_time") + range_str = get_string_with_default(config,"valid_range") + end if + end if + + if (file_frequency /= '') then + data_set%frequency = string_to_esmf_timeinterval(file_frequency) + else + last_token = index(data_set%file_template,'%',back=.true.) + if (last_token.gt.0) then + token = data_set%file_template(last_token+1:last_token+2) + select case(token) + case("y4") + call ESMF_TimeIntervalSet(data_set%frequency,yy=1,__RC__) + case("m2") + call ESMF_TimeIntervalSet(data_set%frequency,mm=1,__RC__) + case("d2") + call ESMF_TimeIntervalSet(data_set%frequency,d=1,__RC__) + case("h2") + call ESMF_TimeIntervalSet(data_set%frequency,h=1,__RC__) + case("n2") + call ESMF_TimeIntervalSet(data_set%frequency,m=1,__RC__) + end select + else + ! couldn't find any tokens so all the data must be on one file + call ESMF_TimeIntervalSet(data_set%frequency,__RC__) + end if + end if + + if (file_reff_time /= '') then + data_set%reff_time = string_to_esmf_time(file_reff_time) + else + last_token = index(data_set%file_template,'%',back=.true.) + if (last_token.gt.0) then + call ESMF_TimeGet(current_time, yy=iyy, mm=imm, dd=idd,h=ihh, m=imn, s=isc ,__RC__) + token = data_set%file_template(last_token+1:last_token+2) + select case(token) + case("y4") + call ESMF_TimeSet(data_set%reff_time,yy=iyy,mm=1,dd=1,h=0,m=0,s=0,__RC__) + case("m2") + call ESMF_TimeSet(data_set%reff_time,yy=iyy,mm=imm,dd=1,h=0,m=0,s=0,__RC__) + case("d2") + call ESMF_TimeSet(data_set%reff_time,yy=iyy,mm=imm,dd=idd,h=0,m=0,s=0,__RC__) + case("h2") + call ESMF_TimeSet(data_set%reff_time,yy=iyy,mm=imm,dd=idd,h=ihh,m=0,s=0,__RC__) + case("n2") + call ESMF_TimeSet(data_set%reff_time,yy=iyy,mm=imm,dd=idd,h=ihh,m=imn,s=0,__RC__) + end select + else + data_set%reff_time = current_time + end if + end if + + if (range_str /= '') then + idx = index(range_str,',') + _ASSERT(idx/=0,'invalid specification of time range') + if (allocated(data_set%valid_range)) deallocate(data_set%valid_range) + allocate(data_set%valid_range(2)) + data_set%valid_range(1)=string_to_esmf_time(range_str(:idx-1)) + data_set%valid_range(2)=string_to_esmf_time(range_str(idx+1:)) + call ESMF_TimeGet(data_set%reff_time,yy=iyy,mm=imm,dd=idd,h=ihh,m=imn,__RC__) + call ESMF_TimeGet(data_set%valid_range(1),yy=iyy,__RC__) + call ESMF_TimeSet(data_set%reff_time,yy=iyy,mm=imm,dd=idd,h=ihh,m=imn,__RC__) + end if + data_set%collection_id = MAPL_DataAddCollection(data_set%file_template) + + _RETURN(_SUCCESS) + + contains + + function get_string_with_default(config,selector) result(string) + type(Configuration), intent(in) :: config + character(len=*), intent(In) :: selector + character(len=:), allocatable :: string + + if (config%has(selector)) then + string=config%of(selector) + else + string='' + end if + end function + + end function new_ExtDataFileStream + + subroutine detect_metadata(this,metadata_out,time,get_range,rc) + class(ExtDataFileStream), intent(inout) :: this + type(FileMetadataUtils), intent(inout) :: metadata_out + type(ESMF_Time), intent(in) :: time + logical, optional, intent(in) :: get_range + integer, optional, intent(out) :: rc + + logical :: get_range_ + type(MAPLDataCollection), pointer :: collection + type(FileMetadataUtils), pointer :: metadata + type(ESMF_Time), allocatable :: time_series(:) + integer :: status + character(len=ESMF_MAXPATHLEN) :: filename + + if (present(get_range)) then + get_range_ = get_range + else + get_range_ = .false. + end if + + collection => DataCollections%at(this%collection_id) + if (get_range_ .and. (.not.allocated(this%valid_range))) then + if (index('%',this%file_template) == 0) then + metadata => collection%find(this%file_template) + call metadata%get_time_info(timeVector=time_series,__RC__) + allocate(this%valid_range(2)) + this%valid_range(1)=time_series(1) + this%valid_range(2)=time_series(size(time_series)) + end if + end if + if (get_range_) then + call ESMF_TimePrint(this%valid_range(1),options='string') + call ESMF_TimePrint(this%valid_range(2),options='string') + end if + + if (get_range_) then + call fill_grads_template(filename,this%file_template,time=this%valid_range(1),__RC__) + else + call fill_grads_template(filename,this%file_template,time=time,__RC__) + end if + metadata => collection%find(filename,__RC__) + metadata_out = metadata + _RETURN(_SUCCESS) + + end subroutine detect_metadata + +end module MAPL_ExtDataFileStream + +module MAPL_ExtDataFileStreamMap + use MAPL_ExtDataFileStream + +#include "types/key_deferredLengthString.inc" +#define _value type(ExtDataFileStream) +#define _alt + +#define _map ExtDataFileStreamMap +#define _iterator ExtDataFileStreamMapIterator + +#include "templates/map.inc" + +#undef _iterator +#undef _map + +#undef _alt +#undef _value + +end module MAPL_ExtDataFileStreamMap diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 new file mode 100644 index 000000000000..d7f6174bc1a0 --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -0,0 +1,2301 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_Generic.h" +#include "unused_dummy.H" + +!------------------------------------------------------------------------- +! NASA/GSFC, Global Modeling and Assimilation Office, Code 910.1 ! +!------------------------------------------------------------------------- + + MODULE MAPL_ExtDataGridCompNG + +!BOP +! !MODULE: MAPL_ExtDataGridCompMod - Implements Interface to External Data +! +! !DESCRIPTION: +! +! {\tt MAPL\_ExtDataGridComp} is an ESMF gridded component implementing +! an interface to boundary conditions and other types of external data +! files. +! +! Developed for GEOS-5 release Fortuna 2.0 and later. +! +! !USES: +! + USE ESMF + use gFTL_StringVector + use MAPL_BaseMod + use MAPL_CommsMod + use MAPL_ShmemMod + use ESMFL_Mod + use MAPL_GenericMod + use MAPL_VarSpecMod + use MAPL_CFIOMod + use MAPL_NewArthParserMod + use MAPL_ConstantsMod, only: MAPL_PI,MAPL_PI_R8,MAPL_RADIANS_TO_DEGREES + use MAPL_IOMod, only: MAPL_NCIOParseTimeUnits + use, intrinsic :: iso_fortran_env, only: REAL64 + use linearVerticalInterpolation_mod + use ESMF_CFIOCollectionVectorMod + use ESMF_CFIOCollectionMod + use MAPL_ConfigMod + use MAPL_GridManagerMod + use MAPL_ExtData_IOBundleMod + use MAPL_ExtData_IOBundleVectorMod + use MAPL_ExceptionHandling + use MAPL_DataCollectionMod + use MAPL_CollectionVectorMod + use MAPL_DataCollectionManagerMod + use MAPL_FileMetadataUtilsMod + use pFIO_ClientManagerMod, only : i_Clients + use MAPL_GriddedIOItemMod + use MAPL_GriddedIOItemVectorMod + use MAPL_ExtDataConfig + use MAPL_ExtDataTypeDef + use MAPL_ExtDataOldTypesCreator + use MAPL_StringTemplate + use pflogger, only: logging, Logger + use MAPL_ExtDataLogger + use MAPL_ExtDataConstants + + IMPLICIT NONE + PRIVATE +! +! !PUBLIC MEMBER FUNCTIONS: + + PUBLIC SetServices + public t_extdata_state + public extdata_wrap +!EOP +! +! !REVISION HISTORY: +! +! 12Dec2009 da Silva Design and first implementation. +! +!------------------------------------------------------------------------- + + integer :: Ext_Debug + integer, parameter :: MAPL_ExtDataLeft = 1 + integer, parameter :: MAPL_ExtDataRight = 2 + logical :: hasRun + character(len=ESMF_MAXSTR) :: error_msg_str + + type PrimaryExports + PRIVATE + integer :: nItems = 0 + logical :: have_phis + type(PrimaryExport), pointer :: item(:) => null() + end type PrimaryExports + + type DerivedExports + PRIVATE + integer :: nItems = 0 + type(DerivedExport), pointer :: item(:) => null() + end type DerivedExports + +! Legacy state +! ------------ + type MAPL_ExtData_State + PRIVATE + type(PrimaryExports) :: Primary + type(DerivedExports) :: Derived + ! will add fields from export state to this state + ! will also add new fields that could be mask + ! or primary exports that were not in the export + ! state recieved by ExtData, i.e. fields that are + ! needed by a derived field where the primary fields + ! are not actually required + type(ESMF_State) :: ExtDataState + type(ESMF_Config) :: CF + logical :: active + integer, allocatable :: PrimaryOrder(:) + end type MAPL_ExtData_State + +! Hook for the ESMF +! ----------------- + type MAPL_ExtData_Wrap + type (MAPL_ExtData_State), pointer :: PTR => null() + end type MAPL_ExtData_WRAP + + type t_extdata_state + type(ESMF_State) :: expState + type(ESMF_GridComp) :: gc + end type t_extdata_state + + ! Wrapper for extracting internal state + ! ------------------------------------- + type extdata_wrap + type (t_extdata_state), pointer :: PTR + end type extdata_wrap + + +CONTAINS + + +!------------------------------------------------------------------------- +! NASA/GSFC, Global Modeling and Assimilation Office, Code 910.1 ! +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: SetServices --- Sets IRF services for the MAPL_ExtData +! +! !INTERFACE: + + SUBROUTINE SetServices ( GC, RC ) + +! !ARGUMENTS: + + type(ESMF_GridComp), intent(INOUT) :: GC ! gridded component + integer, optional :: RC ! return code + +! !DESCRIPTION: Sets Initialize, Run and Finalize services. +! +! !REVISION HISTORY: +! +! 12Dec2009 da Silva Design and first implementation. +! +!EOP +!------------------------------------------------------------------------- + +! Local derived type aliases +! -------------------------- + type (MAPL_ExtData_State), pointer :: self ! internal, that is + type (MAPL_ExtData_wrap) :: wrap + + character(len=ESMF_MAXSTR) :: comp_name + character(len=ESMF_MAXSTR) :: Iam + integer :: status + +! ------------ + +! Get my name and set-up traceback handle +! --------------------------------------- + Iam = 'SetServices' + call ESMF_GridCompGet( GC, name=comp_name, __RC__ ) + Iam = trim(comp_name) // '::' // trim(Iam) + +! Wrap internal state for storing in GC; rename legacyState +! ------------------------------------- + allocate ( self, stat=STATUS ) + _VERIFY(STATUS) + wrap%ptr => self + +! ------------------------ +! ESMF Functional Services +! ------------------------ + +! Set the Initialize, Run, Finalize entry points +! ---------------------------------------------- + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_INITIALIZE, Initialize_, __RC__ ) + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run_, __RC__ ) + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_FINALIZE, Finalize_, __RC__ ) + +! Store internal state in GC +! -------------------------- + call ESMF_UserCompSetInternalState ( GC, 'MAPL_ExtData_state', wrap, STATUS ) + _VERIFY(STATUS) + + call MAPL_TimerAdd(gc,name="Initialize", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="Run", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="-Read_Loop", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="--CheckUpd", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="--Read", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="--GridCreate", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="--IclientWait", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="--PRead", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="---CreateCFIO", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="---prefetch", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="----add-collection", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="----make-reference", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="----RegridStore", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="----request", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="---IclientDone", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="----RegridApply", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="---read-prefetch", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="--Swap", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="--Bracket", rc=status) + _VERIFY(STATUS) + call MAPL_TimerAdd(gc,name="-Interpolate", rc=status) + _VERIFY(STATUS) +! Generic Set Services +! -------------------- + call MAPL_GenericSetServices ( GC, __RC__ ) + +! All done +! -------- + + _RETURN(ESMF_SUCCESS) + + END SUBROUTINE SetServices + + +!------------------------------------------------------------------------- +! NASA/GSFC, Global Modeling and Assimilation Office, Code 610.1 ! +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Initialize_ --- Initialize MAPL_ExtData +! +! !INTERFACE: +! + + SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) + +! !USES: + + implicit NONE + +! !INPUT PARAMETERS: + + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + +! !OUTPUT PARAMETERS: + + type(ESMF_GridComp), intent(inout) :: GC ! Grid Component + type(ESMF_State), intent(inout) :: IMPORT ! Import State + type(ESMF_State), intent(inout) :: EXPORT ! Export State + integer, intent(out) :: rc ! Error return code: + ! 0 - all is well + ! 1 - + +! !DESCRIPTION: This is a simple ESMF wrapper. +! +! !REVISION HISTORY: +! +! 12Dec2009 da Silva Design and first implementation. +! +!EOP +!------------------------------------------------------------------------- + + type(MAPL_ExtData_state), pointer :: self ! Legacy state + type(ESMF_Grid) :: GRID ! Grid + type(ESMF_Config) :: CF_master ! Universal Config + + character(len=ESMF_MAXSTR) :: comp_name + character(len=ESMF_MAXSTR) :: Iam + integer :: Status + + type(PrimaryExport), pointer :: item + integer :: i + integer :: ItemCount + integer :: PrimaryItemCount, DerivedItemCount + + type(ESMF_Time) :: time + + type (ESMF_Field) :: field,left_field,right_field + integer :: fieldRank, lm + type (ESMF_StateItem_Flag), pointer :: ITEMTYPES(:) + character(len=ESMF_MAXSTR), allocatable :: ITEMNAMES(:) + + real, pointer :: ptr2d(:,:) => null() + real, pointer :: ptr3d(:,:,:) => null() + integer :: idx + type(ESMF_VM) :: vm + type(MAPL_MetaComp),pointer :: MAPLSTATE + + type(ExtDataOldTypesCreator),target :: config_yaml + character(len=:), allocatable :: new_rc_file + logical :: found_in_config + integer :: num_primary,num_derived + integer, allocatable :: item_types(:) + type(StringVector) :: unsatisfied_imports + !class(logger), pointer :: lgr + +! Get my name and set-up traceback handle +! --------------------------------------- + Iam = 'Initialize_' + call ESMF_GridCompGet( GC, name=comp_name, config=CF_master, __RC__ ) + Iam = trim(comp_name) // '::' // trim(Iam) + call MAPL_GetLogger(gc, extdata_lgr, __RC__) + +! Extract relevant runtime information +! ------------------------------------ + call extract_ ( GC, self, CF_master, __RC__) + self%CF = CF_master + +! Start Some Timers +! ----------------- + call MAPL_GetObjectFromGC ( gc, MAPLSTATE, RC=STATUS) + _VERIFY(STATUS) + call MAPL_TimerOn(MAPLSTATE,"TOTAL") + call MAPL_TimerOn(MAPLSTATE,"Initialize") + + call ESMF_ClockGet(CLOCK, currTIME=time, __RC__) + new_rc_file = "extdata.yaml" + config_yaml = ExtDataOldTypesCreator(new_rc_file,time,__RC__) +! Get information from export state +!---------------------------------- + call ESMF_StateGet(EXPORT, ITEMCOUNT=ItemCount, RC=STATUS) + _VERIFY(STATUS) + + ! set ExtData on by default, let user turn it off if they want + call ESMF_ConfigGetAttribute(CF_master,self%active, Label='USE_EXTDATA:',default=.true.,rc=status) + + ! no need to run ExtData if there are no imports to fill + if (ItemCount == 0) then + self%active = .false. + end if + + if (.not.self%active) then + call MAPL_TimerOff(MAPLSTATE,"Initialize") + call MAPL_TimerOff(MAPLSTATE,"TOTAL") + _RETURN(ESMF_SUCCESS) + end if + +! Greetings +! --------- + if (MAPL_am_I_root()) then + print *, TRIM(Iam)//': ACTIVE' + print * + end if + + allocate(ITEMNAMES(ITEMCOUNT), STAT=STATUS) + _VERIFY(STATUS) + allocate(ITEMTYPES(ITEMCOUNT), STAT=STATUS) + _VERIFY(STATUS) + + call ESMF_StateGet(EXPORT, ITEMNAMELIST=ITEMNAMES, & + ITEMTYPELIST=ITEMTYPES, RC=STATUS) + _VERIFY(STATUS) + +! -------- +! Initialize MAPL Generic +! ----------------------- + call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, clock, __RC__ ) + + +! --------------------------- +! Parse ExtData Resource File +! --------------------------- + num_primary=0 + num_derived=0 + primaryitemcount=0 + deriveditemcount=0 + allocate(item_types(size(itemnames)),__STAT__) + do i=1,size(itemnames) + item_types(i) = config_yaml%get_item_type(trim(itemnames(i)),rc=status) + _VERIFY(status) + found_in_config = (item_types(i)/= ExtData_not_found) + if (.not.found_in_config) call unsatisfied_imports%push_back(itemnames(i)) + if (item_types(i) == derived_type) then + deriveditemcount=deriveditemcount+1 + else + primaryitemcount=primaryitemcount+1 + end if + enddo + if (unsatisfied_imports%size() > 0) then + do i=1,unsatisfied_imports%size() + call extdata_lgr%error("In ExtData resource file, could not find: "//trim(unsatisfied_imports%at(i))) + enddo + _FAIL("Unsatisfied imports in ExtData") + end if + + ext_debug=config_yaml%get_debug_flag() + allocate(self%primary%item(PrimaryItemCount),__STAT__) + allocate(self%derived%item(DerivedItemCount),__STAT__) + self%primary%nitems = PrimaryItemCount + self%derived%nitems = DerivedItemCount + + self%ExtDataState = ESMF_StateCreate(Name="ExtDataNameSpace",__RC__) + num_primary=0 + num_derived=0 + do i=1,size(itemnames) + if (item_types(i)==Primary_Type_Scalar .or. item_types(i)==Primary_Type_Vector_comp1) then + num_primary=num_primary+1 + call config_yaml%fillin_primary(trim(itemnames(i)),self%primary%item(num_primary),time,clock,__RC__) + else if (item_types(i)==Derived_type) then + num_derived=num_derived+1 + call config_yaml%fillin_derived(trim(itemnames(i)),self%derived%item(num_derived),time,clock,__RC__) + end if + call ESMF_StateGet(Export,trim(itemnames(i)),field,__RC__) + call MAPL_StateAdd(self%ExtDataState,field,__RC__) + enddo +! note: handle case if variables in derived expression need to be allocated! + + PrimaryLoop: do i = 1, self%primary%nItems + + item => self%primary%item(i) + + item%pfioCollection_id = MAPL_DataAddCollection(item%file) + +! Read the single step files (read interval equal to zero) +! -------------------------------------------------------- + + if (item%isConst) then + + if (item%vartype == MAPL_FieldItem) then + call ESMF_StateGet(self%ExtDataState,trim(item%name),field,__RC__) + call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) + if (fieldRank == 2) then + call MAPL_GetPointer(self%ExtDataState, ptr2d, trim(item%name),__RC__) + ptr2d = item%const + else if (fieldRank == 3) then + call MAPL_GetPointer(self%ExtDataState, ptr3d, trim(item%name), __RC__) + ptr3d = item%const + endif + else if (item%vartype == MAPL_VectorField) then + call ESMF_StateGet(self%ExtDataState,trim(item%vcomp1),field,__RC__) + call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) + if (fieldRank == 2) then + call MAPL_GetPointer(self%ExtDataState, ptr2d, trim(item%vcomp1),__RC__) + ptr2d = item%const + else if (fieldRank == 3) then + call MAPL_GetPointer(self%ExtDataState, ptr3d, trim(item%vcomp1), __RC__) + ptr3d = item%const + endif + call ESMF_StateGet(self%ExtDataState,trim(item%vcomp2),field,__RC__) + call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) + if (fieldRank == 2) then + call MAPL_GetPointer(self%ExtDataState, ptr2d, trim(item%vcomp2),__RC__) + ptr2d = item%const + else if (fieldRank == 3) then + call MAPL_GetPointer(self%ExtDataState, ptr3d, trim(item%vcomp2), __RC__) + ptr3d = item%const + endif + end if + cycle + end if + + ! get levels, other information + call GetLevs(item,__RC__) + call ESMF_VMBarrier(vm) + ! register collections + item%iclient_collection_id=i_clients%add_ext_collection(trim(item%file)) + ! create interpolating fields, check if the vertical levels match the file + if (item%vartype == MAPL_FieldItem) then + + call ESMF_StateGet(self%ExtDataState, trim(item%name), field,__RC__) + call ESMF_FieldGet(field,grid=grid,rank=fieldRank,__RC__) + + lm=0 + if (fieldRank==3) then + call ESMF_FieldGet(field,0,farrayPtr=ptr3d,__RC__) + lm = size(ptr3d,3) + end if + if (item%lm /= lm .and. lm /= 0 .and. item%havePressure) then + item%do_VertInterp = .true. + else if (item%lm /= lm .and. lm /= 0) then + item%do_Fill = .true. + end if + left_field = MAPL_FieldCreate(field,item%var,doCopy=.true.,__RC__) + right_field = MAPL_FieldCreate(field,item%var,doCopy=.true.,__RC__) + call item%modelGridFields%comp1%set_parameters(left_field=left_field,right_field=right_field, __RC__) + if (item%do_fill .or. item%do_vertInterp) then + call createFileLevBracket(item,cf_master,__RC__) + end if + + else if (item%vartype == MAPL_VectorField) then + + ! check that we are not asking for conservative regridding +!!$ if (item%Trans /= MAPL_HorzTransOrderBilinear) then + if (item%Trans /= REGRID_METHOD_BILINEAR) then + _ASSERT(.false.,'No conservative re-gridding with vectors') + end if + + block + integer :: gridRotation1, gridRotation2 + call ESMF_StateGet(self%ExtDataState, trim(item%vcomp1), field,__RC__) + call ESMF_AttributeGet(field, NAME='ROTATION', value=gridRotation1, __RC__) + call ESMF_StateGet(self%ExtDataState, trim(item%vcomp2), field,__RC__) + call ESMF_AttributeGet(field, NAME='ROTATION', value=gridRotation2, __RC__) + _ASSERT(GridRotation1 == gridRotation2,'Grid rotations must match when performing vector re-gridding') + end block + + call ESMF_StateGet(self%ExtDataState, trim(item%vcomp1), field,__RC__) + call ESMF_FieldGet(field,grid=grid,rank=fieldRank,__RC__) + + lm = 0 + if (fieldRank==3) then + call ESMF_FieldGet(field,0,farrayPtr=ptr3d,__RC__) + lm = size(ptr3d,3) + end if + if (item%lm /= lm .and. item%havePressure) then + item%do_VertInterp = .true. + else if (item%lm /= lm .and. lm /= 0) then + item%do_Fill = .true. + end if + + left_field = MAPL_FieldCreate(field,item%fcomp1,doCopy=.true.,__RC__) + right_field = MAPL_FieldCreate(field,item%fcomp1,doCopy=.true.,__RC__) + call item%modelGridFields%comp1%set_parameters(left_field=left_field,right_field=right_field, __RC__) + call ESMF_StateGet(self%ExtDataState, trim(item%vcomp2), field,__RC__) + left_field = MAPL_FieldCreate(field,item%fcomp2,doCopy=.true.,__RC__) + right_field = MAPL_FieldCreate(field,item%fcomp2,doCopy=.true.,__RC__) + call item%modelGridFields%comp2%set_parameters(left_field=left_field,right_field=right_field, __RC__) + + if (item%do_fill .or. item%do_vertInterp) then + call createFileLevBracket(item,cf_master,__RC__) + end if + + end if + + end do PrimaryLoop + +! Check if we have any files that would need to be vertically interpolated +! if so ensure that PS is done first + allocate(self%primaryOrder(size(self%primary%item)),__STAT__) + do i=1,size(self%primary%item) + self%primaryOrder(i)=i + enddo +! check for PS + idx = -1 + if (any(self%primary%item%do_VertInterp .eqv. .true.)) then + do i=1,size(self%primary%item) + if (self%primary%item(i)%name=='PS') then + idx =i + end if + enddo + _ASSERT(idx/=-1,'Surface pressure not present for vertical interpolation') + self%primaryOrder(1)=idx + self%primaryOrder(idx)=1 + self%primary%item(idx)%units = ESMF_UtilStringUppercase(self%primary%item(idx)%units,rc=status) + _ASSERT(trim(self%primary%item(idx)%units)=="PA",'PS must be in units of PA') + end if +! check for PHIS + idx = -1 + if (any(self%primary%item%do_VertInterp .eqv. .true.)) then + do i=1,size(self%primary%item) + if (self%primary%item(i)%name=='PHIS') then + idx =i + end if + enddo + if (idx/=-1) then + self%primaryOrder(2)=idx + self%primaryOrder(idx)=2 + self%primary%have_phis=.true. + end if + end if + + call extdata_lgr%info('*******************************************************') + call extdata_lgr%info('** Variables to be provided by the ExtData Component **') + call extdata_lgr%info('*******************************************************') + do i = 1, ItemCount + call extdata_lgr%info('---- %i0.5~: %a', i, trim(ItemNames(i))) + end do + call extdata_lgr%info('*******************************************************\n') + +! Clean up +! -------- + deallocate(ItemTypes) + deallocate(ItemNames) + +! Set has run to false to we know when we first go to run method it is first call + hasRun = .false. + + call MAPL_TimerOff(MAPLSTATE,"Initialize") + call MAPL_TimerOff(MAPLSTATE,"TOTAL") +! All done +! -------- + + IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN + Write(*,*) 'ExtData Initialize_: End' + ENDIF + + _RETURN(ESMF_SUCCESS) + + END SUBROUTINE Initialize_ + + +!------------------------------------------------------------------------- +! NASA/GSFC, Global Modeling and Assimilation Office, Code 610.1 ! +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Run_ --- Runs MAPL_ExtData +! +! !INTERFACE: +! + + SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) + +! !USES: + + implicit NONE + +! !INPUT PARAMETERS: + + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + +! !OUTPUT PARAMETERS: + + type(ESMF_GridComp), intent(inout) :: GC ! Grid Component + type(ESMF_State), intent(inout) :: IMPORT ! Import State + type(ESMF_State), intent(inout) :: EXPORT ! Export State + integer, intent(out) :: rc ! Error return code: + ! 0 - all is well + ! 1 - + +! !DESCRIPTION: This is a simple ESMF wrapper. +! +! !REVISION HISTORY: +! +! 12Dec2009 da Silva Design and first implementation. +! +!EOP +!------------------------------------------------------------------------- + + type(MAPL_ExtData_state), pointer :: self ! Legacy state + type(ESMF_Config) :: CF ! Universal Config + + character(len=ESMF_MAXSTR) :: comp_name + character(len=ESMF_MAXSTR) :: Iam + integer :: status + + type(PrimaryExport), pointer :: item + type(DerivedExport), pointer :: derivedItem + integer :: i + + type(ESMF_Time) :: time, time0 + type(MAPL_MetaComp), pointer :: MAPLSTATE + + logical :: doUpdate_ + character(len=ESMF_MAXPATHLEN) :: file_processed + logical, allocatable :: doUpdate(:) + type(ESMF_Time), allocatable :: useTime(:) + + integer :: bracket_side + integer :: entry_num + type(IOBundleVector), target :: IOBundles + type(IOBundleVectorIterator) :: bundle_iter + type(ExtData_IOBundle), pointer :: io_bundle + + _UNUSED_DUMMY(IMPORT) + _UNUSED_DUMMY(EXPORT) + +! Declare pointers to IMPORT/EXPORT/INTERNAL states +! ------------------------------------------------- +! #include "MAPL_ExtData_DeclarePointer___.h" + +! Get my name and set-up traceback handle +! --------------------------------------- + Iam = 'Run_' + call ESMF_GridCompGet( GC, name=comp_name, __RC__ ) + Iam = trim(comp_name) // '::' // trim(Iam) + + +! Call Run for every Child +! ------------------------- +!ALT call MAPL_GenericRunChildren ( GC, IMPORT, EXPORT, CLOCK, __RC__) + + +! Extract relevant runtime information +! ------------------------------------ + call extract_ ( GC, self, CF, __RC__ ) + + if (.not. self%active) then + _RETURN(ESMF_SUCCESS) + end if + + call MAPL_GetObjectFromGC ( gc, MAPLSTATE, RC=STATUS) + _VERIFY(STATUS) + call MAPL_TimerOn(MAPLSTATE,"TOTAL") + call MAPL_TimerOn(MAPLSTATE,"Run") + + call ESMF_ClockGet(CLOCK, currTIME=time0, __RC__) + + +! Fill in the internal state with data from the files +! --------------------------------------------------- + + allocate(doUpdate(self%primary%nitems),stat=status) + _VERIFY(STATUS) + doUpdate = .false. + allocate(useTime(self%primary%nitems),stat=status) + _VERIFY(STATUS) + + call MAPL_TimerOn(MAPLSTATE,"-Read_Loop") + + IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN + Write(*,*) 'ExtData Run_: Start' + Write(*,*) 'ExtData Run_: READ_LOOP: Start' + ENDIF + + READ_LOOP: do i = 1, self%primary%nItems + + item => self%primary%item(self%primaryOrder(i)) + + IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN + Write(*,*) ' ' + Write(*,'(a,I0.3,a,I0.3,a,a)') 'ExtData Run_: READ_LOOP: variable ', i, ' of ', self%primary%nItems, ': ', trim(item%var) + Write(*,*) ' ==> file: ', trim(item%file) + Write(*,*) ' ==> isConst: ', item%isConst + ENDIF + + if (item%isConst) then + IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN + Write(*,*) ' ==> Break loop since isConst is true' + ENDIF + cycle + endif + + call MAPL_TimerOn(MAPLSTATE,"--CheckUpd") + + call item%update_freq%check_update(doUpdate(i),time,time0,.not.hasRun,__RC__) + !doUpdate(i) = doUpdate_ .or. (.not.hasRun) + call MAPL_TimerOff(MAPLSTATE,"--CheckUpd") + + DO_UPDATE: if (doUpdate(i)) then + + call item%modelGridFields%comp1%reset() + call item%filestream%get_file_bracket(time,item%source_time, item%modelGridFields%comp1,__RC__) + call IOBundle_Add_Entry(IOBundles,item,self%primaryOrder(i)) + useTime(i)=time + + end if DO_UPDATE + + end do READ_LOOP + + IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN + Write(*,*) 'ExtData Run_: READ_LOOP: Done' + ENDIF + + bundle_iter = IOBundles%begin() + do while (bundle_iter /= IoBundles%end()) + io_bundle => bundle_iter%get() + bracket_side = io_bundle%bracket_side + entry_num = io_bundle%entry_index + file_Processed = io_bundle%file_name + item => self%primary%item(entry_num) + + io_bundle%pbundle = ESMF_FieldBundleCreate(rc=status) + _VERIFY(STATUS) + + call MAPL_ExtDataPopulateBundle(item,bracket_side,io_bundle%pbundle,rc=status) + _VERIFY(status) + call bundle_iter%next() + enddo + + call MAPL_TimerOn(MAPLSTATE,"--PRead") + call MAPL_TimerOn(MAPLSTATE,"---CreateCFIO") + call MAPL_ExtDataCreateCFIO(IOBundles, rc=status) + _VERIFY(status) + call MAPL_TimerOff(MAPLSTATE,"---CreateCFIO") + + call MAPL_TimerOn(MAPLSTATE,"---prefetch") + call MAPL_ExtDataPrefetch(IOBundles, rc=status) + _VERIFY(status) + call MAPL_TimerOff(MAPLSTATE,"---prefetch") + _VERIFY(STATUS) + call MAPL_TimerOn(MAPLSTATE,"---IclientDone") + + call i_Clients%done_collective_prefetch() + call i_Clients%wait() + + call MAPL_TimerOff(MAPLSTATE,"---IclientDone") + _VERIFY(STATUS) + + call MAPL_TimerOn(MAPLSTATE,"---read-prefetch") + call MAPL_ExtDataReadPrefetch(IOBundles,rc=status) + _VERIFY(status) + call MAPL_TimerOff(MAPLSTATE,"---read-prefetch") + call MAPL_TimerOff(MAPLSTATE,"--PRead") + + bundle_iter = IOBundles%begin() + do while (bundle_iter /= IOBundles%end()) + io_bundle => bundle_iter%get() + bracket_side = io_bundle%bracket_side + entry_num = io_bundle%entry_index + item => self%primary%item(entry_num) + call MAPL_ExtDataVerticalInterpolate(self,item,bracket_side,rc=status) + _VERIFY(status) + call bundle_iter%next() + enddo + call MAPL_ExtDataDestroyCFIO(IOBundles,rc=status) + _VERIFY(status) + + call MAPL_TimerOff(MAPLSTATE,"-Read_Loop") + + call MAPL_TimerOn(MAPLSTATE,"-Interpolate") + + IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN + Write(*,*) 'ExtData Run_: INTERP_LOOP: Start' + ENDIF + + INTERP_LOOP: do i = 1, self%primary%nItems + + item => self%primary%item(self%primaryOrder(i)) + + if (doUpdate(i)) then + + IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN + Write(*,*) ' ' + Write(*,'(a)') 'ExtData Run_: INTERP_LOOP: interpolating between bracket times' + Write(*,*) ' ==> variable: ', trim(item%var) + Write(*,*) ' ==> file: ', trim(item%file) + ENDIF + + ! finally interpolate between bracketing times + + call MAPL_ExtDataInterpField(item,self%ExtDataState,useTime(i),__RC__) + + endif + + nullify(item) + + end do INTERP_LOOP + + IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN + Write(*,*) 'ExtData Run_: INTERP_LOOP: Done' + ENDIF + + call MAPL_TimerOff(MAPLSTATE,"-Interpolate") + + ! now take care of derived fields + do i=1,self%derived%nItems + + derivedItem => self%derived%item(i) + + call derivedItem%update_freq%check_update(doUpdate_,time,time0,.not.hasRun,__RC__) + !doUpdate_ = doUpdate_ .or. (.not.hasRun) + + if (doUpdate_) then + + call CalcDerivedField(self%ExtDataState,derivedItem%name,derivedItem%expression, & + derivedItem%masking,__RC__) + + end if + + end do + + IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN + Write(*,*) 'ExtData Run_: End' + ENDIF + +! All done +! -------- + deallocate(doUpdate) + deallocate(useTime) + + if (hasRun .eqv. .false.) hasRun = .true. + call MAPL_TimerOff(MAPLSTATE,"Run") + call MAPL_TimerOff(MAPLSTATE,"TOTAL") + + _RETURN(ESMF_SUCCESS) + + END SUBROUTINE Run_ + +!------------------------------------------------------------------------- +! NASA/GSFC, Global Modeling and Assimilation Office, Code 610.1 ! +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Finalize_ --- Finalize MAPL_ExtData +! +! !INTERFACE: +! + + SUBROUTINE Finalize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) + +! !USES: + + implicit NONE + +! !INPUT PARAMETERS: + + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + +! !OUTPUT PARAMETERS: + + type(ESMF_GridComp), intent(inout) :: GC ! Grid Component + type(ESMF_State), intent(inout) :: IMPORT ! Import State + type(ESMF_State), intent(inout) :: EXPORT ! Export State + integer, intent(out) :: rc ! Error return code: + ! 0 - all is well + ! 1 - + +! !DESCRIPTION: This is a simple ESMF wrapper. +! +! !REVISION HISTORY: +! +! 12Dec2009 da Silva Design and first implementation. +! +!EOP +!------------------------------------------------------------------------- + + type(MAPL_ExtData_state), pointer :: self ! Legacy state + type(ESMF_Config) :: CF ! Universal Config + + character(len=ESMF_MAXSTR) :: comp_name + character(len=ESMF_MAXSTR) :: Iam + integer :: status + + +! Get my name and set-up traceback handle +! --------------------------------------- + Iam = 'Finalize_' + call ESMF_GridCompGet( GC, name=comp_name, __RC__ ) + Iam = trim(comp_name) // trim(Iam) + +! Finalize MAPL Generic +! --------------------- + call MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, __RC__ ) + +! Extract relevant runtime information +! ------------------------------------ + call extract_ ( GC, self, CF, __RC__) + +! Free the memory used to hold the primary export items +! ----------------------------------------------------- + if (associated(self%primary%item)) then + deallocate(self%primary%item) + end if + + +! All done +! -------- + _RETURN(ESMF_SUCCESS) + + end SUBROUTINE Finalize_ + +!....................................................................... + + subroutine extract_ ( GC, self, CF, rc) + + type(ESMF_GridComp), intent(INout) :: GC ! Grid Comp object + + type(MAPL_ExtData_state), pointer :: self ! Legacy state + type(ESMF_Config), intent(out) :: CF ! Universal Config + + integer, intent(out), optional :: rc + +! --- + + character(len=ESMF_MAXSTR) :: comp_name + character(len=ESMF_MAXSTR) :: Iam + integer :: status + + type(MAPL_ExtData_Wrap) :: wrap + +! Get my name and set-up traceback handle +! --------------------------------------- + Iam = 'extract_' + call ESMF_GridCompGet( GC, NAME=comp_name, __RC__ ) + Iam = trim(COMP_NAME) // '::' // trim(Iam) + + If (present(rc)) rc=ESMF_SUCCESS + +! Get my internal state +! --------------------- + call ESMF_UserCompGetInternalState(gc, 'MAPL_ExtData_state', WRAP, STATUS) + _VERIFY(STATUS) + self => wrap%ptr + +! Get the configuration +! --------------------- + call ESMF_GridCompGet ( GC, config=CF, __RC__ ) + + + _RETURN(ESMF_SUCCESS) + + end subroutine extract_ + +! ............................................................................ + + logical function PrimaryExportIsConstant_(item) + + type(PrimaryExport), intent(in) :: item + + if ( item%update_freq%is_single_shot() .or. & + trim(item%file) == '/dev/null' ) then + PrimaryExportIsConstant_ = .true. + else + PrimaryExportIsConstant_ = .false. + end if + + end function PrimaryExportIsConstant_ + +! ............................................................................ + + logical function DerivedExportIsConstant_(item) + + type(DerivedExport), intent(in) :: item + + if ( item%update_freq%is_disabled() ) then + DerivedExportIsConstant_ = .true. + else + DerivedExportIsConstant_ = .false. + end if + + end function DerivedExportIsConstant_ + + ! ............................................................................ + + type (ESMF_Time) function timestamp_(time, template, rc) + type(ESMF_Time), intent(inout) :: time + character(len=ESMF_MAXSTR), intent(in) :: template + integer, optional, intent(inout) :: rc + + ! locals + integer, parameter :: DATETIME_MAXSTR_ = 32 + integer :: yy, mm, dd, hs, ms, ss + character(len=DATETIME_MAXSTR_) :: buff, buff_date, buff_time + character(len=DATETIME_MAXSTR_) :: str_yy, str_mm, str_dd + character(len=DATETIME_MAXSTR_) :: str_hs, str_ms, str_ss + + integer :: i, il, ir + integer :: status + + ! test the length of the timestamp template + _ASSERT(len_trim(template) < DATETIME_MAXSTR_,'Timestamp template is greater than Maximum allowed len') + + buff = trim(template) + buff = ESMF_UtilStringLowerCase(buff, __RC__) + + ! test if the template is empty and return the current time as result + if (buff == '-' .or. buff == '--' .or. buff == '---' .or. & + buff == 'na' .or. buff == 'none' .or. buff == 'n/a') then + + timestamp_ = time + else + ! split the time stamp template into a date and time strings + i = scan(buff, 't') + If (.not.(i > 3)) Then + _ASSERT(.False.,'ERROR: Time stamp ' // trim(template) // ' uses the fixed format, and must therefore contain a T') + End If + + buff_date = buff(1:i-1) + buff_time = buff(i+1:) + + ! parse the date string + il = scan(buff_date, '-', back=.false.) + ir = scan(buff_date, '-', back=.true. ) + str_yy = trim(buff_date(1:il-1)) + str_mm = trim(buff_date(il+1:ir-1)) + str_dd = trim(buff_date(ir+1:)) + + ! parse the time string + il = scan(buff_time, ':', back=.false.) + ir = scan(buff_time, ':', back=.true. ) + str_hs = trim(buff_time(1:il-1)) + str_ms = trim(buff_time(il+1:ir-1)) + str_ss = trim(buff_time(ir+1:)) + + ! remove the trailing 'Z' from the seconds string + i = scan(str_ss, 'z') + if (i > 0) then + str_ss = trim(str_ss(1:i-1)) + end if + + ! apply the timestamp template + call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=hs, m=ms, s=ss, __RC__) + + i = scan(str_yy, '%'); if (i == 0) read (str_yy, '(I4)') yy + i = scan(str_mm, '%'); if (i == 0) read (str_mm, '(I2)') mm + i = scan(str_dd, '%'); if (i == 0) read (str_dd, '(I2)') dd + i = scan(str_hs, '%'); if (i == 0) read (str_hs, '(I2)') hs + i = scan(str_ms, '%'); if (i == 0) read (str_ms, '(I2)') ms + i = scan(str_ss, '%'); if (i == 0) read (str_ss, '(I2)') ss + + call ESMF_TimeSet(timestamp_, yy=yy, mm=mm, dd=dd, h=hs, m=ms, s=ss, __RC__) + end if + + _RETURN(ESMF_SUCCESS) + + end function timestamp_ + + subroutine GetLevs(item, rc) + + type(PrimaryExport) , intent(inout) :: item + integer, optional , intent(out ) :: rc + + integer :: status + + real, allocatable :: levFile(:) + character(len=ESMF_MAXSTR) :: levunits,tlevunits + character(len=:), allocatable :: levname + character(len=:), pointer :: positive + type(Variable), pointer :: var + integer :: i + + positive=>null() + var => null() + if (item%isVector) then + var=>item%file_metadata%get_variable(trim(item%fcomp1)) + _ASSERT(associated(var),"Variable "//TRIM(item%fcomp1)//" not found in file "//TRIM(item%file)) + var => null() + var=>item%file_metadata%get_variable(trim(item%fcomp2)) + _ASSERT(associated(var),"Variable "//TRIM(item%fcomp2)//" not found in file "//TRIM(item%file)) + else + var=>item%file_metadata%get_variable(trim(item%var)) + _ASSERT(associated(var),"Variable "//TRIM(item%var)//" not found in file "//TRIM(item%file)) + end if + + levName = item%file_metadata%get_level_name(rc=status) + _VERIFY(status) + if (trim(levName) /='') then + call item%file_metadata%get_coordinate_info(levName,coordSize=item%lm,coordUnits=tLevUnits,coords=levFile,__RC__) + levUnits=MAPL_TrimString(tlevUnits) + ! check if pressure + item%levUnit = ESMF_UtilStringLowerCase(levUnits) + if (trim(item%levUnit) == 'hpa' .or. trim(item%levUnit)=='pa') then + item%havePressure = .true. + end if + if (item%havePressure) then + if (levFile(1)>levFile(size(levFile))) item%fileVDir="up" + else + positive => item%file_metadata%get_variable_attribute(levName,'positive',__RC__) + if (associated(positive)) then + if (MAPL_TrimString(positive)=='up') item%fileVDir="up" + end if + end if + + allocate(item%levs(item%lm),__STAT__) + item%levs=levFile + if (trim(item%fileVDir)/=trim(item%importVDir)) then + do i=1,size(levFile) + item%levs(i)=levFile(size(levFile)-i+1) + enddo + end if + if (trim(item%levunit)=='hpa') item%levs=item%levs*100.0 + if (item%isVector) then + item%units = item%file_metadata%get_variable_attribute(trim(item%fcomp1),"units",rc=status) + _VERIFY(status) + else + item%units = item%file_metadata%get_variable_attribute(trim(item%var),"units",rc=status) + _VERIFY(status) + end if + + else + item%LM=0 + end if + + _RETURN(ESMF_SUCCESS) + + end subroutine GetLevs + + subroutine CalcDerivedField(state,exportName,exportExpr,masking,rc) + type(ESMF_State), intent(inout) :: state + character(len=*), intent(in ) :: exportName + character(len=*), intent(in ) :: exportExpr + logical, intent(in ) :: masking + integer, optional, intent(out ) :: rc + + integer :: status + + type(ESMF_Field) :: field + + if (masking) then + call MAPL_ExtDataEvaluateMask(state,exportName,exportExpr,__RC__) + else + call ESMF_StateGet(state,exportName,field,__RC__) + call MAPL_StateEval(state,exportExpr,field,__RC__) + end if + _RETURN(ESMF_SUCCESS) + end subroutine CalcDerivedField + + subroutine MAPL_ExtDataInterpField(item,state,time,rc) + type(PrimaryExport), intent(inout) :: item + type(ESMF_State), intent(in) :: state + type(ESMF_Time), intent(in ) :: time + integer, optional, intent(out ) :: rc + + integer :: status + type(ESMF_Field) :: field + + call ESMF_StateGet(state,item%vcomp1,field,__RC__) + call item%modelGridFields%comp1%interpolate_to_time(field,time,__RC__) + if (item%vartype == MAPL_VectorField) then + call ESMF_StateGet(state,item%vcomp1,field,__RC__) + call item%modelGridFields%comp2%interpolate_to_time(field,time,__RC__) + end if + _RETURN(ESMF_SUCCESS) + end subroutine MAPL_ExtDataInterpField + + subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,rc) + type(MAPL_ExtData_State), intent(inout) :: ExtState + type(PrimaryExport), intent(inout) :: item + integer, intent(in ) :: filec + integer, optional, intent(out ) :: rc + + integer :: status + integer :: id_ps + type(ESMF_Field) :: field, newfield,psF + + if (item%do_VertInterp) then + if (trim(item%importVDir)/=trim(item%fileVDir)) then + call MAPL_ExtDataFlipVertical(item,filec,rc=status) + _VERIFY(status) + end if + if (item%vartype == MAPL_fieldItem) then + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,rc=status) + _VERIFY(STATUS) + call MAPL_ExtDataGetBracket(item,filec,Field,rc=status) + _VERIFY(STATUS) + id_ps = ExtState%primaryOrder(1) + call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,rc=status) + _VERIFY(STATUS) + call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,rc=status) + _VERIFY(STATUS) + + else if (item%vartype == MAPL_VectorField) then + + id_ps = ExtState%primaryOrder(1) + call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,rc=status) + _VERIFY(STATUS) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,rc=status) + _VERIFY(STATUS) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,rc=status) + _VERIFY(STATUS) + call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,rc=status) + _VERIFY(STATUS) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,rc=status) + _VERIFY(STATUS) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,rc=status) + _VERIFY(STATUS) + call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,rc=status) + _VERIFY(STATUS) + + end if + + else if (item%do_Fill) then + if (item%vartype == MAPL_fieldItem) then + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,rc=status) + _VERIFY(STATUS) + call MAPL_ExtDataGetBracket(item,filec,Field,rc=status) + _VERIFY(STATUS) + call MAPL_ExtDataFillField(item,field,newfield,rc=status) + _VERIFY(STATUS) + else if (item%vartype == MAPL_VectorField) then + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,rc=status) + _VERIFY(STATUS) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,rc=status) + _VERIFY(STATUS) + call MAPL_ExtDataFillField(item,field,newfield,rc=status) + _VERIFY(STATUS) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,rc=status) + _VERIFY(STATUS) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,rc=status) + _VERIFY(STATUS) + call MAPL_ExtDataFillField(item,field,newfield,rc=status) + _VERIFY(STATUS) + end if + else + if (trim(item%importVDir)/=trim(item%fileVDir)) then + call MAPL_ExtDataFlipVertical(item,filec,rc=status) + _VERIFY(status) + end if + end if + + _RETURN(ESMF_SUCCESS) + end subroutine MAPL_ExtDataVerticalInterpolate + + subroutine GetMaskName(FuncStr,Var,Needed,rc) + character(len=*), intent(in) :: FuncStr + character(len=*), intent(in) :: Var(:) + logical, intent(inout) :: needed(:) + integer, optional, intent(out) :: rc + + integer :: status + integer :: i1,i2,i,ivar + logical :: found,twovar + character(len=ESMF_MAXSTR) :: tmpstring,tmpstring1,tmpstring2,functionname + + i1 = index(Funcstr,"(") + _ASSERT(i1 > 0,'Incorrect format for function expression: missing "("') + functionname = adjustl(Funcstr(:i1-1)) + functionname = ESMF_UtilStringLowerCase(functionname, __RC__) + if (trim(functionname) == "regionmask") twovar = .true. + if (trim(functionname) == "zonemask") twovar = .false. + if (trim(functionname) == "boxmask") twovar = .false. + tmpstring = adjustl(Funcstr(i1+1:)) + i1 = index(tmpstring,",") + _ASSERT(i1 > 0,'Incorrect format for function expression: missing ","') + i2 = index(tmpstring,";") + if (twovar) then + tmpstring1 = adjustl(tmpstring(1:i1-1)) + tmpstring2 = adjustl(tmpstring(i1+1:i2-1)) + else + tmpstring1 = adjustl(tmpstring(1:i1-1)) + end if + + found = .false. + do i=1,size(var) + if ( trim(tmpstring1) == trim(var(i)) ) then + ivar = i + found = .true. + exit + end if + end do + _ASSERT(found,'Var ' // trim(tmpstring1) // ' not found') + needed(ivar) = .true. + + if (twovar) then + found = .false. + do i=1,size(var) + if ( trim(tmpstring2) == trim(var(i)) ) then + ivar = i + found = .true. + exit + end if + end do + _ASSERT(found,'Secound Var ' // trim(tmpstring2) // ' not found') + needed(ivar) = .true. + end if + _RETURN(ESMF_SUCCESS) + end subroutine GetMaskName + + subroutine MAPL_ExtDataEvaluateMask(state,exportName,exportExpr,rc) + + type(ESMF_STATE), intent(inout) :: state + character(len=*), intent(in) :: exportName + character(len=*), intent(in) :: exportExpr + integer, optional, intent(out) :: rc + + integer :: status + + integer :: k,i + character(len=ESMF_MAXSTR) :: maskString,maskname,vartomask,functionname,clatS,clatN + character(len=ESMF_MAXSTR) :: strtmp + integer, allocatable :: regionNumbers(:), flag(:) + integer, allocatable :: mask(:,:) + real, pointer :: rmask(:,:) => null() + real, pointer :: rvar2d(:,:) => null() + real, pointer :: rvar3d(:,:,:) => null() + real, pointer :: var2d(:,:) => null() + real, pointer :: var3d(:,:,:) => null() + real(REAL64), pointer :: lats(:,:) => null() + real(REAL64), pointer :: lons(:,:) => null() + real(REAL64) :: limitS, limitN, limitE, limitW + real(REAL64) :: limitE1, limitW1 + real(REAL64) :: limitE2, limitW2 + type(ESMF_Field) :: field + type(ESMF_Grid) :: grid + integer :: rank,ib,ie,is,i1,nargs + integer :: counts(3) + logical :: isCube, twoBox + real, allocatable :: temp2d(:,:) + character(len=ESMF_MAXSTR) :: args(5) + + call ESMF_StateGet(state,exportName,field,__RC__) + call ESMF_FieldGet(field,rank=rank,grid=grid,__RC__) + i1 = index(exportExpr,"(") + _ASSERT(i1 > 0,'Expected "(" in expression: ' // trim(exportExpr)) + functionname = adjustl(exportExpr(:i1-1)) + functionname = ESMF_UtilStringLowerCase(functionname, __RC__) + + if (trim(functionname) == "regionmask") then + ! get mask string + ib = index(exportExpr,";") + ie = index(exportExpr,")") + maskString = trim(exportExpr(ib+1:ie-1)) + ! get mask name + ie = index(exportExpr,";") + is = index(exportExpr,"(") + ib = index(exportExpr,",") + vartomask = trim(exportExpr(is+1:ib-1)) + maskname = trim(exportExpr(ib+1:ie-1)) + call MAPL_GetPointer(state,rmask,maskName,__RC__) + if (rank == 2) then + call MAPL_GetPointer(state,rvar2d,vartomask,__RC__) + call MAPL_GetPointer(state,var2d,exportName,__RC__) + else if (rank == 3) then + call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) + call MAPL_GetPointer(state,var3d,exportName,__RC__) + else + _ASSERT(.false.,'Rank must be 2 or 3') + end if + + k=32 + allocate(regionNumbers(k), flag(k), stat=status) + _VERIFY(STATUS) + regionNumbers = 0 + call MAPL_ExtDataExtractIntegers(maskString,k,regionNumbers,rc=status) + _VERIFY(STATUS) + flag(:) = 1 + WHERE(regionNumbers(:) == 0) flag(:) = 0 + k = SUM(flag) + deallocate(flag,stat=status) + _VERIFY(STATUS) + + ! Set local mask to 1 where gridMask matches each integer (within precision!) + ! --------------------------------------------------------------------------- + allocate(mask(size(rmask,1),size(rmask,2)),stat=status) + _VERIFY(STATUS) + mask = 0 + DO i=1,k + WHERE(regionNumbers(i)-0.01 <= rmask .AND. & + rmask <= regionNumbers(i)+0.01) mask = 1 + END DO + + if (rank == 2) then + var2d = rvar2d + where(mask == 0) var2d = 0.0 + else if (rank == 3) then + var3d = rvar3d + do i=1,size(var3d,3) + where(mask == 0) var3d(:,:,i) = 0.0 + enddo + end if + deallocate( mask) + elseif(trim(functionname) == "zonemask") then + + ib = index(exportExpr,"(") + ie = index(exportExpr,",") + vartomask = trim(exportExpr(ib+1:ie-1)) + ib = index(exportExpr,",") + is = index(exportExpr,",",back=.true.) + ie = index(exportExpr,")") + clatS = trim(exportExpr(ib+1:is-1)) + clatN = trim(exportExpr(is+1:ie-1)) + READ(clatS,*,IOSTAT=status) limitS + _VERIFY(status) + READ(clatN,*,IOSTAT=status) limitN + _VERIFY(status) + + call ESMF_GridGetCoord(grid, coordDim=2, localDE=0, & + staggerloc=ESMF_STAGGERLOC_CENTER, farrayPtr=lats, rc=status) + _VERIFY(status) + limitN=limitN*MAPL_PI_R8/180.0d0 + limitS=limitS*MAPL_PI_R8/180.0d0 + + if (rank == 2) then + call MAPL_GetPointer(state,rvar2d,vartomask,__RC__) + call MAPL_GetPointer(state,var2d,exportName,__RC__) + else if (rank == 3) then + call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) + call MAPL_GetPointer(state,var3d,exportName,__RC__) + else + _ASSERT(.false.,'Rank must be 2 or 3') + end if + + if (rank == 2) then + var2d = 0.0 + where(limitS <= lats .and. lats <=limitN) var2d = rvar2d + else if (rank == 3) then + var3d = 0.0 + do i=1,size(var3d,3) + where(limitS <= lats .and. lats <=limitN) var3d(:,:,i) = rvar3d(:,:,i) + enddo + end if + + elseif(trim(functionname) == "boxmask") then + is=index(exportExpr,'(') + ie=index(exportExpr,')') + strtmp = exportExpr(is+1:ie-1) + do nargs=1,5 + is = index(strtmp,',') + if (is >0) then + args(nargs) = strtmp(:is-1) + else + args(nargs) = strtmp + end if + strtmp = strtmp(is+1:) + end do + + varToMask=args(1) + + READ(args(2),*,IOSTAT=status) limitS + _VERIFY(status) + READ(args(3),*,IOSTAT=status) limitN + _VERIFY(status) + READ(args(4),*,IOSTAT=status) limitW + _VERIFY(status) + READ(args(5),*,IOSTAT=status) limitE + _VERIFY(status) + _ASSERT(limitE > limitW,'LimitE must be greater than limitW') + _ASSERT(limitE /= limitW,'LimitE cannot equal limitW') + _ASSERT(limitN /= limitS,'LimitN cannot equal LimitS') + _ASSERT((limitE-limitW)<=360.0d0,'(LimitE - LimitW) must be less than or equal to 360') + + call ESMF_GridGetCoord(grid, coordDim=1, localDE=0, & + staggerloc=ESMF_STAGGERLOC_CENTER, farrayPtr=lons, rc=status) + _VERIFY(status) + call ESMF_GridGetCoord(grid, coordDim=2, localDE=0, & + staggerloc=ESMF_STAGGERLOC_CENTER, farrayPtr=lats, rc=status) + _VERIFY(status) + + ! do some tests if cube goes from 0 to 360, lat-lon -180 to 180 + call MAPL_GridGet(grid, globalCellCountPerDim=COUNTS,rc=status) + _VERIFY(STATUS) + if (counts(2)==6*counts(1)) then + isCube=.true. + else + isCube=.false. + end if + + twoBox = .false. + if (isCube) then + if (limitW < 0.0d0 .and. limitE >=0.0d0) then + ! need two boxes + twoBox=.true. + limitW1=0.0d0 + limitE1=limitE + limitW2=limitW+360.0d0 + limitE2=360.0d0 + + else if (limitW <0.0d0 .and. limitE <0.0d0) then + ! just shift + limitW1=limitW+360.d0 + limitE1=limitE+360.d0 + + else + ! normal case + limitW1=limitW + limitE1=limitE + end if + + else + + if (limitW <= 180.0d0 .and. limitE > 180.0d0) then + ! need two boxes + twoBox=.true. + limitW1=limitW + limitE1=180.0d0 + limitW2=-180.d0 + limitE2=limitE-360.0d0 + else if (limitW > 180.0d0 .and. limitE > 180.0d0) then + ! just shift + limitW1=limitW-360.d0 + limitE1=limitE-360.d0 + else + ! normal case + limitW1=limitW + limitE1=limitE + end if + + end if + + limitE1=limitE1*MAPL_PI_R8/180.0d0 + limitW1=limitW1*MAPL_PI_R8/180.0d0 + limitE2=limitE2*MAPL_PI_R8/180.0d0 + limitW2=limitW2*MAPL_PI_R8/180.0d0 + + limitN=limitN*MAPL_PI_R8/180.0d0 + limitS=limitS*MAPL_PI_R8/180.0d0 + if (rank == 2) then + call MAPL_GetPointer(state,rvar2d,vartomask,__RC__) + call MAPL_GetPointer(state,var2d,exportName,__RC__) + else if (rank == 3) then + call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) + call MAPL_GetPointer(state,var3d,exportName,__RC__) + else + _ASSERT(.false.,'Rank must be 2 or 3') + end if + + if (rank == 2) then + var2d = 0.0 + where(limitS <= lats .and. lats <=limitN .and. limitW1 <= lons .and. lons <= limitE1 ) var2d = rvar2d + else if (rank == 3) then + var3d = 0.0 + do i=1,size(var3d,3) + where(limitS <= lats .and. lats <=limitN .and. limitW1 <= lons .and. lons <= limitE1 ) var3d(:,:,i) = rvar3d(:,:,i) + enddo + end if + + if (twoBox) then + allocate(temp2d(size(var2d,1),size(var2d,2)),stat=status) + _VERIFY(STATUS) + if (rank == 2) then + temp2d = 0.0 + where(limitS <= lats .and. lats <=limitN .and. limitW2 <= lons .and. lons <= limitE2 ) temp2d = rvar2d + var2d=var2d+temp2d + else if (rank == 3) then + do i=1,size(var3d,3) + temp2d = 0.0 + where(limitS <= lats .and. lats <=limitN .and. limitW2 <= lons .and. lons <= limitE2 ) temp2d = rvar3d(:,:,i) + var3d(:,:,i)=var3d(:,:,i)+temp2d + enddo + end if + deallocate(temp2d) + end if + + end if + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_ExtDataEvaluateMask + + SUBROUTINE MAPL_ExtDataExtractIntegers(string,iSize,iValues,delimiter,verbose,rc) + +! !USES: + + IMPLICIT NONE + +! !INPUT/OUTPUT PARAMETERS: + + CHARACTER(LEN=*), INTENT(IN) :: string ! Character-delimited string of integers + INTEGER, INTENT(IN) :: iSize + INTEGER, INTENT(INOUT) :: iValues(iSize)! Space allocated for extracted integers + CHARACTER(LEN=*), OPTIONAL :: delimiter ! 1-character delimiter + LOGICAL, OPTIONAL, INTENT(IN) :: verbose ! Let me know iValues as they are found. + ! DEBUG directive turns on the message even + ! if verbose is not present or if + ! verbose = .FALSE. + INTEGER, OPTIONAL, INTENT(OUT) :: rc ! Return code +! !DESCRIPTION: +! +! Extract integers from a character-delimited string, for example, "-1,45,256,7,10". In the context +! of Chem_Util, this is provided for determining the numerically indexed regions over which an +! emission might be applied. +! +! In multiple passes, the string is parsed for the delimiter, and the characters up to, but not +! including the delimiter are taken as consecutive digits of an integer. A negative sign ("-") is +! allowed. After the first pass, each integer and its trailing delimiter are lopped of the head of +! the (local copy of the) string, and the process is started over. +! +! The default delimiter is a comma (","). +! +! "Unfilled" iValues are zero. +! +! Return codes: +! 1 Zero-length string. +! 2 iSize needs to be increased. +! +! Assumptions/bugs: +! +! A non-zero return code does not stop execution. +! Allowed numerals are: 0,1,2,3,4,5,6,7,8,9. +! A delimiter must be separated from another delimiter by at least one numeral. +! The delimiter cannot be a numeral or a negative sign. +! The character following a negative sign must be an allowed numeral. +! The first character must be an allowed numeral or a negative sign. +! The last character must be an allowed numeral. +! The blank character (" ") cannot serve as a delimiter. +! +! Examples of strings that will work: +! "1" +! "-1" +! "-1,2004,-3" +! "1+-2+3" +! "-1A100A5" +! Examples of strings that will not work: +! "1,--2,3" +! "1,,2,3" +! "1,A,3" +! "1,-,2" +! "1,2,3,4," +! "+1" +! "1 3 6" +! +! !REVISION HISTORY: +! +! Taken from chem utilities. +! +!EOP + CHARACTER(LEN=*), PARAMETER :: Iam = 'Chem_UtilExtractIntegers' + + INTEGER :: base,count,i,iDash,last,lenStr + INTEGER :: multiplier,pos,posDelim,sign + CHARACTER(LEN=255) :: str + CHARACTER(LEN=1) :: char,delimChar + LOGICAL :: Done + LOGICAL :: tellMe + +! Initializations +! --------------- + If (present(rc)) rc=0 + count = 1 + Done = .FALSE. + iValues(:) = 0 + base = ICHAR("0") + iDash = ICHAR("-") + +! Determine verbosity, letting the DEBUG +! directive override local specification +! -------------------------------------- + tellMe = .FALSE. + IF(PRESENT(verbose)) THEN + IF(verbose) tellMe = .TRUE. + END IF +#ifdef DEBUG + tellMe = .TRUE. +#endif +! Check for zero-length string +! ---------------------------- + lenStr = LEN_TRIM(string) + IF(lenStr == 0) THEN + If (present(rc)) rc=1 + PRINT *,trim(IAm),": ERROR - Found zero-length string." + RETURN + END IF + +! Default delimiter is a comma +! ---------------------------- + delimChar = "," + IF(PRESENT(delimiter)) delimChar(1:1) = delimiter(1:1) + +! Work on a local copy +! -------------------- + str = TRIM(string) + +! One pass for each delimited integer +! ----------------------------------- + Parse: DO + + lenStr = LEN_TRIM(str) + +! Parse the string for the delimiter +! ---------------------------------- + posDelim = INDEX(TRIM(str),TRIM(delimChar)) + IF(tellMe) PRINT *,trim(Iam),": Input string is >",TRIM(string),"<" + +! If the delimiter does not exist, +! one integer remains to be extracted. +! ------------------------------------ + IF(posDelim == 0) THEN + Done = .TRUE. + last = lenStr + ELSE + last = posDelim-1 + END IF + multiplier = 10**last + +! Examine the characters of this integer +! -------------------------------------- + Extract: DO pos=1,last + + char = str(pos:pos) + i = ICHAR(char) + +! Account for a leading "-" +! ------------------------- + IF(pos == 1) THEN + IF(i == iDash) THEN + sign = -1 + ELSE + sign = 1 + END IF + END IF + +! "Power" of 10 for this character +! -------------------------------- + multiplier = multiplier/10 + + IF(pos == 1 .AND. sign == -1) CYCLE Extract + +! Integer comes from remaining characters +! --------------------------------------- + i = (i-base)*multiplier + iValues(count) = iValues(count)+i + IF(pos == last) THEN + iValues(count) = iValues(count)*sign + IF(tellMe) PRINT *,trim(Iam),":Integer number ",count," is ",iValues(count) + END IF + + END DO Extract + + IF(Done) EXIT + +! Lop off the leading integer and try again +! ----------------------------------------- + str(1:lenStr-posDelim) = str(posDelim+1:lenStr) + str(lenStr-posDelim+1:255) = " " + count = count+1 + +! Check size +! ---------- + IF(count > iSize) THEN + If (present(rc)) rc=2 + PRINT *,trim(Iam),": ERROR - iValues does not have enough elements." + END IF + + END DO Parse + + _RETURN(ESMF_SUCCESS) + + END SUBROUTINE MAPL_ExtDataExtractIntegers + + function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) + + type(ESMF_Grid), intent(inout) :: Grid + type(ESMF_Config), intent(inout) :: CF + integer, intent(in) :: lm + integer, optional, intent(out) :: rc + + integer :: status + character(len=ESMF_MAXSTR) :: Iam + + character(len=ESMF_MAXSTR) :: gname, comp_name + integer :: counts(3) + integer :: NX,NY + type(ESMF_Grid) :: newGrid + type(ESMF_Config) :: cflocal + character(len=*), parameter :: CF_COMPONENT_SEPARATOR = '.' + real :: temp_real + + IAM = "MAPL_ExtDataGridChangeLev" + + call MAPL_GridGet(grid,globalCellCountPerDim=counts,__RC__) + call ESMF_GridGet(grid,name=gName,__RC__) + call ESMF_ConfigGetAttribute(CF, value = NX, Label="NX:", __RC__) + call ESMF_ConfigGetAttribute(CF, value = NY, Label="NY:", __RC__) + + comp_name = "ExtData" + cflocal = MAPL_ConfigCreate(rc=status) + _VERIFY(status) + call MAPL_ConfigSetAttribute(cflocal,value=NX, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NX:",rc=status) + _VERIFY(status) + call MAPL_ConfigSetAttribute(cflocal,value=lm, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"LM:",rc=status) + _VERIFY(status) + + if (counts(2) == 6*counts(1)) then + call MAPL_ConfigSetAttribute(cflocal,value="Cubed-Sphere", label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRID_TYPE:",rc=status) + _VERIFY(status) + call MAPL_ConfigSetAttribute(cflocal,value=6, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NF:",rc=status) + _VERIFY(status) + call MAPL_ConfigSetAttribute(cflocal,value=counts(1), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"IM_WORLD:",rc=status) + _VERIFY(status) + call MAPL_ConfigSetAttribute(cflocal,value=ny/6, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NY:",rc=status) + _VERIFY(status) + call MAPL_ConfigSetAttribute(cflocal,value=trim(gname), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRIDNAME:",rc=status) + _VERIFY(status) + call ESMF_AttributeGet(grid, name='STRETCH_FACTOR', value=temp_real, rc=status) + if (status == ESMF_SUCCESS) then + call MAPL_ConfigSetAttribute(cflocal,value=temp_real, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"STRETCH_FACTOR:",rc=status) + _VERIFY(status) + endif + call ESMF_AttributeGet(grid, name='TARGET_LON', value=temp_real, rc=status) + if (status == ESMF_SUCCESS) then + call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"TARGET_LON:",rc=status) + _VERIFY(status) + endif + call ESMF_AttributeGet(grid, name='TARGET_LAT', value=temp_real, rc=status) + if (status == ESMF_SUCCESS) then + call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"TARGET_LAT:",rc=status) + _VERIFY(status) + endif + else + call MAPL_ConfigSetAttribute(cflocal,value=counts(1), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"IM_WORLD:",rc=status) + _VERIFY(status) + call MAPL_ConfigSetAttribute(cflocal,value=counts(2), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"JM_WORLD:",rc=status) + _VERIFY(status) + call MAPL_ConfigSetAttribute(cflocal,value=ny, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"NY:",rc=status) + _VERIFY(status) + call MAPL_ConfigSetAttribute(cflocal,value=trim(gname), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRIDNAME:",rc=status) + _VERIFY(status) + end if + newgrid = grid_manager%make_grid(cflocal, prefix=trim(COMP_Name)//".", rc=status) + _VERIFY(status) + + _RETURN(ESMF_SUCCESS) + + end function MAPL_ExtDataGridChangeLev + + subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) + + type(PrimaryExport), intent(inout) :: item + integer, intent(in ) :: bside + type(ESMF_Field), optional, intent(inout) :: field + type(ESMF_FieldBundle), optional, intent(inout) :: bundle + logical, optional, intent(in ) :: getRL + integer, optional, intent(in ) :: vcomp + integer, optional, intent(out ) :: rc + + character(len=ESMF_MAXSTR) :: Iam + integer :: status + + logical :: getRL_ + + Iam = "MAPL_ExtDataGetBracket" + + if (present(getRL)) then + getRL_=getRL + else + getRL_=.false. + end if + + if (present(vcomp)) then + + if (present(field)) then + + if (Bside == MAPL_ExtDataLeft .and. vcomp == 1) then + if (getRL_) then + call item%modelGridFields%auxiliary1%get_parameters('L',field=field,__RC__) + _RETURN(ESMF_SUCCESS) + else + call item%modelGridFields%comp1%get_parameters('L',field=field,__RC__) + _RETURN(ESMF_SUCCESS) + end if + else if (Bside == MAPL_ExtDataLeft .and. vcomp == 2) then + if (getRL_) then + call item%modelGridFields%auxiliary2%get_parameters('L',field=field,__RC__) + _RETURN(ESMF_SUCCESS) + else + call item%modelGridFields%comp2%get_parameters('L',field=field,__RC__) + _RETURN(ESMF_SUCCESS) + end if + else if (Bside == MAPL_ExtDataRight .and. vcomp == 1) then + if (getRL_) then + call item%modelGridFields%auxiliary1%get_parameters('R',field=field,__RC__) + _RETURN(ESMF_SUCCESS) + else + call item%modelGridFields%comp1%get_parameters('R',field=field,__RC__) + _RETURN(ESMF_SUCCESS) + end if + else if (Bside == MAPL_ExtDataRight .and. vcomp == 2) then + if (getRL_) then + call item%modelGridFields%auxiliary2%get_parameters('R',field=field,__RC__) + _RETURN(ESMF_SUCCESS) + else + call item%modelGridFields%comp2%get_parameters('R',field=field,__RC__) + _RETURN(ESMF_SUCCESS) + end if + end if + + else if (present(bundle)) then + _RETURN(ESMF_FAILURE) + end if + + else + + if (present(field)) then + if (Bside == MAPL_ExtDataLeft) then + if (getRL_) then + call item%modelGridFields%auxiliary1%get_parameters('L',field=field,__RC__) + _RETURN(ESMF_SUCCESS) + else + call item%modelGridFields%comp1%get_parameters('L',field=field,__RC__) + _RETURN(ESMF_SUCCESS) + end if + else if (Bside == MAPL_ExtDataRight) then + if (getRL_) then + call item%modelGridFields%auxiliary1%get_parameters('R',field=field,__RC__) + _RETURN(ESMF_SUCCESS) + else + call item%modelGridFields%comp1%get_parameters('R',field=field,__RC__) + _RETURN(ESMF_SUCCESS) + end if + end if + else if (present(bundle)) then + !if (Bside == MAPL_ExtDataLeft) then + !bundle = item%binterp1 + !_RETURN(ESMF_SUCCESS) + !else if (Bside == MAPL_ExtDataRight) then + !bundle = item%binterp2 + !_RETURN(ESMF_SUCCESS) + !end if + + end if + + end if + _RETURN(ESMF_FAILURE) + + end subroutine MAPL_ExtDataGetBracket + + subroutine MAPL_ExtDataFillField(item,FieldF,FieldR,rc) + + type(PrimaryExport), intent(inout) :: item + type(ESMF_Field), intent(inout) :: FieldF + type(ESMF_Field), intent(inout) :: FieldR + integer, optional, intent(out) :: rc + + character(len=ESMF_MAXSTR) :: Iam + integer :: status + + real, pointer :: ptrF(:,:,:),ptrR(:,:,:) + integer :: lm_in,lm_out,i + + Iam = "MAPL_ExtDataFillField" + + call ESMF_FieldGet(FieldF,0,farrayPtr=ptrF,rc=status) + _VERIFY(STATUS) + call ESMF_FieldGet(FieldR,0,farrayPtr=ptrR,rc=status) + _VERIFY(STATUS) + ptrF = 0.0 + lm_in= size(ptrR,3) + lm_out = size(ptrF,3) + if (trim(item%importVDir)=="down") then + + if (trim(item%fileVDir)=="down") then + do i=1,lm_in + ptrF(:,:,lm_out-lm_in+i)=ptrR(:,:,i) + enddo + else if (trim(item%fileVDir)=="up") then + do i=1,lm_in + ptrF(:,:,lm_out-i+1)=ptrR(:,:,i) + enddo + end if + else if (trim(item%importVDir)=="up") then + if (trim(item%fileVDir)=="down") then + do i=1,lm_in + ptrF(:,:,lm_in-i+1)=ptrR(:,:,i) + enddo + else if (trim(item%fileVDir)=="up") then + do i=1,lm_in + ptrF(:,:,i)=ptrR(:,:,i) + enddo + end if + end if + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_ExtDataFillField + + subroutine MAPL_ExtDataFlipVertical(item,filec,rc) + type(PrimaryExport), intent(inout) :: item + integer, intent(in) :: filec + integer, optional, intent(out) :: rc + + integer :: status + + type(ESMF_Field) :: Field,field1,field2 + real, pointer :: ptr(:,:,:) + real, allocatable :: ptemp(:,:,:) + integer :: ls, le + + if (item%isVector) then + + if (item%do_Fill .or. item%do_VertInterp) then + call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,getRL=.true.,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,getRL=.true.,__RC__) + else + call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,__RC__) + end if + + call ESMF_FieldGet(Field1,0,farrayPtr=ptr,rc=status) + _VERIFY(STATUS) + allocate(ptemp,source=ptr,stat=status) + _VERIFY(status) + ls = lbound(ptr,3) + le = ubound(ptr,3) + ptr(:,:,le:ls:-1) = ptemp(:,:,ls:le:+1) + + call ESMF_FieldGet(Field2,0,farrayPtr=ptr,rc=status) + _VERIFY(STATUS) + ptemp=ptr + ptr(:,:,le:ls:-1) = ptemp(:,:,ls:le:+1) + + deallocate(ptemp) + + else + + if (item%do_Fill .or. item%do_VertInterp) then + call MAPL_ExtDataGetBracket(item,filec,field=Field,getRL=.true.,__RC__) + else + call MAPL_ExtDataGetBracket(item,filec,field=Field,__RC__) + end if + + call ESMF_FieldGet(Field,0,farrayPtr=ptr,rc=status) + _VERIFY(STATUS) + allocate(ptemp,source=ptr,stat=status) + _VERIFY(status) + ls = lbound(ptr,3) + le = ubound(ptr,3) + ptr(:,:,le:ls:-1) = ptemp(:,:,ls:le:+1) + deallocate(ptemp) + end if + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_ExtDataFlipVertical + subroutine MAPL_ExtDataPopulateBundle(item,filec,pbundle,rc) + type(PrimaryExport), intent(inout) :: item + integer, intent(in) :: filec + type(ESMF_FieldBundle), intent(inout) :: pbundle + integer, optional, intent(out) :: rc + + integer :: status + + type(ESMF_Field) :: Field,field1,field2 + type(ESMF_Grid) :: grid + + if (item%isVector) then + + if (item%do_Fill .or. item%do_VertInterp) then + call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,getRL=.true.,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,getRL=.true.,__RC__) + else + call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,__RC__) + end if + + call ESMF_FieldGet(Field1,grid=grid,rc=status) + _VERIFY(STATUS) + call ESMF_FieldBundleSet(pbundle,grid=grid,rc=status) + _VERIFY(STATUS) + call MAPL_FieldBundleAdd(pbundle,Field1,rc=status) + _VERIFY(STATUS) + call MAPL_FieldBundleAdd(pbundle,Field2,rc=status) + _VERIFY(STATUS) + + !block + !character(len=ESMF_MAXSTR) :: vectorlist(2) + !vectorlist(1) = item%fcomp1 + !vectorlist(2) = item%fcomp2 + !call ESMF_AttributeSet(pbundle,name="VectorList:", itemCount=2, & + !valuelist = vectorlist, rc=status) + !_VERIFY(STATUS) + !end block + + else + + if (item%do_Fill .or. item%do_VertInterp) then + call MAPL_ExtDataGetBracket(item,filec,field=Field,getRL=.true.,__RC__) + else + call MAPL_ExtDataGetBracket(item,filec,field=Field,__RC__) + end if + + call ESMF_FieldGet(Field,grid=grid,rc=status) + _VERIFY(STATUS) + call ESMF_FieldBundleSet(pbundle,grid=grid,rc=status) + _VERIFY(STATUS) + call MAPL_FieldBundleAdd(pbundle,Field,rc=status) + _VERIFY(STATUS) + + end if + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_ExtDataPopulateBundle + + subroutine MAPL_ExtDataCreateCFIO(IOBundles, rc) + type(IOBundleVector), target, intent(inout) :: IOBundles + integer, optional, intent(out ) :: rc + + type (IoBundleVectorIterator) :: bundle_iter + type (ExtData_IoBundle), pointer :: io_bundle + integer :: status + + bundle_iter = IOBundles%begin() + do while (bundle_iter /= IOBundles%end()) + io_bundle => bundle_iter%get() + call io_bundle%make_cfio(__RC__) + call bundle_iter%next() + enddo + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_ExtDataCreateCFIO + + subroutine MAPL_ExtDataDestroyCFIO(IOBundles,rc) + type(IOBundleVector), target, intent(inout) :: IOBundles + integer, optional, intent(out ) :: rc + + type(IoBundleVectorIterator) :: bundle_iter + type (ExtData_IoBundle), pointer :: io_bundle + integer :: status + + bundle_iter = IOBundles%begin() + do while (bundle_iter /= IOBundles%end()) + io_bundle => bundle_iter%get() + call io_bundle%clean(__RC__) + call bundle_iter%next + enddo + call IOBundles%clear() + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_ExtDataDestroyCFIO + + subroutine MAPL_ExtDataPrefetch(IOBundles,rc) + type(IoBundleVector), target, intent(inout) :: IOBundles + integer, optional, intent(out ) :: rc + + integer :: n,nfiles + type(ExtData_IoBundle), pointer :: io_bundle => null() + integer :: status + + nfiles = IOBundles%size() + + do n = 1, nfiles + io_bundle => IOBundles%at(n) + call io_bundle%cfio%request_data_from_file(io_bundle%file_name,io_bundle%time_index,rc=status) + _VERIFY(status) + enddo + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_ExtDataPrefetch + + subroutine MAPL_ExtDataReadPrefetch(IOBundles,rc) + type(IOBundleVector), target, intent(inout) :: IOBundles + integer, optional, intent(out ) :: rc + + integer :: nfiles, n + type (ExtData_IoBundle), pointer :: io_bundle + integer :: status + + + nfiles = IOBundles%size() + do n=1, nfiles + io_bundle => IOBundles%at(n) + call io_bundle%cfio%process_data_from_file(rc=status) + _VERIFY(status) + enddo + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_ExtDataReadPrefetch + + subroutine createFileLevBracket(item,cf,rc) + type(PrimaryExport), intent(inout) :: item + type(ESMF_Config), intent(inout) :: cf + integer, optional, intent(out) :: rc + + integer :: status + type (ESMF_Grid) :: grid, newgrid + type(ESMF_Field) :: field,new_field + + call item%modelGridFields%comp1%get_parameters('L',field=field,__RC__) + newGrid = MAPL_ExtDataGridChangeLev(grid,cf,item%lm,__RC__) + new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp1),__RC__) + call item%modelGridFields%auxiliary1%set_parameters(left_field=new_field,__RC__) + new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp1),__RC__) + call item%modelGridFields%auxiliary1%set_parameters(right_field=new_field,__RC__) + if (item%vartype==MAPL_VectorField) then + new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp2),__RC__) + call item%modelGridFields%auxiliary2%set_parameters(left_field=new_field,__RC__) + new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp2),__RC__) + call item%modelGridFields%auxiliary2%set_parameters(right_field=new_field,__RC__) + end if + _RETURN(_SUCCESS) + + end subroutine createFileLevBracket + + + subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,rc) + type(Iobundlevector), intent(inout) :: IOBundles + type(primaryExport), intent(inout) :: item + integer, intent(in) :: entry_num + integer, intent(out), optional :: rc + + integer :: status + + type (ExtData_IOBundle) :: io_bundle + type (GriddedIOItemVector) :: items + logical :: update + character(len=ESMF_MAXPATHLEN) :: file + integer :: time_index + + call item%modelGridFields%comp1%get_parameters('L',update=update,file=file,time_index=time_index) + if (update) then + call items%push_back(item%fileVars) + io_bundle = ExtData_IOBundle(MAPL_ExtDataLeft, entry_num, file, time_index, item%trans, item%fracval, item%file, & + item%pfioCollection_id,item%iclient_collection_id,items,rc=status) + _VERIFY(status) + call IOBundles%push_back(io_bundle) + call extdata_lgr%info('%a update L with with: %a %i2 ',item%name, file, time_index) + end if + call item%modelGridFields%comp1%get_parameters('R',update=update,file=file,time_index=time_index) + if (update) then + call items%push_back(item%fileVars) + io_bundle = ExtData_IOBundle(MAPL_ExtDataRight, entry_num, file, time_index, item%trans, item%fracval, item%file, & + item%pfioCollection_id,item%iclient_collection_id,items,rc=status) + _VERIFY(status) + call IOBundles%push_back(io_bundle) + call extdata_lgr%info('%a update R with with: %a %i2 ',item%name,file, time_index) + end if + + _RETURN(ESMF_SUCCESS) + + end subroutine IOBundle_Add_Entry + + END MODULE MAPL_ExtDataGridCompNG diff --git a/gridcomps/ExtData2G/ExtDataLgr.F90 b/gridcomps/ExtData2G/ExtDataLgr.F90 new file mode 100644 index 000000000000..48654ffa982c --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataLgr.F90 @@ -0,0 +1,8 @@ +module MAPL_ExtDataLogger + use pFlogger + + public :: extdata_lgr + class(Logger), pointer :: extdata_lgr + +end module MAPL_ExtDataLogger + diff --git a/gridcomps/ExtData2G/ExtDataNode.F90 b/gridcomps/ExtData2G/ExtDataNode.F90 new file mode 100644 index 000000000000..2726b6428ba9 --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataNode.F90 @@ -0,0 +1,73 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" +module MAPL_ExtDataNode + use ESMF + use MAPL_KeywordEnforcerMod + use MAPL_ExceptionHandling + use MAPL_BaseMod, only: MAPL_UNDEF + implicit none + private + + type, public :: ExtDataNode + type(ESMF_Field) :: field + type(ESMF_Time) :: time + character(len=ESMF_MAXPATHLEN) :: file + integer :: time_index + logical :: was_set + contains + procedure :: set + procedure :: get + procedure :: equals + generic :: operator(==) => equals + end type + +contains + + subroutine set(this, unusable, field, time, file, time_index, was_set, rc) + class(ExtDataNode), intent(inout) :: this + class(KeywordEnforcer), optional, intent(in) :: unusable + type(ESMF_Time), optional, intent(in) :: time + type(ESMF_Field), optional, intent(in) :: field + character(len=*), optional, intent(in) :: file + integer, optional, intent(in) :: time_index + logical, optional, intent(in) :: was_set + integer, optional, intent(out) :: rc + + _UNUSED_DUMMY(unusable) + if (present(time)) this%time = time + if (present(field)) this%field = field + if (present(file)) this%file = trim(file) + if (present(time_index)) this%time_index = time_index + if (present(was_set)) this%was_set = was_set + _RETURN(_SUCCESS) + + end subroutine set + + subroutine get(this, unusable, field, time, file, time_index, was_set, rc) + class(ExtDataNode), intent(inout) :: this + class(KeywordEnforcer), optional, intent(in) :: unusable + type(ESMF_Time), optional, intent(out) :: time + type(ESMF_Field), optional, intent(out) :: field + character(len=*), optional, intent(out) :: file + integer, optional, intent(out) :: time_index + logical, optional, intent(out) :: was_set + integer, optional, intent(out) :: rc + + _UNUSED_DUMMY(unusable) + if (present(time)) time = this%time + if (present(field)) field = this%field + if (present(file)) file = trim(this%file) + if (present(time_index)) time_index = this%time_index + if (present(was_set)) was_set = this%was_set + _RETURN(_SUCCESS) + + end subroutine get + + logical function equals(a,b) + class(ExtDataNode), intent(in) :: a + class(ExtDataNode), intent(in) :: b + + equals = (trim(a%file)==trim(b%file)) .and. (a%time==b%time) .and. (a%time_index==b%time_index) + end function equals + +end module MAPL_ExtDataNode diff --git a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 new file mode 100644 index 000000000000..7e72cb13fb91 --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 @@ -0,0 +1,204 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" + +module MAPL_ExtDataOldTypesCreator + use ESMF + use MAPL_BaseMod + use yafYaml + use MAPL_KeywordEnforcerMod + use MAPL_ExceptionHandling + use MAPL_ExtDataTypeDef + use MAPL_ExtDataConfig + use MAPL_ExtDataFileStream + use MAPL_ExtDataFileStreamMap + use MAPL_ExtDataRule + use MAPL_ExtDataRuleMap + use MAPL_ExtDataDerived + use MAPL_ExtDataDerivedMap + use MAPL_RegridMethods + use MAPL_ExtDataAbstractFileHandler + use MAPL_ExtDataSimpleFileHandler + use MAPL_ExtDataClimFileHandler + use MAPL_ExtDataTimeSample + use MAPL_ExtDataTimeSampleMap + implicit none + public :: ExtDataOldTypesCreator + + type, extends(ExtDataConfig) :: ExtDataOldTypesCreator + private + contains + procedure :: fillin_primary + procedure :: fillin_derived + end type ExtDataOldTypesCreator + + interface ExtDataOldTypesCreator + module procedure :: new_ExtDataOldTypesCreator + end interface + + contains + + function new_ExtDataOldTypesCreator(config_file,current_time,unusable,rc ) result(ExtDataObj) + character(len=*), intent(in) :: config_file + type(ESMF_Time), intent(in) :: current_time + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + type(ExtDataOldTypesCreator) :: ExtDataObj + + integer :: status + + _UNUSED_DUMMY(unusable) + call ExtDataObj%ExtDataConfig%new_ExtDataConfig_from_yaml(config_file,current_time,rc=status) + _VERIFY(status) + + _RETURN(_SUCCESS) + end function new_ExtDataOldTypesCreator + + + subroutine fillin_primary(this,item_name,primary_item,time,clock,unusable,rc) + class(ExtDataOldTypesCreator), intent(inout) :: this + character(len=*), intent(in) :: item_name + type(PrimaryExport), intent(inout) :: primary_item + type(ESMF_Time), intent(inout) :: time + type(ESMF_Clock), intent(inout) :: clock + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + type(ExtDataRule), pointer :: rule + type(ExtDataFileStream), pointer :: dataset + type(ExtDataTimeSample), pointer :: time_sample + type(ExtDataTimeSample), target :: default_time_sample + type(ExtDataSimpleFileHandler) :: simple_handler + type(ExtDataClimFileHandler) :: clim_handler + integer :: status, semi_pos + logical :: disable_interpolation + + _UNUSED_DUMMY(unusable) + rule => this%rule_map%at(trim(item_name)) + time_sample => this%sample_map%at(rule%sample_key) + + if(.not.associated(time_sample)) then + call default_time_sample%set_defaults() + time_sample=>default_time_sample + end if + primary_item%isVector = allocated(rule%vector_partner) + ! name and file var + primary_item%name = trim(item_name) + if (primary_item%isVector) then + primary_item%vartype = MAPL_VectorField + primary_item%vcomp1 = trim(item_name) + primary_item%vcomp2 = trim(rule%vector_partner) + primary_item%var = rule%file_var + primary_item%fcomp1 = rule%file_var + primary_item%fcomp2 = rule%vector_file_partner + primary_item%fileVars%itemType = ItemTypeVector + primary_item%fileVars%xname = trim(rule%file_var) + primary_item%fileVars%yname = trim(rule%vector_file_partner) + else + primary_item%vartype = MAPL_FieldItem + primary_item%vcomp1 = trim(item_name) + primary_item%var = rule%file_var + primary_item%fcomp1 = rule%file_var + primary_item%fileVars%itemType = ItemTypeScalar + primary_item%fileVars%xname = trim(rule%file_var) + end if + + ! regrid method + if (trim(rule%regrid_method) == "BILINEAR") then + primary_item%trans = REGRID_METHOD_BILINEAR + else if (trim(rule%regrid_method) == "CONSERVE") then + primary_item%trans = REGRID_METHOD_CONSERVE + else if (trim(rule%regrid_method) == "VOTE") then + primary_item%trans = REGRID_METHOD_VOTE + else if (index(rule%regrid_method,"FRACTION;")>0) then + semi_pos = index(rule%regrid_method,";") + read(rule%regrid_method(semi_pos+1:),*) primary_item%fracVal + primary_item%trans = REGRID_METHOD_FRACTION + else + _ASSERT(.false.,"Invalid regridding method") + end if + + if (trim(time_sample%extrap_outside) =="clim") then + primary_item%cycling=.true. + else if (trim(time_sample%extrap_outside) == "persist_closest") then + primary_item%persist_closest=.true. + else if (trim(time_sample%extrap_outside) == "none") then + primary_item%cycling=.false. + primary_item%persist_closest=.false. + end if + + allocate(primary_item%source_time,source=time_sample%source_time) + ! new refresh + call primary_item%update_freq%create_from_parameters(time_sample%refresh_time, & + time_sample%refresh_frequency, time_sample%refresh_offset, time, clock, __RC__) + + disable_interpolation = .not.time_sample%time_interpolation + + call primary_item%modelGridFields%comp1%set_parameters(linear_trans=rule%linear_trans,disable_interpolation=disable_interpolation) + call primary_item%modelGridFields%comp2%set_parameters(linear_trans=rule%linear_trans,disable_interpolation=disable_interpolation) + call primary_item%modelGridFields%auxiliary1%set_parameters(linear_trans=rule%linear_trans, disable_interpolation=disable_interpolation) + call primary_item%modelGridFields%auxiliary2%set_parameters(linear_trans=rule%linear_trans, disable_interpolation=disable_interpolation) + + ! file_template + primary_item%isConst = .false. + if (index(rule%collection,"/dev/null")==0) then + dataset => this%file_stream_map%at(trim(rule%collection)) + primary_item%file = dataset%file_template + call dataset%detect_metadata(primary_item%file_metadata,time,get_range=(trim(time_sample%extrap_outside) /= "none"),__RC__) + else + primary_item%file = rule%collection + end if + + if (index(rule%collection,'/dev/null') /= 0) then + primary_item%isConst = .true. + primary_item%const=rule%linear_trans(1) + else + if (primary_item%cycling) then + call clim_handler%initialize(dataset,__RC__) + allocate(primary_item%filestream,source=clim_handler) + else + call simple_handler%initialize(dataset,persist_closest=primary_item%persist_closest,__RC__) + allocate(primary_item%filestream,source=simple_handler) + end if + end if + + _RETURN(_SUCCESS) + + end subroutine fillin_primary + + subroutine fillin_derived(this,item_name,derived_item,time,clock,unusable,rc) + class(ExtDataOldTypesCreator), intent(inout) :: this + character(len=*), intent(in) :: item_name + type(DerivedExport), intent(inout) :: derived_item + type(ESMF_Time), intent(inout) :: time + type(ESMF_Clock), intent(inout) :: clock + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + type(ExtDataDerived), pointer :: rule + integer :: status + type(ExtDataTimeSample), pointer :: time_sample + type(ExtDataTimeSample), target :: default_time_sample + + _UNUSED_DUMMY(unusable) + rule => this%derived_map%at(trim(item_name)) + derived_item%name = trim(item_name) + derived_item%expression = rule%expression + time_sample => this%sample_map%at(rule%sample_key) + + if(.not.associated(time_sample)) then + call default_time_sample%set_defaults() + time_sample=>default_time_sample + end if + call derived_item%update_freq%create_from_parameters(time_sample%refresh_time, & + time_sample%refresh_frequency, time_sample%refresh_offset, time, clock, __RC__) + derived_item%masking=.false. + if (index(derived_item%expression,"mask") /= 0 ) then + derived_item%masking=.true. + end if + + _RETURN(_SUCCESS) + + end subroutine fillin_derived + +end module MAPL_ExtDataOldTypesCreator diff --git a/gridcomps/ExtData2G/ExtDataRule.F90 b/gridcomps/ExtData2G/ExtDataRule.F90 new file mode 100644 index 000000000000..ef3bb8951a63 --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataRule.F90 @@ -0,0 +1,158 @@ +#include "MAPL_ErrLog.h" +module MAPL_ExtDataRule + use yaFyaml + use ESMF + use MAPL_KeywordEnforcerMod + use MAPL_ExceptionHandling + use MAPL_TimeStringConversion + use MAPL_ExtDataTimeSample + use MAPL_ExtDataTimeSampleMap + implicit none + private + + type, public :: ExtDataRule + character(:), allocatable :: collection + character(:), allocatable :: file_var + character(:), allocatable :: sample_key + real, allocatable :: linear_trans(:) + character(:), allocatable :: regrid_method + character(:), allocatable :: vector_partner + character(:), allocatable :: vector_component + character(:), allocatable :: vector_file_partner + contains + procedure :: set_defaults + procedure :: split_vector + end type + + interface ExtDataRule + module procedure new_ExtDataRule + end interface + +contains + + function new_ExtDataRule(config,sample_map,key,unusable,rc) result(rule) + type(Configuration), intent(in) :: config + character(len=*), intent(in) :: key + type(ExtDataTimeSampleMap) :: sample_map + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + type(ExtDataRule) :: rule + logical :: is_present + integer :: status + type(Configuration) ::config1 + character(len=:), allocatable :: tempc + type(ExtDataTimeSample) :: ts + _UNUSED_DUMMY(unusable) + + if (allocated(tempc)) deallocate(tempc) + is_present = config%has("collection") + _ASSERT(is_present,"no collection present in ExtData export") + rule%collection = config%of("collection") + + if (allocated(tempc)) deallocate(tempc) + is_present = config%has("vname") + if (index(rule%collection,"/dev/null")==0) then + _ASSERT(is_present,"no vname present in ExtData export") + end if + if (is_present) then + tempc = config%of("vname") + rule%file_var=tempc + else + _ASSERT(.false.,"no variable name in rule") + end if + + if (config%has("sample")) then + config1=config%at("sample") + if (config1%is_mapping()) then + ts = ExtDataTimeSample(config1,_RC) + call sample_map%insert(trim(key)//"_sample",ts) + rule%sample_key=trim(key)//"_sample" + else if (config1%is_string()) then + rule%sample_key=config1 + else + _ASSERT(.false.,"sample entry unsupported") + end if + end if + + if (allocated(rule%linear_trans)) deallocate(rule%linear_trans) + if (config%has("linear_transformation")) then + call config%get(rule%linear_trans,"linear_transformation") + else + allocate(rule%linear_trans,source=[0.0,0.0]) + end if + + if (allocated(tempc)) deallocate(tempc) + if (config%has("regrid")) then + tempc = config%of("regrid") + rule%regrid_method=tempc + else + rule%regrid_method="BILINEAR" + end if + + _RETURN(_SUCCESS) + end function new_ExtDataRule + + subroutine set_defaults(this,unusable,rc) + class(ExtDataRule), intent(inout), target :: this + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + _UNUSED_DUMMY(unusable) + this%collection='' + this%file_var='missing_variable' + this%regrid_method='BILINEAR' + _RETURN(_SUCCESS) + end subroutine set_defaults + + subroutine split_vector(this,original_key,ucomp,vcomp,unusable,rc) + class(ExtDataRule), intent(in) :: this + character(len=*), intent(in) :: original_key + type(ExtDataRule), intent(inout) :: ucomp,vcomp + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + integer :: semi_pos + character(len=:),allocatable :: uname,vname + + _UNUSED_DUMMY(unusable) + + semi_pos = index(this%file_var,";") + _ASSERT(semi_pos > 0,"vector rule does not have 2 variables in the file_var") + uname = this%file_var(1:semi_pos-1) + vname = this%file_var(semi_pos+1:len_trim(this%file_var)) + ucomp = this + vcomp = this + semi_pos = index(original_key,";") + ucomp%vector_partner = original_key(semi_pos+1:len_trim(original_key)) + vcomp%vector_partner = original_key(1:semi_pos-1) + ucomp%file_var = uname + vcomp%file_var = vname + ucomp%vector_file_partner = vname + vcomp%vector_file_partner = uname + ucomp%vector_component = "EW" + vcomp%vector_component = "NS" + _RETURN(_SUCCESS) + + end subroutine split_vector + +end module MAPL_ExtDataRule + +module MAPL_ExtDataRuleMap + use MAPL_ExtDataRule + +#include "types/key_deferredLengthString.inc" +#define _value type(ExtDataRule) +#define _alt + +#define _map ExtDataRuleMap +#define _iterator ExtDataRuleMapIterator + +#include "templates/map.inc" + +#undef _iterator +#undef _map + +#undef _alt +#undef _value + +end module MAPL_ExtDataRuleMap diff --git a/gridcomps/ExtData2G/ExtDataSample.F90 b/gridcomps/ExtData2G/ExtDataSample.F90 new file mode 100644 index 000000000000..ccf3d62c84dc --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataSample.F90 @@ -0,0 +1,114 @@ +#include "MAPL_ErrLog.h" +module MAPL_ExtDataTimeSample + use yaFyaml + use ESMF + use MAPL_KeywordEnforcerMod + use MAPL_ExceptionHandling + use MAPL_TimeStringConversion + implicit none + private + + type, public :: ExtDataTimeSample + logical :: time_interpolation + type(ESMF_Time), allocatable :: source_time(:) + character(:), allocatable :: extrap_outside + character(:), allocatable :: refresh_time + character(:), allocatable :: refresh_frequency + character(:), allocatable :: refresh_offset + contains + procedure :: set_defaults + end type + + interface ExtDataTimeSample + module procedure new_ExtDataTimeSample + end interface + +contains + + function new_ExtDataTimeSample(config,unusable,rc) result(TimeSample) + type(Configuration), intent(in) :: config + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + type(ExtDataTimeSample) :: TimeSample + integer :: status + character(len=:), allocatable :: source_str + integer :: idx + _UNUSED_DUMMY(unusable) + + call TimeSample%set_defaults() + + if (config%has("extrapolation")) TimeSample%extrap_outside=config%of("extrapolation") + + if (config%has("time_interpolation")) then + TimeSample%time_interpolation = config%of("time_interpolation") + else + TimeSample%time_interpolation = .true. + end if + + if (config%has("update_reference_time")) TimeSample%refresh_time=config%of("update_reference_time") + + if (config%has("update_reference_time")) TimeSample%refresh_frequency=config%of("update_frequency") + + if (config%has("update_offset")) TimeSample%refresh_offset=config%of("update_offset") + + if (config%has("source_time")) then + call config%get(source_str,"source_time",rc=status) + _VERIFY(status) + if (allocated(TimeSample%source_time)) deallocate(TimeSample%source_time) + idx = index(source_str,',') + _ASSERT(idx/=0,'invalid specification of source_time') + allocate(TimeSample%source_time(2)) + TimeSample%source_time(1)=string_to_esmf_time(source_str(:idx-1)) + TimeSample%source_time(2)=string_to_esmf_time(source_str(idx+1:)) + else + if (.not.allocated(TimeSample%source_time)) allocate(TimeSample%source_time(0)) + end if + + _RETURN(_SUCCESS) + + end function new_ExtDataTimeSample + + + subroutine set_defaults(this,unusable,rc) + class(ExtDataTimeSample), intent(inout), target :: this + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + integer :: status + _UNUSED_DUMMY(unusable) + this%time_interpolation=.true. + this%extrap_outside='none' + this%refresh_time="00" + this%refresh_frequency="PT0S" + this%refresh_offset="PT0S" + if (allocated(this%source_time)) then + deallocate(this%source_time,stat=status) + _VERIFY(status) + end if + allocate(this%source_time(0),stat=status) + _VERIFY(status) + _RETURN(_SUCCESS) + end subroutine set_defaults + +end module MAPL_ExtDataTimeSample + +module MAPL_ExtDataTimeSampleMap + use MAPL_ExtDataTimeSample + +#include "types/key_deferredLengthString.inc" +#define _value type(ExtDataTimeSample) +#define _alt + +#define _map ExtDataTimeSampleMap +#define _iterator ExtDataTimeSampleMapIterator + +#include "templates/map.inc" + +#undef _iterator +#undef _map + +#undef _alt +#undef _value + +end module MAPL_ExtDataTimeSampleMap diff --git a/gridcomps/ExtData2G/ExtDataSimpleFileHandler.F90 b/gridcomps/ExtData2G/ExtDataSimpleFileHandler.F90 new file mode 100644 index 000000000000..2c7df5cad502 --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataSimpleFileHandler.F90 @@ -0,0 +1,162 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" +module MAPL_ExtdataSimpleFileHandler + use ESMF + use MAPL_ExtDataAbstractFileHandler + use MAPL_KeywordEnforcerMod + use MAPL_ExceptionHandling + use MAPL_ExtDataFileStream + use MAPL_ExtDataFileStreamMap + use MAPL_DataCollectionMod + use MAPL_CollectionVectorMod + use MAPL_DataCollectionManagerMod + use MAPL_FileMetadataUtilsMod + use MAPL_TimeStringConversion + use MAPL_StringTemplate + use MAPL_ExtDataBracket + use MAPL_ExtDataConstants + + implicit none + private + public ExtDataSimpleFileHandler + + type, extends(ExtDataAbstractFileHandler) :: ExtDataSimpleFileHandler + contains + procedure :: get_file_bracket + procedure :: get_file + end type + +contains + + subroutine get_file_bracket(this, input_time, source_time, bracket, rc) + class(ExtdataSimpleFileHandler), intent(inout) :: this + type(ESMF_Time), intent(in) :: input_time + type(ESMF_Time), intent(in) :: source_time(:) + type(ExtDataBracket), intent(inout) :: bracket + integer, optional, intent(out) :: rc + integer :: status + type(ESMF_TimeInterval) :: zero + + type(ESMF_Time) :: time + integer :: time_index + character(len=ESMF_MAXPATHLEN) :: file + logical :: get_left, get_right,in_range,was_set + type(ESMF_Time) :: target_time + + + get_left=.true. + get_right=.true. + in_range=.true. + target_time=input_time + call bracket%set_parameters(intermittent_disable=.false.) + if (this%persist_closest) then + if (input_time < this%valid_range(1)) then + target_time = this%valid_range(1) + get_right = .false. + in_range = .false. + call bracket%get_node('L',was_set=was_set) + if (was_set) get_left=.false. + call bracket%set_parameters(intermittent_disable=.true.) + else if (input_time > this%valid_range(2)) then + target_time = this%valid_range(2) + get_right = .false. + in_range = .false. + call bracket%get_node('L',was_set=was_set) + if (was_set) get_left=.false. + call bracket%set_parameters(intermittent_disable=.true.) + end if + end if + if (bracket%time_in_bracket(target_time) .and. in_range) then + _RETURN(_SUCCESS) + end if + + call ESMF_TimeIntervalSet(zero,__RC__) + if (this%frequency == zero) then + file = this%file_template + if (get_left) then + call this%get_time_on_file(file,target_time,'L',time_index,time,__RC__) + _ASSERT(time_index/=time_not_found,"Time not found in file") + call bracket%set_node('L',file=file,time_index=time_index,time=time,__RC__) + if (in_range .and. (bracket%left_node == bracket%right_node)) then + call bracket%swap_node_fields(rc=status) + _VERIFY(status) + else + bracket%new_file_left=.true. + call bracket%set_node('L',was_set=.true.) + end if + end if + if (get_right) then + call this%get_time_on_file(file,target_time,'R',time_index,time,__RC__) + _ASSERT(time_index/=time_not_found,"Time not found in file") + call bracket%set_node('R',file=file,time_index=time_index,time=time,__RC__) + bracket%new_file_right=.true. + end if + else + if (get_left) then + call this%get_file(file,target_time,0,__RC__) + call this%get_time_on_file(file,target_time,'L',time_index,time,__RC__) + if (time_index == time_not_found) then + call this%get_file(file,target_time,-1,__RC__) + call this%get_time_on_file(file,target_time,'L',time_index,time,__RC__) + _ASSERT(time_index/=time_not_found,"Time not found in file") + end if + call bracket%set_node('L',file=file,time_index=time_index,time=time,__RC__) + if (in_range .and. (bracket%left_node == bracket%right_node)) then + call bracket%swap_node_fields(rc=status) + _VERIFY(status) + else + bracket%new_file_left=.true. + call bracket%set_node('L',was_set=.true.) + end if + end if + + if (get_right) then + call this%get_file(file,target_time,0,__RC__) + call this%get_time_on_file(file,target_time,'R',time_index,time,__RC__) + if (time_index == time_not_found) then + call this%get_file(file,target_time,1,__RC__) + call this%get_time_on_file(file,target_time,'R',time_index,time,__RC__) + _ASSERT(time_index /= time_not_found,"Time not found in file") + end if + call bracket%set_node('R',file=file,time_index=time_index,time=time,__RC__) + bracket%new_file_right=.true. + end if + + end if + _RETURN(_SUCCESS) + + end subroutine get_file_bracket + + subroutine get_file(this,filename,input_time,shift,rc) + class(ExtdataSimpleFileHandler), intent(inout) :: this + character(len=*), intent(out) :: filename + type(ESMF_Time) :: input_time + integer, intent(in) :: shift + integer, intent(out), optional :: rc + + type(ESMF_Time) :: ftime + integer :: n,status + logical :: file_found + integer(ESMF_KIND_I8) :: interval_seconds + + call ESMF_TimeIntervalGet(this%frequency,s_i8=interval_seconds) + if (interval_seconds==0) then + ! time is not representable as absolute time interval (month, year etc...) do this + ! brute force way. Not good but ESMF leaves no choice + ftime=this%reff_time + do while (ftime < input_time) + ftime = ftime + this%frequency + enddo + ftime=ftime -this%frequency + shift*this%frequency + else + n = (input_time-this%reff_time)/this%frequency + ftime = this%reff_time+(n+shift)*this%frequency + end if + call fill_grads_template(filename,this%file_template,time=ftime,__RC__) + inquire(file=trim(filename),exist=file_found) + _ASSERT(file_found,"get_file did not file a file using: "//trim(this%file_template)) + _RETURN(_SUCCESS) + + end subroutine get_file + +end module MAPL_ExtdataSimpleFileHandler diff --git a/gridcomps/ExtData2G/ExtDataTypeDef.F90 b/gridcomps/ExtData2G/ExtDataTypeDef.F90 new file mode 100644 index 000000000000..48e2ecd26231 --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataTypeDef.F90 @@ -0,0 +1,80 @@ +module MAPL_ExtDataTypeDef + use ESMF + use MAPL_GriddedIOItemMod + use MAPL_ExtDataBracket + use MAPL_ExtDataPointerUpdate + use MAPL_ExtDataAbstractFileHandler + use MAPL_FileMetadataUtilsMod + implicit none + + public PrimaryExport + public DerivedExport + public BracketingFields + + integer, parameter :: MAPL_ExtDataNullFrac = -9999 + + type BracketingFields + ! fields to store endpoints for interpolation of a vector pair + type(ExtDataBracket) :: comp1 + type(ExtDataBracket) :: comp2 + ! if vertically interpolating vector fields + type(ExtDataBracket) :: auxiliary1 + type(ExtDataBracket) :: auxiliary2 + end type BracketingFields + + type PrimaryExport + character(len=ESMF_MAXSTR) :: name + character(len=ESMF_MAXSTR) :: units='' + integer :: Trans + character(len=ESMF_MAXSTR) :: var + character(len=ESMF_MAXPATHLEN) :: file ! remove + + logical :: isConst + real :: Const !remove + integer :: vartype ! MAPL_FieldItem or MAPL_BundleItem + + class(ExtDataAbstractFileHandler), allocatable :: filestream + + ! if primary export represents a pair of vector fields + logical :: isVector + type(BracketingFields) :: modelGridFields + + ! names of the two vector components in the gridded component where import is declared + character(len=ESMF_MAXSTR) :: vcomp1, vcomp2 + ! the corresponding names of the two vector components on file + character(len=ESMF_MAXSTR) :: fcomp1, fcomp2 + type(GriddedIOitem) :: fileVars + + integer :: pfioCollection_id + integer :: iclient_collection_id + + logical :: ExtDataAlloc + integer :: FracVal = MAPL_ExtDataNullFrac + ! do we have to do vertical interpolation + logical :: do_VertInterp = .false. + logical :: do_Fill = .false. + type(FileMetadataUtils) :: file_metadata + integer :: LM + real, allocatable :: levs(:) + character(len=4) :: importVDir = "down" + character(len=4) :: fileVDir = "down" + character(len=ESMF_MAXSTR) :: levUnit + logical :: havePressure = .false. + type(ExtDataPointerUpdate) :: update_freq + + ! new stuff + logical :: cycling + logical :: persist_closest + type(ESMF_Time), allocatable :: source_time(:) + end type PrimaryExport + + type DerivedExport + character(len=ESMF_MAXSTR) :: name + character(len=ESMF_MAXPATHLEN) :: expression + logical :: ExtDataAlloc + logical :: masking + type(ExtDataPointerUpdate) :: update_freq + end type DerivedExport + + +end module MAPL_ExtDataTypeDef diff --git a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 new file mode 100644 index 000000000000..79e31dc6e83f --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 @@ -0,0 +1,106 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" + +module MAPL_ExtDataPointerUpdate + use ESMF + use MAPL_KeywordEnforcerMod + use MAPL_ExceptionHandling + use MAPL_TimeStringConversion + implicit none + + type :: ExtDataPointerUpdate + private + logical :: disabled = .false. + type(ESMF_Alarm) :: update_alarm + type(ESMF_TimeInterval) :: offset + logical :: single_shot = .false. + contains + procedure :: create_from_parameters + procedure :: check_update + procedure :: is_disabled + procedure :: is_single_shot + procedure :: disable + end type + + contains + + subroutine create_from_parameters(this,update_time,update_freq,update_offset,time,clock,rc) + class(ExtDataPointerUpdate), intent(inout) :: this + character(len=*), intent(in) :: update_time + character(len=*), intent(in) :: update_freq + character(len=*), intent(in) :: update_offset + type(ESMF_Time), intent(inout) :: time + type(ESMF_Clock), intent(inout) :: clock + integer, optional, intent(out) :: rc + + type(ESMF_Time) :: reference_time + type(ESMF_TimeInterval) :: reference_freq + integer :: status,int_time,year,month,day,hour,minute,second + + if (update_freq == "-") then + this%single_shot = .true. + else if (update_freq /= "PT0S") then + int_time = string_to_integer_time(update_time) + hour=int_time/10000 + minute=mod(int_time/100,100) + second=mod(int_time,100) + call ESMF_TimeGet(time,yy=year,mm=month,dd=day,__RC__) + call ESMF_TimeSet(reference_time,yy=year,mm=month,dd=day,h=hour,m=minute,s=second,__RC__) + reference_freq = string_to_esmf_timeinterval(update_freq,__RC__) + this%update_alarm = ESMF_AlarmCreate(clock,ringTime=reference_time,ringInterval=reference_freq,sticky=.false.,__RC__) + end if + this%offset=string_to_esmf_timeinterval(update_offset,__RC__) + _RETURN(_SUCCESS) + + end subroutine create_from_parameters + + subroutine check_update(this,do_update,working_time,current_time,first_time,rc) + class(ExtDataPointerUpdate), intent(inout) :: this + logical, intent(out) :: do_update + type(ESMF_Time), intent(inout) :: working_time + type(ESMF_Time), intent(inout) :: current_time + logical, intent(in) :: first_time + integer, optional, intent(out) :: rc + type(ESMF_Time) :: previous_ring + + integer :: status + + if (this%disabled) then + do_update = .false. + _RETURN(_SUCCESS) + end if + if (ESMF_AlarmIsCreated(this%update_alarm)) then + if (first_time) then + call ESMF_AlarmGet(this%update_alarm,prevRingTime=previous_ring,__RC__) + working_time =previous_ring+this%offset + do_update = .true. + else + do_update = ESMF_AlarmIsRinging(this%update_alarm,__RC__) + working_time = current_time+this%offset + end if + else + do_update = .true. + if (this%single_shot) this%disabled = .true. + working_time = current_time+this%offset + end if + + end subroutine check_update + + function is_disabled(this) result(disabled) + class(ExtDataPointerUpdate), intent(in) :: this + logical :: disabled + disabled = this%disabled + end function is_disabled + + function is_single_shot(this) result(single_shot) + class(ExtDataPointerUpdate), intent(in) :: this + logical :: single_shot + single_shot = this%single_shot + end function is_single_shot + + subroutine disable(this) + class(ExtDataPointerUpdate), intent(inout) :: this + this%disabled = .true. + end subroutine + +end module MAPL_ExtDataPointerUpdate diff --git a/gridcomps/ExtData2G/ExtData_IOBundleMod.F90 b/gridcomps/ExtData2G/ExtData_IOBundleMod.F90 new file mode 100644 index 000000000000..888bba679249 --- /dev/null +++ b/gridcomps/ExtData2G/ExtData_IOBundleMod.F90 @@ -0,0 +1,127 @@ +!#include "MAPL_Exceptions.h" +#include "MAPL_Generic.h" +#include "unused_dummy.H" + +!------------------------------------------------------------------------- +! NASA/GSFC, Global Modeling and Assimilation Office, Code 610.1 ! +!------------------------------------------------------------------------- + +module MAPL_ExtData_IOBundleMod + use ESMF + use MAPL_BaseMod + use MAPL_GriddedIOMod + use MAPL_ExceptionHandling + use MAPL_GriddedIOItemMod + use MAPL_GriddedIOItemVectorMod + + public :: ExtData_IoBundle + + type ExtData_IoBundle + type (MAPL_GriddedIO) :: cfio + type (ESMF_FieldBundle) :: pbundle + character(:), allocatable :: template + integer :: regrid_method + + integer :: bracket_side + integer :: entry_index + character(:), allocatable :: file_name + integer :: time_index + integer :: fraction + integer :: metadata_coll_id + integer :: server_coll_id + type(GriddedIOItemVector) :: items + + contains + + procedure :: clean + procedure :: make_cfio + procedure :: assign + generic :: assignment(=) => assign + end type ExtData_IoBundle + + + interface ExtData_IoBundle + module procedure new_ExtData_IoBundle + end interface ExtData_IoBundle + +contains + + function new_ExtData_IoBundle(bracket_side, entry_index, file_name, time_index, regrid_method, fraction, template, metadata_coll_id,server_coll_id,items,rc) result(io_bundle) + type (ExtData_IoBundle) :: io_bundle + + integer, intent(in) :: bracket_side + integer, intent(in) :: entry_index + character(len=*), intent(in) :: file_name + integer, intent(in) :: time_index + integer, intent(in) :: regrid_method + integer, intent(in) :: fraction + character(len=*), intent(in) :: template + integer, intent(in) :: metadata_coll_id + integer, intent(in) :: server_coll_id + type(GriddedIOItemVector) :: items + integer, optional, intent(out) :: rc + + io_bundle%bracket_side = bracket_side + io_bundle%entry_index = entry_index + io_bundle%file_name = file_name + io_bundle%time_index = time_index + io_bundle%regrid_method = regrid_method + io_bundle%fraction = fraction + io_bundle%template = trim(template) + + io_bundle%metadata_coll_id=metadata_coll_id + io_bundle%server_coll_id=server_coll_id + io_bundle%items=items + + _RETURN(ESMF_SUCCESS) + end function new_ExtData_IoBundle + + + subroutine clean(this, rc) + class (ExtData_IoBundle), intent(inout) :: this + integer, optional, intent(out) :: rc + + integer :: status + call ESMF_FieldBundleDestroy(this%pbundle, noGarbage=.true.,rc=status) + _VERIFY(status) + + _RETURN(ESMF_SUCCESS) + + end subroutine clean + + + subroutine make_cfio(this, rc) + class (ExtData_IoBundle), intent(inout) :: this + integer, optional, intent(out) :: rc + + this%cfio = MAPL_GriddedIO(output_bundle=this%pbundle,regrid_method=this%regrid_method, & + read_collection_id=this%server_coll_id, & + metadata_collection_id = this%metadata_coll_id, fraction = this%fraction, & + items=this%items) + + _RETURN(ESMF_SUCCESS) + + end subroutine make_cfio + + subroutine assign(to,from) + class(ExtData_IOBundle), intent(out) :: to + type(ExtData_IOBundle), intent(in) :: from + + to%bracket_side = from%bracket_side + to%entry_index = from%entry_index + to%file_name = from%file_name + to%time_index = from%time_index + to%regrid_method = from%regrid_method + to%fraction = from%fraction + to%template = from%template + + to%metadata_coll_id=from%metadata_coll_id + to%server_coll_id=from%server_coll_id + to%items=from%items + to%pbundle=from%pbundle + to%CFIO=from%CFIO + + end subroutine assign + +end module MAPL_ExtData_IOBundleMod + diff --git a/gridcomps/ExtData2G/ExtData_IOBundleVectorMod.F90 b/gridcomps/ExtData2G/ExtData_IOBundleVectorMod.F90 new file mode 100644 index 000000000000..508fdc8ecf63 --- /dev/null +++ b/gridcomps/ExtData2G/ExtData_IOBundleVectorMod.F90 @@ -0,0 +1,10 @@ +module MAPL_ExtData_IOBundleVectorMod + use MAPL_ExtData_IOBundleMod + +#define _type type(ExtData_IoBundle) +#define _vector IoBundleVector +#define _iterator IoBundleVectorIterator + +#include "templates/vector.inc" + +end module MAPL_ExtData_IOBundleVectorMod diff --git a/gridcomps/ExtData2G/TimeStringConversion.F90 b/gridcomps/ExtData2G/TimeStringConversion.F90 new file mode 100644 index 000000000000..de5a527576de --- /dev/null +++ b/gridcomps/ExtData2G/TimeStringConversion.F90 @@ -0,0 +1,232 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" +module MAPL_TimeStringConversion + use ESMF + use MAPL_KeywordEnforcerMod + use MAPL_ExceptionHandling + implicit none + private + + public :: string_to_integer_time + public :: string_to_integer_date + public :: string_to_esmf_time + public :: string_to_esmf_timeinterval + +contains + + function string_to_integer_time(time_string,unusable,rc) result(time) + character(len=*), intent(in) :: time_string + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + integer :: time + integer mpos(2), hpos(2), spos(2) + integer strlen + integer firstcolon, lastcolon + integer lastspace + integer hour,min,sec + + _UNUSED_DUMMY(unusable) + + strlen = LEN_TRIM (time_string) + + firstcolon = index(time_string, ':') + if (firstcolon .LE. 0) then + + ! If no colons, check for hour. + + ! Logic below assumes a null character or something else is after the hour + ! if we do not find a null character add one so that it correctly parses time + !if (time_string(strlen:strlen) /= char(0)) then + !time_string = trim(time_string)//char(0) + !strlen=len_trim(time_string) + !endif + lastspace = index(TRIM(time_string), ' ', BACK=.TRUE.) + if ((strlen-lastspace).eq.2 .or. (strlen-lastspace).eq.3) then + hpos(1) = lastspace+1 + hpos(2) = strlen-1 + read (time_string(hpos(1):hpos(2)), * ) hour + min = 0 + sec = 0 + else + hour = 0 + min = 0 + sec = 0 + endif + + else + hpos(1) = firstcolon - 2 + hpos(2) = firstcolon - 1 + lastcolon = index(time_string, ':', BACK=.TRUE.) + if ( lastcolon .EQ. firstcolon ) then + mpos(1) = firstcolon + 1 + mpos(2) = firstcolon + 2 + read (time_string(hpos(1):hpos(2)), * ) hour + read (time_string(mpos(1):mpos(2)), * ) min + sec = 0 + else + mpos(1) = firstcolon + 1 + mpos(2) = lastcolon - 1 + spos(1) = lastcolon + 1 + spos(2) = lastcolon + 2 + read (time_string(hpos(1):hpos(2)), * ) hour + read (time_string(mpos(1):mpos(2)), * ) min + read (time_string(spos(1):spos(2)), * ) sec + endif + endif + + time = hour*10000+min*100+sec + _RETURN(_SUCCESS) + + end function string_to_integer_time + + function string_to_integer_date(time_string,unusable,rc) result(date) + character(len=*), intent(in) :: time_string + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + integer :: date + integer ypos(2), mpos(2), dpos(2) + integer strlen + integer firstdash, lastdash + integer year,month,day + + _UNUSED_DUMMY(unusable) + + strlen = LEN_TRIM (time_string) + + firstdash = index(time_string, '-') + lastdash = index(time_string, '-', BACK=.TRUE.) + + if (firstdash .LE. 0 .OR. lastdash .LE. 0) then + _RETURN(_FAILURE) + endif + + ypos(2) = firstdash - 1 + mpos(1) = firstdash + 1 + ypos(1) = ypos(2) - 3 + + mpos(2) = lastdash - 1 + dpos(1) = lastdash + 1 + dpos(2) = dpos(1) + 1 + + read ( time_string(ypos(1):ypos(2)), * ) year + read ( time_string(mpos(1):mpos(2)), * ) month + read ( time_string(dpos(1):dpos(2)), * ) day + + date = year*10000+month*100+day + _RETURN(_SUCCESS) + + end function string_to_integer_date + + function string_to_esmf_time(input_string,unusable,rc) result(time) + character(len=*), intent(in) :: input_string + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + type(ESMF_Time) :: time + integer :: status + integer :: tpos + integer year,month,day,hour,min,sec + integer :: int_time, int_date + character(len=:), allocatable :: date_string,time_string + + _UNUSED_DUMMY(unusable) + + tpos = index(input_string,'T') + _ASSERT(tpos >0,"Invalid date/time format, missing date/time separator") + + date_string = input_string(:tpos-1) + time_string = input_string(tpos+1:) + int_time = string_to_integer_time(time_string,__RC__) + int_date = string_to_integer_date(date_string,__RC__) + + year=int_date/10000 + month=mod(int_date/100,100) + day=mod(int_date,100) + hour=int_time/10000 + min=mod(int_time/100,100) + sec=mod(int_time,100) + call ESMF_TimeSet(time,yy=year,mm=month,dd=day,h=hour,m=min,s=sec,__RC__) + _RETURN(_SUCCESS) + + end function string_to_esmf_time + + function string_to_esmf_timeinterval(time_interval_string,unusable,rc) result(time_interval) + character(len=*), intent(in) :: time_interval_string + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + type(ESMF_TimeInterval) :: time_interval + integer :: status + + integer :: strlen,ppos,cpos,lpos,tpos + integer year,month,day,hour,min,sec + character(len=:), allocatable :: date_string,time_string + _UNUSED_DUMMY(unusable) + + year=0 + month=0 + day=0 + hour=0 + min=0 + sec=0 + strlen = len_trim(time_interval_string) + tpos = index(time_interval_string,'T') + ppos = index(time_interval_string,'P') + _ASSERT(time_interval_string(1:1) == 'P','Not valid time duration') + + if (tpos /= 0) then + if (tpos /= ppos+1) then + date_string = time_interval_string(ppos+1:tpos-1) + end if + time_string = time_interval_string(tpos+1:strlen) + else + date_string = time_interval_string(ppos+1:strlen) + end if + + if (allocated(date_string)) then + strlen = len_trim(date_string) + lpos = 0 + cpos = index(date_string,'Y') + if (cpos /= 0) then + read(date_string(lpos+1:cpos-1),*)year + lpos = cpos + end if + cpos = index(date_string,'M') + if (cpos /= 0) then + read(date_string(lpos+1:cpos-1),*)month + lpos = cpos + end if + cpos = index(date_string,'D') + if (cpos /= 0) then + read(date_string(lpos+1:cpos-1),*)day + lpos = cpos + end if + end if + if (allocated(time_string)) then + strlen = len_trim(time_string) + lpos = 0 + cpos = index(time_string,'H') + if (cpos /= 0) then + read(time_string(lpos+1:cpos-1),*)hour + lpos = cpos + end if + cpos = index(time_string,'M') + if (cpos /= 0) then + read(time_string(lpos+1:cpos-1),*)min + lpos = cpos + end if + cpos = index(time_string,'S') + if (cpos /= 0) then + read(time_string(lpos+1:cpos-1),*)sec + lpos = cpos + end if + end if + + call ESMF_TimeIntervalSet(time_interval,yy=year,mm=month,d=day,h=hour,m=min,s=sec,__RC__) + _RETURN(_SUCCESS) + + end function string_to_esmf_timeinterval + +end module MAPL_TimeStringConversion From 1ae16a640d87c838477523631a6fb7a772508fd2 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 28 Feb 2022 14:23:24 -0500 Subject: [PATCH 027/300] update changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index bc826de8875e..9e1e70a0636b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Fixed duration of the clock to be the smaller of the user specified duration and (END_DATE - currTime) ### Added +- New cmake option USE_EXTDATA2G to enable the next generation of ExtData for development, by default uses 1st generation ExtData ### Changed From 39e3582a5fc3b7f66c2984fb93be7d340f0b5304 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 28 Feb 2022 17:16:48 -0500 Subject: [PATCH 028/300] more updates for optional use of gocart2g at runtime --- CMakeLists.txt | 22 +++++++++---------- MAPL/MAPL.F90 | 5 ----- Tests/ExtDataDriverGridComp.F90 | 21 ++++++++++++------ gridcomps/CMakeLists.txt | 4 +++- gridcomps/Cap/CMakeLists.txt | 3 ++- gridcomps/Cap/ExternalGCStorage.F90 | 14 ++++++++++++ gridcomps/Cap/MAPL_CapGridComp.F90 | 26 +++++++++++++++-------- gridcomps/ExtData/ExtDataGridCompMod.F90 | 13 ------------ gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 18 ++-------------- 9 files changed, 63 insertions(+), 63 deletions(-) create mode 100644 gridcomps/Cap/ExternalGCStorage.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 86d6bf799d37..23ed7381edeb 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -86,17 +86,17 @@ if(NOT TARGET FARGPARSE::fargparse) endif() -option(USE_EXTDATA2G "Use ExtData2G" OFF) -if(NOT TARGET YAFYAML::yafyaml) - if(USE_EXTDATA2G) - set (EXTDATA_TARGET "MAPL.ExtData2G" CACHE STRING "ExtData Target") - find_package(YAFYAML REQUIRED) - message (STATUS "Building with ExtData2G") - else() - set (EXTDATA_TARGET "MAPL.ExtData" CACHE STRING "ExtData Target") - find_package(YAFYAML QUIET) - message (STATUS "Building with ExtData1G") - endif() +option(USE_EXTDATA2G "Use ExtData2G" ON) +if(USE_EXTDATA2G) + set (EXTDATA2G_TARGET "MAPL.ExtData2G" CACHE STRING "ExtData2G Target") + set (EXTDATA_TARGET "MAPL.ExtData" CACHE STRING "ExtData Target") + find_package(YAFYAML REQUIRED) + message (STATUS "Building with ExtData2G") +else() + set (EXTDATA2G_TARGET "" CACHE STRING "ExtData2G Target") + set (EXTDATA_TARGET "MAPL.ExtData" CACHE STRING "ExtData Target") + find_package(YAFYAML QUIET) + message (STATUS "Building with ExtData1G") endif() option(BUILD_WITH_PFLOGGER "Build MAPL with pFlogger library support" ON) diff --git a/MAPL/MAPL.F90 b/MAPL/MAPL.F90 index be1702de556d..d4c50f293ef8 100644 --- a/MAPL/MAPL.F90 +++ b/MAPL/MAPL.F90 @@ -4,11 +4,6 @@ module MAPL use MAPLBase_mod use MAPL_GenericMod use MAPL_VarSpecMiscMod -#if defined(BUILD_WITH_EXTDATA2G) - use MAPL_ExtDataGridCompNG, only : T_EXTDATA_STATE, EXTDATA_WRAP -#else - use MAPL_ExtDataGridCompMod, only : T_EXTDATA_STATE, EXTDATA_WRAP -#endif use ESMF_CFIOMod use pFIO use MAPL_GridCompsMod diff --git a/Tests/ExtDataDriverGridComp.F90 b/Tests/ExtDataDriverGridComp.F90 index 930fadf9cbb0..fa61f75e1f2b 100644 --- a/Tests/ExtDataDriverGridComp.F90 +++ b/Tests/ExtDataDriverGridComp.F90 @@ -5,10 +5,9 @@ module ExtData_DriverGridCompMod use ESMF use MAPL #if defined(BUILD_WITH_EXTDATA2G) - use MAPL_ExtDataGridCompNG, only : ExtData_SetServices => SetServices -#else - use MAPL_ExtDataGridCompMod, only : ExtData_SetServices => SetServices + use MAPL_ExtDataGridComp2G, only : ExtData2G_SetServices => SetServices #endif + use MAPL_ExtDataGridCompMod, only : ExtData1G_SetServices => SetServices use MAPL_HistoryGridCompMod, only : Hist_SetServices => SetServices use MAPL_Profiler, only : get_global_time_profiler, BaseProfiler @@ -144,6 +143,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) procedure(), pointer :: root_set_services type(ExtData_DriverGridComp), pointer :: cap class(BaseProfiler), pointer :: t_p + logical :: use_extdata2g _UNUSED_DUMMY(import_state) _UNUSED_DUMMY(export_state) @@ -323,10 +323,17 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call MAPL_Set(MAPLOBJ, CF=CAP%CF_EXT, RC=STATUS) _VERIFY(STATUS) - - cap%extdata_id = MAPL_AddChild (MAPLOBJ, name = 'EXTDATA', SS = ExtData_SetServices, rc = status) - _VERIFY(status) - + call MAPL_GetResource(maplobj,use_extdata2g,"USE_EXTDATA2G:",default=.false.,_RC) + if (use_extdata2g) then +#if defined(USE_EXTDATA2G) + cap%extdata_id = MAPL_AddChild (MAPLOBJ, name = 'EXTDATA', SS = ExtData2G_SetServices, _RC) +#else + _FAIL('ExtData2G requested but not built') +#endif + else + cap%extdata_id = MAPL_AddChild (MAPLOBJ, name = 'EXTDATA', SS = ExtData1G_SetServices, _RC) + end if + end if ! Query MAPL for the the children's for GCS, IMPORTS, EXPORTS diff --git a/gridcomps/CMakeLists.txt b/gridcomps/CMakeLists.txt index 00e0b99e9158..6493a3ad2de6 100644 --- a/gridcomps/CMakeLists.txt +++ b/gridcomps/CMakeLists.txt @@ -17,4 +17,6 @@ add_subdirectory(Cap) add_subdirectory(History) add_subdirectory(Orbit) add_subdirectory(ExtData) -add_subdirectory(ExtData2G) +if(USE_EXTDATA2G) + add_subdirectory(ExtData2G) +endif() diff --git a/gridcomps/Cap/CMakeLists.txt b/gridcomps/Cap/CMakeLists.txt index 96b5fc9347e3..85240cec04b0 100644 --- a/gridcomps/Cap/CMakeLists.txt +++ b/gridcomps/Cap/CMakeLists.txt @@ -4,6 +4,7 @@ set (srcs MAPL_CapGridComp.F90 MAPL_NUOPCWrapperMod.F90 CapOptions.F90 + ExternalGCStorage.F90 ) if (BUILD_WITH_FLAP) list (APPEND srcs FlapCLI.F90) @@ -11,7 +12,7 @@ endif() esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.profiler MAPL.history - ${EXTDATA_TARGET} TYPE ${MAPL_LIBRARY_TYPE}) + ${EXTDATA_TARGET} ${EXTDATA2G_TARGET} TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran $<$:FLAP::FLAP>) diff --git a/gridcomps/Cap/ExternalGCStorage.F90 b/gridcomps/Cap/ExternalGCStorage.F90 new file mode 100644 index 000000000000..e5660c6f0671 --- /dev/null +++ b/gridcomps/Cap/ExternalGCStorage.F90 @@ -0,0 +1,14 @@ +module MAPL_ExternalGCStorage +use esmf +implicit none + +type ExternalGCStorage + type(ESMF_State) :: expState + type(ESMF_GridComp) :: gc +end type ExternalGCStorage + +type ExternalGCStorageWrap + type (ExternalGCStorage), pointer :: PTR +end type ExternalGCStorageWrap + +end module MAPL_ExternalGCStorage diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index 1baa30d6e4f5..fd289b9b7be7 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -18,12 +18,9 @@ module MAPL_CapGridCompMod use MAPL_HistoryGridCompMod, only : Hist_SetServices => SetServices use MAPL_HistoryGridCompMod, only : HISTORY_ExchangeListWrap #if defined(BUILD_WITH_EXTDATA2G) - use MAPL_ExtDataGridCompNG, only : ExtData_SetServices => SetServices - use MAPL_ExtDataGridCompNG, only : T_EXTDATA_STATE, EXTDATA_WRAP -#else - use MAPL_ExtDataGridCompMod, only : ExtData_SetServices => SetServices - use MAPL_ExtDataGridCompMod, only : T_EXTDATA_STATE, EXTDATA_WRAP + use MAPL_ExtDataGridComp2G, only : ExtData2G_SetServices => SetServices #endif + use MAPL_ExtDataGridCompMod, only : ExtData1G_SetServices => SetServices use MAPL_ConfigMod use MAPL_DirPathMod use MAPL_KeywordEnforcerMod @@ -33,6 +30,7 @@ module MAPL_CapGridCompMod use gFTL_StringVector use pflogger, only: logging, Logger use MAPL_TimeUtilsMod, only: is_valid_time, is_valid_date + use MAPL_ExternalGCStorage use iso_fortran_env @@ -178,8 +176,8 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) integer :: status - type (T_ExtData_STATE), pointer :: ExtData_internal_state => null() - type (ExtData_wrap) :: wrap + type (externalGCStorage), pointer :: ExtData_internal_state => null() + type (externalGCStorageWrap) :: wrap character(len=ESMF_MAXSTR ) :: timerModeStr @@ -215,6 +213,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) class(BaseProfiler), pointer :: t_p class(Logger), pointer :: lgr type(ESMF_Clock) :: cap_clock + logical :: use_extdata2g _UNUSED_DUMMY(import_state) _UNUSED_DUMMY(export_state) @@ -571,8 +570,17 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call MAPL_Set(MAPLOBJ, CF=CAP%CF_EXT, RC=STATUS) _VERIFY(STATUS) - cap%extdata_id = MAPL_AddChild (MAPLOBJ, name = 'EXTDATA', SS = ExtData_SetServices, rc = status) - _VERIFY(status) + call MAPL_GetResource(maplobj,use_extdata2g,"USE_EXTDATA2G:",default=.false.,_RC) + if (use_extdata2g) then +#if defined(USE_EXTDATA2G) + cap%extdata_id = MAPL_AddChild (MAPLOBJ, name = 'EXTDATA', SS = ExtData2G_SetServices, _RC) +#else + call lgr%error('ExtData2G reque3sted but not built') + _FAIL('ExtData2G requested but not built') +#endif + else + cap%extdata_id = MAPL_AddChild (MAPLOBJ, name = 'EXTDATA', SS = ExtData1G_SetServices, _RC) + end if call t_p%stop('SetService') ! Add NX and NY from AGCM.rc to ExtData.rc as well as name of ExtData rc file diff --git a/gridcomps/ExtData/ExtDataGridCompMod.F90 b/gridcomps/ExtData/ExtDataGridCompMod.F90 index c728b2e77cbc..786779a7800b 100644 --- a/gridcomps/ExtData/ExtDataGridCompMod.F90 +++ b/gridcomps/ExtData/ExtDataGridCompMod.F90 @@ -64,8 +64,6 @@ MODULE MAPL_ExtDataGridCompMod ! !PUBLIC MEMBER FUNCTIONS: PUBLIC SetServices - public T_EXTDATA_STATE - public EXTDATA_WRAP !EOP ! ! !REVISION HISTORY: @@ -212,17 +210,6 @@ MODULE MAPL_ExtDataGridCompMod type (MAPL_ExtData_State), pointer :: PTR => null() end type MAPL_ExtData_WRAP - type T_EXTDATA_STATE - type(ESMF_State) :: expState - type(ESMF_GridComp) :: gc - end type T_EXTDATA_STATE - - ! Wrapper for extracting internal state - ! ------------------------------------- - type EXTDATA_WRAP - type (T_EXTDATA_STATE), pointer :: PTR - end type EXTDATA_WRAP - class(Logger), pointer :: lgr diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index d7f6174bc1a0..c8611913e235 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -6,7 +6,7 @@ ! NASA/GSFC, Global Modeling and Assimilation Office, Code 910.1 ! !------------------------------------------------------------------------- - MODULE MAPL_ExtDataGridCompNG + MODULE MAPL_ExtDataGridComp2G !BOP ! !MODULE: MAPL_ExtDataGridCompMod - Implements Interface to External Data @@ -63,8 +63,6 @@ MODULE MAPL_ExtDataGridCompNG ! !PUBLIC MEMBER FUNCTIONS: PUBLIC SetServices - public t_extdata_state - public extdata_wrap !EOP ! ! !REVISION HISTORY: @@ -116,18 +114,6 @@ MODULE MAPL_ExtDataGridCompNG type (MAPL_ExtData_State), pointer :: PTR => null() end type MAPL_ExtData_WRAP - type t_extdata_state - type(ESMF_State) :: expState - type(ESMF_GridComp) :: gc - end type t_extdata_state - - ! Wrapper for extracting internal state - ! ------------------------------------- - type extdata_wrap - type (t_extdata_state), pointer :: PTR - end type extdata_wrap - - CONTAINS @@ -2298,4 +2284,4 @@ subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,rc) end subroutine IOBundle_Add_Entry - END MODULE MAPL_ExtDataGridCompNG + END MODULE MAPL_ExtDataGridComp2G From f5ae872b4f3082a07f956858f126819b15f08a8d Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 28 Feb 2022 20:09:10 -0500 Subject: [PATCH 029/300] more flexible mingled names --- Apps/MAPL_GridCompSpecs_ACG.py | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/Apps/MAPL_GridCompSpecs_ACG.py b/Apps/MAPL_GridCompSpecs_ACG.py index b65e51d3a808..5f21e5bb8176 100755 --- a/Apps/MAPL_GridCompSpecs_ACG.py +++ b/Apps/MAPL_GridCompSpecs_ACG.py @@ -79,10 +79,7 @@ def internal_name(name): return name @staticmethod def mangled_name(name): - if name[-1] == '*': - return "'" + name[:-1] + "'//trim(comp_name)" - else: - return "'" + name + "'" + return "'" + name.replace("*","'//trim(comp_name)//'") + "'" # Pointers must be declared regardless of COND status. Deactivated # pointers should not be _referenced_ but such sections should still From 48c77a124456cd49899fe580d8c470552e2de641 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 1 Mar 2022 08:46:32 -0500 Subject: [PATCH 030/300] Update gridcomps/Cap/MAPL_CapGridComp.F90 Co-authored-by: Matthew Thompson --- gridcomps/Cap/MAPL_CapGridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index fd289b9b7be7..b2aec0743546 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -575,7 +575,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) #if defined(USE_EXTDATA2G) cap%extdata_id = MAPL_AddChild (MAPLOBJ, name = 'EXTDATA', SS = ExtData2G_SetServices, _RC) #else - call lgr%error('ExtData2G reque3sted but not built') + call lgr%error('ExtData2G requested but not built') _FAIL('ExtData2G requested but not built') #endif else From 314dccdf76adca00411ef15bf7039284123f6e14 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 1 Mar 2022 08:56:36 -0500 Subject: [PATCH 031/300] change CHANGELOG.md --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0bc2f7908057..b85acdcefbac 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Replaced a wild card "*" in any position of a string in MAPL_GridCompSpecs_ACG.py - Updated `MAPL_SunGetSolarConstantFromNRLFile` to open NRL Solar Table file only on root and broadcast the tables to all processes. Now all processes do interpolation. ### Removed From 6b4dd643fd1d38f4e2e8a106cb6bdb579e406a08 Mon Sep 17 00:00:00 2001 From: Christoph Keller Date: Tue, 1 Mar 2022 08:58:39 -0500 Subject: [PATCH 032/300] Add voting interpolation method as optional argument to SimpleBundle read method --- base/MAPL_SimpleBundleMod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/base/MAPL_SimpleBundleMod.F90 b/base/MAPL_SimpleBundleMod.F90 index fc9ea5bc013a..bc9883ada328 100644 --- a/base/MAPL_SimpleBundleMod.F90 +++ b/base/MAPL_SimpleBundleMod.F90 @@ -751,7 +751,7 @@ end subroutine MAPL_SimpleBundleDestroy ! Function MAPL_SimpleBundleRead (filename, bundle_name, grid, time, verbose, & - only_vars, expid, rc ) result (self) + only_vars, expid, voting, rc ) result (self) ! !ARGUMENTS: @@ -764,6 +764,7 @@ Function MAPL_SimpleBundleRead (filename, bundle_name, grid, time, verbose, & logical, OPTIONAL, intent(in) :: verbose character(len=*), optional, intent(IN) :: only_vars character(len=*), optional, intent(IN) :: expid + logical, optional, intent(IN) :: voting integer, OPTIONAL, intent(out) :: rc ! !DESCRIPTION: @@ -783,7 +784,7 @@ Function MAPL_SimpleBundleRead (filename, bundle_name, grid, time, verbose, & Bundle = ESMF_FieldBundleCreate ( name=bundle_name, __RC__ ) call ESMF_FieldBundleSet ( bundle, grid=Grid, __RC__ ) call MAPL_CFIORead ( filename, Time, Bundle, verbose=verbose, & - ONLY_VARS=only_vars, expid=expid, __RC__ ) + ONLY_VARS=only_vars, expid=expid, voting=voting, __RC__ ) self = MAPL_SimpleBundleCreate ( Bundle, __RC__ ) self%bundleAlloc = .true. From 96b09a9104b736873542b5c48d7857c726552bcb Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 1 Mar 2022 09:44:25 -0500 Subject: [PATCH 033/300] restore original names so as to not make this non-backwards compatible --- gridcomps/Cap/ExternalGCStorage.F90 | 10 +++++----- gridcomps/Cap/MAPL_CapGridComp.F90 | 4 ++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/gridcomps/Cap/ExternalGCStorage.F90 b/gridcomps/Cap/ExternalGCStorage.F90 index e5660c6f0671..8711c21b8126 100644 --- a/gridcomps/Cap/ExternalGCStorage.F90 +++ b/gridcomps/Cap/ExternalGCStorage.F90 @@ -2,13 +2,13 @@ module MAPL_ExternalGCStorage use esmf implicit none -type ExternalGCStorage +type t_extdata_state type(ESMF_State) :: expState type(ESMF_GridComp) :: gc -end type ExternalGCStorage +end type t_extdata_state -type ExternalGCStorageWrap - type (ExternalGCStorage), pointer :: PTR -end type ExternalGCStorageWrap +type extdata_wrap + type (t_extdata_state), pointer :: PTR +end type extdata_wrap end module MAPL_ExternalGCStorage diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index fd289b9b7be7..5651f615960e 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -176,8 +176,8 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) integer :: status - type (externalGCStorage), pointer :: ExtData_internal_state => null() - type (externalGCStorageWrap) :: wrap + type (t_extdata_state), pointer :: ExtData_internal_state => null() + type (extdata_wrap) :: wrap character(len=ESMF_MAXSTR ) :: timerModeStr From c2279757638d9a5229b6d911137d63c00edfc6b8 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 1 Mar 2022 11:00:09 -0500 Subject: [PATCH 034/300] removing "*" for pointer declaration --- Apps/MAPL_GridCompSpecs_ACG.py | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/Apps/MAPL_GridCompSpecs_ACG.py b/Apps/MAPL_GridCompSpecs_ACG.py index 5f21e5bb8176..990e4c63ee2a 100755 --- a/Apps/MAPL_GridCompSpecs_ACG.py +++ b/Apps/MAPL_GridCompSpecs_ACG.py @@ -73,10 +73,8 @@ def get_rank(self): @staticmethod def internal_name(name): - if name[-1] == '*': - return name[:-1] - else: - return name + return name.replace('*','') + @staticmethod def mangled_name(name): return "'" + name.replace("*","'//trim(comp_name)//'") + "'" From e081ccb206c33475f37467b4b689d2d77d445a2d Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 1 Mar 2022 13:39:24 -0500 Subject: [PATCH 035/300] more bug fixes... --- Tests/ExtDataDriverGridComp.F90 | 4 ++-- gridcomps/Cap/MAPL_CapGridComp.F90 | 4 ++-- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 1 + gridcomps/MAPL_GridComps.F90 | 1 + 4 files changed, 6 insertions(+), 4 deletions(-) diff --git a/Tests/ExtDataDriverGridComp.F90 b/Tests/ExtDataDriverGridComp.F90 index fa61f75e1f2b..1b394018695d 100644 --- a/Tests/ExtDataDriverGridComp.F90 +++ b/Tests/ExtDataDriverGridComp.F90 @@ -216,6 +216,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) !EOR enableTimers = ESMF_UtilStringUpperCase(enableTimers, rc = status) _VERIFY(status) + call MAPL_GetResource(maplobj,use_extdata2g,"USE_EXTDATA2G:",default=.false.,_RC) if (enableTimers /= 'YES') then call MAPL_ProfDisable(rc = status) @@ -323,9 +324,8 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call MAPL_Set(MAPLOBJ, CF=CAP%CF_EXT, RC=STATUS) _VERIFY(STATUS) - call MAPL_GetResource(maplobj,use_extdata2g,"USE_EXTDATA2G:",default=.false.,_RC) if (use_extdata2g) then -#if defined(USE_EXTDATA2G) +#if defined(BUILD_WITH_EXTDATA2G) cap%extdata_id = MAPL_AddChild (MAPLOBJ, name = 'EXTDATA', SS = ExtData2G_SetServices, _RC) #else _FAIL('ExtData2G requested but not built') diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index ed71f27ec14e..2b8b92f67530 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -403,6 +403,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) !EOR enableTimers = ESMF_UtilStringUpperCase(enableTimers, rc = status) _VERIFY(status) + call MAPL_GetResource(maplobj,use_extdata2g,"USE_EXTDATA2G:",default=.false.,_RC) if (enableTimers /= 'YES') then call MAPL_ProfDisable(rc = status) @@ -570,9 +571,8 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call MAPL_Set(MAPLOBJ, CF=CAP%CF_EXT, RC=STATUS) _VERIFY(STATUS) - call MAPL_GetResource(maplobj,use_extdata2g,"USE_EXTDATA2G:",default=.false.,_RC) if (use_extdata2g) then -#if defined(USE_EXTDATA2G) +#if defined(BUILD_WITH_EXTDATA2G) cap%extdata_id = MAPL_AddChild (MAPLOBJ, name = 'EXTDATA', SS = ExtData2G_SetServices, _RC) #else call lgr%error('ExtData2G requested but not built') diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index c8611913e235..16804333b70a 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -366,6 +366,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! ----------------------- call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, clock, __RC__ ) + call extdata_lgr%error("Using ExtData2G, note this is still in BETA stage") ! --------------------------- ! Parse ExtData Resource File diff --git a/gridcomps/MAPL_GridComps.F90 b/gridcomps/MAPL_GridComps.F90 index fea600aa200a..daedebb7f624 100644 --- a/gridcomps/MAPL_GridComps.F90 +++ b/gridcomps/MAPL_GridComps.F90 @@ -1,6 +1,7 @@ module MAPL_GridCompsMod use mapl_CapMod use mapl_CapOptionsMod + use mapl_externalGCStorage #ifdef USE_FLAP use mapl_FlapCLIMod #endif From eb2a67cf54207d5f36011ab77f973f259ee1dfee Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 1 Mar 2022 13:49:21 -0500 Subject: [PATCH 036/300] Update gridcomps/ExtData2G/ExtDataDerived.F90 --- gridcomps/ExtData2G/ExtDataDerived.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gridcomps/ExtData2G/ExtDataDerived.F90 b/gridcomps/ExtData2G/ExtDataDerived.F90 index c8ae79b79e4e..86cfbe1d70e1 100644 --- a/gridcomps/ExtData2G/ExtDataDerived.F90 +++ b/gridcomps/ExtData2G/ExtDataDerived.F90 @@ -57,9 +57,9 @@ subroutine set_defaults(this,unusable,rc) class(KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc - _UNUSED_DUMMY(unusable) this%expression='' _RETURN(_SUCCESS) + _UNUSED_DUMMY(unusable) end subroutine set_defaults subroutine display(this) From a0a67468f4f931b7b7217135e7e43f22d1dc5df2 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 1 Mar 2022 15:23:22 -0500 Subject: [PATCH 037/300] Update base/MAPL_SimpleBundleMod.F90 --- base/MAPL_SimpleBundleMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/base/MAPL_SimpleBundleMod.F90 b/base/MAPL_SimpleBundleMod.F90 index caef8ba62c75..b4f8ac953028 100644 --- a/base/MAPL_SimpleBundleMod.F90 +++ b/base/MAPL_SimpleBundleMod.F90 @@ -750,6 +750,7 @@ end subroutine MAPL_SimpleBundleDestroy Function MAPL_SimpleBundleRead (filename, bundle_name, grid, time, verbose, & only_vars, expid, voting, rc ) result (self) + use mapl_KeywordEnforcerMod ! !ARGUMENTS: From 7f075632eaa0ee8aaf84e1a41b008155ed15ca87 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 1 Mar 2022 15:23:28 -0500 Subject: [PATCH 038/300] Update base/MAPL_SimpleBundleMod.F90 --- base/MAPL_SimpleBundleMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/base/MAPL_SimpleBundleMod.F90 b/base/MAPL_SimpleBundleMod.F90 index b4f8ac953028..3aad460481be 100644 --- a/base/MAPL_SimpleBundleMod.F90 +++ b/base/MAPL_SimpleBundleMod.F90 @@ -763,7 +763,8 @@ Function MAPL_SimpleBundleRead (filename, bundle_name, grid, time, verbose, & logical, OPTIONAL, intent(in) :: verbose character(len=*), optional, intent(IN) :: only_vars character(len=*), optional, intent(IN) :: expid - logical, optional, intent(IN) :: voting + class(KeywordEnforcer), optional, intent(in) :: unused + logical, optional, intent(in) :: voting integer, OPTIONAL, intent(out) :: rc ! !DESCRIPTION: From 5e603f1ae0a0b1ba451a13664b04930a8d1bb046 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 1 Mar 2022 16:19:37 -0500 Subject: [PATCH 039/300] Update base/MAPL_SimpleBundleMod.F90 --- base/MAPL_SimpleBundleMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/base/MAPL_SimpleBundleMod.F90 b/base/MAPL_SimpleBundleMod.F90 index 3aad460481be..9139d75273d2 100644 --- a/base/MAPL_SimpleBundleMod.F90 +++ b/base/MAPL_SimpleBundleMod.F90 @@ -763,7 +763,7 @@ Function MAPL_SimpleBundleRead (filename, bundle_name, grid, time, verbose, & logical, OPTIONAL, intent(in) :: verbose character(len=*), optional, intent(IN) :: only_vars character(len=*), optional, intent(IN) :: expid - class(KeywordEnforcer), optional, intent(in) :: unused + class(KeywordEnforcer), optional, intent(in) :: unusable logical, optional, intent(in) :: voting integer, OPTIONAL, intent(out) :: rc From 8b5178df2bbeced9da2754e01496688a77c948df Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 1 Mar 2022 16:20:10 -0500 Subject: [PATCH 040/300] Update base/MAPL_SimpleBundleMod.F90 --- base/MAPL_SimpleBundleMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/base/MAPL_SimpleBundleMod.F90 b/base/MAPL_SimpleBundleMod.F90 index 9139d75273d2..3e9ab23b9ad2 100644 --- a/base/MAPL_SimpleBundleMod.F90 +++ b/base/MAPL_SimpleBundleMod.F90 @@ -749,7 +749,7 @@ end subroutine MAPL_SimpleBundleDestroy ! Function MAPL_SimpleBundleRead (filename, bundle_name, grid, time, verbose, & - only_vars, expid, voting, rc ) result (self) + only_vars, expid, voting, unusable, rc ) result (self) use mapl_KeywordEnforcerMod ! !ARGUMENTS: From c8eb526ebcfae396708b0b51bf9a4905f0a5f8ca Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 2 Mar 2022 10:21:07 -0500 Subject: [PATCH 041/300] cleanup cmake file --- CMakeLists.txt | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 23ed7381edeb..16e8c3219b59 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -86,15 +86,14 @@ if(NOT TARGET FARGPARSE::fargparse) endif() +set (EXTDATA_TARGET "MAPL.ExtData" CACHE STRING "ExtData Target") option(USE_EXTDATA2G "Use ExtData2G" ON) if(USE_EXTDATA2G) set (EXTDATA2G_TARGET "MAPL.ExtData2G" CACHE STRING "ExtData2G Target") - set (EXTDATA_TARGET "MAPL.ExtData" CACHE STRING "ExtData Target") find_package(YAFYAML REQUIRED) message (STATUS "Building with ExtData2G") else() set (EXTDATA2G_TARGET "" CACHE STRING "ExtData2G Target") - set (EXTDATA_TARGET "MAPL.ExtData" CACHE STRING "ExtData Target") find_package(YAFYAML QUIET) message (STATUS "Building with ExtData1G") endif() From a67a4d1c1eb10dc8acc463eefbfeb92bcc8f775e Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 2 Mar 2022 10:35:10 -0500 Subject: [PATCH 042/300] just get rid of ExtData target --- CMakeLists.txt | 2 +- gridcomps/Cap/CMakeLists.txt | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 16e8c3219b59..953f17b2674f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -86,7 +86,7 @@ if(NOT TARGET FARGPARSE::fargparse) endif() -set (EXTDATA_TARGET "MAPL.ExtData" CACHE STRING "ExtData Target") +#set (EXTDATA_TARGET "MAPL.ExtData" CACHE STRING "ExtData Target") option(USE_EXTDATA2G "Use ExtData2G" ON) if(USE_EXTDATA2G) set (EXTDATA2G_TARGET "MAPL.ExtData2G" CACHE STRING "ExtData2G Target") diff --git a/gridcomps/Cap/CMakeLists.txt b/gridcomps/Cap/CMakeLists.txt index 85240cec04b0..07a2fe92b3cb 100644 --- a/gridcomps/Cap/CMakeLists.txt +++ b/gridcomps/Cap/CMakeLists.txt @@ -12,7 +12,7 @@ endif() esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.profiler MAPL.history - ${EXTDATA_TARGET} ${EXTDATA2G_TARGET} TYPE ${MAPL_LIBRARY_TYPE}) + MAPL.ExtData ${EXTDATA2G_TARGET} TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran $<$:FLAP::FLAP>) From 9f47b91100199f86d17b2b1f34455289a9b2417c Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 2 Mar 2022 11:12:13 -0500 Subject: [PATCH 043/300] more changes --- CMakeLists.txt | 2 -- 1 file changed, 2 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 953f17b2674f..14a6beb3af11 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -86,7 +86,6 @@ if(NOT TARGET FARGPARSE::fargparse) endif() -#set (EXTDATA_TARGET "MAPL.ExtData" CACHE STRING "ExtData Target") option(USE_EXTDATA2G "Use ExtData2G" ON) if(USE_EXTDATA2G) set (EXTDATA2G_TARGET "MAPL.ExtData2G" CACHE STRING "ExtData2G Target") @@ -95,7 +94,6 @@ if(USE_EXTDATA2G) else() set (EXTDATA2G_TARGET "" CACHE STRING "ExtData2G Target") find_package(YAFYAML QUIET) - message (STATUS "Building with ExtData1G") endif() option(BUILD_WITH_PFLOGGER "Build MAPL with pFlogger library support" ON) From 0d3d16a8d08d9c12d0aff5df10b34b0aba58ee07 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 3 Mar 2022 15:02:23 -0500 Subject: [PATCH 044/300] Update CHANGELOG.md --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3a7233c8fbf4..efc09e2bed93 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,6 +18,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed - Updated `MAPL_SunGetSolarConstantFromNRLFile` to open NRL Solar Table file only on root and broadcast the tables to all processes. Now all processes do interpolation. +- Add voting interpolation method as optional argument to SimpleBundleRead method ### Removed From d29d4ebb344fc0641dee57ebf25be2691728d784 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 7 Mar 2022 14:07:35 -0500 Subject: [PATCH 045/300] fix duplicate module name, renamed a bunch of variables for clarify while trying to debug something. Fixed gnu build bug for now --- .../ExtData2G/ExtDataClimFileHandler.F90 | 64 +++++++++---------- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 64 +++++++++---------- .../ExtData2G/ExtDataOldTypesCreator.F90 | 5 +- .../ExtData2G/ExtDataSimpleFileHandler.F90 | 34 +++++----- gridcomps/ExtData2G/ExtDataTypeDef.F90 | 2 +- gridcomps/ExtData2G/ExtDataUpdatePointer.F90 | 3 + gridcomps/ExtData2G/ExtData_IOBundleMod.F90 | 30 ++++----- .../ExtData2G/ExtData_IOBundleVectorMod.F90 | 12 ++-- 8 files changed, 107 insertions(+), 107 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataClimFileHandler.F90 b/gridcomps/ExtData2G/ExtDataClimFileHandler.F90 index 21cddb092810..5d2471d23160 100644 --- a/gridcomps/ExtData2G/ExtDataClimFileHandler.F90 +++ b/gridcomps/ExtData2G/ExtDataClimFileHandler.F90 @@ -5,8 +5,6 @@ module MAPL_ExtdataClimFileHandler use MAPL_ExtDataAbstractFileHandler use MAPL_KeywordEnforcerMod use MAPL_ExceptionHandling - use MAPL_ExtDataFileStream - use MAPL_ExtDataFileStreamMap use MAPL_DataCollectionMod use MAPL_CollectionVectorMod use MAPL_DataCollectionManagerMod @@ -38,7 +36,7 @@ subroutine get_file_bracket(this, input_time, source_time, bracket, rc) type(ESMF_Time) :: time integer :: time_index - character(len=ESMF_MAXPATHLEN) :: file + character(len=ESMF_MAXPATHLEN) :: current_file integer :: status type(ESMF_TimeInterval) :: zero type(ESMF_Time) :: target_time @@ -96,29 +94,29 @@ subroutine get_file_bracket(this, input_time, source_time, bracket, rc) call ESMF_TimeIntervalSet(zero,__RC__) if (this%frequency == zero) then - file = this%file_template - call this%get_time_on_file(file,input_time,'L',time_index,time,__RC__) + current_file = this%file_template + call this%get_time_on_file(current_file,input_time,'L',time_index,time,__RC__) _ASSERT(time_index/=time_not_found,"Time not found on file") - call bracket%set_node('L',file=file,time_index=time_index,time=time,__RC__) + call bracket%set_node('L',file=current_file,time_index=time_index,time=time,__RC__) if (bracket%left_node == bracket%right_node) then call bracket%swap_node_fields(rc=status) _VERIFY(status) else bracket%new_file_left=.true. end if - call this%get_time_on_file(file,input_time,'R',time_index,time,__RC__) + call this%get_time_on_file(current_file,input_time,'R',time_index,time,__RC__) _ASSERT(time_index/=time_not_found,"Time not found on file") - call bracket%set_node('R',file=file,time_index=time_index,time=time,__RC__) + call bracket%set_node('R',file=current_file,time_index=time_index,time=time,__RC__) bracket%new_file_right=.true. else - call this%get_file(file,target_time,0,__RC__) - call this%get_time_on_file(file,target_time,'L',time_index,time,rc=status) + call this%get_file(current_file,target_time,0,__RC__) + call this%get_time_on_file(current_file,target_time,'L',time_index,time,rc=status) if (time_index == time_not_found) then - call this%get_file(file,target_time,-1,__RC__) - call this%get_time_on_file(file,target_time,'L',time_index,time,__RC__) + call this%get_file(current_file,target_time,-1,__RC__) + call this%get_time_on_file(current_file,target_time,'L',time_index,time,__RC__) _ASSERT(time_index/=time_not_found,"Time not found on file") end if - call bracket%set_node('L',file=file,time_index=time_index,time=time,__RC__) + call bracket%set_node('L',file=current_file,time_index=time_index,time=time,__RC__) if (bracket%left_node == bracket%right_node) then call bracket%swap_node_fields(rc=status) _VERIFY(status) @@ -126,14 +124,14 @@ subroutine get_file_bracket(this, input_time, source_time, bracket, rc) bracket%new_file_left=.true. end if - call this%get_file(file,target_time,0,__RC__) - call this%get_time_on_file(file,target_time,'R',time_index,time,rc=status) + call this%get_file(current_file,target_time,0,__RC__) + call this%get_time_on_file(current_file,target_time,'R',time_index,time,rc=status) if (time_index == time_not_found) then - call this%get_file(file,target_time,1,__RC__) - call this%get_time_on_file(file,target_time,'R',time_index,time,__RC__) + call this%get_file(current_file,target_time,1,__RC__) + call this%get_time_on_file(current_file,target_time,'R',time_index,time,__RC__) _ASSERT(time_index/=time_not_found,"Time not found on file") end if - call bracket%set_node('R',file=file,time_index=time_index,time=time,__RC__) + call bracket%set_node('R',file=current_file,time_index=time_index,time=time,__RC__) bracket%new_file_right=.true. end if @@ -144,12 +142,12 @@ subroutine get_file_bracket(this, input_time, source_time, bracket, rc) call ESMF_TimeIntervalSet(zero,__RC__) if (this%frequency == zero) then - file = this%file_template + current_file = this%file_template clim_shift=0 - call this%get_time_on_file(file,target_time,'L',time_index,time,wrap=clim_shift,__RC__) + call this%get_time_on_file(current_file,target_time,'L',time_index,time,wrap=clim_shift,__RC__) _ASSERT(time_index/=time_not_found,"Time not found on file") call swap_year(time,original_year+clim_shift,__RC__) - call bracket%set_node('L',file=file,time_index=time_index,time=time,__RC__) + call bracket%set_node('L',file=current_file,time_index=time_index,time=time,__RC__) if (bracket%left_node == bracket%right_node) then call bracket%swap_node_fields(rc=status) _VERIFY(status) @@ -158,19 +156,19 @@ subroutine get_file_bracket(this, input_time, source_time, bracket, rc) end if clim_shift=0 - call this%get_time_on_file(file,target_time,'R',time_index,time,wrap=clim_shift,__RC__) + call this%get_time_on_file(current_file,target_time,'R',time_index,time,wrap=clim_shift,__RC__) _ASSERT(time_index/=time_not_found,"Time not found on file") call swap_year(time,original_year+clim_shift,__RC__) - call bracket%set_node('R',file=file,time_index=time_index,time=time,__RC__) + call bracket%set_node('R',file=current_file,time_index=time_index,time=time,__RC__) bracket%new_file_right=.true. else - call this%get_file(file,target_time,0,__RC__) - call this%get_time_on_file(file,target_time,'L',time_index,time,rc=status) + call this%get_file(current_file,target_time,0,__RC__) + call this%get_time_on_file(current_file,target_time,'L',time_index,time,rc=status) if (time_index == time_not_found) then - call this%get_file(file,target_time,-1,__RC__) - call this%get_time_on_file(file,target_time,'L',time_index,time,__RC__) + call this%get_file(current_file,target_time,-1,__RC__) + call this%get_time_on_file(current_file,target_time,'L',time_index,time,__RC__) _ASSERT(time_index/=time_not_found,"Time not found on file") call ESMF_TimeGet(target_time,yy=target_year,__RC__) if (target_year > this%clim_year) then @@ -187,13 +185,13 @@ subroutine get_file_bracket(this, input_time, source_time, bracket, rc) else bracket%new_file_left=.true. end if - call bracket%set_node('L',file=file,time_index=time_index,time=time,__RC__) + call bracket%set_node('L',file=current_file,time_index=time_index,time=time,__RC__) - call this%get_file(file,target_time,0,__RC__) - call this%get_time_on_file(file,target_time,'R',time_index,time,rc=status) + call this%get_file(current_file,target_time,0,__RC__) + call this%get_time_on_file(current_file,target_time,'R',time_index,time,rc=status) if (time_index == time_not_found) then - call this%get_file(file,target_time,1,__RC__) - call this%get_time_on_file(file,target_time,'R',time_index,time,__RC__) + call this%get_file(current_file,target_time,1,__RC__) + call this%get_time_on_file(current_file,target_time,'R',time_index,time,__RC__) _ASSERT(time_index/=time_not_found,"Time not found on file") call ESMF_TimeGet(target_time,yy=target_year,__RC__) if (target_year < this%clim_year) then @@ -204,7 +202,7 @@ subroutine get_file_bracket(this, input_time, source_time, bracket, rc) else call swap_year(time,original_year,__RC__) end if - call bracket%set_node('R',file=file,time_index=time_index,time=time,__RC__) + call bracket%set_node('R',file=current_file,time_index=time_index,time=time,__RC__) bracket%new_file_right=.true. end if diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index 16804333b70a..5122856c5a77 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -39,8 +39,8 @@ MODULE MAPL_ExtDataGridComp2G use ESMF_CFIOCollectionMod use MAPL_ConfigMod use MAPL_GridManagerMod - use MAPL_ExtData_IOBundleMod - use MAPL_ExtData_IOBundleVectorMod + use MAPL_ExtDataNG_IOBundleMod + use MAPL_ExtDataNG_IOBundleVectorMod use MAPL_ExceptionHandling use MAPL_DataCollectionMod use MAPL_CollectionVectorMod @@ -420,7 +420,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) item => self%primary%item(i) - item%pfioCollection_id = MAPL_DataAddCollection(item%file) + item%pfioCollection_id = MAPL_DataAddCollection(item%file_template) ! Read the single step files (read interval equal to zero) ! -------------------------------------------------------- @@ -464,7 +464,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call GetLevs(item,__RC__) call ESMF_VMBarrier(vm) ! register collections - item%iclient_collection_id=i_clients%add_ext_collection(trim(item%file)) + item%iclient_collection_id=i_clients%add_ext_collection(trim(item%file_template)) ! create interpolating fields, check if the vertical levels match the file if (item%vartype == MAPL_FieldItem) then @@ -659,9 +659,9 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) integer :: bracket_side integer :: entry_num - type(IOBundleVector), target :: IOBundles - type(IOBundleVectorIterator) :: bundle_iter - type(ExtData_IOBundle), pointer :: io_bundle + type(IOBundleNGVector), target :: IOBundles + type(IOBundleNGVectorIterator) :: bundle_iter + type(ExtDataNG_IOBundle), pointer :: io_bundle _UNUSED_DUMMY(IMPORT) _UNUSED_DUMMY(EXPORT) @@ -721,7 +721,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN Write(*,*) ' ' Write(*,'(a,I0.3,a,I0.3,a,a)') 'ExtData Run_: READ_LOOP: variable ', i, ' of ', self%primary%nItems, ': ', trim(item%var) - Write(*,*) ' ==> file: ', trim(item%file) + Write(*,*) ' ==> file: ', trim(item%file_template) Write(*,*) ' ==> isConst: ', item%isConst ENDIF @@ -825,7 +825,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) Write(*,*) ' ' Write(*,'(a)') 'ExtData Run_: INTERP_LOOP: interpolating between bracket times' Write(*,*) ' ==> variable: ', trim(item%var) - Write(*,*) ' ==> file: ', trim(item%file) + Write(*,*) ' ==> file: ', trim(item%file_template) ENDIF ! finally interpolate between bracketing times @@ -1000,7 +1000,7 @@ logical function PrimaryExportIsConstant_(item) type(PrimaryExport), intent(in) :: item if ( item%update_freq%is_single_shot() .or. & - trim(item%file) == '/dev/null' ) then + trim(item%file_template) == '/dev/null' ) then PrimaryExportIsConstant_ = .true. else PrimaryExportIsConstant_ = .false. @@ -1115,13 +1115,13 @@ subroutine GetLevs(item, rc) var => null() if (item%isVector) then var=>item%file_metadata%get_variable(trim(item%fcomp1)) - _ASSERT(associated(var),"Variable "//TRIM(item%fcomp1)//" not found in file "//TRIM(item%file)) + _ASSERT(associated(var),"Variable "//TRIM(item%fcomp1)//" not found in file "//TRIM(item%file_template)) var => null() var=>item%file_metadata%get_variable(trim(item%fcomp2)) - _ASSERT(associated(var),"Variable "//TRIM(item%fcomp2)//" not found in file "//TRIM(item%file)) + _ASSERT(associated(var),"Variable "//TRIM(item%fcomp2)//" not found in file "//TRIM(item%file_template)) else var=>item%file_metadata%get_variable(trim(item%var)) - _ASSERT(associated(var),"Variable "//TRIM(item%var)//" not found in file "//TRIM(item%file)) + _ASSERT(associated(var),"Variable "//TRIM(item%var)//" not found in file "//TRIM(item%file_template)) end if levName = item%file_metadata%get_level_name(rc=status) @@ -2144,11 +2144,11 @@ subroutine MAPL_ExtDataPopulateBundle(item,filec,pbundle,rc) end subroutine MAPL_ExtDataPopulateBundle subroutine MAPL_ExtDataCreateCFIO(IOBundles, rc) - type(IOBundleVector), target, intent(inout) :: IOBundles + type(IOBundleNGVector), target, intent(inout) :: IOBundles integer, optional, intent(out ) :: rc - type (IoBundleVectorIterator) :: bundle_iter - type (ExtData_IoBundle), pointer :: io_bundle + type (IOBundleNGVectorIterator) :: bundle_iter + type (ExtDataNG_IOBundle), pointer :: io_bundle integer :: status bundle_iter = IOBundles%begin() @@ -2163,11 +2163,11 @@ subroutine MAPL_ExtDataCreateCFIO(IOBundles, rc) end subroutine MAPL_ExtDataCreateCFIO subroutine MAPL_ExtDataDestroyCFIO(IOBundles,rc) - type(IOBundleVector), target, intent(inout) :: IOBundles + type(IOBundleNGVector), target, intent(inout) :: IOBundles integer, optional, intent(out ) :: rc - type(IoBundleVectorIterator) :: bundle_iter - type (ExtData_IoBundle), pointer :: io_bundle + type(IOBundleNGVectorIterator) :: bundle_iter + type (ExtDataNG_IOBundle), pointer :: io_bundle integer :: status bundle_iter = IOBundles%begin() @@ -2183,11 +2183,11 @@ subroutine MAPL_ExtDataDestroyCFIO(IOBundles,rc) end subroutine MAPL_ExtDataDestroyCFIO subroutine MAPL_ExtDataPrefetch(IOBundles,rc) - type(IoBundleVector), target, intent(inout) :: IOBundles + type(IOBundleNGVector), target, intent(inout) :: IOBundles integer, optional, intent(out ) :: rc integer :: n,nfiles - type(ExtData_IoBundle), pointer :: io_bundle => null() + type(ExtDataNG_IOBundle), pointer :: io_bundle => null() integer :: status nfiles = IOBundles%size() @@ -2203,11 +2203,11 @@ subroutine MAPL_ExtDataPrefetch(IOBundles,rc) end subroutine MAPL_ExtDataPrefetch subroutine MAPL_ExtDataReadPrefetch(IOBundles,rc) - type(IOBundleVector), target, intent(inout) :: IOBundles + type(IOBundleNGVector), target, intent(inout) :: IOBundles integer, optional, intent(out ) :: rc integer :: nfiles, n - type (ExtData_IoBundle), pointer :: io_bundle + type (ExtDataNG_IOBundle), pointer :: io_bundle integer :: status @@ -2249,36 +2249,36 @@ end subroutine createFileLevBracket subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,rc) - type(Iobundlevector), intent(inout) :: IOBundles + type(IOBundleNGVector), intent(inout) :: IOBundles type(primaryExport), intent(inout) :: item integer, intent(in) :: entry_num integer, intent(out), optional :: rc integer :: status - type (ExtData_IOBundle) :: io_bundle + type (ExtDataNG_IOBundle) :: io_bundle type (GriddedIOItemVector) :: items logical :: update - character(len=ESMF_MAXPATHLEN) :: file + character(len=ESMF_MAXPATHLEN) :: current_file integer :: time_index - call item%modelGridFields%comp1%get_parameters('L',update=update,file=file,time_index=time_index) + call item%modelGridFields%comp1%get_parameters('L',update=update,file=current_file,time_index=time_index) if (update) then call items%push_back(item%fileVars) - io_bundle = ExtData_IOBundle(MAPL_ExtDataLeft, entry_num, file, time_index, item%trans, item%fracval, item%file, & + io_bundle = ExtDataNG_IOBundle(MAPL_ExtDataLeft, entry_num, current_file, time_index, item%trans, item%fracval, item%file_template, & item%pfioCollection_id,item%iclient_collection_id,items,rc=status) _VERIFY(status) call IOBundles%push_back(io_bundle) - call extdata_lgr%info('%a update L with with: %a %i2 ',item%name, file, time_index) + call extdata_lgr%info('%a update L with with: %a %i2 ',item%name, current_file, time_index) end if - call item%modelGridFields%comp1%get_parameters('R',update=update,file=file,time_index=time_index) + call item%modelGridFields%comp1%get_parameters('R',update=update,file=current_file,time_index=time_index) if (update) then call items%push_back(item%fileVars) - io_bundle = ExtData_IOBundle(MAPL_ExtDataRight, entry_num, file, time_index, item%trans, item%fracval, item%file, & + io_bundle = ExtDataNG_IOBundle(MAPL_ExtDataRight, entry_num, current_file, time_index, item%trans, item%fracval, item%file_template, & item%pfioCollection_id,item%iclient_collection_id,items,rc=status) _VERIFY(status) call IOBundles%push_back(io_bundle) - call extdata_lgr%info('%a update R with with: %a %i2 ',item%name,file, time_index) + call extdata_lgr%info('%a update R with with: %a %i2 ',item%name,current_file, time_index) end if _RETURN(ESMF_SUCCESS) diff --git a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 index 7e72cb13fb91..8fe8d4bf90e3 100644 --- a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 +++ b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 @@ -75,6 +75,7 @@ subroutine fillin_primary(this,item_name,primary_item,time,clock,unusable,rc) _UNUSED_DUMMY(unusable) rule => this%rule_map%at(trim(item_name)) + write(*,*)"bmaa associated rule ",associated(rule) time_sample => this%sample_map%at(rule%sample_key) if(.not.associated(time_sample)) then @@ -143,10 +144,10 @@ subroutine fillin_primary(this,item_name,primary_item,time,clock,unusable,rc) primary_item%isConst = .false. if (index(rule%collection,"/dev/null")==0) then dataset => this%file_stream_map%at(trim(rule%collection)) - primary_item%file = dataset%file_template + primary_item%file_template = dataset%file_template call dataset%detect_metadata(primary_item%file_metadata,time,get_range=(trim(time_sample%extrap_outside) /= "none"),__RC__) else - primary_item%file = rule%collection + primary_item%file_template = rule%collection end if if (index(rule%collection,'/dev/null') /= 0) then diff --git a/gridcomps/ExtData2G/ExtDataSimpleFileHandler.F90 b/gridcomps/ExtData2G/ExtDataSimpleFileHandler.F90 index 2c7df5cad502..a5875a6c1de8 100644 --- a/gridcomps/ExtData2G/ExtDataSimpleFileHandler.F90 +++ b/gridcomps/ExtData2G/ExtDataSimpleFileHandler.F90 @@ -5,8 +5,6 @@ module MAPL_ExtdataSimpleFileHandler use MAPL_ExtDataAbstractFileHandler use MAPL_KeywordEnforcerMod use MAPL_ExceptionHandling - use MAPL_ExtDataFileStream - use MAPL_ExtDataFileStreamMap use MAPL_DataCollectionMod use MAPL_CollectionVectorMod use MAPL_DataCollectionManagerMod @@ -39,7 +37,7 @@ subroutine get_file_bracket(this, input_time, source_time, bracket, rc) type(ESMF_Time) :: time integer :: time_index - character(len=ESMF_MAXPATHLEN) :: file + character(len=ESMF_MAXPATHLEN) :: current_file logical :: get_left, get_right,in_range,was_set type(ESMF_Time) :: target_time @@ -72,11 +70,11 @@ subroutine get_file_bracket(this, input_time, source_time, bracket, rc) call ESMF_TimeIntervalSet(zero,__RC__) if (this%frequency == zero) then - file = this%file_template + current_file = this%file_template if (get_left) then - call this%get_time_on_file(file,target_time,'L',time_index,time,__RC__) + call this%get_time_on_file(current_file,target_time,'L',time_index,time,__RC__) _ASSERT(time_index/=time_not_found,"Time not found in file") - call bracket%set_node('L',file=file,time_index=time_index,time=time,__RC__) + call bracket%set_node('L',file=current_file,time_index=time_index,time=time,__RC__) if (in_range .and. (bracket%left_node == bracket%right_node)) then call bracket%swap_node_fields(rc=status) _VERIFY(status) @@ -86,21 +84,21 @@ subroutine get_file_bracket(this, input_time, source_time, bracket, rc) end if end if if (get_right) then - call this%get_time_on_file(file,target_time,'R',time_index,time,__RC__) + call this%get_time_on_file(current_file,target_time,'R',time_index,time,__RC__) _ASSERT(time_index/=time_not_found,"Time not found in file") - call bracket%set_node('R',file=file,time_index=time_index,time=time,__RC__) + call bracket%set_node('R',file=current_file,time_index=time_index,time=time,__RC__) bracket%new_file_right=.true. end if else if (get_left) then - call this%get_file(file,target_time,0,__RC__) - call this%get_time_on_file(file,target_time,'L',time_index,time,__RC__) + call this%get_file(current_file,target_time,0,__RC__) + call this%get_time_on_file(current_file,target_time,'L',time_index,time,__RC__) if (time_index == time_not_found) then - call this%get_file(file,target_time,-1,__RC__) - call this%get_time_on_file(file,target_time,'L',time_index,time,__RC__) + call this%get_file(current_file,target_time,-1,__RC__) + call this%get_time_on_file(current_file,target_time,'L',time_index,time,__RC__) _ASSERT(time_index/=time_not_found,"Time not found in file") end if - call bracket%set_node('L',file=file,time_index=time_index,time=time,__RC__) + call bracket%set_node('L',file=current_file,time_index=time_index,time=time,__RC__) if (in_range .and. (bracket%left_node == bracket%right_node)) then call bracket%swap_node_fields(rc=status) _VERIFY(status) @@ -111,14 +109,14 @@ subroutine get_file_bracket(this, input_time, source_time, bracket, rc) end if if (get_right) then - call this%get_file(file,target_time,0,__RC__) - call this%get_time_on_file(file,target_time,'R',time_index,time,__RC__) + call this%get_file(current_file,target_time,0,__RC__) + call this%get_time_on_file(current_file,target_time,'R',time_index,time,__RC__) if (time_index == time_not_found) then - call this%get_file(file,target_time,1,__RC__) - call this%get_time_on_file(file,target_time,'R',time_index,time,__RC__) + call this%get_file(current_file,target_time,1,__RC__) + call this%get_time_on_file(current_file,target_time,'R',time_index,time,__RC__) _ASSERT(time_index /= time_not_found,"Time not found in file") end if - call bracket%set_node('R',file=file,time_index=time_index,time=time,__RC__) + call bracket%set_node('R',file=current_file,time_index=time_index,time=time,__RC__) bracket%new_file_right=.true. end if diff --git a/gridcomps/ExtData2G/ExtDataTypeDef.F90 b/gridcomps/ExtData2G/ExtDataTypeDef.F90 index 48e2ecd26231..e1d2f953b5dd 100644 --- a/gridcomps/ExtData2G/ExtDataTypeDef.F90 +++ b/gridcomps/ExtData2G/ExtDataTypeDef.F90 @@ -27,7 +27,7 @@ module MAPL_ExtDataTypeDef character(len=ESMF_MAXSTR) :: units='' integer :: Trans character(len=ESMF_MAXSTR) :: var - character(len=ESMF_MAXPATHLEN) :: file ! remove + character(len=ESMF_MAXPATHLEN) :: file_template ! remove logical :: isConst real :: Const !remove diff --git a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 index 79e31dc6e83f..7b71faf2074e 100644 --- a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 +++ b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 @@ -7,6 +7,9 @@ module MAPL_ExtDataPointerUpdate use MAPL_ExceptionHandling use MAPL_TimeStringConversion implicit none + private + + public :: ExtDataPointerUpdate type :: ExtDataPointerUpdate private diff --git a/gridcomps/ExtData2G/ExtData_IOBundleMod.F90 b/gridcomps/ExtData2G/ExtData_IOBundleMod.F90 index 888bba679249..1e116ee47a8d 100644 --- a/gridcomps/ExtData2G/ExtData_IOBundleMod.F90 +++ b/gridcomps/ExtData2G/ExtData_IOBundleMod.F90 @@ -6,7 +6,7 @@ ! NASA/GSFC, Global Modeling and Assimilation Office, Code 610.1 ! !------------------------------------------------------------------------- -module MAPL_ExtData_IOBundleMod +module MAPL_ExtDataNG_IOBundleMod use ESMF use MAPL_BaseMod use MAPL_GriddedIOMod @@ -14,9 +14,9 @@ module MAPL_ExtData_IOBundleMod use MAPL_GriddedIOItemMod use MAPL_GriddedIOItemVectorMod - public :: ExtData_IoBundle + public :: ExtDataNG_IOBundle - type ExtData_IoBundle + type ExtDataNG_IOBundle type (MAPL_GriddedIO) :: cfio type (ESMF_FieldBundle) :: pbundle character(:), allocatable :: template @@ -37,17 +37,17 @@ module MAPL_ExtData_IOBundleMod procedure :: make_cfio procedure :: assign generic :: assignment(=) => assign - end type ExtData_IoBundle + end type ExtDataNG_IOBundle - interface ExtData_IoBundle - module procedure new_ExtData_IoBundle - end interface ExtData_IoBundle + interface ExtDataNG_IOBundle + module procedure new_ExtDataNG_IOBundle + end interface ExtDataNG_IOBundle contains - function new_ExtData_IoBundle(bracket_side, entry_index, file_name, time_index, regrid_method, fraction, template, metadata_coll_id,server_coll_id,items,rc) result(io_bundle) - type (ExtData_IoBundle) :: io_bundle + function new_ExtDataNG_IOBundle(bracket_side, entry_index, file_name, time_index, regrid_method, fraction, template, metadata_coll_id,server_coll_id,items,rc) result(io_bundle) + type (ExtDataNG_IOBundle) :: io_bundle integer, intent(in) :: bracket_side integer, intent(in) :: entry_index @@ -74,11 +74,11 @@ function new_ExtData_IoBundle(bracket_side, entry_index, file_name, time_index, io_bundle%items=items _RETURN(ESMF_SUCCESS) - end function new_ExtData_IoBundle + end function new_ExtDataNG_IOBundle subroutine clean(this, rc) - class (ExtData_IoBundle), intent(inout) :: this + class (ExtDataNG_IOBundle), intent(inout) :: this integer, optional, intent(out) :: rc integer :: status @@ -91,7 +91,7 @@ end subroutine clean subroutine make_cfio(this, rc) - class (ExtData_IoBundle), intent(inout) :: this + class (ExtDataNG_IOBundle), intent(inout) :: this integer, optional, intent(out) :: rc this%cfio = MAPL_GriddedIO(output_bundle=this%pbundle,regrid_method=this%regrid_method, & @@ -104,8 +104,8 @@ subroutine make_cfio(this, rc) end subroutine make_cfio subroutine assign(to,from) - class(ExtData_IOBundle), intent(out) :: to - type(ExtData_IOBundle), intent(in) :: from + class(ExtDataNG_IOBundle), intent(out) :: to + type(ExtDataNG_IOBundle), intent(in) :: from to%bracket_side = from%bracket_side to%entry_index = from%entry_index @@ -123,5 +123,5 @@ subroutine assign(to,from) end subroutine assign -end module MAPL_ExtData_IOBundleMod +end module MAPL_ExtDataNG_IOBundleMod diff --git a/gridcomps/ExtData2G/ExtData_IOBundleVectorMod.F90 b/gridcomps/ExtData2G/ExtData_IOBundleVectorMod.F90 index 508fdc8ecf63..cdfc72c49b06 100644 --- a/gridcomps/ExtData2G/ExtData_IOBundleVectorMod.F90 +++ b/gridcomps/ExtData2G/ExtData_IOBundleVectorMod.F90 @@ -1,10 +1,10 @@ -module MAPL_ExtData_IOBundleVectorMod - use MAPL_ExtData_IOBundleMod +module MAPL_ExtDataNG_IOBundleVectorMod + use MAPL_ExtDataNG_IOBundleMod -#define _type type(ExtData_IoBundle) -#define _vector IoBundleVector -#define _iterator IoBundleVectorIterator +#define _type type(ExtDataNG_IoBundle) +#define _vector IoBundleNGVector +#define _iterator IoBundleNGVectorIterator #include "templates/vector.inc" -end module MAPL_ExtData_IOBundleVectorMod +end module MAPL_ExtDataNG_IOBundleVectorMod From a92204742b29a984a21a867f425f8dbc71ae4109 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 7 Mar 2022 14:34:42 -0500 Subject: [PATCH 046/300] remove a print --- gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 index 8fe8d4bf90e3..bdca0eea4066 100644 --- a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 +++ b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 @@ -75,7 +75,6 @@ subroutine fillin_primary(this,item_name,primary_item,time,clock,unusable,rc) _UNUSED_DUMMY(unusable) rule => this%rule_map%at(trim(item_name)) - write(*,*)"bmaa associated rule ",associated(rule) time_sample => this%sample_map%at(rule%sample_key) if(.not.associated(time_sample)) then From c6fa5007e7cfecb76e614875458e4ea2b23733e3 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 8 Mar 2022 16:43:14 -0500 Subject: [PATCH 047/300] more bug fixes exposed by gcc and cleanup --- CMakeLists.txt | 6 +++--- gridcomps/ExtData2G/ExtDataAbstractFileHandler.F90 | 4 +++- gridcomps/ExtData2G/ExtDataBracket.F90 | 5 +++-- gridcomps/ExtData2G/ExtDataClimFileHandler.F90 | 3 ++- gridcomps/ExtData2G/ExtDataFileStream.F90 | 4 ---- gridcomps/ExtData2G/ExtDataNode.F90 | 2 +- gridcomps/ExtData2G/ExtDataRule.F90 | 2 ++ gridcomps/ExtData2G/ExtDataSimpleFileHandler.F90 | 5 ++--- 8 files changed, 16 insertions(+), 15 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 14a6beb3af11..168fc15997a9 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -85,15 +85,15 @@ if(NOT TARGET FARGPARSE::fargparse) find_package(FARGPARSE QUIET) endif() - option(USE_EXTDATA2G "Use ExtData2G" ON) if(USE_EXTDATA2G) set (EXTDATA2G_TARGET "MAPL.ExtData2G" CACHE STRING "ExtData2G Target") - find_package(YAFYAML REQUIRED) + if(NOT TARGET YAFYAML::yafyaml) + find_package(YAFYAML REQUIRED) + endif() message (STATUS "Building with ExtData2G") else() set (EXTDATA2G_TARGET "" CACHE STRING "ExtData2G Target") - find_package(YAFYAML QUIET) endif() option(BUILD_WITH_PFLOGGER "Build MAPL with pFlogger library support" ON) diff --git a/gridcomps/ExtData2G/ExtDataAbstractFileHandler.F90 b/gridcomps/ExtData2G/ExtDataAbstractFileHandler.F90 index 1dd10c79c3cc..ec003f7276a6 100644 --- a/gridcomps/ExtData2G/ExtDataAbstractFileHandler.F90 +++ b/gridcomps/ExtData2G/ExtDataAbstractFileHandler.F90 @@ -64,7 +64,9 @@ subroutine initialize(this,file_series,persist_closest,unusable,rc) this%file_template = file_series%file_template this%frequency = file_series%frequency this%reff_time = file_series%reff_time - allocate(this%valid_range,source=file_series%valid_range) + if (allocated(file_series%valid_range)) then + allocate(this%valid_range,source=file_series%valid_range) + end if this%collection_id = file_series%collection_id if (present(persist_closest)) then this%persist_closest = persist_closest diff --git a/gridcomps/ExtData2G/ExtDataBracket.F90 b/gridcomps/ExtData2G/ExtDataBracket.F90 index ab5f84e7fe70..d887b73c8f42 100644 --- a/gridcomps/ExtData2G/ExtDataBracket.F90 +++ b/gridcomps/ExtData2G/ExtDataBracket.F90 @@ -39,11 +39,12 @@ subroutine reset(this) this%new_file_left =.false. end subroutine reset - logical function time_in_bracket(this,time) + function time_in_bracket(this,time) result(in_bracket) class(ExtDataBracket), intent(in) :: this + logical :: in_bracket type(ESMF_Time), intent(in) :: time - time_in_bracket = (this%left_node%time <=time) .and. (time < this%right_node%time) + in_bracket = (this%left_node%time <=time) .and. (time < this%right_node%time) end function time_in_bracket diff --git a/gridcomps/ExtData2G/ExtDataClimFileHandler.F90 b/gridcomps/ExtData2G/ExtDataClimFileHandler.F90 index 5d2471d23160..8dc2619aae33 100644 --- a/gridcomps/ExtData2G/ExtDataClimFileHandler.F90 +++ b/gridcomps/ExtData2G/ExtDataClimFileHandler.F90 @@ -68,7 +68,8 @@ subroutine get_file_bracket(this, input_time, source_time, bracket, rc) call ESMF_TimeGet(target_time,yy=target_year,__RC__) original_year=target_year - if (size(source_years)>0) then + !if (size(source_years)>0) then + if (allocated(source_years)) then if (target_year < source_years(1)) then target_year = source_years(1) this%clim_year = target_year diff --git a/gridcomps/ExtData2G/ExtDataFileStream.F90 b/gridcomps/ExtData2G/ExtDataFileStream.F90 index 9f84e4639e4b..bee7c4208ab5 100644 --- a/gridcomps/ExtData2G/ExtDataFileStream.F90 +++ b/gridcomps/ExtData2G/ExtDataFileStream.F90 @@ -169,10 +169,6 @@ subroutine detect_metadata(this,metadata_out,time,get_range,rc) this%valid_range(2)=time_series(size(time_series)) end if end if - if (get_range_) then - call ESMF_TimePrint(this%valid_range(1),options='string') - call ESMF_TimePrint(this%valid_range(2),options='string') - end if if (get_range_) then call fill_grads_template(filename,this%file_template,time=this%valid_range(1),__RC__) diff --git a/gridcomps/ExtData2G/ExtDataNode.F90 b/gridcomps/ExtData2G/ExtDataNode.F90 index 2726b6428ba9..3270f9868f9c 100644 --- a/gridcomps/ExtData2G/ExtDataNode.F90 +++ b/gridcomps/ExtData2G/ExtDataNode.F90 @@ -13,7 +13,7 @@ module MAPL_ExtDataNode type(ESMF_Time) :: time character(len=ESMF_MAXPATHLEN) :: file integer :: time_index - logical :: was_set + logical :: was_set = .false. contains procedure :: set procedure :: get diff --git a/gridcomps/ExtData2G/ExtDataRule.F90 b/gridcomps/ExtData2G/ExtDataRule.F90 index ef3bb8951a63..fa9ee35db272 100644 --- a/gridcomps/ExtData2G/ExtDataRule.F90 +++ b/gridcomps/ExtData2G/ExtDataRule.F90 @@ -73,6 +73,8 @@ function new_ExtDataRule(config,sample_map,key,unusable,rc) result(rule) else _ASSERT(.false.,"sample entry unsupported") end if + else + rule%sample_key = "" end if if (allocated(rule%linear_trans)) deallocate(rule%linear_trans) diff --git a/gridcomps/ExtData2G/ExtDataSimpleFileHandler.F90 b/gridcomps/ExtData2G/ExtDataSimpleFileHandler.F90 index a5875a6c1de8..7395aec3fb49 100644 --- a/gridcomps/ExtData2G/ExtDataSimpleFileHandler.F90 +++ b/gridcomps/ExtData2G/ExtDataSimpleFileHandler.F90 @@ -41,21 +41,20 @@ subroutine get_file_bracket(this, input_time, source_time, bracket, rc) logical :: get_left, get_right,in_range,was_set type(ESMF_Time) :: target_time - get_left=.true. get_right=.true. in_range=.true. target_time=input_time call bracket%set_parameters(intermittent_disable=.false.) if (this%persist_closest) then - if (input_time < this%valid_range(1)) then + if (input_time <= this%valid_range(1)) then target_time = this%valid_range(1) get_right = .false. in_range = .false. call bracket%get_node('L',was_set=was_set) if (was_set) get_left=.false. call bracket%set_parameters(intermittent_disable=.true.) - else if (input_time > this%valid_range(2)) then + else if (input_time >= this%valid_range(2)) then target_time = this%valid_range(2) get_right = .false. in_range = .false. From 1734aee0f81f08bed528625e8fadc9f59b5275db Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 9 Mar 2022 09:16:14 -0500 Subject: [PATCH 048/300] Add Yafyaml explicit need to ExtData2G Cmake --- gridcomps/ExtData2G/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gridcomps/ExtData2G/CMakeLists.txt b/gridcomps/ExtData2G/CMakeLists.txt index 7fc9dd79da0f..6efdc8a2d362 100644 --- a/gridcomps/ExtData2G/CMakeLists.txt +++ b/gridcomps/ExtData2G/CMakeLists.txt @@ -24,7 +24,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.base MAPL.generic MAPL.griddedio TYPE SHARED) -target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran +target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared YAFYAML::yafyaml esmf NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran) target_include_directories (${this} PUBLIC ${INC_ESMF} ${INC_NETCDF} $) From 7d444376152be591a1a0a1f2deb3f8dd2510799c Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 17 Mar 2022 12:49:38 -0400 Subject: [PATCH 049/300] Fixes from M1 work --- CHANGELOG.md | 4 +++- CMakeLists.txt | 4 +++- profiler/MeterNode.F90 | 43 ++++++++++++++++++++++-------------------- 3 files changed, 29 insertions(+), 22 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1d34779882d1..841fcaf4426a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,10 +10,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed - Fixed duration of the clock to be the smaller of the user specified duration and (END_DATE - currTime) +- Fixes for compiling on M1 Macs (remove REAL128) +- Fix for CMake when `esmf` is already a target ### Added -- New cmake option USE_EXTDATA2G to enable the next generation of ExtData for development, by default uses 1st generation ExtData +- New cmake option USE_EXTDATA2G to enable the next generation of ExtData for development, by default uses 1st generation ExtData - MAPL_ESMFFieldBundleRead/Write modules are now available in when using MAPL ### Changed diff --git a/CMakeLists.txt b/CMakeLists.txt index 25b8ad688a85..ec5876cd4e41 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -122,7 +122,9 @@ if (NOT Baselibs_FOUND) add_definitions(-DH5_HAVE_PARALLEL) endif() - find_package(ESMF MODULE REQUIRED) + if (NOT TARGET esmf) + find_package(ESMF MODULE REQUIRED) + endif () endif () if (BUILD_WITH_PFLOGGER) diff --git a/profiler/MeterNode.F90 b/profiler/MeterNode.F90 index b5fd5d0a360d..043b14340671 100644 --- a/profiler/MeterNode.F90 +++ b/profiler/MeterNode.F90 @@ -1,5 +1,5 @@ module MAPL_MeterNode - use, intrinsic :: iso_fortran_env, only: REAL64, REAL128 + use, intrinsic :: iso_fortran_env, only: REAL64 use MAPL_AbstractMeter use MAPL_AbstractMeterNode use MAPL_MeterNodeVector @@ -67,10 +67,10 @@ module MAPL_MeterNode interface MeterNodeIterator module procedure new_MeterNodeIterator end interface MeterNodeIterator - + integer, parameter :: NOT_FOUND = -1 - + contains @@ -79,7 +79,7 @@ function new_MeterNode(name, meter, depth) result(tree) character(*), intent(in) :: name class(AbstractMeter), intent(in) :: meter integer, optional, intent(in) :: depth - + tree%name = name tree%meter = meter @@ -99,14 +99,14 @@ function get_meter(this) result(meter) class (MeterNode), target, intent(in) :: this meter => this%meter end function get_meter - + function get_name(this) result(name) character(:), pointer :: name class (MeterNode), target, intent(in) :: this name => this%name end function get_name - + function get_inclusive(this) result(inclusive) real(kind=REAL64) :: inclusive @@ -121,11 +121,14 @@ function get_exclusive(this) result(exclusive) type (MeterNodevectorIterator) :: iter class (AbstractMeterNode), pointer :: child - real(kind=REAL128) :: tmp + real(kind=REAL64) :: tmp + + ! Subtract time of submeters from time of node meter. + ! Previously, this used 128-bit precision to avoid negative + ! exclusive times due to roundoff. But the GNU on M1 and NVHPC do + ! not allow REAL128. So tmp is now 64-bit and we use a max(tmp,0) + ! below to try and cap negatives - ! Subtract time of submeters from time of node meter. Note the - ! use of 128-bit precision to avoid negative exclusive times due - ! to roundoff. tmp = this%get_inclusive() iter = this%children%begin() @@ -135,7 +138,7 @@ function get_exclusive(this) result(exclusive) call iter%next() end do - exclusive = tmp + exclusive = max(tmp, 0.0_REAL64) end function get_exclusive @@ -178,7 +181,7 @@ function get_child(this, name) result(child) character(*), intent(in) :: name integer :: idx - + idx = this%find_child(name) if (idx /= NOT_FOUND) then child => this%children%at(idx) @@ -232,7 +235,7 @@ recursive integer function get_num_nodes(this) result(num_nodes) type (MeterNodeVectorIterator) :: iter class (AbstractMeterNode), pointer :: child - + num_nodes = 1 iter = this%children%begin() do while (iter /= this%children%end()) @@ -271,7 +274,7 @@ function begin(this) result(iterator) allocate(iterator, source=MeterNodeIterator(this)) end function begin - + function end(this) result(iterator) @@ -293,7 +296,7 @@ function end(this) result(iterator) end function end - + recursive subroutine next(this) class (MeterNodeIterator), intent(inout) :: this class (AbstractMeterNode), pointer :: current_child @@ -318,7 +321,7 @@ recursive subroutine next(this) deallocate(this%iterator_of_current_child) call this%iterator_over_children%next() if (this%iterator_over_children == this%reference%children%end()) then ! done - deallocate(this%iterator_over_children) + deallocate(this%iterator_over_children) else current_child => this%iterator_over_children%get() this%iterator_of_current_child = current_child%begin() ! always at least one node @@ -326,7 +329,7 @@ recursive subroutine next(this) end if end if end if - + end subroutine next @@ -360,7 +363,7 @@ logical function equals(a, b) type is (MeterNodeIterator) equals = associated(a%reference, b%reference) if (.not. equals) return - + equals = associated(a%current) .eqv. associated(b%current) if (.not. equals) return @@ -423,7 +426,7 @@ recursive subroutine accumulate(this, other) call t%reset() end if call t%accumulate(other%get_meter()) - + ! recurse over children of other iter = other%begin() call iter%next() ! skip top node (already handled) @@ -434,5 +437,5 @@ recursive subroutine accumulate(this, other) end subroutine accumulate - + end module MAPL_MeterNode From 03091fdacfec73b8df4990b26770eaeea4265d56 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 18 Mar 2022 08:47:29 -0400 Subject: [PATCH 050/300] Prepare for 2.19.0 Release --- CHANGELOG.md | 18 +++++++++++++----- CMakeLists.txt | 2 +- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 79ae7924a2bf..3423e26c7526 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,18 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +### Added + +### Changed + +### Removed + +### Deprecated + +## [2.19.0] - 2022-03-18 + +### Fixed + - Fixed duration of the clock to be the smaller of the user specified duration and (END_DATE - currTime) - Fixes for compiling on M1 Macs (remove REAL128) - Fix for CMake when `esmf` is already a target @@ -20,14 +32,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed -- Replaced a wild card "*" in any position of a string in MAPL_GridCompSpecs_ACG.py +- Replaced a wild card "*" in any position of a string in MAPL_GridCompSpecs_ACG.py - Updated `MAPL_SunGetSolarConstantFromNRLFile` to open NRL Solar Table file only on root and broadcast the tables to all processes. Now all processes do interpolation. - Add voting interpolation method as optional argument to SimpleBundleRead method -### Removed - -### Deprecated - ## [2.18.3] - 2022-03-15 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index ec5876cd4e41..5090ffa19888 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.18.3 + VERSION 2.19.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the default build type to release From 1bbfeb9920a09b56c4854478eadddfa65cbcc58b Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 21 Mar 2022 10:18:56 -0400 Subject: [PATCH 051/300] Fix issue with calling ACG multiple times --- CHANGELOG.md | 2 ++ cmake/mapl_acg.cmake | 8 ++++---- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3423e26c7526..c8d8a64c35a4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Fix issue where ACG was called when no file had changed + ### Added ### Changed diff --git a/cmake/mapl_acg.cmake b/cmake/mapl_acg.cmake index b55364233a70..d37f08eafc59 100644 --- a/cmake/mapl_acg.cmake +++ b/cmake/mapl_acg.cmake @@ -28,12 +28,12 @@ function (mapl_acg target specs_file) string (REPLACE "_GridComp" "" component_name ${target}) if (ARGS_UNPARSED_ARGUMENTS) - ecbuild_error ("maple_acg() - unparsed arguments: ${ARGS_UNPARSED_ARGUMENTS}") + ecbuild_error ("mapl_acg() - unparsed arguments: ${ARGS_UNPARSED_ARGUMENTS}") endif () set (generated) # empty unless set (options "") - + set (suffix_for_generated_include_files "___.h") # Handle oneValueArgs with no value (Python provides default) foreach (opt flag default IN ZIP_LISTS oneValueArgs flags defaults) @@ -44,7 +44,7 @@ function (mapl_acg target specs_file) list (APPEND options ${flag} ${ARGS_${opt}}) elseif (${opt} IN_LIST ARGS_KEYWORDS_MISSING_VALUES) string (REPLACE "{component}" component_name fname ${default}) - list (APPEND generated ${fname}) + list (APPEND generated "${component_name}_${fname}${suffix_for_generated_include_files}") list (APPEND options ${flag}) endif () @@ -60,7 +60,7 @@ function (mapl_acg target specs_file) add_custom_command ( OUTPUT ${generated} COMMAND ${generator} ${CMAKE_CURRENT_SOURCE_DIR}/${specs_file} ${options} - MAIN_DEPENDENCY ${CMAKE_CURRENT_SOURCE_DIR}/${specs_file} + MAIN_DEPENDENCY ${CMAKE_CURRENT_SOURCE_DIR}/${specs_file} DEPENDS ${generator} ${specs_file} WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} COMMENT "Generating automatic code for ${specs_file}" From b93440465b1d39834b008e327ea51e9dd1684628 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 21 Mar 2022 14:25:04 -0400 Subject: [PATCH 052/300] Clean up some old CMake --- gridcomps/ExtData2G/CMakeLists.txt | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/gridcomps/ExtData2G/CMakeLists.txt b/gridcomps/ExtData2G/CMakeLists.txt index 6efdc8a2d362..e36dd802d311 100644 --- a/gridcomps/ExtData2G/CMakeLists.txt +++ b/gridcomps/ExtData2G/CMakeLists.txt @@ -26,7 +26,6 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.base MAPL.generic MAPL.griddedio TYPE SHARED) target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared YAFYAML::yafyaml esmf NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran) -target_include_directories (${this} PUBLIC ${INC_ESMF} ${INC_NETCDF} - $) +target_include_directories (${this} PUBLIC $) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) From 5352963430dba4863d320848f9e69e3596cb2c92 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 21 Mar 2022 14:25:31 -0400 Subject: [PATCH 053/300] Update changelog --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index c8d8a64c35a4..aa37071a62ea 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,6 +15,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Cleaned up a bit of old CMake + ### Removed ### Deprecated From 7d575f0cc7cd85ad11e05de0196127a6a65969fa Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 22 Mar 2022 11:11:56 -0400 Subject: [PATCH 054/300] implementing multiple f-streams --- gridcomps/ExtData2G/ExtDataConfig.F90 | 77 +++++++++++++++-------- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 7 ++- gridcomps/ExtData2G/ExtDataRule.F90 | 6 ++ 3 files changed, 62 insertions(+), 28 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index 4f3d0dcc7212..41a12515ab0b 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -25,6 +25,7 @@ module MAPL_ExtDataConfig type(ExtDataTimeSampleMap) :: sample_map contains + procedure :: add_new_rule procedure :: get_item_type procedure :: get_debug_flag procedure :: new_ExtDataConfig_from_yaml @@ -42,23 +43,21 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ type(Parser) :: p type(Configuration) :: config, subcfg, ds_config, rule_config, derived_config, sample_config type(ConfigurationIterator) :: iter - character(len=:), allocatable :: key + character(len=:), allocatable :: key,new_key type(ExtDataFileStream) :: ds type(ExtDataDerived) :: derived - type(ExtDataRule) :: rule,ucomp,vcomp type(ExtDataTimeSample) :: ts - integer :: status, semi_pos - character(len=:), allocatable :: uname,vname + integer :: status type(FileStream) :: fstream type(ExtDataFileStream), pointer :: temp_ds type(ExtDataTimeSample), pointer :: temp_ts - type(ExtDataRule), pointer :: temp_rule type(ExtDataDerived), pointer :: temp_derived - type(Configuration) :: subconfigs + type(Configuration) :: subconfigs,rule_map character(len=:), allocatable :: sub_file - integer :: i + integer :: i,num_rules + character(len=1) :: i_char type(ExtDataTimeSample), pointer :: ts_grr @@ -112,26 +111,20 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ rule_config = config%of("Exports") iter = rule_config%begin() do while (iter /= rule_config%end()) - call rule%set_defaults(rc=status) - _VERIFY(status) call iter%get_key(key) call iter%get_value(subcfg) - rule = ExtDataRule(subcfg,ext_config%sample_map,key,_RC) - semi_pos = index(key,";") - if (semi_pos > 0) then - call rule%split_vector(key,ucomp,vcomp,rc=status) - uname = key(1:semi_pos-1) - vname = key(semi_pos+1:len_trim(key)) - temp_rule => ext_config%rule_map%at(trim(uname)) - _ASSERT(.not.associated(temp_rule),"duplicated export entry key") - call ext_config%rule_map%insert(trim(uname),ucomp) - temp_rule => ext_config%rule_map%at(trim(vname)) - _ASSERT(.not.associated(temp_rule),"duplicated export entry key") - call ext_config%rule_map%insert(trim(vname),vcomp) + if (subcfg%is_mapping()) then + call ext_config%add_new_rule(key,subcfg,_RC) + else if (subcfg%is_sequence()) then + num_rules = subcfg%size() + do i=num_rules + rule_map = subcfg%of(i) + write(i_char,'(I1)')i + new_key = key//i_char + call ext_config%add_new_rule(new_key,rule_map,_RC) + enddo else - temp_rule => ext_config%rule_map%at(trim(key)) - _ASSERT(.not.associated(temp_rule),"duplicated export entry key") - call ext_config%rule_map%insert(trim(key),rule) + _ASSERT(.false.,"Exports must be sequence or map") end if call iter%next() enddo @@ -146,7 +139,7 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ call iter%get_key(key) call iter%get_value(subcfg) derived = ExtDataDerived(subcfg,_RC) - temp_derived => ext_config%derived_map%at(trim(uname)) + temp_derived => ext_config%derived_map%at(trim(key)) _ASSERT(.not.associated(temp_derived),"duplicated derived entry key") call ext_config%derived_map%insert(trim(key),derived) call iter%next() @@ -191,6 +184,40 @@ function get_item_type(this,item_name,unusable,rc) result(item_type) end if _RETURN(_SUCCESS) end function get_item_type + + subroutine add_new_rule(this,key,export_rule,rc) + class(ExtDataConfig), intent(inout) :: this + character(len=*), intent(in) :: key + type(configuration), intent(in) :: export_rule + integer, intent(out), optional :: rc + + integer :: semi_pos,status + type(ExtDataRule) :: rule,ucomp,vcomp + type(ExtDataRule), pointer :: temp_rule + character(len=:), allocatable :: uname,vname + + call rule%set_defaults(rc=status) + _VERIFY(status) + rule = ExtDataRule(export_rule,this%sample_map,key,_RC) + semi_pos = index(key,";") + if (semi_pos > 0) then + call rule%split_vector(key,ucomp,vcomp,rc=status) + uname = key(1:semi_pos-1) + vname = key(semi_pos+1:len_trim(key)) + temp_rule => this%rule_map%at(trim(uname)) + _ASSERT(.not.associated(temp_rule),"duplicated export entry key") + call this%rule_map%insert(trim(uname),ucomp) + temp_rule => this%rule_map%at(trim(vname)) + _ASSERT(.not.associated(temp_rule),"duplicated export entry key") + call this%rule_map%insert(trim(vname),vcomp) + else + temp_rule => this%rule_map%at(trim(key)) + _ASSERT(.not.associated(temp_rule),"duplicated export entry key") + call this%rule_map%insert(trim(key),rule) + end if + _RETURN(_SUCCESS) + end subroutine add_new_rule + integer function get_debug_flag(this) class(ExtDataConfig), intent(inout) :: this diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index 5122856c5a77..c8e798c18565 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -739,7 +739,8 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOff(MAPLSTATE,"--CheckUpd") DO_UPDATE: if (doUpdate(i)) then - + + call extdata_lgr%info('Going to update %a with file template: %a ',item%name, item%file_template) call item%modelGridFields%comp1%reset() call item%filestream%get_file_bracket(time,item%source_time, item%modelGridFields%comp1,__RC__) call IOBundle_Add_Entry(IOBundles,item,self%primaryOrder(i)) @@ -2269,7 +2270,7 @@ subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,rc) item%pfioCollection_id,item%iclient_collection_id,items,rc=status) _VERIFY(status) call IOBundles%push_back(io_bundle) - call extdata_lgr%info('%a update L with with: %a %i2 ',item%name, current_file, time_index) + call extdata_lgr%info('%a updated L bracket with: %a at time index %i2 ',item%name, current_file, time_index) end if call item%modelGridFields%comp1%get_parameters('R',update=update,file=current_file,time_index=time_index) if (update) then @@ -2278,7 +2279,7 @@ subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,rc) item%pfioCollection_id,item%iclient_collection_id,items,rc=status) _VERIFY(status) call IOBundles%push_back(io_bundle) - call extdata_lgr%info('%a update R with with: %a %i2 ',item%name,current_file, time_index) + call extdata_lgr%info('%a updated R bracket with: %a at time index %i2 ',item%name,current_file, time_index) end if _RETURN(ESMF_SUCCESS) diff --git a/gridcomps/ExtData2G/ExtDataRule.F90 b/gridcomps/ExtData2G/ExtDataRule.F90 index fa9ee35db272..b49b962587a8 100644 --- a/gridcomps/ExtData2G/ExtDataRule.F90 +++ b/gridcomps/ExtData2G/ExtDataRule.F90 @@ -11,6 +11,7 @@ module MAPL_ExtDataRule private type, public :: ExtDataRule + character(:) allocatable :: start_time character(:), allocatable :: collection character(:), allocatable :: file_var character(:), allocatable :: sample_key @@ -92,6 +93,11 @@ function new_ExtDataRule(config,sample_map,key,unusable,rc) result(rule) rule%regrid_method="BILINEAR" end if + if (config%has"start") then + tempc = config%of("start") + rule%start_time = tempc + end if + _RETURN(_SUCCESS) end function new_ExtDataRule From 3b627ea930c689f258f25a6cb74d8e38256a1bbf Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 22 Mar 2022 13:45:26 -0400 Subject: [PATCH 055/300] fixed bugs in previous commit, move code around --- gridcomps/ExtData2G/ExtDataConfig.F90 | 2 +- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 78 ++++++++++++++--------- gridcomps/ExtData2G/ExtDataRule.F90 | 4 +- 3 files changed, 50 insertions(+), 34 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index 41a12515ab0b..61f064482e7d 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -117,7 +117,7 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ call ext_config%add_new_rule(key,subcfg,_RC) else if (subcfg%is_sequence()) then num_rules = subcfg%size() - do i=num_rules + do i=1,num_rules rule_map = subcfg%of(i) write(i_char,'(I1)')i new_key = key//i_char diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index c8e798c18565..73b273949fb3 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -426,37 +426,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! -------------------------------------------------------- if (item%isConst) then - - if (item%vartype == MAPL_FieldItem) then - call ESMF_StateGet(self%ExtDataState,trim(item%name),field,__RC__) - call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) - if (fieldRank == 2) then - call MAPL_GetPointer(self%ExtDataState, ptr2d, trim(item%name),__RC__) - ptr2d = item%const - else if (fieldRank == 3) then - call MAPL_GetPointer(self%ExtDataState, ptr3d, trim(item%name), __RC__) - ptr3d = item%const - endif - else if (item%vartype == MAPL_VectorField) then - call ESMF_StateGet(self%ExtDataState,trim(item%vcomp1),field,__RC__) - call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) - if (fieldRank == 2) then - call MAPL_GetPointer(self%ExtDataState, ptr2d, trim(item%vcomp1),__RC__) - ptr2d = item%const - else if (fieldRank == 3) then - call MAPL_GetPointer(self%ExtDataState, ptr3d, trim(item%vcomp1), __RC__) - ptr3d = item%const - endif - call ESMF_StateGet(self%ExtDataState,trim(item%vcomp2),field,__RC__) - call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) - if (fieldRank == 2) then - call MAPL_GetPointer(self%ExtDataState, ptr2d, trim(item%vcomp2),__RC__) - ptr2d = item%const - else if (fieldRank == 3) then - call MAPL_GetPointer(self%ExtDataState, ptr3d, trim(item%vcomp2), __RC__) - ptr3d = item%const - endif - end if + call set_constant_field(item,self%extDataState,_RC) cycle end if @@ -2286,4 +2256,50 @@ subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,rc) end subroutine IOBundle_Add_Entry + subroutine set_constant_field(item,ExtDataState,rc) + type(PrimaryExport), intent(inout) :: item + type(ESMF_State), intent(inout) :: extDataState + integer, intent(out), optional :: rc + + integer :: status,fieldRank + real(kind=REAL32), pointer :: ptr2d(:,:),ptr3d(:,:,:) + type(ESMF_Field) :: field + if (item%isConst) then + + if (item%vartype == MAPL_FieldItem) then + call ESMF_StateGet(ExtDataState,trim(item%name),field,__RC__) + call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) + if (fieldRank == 2) then + call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%name),__RC__) + ptr2d = item%const + else if (fieldRank == 3) then + call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%name), __RC__) + ptr3d = item%const + endif + else if (item%vartype == MAPL_VectorField) then + call ESMF_StateGet(ExtDataState,trim(item%vcomp1),field,__RC__) + call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) + if (fieldRank == 2) then + call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%vcomp1),__RC__) + ptr2d = item%const + else if (fieldRank == 3) then + call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%vcomp1), __RC__) + ptr3d = item%const + endif + call ESMF_StateGet(ExtDataState,trim(item%vcomp2),field,__RC__) + call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) + if (fieldRank == 2) then + call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%vcomp2),__RC__) + ptr2d = item%const + else if (fieldRank == 3) then + call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%vcomp2), __RC__) + ptr3d = item%const + endif + end if + + end if + + _RETURN(_SUCCESS) + end subroutine set_constant_field + END MODULE MAPL_ExtDataGridComp2G diff --git a/gridcomps/ExtData2G/ExtDataRule.F90 b/gridcomps/ExtData2G/ExtDataRule.F90 index b49b962587a8..437c26020050 100644 --- a/gridcomps/ExtData2G/ExtDataRule.F90 +++ b/gridcomps/ExtData2G/ExtDataRule.F90 @@ -11,7 +11,7 @@ module MAPL_ExtDataRule private type, public :: ExtDataRule - character(:) allocatable :: start_time + character(:), allocatable :: start_time character(:), allocatable :: collection character(:), allocatable :: file_var character(:), allocatable :: sample_key @@ -93,7 +93,7 @@ function new_ExtDataRule(config,sample_map,key,unusable,rc) result(rule) rule%regrid_method="BILINEAR" end if - if (config%has"start") then + if (config%has("start")) then tempc = config%of("start") rule%start_time = tempc end if From e3a8819672e96812c46f457d71a317f1fd7afd4b Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 22 Mar 2022 15:15:52 -0400 Subject: [PATCH 056/300] Update CI to use orb build job --- .circleci/config.yml | 178 ++++++++++--------------------------------- CHANGELOG.md | 4 + components.yaml | 4 +- 3 files changed, 47 insertions(+), 139 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 2017d80eb250..9fb8abb76c97 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -1,30 +1,39 @@ version: 2.1 orbs: - circleci-tools: geos-esm/circleci-tools@0.11.0 + ci: geos-esm/circleci-tools@0 workflows: build-and-test: jobs: - - build-and-test-MAPL: + - ci/build: name: build-and-test-MAPL-on-<< matrix.compiler >> matrix: parameters: compiler: [gfortran, ifort] + repo: MAPL + run_unit_tests: true context: - docker-hub-creds - - build-UFS-MAPL: + - ci/build: name: build-UFS-MAPL-on-<< matrix.compiler >> matrix: parameters: compiler: [ifort] + repo: MAPL + run_unit_tests: true + extra_cmake_options: "-DBUILD_WITH_FLAP=OFF -DBUILD_WITH_PFLOGGER=OFF -DBUILD_SHARED_MAPL=OFF" context: - docker-hub-creds - - build-GEOSgcm: + - ci/build: name: build-GEOSgcm-on-<< matrix.compiler >> matrix: parameters: compiler: [gfortran, ifort] + repo: GEOSgcm + checkout_fixture: true + mepodevelop: true + checkout_mapl_branch: true context: - docker-hub-creds ################################################### @@ -47,11 +56,15 @@ workflows: # requires: # # - make-FV3-exp-on-<< matrix.compiler >> # ################################################### - - build-GEOSldas: + - ci/build: name: build-GEOSldas-on-<< matrix.compiler >> matrix: parameters: compiler: [gfortran, ifort] + repo: GEOSldas + checkout_fixture: true + fixture_branch: develop + checkout_mapl_branch: true context: - docker-hub-creds - build-GEOSadas: @@ -63,168 +76,59 @@ workflows: - docker-hub-creds jobs: - build-and-test-MAPL: - parameters: - compiler: - type: string - executor: circleci-tools/<< parameters.compiler >> - working_directory: /root/project - steps: - - checkout: - path: MAPL - - circleci-tools/versions: - compiler: << parameters.compiler >> - - circleci-tools/mepoclone: - repo: MAPL - - circleci-tools/cmake: - repo: MAPL - compiler: << parameters.compiler >> - - circleci-tools/buildinstall: - repo: MAPL - - run: - name: "Build MAPL Unit Tests" - command: | - cd ${CIRCLE_WORKING_DIRECTORY}/workspace/build-MAPL - make -j"$(nproc)" build-tests |& tee /logfiles/build-tests.log - - run: - name: "Run MAPL Unit Tests" - command: | - cd ${CIRCLE_WORKING_DIRECTORY}/workspace/build-MAPL - # skip Performance tests (maybe doable on CircleCI?) - ctest -R MAPL -LE PERFORMANCE --output-on-failure |& tee /logfiles/ctest.log - - circleci-tools/compress_artifacts - - store_artifacts: - path: /logfiles - - build-UFS-MAPL: - parameters: - compiler: - type: string - executor: circleci-tools/<< parameters.compiler >> - working_directory: /root/project - steps: - - checkout: - path: MAPL - - circleci-tools/versions: - compiler: << parameters.compiler >> - - circleci-tools/mepoclone: - repo: MAPL - - circleci-tools/cmake: - repo: MAPL - compiler: << parameters.compiler >> - extra_cmake_options: "-DBUILD_WITH_FLAP=OFF -DBUILD_WITH_PFLOGGER=OFF -DBUILD_SHARED_MAPL=OFF" - - circleci-tools/buildinstall: - repo: MAPL - - run: - name: "Build MAPL Unit Tests" - command: | - cd ${CIRCLE_WORKING_DIRECTORY}/workspace/build-MAPL - make -j"$(nproc)" build-tests |& tee /logfiles/build-tests.log - - run: - name: "Run MAPL Unit Tests" - command: | - cd ${CIRCLE_WORKING_DIRECTORY}/workspace/build-MAPL - # skip Performance tests (maybe doable on CircleCI?) - ctest -R MAPL -LE PERFORMANCE --output-on-failure |& tee /logfiles/ctest.log - - circleci-tools/compress_artifacts - - store_artifacts: - path: /logfiles - - build-GEOSgcm: - parameters: - compiler: - type: string - executor: circleci-tools/<< parameters.compiler >> - working_directory: /root/project - steps: - - circleci-tools/checkout_fixture - - circleci-tools/mepoclone - - circleci-tools/mepodevelop - - circleci-tools/checkout_mapl_branch - - circleci-tools/cmake: - compiler: << parameters.compiler >> - - circleci-tools/buildinstall - - circleci-tools/compress_artifacts - - store_artifacts: - path: /logfiles - - ###################################################### - # # We need to persist the install for the next step # - # # but only if we are running FV3 tests # - # - persist_to_workspace: # - # root: workspace # - # paths: # - # - install-GEOSgcm # - ###################################################### - - build-GEOSldas: - parameters: - compiler: - type: string - executor: circleci-tools/<< parameters.compiler >> - working_directory: /root/project - steps: - - circleci-tools/checkout_fixture: - repo: GEOSldas - - circleci-tools/checkout_branch_on_fixture: - repo: GEOSldas - branch: develop - - circleci-tools/mepoclone: - repo: GEOSldas - - circleci-tools/checkout_mapl_branch: - repo: GEOSldas - - circleci-tools/cmake: - repo: GEOSldas - compiler: << parameters.compiler >> - - circleci-tools/buildinstall: - repo: GEOSldas - - circleci-tools/compress_artifacts - - store_artifacts: - path: /logfiles - build-GEOSadas: parameters: compiler: type: string executor: - name: circleci-tools/<< parameters.compiler >> + name: ci/<< parameters.compiler >> resource_class: xlarge working_directory: /root/project steps: - - circleci-tools/checkout_fixture: + - ci/checkout_fixture: repo: GEOSadas - - circleci-tools/checkout_branch_on_fixture: + - ci/checkout_branch_on_fixture: repo: GEOSadas branch: develop - - circleci-tools/mepoclone: + - ci/mepoclone: repo: GEOSadas - - circleci-tools/checkout_mapl_branch: + - ci/checkout_mapl_branch: repo: GEOSadas # Until GEOSadas is closer to modern GEOSgcm, we need to update the ESMA_cmake - - circleci-tools/checkout_branch_on_subrepo: + - ci/checkout_branch_on_subrepo: repo: GEOSadas branch: develop subrepo: cmake # There is currently an issue building GEOSadas with Debug Intel. - - circleci-tools/checkout_branch_on_subrepo: + - ci/checkout_branch_on_subrepo: repo: GEOSadas branch: develop subrepo: GEOSana_GridComp - - circleci-tools/cmake: + - ci/cmake: repo: GEOSadas compiler: << parameters.compiler >> - - circleci-tools/buildinstall: + - ci/buildinstall: repo: GEOSadas rebuild_procs: 8 - - circleci-tools/compress_artifacts + - ci/compress_artifacts - store_artifacts: path: /logfiles + ###################################################### + # ### For future reference ### # + # # We need to persist the install for the next step # + # # but only if we are running FV3 tests # + # - persist_to_workspace: # + # root: workspace # + # paths: # + # - install-GEOSgcm # + ###################################################### + make-FV3-exp: parameters: compiler: type: string - executor: circleci-tools/<< parameters.compiler >> + executor: ci/<< parameters.compiler >> working_directory: /root/project steps: - attach_workspace: @@ -269,7 +173,7 @@ jobs: parameters: compiler: type: string - executor: circleci-tools/<< parameters.compiler >> + executor: ci/<< parameters.compiler >> working_directory: /root/project steps: - attach_workspace: @@ -295,7 +199,7 @@ jobs: echo "EGRESS not found!" exit 1 fi - - circleci-tools/compress_artifacts + - ci/compress_artifacts - store_artifacts: path: /logfiles diff --git a/CHANGELOG.md b/CHANGELOG.md index aa37071a62ea..a5d5f5e4a2bc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,6 +16,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed - Cleaned up a bit of old CMake +- Updated CircleCI config to use new orb `build` job +- Updated `components.yaml` to match GEOSgcm v10.22.1 + - ESMA_env v3.13.0 + - ESMA_cmake v3.12.0 ### Removed diff --git a/components.yaml b/components.yaml index 6f9e8e70c545..9e5748618313 100644 --- a/components.yaml +++ b/components.yaml @@ -5,13 +5,13 @@ MAPL: ESMA_env: local: ./ESMA_env remote: ../ESMA_env.git - tag: v3.11.0 + tag: v3.13.0 develop: main ESMA_cmake: local: ./ESMA_cmake remote: ../ESMA_cmake.git - tag: v3.10.0 + tag: v3.12.0 develop: develop ecbuild: From 2ce4952e80debf095b71ad53e553a35f1e9b717c Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 22 Mar 2022 15:30:31 -0400 Subject: [PATCH 057/300] Add ctest options --- .circleci/config.yml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 9fb8abb76c97..ac06aa6c7619 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -13,6 +13,7 @@ workflows: compiler: [gfortran, ifort] repo: MAPL run_unit_tests: true + ctest_options: "-R MAPL -LE PERFORMANCE --output-on-failure" context: - docker-hub-creds - ci/build: @@ -21,8 +22,9 @@ workflows: parameters: compiler: [ifort] repo: MAPL - run_unit_tests: true extra_cmake_options: "-DBUILD_WITH_FLAP=OFF -DBUILD_WITH_PFLOGGER=OFF -DBUILD_SHARED_MAPL=OFF" + run_unit_tests: true + ctest_options: "-R MAPL -LE PERFORMANCE --output-on-failure" context: - docker-hub-creds - ci/build: From 20b1f91a450e883aff6b3140278074b9bcc69728 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 22 Mar 2022 16:41:58 -0400 Subject: [PATCH 058/300] Add GEOSadas --- .circleci/config.yml | 48 +++++++++----------------------------------- 1 file changed, 9 insertions(+), 39 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index ac06aa6c7619..eef6ea24818a 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -69,53 +69,23 @@ workflows: checkout_mapl_branch: true context: - docker-hub-creds - - build-GEOSadas: + - ci/build: name: build-GEOSadas-on-<< matrix.compiler >> matrix: parameters: compiler: [ifort] + resource_class: xlarge + repo: GEOSadas + checkout_fixture: true + fixture_branch: develop + checkout_mapl_branch: true + mepodevelop: true + develop_repos: "cmake GEOSana_GridComp" + rebuild_procs: 8 context: - docker-hub-creds jobs: - build-GEOSadas: - parameters: - compiler: - type: string - executor: - name: ci/<< parameters.compiler >> - resource_class: xlarge - working_directory: /root/project - steps: - - ci/checkout_fixture: - repo: GEOSadas - - ci/checkout_branch_on_fixture: - repo: GEOSadas - branch: develop - - ci/mepoclone: - repo: GEOSadas - - ci/checkout_mapl_branch: - repo: GEOSadas - # Until GEOSadas is closer to modern GEOSgcm, we need to update the ESMA_cmake - - ci/checkout_branch_on_subrepo: - repo: GEOSadas - branch: develop - subrepo: cmake - # There is currently an issue building GEOSadas with Debug Intel. - - ci/checkout_branch_on_subrepo: - repo: GEOSadas - branch: develop - subrepo: GEOSana_GridComp - - ci/cmake: - repo: GEOSadas - compiler: << parameters.compiler >> - - ci/buildinstall: - repo: GEOSadas - rebuild_procs: 8 - - ci/compress_artifacts - - store_artifacts: - path: /logfiles - ###################################################### # ### For future reference ### # # # We need to persist the install for the next step # From 2de55c0812fcb462bdbfa3c5122d4f08e3e8e52c Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 22 Mar 2022 17:16:37 -0400 Subject: [PATCH 059/300] change name to variable from vname --- gridcomps/ExtData2G/ExtDataConfig.F90 | 1 - gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 224 +++++++++++----------- gridcomps/ExtData2G/ExtDataRule.F90 | 6 +- 3 files changed, 116 insertions(+), 115 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index 61f064482e7d..28ce097d34c3 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -150,7 +150,6 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ call config%get(ext_config%debug,"debug",rc=status) _VERIFY(status) end if - ts_grr =>ext_config%sample_map%at('sample_0') _RETURN(_SUCCESS) end subroutine new_ExtDataConfig_from_yaml diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index 73b273949fb3..be8ce3fbcbbc 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -271,7 +271,6 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) !------------------------------------------------------------------------- type(MAPL_ExtData_state), pointer :: self ! Legacy state - type(ESMF_Grid) :: GRID ! Grid type(ESMF_Config) :: CF_master ! Universal Config character(len=ESMF_MAXSTR) :: comp_name @@ -285,15 +284,11 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(ESMF_Time) :: time - type (ESMF_Field) :: field,left_field,right_field - integer :: fieldRank, lm + type (ESMF_Field) :: field type (ESMF_StateItem_Flag), pointer :: ITEMTYPES(:) character(len=ESMF_MAXSTR), allocatable :: ITEMNAMES(:) - real, pointer :: ptr2d(:,:) => null() - real, pointer :: ptr3d(:,:,:) => null() integer :: idx - type(ESMF_VM) :: vm type(MAPL_MetaComp),pointer :: MAPLSTATE type(ExtDataOldTypesCreator),target :: config_yaml @@ -429,79 +424,8 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call set_constant_field(item,self%extDataState,_RC) cycle end if - - ! get levels, other information - call GetLevs(item,__RC__) - call ESMF_VMBarrier(vm) - ! register collections - item%iclient_collection_id=i_clients%add_ext_collection(trim(item%file_template)) - ! create interpolating fields, check if the vertical levels match the file - if (item%vartype == MAPL_FieldItem) then - - call ESMF_StateGet(self%ExtDataState, trim(item%name), field,__RC__) - call ESMF_FieldGet(field,grid=grid,rank=fieldRank,__RC__) - - lm=0 - if (fieldRank==3) then - call ESMF_FieldGet(field,0,farrayPtr=ptr3d,__RC__) - lm = size(ptr3d,3) - end if - if (item%lm /= lm .and. lm /= 0 .and. item%havePressure) then - item%do_VertInterp = .true. - else if (item%lm /= lm .and. lm /= 0) then - item%do_Fill = .true. - end if - left_field = MAPL_FieldCreate(field,item%var,doCopy=.true.,__RC__) - right_field = MAPL_FieldCreate(field,item%var,doCopy=.true.,__RC__) - call item%modelGridFields%comp1%set_parameters(left_field=left_field,right_field=right_field, __RC__) - if (item%do_fill .or. item%do_vertInterp) then - call createFileLevBracket(item,cf_master,__RC__) - end if - - else if (item%vartype == MAPL_VectorField) then - - ! check that we are not asking for conservative regridding -!!$ if (item%Trans /= MAPL_HorzTransOrderBilinear) then - if (item%Trans /= REGRID_METHOD_BILINEAR) then - _ASSERT(.false.,'No conservative re-gridding with vectors') - end if - - block - integer :: gridRotation1, gridRotation2 - call ESMF_StateGet(self%ExtDataState, trim(item%vcomp1), field,__RC__) - call ESMF_AttributeGet(field, NAME='ROTATION', value=gridRotation1, __RC__) - call ESMF_StateGet(self%ExtDataState, trim(item%vcomp2), field,__RC__) - call ESMF_AttributeGet(field, NAME='ROTATION', value=gridRotation2, __RC__) - _ASSERT(GridRotation1 == gridRotation2,'Grid rotations must match when performing vector re-gridding') - end block - - call ESMF_StateGet(self%ExtDataState, trim(item%vcomp1), field,__RC__) - call ESMF_FieldGet(field,grid=grid,rank=fieldRank,__RC__) - - lm = 0 - if (fieldRank==3) then - call ESMF_FieldGet(field,0,farrayPtr=ptr3d,__RC__) - lm = size(ptr3d,3) - end if - if (item%lm /= lm .and. item%havePressure) then - item%do_VertInterp = .true. - else if (item%lm /= lm .and. lm /= 0) then - item%do_Fill = .true. - end if - - left_field = MAPL_FieldCreate(field,item%fcomp1,doCopy=.true.,__RC__) - right_field = MAPL_FieldCreate(field,item%fcomp1,doCopy=.true.,__RC__) - call item%modelGridFields%comp1%set_parameters(left_field=left_field,right_field=right_field, __RC__) - call ESMF_StateGet(self%ExtDataState, trim(item%vcomp2), field,__RC__) - left_field = MAPL_FieldCreate(field,item%fcomp2,doCopy=.true.,__RC__) - right_field = MAPL_FieldCreate(field,item%fcomp2,doCopy=.true.,__RC__) - call item%modelGridFields%comp2%set_parameters(left_field=left_field,right_field=right_field, __RC__) - - if (item%do_fill .or. item%do_vertInterp) then - call createFileLevBracket(item,cf_master,__RC__) - end if - end if + call create_bracketing_fields(item,self%ExtDataState,cf_master,rc) end do PrimaryLoop @@ -2264,42 +2188,120 @@ subroutine set_constant_field(item,ExtDataState,rc) integer :: status,fieldRank real(kind=REAL32), pointer :: ptr2d(:,:),ptr3d(:,:,:) type(ESMF_Field) :: field - if (item%isConst) then - - if (item%vartype == MAPL_FieldItem) then - call ESMF_StateGet(ExtDataState,trim(item%name),field,__RC__) - call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) - if (fieldRank == 2) then - call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%name),__RC__) - ptr2d = item%const - else if (fieldRank == 3) then - call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%name), __RC__) - ptr3d = item%const - endif - else if (item%vartype == MAPL_VectorField) then - call ESMF_StateGet(ExtDataState,trim(item%vcomp1),field,__RC__) - call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) - if (fieldRank == 2) then - call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%vcomp1),__RC__) - ptr2d = item%const - else if (fieldRank == 3) then - call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%vcomp1), __RC__) - ptr3d = item%const - endif - call ESMF_StateGet(ExtDataState,trim(item%vcomp2),field,__RC__) - call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) - if (fieldRank == 2) then - call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%vcomp2),__RC__) - ptr2d = item%const - else if (fieldRank == 3) then - call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%vcomp2), __RC__) - ptr3d = item%const - endif - end if - end if + if (item%vartype == MAPL_FieldItem) then + call ESMF_StateGet(ExtDataState,trim(item%name),field,__RC__) + call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) + if (fieldRank == 2) then + call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%name),__RC__) + ptr2d = item%const + else if (fieldRank == 3) then + call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%name), __RC__) + ptr3d = item%const + endif + else if (item%vartype == MAPL_VectorField) then + call ESMF_StateGet(ExtDataState,trim(item%vcomp1),field,__RC__) + call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) + if (fieldRank == 2) then + call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%vcomp1),__RC__) + ptr2d = item%const + else if (fieldRank == 3) then + call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%vcomp1), __RC__) + ptr3d = item%const + endif + call ESMF_StateGet(ExtDataState,trim(item%vcomp2),field,__RC__) + call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) + if (fieldRank == 2) then + call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%vcomp2),__RC__) + ptr2d = item%const + else if (fieldRank == 3) then + call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%vcomp2), __RC__) + ptr3d = item%const + endif + end if _RETURN(_SUCCESS) end subroutine set_constant_field + subroutine create_bracketing_fields(item,ExtDataState,cf,rc) + type(PrimaryExport), intent(inout) :: item + type(ESMF_State), intent(inout) :: extDataState + type(ESMF_Config), intent(inout) :: cf + integer, intent(out), optional :: rc + + integer :: status,lm,fieldRank + type(ESMF_Field) :: field,left_field,right_field + type(ESMF_Grid) :: grid + real(kind=REAL32), pointer :: ptr3d(:,:,:) + + call GetLevs(item,__RC__) + item%iclient_collection_id=i_clients%add_ext_collection(trim(item%file_template)) + if (item%vartype == MAPL_FieldItem) then + + call ESMF_StateGet(ExtDataState, trim(item%name), field,__RC__) + call ESMF_FieldGet(field,grid=grid,rank=fieldRank,__RC__) + + lm=0 + if (fieldRank==3) then + call ESMF_FieldGet(field,0,farrayPtr=ptr3d,__RC__) + lm = size(ptr3d,3) + end if + if (item%lm /= lm .and. lm /= 0 .and. item%havePressure) then + item%do_VertInterp = .true. + else if (item%lm /= lm .and. lm /= 0) then + item%do_Fill = .true. + end if + left_field = MAPL_FieldCreate(field,item%var,doCopy=.true.,__RC__) + right_field = MAPL_FieldCreate(field,item%var,doCopy=.true.,__RC__) + call item%modelGridFields%comp1%set_parameters(left_field=left_field,right_field=right_field, __RC__) + if (item%do_fill .or. item%do_vertInterp) then + call createFileLevBracket(item,cf,__RC__) + end if + + else if (item%vartype == MAPL_VectorField) then + + if (item%Trans /= REGRID_METHOD_BILINEAR) then + _ASSERT(.false.,'No conservative re-gridding with vectors') + end if + + block + integer :: gridRotation1, gridRotation2 + call ESMF_StateGet(ExtDataState, trim(item%vcomp1), field,__RC__) + call ESMF_AttributeGet(field, NAME='ROTATION', value=gridRotation1, __RC__) + call ESMF_StateGet(ExtDataState, trim(item%vcomp2), field,__RC__) + call ESMF_AttributeGet(field, NAME='ROTATION', value=gridRotation2, __RC__) + _ASSERT(GridRotation1 == gridRotation2,'Grid rotations must match when performing vector re-gridding') + end block + + call ESMF_StateGet(ExtDataState, trim(item%vcomp1), field,__RC__) + call ESMF_FieldGet(field,grid=grid,rank=fieldRank,__RC__) + + lm = 0 + if (fieldRank==3) then + call ESMF_FieldGet(field,0,farrayPtr=ptr3d,__RC__) + lm = size(ptr3d,3) + end if + if (item%lm /= lm .and. item%havePressure) then + item%do_VertInterp = .true. + else if (item%lm /= lm .and. lm /= 0) then + item%do_Fill = .true. + end if + + left_field = MAPL_FieldCreate(field,item%fcomp1,doCopy=.true.,__RC__) + right_field = MAPL_FieldCreate(field,item%fcomp1,doCopy=.true.,__RC__) + call item%modelGridFields%comp1%set_parameters(left_field=left_field,right_field=right_field, __RC__) + call ESMF_StateGet(ExtDataState, trim(item%vcomp2), field,__RC__) + left_field = MAPL_FieldCreate(field,item%fcomp2,doCopy=.true.,__RC__) + right_field = MAPL_FieldCreate(field,item%fcomp2,doCopy=.true.,__RC__) + call item%modelGridFields%comp2%set_parameters(left_field=left_field,right_field=right_field, __RC__) + + if (item%do_fill .or. item%do_vertInterp) then + call createFileLevBracket(item,cf,__RC__) + end if + + end if + + _RETURN(_SUCCESS) + end subroutine create_bracketing_fields + END MODULE MAPL_ExtDataGridComp2G diff --git a/gridcomps/ExtData2G/ExtDataRule.F90 b/gridcomps/ExtData2G/ExtDataRule.F90 index 437c26020050..c33619f0f9a6 100644 --- a/gridcomps/ExtData2G/ExtDataRule.F90 +++ b/gridcomps/ExtData2G/ExtDataRule.F90 @@ -52,12 +52,12 @@ function new_ExtDataRule(config,sample_map,key,unusable,rc) result(rule) rule%collection = config%of("collection") if (allocated(tempc)) deallocate(tempc) - is_present = config%has("vname") + is_present = config%has("variable") if (index(rule%collection,"/dev/null")==0) then - _ASSERT(is_present,"no vname present in ExtData export") + _ASSERT(is_present,"no variable present in ExtData export") end if if (is_present) then - tempc = config%of("vname") + tempc = config%of("variable") rule%file_var=tempc else _ASSERT(.false.,"no variable name in rule") From aa0a9d213981ad674cbbec4c1fd62dc2f623b530 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 23 Mar 2022 08:05:31 -0400 Subject: [PATCH 060/300] mepodevelop now default true --- .circleci/config.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.circleci/config.yml b/.circleci/config.yml index eef6ea24818a..2d2b6dc5cfa8 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -12,6 +12,7 @@ workflows: parameters: compiler: [gfortran, ifort] repo: MAPL + mepodevelop: false run_unit_tests: true ctest_options: "-R MAPL -LE PERFORMANCE --output-on-failure" context: @@ -22,6 +23,7 @@ workflows: parameters: compiler: [ifort] repo: MAPL + mepodevelop: false extra_cmake_options: "-DBUILD_WITH_FLAP=OFF -DBUILD_WITH_PFLOGGER=OFF -DBUILD_SHARED_MAPL=OFF" run_unit_tests: true ctest_options: "-R MAPL -LE PERFORMANCE --output-on-failure" @@ -64,6 +66,7 @@ workflows: parameters: compiler: [gfortran, ifort] repo: GEOSldas + mepodevelop: false checkout_fixture: true fixture_branch: develop checkout_mapl_branch: true From f8f86172a38551f008c4119e549b0c51d68ee033 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 23 Mar 2022 08:59:32 -0400 Subject: [PATCH 061/300] Try running FV3 with job --- .circleci/config.yml | 138 ++++++------------------------------------- 1 file changed, 19 insertions(+), 119 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 2d2b6dc5cfa8..30abd3ef7fca 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -8,6 +8,8 @@ workflows: jobs: - ci/build: name: build-and-test-MAPL-on-<< matrix.compiler >> + context: + - docker-hub-creds matrix: parameters: compiler: [gfortran, ifort] @@ -15,10 +17,10 @@ workflows: mepodevelop: false run_unit_tests: true ctest_options: "-R MAPL -LE PERFORMANCE --output-on-failure" - context: - - docker-hub-creds - ci/build: name: build-UFS-MAPL-on-<< matrix.compiler >> + context: + - docker-hub-creds matrix: parameters: compiler: [ifort] @@ -27,10 +29,10 @@ workflows: extra_cmake_options: "-DBUILD_WITH_FLAP=OFF -DBUILD_WITH_PFLOGGER=OFF -DBUILD_SHARED_MAPL=OFF" run_unit_tests: true ctest_options: "-R MAPL -LE PERFORMANCE --output-on-failure" - context: - - docker-hub-creds - ci/build: name: build-GEOSgcm-on-<< matrix.compiler >> + context: + - docker-hub-creds matrix: parameters: compiler: [gfortran, ifort] @@ -38,30 +40,21 @@ workflows: checkout_fixture: true mepodevelop: true checkout_mapl_branch: true + persist_workspace: true # Needs to be true to run fv3/gcm experiment + - ci/run_fv3: + name: run-FV3-on-<< matrix.compiler >> context: - docker-hub-creds - ################################################### - # - make-FV3-exp: # - # name: make-FV3-exp-on-<< matrix.compiler >> # - # matrix: # - # parameters: # - # compiler: [gfortran, ifort] # - # context: # - # - docker-hub-creds # - # requires: # - # - build-GEOSgcm-on-<< matrix.compiler >> # - # - run-FV3: # - # name: run-FV3-on-<< matrix.compiler >> # - # matrix: # - # parameters: # - # compiler: [gfortran, ifort] # - # context: # - # - docker-hub-creds # - # requires: # - # - make-FV3-exp-on-<< matrix.compiler >> # - ################################################### + matrix: + parameters: + compiler: [gfortran, ifort] + requires: + - build-GEOSgcm-on-<< matrix.compiler >> + repo: GEOSgcm - ci/build: name: build-GEOSldas-on-<< matrix.compiler >> + context: + - docker-hub-creds matrix: parameters: compiler: [gfortran, ifort] @@ -70,10 +63,10 @@ workflows: checkout_fixture: true fixture_branch: develop checkout_mapl_branch: true - context: - - docker-hub-creds - ci/build: name: build-GEOSadas-on-<< matrix.compiler >> + context: + - docker-hub-creds matrix: parameters: compiler: [ifort] @@ -85,96 +78,3 @@ workflows: mepodevelop: true develop_repos: "cmake GEOSana_GridComp" rebuild_procs: 8 - context: - - docker-hub-creds - -jobs: - ###################################################### - # ### For future reference ### # - # # We need to persist the install for the next step # - # # but only if we are running FV3 tests # - # - persist_to_workspace: # - # root: workspace # - # paths: # - # - install-GEOSgcm # - ###################################################### - - make-FV3-exp: - parameters: - compiler: - type: string - executor: ci/<< parameters.compiler >> - working_directory: /root/project - steps: - - attach_workspace: - at: workspace - - run: - name: "Run fv3_setup" - command: | - cd ${CIRCLE_WORKING_DIRECTORY}/workspace/install-GEOSgcm/bin - - INPUT_FOR_SETUP=$(cat \< /tmp/input.txt - - cat /tmp/input.txt | ./fv3_setup - - run: - name: "Change FV_NX, FV_NY, and RUN_CMD" - command: | - cd ${CIRCLE_WORKING_DIRECTORY}/workspace/test-fv3-c12 - sed -i.bak -e '/set FV_NX/ s/\([0-9]\+\)/1/' -e '/set FV_NY/ s/\([0-9]\+\)/6/' -e '/set RUN_CMD/ c\set RUN_CMD = "mpirun -np "' fv3.j - - run: - name: "Cat fv3.j" - command: | - cd ${CIRCLE_WORKING_DIRECTORY}/workspace/test-fv3-c12 - cat fv3.j - - # We need to persist the install for the next step - - persist_to_workspace: - root: workspace - paths: - - test-fv3-c12 - - run-FV3: - parameters: - compiler: - type: string - executor: ci/<< parameters.compiler >> - working_directory: /root/project - steps: - - attach_workspace: - at: workspace - - run: - name: "Run fv3.j" - command: | - mkdir -p /logfiles - cd ${CIRCLE_WORKING_DIRECTORY}/workspace/test-fv3-c12 - ./fv3.j |& tee /logfiles/fv3_run.log - - run: - name: "Check for EGRESS" - command: | - cd ${CIRCLE_WORKING_DIRECTORY}/workspace/test-fv3-c12 - - # The scratch directory for fv3 standalone isn't consistent - SCRDIR=$(find . -type d -name 'scratch*') - - if [[ -f $SCRDIR/EGRESS ]] - then - echo "EGRESS found!" - else - echo "EGRESS not found!" - exit 1 - fi - - ci/compress_artifacts - - store_artifacts: - path: /logfiles - From 2d6f0a8d4f77f5257396eea080c904909e74a049 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 23 Mar 2022 10:15:35 -0400 Subject: [PATCH 062/300] Move to orb v1 and add comments. Turn off FV3 --- .circleci/config.yml | 38 +++++++++++++++++++++++++------------- 1 file changed, 25 insertions(+), 13 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 30abd3ef7fca..d29591f9f0e0 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -1,11 +1,13 @@ version: 2.1 orbs: - ci: geos-esm/circleci-tools@0 + ci: geos-esm/circleci-tools@1 workflows: build-and-test: jobs: + + # Builds MAPL in a "default" way - ci/build: name: build-and-test-MAPL-on-<< matrix.compiler >> context: @@ -17,6 +19,8 @@ workflows: mepodevelop: false run_unit_tests: true ctest_options: "-R MAPL -LE PERFORMANCE --output-on-failure" + + # Builds MAPL like UFS does (no FLAP and pFlogger, static) - ci/build: name: build-UFS-MAPL-on-<< matrix.compiler >> context: @@ -29,6 +33,8 @@ workflows: extra_cmake_options: "-DBUILD_WITH_FLAP=OFF -DBUILD_WITH_PFLOGGER=OFF -DBUILD_SHARED_MAPL=OFF" run_unit_tests: true ctest_options: "-R MAPL -LE PERFORMANCE --output-on-failure" + + # Build GEOSgcm - ci/build: name: build-GEOSgcm-on-<< matrix.compiler >> context: @@ -40,17 +46,9 @@ workflows: checkout_fixture: true mepodevelop: true checkout_mapl_branch: true - persist_workspace: true # Needs to be true to run fv3/gcm experiment - - ci/run_fv3: - name: run-FV3-on-<< matrix.compiler >> - context: - - docker-hub-creds - matrix: - parameters: - compiler: [gfortran, ifort] - requires: - - build-GEOSgcm-on-<< matrix.compiler >> - repo: GEOSgcm + persist_workspace: false # Needs to be true to run fv3/gcm experiment, costs extra + + # Build GEOSldas - ci/build: name: build-GEOSldas-on-<< matrix.compiler >> context: @@ -63,6 +61,8 @@ workflows: checkout_fixture: true fixture_branch: develop checkout_mapl_branch: true + + # Build GEOSadas (ifort only, needs a couple develop branches) - ci/build: name: build-GEOSadas-on-<< matrix.compiler >> context: @@ -76,5 +76,17 @@ workflows: fixture_branch: develop checkout_mapl_branch: true mepodevelop: true - develop_repos: "cmake GEOSana_GridComp" + develop_repos: "cmake GEOSana_GridComp" # GEOSadas needs some extra branches to work with mainline MAPL rebuild_procs: 8 + ################################################## + # - ci/run_fv3: # + # name: run-FV3-on-<< matrix.compiler >> # + # context: # + # - docker-hub-creds # + # matrix: # + # parameters: # + # compiler: [gfortran, ifort] # + # requires: # + # - build-GEOSgcm-on-<< matrix.compiler >> # + # repo: GEOSgcm # + ################################################## From f875c9423c5d7d88dc5f08bbab0f9f4f825ce3da Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Thu, 24 Mar 2022 12:21:24 -0400 Subject: [PATCH 063/300] Fixes #1454. Now MAPL_Shmem memory is deallocated properly --- CHANGELOG.md | 1 + generic/GenericCplComp.F90 | 6 ++++-- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3423e26c7526..11fe5e8297a3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] ### Fixed +- fixes a bug deallocating a pointer potentially pointing to shared memory allocated by MAPL_Shmem ### Added diff --git a/generic/GenericCplComp.F90 b/generic/GenericCplComp.F90 index aa1cb263343b..d7fa8cfcbd7e 100644 --- a/generic/GenericCplComp.F90 +++ b/generic/GenericCplComp.F90 @@ -1,3 +1,4 @@ +#define DEALOC_(A) if(associated(A))then;if(MAPL_ShmInitialized)then;call MAPL_SyncSharedMemory(rc=STATUS);call MAPL_DeAllocNodeArray(A,rc=STATUS);else;deallocate(A,stat=STATUS);endif;_VERIFY(STATUS);NULLIFY(A);endif #include "MAPL_Generic.h" #include "unused_dummy.H" @@ -21,6 +22,7 @@ module MAPL_GenericCplCompMod use ESMF use ESMFL_Mod + use MAPL_ShmemMod use MAPL_BaseMod use MAPL_Constants use MAPL_IOMod @@ -1338,7 +1340,7 @@ subroutine ReadRestart(CC, SRC, DST, CLOCK, RC) case default _ASSERT(.false., "Unsupported rank") end select - if(associated(mask)) deallocate(mask) + DEALOC_(mask) end do if (am_i_root) call Free_File(unit = UNIT, rc=STATUS) @@ -1532,7 +1534,7 @@ subroutine WriteRestart(CC, SRC, DST, CLOCK, RC) case default _ASSERT(.false.," Unsupported rank") end select - if(associated(mask)) deallocate(mask) + DEALOC_(mask) end do if(am_i_root) call Free_File(unit = UNIT, rc=STATUS) From 54e7ab8f00e9e15e7b27a60442f7e3637099f8b5 Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Thu, 24 Mar 2022 13:37:46 -0400 Subject: [PATCH 064/300] Adopted the new style macro as suggested by Tom --- generic/GenericCplComp.F90 | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/generic/GenericCplComp.F90 b/generic/GenericCplComp.F90 index d7fa8cfcbd7e..180f75dc7959 100644 --- a/generic/GenericCplComp.F90 +++ b/generic/GenericCplComp.F90 @@ -1,5 +1,14 @@ -#define DEALOC_(A) if(associated(A))then;if(MAPL_ShmInitialized)then;call MAPL_SyncSharedMemory(rc=STATUS);call MAPL_DeAllocNodeArray(A,rc=STATUS);else;deallocate(A,stat=STATUS);endif;_VERIFY(STATUS);NULLIFY(A);endif - +#define _DEALLOC(A) \ + if(associated(A))then; \ + if(MAPL_ShmInitialized)then; \ + call MAPL_SyncSharedMemory(rc=STATUS); \ + call MAPL_DeAllocNodeArray(A,rc=STATUS); \ + else; \ + deallocate(A,stat=STATUS); \ + endif; \ + _VERIFY(STATUS); \ + NULLIFY(A); \ + endif #include "MAPL_Generic.h" #include "unused_dummy.H" @@ -1340,7 +1349,7 @@ subroutine ReadRestart(CC, SRC, DST, CLOCK, RC) case default _ASSERT(.false., "Unsupported rank") end select - DEALOC_(mask) + _DEALLOC(mask) end do if (am_i_root) call Free_File(unit = UNIT, rc=STATUS) @@ -1534,7 +1543,7 @@ subroutine WriteRestart(CC, SRC, DST, CLOCK, RC) case default _ASSERT(.false.," Unsupported rank") end select - DEALOC_(mask) + _DEALLOC(mask) end do if(am_i_root) call Free_File(unit = UNIT, rc=STATUS) From 5071b694c969d94a0a52ddf65df816c49b1924f2 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 24 Mar 2022 14:38:44 -0400 Subject: [PATCH 065/300] Update CHANGELOG and CMakeLists for release --- CHANGELOG.md | 7 ++++++- CMakeLists.txt | 2 +- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 11fe5e8297a3..637de532d1ea 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,7 +8,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] ### Fixed -- fixes a bug deallocating a pointer potentially pointing to shared memory allocated by MAPL_Shmem ### Added @@ -18,6 +17,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Deprecated +## [2.19.1] - 2022-03-24 + +### Fixed + +- Fix a bug deallocating a pointer potentially pointing to shared memory allocated by MAPL_Shmem + ## [2.19.0] - 2022-03-18 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index 5090ffa19888..de364339a5cf 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.19.0 + VERSION 2.19.1 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the default build type to release From 30b81fced5b8040b1f5bcf18a4689e0611acc842 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 28 Mar 2022 10:13:29 -0400 Subject: [PATCH 066/300] Fix GNU Cubed Sphere Factory Bug --- CHANGELOG.md | 6 ++ CMakeLists.txt | 2 +- base/MAPL_CubedSphereGridFactory.F90 | 130 ++++++++++++++------------- 3 files changed, 75 insertions(+), 63 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 637de532d1ea..810b37046654 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Deprecated +## [2.19.2] - 2022-03-28 + +### Fixed + +- Fixed GNU bug when defining file metadata in cubed-sphere grid factory (similar to Issue #1433 and its solution) + ## [2.19.1] - 2022-03-24 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index de364339a5cf..41cfb766652b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.19.1 + VERSION 2.19.2 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the default build type to release diff --git a/base/MAPL_CubedSphereGridFactory.F90 b/base/MAPL_CubedSphereGridFactory.F90 index 8550a1bdb786..426522bd536d 100644 --- a/base/MAPL_CubedSphereGridFactory.F90 +++ b/base/MAPL_CubedSphereGridFactory.F90 @@ -33,7 +33,7 @@ module MAPL_CubedSphereGridFactoryMod type, extends(AbstractGridFactory) :: CubedSphereGridFactory private - + character(len=:), allocatable :: grid_name integer :: grid_type = MAPL_UNDEFINED_INTEGER @@ -90,9 +90,9 @@ module MAPL_CubedSphereGridFactoryMod procedure :: decomps_are_equal procedure :: physical_params_are_equal end type CubedSphereGridFactory - + character(len=*), parameter :: MOD_NAME = 'CubedSphereGridFactory::' - + interface CubedSphereGridFactory module procedure CubedSphereGridFactory_from_parameters end interface CubedSphereGridFactory @@ -128,7 +128,7 @@ function CubedSphereGridFactory_from_parameters(unusable, grid_name, grid_type, integer, optional, intent(in) :: jms(:) ! stretched grid - real(REAL32), optional, intent(in) :: stretch_factor, target_lon, target_lat + real(REAL32), optional, intent(in) :: stretch_factor, target_lon, target_lat integer, optional, intent(out) :: rc @@ -182,7 +182,7 @@ function make_new_grid(this, unusable, rc) result(grid) end function make_new_grid - + function create_basic_grid(this, unusable, rc) result(grid) type (ESMF_Grid) :: grid class (CubedSphereGridFactory), intent(in) :: this @@ -210,7 +210,7 @@ function create_basic_grid(this, unusable, rc) result(grid) enddo if(allocated(this%jms_2d)) then - _ASSERT(size(this%jms_2d,2) == 6,'incompatible shape') + _ASSERT(size(this%jms_2d,2) == 6,'incompatible shape') allocate(jms, source = this%jms_2d) else allocate(jms(this%ny,nTile)) @@ -226,7 +226,7 @@ function create_basic_grid(this, unusable, rc) result(grid) transformArgument%target_lat=this%target_lat grid = ESMF_GridCreateCubedSPhere(this%im_world,countsPerDEDim1PTile=ims, & countsPerDEDim2PTile=jms ,name=this%grid_name, & - staggerLocList=[ESMF_STAGGERLOC_CENTER,ESMF_STAGGERLOC_CORNER], coordSys=ESMF_COORDSYS_SPH_RAD, & + staggerLocList=[ESMF_STAGGERLOC_CENTER,ESMF_STAGGERLOC_CORNER], coordSys=ESMF_COORDSYS_SPH_RAD, & transformArgs=transformArgument,rc=status) _VERIFY(status) if (this%stretch_factor/=MAPL_UNDEFINED_REAL .and. this%target_lon/=MAPL_UNDEFINED_REAL .and. & @@ -287,7 +287,7 @@ function create_basic_grid(this, unusable, rc) result(grid) _RETURN(_SUCCESS) end function create_basic_grid - + subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_file_coordinates, rc) use MAPL_KeywordEnforcerMod use MAPL_BaseMod, only: MAPL_DecomposeDim @@ -351,7 +351,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi _ASSERT(.false.,'unsupport subclass for stretch params') end select end if - + hasLev=.false. hasLevel=.false. @@ -432,7 +432,7 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc _VERIFY(status) ! halo initialization - + call ESMF_VmGet(VM, mpicommunicator=vmcomm, petCount=ndes, rc=status) _VERIFY(status) @@ -440,7 +440,7 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc _RETURN(_SUCCESS) contains - + subroutine get_multi_integer(values, label, rc) integer, allocatable, intent(out) :: values(:) character(len=*) :: label @@ -451,7 +451,7 @@ subroutine get_multi_integer(values, label, rc) integer :: tmp integer :: status logical :: isPresent - + call ESMF_ConfigFindLabel(config, label=prefix//label,isPresent=isPresent,rc=status) _VERIFY(status) if (.not. isPresent) then @@ -494,7 +494,7 @@ subroutine get_jms_from_file(values, file_name, n, rc) integer :: status, N_proc,NF integer, allocatable :: values_tmp(:), values_(:,:) - + N_proc = n*6 ! it has been devided by 6. get back the original NY allocate(values_tmp(N_proc), stat=status) ! no point in checking status _VERIFY(status) @@ -534,7 +534,7 @@ subroutine get_jms_from_file(values, file_name, n, rc) face = face + values_tmp(k) k = k+1 if (face == this%im_world) exit - enddo + enddo enddo values = values_ @@ -551,7 +551,7 @@ subroutine get_bounds(bounds, label, rc) integer :: n integer :: status logical :: isPresent - + call ESMF_ConfigFindLabel(config, label=prefix//label,isPresent=isPresent,rc=status) _VERIFY(status) if (.not. isPresent) then @@ -568,9 +568,9 @@ subroutine get_bounds(bounds, label, rc) end subroutine get_bounds - + end subroutine initialize_from_config_with_prefix - + subroutine halo_init(this, halo_width,rc) class (CubedSphereGridFactory), intent(inout) :: this integer, optional, intent(in) :: halo_width @@ -602,7 +602,7 @@ subroutine halo_init(this, halo_width,rc) _VERIFY(status) call ESMF_FieldDestroy(field,rc=status) _VERIFY(status) - + end subroutine halo_init function to_string(this) result(string) @@ -649,14 +649,14 @@ subroutine check_and_fill_consistency(this, unusable, rc) !_ASSERT(allocated(this%ims) .eqv. allocated(this%jms),'inconsistent options') call verify(this%nx, this%im_world, this%ims, rc=status) if (allocated(this%jms_2d)) then - _ASSERT(size(this%jms_2d,2)==6, 'incompatible shape') + _ASSERT(size(this%jms_2d,2)==6, 'incompatible shape') _ASSERT(sum(this%jms_2d) == 6*this%im_world, 'incompatible shape') else call verify(this%ny, this%im_world, this%jms, rc=status) endif - + _RETURN(_SUCCESS) - + contains subroutine verify(n, m_world, ms, rc) @@ -704,52 +704,52 @@ elemental subroutine set_with_default_integer(to, from, default) integer, intent(out) :: to integer, optional, intent(in) :: from integer, intent(in) :: default - + if (present(from)) then to = from else to = default end if - + end subroutine set_with_default_integer - + elemental subroutine set_with_default_real64(to, from, default) real(REAL64), intent(out) :: to real(REAL64), optional, intent(in) :: from real(REAL64), intent(in) :: default - + if (present(from)) then to = from else to = default end if - + end subroutine set_with_default_real64 - + elemental subroutine set_with_default_real(to, from, default) real, intent(out) :: to real, optional, intent(in) :: from real, intent(in) :: default - + if (present(from)) then to = from else to = default end if - + end subroutine set_with_default_real - + subroutine set_with_default_character(to, from, default) character(len=:), allocatable, intent(out) :: to character(len=*), optional, intent(in) :: from character(len=*), intent(in) :: default - + if (present(from)) then to = from else to = default end if - + end subroutine set_with_default_character @@ -757,15 +757,15 @@ elemental subroutine set_with_default_bounds(to, from, default) type (RealMinMax), intent(out) :: to type (RealMinMax), optional, intent(in) :: from type (RealMinMax), intent(in) :: default - + if (present(from)) then to = from else to = default end if - + end subroutine set_with_default_bounds - + function decomps_are_equal(this, a) result(equal) class (CubedSphereGridFactory), intent(in) :: this class (AbstractGridFactory), intent(in) :: a @@ -781,7 +781,7 @@ function decomps_are_equal(this, a) result(equal) if (.not. equal) return equal = size(a%jms) == size(this%jms) if (.not. equal) return - equal = all(a%ims == this%ims) + equal = all(a%ims == this%ims) if (.not. equal) return if ( allocated(a%jms) .and. allocated(this%jms)) then @@ -795,7 +795,7 @@ function decomps_are_equal(this, a) result(equal) equal = all(a%jms_2d == this%jms_2d) if (.not. equal) return endif - end select + end select end function decomps_are_equal @@ -813,18 +813,18 @@ function physical_params_are_equal(this, a) result(equal) equal = (a%im_world == this%im_world) if (.not. equal) return - + equal = (a%stretch_factor == this%stretch_factor) if (.not. equal) return - + equal = (a%target_lon == this%target_lon) if (.not. equal) return - + equal = (a%target_lat == this%target_lat) if (.not. equal) return - + end select - + end function physical_params_are_equal logical function equals(a, b) @@ -843,12 +843,12 @@ logical function equals(a, b) equals = a%decomps_are_equal(b) if (.not. equals) return - + equals = a%physical_params_are_equal(b) if (.not. equals) return - + end select - + end function equals subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, unusable, rc) @@ -866,7 +866,7 @@ subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, _UNUSED_DUMMY(lon_array) _UNUSED_DUMMY(lat_array) _UNUSED_DUMMY(unusable) - + _FAIL('not implemented') end subroutine initialize_from_esmf_distGrid @@ -887,7 +887,7 @@ subroutine halo(this, array, unusable, halo_width, rc) integer :: useableHalo_width _UNUSED_DUMMY(unusable) - + if (.not. this%halo_initialized) then call this%halo_init(halo_width = halo_width) this%halo_initialized = .true. @@ -912,7 +912,7 @@ subroutine halo(this, array, unusable, halo_width, rc) array = ptr call ESMF_FieldDestroy(field,rc=status) _VERIFY(status) - + _RETURN(_SUCCESS) end subroutine halo @@ -943,6 +943,8 @@ subroutine append_metadata(this, metadata)!, unusable, rc) integer, allocatable :: ivar(:,:) integer, allocatable :: ivar2(:,:,:) + real(REAL64), allocatable :: temp_coords + integer :: status integer, parameter :: ncontact = 4 integer, parameter :: nf = 6 @@ -960,12 +962,16 @@ subroutine append_metadata(this, metadata)!, unusable, rc) v = Variable(type=PFIO_REAL64, dimensions='Xdim') call v%add_attribute('long_name', 'Fake Longitude for GrADS Compatibility') call v%add_attribute('units', 'degrees_east') - call metadata%add_variable('Xdim', CoordinateVariable(v, this%get_fake_longitudes())) + temp_coords = this%get_fake_longitudes() + call metadata%add_variable('Xdim', CoordinateVariable(v, temp_coords)) + deallocate(temp_coords) v = Variable(type=PFIO_REAL64, dimensions='Ydim') call v%add_attribute('long_name', 'Fake Latitude for GrADS Compatibility') call v%add_attribute('units', 'degrees_north') - call metadata%add_variable('Ydim', CoordinateVariable(v, this%get_fake_latitudes())) + temp_coords = this%get_fake_latitudes() + call metadata%add_variable('Ydim', CoordinateVariable(v, temp_coords)) + deallocate(temp_coords) v = Variable(type=PFIO_INT32, dimensions='nf') call v%add_attribute('long_name','cubed-sphere face') @@ -1007,7 +1013,7 @@ subroutine append_metadata(this, metadata)!, unusable, rc) im = this%im_world allocate(ivar2(4,4,6)) - ivar2 = reshape( & + ivar2 = reshape( & [[im, im, 1, im, & 1, im, 1, 1, & 1, im, 1, 1, & @@ -1125,11 +1131,11 @@ function get_fake_longitudes(this, unusable, rc) result(longitudes) integer :: j_mid integer :: tile integer :: status - + character(len=*), parameter :: Iam = MOD_NAME // 'get_fake_longitudes()' - + _UNUSED_DUMMY(unusable) - + grid = this%make_grid() call ESMF_GridGetCoord(grid, coordDim=1, localDE=0, & @@ -1142,7 +1148,7 @@ function get_fake_longitudes(this, unusable, rc) result(longitudes) call ESMF_VMGet(vm, mpiCommunicator=comm_grid, petcount=npes, localpet=pet, rc=status) _VERIFY(status) - + call MAPL_grid_interior(grid, i_1, i_n, j_1, j_n) j_mid = 1 + this%im_world/2 @@ -1159,7 +1165,7 @@ function get_fake_longitudes(this, unusable, rc) result(longitudes) end if allocate(counts(0:npes-1), displs(0:npes-1)) - + call MPI_Allgather(n_loc, 1, MPI_INTEGER, counts, 1, MPI_INTEGER, comm_grid, ierror) _VERIFY(ierror) @@ -1173,7 +1179,7 @@ function get_fake_longitudes(this, unusable, rc) result(longitudes) _VERIFY(ierror) longitudes = longitudes * MAPL_RADIANS_TO_DEGREES - + end function get_fake_longitudes function get_fake_latitudes(this, unusable, rc) result(latitudes) @@ -1197,11 +1203,11 @@ function get_fake_latitudes(this, unusable, rc) result(latitudes) integer :: j_mid integer :: tile integer :: status - + character(len=*), parameter :: Iam = MOD_NAME // 'get_fake_latitudes()' _UNUSED_DUMMY(unusable) - + grid = this%make_grid() call ESMF_GridGetCoord(grid, coordDim=2, localDE=0, & @@ -1214,7 +1220,7 @@ function get_fake_latitudes(this, unusable, rc) result(latitudes) call ESMF_VMGet(vm, mpiCommunicator=comm_grid, petcount=npes, localpet=pet, rc=status) _VERIFY(status) - + call MAPL_grid_interior(grid, i_1, i_n, j_1, j_n) j_mid = 1 + this%im_world/2 @@ -1231,7 +1237,7 @@ function get_fake_latitudes(this, unusable, rc) result(latitudes) end if allocate(counts(0:npes-1), displs(0:npes-1)) - + call MPI_Allgather(n_loc, 1, MPI_INTEGER, counts, 1, MPI_INTEGER, comm_grid, ierror) _VERIFY(ierror) @@ -1245,7 +1251,7 @@ function get_fake_latitudes(this, unusable, rc) result(latitudes) _VERIFY(ierror) latitudes = latitudes * MAPL_RADIANS_TO_DEGREES - + end function get_fake_latitudes subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,metaData,rc) From 23262af24fb8f49d4ecfd288ae5a76472a5cabfe Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 28 Mar 2022 10:32:23 -0400 Subject: [PATCH 067/300] Sigh. Make it an array --- base/MAPL_CubedSphereGridFactory.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/base/MAPL_CubedSphereGridFactory.F90 b/base/MAPL_CubedSphereGridFactory.F90 index 426522bd536d..f680ecf343fd 100644 --- a/base/MAPL_CubedSphereGridFactory.F90 +++ b/base/MAPL_CubedSphereGridFactory.F90 @@ -943,7 +943,7 @@ subroutine append_metadata(this, metadata)!, unusable, rc) integer, allocatable :: ivar(:,:) integer, allocatable :: ivar2(:,:,:) - real(REAL64), allocatable :: temp_coords + real(REAL64), allocatable :: temp_coords(:) integer :: status integer, parameter :: ncontact = 4 From f731668c2093d136f52ee8dd716577bd5e3cb90e Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 28 Mar 2022 12:57:04 -0400 Subject: [PATCH 068/300] Update CHANGELOG.md Co-authored-by: Tom Clune --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 810b37046654..30ce7bc08f28 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -21,7 +21,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed -- Fixed GNU bug when defining file metadata in cubed-sphere grid factory (similar to Issue #1433 and its solution) +- Provided workaround for GNU bug when defining file metadata in cubed-sphere grid factory (similar to Issue #1433 and its solution) ## [2.19.1] - 2022-03-24 From 74244ed7e57d4e312ab1a09dffe8385f36716b12 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 29 Mar 2022 11:33:36 -0400 Subject: [PATCH 069/300] kind of got the multiple templates working --- gridcomps/ExtData2G/ExtDataConfig.F90 | 125 +++++++++- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 228 ++++++++++++------ .../ExtData2G/ExtDataOldTypesCreator.F90 | 14 +- gridcomps/ExtData2G/ExtDataRule.F90 | 4 +- gridcomps/ExtData2G/ExtDataTypeDef.F90 | 4 + gridcomps/ExtData2G/ExtDataUpdatePointer.F90 | 56 ++++- 6 files changed, 344 insertions(+), 87 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index 28ce097d34c3..6f637183b02b 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -14,6 +14,7 @@ module MAPL_ExtDataConfig use MAPL_ExtDataConstants use MAPL_ExtDataTimeSample use MAPL_ExtDataTimeSampleMap + use MAPL_TimeStringConversion implicit none private @@ -29,6 +30,8 @@ module MAPL_ExtDataConfig procedure :: get_item_type procedure :: get_debug_flag procedure :: new_ExtDataConfig_from_yaml + procedure :: count_rules_for_item + procedure :: get_time_range end type contains @@ -57,10 +60,9 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ type(Configuration) :: subconfigs,rule_map character(len=:), allocatable :: sub_file integer :: i,num_rules + integer, allocatable :: sorted_rules(:) character(len=1) :: i_char - type(ExtDataTimeSample), pointer :: ts_grr - _UNUSED_DUMMY(unusable) p = Parser('core') @@ -116,9 +118,10 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ if (subcfg%is_mapping()) then call ext_config%add_new_rule(key,subcfg,_RC) else if (subcfg%is_sequence()) then + sorted_rules = sort_rules_by_start(subcfg,_RC) num_rules = subcfg%size() do i=1,num_rules - rule_map = subcfg%of(i) + rule_map = subcfg%of(sorted_rules(i)) write(i_char,'(I1)')i new_key = key//i_char call ext_config%add_new_rule(new_key,rule_map,_RC) @@ -154,6 +157,100 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ _RETURN(_SUCCESS) end subroutine new_ExtDataConfig_from_yaml + function count_rules_for_item(this,item_name,rc) result(number_of_rules) + integer :: number_of_rules + class(ExtDataConfig), intent(in) :: this + character(len=*), intent(in) :: item_name + integer, optional, intent(out) :: rc + + type(ExtDataRuleMapIterator) :: rule_iterator + character(len=:), pointer :: key + rule_iterator = this%rule_map%begin() + number_of_rules = 0 + do while(rule_iterator /= this%rule_map%end()) + key => rule_iterator%key() + if (index(key,trim(item_name))/=0) number_of_rules = number_of_rules + 1 + call rule_iterator%next() + enddo + + _RETURN(_SUCCESS) + end function count_rules_for_item + + function get_time_range(this,item_name,rc) result(time_range) + type(ESMF_Time), allocatable :: time_range(:) + class(ExtDataConfig), intent(in) :: this + character(len=*), intent(in) :: item_name + integer, optional, intent(out) :: rc + + type(ExtDataRuleMapIterator) :: rule_iterator + character(len=:), pointer :: key + type(StringVector) :: start_times + integer :: num_rules + type(ExtDataRule), pointer :: rule + integer :: i,status + type(ESMF_Time) :: very_future_time + + rule_iterator = this%rule_map%begin() + do while(rule_iterator /= this%rule_map%end()) + key => rule_iterator%key() + if (index(key,trim(item_name))/=0) then + rule => rule_iterator%value() + call start_times%push_back(rule%start_time) + end if + call rule_iterator%next() + enddo + + num_rules = start_times%size() + allocate(time_range(num_rules+1)) + do i=1,num_rules + time_range(i) = string_to_esmf_time(start_times%at(i)) + enddo + call ESMF_TimeSet(very_future_time,yy=2365,mm=1,dd=1,_RC) + time_range(num_rules+1) = very_future_time + + _RETURN(_SUCCESS) + end function get_time_range + + function sort_rules_by_start(yaml_sequence,rc) result(sorted_index) + integer, allocatable :: sorted_index(:) + class(Configuration), intent(inout) :: yaml_sequence + integer, optional, intent(out) :: rc + + integer :: num_rules,i,j,i_temp,imin + logical :: found_start + type(configuration) :: yaml_dict + character(len=:), allocatable :: start_time + type(ESMF_Time), allocatable :: start_times(:) + type(ESMF_Time) :: temp_time + + num_rules = yaml_sequence%size() + allocate(start_times(num_rules)) + allocate(sorted_index(num_rules),source=[(i,i=1,num_rules)]) + + do i=1,num_rules + yaml_dict = yaml_sequence%of(i) + found_start = yaml_dict%has("starting") + _ASSERT(found_start,"no start key in multirule export of extdata") + start_time = yaml_dict%of("starting") + start_times(i) = string_to_esmf_time(start_time) + enddo + + do i=1,num_rules-1 + imin = i + do j=i+1,num_rules + if (start_times(j) < start_times(imin)) then + temp_time = start_times(imin) + start_times(imin) = start_times(i) + start_times(i) = temp_time + i_temp = sorted_index(imin) + sorted_index(imin) = sorted_index(i) + sorted_index(i) = i_temp + end if + enddo + enddo + _RETURN(_SUCCESS) + end function sort_rules_by_start + function get_item_type(this,item_name,unusable,rc) result(item_type) class(ExtDataConfig), intent(inout) :: this character(len=*), intent(in) :: item_name @@ -163,9 +260,29 @@ function get_item_type(this,item_name,unusable,rc) result(item_type) type(ExtDataRule), pointer :: rule type(ExtDataDerived), pointer :: derived + type(ExtDataRuleMapIterator) :: rule_iterator + character(len=:), pointer :: key + character(len=:), allocatable :: found_key + logical :: found_rule + _UNUSED_DUMMY(unusable) item_type=ExtData_not_found - rule => this%rule_map%at(trim(item_name)) + + found_rule = .false. + rule_iterator = this%rule_map%begin() + do while(rule_iterator /= this%rule_map%end()) + key => rule_iterator%key() + if (index(key,trim(item_name))/=0) then + found_rule = .true. + found_key = key + exit + end if + call rule_iterator%next() + enddo + _ASSERT(found_rule,"no rule for "//trim(item_name)) + + !rule => this%rule_map%at(trim(item_name)) + rule => this%rule_map%at(found_key) if (associated(rule)) then if (allocated(rule%vector_component)) then if (rule%vector_component=='EW') then diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index be8ce3fbcbbc..bb0f068de262 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -23,6 +23,7 @@ MODULE MAPL_ExtDataGridComp2G ! USE ESMF use gFTL_StringVector + use gFTL_IntegerVector use MAPL_BaseMod use MAPL_CommsMod use MAPL_ShmemMod @@ -80,13 +81,19 @@ MODULE MAPL_ExtDataGridComp2G type PrimaryExports PRIVATE integer :: nItems = 0 + type(integerVector) :: export_id_start + type(integerVector) :: number_of_rules + type(stringVector) :: import_names logical :: have_phis - type(PrimaryExport), pointer :: item(:) => null() + type(PrimaryExport), pointer :: item(:) => null() + contains + procedure :: get_item_index end type PrimaryExports type DerivedExports PRIVATE integer :: nItems = 0 + type(stringVector) :: import_names type(DerivedExport), pointer :: item(:) => null() end type DerivedExports @@ -278,7 +285,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) integer :: Status type(PrimaryExport), pointer :: item - integer :: i + integer :: i,j integer :: ItemCount integer :: PrimaryItemCount, DerivedItemCount @@ -294,9 +301,12 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(ExtDataOldTypesCreator),target :: config_yaml character(len=:), allocatable :: new_rc_file logical :: found_in_config - integer :: num_primary,num_derived + integer :: num_primary,num_derived,num_rules integer, allocatable :: item_types(:) type(StringVector) :: unsatisfied_imports + character(len=:), pointer :: current_base_name + type(ESMF_Time), allocatable :: time_ranges(:) + character(len=1) :: sidx !class(logger), pointer :: lgr ! Get my name and set-up traceback handle @@ -377,9 +387,11 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) found_in_config = (item_types(i)/= ExtData_not_found) if (.not.found_in_config) call unsatisfied_imports%push_back(itemnames(i)) if (item_types(i) == derived_type) then + call self%derived%import_names%push_back(trim(itemnames(i))) deriveditemcount=deriveditemcount+1 else - primaryitemcount=primaryitemcount+1 + call self%primary%import_names%push_back(trim(itemnames(i))) + primaryitemcount=primaryitemcount+config_yaml%count_rules_for_item(trim(itemnames(i)),_RC) end if enddo if (unsatisfied_imports%size() > 0) then @@ -398,33 +410,51 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) self%ExtDataState = ESMF_StateCreate(Name="ExtDataNameSpace",__RC__) num_primary=0 num_derived=0 - do i=1,size(itemnames) - if (item_types(i)==Primary_Type_Scalar .or. item_types(i)==Primary_Type_Vector_comp1) then + do i=1,self%primary%import_names%size() + current_base_name => self%primary%import_names%at(i) + num_rules = config_yaml%count_rules_for_item(current_base_name) + call self%primary%number_of_rules%push_back(num_rules) + call self%primary%export_id_start%push_back(num_primary+1) + if (num_rules > 1) then + if (allocated(time_ranges)) deallocate(time_ranges) + allocate(time_ranges(num_rules)) + time_ranges = config_yaml%get_time_range(current_base_name,_RC) + do j=1,num_rules + num_primary=num_primary+1 + write(sidx,'(I1)')j + call config_yaml%fillin_primary(current_base_name//sidx,current_base_name,self%primary%item(num_primary),time,clock,__RC__) + allocate(self%primary%item(num_primary)%start_end_time(2)) + self%primary%item(num_primary)%start_end_time(1)=time_ranges(j) + self%primary%item(num_primary)%start_end_time(2)=time_ranges(j+1) + enddo + else num_primary=num_primary+1 - call config_yaml%fillin_primary(trim(itemnames(i)),self%primary%item(num_primary),time,clock,__RC__) - else if (item_types(i)==Derived_type) then - num_derived=num_derived+1 - call config_yaml%fillin_derived(trim(itemnames(i)),self%derived%item(num_derived),time,clock,__RC__) + call config_yaml%fillin_primary(current_base_name,current_base_name,self%primary%item(num_primary),time,clock,__RC__) end if - call ESMF_StateGet(Export,trim(itemnames(i)),field,__RC__) + call ESMF_StateGet(Export,current_base_name,field,__RC__) + call MAPL_StateAdd(self%ExtDataState,field,__RC__) + enddo + do i=1,self%derived%import_names%size() + current_base_name => self%derived%import_names%at(i) + num_derived=num_derived+1 + call config_yaml%fillin_derived(current_base_name,self%derived%item(num_derived),time,clock,__RC__) + call ESMF_StateGet(Export,current_base_name,field,__RC__) call MAPL_StateAdd(self%ExtDataState,field,__RC__) enddo -! note: handle case if variables in derived expression need to be allocated! - PrimaryLoop: do i = 1, self%primary%nItems + !PrimaryLoop: do i = 1, self%primary%nItems + PrimaryLoop: do i=1,self%primary%import_names%size() - item => self%primary%item(i) + current_base_name => self%primary%import_names%at(i) + idx = self%primary%get_item_index(current_base_name,time,_RC) + item => self%primary%item(idx) + item%initialized = .true. item%pfioCollection_id = MAPL_DataAddCollection(item%file_template) - -! Read the single step files (read interval equal to zero) -! -------------------------------------------------------- - if (item%isConst) then call set_constant_field(item,self%extDataState,_RC) cycle end if - call create_bracketing_fields(item,self%ExtDataState,cf_master,rc) end do PrimaryLoop @@ -435,34 +465,34 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) do i=1,size(self%primary%item) self%primaryOrder(i)=i enddo -! check for PS - idx = -1 - if (any(self%primary%item%do_VertInterp .eqv. .true.)) then - do i=1,size(self%primary%item) - if (self%primary%item(i)%name=='PS') then - idx =i - end if - enddo - _ASSERT(idx/=-1,'Surface pressure not present for vertical interpolation') - self%primaryOrder(1)=idx - self%primaryOrder(idx)=1 - self%primary%item(idx)%units = ESMF_UtilStringUppercase(self%primary%item(idx)%units,rc=status) - _ASSERT(trim(self%primary%item(idx)%units)=="PA",'PS must be in units of PA') - end if -! check for PHIS - idx = -1 - if (any(self%primary%item%do_VertInterp .eqv. .true.)) then - do i=1,size(self%primary%item) - if (self%primary%item(i)%name=='PHIS') then - idx =i - end if - enddo - if (idx/=-1) then - self%primaryOrder(2)=idx - self%primaryOrder(idx)=2 - self%primary%have_phis=.true. - end if - end if +!! check for PS + !idx = -1 + !if (any(self%primary%item%do_VertInterp .eqv. .true.)) then + !do i=1,size(self%primary%item) + !if (self%primary%item(i)%name=='PS') then + !idx =i + !end if + !enddo + !_ASSERT(idx/=-1,'Surface pressure not present for vertical interpolation') + !self%primaryOrder(1)=idx + !self%primaryOrder(idx)=1 + !self%primary%item(idx)%units = ESMF_UtilStringUppercase(self%primary%item(idx)%units,rc=status) + !_ASSERT(trim(self%primary%item(idx)%units)=="PA",'PS must be in units of PA') + !end if +!! check for PHIS + !idx = -1 + !if (any(self%primary%item%do_VertInterp .eqv. .true.)) then + !do i=1,size(self%primary%item) + !if (self%primary%item(i)%name=='PHIS') then + !idx =i + !end if + !enddo + !if (idx/=-1) then + !self%primaryOrder(2)=idx + !self%primaryOrder(idx)=2 + !self%primary%have_phis=.true. + !end if + !end if call extdata_lgr%info('*******************************************************') call extdata_lgr%info('** Variables to be provided by the ExtData Component **') @@ -556,6 +586,9 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(IOBundleNGVector), target :: IOBundles type(IOBundleNGVectorIterator) :: bundle_iter type(ExtDataNG_IOBundle), pointer :: io_bundle + character(len=:), pointer :: current_base_name + integer :: idx + type(ESMF_Config) :: cf_master _UNUSED_DUMMY(IMPORT) _UNUSED_DUMMY(EXPORT) @@ -567,15 +600,9 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! Get my name and set-up traceback handle ! --------------------------------------- Iam = 'Run_' - call ESMF_GridCompGet( GC, name=comp_name, __RC__ ) + call ESMF_GridCompGet( GC, name=comp_name, config=CF_master, __RC__ ) Iam = trim(comp_name) // '::' // trim(Iam) - -! Call Run for every Child -! ------------------------- -!ALT call MAPL_GenericRunChildren ( GC, IMPORT, EXPORT, CLOCK, __RC__) - - ! Extract relevant runtime information ! ------------------------------------ call extract_ ( GC, self, CF, __RC__ ) @@ -591,7 +618,6 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call ESMF_ClockGet(CLOCK, currTIME=time0, __RC__) - ! Fill in the internal state with data from the files ! --------------------------------------------------- @@ -608,9 +634,23 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) Write(*,*) 'ExtData Run_: READ_LOOP: Start' ENDIF - READ_LOOP: do i = 1, self%primary%nItems + !READ_LOOP: do i = 1, self%primary%nItems + READ_LOOP: do i=1,self%primary%import_names%size() + + current_base_name => self%primary%import_names%at(i) + idx = self%primary%get_item_index(current_base_name,time0,_RC) + item => self%primary%item(idx) + if (.not.item%initialized) then + item%pfioCollection_id = MAPL_DataAddCollection(item%file_template) + if (item%isConst) then + call set_constant_field(item,self%extDataState,_RC) + cycle + end if + call create_bracketing_fields(item,self%ExtDataState,cf_master, rc) + item%initialized=.true. + end if - item => self%primary%item(self%primaryOrder(i)) + !item => self%primary%item(self%primaryOrder(i)) IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN Write(*,*) ' ' @@ -634,10 +674,11 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) DO_UPDATE: if (doUpdate(i)) then - call extdata_lgr%info('Going to update %a with file template: %a ',item%name, item%file_template) + call extdata_lgr%info('Going to update %a with file template: %a ',current_base_name, item%file_template) call item%modelGridFields%comp1%reset() call item%filestream%get_file_bracket(time,item%source_time, item%modelGridFields%comp1,__RC__) - call IOBundle_Add_Entry(IOBundles,item,self%primaryOrder(i)) + !call IOBundle_Add_Entry(IOBundles,item,self%primaryOrder(i)) + call IOBundle_Add_Entry(IOBundles,item,idx) useTime(i)=time end if DO_UPDATE @@ -710,18 +751,28 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) Write(*,*) 'ExtData Run_: INTERP_LOOP: Start' ENDIF - INTERP_LOOP: do i = 1, self%primary%nItems + INTERP_LOOP: do i=1,self%primary%import_names%size() - item => self%primary%item(self%primaryOrder(i)) + current_base_name => self%primary%import_names%at(i) + idx = self%primary%get_item_index(current_base_name,time0,_RC) + item => self%primary%item(idx) + !if (.not.item%initialized) then + !item%pfioCollection_id = MAPL_DataAddCollection(item%file_template) + !if (item%isConst) then + !call set_constant_field(item,self%extDataState,_RC) + !cycle + !end if + !call create_bracketing_fields(item,self%ExtDataState,cf_master, rc) + !end if if (doUpdate(i)) then - IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN + IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN Write(*,*) ' ' Write(*,'(a)') 'ExtData Run_: INTERP_LOOP: interpolating between bracket times' Write(*,*) ' ==> variable: ', trim(item%var) Write(*,*) ' ==> file: ', trim(item%file_template) - ENDIF + ENDIF ! finally interpolate between bracketing times @@ -2152,25 +2203,25 @@ subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,rc) integer :: status type (ExtDataNG_IOBundle) :: io_bundle - type (GriddedIOItemVector) :: items + type (GriddedIOItemVector) :: itemsL, itemsR logical :: update character(len=ESMF_MAXPATHLEN) :: current_file integer :: time_index call item%modelGridFields%comp1%get_parameters('L',update=update,file=current_file,time_index=time_index) if (update) then - call items%push_back(item%fileVars) + call itemsL%push_back(item%fileVars) io_bundle = ExtDataNG_IOBundle(MAPL_ExtDataLeft, entry_num, current_file, time_index, item%trans, item%fracval, item%file_template, & - item%pfioCollection_id,item%iclient_collection_id,items,rc=status) + item%pfioCollection_id,item%iclient_collection_id,itemsL,rc=status) _VERIFY(status) call IOBundles%push_back(io_bundle) call extdata_lgr%info('%a updated L bracket with: %a at time index %i2 ',item%name, current_file, time_index) end if call item%modelGridFields%comp1%get_parameters('R',update=update,file=current_file,time_index=time_index) if (update) then - call items%push_back(item%fileVars) + call itemsR%push_back(item%fileVars) io_bundle = ExtDataNG_IOBundle(MAPL_ExtDataRight, entry_num, current_file, time_index, item%trans, item%fracval, item%file_template, & - item%pfioCollection_id,item%iclient_collection_id,items,rc=status) + item%pfioCollection_id,item%iclient_collection_id,itemsR,rc=status) _VERIFY(status) call IOBundles%push_back(io_bundle) call extdata_lgr%info('%a updated R bracket with: %a at time index %i2 ',item%name,current_file, time_index) @@ -2304,4 +2355,45 @@ subroutine create_bracketing_fields(item,ExtDataState,cf,rc) _RETURN(_SUCCESS) end subroutine create_bracketing_fields + function get_item_index(this,base_name,current_time,rc) result(item_index) + integer :: item_index + class(primaryExports), intent(in) :: this + type(ESMF_Time) :: current_time + character(len=*),intent(in) :: base_name + integer, optional, intent(out) :: rc + + integer :: status + character(len=:), pointer :: cname + integer :: i + integer, pointer :: num_rules,i_start + logical :: found + + found = .false. + do i=1,this%import_names%size() + cname => this%import_names%at(i) + if (cname == base_name) then + found = .true. + i_start => this%export_id_start%at(i) + num_rules => this%number_of_rules%at(i) + exit + end if + enddo + _ASSERT(found,"no item with that basename found") + + item_index = -1 + if (num_rules == 1) then + item_index = i_start + else if (num_rules > 1) then + do i=1,num_rules + if (current_time >= this%item(i_start+i-1)%start_end_time(1) .and. & + current_time < this%item(i_start+i-1)%start_end_time(2)) then + item_index = i_start + i -1 + exit + endif + enddo + end if + _ASSERT(item_index/=-1,"did not find item") + _RETURN(_SUCCESS) + end function get_item_index + END MODULE MAPL_ExtDataGridComp2G diff --git a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 index bdca0eea4066..72de161aeb7e 100644 --- a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 +++ b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 @@ -55,9 +55,10 @@ function new_ExtDataOldTypesCreator(config_file,current_time,unusable,rc ) resul end function new_ExtDataOldTypesCreator - subroutine fillin_primary(this,item_name,primary_item,time,clock,unusable,rc) + subroutine fillin_primary(this,item_name,base_name,primary_item,time,clock,unusable,rc) class(ExtDataOldTypesCreator), intent(inout) :: this character(len=*), intent(in) :: item_name + character(len=*), intent(in) :: base_name type(PrimaryExport), intent(inout) :: primary_item type(ESMF_Time), intent(inout) :: time type(ESMF_Clock), intent(inout) :: clock @@ -83,10 +84,13 @@ subroutine fillin_primary(this,item_name,primary_item,time,clock,unusable,rc) end if primary_item%isVector = allocated(rule%vector_partner) ! name and file var - primary_item%name = trim(item_name) + !primary_item%name = trim(item_name) + primary_item%name = trim(base_name) if (primary_item%isVector) then + write(*,*)"bmaa vv 1" primary_item%vartype = MAPL_VectorField - primary_item%vcomp1 = trim(item_name) + !primary_item%vcomp1 = trim(item_name) + primary_item%vcomp1 = trim(base_name) primary_item%vcomp2 = trim(rule%vector_partner) primary_item%var = rule%file_var primary_item%fcomp1 = rule%file_var @@ -96,7 +100,9 @@ subroutine fillin_primary(this,item_name,primary_item,time,clock,unusable,rc) primary_item%fileVars%yname = trim(rule%vector_file_partner) else primary_item%vartype = MAPL_FieldItem - primary_item%vcomp1 = trim(item_name) + write(*,*)"bmaa vv 2 ",primary_item%vartype + !primary_item%vcomp1 = trim(item_name) + primary_item%vcomp1 = trim(base_name) primary_item%var = rule%file_var primary_item%fcomp1 = rule%file_var primary_item%fileVars%itemType = ItemTypeScalar diff --git a/gridcomps/ExtData2G/ExtDataRule.F90 b/gridcomps/ExtData2G/ExtDataRule.F90 index c33619f0f9a6..2ba98c7d64b7 100644 --- a/gridcomps/ExtData2G/ExtDataRule.F90 +++ b/gridcomps/ExtData2G/ExtDataRule.F90 @@ -93,8 +93,8 @@ function new_ExtDataRule(config,sample_map,key,unusable,rc) result(rule) rule%regrid_method="BILINEAR" end if - if (config%has("start")) then - tempc = config%of("start") + if (config%has("starting")) then + tempc = config%of("starting") rule%start_time = tempc end if diff --git a/gridcomps/ExtData2G/ExtDataTypeDef.F90 b/gridcomps/ExtData2G/ExtDataTypeDef.F90 index e1d2f953b5dd..12d7c16f938b 100644 --- a/gridcomps/ExtData2G/ExtDataTypeDef.F90 +++ b/gridcomps/ExtData2G/ExtDataTypeDef.F90 @@ -66,6 +66,10 @@ module MAPL_ExtDataTypeDef logical :: cycling logical :: persist_closest type(ESMF_Time), allocatable :: source_time(:) + + ! for multiple collections + type(ESMF_Time), allocatable :: start_end_time(:) + logical :: initialized = .false. end type PrimaryExport type DerivedExport diff --git a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 index 7b71faf2074e..632d600d4161 100644 --- a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 +++ b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 @@ -17,6 +17,10 @@ module MAPL_ExtDataPointerUpdate type(ESMF_Alarm) :: update_alarm type(ESMF_TimeInterval) :: offset logical :: single_shot = .false. + type(ESMF_TimeInterval) :: update_freq + type(ESMF_Time) :: last_ring + type(ESMF_Time) :: reference_time + logical :: simple_alarm_created = .false. contains procedure :: create_from_parameters procedure :: check_update @@ -36,21 +40,21 @@ subroutine create_from_parameters(this,update_time,update_freq,update_offset,tim type(ESMF_Clock), intent(inout) :: clock integer, optional, intent(out) :: rc - type(ESMF_Time) :: reference_time - type(ESMF_TimeInterval) :: reference_freq integer :: status,int_time,year,month,day,hour,minute,second if (update_freq == "-") then this%single_shot = .true. else if (update_freq /= "PT0S") then + this%simple_alarm_created = .true. int_time = string_to_integer_time(update_time) hour=int_time/10000 minute=mod(int_time/100,100) second=mod(int_time,100) call ESMF_TimeGet(time,yy=year,mm=month,dd=day,__RC__) - call ESMF_TimeSet(reference_time,yy=year,mm=month,dd=day,h=hour,m=minute,s=second,__RC__) - reference_freq = string_to_esmf_timeinterval(update_freq,__RC__) - this%update_alarm = ESMF_AlarmCreate(clock,ringTime=reference_time,ringInterval=reference_freq,sticky=.false.,__RC__) + call ESMF_TimeSet(this%reference_time,yy=year,mm=month,dd=day,h=hour,m=minute,s=second,__RC__) + this%last_ring = this%reference_time + this%update_freq = string_to_esmf_timeinterval(update_freq,__RC__) + !this%update_alarm = ESMF_AlarmCreate(clock,ringTime=reference_time,ringInterval=reference_freq,sticky=.false.,__RC__) end if this%offset=string_to_esmf_timeinterval(update_offset,__RC__) _RETURN(_SUCCESS) @@ -64,7 +68,8 @@ subroutine check_update(this,do_update,working_time,current_time,first_time,rc) type(ESMF_Time), intent(inout) :: current_time logical, intent(in) :: first_time integer, optional, intent(out) :: rc - type(ESMF_Time) :: previous_ring + type(ESMF_Time) :: previous_ring, temp_time + type(ESMF_TimeInterval) :: delta,new_delta integer :: status @@ -72,14 +77,47 @@ subroutine check_update(this,do_update,working_time,current_time,first_time,rc) do_update = .false. _RETURN(_SUCCESS) end if - if (ESMF_AlarmIsCreated(this%update_alarm)) then + !if (ESMF_AlarmIsCreated(this%update_alarm)) then + if (this%simple_alarm_created) then if (first_time) then call ESMF_AlarmGet(this%update_alarm,prevRingTime=previous_ring,__RC__) - working_time =previous_ring+this%offset + working_time =this%last_ring+this%offset do_update = .true. else - do_update = ESMF_AlarmIsRinging(this%update_alarm,__RC__) + !do_update = ESMF_AlarmIsRinging(this%update_alarm,__RC__) working_time = current_time+this%offset + ! now find closest time less than 1 delta to the working time + ! if that time equals the working time, the alarm is ringing + !if (working_time == this%last_ring) then + !do_update = .true. + !this%last_ring = working_time + !end if + delta = ESMF_TimeIntervalAbsValue(this%last_ring-working_time) + if (ESMF_TimeIntervalAbsValue(delta) > this%update_freq) then + if (working_time > this%last_ring) then + new_delta = delta + temp_time = this%last_ring + do while (new_delta >= delta) + temp_time = temp_time + this%update_freq + new_delta = ESMF_TimeIntervalAbsValue(working_time-temp_time) + enddo + if (working_time == this%last_ring) then + do_update = .true. + this%last_ring = working_time + end if + else if (working_time < this%last_ring) then + new_delta = delta + temp_time = this%last_ring + do while (new_delta >= delta) + temp_time = temp_time + this%update_freq + new_delta = ESMF_TimeIntervalAbsValue(working_time-temp_time) + enddo + if (working_time == this%last_ring) then + do_update = .true. + this%last_ring = working_time + end if + end if + end if end if else do_update = .true. From d24c209d87863b5405b44353f0fa96bb9ef94f6a Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 29 Mar 2022 13:27:59 -0400 Subject: [PATCH 070/300] cleanup and fix dervied --- gridcomps/ExtData2G/ExtDataConfig.F90 | 24 ++++++------ gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 46 +++-------------------- 2 files changed, 18 insertions(+), 52 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index 6f637183b02b..49856a71cb2b 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -279,25 +279,27 @@ function get_item_type(this,item_name,unusable,rc) result(item_type) end if call rule_iterator%next() enddo - _ASSERT(found_rule,"no rule for "//trim(item_name)) - !rule => this%rule_map%at(trim(item_name)) - rule => this%rule_map%at(found_key) - if (associated(rule)) then - if (allocated(rule%vector_component)) then - if (rule%vector_component=='EW') then - item_type=Primary_Type_Vector_comp2 - else if (rule%vector_component=='NS') then - item_type=Primary_Type_Vector_comp1 + if (found_rule) then + rule => this%rule_map%at(found_key) + if (associated(rule)) then + if (allocated(rule%vector_component)) then + if (rule%vector_component=='EW') then + item_type=Primary_Type_Vector_comp2 + else if (rule%vector_component=='NS') then + item_type=Primary_Type_Vector_comp1 + end if + else + item_type=Primary_Type_scalar end if - else - item_type=Primary_Type_scalar end if end if derived => this%derived_map%at(trim(item_name)) if (associated(derived)) then item_type=derived_type + found_rule = .true. end if + _ASSERT(found_rule,"no rule for "//trim(item_name)) _RETURN(_SUCCESS) end function get_item_type diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index bb0f068de262..5b2cfd6a3b5c 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -84,7 +84,6 @@ MODULE MAPL_ExtDataGridComp2G type(integerVector) :: export_id_start type(integerVector) :: number_of_rules type(stringVector) :: import_names - logical :: have_phis type(PrimaryExport), pointer :: item(:) => null() contains procedure :: get_item_index @@ -112,7 +111,6 @@ MODULE MAPL_ExtDataGridComp2G type(ESMF_State) :: ExtDataState type(ESMF_Config) :: CF logical :: active - integer, allocatable :: PrimaryOrder(:) end type MAPL_ExtData_State ! Hook for the ESMF @@ -442,7 +440,6 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_StateAdd(self%ExtDataState,field,__RC__) enddo - !PrimaryLoop: do i = 1, self%primary%nItems PrimaryLoop: do i=1,self%primary%import_names%size() current_base_name => self%primary%import_names%at(i) @@ -461,10 +458,6 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! Check if we have any files that would need to be vertically interpolated ! if so ensure that PS is done first - allocate(self%primaryOrder(size(self%primary%item)),__STAT__) - do i=1,size(self%primary%item) - self%primaryOrder(i)=i - enddo !! check for PS !idx = -1 !if (any(self%primary%item%do_VertInterp .eqv. .true.)) then @@ -474,25 +467,9 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) !end if !enddo !_ASSERT(idx/=-1,'Surface pressure not present for vertical interpolation') - !self%primaryOrder(1)=idx - !self%primaryOrder(idx)=1 !self%primary%item(idx)%units = ESMF_UtilStringUppercase(self%primary%item(idx)%units,rc=status) !_ASSERT(trim(self%primary%item(idx)%units)=="PA",'PS must be in units of PA') !end if -!! check for PHIS - !idx = -1 - !if (any(self%primary%item%do_VertInterp .eqv. .true.)) then - !do i=1,size(self%primary%item) - !if (self%primary%item(i)%name=='PHIS') then - !idx =i - !end if - !enddo - !if (idx/=-1) then - !self%primaryOrder(2)=idx - !self%primaryOrder(idx)=2 - !self%primary%have_phis=.true. - !end if - !end if call extdata_lgr%info('*******************************************************') call extdata_lgr%info('** Variables to be provided by the ExtData Component **') @@ -634,7 +611,6 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) Write(*,*) 'ExtData Run_: READ_LOOP: Start' ENDIF - !READ_LOOP: do i = 1, self%primary%nItems READ_LOOP: do i=1,self%primary%import_names%size() current_base_name => self%primary%import_names%at(i) @@ -650,8 +626,6 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) item%initialized=.true. end if - !item => self%primary%item(self%primaryOrder(i)) - IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN Write(*,*) ' ' Write(*,'(a,I0.3,a,I0.3,a,a)') 'ExtData Run_: READ_LOOP: variable ', i, ' of ', self%primary%nItems, ': ', trim(item%var) @@ -669,7 +643,6 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOn(MAPLSTATE,"--CheckUpd") call item%update_freq%check_update(doUpdate(i),time,time0,.not.hasRun,__RC__) - !doUpdate(i) = doUpdate_ .or. (.not.hasRun) call MAPL_TimerOff(MAPLSTATE,"--CheckUpd") DO_UPDATE: if (doUpdate(i)) then @@ -677,7 +650,6 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call extdata_lgr%info('Going to update %a with file template: %a ',current_base_name, item%file_template) call item%modelGridFields%comp1%reset() call item%filestream%get_file_bracket(time,item%source_time, item%modelGridFields%comp1,__RC__) - !call IOBundle_Add_Entry(IOBundles,item,self%primaryOrder(i)) call IOBundle_Add_Entry(IOBundles,item,idx) useTime(i)=time @@ -736,7 +708,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) bracket_side = io_bundle%bracket_side entry_num = io_bundle%entry_index item => self%primary%item(entry_num) - call MAPL_ExtDataVerticalInterpolate(self,item,bracket_side,rc=status) + call MAPL_ExtDataVerticalInterpolate(self,item,bracket_side,time0,rc=status) _VERIFY(status) call bundle_iter%next() enddo @@ -756,14 +728,6 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) current_base_name => self%primary%import_names%at(i) idx = self%primary%get_item_index(current_base_name,time0,_RC) item => self%primary%item(idx) - !if (.not.item%initialized) then - !item%pfioCollection_id = MAPL_DataAddCollection(item%file_template) - !if (item%isConst) then - !call set_constant_field(item,self%extDataState,_RC) - !cycle - !end if - !call create_bracketing_fields(item,self%ExtDataState,cf_master, rc) - !end if if (doUpdate(i)) then @@ -796,7 +760,6 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) derivedItem => self%derived%item(i) call derivedItem%update_freq%check_update(doUpdate_,time,time0,.not.hasRun,__RC__) - !doUpdate_ = doUpdate_ .or. (.not.hasRun) if (doUpdate_) then @@ -1151,10 +1114,11 @@ subroutine MAPL_ExtDataInterpField(item,state,time,rc) _RETURN(ESMF_SUCCESS) end subroutine MAPL_ExtDataInterpField - subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,rc) + subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,current_time,rc) type(MAPL_ExtData_State), intent(inout) :: ExtState type(PrimaryExport), intent(inout) :: item integer, intent(in ) :: filec + type(ESMF_Time), intent(in ) :: current_time integer, optional, intent(out ) :: rc integer :: status @@ -1171,7 +1135,7 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,rc) _VERIFY(STATUS) call MAPL_ExtDataGetBracket(item,filec,Field,rc=status) _VERIFY(STATUS) - id_ps = ExtState%primaryOrder(1) + id_ps = ExtState%primary%get_item_index("PS",current_time,_RC) call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,rc=status) _VERIFY(STATUS) call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,rc=status) @@ -1179,7 +1143,7 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,rc) else if (item%vartype == MAPL_VectorField) then - id_ps = ExtState%primaryOrder(1) + id_ps = ExtState%primary%get_item_index("PS",current_time,_RC) call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,rc=status) _VERIFY(STATUS) call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,rc=status) From 7b967025e43f004b98da848b2acaa2bec8a4bab2 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 29 Mar 2022 14:29:16 -0400 Subject: [PATCH 071/300] allow T to be omitted in time change time ranges to be iso compliant --- gridcomps/ExtData2G/ExtDataFileStream.F90 | 2 +- gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 | 2 -- gridcomps/ExtData2G/ExtDataSample.F90 | 2 +- gridcomps/ExtData2G/TimeStringConversion.F90 | 18 ++++++++++++++---- 4 files changed, 16 insertions(+), 8 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataFileStream.F90 b/gridcomps/ExtData2G/ExtDataFileStream.F90 index bee7c4208ab5..b70a24032ba8 100644 --- a/gridcomps/ExtData2G/ExtDataFileStream.F90 +++ b/gridcomps/ExtData2G/ExtDataFileStream.F90 @@ -109,7 +109,7 @@ function new_ExtDataFileStream(config,current_time,unusable,rc) result(data_set) end if if (range_str /= '') then - idx = index(range_str,',') + idx = index(range_str,'/') _ASSERT(idx/=0,'invalid specification of time range') if (allocated(data_set%valid_range)) deallocate(data_set%valid_range) allocate(data_set%valid_range(2)) diff --git a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 index 72de161aeb7e..4720e087b766 100644 --- a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 +++ b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 @@ -87,7 +87,6 @@ subroutine fillin_primary(this,item_name,base_name,primary_item,time,clock,unusa !primary_item%name = trim(item_name) primary_item%name = trim(base_name) if (primary_item%isVector) then - write(*,*)"bmaa vv 1" primary_item%vartype = MAPL_VectorField !primary_item%vcomp1 = trim(item_name) primary_item%vcomp1 = trim(base_name) @@ -100,7 +99,6 @@ subroutine fillin_primary(this,item_name,base_name,primary_item,time,clock,unusa primary_item%fileVars%yname = trim(rule%vector_file_partner) else primary_item%vartype = MAPL_FieldItem - write(*,*)"bmaa vv 2 ",primary_item%vartype !primary_item%vcomp1 = trim(item_name) primary_item%vcomp1 = trim(base_name) primary_item%var = rule%file_var diff --git a/gridcomps/ExtData2G/ExtDataSample.F90 b/gridcomps/ExtData2G/ExtDataSample.F90 index ccf3d62c84dc..757e7f9d9ef2 100644 --- a/gridcomps/ExtData2G/ExtDataSample.F90 +++ b/gridcomps/ExtData2G/ExtDataSample.F90 @@ -56,7 +56,7 @@ function new_ExtDataTimeSample(config,unusable,rc) result(TimeSample) call config%get(source_str,"source_time",rc=status) _VERIFY(status) if (allocated(TimeSample%source_time)) deallocate(TimeSample%source_time) - idx = index(source_str,',') + idx = index(source_str,'/') _ASSERT(idx/=0,'invalid specification of source_time') allocate(TimeSample%source_time(2)) TimeSample%source_time(1)=string_to_esmf_time(source_str(:idx-1)) diff --git a/gridcomps/ExtData2G/TimeStringConversion.F90 b/gridcomps/ExtData2G/TimeStringConversion.F90 index de5a527576de..b7f5017ff001 100644 --- a/gridcomps/ExtData2G/TimeStringConversion.F90 +++ b/gridcomps/ExtData2G/TimeStringConversion.F90 @@ -130,15 +130,25 @@ function string_to_esmf_time(input_string,unusable,rc) result(time) integer year,month,day,hour,min,sec integer :: int_time, int_date character(len=:), allocatable :: date_string,time_string + logical :: have_time _UNUSED_DUMMY(unusable) tpos = index(input_string,'T') - _ASSERT(tpos >0,"Invalid date/time format, missing date/time separator") + if (tpos<=0) then + have_time = .false. + else + have_time = .true. + end if - date_string = input_string(:tpos-1) - time_string = input_string(tpos+1:) - int_time = string_to_integer_time(time_string,__RC__) + if (have_time) then + time_string = input_string(tpos+1:) + date_string = input_string(:tpos-1) + int_time = string_to_integer_time(time_string,__RC__) + else + date_string = trim(input_string) + int_time = 0 + end if int_date = string_to_integer_date(date_string,__RC__) year=int_date/10000 From ed9249a9a5a4e998b40ef488eb685bdb95e87819 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 29 Mar 2022 16:33:08 -0400 Subject: [PATCH 072/300] fix bug with vectors --- gridcomps/ExtData2G/ExtDataConfig.F90 | 4 +-- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 43 +++++++++-------------- 2 files changed, 18 insertions(+), 29 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index 49856a71cb2b..88a70dd66d24 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -285,9 +285,9 @@ function get_item_type(this,item_name,unusable,rc) result(item_type) if (associated(rule)) then if (allocated(rule%vector_component)) then if (rule%vector_component=='EW') then - item_type=Primary_Type_Vector_comp2 - else if (rule%vector_component=='NS') then item_type=Primary_Type_Vector_comp1 + else if (rule%vector_component=='NS') then + item_type=Primary_Type_Vector_comp2 end if else item_type=Primary_Type_scalar diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index 5b2cfd6a3b5c..7583a03cad72 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -300,7 +300,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) character(len=:), allocatable :: new_rc_file logical :: found_in_config integer :: num_primary,num_derived,num_rules - integer, allocatable :: item_types(:) + integer :: item_type type(StringVector) :: unsatisfied_imports character(len=:), pointer :: current_base_name type(ESMF_Time), allocatable :: time_ranges(:) @@ -378,16 +378,15 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) num_derived=0 primaryitemcount=0 deriveditemcount=0 - allocate(item_types(size(itemnames)),__STAT__) do i=1,size(itemnames) - item_types(i) = config_yaml%get_item_type(trim(itemnames(i)),rc=status) + item_type = config_yaml%get_item_type(trim(itemnames(i)),rc=status) _VERIFY(status) - found_in_config = (item_types(i)/= ExtData_not_found) + found_in_config = (item_type/= ExtData_not_found) if (.not.found_in_config) call unsatisfied_imports%push_back(itemnames(i)) - if (item_types(i) == derived_type) then + if (item_type == derived_type) then call self%derived%import_names%push_back(trim(itemnames(i))) deriveditemcount=deriveditemcount+1 - else + else if (item_type==Primary_Type_Scalar .or. item_type==Primary_Type_Vector_comp1) then call self%primary%import_names%push_back(trim(itemnames(i))) primaryitemcount=primaryitemcount+config_yaml%count_rules_for_item(trim(itemnames(i)),_RC) end if @@ -431,6 +430,11 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) end if call ESMF_StateGet(Export,current_base_name,field,__RC__) call MAPL_StateAdd(self%ExtDataState,field,__RC__) + item_type = config_yaml%get_item_type(current_base_name) + if (item_type == Primary_Type_Vector_comp1) then + call ESMF_StateGet(Export,self%primary%item(num_primary)%vcomp2,field,_RC) + call MAPL_StateAdd(self%ExtDataState,field,_RC) + end if enddo do i=1,self%derived%import_names%size() current_base_name => self%derived%import_names%at(i) @@ -452,7 +456,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call set_constant_field(item,self%extDataState,_RC) cycle end if - call create_bracketing_fields(item,self%ExtDataState,cf_master,rc) + call create_bracketing_fields(item,self%ExtDataState,cf_master,_RC) end do PrimaryLoop @@ -622,7 +626,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call set_constant_field(item,self%extDataState,_RC) cycle end if - call create_bracketing_fields(item,self%ExtDataState,cf_master, rc) + call create_bracketing_fields(item,self%ExtDataState,cf_master, _RC) item%initialized=.true. end if @@ -650,6 +654,9 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call extdata_lgr%info('Going to update %a with file template: %a ',current_base_name, item%file_template) call item%modelGridFields%comp1%reset() call item%filestream%get_file_bracket(time,item%source_time, item%modelGridFields%comp1,__RC__) + if (item%vartype == MAPL_VectorField) then + call item%filestream%get_file_bracket(time,item%source_time, item%modelGridFields%comp2,__RC__) + end if call IOBundle_Add_Entry(IOBundles,item,idx) useTime(i)=time @@ -1108,7 +1115,7 @@ subroutine MAPL_ExtDataInterpField(item,state,time,rc) call ESMF_StateGet(state,item%vcomp1,field,__RC__) call item%modelGridFields%comp1%interpolate_to_time(field,time,__RC__) if (item%vartype == MAPL_VectorField) then - call ESMF_StateGet(state,item%vcomp1,field,__RC__) + call ESMF_StateGet(state,item%vcomp2,field,__RC__) call item%modelGridFields%comp2%interpolate_to_time(field,time,__RC__) end if _RETURN(ESMF_SUCCESS) @@ -2023,15 +2030,6 @@ subroutine MAPL_ExtDataPopulateBundle(item,filec,pbundle,rc) call MAPL_FieldBundleAdd(pbundle,Field2,rc=status) _VERIFY(STATUS) - !block - !character(len=ESMF_MAXSTR) :: vectorlist(2) - !vectorlist(1) = item%fcomp1 - !vectorlist(2) = item%fcomp2 - !call ESMF_AttributeSet(pbundle,name="VectorList:", itemCount=2, & - !valuelist = vectorlist, rc=status) - !_VERIFY(STATUS) - !end block - else if (item%do_Fill .or. item%do_VertInterp) then @@ -2279,15 +2277,6 @@ subroutine create_bracketing_fields(item,ExtDataState,cf,rc) _ASSERT(.false.,'No conservative re-gridding with vectors') end if - block - integer :: gridRotation1, gridRotation2 - call ESMF_StateGet(ExtDataState, trim(item%vcomp1), field,__RC__) - call ESMF_AttributeGet(field, NAME='ROTATION', value=gridRotation1, __RC__) - call ESMF_StateGet(ExtDataState, trim(item%vcomp2), field,__RC__) - call ESMF_AttributeGet(field, NAME='ROTATION', value=gridRotation2, __RC__) - _ASSERT(GridRotation1 == gridRotation2,'Grid rotations must match when performing vector re-gridding') - end block - call ESMF_StateGet(ExtDataState, trim(item%vcomp1), field,__RC__) call ESMF_FieldGet(field,grid=grid,rank=fieldRank,__RC__) From 9d1ac4f5e507fd5e7709978ca425a799d94f0bc8 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Thu, 31 Mar 2022 09:33:49 -0400 Subject: [PATCH 073/300] more bug fixes --- gridcomps/ExtData2G/ExtDataConfig.F90 | 1 - gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 4 +++- gridcomps/ExtData2G/ExtDataUpdatePointer.F90 | 2 +- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index 88a70dd66d24..e802db95c5d6 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -299,7 +299,6 @@ function get_item_type(this,item_name,unusable,rc) result(item_type) item_type=derived_type found_rule = .true. end if - _ASSERT(found_rule,"no rule for "//trim(item_name)) _RETURN(_SUCCESS) end function get_item_type diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index 7583a03cad72..07ba5b483ff5 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -305,12 +305,13 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) character(len=:), pointer :: current_base_name type(ESMF_Time), allocatable :: time_ranges(:) character(len=1) :: sidx + type(ESMF_VM) :: vm !class(logger), pointer :: lgr ! Get my name and set-up traceback handle ! --------------------------------------- Iam = 'Initialize_' - call ESMF_GridCompGet( GC, name=comp_name, config=CF_master, __RC__ ) + call ESMF_GridCompGet( GC, name=comp_name, config=CF_master, vm=vm, __RC__ ) Iam = trim(comp_name) // '::' // trim(Iam) call MAPL_GetLogger(gc, extdata_lgr, __RC__) @@ -391,6 +392,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) primaryitemcount=primaryitemcount+config_yaml%count_rules_for_item(trim(itemnames(i)),_RC) end if enddo + call ESMF_VMBarrier(vm,_RC) if (unsatisfied_imports%size() > 0) then do i=1,unsatisfied_imports%size() call extdata_lgr%error("In ExtData resource file, could not find: "//trim(unsatisfied_imports%at(i))) diff --git a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 index 632d600d4161..9463bb54a8ca 100644 --- a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 +++ b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 @@ -80,7 +80,7 @@ subroutine check_update(this,do_update,working_time,current_time,first_time,rc) !if (ESMF_AlarmIsCreated(this%update_alarm)) then if (this%simple_alarm_created) then if (first_time) then - call ESMF_AlarmGet(this%update_alarm,prevRingTime=previous_ring,__RC__) + !call ESMF_AlarmGet(this%update_alarm,prevRingTime=previous_ring,__RC__) working_time =this%last_ring+this%offset do_update = .true. else From 6ee63e3677e4c80a0dafe19ad284d0fa9dd6fe52 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Thu, 31 Mar 2022 17:08:04 -0400 Subject: [PATCH 074/300] fix bugs --- gridcomps/ExtData2G/ExtDataConfig.F90 | 23 +++++++++++++++++------ gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 6 ++++-- 2 files changed, 21 insertions(+), 8 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index e802db95c5d6..0e9c9adf7dab 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -18,6 +18,8 @@ module MAPL_ExtDataConfig implicit none private + character(len=1), parameter :: rule_sep = "+" + type, public :: ExtDataConfig integer :: debug type(ExtDataRuleMap) :: rule_map @@ -123,7 +125,7 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ do i=1,num_rules rule_map = subcfg%of(sorted_rules(i)) write(i_char,'(I1)')i - new_key = key//i_char + new_key = key//rule_sep//i_char call ext_config%add_new_rule(new_key,rule_map,_RC) enddo else @@ -165,11 +167,17 @@ function count_rules_for_item(this,item_name,rc) result(number_of_rules) type(ExtDataRuleMapIterator) :: rule_iterator character(len=:), pointer :: key + integer :: idx rule_iterator = this%rule_map%begin() number_of_rules = 0 do while(rule_iterator /= this%rule_map%end()) key => rule_iterator%key() - if (index(key,trim(item_name))/=0) number_of_rules = number_of_rules + 1 + idx = index(key,rule_sep) + if (idx > 0) then + if (trim(item_name)==key(1:idx-1)) number_of_rules = number_of_rules + 1 + else + if (trim(item_name) == trim(key)) number_of_rules = number_of_rules + 1 + end if call rule_iterator%next() enddo @@ -187,15 +195,18 @@ function get_time_range(this,item_name,rc) result(time_range) type(StringVector) :: start_times integer :: num_rules type(ExtDataRule), pointer :: rule - integer :: i,status + integer :: i,status,idx type(ESMF_Time) :: very_future_time rule_iterator = this%rule_map%begin() do while(rule_iterator /= this%rule_map%end()) key => rule_iterator%key() - if (index(key,trim(item_name))/=0) then - rule => rule_iterator%value() - call start_times%push_back(rule%start_time) + idx = index(key,rule_sep) + if (idx > 0) then + if (key(1:idx-1) == trim(item_name)) then + rule => rule_iterator%value() + call start_times%push_back(rule%start_time) + end if end if call rule_iterator%next() enddo diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index 07ba5b483ff5..b4ac94c489ea 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -412,8 +412,10 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) do i=1,self%primary%import_names%size() current_base_name => self%primary%import_names%at(i) num_rules = config_yaml%count_rules_for_item(current_base_name) + _ASSERT(num_rules > 0,"no rule found for "//trim(current_base_name)) call self%primary%number_of_rules%push_back(num_rules) - call self%primary%export_id_start%push_back(num_primary+1) + call self%primary%export_id_start%push_back(num_primary+1) + call ESMF_VMBarrier if (num_rules > 1) then if (allocated(time_ranges)) deallocate(time_ranges) allocate(time_ranges(num_rules)) @@ -421,7 +423,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) do j=1,num_rules num_primary=num_primary+1 write(sidx,'(I1)')j - call config_yaml%fillin_primary(current_base_name//sidx,current_base_name,self%primary%item(num_primary),time,clock,__RC__) + call config_yaml%fillin_primary(current_base_name//"+"//sidx,current_base_name,self%primary%item(num_primary),time,clock,__RC__) allocate(self%primary%item(num_primary)%start_end_time(2)) self%primary%item(num_primary)%start_end_time(1)=time_ranges(j) self%primary%item(num_primary)%start_end_time(2)=time_ranges(j+1) From 6a4764b950e46f8a5fb2cb3b157c2fa4183cb038 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 1 Apr 2022 10:02:48 -0400 Subject: [PATCH 075/300] should have used info not error --- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index b4ac94c489ea..e7dc9726f389 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -370,7 +370,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! ----------------------- call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, clock, __RC__ ) - call extdata_lgr%error("Using ExtData2G, note this is still in BETA stage") + call extdata_lgr%info("Using ExtData2G, note this is still in BETA stage") ! --------------------------- ! Parse ExtData Resource File @@ -415,7 +415,6 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) _ASSERT(num_rules > 0,"no rule found for "//trim(current_base_name)) call self%primary%number_of_rules%push_back(num_rules) call self%primary%export_id_start%push_back(num_primary+1) - call ESMF_VMBarrier if (num_rules > 1) then if (allocated(time_ranges)) deallocate(time_ranges) allocate(time_ranges(num_rules)) From 8920ed511f31116123fd3a608a94d2d5ce5b6995 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 1 Apr 2022 11:33:25 -0400 Subject: [PATCH 076/300] WIP: Test GCM run in CI --- .circleci/config.yml | 26 +++++++++++++------------- CHANGELOG.md | 1 + 2 files changed, 14 insertions(+), 13 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index d29591f9f0e0..1d473ba33730 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -46,7 +46,7 @@ workflows: checkout_fixture: true mepodevelop: true checkout_mapl_branch: true - persist_workspace: false # Needs to be true to run fv3/gcm experiment, costs extra + persist_workspace: true # Needs to be true to run fv3/gcm experiment, costs extra # Build GEOSldas - ci/build: @@ -78,15 +78,15 @@ workflows: mepodevelop: true develop_repos: "cmake GEOSana_GridComp" # GEOSadas needs some extra branches to work with mainline MAPL rebuild_procs: 8 - ################################################## - # - ci/run_fv3: # - # name: run-FV3-on-<< matrix.compiler >> # - # context: # - # - docker-hub-creds # - # matrix: # - # parameters: # - # compiler: [gfortran, ifort] # - # requires: # - # - build-GEOSgcm-on-<< matrix.compiler >> # - # repo: GEOSgcm # - ################################################## + + # Run gcm + - ci/run_gcm: + name: run-GCM-on-<< matrix.compiler >> + context: + - docker-hub-creds + matrix: + parameters: + compiler: [gfortran, ifort] + requires: + - build-GEOSgcm-on-<< matrix.compiler >> + repo: GEOSgcm diff --git a/CHANGELOG.md b/CHANGELOG.md index ebb81db07b3a..ad006ad0eb71 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Cleaned up a bit of old CMake - Updated CircleCI config to use new orb `build` job + - Turned on GCM run test - Updated `components.yaml` to match GEOSgcm v10.22.1 - ESMA_env v3.13.0 - ESMA_cmake v3.12.0 From b8451eeec3c221024b510537dec669c271848601 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 1 Apr 2022 13:37:26 -0400 Subject: [PATCH 077/300] Change to trigger CI --- .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 1d473ba33730..d6b08ab53015 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -79,7 +79,7 @@ workflows: develop_repos: "cmake GEOSana_GridComp" # GEOSadas needs some extra branches to work with mainline MAPL rebuild_procs: 8 - # Run gcm + # Run GCM - ci/run_gcm: name: run-GCM-on-<< matrix.compiler >> context: From e5ac1243e3cbe3ed9db1c895c6c9b96fcae58cc6 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 1 Apr 2022 13:44:13 -0400 Subject: [PATCH 078/300] Change to trigger CI. Try 2 --- .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index d6b08ab53015..96da0c1d38d7 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -79,7 +79,7 @@ workflows: develop_repos: "cmake GEOSana_GridComp" # GEOSadas needs some extra branches to work with mainline MAPL rebuild_procs: 8 - # Run GCM + # Run GCM (note uses bcs executor inside) - ci/run_gcm: name: run-GCM-on-<< matrix.compiler >> context: From 9d8e8b3146b4d784bf0c8c06802028145625d022 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 1 Apr 2022 14:48:15 -0400 Subject: [PATCH 079/300] One more comment change to trigger executor --- .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 96da0c1d38d7..395120a8fcba 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -79,7 +79,7 @@ workflows: develop_repos: "cmake GEOSana_GridComp" # GEOSadas needs some extra branches to work with mainline MAPL rebuild_procs: 8 - # Run GCM (note uses bcs executor inside) + # Run GCM (1 hour, no ExtData) - ci/run_gcm: name: run-GCM-on-<< matrix.compiler >> context: From 42d2a60a64bc0c95bc79c97b167b324d7ab9ae71 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 5 Apr 2022 10:34:53 -0400 Subject: [PATCH 080/300] Another comment change to trigger CI --- .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 395120a8fcba..da4ccf6e8b69 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -46,7 +46,7 @@ workflows: checkout_fixture: true mepodevelop: true checkout_mapl_branch: true - persist_workspace: true # Needs to be true to run fv3/gcm experiment, costs extra + persist_workspace: true # Needs to be true to run fv3/gcm experiment, costs extra, retained for one day # Build GEOSldas - ci/build: From 6647a3fb54f1b6d5d68d97b8be59cb928196e9b9 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 5 Apr 2022 16:17:07 -0400 Subject: [PATCH 081/300] Add missing rc=status --- CHANGELOG.md | 1 + generic/MAPL_Generic.F90 | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ebb81db07b3a..0cf88ab0c833 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed - Fix issue where ACG was called when no file had changed +- Add missing `rc=status` in `MAPL_GetResourceFromMAPL_scalar` ### Added diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 7e90152a8922..5948efd4a79d 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -8265,10 +8265,10 @@ subroutine MAPL_GetResourceFromMAPL_scalar(state, val, label, default, rc) end if if (label_is_present) then - call MAPL_GetResourceFromConfig_Scalar(state%cf,val,label_to_use,default,rc) + call MAPL_GetResourceFromConfig_Scalar(state%cf,val,label_to_use,default,rc = status) _VERIFY(status) else - call MAPL_GetResourceFromConfig_Scalar(state%cf,val,label,default,rc) + call MAPL_GetResourceFromConfig_Scalar(state%cf,val,label,default,rc = status) _VERIFY(status) end if From ce4302006d067056f9d7ca413c691a9f037642e4 Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Wed, 6 Apr 2022 10:36:29 -0400 Subject: [PATCH 082/300] Fixes #1455. Added support for 4d variables except in coupler's readReasrt and writeRestart routines. The omission is intentional --- CHANGELOG.md | 1 + generic/GenericCplComp.F90 | 141 ++++++++++++++++++++++++++++++++++--- 2 files changed, 132 insertions(+), 10 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0cf88ab0c833..c830f20ef8d5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Add missing `rc=status` in `MAPL_GetResourceFromMAPL_scalar` ### Added +- Added support for 4d variables in the coupler. Intentionally decided not to support 4d in the coupler's ReadRestart and WriteRestart to catch errors ### Changed diff --git a/generic/GenericCplComp.F90 b/generic/GenericCplComp.F90 index 180f75dc7959..e8d740541ecf 100644 --- a/generic/GenericCplComp.F90 +++ b/generic/GenericCplComp.F90 @@ -53,9 +53,10 @@ module MAPL_GenericCplCompMod !EOP type MAPL_CplCnt - integer, pointer :: PTR1C(:) => null() - integer, pointer :: PTR2C(:,:) => null() - integer, pointer :: PTR3C(:,:,:) => null() + integer, pointer :: PTR1C(:) => null() + integer, pointer :: PTR2C(:,:) => null() + integer, pointer :: PTR3C(:,:,:) => null() + integer, pointer :: PTR4C(:,:,:,:) => null() end type MAPL_CplCnt type MAPL_GenericCplState @@ -283,9 +284,11 @@ subroutine Initialize(CC, SRC, DST, CLOCK, RC) real, pointer :: PTR1 (: ) real, pointer :: PTR2 (:,: ) real, pointer :: PTR3 (:,:,:) + real, pointer :: PTR4 (:,:,:,:) real, pointer :: PTR10(: ) real, pointer :: PTR20(:,: ) real, pointer :: PTR30(:,:,:) + real, pointer :: PTR40(:,:,:,:) integer :: OFFSET integer, pointer :: ungrd(:) logical :: has_ungrd @@ -487,7 +490,7 @@ subroutine Initialize(CC, SRC, DST, CLOCK, RC) if (has_ungrd) then DIMS = DIMS + size(UNGRD) end if - _ASSERT(DIMS < 4,'needs informative message') ! ALT: due to laziness we are supporting only 3 dims + _ASSERT(DIMS < 5,'needs informative message') ! ALT: due to laziness we are supporting only 4 dims STATE%ACCUM_RANK(J) = DIMS @@ -508,6 +511,25 @@ subroutine Initialize(CC, SRC, DST, CLOCK, RC) select case(DIMS) + case(4) +! Get SRC pointer, making sure it is allocated. + call MAPL_GetPointer(SRC, PTR4, NAME, ALLOC=.TRUE., RC=STATUS) + _VERIFY(STATUS) +! Allocate space for accumulator + L1 = LBOUND(PTR4,3) + LN = UBOUND(PTR4,3) + allocate(PTR40(size(PTR4,1),size(PTR4,2),L1:LN,size(PTR4,4)), STAT=STATUS) + _VERIFY(STATUS) + if (STATE%couplerType(J) /= MAPL_CplAverage .and. STATE%couplerType(J) /= MAPL_CplAccumulate) then + PTR40 = MAPL_UNDEF + else +! Set accumulator values to zero + PTR40 = 0.0 + endif +! Put pointer in accumulator + STATE%ACCUMULATORS(J)=ESMF_LocalArrayCreate( PTR40, RC=STATUS) + _VERIFY(STATUS) + case(3) ! Get SRC pointer, making sure it is allocated. call MAPL_GetPointer(SRC, PTR3, NAME, ALLOC=.TRUE., RC=STATUS) @@ -657,19 +679,22 @@ subroutine ACCUMULATE(SRC, STATE, RC) ! local vars integer :: J - integer :: I1, I2, I3 + integer :: I1, I2, I3, I4 integer :: couplerType character (len=ESMF_MAXSTR) :: NAME integer :: DIMS real, pointer :: PTR1 (:) real, pointer :: PTR2 (:,:) real, pointer :: PTR3 (:,:,:) + real, pointer :: PTR4 (:,:,:,:) real, pointer :: PTR10(:) real, pointer :: PTR20(:,:) real, pointer :: PTR30(:,:,:) + real, pointer :: PTR40(:,:,:,:) integer, pointer :: PTR1c(:) => NULL() integer, pointer :: PTR2c(:,:) => NULL() integer, pointer :: PTR3c(:,:,:) => NULL() + integer, pointer :: PTR4c(:,:,:,:) => NULL() character(*), parameter :: IAm="ACCUMULATE" integer :: STATUS @@ -694,6 +719,53 @@ subroutine ACCUMULATE(SRC, STATE, RC) select case(DIMS) + case(4) + call MAPL_GetPointer (SRC, PTR4, NAME, RC=STATUS) + _VERIFY(STATUS) + call ESMF_LocalArrayGet(STATE%ACCUMULATORS(J),farrayPtr=PTR40,RC=STATUS) + _VERIFY(STATUS) + PTR4c => STATE%ARRAY_COUNT(J)%PTR4C + + if(.not.associated(PTR4C)) then + if( any( PTR4==MAPL_UNDEF ) ) then + allocate(PTR4C(size(PTR4,1), size(PTR4,2), size(PTR4,3), size(PTR4,4)),STAT=STATUS) + _VERIFY(STATUS) + PTR4C = STATE%ACCUM_COUNT(J) +! put it back into array + STATE%ARRAY_COUNT(J)%PTR4C => PTR4c + _VERIFY(STATUS) + end if + end if + + if (couplerType == MAPL_CplAverage .or. couplerType == MAPL_CplAccumulate) then + if(associated(PTR3C)) then + where (PTR4 /= MAPL_Undef) + PTR40 = PTR40 + PTR4 + PTR4c = PTR4c + 1 + end where + else + PTR40 = PTR40 + PTR4 + end if + else + DO I1=1,size(PTR4,1) + DO I2=1,size(PTR4,2) + DO I3=1,size(PTR4,3) + DO I4=1,size(PTR4,4) + if (PTR40(I1,I2,I3,I4)== MAPL_Undef) then + PTR40(I1,I2,I3,I4) = PTR4(I1,I2,I3,I4) + else + if (couplerType == MAPL_CplMax) then + PTR40(I1,I2,I3,I4) = max(PTR40(I1,I2,I3,I4),PTR4(I1,I2,I3,I4)) + else if (couplerType == MAPL_CplMin) then + PTR40(I1,I2,I3,I4) = min(PTR40(I1,I2,I3,I4),PTR4(I1,I2,I3,I4)) + end if + end if + end DO + end DO + end DO + end DO + end if + case(3) call MAPL_GetPointer (SRC, PTR3, NAME, RC=STATUS) _VERIFY(STATUS) @@ -849,12 +921,10 @@ subroutine ZERO_CLEAR_COUNT(STATE, RC) integer :: J integer :: DIMS logical :: RINGING - real, pointer :: PTR1 (:) - real, pointer :: PTR2 (:,:) - real, pointer :: PTR3 (:,:,:) real, pointer :: PTR10(:) real, pointer :: PTR20(:,:) real, pointer :: PTR30(:,:,:) + real, pointer :: PTR40(:,:,:) character(*), parameter :: IAm="ZERO_CLEAR_COUNT" integer :: STATUS @@ -872,11 +942,21 @@ subroutine ZERO_CLEAR_COUNT(STATE, RC) DIMS = STATE%ACCUM_RANK(J) -! Process the 3 dimension possibilities +! Process the 4 dimension possibilities !-------------------------------------- select case(DIMS) + case(4) + call ESMF_LocalArrayGet(STATE%ACCUMULATORS(J),farrayPtr=PTR40,RC=STATUS) + _VERIFY(STATUS) + if (STATE%couplerType(J) /= MAPL_CplAverage .and. STATE%couplerType(J) /= MAPL_CplAccumulate) then + PTR40 = MAPL_UNDEF + else + PTR40 = 0.0 + endif + if (associated(STATE%ARRAY_COUNT(J)%PTR4C)) STATE%ARRAY_COUNT(J)%PTR4C = 0 + case(3) call ESMF_LocalArrayGet(STATE%ACCUMULATORS(J),farrayPtr=PTR30,RC=STATUS) _VERIFY(STATUS) @@ -925,6 +1005,10 @@ subroutine ZERO_CLEAR_COUNT(STATE, RC) deallocate(STATE%ARRAY_COUNT(J)%PTR3C) nullify(STATE%ARRAY_COUNT(J)%PTR3C) end if + if (associated(STATE%ARRAY_COUNT(J)%PTR4C)) then + deallocate(STATE%ARRAY_COUNT(J)%PTR4C) + nullify(STATE%ARRAY_COUNT(J)%PTR4C) + end if end if end do @@ -946,12 +1030,15 @@ subroutine COUPLE(SRC, STATE, RC) real, pointer :: PTR1 (:) real, pointer :: PTR2 (:,:) real, pointer :: PTR3 (:,:,:) + real, pointer :: PTR4 (:,:,:,:) real, pointer :: PTR10(:) real, pointer :: PTR20(:,:) real, pointer :: PTR30(:,:,:) + real, pointer :: PTR40(:,:,:,:) integer, pointer :: PTR1c(:) integer, pointer :: PTR2c(:,:) integer, pointer :: PTR3c(:,:,:) + integer, pointer :: PTR4c(:,:,:,:) logical :: RINGING integer :: couplerType @@ -975,11 +1062,45 @@ subroutine COUPLE(SRC, STATE, RC) DIMS = STATE%ACCUM_RANK(J) -! Process the three dimension possibilities +! Process the four dimension possibilities !------------------------------------------ select case(DIMS) + case(4) + call ESMF_LocalArrayGet(STATE%ACCUMULATORS(J),farrayPtr=PTR40,RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer (DST, PTR4, NAME, RC=STATUS) + _VERIFY(STATUS) + PTR4c => STATE%ARRAY_COUNT(J)%PTR4C + if(associated(PTR4C)) then + if (couplerType /= MAPL_CplAccumulate) then + where (PTR4C /= 0) + PTR40 = PTR40 / PTR4C + elsewhere + PTR40 = MAPL_Undef + end where + else + where (PTR4C /= 0) + PTR40 = PTR40 + elsewhere + PTR40 = MAPL_Undef + end where + end if + elseif(STATE%ACCUM_COUNT(J)>0) then + if (couplerType /= MAPL_CplAccumulate) then + PTR40 = PTR40 / STATE%ACCUM_COUNT(J) + else + PTR40 = PTR40 + end if + else + PTR40 = MAPL_Undef + end if + +! Regrid stubbed + + PTR4 = PTR40 + case(3) call ESMF_LocalArrayGet(STATE%ACCUMULATORS(J),farrayPtr=PTR30,RC=STATUS) _VERIFY(STATUS) From b60634ae3e9212991ba5489dc44d56efda980e5d Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 6 Apr 2022 11:22:00 -0400 Subject: [PATCH 083/300] fix bug with rewinding clock as well as updating to use logger --- gridcomps/ExtData2G/ExtDataConfig.F90 | 11 +-- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 92 ++++++++++---------- gridcomps/ExtData2G/ExtDataUpdatePointer.F90 | 70 +++++++-------- 3 files changed, 77 insertions(+), 96 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index 0e9c9adf7dab..811c111ecacd 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -30,7 +30,6 @@ module MAPL_ExtDataConfig contains procedure :: add_new_rule procedure :: get_item_type - procedure :: get_debug_flag procedure :: new_ExtDataConfig_from_yaml procedure :: count_rules_for_item procedure :: get_time_range @@ -77,8 +76,8 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ _ASSERT(subconfigs%is_sequence(),'subconfigs is not a sequence') do i=1,subconfigs%size() sub_file = subconfigs%of(i) - call new_ExtDataConfig_from_yaml(ext_config,sub_file,current_time,rc=status) - _VERIFY(status) + call new_ExtDataConfig_from_yaml(ext_config,sub_file,current_time,rc=status) + _VERIFY(status) end do end if @@ -346,10 +345,4 @@ subroutine add_new_rule(this,key,export_rule,rc) _RETURN(_SUCCESS) end subroutine add_new_rule - - integer function get_debug_flag(this) - class(ExtDataConfig), intent(inout) :: this - get_debug_flag=this%debug - end function get_debug_flag - end module MAPL_ExtDataConfig diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index e7dc9726f389..ca06ab273199 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -72,7 +72,6 @@ MODULE MAPL_ExtDataGridComp2G ! !------------------------------------------------------------------------- - integer :: Ext_Debug integer, parameter :: MAPL_ExtDataLeft = 1 integer, parameter :: MAPL_ExtDataRight = 2 logical :: hasRun @@ -297,7 +296,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(MAPL_MetaComp),pointer :: MAPLSTATE type(ExtDataOldTypesCreator),target :: config_yaml - character(len=:), allocatable :: new_rc_file + character(len=ESMF_MAXSTR) :: new_rc_file logical :: found_in_config integer :: num_primary,num_derived,num_rules integer :: item_type @@ -327,17 +326,15 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOn(MAPLSTATE,"TOTAL") call MAPL_TimerOn(MAPLSTATE,"Initialize") + call ESMF_ConfigGetAttribute(cf_master,new_rc_file,label="EXTDATA_YAML_FILE:",default="extdata.yaml",_RC) + self%active = am_i_running(new_rc_file) + call ESMF_ClockGet(CLOCK, currTIME=time, __RC__) - new_rc_file = "extdata.yaml" - config_yaml = ExtDataOldTypesCreator(new_rc_file,time,__RC__) ! Get information from export state !---------------------------------- call ESMF_StateGet(EXPORT, ITEMCOUNT=ItemCount, RC=STATUS) _VERIFY(STATUS) - ! set ExtData on by default, let user turn it off if they want - call ESMF_ConfigGetAttribute(CF_master,self%active, Label='USE_EXTDATA:',default=.true.,rc=status) - ! no need to run ExtData if there are no imports to fill if (ItemCount == 0) then self%active = .false. @@ -349,6 +346,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) _RETURN(ESMF_SUCCESS) end if + config_yaml = ExtDataOldTypesCreator(new_rc_file,time,__RC__) ! Greetings ! --------- if (MAPL_am_I_root()) then @@ -400,7 +398,6 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) _FAIL("Unsatisfied imports in ExtData") end if - ext_debug=config_yaml%get_debug_flag() allocate(self%primary%item(PrimaryItemCount),__STAT__) allocate(self%derived%item(DerivedItemCount),__STAT__) self%primary%nitems = PrimaryItemCount @@ -499,9 +496,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! All done ! -------- - IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN - Write(*,*) 'ExtData Initialize_: End' - ENDIF + call extdata_lgr%debug('ExtData Initialize_(): End') _RETURN(ESMF_SUCCESS) @@ -571,7 +566,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(IOBundleNGVectorIterator) :: bundle_iter type(ExtDataNG_IOBundle), pointer :: io_bundle character(len=:), pointer :: current_base_name - integer :: idx + integer :: idx,nitems type(ESMF_Config) :: cf_master _UNUSED_DUMMY(IMPORT) @@ -612,12 +607,10 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) _VERIFY(STATUS) call MAPL_TimerOn(MAPLSTATE,"-Read_Loop") - - IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN - Write(*,*) 'ExtData Run_: Start' - Write(*,*) 'ExtData Run_: READ_LOOP: Start' - ENDIF + call extdata_lgr%debug('ExtData Rune_(): Start') + call extdata_lgr%debug('ExtData Run_(): READ_LOOP: Start') + READ_LOOP: do i=1,self%primary%import_names%size() current_base_name => self%primary%import_names%at(i) @@ -633,17 +626,13 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) item%initialized=.true. end if - IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN - Write(*,*) ' ' - Write(*,'(a,I0.3,a,I0.3,a,a)') 'ExtData Run_: READ_LOOP: variable ', i, ' of ', self%primary%nItems, ': ', trim(item%var) - Write(*,*) ' ==> file: ', trim(item%file_template) - Write(*,*) ' ==> isConst: ', item%isConst - ENDIF + nitems = self%primary%import_names%size() + !call extdata_lgr%debug('ExtData Run_(): READ_LOOP: variable %i0 of %i0~: %a', i, nitems, trim(current_base_name)) + !call extdata_lgr%debug(' ==> file: %a', trim(item%file_template)) + !call extdata_lgr%debug(' ==> isConst:: %l1', item%isConst) if (item%isConst) then - IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN - Write(*,*) ' ==> Break loop since isConst is true' - ENDIF + call extdata_lgr%debug(' ==> Break loop since isConst is true') cycle endif @@ -654,7 +643,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) DO_UPDATE: if (doUpdate(i)) then - call extdata_lgr%info('Going to update %a with file template: %a ',current_base_name, item%file_template) + !call extdata_lgr%info('Going to update %a with file template: %a ',current_base_name, item%file_template) call item%modelGridFields%comp1%reset() call item%filestream%get_file_bracket(time,item%source_time, item%modelGridFields%comp1,__RC__) if (item%vartype == MAPL_VectorField) then @@ -667,11 +656,10 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) end do READ_LOOP - IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN - Write(*,*) 'ExtData Run_: READ_LOOP: Done' - ENDIF + call extdata_lgr%debug('ExtData Run_: READ_LOOP: Done') bundle_iter = IOBundles%begin() + if (mapl_am_i_root()) write(*,*)"bmaa size: ",iobundles%size() do while (bundle_iter /= IoBundles%end()) io_bundle => bundle_iter%get() bracket_side = io_bundle%bracket_side @@ -728,10 +716,8 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOff(MAPLSTATE,"-Read_Loop") call MAPL_TimerOn(MAPLSTATE,"-Interpolate") - - IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN - Write(*,*) 'ExtData Run_: INTERP_LOOP: Start' - ENDIF + + call extdata_lgr%debug('ExtData Run_: INTERP_LOOP: Start') INTERP_LOOP: do i=1,self%primary%import_names%size() @@ -741,15 +727,9 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) if (doUpdate(i)) then - IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN - Write(*,*) ' ' - Write(*,'(a)') 'ExtData Run_: INTERP_LOOP: interpolating between bracket times' - Write(*,*) ' ==> variable: ', trim(item%var) - Write(*,*) ' ==> file: ', trim(item%file_template) - ENDIF + call extdata_lgr%debug('ExtData Run_: INTERP_LOOP: interpolating between bracket times, variable: %a, file: %a', & + & trim(current_base_name), trim(item%file_template)) - ! finally interpolate between bracketing times - call MAPL_ExtDataInterpField(item,self%ExtDataState,useTime(i),__RC__) endif @@ -758,9 +738,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) end do INTERP_LOOP - IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN - Write(*,*) 'ExtData Run_: INTERP_LOOP: Done' - ENDIF + call extdata_lgr%debug('ExtData Run_: INTERP_LOOP: Done') call MAPL_TimerOff(MAPLSTATE,"-Interpolate") @@ -780,9 +758,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) end do - IF ( (Ext_Debug > 0) .AND. MAPL_Am_I_Root() ) THEN - Write(*,*) 'ExtData Run_: End' - ENDIF + call extdata_lgr%debug('ExtData Run_: End') ! All done ! -------- @@ -2352,4 +2328,24 @@ function get_item_index(this,base_name,current_time,rc) result(item_index) _RETURN(_SUCCESS) end function get_item_index + function am_i_running(yaml_file) result(am_running) + logical :: am_running + character(len=*), intent(in) :: yaml_file + + type(Parser) :: p + type(FileStream) :: fstream + type(Configuration) :: config + + p = Parser('core') + fstream=FileStream(yaml_file) + config = p%load(fstream) + call fstream%close() + + if (config%has("USE_EXTDATA")) then + am_running = config%of("USE_EXTDATA") + else + am_running = .true. + end if + end function am_i_running + END MODULE MAPL_ExtDataGridComp2G diff --git a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 index 9463bb54a8ca..b9d4556706a8 100644 --- a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 +++ b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 @@ -21,6 +21,7 @@ module MAPL_ExtDataPointerUpdate type(ESMF_Time) :: last_ring type(ESMF_Time) :: reference_time logical :: simple_alarm_created = .false. + type(ESMF_TIme) :: last_checked contains procedure :: create_from_parameters procedure :: check_update @@ -42,6 +43,7 @@ subroutine create_from_parameters(this,update_time,update_freq,update_offset,tim integer :: status,int_time,year,month,day,hour,minute,second + this%last_checked = time if (update_freq == "-") then this%single_shot = .true. else if (update_freq /= "PT0S") then @@ -54,22 +56,20 @@ subroutine create_from_parameters(this,update_time,update_freq,update_offset,tim call ESMF_TimeSet(this%reference_time,yy=year,mm=month,dd=day,h=hour,m=minute,s=second,__RC__) this%last_ring = this%reference_time this%update_freq = string_to_esmf_timeinterval(update_freq,__RC__) - !this%update_alarm = ESMF_AlarmCreate(clock,ringTime=reference_time,ringInterval=reference_freq,sticky=.false.,__RC__) end if this%offset=string_to_esmf_timeinterval(update_offset,__RC__) _RETURN(_SUCCESS) end subroutine create_from_parameters - subroutine check_update(this,do_update,working_time,current_time,first_time,rc) + subroutine check_update(this,do_update,use_time,current_time,first_time,rc) class(ExtDataPointerUpdate), intent(inout) :: this logical, intent(out) :: do_update - type(ESMF_Time), intent(inout) :: working_time + type(ESMF_Time), intent(inout) :: use_time type(ESMF_Time), intent(inout) :: current_time logical, intent(in) :: first_time integer, optional, intent(out) :: rc - type(ESMF_Time) :: previous_ring, temp_time - type(ESMF_TimeInterval) :: delta,new_delta + type(ESMF_Time) :: next_ring integer :: status @@ -79,51 +79,43 @@ subroutine check_update(this,do_update,working_time,current_time,first_time,rc) end if !if (ESMF_AlarmIsCreated(this%update_alarm)) then if (this%simple_alarm_created) then + use_time = current_time+this%offset if (first_time) then - !call ESMF_AlarmGet(this%update_alarm,prevRingTime=previous_ring,__RC__) - working_time =this%last_ring+this%offset do_update = .true. + if (mapl_am_I_root()) write(*,*)"bmaa first time " else - !do_update = ESMF_AlarmIsRinging(this%update_alarm,__RC__) - working_time = current_time+this%offset - ! now find closest time less than 1 delta to the working time - ! if that time equals the working time, the alarm is ringing - !if (working_time == this%last_ring) then - !do_update = .true. - !this%last_ring = working_time - !end if - delta = ESMF_TimeIntervalAbsValue(this%last_ring-working_time) - if (ESMF_TimeIntervalAbsValue(delta) > this%update_freq) then - if (working_time > this%last_ring) then - new_delta = delta - temp_time = this%last_ring - do while (new_delta >= delta) - temp_time = temp_time + this%update_freq - new_delta = ESMF_TimeIntervalAbsValue(working_time-temp_time) - enddo - if (working_time == this%last_ring) then - do_update = .true. - this%last_ring = working_time - end if - else if (working_time < this%last_ring) then - new_delta = delta - temp_time = this%last_ring - do while (new_delta >= delta) - temp_time = temp_time + this%update_freq - new_delta = ESMF_TimeIntervalAbsValue(working_time-temp_time) + ! normal flow + next_ring = this%last_ring + if (current_time > this%last_checked) then + if (mapl_am_i_root()) write(*,*)"bmaa normal flow!" + do while (next_ring < current_time) + next_ring=next_ring+this%update_freq + enddo + if (current_time == next_ring) then + do_update = .true. + this%last_ring = next_ring + if (mapl_am_I_root()) write(*,*)"bmaa update " + end if + ! if clock went backwards, so we must update, set ringtime to previous ring from working time + else if (current_time < this%last_checked) then + if (mapl_am_i_root()) write(*,*)"bmaa clock went back!" + + next_ring = this%last_ring + if (this%last_ring > current_time) then + do while(next_ring >= current_time) + next_ring=next_ring-this%update_freq enddo - if (working_time == this%last_ring) then - do_update = .true. - this%last_ring = working_time - end if end if + do_update = .true. + this%last_ring = next_ring end if end if else do_update = .true. if (this%single_shot) this%disabled = .true. - working_time = current_time+this%offset + use_time = current_time+this%offset end if + this%last_checked = current_time end subroutine check_update From 70e35fe84cd99d18468337a007e27b1a394830d7 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 6 Apr 2022 11:24:04 -0400 Subject: [PATCH 084/300] remove comments --- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 1 - gridcomps/ExtData2G/ExtDataUpdatePointer.F90 | 4 ---- 2 files changed, 5 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index ca06ab273199..d116fdcc2a9f 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -659,7 +659,6 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call extdata_lgr%debug('ExtData Run_: READ_LOOP: Done') bundle_iter = IOBundles%begin() - if (mapl_am_i_root()) write(*,*)"bmaa size: ",iobundles%size() do while (bundle_iter /= IoBundles%end()) io_bundle => bundle_iter%get() bracket_side = io_bundle%bracket_side diff --git a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 index b9d4556706a8..e2147f84f7c8 100644 --- a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 +++ b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 @@ -82,23 +82,19 @@ subroutine check_update(this,do_update,use_time,current_time,first_time,rc) use_time = current_time+this%offset if (first_time) then do_update = .true. - if (mapl_am_I_root()) write(*,*)"bmaa first time " else ! normal flow next_ring = this%last_ring if (current_time > this%last_checked) then - if (mapl_am_i_root()) write(*,*)"bmaa normal flow!" do while (next_ring < current_time) next_ring=next_ring+this%update_freq enddo if (current_time == next_ring) then do_update = .true. this%last_ring = next_ring - if (mapl_am_I_root()) write(*,*)"bmaa update " end if ! if clock went backwards, so we must update, set ringtime to previous ring from working time else if (current_time < this%last_checked) then - if (mapl_am_i_root()) write(*,*)"bmaa clock went back!" next_ring = this%last_ring if (this%last_ring > current_time) then From f9c5f28886b57337e137740b0c251ddf96475d59 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 6 Apr 2022 16:42:51 -0400 Subject: [PATCH 085/300] 1 more time get the revese clock right, also hack for gcc and yaml --- gridcomps/ExtData2G/CMakeLists.txt | 1 + gridcomps/ExtData2G/ExtDataConfig.F90 | 30 +++++++++++--------- gridcomps/ExtData2G/ExtDataUpdatePointer.F90 | 30 ++++++++++++++++---- gridcomps/ExtData2G/ExtDataYamlNodeStack.F90 | 8 ++++++ 4 files changed, 49 insertions(+), 20 deletions(-) create mode 100644 gridcomps/ExtData2G/ExtDataYamlNodeStack.F90 diff --git a/gridcomps/ExtData2G/CMakeLists.txt b/gridcomps/ExtData2G/CMakeLists.txt index 6efdc8a2d362..9ca60731b0da 100644 --- a/gridcomps/ExtData2G/CMakeLists.txt +++ b/gridcomps/ExtData2G/CMakeLists.txt @@ -20,6 +20,7 @@ set (srcs ExtDataSample.F90 ExtData_IOBundleMod.F90 ExtData_IOBundleVectorMod.F90 + ExtDataYamlNodeStack.F90 ) diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index 811c111ecacd..7183b2941be6 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -15,6 +15,7 @@ module MAPL_ExtDataConfig use MAPL_ExtDataTimeSample use MAPL_ExtDataTimeSampleMap use MAPL_TimeStringConversion + use MAPL_ExtDataYamlNodeStack implicit none private @@ -45,7 +46,7 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ integer, optional, intent(out) :: rc type(Parser) :: p - type(Configuration) :: config, subcfg, ds_config, rule_config, derived_config, sample_config + type(Configuration) :: config, subcfg, ds_config, rule_config, derived_config, sample_config, subconfigs, rule_map type(ConfigurationIterator) :: iter character(len=:), allocatable :: key,new_key type(ExtDataFileStream) :: ds @@ -58,7 +59,6 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ type(ExtDataTimeSample), pointer :: temp_ts type(ExtDataDerived), pointer :: temp_derived - type(Configuration) :: subconfigs,rule_map character(len=:), allocatable :: sub_file integer :: i,num_rules integer, allocatable :: sorted_rules(:) @@ -66,13 +66,14 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ _UNUSED_DUMMY(unusable) + stack_depth=stack_depth+1 p = Parser('core') fstream=FileStream(config_file) - config = p%load(fstream) + yaml_node_stack(stack_depth) = p%load(fstream) call fstream%close() - if (config%has("subconfigs")) then - subconfigs = config%at("subconfigs") + if (yaml_node_stack(stack_depth)%has("subconfigs")) then + subconfigs = yaml_node_stack(stack_depth)%at("subconfigs") _ASSERT(subconfigs%is_sequence(),'subconfigs is not a sequence') do i=1,subconfigs%size() sub_file = subconfigs%of(i) @@ -81,8 +82,8 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ end do end if - if (config%has("Samplings")) then - sample_config = config%of("Samplings") + if (yaml_node_stack(stack_depth)%has("Samplings")) then + sample_config = yaml_node_stack(stack_depth)%of("Samplings") iter = sample_config%begin() do while (iter /= sample_config%end()) call iter%get_key(key) @@ -96,8 +97,8 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ enddo end if - if (config%has("Collections")) then - ds_config = config%of("Collections") + if (yaml_node_stack(stack_depth)%has("Collections")) then + ds_config = yaml_node_stack(stack_depth)%of("Collections") iter = ds_config%begin() do while (iter /= ds_config%end()) call iter%get_key(key) @@ -110,8 +111,8 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ enddo end if - if (config%has("Exports")) then - rule_config = config%of("Exports") + if (yaml_node_stack(stack_depth)%has("Exports")) then + rule_config = yaml_node_stack(stack_depth)%of("Exports") iter = rule_config%begin() do while (iter /= rule_config%end()) call iter%get_key(key) @@ -134,8 +135,8 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ enddo end if - if (config%has("Derived")) then - derived_config = config%at("Derived") + if (yaml_node_stack(stack_depth)%has("Derived")) then + derived_config = yaml_node_stack(stack_depth)%at("Derived") iter = derived_config%begin() do while (iter /= derived_config%end()) call derived%set_defaults(rc=status) @@ -150,11 +151,12 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ enddo end if - if (config%has("debug")) then + if (yaml_node_stack(stack_depth)%has("debug")) then call config%get(ext_config%debug,"debug",rc=status) _VERIFY(status) end if + stack_depth=stack_depth-1 _RETURN(_SUCCESS) end subroutine new_ExtDataConfig_from_yaml diff --git a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 index e2147f84f7c8..3a782e66d6ac 100644 --- a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 +++ b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 @@ -14,7 +14,7 @@ module MAPL_ExtDataPointerUpdate type :: ExtDataPointerUpdate private logical :: disabled = .false. - type(ESMF_Alarm) :: update_alarm + logical :: first_time_updated = .true. type(ESMF_TimeInterval) :: offset logical :: single_shot = .false. type(ESMF_TimeInterval) :: update_freq @@ -22,6 +22,7 @@ module MAPL_ExtDataPointerUpdate type(ESMF_Time) :: reference_time logical :: simple_alarm_created = .false. type(ESMF_TIme) :: last_checked + type(ESMF_TIme) :: last_updated contains procedure :: create_from_parameters procedure :: check_update @@ -77,11 +78,12 @@ subroutine check_update(this,do_update,use_time,current_time,first_time,rc) do_update = .false. _RETURN(_SUCCESS) end if - !if (ESMF_AlarmIsCreated(this%update_alarm)) then if (this%simple_alarm_created) then use_time = current_time+this%offset if (first_time) then do_update = .true. + this%first_time_updated = .true. + this%last_updated = current_time else ! normal flow next_ring = this%last_ring @@ -91,25 +93,41 @@ subroutine check_update(this,do_update,use_time,current_time,first_time,rc) enddo if (current_time == next_ring) then do_update = .true. + this%last_updated = current_time this%last_ring = next_ring + this%first_time_updated = .false. end if ! if clock went backwards, so we must update, set ringtime to previous ring from working time else if (current_time < this%last_checked) then - next_ring = this%last_ring + ! the clock must have rewound past last ring if (this%last_ring > current_time) then - do while(next_ring >= current_time) + do while(next_ring <= current_time) next_ring=next_ring-this%update_freq enddo + use_time = next_ring+this%offset + this%last_ring = next_ring + ! alarm never rang during the previous advance, only update the previous update was the first time + else if (this%last_ring < current_time) then + if (this%first_time_updated) then + do_update=.true. + this%first_time_updated = .false. + use_time = this%last_updated + this%offset + end if + ! otherwise we land on a time when the alarm would ring and we would update + else if (this%last_ring == current_time) then + do_update =.true. + this%first_time_updated = .false. + use_time = current_time+this%offset + this%last_updated = current_time end if - do_update = .true. - this%last_ring = next_ring end if end if else do_update = .true. if (this%single_shot) this%disabled = .true. use_time = current_time+this%offset + this%last_updated = current_time end if this%last_checked = current_time diff --git a/gridcomps/ExtData2G/ExtDataYamlNodeStack.F90 b/gridcomps/ExtData2G/ExtDataYamlNodeStack.F90 new file mode 100644 index 000000000000..18d5a313a245 --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataYamlNodeStack.F90 @@ -0,0 +1,8 @@ +module MAPL_ExtDataYamlNodeStack + use yaFyaml + implicit none + + integer, save :: stack_depth = 0 + type(Configuration), save :: yaml_node_stack(10) + +end module MAPL_ExtDataYamlNodeStack From e344987d5b4aea8dfa196000f7f3ffc65a4dd217 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 6 Apr 2022 17:29:42 -0400 Subject: [PATCH 086/300] fix regression --- gridcomps/ExtData2G/ExtDataUpdatePointer.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 index 3a782e66d6ac..ddbbbf73b652 100644 --- a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 +++ b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 @@ -84,6 +84,7 @@ subroutine check_update(this,do_update,use_time,current_time,first_time,rc) do_update = .true. this%first_time_updated = .true. this%last_updated = current_time + use_time = this%last_ring + this%offset else ! normal flow next_ring = this%last_ring From 964e46d5c7e045232e83dc22447ca99ea6a5c819 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Thu, 7 Apr 2022 09:24:07 -0400 Subject: [PATCH 087/300] add option to extdatadriver.x to simulate replay --- Tests/ExtDataDriverGridComp.F90 | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/Tests/ExtDataDriverGridComp.F90 b/Tests/ExtDataDriverGridComp.F90 index 1b394018695d..21740859a808 100644 --- a/Tests/ExtDataDriverGridComp.F90 +++ b/Tests/ExtDataDriverGridComp.F90 @@ -34,6 +34,7 @@ module ExtData_DriverGridCompMod type(ESMF_State), allocatable :: imports(:), exports(:) type(ESMF_VM) :: vm type(ESMF_Time), allocatable :: times(:) + logical :: run_fbf = .false. contains procedure :: set_services procedure :: initialize @@ -185,6 +186,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call MAPL_Set(MAPLOBJ, name = cap%name, cf = cap%config, rc = status) _VERIFY(status) + call ESMF_ConfigGetAttribute(cap%config,cap%run_fbf,label="RUN_FBF:",default=.false.) call ESMF_ConfigGetAttribute(cap%config,cap%run_hist,label="RUN_HISTORY:",default=.true.) call ESMF_ConfigGetAttribute(cap%config,cap%run_extdata,label="RUN_EXTDATA:",default=.true.) @@ -411,6 +413,9 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call cap%parseTimes(rc=status) _VERIFY(status) + if (allocated(cap%times) .and. cap%run_fbf ) then + _ASSERT(.false.,"can not run forwards and backwards with specific times") + end if _RETURN(ESMF_SUCCESS) end subroutine initialize_gc @@ -603,6 +608,24 @@ subroutine run_MultipleTimes(gc, rc) call cap%run_one_step(status) _VERIFY(status) enddo + else if (cap%run_fbf) then + do n=1,cap%nsteps + call ESMF_ClockAdvance(cap%clock,rc=status) + _VERIFY(status) + call cap%run_one_step(status) + _VERIFY(status) + enddo + do n=1,cap%nsteps + call ESMF_ClockSet(cap%clock,direction=ESMF_DIRECTION_REVERSE,_RC) + call ESMF_ClockAdvance(cap%clock,rc=status) + call ESMF_ClockSet(cap%clock,direction=ESMF_DIRECTION_FORWARD,_RC) + enddo + do n=1,cap%nsteps + call ESMF_ClockAdvance(cap%clock,rc=status) + _VERIFY(status) + call cap%run_one_step(status) + _VERIFY(status) + enddo else do n=1,cap%nsteps call ESMF_ClockAdvance(cap%clock,rc=status) From 7b64bc2e730f5f7ef55492629773ece08570f5b7 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Thu, 7 Apr 2022 13:00:45 -0400 Subject: [PATCH 088/300] fix bug with replay --- gridcomps/ExtData2G/ExtDataUpdatePointer.F90 | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 index ddbbbf73b652..6d4ff50389bd 100644 --- a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 +++ b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 @@ -6,6 +6,7 @@ module MAPL_ExtDataPointerUpdate use MAPL_KeywordEnforcerMod use MAPL_ExceptionHandling use MAPL_TimeStringConversion + use MAPL_CommsMod implicit none private @@ -16,13 +17,11 @@ module MAPL_ExtDataPointerUpdate logical :: disabled = .false. logical :: first_time_updated = .true. type(ESMF_TimeInterval) :: offset - logical :: single_shot = .false. type(ESMF_TimeInterval) :: update_freq type(ESMF_Time) :: last_ring type(ESMF_Time) :: reference_time logical :: simple_alarm_created = .false. type(ESMF_TIme) :: last_checked - type(ESMF_TIme) :: last_updated contains procedure :: create_from_parameters procedure :: check_update @@ -83,7 +82,6 @@ subroutine check_update(this,do_update,use_time,current_time,first_time,rc) if (first_time) then do_update = .true. this%first_time_updated = .true. - this%last_updated = current_time use_time = this%last_ring + this%offset else ! normal flow @@ -94,7 +92,6 @@ subroutine check_update(this,do_update,use_time,current_time,first_time,rc) enddo if (current_time == next_ring) then do_update = .true. - this%last_updated = current_time this%last_ring = next_ring this%first_time_updated = .false. end if @@ -113,14 +110,13 @@ subroutine check_update(this,do_update,use_time,current_time,first_time,rc) if (this%first_time_updated) then do_update=.true. this%first_time_updated = .false. - use_time = this%last_updated + this%offset + use_time = this%last_ring + this%offset end if ! otherwise we land on a time when the alarm would ring and we would update else if (this%last_ring == current_time) then do_update =.true. this%first_time_updated = .false. use_time = current_time+this%offset - this%last_updated = current_time end if end if end if @@ -128,7 +124,6 @@ subroutine check_update(this,do_update,use_time,current_time,first_time,rc) do_update = .true. if (this%single_shot) this%disabled = .true. use_time = current_time+this%offset - this%last_updated = current_time end if this%last_checked = current_time From 0c163f29bda917256feb76cb4e5a606804fb1ec6 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Thu, 7 Apr 2022 13:03:12 -0400 Subject: [PATCH 089/300] accidnetally deleted line in previous commit, restore --- gridcomps/ExtData2G/ExtDataUpdatePointer.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 index 6d4ff50389bd..0847e067bf35 100644 --- a/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 +++ b/gridcomps/ExtData2G/ExtDataUpdatePointer.F90 @@ -17,6 +17,7 @@ module MAPL_ExtDataPointerUpdate logical :: disabled = .false. logical :: first_time_updated = .true. type(ESMF_TimeInterval) :: offset + logical :: single_shot = .false. type(ESMF_TimeInterval) :: update_freq type(ESMF_Time) :: last_ring type(ESMF_Time) :: reference_time From 064695243170f12223b6fce687d0230a503da6b7 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 8 Apr 2022 08:52:39 -0400 Subject: [PATCH 090/300] Fix typo in mapl_tree.py --- base/mapl_tree.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/base/mapl_tree.py b/base/mapl_tree.py index e55a43e89f04..aabd7003c3de 100755 --- a/base/mapl_tree.py +++ b/base/mapl_tree.py @@ -421,7 +421,7 @@ def main(): if ( REPO ): FULL_TREE = True TRIM = False - + MT = MAPL_Tree(OUT_FORM, OUT_COLOR, ADD_LINK, FULL_TREE, TRIM, REPO) if OUT_TYPE=='chname': @@ -452,7 +452,7 @@ def parse_args(): choices=['txt','mm'], default='txt') p.add_argument('-F','--full', help='display full tree', action='store_true') p.add_argument('-l','--link', help='add external link to nodes (edit MAPL_Tree::get_link)', action='store_true') - p.add_argument('-t','--trim', help='skip non GridComps, shorten names, use bult-in aliases',action='store_true') + p.add_argument('-t','--trim', help='skip non GridComps, shorten names, use built-in aliases',action='store_true') p.add_argument('-r','--repo', help='shows only the repository hierarchy',action='store_true') # Do not document this, it should be removed From 4e1c2f02996b60b9ee92e1802b772f731bbf4150 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 8 Apr 2022 17:00:17 -0400 Subject: [PATCH 091/300] getting derived exports to work --- base/MAPL_NewArthParser.F90 | 155 +++++++++++++++++++++++ gridcomps/ExtData/ExtDataGridCompMod.F90 | 28 ++-- gridcomps/ExtData2G/ExtDataConfig.F90 | 59 +++++++++ gridcomps/ExtData2G/ExtDataDerived.F90 | 54 ++++++++ gridcomps/ExtData2G/ExtDataTypeDef.F90 | 1 - 5 files changed, 282 insertions(+), 15 deletions(-) diff --git a/base/MAPL_NewArthParser.F90 b/base/MAPL_NewArthParser.F90 index 9b7a8e13a054..1a4bc82f17b1 100755 --- a/base/MAPL_NewArthParser.F90 +++ b/base/MAPL_NewArthParser.F90 @@ -55,11 +55,13 @@ MODULE MAPL_NewArthParserMod use MAPL_BaseMod use MAPL_CommsMod use MAPL_ExceptionHandling + use gFTL_StringVector IMPLICIT NONE !------- -------- --------- --------- --------- --------- --------- --------- ------- PRIVATE + public :: parser_variables_in_expression PUBLIC :: MAPL_StateEval PUBLIC :: CheckSyntax PUBLIC :: RealNum @@ -742,6 +744,136 @@ SUBROUTINE CopyScalarToField(ptrs,rn,rc) END SUBROUTINE CopyScalarToField ! + function parser_variables_in_expression (FuncStr,rc) result(variables_in_expression) + !----- -------- --------- --------- --------- --------- --------- --------- ------- + ! Check syntax of function string, returns 0 if syntax is ok + !----- -------- --------- --------- --------- --------- --------- --------- ------- + IMPLICIT NONE + type(StringVector) :: variables_in_expression + CHARACTER (LEN=*), INTENT(in) :: FuncStr ! Original function string + INTEGER, OPTIONAL :: rc + INTEGER :: n + CHARACTER (LEN=1) :: c + REAL :: r + LOGICAL :: err + INTEGER :: ParCnt, & ! Parenthesis counter + j,ib,in,lFunc + LOGICAL :: isUndef + character(len=ESMF_MAXPATHLEN) :: func + integer, allocatable :: ipos(:) + character(len=ESMF_MAXSTR), parameter :: IAm="CheckSyntax" + !----- -------- --------- --------- --------- --------- --------- --------- ------- + Func = FuncStr ! Local copy of function string + ALLOCATE (ipos(LEN_TRIM(FuncStr))) + CALL Replace ('**','^ ',Func) ! Exponent into 1-Char. format + CALL RemoveSpaces (Func,ipos) + j = 1 + ParCnt = 0 + lFunc = LEN_TRIM(Func) + step: DO + IF (j > lFunc) CALL ParseErrMsg (j, FuncStr, ipos) + c = Func(j:j) + !-- -------- --------- --------- --------- --------- --------- --------- ------- + ! Check for valid operand (must appear) + !-- -------- --------- --------- --------- --------- --------- --------- ------- + IF (c == '-' .OR. c == '+') THEN ! Check for leading - or + + j = j+1 + IF (j > lFunc) THEN + CALL ParseErrMsg (j, FuncStr, ipos, 'Missing operand') + _ASSERT(.FALSE.,'needs informative message') + END IF + c = Func(j:j) + IF (ANY(c == Ops)) THEN + CALL ParseErrMsg (j, FuncStr, ipos, 'Multiple operators') + _ASSERT(.FALSE.,'needs informative message') + END IF + END IF + n = MathFunctionIndex (Func(j:)) + IF (n > 0) THEN ! Check for math function + j = j+LEN_TRIM(Funcs(n)) + IF (j > lFunc) THEN + CALL ParseErrMsg (j, FuncStr, ipos, 'Missing function argument') + _ASSERT(.FALSE.,'needs informative message') + END IF + c = Func(j:j) + IF (c /= '(') THEN + CALL ParseErrMsg (j, FuncStr, ipos, 'Missing opening parenthesis') + _ASSERT(.FALSE.,'needs informative message') + END IF + END IF + IF (c == '(') THEN ! Check for opening parenthesis + ParCnt = ParCnt+1 + j = j+1 + CYCLE step + END IF + IF (SCAN(c,'0123456789.') > 0) THEN ! Check for number + r = RealNum (Func(j:),ib,in,err) + IF (err) THEN + CALL ParseErrMsg (j, FuncStr, ipos, 'Invalid number format: '//Func(j+ib-1:j+in-2)) + _ASSERT(.FALSE.,'needs informative message') + END IF + j = j+in-1 + IF (j > lFunc) EXIT + c = Func(j:j) + ELSE ! Check for variable + isUndef = checkUndef(Func(j:),ib,in) + if (isUndef) then + j = j+in-1 + IF (j> lFunc) EXIT + c = Func(j:j) + else + call GetVariables (Func(j:),ib,in) + call variables_in_expression%push_back(Func(j+ib-1:j+in-2)) + j = j+in-1 + IF (j > lFunc) EXIT + c = Func(j:j) + end if + END IF + DO WHILE (c == ')') ! Check for closing parenthesis + ParCnt = ParCnt-1 + IF (ParCnt < 0) THEN + CALL ParseErrMsg (j, FuncStr, ipos, 'Mismatched parenthesis') + _ASSERT(.FALSE.,'needs informative message') + END IF + IF (Func(j-1:j-1) == '(') THEN + CALL ParseErrMsg (j-1, FuncStr, ipos, 'Empty parentheses') + _ASSERT(.FALSE.,'needs informative message') + END IF + j = j+1 + IF (j > lFunc) EXIT + c = Func(j:j) + END DO + !-- -------- --------- --------- --------- --------- --------- --------- ------- + ! Now, we have a legal operand: A legal operator or end of string must follow + !-- -------- --------- --------- --------- --------- --------- --------- ------- + IF (j > lFunc) EXIT + IF (ANY(c == Ops)) THEN ! Check for multiple operators + IF (j+1 > lFunc) THEN + CALL ParseErrMsg (j, FuncStr, ipos) + _ASSERT(.FALSE.,'needs informative message') + END IF + IF (ANY(Func(j+1:j+1) == Ops)) THEN + CALL ParseErrMsg (j+1, FuncStr, ipos, 'Multiple operators') + _ASSERT(.FALSE.,'needs informative message') + END IF + ELSE ! Check for next operand + CALL ParseErrMsg (j, FuncStr, ipos, 'Missing operator') + _ASSERT(.FALSE.,'needs informative message') + END IF + !-- -------- --------- --------- --------- --------- --------- --------- ------- + ! Now, we have an operand and an operator: the next loop will check for another + ! operand (must appear) + !-- -------- --------- --------- --------- --------- --------- --------- ------- + j = j+1 + END DO step + IF (ParCnt > 0) THEN + CALL ParseErrMsg (j, FuncStr, ipos, 'Missing )') + _ASSERT(.FALSE.,'needs informative message') + END IF + DEALLOCATE(ipos) + _RETURN(ESMF_SUCCESS) + end function + SUBROUTINE CheckSyntax (FuncStr,Var,needed,ExtVar,rc) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Check syntax of function string, returns 0 if syntax is ok @@ -945,6 +1077,29 @@ FUNCTION MathFunctionIndex (str) RESULT (n) END DO END FUNCTION MathFunctionIndex ! + subroutine GetVariables (str, ibegin, inext) + !----- -------- --------- --------- --------- --------- --------- --------- ------- + ! Return index of variable at begin of string str (returns 0 if no variable found) + !----- -------- --------- --------- --------- --------- --------- --------- ------- + IMPLICIT NONE + CHARACTER (LEN=*), INTENT(in) :: str ! String + INTEGER, INTENT(out) :: ibegin, & ! Start position of variable name + inext ! Position of character after name + INTEGER :: j,ib,in,lstr + !----- -------- --------- --------- --------- --------- --------- --------- ------- + lstr = LEN_TRIM(str) + IF (lstr > 0) THEN + DO ib=1,lstr ! Search for first character in str + IF (str(ib:ib) /= ' ') EXIT ! When lstr>0 at least 1 char in str + END DO + DO in=ib,lstr ! Search for name terminators + IF (SCAN(str(in:in),'+-*/^) ') > 0) EXIT + END DO + END IF + ibegin = ib + inext = in + end subroutine GetVariables + FUNCTION VariableIndex (str, Var, ibegin, inext) RESULT (n) !----- -------- --------- --------- --------- --------- --------- --------- ------- ! Return index of variable at begin of string str (returns 0 if no variable found) diff --git a/gridcomps/ExtData/ExtDataGridCompMod.F90 b/gridcomps/ExtData/ExtDataGridCompMod.F90 index 9fa76a0fa575..4fdc23adcb5f 100644 --- a/gridcomps/ExtData/ExtDataGridCompMod.F90 +++ b/gridcomps/ExtData/ExtDataGridCompMod.F90 @@ -1302,10 +1302,10 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) item => self%primary%item(self%primaryOrder(i)) - call lgr%debug('ExtData Run_(): READ_LOOP: variable %i0 of %i0~: %a', i, self%primary%nItems, trim(item%var)) - call lgr%debug(' ==> file: %a', trim(item%file)) - call lgr%debug(' ==> cyclic: %a', trim(item%cyclic)) - call lgr%debug(' ==> isConst:: %l1', item%isConst) + !call lgr%debug('ExtData Run_(): READ_LOOP: variable %i0 of %i0~: %a', i, self%primary%nItems, trim(item%var)) + !call lgr%debug(' ==> file: %a', trim(item%file)) + !call lgr%debug(' ==> cyclic: %a', trim(item%cyclic)) + !call lgr%debug(' ==> isConst:: %l1', item%isConst) if (item%isConst) then call lgr%debug(' ==> Break loop since isConst is true') @@ -1515,7 +1515,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) if (doUpdate(i)) then - call lgr%debug('ExtData Run_: INTERP_LOOP: interpolating between bracket times, variable: %a10, file: %a', & + call lgr%debug('ExtData Run_: INTERP_LOOP: interpolating between bracket times, variable: %a, file: %a', & & trim(item%var), trim(item%file)) ! finally interpolate between bracketing times @@ -3254,15 +3254,15 @@ subroutine MAPL_ExtDataInterpField(item,time,field,vector_comp,rc) nymd2=0 end if - if (lgr%isEnabledFor(DEBUG) .and. .not. item%doInterpolate) then - call lgr%debug(' MAPL_ExtDataInterpField: Uninterpolated field %a set to sample L %i0.8 %i0.6', trim(item%name), nymd1, nhms1) - else if (time == item%interp_time1) then - call lgr%debug(' MAPL_ExtDataInterpField: Interpolated field %a set to sample L %i0.8 %i0.6', trim(item%name), nymd1, nhms1) - else if (time == item%interp_time2) then - call lgr%debug(' MAPL_ExtDataInterpField: Interpolated field %a set to sample R %i0.8 %i0.6', trim(item%name), nymd2, nhms2) - else - call lgr%debug(' MAPL_ExtDataInterpField: Interpolated field %a between %i0.8 %i0.6 and %i0.8 %i0.6 (%f10.6 fraction)', trim(item%name), nymd1, nhms1, nymd2, nhms2, alpha) - end if + !if (lgr%isEnabledFor(DEBUG) .and. .not. item%doInterpolate) then + !call lgr%debug(' MAPL_ExtDataInterpField: Uninterpolated field %a set to sample L %i0.8 %i0.6', trim(item%name), nymd1, nhms1) + !else if (time == item%interp_time1) then + !call lgr%debug(' MAPL_ExtDataInterpField: Interpolated field %a set to sample L %i0.8 %i0.6', trim(item%name), nymd1, nhms1) + !else if (time == item%interp_time2) then + !call lgr%debug(' MAPL_ExtDataInterpField: Interpolated field %a set to sample R %i0.8 %i0.6', trim(item%name), nymd2, nhms2) + !else + !call lgr%debug(' MAPL_ExtDataInterpField: Interpolated field %a between %i0.8 %i0.6 and %i0.8 %i0.6 (%f10.6 fraction)', trim(item%name), nymd1, nhms1, nymd2, nhms2, alpha) + !end if end if call ESMF_FieldGet(FIELD, dimCount=fieldRank,name=name, __RC__) diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index 7183b2941be6..3bbfe8dcc5bc 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -34,6 +34,7 @@ module MAPL_ExtDataConfig procedure :: new_ExtDataConfig_from_yaml procedure :: count_rules_for_item procedure :: get_time_range + procedure :: get_extra_derived_items end type contains @@ -347,4 +348,62 @@ subroutine add_new_rule(this,key,export_rule,rc) _RETURN(_SUCCESS) end subroutine add_new_rule + function get_extra_derived_items(this,primary_items,derived_items,rc) result(needed_vars) + type(StringVector) :: needed_vars + class(ExtDataConfig), intent(inout) :: this + type(StringVector), intent(in) :: primary_items + type(StringVector), intent(in) :: derived_items + integer, intent(out), optional :: rc + + integer :: status + type(StringVectorIterator) :: string_iter + type(ExtDataDerived), pointer :: derived_item + type(StringVector) :: variables_in_expression + type(StringVector) :: extra_variables_needed + character(len=:), pointer :: sval,derived_name + type(ExtDataRule), pointer :: rule + integer :: i + + if (derived_items%size() ==0) then + _RETURN(_SUCCESS) + end if + + string_iter = derived_items%begin() + do while(string_iter /= derived_items%end() ) + derived_name => string_iter%get() + derived_item => this%derived_map%at(derived_name) + variables_in_expression = derived_item%get_variables_in_expression() + ! now we have a stringvector of the variables involved in the expression + ! check which of this are already in primary_items list, if any are not + ! then we need to createa new list of needed variables and the "derived field" + ! wence to coppy them + do i=1,variables_in_expression%size() + sval => variables_in_expression%at(i) + if (.not.string_in_string_vector(sval,primary_items)) then + rule => this%rule_map%at(sval) + _ASSERT(associated(rule),"no rule for "//trim(sval)//" needed by "//trim(derived_name)) + call needed_vars%push_back(sval//","//derived_name) + end if + enddo + call string_iter%next() + enddo + + _RETURN(_SUCCESS) + end function + + function string_in_string_vector(target_string,string_vector) result(in_vector) + logical :: in_vector + character(len=*), intent(in) :: target_string + type(StringVector), intent(in) :: string_vector + + type(StringVectorIterator) :: iter + + in_vector = .false. + iter = string_vector%begin() + do while(iter /= string_vector%end()) + if (trim(target_string) == iter%get()) in_vector = .true. + call iter%next() + enddo + end function string_in_string_vector + end module MAPL_ExtDataConfig diff --git a/gridcomps/ExtData2G/ExtDataDerived.F90 b/gridcomps/ExtData2G/ExtDataDerived.F90 index 86cfbe1d70e1..d47dfa5f72bd 100644 --- a/gridcomps/ExtData2G/ExtDataDerived.F90 +++ b/gridcomps/ExtData2G/ExtDataDerived.F90 @@ -1,9 +1,12 @@ #include "MAPL_Exceptions.h" #include "MAPL_ErrLog.h" module MAPL_ExtDataDerived + use ESMF use yaFyaml use MAPL_KeywordEnforcerMod use MAPL_ExceptionHandling + use gFTL_StringVector + use MAPL_NewArthParserMod implicit none private @@ -13,6 +16,7 @@ module MAPL_ExtDataDerived contains procedure :: display procedure :: set_defaults + procedure :: get_variables_in_expression end type interface ExtDataDerived @@ -51,6 +55,56 @@ function new_ExtDataDerived(config,unusable,rc) result(rule) _RETURN(_SUCCESS) end function new_ExtDataDerived + function get_variables_in_expression(this,rc) result(variables_in_expression) + type(StringVector) :: variables_in_expression + class(ExtDataDerived), intent(inout), target :: this + integer, intent(out), optional :: rc + + integer :: status + + if (index(this%expression,"mask")/=0) then + variables_in_expression = get_mask_variables(this%expression,_RC) + else + variables_in_expression = parser_variables_in_expression(this%expression,_RC) + end if + _RETURN(_SUCCESS) + + contains + + function get_mask_variables(funcstr,rc) result(variables_in_mask) + type(StringVector) :: variables_in_mask + character(len=*), intent(in) :: funcstr + integer, intent(out), optional :: rc + + integer :: status + integer :: i1,i2,i,ivar + logical :: found,twovar + character(len=ESMF_MAXSTR) :: tmpstring,tmpstring1,tmpstring2,functionname + + i1 = index(Funcstr,"(") + _ASSERT(i1 > 0,'Incorrect format for function expression: missing "("') + functionname = adjustl(Funcstr(:i1-1)) + functionname = ESMF_UtilStringLowerCase(functionname, __RC__) + if (trim(functionname) == "regionmask") twovar = .true. + if (trim(functionname) == "zonemask") twovar = .false. + if (trim(functionname) == "boxmask") twovar = .false. + tmpstring = adjustl(Funcstr(i1+1:)) + i1 = index(tmpstring,",") + _ASSERT(i1 > 0,'Incorrect format for function expression: missing ","') + i2 = index(tmpstring,";") + if (twovar) then + tmpstring1 = adjustl(tmpstring(1:i1-1)) + tmpstring2 = adjustl(tmpstring(i1+1:i2-1)) + call variables_in_mask%push_back(tmpstring1) + call variables_in_mask%push_back(tmpstring2) + else + tmpstring1 = adjustl(tmpstring(1:i1-1)) + call variables_in_mask%push_back(tmpstring1) + end if + + end function + end function + subroutine set_defaults(this,unusable,rc) class(ExtDataDerived), intent(inout), target :: this diff --git a/gridcomps/ExtData2G/ExtDataTypeDef.F90 b/gridcomps/ExtData2G/ExtDataTypeDef.F90 index 12d7c16f938b..60d5b3c89956 100644 --- a/gridcomps/ExtData2G/ExtDataTypeDef.F90 +++ b/gridcomps/ExtData2G/ExtDataTypeDef.F90 @@ -75,7 +75,6 @@ module MAPL_ExtDataTypeDef type DerivedExport character(len=ESMF_MAXSTR) :: name character(len=ESMF_MAXPATHLEN) :: expression - logical :: ExtDataAlloc logical :: masking type(ExtDataPointerUpdate) :: update_freq end type DerivedExport From 1df94aa66815a923d32c1d6c46c7d54e078a6991 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 11 Apr 2022 14:16:49 -0400 Subject: [PATCH 092/300] fix more bugs for extdata2g with derived types --- gridcomps/ExtData2G/ExtDataConfig.F90 | 2 +- gridcomps/ExtData2G/ExtDataDerived.F90 | 7 ++++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index 3bbfe8dcc5bc..ea699741c0d9 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -389,7 +389,7 @@ function get_extra_derived_items(this,primary_items,derived_items,rc) result(nee enddo _RETURN(_SUCCESS) - end function + end function get_extra_derived_items function string_in_string_vector(target_string,string_vector) result(in_vector) logical :: in_vector diff --git a/gridcomps/ExtData2G/ExtDataDerived.F90 b/gridcomps/ExtData2G/ExtDataDerived.F90 index d47dfa5f72bd..8b31fdb2ad2a 100644 --- a/gridcomps/ExtData2G/ExtDataDerived.F90 +++ b/gridcomps/ExtData2G/ExtDataDerived.F90 @@ -95,12 +95,13 @@ function get_mask_variables(funcstr,rc) result(variables_in_mask) if (twovar) then tmpstring1 = adjustl(tmpstring(1:i1-1)) tmpstring2 = adjustl(tmpstring(i1+1:i2-1)) - call variables_in_mask%push_back(tmpstring1) - call variables_in_mask%push_back(tmpstring2) + call variables_in_mask%push_back(trim(tmpstring1)) + call variables_in_mask%push_back(trim(tmpstring2)) else tmpstring1 = adjustl(tmpstring(1:i1-1)) - call variables_in_mask%push_back(tmpstring1) + call variables_in_mask%push_back(trim(tmpstring1)) end if + _RETURN(_SUCCESS) end function end function From fc9c3b462cb3045f2f411d980878e806fc436553 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 11 Apr 2022 15:26:32 -0400 Subject: [PATCH 093/300] forgot too commit this file --- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 42 ++++++++++++++++++----- 1 file changed, 33 insertions(+), 9 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index d116fdcc2a9f..cb2e23e11d88 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -300,11 +300,15 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) logical :: found_in_config integer :: num_primary,num_derived,num_rules integer :: item_type - type(StringVector) :: unsatisfied_imports - character(len=:), pointer :: current_base_name + type(StringVector) :: unsatisfied_imports,extra_variables_needed + type(StringVectorIterator) :: siter + character(len=:), pointer :: current_base_name,extra_var + character(len=:), allocatable :: primary_var_name,derived_var_name type(ESMF_Time), allocatable :: time_ranges(:) character(len=1) :: sidx type(ESMF_VM) :: vm + type(ESMF_Field) :: new_field,existing_field + type(ESMF_StateItem_Flag) :: state_item_type !class(logger), pointer :: lgr ! Get my name and set-up traceback handle @@ -373,6 +377,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! --------------------------- ! Parse ExtData Resource File ! --------------------------- + self%ExtDataState = ESMF_StateCreate(Name="ExtDataNameSpace",__RC__) num_primary=0 num_derived=0 primaryitemcount=0 @@ -390,6 +395,23 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) primaryitemcount=primaryitemcount+config_yaml%count_rules_for_item(trim(itemnames(i)),_RC) end if enddo + extra_variables_needed = config_yaml%get_extra_derived_items(self%primary%import_names,self%derived%import_names,_RC) + siter = extra_variables_needed%begin() + do while(siter/=extra_variables_needed%end()) + extra_var => siter%get() + idx = index(extra_var,",") + primary_var_name = extra_var(:idx-1) + derived_var_name = extra_var(idx+1:) + call self%primary%import_names%push_back(primary_var_name) + primaryItemCount=primaryItemCount+config_yaml%count_rules_for_item(primary_var_name,_RC) + call ESMF_StateGet(self%ExtDataState,primary_var_name,state_item_type,_RC) + if (state_item_type == ESMF_STATEITEM_NOTFOUND) then + call ESMF_StateGet(export,derived_var_name,existing_field,_RC) + new_field = MAPL_FieldCreate(existing_field,primary_var_name,doCOpy=.true.,_RC) + call MAPL_StateAdd(self%ExtDataState,new_field,__RC__) + end if + call siter%next() + enddo call ESMF_VMBarrier(vm,_RC) if (unsatisfied_imports%size() > 0) then do i=1,unsatisfied_imports%size() @@ -403,7 +425,6 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) self%primary%nitems = PrimaryItemCount self%derived%nitems = DerivedItemCount - self%ExtDataState = ESMF_StateCreate(Name="ExtDataNameSpace",__RC__) num_primary=0 num_derived=0 do i=1,self%primary%import_names%size() @@ -428,12 +449,15 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) num_primary=num_primary+1 call config_yaml%fillin_primary(current_base_name,current_base_name,self%primary%item(num_primary),time,clock,__RC__) end if - call ESMF_StateGet(Export,current_base_name,field,__RC__) - call MAPL_StateAdd(self%ExtDataState,field,__RC__) - item_type = config_yaml%get_item_type(current_base_name) - if (item_type == Primary_Type_Vector_comp1) then - call ESMF_StateGet(Export,self%primary%item(num_primary)%vcomp2,field,_RC) - call MAPL_StateAdd(self%ExtDataState,field,_RC) + call ESMF_StateGet(Export,current_base_name,state_item_type,_RC) + if (state_item_type /= ESMF_STATEITEM_NOTFOUND) then + call ESMF_StateGet(Export,current_base_name,field,__RC__) + call MAPL_StateAdd(self%ExtDataState,field,__RC__) + item_type = config_yaml%get_item_type(current_base_name) + if (item_type == Primary_Type_Vector_comp1) then + call ESMF_StateGet(Export,self%primary%item(num_primary)%vcomp2,field,_RC) + call MAPL_StateAdd(self%ExtDataState,field,_RC) + end if end if enddo do i=1,self%derived%import_names%size() From 90f8883995008a82374c2b5456821b388dceffb5 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 11 Apr 2022 16:30:01 -0400 Subject: [PATCH 094/300] fix gnu bug --- gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 index 4720e087b766..5d6782af3d4d 100644 --- a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 +++ b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 @@ -186,11 +186,12 @@ subroutine fillin_derived(this,item_name,derived_item,time,clock,unusable,rc) _UNUSED_DUMMY(unusable) rule => this%derived_map%at(trim(item_name)) + derived_item%name = trim(item_name) derived_item%expression = rule%expression - time_sample => this%sample_map%at(rule%sample_key) - - if(.not.associated(time_sample)) then + if (allocated(rule%sample_key)) then + time_sample => this%sample_map%at(rule%sample_key) + else call default_time_sample%set_defaults() time_sample=>default_time_sample end if From fa9319197e92c60a5808a5062b7723f2e4873326 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 11 Apr 2022 16:31:35 -0400 Subject: [PATCH 095/300] updated changelog --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index c830f20ef8d5..54203b16ac60 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,9 +11,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Fix issue where ACG was called when no file had changed - Add missing `rc=status` in `MAPL_GetResourceFromMAPL_scalar` +- Fixed bugs with next generation ExtData ### Added - Added support for 4d variables in the coupler. Intentionally decided not to support 4d in the coupler's ReadRestart and WriteRestart to catch errors +- Added ability to use multiple rules for different time periods in next generation ExtData ### Changed From ee872e59e91f5fb911f76ff229383f0f32432491 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 12 Apr 2022 09:30:27 -0400 Subject: [PATCH 096/300] bug fix with forward backwards in tester --- Tests/ExtDataDriverGridComp.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Tests/ExtDataDriverGridComp.F90 b/Tests/ExtDataDriverGridComp.F90 index 21740859a808..fa52b57b8d52 100644 --- a/Tests/ExtDataDriverGridComp.F90 +++ b/Tests/ExtDataDriverGridComp.F90 @@ -615,11 +615,11 @@ subroutine run_MultipleTimes(gc, rc) call cap%run_one_step(status) _VERIFY(status) enddo + call ESMF_ClockSet(cap%clock,direction=ESMF_DIRECTION_REVERSE,_RC) do n=1,cap%nsteps - call ESMF_ClockSet(cap%clock,direction=ESMF_DIRECTION_REVERSE,_RC) call ESMF_ClockAdvance(cap%clock,rc=status) - call ESMF_ClockSet(cap%clock,direction=ESMF_DIRECTION_FORWARD,_RC) enddo + call ESMF_ClockSet(cap%clock,direction=ESMF_DIRECTION_FORWARD,_RC) do n=1,cap%nsteps call ESMF_ClockAdvance(cap%clock,rc=status) _VERIFY(status) From 14d6314dca0c8ca059bcaed99e7b3511a89fd1ca Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 13 Apr 2022 17:51:41 -0400 Subject: [PATCH 097/300] cleanup, move masking to own file --- base/MAPL_NewArthParser.F90 | 65 +-- gridcomps/ExtData2G/CMakeLists.txt | 1 + gridcomps/ExtData2G/ExtDataConfig.F90 | 1 + gridcomps/ExtData2G/ExtDataDerived.F90 | 41 +- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 539 +----------------- .../ExtData2G/ExtDataOldTypesCreator.F90 | 2 + gridcomps/ExtData2G/ExtDataTypeDef.F90 | 24 + 7 files changed, 55 insertions(+), 618 deletions(-) diff --git a/base/MAPL_NewArthParser.F90 b/base/MAPL_NewArthParser.F90 index 1a4bc82f17b1..638dc0fb356a 100755 --- a/base/MAPL_NewArthParser.F90 +++ b/base/MAPL_NewArthParser.F90 @@ -779,26 +779,22 @@ function parser_variables_in_expression (FuncStr,rc) result(variables_in_express IF (c == '-' .OR. c == '+') THEN ! Check for leading - or + j = j+1 IF (j > lFunc) THEN - CALL ParseErrMsg (j, FuncStr, ipos, 'Missing operand') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Missing operand in '//trim(funcstr)) END IF c = Func(j:j) IF (ANY(c == Ops)) THEN - CALL ParseErrMsg (j, FuncStr, ipos, 'Multiple operators') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Multiple operators in '//trim(funcstr)) END IF END IF n = MathFunctionIndex (Func(j:)) IF (n > 0) THEN ! Check for math function j = j+LEN_TRIM(Funcs(n)) IF (j > lFunc) THEN - CALL ParseErrMsg (j, FuncStr, ipos, 'Missing function argument') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Missing function argument in '//trim(funcstr)) END IF c = Func(j:j) IF (c /= '(') THEN - CALL ParseErrMsg (j, FuncStr, ipos, 'Missing opening parenthesis') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Missing opening parenthesis in '//trim(funcstr)) END IF END IF IF (c == '(') THEN ! Check for opening parenthesis @@ -809,8 +805,7 @@ function parser_variables_in_expression (FuncStr,rc) result(variables_in_express IF (SCAN(c,'0123456789.') > 0) THEN ! Check for number r = RealNum (Func(j:),ib,in,err) IF (err) THEN - CALL ParseErrMsg (j, FuncStr, ipos, 'Invalid number format: '//Func(j+ib-1:j+in-2)) - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Invalid number format: '//Func(j+ib-1:j+in-2)) END IF j = j+in-1 IF (j > lFunc) EXIT @@ -832,12 +827,10 @@ function parser_variables_in_expression (FuncStr,rc) result(variables_in_express DO WHILE (c == ')') ! Check for closing parenthesis ParCnt = ParCnt-1 IF (ParCnt < 0) THEN - CALL ParseErrMsg (j, FuncStr, ipos, 'Mismatched parenthesis') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Mismatched parenthesis in '//trim(funcstr)) END IF IF (Func(j-1:j-1) == '(') THEN - CALL ParseErrMsg (j-1, FuncStr, ipos, 'Empty parentheses') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Empty parentheses in '//trim(funcstr)) END IF j = j+1 IF (j > lFunc) EXIT @@ -849,16 +842,13 @@ function parser_variables_in_expression (FuncStr,rc) result(variables_in_express IF (j > lFunc) EXIT IF (ANY(c == Ops)) THEN ! Check for multiple operators IF (j+1 > lFunc) THEN - CALL ParseErrMsg (j, FuncStr, ipos) _ASSERT(.FALSE.,'needs informative message') END IF IF (ANY(Func(j+1:j+1) == Ops)) THEN - CALL ParseErrMsg (j+1, FuncStr, ipos, 'Multiple operators') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Multiple operators in '//trim(funcstr)) END IF ELSE ! Check for next operand - CALL ParseErrMsg (j, FuncStr, ipos, 'Missing operator') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Missing operator in '//trim(funcstr)) END IF !-- -------- --------- --------- --------- --------- --------- --------- ------- ! Now, we have an operand and an operator: the next loop will check for another @@ -867,8 +857,7 @@ function parser_variables_in_expression (FuncStr,rc) result(variables_in_express j = j+1 END DO step IF (ParCnt > 0) THEN - CALL ParseErrMsg (j, FuncStr, ipos, 'Missing )') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Missing ) '//trim(funcstr)) END IF DEALLOCATE(ipos) _RETURN(ESMF_SUCCESS) @@ -912,26 +901,22 @@ SUBROUTINE CheckSyntax (FuncStr,Var,needed,ExtVar,rc) IF (c == '-' .OR. c == '+') THEN ! Check for leading - or + j = j+1 IF (j > lFunc) THEN - CALL ParseErrMsg (j, FuncStr, ipos, 'Missing operand') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Missing operand in '//trim(funcstr)) END IF c = Func(j:j) IF (ANY(c == Ops)) THEN - CALL ParseErrMsg (j, FuncStr, ipos, 'Multiple operators') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Multiple operators in '//trim(funcstr)) END IF END IF n = MathFunctionIndex (Func(j:)) IF (n > 0) THEN ! Check for math function j = j+LEN_TRIM(Funcs(n)) IF (j > lFunc) THEN - CALL ParseErrMsg (j, FuncStr, ipos, 'Missing function argument') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Missing function argument in '//trim(funcStr)) END IF c = Func(j:j) IF (c /= '(') THEN - CALL ParseErrMsg (j, FuncStr, ipos, 'Missing opening parenthesis') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Missing opening parenthesis in '//trim(funcstr)) END IF END IF IF (c == '(') THEN ! Check for opening parenthesis @@ -942,8 +927,7 @@ SUBROUTINE CheckSyntax (FuncStr,Var,needed,ExtVar,rc) IF (SCAN(c,'0123456789.') > 0) THEN ! Check for number r = RealNum (Func(j:),ib,in,err) IF (err) THEN - CALL ParseErrMsg (j, FuncStr, ipos, 'Invalid number format: '//Func(j+ib-1:j+in-2)) - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Invalid number format: '//Func(j+ib-1:j+in-2)) END IF j = j+in-1 IF (j > lFunc) EXIT @@ -961,8 +945,7 @@ SUBROUTINE CheckSyntax (FuncStr,Var,needed,ExtVar,rc) IF (present(ExtVar)) then ExtVar = trim(ExtVar)//Func(j+ib-1:j+in-2)//"," ELSE - CALL ParseErrMsg (j, FuncStr, ipos, 'Invalid element: '//Func(j+ib-1:j+in-2)) - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Invalid element: '//Func(j+ib-1:j+in-2)) ENDIF END IF j = j+in-1 @@ -973,12 +956,10 @@ SUBROUTINE CheckSyntax (FuncStr,Var,needed,ExtVar,rc) DO WHILE (c == ')') ! Check for closing parenthesis ParCnt = ParCnt-1 IF (ParCnt < 0) THEN - CALL ParseErrMsg (j, FuncStr, ipos, 'Mismatched parenthesis') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Mismatched parenthesis in '//trim(funcStr)) END IF IF (Func(j-1:j-1) == '(') THEN - CALL ParseErrMsg (j-1, FuncStr, ipos, 'Empty parentheses') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Empty paraentheses '//trim(funcstr)) END IF j = j+1 IF (j > lFunc) EXIT @@ -990,16 +971,13 @@ SUBROUTINE CheckSyntax (FuncStr,Var,needed,ExtVar,rc) IF (j > lFunc) EXIT IF (ANY(c == Ops)) THEN ! Check for multiple operators IF (j+1 > lFunc) THEN - CALL ParseErrMsg (j, FuncStr, ipos) _ASSERT(.FALSE.,'needs informative message') END IF IF (ANY(Func(j+1:j+1) == Ops)) THEN - CALL ParseErrMsg (j+1, FuncStr, ipos, 'Multiple operators') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Multiple operatos in '//trim(Funcstr)) END IF ELSE ! Check for next operand - CALL ParseErrMsg (j, FuncStr, ipos, 'Missing operator') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Missing operator in '//trim(funcstr)) END IF !-- -------- --------- --------- --------- --------- --------- --------- ------- ! Now, we have an operand and an operator: the next loop will check for another @@ -1008,8 +986,7 @@ SUBROUTINE CheckSyntax (FuncStr,Var,needed,ExtVar,rc) j = j+1 END DO step IF (ParCnt > 0) THEN - CALL ParseErrMsg (j, FuncStr, ipos, 'Missing )') - _ASSERT(.FALSE.,'needs informative message') + _ASSERT(.FALSE.,'Missing ) in '//trim(funcstr)) END IF DEALLOCATE(ipos) _RETURN(ESMF_SUCCESS) diff --git a/gridcomps/ExtData2G/CMakeLists.txt b/gridcomps/ExtData2G/CMakeLists.txt index 276ef8fa83f0..ee599479ac02 100644 --- a/gridcomps/ExtData2G/CMakeLists.txt +++ b/gridcomps/ExtData2G/CMakeLists.txt @@ -21,6 +21,7 @@ set (srcs ExtData_IOBundleMod.F90 ExtData_IOBundleVectorMod.F90 ExtDataYamlNodeStack.F90 + ExtDataMasking.F90 ) diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index ea699741c0d9..f2e9ca15208f 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -16,6 +16,7 @@ module MAPL_ExtDataConfig use MAPL_ExtDataTimeSampleMap use MAPL_TimeStringConversion use MAPL_ExtDataYamlNodeStack + use MAPL_ExtDataMask implicit none private diff --git a/gridcomps/ExtData2G/ExtDataDerived.F90 b/gridcomps/ExtData2G/ExtDataDerived.F90 index 8b31fdb2ad2a..eda6020cce8a 100644 --- a/gridcomps/ExtData2G/ExtDataDerived.F90 +++ b/gridcomps/ExtData2G/ExtDataDerived.F90 @@ -7,6 +7,7 @@ module MAPL_ExtDataDerived use MAPL_ExceptionHandling use gFTL_StringVector use MAPL_NewArthParserMod + use MAPL_ExtDataMask implicit none private @@ -61,49 +62,17 @@ function get_variables_in_expression(this,rc) result(variables_in_expression) integer, intent(out), optional :: rc integer :: status + type(ExtDataMask), allocatable :: temp_mask if (index(this%expression,"mask")/=0) then - variables_in_expression = get_mask_variables(this%expression,_RC) + allocate(temp_mask) + temp_mask = ExtDataMask(this%expression) + variables_in_expression = temp_mask%get_mask_variables(_RC) else variables_in_expression = parser_variables_in_expression(this%expression,_RC) end if _RETURN(_SUCCESS) - contains - - function get_mask_variables(funcstr,rc) result(variables_in_mask) - type(StringVector) :: variables_in_mask - character(len=*), intent(in) :: funcstr - integer, intent(out), optional :: rc - - integer :: status - integer :: i1,i2,i,ivar - logical :: found,twovar - character(len=ESMF_MAXSTR) :: tmpstring,tmpstring1,tmpstring2,functionname - - i1 = index(Funcstr,"(") - _ASSERT(i1 > 0,'Incorrect format for function expression: missing "("') - functionname = adjustl(Funcstr(:i1-1)) - functionname = ESMF_UtilStringLowerCase(functionname, __RC__) - if (trim(functionname) == "regionmask") twovar = .true. - if (trim(functionname) == "zonemask") twovar = .false. - if (trim(functionname) == "boxmask") twovar = .false. - tmpstring = adjustl(Funcstr(i1+1:)) - i1 = index(tmpstring,",") - _ASSERT(i1 > 0,'Incorrect format for function expression: missing ","') - i2 = index(tmpstring,";") - if (twovar) then - tmpstring1 = adjustl(tmpstring(1:i1-1)) - tmpstring2 = adjustl(tmpstring(i1+1:i2-1)) - call variables_in_mask%push_back(trim(tmpstring1)) - call variables_in_mask%push_back(trim(tmpstring2)) - else - tmpstring1 = adjustl(tmpstring(1:i1-1)) - call variables_in_mask%push_back(trim(tmpstring1)) - end if - _RETURN(_SUCCESS) - - end function end function diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index cb2e23e11d88..4aa058bccb32 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -774,8 +774,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) if (doUpdate_) then - call CalcDerivedField(self%ExtDataState,derivedItem%name,derivedItem%expression, & - derivedItem%masking,__RC__) + call derivedItem%evaluate_derived_field(self%ExtDataState,_RC) end if @@ -1085,26 +1084,6 @@ subroutine GetLevs(item, rc) end subroutine GetLevs - subroutine CalcDerivedField(state,exportName,exportExpr,masking,rc) - type(ESMF_State), intent(inout) :: state - character(len=*), intent(in ) :: exportName - character(len=*), intent(in ) :: exportExpr - logical, intent(in ) :: masking - integer, optional, intent(out ) :: rc - - integer :: status - - type(ESMF_Field) :: field - - if (masking) then - call MAPL_ExtDataEvaluateMask(state,exportName,exportExpr,__RC__) - else - call ESMF_StateGet(state,exportName,field,__RC__) - call MAPL_StateEval(state,exportExpr,field,__RC__) - end if - _RETURN(ESMF_SUCCESS) - end subroutine CalcDerivedField - subroutine MAPL_ExtDataInterpField(item,state,time,rc) type(PrimaryExport), intent(inout) :: item type(ESMF_State), intent(in) :: state @@ -1202,522 +1181,6 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,current_time,rc) _RETURN(ESMF_SUCCESS) end subroutine MAPL_ExtDataVerticalInterpolate - subroutine GetMaskName(FuncStr,Var,Needed,rc) - character(len=*), intent(in) :: FuncStr - character(len=*), intent(in) :: Var(:) - logical, intent(inout) :: needed(:) - integer, optional, intent(out) :: rc - - integer :: status - integer :: i1,i2,i,ivar - logical :: found,twovar - character(len=ESMF_MAXSTR) :: tmpstring,tmpstring1,tmpstring2,functionname - - i1 = index(Funcstr,"(") - _ASSERT(i1 > 0,'Incorrect format for function expression: missing "("') - functionname = adjustl(Funcstr(:i1-1)) - functionname = ESMF_UtilStringLowerCase(functionname, __RC__) - if (trim(functionname) == "regionmask") twovar = .true. - if (trim(functionname) == "zonemask") twovar = .false. - if (trim(functionname) == "boxmask") twovar = .false. - tmpstring = adjustl(Funcstr(i1+1:)) - i1 = index(tmpstring,",") - _ASSERT(i1 > 0,'Incorrect format for function expression: missing ","') - i2 = index(tmpstring,";") - if (twovar) then - tmpstring1 = adjustl(tmpstring(1:i1-1)) - tmpstring2 = adjustl(tmpstring(i1+1:i2-1)) - else - tmpstring1 = adjustl(tmpstring(1:i1-1)) - end if - - found = .false. - do i=1,size(var) - if ( trim(tmpstring1) == trim(var(i)) ) then - ivar = i - found = .true. - exit - end if - end do - _ASSERT(found,'Var ' // trim(tmpstring1) // ' not found') - needed(ivar) = .true. - - if (twovar) then - found = .false. - do i=1,size(var) - if ( trim(tmpstring2) == trim(var(i)) ) then - ivar = i - found = .true. - exit - end if - end do - _ASSERT(found,'Secound Var ' // trim(tmpstring2) // ' not found') - needed(ivar) = .true. - end if - _RETURN(ESMF_SUCCESS) - end subroutine GetMaskName - - subroutine MAPL_ExtDataEvaluateMask(state,exportName,exportExpr,rc) - - type(ESMF_STATE), intent(inout) :: state - character(len=*), intent(in) :: exportName - character(len=*), intent(in) :: exportExpr - integer, optional, intent(out) :: rc - - integer :: status - - integer :: k,i - character(len=ESMF_MAXSTR) :: maskString,maskname,vartomask,functionname,clatS,clatN - character(len=ESMF_MAXSTR) :: strtmp - integer, allocatable :: regionNumbers(:), flag(:) - integer, allocatable :: mask(:,:) - real, pointer :: rmask(:,:) => null() - real, pointer :: rvar2d(:,:) => null() - real, pointer :: rvar3d(:,:,:) => null() - real, pointer :: var2d(:,:) => null() - real, pointer :: var3d(:,:,:) => null() - real(REAL64), pointer :: lats(:,:) => null() - real(REAL64), pointer :: lons(:,:) => null() - real(REAL64) :: limitS, limitN, limitE, limitW - real(REAL64) :: limitE1, limitW1 - real(REAL64) :: limitE2, limitW2 - type(ESMF_Field) :: field - type(ESMF_Grid) :: grid - integer :: rank,ib,ie,is,i1,nargs - integer :: counts(3) - logical :: isCube, twoBox - real, allocatable :: temp2d(:,:) - character(len=ESMF_MAXSTR) :: args(5) - - call ESMF_StateGet(state,exportName,field,__RC__) - call ESMF_FieldGet(field,rank=rank,grid=grid,__RC__) - i1 = index(exportExpr,"(") - _ASSERT(i1 > 0,'Expected "(" in expression: ' // trim(exportExpr)) - functionname = adjustl(exportExpr(:i1-1)) - functionname = ESMF_UtilStringLowerCase(functionname, __RC__) - - if (trim(functionname) == "regionmask") then - ! get mask string - ib = index(exportExpr,";") - ie = index(exportExpr,")") - maskString = trim(exportExpr(ib+1:ie-1)) - ! get mask name - ie = index(exportExpr,";") - is = index(exportExpr,"(") - ib = index(exportExpr,",") - vartomask = trim(exportExpr(is+1:ib-1)) - maskname = trim(exportExpr(ib+1:ie-1)) - call MAPL_GetPointer(state,rmask,maskName,__RC__) - if (rank == 2) then - call MAPL_GetPointer(state,rvar2d,vartomask,__RC__) - call MAPL_GetPointer(state,var2d,exportName,__RC__) - else if (rank == 3) then - call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) - call MAPL_GetPointer(state,var3d,exportName,__RC__) - else - _ASSERT(.false.,'Rank must be 2 or 3') - end if - - k=32 - allocate(regionNumbers(k), flag(k), stat=status) - _VERIFY(STATUS) - regionNumbers = 0 - call MAPL_ExtDataExtractIntegers(maskString,k,regionNumbers,rc=status) - _VERIFY(STATUS) - flag(:) = 1 - WHERE(regionNumbers(:) == 0) flag(:) = 0 - k = SUM(flag) - deallocate(flag,stat=status) - _VERIFY(STATUS) - - ! Set local mask to 1 where gridMask matches each integer (within precision!) - ! --------------------------------------------------------------------------- - allocate(mask(size(rmask,1),size(rmask,2)),stat=status) - _VERIFY(STATUS) - mask = 0 - DO i=1,k - WHERE(regionNumbers(i)-0.01 <= rmask .AND. & - rmask <= regionNumbers(i)+0.01) mask = 1 - END DO - - if (rank == 2) then - var2d = rvar2d - where(mask == 0) var2d = 0.0 - else if (rank == 3) then - var3d = rvar3d - do i=1,size(var3d,3) - where(mask == 0) var3d(:,:,i) = 0.0 - enddo - end if - deallocate( mask) - elseif(trim(functionname) == "zonemask") then - - ib = index(exportExpr,"(") - ie = index(exportExpr,",") - vartomask = trim(exportExpr(ib+1:ie-1)) - ib = index(exportExpr,",") - is = index(exportExpr,",",back=.true.) - ie = index(exportExpr,")") - clatS = trim(exportExpr(ib+1:is-1)) - clatN = trim(exportExpr(is+1:ie-1)) - READ(clatS,*,IOSTAT=status) limitS - _VERIFY(status) - READ(clatN,*,IOSTAT=status) limitN - _VERIFY(status) - - call ESMF_GridGetCoord(grid, coordDim=2, localDE=0, & - staggerloc=ESMF_STAGGERLOC_CENTER, farrayPtr=lats, rc=status) - _VERIFY(status) - limitN=limitN*MAPL_PI_R8/180.0d0 - limitS=limitS*MAPL_PI_R8/180.0d0 - - if (rank == 2) then - call MAPL_GetPointer(state,rvar2d,vartomask,__RC__) - call MAPL_GetPointer(state,var2d,exportName,__RC__) - else if (rank == 3) then - call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) - call MAPL_GetPointer(state,var3d,exportName,__RC__) - else - _ASSERT(.false.,'Rank must be 2 or 3') - end if - - if (rank == 2) then - var2d = 0.0 - where(limitS <= lats .and. lats <=limitN) var2d = rvar2d - else if (rank == 3) then - var3d = 0.0 - do i=1,size(var3d,3) - where(limitS <= lats .and. lats <=limitN) var3d(:,:,i) = rvar3d(:,:,i) - enddo - end if - - elseif(trim(functionname) == "boxmask") then - is=index(exportExpr,'(') - ie=index(exportExpr,')') - strtmp = exportExpr(is+1:ie-1) - do nargs=1,5 - is = index(strtmp,',') - if (is >0) then - args(nargs) = strtmp(:is-1) - else - args(nargs) = strtmp - end if - strtmp = strtmp(is+1:) - end do - - varToMask=args(1) - - READ(args(2),*,IOSTAT=status) limitS - _VERIFY(status) - READ(args(3),*,IOSTAT=status) limitN - _VERIFY(status) - READ(args(4),*,IOSTAT=status) limitW - _VERIFY(status) - READ(args(5),*,IOSTAT=status) limitE - _VERIFY(status) - _ASSERT(limitE > limitW,'LimitE must be greater than limitW') - _ASSERT(limitE /= limitW,'LimitE cannot equal limitW') - _ASSERT(limitN /= limitS,'LimitN cannot equal LimitS') - _ASSERT((limitE-limitW)<=360.0d0,'(LimitE - LimitW) must be less than or equal to 360') - - call ESMF_GridGetCoord(grid, coordDim=1, localDE=0, & - staggerloc=ESMF_STAGGERLOC_CENTER, farrayPtr=lons, rc=status) - _VERIFY(status) - call ESMF_GridGetCoord(grid, coordDim=2, localDE=0, & - staggerloc=ESMF_STAGGERLOC_CENTER, farrayPtr=lats, rc=status) - _VERIFY(status) - - ! do some tests if cube goes from 0 to 360, lat-lon -180 to 180 - call MAPL_GridGet(grid, globalCellCountPerDim=COUNTS,rc=status) - _VERIFY(STATUS) - if (counts(2)==6*counts(1)) then - isCube=.true. - else - isCube=.false. - end if - - twoBox = .false. - if (isCube) then - if (limitW < 0.0d0 .and. limitE >=0.0d0) then - ! need two boxes - twoBox=.true. - limitW1=0.0d0 - limitE1=limitE - limitW2=limitW+360.0d0 - limitE2=360.0d0 - - else if (limitW <0.0d0 .and. limitE <0.0d0) then - ! just shift - limitW1=limitW+360.d0 - limitE1=limitE+360.d0 - - else - ! normal case - limitW1=limitW - limitE1=limitE - end if - - else - - if (limitW <= 180.0d0 .and. limitE > 180.0d0) then - ! need two boxes - twoBox=.true. - limitW1=limitW - limitE1=180.0d0 - limitW2=-180.d0 - limitE2=limitE-360.0d0 - else if (limitW > 180.0d0 .and. limitE > 180.0d0) then - ! just shift - limitW1=limitW-360.d0 - limitE1=limitE-360.d0 - else - ! normal case - limitW1=limitW - limitE1=limitE - end if - - end if - - limitE1=limitE1*MAPL_PI_R8/180.0d0 - limitW1=limitW1*MAPL_PI_R8/180.0d0 - limitE2=limitE2*MAPL_PI_R8/180.0d0 - limitW2=limitW2*MAPL_PI_R8/180.0d0 - - limitN=limitN*MAPL_PI_R8/180.0d0 - limitS=limitS*MAPL_PI_R8/180.0d0 - if (rank == 2) then - call MAPL_GetPointer(state,rvar2d,vartomask,__RC__) - call MAPL_GetPointer(state,var2d,exportName,__RC__) - else if (rank == 3) then - call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) - call MAPL_GetPointer(state,var3d,exportName,__RC__) - else - _ASSERT(.false.,'Rank must be 2 or 3') - end if - - if (rank == 2) then - var2d = 0.0 - where(limitS <= lats .and. lats <=limitN .and. limitW1 <= lons .and. lons <= limitE1 ) var2d = rvar2d - else if (rank == 3) then - var3d = 0.0 - do i=1,size(var3d,3) - where(limitS <= lats .and. lats <=limitN .and. limitW1 <= lons .and. lons <= limitE1 ) var3d(:,:,i) = rvar3d(:,:,i) - enddo - end if - - if (twoBox) then - allocate(temp2d(size(var2d,1),size(var2d,2)),stat=status) - _VERIFY(STATUS) - if (rank == 2) then - temp2d = 0.0 - where(limitS <= lats .and. lats <=limitN .and. limitW2 <= lons .and. lons <= limitE2 ) temp2d = rvar2d - var2d=var2d+temp2d - else if (rank == 3) then - do i=1,size(var3d,3) - temp2d = 0.0 - where(limitS <= lats .and. lats <=limitN .and. limitW2 <= lons .and. lons <= limitE2 ) temp2d = rvar3d(:,:,i) - var3d(:,:,i)=var3d(:,:,i)+temp2d - enddo - end if - deallocate(temp2d) - end if - - end if - - _RETURN(ESMF_SUCCESS) - - end subroutine MAPL_ExtDataEvaluateMask - - SUBROUTINE MAPL_ExtDataExtractIntegers(string,iSize,iValues,delimiter,verbose,rc) - -! !USES: - - IMPLICIT NONE - -! !INPUT/OUTPUT PARAMETERS: - - CHARACTER(LEN=*), INTENT(IN) :: string ! Character-delimited string of integers - INTEGER, INTENT(IN) :: iSize - INTEGER, INTENT(INOUT) :: iValues(iSize)! Space allocated for extracted integers - CHARACTER(LEN=*), OPTIONAL :: delimiter ! 1-character delimiter - LOGICAL, OPTIONAL, INTENT(IN) :: verbose ! Let me know iValues as they are found. - ! DEBUG directive turns on the message even - ! if verbose is not present or if - ! verbose = .FALSE. - INTEGER, OPTIONAL, INTENT(OUT) :: rc ! Return code -! !DESCRIPTION: -! -! Extract integers from a character-delimited string, for example, "-1,45,256,7,10". In the context -! of Chem_Util, this is provided for determining the numerically indexed regions over which an -! emission might be applied. -! -! In multiple passes, the string is parsed for the delimiter, and the characters up to, but not -! including the delimiter are taken as consecutive digits of an integer. A negative sign ("-") is -! allowed. After the first pass, each integer and its trailing delimiter are lopped of the head of -! the (local copy of the) string, and the process is started over. -! -! The default delimiter is a comma (","). -! -! "Unfilled" iValues are zero. -! -! Return codes: -! 1 Zero-length string. -! 2 iSize needs to be increased. -! -! Assumptions/bugs: -! -! A non-zero return code does not stop execution. -! Allowed numerals are: 0,1,2,3,4,5,6,7,8,9. -! A delimiter must be separated from another delimiter by at least one numeral. -! The delimiter cannot be a numeral or a negative sign. -! The character following a negative sign must be an allowed numeral. -! The first character must be an allowed numeral or a negative sign. -! The last character must be an allowed numeral. -! The blank character (" ") cannot serve as a delimiter. -! -! Examples of strings that will work: -! "1" -! "-1" -! "-1,2004,-3" -! "1+-2+3" -! "-1A100A5" -! Examples of strings that will not work: -! "1,--2,3" -! "1,,2,3" -! "1,A,3" -! "1,-,2" -! "1,2,3,4," -! "+1" -! "1 3 6" -! -! !REVISION HISTORY: -! -! Taken from chem utilities. -! -!EOP - CHARACTER(LEN=*), PARAMETER :: Iam = 'Chem_UtilExtractIntegers' - - INTEGER :: base,count,i,iDash,last,lenStr - INTEGER :: multiplier,pos,posDelim,sign - CHARACTER(LEN=255) :: str - CHARACTER(LEN=1) :: char,delimChar - LOGICAL :: Done - LOGICAL :: tellMe - -! Initializations -! --------------- - If (present(rc)) rc=0 - count = 1 - Done = .FALSE. - iValues(:) = 0 - base = ICHAR("0") - iDash = ICHAR("-") - -! Determine verbosity, letting the DEBUG -! directive override local specification -! -------------------------------------- - tellMe = .FALSE. - IF(PRESENT(verbose)) THEN - IF(verbose) tellMe = .TRUE. - END IF -#ifdef DEBUG - tellMe = .TRUE. -#endif -! Check for zero-length string -! ---------------------------- - lenStr = LEN_TRIM(string) - IF(lenStr == 0) THEN - If (present(rc)) rc=1 - PRINT *,trim(IAm),": ERROR - Found zero-length string." - RETURN - END IF - -! Default delimiter is a comma -! ---------------------------- - delimChar = "," - IF(PRESENT(delimiter)) delimChar(1:1) = delimiter(1:1) - -! Work on a local copy -! -------------------- - str = TRIM(string) - -! One pass for each delimited integer -! ----------------------------------- - Parse: DO - - lenStr = LEN_TRIM(str) - -! Parse the string for the delimiter -! ---------------------------------- - posDelim = INDEX(TRIM(str),TRIM(delimChar)) - IF(tellMe) PRINT *,trim(Iam),": Input string is >",TRIM(string),"<" - -! If the delimiter does not exist, -! one integer remains to be extracted. -! ------------------------------------ - IF(posDelim == 0) THEN - Done = .TRUE. - last = lenStr - ELSE - last = posDelim-1 - END IF - multiplier = 10**last - -! Examine the characters of this integer -! -------------------------------------- - Extract: DO pos=1,last - - char = str(pos:pos) - i = ICHAR(char) - -! Account for a leading "-" -! ------------------------- - IF(pos == 1) THEN - IF(i == iDash) THEN - sign = -1 - ELSE - sign = 1 - END IF - END IF - -! "Power" of 10 for this character -! -------------------------------- - multiplier = multiplier/10 - - IF(pos == 1 .AND. sign == -1) CYCLE Extract - -! Integer comes from remaining characters -! --------------------------------------- - i = (i-base)*multiplier - iValues(count) = iValues(count)+i - IF(pos == last) THEN - iValues(count) = iValues(count)*sign - IF(tellMe) PRINT *,trim(Iam),":Integer number ",count," is ",iValues(count) - END IF - - END DO Extract - - IF(Done) EXIT - -! Lop off the leading integer and try again -! ----------------------------------------- - str(1:lenStr-posDelim) = str(posDelim+1:lenStr) - str(lenStr-posDelim+1:255) = " " - count = count+1 - -! Check size -! ---------- - IF(count > iSize) THEN - If (present(rc)) rc=2 - PRINT *,trim(Iam),": ERROR - iValues does not have enough elements." - END IF - - END DO Parse - - _RETURN(ESMF_SUCCESS) - - END SUBROUTINE MAPL_ExtDataExtractIntegers - function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) type(ESMF_Grid), intent(inout) :: Grid diff --git a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 index 5d6782af3d4d..936d250e5c9b 100644 --- a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 +++ b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 @@ -200,6 +200,8 @@ subroutine fillin_derived(this,item_name,derived_item,time,clock,unusable,rc) derived_item%masking=.false. if (index(derived_item%expression,"mask") /= 0 ) then derived_item%masking=.true. + allocate(derived_item%mask_definition) + derived_item%mask_definition = ExtDataMask(derived_item%expression,_RC) end if _RETURN(_SUCCESS) diff --git a/gridcomps/ExtData2G/ExtDataTypeDef.F90 b/gridcomps/ExtData2G/ExtDataTypeDef.F90 index 60d5b3c89956..f7f7ec75ded3 100644 --- a/gridcomps/ExtData2G/ExtDataTypeDef.F90 +++ b/gridcomps/ExtData2G/ExtDataTypeDef.F90 @@ -1,3 +1,4 @@ +#include "MAPL_Exceptions.h" module MAPL_ExtDataTypeDef use ESMF use MAPL_GriddedIOItemMod @@ -5,6 +6,8 @@ module MAPL_ExtDataTypeDef use MAPL_ExtDataPointerUpdate use MAPL_ExtDataAbstractFileHandler use MAPL_FileMetadataUtilsMod + use MAPL_NewArthParserMod + use MAPL_ExtDataMask implicit none public PrimaryExport @@ -76,8 +79,29 @@ module MAPL_ExtDataTypeDef character(len=ESMF_MAXSTR) :: name character(len=ESMF_MAXPATHLEN) :: expression logical :: masking + type(ExtDataMask), allocatable :: mask_definition type(ExtDataPointerUpdate) :: update_freq + contains + procedure :: evaluate_derived_field end type DerivedExport + contains + + subroutine evaluate_derived_field(this,state,rc) + class(DerivedExport), intent(inout) :: this + type(ESMF_State), intent(inout) :: state + integer, optional, intent(out) :: rc + + integer :: status + type(ESMF_Field) :: field + + if (this%masking) then + call this%mask_definition%evaluate_mask(state,trim(this%name),_RC) + else + call ESMF_StateGet(state,trim(this%name),field,_RC) + call MAPL_StateEval(state,trim(this%expression),field,_RC) + end if + _RETURN(_SUCCESS) + end subroutine end module MAPL_ExtDataTypeDef From 7472eb5aaf7fade7a7427ce9cf3ca0b1a5fa0cdc Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 13 Apr 2022 17:55:58 -0400 Subject: [PATCH 098/300] forgot to commit this --- gridcomps/ExtData2G/ExtDataMasking.F90 | 597 +++++++++++++++++++++++++ 1 file changed, 597 insertions(+) create mode 100644 gridcomps/ExtData2G/ExtDataMasking.F90 diff --git a/gridcomps/ExtData2G/ExtDataMasking.F90 b/gridcomps/ExtData2G/ExtDataMasking.F90 new file mode 100644 index 000000000000..f923133663f9 --- /dev/null +++ b/gridcomps/ExtData2G/ExtDataMasking.F90 @@ -0,0 +1,597 @@ +#include "MAPL_Exceptions.h" +#include "MAPL_ErrLog.h" +#include "MAPL_Generic.h" +module MAPL_ExtDataMask + use ESMF + use MAPL_KeywordEnforcerMod + use ESMFL_Mod + use MAPL_BaseMod + use MAPL_ExceptionHandling + use gFTL_StringVector + use MAPL_NewArthParserMod + use MAPL_Constants + implicit none + private + + type, public :: ExtDataMask + character(len=:), allocatable :: mask_type + character(len=:), allocatable :: mask_arguments + contains + procedure :: get_mask_variables + procedure :: evaluate_mask + procedure :: evaluate_region_mask + procedure :: evaluate_zone_mask + procedure :: evaluate_box_mask + end type ExtDataMask + + interface ExtDataMask + module procedure new_ExtDataMask + end interface ExtDataMask + + contains + + function new_ExtDataMask(mask_expression,rc) result(new_mask) + type(ExtDataMask) :: new_mask + character(len=*), intent(in) :: mask_expression + integer, optional, intent(out) :: rc + + integer :: status + character(len=:), allocatable :: function_name + character(len=:), allocatable :: arguments + integer :: i1,len + + i1 = index(mask_expression,"(") + _ASSERT(i1 > 0,'Incorrect format for function expression: missing "("') + function_name = adjustl(mask_expression(:i1-1)) + function_name = ESMF_UtilStringLowerCase(function_name, __RC__) + + if (index(function_name,"regionmask") /= 0) then + new_mask%mask_type = "regionmask" + else if (index(function_name,"zonemask") /= 0) then + new_mask%mask_type = "zonemask" + else if (index(function_name,"boxmask") /= 0) then + new_mask%mask_type = "boxmask" + else + _FAIL("Invalid mask type") + end if + + len = len_trim(mask_expression) + arguments = adjustl(mask_expression(i1+1:len-1)) + i1 = index(arguments,",") + _ASSERT(i1 > 0,'Incorrect format for function expression: missing ","') + new_mask%mask_arguments = arguments + _RETURN(_SUCCESS) + end function + + function get_mask_variables(this,rc) result(variables_in_mask) + class(ExtDataMask), intent(inout) :: this + type(StringVector) :: variables_in_mask + integer, intent(out), optional :: rc + + integer :: status + integer :: i1,i2 + logical :: twovar + character(len=:), allocatable :: tmpstring1,tmpstring2 + + if (this%mask_type == "regionmask") twovar = .true. + if (this%mask_type == "zonemask") twovar = .false. + if (this%mask_type == "boxmask") twovar = .false. + i1 = index(this%mask_arguments,",") + i2 = index(this%mask_arguments,";") + if (twovar) then + tmpstring1 = this%mask_arguments(1:i1-1) + tmpstring2 = this%mask_arguments(i1+1:i2-1) + call variables_in_mask%push_back(trim(tmpstring1)) + call variables_in_mask%push_back(trim(tmpstring2)) + else + tmpstring1 = this%mask_arguments(1:i1-1) + call variables_in_mask%push_back(trim(tmpstring1)) + end if + _RETURN(_SUCCESS) + + end function + + subroutine evaluate_mask(this,state,var_name,rc) + class(ExtDataMask), intent(inout) :: this + type(ESMF_State), intent(inout) :: state + character(len=*), intent(in) :: var_name + integer, optional, intent(out) :: rc + + integer :: status + select case(this%mask_type) + case("regionmask") + call this%evaluate_region_mask(state,var_name,_RC) + case("zonemask") + call this%evaluate_zone_mask(state,var_name,_RC) + case("boxmask") + call this%evaluate_box_mask(state,var_name,_RC) + end select + _RETURN(_SUCCESS) + end subroutine evaluate_mask + + subroutine evaluate_region_mask(this,state,var_name,rc) + class(ExtDataMask), intent(inout) :: this + type(ESMF_State), intent(inout) :: state + character(len=*), intent(in) :: var_name + integer, optional, intent(out) :: rc + + integer :: status + integer :: k,i + character(len=:), allocatable :: maskString,maskname,vartomask + integer, allocatable :: regionNumbers(:), flag(:) + integer, allocatable :: mask(:,:) + real, pointer :: rmask(:,:) + real, pointer :: rvar2d(:,:) + real, pointer :: rvar3d(:,:,:) + real, pointer :: var2d(:,:) + real, pointer :: var3d(:,:,:) + integer :: rank,ib,ie + type(ESMF_Field) :: field + + call ESMF_StateGet(state,var_name,field,__RC__) + call ESMF_FieldGet(field,rank=rank,__RC__) + + ! get mask string + ib = index(this%mask_arguments,";") + maskString = this%mask_arguments(ib+1:) + ! get mask name + ie = index(this%mask_arguments,";") + ib = index(this%mask_arguments,",") + vartomask = this%mask_arguments(:ib-1) + maskname = this%mask_arguments(ib+1:ie-1) + + call MAPL_GetPointer(state,rmask,maskName,__RC__) + if (rank == 2) then + call MAPL_GetPointer(state,rvar2d,vartomask,__RC__) + call MAPL_GetPointer(state,var2d,var_name,__RC__) + else if (rank == 3) then + call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) + call MAPL_GetPointer(state,var3d,var_name,__RC__) + else + _ASSERT(.false.,'Rank must be 2 or 3') + end if + + k=32 + allocate(regionNumbers(k), flag(k), stat=status) + _VERIFY(STATUS) + regionNumbers = 0 + call ExtDataExtractIntegers(maskString,k,regionNumbers,rc=status) + _VERIFY(STATUS) + flag(:) = 1 + WHERE(regionNumbers(:) == 0) flag(:) = 0 + k = SUM(flag) + deallocate(flag,stat=status) + _VERIFY(STATUS) + + ! Set local mask to 1 where gridMask matches each integer (within precision!) + ! --------------------------------------------------------------------------- + allocate(mask(size(rmask,1),size(rmask,2)),stat=status) + _VERIFY(STATUS) + mask = 0 + DO i=1,k + WHERE(regionNumbers(i)-0.01 <= rmask .AND. & + rmask <= regionNumbers(i)+0.01) mask = 1 + END DO + + if (rank == 2) then + var2d = rvar2d + where(mask == 0) var2d = 0.0 + else if (rank == 3) then + var3d = rvar3d + do i=1,size(var3d,3) + where(mask == 0) var3d(:,:,i) = 0.0 + enddo + end if + deallocate( mask) + + _RETURN(_SUCCESS) + end subroutine evaluate_region_mask + + subroutine evaluate_zone_mask(this,state,var_name,rc) + class(ExtDataMask), intent(inout) :: this + type(ESMF_State), intent(inout) :: state + character(len=*), intent(in) :: var_name + integer, optional, intent(out) :: rc + + integer :: status + + integer :: i + character(len=:), allocatable :: vartomask,clatS,clatN + real, pointer :: rvar2d(:,:) + real, pointer :: rvar3d(:,:,:) + real, pointer :: var2d(:,:) + real, pointer :: var3d(:,:,:) + real(REAL64), pointer :: lats(:,:) + real(REAL64) :: limitS, limitN + type(ESMF_Field) :: field + type(ESMF_Grid) :: grid + integer :: rank,ib,is + type(ESMF_CoordSys_Flag) :: coordSys + + call ESMF_StateGet(state,var_name,field,__RC__) + call ESMF_FieldGet(field,rank=rank,grid=grid,__RC__) + + ib = index(this%mask_arguments,",") + vartomask = this%mask_arguments(:ib-1) + is = index(this%mask_arguments,",",back=.true.) + clatS = this%mask_arguments(ib+1:is-1) + clatN = this%mask_arguments(is+1:) + READ(clatS,*,IOSTAT=status) limitS + _VERIFY(status) + READ(clatN,*,IOSTAT=status) limitN + _VERIFY(status) + + call ESMF_GridGetCoord(grid, coordDim=2, localDE=0, & + staggerloc=ESMF_STAGGERLOC_CENTER, farrayPtr=lats, rc=status) + _VERIFY(status) + call ESMF_GridGet(grid,coordsys=coordsys,_RC) + if (coordsys == ESMF_COORDSYS_SPH_RAD) then + limitN=limitN*MAPL_PI_R8/180.0d0 + limitS=limitS*MAPL_PI_R8/180.0d0 + end if + + if (rank == 2) then + call MAPL_GetPointer(state,rvar2d,vartomask,__RC__) + call MAPL_GetPointer(state,var2d,var_name,__RC__) + else if (rank == 3) then + call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) + call MAPL_GetPointer(state,var3d,var_name,__RC__) + else + _ASSERT(.false.,'Rank must be 2 or 3') + end if + + if (rank == 2) then + var2d = 0.0 + where(limitS <= lats .and. lats <=limitN) var2d = rvar2d + else if (rank == 3) then + var3d = 0.0 + do i=1,size(var3d,3) + where(limitS <= lats .and. lats <=limitN) var3d(:,:,i) = rvar3d(:,:,i) + enddo + end if + + _RETURN(_SUCCESS) + end subroutine evaluate_zone_mask + + subroutine evaluate_box_mask(this,state,var_name,rc) + class(ExtDataMask), intent(inout) :: this + type(ESMF_State), intent(inout) :: state + character(len=*), intent(in) :: var_name + integer, optional, intent(out) :: rc + + integer :: status + + integer :: i + character(len=:), allocatable :: vartomask,strtmp + real, pointer :: rvar2d(:,:) + real, pointer :: rvar3d(:,:,:) + real, pointer :: var2d(:,:) + real, pointer :: var3d(:,:,:) + real(REAL64), pointer :: lats(:,:) + real(REAL64), pointer :: lons(:,:) + real(REAL64) :: limitS, limitN, limitE, limitW + real(REAL64) :: limitE1, limitW1 + real(REAL64) :: limitE2, limitW2 + type(ESMF_Field) :: field + type(ESMF_Grid) :: grid + integer :: rank,is,nargs + integer :: counts(3) + logical :: isCube, twoBox + real, allocatable :: temp2d(:,:) + character(len=ESMF_MAXSTR) :: args(5) + type(ESMF_CoordSys_Flag) :: coordSys + + call ESMF_StateGet(state,var_name,field,__RC__) + call ESMF_FieldGet(field,rank=rank,grid=grid,__RC__) + call ESMF_GridGet(grid,coordsys=coordsys,_RC) + + strtmp = this%mask_arguments + do nargs=1,5 + is = index(strtmp,',') + if (is >0) then + args(nargs) = strtmp(:is-1) + else + args(nargs) = strtmp + end if + strtmp = strtmp(is+1:) + end do + + varToMask=args(1) + + READ(args(2),*,IOSTAT=status) limitS + _VERIFY(status) + READ(args(3),*,IOSTAT=status) limitN + _VERIFY(status) + READ(args(4),*,IOSTAT=status) limitW + _VERIFY(status) + READ(args(5),*,IOSTAT=status) limitE + _VERIFY(status) + _ASSERT(limitE > limitW,'LimitE must be greater than limitW') + _ASSERT(limitE /= limitW,'LimitE cannot equal limitW') + _ASSERT(limitN /= limitS,'LimitN cannot equal LimitS') + _ASSERT((limitE-limitW)<=360.0d0,'(LimitE - LimitW) must be less than or equal to 360') + + call ESMF_GridGetCoord(grid, coordDim=1, localDE=0, & + staggerloc=ESMF_STAGGERLOC_CENTER, farrayPtr=lons, rc=status) + _VERIFY(status) + call ESMF_GridGetCoord(grid, coordDim=2, localDE=0, & + staggerloc=ESMF_STAGGERLOC_CENTER, farrayPtr=lats, rc=status) + _VERIFY(status) + + ! do some tests if cube goes from 0 to 360, lat-lon -180 to 180 + call MAPL_GridGet(grid, globalCellCountPerDim=COUNTS,rc=status) + _VERIFY(STATUS) + if (counts(2)==6*counts(1)) then + isCube=.true. + else + isCube=.false. + end if + twoBox = .false. + if (isCube) then + if (limitW < 0.0d0 .and. limitE >=0.0d0) then + ! need two boxes + twoBox=.true. + limitW1=0.0d0 + limitE1=limitE + limitW2=limitW+360.0d0 + limitE2=360.0d0 + + else if (limitW <0.0d0 .and. limitE <0.0d0) then + ! just shift + limitW1=limitW+360.d0 + limitE1=limitE+360.d0 + + else + ! normal case + limitW1=limitW + limitE1=limitE + end if + + else + + if (limitW <= 180.0d0 .and. limitE > 180.0d0) then + ! need two boxes + twoBox=.true. + limitW1=limitW + limitE1=180.0d0 + limitW2=-180.d0 + limitE2=limitE-360.0d0 + else if (limitW > 180.0d0 .and. limitE > 180.0d0) then + ! just shift + limitW1=limitW-360.d0 + limitE1=limitE-360.d0 + else + ! normal case + limitW1=limitW + limitE1=limitE + end if + + end if + if (coordSys == ESMF_COORDSYS_SPH_RAD) then + limitE1=limitE1*MAPL_PI_R8/180.0d0 + limitW1=limitW1*MAPL_PI_R8/180.0d0 + if (twoBox) then + limitE2=limitE2*MAPL_PI_R8/180.0d0 + limitW2=limitW2*MAPL_PI_R8/180.0d0 + end if + + limitN=limitN*MAPL_PI_R8/180.0d0 + limitS=limitS*MAPL_PI_R8/180.0d0 + end if + if (rank == 2) then + call MAPL_GetPointer(state,rvar2d,vartomask,__RC__) + call MAPL_GetPointer(state,var2d,var_name,__RC__) + else if (rank == 3) then + call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) + call MAPL_GetPointer(state,var3d,var_name,__RC__) + else + _ASSERT(.false.,'Rank must be 2 or 3') + end if + + if (rank == 2) then + var2d = 0.0 + where(limitS <= lats .and. lats <=limitN .and. limitW1 <= lons .and. lons <= limitE1 ) var2d = rvar2d + else if (rank == 3) then + var3d = 0.0 + do i=1,size(var3d,3) + where(limitS <= lats .and. lats <=limitN .and. limitW1 <= lons .and. lons <= limitE1 ) var3d(:,:,i) = rvar3d(:,:,i) + enddo + end if + + if (twoBox) then + allocate(temp2d(size(var2d,1),size(var2d,2)),stat=status) + _VERIFY(STATUS) + if (rank == 2) then + temp2d = 0.0 + where(limitS <= lats .and. lats <=limitN .and. limitW2 <= lons .and. lons <= limitE2 ) temp2d = rvar2d + var2d=var2d+temp2d + else if (rank == 3) then + do i=1,size(var3d,3) + temp2d = 0.0 + where(limitS <= lats .and. lats <=limitN .and. limitW2 <= lons .and. lons <= limitE2 ) temp2d = rvar3d(:,:,i) + var3d(:,:,i)=var3d(:,:,i)+temp2d + enddo + end if + deallocate(temp2d) + end if + + _RETURN(_SUCCESS) + end subroutine evaluate_box_mask + + SUBROUTINE ExtDataExtractIntegers(string,iSize,iValues,delimiter,verbose,rc) + +! !USES: + + IMPLICIT NONE + +! !INPUT/OUTPUT PARAMETERS: + + CHARACTER(LEN=*), INTENT(IN) :: string ! Character-delimited string of integers + INTEGER, INTENT(IN) :: iSize + INTEGER, INTENT(INOUT) :: iValues(iSize)! Space allocated for extracted integers + CHARACTER(LEN=*), OPTIONAL :: delimiter ! 1-character delimiter + LOGICAL, OPTIONAL, INTENT(IN) :: verbose ! Let me know iValues as they are found. + ! DEBUG directive turns on the message even + ! if verbose is not present or if + ! verbose = .FALSE. + INTEGER, OPTIONAL, INTENT(OUT) :: rc ! Return code +! !DESCRIPTION: +! +! Extract integers from a character-delimited string, for example, "-1,45,256,7,10". In the context +! of Chem_Util, this is provided for determining the numerically indexed regions over which an +! emission might be applied. +! +! In multiple passes, the string is parsed for the delimiter, and the characters up to, but not +! including the delimiter are taken as consecutive digits of an integer. A negative sign ("-") is +! allowed. After the first pass, each integer and its trailing delimiter are lopped of the head of +! the (local copy of the) string, and the process is started over. +! +! The default delimiter is a comma (","). +! +! "Unfilled" iValues are zero. +! +! Return codes: +! 1 Zero-length string. +! 2 iSize needs to be increased. +! +! Assumptions/bugs: +! +! A non-zero return code does not stop execution. +! Allowed numerals are: 0,1,2,3,4,5,6,7,8,9. +! A delimiter must be separated from another delimiter by at least one numeral. +! The delimiter cannot be a numeral or a negative sign. +! The character following a negative sign must be an allowed numeral. +! The first character must be an allowed numeral or a negative sign. +! The last character must be an allowed numeral. +! The blank character (" ") cannot serve as a delimiter. +! +! Examples of strings that will work: +! "1" +! "-1" +! "-1,2004,-3" +! "1+-2+3" +! "-1A100A5" +! Examples of strings that will not work: +! "1,--2,3" +! "1,,2,3" +! "1,A,3" +! "1,-,2" +! "1,2,3,4," +! "+1" +! "1 3 6" + + INTEGER :: base,count,i,iDash,last,lenStr + INTEGER :: multiplier,pos,posDelim,sign + CHARACTER(LEN=255) :: str + CHARACTER(LEN=1) :: char,delimChar + LOGICAL :: Done + LOGICAL :: tellMe + +! Initializations +! --------------- + count = 1 + Done = .FALSE. + iValues(:) = 0 + base = ICHAR("0") + iDash = ICHAR("-") + +! Determine verbosity, letting the DEBUG +! directive override local specification +! -------------------------------------- + tellMe = .FALSE. + IF(PRESENT(verbose)) THEN + IF(verbose) tellMe = .TRUE. + END IF +#ifdef DEBUG + tellMe = .TRUE. +#endif +! Check for zero-length string +! ---------------------------- + lenStr = LEN_TRIM(string) + IF(lenStr == 0) THEN + _FAIL("ERROR - Found zero-length string.") + END IF + +! Default delimiter is a comma +! ---------------------------- + delimChar = "," + IF(PRESENT(delimiter)) delimChar(1:1) = delimiter(1:1) + +! Work on a local copy +! -------------------- + str = TRIM(string) + +! One pass for each delimited integer +! ----------------------------------- + Parse: DO + + lenStr = LEN_TRIM(str) + +! Parse the string for the delimiter +! ---------------------------------- + posDelim = INDEX(TRIM(str),TRIM(delimChar)) + +! If the delimiter does not exist, +! one integer remains to be extracted. +! ------------------------------------ + IF(posDelim == 0) THEN + Done = .TRUE. + last = lenStr + ELSE + last = posDelim-1 + END IF + multiplier = 10**last + +! Examine the characters of this integer +! -------------------------------------- + Extract: DO pos=1,last + + char = str(pos:pos) + i = ICHAR(char) + +! Account for a leading "-" +! ------------------------- + IF(pos == 1) THEN + IF(i == iDash) THEN + sign = -1 + ELSE + sign = 1 + END IF + END IF + +! "Power" of 10 for this character +! -------------------------------- + multiplier = multiplier/10 + + IF(pos == 1 .AND. sign == -1) CYCLE Extract + +! Integer comes from remaining characters +! --------------------------------------- + i = (i-base)*multiplier + iValues(count) = iValues(count)+i + IF(pos == last) THEN + iValues(count) = iValues(count)*sign + END IF + + END DO Extract + IF(Done) EXIT + +! Lop off the leading integer and try again +! ----------------------------------------- + str(1:lenStr-posDelim) = str(posDelim+1:lenStr) + str(lenStr-posDelim+1:255) = " " + count = count+1 + +! Check size +! ---------- + IF(count > iSize) THEN + _FAIL("ERROR - iValues does not have enough elements.") + END IF + + END DO Parse + + _RETURN(ESMF_SUCCESS) + + END SUBROUTINE ExtDataExtractIntegers + +end module MAPL_ExtDataMask From b40e3fb554db5081ad897791f512e2907d972d49 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 15 Apr 2022 15:32:07 -0400 Subject: [PATCH 099/300] more bug fixes and cleanup --- gridcomps/ExtData/ExtDataGridCompMod.F90 | 18 +++++++++--------- .../ExtData2G/ExtDataAbstractFileHandler.F90 | 2 +- gridcomps/ExtData2G/ExtDataBracket.F90 | 6 +++--- gridcomps/ExtData2G/ExtDataClimFileHandler.F90 | 2 +- gridcomps/ExtData2G/ExtDataConfig.F90 | 18 +++++++++++++----- gridcomps/ExtData2G/ExtDataFileStream.F90 | 9 +++++++-- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 4 ++-- gridcomps/ExtData2G/ExtDataMasking.F90 | 6 +++--- gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 | 7 ++++--- gridcomps/ExtData2G/ExtDataRule.F90 | 17 ++++++++++++++--- .../ExtData2G/ExtDataSimpleFileHandler.F90 | 3 +-- 11 files changed, 58 insertions(+), 34 deletions(-) diff --git a/gridcomps/ExtData/ExtDataGridCompMod.F90 b/gridcomps/ExtData/ExtDataGridCompMod.F90 index 4fdc23adcb5f..c523f9e4ea75 100644 --- a/gridcomps/ExtData/ExtDataGridCompMod.F90 +++ b/gridcomps/ExtData/ExtDataGridCompMod.F90 @@ -3254,15 +3254,15 @@ subroutine MAPL_ExtDataInterpField(item,time,field,vector_comp,rc) nymd2=0 end if - !if (lgr%isEnabledFor(DEBUG) .and. .not. item%doInterpolate) then - !call lgr%debug(' MAPL_ExtDataInterpField: Uninterpolated field %a set to sample L %i0.8 %i0.6', trim(item%name), nymd1, nhms1) - !else if (time == item%interp_time1) then - !call lgr%debug(' MAPL_ExtDataInterpField: Interpolated field %a set to sample L %i0.8 %i0.6', trim(item%name), nymd1, nhms1) - !else if (time == item%interp_time2) then - !call lgr%debug(' MAPL_ExtDataInterpField: Interpolated field %a set to sample R %i0.8 %i0.6', trim(item%name), nymd2, nhms2) - !else - !call lgr%debug(' MAPL_ExtDataInterpField: Interpolated field %a between %i0.8 %i0.6 and %i0.8 %i0.6 (%f10.6 fraction)', trim(item%name), nymd1, nhms1, nymd2, nhms2, alpha) - !end if + if (lgr%isEnabledFor(DEBUG) .and. .not. item%doInterpolate) then + call lgr%debug(' MAPL_ExtDataInterpField: Uninterpolated field %a set to sample L %i0.8 %i0.6', trim(item%name), nymd1, nhms1) + else if (time == item%interp_time1) then + call lgr%debug(' MAPL_ExtDataInterpField: Interpolated field %a set to sample L %i0.8 %i0.6', trim(item%name), nymd1, nhms1) + else if (time == item%interp_time2) then + call lgr%debug(' MAPL_ExtDataInterpField: Interpolated field %a set to sample R %i0.8 %i0.6', trim(item%name), nymd2, nhms2) + else + call lgr%debug(' MAPL_ExtDataInterpField: Interpolated field %a between %i0.8 %i0.6 and %i0.8 %i0.6 (%f10.6 fraction)', trim(item%name), nymd1, nhms1, nymd2, nhms2, alpha) + end if end if call ESMF_FieldGet(FIELD, dimCount=fieldRank,name=name, __RC__) diff --git a/gridcomps/ExtData2G/ExtDataAbstractFileHandler.F90 b/gridcomps/ExtData2G/ExtDataAbstractFileHandler.F90 index ec003f7276a6..afa0ccffcb76 100644 --- a/gridcomps/ExtData2G/ExtDataAbstractFileHandler.F90 +++ b/gridcomps/ExtData2G/ExtDataAbstractFileHandler.F90 @@ -144,7 +144,7 @@ subroutine get_time_on_file(this,filename,target_time,bracketside,time_index,out end if end if else - _ASSERT(.false.,"unknown bracket side") + _FAIL("unknown bracket side") end if _RETURN(_SUCCESS) diff --git a/gridcomps/ExtData2G/ExtDataBracket.F90 b/gridcomps/ExtData2G/ExtDataBracket.F90 index d887b73c8f42..393eef062377 100644 --- a/gridcomps/ExtData2G/ExtDataBracket.F90 +++ b/gridcomps/ExtData2G/ExtDataBracket.F90 @@ -73,7 +73,7 @@ subroutine set_node(this, bracketside, unusable, field, file, time, time_index, if (present(file)) this%right_node%file=file if (present(was_set)) this%right_node%was_set=was_set else - _ASSERT(.false.,'wrong bracket side') + _FAIL('wrong bracket side') end if _RETURN(_SUCCESS) @@ -104,7 +104,7 @@ subroutine get_node(this, bracketside, unusable, field, file, time, time_index, if (present(file)) file=this%right_node%file if (present(was_set)) was_set=this%right_node%was_set else - _ASSERT(.false.,'wrong bracket side') + _FAIL('wrong bracket side') end if _RETURN(_SUCCESS) @@ -159,7 +159,7 @@ subroutine get_parameters(this, bracket_side, unusable, field, file, time, time_ if (present(time_index)) time_index = this%right_node%time_index if (present(update)) update = this%new_file_right else - _ASSERT(.false.,'invalid bracket side!') + _FAIL('invalid bracket side!') end if _RETURN(_SUCCESS) diff --git a/gridcomps/ExtData2G/ExtDataClimFileHandler.F90 b/gridcomps/ExtData2G/ExtDataClimFileHandler.F90 index 8dc2619aae33..0e4fdbd75f93 100644 --- a/gridcomps/ExtData2G/ExtDataClimFileHandler.F90 +++ b/gridcomps/ExtData2G/ExtDataClimFileHandler.F90 @@ -233,7 +233,7 @@ subroutine get_file(this,filename,target_time,shift,rc) ! time is not representable as absolute time interval (month, year etc...) do this ! brute force way. Not good but ESMF leaves no choice ftime=this%reff_time - do while (ftime < target_time) + do while (ftime <= target_time) ftime = ftime + this%frequency enddo ftime=ftime -this%frequency + shift*this%frequency diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index f2e9ca15208f..14b8489eb16f 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -128,10 +128,10 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ rule_map = subcfg%of(sorted_rules(i)) write(i_char,'(I1)')i new_key = key//rule_sep//i_char - call ext_config%add_new_rule(new_key,rule_map,_RC) + call ext_config%add_new_rule(new_key,rule_map,multi_rule=.true.,_RC) enddo else - _ASSERT(.false.,"Exports must be sequence or map") + _FAIL("Exports must be sequence or map") end if call iter%next() enddo @@ -316,20 +316,28 @@ function get_item_type(this,item_name,unusable,rc) result(item_type) _RETURN(_SUCCESS) end function get_item_type - subroutine add_new_rule(this,key,export_rule,rc) + subroutine add_new_rule(this,key,export_rule,multi_rule,rc) class(ExtDataConfig), intent(inout) :: this character(len=*), intent(in) :: key type(configuration), intent(in) :: export_rule + logical, optional, intent(in) :: multi_rule integer, intent(out), optional :: rc integer :: semi_pos,status type(ExtDataRule) :: rule,ucomp,vcomp type(ExtDataRule), pointer :: temp_rule character(len=:), allocatable :: uname,vname + logical :: usable_multi_rule + + if (present(multi_rule)) then + usable_multi_rule = multi_rule + else + usable_multi_rule = .false. + end if call rule%set_defaults(rc=status) _VERIFY(status) - rule = ExtDataRule(export_rule,this%sample_map,key,_RC) + rule = ExtDataRule(export_rule,this%sample_map,key,multi_rule=usable_multi_rule,_RC) semi_pos = index(key,";") if (semi_pos > 0) then call rule%split_vector(key,ucomp,vcomp,rc=status) @@ -373,7 +381,7 @@ function get_extra_derived_items(this,primary_items,derived_items,rc) result(nee do while(string_iter /= derived_items%end() ) derived_name => string_iter%get() derived_item => this%derived_map%at(derived_name) - variables_in_expression = derived_item%get_variables_in_expression() + variables_in_expression = derived_item%get_variables_in_expression(_RC) ! now we have a stringvector of the variables involved in the expression ! check which of this are already in primary_items list, if any are not ! then we need to createa new list of needed variables and the "derived field" diff --git a/gridcomps/ExtData2G/ExtDataFileStream.F90 b/gridcomps/ExtData2G/ExtDataFileStream.F90 index b70a24032ba8..c239380a0896 100644 --- a/gridcomps/ExtData2G/ExtDataFileStream.F90 +++ b/gridcomps/ExtData2G/ExtDataFileStream.F90 @@ -139,10 +139,11 @@ function get_string_with_default(config,selector) result(string) end function new_ExtDataFileStream - subroutine detect_metadata(this,metadata_out,time,get_range,rc) + subroutine detect_metadata(this,metadata_out,time,multi_rule,get_range,rc) class(ExtDataFileStream), intent(inout) :: this type(FileMetadataUtils), intent(inout) :: metadata_out type(ESMF_Time), intent(in) :: time + logical, intent(in) :: multi_rule logical, optional, intent(in) :: get_range integer, optional, intent(out) :: rc @@ -153,6 +154,10 @@ subroutine detect_metadata(this,metadata_out,time,get_range,rc) integer :: status character(len=ESMF_MAXPATHLEN) :: filename + if (multi_rule) then + _ASSERT(allocated(this%valid_range),"must use a collection with valid range") + end if + if (present(get_range)) then get_range_ = get_range else @@ -170,7 +175,7 @@ subroutine detect_metadata(this,metadata_out,time,get_range,rc) end if end if - if (get_range_) then + if (get_range_ .or. multi_rule) then call fill_grads_template(filename,this%file_template,time=this%valid_range(1),__RC__) else call fill_grads_template(filename,this%file_template,time=time,__RC__) diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index 4aa058bccb32..627472eb8b2d 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -971,7 +971,7 @@ type (ESMF_Time) function timestamp_(time, template, rc) ! split the time stamp template into a date and time strings i = scan(buff, 't') If (.not.(i > 3)) Then - _ASSERT(.False.,'ERROR: Time stamp ' // trim(template) // ' uses the fixed format, and must therefore contain a T') + _FAIL('ERROR: Time stamp ' // trim(template) // ' uses the fixed format, and must therefore contain a T') End If buff_date = buff(1:i-1) @@ -1739,7 +1739,7 @@ subroutine create_bracketing_fields(item,ExtDataState,cf,rc) else if (item%vartype == MAPL_VectorField) then if (item%Trans /= REGRID_METHOD_BILINEAR) then - _ASSERT(.false.,'No conservative re-gridding with vectors') + _FAIL('No conservative re-gridding with vectors') end if call ESMF_StateGet(ExtDataState, trim(item%vcomp1), field,__RC__) diff --git a/gridcomps/ExtData2G/ExtDataMasking.F90 b/gridcomps/ExtData2G/ExtDataMasking.F90 index f923133663f9..b9fb0d609807 100644 --- a/gridcomps/ExtData2G/ExtDataMasking.F90 +++ b/gridcomps/ExtData2G/ExtDataMasking.F90 @@ -148,7 +148,7 @@ subroutine evaluate_region_mask(this,state,var_name,rc) call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) call MAPL_GetPointer(state,var3d,var_name,__RC__) else - _ASSERT(.false.,'Rank must be 2 or 3') + _FAIL('Rank must be 2 or 3') end if k=32 @@ -237,7 +237,7 @@ subroutine evaluate_zone_mask(this,state,var_name,rc) call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) call MAPL_GetPointer(state,var3d,var_name,__RC__) else - _ASSERT(.false.,'Rank must be 2 or 3') + _FAIL('Rank must be 2 or 3') end if if (rank == 2) then @@ -385,7 +385,7 @@ subroutine evaluate_box_mask(this,state,var_name,rc) call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) call MAPL_GetPointer(state,var3d,var_name,__RC__) else - _ASSERT(.false.,'Rank must be 2 or 3') + _FAIL('Rank must be 2 or 3') end if if (rank == 2) then diff --git a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 index 936d250e5c9b..c8af31d007f8 100644 --- a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 +++ b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 @@ -72,7 +72,7 @@ subroutine fillin_primary(this,item_name,base_name,primary_item,time,clock,unusa type(ExtDataSimpleFileHandler) :: simple_handler type(ExtDataClimFileHandler) :: clim_handler integer :: status, semi_pos - logical :: disable_interpolation + logical :: disable_interpolation, get_range _UNUSED_DUMMY(unusable) rule => this%rule_map%at(trim(item_name)) @@ -119,7 +119,7 @@ subroutine fillin_primary(this,item_name,base_name,primary_item,time,clock,unusa read(rule%regrid_method(semi_pos+1:),*) primary_item%fracVal primary_item%trans = REGRID_METHOD_FRACTION else - _ASSERT(.false.,"Invalid regridding method") + _FAIL("Invalid regridding method") end if if (trim(time_sample%extrap_outside) =="clim") then @@ -148,7 +148,8 @@ subroutine fillin_primary(this,item_name,base_name,primary_item,time,clock,unusa if (index(rule%collection,"/dev/null")==0) then dataset => this%file_stream_map%at(trim(rule%collection)) primary_item%file_template = dataset%file_template - call dataset%detect_metadata(primary_item%file_metadata,time,get_range=(trim(time_sample%extrap_outside) /= "none"),__RC__) + get_range = trim(time_sample%extrap_outside) /= "none" + call dataset%detect_metadata(primary_item%file_metadata,time,rule%multi_rule,get_range=get_range,__RC__) else primary_item%file_template = rule%collection end if diff --git a/gridcomps/ExtData2G/ExtDataRule.F90 b/gridcomps/ExtData2G/ExtDataRule.F90 index 2ba98c7d64b7..fdd0ad1a04e4 100644 --- a/gridcomps/ExtData2G/ExtDataRule.F90 +++ b/gridcomps/ExtData2G/ExtDataRule.F90 @@ -20,6 +20,7 @@ module MAPL_ExtDataRule character(:), allocatable :: vector_partner character(:), allocatable :: vector_component character(:), allocatable :: vector_file_partner + logical :: multi_rule contains procedure :: set_defaults procedure :: split_vector @@ -31,11 +32,12 @@ module MAPL_ExtDataRule contains - function new_ExtDataRule(config,sample_map,key,unusable,rc) result(rule) + function new_ExtDataRule(config,sample_map,key,unusable,multi_rule,rc) result(rule) type(Configuration), intent(in) :: config character(len=*), intent(in) :: key type(ExtDataTimeSampleMap) :: sample_map class(KeywordEnforcer), optional, intent(in) :: unusable + logical, optional, intent(in) :: multi_rule integer, optional, intent(out) :: rc type(ExtDataRule) :: rule @@ -44,8 +46,15 @@ function new_ExtDataRule(config,sample_map,key,unusable,rc) result(rule) type(Configuration) ::config1 character(len=:), allocatable :: tempc type(ExtDataTimeSample) :: ts + logical :: usable_multi_rule _UNUSED_DUMMY(unusable) + if (present(multi_rule)) then + usable_multi_rule = multi_rule + else + usable_multi_rule = .false. + end if + if (allocated(tempc)) deallocate(tempc) is_present = config%has("collection") _ASSERT(is_present,"no collection present in ExtData export") @@ -60,7 +69,7 @@ function new_ExtDataRule(config,sample_map,key,unusable,rc) result(rule) tempc = config%of("variable") rule%file_var=tempc else - _ASSERT(.false.,"no variable name in rule") + _FAIL("no variable name in rule") end if if (config%has("sample")) then @@ -72,7 +81,7 @@ function new_ExtDataRule(config,sample_map,key,unusable,rc) result(rule) else if (config1%is_string()) then rule%sample_key=config1 else - _ASSERT(.false.,"sample entry unsupported") + _FAIL("sample entry unsupported") end if else rule%sample_key = "" @@ -97,6 +106,8 @@ function new_ExtDataRule(config,sample_map,key,unusable,rc) result(rule) tempc = config%of("starting") rule%start_time = tempc end if + + rule%multi_rule=usable_multi_rule _RETURN(_SUCCESS) end function new_ExtDataRule diff --git a/gridcomps/ExtData2G/ExtDataSimpleFileHandler.F90 b/gridcomps/ExtData2G/ExtDataSimpleFileHandler.F90 index 7395aec3fb49..6a1da3d14e8c 100644 --- a/gridcomps/ExtData2G/ExtDataSimpleFileHandler.F90 +++ b/gridcomps/ExtData2G/ExtDataSimpleFileHandler.F90 @@ -66,7 +66,6 @@ subroutine get_file_bracket(this, input_time, source_time, bracket, rc) if (bracket%time_in_bracket(target_time) .and. in_range) then _RETURN(_SUCCESS) end if - call ESMF_TimeIntervalSet(zero,__RC__) if (this%frequency == zero) then current_file = this%file_template @@ -141,7 +140,7 @@ subroutine get_file(this,filename,input_time,shift,rc) ! time is not representable as absolute time interval (month, year etc...) do this ! brute force way. Not good but ESMF leaves no choice ftime=this%reff_time - do while (ftime < input_time) + do while (ftime <= input_time) ftime = ftime + this%frequency enddo ftime=ftime -this%frequency + shift*this%frequency From 8a7c092d6fbc9a7292b005b61d6d9cda7800408f Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 15 Apr 2022 16:03:33 -0400 Subject: [PATCH 100/300] forgot to commit this last file --- base/MAPL_NewArthParser.F90 | 48 ++++++++++++++++++------------------- 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/base/MAPL_NewArthParser.F90 b/base/MAPL_NewArthParser.F90 index 638dc0fb356a..d714397803f5 100755 --- a/base/MAPL_NewArthParser.F90 +++ b/base/MAPL_NewArthParser.F90 @@ -184,7 +184,7 @@ subroutine MAPL_StateEval(state,expression,field,rc) isConformal = CheckIfConformal(field,state_field,rc=status) _VERIFY(STATUS) if (.not.isConformal) then - _ASSERT(.FALSE.,'needs informative message') + _FAIL('needs informative message') end if end if end do @@ -779,22 +779,22 @@ function parser_variables_in_expression (FuncStr,rc) result(variables_in_express IF (c == '-' .OR. c == '+') THEN ! Check for leading - or + j = j+1 IF (j > lFunc) THEN - _ASSERT(.FALSE.,'Missing operand in '//trim(funcstr)) + _FAIL('Missing operand in '//trim(funcstr)) END IF c = Func(j:j) IF (ANY(c == Ops)) THEN - _ASSERT(.FALSE.,'Multiple operators in '//trim(funcstr)) + _FAIL('Multiple operators in '//trim(funcstr)) END IF END IF n = MathFunctionIndex (Func(j:)) IF (n > 0) THEN ! Check for math function j = j+LEN_TRIM(Funcs(n)) IF (j > lFunc) THEN - _ASSERT(.FALSE.,'Missing function argument in '//trim(funcstr)) + _FAIL('Missing function argument in '//trim(funcstr)) END IF c = Func(j:j) IF (c /= '(') THEN - _ASSERT(.FALSE.,'Missing opening parenthesis in '//trim(funcstr)) + _FAIL('Missing opening parenthesis in '//trim(funcstr)) END IF END IF IF (c == '(') THEN ! Check for opening parenthesis @@ -805,7 +805,7 @@ function parser_variables_in_expression (FuncStr,rc) result(variables_in_express IF (SCAN(c,'0123456789.') > 0) THEN ! Check for number r = RealNum (Func(j:),ib,in,err) IF (err) THEN - _ASSERT(.FALSE.,'Invalid number format: '//Func(j+ib-1:j+in-2)) + _FAIL('Invalid number format: '//Func(j+ib-1:j+in-2)) END IF j = j+in-1 IF (j > lFunc) EXIT @@ -827,10 +827,10 @@ function parser_variables_in_expression (FuncStr,rc) result(variables_in_express DO WHILE (c == ')') ! Check for closing parenthesis ParCnt = ParCnt-1 IF (ParCnt < 0) THEN - _ASSERT(.FALSE.,'Mismatched parenthesis in '//trim(funcstr)) + _FAIL('Mismatched parenthesis in '//trim(funcstr)) END IF IF (Func(j-1:j-1) == '(') THEN - _ASSERT(.FALSE.,'Empty parentheses in '//trim(funcstr)) + _FAIL('Empty parentheses in '//trim(funcstr)) END IF j = j+1 IF (j > lFunc) EXIT @@ -842,13 +842,13 @@ function parser_variables_in_expression (FuncStr,rc) result(variables_in_express IF (j > lFunc) EXIT IF (ANY(c == Ops)) THEN ! Check for multiple operators IF (j+1 > lFunc) THEN - _ASSERT(.FALSE.,'needs informative message') + _FAIL('needs informative message') END IF IF (ANY(Func(j+1:j+1) == Ops)) THEN - _ASSERT(.FALSE.,'Multiple operators in '//trim(funcstr)) + _FAIL('Multiple operators in '//trim(funcstr)) END IF ELSE ! Check for next operand - _ASSERT(.FALSE.,'Missing operator in '//trim(funcstr)) + _FAIL('Missing operator in '//trim(funcstr)) END IF !-- -------- --------- --------- --------- --------- --------- --------- ------- ! Now, we have an operand and an operator: the next loop will check for another @@ -857,7 +857,7 @@ function parser_variables_in_expression (FuncStr,rc) result(variables_in_express j = j+1 END DO step IF (ParCnt > 0) THEN - _ASSERT(.FALSE.,'Missing ) '//trim(funcstr)) + _FAIL('Missing ) '//trim(funcstr)) END IF DEALLOCATE(ipos) _RETURN(ESMF_SUCCESS) @@ -901,22 +901,22 @@ SUBROUTINE CheckSyntax (FuncStr,Var,needed,ExtVar,rc) IF (c == '-' .OR. c == '+') THEN ! Check for leading - or + j = j+1 IF (j > lFunc) THEN - _ASSERT(.FALSE.,'Missing operand in '//trim(funcstr)) + _FAIL('Missing operand in '//trim(funcstr)) END IF c = Func(j:j) IF (ANY(c == Ops)) THEN - _ASSERT(.FALSE.,'Multiple operators in '//trim(funcstr)) + _FAIL('Multiple operators in '//trim(funcstr)) END IF END IF n = MathFunctionIndex (Func(j:)) IF (n > 0) THEN ! Check for math function j = j+LEN_TRIM(Funcs(n)) IF (j > lFunc) THEN - _ASSERT(.FALSE.,'Missing function argument in '//trim(funcStr)) + _FAIL('Missing function argument in '//trim(funcStr)) END IF c = Func(j:j) IF (c /= '(') THEN - _ASSERT(.FALSE.,'Missing opening parenthesis in '//trim(funcstr)) + _FAIL('Missing opening parenthesis in '//trim(funcstr)) END IF END IF IF (c == '(') THEN ! Check for opening parenthesis @@ -927,7 +927,7 @@ SUBROUTINE CheckSyntax (FuncStr,Var,needed,ExtVar,rc) IF (SCAN(c,'0123456789.') > 0) THEN ! Check for number r = RealNum (Func(j:),ib,in,err) IF (err) THEN - _ASSERT(.FALSE.,'Invalid number format: '//Func(j+ib-1:j+in-2)) + _FAIL('Invalid number format: '//Func(j+ib-1:j+in-2)) END IF j = j+in-1 IF (j > lFunc) EXIT @@ -945,7 +945,7 @@ SUBROUTINE CheckSyntax (FuncStr,Var,needed,ExtVar,rc) IF (present(ExtVar)) then ExtVar = trim(ExtVar)//Func(j+ib-1:j+in-2)//"," ELSE - _ASSERT(.FALSE.,'Invalid element: '//Func(j+ib-1:j+in-2)) + _FAIL('Invalid element: '//Func(j+ib-1:j+in-2)) ENDIF END IF j = j+in-1 @@ -956,10 +956,10 @@ SUBROUTINE CheckSyntax (FuncStr,Var,needed,ExtVar,rc) DO WHILE (c == ')') ! Check for closing parenthesis ParCnt = ParCnt-1 IF (ParCnt < 0) THEN - _ASSERT(.FALSE.,'Mismatched parenthesis in '//trim(funcStr)) + _FAIL('Mismatched parenthesis in '//trim(funcStr)) END IF IF (Func(j-1:j-1) == '(') THEN - _ASSERT(.FALSE.,'Empty paraentheses '//trim(funcstr)) + _FAIL('Empty paraentheses '//trim(funcstr)) END IF j = j+1 IF (j > lFunc) EXIT @@ -971,13 +971,13 @@ SUBROUTINE CheckSyntax (FuncStr,Var,needed,ExtVar,rc) IF (j > lFunc) EXIT IF (ANY(c == Ops)) THEN ! Check for multiple operators IF (j+1 > lFunc) THEN - _ASSERT(.FALSE.,'needs informative message') + _FAIL('needs informative message') END IF IF (ANY(Func(j+1:j+1) == Ops)) THEN - _ASSERT(.FALSE.,'Multiple operatos in '//trim(Funcstr)) + _FAIL('Multiple operatos in '//trim(Funcstr)) END IF ELSE ! Check for next operand - _ASSERT(.FALSE.,'Missing operator in '//trim(funcstr)) + _FAIL('Missing operator in '//trim(funcstr)) END IF !-- -------- --------- --------- --------- --------- --------- --------- ------- ! Now, we have an operand and an operator: the next loop will check for another @@ -986,7 +986,7 @@ SUBROUTINE CheckSyntax (FuncStr,Var,needed,ExtVar,rc) j = j+1 END DO step IF (ParCnt > 0) THEN - _ASSERT(.FALSE.,'Missing ) in '//trim(funcstr)) + _FAIL('Missing ) in '//trim(funcstr)) END IF DEALLOCATE(ipos) _RETURN(ESMF_SUCCESS) From 76a670ff3551d719040fe9ce03d8bb8811ddeef5 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 18 Apr 2022 08:51:32 -0400 Subject: [PATCH 101/300] remove on redudant get_file_extension --- shared/DSO_Utilities.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/shared/DSO_Utilities.F90 b/shared/DSO_Utilities.F90 index 7f720edaf7cf..0eefd9e27455 100644 --- a/shared/DSO_Utilities.F90 +++ b/shared/DSO_Utilities.F90 @@ -31,7 +31,7 @@ end function is_valid_dso_extension ! puts a Linux DSO in a resource file. pure logical function is_supported_dso_name(name) character(len=*), intent(in) :: name - is_supported_dso_name = is_supported_dso_extension(get_file_extension(get_file_extension(name))) + is_supported_dso_name = is_supported_dso_extension(get_file_extension(name)) end function is_supported_dso_name ! We allow users to specify a DSO extensions that is only valid on From 0decd3e92be57d7290413f254f4bb5c82bb92a8e Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 18 Apr 2022 09:02:26 -0400 Subject: [PATCH 102/300] change log --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6ceab32c02da..05273d495746 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Removed one redundant get_file_extension call - Fixed issue in `CMakePresets.json` where Ninja presets were broken ### Added From ac13f108f120b3d12214a7748a0e7ba1d03454a1 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 18 Apr 2022 15:02:26 -0400 Subject: [PATCH 103/300] Prepare for 2.20.0 Release --- CHANGELOG.md | 17 +++++++++++++---- CMakeLists.txt | 2 +- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index efe1816d93e4..d67bca018f2b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,12 +9,25 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +### Added + +### Changed + +### Removed + +### Deprecated + +## [2.20.0] - 2022-04-19 + +### Fixed + - Removed one redundant get_file_extension call - Fix issue where ACG was called when no file had changed - Add missing `rc=status` in `MAPL_GetResourceFromMAPL_scalar` - Fixed bugs with next generation ExtData ### Added + - Added support for 4d variables in the coupler. Intentionally decided not to support 4d in the coupler's ReadRestart and WriteRestart to catch errors - Added ability to use multiple rules for different time periods in next generation ExtData @@ -26,10 +39,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - ESMA_env v3.13.0 - ESMA_cmake v3.12.0 -### Removed - -### Deprecated - ## [2.19.2] - 2022-03-28 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index 41cfb766652b..49a65d81e0ec 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.19.2 + VERSION 2.20.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the default build type to release From ea3096914e344a0420992bf72e1587eac6b7b20b Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 18 Apr 2022 15:41:31 -0400 Subject: [PATCH 104/300] Restore commented out debugger --- gridcomps/ExtData/ExtDataGridCompMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/gridcomps/ExtData/ExtDataGridCompMod.F90 b/gridcomps/ExtData/ExtDataGridCompMod.F90 index c523f9e4ea75..15c27fb5c7ea 100644 --- a/gridcomps/ExtData/ExtDataGridCompMod.F90 +++ b/gridcomps/ExtData/ExtDataGridCompMod.F90 @@ -1302,10 +1302,10 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) item => self%primary%item(self%primaryOrder(i)) - !call lgr%debug('ExtData Run_(): READ_LOOP: variable %i0 of %i0~: %a', i, self%primary%nItems, trim(item%var)) - !call lgr%debug(' ==> file: %a', trim(item%file)) - !call lgr%debug(' ==> cyclic: %a', trim(item%cyclic)) - !call lgr%debug(' ==> isConst:: %l1', item%isConst) + call lgr%debug('ExtData Run_(): READ_LOOP: variable %i0 of %i0~: %a', i, self%primary%nItems, trim(item%var)) + call lgr%debug(' ==> file: %a', trim(item%file)) + call lgr%debug(' ==> cyclic: %a', trim(item%cyclic)) + call lgr%debug(' ==> isConst:: %l1', item%isConst) if (item%isConst) then call lgr%debug(' ==> Break loop since isConst is true') From 141daecf41711276875bac0b213bec298b49cbc1 Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Mon, 18 Apr 2022 16:04:02 -0400 Subject: [PATCH 105/300] Fixes #1483. Fixed the rank of variable declaration --- CHANGELOG.md | 1 + generic/GenericCplComp.F90 | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index efe1816d93e4..23b845da5600 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Fix issue where ACG was called when no file had changed - Add missing `rc=status` in `MAPL_GetResourceFromMAPL_scalar` - Fixed bugs with next generation ExtData +- Fixed variable PTR40 declaration in GenericCplComp.F90 ### Added - Added support for 4d variables in the coupler. Intentionally decided not to support 4d in the coupler's ReadRestart and WriteRestart to catch errors diff --git a/generic/GenericCplComp.F90 b/generic/GenericCplComp.F90 index e8d740541ecf..80bc16d4bfb6 100644 --- a/generic/GenericCplComp.F90 +++ b/generic/GenericCplComp.F90 @@ -924,7 +924,7 @@ subroutine ZERO_CLEAR_COUNT(STATE, RC) real, pointer :: PTR10(:) real, pointer :: PTR20(:,:) real, pointer :: PTR30(:,:,:) - real, pointer :: PTR40(:,:,:) + real, pointer :: PTR40(:,:,:,:) character(*), parameter :: IAm="ZERO_CLEAR_COUNT" integer :: STATUS From 8096d53e871cb37d4b3721e405241b9544d7785e Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 29 Apr 2022 09:20:45 -0400 Subject: [PATCH 106/300] fixes #1490 --- CHANGELOG.md | 4 ++++ generic/MAPL_Generic.F90 | 27 +++++++++++++++++++++++---- generic/VarSpec.F90 | 13 +++++++++++-- 3 files changed, 38 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ce5dc1c1975c..9f61fd092319 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,8 +9,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Fixed incorrect legend when using PRINTSPEC option in MAPL Cap + ### Added +- Added information about the container type for each item in state when using PRINTSPEC option + ### Changed ### Removed diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 5948efd4a79d..78bbca59b2d6 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -4439,6 +4439,7 @@ recursive subroutine MAPL_StatePrintSpecCSV(GC, printSpec, RC) type (MAPL_VarSpec), pointer :: IMPORT_SPEC(:) type (MAPL_VarSpec), pointer :: EXPORT_SPEC(:) + type (MAPL_VarSpec), pointer :: INTERNAL_SPEC(:) integer :: I type(ESMF_GridComp), pointer :: gridcomp @@ -4459,11 +4460,12 @@ recursive subroutine MAPL_StatePrintSpecCSV(GC, printSpec, RC) IMPORT_SPEC => MAPLOBJ%COMPONENT_SPEC%IMPORT%OLD_VAR_SPECS EXPORT_SPEC => MAPLOBJ%COMPONENT_SPEC%EXPORT%OLD_VAR_SPECS + INTERNAL_SPEC => MAPLOBJ%COMPONENT_SPEC%INTERNAL%OLD_VAR_SPECS if (printSpec == 1) then if (associated(IMPORT_SPEC)) then call WRITE_PARALLEL("#IMPORT spec for " // trim(comp_name)) - call WRITE_PARALLEL("#COMPONENT, SHORT_NAME, LONG_NAME, UNIT, DIMS") + call WRITE_PARALLEL("#COMPONENT, SHORT_NAME, LONG_NAME, UNIT, DIMS, CONTAINER_TYPE") if (associated(IMPORT_SPEC)) then call MAPL_VarSpecPrintCSV(IMPORT_SPEC, comp_name, RC=status) _VERIFY(status) @@ -4471,16 +4473,24 @@ recursive subroutine MAPL_StatePrintSpecCSV(GC, printSpec, RC) end if if (associated(EXPORT_SPEC)) then call WRITE_PARALLEL("#EXPORT spec for " // trim(comp_name)) - call WRITE_PARALLEL("#COMPONENT, SHORT_NAME, LONG_NAME, UNIT, DIMS") + call WRITE_PARALLEL("#COMPONENT, SHORT_NAME, LONG_NAME, UNIT, DIMS, CONTAINER_TYPE") if (associated(EXPORT_SPEC)) then call MAPL_VarSpecPrintCSV(EXPORT_SPEC, comp_name, RC=status) _VERIFY(status) end if end if + if (associated(INTERNAL_SPEC)) then + call WRITE_PARALLEL("#INTERNAL spec for " // trim(comp_name)) + call WRITE_PARALLEL("#COMPONENT, SHORT_NAME, LONG_NAME, UNIT, DIMS, CONTAINER_TYPE") + if (associated(INTERNAL_SPEC)) then + call MAPL_VarSpecPrintCSV(INTERNAL_SPEC, comp_name, RC=status) + _VERIFY(status) + end if + end if else if (printSpec == 2) then if (associated(IMPORT_SPEC)) then call WRITE_PARALLEL("#IMPORT spec for " // trim(comp_name)) - call WRITE_PARALLEL("#COMPONENT, SHORT_NAME, LONG_NAME, UNIT, DIMS") + call WRITE_PARALLEL("#COMPONENT, SHORT_NAME, LONG_NAME, UNIT, DIMS, CONTAINER_TYPE") if (associated(IMPORT_SPEC)) then call MAPL_VarSpecPrintCSV(IMPORT_SPEC, comp_name, RC=status) _VERIFY(status) @@ -4489,12 +4499,21 @@ recursive subroutine MAPL_StatePrintSpecCSV(GC, printSpec, RC) else if (printSpec == 3) then if (associated(EXPORT_SPEC)) then call WRITE_PARALLEL("#EXPORT spec for " // trim(comp_name)) - call WRITE_PARALLEL("#COMPONENT, SHORT_NAME, LONG_NAME, UNIT, DIMS") + call WRITE_PARALLEL("#COMPONENT, SHORT_NAME, LONG_NAME, UNIT, DIMS, CONTAINER_TYPE") if (associated(EXPORT_SPEC)) then call MAPL_VarSpecPrintCSV(EXPORT_SPEC, comp_name, RC=status) _VERIFY(status) end if end if + else if (printSpec == 4) then + if (associated(INTERNAL_SPEC)) then + call WRITE_PARALLEL("#INTERNAL spec for " // trim(comp_name)) + call WRITE_PARALLEL("#COMPONENT, SHORT_NAME, LONG_NAME, UNIT, DIMS, CONTAINER_TYPE") + if (associated(INTERNAL_SPEC)) then + call MAPL_VarSpecPrintCSV(INTERNAL_SPEC, comp_name, RC=status) + _VERIFY(status) + end if + end if end if do I = 1, MAPLOBJ%get_num_children() diff --git a/generic/VarSpec.F90 b/generic/VarSpec.F90 index 080cce7fff9f..71a7d5e1666b 100644 --- a/generic/VarSpec.F90 +++ b/generic/VarSpec.F90 @@ -1450,15 +1450,24 @@ subroutine MAPL_VarSpecPrint1CSV(spec, compName, rc ) integer , optional , intent(out) :: RC class(Logger), pointer :: lgr + character(len=:), allocatable :: item_type if(.not.associated(SPEC%SPECPtr)) then _RETURN(ESMF_FAILURE) endif + if (iand(spec%specptr%stat,MAPL_BundleItem) /= 0) then + item_type = "esmf_bundle" + else if (iand(spec%specptr%stat,MAPL_StateItem) /=0) then + item_type = "esmf_state" + else + item_type = "esmf_field" + end if + lgr => logging%get_logger('MAPL.GENERIC') - call lgr%info('%a~, %a~, %a~, %i3', & + call lgr%info('%a~, %a~, %a~, %a~, %i3~, %a~ ', & trim(compName), trim(spec%specptr%short_name), trim(spec%specptr%long_name), & - spec%specptr%dims) + trim(spec%specptr%units),spec%specptr%dims,item_type) _RETURN(ESMF_SUCCESS) end subroutine MAPL_VarSpecPrint1CSV From b01ce3c867af0aad5bb928089fcf95bdb380a7e7 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 2 May 2022 10:56:19 -0400 Subject: [PATCH 107/300] Convert many _ASSERT(.false.) to _FAIL() --- CHANGELOG.md | 2 + Tests/ExtDataDriverGridComp.F90 | 4 +- Tests/ExtDataRoot_GridComp.F90 | 2 +- base/Base/Base_Base_implementation.F90 | 30 +- base/BinIO.F90 | 4 +- base/ESMFL_Mod.F90 | 4 +- base/FileIOShared.F90 | 6 +- base/FileMetadataUtilities.F90 | 22 +- base/MAPL_AbstractRegridder.F90 | 56 ++-- base/MAPL_CFIO.F90 | 20 +- base/MAPL_Comms.F90 | 2 +- base/MAPL_CubedSphereGridFactory.F90 | 8 +- base/MAPL_LocStreamMod.F90 | 8 +- base/MAPL_TimeMethods.F90 | 6 +- base/MAPL_VerticalMethods.F90 | 2 +- base/MAPL_sun_uc.F90 | 46 +-- base/NCIO.F90 | 58 ++-- base/StringTemplate.F90 | 4 +- base/read_parallel.H | 2 +- base/sun.H | 4 +- base/tests/mapl_bundleio_test.F90 | 2 +- base/write_parallel.H | 2 +- generic/GenericCplComp.F90 | 8 +- generic/MAPL_Generic.F90 | 22 +- gridcomps/ExtData/ExtDataGridCompMod.F90 | 316 +++++++++--------- gridcomps/History/MAPL_HistoryGridComp.F90 | 12 +- .../History/MAPL_HistoryTrajectoryMod.F90 | 2 +- griddedio/GriddedIO.F90 | 8 +- griddedio/Regrid_Util.F90 | 2 +- include/MAPL_ErrLog.h | 2 +- pfio/AbstractDataReference.F90 | 16 +- pfio/AbstractServer.F90 | 6 +- pfio/ArrayReference.F90 | 14 +- pfio/BaseServer.F90 | 4 +- pfio/ClientThread.F90 | 6 +- pfio/CoordinateVariable.F90 | 12 +- pfio/FileMetadata.F90 | 2 +- pfio/LocalMemReference.F90 | 12 +- pfio/MessageVisitor.F90 | 32 +- pfio/MultiCommServer.F90 | 4 +- pfio/MultiGroupServer.F90 | 6 +- pfio/MultiLayerServer.F90 | 2 +- pfio/NetCDF4_FileFormatter.F90 | 2 +- pfio/ServerThread.F90 | 32 +- pfio/SimpleSocket.F90 | 2 +- pfio/UnlimitedEntity.F90 | 18 +- pfio/pFIO_Utilities.F90 | 2 +- pfio/pfio_writer.F90 | 4 +- shared/MAPL_HeapMod.F90 | 8 +- shared/Shmem/Shmem_implementation.F90 | 2 +- 50 files changed, 427 insertions(+), 425 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9f61fd092319..d626aab3478b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Change many instances of `_ASSERT(.false.,"msg")` to `_FAIL("msg")` + ### Removed ### Deprecated diff --git a/Tests/ExtDataDriverGridComp.F90 b/Tests/ExtDataDriverGridComp.F90 index fa52b57b8d52..bb2c3be3be05 100644 --- a/Tests/ExtDataDriverGridComp.F90 +++ b/Tests/ExtDataDriverGridComp.F90 @@ -414,7 +414,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call cap%parseTimes(rc=status) _VERIFY(status) if (allocated(cap%times) .and. cap%run_fbf ) then - _ASSERT(.false.,"can not run forwards and backwards with specific times") + _FAIL("can not run forwards and backwards with specific times") end if _RETURN(ESMF_SUCCESS) @@ -743,7 +743,7 @@ subroutine MAPL_ClockInit ( cf, Clock, nsteps, rc) call ESMF_CalendarSetDefault(ESMF_CALKIND_NOLEAP, RC=STATUS) _VERIFY(STATUS) else - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') endif call ESMF_ConfigGetAttribute(cf, datetime, label='BEG_DATE:',rc=status) diff --git a/Tests/ExtDataRoot_GridComp.F90 b/Tests/ExtDataRoot_GridComp.F90 index 9f17a4c920da..194e43f7e491 100644 --- a/Tests/ExtDataRoot_GridComp.F90 +++ b/Tests/ExtDataRoot_GridComp.F90 @@ -677,7 +677,7 @@ subroutine CompareState(State1,State2,tol,rc) enddo end if if (foundDiff(ii)) then - _ASSERT(.false.,'found difference when compare state') + _FAIL('found difference when compare state') end if enddo diff --git a/base/Base/Base_Base_implementation.F90 b/base/Base/Base_Base_implementation.F90 index e886bf5dae45..6664fed2d6f7 100644 --- a/base/Base/Base_Base_implementation.F90 +++ b/base/Base/Base_Base_implementation.F90 @@ -183,7 +183,7 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & gridToFieldMap=gridToFieldMap, & rc = status) case default - _ASSERT(.false., 'unsupported rank > 1') + _FAIL( 'unsupported rank > 1') end select else @@ -197,7 +197,7 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & gridToFieldMap=gridToFieldMap, & rc = status) case default - _ASSERT(.false., 'unsupported rank > 1') + _FAIL( 'unsupported rank > 1') end select endif @@ -290,7 +290,7 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & totalUWidth=haloWidth(1:griddedDims), & rc = status) case default - _ASSERT(.false., 'only up to 4D are supported') + _FAIL( 'only up to 4D are supported') end select RankCase2d else select case (rank) @@ -325,7 +325,7 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & totalUWidth=haloWidth(1:griddedDims), & rc = status) case default - _ASSERT(.false., 'only up to 4D are supported') + _FAIL( 'only up to 4D are supported') end select end if _VERIFY(STATUS) @@ -444,7 +444,7 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & datacopyFlag = ESMF_DATACOPY_REFERENCE, & rc = status) case default - _ASSERT(.false., 'only 2D and 3D are supported') + _FAIL( 'only 2D and 3D are supported') end select else @@ -474,7 +474,7 @@ module subroutine MAPL_FieldAllocCommit(field, dims, location, typekind, & datacopyFlag = ESMF_DATACOPY_REFERENCE, & rc = status) case default - _ASSERT(.false., 'only 2D and 3D are supported') + _FAIL( 'only 2D and 3D are supported') end select endif @@ -1385,7 +1385,7 @@ module function MAPL_FieldCreateRename(FIELD, NAME, DoCopy, RC) RESULT(F) rc = status) _VERIFY(STATUS) case default - _ASSERT(.false., 'only upto 4D are supported') + _FAIL( 'only upto 4D are supported') end select else if (tk == ESMF_TypeKind_R8) then select case (fieldRank) @@ -1422,10 +1422,10 @@ module function MAPL_FieldCreateRename(FIELD, NAME, DoCopy, RC) RESULT(F) rc = status) _VERIFY(STATUS) case default - _ASSERT(.false., 'only 2D and 3D are supported') + _FAIL( 'only 2D and 3D are supported') end select else - _ASSERT(.false., 'unsupported typekind') + _FAIL( 'unsupported typekind') endif deallocate(gridToFieldMap) @@ -1560,7 +1560,7 @@ module function MAPL_FieldCreateNewgrid(FIELD, GRID, LM, NEWNAME, RC) RESULT(F) DIMS = MAPL_DimsHorzVert end if else - _ASSERT(.false., 'rank > 4 not supported') + _FAIL( 'rank > 4 not supported') end if deallocate(gridToFieldMap) @@ -1660,7 +1660,7 @@ module function MAPL_FieldCreateR4(FIELD, RC) RESULT(F) rc = status) _VERIFY(STATUS) case default - _ASSERT(.false., 'only 2D and 3D are supported') + _FAIL( 'only 2D and 3D are supported') end select deallocate(gridToFieldMap) @@ -1762,7 +1762,7 @@ module subroutine MAPL_FieldCopy(from, to, RC) _VERIFY(STATUS) var_3d = vr8_3d case default - _ASSERT(.false., 'unsupported fieldRank (> 3)') + _FAIL( 'unsupported fieldRank (> 3)') end select _RETURN(ESMF_SUCCESS) @@ -2701,7 +2701,7 @@ module subroutine MAPL_FieldDestroy(Field,RC) deallocate(VR8_3d,stat=status) _VERIFY(STATUS) else - _ASSERT(.false., 'unsupported typekind+rank') + _FAIL( 'unsupported typekind+rank') end if call ESMF_FieldDestroy(Field,rc=status) _VERIFY(STATUS) @@ -3088,7 +3088,7 @@ module subroutine MAPL_GetHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, rc) staggerloc=ESMF_STAGGERLOC_CENTER, fArrayPtr = lats, rc=status) _VERIFY(STATUS) else - _ASSERT(.false.,'if not isCubed, localSearch must be .true.') + _FAIL('if not isCubed, localSearch must be .true.') end if allocate(lons_1d(im),stat=status) _VERIFY(STATUS) @@ -3645,7 +3645,7 @@ module subroutine MAPL_FieldSplit(field, fields, aliasName, rc) end do end if else if (tk == ESMF_TYPEKIND_R8) then - _ASSERT(.false., "R8 overload not implemented yet") + _FAIL( "R8 overload not implemented yet") end if deallocate(gridToFieldMap) diff --git a/base/BinIO.F90 b/base/BinIO.F90 index 2f2dd9735abb..5b3aaf769914 100644 --- a/base/BinIO.F90 +++ b/base/BinIO.F90 @@ -453,7 +453,7 @@ subroutine MAPL_StateVarRead(UNIT, STATE, NAME, arrdes, bootstrapable, RC) _VERIFY(STATUS) !ALT else -!ALT _ASSERT(.false.,'failed mapl_statevarread') +!ALT _FAIL('failed mapl_statevarread') end if @@ -739,7 +739,7 @@ subroutine MAPL_FieldRead(UNIT,FIELD, ARRDES, HomePE, ignoreEOF, RC) call MAPL_VarRead(unit, grid, vr8_4d, rc=status) end if else - _ASSERT(.false., "ERROR: unsupported RANK") + _FAIL( "ERROR: unsupported RANK") endif _VERIFY(STATUS) diff --git a/base/ESMFL_Mod.F90 b/base/ESMFL_Mod.F90 index e3b7de1e38bd..4d0ef998ccec 100644 --- a/base/ESMFL_Mod.F90 +++ b/base/ESMFL_Mod.F90 @@ -3735,7 +3735,7 @@ subroutine Bundle2State (BUN, STA, rc) _VERIFY(STATUS) dst_pr83d = src_pr83d case default - _ASSERT(.false., 'unsupported rank (>= 4)') + _FAIL( 'unsupported rank (>= 4)') end select end if end if @@ -3936,7 +3936,7 @@ SUBROUTINE ESMFL_HALO_R4_2D(GRID, INPUT, RC) if (.not.found) then print *, "Error: need bigger MAX_HALOTYPES value" - _ASSERT(.false., 'no unused slot for halo types') + _FAIL( 'no unused slot for halo types') end if call ESMF_GridGet(GRID, distGrid=distGrid, dimCount=dimCount, RC=STATUS) diff --git a/base/FileIOShared.F90 b/base/FileIOShared.F90 index 4a7adcad26e8..5e6211798dc4 100644 --- a/base/FileIOShared.F90 +++ b/base/FileIOShared.F90 @@ -208,7 +208,7 @@ subroutine alloc_(A,type,im,jm,rc) _ASSERT(present(jm), 'jm not present for 2d') allocate(A%I4_2(IM,JM)) case default - _ASSERT(.false., 'unsupported tkr') + _FAIL( 'unsupported tkr') end select a%allocated=type @@ -254,7 +254,7 @@ subroutine dealloc_(A,RC) nullify(A%i4_2) end if case default - _ASSERT(.false., 'unsupported tkr') + _FAIL( 'unsupported tkr') end select a%allocated=not_allocated end if @@ -367,7 +367,7 @@ subroutine MAPL_TileMaskGet(grid, mask, rc) enddo #ifdef NEW - _ASSERT(.false., 'unsupported code block') !ALT this section is questionable + _FAIL( 'unsupported code block') !ALT this section is questionable do I = 0,nDEs-1 de = I I1 = AL(1,I) diff --git a/base/FileMetadataUtilities.F90 b/base/FileMetadataUtilities.F90 index 64428d1a29ad..f6726730615a 100644 --- a/base/FileMetadataUtilities.F90 +++ b/base/FileMetadataUtilities.F90 @@ -126,7 +126,7 @@ function get_var_attr_real32(this,var_name,attr_name,rc) result(attr_real32) tmp = attr_val attr_real32 = tmp(1) class default - _ASSERT(.false.,'unsupport subclass for units') + _FAIL('unsupport subclass for units') end select _RETURN(_SUCCESS) @@ -155,7 +155,7 @@ function get_var_attr_real64(this,var_name,attr_name,rc) result(attr_real64) tmp = attr_val attr_real64 = tmp(1) class default - _ASSERT(.false.,'unsupport subclass for units') + _FAIL('unsupport subclass for units') end select _RETURN(_SUCCESS) @@ -184,7 +184,7 @@ function get_var_attr_int32(this,var_name,attr_name,rc) result(attr_int32) tmp = attr_val attr_int32 = tmp(1) class default - _ASSERT(.false.,'unsupport subclass for units') + _FAIL('unsupport subclass for units') end select _RETURN(_SUCCESS) @@ -213,7 +213,7 @@ function get_var_attr_int64(this,var_name,attr_name,rc) result(attr_int64) tmp = attr_val attr_int64 = tmp(1) class default - _ASSERT(.false.,'unsupport subclass for units') + _FAIL('unsupport subclass for units') end select _RETURN(_SUCCESS) @@ -240,7 +240,7 @@ function get_var_attr_string(this,var_name,attr_name,rc) result(attr_string) type is(character(*)) attr_string = attr_val class default - _ASSERT(.false.,'unsupport subclass for units') + _FAIL('unsupport subclass for units') end select _RETURN(_SUCCESS) @@ -356,7 +356,7 @@ subroutine get_time_info(this,startTime,startyear,startmonth,startday,starthour, endif endif class default - _ASSERT(.false.,"Time unit must be character") + _FAIL("Time unit must be character") end select call ESMF_TimeSet(unmodStartTime,yy=year,mm=month,dd=day,h=hour,m=min,s=sec,rc=status) _VERIFY(status) @@ -377,7 +377,7 @@ subroutine get_time_info(this,startTime,startyear,startmonth,startday,starthour, type is (integer(kind=INT32)) tr_r64=ptr class default - _ASSERT(.false.,"unsupported time variable type") + _FAIL("unsupported time variable type") end select do i=1,tsize select case (trim(tUnits)) @@ -398,7 +398,7 @@ subroutine get_time_info(this,startTime,startyear,startmonth,startday,starthour, _VERIFY(status) tvec(i)=unmodStartTime+tint case default - _ASSERT(.false.,"unsupported time unit") + _FAIL("unsupported time unit") end select enddo @@ -458,7 +458,7 @@ function get_variable_attribute(this,var_name,attr_name,rc) result(units) type is (character(*)) units => vunits class default - _ASSERT(.false.,'units must be string') + _FAIL('units must be string') end select else units => null() @@ -497,7 +497,7 @@ subroutine get_coordinate_info(this,coordinate_name,coordSize,coordUnits,coords, type is (character(*)) coordUnits = trim(coordUnitPtr) class default - _ASSERT(.false.,'units must be string') + _FAIL('units must be string') end select end if @@ -514,7 +514,7 @@ subroutine get_coordinate_info(this,coordinate_name,coordSize,coordUnits,coords, type is (integer(kind=INT32)) coords=ptr class default - _ASSERT(.false.,"unsupported coordel variable type") + _FAIL("unsupported coordel variable type") end select end if _RETURN(_SUCCESS) diff --git a/base/MAPL_AbstractRegridder.F90 b/base/MAPL_AbstractRegridder.F90 index 3b7a1c55acb2..30ffeb83017e 100644 --- a/base/MAPL_AbstractRegridder.F90 +++ b/base/MAPL_AbstractRegridder.F90 @@ -120,7 +120,7 @@ subroutine regrid_scalar_2d_real32(this, q_in, q_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'regrid_scalar_2d_real32' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(q_in) q_out = 0 @@ -136,7 +136,7 @@ subroutine regrid_scalar_2d_real64(this, q_in, q_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'regrid_scalar_2d_real64' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(q_in) q_out = 0 @@ -152,7 +152,7 @@ subroutine regrid_scalar_3d_real32(this, q_in, q_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'regrid_scalar_3d_real32' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(q_in) q_out = 0 @@ -168,7 +168,7 @@ subroutine regrid_scalar_3d_real64(this, q_in, q_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'regrid_scalar_3d_real64' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(q_in) q_out = 0 @@ -187,7 +187,7 @@ subroutine regrid_vector_2d_real32(this, u_in, v_in, u_out, v_out, rotate, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'regrid_vector_2d_real32' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) @@ -209,7 +209,7 @@ subroutine regrid_vector_2d_real64(this, u_in, v_in, u_out, v_out, rotate, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'regrid_vector_2d_real64' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) @@ -230,7 +230,7 @@ subroutine regrid_vector_3d_real32(this, u_in, v_in, u_out, v_out, rotate, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'regrid_vector_3d_real32' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) @@ -251,7 +251,7 @@ subroutine regrid_vector_3d_real64(this, u_in, v_in, u_out, v_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'regrid_vector_3d_real64' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) @@ -321,7 +321,7 @@ subroutine regrid_esmf_fields_scalar(this, f_in, f_out, rc) end block case default - _ASSERT(.false., 'unsupported typekind') + _FAIL( 'unsupported typekind') end select case (3) @@ -354,11 +354,11 @@ subroutine regrid_esmf_fields_scalar(this, f_in, f_out, rc) _VERIFY(status) end block case default ! unsupported type/kind - _ASSERT(.false., 'unsupported type kind') + _FAIL( 'unsupported type kind') end select case default ! unsupported rank - _ASSERT(.false., 'unsupported rank') + _FAIL( 'unsupported rank') end select _RETURN(_SUCCESS) @@ -445,7 +445,7 @@ subroutine regrid_esmf_fields_vector(this, f_in, f_out, rc) end block case default ! unsupported typekind - _ASSERT(.false., 'unsupported typekind') + _FAIL( 'unsupported typekind') end select case (3) @@ -487,11 +487,11 @@ subroutine regrid_esmf_fields_vector(this, f_in, f_out, rc) end block case default ! unsupported type/kind - _ASSERT(.false., 'unsupported type-kind') + _FAIL( 'unsupported type-kind') end select case default ! unsupported rank - _ASSERT(.false., 'unsupported rank') + _FAIL( 'unsupported rank') end select _RETURN(_SUCCESS) @@ -509,7 +509,7 @@ subroutine transpose_regrid_scalar_2d_real32(this, q_in, q_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_scalar_2d_real32' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(q_in) q_out = 0 @@ -524,7 +524,7 @@ subroutine transpose_regrid_scalar_2d_real64(this, q_in, q_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_scalar_2d_real64' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(q_in) q_out = 0 @@ -539,7 +539,7 @@ subroutine transpose_regrid_scalar_3d_real32(this, q_in, q_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_scalar_3d_real32' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(q_in) q_out = 0 @@ -555,7 +555,7 @@ subroutine transpose_regrid_scalar_3d_real64(this, q_in, q_out, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_scalar_3d_real64' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(q_in) q_out = 0 @@ -575,7 +575,7 @@ subroutine transpose_regrid_vector_2d_real32(this, u_in, v_in, u_out, v_out, rot character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_vector_2d_real32' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) @@ -600,7 +600,7 @@ subroutine transpose_regrid_vector_2d_real64(this, u_in, v_in, u_out, v_out, rot character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_vector_2d_real64' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) @@ -625,7 +625,7 @@ subroutine transpose_regrid_vector_3d_real32(this, u_in, v_in, u_out, v_out, rot character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_vector_3d_real32' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) @@ -649,7 +649,7 @@ subroutine transpose_regrid_vector_3d_real64(this, u_in, v_in, u_out, v_out, rc) character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_vector_3d_real64' - _ASSERT(.false., 'unimplemented - must override in subclass') + _FAIL( 'unimplemented - must override in subclass') _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) @@ -721,7 +721,7 @@ subroutine transpose_regrid_esmf_fields_scalar(this, f_in, f_out, rc) end block case default ! unsupported typekind - _ASSERT(.false., 'unsupported typekind') + _FAIL( 'unsupported typekind') end select case (3) @@ -754,11 +754,11 @@ subroutine transpose_regrid_esmf_fields_scalar(this, f_in, f_out, rc) _VERIFY(status) end block case default ! unsupported type/kind - _ASSERT(.false., 'unsupported typekind') + _FAIL( 'unsupported typekind') end select case default ! unsupported rank - _ASSERT(.false., 'unsupported rank') + _FAIL( 'unsupported rank') end select _RETURN(_SUCCESS) @@ -845,7 +845,7 @@ subroutine transpose_regrid_esmf_fields_vector(this, f_in, f_out, rc) end block case default ! unsupported typekind - _ASSERT(.false., 'unsupported typekind') + _FAIL( 'unsupported typekind') end select case (3) @@ -887,11 +887,11 @@ subroutine transpose_regrid_esmf_fields_vector(this, f_in, f_out, rc) end block case default ! unsupported type/kind - _ASSERT(.false., 'unsupported typekind') + _FAIL( 'unsupported typekind') end select case default ! unsupported rank - _ASSERT(.false., 'unsupported rank') + _FAIL( 'unsupported rank') end select _RETURN(_SUCCESS) diff --git a/base/MAPL_CFIO.F90 b/base/MAPL_CFIO.F90 index 0093464f5536..2032536719b1 100644 --- a/base/MAPL_CFIO.F90 +++ b/base/MAPL_CFIO.F90 @@ -475,7 +475,7 @@ subroutine MAPL_CFIOCreateFromBundle ( MCFIO, NAME, CLOCK, BUNDLE, OFFSET, print*,'WARNING: CFIO parameter "order" is no longer used.' print*,' The new regrid facility uses ESMF parameters to' print*,' specify the type of regridding to perform.' - _ASSERT(.false., 'Order must be present') + _FAIL( 'Order must be present') MCFIO%Order = Order else MCFIO%Order = -1 @@ -739,7 +739,7 @@ subroutine MAPL_CFIOCreateFromBundle ( MCFIO, NAME, CLOCK, BUNDLE, OFFSET, unGrdCoordCheck = .false. end if if ( unGrdUnitCheck .or. unGrdNameCheck .or. unGrdCoordCheck) then - _ASSERT(.false., 'Ungridded attributes for variables in collection do not match') + _FAIL( 'Ungridded attributes for variables in collection do not match') end if end if end do @@ -807,7 +807,7 @@ subroutine MAPL_CFIOCreateFromBundle ( MCFIO, NAME, CLOCK, BUNDLE, OFFSET, LM = size(ULEVELS) HAVE_edge = .false. if (HAVE_ungrd) then - _ASSERT(.false., 'ERROR: Specifying LEVELS is not allowed for UNGRIDDED vars') + _FAIL( 'ERROR: Specifying LEVELS is not allowed for UNGRIDDED vars') end if else @@ -817,17 +817,17 @@ subroutine MAPL_CFIOCreateFromBundle ( MCFIO, NAME, CLOCK, BUNDLE, OFFSET, DO I = 1, NumVars IF (LOCATION(I)==MAPL_VLocationEdge) print*, mCFIO%VarName(I) ENDDO - _ASSERT(.false., 'ERROR: Mixed Vlocation in CFIO not allowed unless LEVELS is specified') + _FAIL( 'ERROR: Mixed Vlocation in CFIO not allowed unless LEVELS is specified') endif if( all(MCFIO%VarDims==2)) then LM = 1 else if (HAVE_ungrd) then if (HAVE_center .or. HAVE_edge) then - _ASSERT(.false., 'ERROR: Mixed 3d and UNGRIDDED in CFIO not allowed') + _FAIL( 'ERROR: Mixed 3d and UNGRIDDED in CFIO not allowed') end if if (minval(vsize) /= maxval(vsize)) then - _ASSERT(.false., 'ERROR: Outputting variables with different ungridded sizes in one collection') + _FAIL( 'ERROR: Outputting variables with different ungridded sizes in one collection') end if LM = maxval(vsize) else @@ -958,7 +958,7 @@ subroutine MAPL_CFIOCreateFromBundle ( MCFIO, NAME, CLOCK, BUNDLE, OFFSET, exit end do if (.not.foundEmpty) then - _ASSERT(.false., 'ERROR: Need bigger table with storedCoords') + _FAIL( 'ERROR: Need bigger table with storedCoords') end if end if endif @@ -995,7 +995,7 @@ subroutine MAPL_CFIOCreateFromBundle ( MCFIO, NAME, CLOCK, BUNDLE, OFFSET, lons1d = MAPL_Range(-180.+(180./IMO), 180.-(180./IMO), IMO) lats1d = MAPL_Range(-90.+(90./JMO), +90.-(90./JMO), JMO) case default - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end select mcfio%xyoffset = xyoffset else @@ -5257,13 +5257,13 @@ subroutine MAPL_CFIOCreateFromFile(MCFIO,bundlein,RegridMethod,hw,only_vars,rc) end if else if (gridStagger == MAPL_DGrid) then if (rotation /= MAPL_RotateCube) then - _ASSERT(.false.,'must rotate LL') + _FAIL('must rotate LL') else mCFIO%doRotate = .false. end if else if (gridStagger == MAPL_CGrid) then if (rotation /= MAPL_RotateCube) then - _ASSERT(.false.,'must rotate LL') + _FAIL('must rotate LL') else mCFIO%doRotate = .false. end if diff --git a/base/MAPL_Comms.F90 b/base/MAPL_Comms.F90 index 9496479311bd..51d86ae8c747 100644 --- a/base/MAPL_Comms.F90 +++ b/base/MAPL_Comms.F90 @@ -464,7 +464,7 @@ subroutine MAPL_CreateRequest(grid, Root, request, tag, RequestType, & _VERIFY(STATUS) end if else - _ASSERT(.false., 'unsupported action') + _FAIL( 'unsupported action') end if ! Allocate a contiguous buffer for communication diff --git a/base/MAPL_CubedSphereGridFactory.F90 b/base/MAPL_CubedSphereGridFactory.F90 index f680ecf343fd..6dad03652172 100644 --- a/base/MAPL_CubedSphereGridFactory.F90 +++ b/base/MAPL_CubedSphereGridFactory.F90 @@ -316,7 +316,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi im = file_metadata%get_dimension('lon',rc=status) _VERIFY(status) else - _ASSERT(.false.,"can not identify dimenions of cubed-sphere file") + _FAIL("can not identify dimenions of cubed-sphere file") end if end associate call this%make_arbitrary_decomposition(this%nx, this%ny, reduceFactor=6, rc=status) @@ -332,7 +332,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi type is (real(kind=REAL32)) this%stretch_factor = q(1) class default - _ASSERT(.false.,'unsupport subclass for stretch params') + _FAIL('unsupport subclass for stretch params') end select attr => file_metadata%get_attribute('TARGET_LAT') attr_val => attr%get_values() @@ -340,7 +340,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi type is (real(kind=REAL32)) this%target_lon = q(1) class default - _ASSERT(.false.,'unsupport subclass for stretch params') + _FAIL('unsupport subclass for stretch params') end select attr => file_metadata%get_attribute('TARGET_LON') attr_val => attr%get_values() @@ -348,7 +348,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi type is (real(kind=REAL32)) this%target_lat = q(1) class default - _ASSERT(.false.,'unsupport subclass for stretch params') + _FAIL('unsupport subclass for stretch params') end select end if diff --git a/base/MAPL_LocStreamMod.F90 b/base/MAPL_LocStreamMod.F90 index 4d9ecc14ede2..220eef8a748b 100644 --- a/base/MAPL_LocStreamMod.F90 +++ b/base/MAPL_LocStreamMod.F90 @@ -233,7 +233,7 @@ subroutine MAPL_LocStreamGet(LocStream, NT_LOCAL, nt_global, TILETYPE, TILEKIND, if (present(tilekind)) then PRINT *, 'IN LocStreamGet TILEKIND NO LONGER VALID ARGUMENT' - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') ! tilekind => locstream%Ptr%Local_GeoLocation(:)%u end if @@ -1912,11 +1912,11 @@ subroutine MAPL_LocStreamTransformT2G (LocStream, OUTPUT, INPUT, MASK, SAMPLE, T end if if (computeVariance .and. usableTranspose) then - _ASSERT(.false.,"Can not compute variance and transpose in LocStream!") + _FAIL("Can not compute variance and transpose in LocStream!") end if if (computeVariance .and. uSample) then - _ASSERT(.false.,"Can not compute variance and sample in LocStream!") + _FAIL("Can not compute variance and sample in LocStream!") end if ! Compute weighted average over masked locations @@ -2123,7 +2123,7 @@ subroutine MAPL_LocStreamTransformG2T ( LocStream, OUTPUT, INPUT, & if (usableGLOBAL) then PRINT *, 'IN G2T GLOBAL NO LONGER VALID ARGUMENT' - _ASSERT(.FALSE.,'needs informative message') + _FAIL('needs informative message') else do N = 1, size(OUTPUT) if(usableMASK(N)) then diff --git a/base/MAPL_TimeMethods.F90 b/base/MAPL_TimeMethods.F90 index c14719ea67b5..4dd8f5a2c832 100644 --- a/base/MAPL_TimeMethods.F90 +++ b/base/MAPL_TimeMethods.F90 @@ -145,7 +145,7 @@ function define_time_variable(this,rc) result(v) end if time_increment = this%frequency/86400 case default - _ASSERT(.false., 'Not supported yet') + _FAIL( 'Not supported yet') end select call this%tvec%clear() @@ -265,7 +265,7 @@ function get_start_time(this,metadata,rc) result(startTime) startTime = parse_time_string(units,rc=status) _VERIFY(status) class default - _ASSERT(.false.,'unsupported subclass for units') + _FAIL('unsupported subclass for units') end select @@ -296,7 +296,7 @@ function parse_time_string(timeUnits,rc) result(time) lastdash = index(TimeUnits, '-', BACK=.TRUE.) if (firstdash .LE. 0 .OR. lastdash .LE. 0) then - _ASSERT(.false.,'time string is not a valid format') + _FAIL('time string is not a valid format') endif ypos(2) = firstdash - 1 mpos(1) = firstdash + 1 diff --git a/base/MAPL_VerticalMethods.F90 b/base/MAPL_VerticalMethods.F90 index 1d6d4d84f4a0..cba4dfb80418 100644 --- a/base/MAPL_VerticalMethods.F90 +++ b/base/MAPL_VerticalMethods.F90 @@ -395,7 +395,7 @@ subroutine append_vertical_metadata(this,metadata,bundle,rc) unGrdCoordCheck = .false. end if if ( unGrdUnitCheck .or. unGrdNameCheck .or. unGrdCoordCheck) then - _ASSERT(.false.,'Ungridded attributes for variables in collection do not match') + _FAIL('Ungridded attributes for variables in collection do not match') end if end if end do diff --git a/base/MAPL_sun_uc.F90 b/base/MAPL_sun_uc.F90 index 14b9d7166a6f..f964b7d7f348 100644 --- a/base/MAPL_sun_uc.F90 +++ b/base/MAPL_sun_uc.F90 @@ -1047,7 +1047,7 @@ subroutine SOLAR_ARR_INT(LONS, LATS, ORBIT, ZTH, SLR, INTV, CLOCK, & ! Begin - _ASSERT(.FALSE.," pmn: this routine is not up to date, is it even used anywhere?") + _FAIL(" pmn: this routine is not up to date, is it even used anywhere?") call ESMF_ArrayGet(LONS, RANK=RANK, RC=STATUS) _VERIFY(STATUS) @@ -1998,7 +1998,7 @@ subroutine MAPL_SunGetSolarConstantByYearDoY(year,dayofyear,SC,HK, rc) HK(8) = ChouBand8(i1)*(1.-F) + ChouBand8(i2)*F _ASSERT(abs(1.0-sum(HK))<1.e-4,'Chou Solar band weightings do not sum to unity!') else - _ASSERT(.false.,'HK: Solar band weightings only available for Chou') + _FAIL('HK: Solar band weightings only available for Chou') endif end if @@ -2080,7 +2080,7 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error opening file ', trim(fileName), status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if ! Read in dimensions @@ -2090,14 +2090,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting ndate dimid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_inquire_dimension(ncid, dimid_ndate, len = ndate) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting ndate length', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if if (present(HK)) then @@ -2105,14 +2105,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting nbin_sorad dimid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_inquire_dimension(ncid, dimid_nbin_sorad, len = nbin_sorad) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting nbin_sorad length', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end if @@ -2121,14 +2121,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting nbin_meso_phot dimid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_inquire_dimension(ncid, dimid_nbin_meso_phot, len = nbin_meso_phot) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting nbin_meso_phot length', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end if @@ -2137,14 +2137,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting nbin_jcalc4 dimid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_inquire_dimension(ncid, dimid_nbin_jcalc4, len = nbin_jcalc4) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting nbin_jcalc4 length', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end if @@ -2182,14 +2182,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting date_year varid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_get_var(ncid, varid_date_year, date_year) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting date_year variable', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if ! Read in date_month @@ -2199,14 +2199,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting date_month varid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_get_var(ncid, varid_date_month, date_month) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting date_month variable', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if ! Read in tsi @@ -2216,14 +2216,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting tsi varid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_get_var(ncid, varid_tsi, tsi) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting tsi variable', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if ! Read in coef_sorad @@ -2235,14 +2235,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting coef_sorad varid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_get_var(ncid, varid_coef_sorad, coef_sorad) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting coef_sorad variable', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end if @@ -2256,14 +2256,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting coef_meso_phot varid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_get_var(ncid, varid_coef_meso_phot, coef_meso_phot) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting coef_meso_phot variable', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end if @@ -2277,14 +2277,14 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting coef_jcalc4 varid', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if status = nf90_get_var(ncid, varid_coef_jcalc4, coef_jcalc4) if (STATUS /= NF90_NOERR) then write (*,*) trim(Iam)//': Error getting coef_jcalc4 variable', status write (*,*) nf90_strerror(status) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end if diff --git a/base/NCIO.F90 b/base/NCIO.F90 index 0480974a09e3..5868690ae01f 100644 --- a/base/NCIO.F90 +++ b/base/NCIO.F90 @@ -242,7 +242,7 @@ subroutine MAPL_FieldReadNCPar(formatter,name,FIELD, ARRDES, HomePE, RC) call ESMF_ArrayGet(array, localDE=0, farrayptr=var_4d, rc=status) _VERIFY(STATUS) if (.not.associated(var_4d)) then - _ASSERT(.false., "Cannot read unassociated variable") + _FAIL( "Cannot read unassociated variable") end if do L = 1,size(var_4d,3) @@ -254,10 +254,10 @@ subroutine MAPL_FieldReadNCPar(formatter,name,FIELD, ARRDES, HomePE, RC) end do end do else - _ASSERT(.false., "ERROR: unsupported RANK/KIND") + _FAIL( "ERROR: unsupported RANK/KIND") endif else - _ASSERT(.false., "ERROR: unsupported RANK") + _FAIL( "ERROR: unsupported RANK") endif _VERIFY(STATUS) @@ -381,7 +381,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients endif else - _ASSERT(.false., "Cannot write unassociated var-1d") + _FAIL( "Cannot write unassociated var-1d") end if else call ESMF_ArrayGet(array, localDE=0, farrayptr=vr8_1d, rc=status) @@ -422,7 +422,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients endif else - _ASSERT(.false., "Cannot write unassociated var8-1d") + _FAIL( "Cannot write unassociated var8-1d") end if endif else if (rank == 2) then @@ -458,7 +458,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients call MAPL_VarWrite(formatter, name, var_2d, arrdes=arrdes, oClients=oClients, rc=status) endif ! dims else - _ASSERT(.false., "Cannot write unassociated var-2d") + _FAIL( "Cannot write unassociated var-2d") endif ! associated else call ESMF_ArrayGet(array, localDE=0, farrayptr=vr8_2d, rc=status) @@ -491,7 +491,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients call MAPL_VarWrite(formatter, name, vr8_2d, arrdes=arrdes, oClients=oClients, rc=status) end if else - _ASSERT(.false., "Cannot write unassociated var8-2d") + _FAIL( "Cannot write unassociated var8-2d") end if endif else if (rank == 3) then @@ -532,7 +532,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients call MAPL_VarWrite(formatter, name, var_3d, arrdes=arrdes, oClients=oClients, rc=status) endif else - _ASSERT(.false., "Cannot write unassociated var-3d") + _FAIL( "Cannot write unassociated var-3d") end if else call ESMF_ArrayGet(array, localDE=0, farrayptr=vr8_3d, rc=status) @@ -570,25 +570,25 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients call MAPL_VarWrite(formatter, name, vr8_3d, arrdes=arrdes, oClients=oClients, rc=status) end if else - _ASSERT(.false., "Cannot write unassociated var8-3d") + _FAIL( "Cannot write unassociated var8-3d") end if endif else if (rank == 4) then if (DIMS == MAPL_DimsTileOnly .or. DIMS == MAPL_DimsTileTile) then - _ASSERT(.false., "Unsupported tile/ungrid variable") + _FAIL( "Unsupported tile/ungrid variable") end if if (tk == ESMF_TYPEKIND_R4) then call ESMF_ArrayGet(array, localDE=0, farrayptr=var_4d, rc=status) _VERIFY(STATUS) if (.not.associated(var_4d)) then - _ASSERT(.false., "Cannot write unassociated vars") + _FAIL( "Cannot write unassociated vars") end if call MAPL_VarWrite(formatter, name, var_4d, arrdes=arrdes, oClients=oClients, rc=status) else call ESMF_ArrayGet(array, localDE=0, farrayptr=vr8_4d, rc=status) _VERIFY(STATUS) if (.not.associated(vr8_4d)) then - _ASSERT(.false., "Cannot write unassociated vars") + _FAIL( "Cannot write unassociated vars") end if call MAPL_VarWrite(formatter, name, vr8_4d, arrdes=arrdes, oClients=oClients, rc=status) endif @@ -2999,7 +2999,7 @@ subroutine MAPL_StateVarReadNCPar(filename, STATE, arrdes, bootstrapable, NAME, value=MAPL_RestartBootstrap, rc=status) else - _ASSERT(.false., " Could not find field "//trim(FieldName)//" in "//trim(filename)) + _FAIL( " Could not find field "//trim(FieldName)//" in "//trim(filename)) end if end if @@ -3053,7 +3053,7 @@ subroutine MAPL_StateVarReadNCPar(filename, STATE, arrdes, bootstrapable, NAME, call ESMF_AttributeSet ( field, name='RESTART', & value=MAPL_RestartBootstrap, rc=status) else - _ASSERT(.false., " Could not find field "//trim(Fieldname)//" in "//trim(filename)) + _FAIL( " Could not find field "//trim(Fieldname)//" in "//trim(filename)) end if end if @@ -3283,7 +3283,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) ! verify that file is compatible with fields in bundle we are reading if (nVars == 0) then - _ASSERT(.false., "The bundle you are trying to write is empty") + _FAIL( "The bundle you are trying to write is empty") endif ! first we need to prep the netcdf file for writing @@ -3374,7 +3374,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) UNGRID_DIMS(I,1) = size(var_4d,3) UNGRID_DIMS(I,2) = size(var_4d,4) else - _ASSERT(.false., "Unsupported DIMS type") + _FAIL( "Unsupported DIMS type") end if elseif (tk == ESMF_TYPEKIND_R8) then call ESMF_ArrayGet(array, localDE=0, farrayptr=var8_4d, rc=status) @@ -3385,10 +3385,10 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) UNGRID_DIMS(I,1) = size(var8_4d,3) UNGRID_DIMS(I,2) = size(var8_4d,4) else - _ASSERT(.false., "Unsupported DIMS type") + _FAIL( "Unsupported DIMS type") end if else - _ASSERT(.false., "Unsupported type/rank") + _FAIL( "Unsupported type/rank") endif endif @@ -3661,7 +3661,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) call add_fvar(cf,trim(fieldname),pfDataType,'edge',units,long_name,rc=status) _VERIFY(status) else - _ASSERT(.false., 'ERROR: LOCATION not recognized for rank 1') + _FAIL( 'ERROR: LOCATION not recognized for rank 1') endif elseif(DIMS(1)==MAPL_DimsTileOnly) then call add_fvar(cf,trim(fieldname),pfDataType,'tile',units,long_name,rc=status) @@ -3680,7 +3680,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) call add_fvar(cf,trim(fieldname),pfDataType,myUngridDimName1,units,long_name,rc=status) _VERIFY(status) else - _ASSERT(.false., 'unsupported Dims case') + _FAIL( 'unsupported Dims case') endif else if(arrayRank == 2) then if (DIMS(1)==MAPL_DimsHorzOnly) then @@ -3701,7 +3701,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) _VERIFY(status) else write(buffer,*)'ERROR: DIMS not recognized for rank 2 variable ',trim(FieldName), DIMS(1) - _ASSERT(.false., trim(buffer)) + _FAIL( trim(buffer)) endif else if(arrayRank == 3) then @@ -3715,7 +3715,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) call add_fvar(cf,trim(fieldname),pfDataType,'lon,lat,edge',units,long_name,rc=status) _VERIFY(status) else - _ASSERT(.false., 'ERROR: LOCATION not recognized for rank 3') + _FAIL( 'ERROR: LOCATION not recognized for rank 3') endif else if(DIMS(1)==MAPL_DimsHorzOnly) then do j=1,n_unique_ungrid_dims @@ -3745,7 +3745,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) call add_fvar(cf,trim(fieldname),pfDataType,'tile,'//myUngridDimName1//','//myUngridDimName2,units,long_name,rc=status) _VERIFY(status) else if(DIMS(1)/=MAPL_DimsHorzVert .and. DIMS(1)/=MAPL_DimsHorzOnly) then - _ASSERT(.false., 'ERROR: What else could it be') + _FAIL( 'ERROR: What else could it be') endif else if(arrayRank == 4) then if (DIMS(1)==MAPL_DimsHorzVert) then @@ -3763,7 +3763,7 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) call add_fvar(cf,trim(fieldname),pfDataType,'lon,lat,edge,'//myUngridDimName1,units,long_name,rc=status) _VERIFY(status) else - _ASSERT(.false., 'ERROR: LOCATION not recognized for rank 4') + _FAIL( 'ERROR: LOCATION not recognized for rank 4') endif else if(DIMS(1)==MAPL_DimsHorzOnly) then do j=1,n_unique_ungrid_dims @@ -3784,13 +3784,13 @@ subroutine MAPL_BundleWriteNCPar(Bundle, arrdes, CLOCK, filename, oClients, rc) _VERIFY(status) else if (DIMS(1)==MAPL_DimsTileOnly .or. & DIMS(1)==MAPL_DimsTileTile) then - _ASSERT(.false., 'ERROR: tiles with 2 or more UNGRIDDED dims not supported') + _FAIL( 'ERROR: tiles with 2 or more UNGRIDDED dims not supported') else - _ASSERT(.false., 'ERROR: What else could it be') + _FAIL( 'ERROR: What else could it be') endif else write(buffer,*) 'ERROR: arrayRank ',arrayRank, ' not supported' - _ASSERT(.false., trim(buffer)) + _FAIL( trim(buffer)) endif enddo @@ -4379,7 +4379,7 @@ subroutine MAPL_IOGetTime(cf,nymd,nhms,rc) type is (character(*)) call MAPL_NCIOParseTimeUnits(units,year,month,day,hour,min,sec,status) class default - _ASSERT(.false., 'unsupported subclass for units') + _FAIL( 'unsupported subclass for units') end select nymd = year*10000 + month*100 + day nhms = hour*10000 + min*100 + sec @@ -4536,7 +4536,7 @@ function check_flip(metadata,rc) result(flip) type is (character(*)) positive => vpos class default - _ASSERT(.false.,'units must be string') + _FAIL('units must be string') end select else positive => null() diff --git a/base/StringTemplate.F90 b/base/StringTemplate.F90 index 03ad68fe0f10..1b13af15edfa 100644 --- a/base/StringTemplate.F90 +++ b/base/StringTemplate.F90 @@ -110,7 +110,7 @@ subroutine fill_grads_template(output_string,template,unusable,experiment_id,nym output_string(k:k+1)="%s" k=k+1 else - _ASSERT(.false.,"Using %s token with no experiment id") + _FAIL("Using %s token with no experiment id") end if case("%") istp=2 @@ -133,7 +133,7 @@ subroutine fill_grads_template(output_string,template,unusable,experiment_id,nym output_string(k:m)=sbuf k=m+1 else - _ASSERT(.false.,"Invalid token in file template: "//c1//c2) + _FAIL("Invalid token in file template: "//c1//c2) end if end select else diff --git a/base/read_parallel.H b/base/read_parallel.H index 83e15b177188..79ba0ad55953 100644 --- a/base/read_parallel.H +++ b/base/read_parallel.H @@ -91,7 +91,7 @@ subroutine SUB_ ( layout, DATA, UNIT, FORMAT, arrdes, RC) #if (RANK_ > 2 || VARTYPE_ <= 0) - _ASSERT(.FALSE.,'needs informative message') + _FAIL('needs informative message') #else diff --git a/base/sun.H b/base/sun.H index 289607f2f2ea..bb58867bc8f4 100644 --- a/base/sun.H +++ b/base/sun.H @@ -108,7 +108,7 @@ ! pmn: EOT will just displace sunlit period wrt mean noon, ! but the daily mean values will not change - _ASSERT(.FALSE.,'pmn: MAPL_SunDailyMean probably in error!') + _FAIL('pmn: MAPL_SunDailyMean probably in error!') _ASSERT(.NOT.ORBIT%ANAL2B,'not implemented for analytic two-body orbit') SLR = sin(LATS)*ORBIT%ZS(IDAY) @@ -149,7 +149,7 @@ ! its a mean over the whole currently fixed 4-year cycle. ! see above - _ASSERT(.FALSE.,'pmn: MAPL_SunAnnualMean probably in error!') + _FAIL('pmn: MAPL_SunAnnualMean probably in error!') _ASSERT(.NOT.ORBIT%ANAL2B,'not implemented for analytic two-body orbit') SLR = 0.0 diff --git a/base/tests/mapl_bundleio_test.F90 b/base/tests/mapl_bundleio_test.F90 index b7006fa3c884..771cc49f38d7 100644 --- a/base/tests/mapl_bundleio_test.F90 +++ b/base/tests/mapl_bundleio_test.F90 @@ -237,7 +237,7 @@ subroutine compare_bundle(State1,State2,tol,rc) enddo end if if (foundDiff(ii)) then - _ASSERT(.false.,'found difference when compare state') + _FAIL('found difference when compare state') end if enddo diff --git a/base/write_parallel.H b/base/write_parallel.H index 5f2e8f343bca..823ce1c74a52 100644 --- a/base/write_parallel.H +++ b/base/write_parallel.H @@ -87,7 +87,7 @@ subroutine SUB_ ( data, UNIT, ARRDES, format, RC) #if (RANK_ > 2 || VARTYPE_ <= 0) - _ASSERT(.FALSE.,'needs informative message') + _FAIL('needs informative message') #else diff --git a/generic/GenericCplComp.F90 b/generic/GenericCplComp.F90 index 80bc16d4bfb6..12cde4206720 100644 --- a/generic/GenericCplComp.F90 +++ b/generic/GenericCplComp.F90 @@ -1468,7 +1468,7 @@ subroutine ReadRestart(CC, SRC, DST, CLOCK, RC) deallocate(buf1) end if case default - _ASSERT(.false., "Unsupported rank") + _FAIL( "Unsupported rank") end select _DEALLOC(mask) end do @@ -1591,7 +1591,7 @@ subroutine WriteRestart(CC, SRC, DST, CLOCK, RC) case(3) local_undefs = associated(state%array_count(i)%ptr3c) case default - _ASSERT(.false., "Unsupported rank") + _FAIL( "Unsupported rank") end select have_undefs = 0 n_undefs = 0 @@ -1662,7 +1662,7 @@ subroutine WriteRestart(CC, SRC, DST, CLOCK, RC) deallocate(buf1) end if case default - _ASSERT(.false.," Unsupported rank") + _FAIL(" Unsupported rank") end select _DEALLOC(mask) end do @@ -1710,7 +1710,7 @@ subroutine MAPL_CplCompSetAlarm ( CC, ALARM, RC ) if (.not.associated(STATE%TIME2CPL_ALARM)) then STATE%TIME2CPL_ALARM => ALARM else - _ASSERT(.false., "Alarm is already associated! Cannot set it again!") + _FAIL( "Alarm is already associated! Cannot set it again!") end if _RETURN(ESMF_SUCCESS) end subroutine MAPL_CplCompSetAlarm diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 78bbca59b2d6..bb5c57454c26 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -2099,7 +2099,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) nwrgt1 = ((state%grid%num_readers > 1) .or. (state%grid%num_writers > 1)) if(FILETYPE=='pnc4' .and. nwrgt1) then print*,trim(Iam),': num_readers and number_writers must be 1 with pnc4 unless HDF5 was built with -enable-parallel' - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') endif #endif call MAPL_GetResource( STATE , hdr, & @@ -2129,7 +2129,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) nwrgt1 = ((state%grid%num_readers > 1) .or. (state%grid%num_writers > 1)) if(FILETYPE=='pnc4' .and. nwrgt1) then print*,trim(Iam),': num_readers and number_writers must be 1 with pnc4 unless HDF5 was built with -enable-parallel' - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') endif #endif call MAPL_ESMFStateWriteToFile(IMPORT,CLOCK,FILENAME, & @@ -5674,7 +5674,7 @@ subroutine MAPL_ESMFStateWriteToFile(STATE,CLOCK,FILENAME,FILETYPE,MPL,HDR, oCli #ifndef H5_HAVE_PARALLEL if (nwrgt1) then print*,trim(Iam),': num_readers and number_writers must be 1 with pnc4 unless HDF5 was built with -enable-parallel' - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if #endif AmWriter = mpl%grid%writers_comm/=MPI_COMM_NULL @@ -6062,7 +6062,7 @@ subroutine MAPL_ESMFStateReadFromFile(STATE,CLOCK,FILENAME,MPL,HDR,RC) #ifndef H5_HAVE_PARALLEL if (nwrgt1) then print*,trim(Iam),': num_readers and number_writers must be 1 with pnc4 unless HDF5 was built with -enable-parallel' - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if #endif AmReader = mpl%grid%readers_comm/=MPI_COMM_NULL @@ -8376,7 +8376,7 @@ subroutine MAPL_GetResourceFromConfig_scalar(config, val, label, default, rc) _VERIFY(status) end if class default - _ASSERT(.false., "Unupported type") + _FAIL( "Unupported type") end select call ESMF_ConfigGetAttribute(config, printrc, label = 'PRINTRC:', default = 0, rc = status) @@ -8501,7 +8501,7 @@ subroutine MAPL_GetResource_array(state, vals, label, default, rc) _VERIFY(status) end if class default - _ASSERT(.false., "Unsupported type") + _FAIL( "Unsupported type") end select _RETURN(ESMF_SUCCESS) @@ -8573,7 +8573,7 @@ subroutine print_resource(printrc, label, val, default, rc) default_str = intrinsic_to_string(default, 'a') end if class default - _ASSERT(.false.,"Unsupported type") + _FAIL("Unsupported type") end select output_format = "(1x, " // type_str // ", 'Resource Parameter: '" // ", a"// ", a)" @@ -8634,7 +8634,7 @@ function intrinsic_to_string(val, str_format, rc) result(formatted_str) type is(character(len=*)) formatted_str = trim(val) class default - _ASSERT(.false., "Unsupported type in intrinsic_to_string") + _FAIL( "Unsupported type in intrinsic_to_string") end select end function intrinsic_to_string @@ -9334,7 +9334,7 @@ subroutine MAPL_ReadForcingX(MPL,NAME,DATAFILE,CURRTIME, & elseif(present(FORCING2)) then ONED = .FALSE. else - _ASSERT(.FALSE.,'needs informative message') + _FAIL('needs informative message') end if ! Get parameters from generic state. @@ -9964,7 +9964,7 @@ subroutine READIT(WHICH) if(TRANSFORM) then if (PRF /= 0) then - _ASSERT(.false.,'needs informative message') ! for now + _FAIL('needs informative message') ! for now else ! ALT this LOOKS WRONG. MAPL_VarRead needs a mask for tiles!!! call MAPL_VarRead(UNIT, GRID, VAR2, RC=status ) @@ -10154,7 +10154,7 @@ subroutine MAPL_GridCreate(GC, MAPLOBJ, ESMFGRID, srcGC, rc) elseif(present(MAPLOBJ)) then STATE => MAPLOBJ else - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') endif call MAPL_ConfigPrepend(state%cf,trim(comp_name),MAPL_CF_COMPONENT_SEPARATOR,'NX:',rc=status) diff --git a/gridcomps/ExtData/ExtDataGridCompMod.F90 b/gridcomps/ExtData/ExtDataGridCompMod.F90 index 15c27fb5c7ea..a87fc8b04865 100644 --- a/gridcomps/ExtData/ExtDataGridCompMod.F90 +++ b/gridcomps/ExtData/ExtDataGridCompMod.F90 @@ -11,7 +11,7 @@ MODULE MAPL_ExtDataGridCompMod !BOP ! !MODULE: MAPL_ExtDataGridCompMod - Implements Interface to External Data ! -! !DESCRIPTION: +! !DESCRIPTION: ! ! {\tt MAPL\_ExtDataGridComp} is an ESMF gridded component implementing ! an interface to boundary conditions and other types of external data @@ -131,12 +131,12 @@ MODULE MAPL_ExtDataGridCompMod ! the corresponding names of the two vector components on file character(len=ESMF_MAXSTR) :: fcomp1, fcomp2 type(GriddedIOitem) :: fileVars - type(SimpleAlarm) :: update_alarm + type(SimpleAlarm) :: update_alarm integer :: collection_id integer :: pfioCollection_id integer :: iclient_collection_id - + logical :: ExtDataAlloc ! time shifting during continuous update type(ESMF_TimeInterval) :: tshift @@ -157,7 +157,7 @@ MODULE MAPL_ExtDataGridCompMod PRIVATE integer :: nItems = 0 logical :: have_phis - type(PrimaryExport), pointer :: item(:) => null() + type(PrimaryExport), pointer :: item(:) => null() end type PrimaryExports type DerivedExport @@ -232,7 +232,7 @@ SUBROUTINE SetServices ( GC, RC ) type(ESMF_GridComp), intent(INOUT) :: GC ! gridded component integer, optional :: RC ! return code -! !DESCRIPTION: Sets Initialize, Run and Finalize services. +! !DESCRIPTION: Sets Initialize, Run and Finalize services. ! ! !REVISION HISTORY: ! @@ -263,7 +263,7 @@ SUBROUTINE SetServices ( GC, RC ) allocate ( self, stat=STATUS ) _VERIFY(STATUS) wrap%ptr => self - + ! ------------------------ ! ESMF Functional Services ! ------------------------ @@ -273,12 +273,12 @@ SUBROUTINE SetServices ( GC, RC ) call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_INITIALIZE, Initialize_, __RC__ ) call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run_, __RC__ ) call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_FINALIZE, Finalize_, __RC__ ) - + ! Store internal state in GC ! -------------------------- call ESMF_UserCompSetInternalState ( GC, 'MAPL_ExtData_state', wrap, STATUS ) _VERIFY(STATUS) - + ! Generic Set Services ! -------------------- @@ -319,7 +319,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(ESMF_State), intent(inout) :: EXPORT ! Export State integer, intent(out) :: rc ! Error return code: ! 0 - all is well - ! 1 - + ! 1 - ! !DESCRIPTION: This is a simple ESMF wrapper. ! @@ -332,7 +332,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(MAPL_ExtData_state), pointer :: self ! Legacy state type(ESMF_Grid) :: GRID ! Grid - type(ESMF_Config) :: CF_main ! Universal Config + type(ESMF_Config) :: CF_main ! Universal Config character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: Iam @@ -342,7 +342,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(PrimaryExports) :: Primary type(PrimaryExport), pointer :: item type(DerivedExports) :: Derived - type(DerivedExport), pointer :: derivedItem + type(DerivedExport), pointer :: derivedItem integer :: nLines integer :: i integer :: ItemCount, itemCounter, j @@ -408,7 +408,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! Start Some Timers ! ----------------- call MAPL_GetObjectFromGC ( gc, MAPLSTATE, RC=STATUS) - _VERIFY(STATUS) + _VERIFY(STATUS) call MAPL_TimerOn(MAPLSTATE,"Initialize") ! Get information from export state @@ -476,9 +476,9 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) totalPrimaryEntries=0 totalDerivedEntries=0 call ESMF_ConfigNextLine(CFtemp,__RC__) - do while (status == ESMF_SUCCESS) + do while (status == ESMF_SUCCESS) call ESMF_ConfigNextLine(CFtemp,rc=status) - if (status == ESMF_SUCCESS) then + if (status == ESMF_SUCCESS) then call ESMF_ConfigGetAttribute(CFtemp,thisLine,rc=status) _VERIFY(STATUS) if (trim(thisLine) == "PrimaryExports%%" .or. trim(thisLine) == "DerivedExports%%" ) then @@ -509,14 +509,14 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) allocate(primary%item(totalPrimaryEntries), stat=STATUS) _VERIFY(STATUS) end if - + derived%nItems = totalDerivedEntries - if (totalDerivedEntries > 0) then + if (totalDerivedEntries > 0) then Allocate(DerivedVarNeeded(totalDerivedEntries),stat=status) _VERIFY(STATUS) DerivedVarNeeded = .false. allocate(derived%item(totalDerivedEntries),stat=status) - _VERIFY(STATUS) + _VERIFY(STATUS) end if ! Primary Exports @@ -530,7 +530,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call ESMF_ConfigLoadFile(CFtemp,EXTDATA_CF,rc=status) _VERIFY(STATUS) call ESMF_ConfigNextLine(CFtemp,__RC__) - do while(status == ESMF_SUCCESS) + do while(status == ESMF_SUCCESS) call ESMF_ConfigNextLine(CFtemp,rc=status) if (status == ESMF_SUCCESS) then @@ -628,7 +628,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) primary%item(totalPrimaryEntries)%do_scale = .true. read(c_scale,*,iostat=ios) primary%item(totalPrimaryEntries)%scale end if - + ! variable name on file entry call ESMF_ConfigGetAttribute(CFtemp, primary%item(totalPrimaryEntries)%var, __RC__) ! file template entry @@ -643,8 +643,8 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) primary%item(totalPrimaryEntries)%hasFileReffTime = .false. else primary%item(totalPrimaryEntries)%hasFileReffTime = .true. - end if - + end if + ! assume we will allocate primary%item(totalPrimaryEntries)%ExtDataAlloc = .true. ! check if this is going to be a constant @@ -685,7 +685,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) end if end if end do - !Done parsing resource file + !Done parsing resource file PrimaryItemCount = 0 DerivedItemCount = 0 @@ -741,14 +741,14 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) itemCounter = itemCounter + 1 found = .true. if (primary%item(j)%isConst .and. ITEMTYPES(I) == ESMF_StateItem_FieldBundle) then - _ASSERT(.false., 'Can not have constant bundle in ExtData.rc file') + _FAIL( 'Can not have constant bundle in ExtData.rc file') end if PrimaryItemCount = PrimaryItemCount + 1 PrimaryVarNeeded(j) = .true. primary%item(j)%ExtDataAlloc = .false. VarName=trim(primary%item(J)%name) primary%item(j)%fileVars%xname=trim(primary%item(J)%var) - + if (ITEMTYPES(I) == ESMF_StateItem_Field) then primary%item(J)%vartype = MAPL_FieldItem call ESMF_StateGet(Export,VarName,field,__RC__) @@ -768,7 +768,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) if (ItemNames(I) == derived%item(J)%name) then if (ITEMTYPES(I) == ESMF_StateItem_FieldBundle) then - _ASSERT(.false.,'Derived items cannot be field bundle') + _FAIL('Derived items cannot be field bundle') end if found = .true. DerivedVarNeeded(j) = .true. @@ -788,15 +788,15 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) end if end do - call ESMF_VMGetCurrent(VM) + call ESMF_VMGetCurrent(VM) call ESMF_VMBarrier(VM) - + ! we have better found all the items in the export in either a primary or derived item if (itemCounter /= ItemCount) then write(error_msg_str, '(A6,I3,A31)') 'Found ', ItemCount-itemCounter,' unfulfilled imports in extdata' - _ASSERT(.false., error_msg_str) + _FAIL( error_msg_str) end if - + NumVarNames=primary%nItems allocate(VarNames(NumVarNames)) allocate(LocalVarNeeded(NumVarNames)) @@ -843,7 +843,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call ESMF_StateGet(self%ExtDataState,VarName,field,__RC__) VarName=trim(primary%item(j)%name) fieldnew = MAPL_FieldCreate(field,varname,doCopy=.true.,__RC__) - primary%item(j)%fileVars%xname=trim(primary%item(j)%var) + primary%item(j)%fileVars%xname=trim(primary%item(j)%var) call MAPL_StateAdd(self%ExtDataState,fieldnew,__RC__) PrimaryVarNeeded(j) = .true. primary%item(j)%ExtDataAlloc = .true. @@ -897,7 +897,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) if ( .not. item%isConst ) then call CreateTimeInterval(item,clock,__RC__) end if - + item%pfioCollection_id = MAPL_DataAddCollection(item%file,use_file_coords=self%use_file_coords) ! parse refresh template to see if we have a time shift during constant updating @@ -949,30 +949,30 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ptr3d = item%const endif else if (item%vartype == MAPL_BundleItem) then - _ASSERT(.false.,'Cannot assign constant to field bundle') + _FAIL('Cannot assign constant to field bundle') else if (item%vartype == MAPL_ExtDataVectorItem) then call ESMF_StateGet(self%ExtDataState,trim(item%vcomp1),field,__RC__) call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) - if (fieldRank == 2) then + if (fieldRank == 2) then call MAPL_GetPointer(self%ExtDataState, ptr2d, trim(item%vcomp1),__RC__) ptr2d = item%const - else if (fieldRank == 3) then + else if (fieldRank == 3) then call MAPL_GetPointer(self%ExtDataState, ptr3d, trim(item%vcomp1), __RC__) ptr3d = item%const endif call ESMF_StateGet(self%ExtDataState,trim(item%vcomp2),field,__RC__) call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) - if (fieldRank == 2) then + if (fieldRank == 2) then call MAPL_GetPointer(self%ExtDataState, ptr2d, trim(item%vcomp2),__RC__) ptr2d = item%const - else if (fieldRank == 3) then + else if (fieldRank == 3) then call MAPL_GetPointer(self%ExtDataState, ptr3d, trim(item%vcomp2), __RC__) ptr3d = item%const endif end if cycle end if - + ! check if this is a single piece of data if user put - for refresh template ! by that it is an untemplated file with one time that could not possibly be time interpolated if (PrimaryExportIsConstant_(item)) then @@ -1003,7 +1003,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) if (fieldRank==3) then call ESMF_FieldGet(field,0,farrayPtr=ptr3d,__RC__) lm = size(ptr3d,3) - end if + end if if (item%lm /= lm .and. lm /= 0 .and. item%havePressure) then item%do_VertInterp = .true. else if (item%lm /= lm .and. lm /= 0) then @@ -1026,9 +1026,9 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call ESMF_FieldBundleSet(item%binterp2, GRID=GRID, __RC__) call MAPL_CFIORead(item%file,time,item%binterp1,noread=.true.,ignorecase=self%ignorecase,only_vars=item%var,__RC__) call MAPL_CFIORead(item%file,time,item%binterp2,noread=.true.,ignorecase=self%ignorecase,only_vars=item%var,__RC__) - + else if (item%vartype == MAPL_ExtDataVectorItem) then - + ! Only some methods are supported for vector regridding _ASSERT(any(item%Trans /= [REGRID_METHOD_BILINEAR,REGRID_METHOD_CONSERVE_HFLUX]), 'Regrid method unsupported for vectors.') @@ -1044,7 +1044,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call ESMF_StateGet(self%ExtDataState, trim(item%vcomp1), field,__RC__) call ESMF_FieldGet(field,grid=grid,rank=fieldRank,__RC__) - lm = 0 + lm = 0 if (fieldRank==3) then call ESMF_FieldGet(field,0,farrayPtr=ptr3d,__RC__) lm = size(ptr3d,3) @@ -1107,7 +1107,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) print *, trim(Iam)//': IMPORT State during Initialize():' call ESMF_StatePrint ( IMPORT ) print * - print *, trim(Iam)//': EXPORT State during Initialize():' + print *, trim(Iam)//': EXPORT State during Initialize():' call ESMF_StatePrint ( EXPORT ) end if #endif @@ -1126,7 +1126,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) idx =i end if if (self%primary%item(i)%vartype==MAPL_BundleItem) then - _ASSERT(.false.,'Cannot perform vertical interpolation on field bundle') + _FAIL('Cannot perform vertical interpolation on field bundle') end if enddo _ASSERT(idx/=-1,'Surface pressure not present for vertical interpolation') @@ -1143,7 +1143,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) idx =i end if if (self%primary%item(i)%vartype==MAPL_BundleItem) then - _ASSERT(.false.,'Cannot perform vertical interpolation on field bundle') + _FAIL('Cannot perform vertical interpolation on field bundle') end if enddo if (idx/=-1) then @@ -1165,7 +1165,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) if (allocated(DerivedVarNeeded)) deallocate(DerivedVarNeeded) if (allocated(LocalVarNeeded)) deallocate(LocalVarNeeded) - !Done parsing resource file + !Done parsing resource file ! Set has run to false to we know when we first go to run method it is first call hasRun = .false. @@ -1208,7 +1208,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(ESMF_State), intent(inout) :: EXPORT ! Export State integer, intent(out) :: rc ! Error return code: ! 0 - all is well - ! 1 - + ! 1 - ! !DESCRIPTION: This is a simple ESMF wrapper. ! @@ -1222,7 +1222,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(MAPL_ExtData_state), pointer :: self ! Legacy state type(ESMF_Field) :: field ! Field type(ESMF_FieldBundle) :: bundle - type(ESMF_Config) :: CF ! Universal Config + type(ESMF_Config) :: CF ! Universal Config character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: Iam @@ -1253,10 +1253,10 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) _UNUSED_DUMMY(IMPORT) _UNUSED_DUMMY(EXPORT) -! Declare pointers to IMPORT/EXPORT/INTERNAL states +! Declare pointers to IMPORT/EXPORT/INTERNAL states ! ------------------------------------------------- ! #include "MAPL_ExtData_DeclarePointer___.h" - + ! Get my name and set-up traceback handle ! --------------------------------------- Iam = 'Run_' @@ -1278,13 +1278,13 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) end if call MAPL_GetObjectFromGC ( gc, MAPLSTATE, RC=STATUS) - _VERIFY(STATUS) + _VERIFY(STATUS) call MAPL_TimerOn(MAPLSTATE,"Run") call ESMF_ClockGet(CLOCK, currTIME=time0, __RC__) -! Fill in the internal state with data from the files +! Fill in the internal state with data from the files ! --------------------------------------------------- allocate(doUpdate(self%primary%nitems),stat=status) @@ -1294,7 +1294,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) _VERIFY(STATUS) call MAPL_TimerOn(MAPLSTATE,"-Read_Loop") - + call lgr%debug('ExtData Rune_(): Start') call lgr%debug('ExtData Run_(): READ_LOOP: Start') @@ -1335,7 +1335,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! update left time call lgr%debug(' ExtData Run_: HAS_RUN: NotSingle is true. Update left time (bracket L)') - call UpdateBracketTime(item,time,"L",item%interp_time1, & + call UpdateBracketTime(item,time,"L",item%interp_time1, & item%time1,file_processed1,self%allowExtrap,rc=status) _VERIFY(status) call IOBundle_Add_Entry(IOBundles,item,self%primaryOrder(i),file_processed1,MAPL_ExtDataLeft,item%tindex1,__RC__) @@ -1362,7 +1362,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call lgr%debug(' ExtData Run_: HAS_RUN: End') endif HAS_RUN - + ! now update bracketing times if neccessary NOT_SINGLE: if (NotSingle) then @@ -1483,9 +1483,9 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOff(MAPLSTATE,"---IclientDone") _VERIFY(STATUS) - + call MAPL_TimerOn(MAPLSTATE,"---read-prefetch") - call MAPL_ExtDataReadPrefetch(IOBundles,rc=status) + call MAPL_ExtDataReadPrefetch(IOBundles,rc=status) _VERIFY(status) call MAPL_TimerOff(MAPLSTATE,"---read-prefetch") call MAPL_TimerOff(MAPLSTATE,"--PRead") @@ -1506,7 +1506,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOff(MAPLSTATE,"-Read_Loop") call MAPL_TimerOn(MAPLSTATE,"-Interpolate") - + call lgr%debug('ExtData Run_: INTERP_LOOP: Start') INTERP_LOOP: do i = 1, self%primary%nItems @@ -1517,13 +1517,13 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call lgr%debug('ExtData Run_: INTERP_LOOP: interpolating between bracket times, variable: %a, file: %a', & & trim(item%var), trim(item%file)) - + ! finally interpolate between bracketing times if (item%vartype == MAPL_FieldItem) then call ESMF_StateGet(self%ExtDataState, item%name, field, __RC__) - call MAPL_ExtDataInterpField(item,useTime(i),field,__RC__) + call MAPL_ExtDataInterpField(item,useTime(i),field,__RC__) else if (item%vartype == MAPL_BundleItem) then @@ -1543,12 +1543,12 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_ExtDataInterpField(item,useTime(i),field,vector_comp=1,__RC__) call ESMF_StateGet(self%ExtDataState, item%vcomp2, field, __RC__) call MAPL_ExtDataInterpField(item,useTime(i),field,vector_comp=2,__RC__) - + end if endif - nullify(item) + nullify(item) end do INTERP_LOOP @@ -1618,7 +1618,7 @@ SUBROUTINE Finalize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(ESMF_State), intent(inout) :: EXPORT ! Export State integer, intent(out) :: rc ! Error return code: ! 0 - all is well - ! 1 - + ! 1 - ! !DESCRIPTION: This is a simple ESMF wrapper. ! @@ -1630,7 +1630,7 @@ SUBROUTINE Finalize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) !------------------------------------------------------------------------- type(MAPL_ExtData_state), pointer :: self ! Legacy state - type(ESMF_Config) :: CF ! Universal Config + type(ESMF_Config) :: CF ! Universal Config character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: Iam @@ -1688,7 +1688,7 @@ subroutine extract_ ( GC, self, CF, rc) type(ESMF_GridComp), intent(INout) :: GC ! Grid Comp object type(MAPL_ExtData_state), pointer :: self ! Legacy state - type(ESMF_Config), intent(out) :: CF ! Universal Config + type(ESMF_Config), intent(out) :: CF ! Universal Config integer, intent(out), optional :: rc @@ -1718,20 +1718,20 @@ subroutine extract_ ( GC, self, CF, rc) ! --------------------- call ESMF_GridCompGet ( GC, config=CF, __RC__ ) - + _RETURN(ESMF_SUCCESS) end subroutine extract_ - + ! ............................................................................ logical function PrimaryExportIsConstant_(item) - + type(PrimaryExport), intent(in) :: item if ( trim(item%refresh_template) == '-' .or. & trim(item%file) == '/dev/null' ) then - PrimaryExportIsConstant_ = .true. + PrimaryExportIsConstant_ = .true. else PrimaryExportIsConstant_ = .false. end if @@ -1741,11 +1741,11 @@ end function PrimaryExportIsConstant_ ! ............................................................................ logical function DerivedExportIsConstant_(item) - + type(DerivedExport), intent(in) :: item if ( trim(item%refresh_template) == '-') then - DerivedExportIsConstant_ = .true. + DerivedExportIsConstant_ = .true. else DerivedExportIsConstant_ = .false. end if @@ -1793,7 +1793,7 @@ end subroutine scale_field_ type (ESMF_Time) function timestamp_(time, template, rc) type(ESMF_Time), intent(inout) :: time character(len=ESMF_MAXSTR), intent(in) :: template - integer, optional, intent(inout) :: rc + integer, optional, intent(inout) :: rc ! locals integer, parameter :: DATETIME_MAXSTR_ = 32 @@ -1804,23 +1804,23 @@ type (ESMF_Time) function timestamp_(time, template, rc) integer :: i, il, ir integer :: status - + ! test the length of the timestamp template _ASSERT(len_trim(template) < DATETIME_MAXSTR_,'Timestamp template is greater than Maximum allowed len') buff = trim(template) buff = ESMF_UtilStringLowerCase(buff, __RC__) - + ! test if the template is empty and return the current time as result if (buff == '-' .or. buff == '--' .or. buff == '---' .or. & buff == 'na' .or. buff == 'none' .or. buff == 'n/a') then timestamp_ = time - else + else ! split the time stamp template into a date and time strings i = scan(buff, 't') If (.not.(i > 3)) Then - _ASSERT(.False.,'ERROR: Time stamp ' // trim(template) // ' uses the fixed format, and must therefore contain a T') + _FAIL('ERROR: Time stamp ' // trim(template) // ' uses the fixed format, and must therefore contain a T') End If buff_date = buff(1:i-1) @@ -1839,7 +1839,7 @@ type (ESMF_Time) function timestamp_(time, template, rc) str_hs = trim(buff_time(1:il-1)) str_ms = trim(buff_time(il+1:ir-1)) str_ss = trim(buff_time(ir+1:)) - + ! remove the trailing 'Z' from the seconds string i = scan(str_ss, 'z') if (i > 0) then @@ -1862,7 +1862,7 @@ type (ESMF_Time) function timestamp_(time, template, rc) _RETURN(ESMF_SUCCESS) end function timestamp_ - + subroutine CreateTimeInterval(item,clock,rc) type(PrimaryExport) , intent(inout) :: item type(ESMF_Clock) , intent(in ) :: clock @@ -1874,16 +1874,16 @@ subroutine CreateTimeInterval(item,clock,rc) type(ESMF_Time) :: time,start_time integer :: cindex,pindex character(len=ESMF_MAXSTR) :: creffTime, ctInt - + integer :: status logical :: found - + creffTime = '' ctInt = '' call ESMF_ClockGet (CLOCK, currTIME=time, startTime=start_time, __RC__) if (.not.item%hasFileReffTime) then ! if int_frequency is less than zero than try to guess it from the file template - ! if that fails then it must be a single file or a climatology + ! if that fails then it must be a single file or a climatology call ESMF_TimeGet(time, yy=iyy, mm=imm, dd=idd,h=ihh, m=imn, s=isc ,__RC__) !======================================================================= @@ -1936,10 +1936,10 @@ subroutine CreateTimeInterval(item,clock,rc) ! 1985-01-01T00:00:00P0001-00-00T00:00:00 ! Get refference time, if not provided use current model date pindex=index(item%FileReffTime,'P') - if (pindex==0) then - _ASSERT(.false., 'ERROR: File template ' // item%file // ' has invalid reference date format') + if (pindex==0) then + _FAIL( 'ERROR: File template ' // item%file // ' has invalid reference date format') end if - cReffTime = item%FileReffTime(1:pindex-1) + cReffTime = item%FileReffTime(1:pindex-1) if (trim(cReffTime) == '') then item%reff_time = Time else @@ -1955,7 +1955,7 @@ subroutine CreateTimeInterval(item,clock,rc) call MAPL_NCIOParseTimeUnits(ctInt,iyy,imm,idd,ihh,imn,isc,status) _VERIFY(STATUS) call ESMF_TimeIntervalSet(item%frequency,yy=iyy,mm=imm,d=idd,h=ihh,m=imn,s=isc,rc=status) - _VERIFY(STATUS) + _VERIFY(STATUS) end if if (lgr%isEnabledFor(DEBUG)) then @@ -1965,7 +1965,7 @@ subroutine CreateTimeInterval(item,clock,rc) call ESMF_TimeIntervalGet(item%frequency,yy=iyy,mm=imm,d=idd,h=ihh,m=imn,s=isc,rc=status) call lgr%debug(' >> Frequency : %i0.4~-%i0.2~-%i0.2 %i0.2~:%i0.2~:%i0.2', iYy, iMm, iDd, iHh, iMn, iSc) endif - _RETURN(ESMF_SUCCESS) + _RETURN(ESMF_SUCCESS) end subroutine CreateTimeInterval @@ -2024,7 +2024,7 @@ subroutine GetClimYear(item, rc) item%climYear = climYear _RETURN(ESMF_SUCCESS) else - _ASSERT(.false., 'cyclic keyword was not y, n, or a valid year (0 < year < 3000)') + _FAIL( 'cyclic keyword was not y, n, or a valid year (0 < year < 3000)') end if end if @@ -2045,12 +2045,12 @@ subroutine GetLevs(item, time, state, allowExtrap, rc) integer :: nymd, nhms, rank type(ESMF_Time) :: fTime type(ESMF_Field) :: field - real, allocatable :: levFile(:) + real, allocatable :: levFile(:) character(len=ESMF_MAXSTR) :: buff,levunits,tlevunits,temp_name logical :: found,lFound,intOK integer :: maxOffset character(len=:), allocatable :: levname - character(len=:), pointer :: positive + character(len=:), pointer :: positive type(FileMetadataUtils), pointer :: metadata type(Variable), pointer :: var type(ESMF_TimeInterval) :: zero @@ -2074,7 +2074,7 @@ subroutine GetLevs(item, time, state, allowExtrap, rc) end if if (item%frequency == zero) then - + file = item%file Inquire(file=trim(file),EXIST=found) @@ -2129,10 +2129,10 @@ subroutine GetLevs(item, time, state, allowExtrap, rc) enddo if (.not.lfound) then - _ASSERT(.false., 'From ' // trim(item%file) // ' could not find file with extrapolation') + _FAIL( 'From ' // trim(item%file) // ' could not find file with extrapolation') end if else - _ASSERT(.false.,'From ' // trim(item%file) // ' could not find time no extrapolation') + _FAIL('From ' // trim(item%file) // ' could not find time no extrapolation') end if end if @@ -2148,7 +2148,7 @@ subroutine GetLevs(item, time, state, allowExtrap, rc) var=>metadata%get_variable(trim(item%var)) _ASSERT(associated(var),"Variable "//TRIM(item%var)//" not found in file "//TRIM(item%file)) end if - + levName = metadata%get_level_name(rc=status) _VERIFY(status) if (trim(levName) /='') then @@ -2239,7 +2239,7 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed UniFileClim = .false. ! if the file is constant, i.e. no tokens in in the template - ! but it was marked as cyclic we must have a year long climatology + ! but it was marked as cyclic we must have a year long climatology ! on one file, set UniFileClim to true if (trim(item%cyclic)=='y') UniFileClim = .true. file_processed = item%file @@ -2255,7 +2255,7 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed call lgr%error('Bracket timing request failed on fixed file %a for side %a', trim(item%file), bSide) _RETURN(ESMF_FAILURE) end if - else + else if (lgr%isEnabledFor(DEBUG)) then call lgr%debug(' UpdateBracketTime: Scanning template %a for side %a1',trim(item%file), bSide) @@ -2275,14 +2275,14 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed else yrOffset = 0 if (item%reff_time > cTime) then - _ASSERT(.False.,'Reference time for file ' // trim(item%file) // ' is too late') + _FAIL('Reference time for file ' // trim(item%file) // ' is too late') end if ! This approach causes a problem if cTime and item%reff_time are too far - ! apart - do it the hard way instead... + ! apart - do it the hard way instead... ftime = item%reff_time n = 0 ! SDE DEBUG: This caused problems in the past but the - ! alternative is far too slow... need to keep an eye + ! alternative is far too slow... need to keep an eye ! on this but the Max(0,...) should help. n = max(0,floor((cTime-item%reff_time)/item%frequency)) if (n>0) fTime = fTime + (n*item%frequency) @@ -2316,7 +2316,7 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed if (found) then call lgr%debug(' Target file for %a found and is %a', trim(item%file), trim(file_processed)) !yrOffset = 0 - Else if (allowExtrap) then + Else if (allowExtrap) then if (lgr%isEnabledFor(DEBUG)) then call lgr%debug(' UpdateBracketTime: Target file not found: %a', trim(item%file)) @@ -2428,7 +2428,7 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed do while (ftime > newTime) fTime = fTime - item%frequency n = n - 1 - end do + end do ! untemplate file call ESMF_TimeGet(fTime,yy=iyr,mm=imm,dd=idd,h=ihr,m=imn,s=isc,__RC__) call MAPL_PackTime(curDate,iyr,imm,idd) @@ -2458,7 +2458,7 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed ! question could actually be for a different year. We therefore feed the file time ! into the refresh template and see if the result has the same year. If it doesn't, ! then we can assume that the year is actually fixed, and the times in the file will - ! correspond to the year in the refresh template. In this case, an additional year + ! correspond to the year in the refresh template. In this case, an additional year ! offset must be applied. yrOffsetStamp = 0 buff = trim(item%refresh_template) @@ -2479,7 +2479,7 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed call lgr%debug(' UpdateBracketTime: Found status of %a~: %l1', trim(file_processed), found) ! if we didn't find the bracketing time look forwards or backwards depending on - ! whether it is the right or left time + ! whether it is the right or left time if (.not.found) then call lgr%debug(' UpdateBracketTime: Scanning for bracket %a1 of %a~. RSide: %l1', bSide, trim(file_processed), (bSide=="R")) @@ -2584,7 +2584,7 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed buff = ESMF_UtilStringLowerCase(buff, __RC__) If (buff /= "0" .and. index(buff,"p")==0 ) Then newTime = timestamp_(fTime,item%refresh_template,__RC__) - + if (lgr%isEnabledFor(DEBUG)) then call ESMF_TimeGet(fTime,yy=iyr,mm=imm,dd=idd,h=ihr,m=imn,s=isc,__RC__) call ESMF_TimeGet(newTime,yy=fyr,mm=fmm,dd=fdd,h=fhr,m=fmn,s=fsc,__RC__) @@ -2636,9 +2636,9 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed call lgr%info(' ... file processed: %a', trim(file_processed)) _RETURN(ESMF_SUCCESS) - + end subroutine UpdateBracketTime - + subroutine swapBracketInformation(item,rc) type(PrimaryExport), intent(inout) :: item integer, optional, intent(out) :: rc @@ -2675,7 +2675,7 @@ subroutine swapBracketInformation(item,rc) do j = 1,fieldCount call ESMF_FieldBundleGet(item%binterp1, names(j), field=field1, __RC__) call ESMF_FieldBundleGet(item%binterp2, names(j), field=field2, __RC__) - call ESMF_FieldGet(field1, dimCount=fieldRank, __RC__) + call ESMF_FieldGet(field1, dimCount=fieldRank, __RC__) if (fieldRank == 2) then call ESMF_FieldGet(field1, localDE=0, farrayPtr=var2d_prev, __RC__) call ESMF_FieldGet(field2, localDE=0, farrayPtr=var2d_next, __RC__) @@ -2743,7 +2743,7 @@ subroutine GetTimesOnFile(cfio,tSeries,rc) allocate(tSeriesInt(cfio%tSteps)) call getDateTimeVec(cfio%fid,begDate,begTime,tSeriesInt,__RC__) - + ! Assume success If (present(rc)) rc=ESMF_SUCCESS @@ -2757,7 +2757,7 @@ subroutine GetTimesOnFile(cfio,tSeries,rc) call MAPL_UnpackTime(nymdB,iyr,imm,idd) call MAPL_UnpackTime(nhmsB,ihr,imn,isc) - + if (lgr%isEnabledFor(DEBUG) .and. any(i == [1,cfio%tsteps])) then call lgr%debug(' ==> STD Sample %i~: %i0.4~-%i0.2~-%i0.2 %i0.2~:%i0.2~:%i0.2', i, iYr, iMm, iDd, iHr, iMn, iSc) end if @@ -2770,7 +2770,7 @@ subroutine GetTimesOnFile(cfio,tSeries,rc) end subroutine GetTimesOnFile subroutine OffsetTimeYear(inTime,yrOffset,outTime,rc) - + type(ESMF_Time), intent(in ) :: inTime integer :: yrOffset type(ESMF_Time), intent(out ) :: outTime @@ -2841,7 +2841,7 @@ subroutine GetBracketTimeOnSingleFile(fdata,tSeries,cTime,bSide,UniFileClim,inte nsteps = size(tSeries) call ESMF_TimeGet(cTime,yy=targYear,mm=imm,dd=idd,h=ihr,m=imn,s=isc,__RC__) - + if (lgr%isEnabledFor(DEBUG)) then call lgr%debug(' GetBracketTimeOnSingleFile called for %a', trim(fdata%get_file_name())) call lgr%debug(' GetBracketTimeOnSingleFile: Reading times from fixed (%l1) file %a', UniFileClim, trim(fdata%get_file_name())) @@ -2875,7 +2875,7 @@ subroutine GetBracketTimeOnSingleFile(fdata,tSeries,cTime,bSide,UniFileClim,inte end if end do - + allocate(tSeriesC(tsteps),__STAT__) do i=1,tsteps tSeriesC(i)=tSeries(iEntry+i-1) @@ -2934,7 +2934,7 @@ subroutine GetBracketTimeOnSingleFile(fdata,tSeries,cTime,bSide,UniFileClim,inte end if end do end if - end if + end if else @@ -2946,7 +2946,7 @@ subroutine GetBracketTimeOnSingleFile(fdata,tSeries,cTime,bSide,UniFileClim,inte RSide = (.not.LSide) LExact = (cLimTime == tSeries(1)) RExact = (cLimTime == tSeries(nsteps)) - LExtrap = (cLimTime < tSeries(1)) + LExtrap = (cLimTime < tSeries(1)) RExtrap = (cLimTime > tSeries(nsteps)) found = .false. @@ -3104,7 +3104,7 @@ subroutine GetBracketTimeOnFile(fdata,tSeries,cTime,bSide,UniFileClim,interpTime call OffsetTimeYear(cTime,yrOffset,cLimTime,rc) else climTime = cTime - end if + end if climSize = 1 ! Debug output @@ -3180,15 +3180,15 @@ subroutine GetBracketTimeOnFile(fdata,tSeries,cTime,bSide,UniFileClim,interpTime call lgr%error('Requested sample not found in file %a ', trim(fdata%get_file_name())) _RETURN(ESMF_FAILURE) endif - !end if + !end if end subroutine GetBracketTimeOnFile subroutine CalcDerivedField(state,exportName,exportExpr,masking,rc) type(ESMF_State), intent(inout) :: state - character(len=*), intent(in ) :: exportName + character(len=*), intent(in ) :: exportName character(len=*), intent(in ) :: exportExpr - logical, intent(in ) :: masking + logical, intent(in ) :: masking integer, optional, intent(out ) :: rc integer :: status @@ -3218,7 +3218,7 @@ subroutine MAPL_ExtDataInterpField(item,time,field,vector_comp,rc) real :: alpha real, pointer :: var2d(:,:) => null() real, pointer :: var3d(:,:,:) => null() - real, pointer :: var2d_prev(:,:) => null() + real, pointer :: var2d_prev(:,:) => null() real, pointer :: var2d_next(:,:) => null() real, pointer :: var3d_prev(:,:,:) => null() real, pointer :: var3d_next(:,:,:) => null() @@ -3235,7 +3235,7 @@ subroutine MAPL_ExtDataInterpField(item,time,field,vector_comp,rc) alpha = tinv1/tinv2 end if call ESMF_FieldGet(FIELD, dimCount=fieldRank,name=name,__RC__) - + if (lgr%isEnabledFor(DEBUG)) then call ESMF_TimeGet(item%interp_time1,yy=yr,mm=mm,dd=dd,h=hr,m=mn,s=sc,__RC__) call MAPL_PackTime(nhms1,hr,mn,sc) @@ -3253,7 +3253,7 @@ subroutine MAPL_ExtDataInterpField(item,time,field,vector_comp,rc) nhms2=0 nymd2=0 end if - + if (lgr%isEnabledFor(DEBUG) .and. .not. item%doInterpolate) then call lgr%debug(' MAPL_ExtDataInterpField: Uninterpolated field %a set to sample L %i0.8 %i0.6', trim(item%name), nymd1, nhms1) else if (time == item%interp_time1) then @@ -3364,7 +3364,7 @@ subroutine MAPL_ExtDataInterpField(item,time,field,vector_comp,rc) end if enddo enddo - enddo + enddo endif _RETURN(ESMF_SUCCESS) @@ -3387,7 +3387,7 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,rc) if (trim(item%importVDir)/=trim(item%fileVDir)) then call MAPL_ExtDataFlipVertical(item,filec,rc=status) _VERIFY(status) - end if + end if if (item%vartype == MAPL_fieldItem) then call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,rc=status) _VERIFY(STATUS) @@ -3398,7 +3398,7 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,rc) _VERIFY(STATUS) call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,rc=status) _VERIFY(STATUS) - + else if (item%vartype == MAPL_ExtDataVectorItem) then id_ps = ExtState%primaryOrder(1) @@ -3447,7 +3447,7 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,rc) _VERIFY(status) end if end if - + _RETURN(ESMF_SUCCESS) end subroutine MAPL_ExtDataVerticalInterpolate @@ -3564,7 +3564,7 @@ subroutine MAPL_ExtDataEvaluateMask(state,exportName,exportExpr,rc) call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) call MAPL_GetPointer(state,var3d,exportName,__RC__) else - _ASSERT(.false.,'Rank must be 2 or 3') + _FAIL('Rank must be 2 or 3') end if k=32 @@ -3579,7 +3579,7 @@ subroutine MAPL_ExtDataEvaluateMask(state,exportName,exportExpr,rc) deallocate(flag,stat=status) _VERIFY(STATUS) - ! Set local mask to 1 where gridMask matches each integer (within precision!) + ! Set local mask to 1 where gridMask matches each integer (within precision!) ! --------------------------------------------------------------------------- allocate(mask(size(rmask,1),size(rmask,2)),stat=status) _VERIFY(STATUS) @@ -3627,7 +3627,7 @@ subroutine MAPL_ExtDataEvaluateMask(state,exportName,exportExpr,rc) call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) call MAPL_GetPointer(state,var3d,exportName,__RC__) else - _ASSERT(.false.,'Rank must be 2 or 3') + _FAIL('Rank must be 2 or 3') end if if (rank == 2) then @@ -3741,7 +3741,7 @@ subroutine MAPL_ExtDataEvaluateMask(state,exportName,exportExpr,rc) call MAPL_GetPointer(state,rvar3d,vartomask,__RC__) call MAPL_GetPointer(state,var3d,exportName,__RC__) else - _ASSERT(.false.,'Rank must be 2 or 3') + _FAIL('Rank must be 2 or 3') end if if (rank == 2) then @@ -3789,15 +3789,15 @@ SUBROUTINE MAPL_ExtDataExtractIntegers(string,iSize,iValues,delimiter,verbose,rc INTEGER, INTENT(IN) :: iSize INTEGER, INTENT(INOUT) :: iValues(iSize)! Space allocated for extracted integers CHARACTER(LEN=*), OPTIONAL :: delimiter ! 1-character delimiter - LOGICAL, OPTIONAL, INTENT(IN) :: verbose ! Let me know iValues as they are found. - ! DEBUG directive turns on the message even - ! if verbose is not present or if + LOGICAL, OPTIONAL, INTENT(IN) :: verbose ! Let me know iValues as they are found. + ! DEBUG directive turns on the message even + ! if verbose is not present or if ! verbose = .FALSE. INTEGER, OPTIONAL, INTENT(OUT) :: rc ! Return code -! !DESCRIPTION: +! !DESCRIPTION: ! ! Extract integers from a character-delimited string, for example, "-1,45,256,7,10". In the context -! of Chem_Util, this is provided for determining the numerically indexed regions over which an +! of Chem_Util, this is provided for determining the numerically indexed regions over which an ! emission might be applied. ! ! In multiple passes, the string is parsed for the delimiter, and the characters up to, but not @@ -3808,7 +3808,7 @@ SUBROUTINE MAPL_ExtDataExtractIntegers(string,iSize,iValues,delimiter,verbose,rc ! The default delimiter is a comma (","). ! ! "Unfilled" iValues are zero. -! +! ! Return codes: ! 1 Zero-length string. ! 2 iSize needs to be increased. @@ -3839,7 +3839,7 @@ SUBROUTINE MAPL_ExtDataExtractIntegers(string,iSize,iValues,delimiter,verbose,rc ! "+1" ! "1 3 6" ! -! !REVISION HISTORY: +! !REVISION HISTORY: ! ! Taken from chem utilities. ! @@ -3862,7 +3862,7 @@ SUBROUTINE MAPL_ExtDataExtractIntegers(string,iSize,iValues,delimiter,verbose,rc base = ICHAR("0") iDash = ICHAR("-") -! Determine verbosity, letting the DEBUG +! Determine verbosity, letting the DEBUG ! directive override local specification ! -------------------------------------- tellMe = .FALSE. @@ -4014,9 +4014,9 @@ subroutine AdvanceAndCount(CF,nLines,rc) _VERIFY(STATUS) call ESMF_ConfigGetAttribute(CF,thisLine,rc=status) _VERIFY(STATUS) - if (trim(thisLine) == "%%") then + if (trim(thisLine) == "%%") then inBlock = .false. - else + else iCnt = iCnt + 1 end if end do @@ -4026,7 +4026,7 @@ subroutine AdvanceAndCount(CF,nLines,rc) end subroutine advanceAndCount - subroutine CheckUpdate(doUpdate,updateTime,currTime,hasRun,primaryItem,derivedItem,rc) + subroutine CheckUpdate(doUpdate,updateTime,currTime,hasRun,primaryItem,derivedItem,rc) logical, intent(out ) :: doUpdate type(ESMF_Time), intent(inout) :: updateTime type(ESMF_Time), intent(inout) :: currTime @@ -4043,7 +4043,7 @@ subroutine CheckUpdate(doUpdate,updateTime,currTime,hasRun,primaryItem,derivedIt time0 = currTime time = currTime if (present(primaryItem)) then - + if (primaryItem%AlarmIsEnabled) then doUpdate = primaryItem%update_alarm%is_ringing(currTime,__RC__) if (hasRun .eqv. .false.) doUpdate = .true. @@ -4095,11 +4095,11 @@ subroutine CheckUpdate(doUpdate,updateTime,currTime,hasRun,primaryItem,derivedIt end if end if end if - + _RETURN(ESMF_SUCCESS) end subroutine CheckUpdate - subroutine SetRefreshAlarms(clock,primaryItem,derivedItem,rc) + subroutine SetRefreshAlarms(clock,primaryItem,derivedItem,rc) type(ESMF_Clock), intent(inout) :: Clock type(PrimaryExport), optional, intent(inout) :: primaryItem type(DerivedExport), optional, intent(inout) :: derivedItem @@ -4129,7 +4129,7 @@ subroutine SetRefreshAlarms(clock,primaryItem,derivedItem,rc) call MAPL_NCIOParseTimeUnits(ctInt,iyy,imm,idd,ihh,imn,isc,status) _VERIFY(STATUS) call ESMF_TimeIntervalSet(tInterval,yy=iyy,mm=imm,d=idd,h=ihh,m=imn,s=isc,rc=status) - _VERIFY(STATUS) + _VERIFY(STATUS) if (present(primaryItem)) then primaryItem%update_alarm = simpleAlarm(current_time,tInterval,rc=status) _VERIFY(status) @@ -4245,7 +4245,7 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) character(len=ESMF_MAXSTR) :: Iam logical :: getRL_ - + Iam = "MAPL_ExtDataGetBracket" if (present(getRL)) then @@ -4258,7 +4258,7 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) if (present(field)) then - if (Bside == MAPL_ExtDataLeft .and. vcomp == 1) then + if (Bside == MAPL_ExtDataLeft .and. vcomp == 1) then if (getRL_) then field = item%modelGridFields%v1_faux1 _RETURN(ESMF_SUCCESS) @@ -4266,7 +4266,7 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) field = item%modelGridFields%v1_finterp1 _RETURN(ESMF_SUCCESS) end if - else if (Bside == MAPL_ExtDataLeft .and. vcomp == 2) then + else if (Bside == MAPL_ExtDataLeft .and. vcomp == 2) then if (getRL_) then field = item%modelGridFields%v2_faux1 _RETURN(ESMF_SUCCESS) @@ -4274,7 +4274,7 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) field = item%modelGridFields%v2_finterp1 _RETURN(ESMF_SUCCESS) end if - else if (Bside == MAPL_ExtDataRight .and. vcomp == 1) then + else if (Bside == MAPL_ExtDataRight .and. vcomp == 1) then if (getRL_) then field = item%modelGridFields%v1_faux2 _RETURN(ESMF_SUCCESS) @@ -4282,7 +4282,7 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) field = item%modelGridFields%v1_finterp2 _RETURN(ESMF_SUCCESS) end if - else if (Bside == MAPL_ExtDataRight .and. vcomp == 2) then + else if (Bside == MAPL_ExtDataRight .and. vcomp == 2) then if (getRL_) then field = item%modelGridFields%v2_faux2 _RETURN(ESMF_SUCCESS) @@ -4304,7 +4304,7 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) if (getRL_) then field = item%modelGridFields%v1_faux1 _RETURN(ESMF_SUCCESS) - else + else field = item%modelGridFields%v1_finterp1 _RETURN(ESMF_SUCCESS) end if @@ -4312,16 +4312,16 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) if (getRL_) then field = item%modelGridFields%v1_faux2 _RETURN(ESMF_SUCCESS) - else + else field = item%modelGridFields%v1_finterp2 _RETURN(ESMF_SUCCESS) end if end if else if (present(bundle)) then - if (Bside == MAPL_ExtDataLeft) then + if (Bside == MAPL_ExtDataLeft) then bundle = item%binterp1 _RETURN(ESMF_SUCCESS) - else if (Bside == MAPL_ExtDataRight) then + else if (Bside == MAPL_ExtDataRight) then bundle = item%binterp2 _RETURN(ESMF_SUCCESS) end if @@ -4379,16 +4379,16 @@ subroutine MAPL_ExtDataFillField(item,FieldF,FieldR,rc) end if _RETURN(ESMF_SUCCESS) - + end subroutine MAPL_ExtDataFillField subroutine MAPL_ExtDataFlipVertical(item,filec,rc) type(PrimaryExport), intent(inout) :: item integer, intent(in) :: filec integer, optional, intent(out) :: rc - + integer :: status - + type(ESMF_Field) :: Field,field1,field2 real, pointer :: ptr(:,:,:) real, allocatable :: ptemp(:,:,:) @@ -4445,9 +4445,9 @@ subroutine MAPL_ExtDataPopulateBundle(item,filec,pbundle,rc) integer, intent(in) :: filec type(ESMF_FieldBundle), intent(inout) :: pbundle integer, optional, intent(out) :: rc - + integer :: status - + type(ESMF_Field) :: Field,field1,field2 type(ESMF_Grid) :: grid @@ -4507,7 +4507,7 @@ subroutine MAPL_ExtDataCreateCFIO(IOBundles, rc) type (IoBundleVectorIterator) :: bundle_iter type (ExtData_IoBundle), pointer :: io_bundle integer :: status - + bundle_iter = IOBundles%begin() do while (bundle_iter /= IOBundles%end()) io_bundle => bundle_iter%get() @@ -4610,7 +4610,7 @@ end subroutine createFileLevBracket subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,file,bside,time_index,rc) type(Iobundlevector), intent(inout) :: IOBundles - type(primaryExport), intent(in) :: item + type(primaryExport), intent(in) :: item integer, intent(in) :: entry_num character(len=*), intent(in) :: file integer, intent(in) :: bside diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 4c4d0bf1aec2..c0ee19fbc800 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -541,7 +541,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) else if (trim(cFileOrder) == 'AddOrder') then intstate%fileOrderAlphabetical = .false. else - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if call ESMF_ConfigGetAttribute(config, value=intstate%integer_time,label="IntegerTime:", default=.false.,_RC) @@ -1421,7 +1421,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) else if (index(list(n)%field_set%fields(1,m),'%') /= 0) then call WRITE_PARALLEL('Can not do arithmetic expression with bundle item') - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end if enddo @@ -2579,7 +2579,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) case (3) print *, ' XY-offset: ',list(n)%xyoffset,' (DePe: Dateline Edge, Pole Edge)' case default - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end select !print *, ' Fields: ',((trim(list(n)%field_set%fields(3,m)),' '),m=1,list(n)%field_set%nfields) @@ -3009,7 +3009,7 @@ function hasSplitableField(fldName, rc) result(okToSplit) exp_state = export(k) call MAPL_StateGet(exp_state,baseName,fld,__RC__) - + okToSplit = hasSplitField(fld, __RC__) if (okToSplit) then @@ -5085,7 +5085,7 @@ subroutine MAPL_SetExpression(nfield,fields,tmpfields,rewrite,nPExtraFields, & if (ifound_vloc) then if (ivLoc /= Totloc(i) .and. totloc(i) /= MAPL_VLocationNone) then - _ASSERT(.false.,'arithmetic expression has two different vlocations') + _FAIL('arithmetic expression has two different vlocations') end if else if (totloc(i) /= MAPL_VLocationNone) then @@ -5381,7 +5381,7 @@ subroutine shavebits( state, list, rc) call pFIO_DownBit(ptr3d,ptr3d,list%nbits,undef=MAPL_undef,rc=status) _VERIFY(STATUS) else - _ASSERT(.false. ,'The field rank is not implmented') + _FAIL('The field rank is not implmented') endif enddo diff --git a/gridcomps/History/MAPL_HistoryTrajectoryMod.F90 b/gridcomps/History/MAPL_HistoryTrajectoryMod.F90 index 00812e736fd3..94e0d1c3d3a8 100644 --- a/gridcomps/History/MAPL_HistoryTrajectoryMod.F90 +++ b/gridcomps/History/MAPL_HistoryTrajectoryMod.F90 @@ -596,7 +596,7 @@ subroutine get_file_start_time(this,start_time,time_units,rc) endif endif class default - _ASSERT(.false.,"Time unit must be character") + _FAIL("Time unit must be character") end select call ESMF_TimeSet(start_time,yy=year,mm=month,dd=day,h=hour,m=min,s=sec,rc=status) _VERIFY(status) diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index ea18ad2c1dba..84b5b63dfb0c 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -301,7 +301,7 @@ subroutine CreateVariable(this,itemName,rc) else if (fieldRank==3) then vdims=grid_dims//",lev,time" else - _ASSERT(.false., 'Unsupported field rank') + _FAIL( 'Unsupported field rank') end if v = Variable(type=PFIO_REAL32,dimensions=vdims,chunksizes=this%chunking,deflation=this%deflateLevel) call v%add_attribute('units',trim(units)) @@ -541,7 +541,7 @@ subroutine RegridScalar(this,itemName,rc) _VERIFY(status) end if else - _ASSERT(.false.,'rank not supported') + _FAIL('rank not supported') end if if (allocated(ptr3d_inter)) deallocate(ptr3d_inter) @@ -851,7 +851,7 @@ subroutine stageData(this, field, fileName, tIndex, oClients, rc) allocate(globalStart,source=[gridGlobalStart,1,tindex]) allocate(globalCount,source=[gridGlobalCount,lm,1]) else - _ASSERT(.false., "Rank not supported") + _FAIL( "Rank not supported") end if call oClients%collective_stage_data(this%write_collection_id,trim(filename),trim(fieldName), & ref,start=localStart, global_start=GlobalStart, global_count=GlobalCount) @@ -1104,7 +1104,7 @@ subroutine swap_undef_value(this,fname,rc) end if where(ptr3d==fill_value) ptr3d=MAPL_UNDEF else - _ASSERT(.false.,'rank not supported') + _FAIL('rank not supported') end if end if _RETURN(_SUCCESS) diff --git a/griddedio/Regrid_Util.F90 b/griddedio/Regrid_Util.F90 index f5affdc4d7d2..b23a7f008765 100644 --- a/griddedio/Regrid_Util.F90 +++ b/griddedio/Regrid_Util.F90 @@ -185,7 +185,7 @@ subroutine process_command_line(this,rc) if (trim(regridMth) .ne. 'bilinear' .and. trim(regridMth ) .ne. 'conservative' .and. trim(regridMth ) .ne. 'conservative2' .and. & trim(regridMth).ne.'patch') then if (MAPL_AM_I_Root()) write(*,*)'invalid regrid method choose bilinear or conservative' - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if if (trim(regridMth) == 'bilinear') then this%regridMethod = REGRID_METHOD_BILINEAR diff --git a/include/MAPL_ErrLog.h b/include/MAPL_ErrLog.h index 6c5dacb8a597..cfb717379045 100644 --- a/include/MAPL_ErrLog.h +++ b/include/MAPL_ErrLog.h @@ -109,7 +109,7 @@ # define _ASSERT(A,msg) _ASSERT_MSG_AND_LOC(A,msg,1,_FILE_,__LINE__) # define _ASSERT_RC(A,msg,stat) _ASSERT_MSG_AND_LOC(A,msg,stat,_FILE_,__LINE__) # define _ASSERT_NOMSG(A) _ASSERT(A,'needs informative message') -# define _FAIL(msg) _ASSERT(.false.,msg) +# define _FAIL(msg) _FAIL(msg) # endif diff --git a/pfio/AbstractDataReference.F90 b/pfio/AbstractDataReference.F90 index bfe9704b1f34..2a31225eb722 100644 --- a/pfio/AbstractDataReference.F90 +++ b/pfio/AbstractDataReference.F90 @@ -140,7 +140,7 @@ subroutine fetch_data(this,offset_address,global_shape,offset_start, rc) full_rank = size(global_shape) if(size(this%shape) > full_rank) then - _ASSERT(.false.,"ranks do not agree (probably fixable)") + _FAIL("ranks do not agree (probably fixable)") endif allocate(count(full_rank)) @@ -176,7 +176,7 @@ subroutine fetch_data(this,offset_address,global_shape,offset_start, rc) call c_f_pointer(offset_address, all_real64_0d) values_real64_0d=all_real64_0d case default - _ASSERT(.false.,"type not supported yet") + _FAIL("type not supported yet") end select case(1) s1=start(1) @@ -199,7 +199,7 @@ subroutine fetch_data(this,offset_address,global_shape,offset_start, rc) call c_f_pointer(offset_address, all_real64_1d, global_shape) values_real64_1d=all_real64_1d(s1:e1) case default - _ASSERT(.false.,"type not supported yet") + _FAIL("type not supported yet") end select case(2) s1=start(1) @@ -224,7 +224,7 @@ subroutine fetch_data(this,offset_address,global_shape,offset_start, rc) call c_f_pointer(offset_address, all_real64_2d, global_shape) values_real64_2d=all_real64_2d(s1:e1,s2:e2) case default - _ASSERT(.false.,"type not supported yet") + _FAIL("type not supported yet") end select case (3) s1=start(1) @@ -251,7 +251,7 @@ subroutine fetch_data(this,offset_address,global_shape,offset_start, rc) call c_f_pointer(offset_address, all_real64_3d, global_shape) values_real64_3d=all_real64_3d(s1:e1,s2:e2,s3:e3) case default - _ASSERT(.false.,"type not supported yet") + _FAIL("type not supported yet") end select case (4) s1=start(1) @@ -280,7 +280,7 @@ subroutine fetch_data(this,offset_address,global_shape,offset_start, rc) call c_f_pointer(offset_address, all_real64_4d, global_shape) values_real64_4d=all_real64_4d(s1:e1,s2:e2,s3:e3,s4:e4) case default - _ASSERT(.false.,"type not supported yet") + _FAIL("type not supported yet") end select case (5) @@ -312,11 +312,11 @@ subroutine fetch_data(this,offset_address,global_shape,offset_start, rc) call c_f_pointer(offset_address, all_real64_5d, global_shape) values_real64_5d=all_real64_5d(s1:e1,s2:e2,s3:e3,s4:e4,s5:e5) case default - _ASSERT(.false.,"type not supported yet") + _FAIL("type not supported yet") end select case default - _ASSERT(.false.,"dimension not supported yet") + _FAIL("dimension not supported yet") end select end subroutine fetch_data diff --git a/pfio/AbstractServer.F90 b/pfio/AbstractServer.F90 index 3793a237309f..1224f5b0ffa6 100644 --- a/pfio/AbstractServer.F90 +++ b/pfio/AbstractServer.F90 @@ -315,20 +315,20 @@ subroutine receive_output_data(this, rc) class (AbstractServer),target, intent(inout) :: this integer, optional, intent(out) :: rc - _ASSERT(.false.," no action of receive_output_data") + _FAIL(" no action of receive_output_data") end subroutine receive_output_data subroutine put_DataToFile(this, rc) class (AbstractServer),target, intent(inout) :: this integer, optional, intent(out) :: rc - _ASSERT(.false.," no action of server_put_DataToFile") + _FAIL(" no action of server_put_DataToFile") end subroutine put_DataToFile subroutine get_DataFromMem(this,multi, rc) class (AbstractServer),target, intent(inout) :: this logical, intent(in) :: multi integer, optional, intent(out) :: rc - _ASSERT(.false.," no action of server_get_DataFromMem") + _FAIL(" no action of server_get_DataFromMem") _UNUSED_DUMMY(multi) end subroutine get_DataFromMem diff --git a/pfio/ArrayReference.F90 b/pfio/ArrayReference.F90 index 716faaa5cd80..c821a7ee6d3b 100644 --- a/pfio/ArrayReference.F90 +++ b/pfio/ArrayReference.F90 @@ -55,7 +55,7 @@ function new_ArrayReference_0d(scalar, rc) result(reference) type is (integer(kind=INT64)) reference%base_address = c_loc(scalar) class default - _ASSERT(.false., "ArrayRef does not support this type") + _FAIL( "ArrayRef does not support this type") end select reference%shape = shape(scalar) reference%type_kind = type_kind(scalar) @@ -81,7 +81,7 @@ function new_ArrayReference_1d(array, rc) result(reference) reference%base_address = c_loc(array) reference%type_kind = pFIO_INT64 class default - _ASSERT(.false., "ArrayRef does not support this type") + _FAIL( "ArrayRef does not support this type") end select reference%shape = shape(array) @@ -108,7 +108,7 @@ function new_ArrayReference_2d(array, rc) result(reference) reference%base_address = c_loc(array) reference%type_kind = pFIO_INT64 class default - _ASSERT(.false., "ArrayRef does not support this type") + _FAIL( "ArrayRef does not support this type") end select reference%shape = shape(array) @@ -135,7 +135,7 @@ function new_ArrayReference_3d(array, rc) result(reference) reference%base_address = c_loc(array) reference%type_kind = pFIO_INT64 class default - _ASSERT(.false., "ArrayRef does not support this type") + _FAIL( "ArrayRef does not support this type") end select reference%shape = shape(array) @@ -163,7 +163,7 @@ function new_ArrayReference_4d(array, rc) result(reference) reference%base_address = c_loc(array) reference%type_kind = pFIO_INT64 class default - _ASSERT(.false., "ArrayRef does not support this type") + _FAIL( "ArrayRef does not support this type") end select reference%shape = shape(array) @@ -190,7 +190,7 @@ function new_ArrayReference_5d(array, rc) result(reference) reference%base_address = c_loc(array) reference%type_kind = pFIO_INT64 class default - _ASSERT(.false., "ArrayRef does not support this type") + _FAIL( "ArrayRef does not support this type") end select reference%shape = shape(array) @@ -213,7 +213,7 @@ integer function type_kind(element, rc) type is (real(kind=REAL64)) type_kind = pFIO_REAL64 class default - _ASSERT(.false.,'kind error') + _FAIL('kind error') end select _RETURN(_SUCCESS) end function type_kind diff --git a/pfio/BaseServer.F90 b/pfio/BaseServer.F90 index 472df508f2f5..4ec1c741859b 100644 --- a/pfio/BaseServer.F90 +++ b/pfio/BaseServer.F90 @@ -125,7 +125,7 @@ subroutine put_DataToFile(this, rc) type is (RDMAReference) remotePtr=>dataRefPtr class default - _ASSERT(.false., "remote is a must") + _FAIL( "remote is a must") end select request_iter = this%stage_offset%find(i_to_string(q%request_id)//'done') @@ -219,7 +219,7 @@ function get_dmessage(this, rc) result(dmessage) type is (MpiSocket) allocate(dmessage,source = DummyMessage()) class default - _ASSERT(.false., "wrong socket type") + _FAIL( "wrong socket type") end select _RETURN(_SUCCESS) diff --git a/pfio/ClientThread.F90 b/pfio/ClientThread.F90 index 1706c66c97ec..50adf0fff852 100644 --- a/pfio/ClientThread.F90 +++ b/pfio/ClientThread.F90 @@ -123,7 +123,7 @@ function add_ext_collection(this, template, rc) result(collection_id) type is(IDMessage) collection_id = message%id class default - _ASSERT(.false., " should get id message") + _FAIL( " should get id message") end select _RETURN(_SUCCESS) end function add_ext_collection @@ -146,7 +146,7 @@ function add_hist_collection(this, fmd, rc) result(hist_collection_id) type is(IDMessage) hist_collection_id = message%id class default - _ASSERT(.false., " should get id message") + _FAIL( " should get id message") end select _RETURN(_SUCCESS) @@ -172,7 +172,7 @@ subroutine replace_hist_collection(this,hist_collection_id,fmd, rc) type is(IDMessage) return_id = message%id class default - _ASSERT(.false., " should get id message") + _FAIL( " should get id message") end select _ASSERT( return_id == hist_collection_id, "return id should be the same as the collection_id") diff --git a/pfio/CoordinateVariable.F90 b/pfio/CoordinateVariable.F90 index e692e4a59f00..9ae8cade769a 100644 --- a/pfio/CoordinateVariable.F90 +++ b/pfio/CoordinateVariable.F90 @@ -119,7 +119,7 @@ subroutine get_real32(this, coordinate_data, unusable, rc) type is (real(kind=REAL32)) coordinate_data => q class default ! wrong type - _ASSERT(.false., "wrong type") + _FAIL( "wrong type") end select _RETURN(_SUCCESS) @@ -138,7 +138,7 @@ subroutine get_real64(this, coordinate_data, unusable, rc) type is (real(kind=REAL64)) coordinate_data => q class default ! wrong type - _ASSERT(.false., 'wrong type') + _FAIL( 'wrong type') end select _RETURN(_SUCCESS) @@ -156,7 +156,7 @@ subroutine get_int32(this, coordinate_data, unusable, rc) type is (integer(kind=INT32)) coordinate_data => q class default ! wrong type - _ASSERT(.false., 'wrong type') + _FAIL( 'wrong type') end select _RETURN(_SUCCESS) @@ -174,7 +174,7 @@ subroutine get_int64(this, coordinate_data, unusable, rc) type is (integer(kind=INT64)) coordinate_data => q class default ! wrong type - _ASSERT(.false., 'wrong type') + _FAIL( 'wrong type') end select _RETURN(_SUCCESS) @@ -209,7 +209,7 @@ subroutine serialize(this, buffer, rc) type_kind = pFIO_REAL64 buffer =[tmp_buffer, serialize_intrinsic(type_kind),serialize_intrinsic(coord)] class default - _ASSERT(.false.,"not support coord type") + _FAIL("not support coord type") end select length = serialize_buffer_length(length)+ serialize_buffer_length(Coord_SERIALIZE_TYPE) + size(buffer) buffer = [serialize_intrinsic(length), serialize_intrinsic(Coord_SERIALIZE_TYPE), buffer] @@ -273,7 +273,7 @@ subroutine deserialize(this, buffer, rc) call deserialize_intrinsic(buffer(n:),values_REAL64) allocate(this%coordinate_data, source = values_real64) case default - _ASSERT(.false., "not supportted type") + _FAIL( "not supportted type") end select _RETURN(_SUCCESS) end subroutine deserialize diff --git a/pfio/FileMetadata.F90 b/pfio/FileMetadata.F90 index 7db3a79ab68c..8d68728e4c0d 100644 --- a/pfio/FileMetadata.F90 +++ b/pfio/FileMetadata.F90 @@ -160,7 +160,7 @@ integer function get_dimension(this, dim_name, unusable, rc) result(extent) else extent = 0 if (present(rc)) rc=pFIO_DIMENSION_NOT_FOUND - !_ASSERT(.false., 'FileMetadata::get_dimension() - no such dimension <'//dim_name//'>.') + !_FAIL( 'FileMetadata::get_dimension() - no such dimension <'//dim_name//'>.') end if _UNUSED_DUMMY(unusable) diff --git a/pfio/LocalMemReference.F90 b/pfio/LocalMemReference.F90 index 23d74414fa53..bae5ebfb3b0a 100644 --- a/pfio/LocalMemReference.F90 +++ b/pfio/LocalMemReference.F90 @@ -90,7 +90,7 @@ function new_LocalMemReference_0d(scalar, rc) result(reference) call c_f_pointer(reference%base_address, real64Ptr) real64Ptr = scalar class default - _ASSERT(.false., "LocalMemRef does not support this type") + _FAIL( "LocalMemRef does not support this type") end select _RETURN(_SUCCESS) @@ -140,7 +140,7 @@ function new_LocalMemReference_1d(array, rc) result(reference) call c_f_pointer(reference%base_address, real64Ptr, shape=shape(array)) real64Ptr = array class default - _ASSERT(.false., "LocalMemRef does not support this type") + _FAIL( "LocalMemRef does not support this type") end select _RETURN(_SUCCESS) @@ -191,7 +191,7 @@ function new_LocalMemReference_2d(array, rc) result(reference) call c_f_pointer(reference%base_address, real64Ptr, shape=shape(array)) real64Ptr = array class default - _ASSERT(.false., "LocalMemRef does not support this type") + _FAIL( "LocalMemRef does not support this type") end select _RETURN(_SUCCESS) @@ -242,7 +242,7 @@ function new_LocalMemReference_3d(array, rc) result(reference) call c_f_pointer(reference%base_address, real64Ptr, shape=shape(array)) real64Ptr = array class default - _ASSERT(.false., "LocalMemRef does not support this type") + _FAIL( "LocalMemRef does not support this type") end select _RETURN(_SUCCESS) @@ -293,7 +293,7 @@ function new_LocalMemReference_4d(array, rc) result(reference) call c_f_pointer(reference%base_address, real64Ptr, shape=shape(array)) real64Ptr = array class default - _ASSERT(.false., "LocalMemRef does not support this type") + _FAIL( "LocalMemRef does not support this type") end select _RETURN(_SUCCESS) @@ -344,7 +344,7 @@ function new_LocalMemReference_5d(array, rc) result(reference) call c_f_pointer(reference%base_address, real64Ptr, shape=shape(array)) real64Ptr = array class default - _ASSERT(.false., "LocalMemRef does not support this type") + _FAIL( "LocalMemRef does not support this type") end select _RETURN(_SUCCESS) diff --git a/pfio/MessageVisitor.F90 b/pfio/MessageVisitor.F90 index c1a1805545b2..e2134c940693 100644 --- a/pfio/MessageVisitor.F90 +++ b/pfio/MessageVisitor.F90 @@ -126,7 +126,7 @@ recursive subroutine handle(this, message, rc) ! if the serverthread sends the dummy directly to clientthread, it will not go through here. _VERIFY(0) class default - _ASSERT(.false., 'unsupported subclass') + _FAIL( 'unsupported subclass') end select _RETURN(_SUCCESS) end subroutine handle @@ -135,7 +135,7 @@ subroutine handle_CollectivePrefetchData(this, message, rc) class (MessageVisitor), intent(inout) :: this type (CollectivePrefetchDataMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_CollectivePrefetchData should not be called") + _FAIL( "Warning : dummy handle_CollectivePrefetchData should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_CollectivePrefetchData @@ -144,7 +144,7 @@ subroutine handle_CollectiveStageData(this, message, rc) class (MessageVisitor), intent(inout) :: this type (CollectiveStageDataMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_CollectiveStageData should not be called") + _FAIL( "Warning : dummy handle_CollectiveStageData should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_CollectiveStageData @@ -153,7 +153,7 @@ subroutine handle_Terminate(this, message, rc) class (MessageVisitor), intent(inout) :: this type (TerminateMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_Terminate should not be called") + _FAIL( "Warning : dummy handle_Terminate should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_Terminate @@ -162,7 +162,7 @@ subroutine handle_Done(this, message, rc) class (MessageVisitor), target, intent(inout) :: this type (DoneMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_Done should not be called") + _FAIL( "Warning : dummy handle_Done should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_Done @@ -171,7 +171,7 @@ subroutine handle_Done_prefetch(this, message, rc) class (MessageVisitor), target, intent(inout) :: this type (PrefetchDoneMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_Done_prefetch should not be called") + _FAIL( "Warning : dummy handle_Done_prefetch should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_Done_prefetch @@ -180,7 +180,7 @@ subroutine handle_Done_collective_prefetch(this, message, rc) class (MessageVisitor), target, intent(inout) :: this type (CollectivePrefetchDoneMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_Done_collective_prefetch should not be called") + _FAIL( "Warning : dummy handle_Done_collective_prefetch should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_Done_collective_prefetch @@ -189,7 +189,7 @@ subroutine handle_Done_stage(this, message, rc) class (MessageVisitor), target, intent(inout) :: this type (StageDoneMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_Done_stage should not be called") + _FAIL( "Warning : dummy handle_Done_stage should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_Done_stage @@ -198,7 +198,7 @@ subroutine handle_Done_collective_stage(this, message, rc) class (MessageVisitor), target, intent(inout) :: this type (CollectiveStageDoneMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_Done_collective_stage should not be called") + _FAIL( "Warning : dummy handle_Done_collective_stage should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_Done_collective_stage @@ -207,7 +207,7 @@ subroutine handle_AddExtCollection(this, message, rc) class (MessageVisitor), target, intent(inout) :: this type (AddExtCollectionMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_AddExtCollection should not be called") + _FAIL( "Warning : dummy handle_AddExtCollection should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_AddExtCollection @@ -216,7 +216,7 @@ subroutine handle_AddHistCollection(this, message, rc) class (MessageVisitor), target, intent(inout) :: this type (AddHistCollectionMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_AddHistCollection should not be called") + _FAIL( "Warning : dummy handle_AddHistCollection should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_AddHistCollection @@ -225,7 +225,7 @@ subroutine handle_Id(this, message, rc) class (MessageVisitor), intent(inout) :: this type (IdMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_ID should not be called. hint: maybe server and app are the same?") + _FAIL( "Warning : dummy handle_ID should not be called. hint: maybe server and app are the same?") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_Id @@ -234,7 +234,7 @@ subroutine handle_PrefetchData(this, message, rc) class (MessageVisitor), intent(inout) :: this type (PrefetchDataMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_PrefetchData should not be called") + _FAIL( "Warning : dummy handle_PrefetchData should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_PrefetchData @@ -243,7 +243,7 @@ subroutine handle_StageData(this, message, rc) class (MessageVisitor), intent(inout) :: this type (StageDataMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_StageData should not be called") + _FAIL( "Warning : dummy handle_StageData should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_StageData @@ -252,7 +252,7 @@ subroutine handle_ModifyMetadata(this, message, rc) class (MessageVisitor), intent(inout) :: this type (ModifyMetadataMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_ModifyMetadata should not be called") + _FAIL( "Warning : dummy handle_ModifyMetadata should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_ModifyMetadata @@ -261,7 +261,7 @@ subroutine handle_HandShake(this, message, rc) class (MessageVisitor), target, intent(inout) :: this type (HandShakeMessage), intent(in) :: message integer, optional, intent(out) :: rc - _ASSERT(.false., "Warning : dummy handle_HandShake should not be called") + _FAIL( "Warning : dummy handle_HandShake should not be called") _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) end subroutine handle_HandShake diff --git a/pfio/MultiCommServer.F90 b/pfio/MultiCommServer.F90 index 5d1f2246e167..99cd49a4c034 100644 --- a/pfio/MultiCommServer.F90 +++ b/pfio/MultiCommServer.F90 @@ -482,7 +482,7 @@ subroutine clean_up(this, rc) type is (LocalMemReference) i_ptr =>dataRefPtr%i_ptr class default - _ASSERT(.false., "I expect localmemReference") + _FAIL( "I expect localmemReference") end select iter = this%stage_offset%find(i_to_string(q%request_id)//'done') @@ -497,7 +497,7 @@ subroutine clean_up(this, rc) call this%stage_offset%insert(i_to_string(q%request_id)//'done',0_MPI_ADDRESS_KIND) endif class default - _ASSERT(.false., "I expect CollectiveStageDataMessage") + _FAIL( "I expect CollectiveStageDataMessage") end select call msg_iter%next() enddo diff --git a/pfio/MultiGroupServer.F90 b/pfio/MultiGroupServer.F90 index ec7d9a4901e3..ec8ef6ab7b27 100644 --- a/pfio/MultiGroupServer.F90 +++ b/pfio/MultiGroupServer.F90 @@ -264,7 +264,7 @@ subroutine put_DataToFile(this, rc) class (MultiGroupServer),target, intent(inout) :: this integer, optional, intent(out) :: rc if (this%front_Comm == MPI_COMM_NULL) then - _ASSERT(.false. , "hey backend does not call this") + _FAIL("hey backend does not call this") else _RETURN(_SUCCESS) endif @@ -383,7 +383,7 @@ subroutine receive_output_data(this, rc) endif if (associated(ioserver_profiler)) call ioserver_profiler%stop("collection_"//i_to_string(q%collection_id)) class default - _ASSERT(.false., "yet to implemented") + _FAIL( "yet to implemented") end select call iter%next() end do ! iter @@ -684,7 +684,7 @@ subroutine start_back_writers(rc) q%start(1) = word_size(q%type_kind)*(q%start(1)-1)+1 select case (d_rank) case (0) - _ASSERT(.false., "scalar ?? ") + _FAIL( "scalar ?? ") case (1) call c_f_pointer(address, g_1d, shape=q%global_count) msize_word = product(q%count) diff --git a/pfio/MultiLayerServer.F90 b/pfio/MultiLayerServer.F90 index 6857e179029f..48a96b8be76f 100644 --- a/pfio/MultiLayerServer.F90 +++ b/pfio/MultiLayerServer.F90 @@ -180,7 +180,7 @@ subroutine put_DataToFile(this, rc) type is (RDMAReference) remotePtr=>dataRefPtr class default - _ASSERT(.false., "remote is a must") + _FAIL( "remote is a must") end select request_iter = this%stage_offset%find(i_to_string(q%request_id)//'done') diff --git a/pfio/NetCDF4_FileFormatter.F90 b/pfio/NetCDF4_FileFormatter.F90 index ffadf77f9d53..382921e4b9c3 100644 --- a/pfio/NetCDF4_FileFormatter.F90 +++ b/pfio/NetCDF4_FileFormatter.F90 @@ -234,7 +234,7 @@ subroutine open(this, file, mode, unusable, comm, info, rc) case (pFIO_WRITE) omode = NF90_WRITE case default - _ASSERT(.false.,"read or write mode") + _FAIL("read or write mode") end select if (present(comm)) then diff --git a/pfio/ServerThread.F90 b/pfio/ServerThread.F90 index 832394bf368c..ca33c9f8a877 100644 --- a/pfio/ServerThread.F90 +++ b/pfio/ServerThread.F90 @@ -255,19 +255,19 @@ recursive subroutine handle_Done(this, message, rc) select type (q=>msg) type is (PrefetchDataMessage) - _ASSERT(.false., "please use done_prefetch") + _FAIL( "please use done_prefetch") _RETURN(_SUCCESS) type is (CollectivePrefetchDataMessage) - _ASSERT(.false., "please use done_collective_prefetch") + _FAIL( "please use done_collective_prefetch") _RETURN(_SUCCESS) type is (StageDataMessage) - _ASSERT(.false., "please use done_stage") + _FAIL( "please use done_stage") _RETURN(_SUCCESS) type is (CollectiveStageDataMessage) - _ASSERT(.false., "please use done_collective_stage") + _FAIL( "please use done_collective_stage") _RETURN(_SUCCESS) class default - _ASSERT(.false., "Wrong message type") + _FAIL( "Wrong message type") end select @@ -681,7 +681,7 @@ subroutine get_DataFromFile(this,message,address, rc) start = message%global_start count = message%global_count class default - _ASSERT(.false., "wrong PrefetchDataMessage type") + _FAIL( "wrong PrefetchDataMessage type") end select ! if (product(count) /= product(file_data_reference%shape)) stop "memory size not match" @@ -701,7 +701,7 @@ subroutine get_DataFromFile(this,message,address, rc) call c_f_pointer(address, values_real64_0d) call formatter%get_var(message%var_name, values_real64_0d, _RC) case default - _ASSERT(.false., "Not supported type") + _FAIL( "Not supported type") end select case (1:) select case (message%type_kind) @@ -718,7 +718,7 @@ subroutine get_DataFromFile(this,message,address, rc) call c_f_pointer(address, values_real64_1d, [product(count)]) call formatter%get_var(message%var_name, values_real64_1d, start=start, count=count, _RC) case default - _ASSERT(.false., "Not supported type") + _FAIL( "Not supported type") end select end select @@ -808,7 +808,7 @@ subroutine put_DataToFile(this, message, address, rc) count = message%global_count class default - _ASSERT(.false., "wrong StageDataMessage type") + _FAIL( "wrong StageDataMessage type") end select ! if (product(count) /= product(file_data_reference%shape)) stop "memory size not match" select case (size(count)) ! rank @@ -827,7 +827,7 @@ subroutine put_DataToFile(this, message, address, rc) call c_f_pointer(address, values_real64_0d) call formatter%put_var(message%var_name, values_real64_0d, _RC) case default - _ASSERT(.false., "not supported type") + _FAIL( "not supported type") end select case (1:) select case (message%type_kind) @@ -844,7 +844,7 @@ subroutine put_DataToFile(this, message, address, rc) call c_f_pointer(address, values_real64_1d, [product(count)]) call formatter%put_var(message%var_name, values_real64_1d, start=start, count=count, _RC) case default - _ASSERT(.false., "not supported type") + _FAIL( "not supported type") end select end select @@ -904,7 +904,7 @@ subroutine receive_output_data(this, rc) type is (RDMAReference) remotePtr=>dataRefPtr class default - _ASSERT(.false., " need a remote pointer") + _FAIL( " need a remote pointer") end select rank = remotePtr%mem_rank @@ -916,7 +916,7 @@ subroutine receive_output_data(this, rc) endif ! local_size > 0 class default - _ASSERT(.false., "receive_output_data") + _FAIL( "receive_output_data") end select call iter%next() enddo @@ -1028,7 +1028,7 @@ recursive subroutine handle_Done_stage(this, message, rc) call this%request_backlog%erase(iter) class default - _ASSERT(.false., "Wrong message type") + _FAIL( "Wrong message type") end select iter = this%request_backlog%begin() enddo @@ -1067,7 +1067,7 @@ recursive subroutine handle_Done_prefetch(this, message, rc) call this%request_backlog%erase(iter) class default - _ASSERT(.false., "Wrong message type") + _FAIL( "Wrong message type") end select iter = this%request_backlog%begin() enddo @@ -1164,7 +1164,7 @@ subroutine get_DataFromMem( this, multi_data_read, rc) call this%request_backlog%erase(iter) class default - _ASSERT(.false., "Message type should be CollectivePrefetchDataMessage ") + _FAIL( "Message type should be CollectivePrefetchDataMessage ") end select iter = this%request_backlog%begin() enddo diff --git a/pfio/SimpleSocket.F90 b/pfio/SimpleSocket.F90 index 195ae6655914..65344ab9d9d9 100644 --- a/pfio/SimpleSocket.F90 +++ b/pfio/SimpleSocket.F90 @@ -106,7 +106,7 @@ recursive subroutine send(this, message, rc) allocate(connection%msg , source = message) call connection%msg%dispatch(this%visitor, _RC) class default - _ASSERT(.false.,"Simple should connect Simple") + _FAIL("Simple should connect Simple") end select _RETURN(_SUCCESS) ! call message%dispatch(this%visitor,_RC) diff --git a/pfio/UnlimitedEntity.F90 b/pfio/UnlimitedEntity.F90 index 4b21aa8a1b72..a8f3c706c27e 100644 --- a/pfio/UnlimitedEntity.F90 +++ b/pfio/UnlimitedEntity.F90 @@ -110,7 +110,7 @@ function new_UnlimitedEntity_1d(values, rc) result(attr) select type (values) type is (character(len=*)) - _ASSERT(.false., 'unsupported unless shape is [1]') + _FAIL( 'unsupported unless shape is [1]') class default allocate(attr%values, source=values) attr%shape = shape(values) @@ -137,7 +137,7 @@ function new_UnlimitedEntity_2d(values, rc) result(attr) type is (logical) allocate(values1d, source = reshape(values, [product(shape(values))])) class default - _ASSERT(.false., 'not support type') + _FAIL( 'not support type') end select attr = UnlimitedEntity(values1d) @@ -165,7 +165,7 @@ function new_UnlimitedEntity_3d(values, rc) result(attr) type is (logical) allocate(values1d, source = reshape(values, [product(shape(values))])) class default - _ASSERT(.false., 'not support type') + _FAIL( 'not support type') end select attr = UnlimitedEntity(values1d) @@ -193,7 +193,7 @@ function new_UnlimitedEntity_4d(values, rc) result(attr) type is (logical) allocate(values1d, source = reshape(values, [product(shape(values))])) class default - _ASSERT(.false., 'not support type') + _FAIL( 'not support type') end select attr = UnlimitedEntity(values1d) @@ -221,7 +221,7 @@ function new_UnlimitedEntity_5d(values, rc) result(attr) type is (logical) allocate(values1d, source = reshape(values, [product(shape(values))])) class default - _ASSERT(.false., 'not support type') + _FAIL( 'not support type') end select attr = UnlimitedEntity(values1d) @@ -544,7 +544,7 @@ subroutine serialize( this, buffer, rc) serialize_intrinsic(type_kind), & serialize_intrinsic(value%value)] class default - _ASSERT(.false.," type is not supported") + _FAIL(" type is not supported") end select endif case (1:) @@ -581,7 +581,7 @@ subroutine serialize( this, buffer, rc) ! serialize_intrinsic(type_kind), & ! serialize_intrinsic(values)] class default - _ASSERT(.false.," type is not supported") + _FAIL(" type is not supported") end select end select length = serialize_buffer_length(length) + size(buffer) @@ -658,7 +658,7 @@ subroutine deserialize( this, buffer, rc) ! this is uninitialized case, make sure shape is not allocated even it is empty if (allocated(this%shape))deallocate(this%shape) case default - _ASSERT(.false., "UnlimitedEntity deserialize not support") + _FAIL( "UnlimitedEntity deserialize not support") end select case (1:) select case (type_kind) @@ -678,7 +678,7 @@ subroutine deserialize( this, buffer, rc) call deserialize_intrinsic(buffer(n:),values_logical) allocate(this%values, source =values_logical) case default - _ASSERT(.false., "UnlimitedEntity deserialize not support") + _FAIL( "UnlimitedEntity deserialize not support") end select end select diff --git a/pfio/pFIO_Utilities.F90 b/pfio/pFIO_Utilities.F90 index d9152252321c..e94d903b831e 100644 --- a/pfio/pFIO_Utilities.F90 +++ b/pfio/pFIO_Utilities.F90 @@ -514,7 +514,7 @@ integer function word_size(type_kind,rc) case (pFIO_INT64) word_size = c_sizeof(i64)/c_sizeof(i32) case default - _ASSERT(.false., "unsupported type kind") + _FAIL( "unsupported type kind") end select _RETURN(_SUCCESS) diff --git a/pfio/pfio_writer.F90 b/pfio/pfio_writer.F90 index 3e3410749e2f..d567be3afb02 100644 --- a/pfio/pfio_writer.F90 +++ b/pfio/pfio_writer.F90 @@ -232,7 +232,7 @@ subroutine write_data(message, formatter, attr, rc) call c_f_pointer(address, values_real64_0d) call formatter%put_var(message%var_name, values_real64_0d) case default - _ASSERT(.false., "not supported type") + _FAIL( "not supported type") end select case (1:) select case (message%type_kind) @@ -249,7 +249,7 @@ subroutine write_data(message, formatter, attr, rc) call c_f_pointer(address, values_real64_1d, [product(count)]) call formatter%put_var(message%var_name, values_real64_1d, start=start, count=count) case default - _ASSERT(.false., "not supported type") + _FAIL( "not supported type") end select end select end subroutine diff --git a/shared/MAPL_HeapMod.F90 b/shared/MAPL_HeapMod.F90 index 4259394d93ae..ffab5917c1aa 100644 --- a/shared/MAPL_HeapMod.F90 +++ b/shared/MAPL_HeapMod.F90 @@ -139,7 +139,7 @@ end function loadr2d if(I>=NumSegments) then print *, 'MAPL_Alloc: Out of Segments. Need: ', I - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if ! If we are filling a gap, move trailing segments down @@ -174,7 +174,7 @@ end function loadr2d do i=1,NumSegments print *, i, heap%HP_start(i), heap%HP_end(i) end do - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if heap%ptrs(i)%a => heap%buffer(heap%HP_start(i):heap%HP_end(i)) @@ -216,7 +216,7 @@ end function ival1 i = i+1 if(i==NumSegments) then print *, 'MAPL_DeAlloc: Bad Pointer' - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end do @@ -230,7 +230,7 @@ end function ival1 i = i+1 if(i==NumSegments-1) then print *, 'MAPL_DeAlloc: Something wrong. Missed bottom mark' - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if end do diff --git a/shared/Shmem/Shmem_implementation.F90 b/shared/Shmem/Shmem_implementation.F90 index 4de51b02915e..0c1c60851f9f 100644 --- a/shared/Shmem/Shmem_implementation.F90 +++ b/shared/Shmem/Shmem_implementation.F90 @@ -929,7 +929,7 @@ Segs(pos)%shmid = shmget(key, numBytes, shmflg) if (Segs(pos)%shmid < 0) then call perror('server shmget():'//C_NULL_CHAR) - _ASSERT(.false.,'needs informative message') + _FAIL('needs informative message') end if call MPI_Barrier(MAPL_NodeComm, STATUS) _ASSERT(STATUS==MPI_SUCCESS,'needs informative message') From 1477f23d5dd917c3ff7851f5db2ef45a501eb5b2 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 2 May 2022 11:09:46 -0400 Subject: [PATCH 108/300] Undo sed on the main command --- include/MAPL_ErrLog.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/include/MAPL_ErrLog.h b/include/MAPL_ErrLog.h index cfb717379045..6c5dacb8a597 100644 --- a/include/MAPL_ErrLog.h +++ b/include/MAPL_ErrLog.h @@ -109,7 +109,7 @@ # define _ASSERT(A,msg) _ASSERT_MSG_AND_LOC(A,msg,1,_FILE_,__LINE__) # define _ASSERT_RC(A,msg,stat) _ASSERT_MSG_AND_LOC(A,msg,stat,_FILE_,__LINE__) # define _ASSERT_NOMSG(A) _ASSERT(A,'needs informative message') -# define _FAIL(msg) _FAIL(msg) +# define _FAIL(msg) _ASSERT(.false.,msg) # endif From 1b781124489d83be439c73a013517bee62f31923 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 3 May 2022 12:16:57 -0400 Subject: [PATCH 109/300] Closes #1495. Correct ESMF errors with monthly collections --- CHANGELOG.md | 1 + gridcomps/History/MAPL_HistoryGridComp.F90 | 16 +++++++++------- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d626aab3478b..69fc60e46fdc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed - Fixed incorrect legend when using PRINTSPEC option in MAPL Cap +- Fix ESMF errors exposed by monthly collections ### Added diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index c0ee19fbc800..08868fff6ad4 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -490,7 +490,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) ! set up few variables to deal with monthly startOfThisMonth = currTime call ESMF_TimeSet(startOfThisMonth,dd=1,h=0,m=0,s=0,__RC__) - call ESMF_TimeIntervalSet( oneMonth, MM=1, __RC__) + call ESMF_TimeIntervalSet( oneMonth, MM=1, StartTime=StartTime, __RC__) ! Read User-Supplied History Lists from Config File @@ -1257,7 +1257,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) RingTime = startOfThisMonth else sec = MAPL_nsecf( list(n)%frequency ) - call ESMF_TimeIntervalSet( Frequency, S=sec, calendar=cal, rc=status ) ; _VERIFY(STATUS) + call ESMF_TimeIntervalSet( Frequency, S=sec, StartTime=StartTime, rc=status ) ; _VERIFY(STATUS) RingTime = RefTime end if @@ -1280,7 +1280,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) if( list(n)%duration.ne.0 ) then if (.not.list(n)%monthly) then sec = MAPL_nsecf( list(n)%duration ) - call ESMF_TimeIntervalSet( Frequency, S=sec, calendar=cal, rc=status ) ; _VERIFY(STATUS) + call ESMF_TimeIntervalSet( Frequency, S=sec, StartTime=StartTime, rc=status ) ; _VERIFY(STATUS) else Frequency = oneMonth !ALT keep the values from above @@ -3863,6 +3863,7 @@ subroutine MAPL_GradsCtlWrite ( clock, state,list,fname,expid,expdsc,output_grid type(ESMF_Grid) :: grid type(ESMF_Time) :: CurrTime type(ESMF_Time) :: StopTime + type(ESMF_Time) :: StartTime type(ESMF_Calendar) :: cal type(ESMF_TimeInterval) :: ti, Frequency integer :: nsteps @@ -3898,9 +3899,10 @@ subroutine MAPL_GradsCtlWrite ( clock, state,list,fname,expid,expdsc,output_grid 'DTDT' , 'PHYSICS' , & 'DTDT' , 'GWD' / - call ESMF_ClockGet ( clock, currTime=CurrTime ,rc=STATUS ) ; _VERIFY(STATUS) - call ESMF_ClockGet ( clock, StopTime=StopTime ,rc=STATUS ) ; _VERIFY(STATUS) - call ESMF_ClockGet ( clock, Calendar=cal ,rc=STATUS ) ; _VERIFY(STATUS) + call ESMF_ClockGet ( clock, currTime=CurrTime, rc=STATUS ) ; _VERIFY(STATUS) + call ESMF_ClockGet ( clock, StopTime=StopTime, rc=STATUS ) ; _VERIFY(STATUS) + call ESMF_ClockGet ( clock, StartTime=StartTime, rc=STATUS ) ; _VERIFY(STATUS) + call ESMF_ClockGet ( clock, Calendar=cal, rc=STATUS ) ; _VERIFY(STATUS) call ESMF_TimeGet ( CurrTime, timeString=TimeString, rc=status ) ; _VERIFY(STATUS) @@ -3912,7 +3914,7 @@ subroutine MAPL_GradsCtlWrite ( clock, state,list,fname,expid,expdsc,output_grid ti = StopTime-CurrTime freq = MAPL_nsecf( list%frequency ) - call ESMF_TimeIntervalSet( Frequency, S=freq, calendar=cal, rc=status ) ; _VERIFY(STATUS) + call ESMF_TimeIntervalSet( Frequency, S=freq, StartTime=StartTime, rc=status ) ; _VERIFY(STATUS) nsteps = ti/Frequency + 1 From 7e0bb1dee4922f44e6b558b84ba7d019f4714ae9 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 3 May 2022 14:35:41 -0400 Subject: [PATCH 110/300] Closes #1420. Extend profiler width --- CHANGELOG.md | 1 + generic/MAPL_Generic.F90 | 12 ++++++------ pfio/AbstractServer.F90 | 8 ++++---- 3 files changed, 11 insertions(+), 10 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d626aab3478b..a84d9c1bb12e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,6 +18,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed - Change many instances of `_ASSERT(.false.,"msg")` to `_FAIL("msg")` +- Extended format width for exclusive and inclusive times in profiler from `f9.2` to `f10.2` (see #1420) ### Removed diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index bb5c57454c26..783556841f78 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -2184,18 +2184,18 @@ subroutine report_generic_profile( rc ) min_multi = MultiColumn(['Min'], separator='=') call min_multi%add_column(FormattedTextColumn(' % ','(f6.2)', 6, PercentageColumn(ExclusiveColumn('MIN')), separator='-')) - call min_multi%add_column(FormattedTextColumn('inclusive', '(f9.2)', 9, InclusiveColumn('MIN'), separator='-')) - call min_multi%add_column(FormattedTextColumn('exclusive', '(f9.2)',9, ExclusiveColumn('MIN'), separator='-')) + call min_multi%add_column(FormattedTextColumn('inclusive', '(f10.2)', 10, InclusiveColumn('MIN'), separator='-')) + call min_multi%add_column(FormattedTextColumn('exclusive', '(f10.2)',10, ExclusiveColumn('MIN'), separator='-')) mean_multi = MultiColumn(['Mean'], separator='=') call mean_multi%add_column(FormattedTextColumn(' % ','(f6.2)', 6, PercentageColumn(ExclusiveColumn('MEAN')), separator='-')) - call mean_multi%add_column(FormattedTextColumn('inclusive', '(f9.2)', 9, InclusiveColumn('MEAN'), separator='-')) - call mean_multi%add_column(FormattedTextColumn('exclusive', '(f9.2)', 9, ExclusiveColumn('MEAN'), separator='-')) + call mean_multi%add_column(FormattedTextColumn('inclusive', '(f10.2)', 10, InclusiveColumn('MEAN'), separator='-')) + call mean_multi%add_column(FormattedTextColumn('exclusive', '(f10.2)', 10, ExclusiveColumn('MEAN'), separator='-')) max_multi = MultiColumn(['Max'], separator='=') call max_multi%add_column(FormattedTextColumn(' % ','(f6.2)', 6, PercentageColumn(ExclusiveColumn('MAX')), separator='-')) - call max_multi%add_column(FormattedTextColumn('inclusive', '(f9.2)', 9, InclusiveColumn('MAX'), separator='-')) - call max_multi%add_column(FormattedTextColumn('exclusive', '(f9.2)', 9, ExclusiveColumn('MAX'), separator='-')) + call max_multi%add_column(FormattedTextColumn('inclusive', '(f10.2)', 10, InclusiveColumn('MAX'), separator='-')) + call max_multi%add_column(FormattedTextColumn('exclusive', '(f10.2)', 10, ExclusiveColumn('MAX'), separator='-')) pe_multi = MultiColumn(['PE'], separator='=') call pe_multi%add_column(FormattedTextColumn('max','(1x,i5.5)', 6, ExclusiveColumn('MAX_PE'), separator='-')) diff --git a/pfio/AbstractServer.F90 b/pfio/AbstractServer.F90 index 1224f5b0ffa6..232a145d1aa8 100644 --- a/pfio/AbstractServer.F90 +++ b/pfio/AbstractServer.F90 @@ -434,12 +434,12 @@ subroutine report_profile(this, rc ) reporter = ProfileReporter(empty) call reporter%add_column(NameColumn(20)) - call reporter%add_column(FormattedTextColumn('Inclusive','(f9.2)', 9, InclusiveColumn('MEAN'))) + call reporter%add_column(FormattedTextColumn('Inclusive','(f10.2)', 10, InclusiveColumn('MEAN'))) call reporter%add_column(FormattedTextColumn('% Incl','(f6.2)', 6, PercentageColumn(InclusiveColumn('MEAN'),'MAX'))) - call reporter%add_column(FormattedTextColumn('Exclusive','(f9.2)', 9, ExclusiveColumn('MEAN'))) + call reporter%add_column(FormattedTextColumn('Exclusive','(f10.2)', 10, ExclusiveColumn('MEAN'))) call reporter%add_column(FormattedTextColumn('% Excl','(f6.2)', 6, PercentageColumn(ExclusiveColumn('MEAN')))) - call reporter%add_column(FormattedTextColumn(' Max Excl)','(f9.2)', 9, ExclusiveColumn('MAX'))) - call reporter%add_column(FormattedTextColumn(' Min Excl)','(f9.2)', 9, ExclusiveColumn('MIN'))) + call reporter%add_column(FormattedTextColumn(' Max Excl)','(f10.2)', 10, ExclusiveColumn('MAX'))) + call reporter%add_column(FormattedTextColumn(' Min Excl)','(f10.2)', 10, ExclusiveColumn('MIN'))) call reporter%add_column(FormattedTextColumn('Max PE)','(1x,i4.4,1x)', 6, ExclusiveColumn('MAX_PE'))) call reporter%add_column(FormattedTextColumn('Min PE)','(1x,i4.4,1x)', 6, ExclusiveColumn('MIN_PE'))) report_lines = reporter%generate_report(ioserver_profiler) From 3a6acb659132d6a0751effa9b1f4b5ce73c8657c Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 3 May 2022 20:44:48 -0400 Subject: [PATCH 111/300] add variable inquiry function to FileMetadata --- CHANGELOG.md | 1 + pfio/FileMetadata.F90 | 15 +++++++++++++++ 2 files changed, 16 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index a977de6b9f11..61e198caa3fb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +- Added has_varaible function to FileMetatda - Added information about the container type for each item in state when using PRINTSPEC option ### Changed diff --git a/pfio/FileMetadata.F90 b/pfio/FileMetadata.F90 index 8d68728e4c0d..ba8cb785da30 100644 --- a/pfio/FileMetadata.F90 +++ b/pfio/FileMetadata.F90 @@ -51,6 +51,7 @@ module pFIO_FileMetadataMod procedure :: set_order procedure :: modify_variable procedure :: has_dimension + procedure :: has_variable generic :: operator(==) => equal generic :: operator(/=) => not_equal @@ -239,6 +240,20 @@ function get_variable(this, var_name, unusable, rc) result(var) _UNUSED_DUMMY(unusable) end function get_variable + logical function has_variable(this, var_name, unusable, rc) result(has) + class (FileMetadata), target, intent(in) :: this + character(len=*), intent(in) :: var_name + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + class (Variable), pointer :: var + + has = .false. + var => this%variables%at(var_name) + if (associated(var)) has = .true. + _RETURN(_SUCCESS) + _UNUSED_DUMMY(unusable) + end function has_variable + ! Returns null pointer unless var_name is a key corresponding to ! a CoordinateVariable value. ! rc returns _SUCCESS unless the var_name is not found at all. From e1dfdb317041e24113330938ec743d7e22913912 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Wed, 4 May 2022 08:00:37 -0400 Subject: [PATCH 112/300] Update CHANGELOG.md --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 61e198caa3fb..c1e0c961f4a9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,7 +14,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added -- Added has_varaible function to FileMetatda +- Added has_variable function to FileMetatda - Added information about the container type for each item in state when using PRINTSPEC option ### Changed From bce8eab88a844221b817d0ca5508047da0af4fda Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang <52509753+weiyuan-jiang@users.noreply.github.com> Date: Wed, 4 May 2022 08:41:43 -0400 Subject: [PATCH 113/300] Update CHANGELOG.md --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c1e0c961f4a9..1249311d47b5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,7 +14,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added -- Added has_variable function to FileMetatda +- Added has_variable function to FileMetadata - Added information about the container type for each item in state when using PRINTSPEC option ### Changed From 4eaa68c25f61c2f32ad6b4fbd06feb7162548741 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 5 May 2022 10:17:17 -0400 Subject: [PATCH 114/300] Prepare for 2.21.0 Release --- CHANGELOG.md | 16 ++++++++++++---- CMakeLists.txt | 2 +- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1249311d47b5..428acf5dccd3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,18 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +### Added + +### Changed + +### Removed + +### Deprecated + +## [2.21.0] - 2022-05-05 + +### Fixed + - Fixed incorrect legend when using PRINTSPEC option in MAPL Cap - Fix ESMF errors exposed by monthly collections @@ -22,10 +34,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Change many instances of `_ASSERT(.false.,"msg")` to `_FAIL("msg")` - Extended format width for exclusive and inclusive times in profiler from `f9.2` to `f10.2` (see #1420) -### Removed - -### Deprecated - ## [2.20.0] - 2022-04-19 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index 49a65d81e0ec..b7b8ae6e84a7 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.20.0 + VERSION 2.21.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the default build type to release From fd5e415f4dc2faa2a6708bc908bbc0276ebc1c53 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 16 May 2022 14:57:11 -0400 Subject: [PATCH 115/300] Fix ADAS CI --- .circleci/config.yml | 14 +++++++++++++- CHANGELOG.md | 2 ++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index d29591f9f0e0..4c69b16b99b5 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -76,7 +76,19 @@ workflows: fixture_branch: develop checkout_mapl_branch: true mepodevelop: true - develop_repos: "cmake GEOSana_GridComp" # GEOSadas needs some extra branches to work with mainline MAPL + # GEOSadas develop at the moment is in a weird state where MAPL develop + # requires a newer version of ESMA_cmake, but not *too* new a version of + # ESMA_cmake + checkout_branch_on_subrepo: + repo: GEOSadas + branch: v3.13.0 + subrepo: cmake + # Note: This isn't needed for CI, but it is on discover, so this is a + # way to remind me + checkout_branch_on_subrepo: + repo: GEOSadas + branch: v3.13.0 + subrepo: env rebuild_procs: 8 ################################################## # - ci/run_fv3: # diff --git a/CHANGELOG.md b/CHANGELOG.md index 428acf5dccd3..0182437094d0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Update CI to work with latest GEOSadas `develop` + ### Added ### Changed From 282e883f6b63bb0010e37acc5c9bef2a250192f7 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 16 May 2022 15:15:13 -0400 Subject: [PATCH 116/300] Add loggers for generic stages --- CHANGELOG.md | 2 ++ generic/MAPL_Generic.F90 | 60 +++++++++++++++++++++++++--------------- 2 files changed, 39 insertions(+), 23 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 428acf5dccd3..ebb8c0a8b1c6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +- Add debug loggers for start/stop during stages in MAPL_Generic + ### Changed ### Removed diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 783556841f78..088cfc55742f 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -1707,7 +1707,10 @@ recursive subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) procedure(ESMF_GridCompRun), pointer :: func_ptr => NULL() character(len=12), target :: timers_run(1) = & [character(len=12):: 'GenRunMine'] - character(len=12) :: sbrtn + character(len=:), allocatable :: sbrtn + + character(:), allocatable :: stage_description + class(Logger), pointer :: lgr !============================================================================= @@ -1726,6 +1729,8 @@ recursive subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) _VERIFY(status) Iam = trim(comp_name) // trim(Iam) + lgr => logging%get_logger('MAPL.GENERIC') + call ESMF_VmGetCurrent(VM) ! Retrieve the pointer to the internal state. It comes in a wrapper. ! ------------------------------------------------------------------ @@ -1735,7 +1740,7 @@ recursive subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) ! TIMERS on t_p => get_global_time_profiler() - call t_p%start(trim(state%compname),__RC__) + call t_p%start(trim(state%compname),_RC) phase_ = MAPL_MAX_PHASES+phase ! this is the "actual" phase, i.e. the one user registered @@ -1770,10 +1775,12 @@ recursive subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) sbrtn = 'WriteRestart' endif MethodBlock + stage_description = sbrtn//' stage of the gridded component <'//trim(COMP_NAME)//'>' + ! TIMERS on if (method /= ESMF_METHOD_READRESTART .and. method /= ESMF_METHOD_WRITERESTART) then - call state%t_profiler%start(__RC__) - call state%t_profiler%start(trim(sbrtn),__RC__) + call state%t_profiler%start(_RC) + call state%t_profiler%start(trim(sbrtn),_RC) end if if (associated(timers)) then @@ -1784,34 +1791,32 @@ recursive subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) ! Method itself ! ---------- -#ifdef DEBUG - IF (mapl_am_i_root(vm)) then - print *,'DBG: running ', sbrtn, ' phase ',phase,' of ',trim(comp_name) - end IF -#endif - + call lgr%debug('Started %a', stage_description) call func_ptr (GC, & importState=IMPORT, & exportState=EXPORT, & clock=CLOCK, PHASE=PHASE_, & - userRC=userRC, __RC__ ) + userRC=userRC, _RC ) _VERIFY(userRC) + _ASSERT(userRC==ESMF_SUCCESS .and. STATUS==ESMF_SUCCESS,'Error during '//stage_description//' for <'//trim(COMP_NAME)//'>') + call lgr%debug('Finished %a', stage_description) + ! TIMERS off if (associated(timers)) then do i = size(timers),1,-1 - call MAPL_TimerOff (STATE,timers(i),__RC__) + call MAPL_TimerOff (STATE,timers(i),_RC) end do end if if (method /= ESMF_METHOD_FINALIZE) then if (method /= ESMF_METHOD_WRITERESTART .and. & method /= ESMF_METHOD_READRESTART) then - call state%t_profiler%stop(trim(sbrtn),__RC__) - call state%t_profiler%stop(__RC__) + call state%t_profiler%stop(trim(sbrtn),_RC) + call state%t_profiler%stop(_RC) end if - call t_p%stop(trim(state%compname),__RC__) + call t_p%stop(trim(state%compname),_RC) endif @@ -4553,6 +4558,9 @@ recursive integer function AddChildFromMeta(META, NAME, GRID, & class(BaseProfiler), pointer :: t_p integer :: userRC + character(:), allocatable :: stage_description + class(Logger), pointer :: lgr + if (.not.allocated(META%GCNameList)) then ! this is the first child to be added allocate(META%GCNameList(0), __STAT__) @@ -4561,19 +4569,25 @@ recursive integer function AddChildFromMeta(META, NAME, GRID, & I = META%get_num_children() + 1 AddChildFromMeta = I - call AddChild_preamble(meta, I, name, grid=grid, configfile=configfile, parentGC=parentgc, petList=petlist, child_meta=child_meta, __RC__) + call AddChild_preamble(meta, I, name, grid=grid, configfile=configfile, parentGC=parentgc, petList=petlist, child_meta=child_meta, _RC) + + stage_description = 'setServices() of the gridded component <'//trim(name)//'>' + lgr => logging%get_logger('MAPL.GENERIC') + t_p => get_global_time_profiler() - call t_p%start(trim(NAME),__RC__) - call child_meta%t_profiler%start(__RC__) - call child_meta%t_profiler%start('SetService',__RC__) + call t_p%start(trim(NAME),_RC) + call child_meta%t_profiler%start(_RC) + call child_meta%t_profiler%start('SetService',_RC) !!$ gridcomp => META%GET_CHILD_GRIDCOMP(I) - call ESMF_GridCompSetServices ( child_meta%gridcomp, SS, userRC=userRC, __RC__ ) + call lgr%debug("Started %a", stage_description) + call ESMF_GridCompSetServices ( child_meta%gridcomp, SS, userRC=userRC, _RC ) _VERIFY(userRC) + call lgr%debug("Finished %a", stage_description) - call child_meta%t_profiler%stop('SetService',__RC__) - call child_meta%t_profiler%stop(__RC__) - call t_p%stop(trim(NAME),__RC__) + call child_meta%t_profiler%stop('SetService',_RC) + call child_meta%t_profiler%stop(_RC) + call t_p%stop(trim(NAME),_RC) _VERIFY(status) From 26e1c9900d28d47f60b8574d3b50521da71b2cc2 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 16 May 2022 15:34:19 -0400 Subject: [PATCH 117/300] Use special branch of adas --- .circleci/config.yml | 15 +-------------- CHANGELOG.md | 2 +- 2 files changed, 2 insertions(+), 15 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 4c69b16b99b5..778380faedea 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -73,22 +73,9 @@ workflows: resource_class: xlarge repo: GEOSadas checkout_fixture: true - fixture_branch: develop + fixture_branch: feature/mathomp4/mapldevelop checkout_mapl_branch: true mepodevelop: true - # GEOSadas develop at the moment is in a weird state where MAPL develop - # requires a newer version of ESMA_cmake, but not *too* new a version of - # ESMA_cmake - checkout_branch_on_subrepo: - repo: GEOSadas - branch: v3.13.0 - subrepo: cmake - # Note: This isn't needed for CI, but it is on discover, so this is a - # way to remind me - checkout_branch_on_subrepo: - repo: GEOSadas - branch: v3.13.0 - subrepo: env rebuild_procs: 8 ################################################## # - ci/run_fv3: # diff --git a/CHANGELOG.md b/CHANGELOG.md index 0182437094d0..db58f7709180 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,7 +9,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed -- Update CI to work with latest GEOSadas `develop` +- Update CI to work with latest GEOSadas `develop` (Uses a special branch of GEOSadas) ### Added From de2024d70083f9572f11ee926d26c9817b6ec994 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 16 May 2022 15:34:54 -0400 Subject: [PATCH 118/300] Add comment --- .circleci/config.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.circleci/config.yml b/.circleci/config.yml index 778380faedea..6a58ad67e8d5 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -73,6 +73,8 @@ workflows: resource_class: xlarge repo: GEOSadas checkout_fixture: true + # This branch on GEOSadas will be used to track subrepos needed + # for GEOSadas + MAPL develop much like how we do with MAPL 3 fixture_branch: feature/mathomp4/mapldevelop checkout_mapl_branch: true mepodevelop: true From c88a5a75da515735a7671618a32748d02c061468 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 16 May 2022 15:50:19 -0400 Subject: [PATCH 119/300] Don't do mepodevelop for adas --- .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 6a58ad67e8d5..96ea44025596 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -77,7 +77,7 @@ workflows: # for GEOSadas + MAPL develop much like how we do with MAPL 3 fixture_branch: feature/mathomp4/mapldevelop checkout_mapl_branch: true - mepodevelop: true + mepodevelop: false rebuild_procs: 8 ################################################## # - ci/run_fv3: # From fe2f88f75fb483c24f80e65ac923974c91e3e02e Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 17 May 2022 07:24:25 -0400 Subject: [PATCH 120/300] Update CHANGELOG.md --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index a60a888e08d1..f2a8eaf601b7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added - Add debug loggers for start/stop during stages in MAPL_Generic +- Enable GCM run test in CircleCI ### Changed @@ -57,7 +58,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Cleaned up a bit of old CMake - Updated CircleCI config to use new orb `build` job - - Turned on GCM run test - Updated `components.yaml` to match GEOSgcm v10.22.1 - ESMA_env v3.13.0 - ESMA_cmake v3.12.0 From 4fb3b9e871c7bdd4281d1da5874da7a217187825 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 11 May 2022 10:42:03 -0400 Subject: [PATCH 121/300] Expand error handling in FileMetadataUtilities to print filename Signed-off-by: Lizzie Lundgren --- base/FileMetadataUtilities.F90 | 74 ++++++++++++++++++++++------------ 1 file changed, 48 insertions(+), 26 deletions(-) diff --git a/base/FileMetadataUtilities.F90 b/base/FileMetadataUtilities.F90 index f6726730615a..6a18cc76ccbb 100644 --- a/base/FileMetadataUtilities.F90 +++ b/base/FileMetadataUtilities.F90 @@ -61,10 +61,12 @@ function var_get_missing_value(this,var_name,rc) result(missing_value) integer, optional, intent(out) :: rc integer :: status + character(len=ESMF_MAXSTR) :: fname type(Variable), pointer :: var + fname = get_file_name(this,_RC) var => this%get_variable(var_name,_RC) - _ASSERT(associated(var),"no variable named "//var_name//" in file") + _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) ! check _FillValue, we could do more, not sure what to do here like also check for missing_value ... if (this%var_has_attr(var_name,"_FillValue")) then missing_value = this%get_var_attr_real32(var_name,"_FillValue",_RC) @@ -79,10 +81,12 @@ logical function var_has_missing_value(this,var_name,rc) integer, optional, intent(out) :: rc integer :: status + character(len=ESMF_MAXSTR) :: fname type(Variable), pointer :: var + fname = get_file_name(this,_RC) var => this%get_variable(var_name,_RC) - _ASSERT(associated(var),"no variable named "//var_name//" in file") + _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) var_has_missing_value = var%is_attribute_present("_FillValue") _RETURN(_SUCCESS) @@ -95,10 +99,12 @@ logical function var_has_attr(this,var_name,attr_name,rc) integer, optional, intent(out) :: rc integer :: status + character(len=ESMF_MAXSTR) :: fname type(Variable), pointer :: var + fname = get_file_name(this,_RC) var => this%get_variable(var_name,_RC) - _ASSERT(associated(var),"no variable named "//var_name//" in file") + _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) var_has_attr = var%is_attribute_present(attr_name) _RETURN(_SUCCESS) end function var_has_attr @@ -112,21 +118,23 @@ function get_var_attr_real32(this,var_name,attr_name,rc) result(attr_real32) real(REAL32) :: tmp(1) integer :: status + character(len=ESMF_MAXSTR) :: fname type(Attribute), pointer :: attr type(Variable), pointer :: var class(*), pointer :: attr_val(:) + fname = get_file_name(this,_RC) var => this%get_variable(var_name,_RC) - _ASSERT(associated(var),"no variable named "//var_name//" in file") + _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) attr => var%get_attribute(attr_name,_RC) - _ASSERT(associated(attr),"no attribute named "//attr_name//" in "//var_name//" in file") + _ASSERT(associated(attr),"no attribute named "//attr_name//" in "//var_name//" in "//fname) attr_val => attr%get_values() select type(attr_val) type is(real(kind=REAL32)) tmp = attr_val attr_real32 = tmp(1) class default - _FAIL('unsupport subclass for units') + _FAIL('unsupported subclass (not real32) for units of attribute named '//attr_name//' in '//var_name//' in '//fname) end select _RETURN(_SUCCESS) @@ -141,21 +149,23 @@ function get_var_attr_real64(this,var_name,attr_name,rc) result(attr_real64) real(REAL64) :: tmp(1) integer :: status + character(len=ESMF_MAXSTR) :: fname type(Attribute), pointer :: attr type(Variable), pointer :: var class(*), pointer :: attr_val(:) + fname = get_file_name(this,_RC) var => this%get_variable(var_name,_RC) - _ASSERT(associated(var),"no variable named "//var_name//" in file") + _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) attr => var%get_attribute(attr_name,_RC) - _ASSERT(associated(attr),"no attribute named "//attr_name//" in "//var_name//" in file") + _ASSERT(associated(attr),"no attribute named "//attr_name//" in "//var_name//" in "//fname) attr_val => attr%get_values() select type(attr_val) type is(real(kind=REAL64)) tmp = attr_val attr_real64 = tmp(1) class default - _FAIL('unsupport subclass for units') + _FAIL('unsupported subclass (not real64) for units of attribute named '//attr_name//' in '//var_name//' in '//fname) end select _RETURN(_SUCCESS) @@ -170,21 +180,23 @@ function get_var_attr_int32(this,var_name,attr_name,rc) result(attr_int32) integer(INT32) :: tmp(1) integer :: status + character(len=ESMF_MAXSTR) :: fname type(Attribute), pointer :: attr type(Variable), pointer :: var class(*), pointer :: attr_val(:) + fname = get_file_name(this,_RC) var => this%get_variable(var_name,_RC) - _ASSERT(associated(var),"no variable named "//var_name//" in file") + _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) attr => var%get_attribute(attr_name,_RC) - _ASSERT(associated(attr),"no attribute named "//attr_name//" in "//var_name//" in file") + _ASSERT(associated(attr),"no attribute named "//attr_name//" in "//var_name//" in "//fname) attr_val => attr%get_values() select type(attr_val) type is(integer(kind=INT32)) tmp = attr_val attr_int32 = tmp(1) class default - _FAIL('unsupport subclass for units') + _FAIL('unsupported subclass (not int32) for units of attribute named '//attr_name//' in '//var_name//' in '//fname) end select _RETURN(_SUCCESS) @@ -199,21 +211,23 @@ function get_var_attr_int64(this,var_name,attr_name,rc) result(attr_int64) integer(INT64) :: tmp(1) integer :: status + character(len=ESMF_MAXSTR) :: fname type(Attribute), pointer :: attr type(Variable), pointer :: var class(*), pointer :: attr_val(:) + fname = get_file_name(this,_RC) var => this%get_variable(var_name,_RC) - _ASSERT(associated(var),"no variable named "//var_name//" in file") + _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) attr => var%get_attribute(attr_name,_RC) - _ASSERT(associated(attr),"no attribute named "//attr_name//" in "//var_name//" in file") + _ASSERT(associated(attr),"no attribute named "//attr_name//" in "//var_name//" in "//fname) attr_val => attr%get_values() select type(attr_val) type is(integer(kind=INT64)) tmp = attr_val attr_int64 = tmp(1) class default - _FAIL('unsupport subclass for units') + _FAIL('unsupported subclass (not int64) for units of attribute named '//attr_name//' in '//var_name//' in '//fname) end select _RETURN(_SUCCESS) @@ -227,20 +241,22 @@ function get_var_attr_string(this,var_name,attr_name,rc) result(attr_string) integer, optional, intent(out) :: rc integer :: status + character(len=ESMF_MAXSTR) :: fname type(Attribute), pointer :: attr type(Variable), pointer :: var class(*), pointer :: attr_val + fname = get_file_name(this,_RC) var => this%get_variable(var_name,_RC) - _ASSERT(associated(var),"no variable named "//var_name//" in file") + _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) attr => var%get_attribute(attr_name,_RC) - _ASSERT(associated(attr),"no attribute named "//attr_name//" in "//var_name//" in file") + _ASSERT(associated(attr),"no attribute named "//attr_name//" in "//var_name//" in "//fname) attr_val => attr%get_value() select type(attr_val) type is(character(*)) attr_string = attr_val class default - _FAIL('unsupport subclass for units') + _FAIL('unsupported subclass (not string) for units of attribute named '//attr_name//' in '//var_name//' in '//fname) end select _RETURN(_SUCCESS) @@ -261,6 +277,7 @@ subroutine get_time_info(this,startTime,startyear,startmonth,startday,starthour, integer, optional, intent(out) :: rc integer :: status + character(len=ESMF_MAXSTR) :: fname class(CoordinateVariable), pointer :: var type(Attribute), pointer :: attr class(*), pointer :: pTimeUnits @@ -278,6 +295,7 @@ subroutine get_time_info(this,startTime,startyear,startmonth,startday,starthour, real(REAL64), allocatable :: tr_r64(:) type(ESMF_TimeInterval) :: tint + fname = get_file_name(this,_RC) var => this%get_coordinate_variable('time',rc=status) _VERIFY(status) attr => var%get_attribute('units') @@ -356,7 +374,7 @@ subroutine get_time_info(this,startTime,startyear,startmonth,startday,starthour, endif endif class default - _FAIL("Time unit must be character") + _FAIL("Time unit must be character in "//fname) end select call ESMF_TimeSet(unmodStartTime,yy=year,mm=month,dd=day,h=hour,m=min,s=sec,rc=status) _VERIFY(status) @@ -366,7 +384,7 @@ subroutine get_time_info(this,startTime,startyear,startmonth,startday,starthour, allocate(tr_r64(tsize)) allocate(tvec(tsize)) ptr => var%get_coordinate_data() - _ASSERT(associated(ptr),"time variable coordinate data not found") + _ASSERT(associated(ptr),"time variable coordinate data not found in "//fname) select type (ptr) type is (real(kind=REAL64)) tr_r64=ptr @@ -377,7 +395,7 @@ subroutine get_time_info(this,startTime,startyear,startmonth,startday,starthour, type is (integer(kind=INT32)) tr_r64=ptr class default - _FAIL("unsupported time variable type") + _FAIL("unsupported time variable type in "//fname) end select do i=1,tsize select case (trim(tUnits)) @@ -398,7 +416,7 @@ subroutine get_time_info(this,startTime,startyear,startmonth,startday,starthour, _VERIFY(status) tvec(i)=unmodStartTime+tint case default - _FAIL("unsupported time unit") + _FAIL("unsupported time unit in "//fname) end select enddo @@ -441,6 +459,7 @@ function get_variable_attribute(this,var_name,attr_name,rc) result(units) character(len=*), intent(in) :: attr_name integer, optional, intent(out) :: rc + character(len=ESMF_MAXSTR) :: fname character(len=:), pointer :: units type(Attribute), pointer :: attr => null() class(Variable), pointer :: var => null() @@ -448,6 +467,7 @@ function get_variable_attribute(this,var_name,attr_name,rc) result(units) logical :: isPresent integer :: status + fname = get_file_name(this,_RC) var => this%get_variable(var_name,rc=status) _VERIFY(status) isPresent = var%is_attribute_present(trim(attr_name)) @@ -458,7 +478,7 @@ function get_variable_attribute(this,var_name,attr_name,rc) result(units) type is (character(*)) units => vunits class default - _FAIL('units must be string') + _FAIL('units must be string for '//var_name//' in '//fname) end select else units => null() @@ -476,12 +496,14 @@ subroutine get_coordinate_info(this,coordinate_name,coordSize,coordUnits,coords, integer, optional, intent(out) :: rc integer :: status + character(len=ESMF_MAXSTR) :: fname class(CoordinateVariable), pointer :: var type(Attribute), pointer :: attr character(len=:), pointer :: vdim class(*), pointer :: coordUnitPtr class(*), pointer :: ptr(:) + fname = get_file_name(this,_RC) var => this%get_coordinate_variable(trim(coordinate_name),rc=status) _VERIFY(status) @@ -497,13 +519,13 @@ subroutine get_coordinate_info(this,coordinate_name,coordSize,coordUnits,coords, type is (character(*)) coordUnits = trim(coordUnitPtr) class default - _FAIL('units must be string') + _FAIL('coordinate units must be string in '//fname) end select end if if (present(coords)) then ptr => var%get_coordinate_data() - _ASSERT(associated(ptr),"coord variable coordinate data not found") + _ASSERT(associated(ptr),"coord variable coordinate data not found in "//fname) select type (ptr) type is (real(kind=REAL64)) coords=ptr @@ -514,7 +536,7 @@ subroutine get_coordinate_info(this,coordinate_name,coordSize,coordUnits,coords, type is (integer(kind=INT32)) coords=ptr class default - _FAIL("unsupported coordel variable type") + _FAIL("unsupported coordinate variable type in "//fname) end select end if _RETURN(_SUCCESS) From b037c3cb1beb766ebcbee572b8be29eb3d26fced Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 11 May 2022 10:33:15 -0400 Subject: [PATCH 122/300] Allow double precision data when retrieving single precision attributes This update prevents run fail when retrieving _FillValue from import files containing double precision data. Signed-off-by: Lizzie Lundgren --- base/FileMetadataUtilities.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/base/FileMetadataUtilities.F90 b/base/FileMetadataUtilities.F90 index 6a18cc76ccbb..70f98b7cd31c 100644 --- a/base/FileMetadataUtilities.F90 +++ b/base/FileMetadataUtilities.F90 @@ -117,6 +117,7 @@ function get_var_attr_real32(this,var_name,attr_name,rc) result(attr_real32) integer, optional, intent(out) :: rc real(REAL32) :: tmp(1) + real(REAL64) :: tmpd(1) integer :: status character(len=ESMF_MAXSTR) :: fname type(Attribute), pointer :: attr @@ -133,6 +134,9 @@ function get_var_attr_real32(this,var_name,attr_name,rc) result(attr_real32) type is(real(kind=REAL32)) tmp = attr_val attr_real32 = tmp(1) + type is(real(kind=REAL64)) + tmpd = attr_val + attr_real32 = REAL(tmpd(1)) class default _FAIL('unsupported subclass (not real32) for units of attribute named '//attr_name//' in '//var_name//' in '//fname) end select From bec668082cd14b1821ed5ee78c2079baec15ea56 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 11 May 2022 11:25:01 -0400 Subject: [PATCH 123/300] Update Changelog Signed-off-by: Lizzie Lundgren --- CHANGELOG.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index a3ab4a9e9dea..52fdcaddbfcd 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,9 +14,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added - Add debug loggers for start/stop during stages in MAPL_Generic +- Handling for double precision input when retrieving single precision attributes ### Changed +- Modified error messages in FileMetadataUtilities to be unique and print filename + ### Removed ### Deprecated From e484e71d728c5e1da6ff991d0d0bf80c32c78864 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Mon, 16 May 2022 11:03:59 -0400 Subject: [PATCH 124/300] Update usage of fname Signed-off-by: Lizzie Lundgren --- base/FileMetadataUtilities.F90 | 45 +++++++++++++++++----------------- 1 file changed, 22 insertions(+), 23 deletions(-) diff --git a/base/FileMetadataUtilities.F90 b/base/FileMetadataUtilities.F90 index 70f98b7cd31c..695bffe89e5b 100644 --- a/base/FileMetadataUtilities.F90 +++ b/base/FileMetadataUtilities.F90 @@ -61,10 +61,10 @@ function var_get_missing_value(this,var_name,rc) result(missing_value) integer, optional, intent(out) :: rc integer :: status - character(len=ESMF_MAXSTR) :: fname + character(:), allocatable :: fname type(Variable), pointer :: var - fname = get_file_name(this,_RC) + fname = this%get_file_name(_RC) var => this%get_variable(var_name,_RC) _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) ! check _FillValue, we could do more, not sure what to do here like also check for missing_value ... @@ -81,10 +81,10 @@ logical function var_has_missing_value(this,var_name,rc) integer, optional, intent(out) :: rc integer :: status - character(len=ESMF_MAXSTR) :: fname + character(:), allocatable :: fname type(Variable), pointer :: var - fname = get_file_name(this,_RC) + fname = this%get_file_name(_RC) var => this%get_variable(var_name,_RC) _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) var_has_missing_value = var%is_attribute_present("_FillValue") @@ -99,10 +99,10 @@ logical function var_has_attr(this,var_name,attr_name,rc) integer, optional, intent(out) :: rc integer :: status - character(len=ESMF_MAXSTR) :: fname + character(:), allocatable :: fname type(Variable), pointer :: var - fname = get_file_name(this,_RC) + fname = this%get_file_name(_RC) var => this%get_variable(var_name,_RC) _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) var_has_attr = var%is_attribute_present(attr_name) @@ -119,12 +119,12 @@ function get_var_attr_real32(this,var_name,attr_name,rc) result(attr_real32) real(REAL32) :: tmp(1) real(REAL64) :: tmpd(1) integer :: status - character(len=ESMF_MAXSTR) :: fname + character(:), allocatable :: fname type(Attribute), pointer :: attr type(Variable), pointer :: var class(*), pointer :: attr_val(:) - fname = get_file_name(this,_RC) + fname = this%get_file_name(_RC) var => this%get_variable(var_name,_RC) _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) attr => var%get_attribute(attr_name,_RC) @@ -153,12 +153,12 @@ function get_var_attr_real64(this,var_name,attr_name,rc) result(attr_real64) real(REAL64) :: tmp(1) integer :: status - character(len=ESMF_MAXSTR) :: fname + character(:), allocatable :: fname type(Attribute), pointer :: attr type(Variable), pointer :: var class(*), pointer :: attr_val(:) - fname = get_file_name(this,_RC) + fname = this%get_file_name(_RC) var => this%get_variable(var_name,_RC) _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) attr => var%get_attribute(attr_name,_RC) @@ -184,12 +184,12 @@ function get_var_attr_int32(this,var_name,attr_name,rc) result(attr_int32) integer(INT32) :: tmp(1) integer :: status - character(len=ESMF_MAXSTR) :: fname + character(:), allocatable :: fname type(Attribute), pointer :: attr type(Variable), pointer :: var class(*), pointer :: attr_val(:) - fname = get_file_name(this,_RC) + fname = this%get_file_name(_RC) var => this%get_variable(var_name,_RC) _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) attr => var%get_attribute(attr_name,_RC) @@ -215,12 +215,12 @@ function get_var_attr_int64(this,var_name,attr_name,rc) result(attr_int64) integer(INT64) :: tmp(1) integer :: status - character(len=ESMF_MAXSTR) :: fname + character(:), allocatable :: fname type(Attribute), pointer :: attr type(Variable), pointer :: var class(*), pointer :: attr_val(:) - fname = get_file_name(this,_RC) + fname = this%get_file_name(_RC) var => this%get_variable(var_name,_RC) _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) attr => var%get_attribute(attr_name,_RC) @@ -245,12 +245,12 @@ function get_var_attr_string(this,var_name,attr_name,rc) result(attr_string) integer, optional, intent(out) :: rc integer :: status - character(len=ESMF_MAXSTR) :: fname + character(:), allocatable :: fname type(Attribute), pointer :: attr type(Variable), pointer :: var class(*), pointer :: attr_val - fname = get_file_name(this,_RC) + fname = this%get_file_name(_RC) var => this%get_variable(var_name,_RC) _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) attr => var%get_attribute(attr_name,_RC) @@ -281,7 +281,7 @@ subroutine get_time_info(this,startTime,startyear,startmonth,startday,starthour, integer, optional, intent(out) :: rc integer :: status - character(len=ESMF_MAXSTR) :: fname + character(:), allocatable :: fname class(CoordinateVariable), pointer :: var type(Attribute), pointer :: attr class(*), pointer :: pTimeUnits @@ -299,7 +299,7 @@ subroutine get_time_info(this,startTime,startyear,startmonth,startday,starthour, real(REAL64), allocatable :: tr_r64(:) type(ESMF_TimeInterval) :: tint - fname = get_file_name(this,_RC) + fname = this%get_file_name(_RC) var => this%get_coordinate_variable('time',rc=status) _VERIFY(status) attr => var%get_attribute('units') @@ -462,8 +462,7 @@ function get_variable_attribute(this,var_name,attr_name,rc) result(units) character(len=*), intent(in) :: var_name character(len=*), intent(in) :: attr_name integer, optional, intent(out) :: rc - - character(len=ESMF_MAXSTR) :: fname + character(:), allocatable :: fname character(len=:), pointer :: units type(Attribute), pointer :: attr => null() class(Variable), pointer :: var => null() @@ -471,7 +470,7 @@ function get_variable_attribute(this,var_name,attr_name,rc) result(units) logical :: isPresent integer :: status - fname = get_file_name(this,_RC) + fname = this%get_file_name(_RC) var => this%get_variable(var_name,rc=status) _VERIFY(status) isPresent = var%is_attribute_present(trim(attr_name)) @@ -500,14 +499,14 @@ subroutine get_coordinate_info(this,coordinate_name,coordSize,coordUnits,coords, integer, optional, intent(out) :: rc integer :: status - character(len=ESMF_MAXSTR) :: fname + character(:), allocatable :: fname class(CoordinateVariable), pointer :: var type(Attribute), pointer :: attr character(len=:), pointer :: vdim class(*), pointer :: coordUnitPtr class(*), pointer :: ptr(:) - fname = get_file_name(this,_RC) + fname = this%get_file_name(_RC) var => this%get_coordinate_variable(trim(coordinate_name),rc=status) _VERIFY(status) From e90cd763e13a91385ad17bc152c268270c488e78 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 17 May 2022 14:51:46 -0400 Subject: [PATCH 125/300] Update CHANGELOG.md --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 19ab265e5973..b324f0f6e205 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,7 +15,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Add debug loggers for start/stop during stages in MAPL_Generic - Handling for double precision input when retrieving single precision attributes -- Enable GCM run test in CircleCI +- Enable GCM run test in CircleCI (1-hour, no ExtData) ### Changed From e114377f8814e53ff206061f941b768c261339a1 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 17 May 2022 14:54:31 -0400 Subject: [PATCH 126/300] if a field makes it to ExtData. Go through all components and if that field is in its import state, make it MAPL_RestartSkip --- CHANGELOG.md | 2 ++ generic/MAPL_Generic.F90 | 44 ++++++++++++++++++++++++++++++ gridcomps/Cap/MAPL_CapGridComp.F90 | 6 ++-- 3 files changed, 50 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 428acf5dccd3..5ec857e7742a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +- Updated MAPL_CapGridComp to mark fields going to ExtData to not be checkpointed by components + ### Changed ### Removed diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 783556841f78..a076986330c4 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -222,6 +222,7 @@ module MAPL_GenericMod public MAPL_GenericStateSave public MAPL_GenericStateRestore public MAPL_RootGcRetrieve + public MAPL_AddAttributeToFields !BOP ! !PUBLIC TYPES: @@ -341,6 +342,10 @@ module MAPL_GenericMod module procedure MAPL_GetLogger_meta end interface MAPL_GetLogger + interface MAPL_AddAttributeToFields + module procedure MAPL_AddI4AttributeToFields + end interface + ! ======================================================================= @@ -11320,4 +11325,43 @@ subroutine warn_empty(string, MPL, rc) _RETURN(ESMF_SUCCESS) end subroutine warn_empty + recursive subroutine MAPL_AddI4AttributeToFields(gc,field_name,att_name,att_val,rc) + type(ESMF_GridComp), pointer, intent(inout) :: gc + character(len=*), intent(in) :: field_name + character(len=*), intent(in) :: att_name + integer(int32), intent(in) :: att_val + integer, optional, intent(out) :: rc + + integer :: nc,i,status + type(MAPL_MetaComp), pointer :: state + type(ESMF_GridComp), pointer :: child_gc + type(ESMF_Field) :: field + type(ESMF_StateItem_Flag) :: item_type + type(ESMF_TypeKind_Flag) :: item_kind + integer :: item_count + logical :: is_present + + call MAPL_GetObjectFromGC(gc,state,_RC) + call ESMF_StateGet(state%import_state,field_name,item_type,_RC) + if (item_type == ESMF_STATEITEM_FIELD) then + call ESMF_StateGet(state%import_state,field_name,field,_RC) + call ESMF_AttributeGet(field,name=att_name,isPresent=is_Present,_RC) + if (is_present) then + call ESMF_AttributeGet(field,name=att_name,typekind=item_kind,itemCount=item_count,_RC) + _ASSERT(item_kind == ESMF_TYPEKIND_I4,"attribute "//att_name//" in "//field_name//" is not I4") + _ASSERT(item_count==1,"attribute "//att_name//" in "//field_name//" is not a scalar") + end if + call ESMF_AttributeSet(field,name=att_name,value=att_val,_RC) + end if + nc = state%get_num_children() + if (nc > 0) then + do i=1,nc + child_gc => state%get_child_gridcomp(i) + call MAPL_AddI4AttributeToFields(child_gc,field_name,att_name,att_val,_RC) + enddo + end if + + _RETURN(_SUCCESS) + end subroutine MAPL_AddI4AttributeToFields + end module MAPL_GenericMod diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index 2b8b92f67530..e072574f1609 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -631,7 +631,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call cap%initialize_history(rc=status) _VERIFY(status) - call cap%initialize_extdata(rc=status) + call cap%initialize_extdata(root_gc,rc=status) _VERIFY(status) ! Finally check is this is a regular replay @@ -690,8 +690,9 @@ subroutine initialize_history(cap, rc) end subroutine initialize_history - subroutine initialize_extdata(cap , rc) + subroutine initialize_extdata(cap , root_gc, rc) class(MAPL_CapGridComp), intent(inout) :: cap + type (ESMF_GridComp), intent(inout), pointer :: root_gc integer, optional, intent(out) :: rc integer :: item_count, status type (ESMF_StateItem_Flag), pointer :: item_types(:) @@ -758,6 +759,7 @@ subroutine initialize_extdata(cap , rc) if (item_types(i) == ESMF_StateItem_Field) then call ESMF_StateGet(root_imports, item_names(i), field, rc = status) _VERIFY(status) + call MAPL_AddAttributeToFields(root_gc,trim(item_names(i)),'RESTART',MAPL_RestartSkip,_RC) call MAPL_StateAdd(state, field, rc = status) _VERIFY(status) else if (item_types(i) == ESMF_StateItem_FieldBundle) then From 61184cec72293281300d328488211925a6ab0326 Mon Sep 17 00:00:00 2001 From: Ben Auer Date: Wed, 18 May 2022 10:55:09 -0400 Subject: [PATCH 127/300] Update generic/MAPL_Generic.F90 Co-authored-by: Tom Clune --- generic/MAPL_Generic.F90 | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index d9fe7b8c7852..40c5dc82ae26 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -11368,12 +11368,10 @@ recursive subroutine MAPL_AddI4AttributeToFields(gc,field_name,att_name,att_val, call ESMF_AttributeSet(field,name=att_name,value=att_val,_RC) end if nc = state%get_num_children() - if (nc > 0) then - do i=1,nc - child_gc => state%get_child_gridcomp(i) - call MAPL_AddI4AttributeToFields(child_gc,field_name,att_name,att_val,_RC) - enddo - end if + do i=1,nc + child_gc => state%get_child_gridcomp(i) + call MAPL_AddI4AttributeToFields(child_gc,field_name,att_name,att_val,_RC) + enddo _RETURN(_SUCCESS) end subroutine MAPL_AddI4AttributeToFields From 338f3d19f98e5e2325fa0331e89f09d0d436b754 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 18 May 2022 10:56:09 -0400 Subject: [PATCH 128/300] better naming ... --- generic/MAPL_Generic.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 40c5dc82ae26..a712c2485bc9 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -343,7 +343,7 @@ module MAPL_GenericMod end interface MAPL_GetLogger interface MAPL_AddAttributeToFields - module procedure MAPL_AddI4AttributeToFields + module procedure MAPL_AddAttributeToFields_I4 end interface @@ -11339,7 +11339,7 @@ subroutine warn_empty(string, MPL, rc) _RETURN(ESMF_SUCCESS) end subroutine warn_empty - recursive subroutine MAPL_AddI4AttributeToFields(gc,field_name,att_name,att_val,rc) + recursive subroutine MAPL_AddAttributeToFields_I4(gc,field_name,att_name,att_val,rc) type(ESMF_GridComp), pointer, intent(inout) :: gc character(len=*), intent(in) :: field_name character(len=*), intent(in) :: att_name @@ -11370,10 +11370,10 @@ recursive subroutine MAPL_AddI4AttributeToFields(gc,field_name,att_name,att_val, nc = state%get_num_children() do i=1,nc child_gc => state%get_child_gridcomp(i) - call MAPL_AddI4AttributeToFields(child_gc,field_name,att_name,att_val,_RC) + call MAPL_AddAttributeToFields_I4(child_gc,field_name,att_name,att_val,_RC) enddo _RETURN(_SUCCESS) - end subroutine MAPL_AddI4AttributeToFields + end subroutine MAPL_AddAttributeToFields_I4 end module MAPL_GenericMod From 77607cf8ac1970b3035dfd9ddcc79b860730828b Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 24 May 2022 11:07:01 -0400 Subject: [PATCH 129/300] fixes #1522 --- CHANGELOG.md | 2 ++ griddedio/GriddedIO.F90 | 12 +++++++++--- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 428acf5dccd3..aff94d16a22a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Adding missing _RETURN and _VERIFY macros in GriddedIO.F90 + ### Added ### Changed diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index 84b5b63dfb0c..d28851bfbb43 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -198,6 +198,7 @@ subroutine CreateFileMetaData(this,items,bundle,timeInfo,vdata,ogrid,global_attr call s_iter%next() enddo end if + _RETURN(_SUCCESS) end subroutine CreateFileMetaData @@ -323,12 +324,14 @@ subroutine CreateVariable(this,itemName,rc) newField = MAPL_FieldCreate(field,this%output_grid,lm=this%vData%lm,rc=status) _VERIFY(status) call MAPL_FieldBundleAdd(this%output_bundle,newField,rc=status) + _VERIFY(status) else newField = MAPL_FieldCreate(field,this%output_grid,rc=status) _VERIFY(status) call MAPL_FieldBundleAdd(this%output_bundle,newField,rc=status) + _VERIFY(status) end if - + _RETURN(_SUCCESS) end subroutine CreateVariable @@ -389,7 +392,7 @@ subroutine bundlepost(this,filename,oClients,rc) tindex = size(this%times) if (tindex==1) then - call this%stage2DLatLon(filename,oClients=oClients,rc=status) + call this%stage2DLatLon(filename,oClients=oClients,_RC) end if if (this%vdata%regrid_type==VERTICAL_METHOD_ETA2LEV) then @@ -545,6 +548,7 @@ subroutine RegridScalar(this,itemName,rc) end if if (allocated(ptr3d_inter)) deallocate(ptr3d_inter) + _RETURN(_SUCCESS) end subroutine RegridScalar @@ -711,6 +715,7 @@ subroutine RegridVector(this,xName,yName,rc) if (allocated(xptr3d_inter)) deallocate(xptr3d_inter) if (allocated(yptr3d_inter)) deallocate(yptr3d_inter) + _RETURN(_SUCCESS) end subroutine RegridVector @@ -786,7 +791,7 @@ subroutine stage2DLatLon(this, fileName, oClients, rc) call oClients%collective_stage_data(this%write_collection_id,trim(filename),'corner_lats', & ref,start=localStart, global_start=GlobalStart, global_count=GlobalCount) end if - + _RETURN(_SUCCESS) end subroutine stage2DLatLon @@ -855,6 +860,7 @@ subroutine stageData(this, field, fileName, tIndex, oClients, rc) end if call oClients%collective_stage_data(this%write_collection_id,trim(filename),trim(fieldName), & ref,start=localStart, global_start=GlobalStart, global_count=GlobalCount) + _RETURN(_SUCCESS) end subroutine stageData From 33599f962e1014606068d76dd6e7a8a149cdf6fd Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 24 May 2022 12:10:59 -0400 Subject: [PATCH 130/300] Fix CI. Update changelog and cmakelists for 2.21.1 release --- .circleci/config.yml | 8 +++++--- CHANGELOG.md | 7 +++++++ CMakeLists.txt | 2 +- 3 files changed, 13 insertions(+), 4 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index d29591f9f0e0..1a5b8d8dfff7 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -73,11 +73,13 @@ workflows: resource_class: xlarge repo: GEOSadas checkout_fixture: true - fixture_branch: develop + # This branch on GEOSadas will be used to track subrepos needed + # for GEOSadas + MAPL develop much like how we do with MAPL 3 + fixture_branch: feature/mathomp4/mapldevelop checkout_mapl_branch: true - mepodevelop: true - develop_repos: "cmake GEOSana_GridComp" # GEOSadas needs some extra branches to work with mainline MAPL + mepodevelop: false rebuild_procs: 8 + ################################################## # - ci/run_fv3: # # name: run-FV3-on-<< matrix.compiler >> # diff --git a/CHANGELOG.md b/CHANGELOG.md index aff94d16a22a..d70747f3df8f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -19,6 +19,13 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Deprecated +## [2.21.1] - 2022-05-24 + +### Fixed + +- Adding missing _RETURN and _VERIFY macros in GriddedIO.F90 +- Update CircleCI to work with latest GEOSadas + ## [2.21.0] - 2022-05-05 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index b7b8ae6e84a7..39bff4d1d238 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.21.0 + VERSION 2.21.1 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the default build type to release From 8b5207459b9eb789944193ea7ffe328c1cadf2bb Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 25 May 2022 13:40:23 -0400 Subject: [PATCH 131/300] allow monotonic dynamic masking and update history kewords --- base/MAPL_EsmfRegridder.F90 | 61 +++++++++++++++++++- base/RegridMethods.F90 | 4 ++ gridcomps/History/MAPL_HistoryCollection.F90 | 2 +- gridcomps/History/MAPL_HistoryGridComp.F90 | 29 +++++++--- 4 files changed, 85 insertions(+), 11 deletions(-) diff --git a/base/MAPL_EsmfRegridder.F90 b/base/MAPL_EsmfRegridder.F90 index 9749a184acdc..8ebdab4767bb 100644 --- a/base/MAPL_EsmfRegridder.F90 +++ b/base/MAPL_EsmfRegridder.F90 @@ -83,8 +83,10 @@ logical function supports(spec, unusable, rc) supports = any(spec%regrid_method == & [ & REGRID_METHOD_BILINEAR, & + REGRID_METHOD_BILINEAR_MONOTONIC, & REGRID_METHOD_BILINEAR_ROTATE, & REGRID_METHOD_CONSERVE, & + REGRID_METHOD_CONSERVE_MONOTONIC, & REGRID_METHOD_VOTE, & REGRID_METHOD_FRACTION, & REGRID_METHOD_CONSERVE_2ND, & @@ -1172,7 +1174,56 @@ subroutine simpleDynMaskProcV(dynamicMaskList, dynamicSrcMaskValue, & rc = ESMF_SUCCESS end subroutine simpleDynMaskProcV + subroutine monotonicDynMaskProcV(dynamicMaskList, dynamicSrcMaskValue, & + dynamicDstMaskValue, rc) + type(ESMF_DynamicMaskElementR4R8R4V), pointer :: dynamicMaskList(:) + real(ESMF_KIND_R4), intent(in), optional :: dynamicSrcMaskValue + real(ESMF_KIND_R4), intent(in), optional :: dynamicDstMaskValue + integer, intent(out) :: rc + integer :: i, j, k, n + real(ESMF_KIND_R4), allocatable :: renorm(:),max_input(:),min_input(:) + + _UNUSED_DUMMY(dynamicDstMaskValue) + + if (associated(dynamicMaskList)) then + n = size(dynamicMaskList(1)%srcElement(1)%ptr) + allocate(renorm(n),max_input(n),min_input(n)) + do i=1, size(dynamicMaskList) + dynamicMaskList(i)%dstElement = 0.0 ! set to zero + + renorm = 0.d0 ! reset + max_input = -huge(0.0) + min_input = huge(0.0) + do j=1, size(dynamicMaskList(i)%factor) + do k = 1, size(dynamicMaskList(i)%srcElement(j)%ptr) + if (.not. & + match(dynamicSrcMaskValue,dynamicMaskList(i)%srcElement(j)%ptr(k))) then + dynamicMaskList(i)%dstElement(k) = dynamicMaskList(i)%dstElement(k) & + + dynamicMaskList(i)%factor(j) & + * dynamicMaskList(i)%srcElement(j)%ptr(k) + renorm(k) = renorm(k) + dynamicMaskList(i)%factor(j) + if (dynamicMaskList(i)%srcElement(j)%ptr(k) > max_input(k)) max_input(k) = dynamicMaskList(i)%srcElement(j)%ptr(k) + if (dynamicMaskList(i)%srcElement(j)%ptr(k) < min_input(k)) min_input(k) = dynamicMaskList(i)%srcElement(j)%ptr(k) + endif + end do + end do + where (renorm > 0.d0) + dynamicMaskList(i)%dstElement = dynamicMaskList(i)%dstElement / renorm + elsewhere + dynamicMaskList(i)%dstElement = dynamicSrcMaskValue + end where + where (renorm > 0.d0 .and. dynamicMaskList(i)%dstElement > max_input) + dynamicMaskList(i)%dstElement = max_input + end where + where (renorm > 0.d0 .and. dynamicMaskList(i)%dstElement < min_input) + dynamicMaskList(i)%dstElement = min_input + end where + enddo + endif + ! return successfully + rc = ESMF_SUCCESS + end subroutine monotonicDynMaskProcV logical function match(missing,b) @@ -1337,6 +1388,12 @@ subroutine initialize_subclass(this, unusable, rc) & dynamicMaskRoutine=simpleDynMaskProcV, & & rc=rc) _VERIFY(rc) + case (REGRID_METHOD_BILINEAR_MONOTONIC, REGRID_METHOD_CONSERVE_MONOTONIC) + call ESMF_DynamicMaskSetR4R8R4V(this%dynamic_mask, & + & dynamicSrcMaskValue=MAPL_undef, & + & dynamicMaskRoutine=monotonicDynMaskProcV, & + & rc=rc) + _VERIFY(rc) case (REGRID_METHOD_VOTE) call ESMF_DynamicMaskSetR4R8R4V(this%dynamic_mask, & & dynamicSrcMaskValue=MAPL_undef, & @@ -1435,7 +1492,7 @@ subroutine create_route_handle(this, kind, rc) if (.not.global) unmappedaction=ESMF_UNMAPPEDACTION_IGNORE end if select case (spec%regrid_method) - case (REGRID_METHOD_BILINEAR) + case (REGRID_METHOD_BILINEAR, REGRID_METHOD_BILINEAR_MONOTONIC) call ESMF_FieldRegridStore(src_field, dst_field, & & regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & @@ -1462,7 +1519,7 @@ subroutine create_route_handle(this, kind, rc) & factorList=factorList, factorIndexList=factorIndexList, & & routehandle=route_handle, unmappedaction=unmappedaction, rc=status) _VERIFY(status) - case (REGRID_METHOD_CONSERVE, REGRID_METHOD_VOTE, REGRID_METHOD_FRACTION) + case (REGRID_METHOD_CONSERVE, REGRID_METHOD_CONSERVE_MONOTONIC, REGRID_METHOD_VOTE, REGRID_METHOD_FRACTION) call ESMF_FieldRegridStore(src_field, dst_field, & & regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & & srcTermProcessing = srcTermProcessing, & diff --git a/base/RegridMethods.F90 b/base/RegridMethods.F90 index dfdc698a2c48..ba16f543c914 100644 --- a/base/RegridMethods.F90 +++ b/base/RegridMethods.F90 @@ -5,8 +5,10 @@ module mapl_RegridMethods public :: REGRID_HINT_LOCAL public :: REGRID_METHOD_IDENTITY public :: REGRID_METHOD_BILINEAR + public :: REGRID_METHOD_BILINEAR_MONOTONIC public :: REGRID_METHOD_BILINEAR_ROTATE public :: REGRID_METHOD_CONSERVE + public :: REGRID_METHOD_CONSERVE_MONOTONIC public :: REGRID_METHOD_VOTE public :: REGRID_METHOD_FRACTION public :: REGRID_METHOD_CONSERVE_2ND @@ -27,6 +29,8 @@ module mapl_RegridMethods enumerator :: REGRID_METHOD_PATCH enumerator :: REGRID_METHOD_NEAREST_STOD enumerator :: REGRID_METHOD_CONSERVE_HFLUX + enumerator :: REGRID_METHOD_BILINEAR_MONOTONIC + enumerator :: REGRID_METHOD_CONSERVE_MONOTONIC enumerator :: UNSPECIFIED_REGRID_METHOD = -1 end enum integer, parameter :: TILING_METHODS(3) = [REGRID_METHOD_CONSERVE,REGRID_METHOD_VOTE,REGRID_METHOD_FRACTION] diff --git a/gridcomps/History/MAPL_HistoryCollection.F90 b/gridcomps/History/MAPL_HistoryCollection.F90 index 1655a760a7b4..ae367ae7e1b2 100644 --- a/gridcomps/History/MAPL_HistoryCollection.F90 +++ b/gridcomps/History/MAPL_HistoryCollection.F90 @@ -70,7 +70,7 @@ module MAPL_HistoryCollectionMod real :: vscale character(len=ESMF_MAXSTR) :: vunit character(len=ESMF_MAXSTR) :: vvars(2) - integer :: conservative + integer :: regrid_method integer :: voting integer :: nbits integer :: deflate diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 08868fff6ad4..bb49d05a23b9 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -426,6 +426,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) character(len=ESMF_MAXSTR), allocatable :: regexList(:) type(StringStringMap) :: global_attributes character(len=ESMF_MAXSTR) :: name + logical :: has_conservative_keyword, has_regrid_keyword ! Begin !------ @@ -880,13 +881,25 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) call ESMF_ConfigGetAttribute ( cfg, list(n)%tm, default=tm_default, & label=trim(string) // 'tm:', rc=status ) _VERIFY(STATUS) - call ESMF_ConfigGetAttribute ( cfg, list(n)%conservative, default=0, & - label=trim(string) // 'conservative:' ,rc=status ) - _VERIFY(STATUS) - if (list(n)%conservative==0) then - list(n)%conservative=REGRID_METHOD_BILINEAR - else if (list(n)%conservative==1) then - list(n)%conservative=REGRID_METHOD_CONSERVE + + call ESMF_ConfigFindLabel ( cfg, label=trim(string) // 'conservative:',isPresent=has_conservative_keyword,_RC) + call ESMF_ConfigFindLabel ( cfg, label=trim(string) // 'regrid_method:',isPresent=has_regrid_keyword,_RC) + _ASSERT(has_conservative_keyword .and. has_regrid_keyword,trim(string)//" specified both conservative and regrid_method") + + if (has_conservative_keyword) then + call ESMF_ConfigGetAttribute ( cfg, list(n)%regrid_method, default=0, & + label=trim(string) // 'conservative:' ,rc=status ) + _VERIFY(STATUS) + if (list(n)%regrid_method==0) then + list(n)%regrid_method=REGRID_METHOD_BILINEAR + else if (list(n)%regrid_method==1) then + list(n)%regrid_method=REGRID_METHOD_CONSERVE + end if + end if + if (has_regrid_keyword) then + call ESMF_ConfigGetAttribute ( cfg, list(n)%regrid_method, default=REGRID_METHOD_BILINEAR, & + label=trim(string) // 'regrid_method:' ,rc=status ) + _VERIFY(STATUS) end if ! Get an optional file containing a 1-D track for the output @@ -2482,7 +2495,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) _VERIFY(status) call list(n)%mGriddedIO%set_param(nbits=list(n)%nbits,rc=status) _VERIFY(status) - call list(n)%mGriddedIO%set_param(regrid_method=list(n)%conservative,rc=status) + call list(n)%mGriddedIO%set_param(regrid_method=list(n)%regrid_method,rc=status) _VERIFY(status) call list(n)%mGriddedIO%set_param(itemOrder=intState%fileOrderAlphabetical,rc=status) _VERIFY(status) From 9ae0462bebb1038145ad88f80f681f20b6e720e4 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Thu, 26 May 2022 11:38:20 -0400 Subject: [PATCH 132/300] update to add "monotonic" option to regridding --- base/RegridMethods.F90 | 38 +++++++++++++++++++ gridcomps/ExtData2G/ExtDataConfig.F90 | 6 +-- .../ExtData2G/ExtDataOldTypesCreator.F90 | 13 ++----- gridcomps/History/MAPL_HistoryGridComp.F90 | 8 ++-- griddedio/Regrid_Util.F90 | 19 +--------- 5 files changed, 52 insertions(+), 32 deletions(-) diff --git a/base/RegridMethods.F90 b/base/RegridMethods.F90 index ba16f543c914..b8b809adc77a 100644 --- a/base/RegridMethods.F90 +++ b/base/RegridMethods.F90 @@ -1,4 +1,5 @@ module mapl_RegridMethods + use ESMF implicit none private @@ -17,6 +18,7 @@ module mapl_RegridMethods public :: REGRID_METHOD_CONSERVE_HFLUX public :: UNSPECIFIED_REGRID_METHOD public :: TILING_METHODS + public :: get_regrid_method enum, bind(c) enumerator :: REGRID_METHOD_IDENTITY @@ -36,5 +38,41 @@ module mapl_RegridMethods integer, parameter :: TILING_METHODS(3) = [REGRID_METHOD_CONSERVE,REGRID_METHOD_VOTE,REGRID_METHOD_FRACTION] integer, parameter :: REGRID_HINT_LOCAL = 1 + contains + + function get_regrid_method(string_regrid_method) result(int_regrid_method) + integer :: int_regrid_method + character(len=*), intent(in) :: string_regrid_method + + character(len=:), allocatable :: temp_str + temp_str = ESMF_UtilStringUpperCase(trim(string_regrid_method)) + + select case (temp_str) + case ("IDENTITY") + int_regrid_method = REGRID_METHOD_IDENTITY + case ("BILINEAR") + int_regrid_method = REGRID_METHOD_BILINEAR + case ("BILINEAR_ROTATE") + int_regrid_method = REGRID_METHOD_BILINEAR_ROTATE + case ("CONSERVE") + int_regrid_method = REGRID_METHOD_CONSERVE + case ("VOTE") + int_regrid_method = REGRID_METHOD_VOTE + case ("FRACTION") + int_regrid_method = REGRID_METHOD_FRACTION + case ("CONSERVE_2ND") + int_regrid_method = REGRID_METHOD_CONSERVE_2ND + case ("PATCH") + int_regrid_method = REGRID_METHOD_PATCH + case ("CONSERVE_HFLUX") + int_regrid_method = REGRID_METHOD_CONSERVE_HFLUX + case ("CONSERVE_MONOTONIC") + int_regrid_method = REGRID_METHOD_CONSERVE_MONOTONIC + case ("BILINEAR_MONOTONIC") + int_regrid_method = REGRID_METHOD_BILINEAR_MONOTONIC + case default + int_regrid_method = UNSPECIFIED_REGRID_METHOD + end select + end function end module mapl_RegridMethods diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index 14b8489eb16f..54f87021b213 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -344,14 +344,14 @@ subroutine add_new_rule(this,key,export_rule,multi_rule,rc) uname = key(1:semi_pos-1) vname = key(semi_pos+1:len_trim(key)) temp_rule => this%rule_map%at(trim(uname)) - _ASSERT(.not.associated(temp_rule),"duplicated export entry key") + _ASSERT(.not.associated(temp_rule),"duplicated export entry key: "//trim(key)) call this%rule_map%insert(trim(uname),ucomp) temp_rule => this%rule_map%at(trim(vname)) - _ASSERT(.not.associated(temp_rule),"duplicated export entry key") + _ASSERT(.not.associated(temp_rule),"duplicated export entry key: "//trim(key)) call this%rule_map%insert(trim(vname),vcomp) else temp_rule => this%rule_map%at(trim(key)) - _ASSERT(.not.associated(temp_rule),"duplicated export entry key") + _ASSERT(.not.associated(temp_rule),"duplicated export entry key: "//trim(key)) call this%rule_map%insert(trim(key),rule) end if _RETURN(_SUCCESS) diff --git a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 index c8af31d007f8..305c93d6727c 100644 --- a/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 +++ b/gridcomps/ExtData2G/ExtDataOldTypesCreator.F90 @@ -108,19 +108,14 @@ subroutine fillin_primary(this,item_name,base_name,primary_item,time,clock,unusa end if ! regrid method - if (trim(rule%regrid_method) == "BILINEAR") then - primary_item%trans = REGRID_METHOD_BILINEAR - else if (trim(rule%regrid_method) == "CONSERVE") then - primary_item%trans = REGRID_METHOD_CONSERVE - else if (trim(rule%regrid_method) == "VOTE") then - primary_item%trans = REGRID_METHOD_VOTE - else if (index(rule%regrid_method,"FRACTION;")>0) then + if (index(rule%regrid_method,"FRACTION;")>0) then semi_pos = index(rule%regrid_method,";") read(rule%regrid_method(semi_pos+1:),*) primary_item%fracVal primary_item%trans = REGRID_METHOD_FRACTION - else - _FAIL("Invalid regridding method") + else + primary_item%trans = get_regrid_method(rule%regrid_method) end if + _ASSERT(primary_item%trans/=UNSPECIFIED_REGRID_METHOD,"improper regrid method chosen") if (trim(time_sample%extrap_outside) =="clim") then primary_item%cycling=.true. diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index bb49d05a23b9..2076ddb621e0 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -425,7 +425,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) type(ESMF_Field), allocatable :: fldList(:) character(len=ESMF_MAXSTR), allocatable :: regexList(:) type(StringStringMap) :: global_attributes - character(len=ESMF_MAXSTR) :: name + character(len=ESMF_MAXSTR) :: name,regrid_method logical :: has_conservative_keyword, has_regrid_keyword ! Begin @@ -884,8 +884,9 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) call ESMF_ConfigFindLabel ( cfg, label=trim(string) // 'conservative:',isPresent=has_conservative_keyword,_RC) call ESMF_ConfigFindLabel ( cfg, label=trim(string) // 'regrid_method:',isPresent=has_regrid_keyword,_RC) - _ASSERT(has_conservative_keyword .and. has_regrid_keyword,trim(string)//" specified both conservative and regrid_method") + _ASSERT(.not.(has_conservative_keyword .and. has_regrid_keyword),trim(string)//" specified both conservative and regrid_method") + list(n)%regrid_method = REGRID_METHOD_BILINEAR if (has_conservative_keyword) then call ESMF_ConfigGetAttribute ( cfg, list(n)%regrid_method, default=0, & label=trim(string) // 'conservative:' ,rc=status ) @@ -897,9 +898,10 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) end if end if if (has_regrid_keyword) then - call ESMF_ConfigGetAttribute ( cfg, list(n)%regrid_method, default=REGRID_METHOD_BILINEAR, & + call ESMF_ConfigGetAttribute ( cfg, regrid_method, default="REGRID_METHOD_BILINEAR", & label=trim(string) // 'regrid_method:' ,rc=status ) _VERIFY(STATUS) + list(n)%regrid_method = get_regrid_method(trim(regrid_method)) end if ! Get an optional file containing a 1-D track for the output diff --git a/griddedio/Regrid_Util.F90 b/griddedio/Regrid_Util.F90 index b23a7f008765..574aa15058ba 100644 --- a/griddedio/Regrid_Util.F90 +++ b/griddedio/Regrid_Util.F90 @@ -182,23 +182,8 @@ subroutine process_command_line(this,rc) end select enddo - if (trim(regridMth) .ne. 'bilinear' .and. trim(regridMth ) .ne. 'conservative' .and. trim(regridMth ) .ne. 'conservative2' .and. & - trim(regridMth).ne.'patch') then - if (MAPL_AM_I_Root()) write(*,*)'invalid regrid method choose bilinear or conservative' - _FAIL('needs informative message') - end if - if (trim(regridMth) == 'bilinear') then - this%regridMethod = REGRID_METHOD_BILINEAR - end if - if (trim(regridMth) == 'patch') then - this%regridMethod = REGRID_METHOD_PATCH - end if - if (trim(regridMth) == 'conservative') then - this%regridMethod = REGRID_METHOD_CONSERVE - end if - if (trim(regridMth) == 'conservative2') then - this%regridMethod = REGRID_METHOD_CONSERVE_2ND - end if + this%regridMethod = get_regrid_method(regridMth) + _ASSERT(this%regridMethod/=UNSPECIFIED_REGRID_METHOD,"improper regrid method chosen") this%filenames = split_string(cfilenames,',') this%outputfiles = split_string(coutputfiles,',') From 4fb27228dd75da8a7bdfb56c46781d9561f9b55d Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Thu, 26 May 2022 11:44:04 -0400 Subject: [PATCH 133/300] update changelog --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9a0e2990c095..04ad508563a9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Add debug loggers for start/stop during stages in MAPL_Generic - Handling for double precision input when retrieving single precision attributes - Enable GCM run test in CircleCI (1-hour, no ExtData) +- Added monotonic regridding option +- Make availalbe to History and ExtData2G all supported regridding methods ### Changed From 0569e4bfeb336ebcbcc7da2a8877328cbea9f0a8 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Thu, 26 May 2022 13:01:20 -0400 Subject: [PATCH 134/300] oops, forgot the most important part! --- base/MAPL_EsmfRegridder.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/base/MAPL_EsmfRegridder.F90 b/base/MAPL_EsmfRegridder.F90 index 8ebdab4767bb..519f216ef6f9 100644 --- a/base/MAPL_EsmfRegridder.F90 +++ b/base/MAPL_EsmfRegridder.F90 @@ -1392,6 +1392,7 @@ subroutine initialize_subclass(this, unusable, rc) call ESMF_DynamicMaskSetR4R8R4V(this%dynamic_mask, & & dynamicSrcMaskValue=MAPL_undef, & & dynamicMaskRoutine=monotonicDynMaskProcV, & + & handleAllElements=.true., & & rc=rc) _VERIFY(rc) case (REGRID_METHOD_VOTE) From 1020a202e645fdb5b0f844da10de92a83347eee6 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 27 May 2022 14:35:35 -0400 Subject: [PATCH 135/300] Hotfix 1530: Initialize lperp --- CHANGELOG.md | 6 ++ CMakeLists.txt | 2 +- gridcomps/Cap/MAPL_CapGridComp.F90 | 121 +++++++++++++++-------------- 3 files changed, 68 insertions(+), 61 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d70747f3df8f..b4caba0b961d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -19,6 +19,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Deprecated +## [2.21.2] - 2022-05-27 + +### Fixed + +- Initialize `cap%lperp` in `MAPL_CapGridComp.F90` (see Issue #1530) + ## [2.21.1] - 2022-05-24 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index 39bff4d1d238..7c36faf15fe0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.21.1 + VERSION 2.21.2 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the default build type to release diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index 2b8b92f67530..7cd16ef83648 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -33,7 +33,7 @@ module MAPL_CapGridCompMod use MAPL_ExternalGCStorage use iso_fortran_env - + implicit none private @@ -53,7 +53,8 @@ module MAPL_CapGridCompMod procedure(), pointer, nopass :: root_set_services => null() character(len=:), allocatable :: final_file, name, cap_rc_file integer :: nsteps, heartbeat_dt, perpetual_year, perpetual_month, perpetual_day - logical :: amiroot, lperp, started_loop_timer + logical :: amiroot, started_loop_timer + logical :: lperp = .false. integer :: extdata_id, history_id, root_id, printspec type(ESMF_Clock) :: clock, clock_hist type(ESMF_Config) :: cf_ext, cf_root, cf_hist, config @@ -105,7 +106,7 @@ module MAPL_CapGridCompMod contains - + subroutine MAPL_CapGridCompCreate(cap, root_set_services, cap_rc, name, final_file, unusable, n_run_phases, rc) use mapl_StubComponent type(MAPL_CapGridComp), intent(out), target :: cap @@ -118,10 +119,10 @@ subroutine MAPL_CapGridCompCreate(cap, root_set_services, cap_rc, name, final_fi type(MAPL_CapGridComp_Wrapper) :: cap_wrapper type(MAPL_MetaComp), pointer :: meta => null() - integer :: status + integer :: status character(*), parameter :: cap_name = "CAP" type(StubComponent) :: stub_component - + _UNUSED_DUMMY(unusable) cap%cap_rc_file = cap_rc @@ -275,7 +276,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) cap%nsteps = 1 cap%compute_throughput = .false. else - ! Create Clock. This is a private routine that sets the start and + ! Create Clock. This is a private routine that sets the start and ! end times and the time interval of the clock from the configuration. ! The start time is temporarily set to 1 interval before the time in the ! configuration. Once the Alarms are set in intialize, the clock will @@ -369,33 +370,33 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) endif endif - ! Get configurable info to create HIST + ! Get configurable info to create HIST ! and the ROOT of the computational hierarchy !--------------------------------------------- !BOR ! !RESOURCE_ITEM: string :: Name of ROOT's config file - call MAPL_GetResource(MAPLOBJ, ROOT_CF, "ROOT_CF:", default = "ROOT.rc", rc = status) + call MAPL_GetResource(MAPLOBJ, ROOT_CF, "ROOT_CF:", default = "ROOT.rc", rc = status) _VERIFY(status) ! !RESOURCE_ITEM: string :: Name to assign to the ROOT component - call MAPL_GetResource(MAPLOBJ, ROOT_NAME, "ROOT_NAME:", default = "ROOT", rc = status) + call MAPL_GetResource(MAPLOBJ, ROOT_NAME, "ROOT_NAME:", default = "ROOT", rc = status) _VERIFY(status) - ! !RESOURCE_ITEM: string :: Name of HISTORY's config file - call MAPL_GetResource(MAPLOBJ, HIST_CF, "HIST_CF:", default = "HIST.rc", rc = status) + ! !RESOURCE_ITEM: string :: Name of HISTORY's config file + call MAPL_GetResource(MAPLOBJ, HIST_CF, "HIST_CF:", default = "HIST.rc", rc = status) _VERIFY(status) ! !RESOURCE_ITEM: string :: Name of ExtData's config file call MAPL_GetResource(MAPLOBJ, EXTDATA_CF, "EXTDATA_CF:", default = 'ExtData.rc', rc = status) _VERIFY(status) - ! !RESOURCE_ITEM: string :: Control Timers + ! !RESOURCE_ITEM: string :: Control Timers call MAPL_GetResource(MAPLOBJ, enableTimers, "MAPL_ENABLE_TIMERS:", default = 'NO', rc = status) _VERIFY(status) - ! !RESOURCE_ITEM: string :: Control Memory Diagnostic Utility + ! !RESOURCE_ITEM: string :: Control Memory Diagnostic Utility call MAPL_GetResource(MAPLOBJ, enableMemUtils, "MAPL_ENABLE_MEMUTILS:", default='NO', rc = status) _VERIFY(status) call MAPL_GetResource(MAPLOBJ, MemUtilsMode, "MAPL_MEMUTILS_MODE:", default = MAPL_MemUtilsModeBase, rc = status) @@ -414,7 +415,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) _VERIFY(STATUS) timerModeStr = ESMF_UtilStringUpperCase(timerModeStr, rc=STATUS) - _VERIFY(STATUS) + _VERIFY(STATUS) end if cap%started_loop_timer=.false. @@ -534,11 +535,11 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) root_set_services => cap%root_set_services call t_p%start('SetService') - cap%root_id = MAPL_AddChild(MAPLOBJ, name = root_name, SS = root_set_services, rc = status) + cap%root_id = MAPL_AddChild(MAPLOBJ, name = root_name, SS = root_set_services, rc = status) _VERIFY(status) root_gc => maplobj%get_child_gridcomp(cap%root_id) - call MAPL_GetObjectFromGC(root_gc, root_obj, rc=status) - _ASSERT(cap%n_run_phases <= SIZE(root_obj%phase_run),"n_run_phases in cap_gc should not exceed n_run_phases in root") + call MAPL_GetObjectFromGC(root_gc, root_obj, rc=status) + _ASSERT(cap%n_run_phases <= SIZE(root_obj%phase_run),"n_run_phases in cap_gc should not exceed n_run_phases in root") ! Create History child !---------------------- @@ -546,7 +547,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call MAPL_Set(MAPLOBJ, CF=CAP%CF_HIST, RC=STATUS) _VERIFY(STATUS) - cap%history_id = MAPL_AddChild( MAPLOBJ, name = 'HIST', SS = HIST_SetServices, rc = status) + cap%history_id = MAPL_AddChild( MAPLOBJ, name = 'HIST', SS = HIST_SetServices, rc = status) _VERIFY(status) @@ -572,7 +573,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) _VERIFY(STATUS) if (use_extdata2g) then -#if defined(BUILD_WITH_EXTDATA2G) +#if defined(BUILD_WITH_EXTDATA2G) cap%extdata_id = MAPL_AddChild (MAPLOBJ, name = 'EXTDATA', SS = ExtData2G_SetServices, _RC) #else call lgr%error('ExtData2G requested but not built') @@ -647,7 +648,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) _VERIFY(STATUS) ExtData_internal_state => wrap%ptr ExtData_internal_state%gc = CAP%GCS(cap%extdata_id) - ExtData_internal_state%expState = CAP%CHILD_EXPORTS(cap%extdata_id) + ExtData_internal_state%expState = CAP%CHILD_EXPORTS(cap%extdata_id) end if call t_p%stop('Initialize') end if @@ -656,7 +657,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) _RETURN(ESMF_SUCCESS) end subroutine initialize_gc - + subroutine initialize_history(cap, rc) class(MAPL_CapGridComp), intent(inout) :: cap integer, optional, intent(out) :: rc @@ -775,18 +776,18 @@ subroutine initialize_extdata(cap , rc) !------------------------ call ESMF_GridCompInitialize (cap%gcs(cap%extdata_id), importState = cap%child_imports(cap%extdata_id), & - exportState = cap%child_exports(cap%extdata_id), & + exportState = cap%child_exports(cap%extdata_id), & clock = cap%clock, userRc = status) _VERIFY(status) _RETURN(ESMF_SUCCESS) end subroutine initialize_extdata - - + + subroutine run_gc(gc, import, export, clock, rc) !ARGUMENTS: - type(ESMF_GridComp) :: GC ! Gridded component + type(ESMF_GridComp) :: GC ! Gridded component type(ESMF_State) :: import ! Import state type(ESMF_State) :: export ! Export state type(ESMF_Clock) :: clock ! The clock @@ -830,7 +831,7 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) _UNUSED_DUMMY(import_state) _UNUSED_DUMMY(export_state) _UNUSED_DUMMY(clock) - + cap => get_CapGridComp_from_gc(gc) call MAPL_GetObjectFromGC(gc, maplobj, rc=status) _VERIFY(status) @@ -924,7 +925,7 @@ end subroutine set_services subroutine initialize(this, rc) class(MAPL_CapGridComp), intent(inout) :: this integer, optional, intent(out) :: rc - + integer :: status call ESMF_GridCompInitialize(this%gc, userRC=status) @@ -954,9 +955,9 @@ end subroutine run subroutine finalize(this, rc) class(MAPL_CapGridComp), intent(inout) :: this integer, optional, intent(out) :: rc - - integer :: status - + + integer :: status + call ESMF_GridCompFinalize(this%gc, rc = status) _VERIFY(status) _RETURN(ESMF_SUCCESS) @@ -975,7 +976,7 @@ function get_model_duration(this, rc) result (duration) end function get_model_duration - + function get_am_i_root(this, rc) result (amiroot) class (MAPL_CapGridComp) :: this integer, optional, intent(out) :: rc @@ -1042,8 +1043,8 @@ function get_CapGridComp_from_gc(gc) result(cap) cap => cap_wrapper%ptr end function get_CapGridComp_from_gc - - + + function get_vec_from_config(config, key) result(vec) type(ESMF_Config), intent(inout) :: config character(len=*), intent(in) :: key @@ -1051,13 +1052,13 @@ function get_vec_from_config(config, key) result(vec) integer :: status, rc character(len=ESMF_MAXSTR) :: cap_import type(StringVector) :: vec - + call ESMF_ConfigFindLabel(config, key//":", isPresent = present, rc = status) _VERIFY(status) cap_import = "" if (present) then - + do while(trim(cap_import) /= "::") call ESMF_ConfigNextLine(config, rc = status) _VERIFY(status) @@ -1066,10 +1067,10 @@ function get_vec_from_config(config, key) result(vec) if (trim(cap_import) /= "::") call vec%push_back(trim(cap_import)) end do end if - + end function get_vec_from_config - + logical function vector_contains_str(vector, string) type(StringVector), intent(in) :: vector character(len=*), intent(in) :: string @@ -1091,12 +1092,12 @@ logical function vector_contains_str(vector, string) end function vector_contains_str - + subroutine run_MAPL_GridComp(gc, phase, rc) type (ESMF_Gridcomp) :: gc integer, optional, intent(in) :: phase integer, optional, intent(out) :: rc - + integer :: n, status, phase_ logical :: done @@ -1247,19 +1248,19 @@ subroutine last_phase(rc) _VERIFY(status) end_run_timer = MPI_WTime(status) end if - + call ESMF_ClockAdvance(this%clock, rc = status) _VERIFY(STATUS) call ESMF_ClockAdvance(this%clock_hist, rc = status) _VERIFY(STATUS) - + ! Update Perpetual Clock ! ---------------------- if (this%lperp) then call Perpetual_Clock(this, status) _VERIFY(status) end if - + call ESMF_GridCompRun(this%gcs(this%history_id), importstate=this%child_imports(this%history_id), & exportstate = this%child_exports(this%history_id), & clock = this%clock_hist, userrc = status) @@ -1290,7 +1291,7 @@ subroutine print_throughput(rc) integer :: AGCM_YY, AGCM_MM, AGCM_DD, AGCM_H, AGCM_M, AGCM_S integer :: HRS_R, MIN_R, SEC_R - + call ESMF_ClockGet(this%clock, CurrTime = currTime, rc = status) _VERIFY(status) call ESMF_TimeGet(CurrTime, YY = AGCM_YY, & @@ -1334,7 +1335,7 @@ subroutine print_throughput(rc) f5.1,'% : ',f5.1,'% Mem Comm:Used') _RETURN(_SUCCESS) - + end subroutine end subroutine step @@ -1374,7 +1375,7 @@ subroutine refresh_state(this, rc) integer, intent(out) :: rc integer :: status - integer :: i + integer :: i call MAPL_GenericStateRestore(this%gcs(this%root_id),this%child_imports(this%root_id), & this%child_exports(this%root_id),this%clock,rc=status) _VERIFY(status) @@ -1501,7 +1502,7 @@ subroutine destroy_state(this, rc) call MAPL_DestroyStateSave(this%gcs(this%root_id),rc=status) _VERIFY(status) - + if (allocated(this%alarm_list)) deallocate(this%alarm_list) if (allocated(this%AlarmRingTime)) deallocate(this%alarmRingTime) if (allocated(this%ringingState)) deallocate(this%ringingState) @@ -1522,7 +1523,7 @@ subroutine rewind_clock(this, time, rc) if (current_time > time) then call ESMF_ClockSet(this%clock,direction=ESMF_DIRECTION_REVERSE,rc=status) _VERIFY(status) - do + do call ESMF_ClockAdvance(this%clock,rc=status) _VERIFY(status) call ESMF_ClockGet(this%clock,currTime=ct,rc=status) @@ -1532,13 +1533,13 @@ subroutine rewind_clock(this, time, rc) call ESMF_ClockSet(this%clock,direction=ESMF_DIRECTION_FORWARD,rc=status) _VERIFY(status) end if - + call ESMF_ClockGet(this%clock_hist,currTime=current_time,rc=status) _VERIFY(status) if (current_time > time) then call ESMF_ClockSet(this%clock_hist,direction=ESMF_DIRECTION_REVERSE,rc=status) _VERIFY(status) - do + do call ESMF_ClockAdvance(this%clock_hist,rc=status) _VERIFY(status) call ESMF_ClockGet(this%clock_hist,currTime=ct,rc=status) @@ -1548,15 +1549,15 @@ subroutine rewind_clock(this, time, rc) call ESMF_ClockSet(this%clock_hist,direction=ESMF_DIRECTION_FORWARD,rc=status) _VERIFY(status) end if - - + + _RETURN(_SUCCESS) end subroutine rewind_clock ! !IROUTINE: MAPL_ClockInit -- Sets the clock - ! !INTERFACE: + ! !INTERFACE: subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) @@ -1569,10 +1570,10 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) ! !DESCRIPTION: - ! This is a private routine that sets the start and + ! This is a private routine that sets the start and ! end times and the time interval of the application clock from the configuration. ! This time interal is the ``heartbeat'' of the application. - ! The Calendar is set to Gregorian by default. + ! The Calendar is set to Gregorian by default. ! The start time is temporarily set to 1 interval before the time in the ! configuration. Once the Alarms are set in intialize, the clock will ! be advanced to guarantee it and its alarms are in the same state as they @@ -1781,7 +1782,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) M = END_M , & S = END_S , & calendar=cal, rc = STATUS ) - _VERIFY(STATUS) + _VERIFY(STATUS) ! Read CAP Restart File for Current Time ! -------------------------------------- @@ -1823,7 +1824,7 @@ subroutine MAPL_ClockInit ( MAPLOBJ, Clock, nsteps, rc) S = CUR_S , & calendar=cal, rc = STATUS ) _VERIFY(STATUS) - + ! initialize final stop time ! -------------------------- @@ -1982,7 +1983,7 @@ subroutine Perpetual_Clock (this, rc) (PERPETUAL_DAY == -999) ) then AGCM_YY = PERPETUAL_YEAR AGCM_MM = PERPETUAL_MONTH - if( HIST_MM /= PERPETUAL_MONTH ) then + if( HIST_MM /= PERPETUAL_MONTH ) then HIST_MM = PERPETUAL_MONTH if( PERPETUAL_MONTH /= 12) HIST_YY = HIST_YY + 1 call ESMF_AlarmRingerOn( PERPETUAL, rc=status ) @@ -1998,7 +1999,7 @@ subroutine Perpetual_Clock (this, rc) (PERPETUAL_MONTH /= -999) .and. & (PERPETUAL_DAY == -999) ) then AGCM_MM = PERPETUAL_MONTH - if( HIST_MM /= PERPETUAL_MONTH ) then + if( HIST_MM /= PERPETUAL_MONTH ) then HIST_MM = PERPETUAL_MONTH if( PERPETUAL_MONTH /= 12) HIST_YY = HIST_YY + 1 AGCM_YY = HIST_YY @@ -2013,7 +2014,7 @@ subroutine Perpetual_Clock (this, rc) AGCM_YY = PERPETUAL_YEAR AGCM_MM = PERPETUAL_MONTH AGCM_DD = PERPETUAL_DAY - if( HIST_MM /= PERPETUAL_MONTH ) then + if( HIST_MM /= PERPETUAL_MONTH ) then HIST_MM = PERPETUAL_MONTH if( PERPETUAL_MONTH /= 12) HIST_YY = HIST_YY + 1 call ESMF_AlarmRingerOn( PERPETUAL, rc=status ) @@ -2055,7 +2056,7 @@ subroutine ESMFL_ClockSet(clock, currTime, rc) ! ErrLog vars integer :: status - ! Local Vars + ! Local Vars type(ESMF_Time) :: targetTime type(ESMF_Time) :: cTime type(ESMF_TimeInterval) :: zero From cf649f002d7af6437df5e91f871c4310d1808533 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 31 May 2022 07:33:20 -0400 Subject: [PATCH 136/300] Update changelog for release --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index b4caba0b961d..d4d03719912c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -19,7 +19,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Deprecated -## [2.21.2] - 2022-05-27 +## [2.21.2] - 2022-05-31 ### Fixed From a01951218db158ec96d0715e7bdbdfdc1aef6f22 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 3 Jun 2022 12:25:32 -0400 Subject: [PATCH 137/300] Update to ESMA_cmake v3.16.0 --- CHANGELOG.md | 1 + components.yaml | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6a5d75749721..fc9a8e1e289d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -23,6 +23,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed - Modified error messages in FileMetadataUtilities to be unique and print filename +- Updated the ESMA_cmake version to v3.16.0 ### Removed diff --git a/components.yaml b/components.yaml index 9e5748618313..d84e5e3017a0 100644 --- a/components.yaml +++ b/components.yaml @@ -11,7 +11,7 @@ ESMA_env: ESMA_cmake: local: ./ESMA_cmake remote: ../ESMA_cmake.git - tag: v3.12.0 + tag: v3.16.0 develop: develop ecbuild: From 630154c5bbcba612396d5f917da326e821d1acce Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 3 Jun 2022 12:43:14 -0400 Subject: [PATCH 138/300] Update GitHub Actions --- .github/workflows/workflow.yml | 81 ++-------------------------------- CHANGELOG.md | 1 + 2 files changed, 5 insertions(+), 77 deletions(-) diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index b86cbbc3aa35..05fa5f62f17a 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -17,7 +17,7 @@ jobs: name: Build and Test MAPL runs-on: ubuntu-latest container: - image: gmao/ubuntu20-geos-env-mkl:v6.2.8-openmpi_4.0.6-gcc_11.2.0 + image: gmao/ubuntu20-geos-env-mkl:v6.2.13-openmpi_4.1.2-gcc_11.2.0 # Per https://github.com/actions/virtual-environments/issues/1445#issuecomment-713861495 # It seems like we might not need secrets on GitHub Actions which is good for forked # pull requests @@ -30,7 +30,7 @@ jobs: OMPI_MCA_btl_vader_single_copy_mechanism: none steps: - name: Cancel Previous Runs - uses: styfle/cancel-workflow-action@0.9.0 + uses: styfle/cancel-workflow-action@0.9.1 with: access_token: ${{ github.token }} - name: Checkout @@ -62,84 +62,11 @@ jobs: make -j4 build-tests # skip performance tests ctest -R MAPL -LE PERFORMANCE --output-on-failure - ############################################################################################################################################################ - # build_gcm: # - # name: Build GEOSgcm # - # if: "!contains(github.event.pull_request.labels.*.name, '0 diff trivial')" # - # runs-on: ubuntu-latest # - # container: # - # image: gmao/ubuntu20-geos-env-mkl:v6.2.8-openmpi_4.0.6-gcc_11.2.0 # - # env: # - # OMPI_ALLOW_RUN_AS_ROOT: 1 # - # OMPI_ALLOW_RUN_AS_ROOT_CONFIRM: 1 # - # OMPI_MCA_btl_vader_single_copy_mechanism: none # - # steps: # - # - name: Cancel Previous Runs # - # uses: styfle/cancel-workflow-action@0.9.0 # - # with: # - # access_token: ${{ github.token }} # - # - name: Checkout GCM # - # uses: actions/checkout@v2 # - # with: # - # repository: GEOS-ESM/GEOSgcm # - # fetch-depth: 1 # - # - name: Versions etc. # - # run: | # - # gfortran --version # - # mpirun --version # - # echo $BASEDIR # - # echo ${GITHUB_HEAD_REF} # - # echo ${{github.ref}} # - # echo ${{github.head_ref}} # - # - name: Mepo clone external repos # - # run: | # - # mepo init # - # mepo clone # - # mepo status # - # mepo develop GEOSgcm_GridComp GEOSgcm_App # - # mepo status # - # # The next two actions use: # - # # https://github.uint.cloudmunity/t/is-there-a-way-to-tell-if-a-pr-is-from-a-forked-repository/134186/7?u=mathomp4 # - # # to test if you are in a fork or not # - # - name: Git checkout MAPL branch (forks) # - # if: github.event.pull_request.head.repo.full_name != github.repository # - # working-directory: ./src/Shared/@MAPL # - # run: | # - # # GITHUB_REF will look like 'refs/pull/669/merge' and we want 'pull/669' # - # GITHUB_REF_STRIP_REFS=${GITHUB_REF##refs/} # - # GITHUB_REF_STRIP_MERGE=${GITHUB_REF_STRIP_REFS%%/merge} # - # # This was figured out with looking at CircleCI output # - # git fetch --force origin "${GITHUB_REF_STRIP_MERGE}/head:remotes/origin/${GITHUB_REF_STRIP_MERGE}" # - # mepo checkout ${GITHUB_REF_STRIP_MERGE} MAPL # - # mepo status # - # # If we are in the same org, this will work # - # - name: Mepo checkout MAPL branch (same org), MAPL on main/develop # - # if: github.event.pull_request.head.repo.full_name == github.repository && (github.head_ref == 'main' || github.head_ref == 'develop') # - # run: | # - # mepo checkout ${GITHUB_HEAD_REF} MAPL # - # mepo status # - # # If we are in the same org, this will work # - # - name: Mepo checkout MAPL branch (same org), MAPL not on main/develop # - # if: github.event.pull_request.head.repo.full_name == github.repository && (github.head_ref != 'main' && github.head_ref != 'develop') # - # run: | # - # mepo checkout ${GITHUB_HEAD_REF} MAPL # - # mepo checkout-if-exists ${GITHUB_HEAD_REF} # - # mepo status # - # - name: CMake # - # run: | # - # mkdir build # - # cd build # - # cmake .. -DBASEDIR=$BASEDIR/Linux -DCMAKE_Fortran_COMPILER=gfortran -DCMAKE_BUILD_TYPE=Debug -DMPIEXEC_PREFLAGS='--oversubscribe' -DUSE_F2PY=OFF # - # - name: Build # - # run: | # - # cd build # - # make -j4 install # - ############################################################################################################################################################ build_test_mapl_intel: name: Build and Test MAPL Intel runs-on: ubuntu-latest container: - image: gmao/ubuntu20-geos-env:v6.2.8-intelmpi_2021.3.0-intel_2021.3.0 + image: gmao/ubuntu20-geos-env:v6.2.13-intelmpi_2021.3.0-intel_2021.3.0 # Per https://github.com/actions/virtual-environments/issues/1445#issuecomment-713861495 # It seems like we might not need secrets on GitHub Actions which is good for forked # pull requests @@ -148,7 +75,7 @@ jobs: #password: ${{ secrets.DOCKERHUB_TOKEN }} steps: - name: Cancel Previous Runs - uses: styfle/cancel-workflow-action@0.9.0 + uses: styfle/cancel-workflow-action@0.9.1 with: access_token: ${{ github.token }} - name: Checkout diff --git a/CHANGELOG.md b/CHANGELOG.md index fc9a8e1e289d..a4ae276cef82 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -24,6 +24,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Modified error messages in FileMetadataUtilities to be unique and print filename - Updated the ESMA_cmake version to v3.16.0 +- Updated GitHub Actions MAPL build tests ### Removed From f9f207a08b9434034912636f38f80adf9f8c6681 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 6 Jun 2022 13:44:05 -0400 Subject: [PATCH 139/300] Fixes #1544. Adds _ASSERT for missing ExtData file --- CHANGELOG.md | 1 + gridcomps/ExtData2G/ExtDataConfig.F90 | 30 +++++++++++++++------------ 2 files changed, 18 insertions(+), 13 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index a4ae276cef82..ab3315175639 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -25,6 +25,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Modified error messages in FileMetadataUtilities to be unique and print filename - Updated the ESMA_cmake version to v3.16.0 - Updated GitHub Actions MAPL build tests +- Added assert for missing file with ExtData2G ### Removed diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index 54f87021b213..143ba31a59a0 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -28,7 +28,7 @@ module MAPL_ExtDataConfig type(ExtDataDerivedMap) :: derived_map type(ExtDataFileStreamMap) :: file_stream_map type(ExtDataTimeSampleMap) :: sample_map - + contains procedure :: add_new_rule procedure :: get_item_type @@ -40,7 +40,7 @@ module MAPL_ExtDataConfig contains - recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_time,unusable,rc) + recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_time,unusable,rc) class(ExtDataConfig), intent(inout), target :: ext_config character(len=*), intent(in) :: config_file type(ESMF_Time), intent(in) :: current_time @@ -65,16 +65,20 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ integer :: i,num_rules integer, allocatable :: sorted_rules(:) character(len=1) :: i_char + logical :: file_found _UNUSED_DUMMY(unusable) + inquire(file=trim(config_file),exist=file_found) + _ASSERT(file_found,"could not find: "//trim(config_file)) + stack_depth=stack_depth+1 p = Parser('core') fstream=FileStream(config_file) yaml_node_stack(stack_depth) = p%load(fstream) call fstream%close() - if (yaml_node_stack(stack_depth)%has("subconfigs")) then + if (yaml_node_stack(stack_depth)%has("subconfigs")) then subconfigs = yaml_node_stack(stack_depth)%at("subconfigs") _ASSERT(subconfigs%is_sequence(),'subconfigs is not a sequence') do i=1,subconfigs%size() @@ -83,7 +87,7 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ _VERIFY(status) end do end if - + if (yaml_node_stack(stack_depth)%has("Samplings")) then sample_config = yaml_node_stack(stack_depth)%of("Samplings") iter = sample_config%begin() @@ -122,14 +126,14 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ if (subcfg%is_mapping()) then call ext_config%add_new_rule(key,subcfg,_RC) else if (subcfg%is_sequence()) then - sorted_rules = sort_rules_by_start(subcfg,_RC) + sorted_rules = sort_rules_by_start(subcfg,_RC) num_rules = subcfg%size() do i=1,num_rules rule_map = subcfg%of(sorted_rules(i)) write(i_char,'(I1)')i new_key = key//rule_sep//i_char call ext_config%add_new_rule(new_key,rule_map,multi_rule=.true.,_RC) - enddo + enddo else _FAIL("Exports must be sequence or map") end if @@ -167,7 +171,7 @@ function count_rules_for_item(this,item_name,rc) result(number_of_rules) class(ExtDataConfig), intent(in) :: this character(len=*), intent(in) :: item_name integer, optional, intent(out) :: rc - + type(ExtDataRuleMapIterator) :: rule_iterator character(len=:), pointer :: key integer :: idx @@ -200,7 +204,7 @@ function get_time_range(this,item_name,rc) result(time_range) type(ExtDataRule), pointer :: rule integer :: i,status,idx type(ESMF_Time) :: very_future_time - + rule_iterator = this%rule_map%begin() do while(rule_iterator /= this%rule_map%end()) key => rule_iterator%key() @@ -281,7 +285,7 @@ function get_item_type(this,item_name,unusable,rc) result(item_type) _UNUSED_DUMMY(unusable) item_type=ExtData_not_found - + found_rule = .false. rule_iterator = this%rule_map%begin() do while(rule_iterator /= this%rule_map%end()) @@ -316,7 +320,7 @@ function get_item_type(this,item_name,unusable,rc) result(item_type) _RETURN(_SUCCESS) end function get_item_type - subroutine add_new_rule(this,key,export_rule,multi_rule,rc) + subroutine add_new_rule(this,key,export_rule,multi_rule,rc) class(ExtDataConfig), intent(inout) :: this character(len=*), intent(in) :: key type(configuration), intent(in) :: export_rule @@ -385,18 +389,18 @@ function get_extra_derived_items(this,primary_items,derived_items,rc) result(nee ! now we have a stringvector of the variables involved in the expression ! check which of this are already in primary_items list, if any are not ! then we need to createa new list of needed variables and the "derived field" - ! wence to coppy them + ! wence to coppy them do i=1,variables_in_expression%size() sval => variables_in_expression%at(i) if (.not.string_in_string_vector(sval,primary_items)) then rule => this%rule_map%at(sval) _ASSERT(associated(rule),"no rule for "//trim(sval)//" needed by "//trim(derived_name)) - call needed_vars%push_back(sval//","//derived_name) + call needed_vars%push_back(sval//","//derived_name) end if enddo call string_iter%next() enddo - + _RETURN(_SUCCESS) end function get_extra_derived_items From d72bf3e5d4416ed2dbc9e3eadb17996783e3ceef Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 7 Jun 2022 09:47:42 -0400 Subject: [PATCH 140/300] Updates for Spack Support --- CHANGELOG.md | 1 + CMakeLists.txt | 3 +++ 2 files changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index ab3315175639..c8e16416c26a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -26,6 +26,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Updated the ESMA_cmake version to v3.16.0 - Updated GitHub Actions MAPL build tests - Added assert for missing file with ExtData2G +- Add `find_package(MPI)` for non-Baselibs builds ### Removed diff --git a/CMakeLists.txt b/CMakeLists.txt index 7c36faf15fe0..8b926badfbf0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -111,6 +111,9 @@ endif () ecbuild_declare_project() if (NOT Baselibs_FOUND) + set(MPI_DETERMINE_LIBRARY_VERSION TRUE) + find_package(MPI) + find_package(NetCDF REQUIRED Fortran) add_definitions(-DHAS_NETCDF4) add_definitions(-DHAS_NETCDF3) From d9cbe44ec54f0b6ad18fec37e90906c1a87f7ca2 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 7 Jun 2022 09:53:34 -0400 Subject: [PATCH 141/300] Add library alias --- CMakeLists.txt | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 8b926badfbf0..cfa68f08a752 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -127,6 +127,9 @@ if (NOT Baselibs_FOUND) if (NOT TARGET esmf) find_package(ESMF MODULE REQUIRED) + + # MAPL uses lowercase due to historical reasons + add_library(esmf ALIAS ESMF) endif () endif () From 91c46e1d3e18ab31e0217881ee14de6cc448219c Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 7 Jun 2022 09:54:32 -0400 Subject: [PATCH 142/300] Add interface library --- CMakeLists.txt | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index cfa68f08a752..50dbfa7facd4 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -128,6 +128,9 @@ if (NOT Baselibs_FOUND) if (NOT TARGET esmf) find_package(ESMF MODULE REQUIRED) + # ESMF as used in MAPL requires MPI + target_link_libraries(ESMF INTERFACE MPI::MPI_Fortran) + # MAPL uses lowercase due to historical reasons add_library(esmf ALIAS ESMF) endif () From bf599e862f8282b1252b199d394695fb03d5a58f Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 7 Jun 2022 10:24:08 -0400 Subject: [PATCH 143/300] Change all esmf to ESMF in CMake --- CHANGELOG.md | 6 +++++- CMakeLists.txt | 4 ++-- MAPL/CMakeLists.txt | 4 ++-- MAPL_cfio/CMakeLists.txt | 14 +++++++------- Tests/CMakeLists.txt | 4 ++-- base/CMakeLists.txt | 20 ++++++++++---------- base/tests/CMakeLists.txt | 2 +- generic/CMakeLists.txt | 2 +- gridcomps/Cap/CMakeLists.txt | 2 +- gridcomps/ExtData/CMakeLists.txt | 2 +- gridcomps/ExtData2G/CMakeLists.txt | 2 +- gridcomps/History/CMakeLists.txt | 2 +- gridcomps/Orbit/CMakeLists.txt | 2 +- griddedio/CMakeLists.txt | 4 ++-- pfunit/CMakeLists.txt | 4 ++-- 15 files changed, 39 insertions(+), 35 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c8e16416c26a..4e6899de234f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -26,7 +26,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Updated the ESMA_cmake version to v3.16.0 - Updated GitHub Actions MAPL build tests - Added assert for missing file with ExtData2G -- Add `find_package(MPI)` for non-Baselibs builds +- Updates for Sspack support + - Add `find_package(MPI)` for non-Baselibs builds + - Update all `esmf` target references in CMake to `ESMF` + - Add `esmf` alias library for `ESMF` for compatibility + - Add explicit interface dependence of `MPI` for `ESMF` target ### Removed diff --git a/CMakeLists.txt b/CMakeLists.txt index 50dbfa7facd4..7ca12ed9e43e 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -125,13 +125,13 @@ if (NOT Baselibs_FOUND) add_definitions(-DH5_HAVE_PARALLEL) endif() - if (NOT TARGET esmf) + if (NOT TARGET ESMF) find_package(ESMF MODULE REQUIRED) # ESMF as used in MAPL requires MPI target_link_libraries(ESMF INTERFACE MPI::MPI_Fortran) - # MAPL uses lowercase due to historical reasons + # MAPL and GEOS used lowercase target due to historical reasons add_library(esmf ALIAS ESMF) endif () endif () diff --git a/MAPL/CMakeLists.txt b/MAPL/CMakeLists.txt index a7d0f97de35d..fe702cf53de5 100644 --- a/MAPL/CMakeLists.txt +++ b/MAPL/CMakeLists.txt @@ -4,9 +4,9 @@ esma_set_this() esma_add_library (${this} SRCS MAPL.F90 DEPENDENCIES MAPL.base MAPL.generic MAPL.pfio MAPL_cfio_r4 MAPL.gridcomps MAPL.orbit MAPL.griddedio ${EXTDATA_TARGET} - esmf NetCDF::NetCDF_Fortran MPI::MPI_Fortran + ESMF NetCDF::NetCDF_Fortran MPI::MPI_Fortran $<$:FLAP::FLAP> - TYPE ${MAPL_LIBRARY_TYPE} + TYPE ${MAPL_LIBRARY_TYPE} ) target_compile_definitions (${this} PRIVATE $<$:BUILD_WITH_EXTDATA2G>) diff --git a/MAPL_cfio/CMakeLists.txt b/MAPL_cfio/CMakeLists.txt index 342cdc9e0c75..e87b583bcd0b 100644 --- a/MAPL_cfio/CMakeLists.txt +++ b/MAPL_cfio/CMakeLists.txt @@ -4,12 +4,12 @@ string (REPLACE MAPL_cfio_ "" precision ${this}) set (srcs ESMF_CFIOBaseMod.f - ESMF_CFIOFileMod.F90 - ESMF_CFIOGridMod.F90 - ESMF_CFIOMod.F90 - ESMF_CFIOSdfMod.F90 - ESMF_CFIOUtilMod.F90 - ESMF_CFIOVarInfoMod.F90 + ESMF_CFIOFileMod.F90 + ESMF_CFIOGridMod.F90 + ESMF_CFIOMod.F90 + ESMF_CFIOSdfMod.F90 + ESMF_CFIOUtilMod.F90 + ESMF_CFIOVarInfoMod.F90 ShaveMantissa.c ) @@ -44,7 +44,7 @@ endif () esma_add_library (${lib} SRCS ${srcs} - DEPENDENCIES esmf NetCDF::NetCDF_Fortran + DEPENDENCIES ESMF NetCDF::NetCDF_Fortran TYPE ${LIBRARY_TYPE} ) diff --git a/Tests/CMakeLists.txt b/Tests/CMakeLists.txt index bba1dbb97aa7..eb37b886b41d 100644 --- a/Tests/CMakeLists.txt +++ b/Tests/CMakeLists.txt @@ -11,7 +11,7 @@ set (srcs if (BUILD_WITH_FLAP) ecbuild_add_executable (TARGET ExtDataDriver.x SOURCES ${srcs}) - target_link_libraries (ExtDataDriver.x PRIVATE MAPL FLAP::FLAP esmf) + target_link_libraries (ExtDataDriver.x PRIVATE MAPL FLAP::FLAP ESMF) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") target_link_libraries(ExtDataDriver.x PRIVATE OpenMP::OpenMP_Fortran) @@ -20,7 +20,7 @@ if (BUILD_WITH_FLAP) target_compile_definitions (ExtDataDriver.x PRIVATE $<$:BUILD_WITH_EXTDATA2G>) ecbuild_add_executable (TARGET pfio_MAPL_demo.x SOURCES pfio_MAPL_demo.F90) - target_link_libraries (pfio_MAPL_demo.x PRIVATE MAPL FLAP::FLAP esmf) + target_link_libraries (pfio_MAPL_demo.x PRIVATE MAPL FLAP::FLAP ESMF) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") target_link_libraries(pfio_MAPL_demo.x PRIVATE OpenMP::OpenMP_Fortran) diff --git a/base/CMakeLists.txt b/base/CMakeLists.txt index 113d798cb93f..b17ff89b4309 100644 --- a/base/CMakeLists.txt +++ b/base/CMakeLists.txt @@ -19,10 +19,10 @@ set (srcs ESMF_CFIOPtrVectorMod.F90 MAPL_RegridderVector.F90 ESMFL_Mod.F90 MAPL_SatVapor.F90 FileMetadataUtilities.F90 MAPL_GetLatLonCoord.F90 MAPL_SimpleAlarm.F90 - FileMetadataUtilitiesVector.F90 MAPL_GridManager.F90 MAPL_SimpleBundleMod.F90 + FileMetadataUtilitiesVector.F90 MAPL_GridManager.F90 MAPL_SimpleBundleMod.F90 MAPL_AbstractGridFactory.F90 MAPL_GridSpec.F90 MAPL_StringGridFactoryMap.F90 MAPL_GridType.F90 MAPL_StringGridMap.F90 MaplGrid.F90 - MAPL_AbstractRegridder.F90 + MAPL_AbstractRegridder.F90 MAPL_StringRouteHandleMap.F90 MAPL_IdentityRegridder.F90 MAPL_stubs.F90 MAPL_Integer64GridFactoryMap.F90 MAPL_sun_uc.F90 @@ -37,16 +37,16 @@ set (srcs MAPL_ConservativeRegridder.F90 MAPL_MaxMinMod.F90 MAPL_VerticalInterpMod.F90 MAPL_CubedSphereGridFactory.F90 MAPL_MemUtils.F90 MAPL_VerticalMethods.F90 MAPL_DefGridName.F90 Base.F90 MAPL_VotingRegridder.F90 - MAPL_EsmfRegridder.F90 MAPL_NewArthParser.F90 + MAPL_EsmfRegridder.F90 MAPL_NewArthParser.F90 MAPL_ESMFTimeVectorMod.F90 Regrid_Functions_Mod.F90 - MAPL_EtaHybridVerticalCoordinate.F90 - MAPL_NominalOrbitsMod.F90 + MAPL_EtaHybridVerticalCoordinate.F90 + MAPL_NominalOrbitsMod.F90 MAPL_LocStreamFactoryMod.F90 MAPL_LocstreamRegridder.F90 MAPL_ExternalGridFactory.F90 ServerManager.F90 ApplicationSupport.F90 - ESMF_CFIOPtrVectorMod.F90 + ESMF_CFIOPtrVectorMod.F90 CFIOCollection.F90 MAPL_CFIO.F90 - regex_module.F90 StringTemplate.F90 MAPL_SphericalGeometry.F90 + regex_module.F90 StringTemplate.F90 MAPL_SphericalGeometry.F90 regex_F.c c_mapl_locstream_F.c getrss.c memuse.c Base/Base_Base.F90 Base/Base_Base_implementation.F90 @@ -59,7 +59,7 @@ set (srcs esma_add_library( ${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.profiler MAPL.pfio MAPL_cfio_r4 PFLOGGER::pflogger GFTL_SHARED::gftl-shared - esmf NetCDF::NetCDF_Fortran MPI::MPI_Fortran + ESMF NetCDF::NetCDF_Fortran MPI::MPI_Fortran TYPE ${MAPL_LIBRARY_TYPE}) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 @@ -80,7 +80,7 @@ foreach(dir ${OSX_EXTRA_LIBRARY_PATH}) target_link_libraries(${this} PUBLIC "-Xlinker -rpath -Xlinker ${dir}") endforeach() -ecbuild_add_executable (TARGET cub2latlon.x SOURCES cub2latlon_regridder.F90 DEPENDS esmf MAPL.shared) +ecbuild_add_executable (TARGET cub2latlon.x SOURCES cub2latlon_regridder.F90 DEPENDS ESMF MAPL.shared) target_link_libraries (cub2latlon.x PRIVATE ${this} MAPL.pfio ${MPI_Fortran_LIBRARIES}) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") @@ -92,7 +92,7 @@ if (EXTENDED_SOURCE) esma_fortran_generator_list (${this} ${EXTENDED_SOURCE}) endif() -# Users guide +# Users guide if (LATEX_FOUND) add_subdirectory (TeX) endif () diff --git a/base/tests/CMakeLists.txt b/base/tests/CMakeLists.txt index 9e300e6d8357..3c05a5200ba8 100644 --- a/base/tests/CMakeLists.txt +++ b/base/tests/CMakeLists.txt @@ -28,7 +28,7 @@ set (SRCS # MAPL_Initialize.F90 # ) #target_link_libraries (base_extras MAPL.shared MAPL.pfunit -# esmf NetCDF::NetCDF_Fortran) +# ESMF NetCDF::NetCDF_Fortran) add_pfunit_ctest(MAPL.base.tests TEST_SOURCES ${TEST_SRCS} diff --git a/generic/CMakeLists.txt b/generic/CMakeLists.txt index 643fc9bcf985..9172d70ddaaa 100644 --- a/generic/CMakeLists.txt +++ b/generic/CMakeLists.txt @@ -61,7 +61,7 @@ esma_add_library(${this} ) target_include_directories (${this} PUBLIC $) -target_link_libraries (${this} PUBLIC esmf NetCDF::NetCDF_Fortran) +target_link_libraries (${this} PUBLIC ESMF NetCDF::NetCDF_Fortran) if (PFUNIT_FOUND) add_subdirectory(tests EXCLUDE_FROM_ALL) diff --git a/gridcomps/Cap/CMakeLists.txt b/gridcomps/Cap/CMakeLists.txt index 07a2fe92b3cb..3126ee2795ad 100644 --- a/gridcomps/Cap/CMakeLists.txt +++ b/gridcomps/Cap/CMakeLists.txt @@ -13,7 +13,7 @@ endif() esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.profiler MAPL.history MAPL.ExtData ${EXTDATA2G_TARGET} TYPE ${MAPL_LIBRARY_TYPE}) -target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran +target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran $<$:FLAP::FLAP>) target_compile_definitions (${this} PRIVATE $<$:BUILD_WITH_EXTDATA2G>) diff --git a/gridcomps/ExtData/CMakeLists.txt b/gridcomps/ExtData/CMakeLists.txt index dbc7e032cc6d..38922c95fd39 100644 --- a/gridcomps/ExtData/CMakeLists.txt +++ b/gridcomps/ExtData/CMakeLists.txt @@ -8,7 +8,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.generic MAPL.pfio MAPL.griddedio MAPL_cfio_r4 TYPE ${MAPL_LIBRARY_TYPE}) -target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran +target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 diff --git a/gridcomps/ExtData2G/CMakeLists.txt b/gridcomps/ExtData2G/CMakeLists.txt index ee599479ac02..2d13a2a2463d 100644 --- a/gridcomps/ExtData2G/CMakeLists.txt +++ b/gridcomps/ExtData2G/CMakeLists.txt @@ -26,7 +26,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.base MAPL.generic MAPL.griddedio TYPE SHARED) -target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared YAFYAML::yafyaml esmf NetCDF::NetCDF_Fortran +target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared YAFYAML::yafyaml ESMF NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran) target_include_directories (${this} PUBLIC $) diff --git a/gridcomps/History/CMakeLists.txt b/gridcomps/History/CMakeLists.txt index 0973f096f2dc..ab015df5ede2 100644 --- a/gridcomps/History/CMakeLists.txt +++ b/gridcomps/History/CMakeLists.txt @@ -8,7 +8,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.generic MAPL.profiler MAPL.griddedio TYPE ${MAPL_LIBRARY_TYPE}) -target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran +target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 diff --git a/gridcomps/Orbit/CMakeLists.txt b/gridcomps/Orbit/CMakeLists.txt index b33c4f37778b..41d34c979837 100644 --- a/gridcomps/Orbit/CMakeLists.txt +++ b/gridcomps/Orbit/CMakeLists.txt @@ -5,7 +5,7 @@ set (srcs ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.generic TYPE ${MAPL_LIBRARY_TYPE}) -target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran +target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 diff --git a/griddedio/CMakeLists.txt b/griddedio/CMakeLists.txt index 44fd7a6e8336..862d98bd3bd5 100644 --- a/griddedio/CMakeLists.txt +++ b/griddedio/CMakeLists.txt @@ -11,7 +11,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.pfio MAPL_cfio_r4 TYPE ${MAPL_LIBRARY_TYPE}) -target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran +target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 @@ -22,7 +22,7 @@ target_include_directories (${this} PUBLIC $ Date: Tue, 7 Jun 2022 13:14:48 -0400 Subject: [PATCH 144/300] fixes #1549 --- CHANGELOG.md | 1 + base/Base/Base_Base_implementation.F90 | 42 +++++++++----------------- 2 files changed, 16 insertions(+), 27 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d4d03719912c..c07c72f60d58 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed - Adding missing _RETURN and _VERIFY macros in GriddedIO.F90 +- Fixed bug in non cubed-sphere grid path in MAPL_GetHorzIJIndex ### Added diff --git a/base/Base/Base_Base_implementation.F90 b/base/Base/Base_Base_implementation.F90 index 6664fed2d6f7..d415ca1f00b7 100644 --- a/base/Base/Base_Base_implementation.F90 +++ b/base/Base/Base_Base_implementation.F90 @@ -3011,10 +3011,8 @@ module subroutine MAPL_GetHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, rc) integer :: IM_World, JM_World, dims(3) integer :: IM, JM, counts(3) - real(ESMF_KIND_R8), pointer :: lons(:,:) => null() - real(ESMF_KIND_R8), pointer :: lats(:,:) => null() - real(ESMF_KIND_R8), allocatable :: lons_1d(:) - real(ESMF_KIND_R8), allocatable :: lats_1d(:) + real(ESMF_KIND_R8), pointer :: lons(:,:) + real(ESMF_KIND_R8), pointer :: lats(:,:) real(ESMF_KIND_R8), allocatable :: elons(:) real(ESMF_KIND_R8), allocatable :: elats(:) integer :: i,iiloc,jjloc @@ -3082,26 +3080,26 @@ module subroutine MAPL_GetHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, rc) else if (localSearch) then call ESMF_GridGetCoord(grid,coordDim=1, localDe=0, & - staggerloc=ESMF_STAGGERLOC_CENTER, fArrayPtr = lons, rc=status) - _VERIFY(STATUS) + staggerloc=ESMF_STAGGERLOC_CORNER, fArrayPtr = lons, _RC) call ESMF_GridGetCoord(grid,coordDim=2, localDe=0, & - staggerloc=ESMF_STAGGERLOC_CENTER, fArrayPtr = lats, rc=status) - _VERIFY(STATUS) + staggerloc=ESMF_STAGGERLOC_CORNER, fArrayPtr = lats, _RC) else _FAIL('if not isCubed, localSearch must be .true.') end if - allocate(lons_1d(im),stat=status) - _VERIFY(STATUS) - allocate(lats_1d(jm),stat=status) - _VERIFY(STATUS) allocate(elons(im+1),stat=status) _VERIFY(STATUS) allocate(elats(jm+1),stat=status) _VERIFY(STATUS) - lons_1d = lons(:,1) - lats_1d = lats(1,:) - call calc_edges_1d(elons,lons_1d,IM) - call calc_edges_1d(elats,lats_1d,JM) + call ESMF_GridGet(grid,coordSys=coordSys,rc=status) + _VERIFY(STATUS) + elons = lons(:,1) + elats = lats(1,:) + if (coordSys==ESMF_COORDSYS_SPH_DEG) then + elons=elons*MAPL_DEGREES_TO_RADIANS_R8 + elats=elats*MAPL_DEGREES_TO_RADIANS_R8 + else if (coordSys==ESMF_COORDSYS_CART) then + _FAIL('Unsupported coordinate system: ESMF_COORDSYS_CART') + end if ! lat-lon grid goes from -180 to 180 shift if we must ! BMA this -180 to 180 might change at some point do i=1,npts @@ -3113,7 +3111,7 @@ module subroutine MAPL_GetHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, rc) II(i) = IIloc JJ(i) = JJloc end do - deallocate(lons_1d,lats_1d,elons,elats) + deallocate(elons,elats) end if _RETURN(ESMF_SUCCESS) @@ -3167,16 +3165,6 @@ integer function ijsearch(coords,idim,valueIn,periodic) ! fast bisection version endif end function ijsearch - subroutine calc_edges_1d(ecoords,coords,idim) - integer, intent(in) :: idim - real(ESMF_KIND_R8), intent(in) :: coords(idim) - real(ESMF_KIND_R8), intent(out) :: ecoords(idim+1) - ecoords(1) = coords(1) - 0.5 * ( coords(2) - coords(1) ) - ecoords(2:idim) = 0.5 * ( coords(1:idim-1)+coords(2:idim) ) - ecoords(idim+1) = coords(idim) + 0.5 * (coords(idim) - coords(idim-1)) - return - end subroutine calc_edges_1d - end subroutine MAPL_GetHorzIJIndex module subroutine MAPL_GenGridName(im, jm, lon, lat, xyoffset, gridname, geos_style) From be55456d9b9ebb866d348e8540dd3ea250c48a03 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 7 Jun 2022 13:29:36 -0400 Subject: [PATCH 145/300] Update CHANGELOG and CMakeLists for 2.21.3 Release --- CHANGELOG.md | 9 ++++++--- CMakeLists.txt | 2 +- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c07c72f60d58..e7afbfd94e9f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,9 +9,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed -- Adding missing _RETURN and _VERIFY macros in GriddedIO.F90 -- Fixed bug in non cubed-sphere grid path in MAPL_GetHorzIJIndex - ### Added ### Changed @@ -20,6 +17,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Deprecated +## [2.21.3] - 2022-06-07 + +### Fixed + +- Fixed bug in non cubed-sphere grid path in MAPL_GetHorzIJIndex + ## [2.21.2] - 2022-05-31 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index 7c36faf15fe0..91364980ae7c 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.21.2 + VERSION 2.21.3 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the default build type to release From 9808957c21319f4ff0936a2e5cee597814de61de Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 10 Jun 2022 14:18:09 -0400 Subject: [PATCH 146/300] add extdata testing framework --- CHANGELOG.md | 1 + .../test_cases/case1/AGCM1.rc | 24 +++ .../test_cases/case1/AGCM2.rc | 29 +++ .../test_cases/case1/CAP.rc | 4 + .../test_cases/case1/CAP1.rc | 25 +++ .../test_cases/case1/CAP2.rc | 15 ++ .../test_cases/case1/ExtData.rc | 13 ++ .../test_cases/case1/HISTORY1.rc | 13 ++ .../test_cases/case1/HISTORY2.rc | 5 + .../test_cases/case1/README | 1 + .../test_cases/case1/extdata.yaml | 5 + .../test_cases/case10/AGCM1.rc | 22 ++ .../test_cases/case10/AGCM2.rc | 27 +++ .../test_cases/case10/CAP.rc | 4 + .../test_cases/case10/CAP1.rc | 36 ++++ .../test_cases/case10/CAP2.rc | 14 ++ .../test_cases/case10/ExtData.rc | 12 ++ .../test_cases/case10/HISTORY1.rc | 11 + .../test_cases/case10/HISTORY2.rc | 5 + .../test_cases/case10/README | 2 + .../test_cases/case10/extdata.yaml | 6 + .../test_cases/case11/AGCM1.rc | 22 ++ .../test_cases/case11/AGCM2.rc | 27 +++ .../test_cases/case11/CAP.rc | 4 + .../test_cases/case11/CAP1.rc | 36 ++++ .../test_cases/case11/CAP2.rc | 14 ++ .../test_cases/case11/ExtData.rc | 12 ++ .../test_cases/case11/HISTORY1.rc | 11 + .../test_cases/case11/HISTORY2.rc | 5 + .../test_cases/case11/README | 1 + .../test_cases/case11/extdata.yaml | 4 + .../test_cases/case12/AGCM1.rc | 22 ++ .../test_cases/case12/AGCM2.rc | 27 +++ .../test_cases/case12/CAP.rc | 4 + .../test_cases/case12/CAP1.rc | 16 ++ .../test_cases/case12/CAP2.rc | 13 ++ .../test_cases/case12/ExtData.rc | 13 ++ .../test_cases/case12/HISTORY1.rc | 30 +++ .../test_cases/case12/HISTORY2.rc | 5 + .../test_cases/case12/README | 1 + .../test_cases/case12/extdata.yaml | 6 + .../test_cases/case12/nproc.rc | 1 + .../test_cases/case13/AGCM1.rc | 22 ++ .../test_cases/case13/AGCM2.rc | 25 +++ .../test_cases/case13/CAP.rc | 4 + .../test_cases/case13/CAP1.rc | 25 +++ .../test_cases/case13/CAP2.rc | 13 ++ .../test_cases/case13/ExtData.rc | 12 ++ .../test_cases/case13/HISTORY1.rc | 12 ++ .../test_cases/case13/HISTORY2.rc | 5 + .../test_cases/case13/README | 1 + .../test_cases/case13/extdata.yaml | 4 + .../test_cases/case14/AGCM1.rc | 22 ++ .../test_cases/case14/AGCM2.rc | 24 +++ .../test_cases/case14/CAP.rc | 4 + .../test_cases/case14/CAP1.rc | 10 + .../test_cases/case14/CAP2.rc | 14 ++ .../test_cases/case14/ExtData.rc | 12 ++ .../test_cases/case14/HISTORY1.rc | 12 ++ .../test_cases/case14/HISTORY2.rc | 5 + .../test_cases/case14/README | 1 + .../test_cases/case14/extdata.yaml | 6 + .../test_cases/case15/AGCM1.rc | 22 ++ .../test_cases/case15/AGCM2.rc | 27 +++ .../test_cases/case15/CAP.rc | 4 + .../test_cases/case15/CAP1.rc | 10 + .../test_cases/case15/CAP2.rc | 14 ++ .../test_cases/case15/ExtData.rc | 12 ++ .../test_cases/case15/HISTORY1.rc | 13 ++ .../test_cases/case15/HISTORY2.rc | 5 + .../test_cases/case15/README | 1 + .../test_cases/case15/extdata.yaml | 6 + .../test_cases/case16/AGCM1.rc | 22 ++ .../test_cases/case16/AGCM2.rc | 27 +++ .../test_cases/case16/CAP.rc | 4 + .../test_cases/case16/CAP1.rc | 10 + .../test_cases/case16/CAP2.rc | 14 ++ .../test_cases/case16/ExtData.rc | 12 ++ .../test_cases/case16/HISTORY1.rc | 13 ++ .../test_cases/case16/HISTORY2.rc | 5 + .../test_cases/case16/README | 1 + .../test_cases/case16/extdata.yaml | 6 + .../test_cases/case18/AGCM1.rc | 24 +++ .../test_cases/case18/AGCM2.rc | 33 +++ .../test_cases/case18/CAP.rc | 4 + .../test_cases/case18/CAP1.rc | 26 +++ .../test_cases/case18/CAP2.rc | 15 ++ .../test_cases/case18/ExtData.rc | 15 ++ .../test_cases/case18/HISTORY1.rc | 15 ++ .../test_cases/case18/HISTORY2.rc | 13 ++ .../test_cases/case18/README | 1 + .../test_cases/case18/extdata.yaml | 4 + .../test_cases/case18/nproc.rc | 1 + .../test_cases/case19/AGCM1.rc | 24 +++ .../test_cases/case19/CAP.rc | 3 + .../test_cases/case19/CAP1.rc | 25 +++ .../test_cases/case19/ExtData.rc | 12 ++ .../test_cases/case19/HISTORY1.rc | 5 + .../test_cases/case19/README | 1 + .../test_cases/case19/extdata.yaml | 2 + .../test_cases/case2/AGCM1.rc | 24 +++ .../test_cases/case2/AGCM2.rc | 30 +++ .../test_cases/case2/CAP.rc | 4 + .../test_cases/case2/CAP1.rc | 25 +++ .../test_cases/case2/CAP2.rc | 15 ++ .../test_cases/case2/ExtData.rc | 13 ++ .../test_cases/case2/HISTORY1.rc | 13 ++ .../test_cases/case2/HISTORY2.rc | 5 + .../test_cases/case2/README | 1 + .../test_cases/case2/extdata.yaml | 7 + .../test_cases/case20/AGCM1.rc | 22 ++ .../test_cases/case20/AGCM2.rc | 24 +++ .../test_cases/case20/CAP.rc | 4 + .../test_cases/case20/CAP1.rc | 10 + .../test_cases/case20/CAP2.rc | 14 ++ .../test_cases/case20/ExtData.rc | 12 ++ .../test_cases/case20/HISTORY1.rc | 12 ++ .../test_cases/case20/HISTORY2.rc | 5 + .../test_cases/case20/README | 1 + .../test_cases/case20/extdata.yaml | 8 + .../test_cases/case21/AGCM1.rc | 24 +++ .../test_cases/case21/AGCM2.rc | 33 +++ .../test_cases/case21/CAP.rc | 4 + .../test_cases/case21/CAP1.rc | 25 +++ .../test_cases/case21/CAP2.rc | 15 ++ .../test_cases/case21/ExtData.rc | 13 ++ .../test_cases/case21/HISTORY1.rc | 13 ++ .../test_cases/case21/HISTORY2.rc | 5 + .../test_cases/case21/README | 1 + .../test_cases/case21/extdata.yaml | 8 + .../test_cases/case22/AGCM1.rc | 22 ++ .../test_cases/case22/AGCM2.rc | 22 ++ .../test_cases/case22/AGCM3.rc | 26 +++ .../test_cases/case22/CAP.rc | 5 + .../test_cases/case22/CAP1.rc | 12 ++ .../test_cases/case22/CAP2.rc | 12 ++ .../test_cases/case22/CAP3.rc | 11 + .../test_cases/case22/ExtData.rc | 12 ++ .../test_cases/case22/HISTORY1.rc | 13 ++ .../test_cases/case22/HISTORY2.rc | 13 ++ .../test_cases/case22/HISTORY3.rc | 13 ++ .../test_cases/case22/README | 1 + .../test_cases/case22/case1.rcx | 7 + .../test_cases/case22/case2.rcx | 7 + .../test_cases/case22/egress | 0 .../test_cases/case22/extdata.yaml | 7 + .../test_cases/case22/warnings_and_errors.log | 60 ++++++ .../test_cases/case23/AGCM1.rc | 22 ++ .../test_cases/case23/AGCM2.rc | 22 ++ .../test_cases/case23/AGCM3.rc | 26 +++ .../test_cases/case23/CAP.rc | 5 + .../test_cases/case23/CAP1.rc | 11 + .../test_cases/case23/CAP2.rc | 11 + .../test_cases/case23/CAP3.rc | 11 + .../test_cases/case23/ExtData.rc | 12 ++ .../test_cases/case23/HISTORY1.rc | 12 ++ .../test_cases/case23/HISTORY2.rc | 12 ++ .../test_cases/case23/HISTORY3.rc | 12 ++ .../test_cases/case23/README | 1 + .../test_cases/case23/extdata.yaml | 11 + .../test_cases/case24/AGCM1.rc | 22 ++ .../test_cases/case24/AGCM2.rc | 27 +++ .../test_cases/case24/CAP.rc | 4 + .../test_cases/case24/CAP1.rc | 25 +++ .../test_cases/case24/CAP2.rc | 15 ++ .../test_cases/case24/ExtData.rc | 13 ++ .../test_cases/case24/HISTORY1.rc | 19 ++ .../test_cases/case24/HISTORY2.rc | 5 + .../test_cases/case24/README | 1 + .../test_cases/case24/extdata.yaml | 6 + .../test_cases/case24/nproc.rc | 1 + .../test_cases/case25/AGCM1.rc | 22 ++ .../test_cases/case25/AGCM2.rc | 26 +++ .../test_cases/case25/CAP.rc | 4 + .../test_cases/case25/CAP1.rc | 25 +++ .../test_cases/case25/CAP2.rc | 15 ++ .../test_cases/case25/ExtData.rc | 13 ++ .../test_cases/case25/HISTORY1.rc | 23 +++ .../test_cases/case25/HISTORY2.rc | 5 + .../test_cases/case25/README | 1 + .../test_cases/case25/extdata.yaml | 5 + .../test_cases/case26/AGCM1.rc | 24 +++ .../test_cases/case26/AGCM2.rc | 29 +++ .../test_cases/case26/CAP.rc | 4 + .../test_cases/case26/CAP1.rc | 25 +++ .../test_cases/case26/CAP2.rc | 15 ++ .../test_cases/case26/ExtData.rc | 13 ++ .../test_cases/case26/HISTORY1.rc | 31 +++ .../test_cases/case26/HISTORY2.rc | 5 + .../test_cases/case26/README | 1 + .../test_cases/case26/extdata.yaml | 6 + .../test_cases/case3/AGCM1.rc | 22 ++ .../test_cases/case3/AGCM2.rc | 27 +++ .../test_cases/case3/CAP.rc | 4 + .../test_cases/case3/CAP1.rc | 24 +++ .../test_cases/case3/CAP2.rc | 15 ++ .../test_cases/case3/ExtData.rc | 12 ++ .../test_cases/case3/HISTORY1.rc | 11 + .../test_cases/case3/HISTORY2.rc | 5 + .../test_cases/case3/README | 1 + .../test_cases/case3/extdata.yaml | 6 + .../test_cases/case4/AGCM1.rc | 22 ++ .../test_cases/case4/AGCM2.rc | 26 +++ .../test_cases/case4/CAP.rc | 4 + .../test_cases/case4/CAP1.rc | 16 ++ .../test_cases/case4/CAP2.rc | 13 ++ .../test_cases/case4/ExtData.rc | 12 ++ .../test_cases/case4/HISTORY1.rc | 11 + .../test_cases/case4/HISTORY2.rc | 5 + .../test_cases/case4/README | 1 + .../test_cases/case4/extdata.yaml | 6 + .../test_cases/case5/AGCM1.rc | 22 ++ .../test_cases/case5/AGCM2.rc | 26 +++ .../test_cases/case5/CAP.rc | 4 + .../test_cases/case5/CAP1.rc | 16 ++ .../test_cases/case5/CAP2.rc | 13 ++ .../test_cases/case5/ExtData.rc | 12 ++ .../test_cases/case5/HISTORY1.rc | 11 + .../test_cases/case5/HISTORY2.rc | 5 + .../test_cases/case5/README | 1 + .../test_cases/case5/extdata.yaml | 4 + .../test_cases/case6/AGCM1.rc | 22 ++ .../test_cases/case6/AGCM2.rc | 24 +++ .../test_cases/case6/CAP.rc | 4 + .../test_cases/case6/CAP1.rc | 10 + .../test_cases/case6/CAP2.rc | 14 ++ .../test_cases/case6/ExtData.rc | 12 ++ .../test_cases/case6/HISTORY1.rc | 12 ++ .../test_cases/case6/HISTORY2.rc | 5 + .../test_cases/case6/README | 1 + .../test_cases/case6/extdata.yaml | 6 + .../test_cases/case7/AGCM1.rc | 22 ++ .../test_cases/case7/AGCM2.rc | 25 +++ .../test_cases/case7/CAP.rc | 4 + .../test_cases/case7/CAP1.rc | 25 +++ .../test_cases/case7/CAP2.rc | 14 ++ .../test_cases/case7/ExtData.rc | 11 + .../test_cases/case7/HISTORY1.rc | 12 ++ .../test_cases/case7/HISTORY2.rc | 5 + .../test_cases/case7/README | 1 + .../test_cases/case7/extdata.yaml | 6 + .../test_cases/case8/AGCM1.rc | 22 ++ .../test_cases/case8/AGCM2.rc | 26 +++ .../test_cases/case8/CAP.rc | 4 + .../test_cases/case8/CAP1.rc | 9 + .../test_cases/case8/CAP2.rc | 14 ++ .../test_cases/case8/ExtData.rc | 12 ++ .../test_cases/case8/HISTORY1.rc | 12 ++ .../test_cases/case8/HISTORY2.rc | 5 + .../test_cases/case8/README | 1 + .../test_cases/case8/extdata.yaml | 4 + .../test_cases/case9/AGCM1.rc | 22 ++ .../test_cases/case9/AGCM2.rc | 25 +++ .../test_cases/case9/CAP.rc | 4 + .../test_cases/case9/CAP1.rc | 14 ++ .../test_cases/case9/CAP2.rc | 17 ++ .../test_cases/case9/ExtData.rc | 12 ++ .../test_cases/case9/HISTORY1.rc | 12 ++ .../test_cases/case9/HISTORY2.rc | 5 + .../test_cases/case9/README | 1 + .../test_cases/case9/extdata.yaml | 6 + .../test_cases/cases.txt | 25 +++ .../test_cases/test_case_descriptions.md | 33 +++ .../test_cases/use_extdata2g.rc | 1 + .../test_script/.gitignore | 1 + .../test_script/run_case.py | 64 ++++++ .../test_script/run_extdatadriver_cases.py | 56 +++++ .../test_script/utils.py | 191 ++++++++++++++++++ 268 files changed, 3653 insertions(+) create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case1/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case1/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case1/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case1/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case1/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case1/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case1/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case10/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case10/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case10/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case10/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case10/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case10/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case10/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case11/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case11/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case11/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case11/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case11/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case11/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case11/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case12/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case12/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case12/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case12/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case12/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case12/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case12/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case12/nproc.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case13/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case13/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case13/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case13/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case13/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case13/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case13/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case14/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case14/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case14/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case14/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case14/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case14/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case14/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case15/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case15/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case15/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case15/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case15/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case15/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case15/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case16/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case16/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case16/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case16/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case16/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case16/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case16/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case18/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case18/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case18/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case18/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case18/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case18/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case18/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case18/nproc.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case19/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case19/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case19/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case19/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case19/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case19/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case19/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case2/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case2/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case2/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case2/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case2/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case2/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case2/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case20/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case20/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case20/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case20/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case20/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case20/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case20/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case21/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case21/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case21/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case21/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case21/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case21/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case21/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM3.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP3.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case22/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY3.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case22/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case22/case1.rcx create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case22/case2.rcx create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case22/egress create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case22/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case22/warnings_and_errors.log create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM3.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP3.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case23/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY3.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case23/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case23/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case24/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case24/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case24/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case24/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case24/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case24/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case24/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case24/nproc.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case25/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case25/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case25/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case25/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case25/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case25/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case25/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case26/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case26/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case26/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case26/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case26/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case26/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case26/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case3/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case3/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case3/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case3/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case3/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case3/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case3/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case4/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case4/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case4/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case4/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case4/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case4/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case4/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case5/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case5/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case5/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case5/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case5/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case5/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case5/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case6/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case6/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case6/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case6/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case6/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case6/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case6/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case7/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case7/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case7/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case7/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case7/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case7/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case7/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case8/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case8/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case8/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case8/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case8/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case8/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case8/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case9/AGCM1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case9/AGCM2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case9/ExtData.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case9/HISTORY1.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case9/HISTORY2.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case9/README create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case9/extdata.yaml create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/cases.txt create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/test_case_descriptions.md create mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/use_extdata2g.rc create mode 100644 Tests/ExtData_Testing_Framekwork/test_script/.gitignore create mode 100755 Tests/ExtData_Testing_Framekwork/test_script/run_case.py create mode 100755 Tests/ExtData_Testing_Framekwork/test_script/run_extdatadriver_cases.py create mode 100644 Tests/ExtData_Testing_Framekwork/test_script/utils.py diff --git a/CHANGELOG.md b/CHANGELOG.md index bde3067f9929..518405762a9e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -19,6 +19,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Enable GCM run test in CircleCI (1-hour, no ExtData) - Added monotonic regridding option - Make availalbe to History and ExtData2G all supported regridding methods +- Add test cases for ExtData ### Changed diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case1/AGCM1.rc new file mode 100644 index 000000000000..83ad27a2c551 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case1/AGCM1.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case1/AGCM2.rc new file mode 100644 index 000000000000..2e79954523bd --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case1/AGCM2.rc @@ -0,0 +1,29 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP1.rc new file mode 100644 index 000000000000..ce2690d6937b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP2.rc new file mode 100644 index 000000000000..4e9e1bb95026 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20041125 210000 +20041126 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case1/ExtData.rc new file mode 100644 index 000000000000..a45d1dd13f7f --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case1/ExtData.rc @@ -0,0 +1,13 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4.nc4 +VAR3D NA N N 0 none none VAR3D case1.%y4.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case1/HISTORY1.rc new file mode 100644 index 000000000000..51d004d9660c --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case1/HISTORY1.rc @@ -0,0 +1,13 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000 + case1.fields: 'VAR2D', 'Root', + 'VAR3D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case1/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case1/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/README b/Tests/ExtData_Testing_Framekwork/test_cases/case1/README new file mode 100644 index 000000000000..9a6d7597262d --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case1/README @@ -0,0 +1 @@ +Case, 12-month/12 time 2004 file with 2 updates, non-climatology diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case1/extdata.yaml new file mode 100644 index 000000000000..e2ddb90675ab --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case1/extdata.yaml @@ -0,0 +1,5 @@ +Collections: + fstream1: {template: case1.%y4.nc4, valid_range: "2004-01-01/2005-01-01" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1} + VAR3D: {variable: VAR3D, collection: fstream1} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case10/AGCM1.rc new file mode 100644 index 000000000000..302766bebfab --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case10/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case10/AGCM2.rc new file mode 100644 index 000000000000..58616c46abc8 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case10/AGCM2.rc @@ -0,0 +1,27 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC900x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +CLIM_YEAR: 2005 +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP1.rc new file mode 100644 index 000000000000..7ad5b6f1a378 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP1.rc @@ -0,0 +1,36 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00002400 000000 +HEARTBEAT_DT: 3600 + +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +20050115 210000 +20050215 210000 +20050315 210000 +20050415 210000 +20050515 210000 +20050615 210000 +20050715 210000 +20050815 210000 +20050915 210000 +20051015 210000 +20051115 210000 +20051215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP2.rc new file mode 100644 index 000000000000..af18ab35fe0d --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP2.rc @@ -0,0 +1,14 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20060101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20060225 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case10/ExtData.rc new file mode 100644 index 000000000000..92697fa916f0 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case10/ExtData.rc @@ -0,0 +1,12 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .true. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4%m2.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case10/HISTORY1.rc new file mode 100644 index 000000000000..0b54db8e8f25 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case10/HISTORY1.rc @@ -0,0 +1,11 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4%m2.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case10/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case10/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/README b/Tests/ExtData_Testing_Framekwork/test_cases/case10/README new file mode 100644 index 000000000000..d2069c0d94d4 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case10/README @@ -0,0 +1,2 @@ +Interpolation outside of data set (Harvard mode), make a multi year dataset. +Define as not a climatology and ask for data after dataset time range diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case10/extdata.yaml new file mode 100644 index 000000000000..4e9e3ccb39fb --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case10/extdata.yaml @@ -0,0 +1,6 @@ +Samplings: + extrap_clim: {extrapolation: clim} +Collections: + fstream1: {template: "case1.%y4%m2.nc4", valid_range: "2004-01-01/2005-12-31" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1, sample: extrap_clim} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case11/AGCM1.rc new file mode 100644 index 000000000000..302766bebfab --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case11/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case11/AGCM2.rc new file mode 100644 index 000000000000..48eb8ed1b8d3 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case11/AGCM2.rc @@ -0,0 +1,27 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC900x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +CLIM_YEAR: 2006 +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP1.rc new file mode 100644 index 000000000000..e800400d918a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP1.rc @@ -0,0 +1,36 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20060101 210000 + +JOB_SGMT: 00002400 000000 +HEARTBEAT_DT: 3600 + +RUN_TIMES:: +20060115 210000 +20060215 210000 +20060315 210000 +20060415 210000 +20060515 210000 +20060615 210000 +20060715 210000 +20060815 210000 +20060915 210000 +20061015 210000 +20061115 210000 +20061215 210000 +20070115 210000 +20070215 210000 +20070315 210000 +20070415 210000 +20070515 210000 +20070615 210000 +20070715 210000 +20070815 210000 +20070915 210000 +20071015 210000 +20071115 210000 +20071215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP2.rc new file mode 100644 index 000000000000..68f902819dd8 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP2.rc @@ -0,0 +1,14 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20050101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20050225 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case11/ExtData.rc new file mode 100644 index 000000000000..92697fa916f0 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case11/ExtData.rc @@ -0,0 +1,12 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .true. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4%m2.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case11/HISTORY1.rc new file mode 100644 index 000000000000..0b54db8e8f25 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case11/HISTORY1.rc @@ -0,0 +1,11 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4%m2.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case11/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case11/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/README b/Tests/ExtData_Testing_Framekwork/test_cases/case11/README new file mode 100644 index 000000000000..52a3f7e59bfa --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case11/README @@ -0,0 +1 @@ +Interpolation outside of data set (Harvard mode), make a multi year dataset. Define as not a climatology and ask for data before datset time range diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case11/extdata.yaml new file mode 100644 index 000000000000..f5641f693d84 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case11/extdata.yaml @@ -0,0 +1,4 @@ +Collections: + fstream1: {template: "case1.%y4%m2.nc4", valid_range: "2006-01-01/2007-12-31" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1, sample: {extrapolation: clim}} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case12/AGCM1.rc new file mode 100644 index 000000000000..5d1b0f452725 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case12/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 6 +NY: 36 + +Root.GRID_TYPE: Cubed-Sphere +Root.GRIDNAME: PE24x144-CF +Root.LM: 3 +Root.NF 6 +Root.IM_WORLD: 24 + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case12/AGCM2.rc new file mode 100644 index 000000000000..fe9b76e9ab6b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case12/AGCM2.rc @@ -0,0 +1,27 @@ +NX: 6 +NY: 36 + +Root.GRID_TYPE: Cubed-Sphere +Root.GRIDNAME: PE24x144-CF +Root.LM: 3 +Root.NF 6 +Root.IM_WORLD: 24 + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP1.rc new file mode 100644 index 000000000000..bed0725f4039 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP1.rc @@ -0,0 +1,16 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +RUN_TIMES:: +20040702 000000 +20040703 000000 +20040704 000000 +20040705 000000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP2.rc new file mode 100644 index 000000000000..f4182daac2ca --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP2.rc @@ -0,0 +1,13 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +RUN_TIMES:: +20040703 120000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case12/ExtData.rc new file mode 100644 index 000000000000..19bc2d0132f6 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case12/ExtData.rc @@ -0,0 +1,13 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N - none none VAR2D vars2d.nc4 +VAR3D NA N N - none none VAR3D vars3d.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case12/HISTORY1.rc new file mode 100644 index 000000000000..bdc7875e13f3 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case12/HISTORY1.rc @@ -0,0 +1,30 @@ +VERSION: 1 +GRID_LABELS: PC20x11-DC +:: + +PC20x11-DC.GRID_TYPE: LatLon +PC20x11-DC.IM_WORLD: 20 +PC20x11-DC.JM_WORLD: 11 +PC20x11-DC.POLE: PC +PC20x11-DC.DATELINE: DC +PC20x11-DC.LM: 3 + +COLLECTIONS: vars2d + vars3d +:: + + + vars2d.template: 'nc4', + vars2d.format: 'CFIO', + vars2d.frequency: 010000, + vars2d.duration: 000000 + vars2d.grid_label: PC20x11-DC + vars2d.fields: 'VAR2D', 'Root', + :: + vars3d.template: 'nc4', + vars3d.format: 'CFIO', + vars3d.frequency: 010000, + vars3d.duration: 000000 + vars3d.grid_label: PC20x11-DC + vars3d.fields: 'VAR3D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case12/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case12/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/README b/Tests/ExtData_Testing_Framekwork/test_cases/case12/README new file mode 100644 index 000000000000..faaab2c64256 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case12/README @@ -0,0 +1 @@ +Test of case where you want to make a really coarse file in History that can not be decomposed on the default layout in the rc file. Be able to output such a file, then read back in on same grid in ExtData diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case12/extdata.yaml new file mode 100644 index 000000000000..e7eeef4a6e16 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case12/extdata.yaml @@ -0,0 +1,6 @@ +Collections: + fstream1: {template: "vars2d.nc4"} + fstream2: {template: "vars3d.nc4"} +Exports: + VAR2D: {variable: VAR2D, collection: fstream1, sample: {update_frequency: "-"}} + VAR3D: {variable: VAR3D, collection: fstream2, sample: {update_frequency: "-"}} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/nproc.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case12/nproc.rc new file mode 100644 index 000000000000..a817176f4a68 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case12/nproc.rc @@ -0,0 +1 @@ +216 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case13/AGCM1.rc new file mode 100644 index 000000000000..1199f8335bc6 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case13/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC900x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20070101 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case13/AGCM2.rc new file mode 100644 index 000000000000..814c1dfd5e43 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case13/AGCM2.rc @@ -0,0 +1,25 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D 45.0+(73.0-45.0)*0.5 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP1.rc new file mode 100644 index 000000000000..b40edc56fda7 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20070101 000000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20070115 000000 +20070215 000000 +20070315 000000 +20070415 000000 +20070515 000000 +20070615 000000 +20070715 000000 +20070815 000000 +20070915 000000 +20071015 000000 +20071115 000000 +20071215 000000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP2.rc new file mode 100644 index 000000000000..ad9fdbaa59ef --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP2.rc @@ -0,0 +1,13 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20080101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +RUN_TIMES:: +20080229 120000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case13/ExtData.rc new file mode 100644 index 000000000000..e535516c3bdf --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case13/ExtData.rc @@ -0,0 +1,12 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA Y N 0 none none VAR2D case1.2007%m2.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case13/HISTORY1.rc new file mode 100644 index 000000000000..1e9dd9d44599 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case13/HISTORY1.rc @@ -0,0 +1,12 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4%m2.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + #case1.duration: 000000 + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case13/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case13/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/README b/Tests/ExtData_Testing_Framekwork/test_cases/case13/README new file mode 100644 index 000000000000..8a66da41fbc9 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case13/README @@ -0,0 +1 @@ +Testing that we can take a climatology for a non-leap year and interpolate to a leap year. 12 files each with the midmonth value for 2007 (non-leap year). Interpolate to 02/29/2008 (leap year) diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case13/extdata.yaml new file mode 100644 index 000000000000..1dc456d831f9 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case13/extdata.yaml @@ -0,0 +1,4 @@ +Collections: + fstream1: {template: "case1.2007%m2.nc4", valid_range: "2007-01-01/2007-12-31" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1, sample: {extrapolation: clim, source_time: "2007-01-01/2007-12-31"}} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case14/AGCM1.rc new file mode 100644 index 000000000000..58c95c0fd941 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case14/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20070101 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case14/AGCM2.rc new file mode 100644 index 000000000000..0858aa614d31 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case14/AGCM2.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC900x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D 58.0+(59.0-58.0)*0.75 +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP1.rc new file mode 100644 index 000000000000..e725586cac99 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP1.rc @@ -0,0 +1,10 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20061231 000000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP2.rc new file mode 100644 index 000000000000..36aafef783fe --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP2.rc @@ -0,0 +1,14 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20080229 120000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case14/ExtData.rc new file mode 100644 index 000000000000..00b82c0f4f77 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case14/ExtData.rc @@ -0,0 +1,12 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA 2007 N 0 none none VAR2D case1.%y4%m2%d2.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case14/HISTORY1.rc new file mode 100644 index 000000000000..7f1045a27232 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case14/HISTORY1.rc @@ -0,0 +1,12 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4%m2%d2.nc4', + case1.format: 'CFIO', + case1.frequency: 240000, + case1.ref_time: 000000, + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case14/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case14/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/README b/Tests/ExtData_Testing_Framekwork/test_cases/case14/README new file mode 100644 index 000000000000..712f8869bac4 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case14/README @@ -0,0 +1 @@ +Testing that we can take a climatology for a non-leap year and interpolate to a leap year. Daily files each with 1 value for 2007 (non-leap year). Interpolate to 02/29/2008 (leap year) diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case14/extdata.yaml new file mode 100644 index 000000000000..11c4ed30a938 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case14/extdata.yaml @@ -0,0 +1,6 @@ +Samplings: + sample_clim: {extrapolation: clim} +Collections: + fstream1: {template: "case1.%y4%m2%d2.nc4", valid_range: "2007-01-01/2007-12-31" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1, source_time: "2007-01-01/2007-12-31", sample: sample_clim} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case15/AGCM1.rc new file mode 100644 index 000000000000..58c95c0fd941 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case15/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20070101 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case15/AGCM2.rc new file mode 100644 index 000000000000..58fc61c57d55 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case15/AGCM2.rc @@ -0,0 +1,27 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC900x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +CLIM_YEAR: 2007 +REF_TIME: 20070101 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP1.rc new file mode 100644 index 000000000000..957ef31d3145 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP1.rc @@ -0,0 +1,10 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20061231 230000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP2.rc new file mode 100644 index 000000000000..7e31eadc76a6 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP2.rc @@ -0,0 +1,14 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20060329 120000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case15/ExtData.rc new file mode 100644 index 000000000000..7032d5b44348 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case15/ExtData.rc @@ -0,0 +1,12 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA 2007 N 0 none none VAR2D case1.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case15/HISTORY1.rc new file mode 100644 index 000000000000..0f000be68631 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case15/HISTORY1.rc @@ -0,0 +1,13 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: 'nc4', + case1.format: 'CFIO', + case1.frequency: 60000, + case1.duration: 000000, + case1.ref_time: 000000, + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case15/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case15/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/README b/Tests/ExtData_Testing_Framekwork/test_cases/case15/README new file mode 100644 index 000000000000..c8303c9f308c --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case15/README @@ -0,0 +1 @@ +Testing that we can take a climatology for a non-leap year and interpolate to a non-leap year. Daily files each with 1 value for 2007 (non-leap year). Interpolate to 03/29/2006 (leap year) diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case15/extdata.yaml new file mode 100644 index 000000000000..a64fe328c5bd --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case15/extdata.yaml @@ -0,0 +1,6 @@ +Samplings: + sample_clim: {extrapolation: clim, source_time: "2007-01-01/2007-12-31"} +Collections: + fstream1: {template: "case1.nc4", valid_range: "2007-01-01/2007-12-31" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1, sample: sample_clim} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case16/AGCM1.rc new file mode 100644 index 000000000000..81bb07dcdcbd --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case16/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20080101 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case16/AGCM2.rc new file mode 100644 index 000000000000..040b724d894e --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case16/AGCM2.rc @@ -0,0 +1,27 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC900x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +CLIM_YEAR: 2008 +REF_TIME: 20080101 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP1.rc new file mode 100644 index 000000000000..2840fe1b50ce --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP1.rc @@ -0,0 +1,10 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20071231 230000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP2.rc new file mode 100644 index 000000000000..8ed72d5aabe6 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP2.rc @@ -0,0 +1,14 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20060329 150000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case16/ExtData.rc new file mode 100644 index 000000000000..1b98d7c432b9 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case16/ExtData.rc @@ -0,0 +1,12 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA 2008 N 0 none none VAR2D case1.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case16/HISTORY1.rc new file mode 100644 index 000000000000..0f000be68631 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case16/HISTORY1.rc @@ -0,0 +1,13 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: 'nc4', + case1.format: 'CFIO', + case1.frequency: 60000, + case1.duration: 000000, + case1.ref_time: 000000, + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case16/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case16/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/README b/Tests/ExtData_Testing_Framekwork/test_cases/case16/README new file mode 100644 index 000000000000..2b112ffe7b9c --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case16/README @@ -0,0 +1 @@ +Testing that we can take a climatology for a leap year and interpolate to a non-leap year. Daily files each with 1 value for 2008 (leap year). Interpolate to 03/29/2006 15z (leap year) diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case16/extdata.yaml new file mode 100644 index 000000000000..89a527a980e2 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case16/extdata.yaml @@ -0,0 +1,6 @@ +Collections: + fstream1: {template: "case1.nc4", valid_range: "2008-01-01/2008-12-31" } +Samplings: + s1: {source_time: "2008-01-01/2008-12-31", extrapolation: clim} +Exports: + VAR2D: {variable: VAR2D, collection: fstream1, sample: s1} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case18/AGCM1.rc new file mode 100644 index 000000000000..7787931e9777 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case18/AGCM1.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +U2D , time , days , xy , c +V2D , time , days , xy , c +:: + +FILL_DEF:: +U2D 0.0 +V2D 5.0 +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case18/AGCM2.rc new file mode 100644 index 000000000000..13bea40d79d3 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case18/AGCM2.rc @@ -0,0 +1,33 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: FillExportsFromImports + +IMPORT_STATE:: +U2D , time , days , xy , c +#U3D , time , days , xyz , c +V2D , time , days , xy , c +#V3D , time , days , xyz , c +:: + +EXPORT_STATE:: +U2D , time , days , xy , c +#U3D , time , days , xyz , c +V2D , time , days , xy , c +#V3D , time , days , xyz , c +:: + +#FILL_DEF:: +#VAR2D time +#VAR3D time +#:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP1.rc new file mode 100644 index 000000000000..11e0e36bd675 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP1.rc @@ -0,0 +1,26 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + +USE_EXTDATA2G: .true. diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP2.rc new file mode 100644 index 000000000000..4a0f45af02e4 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20041126 210000 +:: + +USE_EXTDATA2G: .true. diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case18/ExtData.rc new file mode 100644 index 000000000000..79cf7c1399ab --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case18/ExtData.rc @@ -0,0 +1,15 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +DEBUG_LEVEL: 20 + +PrimaryExports%% +U2D;V2D NA N N 0 none none U2D;V2D case1.%y4.nc4 +#U3D;V3D NA N N 0 none none U3D;V3D case1.%y4.nc4 +#U2D NA N N 0 none none U2D case1.%y4.nc4 +#V2D NA N N 0 none none V2D case1.%y4.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case18/HISTORY1.rc new file mode 100644 index 000000000000..e19d49760185 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case18/HISTORY1.rc @@ -0,0 +1,15 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000 + case1.fields: 'U2D', 'Root', + #'U3D', 'Root', + 'V2D', 'Root', + #'V3D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case18/HISTORY2.rc new file mode 100644 index 000000000000..6091a4c984bd --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case18/HISTORY2.rc @@ -0,0 +1,13 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: + + case18_2.template: '%y4.nc4', + case18_2.format: 'CFIO', + case18_2.frequency: 010000, + case18_2.duration: 000000 + case18_2.fields: 'U2D', 'Root', + 'V2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/README b/Tests/ExtData_Testing_Framekwork/test_cases/case18/README new file mode 100644 index 000000000000..60994edbc151 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case18/README @@ -0,0 +1 @@ +Test vector regridding diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case18/extdata.yaml new file mode 100644 index 000000000000..c69f0f79bf8a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case18/extdata.yaml @@ -0,0 +1,4 @@ +Collections: + fstream1: {template: "case1.%y4.nc4"} +Exports: + U2D;V2D: {variable: U2D;V2D, collection: fstream1} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/nproc.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case18/nproc.rc new file mode 100644 index 000000000000..d00491fd7e5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case18/nproc.rc @@ -0,0 +1 @@ +1 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case19/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case19/AGCM1.rc new file mode 100644 index 000000000000..4ebd5b1a73fa --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case19/AGCM1.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC900x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D 17.0 +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case19/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case19/CAP.rc new file mode 100644 index 000000000000..4f5328064bab --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case19/CAP.rc @@ -0,0 +1,3 @@ +CASES:: +CAP1.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case19/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case19/CAP1.rc new file mode 100644 index 000000000000..ce2690d6937b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case19/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case19/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case19/ExtData.rc new file mode 100644 index 000000000000..45b2e1653d38 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case19/ExtData.rc @@ -0,0 +1,12 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D /dev/null:17.0 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case19/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case19/HISTORY1.rc new file mode 100644 index 000000000000..d3a6677416e1 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case19/HISTORY1.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case19/README b/Tests/ExtData_Testing_Framekwork/test_cases/case19/README new file mode 100644 index 000000000000..23052d595d01 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case19/README @@ -0,0 +1 @@ +test /dev/null diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case19/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case19/extdata.yaml new file mode 100644 index 000000000000..47bc213019b6 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case19/extdata.yaml @@ -0,0 +1,2 @@ +Exports: + VAR2D: {variable: VAR2D, collection: "/dev/null", linear_transformation: [17.0,0.0]} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case2/AGCM1.rc new file mode 100644 index 000000000000..ada4fab64746 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case2/AGCM1.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC900x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case2/AGCM2.rc new file mode 100644 index 000000000000..6fb58c19aba5 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case2/AGCM2.rc @@ -0,0 +1,30 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +CLIM_YEAR: 2004 +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP1.rc new file mode 100644 index 000000000000..ce2690d6937b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP2.rc new file mode 100644 index 000000000000..4dc521f63044 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20071125 210000 +20071126 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case2/ExtData.rc new file mode 100644 index 000000000000..9a1d56d1f370 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case2/ExtData.rc @@ -0,0 +1,13 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA Y N 0 none none VAR2D case1.2004.nc4 +VAR3D NA Y N 0 none none VAR3D case1.2004.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case2/HISTORY1.rc new file mode 100644 index 000000000000..51d004d9660c --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case2/HISTORY1.rc @@ -0,0 +1,13 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000 + case1.fields: 'VAR2D', 'Root', + 'VAR3D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case2/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case2/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/README b/Tests/ExtData_Testing_Framekwork/test_cases/case2/README new file mode 100644 index 000000000000..a022d98f1113 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case2/README @@ -0,0 +1 @@ +Case, 12-month/12 time 2004 file with 2 updates, climatology diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case2/extdata.yaml new file mode 100644 index 000000000000..739a9e22c98c --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case2/extdata.yaml @@ -0,0 +1,7 @@ +Samplings: + sample_clim: {extrapolation: clim} +Collections: + fstream1: {template: "case1.2004.nc4"} +Exports: + VAR2D: {variable: VAR2D, collection: fstream1, sample: sample_clim} + VAR3D: {variable: VAR3D, collection: fstream1, sample: sample_clim} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case20/AGCM1.rc new file mode 100644 index 000000000000..3583e9d12516 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case20/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20160101 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case20/AGCM2.rc new file mode 100644 index 000000000000..fb783b442edd --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case20/AGCM2.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC900x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D 59.0+(58.0-57.0)*0.5 +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP1.rc new file mode 100644 index 000000000000..397c91b0abe3 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP1.rc @@ -0,0 +1,10 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20151231 000000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP2.rc new file mode 100644 index 000000000000..0f06f66198de --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP2.rc @@ -0,0 +1,14 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20200101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20200229 120000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case20/ExtData.rc new file mode 100644 index 000000000000..67ef7b54a4a8 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case20/ExtData.rc @@ -0,0 +1,12 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .true. +Prefetch: .true. +DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4%m2%d2.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case20/HISTORY1.rc new file mode 100644 index 000000000000..7f1045a27232 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case20/HISTORY1.rc @@ -0,0 +1,12 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4%m2%d2.nc4', + case1.format: 'CFIO', + case1.frequency: 240000, + case1.ref_time: 000000, + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case20/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case20/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/README b/Tests/ExtData_Testing_Framekwork/test_cases/case20/README new file mode 100644 index 000000000000..5e7fa8803054 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case20/README @@ -0,0 +1 @@ +Make daily files for 2016. Then start on February 29th in 2020 and allow extrapolation outside of dataset a climatology diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case20/extdata.yaml new file mode 100644 index 000000000000..01db6d85f976 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case20/extdata.yaml @@ -0,0 +1,8 @@ +Collections: + fstream1: {template: "case1.%y4%m2%d2.nc4", valid_range: "2016-01-01/2016-12-31" } +Samplings: + S1: + extrapolation: clim + source_time: "2016-01-01/2016-12-31" +Exports: + VAR2D: {variable: VAR2D, collection: fstream1, sample: S1} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case21/AGCM1.rc new file mode 100644 index 000000000000..1f672143e749 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case21/AGCM1.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR1 , time , days , xy , c +VAR2 , time , days , xy , c +:: + +FILL_DEF:: +VAR1 time +VAR2 time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case21/AGCM2.rc new file mode 100644 index 000000000000..14b0d586bdfb --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case21/AGCM2.rc @@ -0,0 +1,33 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +VAR1 , time , days , xy , c +VAR2 , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR1 , time , days , xy , c +VAR2 , time , days , xy , c +:: + + +FILL_DEF:: +VAR2D time+time +VAR1 time +VAR2 time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP1.rc new file mode 100644 index 000000000000..ce2690d6937b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP2.rc new file mode 100644 index 000000000000..4e9e1bb95026 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20041125 210000 +20041126 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case21/ExtData.rc new file mode 100644 index 000000000000..a45d1dd13f7f --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case21/ExtData.rc @@ -0,0 +1,13 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4.nc4 +VAR3D NA N N 0 none none VAR3D case1.%y4.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case21/HISTORY1.rc new file mode 100644 index 000000000000..bb5ee8a77ef6 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case21/HISTORY1.rc @@ -0,0 +1,13 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000 + case1.fields: 'VAR1', 'Root', + 'VAR2', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case21/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case21/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/README b/Tests/ExtData_Testing_Framekwork/test_cases/case21/README new file mode 100644 index 000000000000..df7cb0f82872 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case21/README @@ -0,0 +1 @@ +test derived export to create sum of 2 variables diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case21/extdata.yaml new file mode 100644 index 000000000000..c1f9b4354434 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case21/extdata.yaml @@ -0,0 +1,8 @@ +Collections: + fstream1: {template: case1.%y4.nc4, valid_range: "2004-01-01/2005-01-01" } +Exports: + VAR1: {variable: VAR1, collection: fstream1} + VAR2: {variable: VAR2, collection: fstream1} + +Derived: + VAR2D: {function: VAR1+VAR2} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM1.rc new file mode 100644 index 000000000000..81bb07dcdcbd --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20080101 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM2.rc new file mode 100644 index 000000000000..0a1f70b7456c --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM2.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 90 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20080101 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM3.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM3.rc new file mode 100644 index 000000000000..dc81ef15d2da --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM3.rc @@ -0,0 +1,26 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC900x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20080101 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP.rc new file mode 100644 index 000000000000..7cbd02ce9493 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP.rc @@ -0,0 +1,5 @@ +CASES:: +CAP1.rc +CAP2.rc +CAP3.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP1.rc new file mode 100644 index 000000000000..2dd970d08f1b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP1.rc @@ -0,0 +1,12 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20071231 230000 + +JOB_SGMT: 00001201 000000 +HEARTBEAT_DT: 3600 + + +USE_EXTDATA2G: .true. +USE_EXTDATA2G: .true. diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP2.rc new file mode 100644 index 000000000000..18c901f66ed9 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP2.rc @@ -0,0 +1,12 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20081231 230000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + + +USE_EXTDATA2G: .true. +USE_EXTDATA2G: .true. diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP3.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP3.rc new file mode 100644 index 000000000000..cbb7b325f460 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP3.rc @@ -0,0 +1,11 @@ +ROOT_NAME: Root +ROOT_CF: AGCM3.rc +HIST_CF: HISTORY3.rc + +BEG_DATE: 20081229 000000 + +JOB_SGMT: 00000010 000000 +HEARTBEAT_DT: 3600 + + +USE_EXTDATA2G: .true. diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case22/ExtData.rc new file mode 100644 index 000000000000..1b98d7c432b9 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case22/ExtData.rc @@ -0,0 +1,12 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA 2008 N 0 none none VAR2D case1.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY1.rc new file mode 100644 index 000000000000..fe45450680fd --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY1.rc @@ -0,0 +1,13 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: 'nc4', + case1.format: 'CFIO', + case1.frequency: 240000, + case1.duration: 000000, + case1.ref_time: 000000, + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY2.rc new file mode 100644 index 000000000000..e75f98424508 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY2.rc @@ -0,0 +1,13 @@ +GRID_LABELS: +:: + +COLLECTIONS: case2 +:: + + case2.template: 'nc4', + case2.format: 'CFIO', + case2.frequency: 240000, + case2.duration: 000000, + case2.ref_time: 000000, + case2.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY3.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY3.rc new file mode 100644 index 000000000000..720dd45ecd3d --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY3.rc @@ -0,0 +1,13 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: + + case2.template: 'nc4', + case2.format: 'CFIO', + case2.frequency: 240000, + case2.duration: 000000, + case2.ref_time: 000000, + case2.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/README b/Tests/ExtData_Testing_Framekwork/test_cases/case22/README new file mode 100644 index 000000000000..6ea1c769dbad --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case22/README @@ -0,0 +1 @@ +test multiple datasets where an export uses both with with no extrapolation outside and crosses transition date diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/case1.rcx b/Tests/ExtData_Testing_Framekwork/test_cases/case22/case1.rcx new file mode 100644 index 000000000000..1a19553ea86f --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case22/case1.rcx @@ -0,0 +1,7 @@ + case1.template: 'nc4', + case1.format: 'CFIO', + case1.frequency: 240000, + case1.duration: 000000, + case1.ref_time: 000000, + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/case2.rcx b/Tests/ExtData_Testing_Framekwork/test_cases/case22/case2.rcx new file mode 100644 index 000000000000..4ba51fb14b9b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case22/case2.rcx @@ -0,0 +1,7 @@ + case2.template: 'nc4', + case2.format: 'CFIO', + case2.frequency: 240000, + case2.duration: 000000, + case2.ref_time: 000000, + case2.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/egress b/Tests/ExtData_Testing_Framekwork/test_cases/case22/egress new file mode 100644 index 000000000000..e69de29bb2d1 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case22/extdata.yaml new file mode 100644 index 000000000000..34ce04867e7b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case22/extdata.yaml @@ -0,0 +1,7 @@ +Collections: + fstream1: {template: "case1.nc4", valid_range: "2008-01-01/2008-12-31"} + fstream2: {template: "case2.nc4", valid_range: "2009-01-01/2009-12-31"} +Exports: + VAR2D: + - {starting: "2008-01-01", variable: VAR2D, collection: fstream1} + - {starting: "2009-01-01", variable: VAR2D, collection: fstream2} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/warnings_and_errors.log b/Tests/ExtData_Testing_Framekwork/test_cases/case22/warnings_and_errors.log new file mode 100644 index 000000000000..9144b2f54291 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case22/warnings_and_errors.log @@ -0,0 +1,60 @@ +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: EXTDATA: In ExtData resource file, could not find: VAR2D +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: EXTDATA: In ExtData resource file, could not find: VAR2D +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: EXTDATA: In ExtData resource file, could not find: VAR2D +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage +pe=00000: MAPL: No configure file specified for logging layer. Using defaults. +pe=00000: EXTDATA: Using ExtData2G, note this is still in BETA stage diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM1.rc new file mode 100644 index 000000000000..3583e9d12516 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20160101 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM2.rc new file mode 100644 index 000000000000..3583e9d12516 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM2.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20160101 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM3.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM3.rc new file mode 100644 index 000000000000..fa066d52daf6 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM3.rc @@ -0,0 +1,26 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: FillImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20160101 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP.rc new file mode 100644 index 000000000000..7cbd02ce9493 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP.rc @@ -0,0 +1,5 @@ +CASES:: +CAP1.rc +CAP2.rc +CAP3.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP1.rc new file mode 100644 index 000000000000..cd699d9b294a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP1.rc @@ -0,0 +1,11 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20151231 000000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + + +USE_EXTDATA2G: .true. diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP2.rc new file mode 100644 index 000000000000..70bafc168604 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP2.rc @@ -0,0 +1,11 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20191225 000000 + +JOB_SGMT: 00000020 000000 +HEARTBEAT_DT: 3600 + + +USE_EXTDATA2G: .true. diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP3.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP3.rc new file mode 100644 index 000000000000..177c24b23153 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP3.rc @@ -0,0 +1,11 @@ +ROOT_NAME: Root +ROOT_CF: AGCM3.rc +HIST_CF: HISTORY3.rc + +BEG_DATE: 20191227 000000 + +JOB_SGMT: 00000011 000000 +HEARTBEAT_DT: 3600 + + +USE_EXTDATA2G: .true. diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case23/ExtData.rc new file mode 100644 index 000000000000..67ef7b54a4a8 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case23/ExtData.rc @@ -0,0 +1,12 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .true. +Prefetch: .true. +DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4%m2%d2.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY1.rc new file mode 100644 index 000000000000..7f1045a27232 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY1.rc @@ -0,0 +1,12 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4%m2%d2.nc4', + case1.format: 'CFIO', + case1.frequency: 240000, + case1.ref_time: 000000, + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY2.rc new file mode 100644 index 000000000000..cddbea20dd5e --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY2.rc @@ -0,0 +1,12 @@ +GRID_LABELS: +:: + +COLLECTIONS: case2 +:: + + case2.template: '%y4%m2%d2.nc4', + case2.format: 'CFIO', + case2.frequency: 240000, + case2.ref_time: 000000, + case2.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY3.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY3.rc new file mode 100644 index 000000000000..31702240896d --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY3.rc @@ -0,0 +1,12 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: + + case1.template: '%y4%m2%d2.nc4', + case1.format: 'CFIO', + case1.frequency: 240000, + case1.ref_time: 000000, + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/README b/Tests/ExtData_Testing_Framekwork/test_cases/case23/README new file mode 100644 index 000000000000..8f1c29fb1967 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case23/README @@ -0,0 +1 @@ +Test multiple datasets and treat Climatology in the first and a real-time in the 2nd diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case23/extdata.yaml new file mode 100644 index 000000000000..62007858b755 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case23/extdata.yaml @@ -0,0 +1,11 @@ +Collections: + fstream1: {template: "case1.%y4%m2%d2.nc4", valid_range: "2016-01-01/2016-12-31" } + fstream2: {template: "case2.%y4%m2%d2.nc4", valid_range: "2019-12-31/2020-01-10" } +Samplings: + S1: + extrapolation: clim + source_time: "2016-01-01/2016-12-31" +Exports: + VAR2D: + - {starting: 1970-01-01, variable: VAR2D, collection: fstream1, sample: S1} + - {starting: 2020-01-01, variable: VAR2D, collection: fstream2} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case24/AGCM1.rc new file mode 100644 index 000000000000..2ef970737fb7 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case24/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 6 + +Root.GRID_TYPE: Cubed-Sphere +Root.GRIDNAME: PE24x144-CF +Root.LM: 3 +Root.IM_WORLD: 24 +Root.NF: 6 + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case24/AGCM2.rc new file mode 100644 index 000000000000..c49217bcec3c --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case24/AGCM2.rc @@ -0,0 +1,27 @@ +NX: 1 +NY: 6 + +Root.GRID_TYPE: Cubed-Sphere +Root.GRIDNAME: PE24x144-CF +Root.LM: 3 +Root.IM_WORLD: 24 +Root.NF: 6 + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +VAR3D , time , days , xyz , c +:: + +FILL_DEF:: +VAR2D time +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP1.rc new file mode 100644 index 000000000000..ce2690d6937b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP2.rc new file mode 100644 index 000000000000..4e9e1bb95026 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20041125 210000 +20041126 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case24/ExtData.rc new file mode 100644 index 000000000000..0e50d21b5b84 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case24/ExtData.rc @@ -0,0 +1,13 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4.nc4 +VAR3D NA N N 0 none none VAR3D case2.%y4.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case24/HISTORY1.rc new file mode 100644 index 000000000000..15d036f1bc9f --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case24/HISTORY1.rc @@ -0,0 +1,19 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 + case2 +:: + + case1.template: '%y4.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000 + case1.fields: 'VAR2D', 'Root', + :: + case2.template: '%y4.nc4', + case2.format: 'CFIO', + case2.frequency: 010000, + case2.duration: 000000 + case2.fields: 'VAR3D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case24/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case24/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/README b/Tests/ExtData_Testing_Framekwork/test_cases/case24/README new file mode 100644 index 000000000000..39f44190eea4 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case24/README @@ -0,0 +1 @@ +Case, 12-month/12 time 2004 file with 2 updates, non-climatology, cubed-sphere diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case24/extdata.yaml new file mode 100644 index 000000000000..ade3dd293935 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case24/extdata.yaml @@ -0,0 +1,6 @@ +Collections: + fstream1: {template: case1.%y4.nc4, valid_range: "2004-01-01/2005-01-01" } + fstream2: {template: case2.%y4.nc4, valid_range: "2004-01-01/2005-01-01" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1} + VAR3D: {variable: VAR3D, collection: fstream2} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/nproc.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case24/nproc.rc new file mode 100644 index 000000000000..1e8b31496214 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case24/nproc.rc @@ -0,0 +1 @@ +6 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case25/AGCM1.rc new file mode 100644 index 000000000000..9772fa73fa05 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case25/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR3D , time , days , xyz , e +:: + +FILL_DEF:: +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case25/AGCM2.rc new file mode 100644 index 000000000000..25468d893da6 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case25/AGCM2.rc @@ -0,0 +1,26 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR3D , time , days , xyz , e +:: + +EXPORT_STATE:: +VAR3D , time , days , xyz , e +:: + +FILL_DEF:: +VAR3D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP1.rc new file mode 100644 index 000000000000..ce2690d6937b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP2.rc new file mode 100644 index 000000000000..4e9e1bb95026 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20041125 210000 +20041126 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case25/ExtData.rc new file mode 100644 index 000000000000..a45d1dd13f7f --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case25/ExtData.rc @@ -0,0 +1,13 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4.nc4 +VAR3D NA N N 0 none none VAR3D case1.%y4.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case25/HISTORY1.rc new file mode 100644 index 000000000000..1b6e816089a7 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case25/HISTORY1.rc @@ -0,0 +1,23 @@ +GRID_LABELS: PC45x21-DC +:: + +PC45x21-DC.GRID_TYPE: LatLon +PC45x21-DC.IM_WORLD: 45 +PC45x21-DC.JM_WORLD: 21 +PC45x21-DC.POLE: PC +PC45x21-DC.DATELINE: DC +PC45x21-DC.LM: 3 + +#GRID_LABELS: +#:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000 + case1.grid_label: PC45x21-DC + case1.fields: 'VAR3D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case25/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case25/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/README b/Tests/ExtData_Testing_Framekwork/test_cases/case25/README new file mode 100644 index 000000000000..318986102ca4 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case25/README @@ -0,0 +1 @@ +test reading edge variables diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case25/extdata.yaml new file mode 100644 index 000000000000..e2ddb90675ab --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case25/extdata.yaml @@ -0,0 +1,5 @@ +Collections: + fstream1: {template: case1.%y4.nc4, valid_range: "2004-01-01/2005-01-01" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1} + VAR3D: {variable: VAR3D, collection: fstream1} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case26/AGCM1.rc new file mode 100644 index 000000000000..214bbb31e7bf --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case26/AGCM1.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR3Dc , time , days , xyz , c +VAR3De , time , days , xyz , e +:: + +FILL_DEF:: +VAR3Dc time +VAR3De time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case26/AGCM2.rc new file mode 100644 index 000000000000..defaa0643ab7 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case26/AGCM2.rc @@ -0,0 +1,29 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR3Dc , time , days , xyz , c +VAR3De , time , days , xyz , e +:: + +EXPORT_STATE:: +VAR3Dc , time , days , xyz , c +VAR3De , time , days , xyz , e +:: + +FILL_DEF:: +VAR3Dc time +VAR3De time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP1.rc new file mode 100644 index 000000000000..ce2690d6937b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP2.rc new file mode 100644 index 000000000000..4e9e1bb95026 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20041125 210000 +20041126 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case26/ExtData.rc new file mode 100644 index 000000000000..10b7735216ec --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case26/ExtData.rc @@ -0,0 +1,13 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR3Dc NA N N 0 none none VAR3Dc casec.%y4.nc4 +VAR3De NA N N 0 none none VAR3De casee.%y4.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case26/HISTORY1.rc new file mode 100644 index 000000000000..d0936b060353 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case26/HISTORY1.rc @@ -0,0 +1,31 @@ +GRID_LABELS: PC45x21-DC +:: + +PC45x21-DC.GRID_TYPE: LatLon +PC45x21-DC.IM_WORLD: 45 +PC45x21-DC.JM_WORLD: 21 +PC45x21-DC.POLE: PC +PC45x21-DC.DATELINE: DC +PC45x21-DC.LM: 3 + +#GRID_LABELS: +#:: + +COLLECTIONS: casec + casee +:: + + casec.template: '%y4.nc4', + casec.format: 'CFIO', + casec.frequency: 010000, + casec.duration: 000000 + casec.grid_label: PC45x21-DC + casec.fields: 'VAR3Dc', 'Root', + :: + casee.template: '%y4.nc4', + casee.format: 'CFIO', + casee.frequency: 010000, + casee.duration: 000000 + casee.grid_label: PC45x21-DC + casee.fields: 'VAR3De', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case26/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case26/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/README b/Tests/ExtData_Testing_Framekwork/test_cases/case26/README new file mode 100644 index 000000000000..cec787fe0882 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case26/README @@ -0,0 +1 @@ +Read edge + center diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case26/extdata.yaml new file mode 100644 index 000000000000..75ab030466dd --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case26/extdata.yaml @@ -0,0 +1,6 @@ +Collections: + fstreamc: {template: casec.%y4.nc4, valid_range: "2004-01-01/2005-01-01" } + fstreame: {template: casee.%y4.nc4, valid_range: "2004-01-01/2005-01-01" } +Exports: + VAR3Dc: {variable: VAR3Dc, collection: fstreamc} + VAR3De: {variable: VAR3De, collection: fstreame} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case3/AGCM1.rc new file mode 100644 index 000000000000..302766bebfab --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case3/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case3/AGCM2.rc new file mode 100644 index 000000000000..63df38ae71a5 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case3/AGCM2.rc @@ -0,0 +1,27 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC900x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +CLIM_YEAR: 2004 +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP1.rc new file mode 100644 index 000000000000..a75a8c48bd1e --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP1.rc @@ -0,0 +1,24 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +RUN_TIMES:: +20040115 210000 +20040215 210000 +20040315 210000 +20040415 210000 +20040515 210000 +20040615 210000 +20040715 210000 +20040815 210000 +20040915 210000 +20041015 210000 +20041115 210000 +20041215 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP2.rc new file mode 100644 index 000000000000..4dc521f63044 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP2.rc @@ -0,0 +1,15 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20071125 210000 +20071126 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case3/ExtData.rc new file mode 100644 index 000000000000..523802edf5f1 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case3/ExtData.rc @@ -0,0 +1,12 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA 2004 N 0 none none VAR2D case1.%y4%m2.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case3/HISTORY1.rc new file mode 100644 index 000000000000..0b54db8e8f25 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case3/HISTORY1.rc @@ -0,0 +1,11 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4%m2.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case3/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case3/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/README b/Tests/ExtData_Testing_Framekwork/test_cases/case3/README new file mode 100644 index 000000000000..f47e12688ffc --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case3/README @@ -0,0 +1 @@ +Case 3, monthly files for 2004 file with 1 updates, climatology for 2007 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case3/extdata.yaml new file mode 100644 index 000000000000..1f70929226a8 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case3/extdata.yaml @@ -0,0 +1,6 @@ +Samplings: + sample_clim: {extrapolation: clim} +Collections: + fstream1: {template: "case1.%y4%m2.nc4", valid_range: "2004-01-01/2004-12-31" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1, source_time: "2004-01-01/2004-12-31", sample: sample_clim} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case4/AGCM1.rc new file mode 100644 index 000000000000..93585c3bfdd2 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case4/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20040415 210000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case4/AGCM2.rc new file mode 100644 index 000000000000..2271a4a04fe9 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case4/AGCM2.rc @@ -0,0 +1,26 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20040416 090000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP1.rc new file mode 100644 index 000000000000..8bc0e5df5306 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP1.rc @@ -0,0 +1,16 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +RUN_TIMES:: +20040415 210000 +20040416 210000 +20040417 210000 +20040418 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP2.rc new file mode 100644 index 000000000000..0209bfea0d8b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP2.rc @@ -0,0 +1,13 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040415 210000 + +JOB_SGMT: 00000001 000000 +HEARTBEAT_DT: 3600 + +RUN_TIMES:: +20040416 090000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case4/ExtData.rc new file mode 100644 index 000000000000..782b2e1947b9 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case4/ExtData.rc @@ -0,0 +1,12 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N F0 none none VAR2D case1.%y4%m2%d2.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case4/HISTORY1.rc new file mode 100644 index 000000000000..295240a18188 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case4/HISTORY1.rc @@ -0,0 +1,11 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4%m2%d2.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case4/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case4/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/README b/Tests/ExtData_Testing_Framekwork/test_cases/case4/README new file mode 100644 index 000000000000..04a0216fbe17 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case4/README @@ -0,0 +1 @@ +Case 4, simple everytime update with daily files and last value fixed diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case4/extdata.yaml new file mode 100644 index 000000000000..191e5e0e8ca5 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case4/extdata.yaml @@ -0,0 +1,6 @@ +Samplings: + sample_fixed: {time_interpolation: false} +Collections: + fstream1: {template: case1.%y4%m2%d2.nc4} +Exports: + VAR2D: {variable: VAR2D, collection: fstream1, sample: sample_fixed} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case5/AGCM1.rc new file mode 100644 index 000000000000..93585c3bfdd2 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case5/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20040415 210000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case5/AGCM2.rc new file mode 100644 index 000000000000..6241b66ae49c --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case5/AGCM2.rc @@ -0,0 +1,26 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20040415 210000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP1.rc new file mode 100644 index 000000000000..8bc0e5df5306 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP1.rc @@ -0,0 +1,16 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +RUN_TIMES:: +20040415 210000 +20040416 210000 +20040417 210000 +20040418 210000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP2.rc new file mode 100644 index 000000000000..0209bfea0d8b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP2.rc @@ -0,0 +1,13 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040415 210000 + +JOB_SGMT: 00000001 000000 +HEARTBEAT_DT: 3600 + +RUN_TIMES:: +20040416 090000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case5/ExtData.rc new file mode 100644 index 000000000000..1c81c28b2b97 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case5/ExtData.rc @@ -0,0 +1,12 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4%m2%d2.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case5/HISTORY1.rc new file mode 100644 index 000000000000..295240a18188 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case5/HISTORY1.rc @@ -0,0 +1,11 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4%m2%d2.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case5/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case5/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/README b/Tests/ExtData_Testing_Framekwork/test_cases/case5/README new file mode 100644 index 000000000000..728af50ea7e9 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case5/README @@ -0,0 +1 @@ +Case 5, simple everytime update with daily files and time interpolation diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case5/extdata.yaml new file mode 100644 index 000000000000..a126e4e0ebf9 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case5/extdata.yaml @@ -0,0 +1,4 @@ +Collections: + fstream1: {template: case1.%y4%m2%d2.nc4} +Exports: + VAR2D: {variable: VAR2D, collection: fstream1} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case6/AGCM1.rc new file mode 100644 index 000000000000..302766bebfab --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case6/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case6/AGCM2.rc new file mode 100644 index 000000000000..7c517e6969e4 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case6/AGCM2.rc @@ -0,0 +1,24 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC900x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D 183+0.5*(-182.0-183.0) +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP1.rc new file mode 100644 index 000000000000..b9c2d90f9891 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP1.rc @@ -0,0 +1,10 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20031231 000000 + +JOB_SGMT: 00001202 000000 +HEARTBEAT_DT: 3600 + + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP2.rc new file mode 100644 index 000000000000..845a49be478b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP2.rc @@ -0,0 +1,14 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20061231 120000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case6/ExtData.rc new file mode 100644 index 000000000000..13d1376b6cf3 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case6/ExtData.rc @@ -0,0 +1,12 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA 2004 N 0 none none VAR2D case1.%y4%m2%d2.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case6/HISTORY1.rc new file mode 100644 index 000000000000..7f1045a27232 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case6/HISTORY1.rc @@ -0,0 +1,12 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4%m2%d2.nc4', + case1.format: 'CFIO', + case1.frequency: 240000, + case1.ref_time: 000000, + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case6/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case6/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/README b/Tests/ExtData_Testing_Framekwork/test_cases/case6/README new file mode 100644 index 000000000000..585f98aab2ca --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case6/README @@ -0,0 +1 @@ +Case 6, daily files for 0z for a year, fill a time at 12z on the 31st of december 2006 as a climatology diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case6/extdata.yaml new file mode 100644 index 000000000000..67a7a29a9b0d --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case6/extdata.yaml @@ -0,0 +1,6 @@ +Samplings: + sample_clim: {extrapolation: clim, source_time: "2004-01-01/2004-12-31"} +Collections: + fstream1: {template: "case1.%y4%m2%d2.nc4", valid_range: "2004-01-01/2004-12-31" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1, sample: sample_clim} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case7/AGCM1.rc new file mode 100644 index 000000000000..1a52adfe187d --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case7/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC900x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case7/AGCM2.rc new file mode 100644 index 000000000000..7bc84048f88f --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case7/AGCM2.rc @@ -0,0 +1,25 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D 167.0+(2.0/31.0)*(-168.0-167.0) +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP1.rc new file mode 100644 index 000000000000..77bd783ddb2e --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP1.rc @@ -0,0 +1,25 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040115 000000 +20040215 000000 +20040315 000000 +20040415 000000 +20040515 000000 +20040615 000000 +20040715 000000 +20040815 000000 +20040915 000000 +20041015 000000 +20041115 000000 +20041215 000000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP2.rc new file mode 100644 index 000000000000..af401118d4fa --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP2.rc @@ -0,0 +1,14 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20061217 000000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case7/ExtData.rc new file mode 100644 index 000000000000..ca41e8d3a0ec --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case7/ExtData.rc @@ -0,0 +1,11 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. + +PrimaryExports%% +VAR2D NA Y N 0 none none VAR2D case1.2004.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case7/HISTORY1.rc new file mode 100644 index 000000000000..a2ad110c3fde --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case7/HISTORY1.rc @@ -0,0 +1,12 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4.nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000 + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case7/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case7/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/README b/Tests/ExtData_Testing_Framekwork/test_cases/case7/README new file mode 100644 index 000000000000..fdfb854902d9 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case7/README @@ -0,0 +1 @@ +Case, 12-month/12 time 2004 file with an update that will wrap around the year diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case7/extdata.yaml new file mode 100644 index 000000000000..23fba59ae3ba --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case7/extdata.yaml @@ -0,0 +1,6 @@ +Samplings: + sample_clim: {source_time: "2004-01-01/2004-12-31", extrapolation: clim} +Collections: + fstream1: {template: "case1.2004.nc4", valid_range: "2004-01-01/2004-12-31" } +Exports: + VAR2D: {variable: VAR2D, collection: fstream1, sample: sample_clim} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case8/AGCM1.rc new file mode 100644 index 000000000000..93585c3bfdd2 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case8/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20040415 210000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case8/AGCM2.rc new file mode 100644 index 000000000000..6241b66ae49c --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case8/AGCM2.rc @@ -0,0 +1,26 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D time +:: + +REF_TIME: 20040415 210000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP1.rc new file mode 100644 index 000000000000..72cccef1f8b8 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP1.rc @@ -0,0 +1,9 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040201 210000 + +JOB_SGMT: 00000002 000000 +HEARTBEAT_DT: 1800 + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP2.rc new file mode 100644 index 000000000000..e820872c1e5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP2.rc @@ -0,0 +1,14 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20040201 213000 + +JOB_SGMT: 00000002 000000 +HEARTBEAT_DT: 1800 + +RUN_TIMES:: +20040202 150000 +20040202 230000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case8/ExtData.rc new file mode 100644 index 000000000000..706353827d51 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case8/ExtData.rc @@ -0,0 +1,12 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N 0 none none VAR2D case1.%y4%m2%d2_%h2%n2.nc4 2004-02-01T21:30:00P0000-00-00T03:00:00 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case8/HISTORY1.rc new file mode 100644 index 000000000000..ce09c7e5290b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case8/HISTORY1.rc @@ -0,0 +1,12 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: '%y4%m2%d2_%h2%n2.nc4', + case1.format: 'CFIO', + case1.frequency: 030000, + case1.ref_time: 213000 + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case8/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case8/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/README b/Tests/ExtData_Testing_Framekwork/test_cases/case8/README new file mode 100644 index 000000000000..ef8f3c8089fb --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case8/README @@ -0,0 +1 @@ +Case 8, simple everytime update with a new file every 3 hours relative to 003000z diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case8/extdata.yaml new file mode 100644 index 000000000000..f7fbd8500570 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case8/extdata.yaml @@ -0,0 +1,4 @@ +Collections: + fstream1: {template: case1.%y4%m2%d2_%h2%n2.nc4, ref_time: "2004-02-01T21:30:00", freq: PT3H} +Exports: + VAR2D: {variable: VAR2D, collection: fstream1} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/AGCM1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case9/AGCM1.rc new file mode 100644 index 000000000000..e7caf16aa2d0 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case9/AGCM1.rc @@ -0,0 +1,22 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: GenerateExports + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D 17.0 +:: + +REF_TIME: 20040701 000000 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/AGCM2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case9/AGCM2.rc new file mode 100644 index 000000000000..8560c27aecc7 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case9/AGCM2.rc @@ -0,0 +1,25 @@ +NX: 1 +NY: 1 + +Root.GRID_TYPE: LatLon +Root.GRIDNAME: DC90x45-PC +Root.LM: 3 +Root.IM_WORLD: 90 +Root.JM_WORLD: 45 +Root.POLE: 'PC' +Root.DATELINE: 'DC' + +RUN_MODE: CompareImports + +IMPORT_STATE:: +VAR2D , time , days , xy , c +:: + +EXPORT_STATE:: +VAR2D , time , days , xy , c +:: + +FILL_DEF:: +VAR2D 17.0 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP.rc new file mode 100644 index 000000000000..680d0ffa9c5b --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP.rc @@ -0,0 +1,4 @@ +CASES:: +CAP1.rc +CAP2.rc +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP1.rc new file mode 100644 index 000000000000..db6a1b1fa205 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP1.rc @@ -0,0 +1,14 @@ +ROOT_NAME: Root +ROOT_CF: AGCM1.rc +HIST_CF: HISTORY1.rc + +BEG_DATE: 20040101 210000 + +JOB_SGMT: 00001200 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20040701 000000 +:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP2.rc new file mode 100644 index 000000000000..31ad1a874601 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP2.rc @@ -0,0 +1,17 @@ +ROOT_NAME: Root +ROOT_CF: AGCM2.rc +HIST_CF: HISTORY2.rc + +BEG_DATE: 20000101 210000 + +JOB_SGMT: 00009600 000000 +HEARTBEAT_DT: 3600 + +#RUN_EXTDATA: .false. +RUN_TIMES:: +20020703 000000 +:: +#RUN_TIMES:: +#20041125 210000 +#:: + diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case9/ExtData.rc new file mode 100644 index 000000000000..b5f2a303a22e --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case9/ExtData.rc @@ -0,0 +1,12 @@ +#CASE_SENSITIVE_VARIABLE_NAMES: .false. +Ext_AllowExtrap: .false. +Prefetch: .true. +#DEBUG_LEVEL: 20 + +PrimaryExports%% +VAR2D NA N N - none none VAR2D case1.nc4 +%% + + +DerivedExports%% +%% diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/HISTORY1.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case9/HISTORY1.rc new file mode 100644 index 000000000000..490301aee5ea --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case9/HISTORY1.rc @@ -0,0 +1,12 @@ +GRID_LABELS: +:: + +COLLECTIONS: case1 +:: + + case1.template: 'nc4', + case1.format: 'CFIO', + case1.frequency: 010000, + case1.duration: 000000 + case1.fields: 'VAR2D', 'Root', + :: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/HISTORY2.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case9/HISTORY2.rc new file mode 100644 index 000000000000..2895432e995a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case9/HISTORY2.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/README b/Tests/ExtData_Testing_Framekwork/test_cases/case9/README new file mode 100644 index 000000000000..ffb8734bc0e7 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case9/README @@ -0,0 +1 @@ +Case 9 Single time file, persisted at all times diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/extdata.yaml b/Tests/ExtData_Testing_Framekwork/test_cases/case9/extdata.yaml new file mode 100644 index 000000000000..79f977377386 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case9/extdata.yaml @@ -0,0 +1,6 @@ +Samplings: + sample_closest: {extrapolation: persist_closest} +Collections: + fstream1: {template: case1.nc4} +Exports: + VAR2D: {variable: VAR2D, collection: fstream1, sample: sample_closest} diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/cases.txt b/Tests/ExtData_Testing_Framekwork/test_cases/cases.txt new file mode 100644 index 000000000000..9753d563eb9a --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/cases.txt @@ -0,0 +1,25 @@ +case1 +case2 +case3 +case4 +case5 +case6 +case7 +case8 +case9 +case10 +case11 +case12 +case13 +case14 +case15 +case16 +case18 +case19 +case20 +case21 +case22 +case23 +case24 +case25 +case26 diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/test_case_descriptions.md b/Tests/ExtData_Testing_Framekwork/test_cases/test_case_descriptions.md new file mode 100644 index 000000000000..2b8b02b42681 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/test_case_descriptions.md @@ -0,0 +1,33 @@ +# Test Case Descriptions + +Note all test cases are in a numbered directory caseX, where a X is an integer and each case is described in the following list where the list number X is for folder caseX + +To run the test cases you can use the provided script and run the command: +path_to_script/run_extdatadriver_cases.py --builddir path_to_geos_install/bin --casedir path_to_cases --cases cases.txt --savelog TRUE + +1. 12-month/12 time 2004 file with 2 updates, non-climatology +2. 12-month/12 time 2004 file with 2 updates, climatology +3. monthly files for 2004 file with 1 updates, climatology for 2007 +4. simple everytime update with daily files and no time interpolation +5. simple everytime update with daily files and time interpolation +6. daily files for 0z for a year, fill a time at 12z on the 31st of december 2006 as a climatology +7. 12-month/12 time 2004 file with an update that will wrap around the year +8. simple everytime update with a new file every 3 hours relative to 003000z +9. Single time file, persisted at all times +10. Interpolation outside of data set (Harvard mode), make a multi year dataset. Define as not a climatology and ask for data after dataset time range +11. Interpolation outside of data set (Harvard mode), make a multi year dataset. Define as not a climatology and ask for data before datset time range +12. Test of case where you want to make a really coarse file in History that can not be decomposed on the default layout in the rc file. Be able to output such a file, then read back in on same grid in ExtData +13. Testing that we can take a climatology for a non-leap year and interpolate to a leap year. 12 files each with the midmonth value for 2007 (non-leap year). Interpolate to 02/29/2008 (leap year) +14. Testing that we can take a climatology for a non-leap year and interpolate to a leap year. Daily files each with 1 value for 2007 (non-leap year). Interpolate to 02/29/2008 (leap year) +15. Testing that we can take a climatology for a non-leap year and interpolate to a non-leap year. Daily files each with 1 value for 2007 (non-leap year). Interpolate to 03/29/2006 (leap year) +16. Testing that we can take a climatology for a leap year and interpolate to a non-leap year. Daily files each with 1 value for 2008 (leap year). Interpolate to 03/29/2006 15z (leap year) +17. Not used +18. Test vector regridding +19. Test set file to /dev/null +20. Make daily files for 2016. Then start on February 29th in 2020 and allow extrapolation outside of dataset a climatology +21. Test derived export to create sum of 2 variables +22. Test multiple datasets where an export uses both with with no extrapolation outside and crosses transition date +23. Test multiple datasets and treat Climatology in the first and a real-time in the 2nd +24. Test reading cubed-sphere input +25. Test reading edge variable +26. Test reading edge + cetner variables diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/use_extdata2g.rc b/Tests/ExtData_Testing_Framekwork/test_cases/use_extdata2g.rc new file mode 100644 index 000000000000..1c4e1f9f2026 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_cases/use_extdata2g.rc @@ -0,0 +1 @@ +USE_EXTDATA2G: .true. diff --git a/Tests/ExtData_Testing_Framekwork/test_script/.gitignore b/Tests/ExtData_Testing_Framekwork/test_script/.gitignore new file mode 100644 index 000000000000..aee1c277000c --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_script/.gitignore @@ -0,0 +1 @@ +/run_dir*/ diff --git a/Tests/ExtData_Testing_Framekwork/test_script/run_case.py b/Tests/ExtData_Testing_Framekwork/test_script/run_case.py new file mode 100755 index 000000000000..129bc9a9bb61 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_script/run_case.py @@ -0,0 +1,64 @@ +#!/usr/bin/env python + +import argparse, sys, os +import subprocess as sp +import glob +import shutil +import utils + +class ExtDataCase(): + """ + """ + + def __init__(self, case_name, comm_line_args): + + self.build_dir = comm_line_args['build_dir'] + self.case_dir = comm_line_args['case_dir'] + self.case_name = case_name + self.case_path = self.case_dir+"/"+self.case_name.rstrip() + + def run(self,logfile): + + scrdir="ExtData_scratch" + orig_dir = os.getcwd() + if os.path.isdir(scrdir): + shutil.rmtree(scrdir) + os.mkdir(scrdir) + rc_files = glob.glob(self.case_path+"/*.rc") + for rc_file in rc_files: + shutil.copy(rc_file,scrdir) + yaml_files = glob.glob(self.case_path+"/*.yaml") + for yaml_file in yaml_files: + shutil.copy(yaml_file,scrdir) + os.chdir(scrdir) + + g5_mod_path = self.build_dir+"/g5_modules" + utils.source_g5_modules(g5_mod_path) + success = os.path.isfile('nproc.rc') + if success: + fproc = open('nproc.rc',"r") + nproc = fproc.readline() + nproc = nproc.rstrip() + fproc.close() + else: + nproc = "1" + + exec_path = "cat CAP1.rc " + self.case_dir+"/use_extdata2g.rc > temp.rc ;mv temp.rc CAP1.rc" + sp.call(exec_path,stdout=logfile,stderr=logfile,shell=True) + exec_path = "cat CAP2.rc " + self.case_dir+"/use_extdata2g.rc > temp.rc; mv temp.rc CAP2.rc" + sp.call(exec_path,stdout=logfile,stderr=logfile,shell=True) + + exec_path = "mpirun -np "+nproc+" "+self.build_dir+"/ExtDataDriver.x " + sp.call(exec_path,stdout=logfile,stderr=logfile,shell=True) + sp.call("~/bin/Killall ExtDataDriver.x",stdout=logfile,stderr=logfile,shell=True) + + print("finished exec of "+self.case_name.rstrip()) + success = os.path.isfile('egress') + os.chdir(orig_dir) + shutil.rmtree(scrdir) +# + if success: + return True + else: + return False + diff --git a/Tests/ExtData_Testing_Framekwork/test_script/run_extdatadriver_cases.py b/Tests/ExtData_Testing_Framekwork/test_script/run_extdatadriver_cases.py new file mode 100755 index 000000000000..6e3fc6f4fb58 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_script/run_extdatadriver_cases.py @@ -0,0 +1,56 @@ +#!/usr/bin/env python + +import argparse, sys, os +import subprocess as sp +from run_case import ExtDataCase + +def parse_comm_args(): + + p = argparse.ArgumentParser(description='Run ExtData tester script') + + # BAS_HOM_DIR, CUR_HOM_DIR, DIFF + # ------------------------------ + p.add_argument("--builddir", dest="build_dir",help='src directory for build') + p.add_argument("--casedir", dest="case_dir",help='where cases are located') + p.add_argument("--cases", dest="cases",help='list of cases') + p.add_argument("--savelog",dest="save_log",default="false",help='save the log files for all') + + + args = vars(p.parse_args()) # vars converts to dict + + # some checks on inputs + # --------------------- + if not os.path.isdir(args['build_dir']): + raise Exception('build_dir [%s] does not exist' % args['bas']) + if not os.path.isdir(args['case_dir']): + raise Exception('case_dir [%s] does not exist' % args['bas']) + + # return opts + # ----------- + return args + + +if __name__ == "__main__": + + comm_opts = parse_comm_args() + build_dir = comm_opts['build_dir'] + case_dir = comm_opts['case_dir'] + case_path = comm_opts['cases'] + case_file = open(case_path,'r') + lines =case_file.readlines() + case_file.close() + for case in lines: + if '#' not in case: + print("running "+case.rstrip()) + this_case = ExtDataCase(case,comm_opts) + logfile=case.rstrip()+".log" + log = open(logfile,'w') + success = this_case.run(log) + log.close() + if success: + print(case.rstrip()+" passed") + if comm_opts['save_log'].lower() == "false": + os.remove(logfile) + else: + print(case.rstrip()+" failed") + diff --git a/Tests/ExtData_Testing_Framekwork/test_script/utils.py b/Tests/ExtData_Testing_Framekwork/test_script/utils.py new file mode 100644 index 000000000000..f516aac1172e --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/test_script/utils.py @@ -0,0 +1,191 @@ +#!/usr/bin/env python + +""" +# ------------------------------------------------------------------------------ +# collection of useful functions: +# +# writemsg +# get_hostname +# source_g5_modules +# ------------------------------------------------------------------------------ +""" + + +import os +import sys +import glob +import time +import shutil +import errno +import fnmatch +import subprocess as sp +import filecmp +import shlex +import distutils.spawn +import subprocess +import re + +def writemsg(str2write, fout=None, quiet=None): + """ + # -------------------------------------------------------------------------- + # write message to fout + # + # Inputs: + # str2write: (obvious) + # fout: handle of (open) output file, if None, set to sys.stdout + # -------------------------------------------------------------------------- + """ + if not fout: fout = sys.stdout + if not quiet: fout.write('%s' % str2write); fout.flush() + + + +def get_hostname(): + """ + # -------------------------------------------------------------------------- + # Return the hostname (DISCOVER, PLEIADES) + # -------------------------------------------------------------------------- + """ + + node = os.uname()[1] + if node[0:8]=='discover' or node[0:4]=='borg': + HOST = 'DISCOVER' + elif node[0:3]=='pfe' or node[0:4]=='maia' or (node[0]=='r' and node[4]=='i'): + HOST = 'PLEIADES' + elif node[-13:]=='gsfc.nasa.gov' or (node[:6]=='gs6101' + and (node[-12:]=='ndc.nasa.gov') or node[-5:]=='local'): + HOST = 'DESKTOP' + # MAT Note that the DESKTOP is a "failover" if it is gsfc + # we return DESKTOP if it matches nothing else + else: + HOST = 'DESKTOP' + #raise Exception('could not get host name from node [%s]' % node) + + return HOST + +def source_g5_modules(g5_modules, fout=None): + """ + #--------------------------------------------------------------------------- + # def source_g5_modules(g5_modules, fout): + # + # source_g5_modules is a wrapper for the csh script g5_modules. It + # queries the csh script for basedir, modules and modinit, adds basedir + # to os.environ and loads library modules + # + # Input: + # g5_modules: full path of g5_modules + # fout: handle of (open) log file, if None - set to sys.stdout + #--------------------------------------------------------------------------- + """ + + if not fout: fout = sys.stdout + + # check if g5_modules exists + # -------------------------- + if not os.path.isfile(g5_modules): + raise Exception('g5_modules does not exist') + + + # part of the command to run + # -------------------------- + cmd = ['/bin/csh', g5_modules] + + # query for basedir + # ----------------- + run = sp.Popen(cmd+['basedir'], stdout=sp.PIPE, stderr=sp.PIPE) + output = run.communicate() + rtrnCode = run.wait() + if rtrnCode != 0: + print('0:'); print(output[0]); print('1:'); print(output[1]) + raise Exception('cant query g5_modules for basedir') + #BASEDIR = output[0].strip() + BASEDIR = output[0].split('\n')[0].strip() + + + # query for modules to load + # ------------------------- + run = sp.Popen(cmd+['modules'], stdout=sp.PIPE, stderr=sp.PIPE) + output = run.communicate() + rtrnCode = run.wait() + if rtrnCode != 0: + print('0:'); print(output[0]); print('1:'); print(output[1]) + raise Exception('cant query g5_modules for modules') + #MODULES = output[0].strip().split() + MODULES = output[0].split('\n')[0].strip().split() + + #print("MATMAT MODULES: ", MODULES) + + + # query for modinit + # ----------------- + run = sp.Popen(cmd+['modinit'], stdout=sp.PIPE, stderr=sp.PIPE) + output = run.communicate() + rtrnCode = run.wait() + if rtrnCode != 0: + print('0:'); print(output[0]); print('1:'); print(output[1]) + raise Exception('cant query g5_modules for modinit') + # MODINIT = output[0].strip().replace('csh', 'python') + # For Matt, modinit query results in '/usr/share/modules/init/csh\n/usr/..' + tmpdir = output[0].split('\n')[0].strip() + newdir = tmpdir.split('/') + HOST = get_hostname() + # MAT On anvil, at least, the modules has python.py + if HOST=='PLEIADES' or HOST=='DESKTOP': + newdir[-1] = 'python.py' + else: + newdir[-1] = 'python' + MODINIT = '/'.join(newdir) + + # set BASEDIR + # ----------- + ARCH = os.uname()[0] + writemsg(' %s: Setting BASEDIR' % os.path.basename(g5_modules), fout) + os.environ['BASEDIR'] = BASEDIR # this only modifies the local environment + BASELIB = '%s/%s/lib' % (BASEDIR, ARCH) + if 'LD_LIBRARY_PATH' in os.environ: + os.environ['LD_LIBRARY_PATH'] += os.pathsep + BASELIB + else: + os.environ['LD_LIBRARY_PATH'] = BASELIB + + + # load library modules + # -------------------- + if (os.path.isfile(MODINIT)): + writemsg(' and modules.\n', fout) + + exec(open(MODINIT).read()) + module('purge') + for mod in MODULES: + module('load',mod) + + # At NAS something weird is happening with python + # if you force it to load this at the end, things work + #if HOST=='PLEIADES': + #module('load','python/2.7.15') + #module('list') + elif os.environ.get('LMOD_PKG') is not None: + writemsg(' and modules.\n', fout) + + sys.path.insert(0,os.path.join(os.environ['LMOD_PKG'], "init")) + from env_modules_python import module + + module('purge') + for mod in MODULES: + module('load',mod) + + else: + raise Exception('could not load required modules') + + # set ESMA_FC to gfortran, if needed + # ---------------------------------- + if BASEDIR.split(os.sep)[-1].split('_')[0]=='gfortran': + writemsg(' Setting ESMA_FC to gfortran\n', fout) + os.environ['ESMA_FC'] = 'gfortran' + + # set ESMA_FC to pgfortran, if needed + # ----------------------------------- + if BASEDIR.split(os.sep)[-1].split('_')[0]=='pgfortran': + writemsg(' Setting ESMA_FC to pgfortran\n', fout) + os.environ['ESMA_FC'] = 'pgfortran' + os.environ['PGI_LOCALRC'] = '/discover/swdev/mathomp4/PGILocalRC/linux86-64/17.10/bin/localrc.60300' + writemsg(' Setting PGI_LOCALRC to %s\n' % os.environ['PGI_LOCALRC'], fout) From b2ec7e2f456dd0d6520f428de229a93b5a958771 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 10 Jun 2022 14:20:35 -0400 Subject: [PATCH 147/300] remove accidental .gitignore commit --- Tests/ExtData_Testing_Framekwork/test_script/.gitignore | 1 - 1 file changed, 1 deletion(-) delete mode 100644 Tests/ExtData_Testing_Framekwork/test_script/.gitignore diff --git a/Tests/ExtData_Testing_Framekwork/test_script/.gitignore b/Tests/ExtData_Testing_Framekwork/test_script/.gitignore deleted file mode 100644 index aee1c277000c..000000000000 --- a/Tests/ExtData_Testing_Framekwork/test_script/.gitignore +++ /dev/null @@ -1 +0,0 @@ -/run_dir*/ From f11427336539e36ff6506a08b4f13179f220dac0 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 13 Jun 2022 10:35:38 -0400 Subject: [PATCH 148/300] fixed bundle io tests --- CHANGELOG.md | 1 + base/tests/CMakeLists.txt | 4 ++-- base/tests/mapl_bundleio_test.F90 | 3 ++- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index bde3067f9929..0a0a4489f9c0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -19,6 +19,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Enable GCM run test in CircleCI (1-hour, no ExtData) - Added monotonic regridding option - Make availalbe to History and ExtData2G all supported regridding methods +- Fix bundleio tests ### Changed diff --git a/base/tests/CMakeLists.txt b/base/tests/CMakeLists.txt index 9e300e6d8357..83ac2cf7e2eb 100644 --- a/base/tests/CMakeLists.txt +++ b/base/tests/CMakeLists.txt @@ -53,10 +53,10 @@ ecbuild_add_executable ( set_target_properties(${TESTIO} PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) add_test(NAME bundleio_tests_latlon - COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} 2 ${MPIEXEC_PREFLAGS} ${CMAKE_CURRENT_BINARY_DIR}/${TESTIO} -nx 2 -ny 1 -ogrid PC90x47-DE) + COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} 2 ${MPIEXEC_PREFLAGS} ${CMAKE_CURRENT_BINARY_DIR}/${TESTIO} -nx 2 -ny 1 -ogrid PC90x47-DE -o file1_ll.nc4) add_test(NAME bundleio_tests_cube - COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} 6 ${MPIEXEC_PREFLAGS} ${CMAKE_CURRENT_BINARY_DIR}/${TESTIO} -nx 1 -ny 6 -ogrid PE12x72-CF) + COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} 6 ${MPIEXEC_PREFLAGS} ${CMAKE_CURRENT_BINARY_DIR}/${TESTIO} -nx 1 -ny 6 -ogrid PE12x72-CF -o file_cs.nc4) add_dependencies(build-tests ${TESTIO}) diff --git a/base/tests/mapl_bundleio_test.F90 b/base/tests/mapl_bundleio_test.F90 index 771cc49f38d7..87e9e6c5c9de 100644 --- a/base/tests/mapl_bundleio_test.F90 +++ b/base/tests/mapl_bundleio_test.F90 @@ -97,6 +97,8 @@ subroutine main() case('-ny') call get_command_argument(i+1,astr) read(astr,*)ny + case('-o') + call get_command_argument(i+1,filename) end select enddo @@ -157,7 +159,6 @@ subroutine main() call MAPL_FieldBundleAdd(bundle,field,__RC__) - filename="temp_file.nc4" call newWriter%create_from_bundle(bundle,clock,filename,rc=status) _VERIFY(status) call newWriter%write_to_file(rc=status) From e3d575cfd9a2ea7649ac73c5734d502aa5d5c48e Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 13 Jun 2022 12:10:06 -0400 Subject: [PATCH 149/300] Enable bundleio tests in CI --- .circleci/config.yml | 4 ++-- .github/workflows/workflow.yml | 4 ++-- CHANGELOG.md | 3 ++- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 29f05869612d..940a91d38451 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -18,7 +18,7 @@ workflows: repo: MAPL mepodevelop: false run_unit_tests: true - ctest_options: "-R MAPL -LE PERFORMANCE --output-on-failure" + ctest_options: "-LE PERFORMANCE --output-on-failure" # Builds MAPL like UFS does (no FLAP and pFlogger, static) - ci/build: @@ -32,7 +32,7 @@ workflows: mepodevelop: false extra_cmake_options: "-DBUILD_WITH_FLAP=OFF -DBUILD_WITH_PFLOGGER=OFF -DBUILD_SHARED_MAPL=OFF" run_unit_tests: true - ctest_options: "-R MAPL -LE PERFORMANCE --output-on-failure" + ctest_options: "-LE PERFORMANCE --output-on-failure" # Build GEOSgcm - ci/build: diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 05fa5f62f17a..6d26a5911357 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -61,7 +61,7 @@ jobs: cd build make -j4 build-tests # skip performance tests - ctest -R MAPL -LE PERFORMANCE --output-on-failure + ctest -LE PERFORMANCE --output-on-failure build_test_mapl_intel: name: Build and Test MAPL Intel runs-on: ubuntu-latest @@ -106,4 +106,4 @@ jobs: cd build make -j4 build-tests # skip performance tests - ctest -R MAPL -LE PERFORMANCE --output-on-failure + ctest -LE PERFORMANCE --output-on-failure diff --git a/CHANGELOG.md b/CHANGELOG.md index 0a0a4489f9c0..9864344ee9fd 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed - Update CI to work with latest GEOSadas `develop` (Uses a special branch of GEOSadas) +- Fix bundleio tests ### Added @@ -19,7 +20,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Enable GCM run test in CircleCI (1-hour, no ExtData) - Added monotonic regridding option - Make availalbe to History and ExtData2G all supported regridding methods -- Fix bundleio tests ### Changed @@ -27,6 +27,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Updated the ESMA_cmake version to v3.16.0 - Updated GitHub Actions MAPL build tests - Added assert for missing file with ExtData2G +- Re-enable bundleio tests in CI ### Removed From 3abec6d10c89cfe6d4235567007cde3096c0d249 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 13 Jun 2022 12:53:12 -0400 Subject: [PATCH 150/300] Disable bundleio with Open MPI --- .circleci/config.yml | 27 +++++++++++++++++++++++++-- .github/workflows/workflow.yml | 10 +++++++++- 2 files changed, 34 insertions(+), 3 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 940a91d38451..90c5f95229ff 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -7,19 +7,42 @@ workflows: build-and-test: jobs: - # Builds MAPL in a "default" way + # Builds MAPL in a "default" way - Intel - ci/build: name: build-and-test-MAPL-on-<< matrix.compiler >> context: - docker-hub-creds matrix: parameters: - compiler: [gfortran, ifort] + compiler: [ifort] repo: MAPL mepodevelop: false run_unit_tests: true ctest_options: "-LE PERFORMANCE --output-on-failure" + # Builds MAPL in a "default" way - GNU + # + # NOTE: Currently Open MPI fails on the bundleio with: + # + # The OSC pt2pt component does not support MPI_THREAD_MULTIPLE in this release. + # Workarounds are to run on a single node, or to use a system with an RDMA + # capable network such as Infiniband. + # + # For now, we run GNU/Open MPI without the bundleio tests. Some indications that + # Open MPI 5 will not have this limitation + + - ci/build: + name: build-and-test-MAPL-on-<< matrix.compiler >> + context: + - docker-hub-creds + matrix: + parameters: + compiler: [gfortran] + repo: MAPL + mepodevelop: false + run_unit_tests: true + ctest_options: "-E bundleio -LE PERFORMANCE --output-on-failure" + # Builds MAPL like UFS does (no FLAP and pFlogger, static) - ci/build: name: build-UFS-MAPL-on-<< matrix.compiler >> diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 6d26a5911357..6b393d5260a3 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -61,7 +61,15 @@ jobs: cd build make -j4 build-tests # skip performance tests - ctest -LE PERFORMANCE --output-on-failure + # NOTE: Currently Open MPI fails on the bundleio with: + # + # The OSC pt2pt component does not support MPI_THREAD_MULTIPLE in this release. + # Workarounds are to run on a single node, or to use a system with an RDMA + # capable network such as Infiniband. + # + # For now, we run GNU/Open MPI without the bundleio tests. Some indications that + # Open MPI 5 will not have this limitation + ctest -E bundleio -LE PERFORMANCE --output-on-failure build_test_mapl_intel: name: Build and Test MAPL Intel runs-on: ubuntu-latest From 7ce5207959117c68c7f137ce23f43de55c3cc2dc Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 13 Jun 2022 16:20:47 -0400 Subject: [PATCH 151/300] fixes #1565 --- CHANGELOG.md | 1 + gridcomps/History/MAPL_HistoryGridComp.F90 | 6 +++++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9864344ee9fd..3da56956c14a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Update CI to work with latest GEOSadas `develop` (Uses a special branch of GEOSadas) - Fix bundleio tests +- HistoryGridComp now checks if a file exists already before writing and errors out if so ### Added diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 2076ddb621e0..a9cf19c1f9b6 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -3365,7 +3365,7 @@ subroutine Run ( gc, import, export, clock, rc ) integer :: sec ! variables for "backwards" mode - logical :: fwd + logical :: fwd, file_exists logical, allocatable :: Ignore(:) ! ErrLog vars @@ -3605,6 +3605,10 @@ subroutine Run ( gc, import, export, clock, rc ) list(n)%currentFile = filename(n) else if( list(n)%unit.eq.0 ) then + inquire (file=trim(filename(n)),exist=file_exists) + if (file_exists) then + _FAIL(trim(filename(n))//" being created for History output already exists") + end if if (list(n)%format == 'CFIO') then call list(n)%mGriddedIO%modifyTime(oClients=o_Clients,rc=status) _VERIFY(status) From f1e80eb088c9c66b809c4d9d3d6e1284670db8b8 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 14 Jun 2022 08:17:04 -0400 Subject: [PATCH 152/300] Need to stick to esmf alias for upstream reasons --- CHANGELOG.md | 3 +-- CMakeLists.txt | 4 ++-- MAPL/CMakeLists.txt | 2 +- MAPL_cfio/CMakeLists.txt | 2 +- Tests/CMakeLists.txt | 4 ++-- base/CMakeLists.txt | 4 ++-- base/tests/CMakeLists.txt | 2 +- generic/CMakeLists.txt | 2 +- gridcomps/Cap/CMakeLists.txt | 2 +- gridcomps/ExtData/CMakeLists.txt | 2 +- gridcomps/ExtData2G/CMakeLists.txt | 2 +- gridcomps/History/CMakeLists.txt | 2 +- gridcomps/Orbit/CMakeLists.txt | 2 +- griddedio/CMakeLists.txt | 4 ++-- pfunit/CMakeLists.txt | 2 +- 15 files changed, 19 insertions(+), 20 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 228b84d652a7..d3d82e85db20 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -31,9 +31,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Re-enable bundleio tests in CI - Updates for Spack support - Add `find_package(MPI)` for non-Baselibs builds - - Update all `esmf` target references in CMake to `ESMF` - - Add `esmf` alias library for `ESMF` for compatibility - Add explicit interface dependence of `MPI` for `ESMF` target + - Add `esmf` alias library for `ESMF` for compatibility ### Removed diff --git a/CMakeLists.txt b/CMakeLists.txt index 80ac13de4420..52280cbd9693 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -125,13 +125,13 @@ if (NOT Baselibs_FOUND) add_definitions(-DH5_HAVE_PARALLEL) endif() - if (NOT TARGET ESMF) + if (NOT TARGET esmf) find_package(ESMF MODULE REQUIRED) # ESMF as used in MAPL requires MPI target_link_libraries(ESMF INTERFACE MPI::MPI_Fortran) - # MAPL and GEOS used lowercase target due to historical reasons + # MAPL and GEOS use lowercase target due to historical reasons add_library(esmf ALIAS ESMF) endif () endif () diff --git a/MAPL/CMakeLists.txt b/MAPL/CMakeLists.txt index fe702cf53de5..f49b1d486a46 100644 --- a/MAPL/CMakeLists.txt +++ b/MAPL/CMakeLists.txt @@ -4,7 +4,7 @@ esma_set_this() esma_add_library (${this} SRCS MAPL.F90 DEPENDENCIES MAPL.base MAPL.generic MAPL.pfio MAPL_cfio_r4 MAPL.gridcomps MAPL.orbit MAPL.griddedio ${EXTDATA_TARGET} - ESMF NetCDF::NetCDF_Fortran MPI::MPI_Fortran + esmf NetCDF::NetCDF_Fortran MPI::MPI_Fortran $<$:FLAP::FLAP> TYPE ${MAPL_LIBRARY_TYPE} ) diff --git a/MAPL_cfio/CMakeLists.txt b/MAPL_cfio/CMakeLists.txt index e87b583bcd0b..e6cfd498a7f0 100644 --- a/MAPL_cfio/CMakeLists.txt +++ b/MAPL_cfio/CMakeLists.txt @@ -44,7 +44,7 @@ endif () esma_add_library (${lib} SRCS ${srcs} - DEPENDENCIES ESMF NetCDF::NetCDF_Fortran + DEPENDENCIES esmf NetCDF::NetCDF_Fortran TYPE ${LIBRARY_TYPE} ) diff --git a/Tests/CMakeLists.txt b/Tests/CMakeLists.txt index eb37b886b41d..bba1dbb97aa7 100644 --- a/Tests/CMakeLists.txt +++ b/Tests/CMakeLists.txt @@ -11,7 +11,7 @@ set (srcs if (BUILD_WITH_FLAP) ecbuild_add_executable (TARGET ExtDataDriver.x SOURCES ${srcs}) - target_link_libraries (ExtDataDriver.x PRIVATE MAPL FLAP::FLAP ESMF) + target_link_libraries (ExtDataDriver.x PRIVATE MAPL FLAP::FLAP esmf) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") target_link_libraries(ExtDataDriver.x PRIVATE OpenMP::OpenMP_Fortran) @@ -20,7 +20,7 @@ if (BUILD_WITH_FLAP) target_compile_definitions (ExtDataDriver.x PRIVATE $<$:BUILD_WITH_EXTDATA2G>) ecbuild_add_executable (TARGET pfio_MAPL_demo.x SOURCES pfio_MAPL_demo.F90) - target_link_libraries (pfio_MAPL_demo.x PRIVATE MAPL FLAP::FLAP ESMF) + target_link_libraries (pfio_MAPL_demo.x PRIVATE MAPL FLAP::FLAP esmf) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") target_link_libraries(pfio_MAPL_demo.x PRIVATE OpenMP::OpenMP_Fortran) diff --git a/base/CMakeLists.txt b/base/CMakeLists.txt index b17ff89b4309..26ca0b229332 100644 --- a/base/CMakeLists.txt +++ b/base/CMakeLists.txt @@ -59,7 +59,7 @@ set (srcs esma_add_library( ${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.profiler MAPL.pfio MAPL_cfio_r4 PFLOGGER::pflogger GFTL_SHARED::gftl-shared - ESMF NetCDF::NetCDF_Fortran MPI::MPI_Fortran + esmf NetCDF::NetCDF_Fortran MPI::MPI_Fortran TYPE ${MAPL_LIBRARY_TYPE}) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 @@ -80,7 +80,7 @@ foreach(dir ${OSX_EXTRA_LIBRARY_PATH}) target_link_libraries(${this} PUBLIC "-Xlinker -rpath -Xlinker ${dir}") endforeach() -ecbuild_add_executable (TARGET cub2latlon.x SOURCES cub2latlon_regridder.F90 DEPENDS ESMF MAPL.shared) +ecbuild_add_executable (TARGET cub2latlon.x SOURCES cub2latlon_regridder.F90 DEPENDS esmf MAPL.shared) target_link_libraries (cub2latlon.x PRIVATE ${this} MAPL.pfio ${MPI_Fortran_LIBRARIES}) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") diff --git a/base/tests/CMakeLists.txt b/base/tests/CMakeLists.txt index a508783cb876..83ac2cf7e2eb 100644 --- a/base/tests/CMakeLists.txt +++ b/base/tests/CMakeLists.txt @@ -28,7 +28,7 @@ set (SRCS # MAPL_Initialize.F90 # ) #target_link_libraries (base_extras MAPL.shared MAPL.pfunit -# ESMF NetCDF::NetCDF_Fortran) +# esmf NetCDF::NetCDF_Fortran) add_pfunit_ctest(MAPL.base.tests TEST_SOURCES ${TEST_SRCS} diff --git a/generic/CMakeLists.txt b/generic/CMakeLists.txt index 9172d70ddaaa..643fc9bcf985 100644 --- a/generic/CMakeLists.txt +++ b/generic/CMakeLists.txt @@ -61,7 +61,7 @@ esma_add_library(${this} ) target_include_directories (${this} PUBLIC $) -target_link_libraries (${this} PUBLIC ESMF NetCDF::NetCDF_Fortran) +target_link_libraries (${this} PUBLIC esmf NetCDF::NetCDF_Fortran) if (PFUNIT_FOUND) add_subdirectory(tests EXCLUDE_FROM_ALL) diff --git a/gridcomps/Cap/CMakeLists.txt b/gridcomps/Cap/CMakeLists.txt index 3126ee2795ad..07a2fe92b3cb 100644 --- a/gridcomps/Cap/CMakeLists.txt +++ b/gridcomps/Cap/CMakeLists.txt @@ -13,7 +13,7 @@ endif() esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.profiler MAPL.history MAPL.ExtData ${EXTDATA2G_TARGET} TYPE ${MAPL_LIBRARY_TYPE}) -target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF NetCDF::NetCDF_Fortran +target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran $<$:FLAP::FLAP>) target_compile_definitions (${this} PRIVATE $<$:BUILD_WITH_EXTDATA2G>) diff --git a/gridcomps/ExtData/CMakeLists.txt b/gridcomps/ExtData/CMakeLists.txt index 38922c95fd39..dbc7e032cc6d 100644 --- a/gridcomps/ExtData/CMakeLists.txt +++ b/gridcomps/ExtData/CMakeLists.txt @@ -8,7 +8,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.generic MAPL.pfio MAPL.griddedio MAPL_cfio_r4 TYPE ${MAPL_LIBRARY_TYPE}) -target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF NetCDF::NetCDF_Fortran +target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 diff --git a/gridcomps/ExtData2G/CMakeLists.txt b/gridcomps/ExtData2G/CMakeLists.txt index 2d13a2a2463d..ee599479ac02 100644 --- a/gridcomps/ExtData2G/CMakeLists.txt +++ b/gridcomps/ExtData2G/CMakeLists.txt @@ -26,7 +26,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.base MAPL.generic MAPL.griddedio TYPE SHARED) -target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared YAFYAML::yafyaml ESMF NetCDF::NetCDF_Fortran +target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared YAFYAML::yafyaml esmf NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran) target_include_directories (${this} PUBLIC $) diff --git a/gridcomps/History/CMakeLists.txt b/gridcomps/History/CMakeLists.txt index ab015df5ede2..0973f096f2dc 100644 --- a/gridcomps/History/CMakeLists.txt +++ b/gridcomps/History/CMakeLists.txt @@ -8,7 +8,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.generic MAPL.profiler MAPL.griddedio TYPE ${MAPL_LIBRARY_TYPE}) -target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF NetCDF::NetCDF_Fortran +target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 diff --git a/gridcomps/Orbit/CMakeLists.txt b/gridcomps/Orbit/CMakeLists.txt index 41d34c979837..b33c4f37778b 100644 --- a/gridcomps/Orbit/CMakeLists.txt +++ b/gridcomps/Orbit/CMakeLists.txt @@ -5,7 +5,7 @@ set (srcs ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.generic TYPE ${MAPL_LIBRARY_TYPE}) -target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF NetCDF::NetCDF_Fortran +target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 diff --git a/griddedio/CMakeLists.txt b/griddedio/CMakeLists.txt index 862d98bd3bd5..44fd7a6e8336 100644 --- a/griddedio/CMakeLists.txt +++ b/griddedio/CMakeLists.txt @@ -11,7 +11,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.constants MAPL.base MAPL.pfio MAPL_cfio_r4 TYPE ${MAPL_LIBRARY_TYPE}) -target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared ESMF NetCDF::NetCDF_Fortran +target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared esmf NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 @@ -22,7 +22,7 @@ target_include_directories (${this} PUBLIC $ Date: Tue, 14 Jun 2022 08:42:52 -0400 Subject: [PATCH 153/300] Update comments --- CMakeLists.txt | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 52280cbd9693..8804ee877955 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -131,7 +131,8 @@ if (NOT Baselibs_FOUND) # ESMF as used in MAPL requires MPI target_link_libraries(ESMF INTERFACE MPI::MPI_Fortran) - # MAPL and GEOS use lowercase target due to historical reasons + # MAPL and GEOS use lowercase target due to historical reasons but + # the latest FindESMF.cmake file from ESMF produces an ESMF target. add_library(esmf ALIAS ESMF) endif () endif () From 9d2a685fd94abd352faf6c52af766c63ca8cb17e Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 14 Jun 2022 13:32:59 -0400 Subject: [PATCH 154/300] get testing framework working --- Tests/CMakeLists.txt | 1 + .../ExtData_Testing_Framekwork/CMakeLists.txt | 25 +++ .../run_extdata1g.cmake | 25 +++ .../run_extdata2g.cmake | 27 +++ .../test_cases/case21/ExtData.rc | 5 +- .../test_script/run_case.py | 64 ------ .../test_script/run_extdatadriver_cases.py | 56 ----- .../test_script/utils.py | 191 ------------------ 8 files changed, 81 insertions(+), 313 deletions(-) create mode 100644 Tests/ExtData_Testing_Framekwork/CMakeLists.txt create mode 100644 Tests/ExtData_Testing_Framekwork/run_extdata1g.cmake create mode 100644 Tests/ExtData_Testing_Framekwork/run_extdata2g.cmake delete mode 100755 Tests/ExtData_Testing_Framekwork/test_script/run_case.py delete mode 100755 Tests/ExtData_Testing_Framekwork/test_script/run_extdatadriver_cases.py delete mode 100644 Tests/ExtData_Testing_Framekwork/test_script/utils.py diff --git a/Tests/CMakeLists.txt b/Tests/CMakeLists.txt index bba1dbb97aa7..aa469a39b433 100644 --- a/Tests/CMakeLists.txt +++ b/Tests/CMakeLists.txt @@ -32,3 +32,4 @@ endif () #install(PROGRAMS ExtDataDriver.x DESTINATION bin) #install(TARGETS ExtDataDriver.x DESTINATION bin) +add_subdirectory(ExtData_Testing_Framekwork EXCLUDE_FROM_ALL) diff --git a/Tests/ExtData_Testing_Framekwork/CMakeLists.txt b/Tests/ExtData_Testing_Framekwork/CMakeLists.txt new file mode 100644 index 000000000000..7e482e01eba6 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/CMakeLists.txt @@ -0,0 +1,25 @@ +file(STRINGS "test_cases/cases.txt" TEST_CASES) + +foreach(TEST_CASE ${TEST_CASES}) +add_test( + NAME "ExtData1G_${TEST_CASE}" + COMMAND ${CMAKE_COMMAND} + -DTEST_CASE=${TEST_CASE} + -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} + -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} + -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin + -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata1g.cmake + ) +endforeach() + +foreach(TEST_CASE ${TEST_CASES}) +add_test( + NAME "ExtData2G_${TEST_CASE}" + COMMAND ${CMAKE_COMMAND} + -DTEST_CASE=${TEST_CASE} + -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} + -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} + -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin + -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata2g.cmake + ) +endforeach() diff --git a/Tests/ExtData_Testing_Framekwork/run_extdata1g.cmake b/Tests/ExtData_Testing_Framekwork/run_extdata1g.cmake new file mode 100644 index 000000000000..202d0aae191e --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/run_extdata1g.cmake @@ -0,0 +1,25 @@ +macro(run_case CASE) + string(RANDOM LENGTH 24 tempdir) + execute_process( + COMMAND ${CMAKE_COMMAND} -E make_directory ${tempdir} + COMMAND ${CMAKE_COMMAND} -E copy_directory ${CMAKE_CURRENT_LIST_DIR}/test_cases/${CASE} ${tempdir} + ) + if (EXISTS "${tempdir}/nproc.rc") + file(READ "${tempdir}/nproc.rc" num_procs) + else() + set(num_procs "1") + endif() + execute_process( + COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} ${num_procs} ${MY_BINARY_DIR}/ExtDataDriver.x + RESULT_VARIABLE CMD_RESULT + WORKING_DIRECTORY ${tempdir} + #COMMAND_ECHO STDOUT + ) + execute_process( + COMMAND ${CMAKE_COMMAND} -E rm -rf ${tempdir} + ) + if(CMD_RESULT) + message(FATAL_ERROR "Error running ${CASE}") + endif() +endmacro() +run_case(${TEST_CASE}) diff --git a/Tests/ExtData_Testing_Framekwork/run_extdata2g.cmake b/Tests/ExtData_Testing_Framekwork/run_extdata2g.cmake new file mode 100644 index 000000000000..158ad09e1285 --- /dev/null +++ b/Tests/ExtData_Testing_Framekwork/run_extdata2g.cmake @@ -0,0 +1,27 @@ +macro(run_case CASE) + string(RANDOM LENGTH 24 tempdir) + execute_process( + COMMAND ${CMAKE_COMMAND} -E make_directory ${tempdir} + COMMAND ${CMAKE_COMMAND} -E copy_directory ${CMAKE_CURRENT_LIST_DIR}/test_cases/${CASE} ${tempdir} + ) + if (EXISTS "${tempdir}/nproc.rc") + file(READ "${tempdir}/nproc.rc" num_procs) + else() + set(num_procs "1") + endif() + file(APPEND "${tempdir}/CAP1.rc" "USE_EXTDATA2G: .true.") + file(APPEND "${tempdir}/CAP2.rc" "USE_EXTDATA2G: .true.") + execute_process( + COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} ${num_procs} ${MY_BINARY_DIR}/ExtDataDriver.x + RESULT_VARIABLE CMD_RESULT + WORKING_DIRECTORY ${tempdir} + #COMMAND_ECHO STDOUT + ) + execute_process( + COMMAND ${CMAKE_COMMAND} -E rm -rf ${tempdir} + ) + if(CMD_RESULT) + message(FATAL_ERROR "Error running ${CASE}") + endif() +endmacro() +run_case(${TEST_CASE}) diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/ExtData.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case21/ExtData.rc index a45d1dd13f7f..57736ed30bef 100644 --- a/Tests/ExtData_Testing_Framekwork/test_cases/case21/ExtData.rc +++ b/Tests/ExtData_Testing_Framekwork/test_cases/case21/ExtData.rc @@ -4,10 +4,11 @@ Prefetch: .true. #DEBUG_LEVEL: 20 PrimaryExports%% -VAR2D NA N N 0 none none VAR2D case1.%y4.nc4 -VAR3D NA N N 0 none none VAR3D case1.%y4.nc4 +VAR1 NA N N 0 none none VAR1 case1.%y4.nc4 +VAR2 NA N N 0 none none VAR2 case1.%y4.nc4 %% DerivedExports%% +VAR2D VAR1+VAR2 0 %% diff --git a/Tests/ExtData_Testing_Framekwork/test_script/run_case.py b/Tests/ExtData_Testing_Framekwork/test_script/run_case.py deleted file mode 100755 index 129bc9a9bb61..000000000000 --- a/Tests/ExtData_Testing_Framekwork/test_script/run_case.py +++ /dev/null @@ -1,64 +0,0 @@ -#!/usr/bin/env python - -import argparse, sys, os -import subprocess as sp -import glob -import shutil -import utils - -class ExtDataCase(): - """ - """ - - def __init__(self, case_name, comm_line_args): - - self.build_dir = comm_line_args['build_dir'] - self.case_dir = comm_line_args['case_dir'] - self.case_name = case_name - self.case_path = self.case_dir+"/"+self.case_name.rstrip() - - def run(self,logfile): - - scrdir="ExtData_scratch" - orig_dir = os.getcwd() - if os.path.isdir(scrdir): - shutil.rmtree(scrdir) - os.mkdir(scrdir) - rc_files = glob.glob(self.case_path+"/*.rc") - for rc_file in rc_files: - shutil.copy(rc_file,scrdir) - yaml_files = glob.glob(self.case_path+"/*.yaml") - for yaml_file in yaml_files: - shutil.copy(yaml_file,scrdir) - os.chdir(scrdir) - - g5_mod_path = self.build_dir+"/g5_modules" - utils.source_g5_modules(g5_mod_path) - success = os.path.isfile('nproc.rc') - if success: - fproc = open('nproc.rc',"r") - nproc = fproc.readline() - nproc = nproc.rstrip() - fproc.close() - else: - nproc = "1" - - exec_path = "cat CAP1.rc " + self.case_dir+"/use_extdata2g.rc > temp.rc ;mv temp.rc CAP1.rc" - sp.call(exec_path,stdout=logfile,stderr=logfile,shell=True) - exec_path = "cat CAP2.rc " + self.case_dir+"/use_extdata2g.rc > temp.rc; mv temp.rc CAP2.rc" - sp.call(exec_path,stdout=logfile,stderr=logfile,shell=True) - - exec_path = "mpirun -np "+nproc+" "+self.build_dir+"/ExtDataDriver.x " - sp.call(exec_path,stdout=logfile,stderr=logfile,shell=True) - sp.call("~/bin/Killall ExtDataDriver.x",stdout=logfile,stderr=logfile,shell=True) - - print("finished exec of "+self.case_name.rstrip()) - success = os.path.isfile('egress') - os.chdir(orig_dir) - shutil.rmtree(scrdir) -# - if success: - return True - else: - return False - diff --git a/Tests/ExtData_Testing_Framekwork/test_script/run_extdatadriver_cases.py b/Tests/ExtData_Testing_Framekwork/test_script/run_extdatadriver_cases.py deleted file mode 100755 index 6e3fc6f4fb58..000000000000 --- a/Tests/ExtData_Testing_Framekwork/test_script/run_extdatadriver_cases.py +++ /dev/null @@ -1,56 +0,0 @@ -#!/usr/bin/env python - -import argparse, sys, os -import subprocess as sp -from run_case import ExtDataCase - -def parse_comm_args(): - - p = argparse.ArgumentParser(description='Run ExtData tester script') - - # BAS_HOM_DIR, CUR_HOM_DIR, DIFF - # ------------------------------ - p.add_argument("--builddir", dest="build_dir",help='src directory for build') - p.add_argument("--casedir", dest="case_dir",help='where cases are located') - p.add_argument("--cases", dest="cases",help='list of cases') - p.add_argument("--savelog",dest="save_log",default="false",help='save the log files for all') - - - args = vars(p.parse_args()) # vars converts to dict - - # some checks on inputs - # --------------------- - if not os.path.isdir(args['build_dir']): - raise Exception('build_dir [%s] does not exist' % args['bas']) - if not os.path.isdir(args['case_dir']): - raise Exception('case_dir [%s] does not exist' % args['bas']) - - # return opts - # ----------- - return args - - -if __name__ == "__main__": - - comm_opts = parse_comm_args() - build_dir = comm_opts['build_dir'] - case_dir = comm_opts['case_dir'] - case_path = comm_opts['cases'] - case_file = open(case_path,'r') - lines =case_file.readlines() - case_file.close() - for case in lines: - if '#' not in case: - print("running "+case.rstrip()) - this_case = ExtDataCase(case,comm_opts) - logfile=case.rstrip()+".log" - log = open(logfile,'w') - success = this_case.run(log) - log.close() - if success: - print(case.rstrip()+" passed") - if comm_opts['save_log'].lower() == "false": - os.remove(logfile) - else: - print(case.rstrip()+" failed") - diff --git a/Tests/ExtData_Testing_Framekwork/test_script/utils.py b/Tests/ExtData_Testing_Framekwork/test_script/utils.py deleted file mode 100644 index f516aac1172e..000000000000 --- a/Tests/ExtData_Testing_Framekwork/test_script/utils.py +++ /dev/null @@ -1,191 +0,0 @@ -#!/usr/bin/env python - -""" -# ------------------------------------------------------------------------------ -# collection of useful functions: -# -# writemsg -# get_hostname -# source_g5_modules -# ------------------------------------------------------------------------------ -""" - - -import os -import sys -import glob -import time -import shutil -import errno -import fnmatch -import subprocess as sp -import filecmp -import shlex -import distutils.spawn -import subprocess -import re - -def writemsg(str2write, fout=None, quiet=None): - """ - # -------------------------------------------------------------------------- - # write message to fout - # - # Inputs: - # str2write: (obvious) - # fout: handle of (open) output file, if None, set to sys.stdout - # -------------------------------------------------------------------------- - """ - if not fout: fout = sys.stdout - if not quiet: fout.write('%s' % str2write); fout.flush() - - - -def get_hostname(): - """ - # -------------------------------------------------------------------------- - # Return the hostname (DISCOVER, PLEIADES) - # -------------------------------------------------------------------------- - """ - - node = os.uname()[1] - if node[0:8]=='discover' or node[0:4]=='borg': - HOST = 'DISCOVER' - elif node[0:3]=='pfe' or node[0:4]=='maia' or (node[0]=='r' and node[4]=='i'): - HOST = 'PLEIADES' - elif node[-13:]=='gsfc.nasa.gov' or (node[:6]=='gs6101' - and (node[-12:]=='ndc.nasa.gov') or node[-5:]=='local'): - HOST = 'DESKTOP' - # MAT Note that the DESKTOP is a "failover" if it is gsfc - # we return DESKTOP if it matches nothing else - else: - HOST = 'DESKTOP' - #raise Exception('could not get host name from node [%s]' % node) - - return HOST - -def source_g5_modules(g5_modules, fout=None): - """ - #--------------------------------------------------------------------------- - # def source_g5_modules(g5_modules, fout): - # - # source_g5_modules is a wrapper for the csh script g5_modules. It - # queries the csh script for basedir, modules and modinit, adds basedir - # to os.environ and loads library modules - # - # Input: - # g5_modules: full path of g5_modules - # fout: handle of (open) log file, if None - set to sys.stdout - #--------------------------------------------------------------------------- - """ - - if not fout: fout = sys.stdout - - # check if g5_modules exists - # -------------------------- - if not os.path.isfile(g5_modules): - raise Exception('g5_modules does not exist') - - - # part of the command to run - # -------------------------- - cmd = ['/bin/csh', g5_modules] - - # query for basedir - # ----------------- - run = sp.Popen(cmd+['basedir'], stdout=sp.PIPE, stderr=sp.PIPE) - output = run.communicate() - rtrnCode = run.wait() - if rtrnCode != 0: - print('0:'); print(output[0]); print('1:'); print(output[1]) - raise Exception('cant query g5_modules for basedir') - #BASEDIR = output[0].strip() - BASEDIR = output[0].split('\n')[0].strip() - - - # query for modules to load - # ------------------------- - run = sp.Popen(cmd+['modules'], stdout=sp.PIPE, stderr=sp.PIPE) - output = run.communicate() - rtrnCode = run.wait() - if rtrnCode != 0: - print('0:'); print(output[0]); print('1:'); print(output[1]) - raise Exception('cant query g5_modules for modules') - #MODULES = output[0].strip().split() - MODULES = output[0].split('\n')[0].strip().split() - - #print("MATMAT MODULES: ", MODULES) - - - # query for modinit - # ----------------- - run = sp.Popen(cmd+['modinit'], stdout=sp.PIPE, stderr=sp.PIPE) - output = run.communicate() - rtrnCode = run.wait() - if rtrnCode != 0: - print('0:'); print(output[0]); print('1:'); print(output[1]) - raise Exception('cant query g5_modules for modinit') - # MODINIT = output[0].strip().replace('csh', 'python') - # For Matt, modinit query results in '/usr/share/modules/init/csh\n/usr/..' - tmpdir = output[0].split('\n')[0].strip() - newdir = tmpdir.split('/') - HOST = get_hostname() - # MAT On anvil, at least, the modules has python.py - if HOST=='PLEIADES' or HOST=='DESKTOP': - newdir[-1] = 'python.py' - else: - newdir[-1] = 'python' - MODINIT = '/'.join(newdir) - - # set BASEDIR - # ----------- - ARCH = os.uname()[0] - writemsg(' %s: Setting BASEDIR' % os.path.basename(g5_modules), fout) - os.environ['BASEDIR'] = BASEDIR # this only modifies the local environment - BASELIB = '%s/%s/lib' % (BASEDIR, ARCH) - if 'LD_LIBRARY_PATH' in os.environ: - os.environ['LD_LIBRARY_PATH'] += os.pathsep + BASELIB - else: - os.environ['LD_LIBRARY_PATH'] = BASELIB - - - # load library modules - # -------------------- - if (os.path.isfile(MODINIT)): - writemsg(' and modules.\n', fout) - - exec(open(MODINIT).read()) - module('purge') - for mod in MODULES: - module('load',mod) - - # At NAS something weird is happening with python - # if you force it to load this at the end, things work - #if HOST=='PLEIADES': - #module('load','python/2.7.15') - #module('list') - elif os.environ.get('LMOD_PKG') is not None: - writemsg(' and modules.\n', fout) - - sys.path.insert(0,os.path.join(os.environ['LMOD_PKG'], "init")) - from env_modules_python import module - - module('purge') - for mod in MODULES: - module('load',mod) - - else: - raise Exception('could not load required modules') - - # set ESMA_FC to gfortran, if needed - # ---------------------------------- - if BASEDIR.split(os.sep)[-1].split('_')[0]=='gfortran': - writemsg(' Setting ESMA_FC to gfortran\n', fout) - os.environ['ESMA_FC'] = 'gfortran' - - # set ESMA_FC to pgfortran, if needed - # ----------------------------------- - if BASEDIR.split(os.sep)[-1].split('_')[0]=='pgfortran': - writemsg(' Setting ESMA_FC to pgfortran\n', fout) - os.environ['ESMA_FC'] = 'pgfortran' - os.environ['PGI_LOCALRC'] = '/discover/swdev/mathomp4/PGILocalRC/linux86-64/17.10/bin/localrc.60300' - writemsg(' Setting PGI_LOCALRC to %s\n' % os.environ['PGI_LOCALRC'], fout) From 536efe16bfedfab0cddd7bf266bc311c0d1d128a Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 14 Jun 2022 13:39:53 -0400 Subject: [PATCH 155/300] Add option to test either extdata1g extdata2g or both. Default extdata2g only --- .../ExtData_Testing_Framekwork/CMakeLists.txt | 49 +++++++++++-------- 1 file changed, 28 insertions(+), 21 deletions(-) diff --git a/Tests/ExtData_Testing_Framekwork/CMakeLists.txt b/Tests/ExtData_Testing_Framekwork/CMakeLists.txt index 7e482e01eba6..eae500495d38 100644 --- a/Tests/ExtData_Testing_Framekwork/CMakeLists.txt +++ b/Tests/ExtData_Testing_Framekwork/CMakeLists.txt @@ -1,25 +1,32 @@ file(STRINGS "test_cases/cases.txt" TEST_CASES) -foreach(TEST_CASE ${TEST_CASES}) -add_test( - NAME "ExtData1G_${TEST_CASE}" - COMMAND ${CMAKE_COMMAND} - -DTEST_CASE=${TEST_CASE} - -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} - -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} - -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin - -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata1g.cmake - ) -endforeach() +option(TEST_EXTDATA1G "Whether to text ExtData 1G in addition to 2G" OFF) +option(TEST_EXTDATA2G "Whether to text ExtData 1G in addition to 2G" ON) +if (${TEST_EXTDATA1G}) foreach(TEST_CASE ${TEST_CASES}) -add_test( - NAME "ExtData2G_${TEST_CASE}" - COMMAND ${CMAKE_COMMAND} - -DTEST_CASE=${TEST_CASE} - -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} - -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} - -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin - -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata2g.cmake - ) -endforeach() + add_test( + NAME "ExtData1G_${TEST_CASE}" + COMMAND ${CMAKE_COMMAND} + -DTEST_CASE=${TEST_CASE} + -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} + -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} + -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin + -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata1g.cmake + ) + endforeach() +endif() + +if (${TEST_EXTDATA2G}) + foreach(TEST_CASE ${TEST_CASES}) + add_test( + NAME "ExtData2G_${TEST_CASE}" + COMMAND ${CMAKE_COMMAND} + -DTEST_CASE=${TEST_CASE} + -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} + -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} + -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin + -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata2g.cmake + ) + endforeach() +endif() From 787a605916ee851da12b5c2ef98dee59dc8b2eb0 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 14 Jun 2022 14:45:08 -0400 Subject: [PATCH 156/300] add labels for big and small extdata tests --- .../ExtData_Testing_Framekwork/CMakeLists.txt | 65 +++++++++++-------- 1 file changed, 39 insertions(+), 26 deletions(-) diff --git a/Tests/ExtData_Testing_Framekwork/CMakeLists.txt b/Tests/ExtData_Testing_Framekwork/CMakeLists.txt index eae500495d38..77d40196539c 100644 --- a/Tests/ExtData_Testing_Framekwork/CMakeLists.txt +++ b/Tests/ExtData_Testing_Framekwork/CMakeLists.txt @@ -3,30 +3,43 @@ file(STRINGS "test_cases/cases.txt" TEST_CASES) option(TEST_EXTDATA1G "Whether to text ExtData 1G in addition to 2G" OFF) option(TEST_EXTDATA2G "Whether to text ExtData 1G in addition to 2G" ON) -if (${TEST_EXTDATA1G}) +set(cutoff "7") foreach(TEST_CASE ${TEST_CASES}) - add_test( - NAME "ExtData1G_${TEST_CASE}" - COMMAND ${CMAKE_COMMAND} - -DTEST_CASE=${TEST_CASE} - -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} - -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} - -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin - -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata1g.cmake - ) - endforeach() -endif() - -if (${TEST_EXTDATA2G}) - foreach(TEST_CASE ${TEST_CASES}) - add_test( - NAME "ExtData2G_${TEST_CASE}" - COMMAND ${CMAKE_COMMAND} - -DTEST_CASE=${TEST_CASE} - -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} - -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} - -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin - -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata2g.cmake - ) - endforeach() -endif() + if (EXISTS ${CMAKE_CURRENT_LIST_DIR}/test_cases/${TEST_CASE}/nproc.rc) + file(READ ${CMAKE_CURRENT_LIST_DIR}/test_cases/${TEST_CASE}/nproc.rc num_procs) + else() + set(num_procs "1") + endif() + if (${TEST_EXTDATA1G}) + add_test( + NAME "ExtData1G_${TEST_CASE}" + COMMAND ${CMAKE_COMMAND} + -DTEST_CASE=${TEST_CASE} + -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} + -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} + -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin + -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata1g.cmake + if (${num_procs} LESS ${cutoff}) + set_tests_properties ("ExtData1G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA1G_SMALL_TESTS") + else() + set_tests_properties ("ExtData1G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA1G_BIG_TESTS") + endif() + ) + endif() + if (${TEST_EXTDATA2G}) + add_test( + NAME "ExtData2G_${TEST_CASE}" + COMMAND ${CMAKE_COMMAND} + -DTEST_CASE=${TEST_CASE} + -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} + -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} + -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin + -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata2g.cmake + ) + if (${num_procs} LESS ${cutoff}) + set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA2G_SMALL_TESTS") + else() + set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA2G_BIG_TESTS") + endif() + endif() +endforeach() From cca2d1bbe8aea761c6963f3a4ab736639616c10a Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 14 Jun 2022 15:04:22 -0400 Subject: [PATCH 157/300] consilidate scripts --- .../ExtData_Testing_Framekwork/CMakeLists.txt | 20 ++++++++++++--- ...{run_extdata2g.cmake => run_extdata.cmake} | 8 +++--- .../run_extdata1g.cmake | 25 ------------------- 3 files changed, 21 insertions(+), 32 deletions(-) rename Tests/ExtData_Testing_Framekwork/{run_extdata2g.cmake => run_extdata.cmake} (69%) delete mode 100644 Tests/ExtData_Testing_Framekwork/run_extdata1g.cmake diff --git a/Tests/ExtData_Testing_Framekwork/CMakeLists.txt b/Tests/ExtData_Testing_Framekwork/CMakeLists.txt index 77d40196539c..ad07476f73fe 100644 --- a/Tests/ExtData_Testing_Framekwork/CMakeLists.txt +++ b/Tests/ExtData_Testing_Framekwork/CMakeLists.txt @@ -1,9 +1,17 @@ +# Detect if we are using Open MPI and add oversubscribe +string(REPLACE " " ";" MPI_Fortran_LIBRARY_VERSION_LIST ${MPI_Fortran_LIBRARY_VERSION_STRING}) +list(GET MPI_Fortran_LIBRARY_VERSION_LIST 0 MPI_Fortran_LIBRARY_VERSION_FIRSTWORD) +if(MPI_Fortran_LIBRARY_VERSION_FIRSTWORD MATCHES "Open") + list(APPEND MPIEXEC_PREFLAGS "-oversubscribe") +endif() + file(STRINGS "test_cases/cases.txt" TEST_CASES) -option(TEST_EXTDATA1G "Whether to text ExtData 1G in addition to 2G" OFF) -option(TEST_EXTDATA2G "Whether to text ExtData 1G in addition to 2G" ON) +option(TEST_EXTDATA1G "Test ExtData 1G" ON) +option(TEST_EXTDATA2G "Test ExtData 2G" ON) set(cutoff "7") + foreach(TEST_CASE ${TEST_CASES}) if (EXISTS ${CMAKE_CURRENT_LIST_DIR}/test_cases/${TEST_CASE}/nproc.rc) file(READ ${CMAKE_CURRENT_LIST_DIR}/test_cases/${TEST_CASE}/nproc.rc num_procs) @@ -18,7 +26,9 @@ foreach(TEST_CASE ${TEST_CASES}) -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin - -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata1g.cmake + -DMPIEXEC_PREFLAGS=${MPIEXEC_PREFLAGS} + -DIS_EXTDATA2G=NO + -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata.cmake if (${num_procs} LESS ${cutoff}) set_tests_properties ("ExtData1G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA1G_SMALL_TESTS") else() @@ -34,7 +44,9 @@ foreach(TEST_CASE ${TEST_CASES}) -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin - -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata2g.cmake + -DMPIEXEC_PREFLAGS=${MPIEXEC_PREFLAGS} + -DIS_EXTDATA2G=YES + -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata.cmake ) if (${num_procs} LESS ${cutoff}) set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA2G_SMALL_TESTS") diff --git a/Tests/ExtData_Testing_Framekwork/run_extdata2g.cmake b/Tests/ExtData_Testing_Framekwork/run_extdata.cmake similarity index 69% rename from Tests/ExtData_Testing_Framekwork/run_extdata2g.cmake rename to Tests/ExtData_Testing_Framekwork/run_extdata.cmake index 158ad09e1285..a8ef919dd815 100644 --- a/Tests/ExtData_Testing_Framekwork/run_extdata2g.cmake +++ b/Tests/ExtData_Testing_Framekwork/run_extdata.cmake @@ -9,10 +9,12 @@ macro(run_case CASE) else() set(num_procs "1") endif() - file(APPEND "${tempdir}/CAP1.rc" "USE_EXTDATA2G: .true.") - file(APPEND "${tempdir}/CAP2.rc" "USE_EXTDATA2G: .true.") + if (${IS_EXTDATA2G} STREQUAL "YES") + file(APPEND "${tempdir}/CAP1.rc" "USE_EXTDATA2G: .true.") + file(APPEND "${tempdir}/CAP2.rc" "USE_EXTDATA2G: .true.") + endif() execute_process( - COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} ${num_procs} ${MY_BINARY_DIR}/ExtDataDriver.x + COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_PREFLAGS} ${MPIEXEC_NUMPROC_FLAG} ${num_procs} ${MY_BINARY_DIR}/ExtDataDriver.x RESULT_VARIABLE CMD_RESULT WORKING_DIRECTORY ${tempdir} #COMMAND_ECHO STDOUT diff --git a/Tests/ExtData_Testing_Framekwork/run_extdata1g.cmake b/Tests/ExtData_Testing_Framekwork/run_extdata1g.cmake deleted file mode 100644 index 202d0aae191e..000000000000 --- a/Tests/ExtData_Testing_Framekwork/run_extdata1g.cmake +++ /dev/null @@ -1,25 +0,0 @@ -macro(run_case CASE) - string(RANDOM LENGTH 24 tempdir) - execute_process( - COMMAND ${CMAKE_COMMAND} -E make_directory ${tempdir} - COMMAND ${CMAKE_COMMAND} -E copy_directory ${CMAKE_CURRENT_LIST_DIR}/test_cases/${CASE} ${tempdir} - ) - if (EXISTS "${tempdir}/nproc.rc") - file(READ "${tempdir}/nproc.rc" num_procs) - else() - set(num_procs "1") - endif() - execute_process( - COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} ${num_procs} ${MY_BINARY_DIR}/ExtDataDriver.x - RESULT_VARIABLE CMD_RESULT - WORKING_DIRECTORY ${tempdir} - #COMMAND_ECHO STDOUT - ) - execute_process( - COMMAND ${CMAKE_COMMAND} -E rm -rf ${tempdir} - ) - if(CMD_RESULT) - message(FATAL_ERROR "Error running ${CASE}") - endif() -endmacro() -run_case(${TEST_CASE}) From c4b61ad4cd447fa7d8c24fbb75fceefda2c997e1 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 14 Jun 2022 15:04:56 -0400 Subject: [PATCH 158/300] remove file --- Tests/ExtData_Testing_Framekwork/test_cases/use_extdata2g.rc | 1 - 1 file changed, 1 deletion(-) delete mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/use_extdata2g.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/use_extdata2g.rc b/Tests/ExtData_Testing_Framekwork/test_cases/use_extdata2g.rc deleted file mode 100644 index 1c4e1f9f2026..000000000000 --- a/Tests/ExtData_Testing_Framekwork/test_cases/use_extdata2g.rc +++ /dev/null @@ -1 +0,0 @@ -USE_EXTDATA2G: .true. From 5eb24e5586a384097190a30416cfd008196313f6 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 14 Jun 2022 16:19:29 -0400 Subject: [PATCH 159/300] more updates --- Tests/ExtData_Testing_Framekwork/run_extdata.cmake | 5 +++-- Tests/ExtData_Testing_Framekwork/test_cases/case18/nproc.rc | 1 - 2 files changed, 3 insertions(+), 3 deletions(-) delete mode 100644 Tests/ExtData_Testing_Framekwork/test_cases/case18/nproc.rc diff --git a/Tests/ExtData_Testing_Framekwork/run_extdata.cmake b/Tests/ExtData_Testing_Framekwork/run_extdata.cmake index a8ef919dd815..48986e47d042 100644 --- a/Tests/ExtData_Testing_Framekwork/run_extdata.cmake +++ b/Tests/ExtData_Testing_Framekwork/run_extdata.cmake @@ -5,7 +5,8 @@ macro(run_case CASE) COMMAND ${CMAKE_COMMAND} -E copy_directory ${CMAKE_CURRENT_LIST_DIR}/test_cases/${CASE} ${tempdir} ) if (EXISTS "${tempdir}/nproc.rc") - file(READ "${tempdir}/nproc.rc" num_procs) + file(READ "${tempdir}/nproc.rc" num_procs_temp) + string(STRIP ${num_procs_temp} num_procs) else() set(num_procs "1") endif() @@ -14,7 +15,7 @@ macro(run_case CASE) file(APPEND "${tempdir}/CAP2.rc" "USE_EXTDATA2G: .true.") endif() execute_process( - COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_PREFLAGS} ${MPIEXEC_NUMPROC_FLAG} ${num_procs} ${MY_BINARY_DIR}/ExtDataDriver.x + COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} ${num_procs} ${MPIEXEC_PREFLAGS} ${MY_BINARY_DIR}/ExtDataDriver.x RESULT_VARIABLE CMD_RESULT WORKING_DIRECTORY ${tempdir} #COMMAND_ECHO STDOUT diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/nproc.rc b/Tests/ExtData_Testing_Framekwork/test_cases/case18/nproc.rc deleted file mode 100644 index d00491fd7e5b..000000000000 --- a/Tests/ExtData_Testing_Framekwork/test_cases/case18/nproc.rc +++ /dev/null @@ -1 +0,0 @@ -1 From ae418751ceee386d46421f651da659465925c1bb Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 14 Jun 2022 16:29:58 -0400 Subject: [PATCH 160/300] only add tests for ExtData if ExtDataDriver.x is built --- Tests/CMakeLists.txt | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/Tests/CMakeLists.txt b/Tests/CMakeLists.txt index aa469a39b433..92e184d8a5d3 100644 --- a/Tests/CMakeLists.txt +++ b/Tests/CMakeLists.txt @@ -26,10 +26,6 @@ if (BUILD_WITH_FLAP) target_link_libraries(pfio_MAPL_demo.x PRIVATE OpenMP::OpenMP_Fortran) endif () set_target_properties(pfio_MAPL_demo.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) + add_subdirectory(ExtData_Testing_Framekwork EXCLUDE_FROM_ALL) endif () - -#install(PROGRAMS ExtDataDriver.x DESTINATION bin) -#install(TARGETS ExtDataDriver.x DESTINATION bin) - -add_subdirectory(ExtData_Testing_Framekwork EXCLUDE_FROM_ALL) From 2bc465dd8bca1393eef1b2739d345d5bdb06f4c7 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 14 Jun 2022 16:59:58 -0400 Subject: [PATCH 161/300] remove curlies --- Tests/ExtData_Testing_Framekwork/CMakeLists.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Tests/ExtData_Testing_Framekwork/CMakeLists.txt b/Tests/ExtData_Testing_Framekwork/CMakeLists.txt index ad07476f73fe..e4a96ca2f4c5 100644 --- a/Tests/ExtData_Testing_Framekwork/CMakeLists.txt +++ b/Tests/ExtData_Testing_Framekwork/CMakeLists.txt @@ -18,7 +18,7 @@ foreach(TEST_CASE ${TEST_CASES}) else() set(num_procs "1") endif() - if (${TEST_EXTDATA1G}) + if (TEST_EXTDATA1G) add_test( NAME "ExtData1G_${TEST_CASE}" COMMAND ${CMAKE_COMMAND} @@ -36,7 +36,7 @@ foreach(TEST_CASE ${TEST_CASES}) endif() ) endif() - if (${TEST_EXTDATA2G}) + if (TEST_EXTDATA2G) add_test( NAME "ExtData2G_${TEST_CASE}" COMMAND ${CMAKE_COMMAND} From f69e2730d2166a56bf0a5e76050741f3ad677d20 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 15 Jun 2022 09:51:29 -0400 Subject: [PATCH 162/300] remove case 12 from cases.txt as that is beyond resourses currently available in CI --- Tests/ExtData_Testing_Framekwork/test_cases/cases.txt | 1 - 1 file changed, 1 deletion(-) diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/cases.txt b/Tests/ExtData_Testing_Framekwork/test_cases/cases.txt index 9753d563eb9a..909a208a63eb 100644 --- a/Tests/ExtData_Testing_Framekwork/test_cases/cases.txt +++ b/Tests/ExtData_Testing_Framekwork/test_cases/cases.txt @@ -9,7 +9,6 @@ case8 case9 case10 case11 -case12 case13 case14 case15 From f92952d4d33ee04ff60fefeff09a0eb1391416ef Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 15 Jun 2022 10:30:57 -0400 Subject: [PATCH 163/300] update circle ci --- .circleci/config.yml | 2 +- .../ExtData_Testing_Framekwork/CMakeLists.txt | 68 +++++++++---------- .../test_cases/cases.txt | 1 + 3 files changed, 33 insertions(+), 38 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 90c5f95229ff..23bbafe89dc6 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -18,7 +18,7 @@ workflows: repo: MAPL mepodevelop: false run_unit_tests: true - ctest_options: "-LE PERFORMANCE --output-on-failure" + ctest_options: "-LE 'PERFORMANCE|EXTDATA1G_BIG_TESTS|EXTDATA2G_BIG_TESTS' --output-on-failure" # Builds MAPL in a "default" way - GNU # diff --git a/Tests/ExtData_Testing_Framekwork/CMakeLists.txt b/Tests/ExtData_Testing_Framekwork/CMakeLists.txt index e4a96ca2f4c5..a91051be6019 100644 --- a/Tests/ExtData_Testing_Framekwork/CMakeLists.txt +++ b/Tests/ExtData_Testing_Framekwork/CMakeLists.txt @@ -7,9 +7,6 @@ endif() file(STRINGS "test_cases/cases.txt" TEST_CASES) -option(TEST_EXTDATA1G "Test ExtData 1G" ON) -option(TEST_EXTDATA2G "Test ExtData 2G" ON) - set(cutoff "7") foreach(TEST_CASE ${TEST_CASES}) @@ -18,40 +15,37 @@ foreach(TEST_CASE ${TEST_CASES}) else() set(num_procs "1") endif() - if (TEST_EXTDATA1G) - add_test( - NAME "ExtData1G_${TEST_CASE}" - COMMAND ${CMAKE_COMMAND} - -DTEST_CASE=${TEST_CASE} - -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} - -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} - -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin - -DMPIEXEC_PREFLAGS=${MPIEXEC_PREFLAGS} - -DIS_EXTDATA2G=NO - -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata.cmake - if (${num_procs} LESS ${cutoff}) - set_tests_properties ("ExtData1G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA1G_SMALL_TESTS") - else() - set_tests_properties ("ExtData1G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA1G_BIG_TESTS") - endif() - ) + add_test( + NAME "ExtData1G_${TEST_CASE}" + COMMAND ${CMAKE_COMMAND} + -DTEST_CASE=${TEST_CASE} + -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} + -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} + -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin + -DMPIEXEC_PREFLAGS=${MPIEXEC_PREFLAGS} + -DIS_EXTDATA2G=NO + -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata.cmake + ) + if (${num_procs} LESS ${cutoff}) + set_tests_properties ("ExtData1G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA1G_SMALL_TESTS") + else() + set_tests_properties ("ExtData1G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA1G_BIG_TESTS") endif() - if (TEST_EXTDATA2G) - add_test( - NAME "ExtData2G_${TEST_CASE}" - COMMAND ${CMAKE_COMMAND} - -DTEST_CASE=${TEST_CASE} - -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} - -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} - -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin - -DMPIEXEC_PREFLAGS=${MPIEXEC_PREFLAGS} - -DIS_EXTDATA2G=YES - -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata.cmake - ) - if (${num_procs} LESS ${cutoff}) - set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA2G_SMALL_TESTS") - else() - set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA2G_BIG_TESTS") - endif() + + add_test( + NAME "ExtData2G_${TEST_CASE}" + COMMAND ${CMAKE_COMMAND} + -DTEST_CASE=${TEST_CASE} + -DMPIEXEC_EXECUTABLE=${MPIEXEC_EXECUTABLE} + -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} + -DMY_BINARY_DIR=${CMAKE_BINARY_DIR}/bin + -DMPIEXEC_PREFLAGS=${MPIEXEC_PREFLAGS} + -DIS_EXTDATA2G=YES + -P ${CMAKE_CURRENT_SOURCE_DIR}/run_extdata.cmake + ) + if (${num_procs} LESS ${cutoff}) + set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA2G_SMALL_TESTS") + else() + set_tests_properties ("ExtData2G_${TEST_CASE}" PROPERTIES LABELS "EXTDATA2G_BIG_TESTS") endif() endforeach() diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/cases.txt b/Tests/ExtData_Testing_Framekwork/test_cases/cases.txt index 909a208a63eb..9753d563eb9a 100644 --- a/Tests/ExtData_Testing_Framekwork/test_cases/cases.txt +++ b/Tests/ExtData_Testing_Framekwork/test_cases/cases.txt @@ -9,6 +9,7 @@ case8 case9 case10 case11 +case12 case13 case14 case15 From 84ccfdd036a4fac037e222fd0a0913ec2e5f2581 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 15 Jun 2022 10:32:25 -0400 Subject: [PATCH 164/300] fix directory name --- Tests/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Tests/CMakeLists.txt b/Tests/CMakeLists.txt index 92e184d8a5d3..216bcf16855f 100644 --- a/Tests/CMakeLists.txt +++ b/Tests/CMakeLists.txt @@ -26,6 +26,6 @@ if (BUILD_WITH_FLAP) target_link_libraries(pfio_MAPL_demo.x PRIVATE OpenMP::OpenMP_Fortran) endif () set_target_properties(pfio_MAPL_demo.x PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) - add_subdirectory(ExtData_Testing_Framekwork EXCLUDE_FROM_ALL) + add_subdirectory(ExtData_Testing_Framework EXCLUDE_FROM_ALL) endif () From 516e9dedc12696562c9a70b6569956993d5c2d66 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 15 Jun 2022 10:32:43 -0400 Subject: [PATCH 165/300] renamed --- .../CMakeLists.txt | 0 .../run_extdata.cmake | 0 .../test_cases/case1/AGCM1.rc | 0 .../test_cases/case1/AGCM2.rc | 0 .../test_cases/case1/CAP.rc | 0 .../test_cases/case1/CAP1.rc | 0 .../test_cases/case1/CAP2.rc | 0 .../test_cases/case1/ExtData.rc | 0 .../test_cases/case1/HISTORY1.rc | 0 .../test_cases/case1/HISTORY2.rc | 0 .../test_cases/case1/README | 0 .../test_cases/case1/extdata.yaml | 0 .../test_cases/case10/AGCM1.rc | 0 .../test_cases/case10/AGCM2.rc | 0 .../test_cases/case10/CAP.rc | 0 .../test_cases/case10/CAP1.rc | 0 .../test_cases/case10/CAP2.rc | 0 .../test_cases/case10/ExtData.rc | 0 .../test_cases/case10/HISTORY1.rc | 0 .../test_cases/case10/HISTORY2.rc | 0 .../test_cases/case10/README | 0 .../test_cases/case10/extdata.yaml | 0 .../test_cases/case11/AGCM1.rc | 0 .../test_cases/case11/AGCM2.rc | 0 .../test_cases/case11/CAP.rc | 0 .../test_cases/case11/CAP1.rc | 0 .../test_cases/case11/CAP2.rc | 0 .../test_cases/case11/ExtData.rc | 0 .../test_cases/case11/HISTORY1.rc | 0 .../test_cases/case11/HISTORY2.rc | 0 .../test_cases/case11/README | 0 .../test_cases/case11/extdata.yaml | 0 .../test_cases/case12/AGCM1.rc | 0 .../test_cases/case12/AGCM2.rc | 0 .../test_cases/case12/CAP.rc | 0 .../test_cases/case12/CAP1.rc | 0 .../test_cases/case12/CAP2.rc | 0 .../test_cases/case12/ExtData.rc | 0 .../test_cases/case12/HISTORY1.rc | 0 .../test_cases/case12/HISTORY2.rc | 0 .../test_cases/case12/README | 0 .../test_cases/case12/extdata.yaml | 0 .../test_cases/case12/nproc.rc | 0 .../test_cases/case13/AGCM1.rc | 0 .../test_cases/case13/AGCM2.rc | 0 .../test_cases/case13/CAP.rc | 0 .../test_cases/case13/CAP1.rc | 0 .../test_cases/case13/CAP2.rc | 0 .../test_cases/case13/ExtData.rc | 0 .../test_cases/case13/HISTORY1.rc | 0 .../test_cases/case13/HISTORY2.rc | 0 .../test_cases/case13/README | 0 .../test_cases/case13/extdata.yaml | 0 .../test_cases/case14/AGCM1.rc | 0 .../test_cases/case14/AGCM2.rc | 0 .../test_cases/case14/CAP.rc | 0 .../test_cases/case14/CAP1.rc | 0 .../test_cases/case14/CAP2.rc | 0 .../test_cases/case14/ExtData.rc | 0 .../test_cases/case14/HISTORY1.rc | 0 .../test_cases/case14/HISTORY2.rc | 0 .../test_cases/case14/README | 0 .../test_cases/case14/extdata.yaml | 0 .../test_cases/case15/AGCM1.rc | 0 .../test_cases/case15/AGCM2.rc | 0 .../test_cases/case15/CAP.rc | 0 .../test_cases/case15/CAP1.rc | 0 .../test_cases/case15/CAP2.rc | 0 .../test_cases/case15/ExtData.rc | 0 .../test_cases/case15/HISTORY1.rc | 0 .../test_cases/case15/HISTORY2.rc | 0 .../test_cases/case15/README | 0 .../test_cases/case15/extdata.yaml | 0 .../test_cases/case16/AGCM1.rc | 0 .../test_cases/case16/AGCM2.rc | 0 .../test_cases/case16/CAP.rc | 0 .../test_cases/case16/CAP1.rc | 0 .../test_cases/case16/CAP2.rc | 0 .../test_cases/case16/ExtData.rc | 0 .../test_cases/case16/HISTORY1.rc | 0 .../test_cases/case16/HISTORY2.rc | 0 .../test_cases/case16/README | 0 .../test_cases/case16/extdata.yaml | 0 .../test_cases/case18/AGCM1.rc | 0 .../test_cases/case18/AGCM2.rc | 0 .../test_cases/case18/CAP.rc | 0 .../test_cases/case18/CAP1.rc | 0 .../test_cases/case18/CAP2.rc | 0 .../test_cases/case18/ExtData.rc | 0 .../test_cases/case18/HISTORY1.rc | 0 .../test_cases/case18/HISTORY2.rc | 0 .../test_cases/case18/README | 0 .../test_cases/case18/extdata.yaml | 0 .../test_cases/case19/AGCM1.rc | 0 .../test_cases/case19/CAP.rc | 0 .../test_cases/case19/CAP1.rc | 0 .../test_cases/case19/ExtData.rc | 0 .../test_cases/case19/HISTORY1.rc | 0 .../test_cases/case19/README | 0 .../test_cases/case19/extdata.yaml | 0 .../test_cases/case2/AGCM1.rc | 0 .../test_cases/case2/AGCM2.rc | 0 .../test_cases/case2/CAP.rc | 0 .../test_cases/case2/CAP1.rc | 0 .../test_cases/case2/CAP2.rc | 0 .../test_cases/case2/ExtData.rc | 0 .../test_cases/case2/HISTORY1.rc | 0 .../test_cases/case2/HISTORY2.rc | 0 .../test_cases/case2/README | 0 .../test_cases/case2/extdata.yaml | 0 .../test_cases/case20/AGCM1.rc | 0 .../test_cases/case20/AGCM2.rc | 0 .../test_cases/case20/CAP.rc | 0 .../test_cases/case20/CAP1.rc | 0 .../test_cases/case20/CAP2.rc | 0 .../test_cases/case20/ExtData.rc | 0 .../test_cases/case20/HISTORY1.rc | 0 .../test_cases/case20/HISTORY2.rc | 0 .../test_cases/case20/README | 0 .../test_cases/case20/extdata.yaml | 0 .../test_cases/case21/AGCM1.rc | 0 .../test_cases/case21/AGCM2.rc | 0 .../test_cases/case21/CAP.rc | 0 .../test_cases/case21/CAP1.rc | 0 .../test_cases/case21/CAP2.rc | 0 .../test_cases/case21/ExtData.rc | 0 .../test_cases/case21/HISTORY1.rc | 0 .../test_cases/case21/HISTORY2.rc | 0 .../test_cases/case21/README | 0 .../test_cases/case21/extdata.yaml | 0 .../test_cases/case22/AGCM1.rc | 0 .../test_cases/case22/AGCM2.rc | 0 .../test_cases/case22/AGCM3.rc | 0 .../test_cases/case22/CAP.rc | 0 .../test_cases/case22/CAP1.rc | 0 .../test_cases/case22/CAP2.rc | 0 .../test_cases/case22/CAP3.rc | 0 .../test_cases/case22/ExtData.rc | 0 .../test_cases/case22/HISTORY1.rc | 0 .../test_cases/case22/HISTORY2.rc | 0 .../test_cases/case22/HISTORY3.rc | 0 .../test_cases/case22/README | 0 .../test_cases/case22/case1.rcx | 0 .../test_cases/case22/case2.rcx | 0 .../test_cases/case22/egress | 0 .../test_cases/case22/extdata.yaml | 0 .../test_cases/case22/warnings_and_errors.log | 0 .../test_cases/case23/AGCM1.rc | 0 .../test_cases/case23/AGCM2.rc | 0 .../test_cases/case23/AGCM3.rc | 0 .../test_cases/case23/CAP.rc | 0 .../test_cases/case23/CAP1.rc | 0 .../test_cases/case23/CAP2.rc | 0 .../test_cases/case23/CAP3.rc | 0 .../test_cases/case23/ExtData.rc | 0 .../test_cases/case23/HISTORY1.rc | 0 .../test_cases/case23/HISTORY2.rc | 0 .../test_cases/case23/HISTORY3.rc | 0 .../test_cases/case23/README | 0 .../test_cases/case23/extdata.yaml | 0 .../test_cases/case24/AGCM1.rc | 0 .../test_cases/case24/AGCM2.rc | 0 .../test_cases/case24/CAP.rc | 0 .../test_cases/case24/CAP1.rc | 0 .../test_cases/case24/CAP2.rc | 0 .../test_cases/case24/ExtData.rc | 0 .../test_cases/case24/HISTORY1.rc | 0 .../test_cases/case24/HISTORY2.rc | 0 .../test_cases/case24/README | 0 .../test_cases/case24/extdata.yaml | 0 .../test_cases/case24/nproc.rc | 0 .../test_cases/case25/AGCM1.rc | 0 .../test_cases/case25/AGCM2.rc | 0 .../test_cases/case25/CAP.rc | 0 .../test_cases/case25/CAP1.rc | 0 .../test_cases/case25/CAP2.rc | 0 .../test_cases/case25/ExtData.rc | 0 .../test_cases/case25/HISTORY1.rc | 0 .../test_cases/case25/HISTORY2.rc | 0 .../test_cases/case25/README | 0 .../test_cases/case25/extdata.yaml | 0 .../test_cases/case26/AGCM1.rc | 0 .../test_cases/case26/AGCM2.rc | 0 .../test_cases/case26/CAP.rc | 0 .../test_cases/case26/CAP1.rc | 0 .../test_cases/case26/CAP2.rc | 0 .../test_cases/case26/ExtData.rc | 0 .../test_cases/case26/HISTORY1.rc | 0 .../test_cases/case26/HISTORY2.rc | 0 .../test_cases/case26/README | 0 .../test_cases/case26/extdata.yaml | 0 .../test_cases/case3/AGCM1.rc | 0 .../test_cases/case3/AGCM2.rc | 0 .../test_cases/case3/CAP.rc | 0 .../test_cases/case3/CAP1.rc | 0 .../test_cases/case3/CAP2.rc | 0 .../test_cases/case3/ExtData.rc | 0 .../test_cases/case3/HISTORY1.rc | 0 .../test_cases/case3/HISTORY2.rc | 0 .../test_cases/case3/README | 0 .../test_cases/case3/extdata.yaml | 0 .../test_cases/case4/AGCM1.rc | 0 .../test_cases/case4/AGCM2.rc | 0 .../test_cases/case4/CAP.rc | 0 .../test_cases/case4/CAP1.rc | 0 .../test_cases/case4/CAP2.rc | 0 .../test_cases/case4/ExtData.rc | 0 .../test_cases/case4/HISTORY1.rc | 0 .../test_cases/case4/HISTORY2.rc | 0 .../test_cases/case4/README | 0 .../test_cases/case4/extdata.yaml | 0 .../test_cases/case5/AGCM1.rc | 0 .../test_cases/case5/AGCM2.rc | 0 .../test_cases/case5/CAP.rc | 0 .../test_cases/case5/CAP1.rc | 0 .../test_cases/case5/CAP2.rc | 0 .../test_cases/case5/ExtData.rc | 0 .../test_cases/case5/HISTORY1.rc | 0 .../test_cases/case5/HISTORY2.rc | 0 .../test_cases/case5/README | 0 .../test_cases/case5/extdata.yaml | 0 .../test_cases/case6/AGCM1.rc | 0 .../test_cases/case6/AGCM2.rc | 0 .../test_cases/case6/CAP.rc | 0 .../test_cases/case6/CAP1.rc | 0 .../test_cases/case6/CAP2.rc | 0 .../test_cases/case6/ExtData.rc | 0 .../test_cases/case6/HISTORY1.rc | 0 .../test_cases/case6/HISTORY2.rc | 0 .../test_cases/case6/README | 0 .../test_cases/case6/extdata.yaml | 0 .../test_cases/case7/AGCM1.rc | 0 .../test_cases/case7/AGCM2.rc | 0 .../test_cases/case7/CAP.rc | 0 .../test_cases/case7/CAP1.rc | 0 .../test_cases/case7/CAP2.rc | 0 .../test_cases/case7/ExtData.rc | 0 .../test_cases/case7/HISTORY1.rc | 0 .../test_cases/case7/HISTORY2.rc | 0 .../test_cases/case7/README | 0 .../test_cases/case7/extdata.yaml | 0 .../test_cases/case8/AGCM1.rc | 0 .../test_cases/case8/AGCM2.rc | 0 .../test_cases/case8/CAP.rc | 0 .../test_cases/case8/CAP1.rc | 0 .../test_cases/case8/CAP2.rc | 0 .../test_cases/case8/ExtData.rc | 0 .../test_cases/case8/HISTORY1.rc | 0 .../test_cases/case8/HISTORY2.rc | 0 .../test_cases/case8/README | 0 .../test_cases/case8/extdata.yaml | 0 .../test_cases/case9/AGCM1.rc | 0 .../test_cases/case9/AGCM2.rc | 0 .../test_cases/case9/CAP.rc | 0 .../test_cases/case9/CAP1.rc | 0 .../test_cases/case9/CAP2.rc | 0 .../test_cases/case9/ExtData.rc | 0 .../test_cases/case9/HISTORY1.rc | 0 .../test_cases/case9/HISTORY2.rc | 0 .../test_cases/case9/README | 0 .../test_cases/case9/extdata.yaml | 0 .../test_cases/cases.txt | 0 .../test_cases/test_case_descriptions.md | 0 263 files changed, 0 insertions(+), 0 deletions(-) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/CMakeLists.txt (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/run_extdata.cmake (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case1/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case1/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case1/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case1/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case1/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case1/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case1/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case1/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case1/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case1/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case10/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case10/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case10/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case10/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case10/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case10/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case10/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case10/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case10/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case10/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case11/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case11/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case11/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case11/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case11/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case11/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case11/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case11/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case11/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case11/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case12/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case12/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case12/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case12/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case12/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case12/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case12/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case12/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case12/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case12/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case12/nproc.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case13/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case13/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case13/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case13/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case13/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case13/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case13/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case13/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case13/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case13/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case14/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case14/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case14/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case14/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case14/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case14/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case14/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case14/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case14/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case14/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case15/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case15/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case15/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case15/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case15/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case15/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case15/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case15/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case15/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case15/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case16/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case16/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case16/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case16/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case16/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case16/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case16/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case16/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case16/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case16/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case18/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case18/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case18/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case18/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case18/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case18/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case18/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case18/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case18/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case18/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case19/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case19/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case19/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case19/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case19/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case19/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case19/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case2/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case2/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case2/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case2/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case2/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case2/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case2/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case2/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case2/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case2/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case20/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case20/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case20/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case20/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case20/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case20/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case20/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case20/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case20/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case20/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case21/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case21/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case21/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case21/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case21/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case21/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case21/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case21/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case21/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case21/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case22/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case22/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case22/AGCM3.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case22/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case22/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case22/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case22/CAP3.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case22/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case22/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case22/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case22/HISTORY3.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case22/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case22/case1.rcx (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case22/case2.rcx (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case22/egress (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case22/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case22/warnings_and_errors.log (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case23/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case23/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case23/AGCM3.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case23/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case23/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case23/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case23/CAP3.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case23/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case23/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case23/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case23/HISTORY3.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case23/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case23/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case24/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case24/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case24/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case24/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case24/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case24/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case24/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case24/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case24/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case24/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case24/nproc.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case25/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case25/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case25/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case25/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case25/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case25/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case25/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case25/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case25/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case25/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case26/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case26/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case26/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case26/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case26/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case26/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case26/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case26/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case26/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case26/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case3/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case3/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case3/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case3/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case3/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case3/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case3/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case3/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case3/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case3/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case4/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case4/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case4/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case4/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case4/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case4/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case4/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case4/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case4/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case4/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case5/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case5/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case5/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case5/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case5/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case5/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case5/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case5/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case5/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case5/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case6/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case6/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case6/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case6/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case6/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case6/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case6/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case6/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case6/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case6/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case7/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case7/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case7/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case7/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case7/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case7/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case7/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case7/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case7/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case7/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case8/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case8/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case8/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case8/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case8/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case8/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case8/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case8/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case8/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case8/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case9/AGCM1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case9/AGCM2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case9/CAP.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case9/CAP1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case9/CAP2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case9/ExtData.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case9/HISTORY1.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case9/HISTORY2.rc (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case9/README (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/case9/extdata.yaml (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/cases.txt (100%) rename Tests/{ExtData_Testing_Framekwork => ExtData_Testing_Framework}/test_cases/test_case_descriptions.md (100%) diff --git a/Tests/ExtData_Testing_Framekwork/CMakeLists.txt b/Tests/ExtData_Testing_Framework/CMakeLists.txt similarity index 100% rename from Tests/ExtData_Testing_Framekwork/CMakeLists.txt rename to Tests/ExtData_Testing_Framework/CMakeLists.txt diff --git a/Tests/ExtData_Testing_Framekwork/run_extdata.cmake b/Tests/ExtData_Testing_Framework/run_extdata.cmake similarity index 100% rename from Tests/ExtData_Testing_Framekwork/run_extdata.cmake rename to Tests/ExtData_Testing_Framework/run_extdata.cmake diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case1/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case1/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case1/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case1/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case1/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case1/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case1/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case1/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case1/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case1/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case1/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case1/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case1/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case1/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case1/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case1/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case1/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case1/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case1/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case1/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case1/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case1/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/README b/Tests/ExtData_Testing_Framework/test_cases/case1/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case1/README rename to Tests/ExtData_Testing_Framework/test_cases/case1/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case1/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case1/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case1/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case1/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case10/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case10/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case10/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case10/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case10/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case10/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case10/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case10/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case10/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case10/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case10/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case10/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case10/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case10/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case10/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case10/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case10/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case10/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case10/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case10/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case10/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case10/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/README b/Tests/ExtData_Testing_Framework/test_cases/case10/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case10/README rename to Tests/ExtData_Testing_Framework/test_cases/case10/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case10/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case10/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case10/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case10/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case11/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case11/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case11/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case11/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case11/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case11/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case11/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case11/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case11/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case11/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case11/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case11/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case11/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case11/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case11/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case11/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case11/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case11/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case11/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case11/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case11/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case11/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/README b/Tests/ExtData_Testing_Framework/test_cases/case11/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case11/README rename to Tests/ExtData_Testing_Framework/test_cases/case11/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case11/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case11/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case11/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case11/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case12/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case12/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case12/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case12/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case12/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case12/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case12/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case12/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case12/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case12/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case12/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case12/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case12/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case12/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case12/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case12/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case12/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case12/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case12/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case12/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case12/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case12/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/README b/Tests/ExtData_Testing_Framework/test_cases/case12/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case12/README rename to Tests/ExtData_Testing_Framework/test_cases/case12/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case12/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case12/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case12/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case12/nproc.rc b/Tests/ExtData_Testing_Framework/test_cases/case12/nproc.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case12/nproc.rc rename to Tests/ExtData_Testing_Framework/test_cases/case12/nproc.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case13/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case13/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case13/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case13/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case13/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case13/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case13/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case13/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case13/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case13/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case13/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case13/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case13/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case13/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case13/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case13/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case13/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case13/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case13/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case13/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case13/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case13/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/README b/Tests/ExtData_Testing_Framework/test_cases/case13/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case13/README rename to Tests/ExtData_Testing_Framework/test_cases/case13/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case13/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case13/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case13/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case13/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case14/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case14/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case14/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case14/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case14/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case14/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case14/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case14/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case14/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case14/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case14/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case14/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case14/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case14/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case14/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case14/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case14/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case14/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case14/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case14/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case14/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case14/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/README b/Tests/ExtData_Testing_Framework/test_cases/case14/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case14/README rename to Tests/ExtData_Testing_Framework/test_cases/case14/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case14/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case14/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case14/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case14/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case15/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case15/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case15/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case15/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case15/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case15/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case15/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case15/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case15/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case15/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case15/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case15/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case15/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case15/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case15/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case15/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case15/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case15/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case15/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case15/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case15/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case15/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/README b/Tests/ExtData_Testing_Framework/test_cases/case15/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case15/README rename to Tests/ExtData_Testing_Framework/test_cases/case15/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case15/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case15/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case15/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case15/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case16/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case16/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case16/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case16/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case16/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case16/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case16/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case16/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case16/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case16/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case16/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case16/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case16/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case16/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case16/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case16/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case16/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case16/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case16/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case16/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case16/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case16/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/README b/Tests/ExtData_Testing_Framework/test_cases/case16/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case16/README rename to Tests/ExtData_Testing_Framework/test_cases/case16/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case16/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case16/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case16/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case16/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case18/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case18/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case18/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case18/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case18/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case18/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case18/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case18/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case18/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case18/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case18/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case18/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case18/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case18/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case18/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case18/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case18/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case18/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case18/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case18/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case18/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case18/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/README b/Tests/ExtData_Testing_Framework/test_cases/case18/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case18/README rename to Tests/ExtData_Testing_Framework/test_cases/case18/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case18/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case18/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case18/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case18/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case19/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case19/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case19/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case19/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case19/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case19/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case19/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case19/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case19/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case19/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case19/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case19/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case19/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case19/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case19/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case19/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case19/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case19/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case19/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case19/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case19/README b/Tests/ExtData_Testing_Framework/test_cases/case19/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case19/README rename to Tests/ExtData_Testing_Framework/test_cases/case19/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case19/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case19/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case19/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case19/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case2/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case2/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case2/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case2/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case2/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case2/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case2/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case2/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case2/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case2/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case2/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case2/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case2/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case2/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case2/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case2/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case2/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case2/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case2/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case2/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case2/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case2/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/README b/Tests/ExtData_Testing_Framework/test_cases/case2/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case2/README rename to Tests/ExtData_Testing_Framework/test_cases/case2/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case2/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case2/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case2/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case2/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case20/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case20/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case20/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case20/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case20/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case20/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case20/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case20/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case20/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case20/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case20/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case20/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case20/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case20/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case20/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case20/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case20/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case20/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case20/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case20/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case20/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case20/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/README b/Tests/ExtData_Testing_Framework/test_cases/case20/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case20/README rename to Tests/ExtData_Testing_Framework/test_cases/case20/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case20/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case20/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case20/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case20/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case21/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case21/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case21/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case21/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case21/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case21/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case21/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case21/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case21/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case21/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case21/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case21/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case21/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case21/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case21/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case21/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case21/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case21/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case21/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case21/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case21/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case21/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/README b/Tests/ExtData_Testing_Framework/test_cases/case21/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case21/README rename to Tests/ExtData_Testing_Framework/test_cases/case21/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case21/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case21/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case21/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case21/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case22/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case22/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case22/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case22/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM3.rc b/Tests/ExtData_Testing_Framework/test_cases/case22/AGCM3.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case22/AGCM3.rc rename to Tests/ExtData_Testing_Framework/test_cases/case22/AGCM3.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case22/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case22/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case22/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case22/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case22/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case22/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP3.rc b/Tests/ExtData_Testing_Framework/test_cases/case22/CAP3.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case22/CAP3.rc rename to Tests/ExtData_Testing_Framework/test_cases/case22/CAP3.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case22/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case22/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case22/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case22/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case22/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case22/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case22/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY3.rc b/Tests/ExtData_Testing_Framework/test_cases/case22/HISTORY3.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case22/HISTORY3.rc rename to Tests/ExtData_Testing_Framework/test_cases/case22/HISTORY3.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/README b/Tests/ExtData_Testing_Framework/test_cases/case22/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case22/README rename to Tests/ExtData_Testing_Framework/test_cases/case22/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/case1.rcx b/Tests/ExtData_Testing_Framework/test_cases/case22/case1.rcx similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case22/case1.rcx rename to Tests/ExtData_Testing_Framework/test_cases/case22/case1.rcx diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/case2.rcx b/Tests/ExtData_Testing_Framework/test_cases/case22/case2.rcx similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case22/case2.rcx rename to Tests/ExtData_Testing_Framework/test_cases/case22/case2.rcx diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/egress b/Tests/ExtData_Testing_Framework/test_cases/case22/egress similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case22/egress rename to Tests/ExtData_Testing_Framework/test_cases/case22/egress diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case22/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case22/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case22/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case22/warnings_and_errors.log b/Tests/ExtData_Testing_Framework/test_cases/case22/warnings_and_errors.log similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case22/warnings_and_errors.log rename to Tests/ExtData_Testing_Framework/test_cases/case22/warnings_and_errors.log diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case23/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case23/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case23/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case23/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM3.rc b/Tests/ExtData_Testing_Framework/test_cases/case23/AGCM3.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case23/AGCM3.rc rename to Tests/ExtData_Testing_Framework/test_cases/case23/AGCM3.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case23/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case23/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case23/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case23/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case23/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case23/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP3.rc b/Tests/ExtData_Testing_Framework/test_cases/case23/CAP3.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case23/CAP3.rc rename to Tests/ExtData_Testing_Framework/test_cases/case23/CAP3.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case23/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case23/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case23/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case23/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case23/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case23/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case23/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY3.rc b/Tests/ExtData_Testing_Framework/test_cases/case23/HISTORY3.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case23/HISTORY3.rc rename to Tests/ExtData_Testing_Framework/test_cases/case23/HISTORY3.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/README b/Tests/ExtData_Testing_Framework/test_cases/case23/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case23/README rename to Tests/ExtData_Testing_Framework/test_cases/case23/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case23/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case23/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case23/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case23/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case24/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case24/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case24/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case24/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case24/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case24/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case24/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case24/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case24/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case24/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case24/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case24/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case24/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case24/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case24/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case24/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case24/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case24/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case24/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case24/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case24/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case24/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/README b/Tests/ExtData_Testing_Framework/test_cases/case24/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case24/README rename to Tests/ExtData_Testing_Framework/test_cases/case24/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case24/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case24/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case24/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case24/nproc.rc b/Tests/ExtData_Testing_Framework/test_cases/case24/nproc.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case24/nproc.rc rename to Tests/ExtData_Testing_Framework/test_cases/case24/nproc.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case25/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case25/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case25/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case25/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case25/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case25/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case25/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case25/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case25/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case25/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case25/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case25/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case25/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case25/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case25/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case25/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case25/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case25/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case25/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case25/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case25/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case25/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/README b/Tests/ExtData_Testing_Framework/test_cases/case25/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case25/README rename to Tests/ExtData_Testing_Framework/test_cases/case25/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case25/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case25/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case25/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case25/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case26/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case26/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case26/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case26/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case26/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case26/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case26/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case26/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case26/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case26/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case26/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case26/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case26/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case26/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case26/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case26/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case26/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case26/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case26/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case26/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case26/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case26/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/README b/Tests/ExtData_Testing_Framework/test_cases/case26/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case26/README rename to Tests/ExtData_Testing_Framework/test_cases/case26/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case26/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case26/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case26/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case26/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case3/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case3/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case3/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case3/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case3/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case3/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case3/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case3/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case3/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case3/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case3/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case3/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case3/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case3/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case3/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case3/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case3/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case3/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case3/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case3/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case3/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case3/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/README b/Tests/ExtData_Testing_Framework/test_cases/case3/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case3/README rename to Tests/ExtData_Testing_Framework/test_cases/case3/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case3/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case3/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case3/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case3/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case4/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case4/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case4/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case4/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case4/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case4/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case4/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case4/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case4/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case4/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case4/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case4/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case4/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case4/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case4/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case4/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case4/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case4/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case4/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case4/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case4/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case4/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/README b/Tests/ExtData_Testing_Framework/test_cases/case4/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case4/README rename to Tests/ExtData_Testing_Framework/test_cases/case4/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case4/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case4/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case4/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case4/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case5/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case5/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case5/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case5/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case5/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case5/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case5/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case5/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case5/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case5/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case5/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case5/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case5/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case5/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case5/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case5/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case5/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case5/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case5/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case5/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case5/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case5/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/README b/Tests/ExtData_Testing_Framework/test_cases/case5/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case5/README rename to Tests/ExtData_Testing_Framework/test_cases/case5/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case5/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case5/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case5/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case5/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case6/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case6/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case6/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case6/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case6/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case6/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case6/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case6/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case6/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case6/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case6/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case6/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case6/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case6/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case6/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case6/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case6/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case6/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case6/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case6/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case6/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case6/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/README b/Tests/ExtData_Testing_Framework/test_cases/case6/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case6/README rename to Tests/ExtData_Testing_Framework/test_cases/case6/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case6/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case6/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case6/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case6/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case7/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case7/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case7/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case7/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case7/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case7/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case7/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case7/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case7/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case7/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case7/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case7/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case7/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case7/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case7/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case7/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case7/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case7/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case7/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case7/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case7/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case7/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/README b/Tests/ExtData_Testing_Framework/test_cases/case7/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case7/README rename to Tests/ExtData_Testing_Framework/test_cases/case7/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case7/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case7/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case7/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case7/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case8/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case8/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case8/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case8/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case8/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case8/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case8/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case8/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case8/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case8/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case8/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case8/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case8/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case8/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case8/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case8/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case8/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case8/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case8/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case8/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case8/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case8/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/README b/Tests/ExtData_Testing_Framework/test_cases/case8/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case8/README rename to Tests/ExtData_Testing_Framework/test_cases/case8/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case8/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case8/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case8/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case8/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/AGCM1.rc b/Tests/ExtData_Testing_Framework/test_cases/case9/AGCM1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case9/AGCM1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case9/AGCM1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/AGCM2.rc b/Tests/ExtData_Testing_Framework/test_cases/case9/AGCM2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case9/AGCM2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case9/AGCM2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP.rc b/Tests/ExtData_Testing_Framework/test_cases/case9/CAP.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP.rc rename to Tests/ExtData_Testing_Framework/test_cases/case9/CAP.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP1.rc b/Tests/ExtData_Testing_Framework/test_cases/case9/CAP1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case9/CAP1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP2.rc b/Tests/ExtData_Testing_Framework/test_cases/case9/CAP2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case9/CAP2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case9/CAP2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/ExtData.rc b/Tests/ExtData_Testing_Framework/test_cases/case9/ExtData.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case9/ExtData.rc rename to Tests/ExtData_Testing_Framework/test_cases/case9/ExtData.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/HISTORY1.rc b/Tests/ExtData_Testing_Framework/test_cases/case9/HISTORY1.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case9/HISTORY1.rc rename to Tests/ExtData_Testing_Framework/test_cases/case9/HISTORY1.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/HISTORY2.rc b/Tests/ExtData_Testing_Framework/test_cases/case9/HISTORY2.rc similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case9/HISTORY2.rc rename to Tests/ExtData_Testing_Framework/test_cases/case9/HISTORY2.rc diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/README b/Tests/ExtData_Testing_Framework/test_cases/case9/README similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case9/README rename to Tests/ExtData_Testing_Framework/test_cases/case9/README diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/case9/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case9/extdata.yaml similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/case9/extdata.yaml rename to Tests/ExtData_Testing_Framework/test_cases/case9/extdata.yaml diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/cases.txt b/Tests/ExtData_Testing_Framework/test_cases/cases.txt similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/cases.txt rename to Tests/ExtData_Testing_Framework/test_cases/cases.txt diff --git a/Tests/ExtData_Testing_Framekwork/test_cases/test_case_descriptions.md b/Tests/ExtData_Testing_Framework/test_cases/test_case_descriptions.md similarity index 100% rename from Tests/ExtData_Testing_Framekwork/test_cases/test_case_descriptions.md rename to Tests/ExtData_Testing_Framework/test_cases/test_case_descriptions.md From da39ef11135d2d6c9e326984d903bc2376ce157b Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 15 Jun 2022 10:35:35 -0400 Subject: [PATCH 166/300] more updates for ci --- .circleci/config.yml | 4 ++-- .github/workflows/workflow.yml | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 23bbafe89dc6..c703d1ca64c7 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -41,7 +41,7 @@ workflows: repo: MAPL mepodevelop: false run_unit_tests: true - ctest_options: "-E bundleio -LE PERFORMANCE --output-on-failure" + ctest_options: "-E bundleio -LE 'PERFORMANCE|EXTDATA1G_BIG_TESTS|EXTDATA2G_BIG_TESTS' --output-on-failure" # Builds MAPL like UFS does (no FLAP and pFlogger, static) - ci/build: @@ -55,7 +55,7 @@ workflows: mepodevelop: false extra_cmake_options: "-DBUILD_WITH_FLAP=OFF -DBUILD_WITH_PFLOGGER=OFF -DBUILD_SHARED_MAPL=OFF" run_unit_tests: true - ctest_options: "-LE PERFORMANCE --output-on-failure" + ctest_options: "-LE 'PERFORMANCE|EXTDATA1G_BIG_TESTS|EXTDATA2G_BIG_TESTS' --output-on-failure" # Build GEOSgcm - ci/build: diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 6b393d5260a3..9df322623204 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -69,7 +69,7 @@ jobs: # # For now, we run GNU/Open MPI without the bundleio tests. Some indications that # Open MPI 5 will not have this limitation - ctest -E bundleio -LE PERFORMANCE --output-on-failure + ctest -E bundleio -LE 'PERFORMANCE|EXTDATA1G_BIG_TESTS|EXTDATA2G_BIG_TESTS' --output-on-failure build_test_mapl_intel: name: Build and Test MAPL Intel runs-on: ubuntu-latest @@ -114,4 +114,4 @@ jobs: cd build make -j4 build-tests # skip performance tests - ctest -LE PERFORMANCE --output-on-failure + ctest -LE 'PERFORMANCE|EXTDATA1G_BIG_TESTS|EXTDATA2G_BIG_TESTS' --output-on-failure From 538b0af8ccaf851ecab5a10d8bd59b92b0cd7b0a Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 15 Jun 2022 12:58:29 -0400 Subject: [PATCH 167/300] Updates for FORD Testing --- base/tests/testbin.F90 | 2 +- base/tests/testhorz.F90 | 2 + base/tstqsat.F90 | 2 +- pfio/pfio_io_demo.F90 | 514 -------------------------------- pflogger_stub/pflogger_stub.F90 | 21 +- 5 files changed, 16 insertions(+), 525 deletions(-) delete mode 100644 pfio/pfio_io_demo.F90 diff --git a/base/tests/testbin.F90 b/base/tests/testbin.F90 index 8e7c03c9c0c5..cf9d69a843c5 100644 --- a/base/tests/testbin.F90 +++ b/base/tests/testbin.F90 @@ -1,4 +1,4 @@ - +program testbin use HorzBinMod type (HorzBinTransform) :: T diff --git a/base/tests/testhorz.F90 b/base/tests/testhorz.F90 index 67277d6c7ed2..0f0314a39334 100644 --- a/base/tests/testhorz.F90 +++ b/base/tests/testhorz.F90 @@ -1,3 +1,5 @@ +program testhorz + use MAPL_HorzTransformMod implicit none diff --git a/base/tstqsat.F90 b/base/tstqsat.F90 index b8cb4e5d1b01..871c0f895a53 100644 --- a/base/tstqsat.F90 +++ b/base/tstqsat.F90 @@ -1,4 +1,4 @@ - +program tstqsat use MAPLBase_Mod diff --git a/pfio/pfio_io_demo.F90 b/pfio/pfio_io_demo.F90 deleted file mode 100644 index bddd1ffe4943..000000000000 --- a/pfio/pfio_io_demo.F90 +++ /dev/null @@ -1,514 +0,0 @@ -!usage -!mpirun -np 8 ./pfio_collective_demo.x -nc 4 -nsi 2 -nso 2 -f1 xxx1.nc4 -f2 xxx2.nc4 -v T -s mpi -!The variable should be 4d with lavel>=20 -#include "MAPL_ErrLog.h" -#include "unused_dummy.H" - -module io_demo_CLI - use MAPL_ExceptionHandling - use pFIO_StringVectorMod - implicit none - private - - public :: CommandLineOptions - public :: process_command_line - - type CommandLineOptions - character(len=:), allocatable :: file_1, file_2 - type (StringVector) :: requested_variables - - integer :: npes_client - integer :: npes_iserver - integer :: npes_oserver - logical :: debug - character(len=:),allocatable :: server_type ! 'mpi' or 'openmp' - end type CommandLineOptions - - -contains - - ! The following procedure parses the command line to find various - ! arguments for file names, target grid resolution, etc. - subroutine process_command_line(options, rc) - type (CommandLineOptions), intent(inout) :: options - integer, optional, intent(out) :: rc - - integer :: n_args - integer :: i_arg - character(len=:), allocatable :: argument - character(len=:), allocatable :: buffer - - n_args = command_argument_count() - - i_arg = 0 - do - if (i_arg > n_args) exit - - argument = get_next_argument() - - select case (argument) - case ('-nc', '--npes_client') - buffer = get_next_argument() - _ASSERT(buffer /= '-') - read(buffer,*) options%npes_client - case ('-nsi', '--npes_iserver') - buffer = get_next_argument() - _ASSERT(buffer /= '-') - read(buffer,*) options%npes_iserver - case ('-nso', '--npes_oserver') - buffer = get_next_argument() - _ASSERT(buffer /= '-') - read(buffer,*) options%npes_oserver - case ('-f1', '--file_1') - options%file_1 = get_next_argument() - _ASSERT(options%file_1(1:1) /= '-') - case ('-f2', '--file_2') - options%file_2 = get_next_argument() - _ASSERT(options%file_2(1:1) /= '-') - case ('-v', '--var') - buffer = get_next_argument() - _ASSERT(buffer(1:1) /= '-') - options%requested_variables = parse_vars(buffer) - case ('-s', '--server_type') - options%server_type = get_next_argument() - _ASSERT(options%server_type /= '-') - case ('-d', '--debug') - options%debug = .true. - case default - ! ignore - end select - - end do - - contains - - function get_next_argument() result(argument) - character(len=:), allocatable :: argument - - integer :: length - - i_arg = i_arg + 1 - - call get_command_argument(i_arg, length=length) - allocate(character(len=length) :: argument) - call get_command_argument(i_arg, value=argument) - - end function get_next_argument - - function parse_vars(buffer) result(vars) - type (StringVector) :: vars - character(len=*), intent(in) :: buffer - - integer :: idx - character(len=1), parameter :: COMMA = ',' - character(len=:), allocatable :: string - - string = buffer // COMMA - do - if (len(string) == 0) exit - idx = index(string,COMMA) - call vars%push_back(string(1:idx-1)) - string = string(idx+1:) - end do - - end function parse_vars - - - end subroutine process_command_line - - -end module io_demo_CLI - -module FakeExtDataMod - use io_demo_CLI - use pFIO - use pFIO_StringVectorMod - use, intrinsic :: iso_fortran_env, only: REAL32 - implicit none - private - - public :: FakeExtData - - type FakeBundle - real(kind=REAL32), allocatable :: x(:,:,:,:) - integer :: request_id - end type FakeBundle - - type FakeExtData - type (ClientThread) :: i_c - type (ClientThread) :: o_c - integer, allocatable :: hist_collection_ids(:) - - character(len=:), allocatable :: file_1 - character(len=:), allocatable :: file_2 - - type (StringVector) :: vars - type (FakeBundle), allocatable :: bundle(:) - - integer :: comm - integer :: rank - integer :: npes - - integer :: nlat - integer :: nlon - - contains - procedure :: init - procedure :: run - procedure :: finalize - - end type FakeExtData - -contains - - - subroutine init(this, options, comm, d_s) - use pFIO_StringIntegerMapMod - class (FakeExtData),target, intent(inout) :: this - type (CommandLineOptions), intent(in) :: options - integer, intent(in) :: comm - class (AbstractDirectoryService), target,intent(inout) :: d_s - - integer :: ierror - type (FileMetadata) :: file_metadata - type (NetCDF4_FileFormatter) :: formatter - type (StringIntegerMap) :: dims - - this%i_c = ClientThread() - call d_s%connect_to_server('i_server', this%i_c, comm) - - this%o_c = ClientThread() - call d_s%connect_to_server('o_server', this%o_c, comm) - - - this%file_1 = options%file_1 - this%file_2 = options%file_2 - this%vars = options%requested_variables - !call this%vars%push_back('T') - !call this%vars%push_back('U') - !call this%vars%push_back('V') - - - this%comm = comm - call MPI_Comm_rank(comm,this%rank,ierror) - call MPI_Comm_size(comm,this%npes,ierror) - - allocate(this%bundle(this%vars%size())) - - call formatter%open(this%file_1, pFIO_READ) - file_metadata = formatter%read() - call formatter%close() - - dims = file_metadata%get_dimensions() - this%nlat = dims%at('lat') - this%nlon = dims%at('lon') - - allocate(this%hist_collection_ids(10)) - - end subroutine init - - subroutine run(this, step) - class (FakeExtData), target, intent(inout) :: this - integer, intent(in) :: step - - type(ArrayReference) :: ref - type(FileMetadata) :: fmd,fmd2 - Type(Variable) :: T1,T2 - - integer :: i_var,i - integer :: lat0, lat1, nlats - integer :: collection_id, file_md_id - character(len=3) :: tmp - integer :: c1,c2,num_request - integer,allocatable :: pull_ids(:,:) - integer,allocatable :: push_ids(:,:) - - lat0 = 1 + (this%rank*this%nlat)/this%npes - lat1 = (this%rank+1)*this%nlat/this%npes - nlats = (lat1 - lat0 + 1) - - ! Establish the collection - ! In a real use case the collection name would be the ExtData template. - ! But the actual name does not matter - it is just used to identify - ! a group of files that have identical metadata (except for time) - !num_request = 1000 - num_request = 3 - call system_clock(c1) - - do i = 1,num_request - tmp= '' - write(tmp,'(I3.3)') i - collection_id = this%i_c%add_ext_collection('collection-i'//tmp) - collection_id = this%o_c%add_ext_collection('collection-o'//tmp) - enddo - call system_clock(c2) - - allocate(pull_ids(this%vars%size(),num_request)) - allocate(push_ids(this%vars%size(),num_request)) - - select case (step) - case (1) ! read 1st file; prefetch 2nd - - ! call system_clock(c1) - do i_var = 1, this%vars%size() - allocate(this%bundle(i_var)%x(this%nlon,lat0:lat1,1,1)) - this%bundle(i_var)%x = -1 - ref = ArrayReference(this%bundle(i_var)%x) - - do i =1, num_request - pull_ids(i_var,i) = & - & this%i_c%collective_prefetch_data(collection_id, this%file_1, this%vars%at(i_var), ref,& - & start=[1,lat0,20,1], & - & global_start=[1,1,20,1],global_count=[this%nlon,this%nlat,1,1]) - enddo - - end do - !call system_clock(c2) - call this%i_c%done_collective_prefetch() - - do i_var = 1, this%vars%size() - do i = 1, num_request - call this%i_c%wait(pull_ids(i_var,i)) - enddo - end do - - do i_var = 1, this%vars%size() - this%bundle(i_var)%x = -1 - ref = ArrayReference(this%bundle(i_var)%x) - this%bundle(i_var)%request_id = & - & this%i_c%collective_prefetch_data(collection_id, this%file_1, this%vars%at(i_var), ref,& - & start=[1,lat0,20,1], & - & global_start=[1,1,20,1],global_count=[this%nlon,this%nlat,1,1]) - end do - call this%i_c%done_collective_prefetch() - - - case (2) ! wait for 2nd file to complete - - do i_var = 1, this%vars%size() - call this%i_c%wait(this%bundle(i_var)%request_id) - end do - -!!!!!!!!!!!!!!!!! -! individual write - call fmd%add_dimension('lon',this%nlon) - call fmd%add_dimension('lat',nlats) - call fmd%add_dimension('level',1) - call fmd%add_dimension('time',1) - T1 = Variable(type=pFIO_REAL32, dimensions='lon,lat,level,time') - call fmd%add_variable('T',T1) - this%hist_collection_ids(1) = this%o_c%add_hist_collection(fmd) - - call fmd2%add_dimension('lon',this%nlon) - call fmd2%add_dimension('lat',this%nlat) - call fmd2%add_dimension('level',1) - call fmd2%add_dimension('time',1) - T2 = Variable(type=pFIO_REAL32, dimensions='lon,lat,level,time') - call fmd2%add_variable('T',T2) - this%hist_collection_ids(2) = this%o_c%add_hist_collection(fmd2) - - file_md_id = this%hist_collection_ids(1) - write(tmp,'(I3.3)') this%rank - - do i_var = 1, this%vars%size() - - ref = ArrayReference(this%bundle(i_var)%x) - - do i =1, 1 - push_ids(i_var,i) = & - & this%o_c%stage_data(file_md_id,trim(this%file_1)//'.rank_'//tmp//'.nc4', this%vars%at(i_var), ref,& - & start=[1,lat0,20,1]) - - enddo - - end do - !call system_clock(c2) - call this%o_c%done_stage() - do i_var = 1, this%vars%size() - do i = 1, 1 - call this%o_c%wait(push_ids(i_var,i)) - enddo - end do - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! writing - file_md_id = this%hist_collection_ids(2) - - do i_var = 1, this%vars%size() - - ref = ArrayReference(this%bundle(i_var)%x) - do i =1, 1 - push_ids(i_var,i) = & - & this%o_c%collective_stage_data(file_md_id, trim(this%file_1)//'.new.nc4', this%vars%at(i_var), ref,& - & start=[1,lat0,1,1], & - & global_start=[1,1,1,1],global_count=[this%nlon,this%nlat,1,1]) - - enddo - - end do - !call system_clock(c2) - call this%o_c%done_collective_stage() - do i_var = 1, this%vars%size() - do i = 1, 1 - call this%o_c%wait(push_ids(i_var,i)) - enddo - end do - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 - end select - - end subroutine run - - - subroutine finalize(this) - class (FakeExtData), intent(inout) :: this - integer :: ierror - deallocate(this%bundle) - call Mpi_Barrier(this%comm,ierror) - print*,"iclient sent terminate signal" - call this%i_c%terminate() - call Mpi_Barrier(this%comm,ierror) - print*,"oclient sent terminate signal" - call this%o_c%terminate() - end subroutine finalize - -end module FakeExtDataMod - -program main - use, intrinsic :: iso_fortran_env, only: REAL32 - use mpi - use pFIO - use io_demo_CLI - use FakeExtDataMod - use MAPL_ExceptionHandling - implicit none - - integer :: rank, npes, ierror, provided,required - integer :: status, color, key - - class(AbstractServer),pointer :: iserver,oserver - class(AbstractDirectoryService), pointer :: d_s => null() - - type (CommandLineOptions) :: options - integer, parameter :: NO_COLOR = 0 - integer, parameter :: iSERVER_COLOR = 1 - integer, parameter :: oSERVER_COLOR = 4 - integer, parameter :: CLIENT_COLOR = 2 - integer, parameter :: BOTH_COLOR = 3 - - integer :: comm,num_threads - type (FakeExtData), target :: extData - - - required = MPI_THREAD_MULTIPLE - call MPI_init_thread(required, provided, ierror) - call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) - call MPI_Comm_size(MPI_COMM_WORLD, npes, ierror) - - call process_command_line(options, rc=status) - -!! sanity check - - if(options%server_type == 'openmp') then - if (required > provided) stop "provided thread is not enough for openmp" - num_threads = 10 - call omp_set_num_threads(num_threads) - endif - - d_s => get_directory_service(options%server_type) - - color = split_color(options%server_type,options%npes_iserver,options%npes_oserver) - key = 0 - - call MPI_Comm_split(MPI_COMM_WORLD, color, key, comm, ierror) - - if (color == iSERVER_COLOR .or. color == BOTH_COLOR ) then ! i_server - - iserver=>get_server(options%server_type,comm, d_s,'i_server') - print*,"start i_server" - if (color == iSERVER_COLOR ) call iserver%start() - - endif - - if (color == oSERVER_COLOR .or. color == BOTH_COLOR ) then ! o_server - - oserver=>get_server(options%server_type,comm,d_s,'o_server') - - print*,"start o_server" - if (color == oSERVER_COLOR ) call oserver%start() - - endif - - if (color == CLIENT_COLOR .or. color == BOTH_COLOR) then ! client - - call extData%init(options, comm, d_s) - call extData%run(step=1) - call extData%run(step=2) - call extData%finalize() - - end if - - call Mpi_Barrier(MPI_COMM_WORLD,ierror) - - call MPI_finalize(ierror) - -contains - - function get_directory_service(stype) result(d_s) - character(*),intent(in) :: stype - class(AbstractDirectoryService),pointer :: d_s - - allocate(d_s, source = DirectoryService(MPI_COMM_WORLD)) - - end function - - function split_color(stype,split_irank,split_orank) result(color) - character(*),intent(in) :: stype - integer,intent(in) :: split_irank - integer,intent(in) :: split_orank - integer :: color - - select case (stype) - case ('openmp','mpi') - if (rank < split_irank) then - color = iSERVER_COLOR - elseif (rank < split_orank+split_irank ) then - color = oSERVER_COLOR - else - color = CLIENT_COLOR - end if - case ('simple') - color = BOTH_COLOR - case default - stop "not known server type" - end select - - end function - - function get_server(stype,comm,d_s,port_name) result(server) - character(*),intent(in) :: stype - integer,intent(in) :: comm - class (AbstractDirectoryService), target,intent(inout) :: d_s - character(*), intent(in) :: port_name - - class(BaseServer),pointer :: server - - select case (stype) - case('mpi') - allocate(server,source=MpiServer(comm, port_name)) - call d_s%publish(PortInfo(port_name, server),server) - call d_s%connect_to_client(port_name, server) - print*,"using MpiServer" - case('openmp') -!!$ allocate(server,source=OpenmpServer(comm,d_s)) -!!$ print*,"using OpenMpServer" - case('simple') - allocate(server,source=MpiServer(comm, port_name)) - call d_s%publish(PortInfo(port_name, server), server) -! call d_s%connect_to_client(port_name, server) - print*,"using simple server" - end select - - end function - -end program main diff --git a/pflogger_stub/pflogger_stub.F90 b/pflogger_stub/pflogger_stub.F90 index dcf56379bdf9..f35cc62bf69d 100644 --- a/pflogger_stub/pflogger_stub.F90 +++ b/pflogger_stub/pflogger_stub.F90 @@ -1,5 +1,8 @@ #include "MAPL_ErrLog.h" #define _SUCCESS 0 +#ifdef _RETURN +#undef _RETURN +#endif #define _RETURN(status) if(present(rc))rc=status; return module PFL_SeverityLevels @@ -22,7 +25,7 @@ module PFL_SeverityLevels end enum end module PFL_SeverityLevels - + module PFL_Logger use PFL_SeverityLevels, only: NOTSET use PFL_SeverityLevels, only: DEBUG_LEVEL => DEBUG @@ -60,7 +63,7 @@ end subroutine free subroutine debug(this, message, ARG_LIST, unusable, extra, line, file, rc) class (Logger), target, intent(inout) :: this character(len=*), intent(in) :: message - include 'recordOptArgs.inc' + include 'recordOptArgs.inc' class (KeywordEnforcer), optional, intent(in) :: unusable type (StringUnlimitedMap), optional, target, intent(in) :: extra integer, optional, intent(in) :: line @@ -89,7 +92,7 @@ end subroutine debug subroutine info(this, message, ARG_LIST, unusable, extra, line, file, rc) class (Logger), target, intent(inout) :: this character(len=*), intent(in) :: message - include 'recordOptArgs.inc' + include 'recordOptArgs.inc' class (KeywordEnforcer), optional, intent(in) :: unusable type (StringUnlimitedMap), optional, target, intent(in) :: extra integer, optional, intent(in) :: line @@ -118,13 +121,13 @@ end subroutine info subroutine warning(this, message, ARG_LIST, unusable, extra, line, file, rc) class (Logger), target, intent(inout) :: this character(len=*), intent(in) :: message - include 'recordOptArgs.inc' + include 'recordOptArgs.inc' class (KeywordEnforcer), optional, intent(in) :: unusable type (StringUnlimitedMap), optional, target, intent(in) :: extra integer, optional, intent(in) :: line character(*), optional, intent(in) :: file integer, optional, intent(out) :: rc - + _UNUSED_DUMMY(this) _UNUSED_DUMMY(message) _UNUSED_DUMMY(arg1) @@ -148,7 +151,7 @@ subroutine error(this, message, ARG_LIST, unusable, extra, line, file, rc) ! Log message with the integer severity 'DEBUG'. class (Logger), target, intent(inout) :: this character(len=*), intent(in) :: message - include 'recordOptArgs.inc' + include 'recordOptArgs.inc' class (KeywordEnforcer), optional, intent(in) :: unusable type (StringUnlimitedMap), optional, target, intent(in) :: extra integer, optional, intent(in) :: line @@ -177,7 +180,7 @@ end subroutine error subroutine critical(this, message, ARG_LIST, unusable, extra, line, file, rc) class (Logger), target, intent(inout) :: this character(len=*), intent(in) :: message - include 'recordOptArgs.inc' + include 'recordOptArgs.inc' class (KeywordEnforcer), optional, intent(in) :: unusable type (StringUnlimitedMap), optional, target, intent(in) :: extra integer, optional, intent(in) :: line @@ -208,7 +211,7 @@ logical function isEnabledFor(this, level) integer, intent(in) :: level isEnabledFor = .false. end function isEnabledFor - + end module PFL_Logger module PFL_LoggerManager @@ -228,7 +231,7 @@ module PFL_LoggerManager generic :: get_logger => get_logger_root procedure :: free end type LoggerManager - + type (LoggerManager), target, save :: logging contains From f6e47a709ec21c6094d03e306f454ef4b1ad1d9f Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 15 Jun 2022 13:00:51 -0400 Subject: [PATCH 168/300] Update CHANGELOG --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index f7fa063469c1..bd39acbbb3ec 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Update CI to work with latest GEOSadas `develop` (Uses a special branch of GEOSadas) - Fix bundleio tests - HistoryGridComp now checks if a file exists already before writing and errors out if so +- Minor updates for FORD documentation testing + - Add `program` statements to some test programs + - Remove `pfio/pfio_io_demo.F90` as dead code + - Fix redefinition of `_RETURN` in `pflogger_stub.F90` ### Added From fef169d5e4a10772b037ffd59d1c210795e82e7c Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 16 Jun 2022 08:27:31 -0400 Subject: [PATCH 169/300] Remove pfio/tests/Test_SimpleClient.pf --- CHANGELOG.md | 1 + pfio/tests/Test_SimpleClient.pf | 15 --------------- 2 files changed, 1 insertion(+), 15 deletions(-) delete mode 100644 pfio/tests/Test_SimpleClient.pf diff --git a/CHANGELOG.md b/CHANGELOG.md index bd39acbbb3ec..20aba8c59140 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,6 +16,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Add `program` statements to some test programs - Remove `pfio/pfio_io_demo.F90` as dead code - Fix redefinition of `_RETURN` in `pflogger_stub.F90` + - Removed unused `Test_SimpleClient.pf` ### Added diff --git a/pfio/tests/Test_SimpleClient.pf b/pfio/tests/Test_SimpleClient.pf deleted file mode 100644 index fe526bea29cb..000000000000 --- a/pfio/tests/Test_SimpleClient.pf +++ /dev/null @@ -1,15 +0,0 @@ -module Test_SimpleClient - use pFIO_SimpleClient - use pfunit - implicit none - -contains - - @test - subroutine test_ - - - call client%send(array) - - -end module Test_SimpleClient From db88ebe17a5a6f5d84d50cc7ad7415a3dc985131 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 16 Jun 2022 14:52:59 -0400 Subject: [PATCH 170/300] Update components.yaml to latest env and cmake --- .circleci/config.yml | 10 ++++++++++ .github/workflows/workflow.yml | 4 ++-- CHANGELOG.md | 4 +++- components.yaml | 4 ++-- 4 files changed, 17 insertions(+), 5 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index c703d1ca64c7..49a2d2c37434 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -1,5 +1,8 @@ version: 2.1 +# Anchor to prevent forgetting to update a version +baselibs_version: &baselibs_version v6.3.1 + orbs: ci: geos-esm/circleci-tools@1 @@ -15,6 +18,7 @@ workflows: matrix: parameters: compiler: [ifort] + baselibs_version: *baselibs_version repo: MAPL mepodevelop: false run_unit_tests: true @@ -38,6 +42,7 @@ workflows: matrix: parameters: compiler: [gfortran] + baselibs_version: *baselibs_version repo: MAPL mepodevelop: false run_unit_tests: true @@ -51,6 +56,7 @@ workflows: matrix: parameters: compiler: [ifort] + baselibs_version: *baselibs_version repo: MAPL mepodevelop: false extra_cmake_options: "-DBUILD_WITH_FLAP=OFF -DBUILD_WITH_PFLOGGER=OFF -DBUILD_SHARED_MAPL=OFF" @@ -65,6 +71,7 @@ workflows: matrix: parameters: compiler: [gfortran, ifort] + baselibs_version: *baselibs_version repo: GEOSgcm checkout_fixture: true mepodevelop: true @@ -79,6 +86,7 @@ workflows: matrix: parameters: compiler: [gfortran, ifort] + baselibs_version: *baselibs_version repo: GEOSldas mepodevelop: false checkout_fixture: true @@ -94,6 +102,7 @@ workflows: parameters: compiler: [ifort] resource_class: xlarge + baselibs_version: *baselibs_version repo: GEOSadas checkout_fixture: true # This branch on GEOSadas will be used to track subrepos needed @@ -114,3 +123,4 @@ workflows: requires: - build-GEOSgcm-on-<< matrix.compiler >> repo: GEOSgcm + baselibs_version: *baselibs_version diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 9df322623204..1ce85fe7eaa1 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -17,7 +17,7 @@ jobs: name: Build and Test MAPL runs-on: ubuntu-latest container: - image: gmao/ubuntu20-geos-env-mkl:v6.2.13-openmpi_4.1.2-gcc_11.2.0 + image: gmao/ubuntu20-geos-env-mkl:v6.3.1-openmpi_4.1.2-gcc_11.2.0 # Per https://github.com/actions/virtual-environments/issues/1445#issuecomment-713861495 # It seems like we might not need secrets on GitHub Actions which is good for forked # pull requests @@ -74,7 +74,7 @@ jobs: name: Build and Test MAPL Intel runs-on: ubuntu-latest container: - image: gmao/ubuntu20-geos-env:v6.2.13-intelmpi_2021.3.0-intel_2021.3.0 + image: gmao/ubuntu20-geos-env:v6.3.1-intelmpi_2021.3.0-intel_2021.3.0 # Per https://github.com/actions/virtual-environments/issues/1445#issuecomment-713861495 # It seems like we might not need secrets on GitHub Actions which is good for forked # pull requests diff --git a/CHANGELOG.md b/CHANGELOG.md index 20aba8c59140..5e6cccadcdf5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -31,10 +31,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed - Modified error messages in FileMetadataUtilities to be unique and print filename -- Updated the ESMA_cmake version to v3.16.0 +- Updated the ESMA_env version to v3.14.0 +- Updated the ESMA_cmake version to v3.17.0 - Updated GitHub Actions MAPL build tests - Added assert for missing file with ExtData2G - Re-enable bundleio tests in CI +- Updated CircleCI to use latest Baselibs ### Removed diff --git a/components.yaml b/components.yaml index d84e5e3017a0..35913f85302e 100644 --- a/components.yaml +++ b/components.yaml @@ -5,13 +5,13 @@ MAPL: ESMA_env: local: ./ESMA_env remote: ../ESMA_env.git - tag: v3.13.0 + tag: v3.14.0 develop: main ESMA_cmake: local: ./ESMA_cmake remote: ../ESMA_cmake.git - tag: v3.16.0 + tag: v3.17.0 develop: develop ecbuild: From c76f20f415662134aabd31212511918908590655 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 17 Jun 2022 08:54:03 -0400 Subject: [PATCH 171/300] Try to get GEOSldas to work --- .circleci/config.yml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 49a2d2c37434..b0573fa2bf02 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -88,7 +88,9 @@ workflows: compiler: [gfortran, ifort] baselibs_version: *baselibs_version repo: GEOSldas - mepodevelop: false + #mepodevelop: false # Until GEOSldas updates its cmake, we need to update it here + mepodevelop: true + develop_repos: "cmake" checkout_fixture: true fixture_branch: develop checkout_mapl_branch: true From 0cfa10c6a9cb931167cdc7bd250662d9cd2b47b4 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 17 Jun 2022 10:12:51 -0400 Subject: [PATCH 172/300] GEOSldas is updated. Push --- .circleci/config.yml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index b0573fa2bf02..49a2d2c37434 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -88,9 +88,7 @@ workflows: compiler: [gfortran, ifort] baselibs_version: *baselibs_version repo: GEOSldas - #mepodevelop: false # Until GEOSldas updates its cmake, we need to update it here - mepodevelop: true - develop_repos: "cmake" + mepodevelop: false checkout_fixture: true fixture_branch: develop checkout_mapl_branch: true From f93dab2b48d962a337539de90e1771133ff17765 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Sat, 18 Jun 2022 13:57:47 -0400 Subject: [PATCH 173/300] by pass missing value of NaN --- base/FileMetadataUtilities.F90 | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/base/FileMetadataUtilities.F90 b/base/FileMetadataUtilities.F90 index 695bffe89e5b..4168df2d3305 100644 --- a/base/FileMetadataUtilities.F90 +++ b/base/FileMetadataUtilities.F90 @@ -83,11 +83,28 @@ logical function var_has_missing_value(this,var_name,rc) integer :: status character(:), allocatable :: fname type(Variable), pointer :: var + class(Attribute), pointer :: attr + class(*), pointer :: value fname = this%get_file_name(_RC) var => this%get_variable(var_name,_RC) _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) - var_has_missing_value = var%is_attribute_present("_FillValue") + + var_has_missing_value = .false. + if ( var%is_attribute_present("_FillValue")) then + attr=>var%get_attribute("_FillValue") + value =>attr%get_value() + select type(value) + type is (real(kind=REAL64)) + var_has_missing_value = .true. + type is (real(kind=REAL32)) + var_has_missing_value = .true. + type is (integer(kind=INT64)) + var_has_missing_value = .true. + type is (integer(kind=INT32)) + var_has_missing_value = .true. + end select + endif _RETURN(_SUCCESS) end function var_has_missing_value From e63aec1bfc059e865bfe6f4bdab7baa869214bd0 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Sat, 18 Jun 2022 14:01:10 -0400 Subject: [PATCH 174/300] change log --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6bd9daa74074..f7e249900895 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- By pass the check of the missing value of Nan - Update CI to work with latest GEOSadas `develop` (Uses a special branch of GEOSadas) - Fix bundleio tests - HistoryGridComp now checks if a file exists already before writing and errors out if so From cbfb498e5a9de3504a46a4a9bf0bd849ee6bf7a2 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 22 Jun 2022 00:06:09 -0400 Subject: [PATCH 175/300] by pass in request data call --- base/FileMetadataUtilities.F90 | 19 +------------------ griddedio/GriddedIO.F90 | 4 ++++ 2 files changed, 5 insertions(+), 18 deletions(-) diff --git a/base/FileMetadataUtilities.F90 b/base/FileMetadataUtilities.F90 index 4168df2d3305..695bffe89e5b 100644 --- a/base/FileMetadataUtilities.F90 +++ b/base/FileMetadataUtilities.F90 @@ -83,28 +83,11 @@ logical function var_has_missing_value(this,var_name,rc) integer :: status character(:), allocatable :: fname type(Variable), pointer :: var - class(Attribute), pointer :: attr - class(*), pointer :: value fname = this%get_file_name(_RC) var => this%get_variable(var_name,_RC) _ASSERT(associated(var),"no variable named "//var_name//" in "//fname) - - var_has_missing_value = .false. - if ( var%is_attribute_present("_FillValue")) then - attr=>var%get_attribute("_FillValue") - value =>attr%get_value() - select type(value) - type is (real(kind=REAL64)) - var_has_missing_value = .true. - type is (real(kind=REAL32)) - var_has_missing_value = .true. - type is (integer(kind=INT64)) - var_has_missing_value = .true. - type is (integer(kind=INT32)) - var_has_missing_value = .true. - end select - endif + var_has_missing_value = var%is_attribute_present("_FillValue") _RETURN(_SUCCESS) end function var_has_missing_value diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index d28851bfbb43..4a7ffcf898ad 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -1013,6 +1013,10 @@ subroutine request_data_from_file(this,filename,timeindex,rc) this%read_collection_id, fileName, trim(names(i)), & & ref, start=localStart, global_start=globalStart, global_count=globalCount) deallocate(localStart,globalStart,globalCount) + ! if is Nan, do not set '_FillValue'. + ! The pair ESMF_AttributeSet and ESMF_AttributeGet cannot handle Nan + if (missing_value /= missing_value) cycle + if (missing_value /= MAPL_UNDEF) then call ESMF_AttributeSet(input_fields(i),name=fill_value_label,value=missing_value,_RC) end if From 3b9d10b45e15c0878b801aaa31d2ba5be2da5725 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 22 Jun 2022 09:16:21 -0400 Subject: [PATCH 176/300] test Nan and change Nan to MAPL_Undef --- griddedio/GriddedIO.F90 | 56 +++++++++++++++++++++++++---------------- 1 file changed, 35 insertions(+), 21 deletions(-) diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index 4a7ffcf898ad..82a3b1497cd5 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -24,6 +24,7 @@ module MAPL_GriddedIOMod use MAPL_FileMetadataUtilsMod use, intrinsic :: ISO_C_BINDING use, intrinsic :: iso_fortran_env, only: REAL64 + use ieee_arithmetic, only: isnan => ieee_is_nan implicit none private @@ -1015,7 +1016,7 @@ subroutine request_data_from_file(this,filename,timeindex,rc) deallocate(localStart,globalStart,globalCount) ! if is Nan, do not set '_FillValue'. ! The pair ESMF_AttributeSet and ESMF_AttributeGet cannot handle Nan - if (missing_value /= missing_value) cycle + if (isnan(missing_value)) cycle if (missing_value /= MAPL_UNDEF) then call ESMF_AttributeSet(input_fields(i),name=fill_value_label,value=missing_value,_RC) @@ -1092,31 +1093,44 @@ subroutine swap_undef_value(this,fname,rc) call ESMF_AttributeGet(field,name=fill_value_label,isPresent=has_custom_fill_val,_RC) if (has_custom_fill_val) then - call ESMF_AttributeGet(field,name=fill_value_label,value=fill_value,_RC) - call ESMF_FieldGet(field,rank=fieldRank,_RC) - _VERIFY(status) - call ESMF_FieldBundleGet(this%input_bundle,grid=gridIn,_RC) - hasDE_in = MAPL_GridHasDE(gridIn,_RC) + endif + + call ESMF_FieldGet(field,rank=fieldRank,_RC) + _VERIFY(status) + call ESMF_FieldBundleGet(this%input_bundle,grid=gridIn,_RC) + hasDE_in = MAPL_GridHasDE(gridIn,_RC) - if (fieldRank==2) then - if (hasDE_in) then - call MAPL_FieldGetPointer(field,ptr2d,_RC) - else - allocate(ptr2d(0,0)) - end if - where(ptr2d==fill_value) ptr2d=MAPL_UNDEF - else if (fieldRank==3) then - if (hasDE_in) then - call ESMF_FieldGet(field,farrayPtr=ptr3d,_RC) - else - allocate(ptr3d(0,0,0)) - end if - where(ptr3d==fill_value) ptr3d=MAPL_UNDEF + if (fieldRank==2) then + if (hasDE_in) then + call MAPL_FieldGetPointer(field,ptr2d,_RC) else - _FAIL('rank not supported') + allocate(ptr2d(0,0)) end if + else if (fieldRank==3) then + if (hasDE_in) then + call ESMF_FieldGet(field,farrayPtr=ptr3d,_RC) + else + allocate(ptr3d(0,0,0)) + end if + else + _FAIL('rank not supported') end if + + if (associated(ptr2d)) then + if (has_custom_fill_val) then + where(ptr2d==fill_value) ptr2d=MAPL_UNDEF + else + where(isnan(ptr2d)) ptr2d=MAPL_UNDEF + endif + else if (associated(ptr3d)) then + if (has_custom_fill_val) then + where(ptr3d==fill_value) ptr3d=MAPL_UNDEF + else + where(isnan(ptr3d)) ptr3d=MAPL_UNDEF + endif + endif + _RETURN(_SUCCESS) end subroutine swap_undef_value From f5e34e9336d6cfdc8d5ab35e7e035e4cc7ccfe14 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 22 Jun 2022 11:40:17 -0400 Subject: [PATCH 177/300] save metadata to cfio --- griddedio/GriddedIO.F90 | 37 ++++++++++++++----------------------- 1 file changed, 14 insertions(+), 23 deletions(-) diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index 82a3b1497cd5..29cad7275729 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -944,7 +944,7 @@ subroutine request_data_from_file(this,filename,timeindex,rc) collection => Datacollections%at(this%metadata_collection_id) metadata => collection%find(filename, __RC__) - + this%metadata = metadata filegrid = collection%src_grid factory => get_factory(filegrid) hasDE=MAPL_GridHasDE(filegrid,rc=status) @@ -1014,13 +1014,6 @@ subroutine request_data_from_file(this,filename,timeindex,rc) this%read_collection_id, fileName, trim(names(i)), & & ref, start=localStart, global_start=globalStart, global_count=globalCount) deallocate(localStart,globalStart,globalCount) - ! if is Nan, do not set '_FillValue'. - ! The pair ESMF_AttributeSet and ESMF_AttributeGet cannot handle Nan - if (isnan(missing_value)) cycle - - if (missing_value /= MAPL_UNDEF) then - call ESMF_AttributeSet(input_fields(i),name=fill_value_label,value=missing_value,_RC) - end if enddo deallocate(gridLocalStart,gridGlobalStart,gridGlobalCount) this%input_bundle = ESMF_FieldBundleCreate(fieldList=input_fields,rc=status) @@ -1086,19 +1079,17 @@ subroutine swap_undef_value(this,fname,rc) real, pointer :: ptr3d(:,:,:) real, pointer :: ptr2d(:,:) type(ESMF_Grid) :: gridIn - logical :: hasDE_in,has_custom_fill_val + logical :: hasDE_in real(REAL32) :: fill_value - call ESMF_FieldBundleGet(this%input_bundle,fname,field=field,_RC) - call ESMF_AttributeGet(field,name=fill_value_label,isPresent=has_custom_fill_val,_RC) - - if (has_custom_fill_val) then - call ESMF_AttributeGet(field,name=fill_value_label,value=fill_value,_RC) + if ( .not. this%metadata%var_has_missing_value(fname) ) + _RETURN(_SUCCESS) endif - + + fill_value = this%metadata%var_get_missing_value(fname,_RC) + + call ESMF_FieldBundleGet(this%input_bundle,fname,field=field, grid=gridIn, _RC) call ESMF_FieldGet(field,rank=fieldRank,_RC) - _VERIFY(status) - call ESMF_FieldBundleGet(this%input_bundle,grid=gridIn,_RC) hasDE_in = MAPL_GridHasDE(gridIn,_RC) if (fieldRank==2) then @@ -1118,16 +1109,16 @@ subroutine swap_undef_value(this,fname,rc) end if if (associated(ptr2d)) then - if (has_custom_fill_val) then - where(ptr2d==fill_value) ptr2d=MAPL_UNDEF - else + if (isnan(fill_value)) then where(isnan(ptr2d)) ptr2d=MAPL_UNDEF + else + where(ptr2d==fill_value) ptr2d=MAPL_UNDEF endif else if (associated(ptr3d)) then - if (has_custom_fill_val) then - where(ptr3d==fill_value) ptr3d=MAPL_UNDEF - else + if (isnan(fill_value)) then where(isnan(ptr3d)) ptr3d=MAPL_UNDEF + else + where(ptr3d==fill_value) ptr3d=MAPL_UNDEF endif endif From 247248c1583ed4f86f265a256c6abbbd05fd68a4 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 22 Jun 2022 12:05:19 -0400 Subject: [PATCH 178/300] add the field current_file_metadata --- griddedio/GriddedIO.F90 | 19 ++++++------------- 1 file changed, 6 insertions(+), 13 deletions(-) diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index 29cad7275729..108dd334d071 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -29,10 +29,9 @@ module MAPL_GriddedIOMod private - character(len=20), parameter :: fill_value_label = "GriddedIO_Fill_Value" - type, public :: MAPL_GriddedIO type(FileMetaData) :: metadata + type(fileMetadataUtils), pointer :: current_file_metadata integer :: write_collection_id integer :: read_collection_id integer :: metadata_collection_id @@ -939,12 +938,10 @@ subroutine request_data_from_file(this,filename,timeindex,rc) type(ESMF_Grid) :: output_grid logical :: hasDE class(AbstractGridFactory), pointer :: factory - type(fileMetadataUtils), pointer :: metadata real(REAL32) :: missing_value collection => Datacollections%at(this%metadata_collection_id) - metadata => collection%find(filename, __RC__) - this%metadata = metadata + this%current_file_metadata => collection%find(filename, __RC__) filegrid = collection%src_grid factory => get_factory(filegrid) hasDE=MAPL_GridHasDE(filegrid,rc=status) @@ -957,7 +954,7 @@ subroutine request_data_from_file(this,filename,timeindex,rc) end if call MAPL_GridGet(filegrid,globalCellCountPerdim=dims,rc=status) _VERIFY(status) - call factory%generate_file_bounds(fileGrid,gridLocalStart,gridGlobalStart,gridGlobalCount,metadata=metadata%fileMetadata,rc=status) + call factory%generate_file_bounds(fileGrid,gridLocalStart,gridGlobalStart,gridGlobalCount,metadata=this%current_file_metadata%fileMetadata,rc=status) _VERIFY(status) ! create input bundle call ESMF_FieldBundleGet(this%output_bundle,fieldCount=numVars,rc=status) @@ -973,10 +970,6 @@ subroutine request_data_from_file(this,filename,timeindex,rc) _VERIFY(status) call ESMF_FieldGet(output_field,rank=rank,rc=status) _VERIFY(status) - missing_value = MAPL_UNDEF - if (metadata%var_has_missing_value(trim(names(i)))) then - missing_value = metadata%var_get_missing_value(trim(names(i)),_RC) - end if if (rank==2) then input_fields(i) = ESMF_FieldCreate(filegrid,typekind=ESMF_TYPEKIND_R4,gridToFieldMap=[1,2],name=trim(names(i)),rc=status) _VERIFY(status) @@ -1005,7 +998,7 @@ subroutine request_data_from_file(this,filename,timeindex,rc) allocate(ptr3d(0,0,0),stat=status) _VERIFY(status) end if - ref=factory%generate_file_reference3D(ptr3d,metadata=metadata%filemetadata) + ref=factory%generate_file_reference3D(ptr3d,metadata=this%current_file_metadata%filemetadata) allocate(localStart,source=[gridLocalStart,1,timeIndex]) allocate(globalStart,source=[gridGlobalStart,1,timeIndex]) allocate(globalCount,source=[gridGlobalCount,lm,1]) @@ -1082,11 +1075,11 @@ subroutine swap_undef_value(this,fname,rc) logical :: hasDE_in real(REAL32) :: fill_value - if ( .not. this%metadata%var_has_missing_value(fname) ) + if ( .not. this%current_file_metadata%var_has_missing_value(fname) ) _RETURN(_SUCCESS) endif - fill_value = this%metadata%var_get_missing_value(fname,_RC) + fill_value = this%current_file_metadata%var_get_missing_value(fname,_RC) call ESMF_FieldBundleGet(this%input_bundle,fname,field=field, grid=gridIn, _RC) call ESMF_FieldGet(field,rank=fieldRank,_RC) From 5bd1910525b6aace0ca25c9e46781c739cfb4828 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang <52509753+weiyuan-jiang@users.noreply.github.com> Date: Wed, 22 Jun 2022 17:35:54 -0400 Subject: [PATCH 179/300] fix typos --- griddedio/GriddedIO.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index 108dd334d071..c0b96e7ddb00 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -1075,13 +1075,14 @@ subroutine swap_undef_value(this,fname,rc) logical :: hasDE_in real(REAL32) :: fill_value - if ( .not. this%current_file_metadata%var_has_missing_value(fname) ) + if ( .not. this%current_file_metadata%var_has_missing_value(fname) ) then _RETURN(_SUCCESS) endif fill_value = this%current_file_metadata%var_get_missing_value(fname,_RC) - call ESMF_FieldBundleGet(this%input_bundle,fname,field=field, grid=gridIn, _RC) + call ESMF_FieldBundleGet(this%input_bundle,fname,field=field,_RC) + call ESMF_FieldBundleGet(this%input_bundle,grid=gridIn,_RC) call ESMF_FieldGet(field,rank=fieldRank,_RC) hasDE_in = MAPL_GridHasDE(gridIn,_RC) From 961d4dedc8a4a04f6a40604945d20213acd12bdd Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 22 Jun 2022 22:49:13 -0400 Subject: [PATCH 180/300] re-block check --- griddedio/GriddedIO.F90 | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index 108dd334d071..43e97b5e05f2 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -1091,29 +1091,29 @@ subroutine swap_undef_value(this,fname,rc) else allocate(ptr2d(0,0)) end if + + if (isnan(fill_value)) then + where(isnan(ptr2d)) ptr2d=MAPL_UNDEF + else + where(ptr2d==fill_value) ptr2d=MAPL_UNDEF + endif + else if (fieldRank==3) then if (hasDE_in) then call ESMF_FieldGet(field,farrayPtr=ptr3d,_RC) else allocate(ptr3d(0,0,0)) end if - else - _FAIL('rank not supported') - end if - if (associated(ptr2d)) then - if (isnan(fill_value)) then - where(isnan(ptr2d)) ptr2d=MAPL_UNDEF - else - where(ptr2d==fill_value) ptr2d=MAPL_UNDEF - endif - else if (associated(ptr3d)) then if (isnan(fill_value)) then where(isnan(ptr3d)) ptr3d=MAPL_UNDEF else where(ptr3d==fill_value) ptr3d=MAPL_UNDEF endif - endif + + else + _FAIL('rank not supported') + end if _RETURN(_SUCCESS) From 5ace0e718105782c3de459564cb30cbc44b4fd41 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 23 Jun 2022 12:28:24 -0500 Subject: [PATCH 181/300] fixed CMakeLists.txt --- CMakeLists.txt | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 8804ee877955..cd77e85fd5af 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -129,11 +129,14 @@ if (NOT Baselibs_FOUND) find_package(ESMF MODULE REQUIRED) # ESMF as used in MAPL requires MPI - target_link_libraries(ESMF INTERFACE MPI::MPI_Fortran) - - # MAPL and GEOS use lowercase target due to historical reasons but - # the latest FindESMF.cmake file from ESMF produces an ESMF target. - add_library(esmf ALIAS ESMF) + if (TARGET esmf) + target_link_libraries(esmf INTERFACE MPI::MPI_Fortran) + else() + target_link_libraries(ESMF INTERFACE MPI::MPI_Fortran) + # MAPL and GEOS use lowercase target due to historical reasons but + # the latest FindESMF.cmake file from ESMF produces an ESMF target. + add_library(esmf ALIAS ESMF) + endif() endif () endif () From e79c77224095546aaa0fba7d130f10282d223f30 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 23 Jun 2022 14:11:36 -0400 Subject: [PATCH 182/300] Add NetCDF C requirement to CMake --- CHANGELOG.md | 1 + CMakeLists.txt | 2 +- pfio/CMakeLists.txt | 4 ++-- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6bd9daa74074..f06bf2c7c10a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Remove `pfio/pfio_io_demo.F90` as dead code - Fix redefinition of `_RETURN` in `pflogger_stub.F90` - Removed unused `Test_SimpleClient.pf` +- Update CMake to require NetCDF C components and add `NetCDF::NetCDF_C` to pfio CMake ### Added diff --git a/CMakeLists.txt b/CMakeLists.txt index 8804ee877955..fffa466d23c5 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -114,7 +114,7 @@ if (NOT Baselibs_FOUND) set(MPI_DETERMINE_LIBRARY_VERSION TRUE) find_package(MPI) - find_package(NetCDF REQUIRED Fortran) + find_package(NetCDF REQUIRED C Fortran) add_definitions(-DHAS_NETCDF4) add_definitions(-DHAS_NETCDF3) add_definitions(-DNETCDF_NEED_NF_MPIIO) diff --git a/pfio/CMakeLists.txt b/pfio/CMakeLists.txt index f3574f53c43f..f0e85631d0fe 100644 --- a/pfio/CMakeLists.txt +++ b/pfio/CMakeLists.txt @@ -91,7 +91,7 @@ set (srcs StringVectorUtil.F90 ) -esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.profiler NetCDF::NetCDF_Fortran TYPE ${MAPL_LIBRARY_TYPE}) +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.profiler NetCDF::NetCDF_Fortran NetCDF::NetCDF_C TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL_SHARED::gftl-shared PRIVATE MPI::MPI_Fortran) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") @@ -135,7 +135,7 @@ endif () ecbuild_add_executable ( TARGET pfio_writer.x SOURCES pfio_writer.F90 - LIBS ${this} NetCDF::NetCDF_Fortran MPI::MPI_Fortran) + LIBS ${this} NetCDF::NetCDF_Fortran NetCDF::NetCDF_C MPI::MPI_Fortran) set_target_properties (pfio_writer.x PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) #-------------------- From 9d5968b53c8d2352689010a574b520c195765720 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 23 Jun 2022 14:20:43 -0400 Subject: [PATCH 183/300] Add comment about ESMF library CMake --- CMakeLists.txt | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index cd77e85fd5af..a319c18150f0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -129,9 +129,12 @@ if (NOT Baselibs_FOUND) find_package(ESMF MODULE REQUIRED) # ESMF as used in MAPL requires MPI + # NOTE: This looks odd because some versions of FindESMF.cmake out in the + # world provide an "esmf" target while others provide "ESMF". So we + # need this ugliness to support both. if (TARGET esmf) target_link_libraries(esmf INTERFACE MPI::MPI_Fortran) - else() + else() target_link_libraries(ESMF INTERFACE MPI::MPI_Fortran) # MAPL and GEOS use lowercase target due to historical reasons but # the latest FindESMF.cmake file from ESMF produces an ESMF target. From 8a9ab11908b9878347e4c4e0582bc159fc80fc2b Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 23 Jun 2022 15:49:11 -0400 Subject: [PATCH 184/300] Add YAML Linter --- .github/workflows/changelog-enforcer.yml | 2 +- .github/workflows/validate_yaml_files.yml | 24 +++++++++++++++ .yamllint.yml | 29 +++++++++++++++++++ CHANGELOG.md | 2 ++ .../test_cases/case11/extdata.yaml | 2 +- .../test_cases/case23/extdata.yaml | 2 +- 6 files changed, 58 insertions(+), 3 deletions(-) create mode 100644 .github/workflows/validate_yaml_files.yml create mode 100644 .yamllint.yml diff --git a/.github/workflows/changelog-enforcer.yml b/.github/workflows/changelog-enforcer.yml index 1e9cb2979097..cd31258b2684 100644 --- a/.github/workflows/changelog-enforcer.yml +++ b/.github/workflows/changelog-enforcer.yml @@ -4,7 +4,7 @@ on: types: [opened, synchronize, reopened, ready_for_review, labeled, unlabeled] jobs: - # Enforces the update of a changelog file on every pull request + # Enforces the update of a changelog file on every pull request changelog: runs-on: ubuntu-latest steps: diff --git a/.github/workflows/validate_yaml_files.yml b/.github/workflows/validate_yaml_files.yml new file mode 100644 index 000000000000..b87f59d99d05 --- /dev/null +++ b/.github/workflows/validate_yaml_files.yml @@ -0,0 +1,24 @@ +--- +name: Yaml Lint + +on: + pull_request: + types: [opened, synchronize, reopened, ready_for_review, labeled, unlabeled] +jobs: + validate-YAML: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v2 + - id: yaml-lint + name: yaml-lint + uses: ibiqlik/action-yamllint@v3 + with: + no_warnings: true + format: colored + config_file: .yamllint.yml + + - uses: actions/upload-artifact@v2 + if: always() + with: + name: yamllint-logfile + path: ${{ steps.yaml-lint.outputs.logfile }} diff --git a/.yamllint.yml b/.yamllint.yml new file mode 100644 index 000000000000..83f5340c7fdf --- /dev/null +++ b/.yamllint.yml @@ -0,0 +1,29 @@ +--- + +extends: default + +rules: + braces: + level: warning + max-spaces-inside: 1 + brackets: + level: warning + max-spaces-inside: 1 + colons: + level: warning + commas: + level: warning + comments: disable + comments-indentation: disable + document-start: disable + empty-lines: + level: warning + hyphens: + level: warning + indentation: + level: warning + indent-sequences: consistent + line-length: + level: warning + allow-non-breakable-inline-mappings: true + truthy: disable diff --git a/CHANGELOG.md b/CHANGELOG.md index f06bf2c7c10a..ebf770d624c5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -28,6 +28,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Added monotonic regridding option - Make availalbe to History and ExtData2G all supported regridding methods - Add test cases for ExtData +- Add YAML validator GitHub Action + - This action makes sure all YAML files are valid (to a relaxed standard) ### Changed diff --git a/Tests/ExtData_Testing_Framework/test_cases/case11/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case11/extdata.yaml index f5641f693d84..6738280d70a4 100644 --- a/Tests/ExtData_Testing_Framework/test_cases/case11/extdata.yaml +++ b/Tests/ExtData_Testing_Framework/test_cases/case11/extdata.yaml @@ -1,4 +1,4 @@ Collections: fstream1: {template: "case1.%y4%m2.nc4", valid_range: "2006-01-01/2007-12-31" } Exports: - VAR2D: {variable: VAR2D, collection: fstream1, sample: {extrapolation: clim}} + VAR2D: {variable: VAR2D, collection: fstream1, sample: {extrapolation: clim}} diff --git a/Tests/ExtData_Testing_Framework/test_cases/case23/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case23/extdata.yaml index 62007858b755..49fa281346d1 100644 --- a/Tests/ExtData_Testing_Framework/test_cases/case23/extdata.yaml +++ b/Tests/ExtData_Testing_Framework/test_cases/case23/extdata.yaml @@ -6,6 +6,6 @@ Samplings: extrapolation: clim source_time: "2016-01-01/2016-12-31" Exports: - VAR2D: + VAR2D: - {starting: 1970-01-01, variable: VAR2D, collection: fstream1, sample: S1} - {starting: 2020-01-01, variable: VAR2D, collection: fstream2} From 1744fb4d1ab96457973ce7a8efb78f7ae0d3a864 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 23 Jun 2022 15:51:51 -0400 Subject: [PATCH 185/300] Add comments about yaml linter --- .github/workflows/validate_yaml_files.yml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/.github/workflows/validate_yaml_files.yml b/.github/workflows/validate_yaml_files.yml index b87f59d99d05..ff19b0d6e695 100644 --- a/.github/workflows/validate_yaml_files.yml +++ b/.github/workflows/validate_yaml_files.yml @@ -1,9 +1,16 @@ --- + +# Based on code from https://github.com/marketplace/actions/yaml-lint + name: Yaml Lint on: pull_request: types: [opened, synchronize, reopened, ready_for_review, labeled, unlabeled] + +# This validation is equivalent to running on the command line: +# yamllint -d relaxed --no-warnings +# and is controlled by the .yamllint.yml file jobs: validate-YAML: runs-on: ubuntu-latest From 6f7b2d21546e595dc2f9868428e17947a6ef75e5 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 24 Jun 2022 09:29:44 -0400 Subject: [PATCH 186/300] Update CHANGELOG and CMakeLists for 2.22.0 Release --- CHANGELOG.md | 16 ++++++++++++---- CMakeLists.txt | 2 +- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index cd59d38a03a9..07e285887c75 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,18 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +### Added + +### Changed + +### Removed + +### Deprecated + +## [2.22.0] - 2022-06-24 + +### Fixed + - By pass the check of the missing value of Nan - Update CI to work with latest GEOSadas `develop` (Uses a special branch of GEOSadas) - Fix bundleio tests @@ -46,10 +58,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Add explicit interface dependence of `MPI` for `ESMF` target - Add `esmf` alias library for `ESMF` for compatibility -### Removed - -### Deprecated - ## [2.21.3] - 2022-06-07 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index a7ed98affc42..e6e2bfab0487 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.21.3 + VERSION 2.22.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the default build type to release From 420c3aaa2af47bafb19e956792ebbcfe1902a3f3 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 11:41:59 -0400 Subject: [PATCH 187/300] my proposal tutorial --- CMakeLists.txt | 1 + generic/MAPL_Generic.F90 | 64 +++++++++++++ gridcomps/Cap/CMakeLists.txt | 2 +- gridcomps/Cap/CapOptions.F90 | 1 + gridcomps/Cap/FlapCLI.F90 | 12 +++ gridcomps/Cap/MAPL_Cap.F90 | 21 +++- gridcomps/Cap/MAPL_CapGridComp.F90 | 39 +++++--- tutorial/CMakeLists.txt | 5 + tutorial/driver_app/CMakeLists.txt | 8 ++ tutorial/driver_app/Example_Driver.F90 | 22 +++++ tutorial/grid_comps/CMakeLists.txt | 6 ++ .../hello_world_gridcomp/CMakeLists.txt | 10 ++ .../HelloWorld_GridComp.F90 | 75 +++++++++++++++ .../grid_comps/leaf_comp_a/AAA_GridComp.F90 | 83 ++++++++++++++++ .../grid_comps/leaf_comp_a/CMakeLists.txt | 10 ++ .../grid_comps/leaf_comp_b/BBB_GridComp.F90 | 77 +++++++++++++++ .../grid_comps/leaf_comp_b/CMakeLists.txt | 10 ++ .../no_children_gridcomp/CMakeLists.txt | 10 ++ .../NoChildren_GridComp.F90 | 82 ++++++++++++++++ .../one_child_gridcomp/CMakeLists.txt | 10 ++ .../one_child_gridcomp/OneChild_GridComp.F90 | 87 +++++++++++++++++ .../two_siblings_gridcomp/CMakeLists.txt | 10 ++ .../TwoSiblings_GridComp.F90 | 96 +++++++++++++++++++ tutorial/run_tutorial_case.sh | 29 ++++++ .../tutorials/hello_world_tutorial/CAP.rc | 11 +++ .../tutorials/hello_world_tutorial/ExtData.rc | 0 .../tutorials/hello_world_tutorial/HISTORY.rc | 5 + .../hello_world_tutorial/cap_restart | 1 + .../hello_world_tutorial/hello_world.rc | 10 ++ .../tutorials/hello_world_tutorial/root_lib | 1 + .../tutorials/no_children_tutorial/CAP.rc | 11 +++ .../tutorials/no_children_tutorial/ExtData.rc | 0 .../tutorials/no_children_tutorial/HISTORY.rc | 12 +++ .../no_children_tutorial/cap_restart | 1 + .../tutorials/no_children_tutorial/root.rc | 12 +++ .../tutorials/no_children_tutorial/root_lib | 1 + 36 files changed, 816 insertions(+), 19 deletions(-) create mode 100644 tutorial/CMakeLists.txt create mode 100644 tutorial/driver_app/CMakeLists.txt create mode 100644 tutorial/driver_app/Example_Driver.F90 create mode 100644 tutorial/grid_comps/CMakeLists.txt create mode 100644 tutorial/grid_comps/hello_world_gridcomp/CMakeLists.txt create mode 100644 tutorial/grid_comps/hello_world_gridcomp/HelloWorld_GridComp.F90 create mode 100644 tutorial/grid_comps/leaf_comp_a/AAA_GridComp.F90 create mode 100644 tutorial/grid_comps/leaf_comp_a/CMakeLists.txt create mode 100644 tutorial/grid_comps/leaf_comp_b/BBB_GridComp.F90 create mode 100644 tutorial/grid_comps/leaf_comp_b/CMakeLists.txt create mode 100644 tutorial/grid_comps/no_children_gridcomp/CMakeLists.txt create mode 100644 tutorial/grid_comps/no_children_gridcomp/NoChildren_GridComp.F90 create mode 100644 tutorial/grid_comps/one_child_gridcomp/CMakeLists.txt create mode 100644 tutorial/grid_comps/one_child_gridcomp/OneChild_GridComp.F90 create mode 100644 tutorial/grid_comps/two_siblings_gridcomp/CMakeLists.txt create mode 100644 tutorial/grid_comps/two_siblings_gridcomp/TwoSiblings_GridComp.F90 create mode 100755 tutorial/run_tutorial_case.sh create mode 100644 tutorial/tutorials/hello_world_tutorial/CAP.rc create mode 100644 tutorial/tutorials/hello_world_tutorial/ExtData.rc create mode 100644 tutorial/tutorials/hello_world_tutorial/HISTORY.rc create mode 100644 tutorial/tutorials/hello_world_tutorial/cap_restart create mode 100644 tutorial/tutorials/hello_world_tutorial/hello_world.rc create mode 100644 tutorial/tutorials/hello_world_tutorial/root_lib create mode 100644 tutorial/tutorials/no_children_tutorial/CAP.rc create mode 100644 tutorial/tutorials/no_children_tutorial/ExtData.rc create mode 100644 tutorial/tutorials/no_children_tutorial/HISTORY.rc create mode 100644 tutorial/tutorials/no_children_tutorial/cap_restart create mode 100644 tutorial/tutorials/no_children_tutorial/root.rc create mode 100644 tutorial/tutorials/no_children_tutorial/root_lib diff --git a/CMakeLists.txt b/CMakeLists.txt index e6e2bfab0487..508ea23807d5 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -163,6 +163,7 @@ add_subdirectory (base) add_subdirectory (MAPL) add_subdirectory (gridcomps) add_subdirectory (griddedio) +add_subdirectory (tutorial) if (PFUNIT_FOUND) include (add_pfunit_ctest) diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index a712c2485bc9..0fd2d499d763 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -243,6 +243,7 @@ module MAPL_GenericMod module procedure AddChildFromMeta module procedure AddChildFromDSO_old module procedure AddChildFromDSO + module procedure AddChildFromDSOMeta end interface MAPL_AddChild interface MAPL_AddImportSpec @@ -4784,6 +4785,69 @@ recursive integer function AddChildFromGC(GC, name, SS, petList, configFile, RC) _RETURN(ESMF_SUCCESS) end function AddChildFromGC + recursive integer function AddChildFromDSOMeta(meta, name, userRoutine, grid, sharedObj, petList, configFile, parentGC, RC) + + !ARGUMENTS: + type(MAPL_MetaComp), target, intent(INOUT) :: META + character(len=*), intent(IN) :: name + character(len=*), intent(in) :: userRoutine + type(ESMF_Grid), optional, intent(INout) :: grid + character(len=*), optional, intent(in) :: sharedObj + + integer, optional , intent(IN ) :: petList(:) + character(len=*), optional, intent(IN ) :: configFile + type(ESMF_GridComp), optional, intent(IN ) :: parentGC + integer, optional , intent( OUT) :: rc + !EOP + + integer :: status + integer :: userRC + + integer :: I + type(MAPL_MetaComp), pointer :: child_meta + class(BaseProfiler), pointer :: t_p + + class(Logger), pointer :: lgr + character(len=:), allocatable :: shared_object_library_to_load + character(len=:), allocatable :: extension + + if (.not.allocated(meta%GCNameList)) then + ! this is the first child to be added + allocate(meta%GCNameList(0), __STAT__) + end if + + I = meta%get_num_children() + 1 + AddChildFromDSOMeta = I + + call AddChild_preamble(meta, I, name, grid=grid, configfile=configfile, parentGC=parentGC, petList=petlist, child_meta=child_meta,__RC__) + + t_p => get_global_time_profiler() + call t_p%start(trim(name),__RC__) + call child_meta%t_profiler%start(__RC__) + call child_meta%t_profiler%start('SetService',__RC__) + + extension = get_file_extension(SharedObj) + _ASSERT(is_supported_dso_name(SharedObj), "AddChildFromDSO: Unsupported shared library extension '"//extension//",.") + + if (.not. is_valid_dso_name(SharedObj)) then + lgr => logging%get_logger('MAPL.GENERIC') + call lgr%warning("AddChildFromDSO: changing shared library extension from %a~ to system specific extension %a~", & + "'"//extension//"'", "'"//SYSTEM_DSO_EXTENSION//"'") + end if + + shared_object_library_to_load = adjust_dso_name(sharedObj) + call ESMF_GridCompSetServices ( child_meta%gridcomp, userRoutine, & + sharedObj=shared_object_library_to_load,userRC=userRC,__RC__) + _VERIFY(userRC) + + call child_meta%t_profiler%stop('SetService',__RC__) + call child_meta%t_profiler%stop(__RC__) + call t_p%stop(trim(name),__RC__) + + _RETURN(ESMF_SUCCESS) + end function AddChildFromDSOMeta + + !INTERFACE: recursive integer function AddChildFromDSO(gc, name, userRoutine, grid, sharedObj, petList, configFile, RC) diff --git a/gridcomps/Cap/CMakeLists.txt b/gridcomps/Cap/CMakeLists.txt index 07a2fe92b3cb..039f7c6969e7 100644 --- a/gridcomps/Cap/CMakeLists.txt +++ b/gridcomps/Cap/CMakeLists.txt @@ -2,7 +2,7 @@ esma_set_this (OVERRIDE MAPL.cap) set (srcs MAPL_Cap.F90 MAPL_CapGridComp.F90 - MAPL_NUOPCWrapperMod.F90 + #MAPL_NUOPCWrapperMod.F90 CapOptions.F90 ExternalGCStorage.F90 ) diff --git a/gridcomps/Cap/CapOptions.F90 b/gridcomps/Cap/CapOptions.F90 index 104136cf2553..661dedc5593e 100644 --- a/gridcomps/Cap/CapOptions.F90 +++ b/gridcomps/Cap/CapOptions.F90 @@ -16,6 +16,7 @@ module mapl_CapOptionsMod logical :: use_comm_world = .true. character(:), allocatable :: egress_file character(:), allocatable :: cap_rc_file + character(:), allocatable :: root_dso type (ESMF_LogKind_Flag) :: esmf_logging_mode = ESMF_LOGKIND_NONE integer :: npes_model = -1 ! only one of the next two options can have nonzero values diff --git a/gridcomps/Cap/FlapCLI.F90 b/gridcomps/Cap/FlapCLI.F90 index 32ef0c687ac6..6c81e1e702a4 100644 --- a/gridcomps/Cap/FlapCLI.F90 +++ b/gridcomps/Cap/FlapCLI.F90 @@ -92,6 +92,13 @@ subroutine add_command_line_options(options, unusable, rc) integer :: status _UNUSED_DUMMY(unusable) + call options%add(switch='--root_dso', & + help='name of root dso to use', & + required=.false., & + def='none', & + act='store', & + error=status) + _VERIFY(status) call options%add(switch='--esmf_logtype', & help='ESMF Logging type', & required=.false., & @@ -275,6 +282,9 @@ subroutine fill_cap_options(flapCLI, cap_options, unusable, rc) integer, allocatable :: nodes_output_server(:) + call flapCLI%cli_options%get(val=buffer, switch='--root_dso', error=status); _VERIFY(status) + cap_options%root_dso = trim(buffer) + call flapCLI%cli_options%get(val=buffer, switch='--egress_file', error=status); _VERIFY(status) cap_options%egress_file = trim(buffer) @@ -357,6 +367,8 @@ function old_CapOptions_from_Flap( flapCLI, unusable, rc) result (cap_options) integer, allocatable :: nodes_output_server(:) + call flapCLI%cli_options%get(val=buffer, switch='--root_dso', error=status); _VERIFY(status) + cap_options%root_dso = trim(buffer) call flapCLI%cli_options%get(val=buffer, switch='--egress_file', error=status); _VERIFY(status) cap_options%egress_file = trim(buffer) diff --git a/gridcomps/Cap/MAPL_Cap.F90 b/gridcomps/Cap/MAPL_Cap.F90 index 5feeeeb6eb21..b4ce974ee307 100644 --- a/gridcomps/Cap/MAPL_Cap.F90 +++ b/gridcomps/Cap/MAPL_Cap.F90 @@ -25,9 +25,11 @@ module MAPL_CapMod private character(:), allocatable :: name procedure(), nopass, pointer :: set_services => null() + logical :: non_dso = .false. integer :: comm_world integer :: rank integer :: npes_member + character(:), allocatable :: root_dso type (MAPL_CapOptions), allocatable :: cap_options ! misc @@ -75,17 +77,20 @@ end function c_chdir contains - function new_MAPL_Cap(name, set_services, unusable, cap_options, rc) result(cap) + function new_MAPL_Cap(name, unusable,set_services, cap_options, rc) result(cap) type (MAPL_Cap) :: cap character(*), intent(in) :: name - procedure() :: set_services class (KeywordEnforcer), optional, intent(in) :: unusable + procedure(), optional :: set_services type ( MAPL_CapOptions), optional, intent(in) :: cap_options integer, optional, intent(out) :: rc integer :: status cap%name = name - cap%set_services => set_services + if (present(set_services)) then + cap%set_services => set_services + cap%non_dso = .true. + end if if (present(cap_options)) then allocate(cap%cap_options, source = cap_options) @@ -314,8 +319,14 @@ subroutine initialize_cap_gc(this, unusable, n_run_phases, rc) _UNUSED_DUMMY(unusable) - call MAPL_CapGridCompCreate(this%cap_gc, this%set_services, this%get_cap_rc_file(), & - this%name, this%get_egress_file(), n_run_phases=n_run_phases, rc=status) + if (this%non_dso) then + call MAPL_CapGridCompCreate(this%cap_gc, this%get_cap_rc_file(), & + this%name, this%get_egress_file(), n_run_phases=n_run_phases, root_set_services = this%set_services,rc=status) + else + _ASSERT(this%cap_options%root_dso /= 'none',"No set services specified, must pass a dso") + call MAPL_CapGridCompCreate(this%cap_gc, this%get_cap_rc_file(), & + this%name, this%get_egress_file(), n_run_phases=n_run_phases, root_dso = this%cap_options%root_dso,rc=status) + end if _VERIFY(status) _RETURN(_SUCCESS) end subroutine initialize_cap_gc diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index c317fc364764..78429d782fc1 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -51,6 +51,7 @@ module MAPL_CapGridCompMod private type (ESMF_GridComp) :: gc procedure(), pointer, nopass :: root_set_services => null() + character(len=:), allocatable :: root_dso character(len=:), allocatable :: final_file, name, cap_rc_file integer :: nsteps, heartbeat_dt, perpetual_year, perpetual_month, perpetual_day logical :: amiroot, started_loop_timer @@ -107,13 +108,14 @@ module MAPL_CapGridCompMod contains - subroutine MAPL_CapGridCompCreate(cap, root_set_services, cap_rc, name, final_file, unusable, n_run_phases, rc) + subroutine MAPL_CapGridCompCreate(cap, cap_rc, name, final_file, unusable, n_run_phases, root_set_services, root_dso, rc) use mapl_StubComponent type(MAPL_CapGridComp), intent(out), target :: cap - procedure() :: root_set_services character(*), intent(in) :: cap_rc, name character(len=*), optional, intent(in) :: final_file class(KeywordEnforcer), optional, intent(in) :: unusable + procedure(), optional :: root_set_services + character(len=*), optional, intent(in) :: root_dso integer, optional, intent(in) :: n_run_phases integer, optional, intent(out) :: rc @@ -126,7 +128,11 @@ subroutine MAPL_CapGridCompCreate(cap, root_set_services, cap_rc, name, final_fi _UNUSED_DUMMY(unusable) cap%cap_rc_file = cap_rc - cap%root_set_services => root_set_services + if (present(root_set_services)) cap%root_set_services => root_set_services + if (present(root_dso)) cap%root_dso = root_dso + if (present(root_dso) .and. present(root_set_services)) then + _FAIL("can only specify a setservice pointer or a dso to use") + end if if (present(final_file)) then allocate(cap%final_file, source=final_file) end if @@ -208,6 +214,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) type (MAPL_MetaComp), pointer :: maplobj, root_obj + character(len=ESMF_MAXSTR) :: sharedObj type (ESMF_GridComp), pointer :: root_gc procedure(), pointer :: root_set_services type(MAPL_CapGridComp), pointer :: cap @@ -510,13 +517,13 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) ! Add a SINGLE_COLUMN flag in HISTORY.rc based on DYCORE value(from AGCM.rc) !--------------------------------------------------------------------------- - call ESMF_ConfigGetAttribute(cap%cf_root, value=DYCORE, Label="DYCORE:", rc=status) - _VERIFY(STATUS) - if (DYCORE == 'DATMO') then - snglcol = 1 - call MAPL_ConfigSetAttribute(cap%cf_hist, value=snglcol, Label="SINGLE_COLUMN:", rc=status) - _VERIFY(STATUS) - end if + !call ESMF_ConfigGetAttribute(cap%cf_root, value=DYCORE, Label="DYCORE:", rc=status) + !_VERIFY(STATUS) + !if (DYCORE == 'DATMO') then + !snglcol = 1 + !call MAPL_ConfigSetAttribute(cap%cf_hist, value=snglcol, Label="SINGLE_COLUMN:", rc=status) + !_VERIFY(STATUS) + !end if ! Detect if this a regular replay in the AGCM.rc ! ---------------------------------------------- @@ -535,8 +542,14 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) root_set_services => cap%root_set_services call t_p%start('SetService') - cap%root_id = MAPL_AddChild(MAPLOBJ, name = root_name, SS = root_set_services, rc = status) - _VERIFY(status) + if (cap%root_dso == "none") then + cap%root_id = MAPL_AddChild(MAPLOBJ, name = root_name, SS = root_set_services, rc = status) + _VERIFY(status) + else + sharedObj = "libMAPL."//trim(cap%root_dso)//".so" + cap%root_id = MAPL_AddChild(MAPLOBJ, root_name, 'setservices_', sharedObj=sharedObj, rc=status) + _VERIFY(status) + end if root_gc => maplobj%get_child_gridcomp(cap%root_id) call MAPL_GetObjectFromGC(root_gc, root_obj, rc=status) _ASSERT(cap%n_run_phases <= SIZE(root_obj%phase_run),"n_run_phases in cap_gc should not exceed n_run_phases in root") @@ -1333,7 +1346,7 @@ subroutine print_throughput(rc) LOOP_THROUGHPUT,INST_THROUGHPUT,RUN_THROUGHPUT,HRS_R,MIN_R,SEC_R,& mem_committed_percent,mem_used_percent 1000 format(1x,'AGCM Date: ',i4.4,'/',i2.2,'/',i2.2,2x,'Time: ',i2.2,':',i2.2,':',i2.2, & - 2x,'Throughput(days/day)[Avg Tot Run]: ',f8.1,1x,f8.1,1x,f8.1,2x,'TimeRemaining(Est) ',i3.3,':'i2.2,':',i2.2,2x, & + 2x,'Throughput(days/day)[Avg Tot Run]: ',f12.1,1x,f12.1,1x,f12.1,2x,'TimeRemaining(Est) ',i3.3,':'i2.2,':',i2.2,2x, & f5.1,'% : ',f5.1,'% Mem Comm:Used') _RETURN(_SUCCESS) diff --git a/tutorial/CMakeLists.txt b/tutorial/CMakeLists.txt new file mode 100644 index 000000000000..ec6e98ef54f4 --- /dev/null +++ b/tutorial/CMakeLists.txt @@ -0,0 +1,5 @@ +install (PROGRAMS run_tutorial_case.sh DESTINATION bin) + +add_subdirectory (driver_app) +add_subdirectory (grid_comps) +#add_subdirectory (tutorials) diff --git a/tutorial/driver_app/CMakeLists.txt b/tutorial/driver_app/CMakeLists.txt new file mode 100644 index 000000000000..35a100098073 --- /dev/null +++ b/tutorial/driver_app/CMakeLists.txt @@ -0,0 +1,8 @@ +set (srcs + Example_Driver.F90 + ) + +ecbuild_add_executable (TARGET Example_Driver.x SOURCES ${srcs}) +target_link_libraries (Example_Driver.x PRIVATE MAPL OpenMP::OpenMP_Fortran FLAP::FLAP esmf) +target_compile_definitions (Example_Driver.x PRIVATE $<$:BUILD_WITH_EXTDATA2G>) + diff --git a/tutorial/driver_app/Example_Driver.F90 b/tutorial/driver_app/Example_Driver.F90 new file mode 100644 index 000000000000..f489f358637f --- /dev/null +++ b/tutorial/driver_app/Example_Driver.F90 @@ -0,0 +1,22 @@ +#define I_AM_MAIN + +#include "MAPL_Generic.h" + +program Example_Driver + use MPI + use MAPL + implicit none + + type (MAPL_Cap) :: cap + type (MAPL_FlapCLI) :: cli + type (MAPL_CapOptions) :: cap_options + integer :: status + + cli = MAPL_FlapCLI(description = 'GEOS AGCM', & + authors = 'GMAO') + cap_options = MAPL_CapOptions(cli) + cap = MAPL_Cap('example', cap_options = cap_options) + call cap%run(_RC) + +end program Example_Driver + diff --git a/tutorial/grid_comps/CMakeLists.txt b/tutorial/grid_comps/CMakeLists.txt new file mode 100644 index 000000000000..da96e372bff3 --- /dev/null +++ b/tutorial/grid_comps/CMakeLists.txt @@ -0,0 +1,6 @@ +add_subdirectory (hello_world_gridcomp) +add_subdirectory (no_children_gridcomp) +add_subdirectory (leaf_comp_a) +add_subdirectory (leaf_comp_b) +add_subdirectory (one_child_gridcomp) +add_subdirectory (two_siblings_gridcomp) diff --git a/tutorial/grid_comps/hello_world_gridcomp/CMakeLists.txt b/tutorial/grid_comps/hello_world_gridcomp/CMakeLists.txt new file mode 100644 index 000000000000..e73d833a3992 --- /dev/null +++ b/tutorial/grid_comps/hello_world_gridcomp/CMakeLists.txt @@ -0,0 +1,10 @@ +esma_set_this (OVERRIDE MAPL.hello_world_gridcomp) +set (srcs + HelloWorld_GridComp.F90 + ) + +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) +target_link_libraries (${this} PRIVATE esmf OpenMP::OpenMP_Fortran) +target_include_directories (${this} PUBLIC $) +set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) +#target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/tutorial/grid_comps/hello_world_gridcomp/HelloWorld_GridComp.F90 b/tutorial/grid_comps/hello_world_gridcomp/HelloWorld_GridComp.F90 new file mode 100644 index 000000000000..94ec32261eb8 --- /dev/null +++ b/tutorial/grid_comps/hello_world_gridcomp/HelloWorld_GridComp.F90 @@ -0,0 +1,75 @@ +#include "MAPL_Generic.h" +#include "MAPL_Exceptions.h" +module HelloWorld_GridComp + + use ESMF + use MAPL + + implicit none + private + + public setservices + + contains + + subroutine setservices(gc,rc) + + type(ESMF_GridComp), intent(inout) :: gc + integer, optional :: rc + + integer :: status + + call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_INITIALIZE, my_initialize, _RC) + call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_RUN, my_run, _RC) + call MAPL_GenericSetServices(gc, _RC) + _RETURN(_SUCCESS) + + end subroutine setservices + + + subroutine my_initialize(gc, import, export, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc + type(ESMF_State), intent(inout) :: import + type(ESMF_State), intent(inout) :: export + type(ESMF_Clock), intent(inout) :: clock + integer, intent(out), optional :: rc + + integer :: status + + call MAPL_GridCreate(gc, _RC) + call MAPL_GenericInitialize(gc, import, export, clock, _RC) + + _RETURN(_SUCCESS) + + end subroutine my_initialize + + + subroutine my_run(gc, import, export, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc + type(ESMF_State), intent(inout) :: import + type(ESMF_State), intent(inout) :: export + type(ESMF_Clock), intent(inout) :: clock + integer, intent(out), optional :: rc + + type(ESMF_Time) :: current_time + integer :: status + + call ESMF_ClockGet(clock,currTime=current_time,_RC) + write(*,*) + write(*,*) + write(*,*)"Hello World, I say the time is:" + call ESMF_TimePrint(current_time,options='string',_RC) + + _RETURN(_SUCCESS) + + end subroutine my_run + +end module HelloWorld_GridComp + +subroutine SetServices(gc, rc) + use ESMF + use HelloWorld_GridComp, only : mySetservices=>SetServices + type(ESMF_GridComp) :: gc + integer, intent(out) :: rc + call mySetServices(gc, rc=rc) +end subroutine diff --git a/tutorial/grid_comps/leaf_comp_a/AAA_GridComp.F90 b/tutorial/grid_comps/leaf_comp_a/AAA_GridComp.F90 new file mode 100644 index 000000000000..d35e87669bef --- /dev/null +++ b/tutorial/grid_comps/leaf_comp_a/AAA_GridComp.F90 @@ -0,0 +1,83 @@ +#include "MAPL_Generic.h" +#include "MAPL_Exceptions.h" +module AAA_GridComp + + use ESMF + use MAPL + + implicit none + private + + public setservices + + contains + + subroutine setservices(gc,rc) + + type(ESMF_GridComp), intent(inout) :: gc + integer, optional :: rc + + integer :: status + + call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_INITIALIZE, my_initialize, _RC) + call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_RUN, my_run, _RC) + + call MAPL_AddExportSpec(gc,short_name='AAA_output_1', long_name='NA',units='NA', & + dims = MAPL_DimsHorzOnly, & + vlocation = MAPL_VLocationNone, _RC) + + + call MAPL_GenericSetServices(gc, _RC) + _RETURN(_SUCCESS) + + end subroutine setservices + + + subroutine my_initialize(gc, import, export, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc + type(ESMF_State), intent(inout) :: import + type(ESMF_State), intent(inout) :: export + type(ESMF_Clock), intent(inout) :: clock + integer, intent(out), optional :: rc + + integer :: status + + call MAPL_GenericInitialize(gc, import, export, clock, _RC) + + _RETURN(_SUCCESS) + + end subroutine my_initialize + + + subroutine my_run(gc, import, export, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc + type(ESMF_State), intent(inout) :: import + type(ESMF_State), intent(inout) :: export + type(ESMF_Clock), intent(inout) :: clock + integer, intent(out), optional :: rc + + real, pointer :: ptr_2d(:,:) + type(ESMF_Time) :: current_time, start_time + type(ESMF_TimeInterval) :: time_interval + real(ESMF_KIND_R8) :: relative_time + integer :: status + + call MAPL_GetPointer(export,ptr_2d,'AAA_output_1',_RC) + call ESMF_ClockGet(clock,currTime=current_time,startTime=start_time,_RC) + time_interval = current_time - start_time + call ESMF_TimeIntervalGet(time_interval,h_r8=relative_time,_RC) + ptr_2d = relative_time + + _RETURN(_SUCCESS) + + end subroutine my_run + +end module AAA_GridComp + +subroutine SetServices(gc, rc) + use ESMF + use AAA_GridComp, only : mySetservices=>SetServices + type(ESMF_GridComp) :: gc + integer, intent(out) :: rc + call mySetServices(gc, rc=rc) +end subroutine diff --git a/tutorial/grid_comps/leaf_comp_a/CMakeLists.txt b/tutorial/grid_comps/leaf_comp_a/CMakeLists.txt new file mode 100644 index 000000000000..01e9e9b6df6d --- /dev/null +++ b/tutorial/grid_comps/leaf_comp_a/CMakeLists.txt @@ -0,0 +1,10 @@ +esma_set_this (OVERRIDE MAPL.aaa) +set (srcs + AAA_GridComp.F90 + ) + +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) +target_link_libraries (${this} PRIVATE esmf OpenMP::OpenMP_Fortran) +target_include_directories (${this} PUBLIC $) +set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) +#target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/tutorial/grid_comps/leaf_comp_b/BBB_GridComp.F90 b/tutorial/grid_comps/leaf_comp_b/BBB_GridComp.F90 new file mode 100644 index 000000000000..b965938ff3f5 --- /dev/null +++ b/tutorial/grid_comps/leaf_comp_b/BBB_GridComp.F90 @@ -0,0 +1,77 @@ +#include "MAPL_Generic.h" +#include "MAPL_Exceptions.h" +module BBB_GridComp + + use ESMF + use MAPL + + implicit none + private + + public setservices + + contains + + subroutine setservices(gc,rc) + + type(ESMF_GridComp), intent(inout) :: gc + integer, optional :: rc + + integer :: status + + call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_INITIALIZE, my_initialize, _RC) + call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_RUN, my_run, _RC) + + call MAPL_AddImportSpec(gc,short_name='BBB_input_1', long_name='NA',units='NA', & + dims = MAPL_DimsHorzOnly, & + vlocation = MAPL_VLocationNone, _RC) + + + call MAPL_GenericSetServices(gc, _RC) + _RETURN(_SUCCESS) + + end subroutine setservices + + + subroutine my_initialize(gc, import, export, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc + type(ESMF_State), intent(inout) :: import + type(ESMF_State), intent(inout) :: export + type(ESMF_Clock), intent(inout) :: clock + integer, intent(out), optional :: rc + + integer :: status + + call MAPL_GenericInitialize(gc, import, export, clock, _RC) + + _RETURN(_SUCCESS) + + end subroutine my_initialize + + + subroutine my_run(gc, import, export, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc + type(ESMF_State), intent(inout) :: import + type(ESMF_State), intent(inout) :: export + type(ESMF_Clock), intent(inout) :: clock + integer, intent(out), optional :: rc + + real, pointer :: ptr_2d(:,:) + integer :: status + + call MAPL_GetPointer(import,ptr_2d,'BBB_input_1',_RC) + write(*,*)"BBB import 1 maxval: ",maxval(ptr_2d) + + _RETURN(_SUCCESS) + + end subroutine my_run + +end module BBB_GridComp + +subroutine SetServices(gc, rc) + use ESMF + use BBB_GridComp, only : mySetservices=>SetServices + type(ESMF_GridComp) :: gc + integer, intent(out) :: rc + call mySetServices(gc, rc=rc) +end subroutine diff --git a/tutorial/grid_comps/leaf_comp_b/CMakeLists.txt b/tutorial/grid_comps/leaf_comp_b/CMakeLists.txt new file mode 100644 index 000000000000..7c272521d5c7 --- /dev/null +++ b/tutorial/grid_comps/leaf_comp_b/CMakeLists.txt @@ -0,0 +1,10 @@ +esma_set_this (OVERRIDE MAPL.bbb) +set (srcs + BBB_GridComp.F90 + ) + +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) +target_link_libraries (${this} PRIVATE esmf OpenMP::OpenMP_Fortran) +target_include_directories (${this} PUBLIC $) +set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) +#target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/tutorial/grid_comps/no_children_gridcomp/CMakeLists.txt b/tutorial/grid_comps/no_children_gridcomp/CMakeLists.txt new file mode 100644 index 000000000000..6c5b7deb14fb --- /dev/null +++ b/tutorial/grid_comps/no_children_gridcomp/CMakeLists.txt @@ -0,0 +1,10 @@ +esma_set_this (OVERRIDE MAPL.no_children) +set (srcs + NoChildren_GridComp.F90 + ) + +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) +target_link_libraries (${this} PRIVATE esmf OpenMP::OpenMP_Fortran) +target_include_directories (${this} PUBLIC $) +set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) +#target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/tutorial/grid_comps/no_children_gridcomp/NoChildren_GridComp.F90 b/tutorial/grid_comps/no_children_gridcomp/NoChildren_GridComp.F90 new file mode 100644 index 000000000000..59a96e8fd053 --- /dev/null +++ b/tutorial/grid_comps/no_children_gridcomp/NoChildren_GridComp.F90 @@ -0,0 +1,82 @@ +#include "MAPL_Generic.h" +#include "MAPL_Exceptions.h" +module Example1_GridComp + + use ESMF + use MAPL + + implicit none + private + + public setservices + + contains + + subroutine setservices(gc,rc) + + type(ESMF_GridComp), intent(inout) :: gc + integer, optional :: rc + + integer :: status + + call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_INITIALIZE, my_initialize, _RC) + call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_RUN, my_run, _RC) + + call MAPL_AddExportSpec(gc,short_name='output1', long_name='NA',units='NA', & + dims = MAPL_DimsHorzOnly, & + vlocation = MAPL_VLocationNone, _RC) + + + call MAPL_GenericSetServices(gc, _RC) + _RETURN(_SUCCESS) + + end subroutine setservices + + + subroutine my_initialize(gc, import, export, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc + type(ESMF_State), intent(inout) :: import + type(ESMF_State), intent(inout) :: export + type(ESMF_Clock), intent(inout) :: clock + integer, intent(out), optional :: rc + + integer :: status + + call MAPL_GridCreate(gc, _RC) + call MAPL_GenericInitialize(gc, import, export, clock, _RC) + + _RETURN(_SUCCESS) + + end subroutine my_initialize + + + subroutine my_run(gc, import, export, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc + type(ESMF_State), intent(inout) :: import + type(ESMF_State), intent(inout) :: export + type(ESMF_Clock), intent(inout) :: clock + integer, intent(out), optional :: rc + + real, pointer :: ptr_2d(:,:) + type (MAPL_MetaComp), pointer :: MAPL + real :: my_constant + integer :: status + + call MAPL_GetObjectFromGC ( GC, MAPL, _RC) + call MAPL_GetResource(MAPL, my_constant, Label="my_value:", default=17.0,_RC) + call MAPL_GetPointer(export,ptr_2d,'output1',_RC) + ptr_2d = my_constant + + _RETURN(_SUCCESS) + + end subroutine my_run + +end module Example1_GridComp + +subroutine SetServices(gc, rc) + use ESMF + use Example1_GridComp, only : mySetservices=>SetServices + type(ESMF_GridComp) :: gc + integer, intent(out) :: rc + call mySetServices(gc, rc=rc) +end subroutine diff --git a/tutorial/grid_comps/one_child_gridcomp/CMakeLists.txt b/tutorial/grid_comps/one_child_gridcomp/CMakeLists.txt new file mode 100644 index 000000000000..61624044eac6 --- /dev/null +++ b/tutorial/grid_comps/one_child_gridcomp/CMakeLists.txt @@ -0,0 +1,10 @@ +esma_set_this (OVERRIDE MAPL.one_child) +set (srcs + OneChild_GridComp.F90 + ) + +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) +target_link_libraries (${this} PRIVATE esmf OpenMP::OpenMP_Fortran) +target_include_directories (${this} PUBLIC $) +set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) +#target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/tutorial/grid_comps/one_child_gridcomp/OneChild_GridComp.F90 b/tutorial/grid_comps/one_child_gridcomp/OneChild_GridComp.F90 new file mode 100644 index 000000000000..8932ca5d4dcf --- /dev/null +++ b/tutorial/grid_comps/one_child_gridcomp/OneChild_GridComp.F90 @@ -0,0 +1,87 @@ +#include "MAPL_Generic.h" +#include "MAPL_Exceptions.h" +module Example1_GridComp + + use ESMF + use MAPL + + implicit none + private + + public setservices + + integer :: child_aaa + + contains + + subroutine setservices(gc,rc) + + type(ESMF_GridComp), intent(inout) :: gc + integer, optional :: rc + + integer :: status + + call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_INITIALIZE, my_initialize, _RC) + call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_RUN, my_run, _RC) + + call MAPL_AddExportSpec(gc,short_name='output1', long_name='NA',units='NA', & + dims = MAPL_DimsHorzOnly, & + vlocation = MAPL_VLocationNone, _RC) + + child_aaa = MAPL_AddChild("AAA", "setservices_", sharedObj="libMAPL.aaa.so", _RC) + + call MAPL_GenericSetServices(gc, _RC) + _RETURN(_SUCCESS) + + end subroutine setservices + + + subroutine my_initialize(gc, import, export, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc + type(ESMF_State), intent(inout) :: import + type(ESMF_State), intent(inout) :: export + type(ESMF_Clock), intent(inout) :: clock + integer, intent(out), optional :: rc + + integer :: status + + call MAPL_GridCreate(gc, _RC) + call MAPL_GenericInitialize(gc, import, export, clock, _RC) + + _RETURN(_SUCCESS) + + end subroutine my_initialize + + + subroutine my_run(gc, import, export, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc + type(ESMF_State), intent(inout) :: import + type(ESMF_State), intent(inout) :: export + type(ESMF_Clock), intent(inout) :: clock + integer, intent(out), optional :: rc + + type(MAPL_MetaComp), pointer :: MAPL + real, pointer :: ptr_2d(:,:) + real :: my_constant + integer :: status + + call MAPL_GetObjectFromGC ( GC, MAPL, _RC) + call MAPL_GetResource(MAPL, my_constant, Label="my_value:", default=17.0,_RC) + call MAPL_GetPointer(export,ptr_2d,'output1',_RC) + ptr_2d = my_constant + + call MAPL_GenericRunChildren(gc, import, export, clock, _RC) + + _RETURN(_SUCCESS) + + end subroutine my_run + +end module Example1_GridComp + +subroutine SetServices(gc, rc) + use ESMF + use Example1_GridComp, only : mySetservices=>SetServices + type(ESMF_GridComp) :: gc + integer, intent(out) :: rc + call mySetServices(gc, rc=rc) +end subroutine diff --git a/tutorial/grid_comps/two_siblings_gridcomp/CMakeLists.txt b/tutorial/grid_comps/two_siblings_gridcomp/CMakeLists.txt new file mode 100644 index 000000000000..fd6137d6f5d8 --- /dev/null +++ b/tutorial/grid_comps/two_siblings_gridcomp/CMakeLists.txt @@ -0,0 +1,10 @@ +esma_set_this (OVERRIDE MAPL.two_siblings) +set (srcs + TwoSiblings_GridComp.F90 + ) + +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) +target_link_libraries (${this} PRIVATE esmf OpenMP::OpenMP_Fortran) +target_include_directories (${this} PUBLIC $) +set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) +#target_compile_definitions(${this} PRIVATE SYSTEM_DSO_SUFFIX="${CMAKE_SHARED_LIBRARY_SUFFIX}") diff --git a/tutorial/grid_comps/two_siblings_gridcomp/TwoSiblings_GridComp.F90 b/tutorial/grid_comps/two_siblings_gridcomp/TwoSiblings_GridComp.F90 new file mode 100644 index 000000000000..0b1ceb56e767 --- /dev/null +++ b/tutorial/grid_comps/two_siblings_gridcomp/TwoSiblings_GridComp.F90 @@ -0,0 +1,96 @@ +#include "MAPL_Generic.h" +#include "MAPL_Exceptions.h" +module Example1_GridComp + + use ESMF + use MAPL + + implicit none + private + + public setservices + + integer :: child_aaa + integer :: child_bbb + + contains + + subroutine setservices(gc,rc) + + type(ESMF_GridComp), intent(inout) :: gc + integer, optional :: rc + + integer :: status + + call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_INITIALIZE, my_initialize, _RC) + call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_RUN, my_run, _RC) + + call MAPL_AddExportSpec(gc,short_name='output1', long_name='NA',units='NA', & + dims = MAPL_DimsHorzOnly, & + vlocation = MAPL_VLocationNone, _RC) + + child_aaa = MAPL_AddChild("AAA", "setservices_", sharedObj="libMAPL.aaa.so", _RC) + child_aaa = MAPL_AddChild("BBB", "setservices_", sharedObj="libMAPL.bbb.so", _RC) + + call MAPL_AddConnectivity(gc, & + src_name = "AAA_output_1", & + dst_name = "BBB_output_1", & + src_id = child_aaa, & + dst_id = child_bbb, & + _RC) + + call MAPL_GenericSetServices(gc, _RC) + _RETURN(_SUCCESS) + + end subroutine setservices + + + subroutine my_initialize(gc, import, export, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc + type(ESMF_State), intent(inout) :: import + type(ESMF_State), intent(inout) :: export + type(ESMF_Clock), intent(inout) :: clock + integer, intent(out), optional :: rc + + integer :: status + + call MAPL_GridCreate(gc, _RC) + call MAPL_GenericInitialize(gc, import, export, clock, _RC) + + _RETURN(_SUCCESS) + + end subroutine my_initialize + + + subroutine my_run(gc, import, export, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc + type(ESMF_State), intent(inout) :: import + type(ESMF_State), intent(inout) :: export + type(ESMF_Clock), intent(inout) :: clock + integer, intent(out), optional :: rc + + type(MAPL_MetaComp), pointer :: MAPL + real, pointer :: ptr_2d(:,:) + real :: my_constant + integer :: status + + call MAPL_GetObjectFromGC ( GC, MAPL, _RC) + call MAPL_GetResource(MAPL, my_constant, Label="my_value:", default=17.0,_RC) + call MAPL_GetPointer(export,ptr_2d,'output1',_RC) + ptr_2d = my_constant + + call MAPL_GenericRunChildren(gc, import, export, clock, _RC) + + _RETURN(_SUCCESS) + + end subroutine my_run + +end module Example1_GridComp + +subroutine SetServices(gc, rc) + use ESMF + use Example1_GridComp, only : mySetservices=>SetServices + type(ESMF_GridComp) :: gc + integer, intent(out) :: rc + call mySetServices(gc, rc=rc) +end subroutine diff --git a/tutorial/run_tutorial_case.sh b/tutorial/run_tutorial_case.sh new file mode 100755 index 000000000000..98f80b1109c5 --- /dev/null +++ b/tutorial/run_tutorial_case.sh @@ -0,0 +1,29 @@ +#!/bin/bash -f + +####################################################################### +# Batch Parameters for Run Job +####################################################################### + +umask 022 + +ulimit -s unlimited + +####################################################################### +# Architecture Specific Environment Variables +####################################################################### + +export site=NCCS + +export INSTALL_DIR=$1 +export TUTORIAL_CASE=$2 +source $INSTALL_DIR/bin/g5_modules.sh +export LD_LIBRARY_PATH=${LD_LIBRARY_PATH}:${BASEDIR}/${ARCH}/lib:${INSTALL_DIR}/lib + +for file in `ls ${TUTORIAL_CASE}`; do + echo ${file} + cp "${TUTORIAL_CASE}/${file}" . +done + +ROOT_LIB=`cat root_lib` + +mpirun -np 1 ${INSTALL_DIR}/bin/Example_Driver.x --root_dso ${ROOT_LIB} diff --git a/tutorial/tutorials/hello_world_tutorial/CAP.rc b/tutorial/tutorials/hello_world_tutorial/CAP.rc new file mode 100644 index 000000000000..b34314f95bb0 --- /dev/null +++ b/tutorial/tutorials/hello_world_tutorial/CAP.rc @@ -0,0 +1,11 @@ +MAPLROOT_COMPNAME: hello_world +ROOT_NAME: hello_world +HIST_CF: HISTORY.rc + + +ROOT_CF: hello_world.rc + +BEG_DATE: 20070801 000000 +END_DATE: 29990302 210000 +JOB_SGMT: 00000001 000000 +HEARTBEAT_DT: 3600 diff --git a/tutorial/tutorials/hello_world_tutorial/ExtData.rc b/tutorial/tutorials/hello_world_tutorial/ExtData.rc new file mode 100644 index 000000000000..e69de29bb2d1 diff --git a/tutorial/tutorials/hello_world_tutorial/HISTORY.rc b/tutorial/tutorials/hello_world_tutorial/HISTORY.rc new file mode 100644 index 000000000000..d3a6677416e1 --- /dev/null +++ b/tutorial/tutorials/hello_world_tutorial/HISTORY.rc @@ -0,0 +1,5 @@ +GRID_LABELS: +:: + +COLLECTIONS: +:: diff --git a/tutorial/tutorials/hello_world_tutorial/cap_restart b/tutorial/tutorials/hello_world_tutorial/cap_restart new file mode 100644 index 000000000000..d61015bfaab6 --- /dev/null +++ b/tutorial/tutorials/hello_world_tutorial/cap_restart @@ -0,0 +1 @@ +20070801 000000 diff --git a/tutorial/tutorials/hello_world_tutorial/hello_world.rc b/tutorial/tutorials/hello_world_tutorial/hello_world.rc new file mode 100644 index 000000000000..4eb08053f1f6 --- /dev/null +++ b/tutorial/tutorials/hello_world_tutorial/hello_world.rc @@ -0,0 +1,10 @@ +NX: 1 +NY: 1 + +hello_world.GRID_TYPE: LatLon +hello_world.GRIDNAME: DC90x45-PC +hello_world.LM: 72 +hello_world.IM_WORLD: 90 +hello_world.JM_WORLD: 45 +hello_world.POLE: 'PC' +hello_world.DATELINE: 'DC' diff --git a/tutorial/tutorials/hello_world_tutorial/root_lib b/tutorial/tutorials/hello_world_tutorial/root_lib new file mode 100644 index 000000000000..6cec8490da15 --- /dev/null +++ b/tutorial/tutorials/hello_world_tutorial/root_lib @@ -0,0 +1 @@ +hello_world_gridcomp diff --git a/tutorial/tutorials/no_children_tutorial/CAP.rc b/tutorial/tutorials/no_children_tutorial/CAP.rc new file mode 100644 index 000000000000..4176101a8081 --- /dev/null +++ b/tutorial/tutorials/no_children_tutorial/CAP.rc @@ -0,0 +1,11 @@ +MAPLROOT_COMPNAME: root +ROOT_NAME: root +HIST_CF: HISTORY.rc + + +ROOT_CF: root.rc + +BEG_DATE: 20070801 000000 +END_DATE: 29990302 210000 +JOB_SGMT: 00000001 000000 +HEARTBEAT_DT: 3600 diff --git a/tutorial/tutorials/no_children_tutorial/ExtData.rc b/tutorial/tutorials/no_children_tutorial/ExtData.rc new file mode 100644 index 000000000000..e69de29bb2d1 diff --git a/tutorial/tutorials/no_children_tutorial/HISTORY.rc b/tutorial/tutorials/no_children_tutorial/HISTORY.rc new file mode 100644 index 000000000000..28cfb9eaf6bf --- /dev/null +++ b/tutorial/tutorials/no_children_tutorial/HISTORY.rc @@ -0,0 +1,12 @@ +GRID_LABELS: +:: + +COLLECTIONS: my_collection +:: + +my_collection.template: "%y4%m2%d2_%h2%n2z.nc4" +my_collection.format: 'CFIO' +my_collection.frequency: 060000 +my_collection.fields: 'output1', 'root' + :: + diff --git a/tutorial/tutorials/no_children_tutorial/cap_restart b/tutorial/tutorials/no_children_tutorial/cap_restart new file mode 100644 index 000000000000..d61015bfaab6 --- /dev/null +++ b/tutorial/tutorials/no_children_tutorial/cap_restart @@ -0,0 +1 @@ +20070801 000000 diff --git a/tutorial/tutorials/no_children_tutorial/root.rc b/tutorial/tutorials/no_children_tutorial/root.rc new file mode 100644 index 000000000000..a9db4182618a --- /dev/null +++ b/tutorial/tutorials/no_children_tutorial/root.rc @@ -0,0 +1,12 @@ +NX: 1 +NY: 1 + +root.GRID_TYPE: LatLon +root.GRIDNAME: DC90x45-PC +root.LM: 72 +root.IM_WORLD: 90 +root.JM_WORLD: 45 +root.POLE: 'PC' +root.DATELINE: 'DC' + +my_value: 11.0 diff --git a/tutorial/tutorials/no_children_tutorial/root_lib b/tutorial/tutorials/no_children_tutorial/root_lib new file mode 100644 index 000000000000..e6c005133a7f --- /dev/null +++ b/tutorial/tutorials/no_children_tutorial/root_lib @@ -0,0 +1 @@ +no_children From 2a4a678b4d59048b3b56a39df2de33b52cf27965 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 12:14:55 -0400 Subject: [PATCH 188/300] more updates --- tutorial/grid_comps/leaf_comp_a/AAA_GridComp.F90 | 2 +- .../one_child_gridcomp/OneChild_GridComp.F90 | 2 +- .../two_siblings_gridcomp/TwoSiblings_GridComp.F90 | 4 ++-- .../tutorials/one_child_tutorial_no_imports/CAP.rc | 11 +++++++++++ .../one_child_tutorial_no_imports/ExtData.rc | 0 .../one_child_tutorial_no_imports/HISTORY.rc | 12 ++++++++++++ .../one_child_tutorial_no_imports/cap_restart | 1 + .../tutorials/one_child_tutorial_no_imports/root.rc | 12 ++++++++++++ .../tutorials/one_child_tutorial_no_imports/root_lib | 1 + 9 files changed, 41 insertions(+), 4 deletions(-) create mode 100644 tutorial/tutorials/one_child_tutorial_no_imports/CAP.rc create mode 100644 tutorial/tutorials/one_child_tutorial_no_imports/ExtData.rc create mode 100644 tutorial/tutorials/one_child_tutorial_no_imports/HISTORY.rc create mode 100644 tutorial/tutorials/one_child_tutorial_no_imports/cap_restart create mode 100644 tutorial/tutorials/one_child_tutorial_no_imports/root.rc create mode 100644 tutorial/tutorials/one_child_tutorial_no_imports/root_lib diff --git a/tutorial/grid_comps/leaf_comp_a/AAA_GridComp.F90 b/tutorial/grid_comps/leaf_comp_a/AAA_GridComp.F90 index d35e87669bef..ccdc51590ed8 100644 --- a/tutorial/grid_comps/leaf_comp_a/AAA_GridComp.F90 +++ b/tutorial/grid_comps/leaf_comp_a/AAA_GridComp.F90 @@ -66,7 +66,7 @@ subroutine my_run(gc, import, export, clock, rc) call ESMF_ClockGet(clock,currTime=current_time,startTime=start_time,_RC) time_interval = current_time - start_time call ESMF_TimeIntervalGet(time_interval,h_r8=relative_time,_RC) - ptr_2d = relative_time + if (associated(ptr_2d)) ptr_2d = relative_time _RETURN(_SUCCESS) diff --git a/tutorial/grid_comps/one_child_gridcomp/OneChild_GridComp.F90 b/tutorial/grid_comps/one_child_gridcomp/OneChild_GridComp.F90 index 8932ca5d4dcf..e12c66f95e6b 100644 --- a/tutorial/grid_comps/one_child_gridcomp/OneChild_GridComp.F90 +++ b/tutorial/grid_comps/one_child_gridcomp/OneChild_GridComp.F90 @@ -28,7 +28,7 @@ subroutine setservices(gc,rc) dims = MAPL_DimsHorzOnly, & vlocation = MAPL_VLocationNone, _RC) - child_aaa = MAPL_AddChild("AAA", "setservices_", sharedObj="libMAPL.aaa.so", _RC) + child_aaa = MAPL_AddChild(gc, "AAA", "setservices_", sharedObj="libMAPL.aaa.so", _RC) call MAPL_GenericSetServices(gc, _RC) _RETURN(_SUCCESS) diff --git a/tutorial/grid_comps/two_siblings_gridcomp/TwoSiblings_GridComp.F90 b/tutorial/grid_comps/two_siblings_gridcomp/TwoSiblings_GridComp.F90 index 0b1ceb56e767..bbf6ac867617 100644 --- a/tutorial/grid_comps/two_siblings_gridcomp/TwoSiblings_GridComp.F90 +++ b/tutorial/grid_comps/two_siblings_gridcomp/TwoSiblings_GridComp.F90 @@ -29,8 +29,8 @@ subroutine setservices(gc,rc) dims = MAPL_DimsHorzOnly, & vlocation = MAPL_VLocationNone, _RC) - child_aaa = MAPL_AddChild("AAA", "setservices_", sharedObj="libMAPL.aaa.so", _RC) - child_aaa = MAPL_AddChild("BBB", "setservices_", sharedObj="libMAPL.bbb.so", _RC) + child_aaa = MAPL_AddChild(gc,"AAA", "setservices_", sharedObj="libMAPL.aaa.so", _RC) + child_aaa = MAPL_AddChild(gc,"BBB", "setservices_", sharedObj="libMAPL.bbb.so", _RC) call MAPL_AddConnectivity(gc, & src_name = "AAA_output_1", & diff --git a/tutorial/tutorials/one_child_tutorial_no_imports/CAP.rc b/tutorial/tutorials/one_child_tutorial_no_imports/CAP.rc new file mode 100644 index 000000000000..4176101a8081 --- /dev/null +++ b/tutorial/tutorials/one_child_tutorial_no_imports/CAP.rc @@ -0,0 +1,11 @@ +MAPLROOT_COMPNAME: root +ROOT_NAME: root +HIST_CF: HISTORY.rc + + +ROOT_CF: root.rc + +BEG_DATE: 20070801 000000 +END_DATE: 29990302 210000 +JOB_SGMT: 00000001 000000 +HEARTBEAT_DT: 3600 diff --git a/tutorial/tutorials/one_child_tutorial_no_imports/ExtData.rc b/tutorial/tutorials/one_child_tutorial_no_imports/ExtData.rc new file mode 100644 index 000000000000..e69de29bb2d1 diff --git a/tutorial/tutorials/one_child_tutorial_no_imports/HISTORY.rc b/tutorial/tutorials/one_child_tutorial_no_imports/HISTORY.rc new file mode 100644 index 000000000000..28cfb9eaf6bf --- /dev/null +++ b/tutorial/tutorials/one_child_tutorial_no_imports/HISTORY.rc @@ -0,0 +1,12 @@ +GRID_LABELS: +:: + +COLLECTIONS: my_collection +:: + +my_collection.template: "%y4%m2%d2_%h2%n2z.nc4" +my_collection.format: 'CFIO' +my_collection.frequency: 060000 +my_collection.fields: 'output1', 'root' + :: + diff --git a/tutorial/tutorials/one_child_tutorial_no_imports/cap_restart b/tutorial/tutorials/one_child_tutorial_no_imports/cap_restart new file mode 100644 index 000000000000..d61015bfaab6 --- /dev/null +++ b/tutorial/tutorials/one_child_tutorial_no_imports/cap_restart @@ -0,0 +1 @@ +20070801 000000 diff --git a/tutorial/tutorials/one_child_tutorial_no_imports/root.rc b/tutorial/tutorials/one_child_tutorial_no_imports/root.rc new file mode 100644 index 000000000000..a9db4182618a --- /dev/null +++ b/tutorial/tutorials/one_child_tutorial_no_imports/root.rc @@ -0,0 +1,12 @@ +NX: 1 +NY: 1 + +root.GRID_TYPE: LatLon +root.GRIDNAME: DC90x45-PC +root.LM: 72 +root.IM_WORLD: 90 +root.JM_WORLD: 45 +root.POLE: 'PC' +root.DATELINE: 'DC' + +my_value: 11.0 diff --git a/tutorial/tutorials/one_child_tutorial_no_imports/root_lib b/tutorial/tutorials/one_child_tutorial_no_imports/root_lib new file mode 100644 index 000000000000..ba918cc85bc7 --- /dev/null +++ b/tutorial/tutorials/one_child_tutorial_no_imports/root_lib @@ -0,0 +1 @@ +one_child From cde3cd922cd0dcc2d34d8d35d57227c0a90eadf0 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 12:57:13 -0400 Subject: [PATCH 189/300] rename some things --- .../CMakeLists.txt | 0 .../NoChildren_GridComp.F90 | 0 .../{one_child_gridcomp => parent_with_one_child}/CMakeLists.txt | 0 .../OneChild_GridComp.F90 | 0 .../CMakeLists.txt | 0 .../TwoSiblings_GridComp.F90 | 0 6 files changed, 0 insertions(+), 0 deletions(-) rename tutorial/grid_comps/{no_children_gridcomp => parent_with_no_children}/CMakeLists.txt (100%) rename tutorial/grid_comps/{no_children_gridcomp => parent_with_no_children}/NoChildren_GridComp.F90 (100%) rename tutorial/grid_comps/{one_child_gridcomp => parent_with_one_child}/CMakeLists.txt (100%) rename tutorial/grid_comps/{one_child_gridcomp => parent_with_one_child}/OneChild_GridComp.F90 (100%) rename tutorial/grid_comps/{two_siblings_gridcomp => parent_with_two_children}/CMakeLists.txt (100%) rename tutorial/grid_comps/{two_siblings_gridcomp => parent_with_two_children}/TwoSiblings_GridComp.F90 (100%) diff --git a/tutorial/grid_comps/no_children_gridcomp/CMakeLists.txt b/tutorial/grid_comps/parent_with_no_children/CMakeLists.txt similarity index 100% rename from tutorial/grid_comps/no_children_gridcomp/CMakeLists.txt rename to tutorial/grid_comps/parent_with_no_children/CMakeLists.txt diff --git a/tutorial/grid_comps/no_children_gridcomp/NoChildren_GridComp.F90 b/tutorial/grid_comps/parent_with_no_children/NoChildren_GridComp.F90 similarity index 100% rename from tutorial/grid_comps/no_children_gridcomp/NoChildren_GridComp.F90 rename to tutorial/grid_comps/parent_with_no_children/NoChildren_GridComp.F90 diff --git a/tutorial/grid_comps/one_child_gridcomp/CMakeLists.txt b/tutorial/grid_comps/parent_with_one_child/CMakeLists.txt similarity index 100% rename from tutorial/grid_comps/one_child_gridcomp/CMakeLists.txt rename to tutorial/grid_comps/parent_with_one_child/CMakeLists.txt diff --git a/tutorial/grid_comps/one_child_gridcomp/OneChild_GridComp.F90 b/tutorial/grid_comps/parent_with_one_child/OneChild_GridComp.F90 similarity index 100% rename from tutorial/grid_comps/one_child_gridcomp/OneChild_GridComp.F90 rename to tutorial/grid_comps/parent_with_one_child/OneChild_GridComp.F90 diff --git a/tutorial/grid_comps/two_siblings_gridcomp/CMakeLists.txt b/tutorial/grid_comps/parent_with_two_children/CMakeLists.txt similarity index 100% rename from tutorial/grid_comps/two_siblings_gridcomp/CMakeLists.txt rename to tutorial/grid_comps/parent_with_two_children/CMakeLists.txt diff --git a/tutorial/grid_comps/two_siblings_gridcomp/TwoSiblings_GridComp.F90 b/tutorial/grid_comps/parent_with_two_children/TwoSiblings_GridComp.F90 similarity index 100% rename from tutorial/grid_comps/two_siblings_gridcomp/TwoSiblings_GridComp.F90 rename to tutorial/grid_comps/parent_with_two_children/TwoSiblings_GridComp.F90 From dbdf2d2873669c95433579bc86d85785a954c5c6 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 12:58:17 -0400 Subject: [PATCH 190/300] update name --- tutorial/grid_comps/parent_with_no_children/CMakeLists.txt | 2 +- .../{NoChildren_GridComp.F90 => ParentNoChildren_GridComp.F90} | 0 2 files changed, 1 insertion(+), 1 deletion(-) rename tutorial/grid_comps/parent_with_no_children/{NoChildren_GridComp.F90 => ParentNoChildren_GridComp.F90} (100%) diff --git a/tutorial/grid_comps/parent_with_no_children/CMakeLists.txt b/tutorial/grid_comps/parent_with_no_children/CMakeLists.txt index 6c5b7deb14fb..5bc89184498f 100644 --- a/tutorial/grid_comps/parent_with_no_children/CMakeLists.txt +++ b/tutorial/grid_comps/parent_with_no_children/CMakeLists.txt @@ -1,6 +1,6 @@ esma_set_this (OVERRIDE MAPL.no_children) set (srcs - NoChildren_GridComp.F90 + ParentNoChildren_GridComp.F90 ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) diff --git a/tutorial/grid_comps/parent_with_no_children/NoChildren_GridComp.F90 b/tutorial/grid_comps/parent_with_no_children/ParentNoChildren_GridComp.F90 similarity index 100% rename from tutorial/grid_comps/parent_with_no_children/NoChildren_GridComp.F90 rename to tutorial/grid_comps/parent_with_no_children/ParentNoChildren_GridComp.F90 From c763bc87f3ce16c39af1b7a67f921270a5723d8e Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 13:00:37 -0400 Subject: [PATCH 191/300] update names --- tutorial/grid_comps/parent_with_no_children/CMakeLists.txt | 2 +- .../parent_with_no_children/ParentNoChildren_GridComp.F90 | 6 +++--- tutorial/grid_comps/parent_with_one_child/CMakeLists.txt | 4 ++-- .../{OneChild_GridComp.F90 => ParentOneChild_GridComp.F90} | 0 4 files changed, 6 insertions(+), 6 deletions(-) rename tutorial/grid_comps/parent_with_one_child/{OneChild_GridComp.F90 => ParentOneChild_GridComp.F90} (100%) diff --git a/tutorial/grid_comps/parent_with_no_children/CMakeLists.txt b/tutorial/grid_comps/parent_with_no_children/CMakeLists.txt index 5bc89184498f..e370ad84e3ed 100644 --- a/tutorial/grid_comps/parent_with_no_children/CMakeLists.txt +++ b/tutorial/grid_comps/parent_with_no_children/CMakeLists.txt @@ -1,4 +1,4 @@ -esma_set_this (OVERRIDE MAPL.no_children) +esma_set_this (OVERRIDE MAPL.parent_no_children) set (srcs ParentNoChildren_GridComp.F90 ) diff --git a/tutorial/grid_comps/parent_with_no_children/ParentNoChildren_GridComp.F90 b/tutorial/grid_comps/parent_with_no_children/ParentNoChildren_GridComp.F90 index 59a96e8fd053..39e245b5bfb6 100644 --- a/tutorial/grid_comps/parent_with_no_children/ParentNoChildren_GridComp.F90 +++ b/tutorial/grid_comps/parent_with_no_children/ParentNoChildren_GridComp.F90 @@ -1,6 +1,6 @@ #include "MAPL_Generic.h" #include "MAPL_Exceptions.h" -module Example1_GridComp +module ParentNoChild_GridComp use ESMF use MAPL @@ -71,11 +71,11 @@ subroutine my_run(gc, import, export, clock, rc) end subroutine my_run -end module Example1_GridComp +end module ParentNoChild_GridComp subroutine SetServices(gc, rc) use ESMF - use Example1_GridComp, only : mySetservices=>SetServices + use ParentNoChild_GridComp, only : mySetservices=>SetServices type(ESMF_GridComp) :: gc integer, intent(out) :: rc call mySetServices(gc, rc=rc) diff --git a/tutorial/grid_comps/parent_with_one_child/CMakeLists.txt b/tutorial/grid_comps/parent_with_one_child/CMakeLists.txt index 61624044eac6..c0ca68ae25ac 100644 --- a/tutorial/grid_comps/parent_with_one_child/CMakeLists.txt +++ b/tutorial/grid_comps/parent_with_one_child/CMakeLists.txt @@ -1,6 +1,6 @@ -esma_set_this (OVERRIDE MAPL.one_child) +esma_set_this (OVERRIDE MAPL.parent_one_child) set (srcs - OneChild_GridComp.F90 + ParentOneChild_GridComp.F90 ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) diff --git a/tutorial/grid_comps/parent_with_one_child/OneChild_GridComp.F90 b/tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 similarity index 100% rename from tutorial/grid_comps/parent_with_one_child/OneChild_GridComp.F90 rename to tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 From 010eddcc12a9a082cb96d05484ba752b14ad6596 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 13:01:58 -0400 Subject: [PATCH 192/300] rename things --- .../parent_with_one_child/ParentOneChild_GridComp.F90 | 6 +++--- tutorial/grid_comps/parent_with_two_children/CMakeLists.txt | 4 ++-- ...Siblings_GridComp.F90 => ParentTwoSiblings_GridComp.F90} | 0 3 files changed, 5 insertions(+), 5 deletions(-) rename tutorial/grid_comps/parent_with_two_children/{TwoSiblings_GridComp.F90 => ParentTwoSiblings_GridComp.F90} (100%) diff --git a/tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 b/tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 index e12c66f95e6b..5999ee0260a6 100644 --- a/tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 +++ b/tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 @@ -1,6 +1,6 @@ #include "MAPL_Generic.h" #include "MAPL_Exceptions.h" -module Example1_GridComp +module ParentOneChild_GridComp use ESMF use MAPL @@ -76,11 +76,11 @@ subroutine my_run(gc, import, export, clock, rc) end subroutine my_run -end module Example1_GridComp +end module ParentOneChild_GridComp subroutine SetServices(gc, rc) use ESMF - use Example1_GridComp, only : mySetservices=>SetServices + use ParentOneChild_GridComp, only : mySetservices=>SetServices type(ESMF_GridComp) :: gc integer, intent(out) :: rc call mySetServices(gc, rc=rc) diff --git a/tutorial/grid_comps/parent_with_two_children/CMakeLists.txt b/tutorial/grid_comps/parent_with_two_children/CMakeLists.txt index fd6137d6f5d8..e79ece0e2b32 100644 --- a/tutorial/grid_comps/parent_with_two_children/CMakeLists.txt +++ b/tutorial/grid_comps/parent_with_two_children/CMakeLists.txt @@ -1,6 +1,6 @@ -esma_set_this (OVERRIDE MAPL.two_siblings) +esma_set_this (OVERRIDE MAPL.parent_two_siblings) set (srcs - TwoSiblings_GridComp.F90 + ParentTwoSiblings_GridComp.F90 ) esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL TYPE ${MAPL_LIBRARY_TYPE}) diff --git a/tutorial/grid_comps/parent_with_two_children/TwoSiblings_GridComp.F90 b/tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 similarity index 100% rename from tutorial/grid_comps/parent_with_two_children/TwoSiblings_GridComp.F90 rename to tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 From b8496a6be48269588de50898c973e81100adb90d Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 13:02:35 -0400 Subject: [PATCH 193/300] rename --- .../parent_with_two_children/ParentTwoSiblings_GridComp.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 b/tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 index bbf6ac867617..463a60eaa0b8 100644 --- a/tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 +++ b/tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 @@ -1,6 +1,6 @@ #include "MAPL_Generic.h" #include "MAPL_Exceptions.h" -module Example1_GridComp +module ParentTwoSiblings_GridComp use ESMF use MAPL @@ -85,11 +85,11 @@ subroutine my_run(gc, import, export, clock, rc) end subroutine my_run -end module Example1_GridComp +end module ParentTwoSiblings_GridComp subroutine SetServices(gc, rc) use ESMF - use Example1_GridComp, only : mySetservices=>SetServices + use ParentTwoSiblings_GridComp, only : mySetservices=>SetServices type(ESMF_GridComp) :: gc integer, intent(out) :: rc call mySetServices(gc, rc=rc) From 27366b6320a09fa513d01e86b6de08b0180fc593 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 13:07:30 -0400 Subject: [PATCH 194/300] rename things --- tutorial/grid_comps/CMakeLists.txt | 6 +++--- .../tutorials/{hello_world_tutorial => hello_world}/CAP.rc | 0 .../{hello_world_tutorial => hello_world}/ExtData.rc | 0 .../{hello_world_tutorial => hello_world}/HISTORY.rc | 0 .../{hello_world_tutorial => hello_world}/cap_restart | 0 .../{hello_world_tutorial => hello_world}/hello_world.rc | 0 .../{hello_world_tutorial => hello_world}/root_lib | 0 .../tutorials/{no_children_tutorial => no_children}/CAP.rc | 0 .../{no_children_tutorial => no_children}/ExtData.rc | 0 .../{no_children_tutorial => no_children}/HISTORY.rc | 0 .../{no_children_tutorial => no_children}/cap_restart | 0 .../tutorials/{no_children_tutorial => no_children}/root.rc | 0 .../{no_children_tutorial => no_children}/root_lib | 0 13 files changed, 3 insertions(+), 3 deletions(-) rename tutorial/tutorials/{hello_world_tutorial => hello_world}/CAP.rc (100%) rename tutorial/tutorials/{hello_world_tutorial => hello_world}/ExtData.rc (100%) rename tutorial/tutorials/{hello_world_tutorial => hello_world}/HISTORY.rc (100%) rename tutorial/tutorials/{hello_world_tutorial => hello_world}/cap_restart (100%) rename tutorial/tutorials/{hello_world_tutorial => hello_world}/hello_world.rc (100%) rename tutorial/tutorials/{hello_world_tutorial => hello_world}/root_lib (100%) rename tutorial/tutorials/{no_children_tutorial => no_children}/CAP.rc (100%) rename tutorial/tutorials/{no_children_tutorial => no_children}/ExtData.rc (100%) rename tutorial/tutorials/{no_children_tutorial => no_children}/HISTORY.rc (100%) rename tutorial/tutorials/{no_children_tutorial => no_children}/cap_restart (100%) rename tutorial/tutorials/{no_children_tutorial => no_children}/root.rc (100%) rename tutorial/tutorials/{no_children_tutorial => no_children}/root_lib (100%) diff --git a/tutorial/grid_comps/CMakeLists.txt b/tutorial/grid_comps/CMakeLists.txt index da96e372bff3..2a006d2e4feb 100644 --- a/tutorial/grid_comps/CMakeLists.txt +++ b/tutorial/grid_comps/CMakeLists.txt @@ -1,6 +1,6 @@ add_subdirectory (hello_world_gridcomp) -add_subdirectory (no_children_gridcomp) +add_subdirectory (parent_with_no_children) add_subdirectory (leaf_comp_a) add_subdirectory (leaf_comp_b) -add_subdirectory (one_child_gridcomp) -add_subdirectory (two_siblings_gridcomp) +add_subdirectory (parent_with_one_child) +add_subdirectory (parent_with_two_children) diff --git a/tutorial/tutorials/hello_world_tutorial/CAP.rc b/tutorial/tutorials/hello_world/CAP.rc similarity index 100% rename from tutorial/tutorials/hello_world_tutorial/CAP.rc rename to tutorial/tutorials/hello_world/CAP.rc diff --git a/tutorial/tutorials/hello_world_tutorial/ExtData.rc b/tutorial/tutorials/hello_world/ExtData.rc similarity index 100% rename from tutorial/tutorials/hello_world_tutorial/ExtData.rc rename to tutorial/tutorials/hello_world/ExtData.rc diff --git a/tutorial/tutorials/hello_world_tutorial/HISTORY.rc b/tutorial/tutorials/hello_world/HISTORY.rc similarity index 100% rename from tutorial/tutorials/hello_world_tutorial/HISTORY.rc rename to tutorial/tutorials/hello_world/HISTORY.rc diff --git a/tutorial/tutorials/hello_world_tutorial/cap_restart b/tutorial/tutorials/hello_world/cap_restart similarity index 100% rename from tutorial/tutorials/hello_world_tutorial/cap_restart rename to tutorial/tutorials/hello_world/cap_restart diff --git a/tutorial/tutorials/hello_world_tutorial/hello_world.rc b/tutorial/tutorials/hello_world/hello_world.rc similarity index 100% rename from tutorial/tutorials/hello_world_tutorial/hello_world.rc rename to tutorial/tutorials/hello_world/hello_world.rc diff --git a/tutorial/tutorials/hello_world_tutorial/root_lib b/tutorial/tutorials/hello_world/root_lib similarity index 100% rename from tutorial/tutorials/hello_world_tutorial/root_lib rename to tutorial/tutorials/hello_world/root_lib diff --git a/tutorial/tutorials/no_children_tutorial/CAP.rc b/tutorial/tutorials/no_children/CAP.rc similarity index 100% rename from tutorial/tutorials/no_children_tutorial/CAP.rc rename to tutorial/tutorials/no_children/CAP.rc diff --git a/tutorial/tutorials/no_children_tutorial/ExtData.rc b/tutorial/tutorials/no_children/ExtData.rc similarity index 100% rename from tutorial/tutorials/no_children_tutorial/ExtData.rc rename to tutorial/tutorials/no_children/ExtData.rc diff --git a/tutorial/tutorials/no_children_tutorial/HISTORY.rc b/tutorial/tutorials/no_children/HISTORY.rc similarity index 100% rename from tutorial/tutorials/no_children_tutorial/HISTORY.rc rename to tutorial/tutorials/no_children/HISTORY.rc diff --git a/tutorial/tutorials/no_children_tutorial/cap_restart b/tutorial/tutorials/no_children/cap_restart similarity index 100% rename from tutorial/tutorials/no_children_tutorial/cap_restart rename to tutorial/tutorials/no_children/cap_restart diff --git a/tutorial/tutorials/no_children_tutorial/root.rc b/tutorial/tutorials/no_children/root.rc similarity index 100% rename from tutorial/tutorials/no_children_tutorial/root.rc rename to tutorial/tutorials/no_children/root.rc diff --git a/tutorial/tutorials/no_children_tutorial/root_lib b/tutorial/tutorials/no_children/root_lib similarity index 100% rename from tutorial/tutorials/no_children_tutorial/root_lib rename to tutorial/tutorials/no_children/root_lib From 7d8f1e5d208d6461bfeab4a2b9d309e9a24b8000 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 13:10:07 -0400 Subject: [PATCH 195/300] more cases --- tutorial/tutorials/no_children/root_lib | 2 +- .../tutorials/one_child_tutorial_no_imports/root_lib | 2 +- .../two_child_connect_import_and_export/CAP.rc | 11 +++++++++++ .../two_child_connect_import_and_export/ExtData.rc | 0 .../two_child_connect_import_and_export/HISTORY.rc | 12 ++++++++++++ .../two_child_connect_import_and_export/cap_restart | 1 + .../two_child_connect_import_and_export/root.rc | 12 ++++++++++++ .../two_child_connect_import_and_export/root_lib | 1 + 8 files changed, 39 insertions(+), 2 deletions(-) create mode 100644 tutorial/tutorials/two_child_connect_import_and_export/CAP.rc create mode 100644 tutorial/tutorials/two_child_connect_import_and_export/ExtData.rc create mode 100644 tutorial/tutorials/two_child_connect_import_and_export/HISTORY.rc create mode 100644 tutorial/tutorials/two_child_connect_import_and_export/cap_restart create mode 100644 tutorial/tutorials/two_child_connect_import_and_export/root.rc create mode 100644 tutorial/tutorials/two_child_connect_import_and_export/root_lib diff --git a/tutorial/tutorials/no_children/root_lib b/tutorial/tutorials/no_children/root_lib index e6c005133a7f..a4d454946df6 100644 --- a/tutorial/tutorials/no_children/root_lib +++ b/tutorial/tutorials/no_children/root_lib @@ -1 +1 @@ -no_children +parent_no_children diff --git a/tutorial/tutorials/one_child_tutorial_no_imports/root_lib b/tutorial/tutorials/one_child_tutorial_no_imports/root_lib index ba918cc85bc7..ab04ecfa8244 100644 --- a/tutorial/tutorials/one_child_tutorial_no_imports/root_lib +++ b/tutorial/tutorials/one_child_tutorial_no_imports/root_lib @@ -1 +1 @@ -one_child +parent_one_child diff --git a/tutorial/tutorials/two_child_connect_import_and_export/CAP.rc b/tutorial/tutorials/two_child_connect_import_and_export/CAP.rc new file mode 100644 index 000000000000..4176101a8081 --- /dev/null +++ b/tutorial/tutorials/two_child_connect_import_and_export/CAP.rc @@ -0,0 +1,11 @@ +MAPLROOT_COMPNAME: root +ROOT_NAME: root +HIST_CF: HISTORY.rc + + +ROOT_CF: root.rc + +BEG_DATE: 20070801 000000 +END_DATE: 29990302 210000 +JOB_SGMT: 00000001 000000 +HEARTBEAT_DT: 3600 diff --git a/tutorial/tutorials/two_child_connect_import_and_export/ExtData.rc b/tutorial/tutorials/two_child_connect_import_and_export/ExtData.rc new file mode 100644 index 000000000000..e69de29bb2d1 diff --git a/tutorial/tutorials/two_child_connect_import_and_export/HISTORY.rc b/tutorial/tutorials/two_child_connect_import_and_export/HISTORY.rc new file mode 100644 index 000000000000..28cfb9eaf6bf --- /dev/null +++ b/tutorial/tutorials/two_child_connect_import_and_export/HISTORY.rc @@ -0,0 +1,12 @@ +GRID_LABELS: +:: + +COLLECTIONS: my_collection +:: + +my_collection.template: "%y4%m2%d2_%h2%n2z.nc4" +my_collection.format: 'CFIO' +my_collection.frequency: 060000 +my_collection.fields: 'output1', 'root' + :: + diff --git a/tutorial/tutorials/two_child_connect_import_and_export/cap_restart b/tutorial/tutorials/two_child_connect_import_and_export/cap_restart new file mode 100644 index 000000000000..d61015bfaab6 --- /dev/null +++ b/tutorial/tutorials/two_child_connect_import_and_export/cap_restart @@ -0,0 +1 @@ +20070801 000000 diff --git a/tutorial/tutorials/two_child_connect_import_and_export/root.rc b/tutorial/tutorials/two_child_connect_import_and_export/root.rc new file mode 100644 index 000000000000..a9db4182618a --- /dev/null +++ b/tutorial/tutorials/two_child_connect_import_and_export/root.rc @@ -0,0 +1,12 @@ +NX: 1 +NY: 1 + +root.GRID_TYPE: LatLon +root.GRIDNAME: DC90x45-PC +root.LM: 72 +root.IM_WORLD: 90 +root.JM_WORLD: 45 +root.POLE: 'PC' +root.DATELINE: 'DC' + +my_value: 11.0 diff --git a/tutorial/tutorials/two_child_connect_import_and_export/root_lib b/tutorial/tutorials/two_child_connect_import_and_export/root_lib new file mode 100644 index 000000000000..6c8ec46fbcc5 --- /dev/null +++ b/tutorial/tutorials/two_child_connect_import_and_export/root_lib @@ -0,0 +1 @@ +parent_two_siblings From d1a0f5cfbc3ef4c557e7f8318debaee87ce7a66d Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 13:13:35 -0400 Subject: [PATCH 196/300] rename and just pass full dso name... --- tutorial/tutorials/hello_world/root_lib | 2 +- tutorial/tutorials/no_children/root_lib | 2 +- tutorial/tutorials/one_child_tutorial_no_imports/root_lib | 2 +- tutorial/tutorials/two_child_connect_import_and_export/root_lib | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/tutorial/tutorials/hello_world/root_lib b/tutorial/tutorials/hello_world/root_lib index 6cec8490da15..7956352b0320 100644 --- a/tutorial/tutorials/hello_world/root_lib +++ b/tutorial/tutorials/hello_world/root_lib @@ -1 +1 @@ -hello_world_gridcomp +libMAPL.hello_world_gridcomp.so diff --git a/tutorial/tutorials/no_children/root_lib b/tutorial/tutorials/no_children/root_lib index a4d454946df6..36c8061079f3 100644 --- a/tutorial/tutorials/no_children/root_lib +++ b/tutorial/tutorials/no_children/root_lib @@ -1 +1 @@ -parent_no_children +libMAPL.parent_no_children.so diff --git a/tutorial/tutorials/one_child_tutorial_no_imports/root_lib b/tutorial/tutorials/one_child_tutorial_no_imports/root_lib index ab04ecfa8244..af62f457c3b0 100644 --- a/tutorial/tutorials/one_child_tutorial_no_imports/root_lib +++ b/tutorial/tutorials/one_child_tutorial_no_imports/root_lib @@ -1 +1 @@ -parent_one_child +libMAPL.parent_one_child.so diff --git a/tutorial/tutorials/two_child_connect_import_and_export/root_lib b/tutorial/tutorials/two_child_connect_import_and_export/root_lib index 6c8ec46fbcc5..1af902f1b72f 100644 --- a/tutorial/tutorials/two_child_connect_import_and_export/root_lib +++ b/tutorial/tutorials/two_child_connect_import_and_export/root_lib @@ -1 +1 @@ -parent_two_siblings +libMAPL.parent_two_siblings.so From f9724c6c053b232b62e940f427a607c6c5d17b9e Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 13:18:02 -0400 Subject: [PATCH 197/300] fix typos in code --- gridcomps/Cap/MAPL_CapGridComp.F90 | 2 +- .../parent_with_two_children/ParentTwoSiblings_GridComp.F90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index 78429d782fc1..8bf7c60f9db1 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -546,7 +546,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) cap%root_id = MAPL_AddChild(MAPLOBJ, name = root_name, SS = root_set_services, rc = status) _VERIFY(status) else - sharedObj = "libMAPL."//trim(cap%root_dso)//".so" + sharedObj = trim(cap%root_dso) cap%root_id = MAPL_AddChild(MAPLOBJ, root_name, 'setservices_', sharedObj=sharedObj, rc=status) _VERIFY(status) end if diff --git a/tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 b/tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 index 463a60eaa0b8..97ab88f0cf46 100644 --- a/tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 +++ b/tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 @@ -30,11 +30,11 @@ subroutine setservices(gc,rc) vlocation = MAPL_VLocationNone, _RC) child_aaa = MAPL_AddChild(gc,"AAA", "setservices_", sharedObj="libMAPL.aaa.so", _RC) - child_aaa = MAPL_AddChild(gc,"BBB", "setservices_", sharedObj="libMAPL.bbb.so", _RC) + child_bbb = MAPL_AddChild(gc,"BBB", "setservices_", sharedObj="libMAPL.bbb.so", _RC) call MAPL_AddConnectivity(gc, & src_name = "AAA_output_1", & - dst_name = "BBB_output_1", & + dst_name = "BBB_input_1", & src_id = child_aaa, & dst_id = child_bbb, & _RC) From 7ca65b4c61b6ff8ce5671e0b3624f6e186df8161 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 13:19:58 -0400 Subject: [PATCH 198/300] rename --- tutorial/tutorials/{no_children => parent_no_children}/CAP.rc | 0 tutorial/tutorials/{no_children => parent_no_children}/ExtData.rc | 0 tutorial/tutorials/{no_children => parent_no_children}/HISTORY.rc | 0 .../tutorials/{no_children => parent_no_children}/cap_restart | 0 tutorial/tutorials/{no_children => parent_no_children}/root.rc | 0 tutorial/tutorials/{no_children => parent_no_children}/root_lib | 0 .../CAP.rc | 0 .../ExtData.rc | 0 .../HISTORY.rc | 0 .../cap_restart | 0 .../root.rc | 0 .../root_lib | 0 .../CAP.rc | 0 .../ExtData.rc | 0 .../HISTORY.rc | 0 .../cap_restart | 0 .../root.rc | 0 .../root_lib | 0 18 files changed, 0 insertions(+), 0 deletions(-) rename tutorial/tutorials/{no_children => parent_no_children}/CAP.rc (100%) rename tutorial/tutorials/{no_children => parent_no_children}/ExtData.rc (100%) rename tutorial/tutorials/{no_children => parent_no_children}/HISTORY.rc (100%) rename tutorial/tutorials/{no_children => parent_no_children}/cap_restart (100%) rename tutorial/tutorials/{no_children => parent_no_children}/root.rc (100%) rename tutorial/tutorials/{no_children => parent_no_children}/root_lib (100%) rename tutorial/tutorials/{one_child_tutorial_no_imports => parent_one_child_no_imports}/CAP.rc (100%) rename tutorial/tutorials/{one_child_tutorial_no_imports => parent_one_child_no_imports}/ExtData.rc (100%) rename tutorial/tutorials/{one_child_tutorial_no_imports => parent_one_child_no_imports}/HISTORY.rc (100%) rename tutorial/tutorials/{one_child_tutorial_no_imports => parent_one_child_no_imports}/cap_restart (100%) rename tutorial/tutorials/{one_child_tutorial_no_imports => parent_one_child_no_imports}/root.rc (100%) rename tutorial/tutorials/{one_child_tutorial_no_imports => parent_one_child_no_imports}/root_lib (100%) rename tutorial/tutorials/{two_child_connect_import_and_export => parent_two_siblings_connect_import_export}/CAP.rc (100%) rename tutorial/tutorials/{two_child_connect_import_and_export => parent_two_siblings_connect_import_export}/ExtData.rc (100%) rename tutorial/tutorials/{two_child_connect_import_and_export => parent_two_siblings_connect_import_export}/HISTORY.rc (100%) rename tutorial/tutorials/{two_child_connect_import_and_export => parent_two_siblings_connect_import_export}/cap_restart (100%) rename tutorial/tutorials/{two_child_connect_import_and_export => parent_two_siblings_connect_import_export}/root.rc (100%) rename tutorial/tutorials/{two_child_connect_import_and_export => parent_two_siblings_connect_import_export}/root_lib (100%) diff --git a/tutorial/tutorials/no_children/CAP.rc b/tutorial/tutorials/parent_no_children/CAP.rc similarity index 100% rename from tutorial/tutorials/no_children/CAP.rc rename to tutorial/tutorials/parent_no_children/CAP.rc diff --git a/tutorial/tutorials/no_children/ExtData.rc b/tutorial/tutorials/parent_no_children/ExtData.rc similarity index 100% rename from tutorial/tutorials/no_children/ExtData.rc rename to tutorial/tutorials/parent_no_children/ExtData.rc diff --git a/tutorial/tutorials/no_children/HISTORY.rc b/tutorial/tutorials/parent_no_children/HISTORY.rc similarity index 100% rename from tutorial/tutorials/no_children/HISTORY.rc rename to tutorial/tutorials/parent_no_children/HISTORY.rc diff --git a/tutorial/tutorials/no_children/cap_restart b/tutorial/tutorials/parent_no_children/cap_restart similarity index 100% rename from tutorial/tutorials/no_children/cap_restart rename to tutorial/tutorials/parent_no_children/cap_restart diff --git a/tutorial/tutorials/no_children/root.rc b/tutorial/tutorials/parent_no_children/root.rc similarity index 100% rename from tutorial/tutorials/no_children/root.rc rename to tutorial/tutorials/parent_no_children/root.rc diff --git a/tutorial/tutorials/no_children/root_lib b/tutorial/tutorials/parent_no_children/root_lib similarity index 100% rename from tutorial/tutorials/no_children/root_lib rename to tutorial/tutorials/parent_no_children/root_lib diff --git a/tutorial/tutorials/one_child_tutorial_no_imports/CAP.rc b/tutorial/tutorials/parent_one_child_no_imports/CAP.rc similarity index 100% rename from tutorial/tutorials/one_child_tutorial_no_imports/CAP.rc rename to tutorial/tutorials/parent_one_child_no_imports/CAP.rc diff --git a/tutorial/tutorials/one_child_tutorial_no_imports/ExtData.rc b/tutorial/tutorials/parent_one_child_no_imports/ExtData.rc similarity index 100% rename from tutorial/tutorials/one_child_tutorial_no_imports/ExtData.rc rename to tutorial/tutorials/parent_one_child_no_imports/ExtData.rc diff --git a/tutorial/tutorials/one_child_tutorial_no_imports/HISTORY.rc b/tutorial/tutorials/parent_one_child_no_imports/HISTORY.rc similarity index 100% rename from tutorial/tutorials/one_child_tutorial_no_imports/HISTORY.rc rename to tutorial/tutorials/parent_one_child_no_imports/HISTORY.rc diff --git a/tutorial/tutorials/one_child_tutorial_no_imports/cap_restart b/tutorial/tutorials/parent_one_child_no_imports/cap_restart similarity index 100% rename from tutorial/tutorials/one_child_tutorial_no_imports/cap_restart rename to tutorial/tutorials/parent_one_child_no_imports/cap_restart diff --git a/tutorial/tutorials/one_child_tutorial_no_imports/root.rc b/tutorial/tutorials/parent_one_child_no_imports/root.rc similarity index 100% rename from tutorial/tutorials/one_child_tutorial_no_imports/root.rc rename to tutorial/tutorials/parent_one_child_no_imports/root.rc diff --git a/tutorial/tutorials/one_child_tutorial_no_imports/root_lib b/tutorial/tutorials/parent_one_child_no_imports/root_lib similarity index 100% rename from tutorial/tutorials/one_child_tutorial_no_imports/root_lib rename to tutorial/tutorials/parent_one_child_no_imports/root_lib diff --git a/tutorial/tutorials/two_child_connect_import_and_export/CAP.rc b/tutorial/tutorials/parent_two_siblings_connect_import_export/CAP.rc similarity index 100% rename from tutorial/tutorials/two_child_connect_import_and_export/CAP.rc rename to tutorial/tutorials/parent_two_siblings_connect_import_export/CAP.rc diff --git a/tutorial/tutorials/two_child_connect_import_and_export/ExtData.rc b/tutorial/tutorials/parent_two_siblings_connect_import_export/ExtData.rc similarity index 100% rename from tutorial/tutorials/two_child_connect_import_and_export/ExtData.rc rename to tutorial/tutorials/parent_two_siblings_connect_import_export/ExtData.rc diff --git a/tutorial/tutorials/two_child_connect_import_and_export/HISTORY.rc b/tutorial/tutorials/parent_two_siblings_connect_import_export/HISTORY.rc similarity index 100% rename from tutorial/tutorials/two_child_connect_import_and_export/HISTORY.rc rename to tutorial/tutorials/parent_two_siblings_connect_import_export/HISTORY.rc diff --git a/tutorial/tutorials/two_child_connect_import_and_export/cap_restart b/tutorial/tutorials/parent_two_siblings_connect_import_export/cap_restart similarity index 100% rename from tutorial/tutorials/two_child_connect_import_and_export/cap_restart rename to tutorial/tutorials/parent_two_siblings_connect_import_export/cap_restart diff --git a/tutorial/tutorials/two_child_connect_import_and_export/root.rc b/tutorial/tutorials/parent_two_siblings_connect_import_export/root.rc similarity index 100% rename from tutorial/tutorials/two_child_connect_import_and_export/root.rc rename to tutorial/tutorials/parent_two_siblings_connect_import_export/root.rc diff --git a/tutorial/tutorials/two_child_connect_import_and_export/root_lib b/tutorial/tutorials/parent_two_siblings_connect_import_export/root_lib similarity index 100% rename from tutorial/tutorials/two_child_connect_import_and_export/root_lib rename to tutorial/tutorials/parent_two_siblings_connect_import_export/root_lib From 5ff510bab0bea55d64d76c17e4e41430ece8a2dd Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 13:46:41 -0400 Subject: [PATCH 199/300] more renames, redo grid comps for generality --- .../grid_comps/leaf_comp_a/AAA_GridComp.F90 | 4 +-- .../grid_comps/leaf_comp_b/BBB_GridComp.F90 | 4 +-- .../ParentOneChild_GridComp.F90 | 10 ++++++-- .../ParentTwoSiblings_GridComp.F90 | 25 ++++++++++++------- .../parent_one_child_no_imports/HISTORY.rc | 3 ++- .../parent_one_child_no_imports/root.rc | 2 ++ .../root.rc | 4 +++ 7 files changed, 36 insertions(+), 16 deletions(-) diff --git a/tutorial/grid_comps/leaf_comp_a/AAA_GridComp.F90 b/tutorial/grid_comps/leaf_comp_a/AAA_GridComp.F90 index ccdc51590ed8..444666f066cc 100644 --- a/tutorial/grid_comps/leaf_comp_a/AAA_GridComp.F90 +++ b/tutorial/grid_comps/leaf_comp_a/AAA_GridComp.F90 @@ -22,7 +22,7 @@ subroutine setservices(gc,rc) call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_INITIALIZE, my_initialize, _RC) call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_RUN, my_run, _RC) - call MAPL_AddExportSpec(gc,short_name='AAA_output_1', long_name='NA',units='NA', & + call MAPL_AddExportSpec(gc,short_name='field1', long_name='NA',units='NA', & dims = MAPL_DimsHorzOnly, & vlocation = MAPL_VLocationNone, _RC) @@ -62,7 +62,7 @@ subroutine my_run(gc, import, export, clock, rc) real(ESMF_KIND_R8) :: relative_time integer :: status - call MAPL_GetPointer(export,ptr_2d,'AAA_output_1',_RC) + call MAPL_GetPointer(export,ptr_2d,'field1',_RC) call ESMF_ClockGet(clock,currTime=current_time,startTime=start_time,_RC) time_interval = current_time - start_time call ESMF_TimeIntervalGet(time_interval,h_r8=relative_time,_RC) diff --git a/tutorial/grid_comps/leaf_comp_b/BBB_GridComp.F90 b/tutorial/grid_comps/leaf_comp_b/BBB_GridComp.F90 index b965938ff3f5..ef8eb94d565d 100644 --- a/tutorial/grid_comps/leaf_comp_b/BBB_GridComp.F90 +++ b/tutorial/grid_comps/leaf_comp_b/BBB_GridComp.F90 @@ -22,7 +22,7 @@ subroutine setservices(gc,rc) call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_INITIALIZE, my_initialize, _RC) call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_RUN, my_run, _RC) - call MAPL_AddImportSpec(gc,short_name='BBB_input_1', long_name='NA',units='NA', & + call MAPL_AddImportSpec(gc,short_name='field1', long_name='NA',units='NA', & dims = MAPL_DimsHorzOnly, & vlocation = MAPL_VLocationNone, _RC) @@ -59,7 +59,7 @@ subroutine my_run(gc, import, export, clock, rc) real, pointer :: ptr_2d(:,:) integer :: status - call MAPL_GetPointer(import,ptr_2d,'BBB_input_1',_RC) + call MAPL_GetPointer(import,ptr_2d,'field1',_RC) write(*,*)"BBB import 1 maxval: ",maxval(ptr_2d) _RETURN(_SUCCESS) diff --git a/tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 b/tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 index 5999ee0260a6..1f742ae5151a 100644 --- a/tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 +++ b/tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 @@ -10,7 +10,7 @@ module ParentOneChild_GridComp public setservices - integer :: child_aaa + integer :: child1 contains @@ -20,7 +20,13 @@ subroutine setservices(gc,rc) integer, optional :: rc integer :: status + type(MAPL_MetaComp), pointer :: MAPL + character(len=80) :: my_child_name, my_child_so + call MAPL_GetObjectFromGC ( GC, MAPL, _RC) + call MAPL_GetResource(MAPL, my_child_name, Label="my_child_name:",_RC) + call MAPL_GetResource(MAPL, my_child_so, Label="my_child_so:",_RC) + call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_INITIALIZE, my_initialize, _RC) call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_RUN, my_run, _RC) @@ -28,7 +34,7 @@ subroutine setservices(gc,rc) dims = MAPL_DimsHorzOnly, & vlocation = MAPL_VLocationNone, _RC) - child_aaa = MAPL_AddChild(gc, "AAA", "setservices_", sharedObj="libMAPL.aaa.so", _RC) + child1 = MAPL_AddChild(gc, my_child_name, "setservices_", sharedObj=my_child_so, _RC) call MAPL_GenericSetServices(gc, _RC) _RETURN(_SUCCESS) diff --git a/tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 b/tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 index 97ab88f0cf46..45686375ebae 100644 --- a/tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 +++ b/tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 @@ -10,8 +10,8 @@ module ParentTwoSiblings_GridComp public setservices - integer :: child_aaa - integer :: child_bbb + integer :: child1 + integer :: child2 contains @@ -21,6 +21,15 @@ subroutine setservices(gc,rc) integer, optional :: rc integer :: status + type(MAPL_MetaComp), pointer :: MAPL + character(len=80) :: my_child1_name, my_child1_so + character(len=80) :: my_child2_name, my_child2_so + + call MAPL_GetObjectFromGC ( GC, MAPL, _RC) + call MAPL_GetResource(MAPL, my_child1_name, Label="my_child1_name:",_RC) + call MAPL_GetResource(MAPL, my_child1_so, Label="my_child1_so:",_RC) + call MAPL_GetResource(MAPL, my_child2_name, Label="my_child2_name:",_RC) + call MAPL_GetResource(MAPL, my_child2_so, Label="my_child2_so:",_RC) call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_INITIALIZE, my_initialize, _RC) call MAPL_GridCompSetEntryPoint ( gc, ESMF_METHOD_RUN, my_run, _RC) @@ -29,14 +38,12 @@ subroutine setservices(gc,rc) dims = MAPL_DimsHorzOnly, & vlocation = MAPL_VLocationNone, _RC) - child_aaa = MAPL_AddChild(gc,"AAA", "setservices_", sharedObj="libMAPL.aaa.so", _RC) - child_bbb = MAPL_AddChild(gc,"BBB", "setservices_", sharedObj="libMAPL.bbb.so", _RC) - + child1 = MAPL_AddChild(gc, my_child1_name, "setservices_", sharedObj=my_child1_so, _RC) + child2 = MAPL_AddChild(gc, my_child2_name, "setservices_", sharedObj=my_child2_so, _RC) call MAPL_AddConnectivity(gc, & - src_name = "AAA_output_1", & - dst_name = "BBB_input_1", & - src_id = child_aaa, & - dst_id = child_bbb, & + short_name = ["field1"], & + src_id = child1, & + dst_id = child2, & _RC) call MAPL_GenericSetServices(gc, _RC) diff --git a/tutorial/tutorials/parent_one_child_no_imports/HISTORY.rc b/tutorial/tutorials/parent_one_child_no_imports/HISTORY.rc index 28cfb9eaf6bf..32ae97d5a103 100644 --- a/tutorial/tutorials/parent_one_child_no_imports/HISTORY.rc +++ b/tutorial/tutorials/parent_one_child_no_imports/HISTORY.rc @@ -7,6 +7,7 @@ COLLECTIONS: my_collection my_collection.template: "%y4%m2%d2_%h2%n2z.nc4" my_collection.format: 'CFIO' my_collection.frequency: 060000 -my_collection.fields: 'output1', 'root' +my_collection.fields: 'output1', 'root' , 'root_output_field' + 'field1', 'AAA', :: diff --git a/tutorial/tutorials/parent_one_child_no_imports/root.rc b/tutorial/tutorials/parent_one_child_no_imports/root.rc index a9db4182618a..650c0f8b75ca 100644 --- a/tutorial/tutorials/parent_one_child_no_imports/root.rc +++ b/tutorial/tutorials/parent_one_child_no_imports/root.rc @@ -10,3 +10,5 @@ root.POLE: 'PC' root.DATELINE: 'DC' my_value: 11.0 +my_child_so: libMAPL.aaa.so +my_child_name: AAA diff --git a/tutorial/tutorials/parent_two_siblings_connect_import_export/root.rc b/tutorial/tutorials/parent_two_siblings_connect_import_export/root.rc index a9db4182618a..0b01c46cfb13 100644 --- a/tutorial/tutorials/parent_two_siblings_connect_import_export/root.rc +++ b/tutorial/tutorials/parent_two_siblings_connect_import_export/root.rc @@ -10,3 +10,7 @@ root.POLE: 'PC' root.DATELINE: 'DC' my_value: 11.0 +my_child1_so: libMAPL.aaa.so +my_child1_name: AAA +my_child2_so: libMAPL.bbb.so +my_child2_name: BBB From 95781718e50c06f63ae2e809d68d71f29ba07a0e Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 13:48:53 -0400 Subject: [PATCH 200/300] add new tutorial --- .../parent_one_child_import_via_extdata/CAP.rc | 11 +++++++++++ .../parent_one_child_import_via_extdata/ExtData.rc | 0 .../parent_one_child_import_via_extdata/HISTORY.rc | 12 ++++++++++++ .../cap_restart | 1 + .../parent_one_child_import_via_extdata/root.rc | 14 ++++++++++++++ .../parent_one_child_import_via_extdata/root_lib | 1 + 6 files changed, 39 insertions(+) create mode 100644 tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc create mode 100644 tutorial/tutorials/parent_one_child_import_via_extdata/ExtData.rc create mode 100644 tutorial/tutorials/parent_one_child_import_via_extdata/HISTORY.rc create mode 100644 tutorial/tutorials/parent_one_child_import_via_extdata/cap_restart create mode 100644 tutorial/tutorials/parent_one_child_import_via_extdata/root.rc create mode 100644 tutorial/tutorials/parent_one_child_import_via_extdata/root_lib diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc b/tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc new file mode 100644 index 000000000000..4176101a8081 --- /dev/null +++ b/tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc @@ -0,0 +1,11 @@ +MAPLROOT_COMPNAME: root +ROOT_NAME: root +HIST_CF: HISTORY.rc + + +ROOT_CF: root.rc + +BEG_DATE: 20070801 000000 +END_DATE: 29990302 210000 +JOB_SGMT: 00000001 000000 +HEARTBEAT_DT: 3600 diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/ExtData.rc b/tutorial/tutorials/parent_one_child_import_via_extdata/ExtData.rc new file mode 100644 index 000000000000..e69de29bb2d1 diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/HISTORY.rc b/tutorial/tutorials/parent_one_child_import_via_extdata/HISTORY.rc new file mode 100644 index 000000000000..e6356be28553 --- /dev/null +++ b/tutorial/tutorials/parent_one_child_import_via_extdata/HISTORY.rc @@ -0,0 +1,12 @@ +GRID_LABELS: +:: + +COLLECTIONS: my_collection +:: + +my_collection.template: "%y4%m2%d2_%h2%n2z.nc4" +my_collection.format: 'CFIO' +my_collection.frequency: 060000 +my_collection.fields: 'output1', 'root' , 'root_output_field' + :: + diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/cap_restart b/tutorial/tutorials/parent_one_child_import_via_extdata/cap_restart new file mode 100644 index 000000000000..d61015bfaab6 --- /dev/null +++ b/tutorial/tutorials/parent_one_child_import_via_extdata/cap_restart @@ -0,0 +1 @@ +20070801 000000 diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/root.rc b/tutorial/tutorials/parent_one_child_import_via_extdata/root.rc new file mode 100644 index 000000000000..a6773f784a08 --- /dev/null +++ b/tutorial/tutorials/parent_one_child_import_via_extdata/root.rc @@ -0,0 +1,14 @@ +NX: 1 +NY: 1 + +root.GRID_TYPE: LatLon +root.GRIDNAME: DC90x45-PC +root.LM: 72 +root.IM_WORLD: 90 +root.JM_WORLD: 45 +root.POLE: 'PC' +root.DATELINE: 'DC' + +my_value: 11.0 +my_child_so: libMAPL.bbb.so +my_child_name: BBB diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/root_lib b/tutorial/tutorials/parent_one_child_import_via_extdata/root_lib new file mode 100644 index 000000000000..af62f457c3b0 --- /dev/null +++ b/tutorial/tutorials/parent_one_child_import_via_extdata/root_lib @@ -0,0 +1 @@ +libMAPL.parent_one_child.so From 042cc008427b4c7b91a2a3c419e4fba782123315 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 13:51:36 -0400 Subject: [PATCH 201/300] git push --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 07e285887c75..643e4c2b36b7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed ### Added +- Add tutorials ### Changed From 5286c4f97f67f22eded9015be659eb45123c575f Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 14:30:01 -0400 Subject: [PATCH 202/300] fix so regular model will build two constructors for cap --- gridcomps/Cap/MAPL_Cap.F90 | 55 +++++++++++++++++++++++++++++++------- 1 file changed, 45 insertions(+), 10 deletions(-) diff --git a/gridcomps/Cap/MAPL_Cap.F90 b/gridcomps/Cap/MAPL_Cap.F90 index b4ce974ee307..624257ffdb58 100644 --- a/gridcomps/Cap/MAPL_Cap.F90 +++ b/gridcomps/Cap/MAPL_Cap.F90 @@ -64,7 +64,8 @@ module MAPL_CapMod end type MAPL_Cap interface MAPL_Cap - module procedure new_MAPL_Cap + module procedure new_MAPL_Cap_from_set_services + module procedure new_MAPL_Cap_from_dso end interface MAPL_Cap @@ -76,21 +77,55 @@ end function c_chdir end interface contains - - function new_MAPL_Cap(name, unusable,set_services, cap_options, rc) result(cap) + + function new_MAPL_Cap_from_set_services(name, set_services, unusable, cap_options, rc) result(cap) type (MAPL_Cap) :: cap character(*), intent(in) :: name + procedure() :: set_services class (KeywordEnforcer), optional, intent(in) :: unusable - procedure(), optional :: set_services type ( MAPL_CapOptions), optional, intent(in) :: cap_options integer, optional, intent(out) :: rc - integer :: status + integer :: status + + cap%name = name + cap%set_services => set_services + cap%non_dso = .true. + + if (present(cap_options)) then + allocate(cap%cap_options, source = cap_options) + else + allocate(cap%cap_options, source = MAPL_CapOptions()) + endif + + if (cap%cap_options%use_comm_world) then + cap%comm_world = MPI_COMM_WORLD + cap%cap_options%comm = MPI_COMM_WORLD + else + cap%comm_world = cap%cap_options%comm + endif + + call cap%initialize_mpi(rc=status) + _VERIFY(status) + + call MAPL_Initialize(comm=cap%comm_world, & + logging_config=cap%cap_options%logging_config, & + rc=status) + _VERIFY(status) + + _RETURN(_SUCCESS) + _UNUSED_DUMMY(unusable) + + end function new_MAPL_Cap_from_set_services + + function new_MAPL_Cap_from_dso(name, unusable, cap_options, rc) result(cap) + type (MAPL_Cap) :: cap + character(*), intent(in) :: name + class (KeywordEnforcer), optional, intent(in) :: unusable + type ( MAPL_CapOptions), optional, intent(in) :: cap_options + integer, optional, intent(out) :: rc + integer :: status cap%name = name - if (present(set_services)) then - cap%set_services => set_services - cap%non_dso = .true. - end if if (present(cap_options)) then allocate(cap%cap_options, source = cap_options) @@ -116,7 +151,7 @@ function new_MAPL_Cap(name, unusable,set_services, cap_options, rc) result(cap) _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) - end function new_MAPL_Cap + end function new_MAPL_Cap_from_dso ! 3. Run the ensemble (default is 1 member) From 81581b6ae7e505b951856cd93170726bce02d605 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 14:46:00 -0400 Subject: [PATCH 203/300] fix for full model --- gridcomps/Cap/CMakeLists.txt | 2 +- gridcomps/Cap/MAPL_CapGridComp.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/gridcomps/Cap/CMakeLists.txt b/gridcomps/Cap/CMakeLists.txt index 039f7c6969e7..07a2fe92b3cb 100644 --- a/gridcomps/Cap/CMakeLists.txt +++ b/gridcomps/Cap/CMakeLists.txt @@ -2,7 +2,7 @@ esma_set_this (OVERRIDE MAPL.cap) set (srcs MAPL_Cap.F90 MAPL_CapGridComp.F90 - #MAPL_NUOPCWrapperMod.F90 + MAPL_NUOPCWrapperMod.F90 CapOptions.F90 ExternalGCStorage.F90 ) diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index 8bf7c60f9db1..77858d74488d 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -542,7 +542,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) root_set_services => cap%root_set_services call t_p%start('SetService') - if (cap%root_dso == "none") then + if (.not.allocated(cap%root_dso)) then cap%root_id = MAPL_AddChild(MAPLOBJ, name = root_name, SS = root_set_services, rc = status) _VERIFY(status) else From 8a054c4490d4c8598dd2a2f4ef7f5ef39a0970d9 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 15:36:58 -0400 Subject: [PATCH 204/300] updates for new test case, protect against null poitner --- CMakeLists.txt | 4 +++- .../ParentOneChild_GridComp.F90 | 2 +- .../ParentTwoSiblings_GridComp.F90 | 2 +- .../parent_one_child_import_via_extdata/CAP.rc | 1 + .../ExtData.rc | 3 +++ .../HISTORY.rc | 9 +-------- .../extdata_input.200708.nc4 | Bin 0 -> 55839 bytes 7 files changed, 10 insertions(+), 11 deletions(-) create mode 100644 tutorial/tutorials/parent_one_child_import_via_extdata/extdata_input.200708.nc4 diff --git a/CMakeLists.txt b/CMakeLists.txt index 508ea23807d5..784abf4b5912 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -163,7 +163,9 @@ add_subdirectory (base) add_subdirectory (MAPL) add_subdirectory (gridcomps) add_subdirectory (griddedio) -add_subdirectory (tutorial) +if (BUILD_WITH_FLAP) + add_subdirectory (tutorial) +endif() if (PFUNIT_FOUND) include (add_pfunit_ctest) diff --git a/tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 b/tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 index 1f742ae5151a..1b61b22c4a87 100644 --- a/tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 +++ b/tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 @@ -74,7 +74,7 @@ subroutine my_run(gc, import, export, clock, rc) call MAPL_GetObjectFromGC ( GC, MAPL, _RC) call MAPL_GetResource(MAPL, my_constant, Label="my_value:", default=17.0,_RC) call MAPL_GetPointer(export,ptr_2d,'output1',_RC) - ptr_2d = my_constant + if (associated(ptr_2d)) ptr_2d = my_constant call MAPL_GenericRunChildren(gc, import, export, clock, _RC) diff --git a/tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 b/tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 index 45686375ebae..be0a3257234c 100644 --- a/tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 +++ b/tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 @@ -84,7 +84,7 @@ subroutine my_run(gc, import, export, clock, rc) call MAPL_GetObjectFromGC ( GC, MAPL, _RC) call MAPL_GetResource(MAPL, my_constant, Label="my_value:", default=17.0,_RC) call MAPL_GetPointer(export,ptr_2d,'output1',_RC) - ptr_2d = my_constant + if (associated(ptr_2d)) ptr_2d = my_constant call MAPL_GenericRunChildren(gc, import, export, clock, _RC) diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc b/tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc index 4176101a8081..242b1942aaeb 100644 --- a/tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc +++ b/tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc @@ -1,3 +1,4 @@ +USE_EXTDATA2G: .true. MAPLROOT_COMPNAME: root ROOT_NAME: root HIST_CF: HISTORY.rc diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/ExtData.rc b/tutorial/tutorials/parent_one_child_import_via_extdata/ExtData.rc index e69de29bb2d1..99c82e227446 100644 --- a/tutorial/tutorials/parent_one_child_import_via_extdata/ExtData.rc +++ b/tutorial/tutorials/parent_one_child_import_via_extdata/ExtData.rc @@ -0,0 +1,3 @@ +PrimaryExports%% +field1 NA N N 0 none none field1 extdata_input.%y4%m2.nc4 +%% diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/HISTORY.rc b/tutorial/tutorials/parent_one_child_import_via_extdata/HISTORY.rc index e6356be28553..d3a6677416e1 100644 --- a/tutorial/tutorials/parent_one_child_import_via_extdata/HISTORY.rc +++ b/tutorial/tutorials/parent_one_child_import_via_extdata/HISTORY.rc @@ -1,12 +1,5 @@ GRID_LABELS: :: -COLLECTIONS: my_collection +COLLECTIONS: :: - -my_collection.template: "%y4%m2%d2_%h2%n2z.nc4" -my_collection.format: 'CFIO' -my_collection.frequency: 060000 -my_collection.fields: 'output1', 'root' , 'root_output_field' - :: - diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/extdata_input.200708.nc4 b/tutorial/tutorials/parent_one_child_import_via_extdata/extdata_input.200708.nc4 new file mode 100644 index 0000000000000000000000000000000000000000..febb4492617c42742d9cbec72a18b097f2869b6f GIT binary patch literal 55839 zcmeHOdvKIj6+gQhk`MxfN(+spERh?N;B(`vPKsAK=Ac+P!f_gl!z z#@dy0+mG|zd(VCS&hI{Qzq60D`2w>msw?c}<)Fh=6&AlLQ(P)z&hrmH+}-Buwa=bw zw=WfmjuMrp%M{8AJJ?9&=G%Z&9Tl+6E{j}H(&3Qt(pyN{bcNuEr;-nqiR-@vHW0+RK#xKbQA^!w3G~2zScOrU zv-vKW^Kqr1W$Bv3pKR&t2w?B_lP0PW55Mxv=N7`dq}vHV-AL>@avKa&!df}rvcG+G z1&EoloKgWU{o_X~;3rgvAAqJre9eVg_!4Ddr8MAy)Nftzb<)7r$v*Xto=?Gp_yTv3 zu>dZ+YEME7X<#d*DDL{%(KE0CUnqgn|8DbNc=r$Q{E3n{Ob-IW{xdDcv|w&Ak;S4G zMp*b_v7&`q76w=dbK*PA%cf^UT+37tkXz}~HrsqEWw+UEx2xh>I_A^lo9EmjrY(RQ z8fQV{Rh-l_#J1`vtr9Ekw?82Zeo>Xzn{65B)wfVqdPvm)^Pv(S2z43RNHo^yO{LON zGa1er8K}agLawk*(K%WMDCEmZTw-ikO(}K|b-f*)U=TirO4Kb{S$yrC{;ptqcULIr z^>p~55{G8T0yAWRE>EXl=u<Dnu!i-vbg$1ZLmAKxPV1Wu* zDb~>+N`@1LsF{{TRdc_Y9gG^4D`{yR?ek#L%w~jUrP7QV{b|FuFU1 zWz+=>PbxXABs`~Qhs@`HivWRWz|dC%#u2i6?r4nr^>vf>%J;Ji9A`g zIJ?$s<+@FkJ%wl2ra3YUzp`!(my12i3Jijz(H;^;q4lDjWm4nHfrS6OCI&K1??E4 z1UwbM5!LK0Ovs#i>OI?{4h^ADx{?3M-{KW!7E?n$5iBN#e9l0=;Vjg!u)u20d{bJu zVX>ISz!t_tOJ3P|Bin8|#@_1f?w~2AFZ0DaM#Z5UrT)Z1Q;0%gI!#~-I$eLS(aWMv z*Y(Vh>euMg-xd_KzWyd8Qvr6*)o&~r0Y-okU<4QeMt~7u1Q-EEfDvE>7y(9Lst9y@ z+qRVpKS_t}Sd%P$LRC_Uw`!&6LopXzJ`{ z9}4u)6o0-)(K9odG114Pd?N1>?V+h}9gfFeem%cOP54cb!rM~7hu0&0-?4Jp@b*A3 z=m+i5XhY{fhsgc?YYjgTS^9&q4Zpp5Mb=L*w%#hT^hL7`FC2G@yOM?@-LC}Nd@ZA2 zGsMvDz5nzVrsSui?_IRi{UszFFbnO477GQ;czk;}K4`!^=e4d7-zc7FzM;?kmrzSYgyTji z7LH_7=_!nKXbW{h_(Wy0;bb(Nj^;d)@_VWrr*ck6`I+RJg|+-g81(x>qc5C;Wc^Kv<>k?IU!b}dL%cK)mw20wsaJialUCp(w)lQddz4-sb*eMAD z4n>ZDnE(10GGZ+EpWblNfm?}muuUZdU&%v}zK0O6(RJ7B3)D8|DJ8SGVF{mBT60Nh zAe(()eSLj@BAlx0&%`2i$#5oI*Pq(!!1{RcBZ0698V5T+*X|)JVYc+{4o%gaCXOHX2hV?L-e-S zh#6@EC!`z?eOssgW(-5L?2M)&g9N51?7*L2h*H7SU^*f_hv~Z#m2evSA28B%bj^m$ z==#yMw9m}Or6w)4sA(VF^g~_Vo^%RJWlh!mQdQYrBTWb3O${|k;c~sHv97spb$b*o)<>rj!y4UNFi_7O3Dcb}BdE9FqPif>c#fQq*$xk1SWC6_7*DlB!&mj)#_ zDA^+AP(a1Esd%@F_e$yRQ|a54jE#T@hLl4Q72l)cyH$Lbk~@{$q2xVEs_{XWinl4L z$JMOjtCR#4R=MR%vyv@Jwkg@Ar0PH1qvAW1+^OU)DTj8e_#PFHsJNjda9{)&0Y-ok zUSJ$t<^NdyI@IkBoMCX{$QL8?Es~9gd zeOcz}{%Gg&vC7O9KXL%j`ekD&s`Sh13%S;(OWN_m@b_e{)}P31PrP8&uNbd#%uD^; zs!u<3885WHWX;w3`d3l4loCp z1Iz*D0CS+|IpE%mXH$L{1Lgp8fH}Y%U=A<`m;*)6fsrkEU&jw)z#L!>Fb9|e%mL;A zbD-!s;P&8s9Y2f#bAUO(9AFMG2bcrQfuiTYNDJQA@xvG}2bcrQ0pFb9|e%z>ikfO{+6*YU#`Fb9|e R%mL;AbAUO(94K}U{2LSvnpOY+ literal 0 HcmV?d00001 From fde8504ff1c821063a56966a81ea4ebc362807ad Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 15:37:36 -0400 Subject: [PATCH 205/300] bad commit reverse --- tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc | 1 - 1 file changed, 1 deletion(-) diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc b/tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc index 242b1942aaeb..4176101a8081 100644 --- a/tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc +++ b/tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc @@ -1,4 +1,3 @@ -USE_EXTDATA2G: .true. MAPLROOT_COMPNAME: root ROOT_NAME: root HIST_CF: HISTORY.rc From 4f635874217ccf72bec46b357218e8ed4f10053c Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 15:40:20 -0400 Subject: [PATCH 206/300] add yaml file for new extdata --- .../parent_one_child_import_via_extdata/extdata.yaml | 5 +++++ 1 file changed, 5 insertions(+) create mode 100644 tutorial/tutorials/parent_one_child_import_via_extdata/extdata.yaml diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/extdata.yaml b/tutorial/tutorials/parent_one_child_import_via_extdata/extdata.yaml new file mode 100644 index 000000000000..162048cd8d0c --- /dev/null +++ b/tutorial/tutorials/parent_one_child_import_via_extdata/extdata.yaml @@ -0,0 +1,5 @@ +Collections: + collection_1: {template: extdata_input.%y4%m2.nc4} + +Exports: + field1: {collection: collection_1, variable: field1} From 49453354ceb4caaa8e63c09666a695e995cdb86e Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 28 Jun 2022 15:54:02 -0400 Subject: [PATCH 207/300] remove unneccessary lines, add 3D export to no child --- .../ParentNoChildren_GridComp.F90 | 10 ++++++++-- tutorial/tutorials/hello_world/CAP.rc | 1 - tutorial/tutorials/parent_no_children/CAP.rc | 2 -- .../parent_one_child_import_via_extdata/CAP.rc | 1 - tutorial/tutorials/parent_one_child_no_imports/CAP.rc | 1 - .../parent_two_siblings_connect_import_export/CAP.rc | 1 - 6 files changed, 8 insertions(+), 8 deletions(-) diff --git a/tutorial/grid_comps/parent_with_no_children/ParentNoChildren_GridComp.F90 b/tutorial/grid_comps/parent_with_no_children/ParentNoChildren_GridComp.F90 index 39e245b5bfb6..80c37872ae84 100644 --- a/tutorial/grid_comps/parent_with_no_children/ParentNoChildren_GridComp.F90 +++ b/tutorial/grid_comps/parent_with_no_children/ParentNoChildren_GridComp.F90 @@ -25,6 +25,10 @@ subroutine setservices(gc,rc) call MAPL_AddExportSpec(gc,short_name='output1', long_name='NA',units='NA', & dims = MAPL_DimsHorzOnly, & vlocation = MAPL_VLocationNone, _RC) + call MAPL_AddExportSpec(gc,short_name='output2', long_name='NA',units='NA', & + dims = MAPL_DimsHorzVert, & + vlocation = MAPL_VLocationCenter, _RC) + call MAPL_GenericSetServices(gc, _RC) @@ -57,7 +61,7 @@ subroutine my_run(gc, import, export, clock, rc) type(ESMF_Clock), intent(inout) :: clock integer, intent(out), optional :: rc - real, pointer :: ptr_2d(:,:) + real, pointer :: ptr_2d(:,:), ptr_3d(:,:) type (MAPL_MetaComp), pointer :: MAPL real :: my_constant integer :: status @@ -65,7 +69,9 @@ subroutine my_run(gc, import, export, clock, rc) call MAPL_GetObjectFromGC ( GC, MAPL, _RC) call MAPL_GetResource(MAPL, my_constant, Label="my_value:", default=17.0,_RC) call MAPL_GetPointer(export,ptr_2d,'output1',_RC) - ptr_2d = my_constant + if (associated(ptr_2d)) ptr_2d = my_constant + call MAPL_GetPointer(export,ptr_3d,'output2',_RC) + if (associated(ptr_3d)) ptr_3d = my_constant _RETURN(_SUCCESS) diff --git a/tutorial/tutorials/hello_world/CAP.rc b/tutorial/tutorials/hello_world/CAP.rc index b34314f95bb0..da07b2afa230 100644 --- a/tutorial/tutorials/hello_world/CAP.rc +++ b/tutorial/tutorials/hello_world/CAP.rc @@ -1,4 +1,3 @@ -MAPLROOT_COMPNAME: hello_world ROOT_NAME: hello_world HIST_CF: HISTORY.rc diff --git a/tutorial/tutorials/parent_no_children/CAP.rc b/tutorial/tutorials/parent_no_children/CAP.rc index 4176101a8081..b613b5f5ceb6 100644 --- a/tutorial/tutorials/parent_no_children/CAP.rc +++ b/tutorial/tutorials/parent_no_children/CAP.rc @@ -1,8 +1,6 @@ -MAPLROOT_COMPNAME: root ROOT_NAME: root HIST_CF: HISTORY.rc - ROOT_CF: root.rc BEG_DATE: 20070801 000000 diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc b/tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc index 4176101a8081..de00498d9711 100644 --- a/tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc +++ b/tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc @@ -1,4 +1,3 @@ -MAPLROOT_COMPNAME: root ROOT_NAME: root HIST_CF: HISTORY.rc diff --git a/tutorial/tutorials/parent_one_child_no_imports/CAP.rc b/tutorial/tutorials/parent_one_child_no_imports/CAP.rc index 4176101a8081..de00498d9711 100644 --- a/tutorial/tutorials/parent_one_child_no_imports/CAP.rc +++ b/tutorial/tutorials/parent_one_child_no_imports/CAP.rc @@ -1,4 +1,3 @@ -MAPLROOT_COMPNAME: root ROOT_NAME: root HIST_CF: HISTORY.rc diff --git a/tutorial/tutorials/parent_two_siblings_connect_import_export/CAP.rc b/tutorial/tutorials/parent_two_siblings_connect_import_export/CAP.rc index 4176101a8081..de00498d9711 100644 --- a/tutorial/tutorials/parent_two_siblings_connect_import_export/CAP.rc +++ b/tutorial/tutorials/parent_two_siblings_connect_import_export/CAP.rc @@ -1,4 +1,3 @@ -MAPLROOT_COMPNAME: root ROOT_NAME: root HIST_CF: HISTORY.rc From e711cee05b7ef06b752ba3bf8a58d5e0dc0b15b0 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 29 Jun 2022 10:41:43 -0400 Subject: [PATCH 208/300] add some readmes --- gridcomps/Cap/MAPL_CapGridComp.F90 | 14 +-- tutorial/README.md | 41 +++++++ tutorial/run_tutorial_case.sh | 1 - tutorial/tutorials/hello_world/README.md | 110 ++++++++++++++++++ .../tutorials/parent_no_children/README.md | 47 ++++++++ 5 files changed, 205 insertions(+), 8 deletions(-) create mode 100644 tutorial/README.md create mode 100644 tutorial/tutorials/hello_world/README.md create mode 100644 tutorial/tutorials/parent_no_children/README.md diff --git a/gridcomps/Cap/MAPL_CapGridComp.F90 b/gridcomps/Cap/MAPL_CapGridComp.F90 index 77858d74488d..9e5733630969 100644 --- a/gridcomps/Cap/MAPL_CapGridComp.F90 +++ b/gridcomps/Cap/MAPL_CapGridComp.F90 @@ -517,13 +517,13 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) ! Add a SINGLE_COLUMN flag in HISTORY.rc based on DYCORE value(from AGCM.rc) !--------------------------------------------------------------------------- - !call ESMF_ConfigGetAttribute(cap%cf_root, value=DYCORE, Label="DYCORE:", rc=status) - !_VERIFY(STATUS) - !if (DYCORE == 'DATMO') then - !snglcol = 1 - !call MAPL_ConfigSetAttribute(cap%cf_hist, value=snglcol, Label="SINGLE_COLUMN:", rc=status) - !_VERIFY(STATUS) - !end if + call ESMF_ConfigGetAttribute(cap%cf_root, value=DYCORE, Label="DYCORE:", default = 'FV3', rc=status) + _VERIFY(STATUS) + if (DYCORE == 'DATMO') then + snglcol = 1 + call MAPL_ConfigSetAttribute(cap%cf_hist, value=snglcol, Label="SINGLE_COLUMN:", rc=status) + _VERIFY(STATUS) + end if ! Detect if this a regular replay in the AGCM.rc ! ---------------------------------------------- diff --git a/tutorial/README.md b/tutorial/README.md new file mode 100644 index 000000000000..822b396ab724 --- /dev/null +++ b/tutorial/README.md @@ -0,0 +1,41 @@ +# MAPL Tutorials Overview + +For user education we have provided some simple tutorials. These demonstrate how to create simple gridded componnts and hierachies of components and drive them via the MAPL_Cap just like the real GEOSgcm model. Each "tutorial" will consist of a set of input files that can be run with our the Example_Driver.x and will itself contain a REAMDE file with explanation about what that particular tutorial is demonstrating. In addition each will suggest exercises that the user can do to extend them. + +Before embarking on these tutorials the new users should review the MAPL/ESMF powerpoint presentation here to get a general sense of what these frameworks are about and become familiar with the terminology. + +In addition, to use these tutorials you will have to have either built MAPL as a standalone fixure or as part of another figure like the GEOSgcm. If you are reading this and have not build either, see the instructions for how to build MAPL here: [How to Build MAPL](https://github.com/GEOS-ESM/MAPL/wiki/Building-and-Testing-MAPL-as-a-standalone). For these exercises we highly recommend building MAPL by itself as your build will be much faster, expecially when you change the code. The build itself takes a short time. We also recommend useing the "debug" build rather than the "release" build. + +Once you have installed either MAPL or the full GEOSgcm you will have an installation directory whose full path I will refer to as INSTALL_DIR. + +Once you have this the user will find a script run_tutorial_case.sh that is in INSTALL_DIR/bin we have created for the users convinience. + +This script takes two arguments. The path to INSTALL_DIR and the directory name of the test case you wish to run. To run this, go to a tempoary directory then run the script with the arguments. It will copy the input files to that directory and run the Example_Driver.x for that set of input files. Note that if you are at NCCS or NAS you will need to be on an interactive slurm job with a single node. + +The follow tutorials are available in the recommended order and represent the tutorial name you would use in the run script. +- hello_world +- parent_no_children +- parent_one_child_no_imports +- parent_two_siblings_connect_import_export +- parent_one_child_import_via_extdata + + +As a concrete example, suppose you have installed MAPL here at /discover/nobackup/auser/MAPL/install and want to run hello_world you run this on the command line: + +``` +/discover/nobackup/auser/MAPL/install/bin/run_tutorial_case.sh /discover/nobackup/auser/MAPL/install hello_world +``` + + +# Note for the Curious +The astute user might ask, how is it each tutorial is running the same executable yet using different gridded components. The answer is that each gridded component is compiled as a shared objection library. Each time you run Example_Driver.x you pass in the actual name of the shared object library that will be used as the top leve gridded component. This was done to make the life of the hubmle developer writing this tutorial easier. + +Note that this technology, while used at places in the full GEOSgcm model to handle mom5 and mom6 it is not ubiquitous. You might notice that a few calls in these tutorails, particularly MAPL_AddChild calls in most gridded components and the "program" itself, aka where you have something like this: +``` +program Example_Driver.x + +! we have some source code + +end program Example_Driver.x +``` +may look a little different if you look at the corresponding program file for GEOSgcm.x. Do not worry, please come ask your nearest SI team. diff --git a/tutorial/run_tutorial_case.sh b/tutorial/run_tutorial_case.sh index 98f80b1109c5..afde1c99d536 100755 --- a/tutorial/run_tutorial_case.sh +++ b/tutorial/run_tutorial_case.sh @@ -20,7 +20,6 @@ source $INSTALL_DIR/bin/g5_modules.sh export LD_LIBRARY_PATH=${LD_LIBRARY_PATH}:${BASEDIR}/${ARCH}/lib:${INSTALL_DIR}/lib for file in `ls ${TUTORIAL_CASE}`; do - echo ${file} cp "${TUTORIAL_CASE}/${file}" . done diff --git a/tutorial/tutorials/hello_world/README.md b/tutorial/tutorials/hello_world/README.md new file mode 100644 index 000000000000..ac2f093f98ef --- /dev/null +++ b/tutorial/tutorials/hello_world/README.md @@ -0,0 +1,110 @@ +# Tutorial 1 - Hello World +Note the code for the gridded component used by this tutorial can be found here: + +tutorial/grid_comps/hello_world_gridcomp/HelloWorld_GridComp.F90 + +For this tutorial we will make the simplest possible gridded component we can and have it print hello in it's run method. + +The gridded component itself is run from the MAPL "CAP". This is a layer that the user should never have to touch. It's main function as far as the user is concerned is to perform the time stepping controlled via the CAP.rc and run the "root" gridded component (in this example HelloWorld_GridComp.F90) the user or program specified as well as two other special gridded components "History" and "ExtData" that provide services that we will talk about in later tutorials. + +# HelloWorld_GridComp.F90 Explanation + +If you look in the gridded component you will see that it is quite simple and is just about the minumum lines needed to create a gridded component, a grid for the component, and a run method that does something. + +The first routine is the setServices. This is where the user registers the actual methods to be used during the initilze and run phases of the gridded component and are specifed via the SetEntryPoint calls. In addition the MAPL_GenericSetServices is called and every MAPL component must call this before ending the subroutine. + +Next we see that a custom initialization routine "my_initialize" is created. It has two calls, the first tells it how to create the grid that is will be used by the gridded component. + +MAPL_GridCreate actually examines the components RC file which in this case is "hello_world.rc". The user will notice these lines: +``` +hello_world.GRID_TYPE: LatLon +hello_world.GRIDNAME: DC90x45-PC +hello_world.LM: 72 +hello_world.IM_WORLD: 90 +hello_world.JM_WORLD: 45 +hello_world.POLE: 'PC' +hello_world.DATELINE: 'DC' +``` +Generally the user will not have to modify these are the setup scripts when running the model would define this for you. In this case it is saying the grid will be a 90x45 lat-lon grid with LM vertical levels. + +After this call MAPL_GenericInitialize is called. Once again every custom initialize routine must call this. If no custom initialize routine is defined this will be call automatically. + +Finally we get to the run method my_run. This was registered and will be executed each time step. As you can see if does very little in this example. It gets the current time from the clock (this literally a clock that is advanced by the MAPL "CAP"), then prints the obligatory "Hello World" and finally uses an ESMF call to print the current time. + +# Running the code +When you run the code the first few lines will look like this: +``` +srun: cluster configuration lacks support for cpu binding + MAPL: No configure file specified for logging layer. Using defaults. + Starting pFIO input server on Clients + Starting pFIO output server on Clients + MAPL: Running with MOAB library for ESMF Mesh: F + SHMEM: NumCores per Node = 1 + SHMEM: NumNodes in use = 1 + SHMEM: Total PEs = 1 + SHMEM: NumNodes in use = 1 + Integer*4 Resource Parameter: HEARTBEAT_DT:3600 + NOT using buffer I/O for file: cap_restart + CAP: Read CAP restart properly, Current Date = 2007/08/01 + CAP: Current Time = 00/00/00 + Character Resource Parameter: ROOT_CF:hello_world.rc + Character Resource Parameter: ROOT_NAME:hello_world + Character Resource Parameter: HIST_CF:HISTORY.rc + oserver is not split + + EXPSRC: + EXPID: + Descr: + DisableSubVmChecks: F + BlockSize: 10 + MarkDone: 0 + PrePost: 1 + + Reading HISTORY RC Files: + ------------------------- + + + Hello World, I say the time is: +Time ----------------------------------- +2007-08-01T00:00:00 +end Time ------------------------------- + + AGCM Date: 2007/08/01 Time: 01:00:00 Throughput(days/day)[Avg Tot Run]: 407962.2 410922.5 18590964.7 TimeRemaining(Est) 000:00:00 2.7% : 13.3% Mem Comm:Used + + + Hello World, I say the time is: +Time ----------------------------------- +2007-08-01T01:00:00 +end Time ------------------------------- + + AGCM Date: 2007/08/01 Time: 02:00:00 Throughput(days/day)[Avg Tot Run]: 21061906.1 10684057.3 25508595.8 TimeRemaining(Est) 000:00:00 2.7% : 13.3% Mem Comm:Used + ``` + Lets see how this corresponds to what is in the input files. + + First lets discuss the CAP.rc, the relevant lines are + ``` + JOB_SGMT: 00000001 000000 +HEARTBEAT_DT: 3600 +``` +which tell the MAPL "CAP" to run 1 day via the JOB_SGMT line and with a timestep of 3600s. In addition the +``` +ROOT_CF: hello_world.rc +``` +tells "CAP" that the root component will use hello_world.rc. +Finally you will notice that hello_world.rc has these lines: +``` +NX: 1 +NY: 1 +``` +This says we will be using decomposing each dimension of the grid by 1 (so no decomposition at all!). A rule of thumb, the number of MPI tasks must be equal to NX*NY. + +Now to connect this to the output. We see the that it reports +``` +SHMEM: Total PEs = 1 +``` +which says we are using 1 MPI task. +Then later you the tell works and quick glance should confirm it is stepping the clock by 1 hour each time. Finally you see lines like this: +``` +AGCM Date: 2007/08/01 Time: 02:00:00 Throughput(days/day)[Avg Tot Run]: 21061906.1 10684057.3 25508595.8 TimeRemaining(Est) 000:00:00 2.7% : 13.3% Mem Comm:Used +``` +This is actually reported by the "CAP" itself. and prints the current time as well as some statistics about memroy use and throughput. The astute user will notice that the time reported here is 1 hour after the time printed in the gridded component. This is because the clock is advanced at the end of each iteration in the "CAP", after the component is run and this reporting is at the very end of each iteration. diff --git a/tutorial/tutorials/parent_no_children/README.md b/tutorial/tutorials/parent_no_children/README.md new file mode 100644 index 000000000000..0d94a47dff12 --- /dev/null +++ b/tutorial/tutorials/parent_no_children/README.md @@ -0,0 +1,47 @@ +# Tutorial 2 - Gridded Component: Create a Field and Write Out Via History +In this tutorial we will take the Hello World example a step further and demonstrate more features. I will only focus on what is added here so make sure you understand the Hello World example first. + +Note the code for the gridded component used by this tutorial can be found here: + +tutorial/grid_comps/parent_with_no_children/ParentNoChildren_GridComp.F90 + + + + +# ParentNoChildren_GridComp.F90 + +The user will notice several new things in this example. First look at the setServices routine. Notice the two MAPL_AddExportSpec calls. The each call tells the component to create an ESMF_Field in the components Export state and information about the dimensionality of the field. In this example output1 is a 2D field with no vertical levels and output2 is a 3D field. This call merely tells MAPL to create the field but does not actually create it until the components MAPL_GenericInitialize is run. + +The my_initalize routine looks the same as the Hello World example. + +Finally the my_run call now has some new stuff. First the user will notice some new declarations, a couple of real pointers as well as a MAPL_MetaComp object. +The MAPL_MetaComp is an internal dervied type stored in the gridded component that stores MAPL specific information beyeond what ESMF stores. +Move past the declarations we see first we retrieve the MAPL_MetaComp from the gridded component. Next we call MAPL_GetResource which is a shorthand way to retreive information from the components rc file which in this case is "root.rc". The call is looking for a key name "my_value:" and if the user examines the rc file they indeed will see this line: +``` +my_value: 11.0 +``` +Finally there are two call so MAPL_GetPointer which is a shorthand way to obtain a the pointer to the data in an ESMF_Field in an ESMF_State. Through the magic of MAPL, the user will find that there are indeed two fields in the state named ouput1 and output2! All this was handled by MAPL and ESMF!. Notice we check if the pointer is associated before suing and if so set all the values of the pointer to the constant my_constat. Why do we check the associated status, because exports might not have been allocated. Imports always are so the rule is for any pointer from an Export state, always check the associated status before using. + +$ HISTORY.rc + +If one looks in the tutorial directory for this example you will see the History.rc contains these lines: +``` +GRID_LABELS: +:: + +COLLECTIONS: my_collection +:: + +my_collection.template: "%y4%m2%d2_%h2%n2z.nc4" +my_collection.format: 'CFIO' +my_collection.frequency: 060000 +my_collection.fields: 'output1', 'root' + :: +``` +The HISTORY.rc drives the MAPL_HistoryGridComp which is a special service provided by MAPL to allow users to write fields from any components export state to a file. Documentation for the input file can be found here: [History Documentation](https://github.com/GEOS-ESM/MAPL/wiki/MAPL-History-Component). In this example we are saying every 6 hours write the field 'output1' from the component root. You should see that in your run directory you have 4 files named starting with my collection. If you ncdump them you will see that the variable output1 should be identically 11 in each one. + + +# Exercise for the User + +The user may want to print the size of the ptr_2d and ptr_3d array to confirm that they match the size of the grid. +Notice that HISTORY.rc is only outputting output1, add output2. From 8eb25e5a7b4d6c8c6e3b24ee563848b97aff5bce Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 29 Jun 2022 11:29:32 -0400 Subject: [PATCH 209/300] add more readmes --- tutorial/tutorials/hello_world/README.md | 2 ++ .../tutorials/parent_no_children/README.md | 2 +- .../README.md | 25 ++++++++++++++ .../parent_one_child_no_imports/README.md | 33 +++++++++++++++++++ .../README.md | 22 +++++++++++++ 5 files changed, 83 insertions(+), 1 deletion(-) create mode 100644 tutorial/tutorials/parent_one_child_import_via_extdata/README.md create mode 100644 tutorial/tutorials/parent_one_child_no_imports/README.md create mode 100644 tutorial/tutorials/parent_two_siblings_connect_import_export/README.md diff --git a/tutorial/tutorials/hello_world/README.md b/tutorial/tutorials/hello_world/README.md index ac2f093f98ef..d2cdfa6d3d3c 100644 --- a/tutorial/tutorials/hello_world/README.md +++ b/tutorial/tutorials/hello_world/README.md @@ -98,6 +98,8 @@ NY: 1 ``` This says we will be using decomposing each dimension of the grid by 1 (so no decomposition at all!). A rule of thumb, the number of MPI tasks must be equal to NX*NY. +Finally in you should see a "cap_restart" file in the run directory. This is the time the application will actually start at. It must be equal or later than the BEG_DATE in the CAP.rc and before the END_DATE. Note that generally these are only needed when running real experiments with the model. One final note about the "cap_restart". When the application finishes it overwrites the cap_restart with the final application time. + Now to connect this to the output. We see the that it reports ``` SHMEM: Total PEs = 1 diff --git a/tutorial/tutorials/parent_no_children/README.md b/tutorial/tutorials/parent_no_children/README.md index 0d94a47dff12..2e2ece1b72ba 100644 --- a/tutorial/tutorials/parent_no_children/README.md +++ b/tutorial/tutorials/parent_no_children/README.md @@ -38,7 +38,7 @@ my_collection.frequency: 060000 my_collection.fields: 'output1', 'root' :: ``` -The HISTORY.rc drives the MAPL_HistoryGridComp which is a special service provided by MAPL to allow users to write fields from any components export state to a file. Documentation for the input file can be found here: [History Documentation](https://github.com/GEOS-ESM/MAPL/wiki/MAPL-History-Component). In this example we are saying every 6 hours write the field 'output1' from the component root. You should see that in your run directory you have 4 files named starting with my collection. If you ncdump them you will see that the variable output1 should be identically 11 in each one. +The HISTORY.rc drives the MAPL_HistoryGridComp which is a special service provided by MAPL to allow users to write fields from any components export state to a file. Documentation for the input file can be found here: [History Documentation](https://github.com/GEOS-ESM/MAPL/wiki/MAPL-History-Component). In this example we are saying every 6 hours write the field 'output1' from the component root. You should see that in your run directory you have 4 files named starting with my collection. If you ncdump them you will see that the variable output1 should be identically 11 in each one. Indeed you should see while that the program runs it will write a message when History writes a file. # Exercise for the User diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/README.md b/tutorial/tutorials/parent_one_child_import_via_extdata/README.md new file mode 100644 index 000000000000..7bc0a652ced2 --- /dev/null +++ b/tutorial/tutorials/parent_one_child_import_via_extdata/README.md @@ -0,0 +1,25 @@ +# Tutorial 5 - Simple Hierarchy with one child and uisng ExtData +In this tutorial we take things a step further and now create a MAPL hierachy of a parent and one child. This time we use component BBB as the child. Please besure you understand everything in the previous before moving on to this one. + +Note the code for the gridded component used by this tutorial can be found here: + +tutorial/grid_comps/leaf_comp_b/BBB_GridComp.F90 +tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 + +# ParentOneChild_GridComp.F90 + +This is the same as the earlier tutorial and the "root" component. + +# BBB_GridComp.F90 +This is the same as the previous totorial + +# Running +In this example we use the same components you have seen before. But now our child has an import and nobody fills it!. But you see that the print from BBB has a value, how is that possible? The answer is the other special MAPL gridded component, ExtData. In during the run you will see lines like this: +``` + EXTDATA: Updating L bracket for field1 + EXTDATA: ... file processed: extdata_input.200708.nc4 + EXTDATA: Updating R bracket for field1 + EXTDATA: ... file processed: extdata_input.200708.nc4 +``` +What is going on is that since there was no connectivity in the "root" component the Import is field filled by a data file on the disk from the "ExtData" component. This is a special component that is used to fill fields from the disk. It is used for time varying quantities like emissions and forcing data. If you look in your input files you will see that ExtData.rc has an entry that starts with "field1". This is a "rule" that tell it how to fill a variable named "field1" from a datafile. For more information about ExtData see here: [ExtData](https://github.com/GEOS-ESM/MAPL/wiki/MAPL-ExtData-Component) + diff --git a/tutorial/tutorials/parent_one_child_no_imports/README.md b/tutorial/tutorials/parent_one_child_no_imports/README.md new file mode 100644 index 000000000000..e66266811c99 --- /dev/null +++ b/tutorial/tutorials/parent_one_child_no_imports/README.md @@ -0,0 +1,33 @@ +# Tutorial 3 - Simple Hierarchy +In this tutorial we take things a step further and now create a MAPL hierachy. Please besure you understand everything in the previous before moving on to this one. + +Note the code for the gridded component used by this tutorial can be found here: + +tutorial/grid_comps/leaf_comp_a/AAA_GridComp.F90 +tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 + +# ParentOneChild_GridComp.F90 + +In this tutorial this is "root" gridded component. Lets go over what's new. First notice that the serservices has a MAPL_AddChild call. We are telling it that we will add a child in the MAPL hierarchy. In this example the name of the child is obtained from the rc file which is again "root.rc" and we tell it the name of the library that will contain the code for the gridded component, also from the rc file. + +Note that other than a few places in the full GEOSgcm model you will see MAPL_AddChild being done slightly differently (the exception is the Ocean gridded components). Usually we explicit "use" a module and pass a pointer to the setservices to MAPL_AddChild but this requires knowing what module you will use at compile time. For the tutorial this is not desireable. Do not get hung up on this. + +Finally in the my_initialize and my_run there are no new wrinkles other than that my_run now calls MAPL_GenericRunChildren. If this call is not made the run method of any children, grandchildren etc will not be executed. + +# AAA_GridComp.F90 + +Now we have our first child component. It should look very familiar. It registers an initialize and run as well as adding an export spec. + +One important point is that it's my initialize does not call MAPL_GridCreate. This is because the component will use the same grid as it's parent. In fact you could delete my_initialize and the SetEntryPoint call in this module since if no user initialize is registered MAPL_GenericInitialize is called automatically! Try it and see. + +Now we get to the run method. Most of this should look the same but now it is adding something slightly more interesting filling the export field with time varying data. In this case I get the start time and current time from the clock and get the difference between the two in hours. I set the field to this value. + +# HISTORY.rc + +Now notice the HISTORY.rc has an extra line in the "fields" definition. +``` +my_collection.fields: 'output1', 'root' , 'root_output_field' + 'field1', 'AAA', + :: +``` +Here it says write out field1 from the component "AAA". The AAA component was added with the name "AAA". If you examine these output files you should notice that output1 is constant where as field1 varies in time. diff --git a/tutorial/tutorials/parent_two_siblings_connect_import_export/README.md b/tutorial/tutorials/parent_two_siblings_connect_import_export/README.md new file mode 100644 index 000000000000..96545b80f34f --- /dev/null +++ b/tutorial/tutorials/parent_two_siblings_connect_import_export/README.md @@ -0,0 +1,22 @@ +# Tutorial 4- Simple Hierarchy with Siblings +In this tutorial we take things a step further and now create a MAPL hierachy of a parent with two Siblings. Please besure you understand everything in the previous before moving on to this one. + +Note the code for the gridded component used by this tutorial can be found here: + +tutorial/grid_comps/leaf_comp_a/AAA_GridComp.F90 +tutorial/grid_comps/leaf_comp_b/BBB_GridComp.F90 +tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 + +# ParentTwoSiblings_GridComp.F90 + +In this tutorial this is "root" gridded component. Lets go over what's new. First notice that the serservices has two MAPL_AddChild calls now. Also notice the MAPL_AddConnectivity call. This says that an a field named "field1" from the export state of child1 (AAA) will be "connected" to a field named "field1" in the import state of child2 (BBB). In pratice what happens behind the scenes is that field1 the respective states actually a pointer to the same memory, so anytime AAA touches field1 in it's export state this is reflected in field1 in the import state of BBB. + +# AAA_GridComp.F90 + +This is the same as the previous tutorial so nothing more needs said + +# BBB_GridComp.F90 +This looks similiar to the AAA gridcomp but now it does a MAPL_AddImportSpec call instead of a MAPL_AddExport Spec call. This adds a field named field1 to it's import state. In the run method we get a pointer to field1 and write the maximum value. Since this is an import field we do not need to protect the pointer with an if (associated) check. + +# Running +When you run this exmaple you should notice the print from BBB each timestep and this should be increasing by 1. That's because it is "connected" to the export from AAA in this example. From 7cd48773c576c77c78b89f70659621f91bbe856a Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 29 Jun 2022 13:43:29 -0400 Subject: [PATCH 210/300] move directory --- tutorial/CMakeLists.txt | 7 ++++++- .../hello_world/CAP.rc | 0 .../hello_world/ExtData.rc | 0 .../hello_world/HISTORY.rc | 0 .../hello_world/README.md | 0 .../hello_world/cap_restart | 0 .../hello_world/hello_world.rc | 0 .../hello_world/root_lib | 0 .../parent_no_children/CAP.rc | 0 .../parent_no_children/ExtData.rc | 0 .../parent_no_children/HISTORY.rc | 0 .../parent_no_children/README.md | 0 .../parent_no_children/cap_restart | 0 .../parent_no_children/root.rc | 0 .../parent_no_children/root_lib | 0 .../parent_one_child_import_via_extdata/CAP.rc | 0 .../parent_one_child_import_via_extdata/ExtData.rc | 0 .../parent_one_child_import_via_extdata/HISTORY.rc | 0 .../parent_one_child_import_via_extdata/README.md | 0 .../cap_restart | 0 .../extdata.yaml | 0 .../extdata_input.200708.nc4 | Bin .../parent_one_child_import_via_extdata/root.rc | 0 .../parent_one_child_import_via_extdata/root_lib | 0 .../parent_one_child_no_imports/CAP.rc | 0 .../parent_one_child_no_imports/ExtData.rc | 0 .../parent_one_child_no_imports/HISTORY.rc | 0 .../parent_one_child_no_imports/README.md | 0 .../parent_one_child_no_imports/cap_restart | 0 .../parent_one_child_no_imports/root.rc | 0 .../parent_one_child_no_imports/root_lib | 0 .../CAP.rc | 0 .../ExtData.rc | 0 .../HISTORY.rc | 0 .../README.md | 0 .../cap_restart | 0 .../root.rc | 0 .../root_lib | 0 tutorial/run_tutorial_case.sh | 13 ++++++++++--- 39 files changed, 16 insertions(+), 4 deletions(-) rename tutorial/{tutorials => mapl_tutorials}/hello_world/CAP.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/hello_world/ExtData.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/hello_world/HISTORY.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/hello_world/README.md (100%) rename tutorial/{tutorials => mapl_tutorials}/hello_world/cap_restart (100%) rename tutorial/{tutorials => mapl_tutorials}/hello_world/hello_world.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/hello_world/root_lib (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_no_children/CAP.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_no_children/ExtData.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_no_children/HISTORY.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_no_children/README.md (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_no_children/cap_restart (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_no_children/root.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_no_children/root_lib (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_one_child_import_via_extdata/CAP.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_one_child_import_via_extdata/ExtData.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_one_child_import_via_extdata/HISTORY.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_one_child_import_via_extdata/README.md (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_one_child_import_via_extdata/cap_restart (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_one_child_import_via_extdata/extdata.yaml (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_one_child_import_via_extdata/extdata_input.200708.nc4 (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_one_child_import_via_extdata/root.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_one_child_import_via_extdata/root_lib (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_one_child_no_imports/CAP.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_one_child_no_imports/ExtData.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_one_child_no_imports/HISTORY.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_one_child_no_imports/README.md (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_one_child_no_imports/cap_restart (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_one_child_no_imports/root.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_one_child_no_imports/root_lib (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_two_siblings_connect_import_export/CAP.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_two_siblings_connect_import_export/ExtData.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_two_siblings_connect_import_export/HISTORY.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_two_siblings_connect_import_export/README.md (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_two_siblings_connect_import_export/cap_restart (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_two_siblings_connect_import_export/root.rc (100%) rename tutorial/{tutorials => mapl_tutorials}/parent_two_siblings_connect_import_export/root_lib (100%) diff --git a/tutorial/CMakeLists.txt b/tutorial/CMakeLists.txt index ec6e98ef54f4..8de0b740c189 100644 --- a/tutorial/CMakeLists.txt +++ b/tutorial/CMakeLists.txt @@ -2,4 +2,9 @@ install (PROGRAMS run_tutorial_case.sh DESTINATION bin) add_subdirectory (driver_app) add_subdirectory (grid_comps) -#add_subdirectory (tutorials) + +file (GLOB_RECURSE tutorial_files CONFIGURE_DEPENDS RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} mapl_tutorials/*) +foreach ( file ${tutorial_files} ) + get_filename_component( dir ${file} DIRECTORY ) + install( FILES ${file} DESTINATION etc/${dir} ) +endforeach() diff --git a/tutorial/tutorials/hello_world/CAP.rc b/tutorial/mapl_tutorials/hello_world/CAP.rc similarity index 100% rename from tutorial/tutorials/hello_world/CAP.rc rename to tutorial/mapl_tutorials/hello_world/CAP.rc diff --git a/tutorial/tutorials/hello_world/ExtData.rc b/tutorial/mapl_tutorials/hello_world/ExtData.rc similarity index 100% rename from tutorial/tutorials/hello_world/ExtData.rc rename to tutorial/mapl_tutorials/hello_world/ExtData.rc diff --git a/tutorial/tutorials/hello_world/HISTORY.rc b/tutorial/mapl_tutorials/hello_world/HISTORY.rc similarity index 100% rename from tutorial/tutorials/hello_world/HISTORY.rc rename to tutorial/mapl_tutorials/hello_world/HISTORY.rc diff --git a/tutorial/tutorials/hello_world/README.md b/tutorial/mapl_tutorials/hello_world/README.md similarity index 100% rename from tutorial/tutorials/hello_world/README.md rename to tutorial/mapl_tutorials/hello_world/README.md diff --git a/tutorial/tutorials/hello_world/cap_restart b/tutorial/mapl_tutorials/hello_world/cap_restart similarity index 100% rename from tutorial/tutorials/hello_world/cap_restart rename to tutorial/mapl_tutorials/hello_world/cap_restart diff --git a/tutorial/tutorials/hello_world/hello_world.rc b/tutorial/mapl_tutorials/hello_world/hello_world.rc similarity index 100% rename from tutorial/tutorials/hello_world/hello_world.rc rename to tutorial/mapl_tutorials/hello_world/hello_world.rc diff --git a/tutorial/tutorials/hello_world/root_lib b/tutorial/mapl_tutorials/hello_world/root_lib similarity index 100% rename from tutorial/tutorials/hello_world/root_lib rename to tutorial/mapl_tutorials/hello_world/root_lib diff --git a/tutorial/tutorials/parent_no_children/CAP.rc b/tutorial/mapl_tutorials/parent_no_children/CAP.rc similarity index 100% rename from tutorial/tutorials/parent_no_children/CAP.rc rename to tutorial/mapl_tutorials/parent_no_children/CAP.rc diff --git a/tutorial/tutorials/parent_no_children/ExtData.rc b/tutorial/mapl_tutorials/parent_no_children/ExtData.rc similarity index 100% rename from tutorial/tutorials/parent_no_children/ExtData.rc rename to tutorial/mapl_tutorials/parent_no_children/ExtData.rc diff --git a/tutorial/tutorials/parent_no_children/HISTORY.rc b/tutorial/mapl_tutorials/parent_no_children/HISTORY.rc similarity index 100% rename from tutorial/tutorials/parent_no_children/HISTORY.rc rename to tutorial/mapl_tutorials/parent_no_children/HISTORY.rc diff --git a/tutorial/tutorials/parent_no_children/README.md b/tutorial/mapl_tutorials/parent_no_children/README.md similarity index 100% rename from tutorial/tutorials/parent_no_children/README.md rename to tutorial/mapl_tutorials/parent_no_children/README.md diff --git a/tutorial/tutorials/parent_no_children/cap_restart b/tutorial/mapl_tutorials/parent_no_children/cap_restart similarity index 100% rename from tutorial/tutorials/parent_no_children/cap_restart rename to tutorial/mapl_tutorials/parent_no_children/cap_restart diff --git a/tutorial/tutorials/parent_no_children/root.rc b/tutorial/mapl_tutorials/parent_no_children/root.rc similarity index 100% rename from tutorial/tutorials/parent_no_children/root.rc rename to tutorial/mapl_tutorials/parent_no_children/root.rc diff --git a/tutorial/tutorials/parent_no_children/root_lib b/tutorial/mapl_tutorials/parent_no_children/root_lib similarity index 100% rename from tutorial/tutorials/parent_no_children/root_lib rename to tutorial/mapl_tutorials/parent_no_children/root_lib diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc b/tutorial/mapl_tutorials/parent_one_child_import_via_extdata/CAP.rc similarity index 100% rename from tutorial/tutorials/parent_one_child_import_via_extdata/CAP.rc rename to tutorial/mapl_tutorials/parent_one_child_import_via_extdata/CAP.rc diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/ExtData.rc b/tutorial/mapl_tutorials/parent_one_child_import_via_extdata/ExtData.rc similarity index 100% rename from tutorial/tutorials/parent_one_child_import_via_extdata/ExtData.rc rename to tutorial/mapl_tutorials/parent_one_child_import_via_extdata/ExtData.rc diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/HISTORY.rc b/tutorial/mapl_tutorials/parent_one_child_import_via_extdata/HISTORY.rc similarity index 100% rename from tutorial/tutorials/parent_one_child_import_via_extdata/HISTORY.rc rename to tutorial/mapl_tutorials/parent_one_child_import_via_extdata/HISTORY.rc diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/README.md b/tutorial/mapl_tutorials/parent_one_child_import_via_extdata/README.md similarity index 100% rename from tutorial/tutorials/parent_one_child_import_via_extdata/README.md rename to tutorial/mapl_tutorials/parent_one_child_import_via_extdata/README.md diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/cap_restart b/tutorial/mapl_tutorials/parent_one_child_import_via_extdata/cap_restart similarity index 100% rename from tutorial/tutorials/parent_one_child_import_via_extdata/cap_restart rename to tutorial/mapl_tutorials/parent_one_child_import_via_extdata/cap_restart diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/extdata.yaml b/tutorial/mapl_tutorials/parent_one_child_import_via_extdata/extdata.yaml similarity index 100% rename from tutorial/tutorials/parent_one_child_import_via_extdata/extdata.yaml rename to tutorial/mapl_tutorials/parent_one_child_import_via_extdata/extdata.yaml diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/extdata_input.200708.nc4 b/tutorial/mapl_tutorials/parent_one_child_import_via_extdata/extdata_input.200708.nc4 similarity index 100% rename from tutorial/tutorials/parent_one_child_import_via_extdata/extdata_input.200708.nc4 rename to tutorial/mapl_tutorials/parent_one_child_import_via_extdata/extdata_input.200708.nc4 diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/root.rc b/tutorial/mapl_tutorials/parent_one_child_import_via_extdata/root.rc similarity index 100% rename from tutorial/tutorials/parent_one_child_import_via_extdata/root.rc rename to tutorial/mapl_tutorials/parent_one_child_import_via_extdata/root.rc diff --git a/tutorial/tutorials/parent_one_child_import_via_extdata/root_lib b/tutorial/mapl_tutorials/parent_one_child_import_via_extdata/root_lib similarity index 100% rename from tutorial/tutorials/parent_one_child_import_via_extdata/root_lib rename to tutorial/mapl_tutorials/parent_one_child_import_via_extdata/root_lib diff --git a/tutorial/tutorials/parent_one_child_no_imports/CAP.rc b/tutorial/mapl_tutorials/parent_one_child_no_imports/CAP.rc similarity index 100% rename from tutorial/tutorials/parent_one_child_no_imports/CAP.rc rename to tutorial/mapl_tutorials/parent_one_child_no_imports/CAP.rc diff --git a/tutorial/tutorials/parent_one_child_no_imports/ExtData.rc b/tutorial/mapl_tutorials/parent_one_child_no_imports/ExtData.rc similarity index 100% rename from tutorial/tutorials/parent_one_child_no_imports/ExtData.rc rename to tutorial/mapl_tutorials/parent_one_child_no_imports/ExtData.rc diff --git a/tutorial/tutorials/parent_one_child_no_imports/HISTORY.rc b/tutorial/mapl_tutorials/parent_one_child_no_imports/HISTORY.rc similarity index 100% rename from tutorial/tutorials/parent_one_child_no_imports/HISTORY.rc rename to tutorial/mapl_tutorials/parent_one_child_no_imports/HISTORY.rc diff --git a/tutorial/tutorials/parent_one_child_no_imports/README.md b/tutorial/mapl_tutorials/parent_one_child_no_imports/README.md similarity index 100% rename from tutorial/tutorials/parent_one_child_no_imports/README.md rename to tutorial/mapl_tutorials/parent_one_child_no_imports/README.md diff --git a/tutorial/tutorials/parent_one_child_no_imports/cap_restart b/tutorial/mapl_tutorials/parent_one_child_no_imports/cap_restart similarity index 100% rename from tutorial/tutorials/parent_one_child_no_imports/cap_restart rename to tutorial/mapl_tutorials/parent_one_child_no_imports/cap_restart diff --git a/tutorial/tutorials/parent_one_child_no_imports/root.rc b/tutorial/mapl_tutorials/parent_one_child_no_imports/root.rc similarity index 100% rename from tutorial/tutorials/parent_one_child_no_imports/root.rc rename to tutorial/mapl_tutorials/parent_one_child_no_imports/root.rc diff --git a/tutorial/tutorials/parent_one_child_no_imports/root_lib b/tutorial/mapl_tutorials/parent_one_child_no_imports/root_lib similarity index 100% rename from tutorial/tutorials/parent_one_child_no_imports/root_lib rename to tutorial/mapl_tutorials/parent_one_child_no_imports/root_lib diff --git a/tutorial/tutorials/parent_two_siblings_connect_import_export/CAP.rc b/tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/CAP.rc similarity index 100% rename from tutorial/tutorials/parent_two_siblings_connect_import_export/CAP.rc rename to tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/CAP.rc diff --git a/tutorial/tutorials/parent_two_siblings_connect_import_export/ExtData.rc b/tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/ExtData.rc similarity index 100% rename from tutorial/tutorials/parent_two_siblings_connect_import_export/ExtData.rc rename to tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/ExtData.rc diff --git a/tutorial/tutorials/parent_two_siblings_connect_import_export/HISTORY.rc b/tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/HISTORY.rc similarity index 100% rename from tutorial/tutorials/parent_two_siblings_connect_import_export/HISTORY.rc rename to tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/HISTORY.rc diff --git a/tutorial/tutorials/parent_two_siblings_connect_import_export/README.md b/tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/README.md similarity index 100% rename from tutorial/tutorials/parent_two_siblings_connect_import_export/README.md rename to tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/README.md diff --git a/tutorial/tutorials/parent_two_siblings_connect_import_export/cap_restart b/tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/cap_restart similarity index 100% rename from tutorial/tutorials/parent_two_siblings_connect_import_export/cap_restart rename to tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/cap_restart diff --git a/tutorial/tutorials/parent_two_siblings_connect_import_export/root.rc b/tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/root.rc similarity index 100% rename from tutorial/tutorials/parent_two_siblings_connect_import_export/root.rc rename to tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/root.rc diff --git a/tutorial/tutorials/parent_two_siblings_connect_import_export/root_lib b/tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/root_lib similarity index 100% rename from tutorial/tutorials/parent_two_siblings_connect_import_export/root_lib rename to tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/root_lib diff --git a/tutorial/run_tutorial_case.sh b/tutorial/run_tutorial_case.sh index afde1c99d536..5f99b9648bfe 100755 --- a/tutorial/run_tutorial_case.sh +++ b/tutorial/run_tutorial_case.sh @@ -18,11 +18,18 @@ export INSTALL_DIR=$1 export TUTORIAL_CASE=$2 source $INSTALL_DIR/bin/g5_modules.sh export LD_LIBRARY_PATH=${LD_LIBRARY_PATH}:${BASEDIR}/${ARCH}/lib:${INSTALL_DIR}/lib +export TUTORIAL_PATH=${INSTALL_DIR}/etc/mapl_tutorials/${TUTORIAL_CASE} -for file in `ls ${TUTORIAL_CASE}`; do - cp "${TUTORIAL_CASE}/${file}" . +for file in `ls ${TUTORIAL_PATH}`; do + cp "${TUTORIAL_PATH}/${file}" . done ROOT_LIB=`cat root_lib` -mpirun -np 1 ${INSTALL_DIR}/bin/Example_Driver.x --root_dso ${ROOT_LIB} +export ROOT_RC=`grep '^\s*ROOT_CF:' CAP.rc | cut -d: -f2` +export NX=`grep '^\s*NX:' ${ROOT_RC} | cut -d: -f2` +export NY=`grep '^\s*NY:' ${ROOT_RC} | cut -d: -f2` + +export NPES=`expr ${NY} \* ${NX}` + +mpirun -np ${NPES} ${INSTALL_DIR}/bin/Example_Driver.x --root_dso ${ROOT_LIB} From 7cbd1434430d3403081d305c9e45c015d375b20f Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 30 Jun 2022 15:58:42 -0400 Subject: [PATCH 211/300] Fix typos --- tutorial/README.md | 18 +++++++++--------- tutorial/mapl_tutorials/hello_world/README.md | 6 +++--- .../parent_no_children/README.md | 12 ++++++------ .../README.md | 6 +++--- .../parent_one_child_no_imports/README.md | 8 ++++---- .../README.md | 10 +++++----- 6 files changed, 30 insertions(+), 30 deletions(-) diff --git a/tutorial/README.md b/tutorial/README.md index 822b396ab724..bb3d50c3b6e5 100644 --- a/tutorial/README.md +++ b/tutorial/README.md @@ -1,18 +1,18 @@ # MAPL Tutorials Overview -For user education we have provided some simple tutorials. These demonstrate how to create simple gridded componnts and hierachies of components and drive them via the MAPL_Cap just like the real GEOSgcm model. Each "tutorial" will consist of a set of input files that can be run with our the Example_Driver.x and will itself contain a REAMDE file with explanation about what that particular tutorial is demonstrating. In addition each will suggest exercises that the user can do to extend them. +For user education we have provided some simple tutorials. These demonstrate how to create simple gridded componnts and hierachies of components and drive them via the MAPL_Cap just like the real GEOSgcm model. Each "tutorial" will consist of a set of input files that can be run with our the Example_Driver.x and will itself contain a REAMDE file with explanation about what that particular tutorial is demonstrating. In addition, each will suggest exercises that you can do to extend them. Before embarking on these tutorials the new users should review the MAPL/ESMF powerpoint presentation here to get a general sense of what these frameworks are about and become familiar with the terminology. -In addition, to use these tutorials you will have to have either built MAPL as a standalone fixure or as part of another figure like the GEOSgcm. If you are reading this and have not build either, see the instructions for how to build MAPL here: [How to Build MAPL](https://github.com/GEOS-ESM/MAPL/wiki/Building-and-Testing-MAPL-as-a-standalone). For these exercises we highly recommend building MAPL by itself as your build will be much faster, expecially when you change the code. The build itself takes a short time. We also recommend useing the "debug" build rather than the "release" build. +In addition, to use these tutorials you will have to have either built MAPL as a standalone fixture or as part of another fixture like the GEOSgcm. If you are reading this and have not built either, see the instructions for how to build MAPL here: [How to Build MAPL](https://github.com/GEOS-ESM/MAPL/wiki/Building-and-Testing-MAPL-as-a-standalone). For these exercises we highly recommend building MAPL by itself as your build will be much faster, expecially when you change the code. The build itself takes a short time. We also recommend using the "debug" build rather than the "release" build. -Once you have installed either MAPL or the full GEOSgcm you will have an installation directory whose full path I will refer to as INSTALL_DIR. +Once you have installed either MAPL or the full GEOSgcm, you will have an installation directory whose full path I will refer to as INSTALL_DIR. -Once you have this the user will find a script run_tutorial_case.sh that is in INSTALL_DIR/bin we have created for the users convinience. +Once you have this, you will find a script run_tutorial_case.sh that is in INSTALL_DIR/bin we have created for your convinience. -This script takes two arguments. The path to INSTALL_DIR and the directory name of the test case you wish to run. To run this, go to a tempoary directory then run the script with the arguments. It will copy the input files to that directory and run the Example_Driver.x for that set of input files. Note that if you are at NCCS or NAS you will need to be on an interactive slurm job with a single node. +This script takes two arguments, the path to INSTALL_DIR and the directory name of the test case you wish to run. To run this, go to a tempoary directory then run the script with the arguments. It will copy the input files to that directory and run the Example_Driver.x for that set of input files. Note that if you are at NCCS or NAS you will need to be on an interactive slurm job with a single node. -The follow tutorials are available in the recommended order and represent the tutorial name you would use in the run script. +The following tutorials are available in the recommended order and represent the tutorial name you would use in the run script. - hello_world - parent_no_children - parent_one_child_no_imports @@ -28,9 +28,9 @@ As a concrete example, suppose you have installed MAPL here at /discover/nobacku # Note for the Curious -The astute user might ask, how is it each tutorial is running the same executable yet using different gridded components. The answer is that each gridded component is compiled as a shared objection library. Each time you run Example_Driver.x you pass in the actual name of the shared object library that will be used as the top leve gridded component. This was done to make the life of the hubmle developer writing this tutorial easier. +The astute user might ask, how is it each tutorial is running the same executable yet using different gridded components? The answer is that each gridded component is compiled as a shared object library. Each time you run Example_Driver.x, you pass in the actual name of the shared object library that will be used as the top level gridded component. This was done to make the life of the humble developer writing this tutorial easier. -Note that this technology, while used at places in the full GEOSgcm model to handle mom5 and mom6 it is not ubiquitous. You might notice that a few calls in these tutorails, particularly MAPL_AddChild calls in most gridded components and the "program" itself, aka where you have something like this: +Note that this technology, while used at places in the full GEOSgcm model to handle mom5 and mom6, it is not ubiquitous. You might notice that a few calls in these tutorails, particularly MAPL_AddChild calls in most gridded components and the "program" itself, aka where you have something like this: ``` program Example_Driver.x @@ -38,4 +38,4 @@ program Example_Driver.x end program Example_Driver.x ``` -may look a little different if you look at the corresponding program file for GEOSgcm.x. Do not worry, please come ask your nearest SI team. +may look a little different if you look at the corresponding program file for GEOSgcm.x. Do not worry. Please come ask your nearest SI team member. diff --git a/tutorial/mapl_tutorials/hello_world/README.md b/tutorial/mapl_tutorials/hello_world/README.md index d2cdfa6d3d3c..ab91e074319c 100644 --- a/tutorial/mapl_tutorials/hello_world/README.md +++ b/tutorial/mapl_tutorials/hello_world/README.md @@ -3,15 +3,15 @@ Note the code for the gridded component used by this tutorial can be found here: tutorial/grid_comps/hello_world_gridcomp/HelloWorld_GridComp.F90 -For this tutorial we will make the simplest possible gridded component we can and have it print hello in it's run method. +For this tutorial we will make the simplest possible gridded component we can and have it print hello in its run method. -The gridded component itself is run from the MAPL "CAP". This is a layer that the user should never have to touch. It's main function as far as the user is concerned is to perform the time stepping controlled via the CAP.rc and run the "root" gridded component (in this example HelloWorld_GridComp.F90) the user or program specified as well as two other special gridded components "History" and "ExtData" that provide services that we will talk about in later tutorials. +The gridded component itself is run from the MAPL "CAP". This is a layer that the user should never have to touch. Its main function, as far as the user is concerned, is to perform the time stepping controlled via the CAP.rc and run the "root" gridded component (in this example HelloWorld_GridComp.F90) the user or program specified, as well as two other special gridded components, "History" and "ExtData", that provide services that we will talk about in later tutorials. # HelloWorld_GridComp.F90 Explanation If you look in the gridded component you will see that it is quite simple and is just about the minumum lines needed to create a gridded component, a grid for the component, and a run method that does something. -The first routine is the setServices. This is where the user registers the actual methods to be used during the initilze and run phases of the gridded component and are specifed via the SetEntryPoint calls. In addition the MAPL_GenericSetServices is called and every MAPL component must call this before ending the subroutine. +The first routine is the setServices. This is where the user registers the actual methods to be used during the initialize and run phases of the gridded component and are specifed via the SetEntryPoint calls. In addition the MAPL_GenericSetServices is called and every MAPL component must call this before ending the subroutine. Next we see that a custom initialization routine "my_initialize" is created. It has two calls, the first tells it how to create the grid that is will be used by the gridded component. diff --git a/tutorial/mapl_tutorials/parent_no_children/README.md b/tutorial/mapl_tutorials/parent_no_children/README.md index 2e2ece1b72ba..49f78dde27f4 100644 --- a/tutorial/mapl_tutorials/parent_no_children/README.md +++ b/tutorial/mapl_tutorials/parent_no_children/README.md @@ -10,17 +10,17 @@ tutorial/grid_comps/parent_with_no_children/ParentNoChildren_GridComp.F90 # ParentNoChildren_GridComp.F90 -The user will notice several new things in this example. First look at the setServices routine. Notice the two MAPL_AddExportSpec calls. The each call tells the component to create an ESMF_Field in the components Export state and information about the dimensionality of the field. In this example output1 is a 2D field with no vertical levels and output2 is a 3D field. This call merely tells MAPL to create the field but does not actually create it until the components MAPL_GenericInitialize is run. +The user will notice several new things in this example. First look at the setServices routine. Notice the two MAPL_AddExportSpec calls. Each call tells the component to create an ESMF_Field in the components Export state and information about the dimensionality of the field. In this example output1 is a 2D field with no vertical levels and output2 is a 3D field. This call merely tells MAPL to create the field but does not actually create it until the components MAPL_GenericInitialize is run. -The my_initalize routine looks the same as the Hello World example. +The my_initialize routine looks the same as the Hello World example. Finally the my_run call now has some new stuff. First the user will notice some new declarations, a couple of real pointers as well as a MAPL_MetaComp object. -The MAPL_MetaComp is an internal dervied type stored in the gridded component that stores MAPL specific information beyeond what ESMF stores. -Move past the declarations we see first we retrieve the MAPL_MetaComp from the gridded component. Next we call MAPL_GetResource which is a shorthand way to retreive information from the components rc file which in this case is "root.rc". The call is looking for a key name "my_value:" and if the user examines the rc file they indeed will see this line: +The MAPL_MetaComp is an internal derived type stored in the gridded component that stores MAPL specific information beyond what ESMF stores. +Past the declarations, we see we first retrieve the MAPL_MetaComp from the gridded component. Next, we call MAPL_GetResource which is a shorthand way to retrieve information from the components rc file which in this case is "root.rc". The call is looking for a key name "my_value:" and if the user examines the rc file they indeed will see this line: ``` my_value: 11.0 ``` -Finally there are two call so MAPL_GetPointer which is a shorthand way to obtain a the pointer to the data in an ESMF_Field in an ESMF_State. Through the magic of MAPL, the user will find that there are indeed two fields in the state named ouput1 and output2! All this was handled by MAPL and ESMF!. Notice we check if the pointer is associated before suing and if so set all the values of the pointer to the constant my_constat. Why do we check the associated status, because exports might not have been allocated. Imports always are so the rule is for any pointer from an Export state, always check the associated status before using. +Finally there are two calls to MAPL_GetPointer which is a shorthand way to obtain a pointer to the data in an ESMF_Field in an ESMF_State. Through the magic of MAPL, the user will find that there are indeed two fields in the state named ouput1 and output2! All this was handled by MAPL and ESMF!. Notice we check if the pointer is associated before using it and if so set all the values of the pointer to the constant my_constat. Why do we check the associated status? Because exports might not have been allocated. Imports always are, so the rule is for any pointer from an Export state, always check the associated status before using it. $ HISTORY.rc @@ -38,7 +38,7 @@ my_collection.frequency: 060000 my_collection.fields: 'output1', 'root' :: ``` -The HISTORY.rc drives the MAPL_HistoryGridComp which is a special service provided by MAPL to allow users to write fields from any components export state to a file. Documentation for the input file can be found here: [History Documentation](https://github.com/GEOS-ESM/MAPL/wiki/MAPL-History-Component). In this example we are saying every 6 hours write the field 'output1' from the component root. You should see that in your run directory you have 4 files named starting with my collection. If you ncdump them you will see that the variable output1 should be identically 11 in each one. Indeed you should see while that the program runs it will write a message when History writes a file. +The HISTORY.rc drives the MAPL_HistoryGridComp which is a special service provided by MAPL to allow users to write fields from any component's export state to a file. Documentation for the input file can be found here: [History Documentation](https://github.com/GEOS-ESM/MAPL/wiki/MAPL-History-Component). In this example we are saying every 6 hours write the field 'output1' from the component root. You should see that in your run directory you have 4 files named starting with my_collection. If you ncdump them you will see that the variable output1 should be identically 11 in each one. Indeed you should see while that the program runs it will write a message when History writes a file. # Exercise for the User diff --git a/tutorial/mapl_tutorials/parent_one_child_import_via_extdata/README.md b/tutorial/mapl_tutorials/parent_one_child_import_via_extdata/README.md index 7bc0a652ced2..10ac11231631 100644 --- a/tutorial/mapl_tutorials/parent_one_child_import_via_extdata/README.md +++ b/tutorial/mapl_tutorials/parent_one_child_import_via_extdata/README.md @@ -1,5 +1,5 @@ -# Tutorial 5 - Simple Hierarchy with one child and uisng ExtData -In this tutorial we take things a step further and now create a MAPL hierachy of a parent and one child. This time we use component BBB as the child. Please besure you understand everything in the previous before moving on to this one. +# Tutorial 5 - Simple Hierarchy with one child and using ExtData +In this tutorial we take things a step further and now create a MAPL hierarchy of a parent and one child. This time we use component BBB as the child. Please be sure you understand everything in the previous tutorial before moving on to this one. Note the code for the gridded component used by this tutorial can be found here: @@ -14,7 +14,7 @@ This is the same as the earlier tutorial and the "root" component. This is the same as the previous totorial # Running -In this example we use the same components you have seen before. But now our child has an import and nobody fills it!. But you see that the print from BBB has a value, how is that possible? The answer is the other special MAPL gridded component, ExtData. In during the run you will see lines like this: +In this example we use the same components you have seen before. But now our child has an import and nobody fills it!. But you see that the print from BBB has a value. How is that possible? The answer is the other special MAPL gridded component, ExtData. During the run you will see lines like this: ``` EXTDATA: Updating L bracket for field1 EXTDATA: ... file processed: extdata_input.200708.nc4 diff --git a/tutorial/mapl_tutorials/parent_one_child_no_imports/README.md b/tutorial/mapl_tutorials/parent_one_child_no_imports/README.md index e66266811c99..81df9b46349f 100644 --- a/tutorial/mapl_tutorials/parent_one_child_no_imports/README.md +++ b/tutorial/mapl_tutorials/parent_one_child_no_imports/README.md @@ -1,5 +1,5 @@ # Tutorial 3 - Simple Hierarchy -In this tutorial we take things a step further and now create a MAPL hierachy. Please besure you understand everything in the previous before moving on to this one. +In this tutorial we take things a step further and now create a MAPL hierarchy. Please be sure you understand everything in the previous tutorialbefore moving on to this one. Note the code for the gridded component used by this tutorial can be found here: @@ -8,9 +8,9 @@ tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 # ParentOneChild_GridComp.F90 -In this tutorial this is "root" gridded component. Lets go over what's new. First notice that the serservices has a MAPL_AddChild call. We are telling it that we will add a child in the MAPL hierarchy. In this example the name of the child is obtained from the rc file which is again "root.rc" and we tell it the name of the library that will contain the code for the gridded component, also from the rc file. +In this tutorial this is the "root" gridded component. Let's go over what's new. First notice that the setservices has a MAPL_AddChild call. We are telling it that we will add a child in the MAPL hierarchy. In this example the name of the child is obtained from the rc file which is again "root.rc" and we tell it the name of the library that will contain the code for the gridded component, also from the rc file. -Note that other than a few places in the full GEOSgcm model you will see MAPL_AddChild being done slightly differently (the exception is the Ocean gridded components). Usually we explicit "use" a module and pass a pointer to the setservices to MAPL_AddChild but this requires knowing what module you will use at compile time. For the tutorial this is not desireable. Do not get hung up on this. +Note that other than a few places in the full GEOSgcm model you will see MAPL_AddChild being done slightly differently (the exception is the Ocean gridded components). Usually we explicit "use" a module and pass a pointer to the setservices to MAPL_AddChild but this requires knowing what module you will use at compile time. For the tutorial this is not desirable. Do not get hung up on this. Finally in the my_initialize and my_run there are no new wrinkles other than that my_run now calls MAPL_GenericRunChildren. If this call is not made the run method of any children, grandchildren etc will not be executed. @@ -18,7 +18,7 @@ Finally in the my_initialize and my_run there are no new wrinkles other than tha Now we have our first child component. It should look very familiar. It registers an initialize and run as well as adding an export spec. -One important point is that it's my initialize does not call MAPL_GridCreate. This is because the component will use the same grid as it's parent. In fact you could delete my_initialize and the SetEntryPoint call in this module since if no user initialize is registered MAPL_GenericInitialize is called automatically! Try it and see. +One important point is that its my-initialize does not call MAPL_GridCreate. This is because the component will use the same grid as its parent. In fact you could delete my_initialize and the SetEntryPoint call in this module since if no user initialize is registered, MAPL_GenericInitialize is called automatically! Try it and see. Now we get to the run method. Most of this should look the same but now it is adding something slightly more interesting filling the export field with time varying data. In this case I get the start time and current time from the clock and get the difference between the two in hours. I set the field to this value. diff --git a/tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/README.md b/tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/README.md index 96545b80f34f..9f89c0ece71c 100644 --- a/tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/README.md +++ b/tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/README.md @@ -1,5 +1,5 @@ # Tutorial 4- Simple Hierarchy with Siblings -In this tutorial we take things a step further and now create a MAPL hierachy of a parent with two Siblings. Please besure you understand everything in the previous before moving on to this one. +In this tutorial we take things a step further and now create a MAPL hierarchy of a parent with two Siblings. Please be sure you understand everything in the previous before moving on to this one. Note the code for the gridded component used by this tutorial can be found here: @@ -9,14 +9,14 @@ tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 # ParentTwoSiblings_GridComp.F90 -In this tutorial this is "root" gridded component. Lets go over what's new. First notice that the serservices has two MAPL_AddChild calls now. Also notice the MAPL_AddConnectivity call. This says that an a field named "field1" from the export state of child1 (AAA) will be "connected" to a field named "field1" in the import state of child2 (BBB). In pratice what happens behind the scenes is that field1 the respective states actually a pointer to the same memory, so anytime AAA touches field1 in it's export state this is reflected in field1 in the import state of BBB. +In this tutorial this is "root" gridded component. Lets go over what's new. First notice that the setservices has two MAPL_AddChild calls now. Also notice the MAPL_AddConnectivity call. This says that a field named "field1" from the export state of child1 (AAA) will be "connected" to a field named "field1" in the import state of child2 (BBB). In practice what happens behind the scenes is that field1 the respective states actually a pointer to the same memory, so any time AAA touches field1 in its export state this is reflected in field1 in the import state of BBB. # AAA_GridComp.F90 -This is the same as the previous tutorial so nothing more needs said +This is the same as the previous tutorial so nothing more needs to be said. # BBB_GridComp.F90 -This looks similiar to the AAA gridcomp but now it does a MAPL_AddImportSpec call instead of a MAPL_AddExport Spec call. This adds a field named field1 to it's import state. In the run method we get a pointer to field1 and write the maximum value. Since this is an import field we do not need to protect the pointer with an if (associated) check. +This looks similar to the AAA gridcomp but now it does a MAPL_AddImportSpec call instead of a MAPL_AddExport Spec call. This adds a field named field1 to its import state. In the run method we get a pointer to field1 and write the maximum value. Since this is an import field we do not need to protect the pointer with an if (associated) check. # Running -When you run this exmaple you should notice the print from BBB each timestep and this should be increasing by 1. That's because it is "connected" to the export from AAA in this example. +When you run this example you should notice the print from BBB each timestep and this should be increasing by 1. That's because it is "connected" to the export from AAA in this example. From fcd270cae027647cb07172290abc1a87a75e4f47 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 1 Jul 2022 12:29:35 -0400 Subject: [PATCH 212/300] update readmes --- tutorial/README.md | 6 ++-- tutorial/mapl_tutorials/hello_world/README.md | 36 ++++++++++++++++--- .../parent_no_children/README.md | 15 ++++++-- .../README.md | 8 +++-- .../README.md | 9 +++-- 5 files changed, 59 insertions(+), 15 deletions(-) diff --git a/tutorial/README.md b/tutorial/README.md index bb3d50c3b6e5..e31e9b3254e3 100644 --- a/tutorial/README.md +++ b/tutorial/README.md @@ -4,13 +4,13 @@ For user education we have provided some simple tutorials. These demonstrate how Before embarking on these tutorials the new users should review the MAPL/ESMF powerpoint presentation here to get a general sense of what these frameworks are about and become familiar with the terminology. -In addition, to use these tutorials you will have to have either built MAPL as a standalone fixture or as part of another fixture like the GEOSgcm. If you are reading this and have not built either, see the instructions for how to build MAPL here: [How to Build MAPL](https://github.com/GEOS-ESM/MAPL/wiki/Building-and-Testing-MAPL-as-a-standalone). For these exercises we highly recommend building MAPL by itself as your build will be much faster, expecially when you change the code. The build itself takes a short time. We also recommend using the "debug" build rather than the "release" build. +In addition, to use these tutorials you will have to have either built MAPL as a standalone fixture or as part of another fixture like the GEOSgcm. If you are reading this and have not built either, see the instructions for how to build MAPL [here](https://github.com/GEOS-ESM/MAPL/wiki/Building-and-Testing-MAPL-as-a-standalone). For these exercises we highly recommend building MAPL by itself as your build will be much faster, expecially when you change the code. The build itself takes a short time. We also recommend using the "debug" build rather than the "release" build. This will turn off optimzations and add extra error checking. The build will be faster in this case. Details on how to do this is in the aformentioned wiki page. Once you have installed either MAPL or the full GEOSgcm, you will have an installation directory whose full path I will refer to as INSTALL_DIR. Once you have this, you will find a script run_tutorial_case.sh that is in INSTALL_DIR/bin we have created for your convinience. -This script takes two arguments, the path to INSTALL_DIR and the directory name of the test case you wish to run. To run this, go to a tempoary directory then run the script with the arguments. It will copy the input files to that directory and run the Example_Driver.x for that set of input files. Note that if you are at NCCS or NAS you will need to be on an interactive slurm job with a single node. +This script takes two arguments, the path to INSTALL_DIR and the directory name of the test case you wish to run. To run this, go to a tempoary directory then run the script with the arguments. It will copy the input files to that directory and run the Example_Driver.x for that set of input files. Note that if you are at NCCS or NAS you will need to be on an interactive job with a single node. If you are at NCCS you will be using slurm and instructions can be found [here](https://www.nccs.nasa.gov/nccs-users/instructional/using-slurm). At NAS you would use PBS and instructions can be found [here](https://www.nas.nasa.gov/hecc/support/kb/portable-batch-system-(pbs)-overview_126.html). The following tutorials are available in the recommended order and represent the tutorial name you would use in the run script. - hello_world @@ -20,7 +20,7 @@ The following tutorials are available in the recommended order and represent the - parent_one_child_import_via_extdata -As a concrete example, suppose you have installed MAPL here at /discover/nobackup/auser/MAPL/install and want to run hello_world you run this on the command line: +As a concrete example, suppose you have installed MAPL here at `discover/nobackup/auser/MAPL/install` and want to run the hello_world tutorial you run this on the command line: ``` /discover/nobackup/auser/MAPL/install/bin/run_tutorial_case.sh /discover/nobackup/auser/MAPL/install hello_world diff --git a/tutorial/mapl_tutorials/hello_world/README.md b/tutorial/mapl_tutorials/hello_world/README.md index ab91e074319c..59b1075b196d 100644 --- a/tutorial/mapl_tutorials/hello_world/README.md +++ b/tutorial/mapl_tutorials/hello_world/README.md @@ -11,9 +11,11 @@ The gridded component itself is run from the MAPL "CAP". This is a layer that th If you look in the gridded component you will see that it is quite simple and is just about the minumum lines needed to create a gridded component, a grid for the component, and a run method that does something. -The first routine is the setServices. This is where the user registers the actual methods to be used during the initialize and run phases of the gridded component and are specifed via the SetEntryPoint calls. In addition the MAPL_GenericSetServices is called and every MAPL component must call this before ending the subroutine. +The first routine is the setServices. This is the ONLY routine in the module that should be public. Everything else should be private. In addition the SetServices interface must match the interface defined by ESMF> The main function of the SetServies is to let the user registers the actual methods to be used during the initialize and run phases of the gridded component. These specifed via the SetEntryPoint calls and methods defined in the same module. They also must be defined with the interface prescribed by ESMF. In addition, the MAPL_GenericSetServices is called in this routine and every MAPL component must call this before ending the subroutine. The MAPL_GenericSetServices handles all the extra services provided by MAPL beyond EMSF. -Next we see that a custom initialization routine "my_initialize" is created. It has two calls, the first tells it how to create the grid that is will be used by the gridded component. +Next we see that a custom initialization routine "my_initialize" is created. Notice the subroutine interface. This is the interface all initialize, run, and finalize methods registered my ESMF SetEntryPoint methods must follow. The import state contains all the fields (as well as possibly other types) that will be needed to run the component. The component should not modify the import state. Likewise the export state is what the gridded component produces for use by other components. Finally the clock is just that, a clock that defines the current temporal situation. + +In this exmaple, the initialize routine only has two calls. The first tells it how to create the grid that is will be used by the gridded component. MAPL_GridCreate actually examines the components RC file which in this case is "hello_world.rc". The user will notice these lines: ``` @@ -27,9 +29,35 @@ hello_world.DATELINE: 'DC' ``` Generally the user will not have to modify these are the setup scripts when running the model would define this for you. In this case it is saying the grid will be a 90x45 lat-lon grid with LM vertical levels. -After this call MAPL_GenericInitialize is called. Once again every custom initialize routine must call this. If no custom initialize routine is defined this will be call automatically. +After this call MAPL_GenericInitialize is called. This is again a MAPL call that handles all the MAPL specify functionality. It also calls the initialize methods of any child, which will be discussed subsequent tutorials. Once again every custom initialize routine must call this. If no custom initialize routine is defined this will be called automatically. + +Finally we get to the run method my_run. Notice it has the same interface the initialize method. This was registered and will be executed each time step. As you can see if does very little in this example. It gets the current time from the ESMF clock (this literally a clock that is advanced by the MAPL "CAP"). The time is stored in a variable of `type(ESMF_Time)` declared in the subroutine. It then prints the obligatory "Hello World" and finally uses an ESMF cal which takes an ESMF time and prints it as a string. + +# A Note on Error Handling +You will notice that the setServices, initialize, and run subroutines all have an optional rc return variable. This is represents a return code that the calling routine can check to see if the subroutine executed successfully or produced an error. All ESMF and MAPL subroutines and functions have an optional rc value that can be checked when making a call. To check the return status you would do something like this. +``` +integer :: status + + +call ESMF_Foo(arg1,arg2,rc=status) +if (status/=ESMF_SUCCESS) then + if present(rc)) then + rc =status + write(*,*)"Error ",rc," in ",__FILE," on ",__LINE__ + return + end if +end +``` + +This would get very tedious, not to mention make the code hard to read if the user had to do this after every subroutine or function call. To assist the developer MAPL defines a collection of preprocessor macros for error checking . + +You will notice that all subroutine calls in this example end with `_RC`. This is a preprocessor macro that expands to `rc=status); _VERIFY(status`. + +`_VERIFY` itself is another macro that essentially implements the lines after the call to `ESMF_Foo` in the previous example. It will check the status and if there is an error report the file and line and return. + +At the end of each subroutine you will notice another macro, `_RETURN(_SUCCESS)`. This macro ensures that if the optional rc code is passed, it will be set to the "succes" value if the caller is checking the return code. It general placed at the very end of a subroutine. -Finally we get to the run method my_run. This was registered and will be executed each time step. As you can see if does very little in this example. It gets the current time from the clock (this literally a clock that is advanced by the MAPL "CAP"), then prints the obligatory "Hello World" and finally uses an ESMF call to print the current time. +All new functions and subroutines should have an optional rc code and use these macros. It will make debugging and crash analysis much easier. # Running the code When you run the code the first few lines will look like this: diff --git a/tutorial/mapl_tutorials/parent_no_children/README.md b/tutorial/mapl_tutorials/parent_no_children/README.md index 49f78dde27f4..d09b4cd59914 100644 --- a/tutorial/mapl_tutorials/parent_no_children/README.md +++ b/tutorial/mapl_tutorials/parent_no_children/README.md @@ -20,7 +20,7 @@ Past the declarations, we see we first retrieve the MAPL_MetaComp from the gridd ``` my_value: 11.0 ``` -Finally there are two calls to MAPL_GetPointer which is a shorthand way to obtain a pointer to the data in an ESMF_Field in an ESMF_State. Through the magic of MAPL, the user will find that there are indeed two fields in the state named ouput1 and output2! All this was handled by MAPL and ESMF!. Notice we check if the pointer is associated before using it and if so set all the values of the pointer to the constant my_constat. Why do we check the associated status? Because exports might not have been allocated. Imports always are, so the rule is for any pointer from an Export state, always check the associated status before using it. +Finally there are two calls to MAPL_GetPointer which is a shorthand way to obtain a Fortran pointer to the data in an ESMF_Field, contained in an ESMF_State. Through the magic of MAPL, the user will find that there are indeed two fields in the state named ouput1 and output2! All this was handled by MAPL and ESMF!. Notice that a check is mde to determine if the pointer is associated before using it. Only if the pointer is actually associated can it be used. If it is associated, in this case all the values of the array are set to the constant my_constat. Why do we check the associated status? Because exports might not have been allocated. Imports always are, so the rule is for any pointer from an Export state, always check the associated status before using it. $ HISTORY.rc @@ -38,10 +38,19 @@ my_collection.frequency: 060000 my_collection.fields: 'output1', 'root' :: ``` -The HISTORY.rc drives the MAPL_HistoryGridComp which is a special service provided by MAPL to allow users to write fields from any component's export state to a file. Documentation for the input file can be found here: [History Documentation](https://github.com/GEOS-ESM/MAPL/wiki/MAPL-History-Component). In this example we are saying every 6 hours write the field 'output1' from the component root. You should see that in your run directory you have 4 files named starting with my_collection. If you ncdump them you will see that the variable output1 should be identically 11 in each one. Indeed you should see while that the program runs it will write a message when History writes a file. +The HISTORY.rc drives the MAPL_HistoryGridComp which is a special service provided by MAPL to allow users to write fields from any component's export state to a file. Documentation for the input file can be found [here](https://github.com/GEOS-ESM/MAPL/wiki/MAPL-History-Component). In this example we are saying every 6 hours write the field 'output1' from the component root. You should see that in your run directory you have 4 files named starting with my_collection. If you ncdump them you will see that the variable output1 should be identically 11 in each one. If you examine the output from the run, you will see message when History writes a file, for example: +``` + AGCM Date: 2007/08/01 Time: 01:00:00 Throughput(days/day)[Avg Tot Run]: 998447.8 1017616.9 22162362.2 TimeRemaining(Est) 000:00:00 2.8% : 13.5% Mem Comm:Used + AGCM Date: 2007/08/01 Time: 02:00:00 Throughput(days/day)[Avg Tot Run]: 24850021.6 12648460.0 51528614.8 TimeRemaining(Est) 000:00:00 2.8% : 13.5% Mem Comm:Used + AGCM Date: 2007/08/01 Time: 03:00:00 Throughput(days/day)[Avg Tot Run]: 16222750.9 14134794.7 55756268.3 TimeRemaining(Est) 000:00:00 2.8% : 13.5% Mem Comm:Used + AGCM Date: 2007/08/01 Time: 04:00:00 Throughput(days/day)[Avg Tot Run]: 13864970.4 13973735.3 49224105.6 TimeRemaining(Est) 000:00:00 2.8% : 13.5% Mem Comm:Used + AGCM Date: 2007/08/01 Time: 05:00:00 Throughput(days/day)[Avg Tot Run]: 12915278.6 14773101.2 58278111.3 TimeRemaining(Est) 000:00:00 2.8% : 13.5% Mem Comm:Used + + Writing: 1 Slices to File: my_collection.20070801_0600z.nc4 +``` # Exercise for the User The user may want to print the size of the ptr_2d and ptr_3d array to confirm that they match the size of the grid. -Notice that HISTORY.rc is only outputting output1, add output2. +The user may also notice that in the files only the output1 field was written. Try adding output2 to the HISTORY.rc and see what happens. diff --git a/tutorial/mapl_tutorials/parent_one_child_import_via_extdata/README.md b/tutorial/mapl_tutorials/parent_one_child_import_via_extdata/README.md index 10ac11231631..7523e41bdfe3 100644 --- a/tutorial/mapl_tutorials/parent_one_child_import_via_extdata/README.md +++ b/tutorial/mapl_tutorials/parent_one_child_import_via_extdata/README.md @@ -11,15 +11,17 @@ tutorial/grid_comps/parent_with_one_child/ParentOneChild_GridComp.F90 This is the same as the earlier tutorial and the "root" component. # BBB_GridComp.F90 -This is the same as the previous totorial +This is the same as the previous tutorial # Running -In this example we use the same components you have seen before. But now our child has an import and nobody fills it!. But you see that the print from BBB has a value. How is that possible? The answer is the other special MAPL gridded component, ExtData. During the run you will see lines like this: +In this example we use the same components you have seen before. But now our child has an import but there is no other child to make a connectivity with to fill it!. But you will see that the print from BBB has a value that is changing on each step. How is that possible? The answer is the other special MAPL gridded component, ExtData. During the run you will see lines like this: ``` EXTDATA: Updating L bracket for field1 EXTDATA: ... file processed: extdata_input.200708.nc4 EXTDATA: Updating R bracket for field1 EXTDATA: ... file processed: extdata_input.200708.nc4 ``` -What is going on is that since there was no connectivity in the "root" component the Import is field filled by a data file on the disk from the "ExtData" component. This is a special component that is used to fill fields from the disk. It is used for time varying quantities like emissions and forcing data. If you look in your input files you will see that ExtData.rc has an entry that starts with "field1". This is a "rule" that tell it how to fill a variable named "field1" from a datafile. For more information about ExtData see here: [ExtData](https://github.com/GEOS-ESM/MAPL/wiki/MAPL-ExtData-Component) +In the tutorial with two childrun under root we discussed how import "bubble up" to their parents. In this case since there is no connectivity here here, the import bubbles up to the MAPL_Cap. At this point any imports that have reached the MAPL_Cap are handed off to a special component named ExtData. This is a special component that is delivered ESMF fields and uses "rules" from an input file to fill these fields with data from NetCDF files on the disk. It is used for time varying quantities like emissions and forcing data. If you look in your input files you will see that ExtData.rc has an entry that starts with "field1". This is a "rule" that tell it how to fill a variable named "field1" from a datafile. More imformation about ExtData [here](https://github.com/GEOS-ESM/MAPL/wiki/MAPL-ExtData-Component). + +Also note that ExtData is currently undergoing a transition to use a new input format which will use YAML rather than the `ESMF_Config` format. Information about that format can be found [here](https://github.com/GEOS-ESM/MAPL/wiki/ExtData-Next-Generation---User-Guide). diff --git a/tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/README.md b/tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/README.md index 9f89c0ece71c..371075d9e99d 100644 --- a/tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/README.md +++ b/tutorial/mapl_tutorials/parent_two_siblings_connect_import_export/README.md @@ -9,7 +9,7 @@ tutorial/grid_comps/parent_with_two_children/ParentTwoSiblings_GridComp.F90 # ParentTwoSiblings_GridComp.F90 -In this tutorial this is "root" gridded component. Lets go over what's new. First notice that the setservices has two MAPL_AddChild calls now. Also notice the MAPL_AddConnectivity call. This says that a field named "field1" from the export state of child1 (AAA) will be "connected" to a field named "field1" in the import state of child2 (BBB). In practice what happens behind the scenes is that field1 the respective states actually a pointer to the same memory, so any time AAA touches field1 in its export state this is reflected in field1 in the import state of BBB. +In this tutorial this is "root" gridded component. Lets go over what's new. First notice that the setservices has two MAPL_AddChild calls now and adds two child components defined in `AAA_GridComp.F90` and `BBB_GridComp.F90`. Also notice the MAPL_AddConnectivity call. This says that a field named "field1" from the export state of child1 (AAA) will be "connected" to a field named "field1" in the import state of child2 (BBB). In practice what happens behind the scenes is that field1 the respective states actually a pointer to the same memory, so any time AAA touches field1 in its export state this is reflected in field1 in the import state of BBB. # AAA_GridComp.F90 @@ -18,5 +18,10 @@ This is the same as the previous tutorial so nothing more needs to be said. # BBB_GridComp.F90 This looks similar to the AAA gridcomp but now it does a MAPL_AddImportSpec call instead of a MAPL_AddExport Spec call. This adds a field named field1 to its import state. In the run method we get a pointer to field1 and write the maximum value. Since this is an import field we do not need to protect the pointer with an if (associated) check. +# How Imports are Handled in a MAPL Hierachy +This section will discuss how imports are handled in a MAPL hierarchy. As stated BBB creates a field in the import state. In fitting with the ESMF symantics and conventions the component should not touch or modify the contents of the import state so something else will nee to fill it with data. The general rule is that a parent "inherits" all the imports of its children. In practice what this means is that if the child has an field in its import state named foo, the parent will also get a field in its import state named foo. Moreover both fields will point to the same underlying pointer so are literally referencing the same memory. If the parent contains a` MAPL_AddConnectivity` call as in this exmaple the import field of the child is connected a field in the export state of another child. In MAPL when we say connected what is actually happening is that both the field in the import state and export state of the components shared the same pointer to the physical memory. The `MAPL_AddConnectivity` call also has another effect. It prevents the parent or grandparent etc of the referenced import field from being added to to those gridded component's import states. + +What would happen in this example if we did not have the `MAPL_AddConnectivity`? That is an important question and will be discussed in a later tutorial. + # Running -When you run this example you should notice the print from BBB each timestep and this should be increasing by 1. That's because it is "connected" to the export from AAA in this example. +When running this example you will notice the print from BBB each timestep and this should be increasing by 1. That's because it is "connected" to the export from AAA in this example. From d6ed51ba968d8d0ea0379d8f09fac1ca68de00dd Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 1 Jul 2022 15:17:19 -0400 Subject: [PATCH 213/300] updates for checking yaml parsing --- components.yaml | 2 +- gridcomps/ExtData2G/CMakeLists.txt | 1 - gridcomps/ExtData2G/ExtDataConfig.F90 | 69 ++++--- gridcomps/ExtData2G/ExtDataDerived.F90 | 2 +- gridcomps/ExtData2G/ExtDataFileStream.F90 | 4 +- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 179 ++++++++++--------- gridcomps/ExtData2G/ExtDataRule.F90 | 6 +- gridcomps/ExtData2G/ExtDataSample.F90 | 2 +- gridcomps/ExtData2G/ExtDataYamlNodeStack.F90 | 8 - 9 files changed, 136 insertions(+), 137 deletions(-) delete mode 100644 gridcomps/ExtData2G/ExtDataYamlNodeStack.F90 diff --git a/components.yaml b/components.yaml index 35913f85302e..fd2817d00890 100644 --- a/components.yaml +++ b/components.yaml @@ -5,7 +5,7 @@ MAPL: ESMA_env: local: ./ESMA_env remote: ../ESMA_env.git - tag: v3.14.0 + tag: v4.2.0 develop: main ESMA_cmake: diff --git a/gridcomps/ExtData2G/CMakeLists.txt b/gridcomps/ExtData2G/CMakeLists.txt index ee599479ac02..e2ab97514db3 100644 --- a/gridcomps/ExtData2G/CMakeLists.txt +++ b/gridcomps/ExtData2G/CMakeLists.txt @@ -20,7 +20,6 @@ set (srcs ExtDataSample.F90 ExtData_IOBundleMod.F90 ExtData_IOBundleVectorMod.F90 - ExtDataYamlNodeStack.F90 ExtDataMasking.F90 ) diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index 143ba31a59a0..b3466628efbd 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -15,7 +15,6 @@ module MAPL_ExtDataConfig use MAPL_ExtDataTimeSample use MAPL_ExtDataTimeSampleMap use MAPL_TimeStringConversion - use MAPL_ExtDataYamlNodeStack use MAPL_ExtDataMask implicit none private @@ -48,20 +47,21 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ integer, optional, intent(out) :: rc type(Parser) :: p - type(Configuration) :: config, subcfg, ds_config, rule_config, derived_config, sample_config, subconfigs, rule_map - type(ConfigurationIterator) :: iter - character(len=:), allocatable :: key,new_key + class(YAML_Node), allocatable :: config + class(YAML_Node), pointer :: subcfg, ds_config, rule_config, derived_config, sample_config, subconfigs, rule_map + class(NodeIterator), allocatable :: iter + character(len=:), pointer :: key + character(len=:), allocatable :: new_key type(ExtDataFileStream) :: ds type(ExtDataDerived) :: derived type(ExtDataTimeSample) :: ts integer :: status - type(FileStream) :: fstream type(ExtDataFileStream), pointer :: temp_ds type(ExtDataTimeSample), pointer :: temp_ts type(ExtDataDerived), pointer :: temp_derived - character(len=:), allocatable :: sub_file + character(len=:), pointer :: sub_file integer :: i,num_rules integer, allocatable :: sorted_rules(:) character(len=1) :: i_char @@ -72,30 +72,27 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ inquire(file=trim(config_file),exist=file_found) _ASSERT(file_found,"could not find: "//trim(config_file)) - stack_depth=stack_depth+1 p = Parser('core') - fstream=FileStream(config_file) - yaml_node_stack(stack_depth) = p%load(fstream) - call fstream%close() + config = p%load(config_file) - if (yaml_node_stack(stack_depth)%has("subconfigs")) then - subconfigs = yaml_node_stack(stack_depth)%at("subconfigs") + if (config%has("subconfigs")) then + subconfigs => config%at("subconfigs") _ASSERT(subconfigs%is_sequence(),'subconfigs is not a sequence') do i=1,subconfigs%size() - sub_file = subconfigs%of(i) + sub_file => to_string(subconfigs%at(i)) call new_ExtDataConfig_from_yaml(ext_config,sub_file,current_time,rc=status) _VERIFY(status) end do end if - if (yaml_node_stack(stack_depth)%has("Samplings")) then - sample_config = yaml_node_stack(stack_depth)%of("Samplings") + if (config%has("Samplings")) then + sample_config => config%of("Samplings") iter = sample_config%begin() do while (iter /= sample_config%end()) - call iter%get_key(key) + key => to_string(iter%first(),_RC) temp_ts => ext_config%sample_map%at(key) _ASSERT(.not.associated(temp_ts),"defined duplicate named sample key") - call iter%get_value(subcfg) + subcfg => iter%second() ts = ExtDataTimeSample(subcfg,_RC) _VERIFY(status) call ext_config%sample_map%insert(trim(key),ts) @@ -103,33 +100,33 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ enddo end if - if (yaml_node_stack(stack_depth)%has("Collections")) then - ds_config = yaml_node_stack(stack_depth)%of("Collections") + if (config%has("Collections")) then + ds_config => config%of("Collections") iter = ds_config%begin() do while (iter /= ds_config%end()) - call iter%get_key(key) + key => to_string(iter%first(),_RC) temp_ds => ext_config%file_stream_map%at(key) _ASSERT(.not.associated(temp_ds),"defined duplicate named collection") - call iter%get_value(subcfg) + subcfg => iter%second() ds = ExtDataFileStream(subcfg,current_time,_RC) call ext_config%file_stream_map%insert(trim(key),ds) call iter%next() enddo end if - if (yaml_node_stack(stack_depth)%has("Exports")) then - rule_config = yaml_node_stack(stack_depth)%of("Exports") + if (config%has("Exports")) then + rule_config => config%of("Exports") iter = rule_config%begin() do while (iter /= rule_config%end()) - call iter%get_key(key) - call iter%get_value(subcfg) + key => to_string(iter%first(),_RC) + subcfg => iter%second() if (subcfg%is_mapping()) then call ext_config%add_new_rule(key,subcfg,_RC) else if (subcfg%is_sequence()) then sorted_rules = sort_rules_by_start(subcfg,_RC) num_rules = subcfg%size() do i=1,num_rules - rule_map = subcfg%of(sorted_rules(i)) + rule_map => subcfg%of(sorted_rules(i)) write(i_char,'(I1)')i new_key = key//rule_sep//i_char call ext_config%add_new_rule(new_key,rule_map,multi_rule=.true.,_RC) @@ -141,14 +138,14 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ enddo end if - if (yaml_node_stack(stack_depth)%has("Derived")) then - derived_config = yaml_node_stack(stack_depth)%at("Derived") + if (config%has("Derived")) then + derived_config => config%at("Derived") iter = derived_config%begin() do while (iter /= derived_config%end()) call derived%set_defaults(rc=status) _VERIFY(status) - call iter%get_key(key) - call iter%get_value(subcfg) + key => to_string(iter%first(),_RC) + subcfg => iter%second() derived = ExtDataDerived(subcfg,_RC) temp_derived => ext_config%derived_map%at(trim(key)) _ASSERT(.not.associated(temp_derived),"duplicated derived entry key") @@ -157,12 +154,11 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ enddo end if - if (yaml_node_stack(stack_depth)%has("debug")) then + if (config%has("debug")) then call config%get(ext_config%debug,"debug",rc=status) _VERIFY(status) end if - stack_depth=stack_depth-1 _RETURN(_SUCCESS) end subroutine new_ExtDataConfig_from_yaml @@ -231,12 +227,12 @@ end function get_time_range function sort_rules_by_start(yaml_sequence,rc) result(sorted_index) integer, allocatable :: sorted_index(:) - class(Configuration), intent(inout) :: yaml_sequence + class(YAML_Node), intent(inout) :: yaml_sequence integer, optional, intent(out) :: rc integer :: num_rules,i,j,i_temp,imin logical :: found_start - type(configuration) :: yaml_dict + class(YAML_Node), pointer :: yaml_dict character(len=:), allocatable :: start_time type(ESMF_Time), allocatable :: start_times(:) type(ESMF_Time) :: temp_time @@ -246,7 +242,7 @@ function sort_rules_by_start(yaml_sequence,rc) result(sorted_index) allocate(sorted_index(num_rules),source=[(i,i=1,num_rules)]) do i=1,num_rules - yaml_dict = yaml_sequence%of(i) + yaml_dict => yaml_sequence%of(i) found_start = yaml_dict%has("starting") _ASSERT(found_start,"no start key in multirule export of extdata") start_time = yaml_dict%of("starting") @@ -323,7 +319,7 @@ end function get_item_type subroutine add_new_rule(this,key,export_rule,multi_rule,rc) class(ExtDataConfig), intent(inout) :: this character(len=*), intent(in) :: key - type(configuration), intent(in) :: export_rule + class(YAML_Node), intent(in) :: export_rule logical, optional, intent(in) :: multi_rule integer, intent(out), optional :: rc @@ -372,7 +368,6 @@ function get_extra_derived_items(this,primary_items,derived_items,rc) result(nee type(StringVectorIterator) :: string_iter type(ExtDataDerived), pointer :: derived_item type(StringVector) :: variables_in_expression - type(StringVector) :: extra_variables_needed character(len=:), pointer :: sval,derived_name type(ExtDataRule), pointer :: rule integer :: i diff --git a/gridcomps/ExtData2G/ExtDataDerived.F90 b/gridcomps/ExtData2G/ExtDataDerived.F90 index eda6020cce8a..f036898ce6b0 100644 --- a/gridcomps/ExtData2G/ExtDataDerived.F90 +++ b/gridcomps/ExtData2G/ExtDataDerived.F90 @@ -27,7 +27,7 @@ module MAPL_ExtDataDerived contains function new_ExtDataDerived(config,unusable,rc) result(rule) - type(Configuration), intent(in) :: config + class(YAML_Node), intent(in) :: config class(KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc diff --git a/gridcomps/ExtData2G/ExtDataFileStream.F90 b/gridcomps/ExtData2G/ExtDataFileStream.F90 index c239380a0896..68ddddc22270 100644 --- a/gridcomps/ExtData2G/ExtDataFileStream.F90 +++ b/gridcomps/ExtData2G/ExtDataFileStream.F90 @@ -31,7 +31,7 @@ module MAPL_ExtDataFileStream contains function new_ExtDataFileStream(config,current_time,unusable,rc) result(data_set) - type(Configuration), intent(in) :: config + class(Yaml_node), intent(in) :: config type(ESMF_Time), intent(in) :: current_time class(KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc @@ -126,7 +126,7 @@ function new_ExtDataFileStream(config,current_time,unusable,rc) result(data_set) contains function get_string_with_default(config,selector) result(string) - type(Configuration), intent(in) :: config + class(Yaml_Node), intent(in) :: config character(len=*), intent(In) :: selector character(len=:), allocatable :: string diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index 627472eb8b2d..e99d395b29cb 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -11,7 +11,7 @@ MODULE MAPL_ExtDataGridComp2G !BOP ! !MODULE: MAPL_ExtDataGridCompMod - Implements Interface to External Data ! -! !DESCRIPTION: +! !DESCRIPTION: ! ! {\tt MAPL\_ExtDataGridComp} is an ESMF gridded component implementing ! an interface to boundary conditions and other types of external data @@ -84,8 +84,8 @@ MODULE MAPL_ExtDataGridComp2G type(integerVector) :: number_of_rules type(stringVector) :: import_names type(PrimaryExport), pointer :: item(:) => null() - contains - procedure :: get_item_index + contains + procedure :: get_item_index end type PrimaryExports type DerivedExports @@ -137,7 +137,7 @@ SUBROUTINE SetServices ( GC, RC ) type(ESMF_GridComp), intent(INOUT) :: GC ! gridded component integer, optional :: RC ! return code -! !DESCRIPTION: Sets Initialize, Run and Finalize services. +! !DESCRIPTION: Sets Initialize, Run and Finalize services. ! ! !REVISION HISTORY: ! @@ -168,7 +168,7 @@ SUBROUTINE SetServices ( GC, RC ) allocate ( self, stat=STATUS ) _VERIFY(STATUS) wrap%ptr => self - + ! ------------------------ ! ESMF Functional Services ! ------------------------ @@ -178,12 +178,12 @@ SUBROUTINE SetServices ( GC, RC ) call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_INITIALIZE, Initialize_, __RC__ ) call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run_, __RC__ ) call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_FINALIZE, Finalize_, __RC__ ) - + ! Store internal state in GC ! -------------------------- call ESMF_UserCompSetInternalState ( GC, 'MAPL_ExtData_state', wrap, STATUS ) _VERIFY(STATUS) - + call MAPL_TimerAdd(gc,name="Initialize", rc=status) _VERIFY(STATUS) call MAPL_TimerAdd(gc,name="Run", rc=status) @@ -263,7 +263,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(ESMF_State), intent(inout) :: EXPORT ! Export State integer, intent(out) :: rc ! Error return code: ! 0 - all is well - ! 1 - + ! 1 - ! !DESCRIPTION: This is a simple ESMF wrapper. ! @@ -275,7 +275,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) !------------------------------------------------------------------------- type(MAPL_ExtData_state), pointer :: self ! Legacy state - type(ESMF_Config) :: CF_master ! Universal Config + type(ESMF_Config) :: CF_master ! Universal Config character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: Iam @@ -326,7 +326,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! Start Some Timers ! ----------------- call MAPL_GetObjectFromGC ( gc, MAPLSTATE, RC=STATUS) - _VERIFY(STATUS) + _VERIFY(STATUS) call MAPL_TimerOn(MAPLSTATE,"TOTAL") call MAPL_TimerOn(MAPLSTATE,"Initialize") @@ -396,11 +396,11 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) end if enddo extra_variables_needed = config_yaml%get_extra_derived_items(self%primary%import_names,self%derived%import_names,_RC) - siter = extra_variables_needed%begin() + siter = extra_variables_needed%begin() do while(siter/=extra_variables_needed%end()) extra_var => siter%get() idx = index(extra_var,",") - primary_var_name = extra_var(:idx-1) + primary_var_name = extra_var(:idx-1) derived_var_name = extra_var(idx+1:) call self%primary%import_names%push_back(primary_var_name) primaryItemCount=primaryItemCount+config_yaml%count_rules_for_item(primary_var_name,_RC) @@ -411,7 +411,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_StateAdd(self%ExtDataState,new_field,__RC__) end if call siter%next() - enddo + enddo call ESMF_VMBarrier(vm,_RC) if (unsatisfied_imports%size() > 0) then do i=1,unsatisfied_imports%size() @@ -419,14 +419,14 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) enddo _FAIL("Unsatisfied imports in ExtData") end if - + allocate(self%primary%item(PrimaryItemCount),__STAT__) allocate(self%derived%item(DerivedItemCount),__STAT__) self%primary%nitems = PrimaryItemCount self%derived%nitems = DerivedItemCount num_primary=0 - num_derived=0 + num_derived=0 do i=1,self%primary%import_names%size() current_base_name => self%primary%import_names%at(i) num_rules = config_yaml%count_rules_for_item(current_base_name) @@ -467,7 +467,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call ESMF_StateGet(Export,current_base_name,field,__RC__) call MAPL_StateAdd(self%ExtDataState,field,__RC__) enddo - + PrimaryLoop: do i=1,self%primary%import_names%size() current_base_name => self%primary%import_names%at(i) @@ -480,7 +480,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call set_constant_field(item,self%extDataState,_RC) cycle end if - call create_bracketing_fields(item,self%ExtDataState,cf_master,_RC) + call create_bracketing_fields(item,self%ExtDataState,cf_master,_RC) end do PrimaryLoop @@ -554,7 +554,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(ESMF_State), intent(inout) :: EXPORT ! Export State integer, intent(out) :: rc ! Error return code: ! 0 - all is well - ! 1 - + ! 1 - ! !DESCRIPTION: This is a simple ESMF wrapper. ! @@ -566,7 +566,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) !------------------------------------------------------------------------- type(MAPL_ExtData_state), pointer :: self ! Legacy state - type(ESMF_Config) :: CF ! Universal Config + type(ESMF_Config) :: CF ! Universal Config character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: Iam @@ -596,10 +596,10 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) _UNUSED_DUMMY(IMPORT) _UNUSED_DUMMY(EXPORT) -! Declare pointers to IMPORT/EXPORT/INTERNAL states +! Declare pointers to IMPORT/EXPORT/INTERNAL states ! ------------------------------------------------- ! #include "MAPL_ExtData_DeclarePointer___.h" - + ! Get my name and set-up traceback handle ! --------------------------------------- Iam = 'Run_' @@ -615,13 +615,13 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) end if call MAPL_GetObjectFromGC ( gc, MAPLSTATE, RC=STATUS) - _VERIFY(STATUS) + _VERIFY(STATUS) call MAPL_TimerOn(MAPLSTATE,"TOTAL") call MAPL_TimerOn(MAPLSTATE,"Run") call ESMF_ClockGet(CLOCK, currTIME=time0, __RC__) -! Fill in the internal state with data from the files +! Fill in the internal state with data from the files ! --------------------------------------------------- allocate(doUpdate(self%primary%nitems),stat=status) @@ -634,7 +634,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call extdata_lgr%debug('ExtData Rune_(): Start') call extdata_lgr%debug('ExtData Run_(): READ_LOOP: Start') - + READ_LOOP: do i=1,self%primary%import_names%size() current_base_name => self%primary%import_names%at(i) @@ -667,7 +667,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) DO_UPDATE: if (doUpdate(i)) then - !call extdata_lgr%info('Going to update %a with file template: %a ',current_base_name, item%file_template) + !call extdata_lgr%info('Going to update %a with file template: %a ',current_base_name, item%file_template) call item%modelGridFields%comp1%reset() call item%filestream%get_file_bracket(time,item%source_time, item%modelGridFields%comp1,__RC__) if (item%vartype == MAPL_VectorField) then @@ -716,9 +716,9 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOff(MAPLSTATE,"---IclientDone") _VERIFY(STATUS) - + call MAPL_TimerOn(MAPLSTATE,"---read-prefetch") - call MAPL_ExtDataReadPrefetch(IOBundles,rc=status) + call MAPL_ExtDataReadPrefetch(IOBundles,rc=status) _VERIFY(status) call MAPL_TimerOff(MAPLSTATE,"---read-prefetch") call MAPL_TimerOff(MAPLSTATE,"--PRead") @@ -740,7 +740,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOn(MAPLSTATE,"-Interpolate") - call extdata_lgr%debug('ExtData Run_: INTERP_LOOP: Start') + call extdata_lgr%debug('ExtData Run_: INTERP_LOOP: Start') INTERP_LOOP: do i=1,self%primary%import_names%size() @@ -752,12 +752,12 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call extdata_lgr%debug('ExtData Run_: INTERP_LOOP: interpolating between bracket times, variable: %a, file: %a', & & trim(current_base_name), trim(item%file_template)) - + call MAPL_ExtDataInterpField(item,self%ExtDataState,useTime(i),__RC__) endif - nullify(item) + nullify(item) end do INTERP_LOOP @@ -822,7 +822,7 @@ SUBROUTINE Finalize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(ESMF_State), intent(inout) :: EXPORT ! Export State integer, intent(out) :: rc ! Error return code: ! 0 - all is well - ! 1 - + ! 1 - ! !DESCRIPTION: This is a simple ESMF wrapper. ! @@ -834,7 +834,7 @@ SUBROUTINE Finalize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) !------------------------------------------------------------------------- type(MAPL_ExtData_state), pointer :: self ! Legacy state - type(ESMF_Config) :: CF ! Universal Config + type(ESMF_Config) :: CF ! Universal Config character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: Iam @@ -875,7 +875,7 @@ subroutine extract_ ( GC, self, CF, rc) type(ESMF_GridComp), intent(INout) :: GC ! Grid Comp object type(MAPL_ExtData_state), pointer :: self ! Legacy state - type(ESMF_Config), intent(out) :: CF ! Universal Config + type(ESMF_Config), intent(out) :: CF ! Universal Config integer, intent(out), optional :: rc @@ -905,20 +905,20 @@ subroutine extract_ ( GC, self, CF, rc) ! --------------------- call ESMF_GridCompGet ( GC, config=CF, __RC__ ) - + _RETURN(ESMF_SUCCESS) end subroutine extract_ - + ! ............................................................................ logical function PrimaryExportIsConstant_(item) - + type(PrimaryExport), intent(in) :: item if ( item%update_freq%is_single_shot() .or. & trim(item%file_template) == '/dev/null' ) then - PrimaryExportIsConstant_ = .true. + PrimaryExportIsConstant_ = .true. else PrimaryExportIsConstant_ = .false. end if @@ -928,11 +928,11 @@ end function PrimaryExportIsConstant_ ! ............................................................................ logical function DerivedExportIsConstant_(item) - + type(DerivedExport), intent(in) :: item if ( item%update_freq%is_disabled() ) then - DerivedExportIsConstant_ = .true. + DerivedExportIsConstant_ = .true. else DerivedExportIsConstant_ = .false. end if @@ -944,7 +944,7 @@ end function DerivedExportIsConstant_ type (ESMF_Time) function timestamp_(time, template, rc) type(ESMF_Time), intent(inout) :: time character(len=ESMF_MAXSTR), intent(in) :: template - integer, optional, intent(inout) :: rc + integer, optional, intent(inout) :: rc ! locals integer, parameter :: DATETIME_MAXSTR_ = 32 @@ -955,19 +955,19 @@ type (ESMF_Time) function timestamp_(time, template, rc) integer :: i, il, ir integer :: status - + ! test the length of the timestamp template _ASSERT(len_trim(template) < DATETIME_MAXSTR_,'Timestamp template is greater than Maximum allowed len') buff = trim(template) buff = ESMF_UtilStringLowerCase(buff, __RC__) - + ! test if the template is empty and return the current time as result if (buff == '-' .or. buff == '--' .or. buff == '---' .or. & buff == 'na' .or. buff == 'none' .or. buff == 'n/a') then timestamp_ = time - else + else ! split the time stamp template into a date and time strings i = scan(buff, 't') If (.not.(i > 3)) Then @@ -990,7 +990,7 @@ type (ESMF_Time) function timestamp_(time, template, rc) str_hs = trim(buff_time(1:il-1)) str_ms = trim(buff_time(il+1:ir-1)) str_ss = trim(buff_time(ir+1:)) - + ! remove the trailing 'Z' from the seconds string i = scan(str_ss, 'z') if (i > 0) then @@ -1013,7 +1013,7 @@ type (ESMF_Time) function timestamp_(time, template, rc) _RETURN(ESMF_SUCCESS) end function timestamp_ - + subroutine GetLevs(item, rc) type(PrimaryExport) , intent(inout) :: item @@ -1021,10 +1021,10 @@ subroutine GetLevs(item, rc) integer :: status - real, allocatable :: levFile(:) + real, allocatable :: levFile(:) character(len=ESMF_MAXSTR) :: levunits,tlevunits character(len=:), allocatable :: levname - character(len=:), pointer :: positive + character(len=:), pointer :: positive type(Variable), pointer :: var integer :: i @@ -1040,7 +1040,7 @@ subroutine GetLevs(item, rc) var=>item%file_metadata%get_variable(trim(item%var)) _ASSERT(associated(var),"Variable "//TRIM(item%var)//" not found in file "//TRIM(item%file_template)) end if - + levName = item%file_metadata%get_level_name(rc=status) _VERIFY(status) if (trim(levName) /='') then @@ -1098,7 +1098,7 @@ subroutine MAPL_ExtDataInterpField(item,state,time,rc) if (item%vartype == MAPL_VectorField) then call ESMF_StateGet(state,item%vcomp2,field,__RC__) call item%modelGridFields%comp2%interpolate_to_time(field,time,__RC__) - end if + end if _RETURN(ESMF_SUCCESS) end subroutine MAPL_ExtDataInterpField @@ -1117,7 +1117,7 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,current_time,rc) if (trim(item%importVDir)/=trim(item%fileVDir)) then call MAPL_ExtDataFlipVertical(item,filec,rc=status) _VERIFY(status) - end if + end if if (item%vartype == MAPL_fieldItem) then call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,rc=status) _VERIFY(STATUS) @@ -1128,7 +1128,7 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,current_time,rc) _VERIFY(STATUS) call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,rc=status) _VERIFY(STATUS) - + else if (item%vartype == MAPL_VectorField) then id_ps = ExtState%primary%get_item_index("PS",current_time,_RC) @@ -1177,7 +1177,7 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,current_time,rc) _VERIFY(status) end if end if - + _RETURN(ESMF_SUCCESS) end subroutine MAPL_ExtDataVerticalInterpolate @@ -1198,6 +1198,8 @@ function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) type(ESMF_Config) :: cflocal character(len=*), parameter :: CF_COMPONENT_SEPARATOR = '.' real :: temp_real + logical :: isPresent + type(ESMF_Info) :: infoh IAM = "MAPL_ExtDataGridChangeLev" @@ -1225,19 +1227,33 @@ function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) _VERIFY(status) call MAPL_ConfigSetAttribute(cflocal,value=trim(gname), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRIDNAME:",rc=status) _VERIFY(status) - call ESMF_AttributeGet(grid, name='STRETCH_FACTOR', value=temp_real, rc=status) - if (status == ESMF_SUCCESS) then - call MAPL_ConfigSetAttribute(cflocal,value=temp_real, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"STRETCH_FACTOR:",rc=status) + + call ESMF_InfoGetFromHost(grid,infoh,rc=status) + _VERIFY(status) + isPresent = ESMF_InfoIsPresent(infoh,'STRETCH_FACTOR',rc=status) + _VERIFY(status) + if (isPresent) then + call ESMF_InfoGet(infoh,'STRETCH_FACTOR',temp_real,rc=status) + _VERIFY(status) + call MAPL_ConfigSetAttribute(cflocal,value=temp_real, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"STRETCH_FACTOR:",rc=status) _VERIFY(status) endif - call ESMF_AttributeGet(grid, name='TARGET_LON', value=temp_real, rc=status) - if (status == ESMF_SUCCESS) then - call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"TARGET_LON:",rc=status) + + isPresent = ESMF_InfoIsPresent(infoh,'TARGET_LON',rc=status) + _VERIFY(status) + if (isPresent) then + call ESMF_InfoGet(infoh,'TARGET_LON',temp_real,rc=status) + _VERIFY(status) + call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"TARGET_LON:",rc=status) _VERIFY(status) endif - call ESMF_AttributeGet(grid, name='TARGET_LAT', value=temp_real, rc=status) - if (status == ESMF_SUCCESS) then - call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"TARGET_LAT:",rc=status) + + isPresent = ESMF_InfoIsPresent(infoh,'TARGET_LAT',rc=status) + _VERIFY(status) + if (isPresent) then + call ESMF_InfoGet(infoh,'TARGET_LAT',temp_real,rc=status) + _VERIFY(status) + call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//MAPL_CF_COMPONENT_SEPARATOR//"TARGET_LAT:",rc=status) _VERIFY(status) endif else @@ -1271,7 +1287,7 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) integer :: status logical :: getRL_ - + Iam = "MAPL_ExtDataGetBracket" if (present(getRL)) then @@ -1284,7 +1300,7 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) if (present(field)) then - if (Bside == MAPL_ExtDataLeft .and. vcomp == 1) then + if (Bside == MAPL_ExtDataLeft .and. vcomp == 1) then if (getRL_) then call item%modelGridFields%auxiliary1%get_parameters('L',field=field,__RC__) _RETURN(ESMF_SUCCESS) @@ -1292,7 +1308,7 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) call item%modelGridFields%comp1%get_parameters('L',field=field,__RC__) _RETURN(ESMF_SUCCESS) end if - else if (Bside == MAPL_ExtDataLeft .and. vcomp == 2) then + else if (Bside == MAPL_ExtDataLeft .and. vcomp == 2) then if (getRL_) then call item%modelGridFields%auxiliary2%get_parameters('L',field=field,__RC__) _RETURN(ESMF_SUCCESS) @@ -1300,7 +1316,7 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) call item%modelGridFields%comp2%get_parameters('L',field=field,__RC__) _RETURN(ESMF_SUCCESS) end if - else if (Bside == MAPL_ExtDataRight .and. vcomp == 1) then + else if (Bside == MAPL_ExtDataRight .and. vcomp == 1) then if (getRL_) then call item%modelGridFields%auxiliary1%get_parameters('R',field=field,__RC__) _RETURN(ESMF_SUCCESS) @@ -1308,7 +1324,7 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) call item%modelGridFields%comp1%get_parameters('R',field=field,__RC__) _RETURN(ESMF_SUCCESS) end if - else if (Bside == MAPL_ExtDataRight .and. vcomp == 2) then + else if (Bside == MAPL_ExtDataRight .and. vcomp == 2) then if (getRL_) then call item%modelGridFields%auxiliary2%get_parameters('R',field=field,__RC__) _RETURN(ESMF_SUCCESS) @@ -1343,10 +1359,10 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) end if end if else if (present(bundle)) then - !if (Bside == MAPL_ExtDataLeft) then + !if (Bside == MAPL_ExtDataLeft) then !bundle = item%binterp1 !_RETURN(ESMF_SUCCESS) - !else if (Bside == MAPL_ExtDataRight) then + !else if (Bside == MAPL_ExtDataRight) then !bundle = item%binterp2 !_RETURN(ESMF_SUCCESS) !end if @@ -1404,16 +1420,16 @@ subroutine MAPL_ExtDataFillField(item,FieldF,FieldR,rc) end if _RETURN(ESMF_SUCCESS) - + end subroutine MAPL_ExtDataFillField subroutine MAPL_ExtDataFlipVertical(item,filec,rc) type(PrimaryExport), intent(inout) :: item integer, intent(in) :: filec integer, optional, intent(out) :: rc - + integer :: status - + type(ESMF_Field) :: Field,field1,field2 real, pointer :: ptr(:,:,:) real, allocatable :: ptemp(:,:,:) @@ -1470,9 +1486,9 @@ subroutine MAPL_ExtDataPopulateBundle(item,filec,pbundle,rc) integer, intent(in) :: filec type(ESMF_FieldBundle), intent(inout) :: pbundle integer, optional, intent(out) :: rc - + integer :: status - + type(ESMF_Field) :: Field,field1,field2 type(ESMF_Grid) :: grid @@ -1523,7 +1539,7 @@ subroutine MAPL_ExtDataCreateCFIO(IOBundles, rc) type (IOBundleNGVectorIterator) :: bundle_iter type (ExtDataNG_IOBundle), pointer :: io_bundle integer :: status - + bundle_iter = IOBundles%begin() do while (bundle_iter /= IOBundles%end()) io_bundle => bundle_iter%get() @@ -1623,7 +1639,7 @@ end subroutine createFileLevBracket subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,rc) type(IOBundleNGVector), intent(inout) :: IOBundles - type(primaryExport), intent(inout) :: item + type(primaryExport), intent(inout) :: item integer, intent(in) :: entry_num integer, intent(out), optional :: rc @@ -1636,7 +1652,7 @@ subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,rc) integer :: time_index call item%modelGridFields%comp1%get_parameters('L',update=update,file=current_file,time_index=time_index) - if (update) then + if (update) then call itemsL%push_back(item%fileVars) io_bundle = ExtDataNG_IOBundle(MAPL_ExtDataLeft, entry_num, current_file, time_index, item%trans, item%fracval, item%file_template, & item%pfioCollection_id,item%iclient_collection_id,itemsL,rc=status) @@ -1645,7 +1661,7 @@ subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,rc) call extdata_lgr%info('%a updated L bracket with: %a at time index %i2 ',item%name, current_file, time_index) end if call item%modelGridFields%comp1%get_parameters('R',update=update,file=current_file,time_index=time_index) - if (update) then + if (update) then call itemsR%push_back(item%fileVars) io_bundle = ExtDataNG_IOBundle(MAPL_ExtDataRight, entry_num, current_file, time_index, item%trans, item%fracval, item%file_template, & item%pfioCollection_id,item%iclient_collection_id,itemsR,rc=status) @@ -1789,7 +1805,7 @@ function get_item_index(this,base_name,current_time,rc) result(item_index) found = .false. do i=1,this%import_names%size() cname => this%import_names%at(i) - if (cname == base_name) then + if (cname == base_name) then found = .true. i_start => this%export_id_start%at(i) num_rules => this%number_of_rules%at(i) @@ -1819,13 +1835,10 @@ function am_i_running(yaml_file) result(am_running) character(len=*), intent(in) :: yaml_file type(Parser) :: p - type(FileStream) :: fstream - type(Configuration) :: config + class(YAML_Node), allocatable :: config p = Parser('core') - fstream=FileStream(yaml_file) - config = p%load(fstream) - call fstream%close() + config = p%load(yaml_file) if (config%has("USE_EXTDATA")) then am_running = config%of("USE_EXTDATA") diff --git a/gridcomps/ExtData2G/ExtDataRule.F90 b/gridcomps/ExtData2G/ExtDataRule.F90 index fdd0ad1a04e4..c7c7a1c7a287 100644 --- a/gridcomps/ExtData2G/ExtDataRule.F90 +++ b/gridcomps/ExtData2G/ExtDataRule.F90 @@ -33,7 +33,7 @@ module MAPL_ExtDataRule contains function new_ExtDataRule(config,sample_map,key,unusable,multi_rule,rc) result(rule) - type(Configuration), intent(in) :: config + class(YAML_Node), intent(in) :: config character(len=*), intent(in) :: key type(ExtDataTimeSampleMap) :: sample_map class(KeywordEnforcer), optional, intent(in) :: unusable @@ -43,7 +43,7 @@ function new_ExtDataRule(config,sample_map,key,unusable,multi_rule,rc) result(ru type(ExtDataRule) :: rule logical :: is_present integer :: status - type(Configuration) ::config1 + class(YAML_Node), pointer ::config1 character(len=:), allocatable :: tempc type(ExtDataTimeSample) :: ts logical :: usable_multi_rule @@ -73,7 +73,7 @@ function new_ExtDataRule(config,sample_map,key,unusable,multi_rule,rc) result(ru end if if (config%has("sample")) then - config1=config%at("sample") + config1=>config%at("sample") if (config1%is_mapping()) then ts = ExtDataTimeSample(config1,_RC) call sample_map%insert(trim(key)//"_sample",ts) diff --git a/gridcomps/ExtData2G/ExtDataSample.F90 b/gridcomps/ExtData2G/ExtDataSample.F90 index 757e7f9d9ef2..8a7629e235c4 100644 --- a/gridcomps/ExtData2G/ExtDataSample.F90 +++ b/gridcomps/ExtData2G/ExtDataSample.F90 @@ -26,7 +26,7 @@ module MAPL_ExtDataTimeSample contains function new_ExtDataTimeSample(config,unusable,rc) result(TimeSample) - type(Configuration), intent(in) :: config + class(YAML_Node), intent(in) :: config class(KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc diff --git a/gridcomps/ExtData2G/ExtDataYamlNodeStack.F90 b/gridcomps/ExtData2G/ExtDataYamlNodeStack.F90 deleted file mode 100644 index 18d5a313a245..000000000000 --- a/gridcomps/ExtData2G/ExtDataYamlNodeStack.F90 +++ /dev/null @@ -1,8 +0,0 @@ -module MAPL_ExtDataYamlNodeStack - use yaFyaml - implicit none - - integer, save :: stack_depth = 0 - type(Configuration), save :: yaml_node_stack(10) - -end module MAPL_ExtDataYamlNodeStack From 329385485b6833114fd74ccae175040b50403151 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 1 Jul 2022 15:19:43 -0400 Subject: [PATCH 214/300] update changelog --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 07e285887c75..26b2d2941c7a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,8 +10,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed ### Added +- Check return codes for YAML files when parsing in ExtData2G ### Changed +- Updated the ESMA_env version to v4.2.0 ### Removed From b1b4182ab0c0b8f000a6caa04e615c5d849c1896 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 1 Jul 2022 16:04:00 -0400 Subject: [PATCH 215/300] report file that failed when parsing yaml --- gridcomps/ExtData2G/ExtDataConfig.F90 | 5 ++++- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 16 +++++++++++----- 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/gridcomps/ExtData2G/ExtDataConfig.F90 b/gridcomps/ExtData2G/ExtDataConfig.F90 index b3466628efbd..a6b29845364c 100644 --- a/gridcomps/ExtData2G/ExtDataConfig.F90 +++ b/gridcomps/ExtData2G/ExtDataConfig.F90 @@ -73,7 +73,10 @@ recursive subroutine new_ExtDataConfig_from_yaml(ext_config,config_file,current_ _ASSERT(file_found,"could not find: "//trim(config_file)) p = Parser('core') - config = p%load(config_file) + config = p%load(config_file,rc=status) + if (status/=_SUCCESS) then + _FAIL("Error parsing "//trim(config_file)) + end if if (config%has("subconfigs")) then subconfigs => config%at("subconfigs") diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index e99d395b29cb..bdcfeb44b774 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -331,7 +331,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOn(MAPLSTATE,"Initialize") call ESMF_ConfigGetAttribute(cf_master,new_rc_file,label="EXTDATA_YAML_FILE:",default="extdata.yaml",_RC) - self%active = am_i_running(new_rc_file) + self%active = am_i_running(new_rc_file,_RC) call ESMF_ClockGet(CLOCK, currTIME=time, __RC__) ! Get information from export state @@ -1830,21 +1830,27 @@ function get_item_index(this,base_name,current_time,rc) result(item_index) _RETURN(_SUCCESS) end function get_item_index - function am_i_running(yaml_file) result(am_running) + function am_i_running(yaml_file,rc) result(am_running) logical :: am_running character(len=*), intent(in) :: yaml_file + integer, intent(out), optional :: rc type(Parser) :: p class(YAML_Node), allocatable :: config + integer :: status + am_running=.true. p = Parser('core') - config = p%load(yaml_file) + config = p%load(yaml_file,rc=status) + if (status/=_SUCCESS) then + _FAIL("Error parsing: "//trim(yaml_file)) + end if if (config%has("USE_EXTDATA")) then am_running = config%of("USE_EXTDATA") - else - am_running = .true. end if + _RETURN(_SUCCESS) + end function am_i_running END MODULE MAPL_ExtDataGridComp2G From 6686e0cb3714d7d144cfe99ec87867d437492a48 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 1 Jul 2022 17:09:05 -0400 Subject: [PATCH 216/300] Update CI Baselibs and BCs --- .circleci/config.yml | 6 ++++-- CHANGELOG.md | 5 ++++- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 49a2d2c37434..b1f401a7bdee 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -1,7 +1,8 @@ version: 2.1 -# Anchor to prevent forgetting to update a version -baselibs_version: &baselibs_version v6.3.1 +# Anchors to prevent forgetting to update a version +baselibs_version: &baselibs_version v7.5.0 +bcs_version: &bcs_version v10.22.3 orbs: ci: geos-esm/circleci-tools@1 @@ -124,3 +125,4 @@ workflows: - build-GEOSgcm-on-<< matrix.compiler >> repo: GEOSgcm baselibs_version: *baselibs_version + bcs_version: *bcs_version diff --git a/CHANGELOG.md b/CHANGELOG.md index 26b2d2941c7a..94b22beb0c5d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,10 +10,13 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed ### Added + - Check return codes for YAML files when parsing in ExtData2G ### Changed -- Updated the ESMA_env version to v4.2.0 + +- Updated the ESMA_env version to v4.2.0 (Baselibs 7.5.0) +- Update the CI for Baselibs 7.5.0, BCs version 10.22.3 ### Removed From a112e5fe7a40ec0703cafeb444eb0d99fdcd8924 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 1 Jul 2022 17:16:09 -0400 Subject: [PATCH 217/300] Update github ci --- .github/workflows/workflow.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 1ce85fe7eaa1..393549ea6c24 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -17,7 +17,7 @@ jobs: name: Build and Test MAPL runs-on: ubuntu-latest container: - image: gmao/ubuntu20-geos-env-mkl:v6.3.1-openmpi_4.1.2-gcc_11.2.0 + image: gmao/ubuntu20-geos-env-mkl:v7.5.0-openmpi_4.1.2-gcc_11.2.0 # Per https://github.com/actions/virtual-environments/issues/1445#issuecomment-713861495 # It seems like we might not need secrets on GitHub Actions which is good for forked # pull requests @@ -74,7 +74,7 @@ jobs: name: Build and Test MAPL Intel runs-on: ubuntu-latest container: - image: gmao/ubuntu20-geos-env:v6.3.1-intelmpi_2021.3.0-intel_2021.3.0 + image: gmao/ubuntu20-geos-env:v7.5.0-intelmpi_2021.3.0-intel_2021.3.0 # Per https://github.com/actions/virtual-environments/issues/1445#issuecomment-713861495 # It seems like we might not need secrets on GitHub Actions which is good for forked # pull requests From bffea04159eb71f9a74708f0c3f065c3244c129f Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 5 Jul 2022 10:42:30 -0400 Subject: [PATCH 218/300] Add required versions to yafyaml and pflogger find_package --- CHANGELOG.md | 5 ++++- CMakeLists.txt | 14 +++++++++++--- 2 files changed, 15 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 94b22beb0c5d..cadd84e5e757 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,7 +15,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed -- Updated the ESMA_env version to v4.2.0 (Baselibs 7.5.0) +- Updated the ESMA_env version to v4.2.0 (Baselibs 7.5.0 → GFE v1.4.0) + - With this update, MAPL now requires these versions of GFE libraries + - yaFyaml v1.0.4 (if building with ExtData2G support) + - pFlogger v1.9.1 (if building with pFlogger support) - Update the CI for Baselibs 7.5.0, BCs version 10.22.3 ### Removed diff --git a/CMakeLists.txt b/CMakeLists.txt index e6e2bfab0487..9fe6aadeda4e 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -75,7 +75,7 @@ if(NOT TARGET GFTL::gftl) find_package(GFTL 1.5.1 REQUIRED) else() if (GFTL_VERSION VERSION_LESS 1.5.1) - message(FATAL_ERROR "GFTL must be at least 1.5.1 - check baselibs version.") + message(FATAL_ERROR "GFTL must be at least 1.5.1") endif () endif() if(NOT TARGET GFTL_SHARED::gftl-shared) @@ -89,7 +89,11 @@ option(USE_EXTDATA2G "Use ExtData2G" ON) if(USE_EXTDATA2G) set (EXTDATA2G_TARGET "MAPL.ExtData2G" CACHE STRING "ExtData2G Target") if(NOT TARGET YAFYAML::yafyaml) - find_package(YAFYAML REQUIRED) + find_package(YAFYAML 1.0.4 REQUIRED) + else() + if (YAFYAML_VERSION VERSION_LESS 1.0.4) + message(FATAL_ERROR "yaFyaml must be at least 1.0.4") + endif () endif() message (STATUS "Building with ExtData2G") else() @@ -99,7 +103,11 @@ endif() option(BUILD_WITH_PFLOGGER "Build MAPL with pFlogger library support" ON) if (BUILD_WITH_PFLOGGER) if(NOT TARGET PFLOGGER::pflogger) - find_package(PFLOGGER REQUIRED) + find_package(PFLOGGER 1.9.1 REQUIRED) + else() + if (PFLOGGER_VERSION VERSION_LESS 1.9.1) + message(FATAL_ERROR "pFlogger must be at least 1.9.1") + endif () endif() endif() From e36e9fd8bc58929f75dbc8d127c33090d03896ec Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 6 Jul 2022 08:32:14 -0400 Subject: [PATCH 219/300] Update CHANGELOG and CMakeLists for 2.23.0 Release --- CHANGELOG.md | 16 +++++++++++----- CMakeLists.txt | 2 +- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index cadd84e5e757..9b5b7b1d0592 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,20 +11,26 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +### Changed + +### Removed + +### Deprecated + +## [2.23.0] - 2022-07-06 + +### Added + - Check return codes for YAML files when parsing in ExtData2G ### Changed - Updated the ESMA_env version to v4.2.0 (Baselibs 7.5.0 → GFE v1.4.0) - - With this update, MAPL now requires these versions of GFE libraries + - With this update, MAPL now **requires** these versions of GFE libraries - yaFyaml v1.0.4 (if building with ExtData2G support) - pFlogger v1.9.1 (if building with pFlogger support) - Update the CI for Baselibs 7.5.0, BCs version 10.22.3 -### Removed - -### Deprecated - ## [2.22.0] - 2022-06-24 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index 9fe6aadeda4e..76ba1b9fa2f7 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.22.0 + VERSION 2.23.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the default build type to release From 0a757711f40c81b0056c328b25d0502344d9fca8 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 7 Jul 2022 12:29:08 -0400 Subject: [PATCH 220/300] Fix GitHub Actions issue --- .github/workflows/workflow.yml | 4 ++-- CHANGELOG.md | 2 ++ 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 393549ea6c24..e6285a3183cf 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -34,7 +34,7 @@ jobs: with: access_token: ${{ github.token }} - name: Checkout - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: fetch-depth: 1 - name: Versions etc. @@ -87,7 +87,7 @@ jobs: with: access_token: ${{ github.token }} - name: Checkout - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: fetch-depth: 1 - name: Versions etc. diff --git a/CHANGELOG.md b/CHANGELOG.md index 9b5b7b1d0592..a7baa4b7706a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Moved to `checkout@v3` action due to git safe directory issue + ### Removed ### Deprecated From 7fa5c3f7150fb8a71fcab6d0126fcc900e58614a Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 7 Jul 2022 12:31:56 -0400 Subject: [PATCH 221/300] Make tests more recognizable --- .github/workflows/workflow.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index e6285a3183cf..57c824d28195 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -14,7 +14,7 @@ on: jobs: build_test_mapl: - name: Build and Test MAPL + name: Build and Test MAPL GNU runs-on: ubuntu-latest container: image: gmao/ubuntu20-geos-env-mkl:v7.5.0-openmpi_4.1.2-gcc_11.2.0 From 389a2cdb36e76a2207a5109e68265663cb2bf461 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 7 Jul 2022 12:36:17 -0400 Subject: [PATCH 222/300] Add set-safe-directory --- .github/workflows/workflow.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 57c824d28195..b62873ff319f 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -37,6 +37,7 @@ jobs: uses: actions/checkout@v3 with: fetch-depth: 1 + set-safe-directory: $GITHUB_WORKSPACE - name: Versions etc. run: | gfortran --version From 77768660dbfbf8238163be62a2af75e2c072c79c Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 7 Jul 2022 12:38:40 -0400 Subject: [PATCH 223/300] Undo last. Didn't work --- .github/workflows/workflow.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index b62873ff319f..57c824d28195 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -37,7 +37,6 @@ jobs: uses: actions/checkout@v3 with: fetch-depth: 1 - set-safe-directory: $GITHUB_WORKSPACE - name: Versions etc. run: | gfortran --version From 309cd8f93df10d2f1bbc4ed82870dd9ec3713cd3 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 7 Jul 2022 12:40:34 -0400 Subject: [PATCH 224/300] Brute force it --- .github/workflows/workflow.yml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 57c824d28195..5314ec33dbd1 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -37,6 +37,9 @@ jobs: uses: actions/checkout@v3 with: fetch-depth: 1 + - name: Set all directories as git safe + run: | + git config --global --add safe.directory '*' - name: Versions etc. run: | gfortran --version @@ -90,6 +93,9 @@ jobs: uses: actions/checkout@v3 with: fetch-depth: 1 + - name: Set all directories as git safe + run: | + git config --global --add safe.directory '*' - name: Versions etc. run: | ifort --version From 0b370ac470bee7a96bb3c9471d92dfd22f61cc6e Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 13 Jul 2022 15:08:41 -0400 Subject: [PATCH 225/300] fixes issue exposed in ldas pr #568 --- gridcomps/History/MAPL_HistoryGridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 08868fff6ad4..8fd8ebc2b9d4 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -3596,7 +3596,7 @@ subroutine Run ( gc, import, export, clock, rc ) list(n)%currentFile = filename(n) list(n)%unit = -1 else - list(n)%unit = GETFILE( trim(filename(n)),all_pes=.true.) + list(n)%unit = GETFILE( trim(filename(n)),all_pes=.false.) end if end if end if From 0117b805b0a34d095cc32d5c6d6bcb9a8cf76452 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 13 Jul 2022 15:26:17 -0400 Subject: [PATCH 226/300] Add tutorials to MAPL CI --- .circleci/config.yml | 15 +++++++++++++++ CHANGELOG.md | 2 ++ 2 files changed, 17 insertions(+) diff --git a/.circleci/config.yml b/.circleci/config.yml index b1f401a7bdee..13efbeeb5c59 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -24,6 +24,7 @@ workflows: mepodevelop: false run_unit_tests: true ctest_options: "-LE 'PERFORMANCE|EXTDATA1G_BIG_TESTS|EXTDATA2G_BIG_TESTS' --output-on-failure" + persist_workspace: true # Needed for MAPL tutorials # Builds MAPL in a "default" way - GNU # @@ -48,6 +49,7 @@ workflows: mepodevelop: false run_unit_tests: true ctest_options: "-E bundleio -LE 'PERFORMANCE|EXTDATA1G_BIG_TESTS|EXTDATA2G_BIG_TESTS' --output-on-failure" + persist_workspace: true # Needed for MAPL tutorials # Builds MAPL like UFS does (no FLAP and pFlogger, static) - ci/build: @@ -126,3 +128,16 @@ workflows: repo: GEOSgcm baselibs_version: *baselibs_version bcs_version: *bcs_version + + # Run MAPL Tutorials + - ci/run_mapl_tutorial: + name: run-<< matrix.tutorial_name >>-Tutorial-with-<< matrix.compiler >> + context: + - docker-hub-creds + matrix: + parameters: + compiler: [gfortran, ifort] + tutorial_name: [hello_world] + requires: + - build-and-test-MAPL-on-<< matrix.compiler >> + baselibs_version: *baselibs_version diff --git a/CHANGELOG.md b/CHANGELOG.md index 0755184c4f7e..23c2d89d668f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,11 +10,13 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed ### Added + - Add tutorials ### Changed - Moved to `checkout@v3` action due to git safe directory issue +- Added tutorials to CI ### Removed From ade81dadd6b99e3ec54af3856afaa803e7f50497 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 13 Jul 2022 15:40:02 -0400 Subject: [PATCH 227/300] Enable all tutorials --- .circleci/config.yml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 13efbeeb5c59..68383c174a69 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -137,7 +137,12 @@ workflows: matrix: parameters: compiler: [gfortran, ifort] - tutorial_name: [hello_world] + tutorial_name: + - hello_world + - parent_no_children + - parent_one_child_import_via_extdata + - parent_one_child_no_imports + - parent_two_siblings_connect_import_export requires: - build-and-test-MAPL-on-<< matrix.compiler >> baselibs_version: *baselibs_version From fb7fc0b064ccbc1953a167b09ae7d83a1cf84571 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Thu, 14 Jul 2022 13:10:03 -0400 Subject: [PATCH 228/300] ldas still hanging, try this instead --- gridcomps/History/MAPL_HistoryGridComp.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 5eb408709f7a..80d9d4f5c14c 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -3605,17 +3605,17 @@ subroutine Run ( gc, import, export, clock, rc ) list(n)%currentFile = filename(n) else if( list(n)%unit.eq.0 ) then - inquire (file=trim(filename(n)),exist=file_exists) - if (file_exists) then - _FAIL(trim(filename(n))//" being created for History output already exists") - end if if (list(n)%format == 'CFIO') then + inquire (file=trim(filename(n)),exist=file_exists) + if (file_exists) then + _FAIL(trim(filename(n))//" being created for History output already exists") + end if call list(n)%mGriddedIO%modifyTime(oClients=o_Clients,rc=status) _VERIFY(status) list(n)%currentFile = filename(n) list(n)%unit = -1 else - list(n)%unit = GETFILE( trim(filename(n)),all_pes=.false.) + list(n)%unit = GETFILE( trim(filename(n)),all_pes=.true.) end if end if end if From 0f87baa0db14357a6eceda6fa84cc55944364fdd Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 15 Jul 2022 07:48:03 -0400 Subject: [PATCH 229/300] Update CHANGELOG and CMakeLists for 2.23.1 Release --- CHANGELOG.md | 7 +++++++ CMakeLists.txt | 2 +- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9b5b7b1d0592..71ea3aeb9c24 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,13 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Deprecated +## [2.23.1] - 2022-07-15 + +### Fixed + +- Fixed the History file existence detection to only run for netCDF output. For still unknown reasons, this detection has an issue + with binary output (see https://github.com/GEOS-ESM/GEOSldas/pull/568) + ## [2.23.0] - 2022-07-06 ### Added diff --git a/CMakeLists.txt b/CMakeLists.txt index 76ba1b9fa2f7..67f8373416fb 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.23.0 + VERSION 2.23.1 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the default build type to release From 60fda9f52a2b148a3fa6d93d25ae30611bee2742 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 15 Jul 2022 08:09:24 -0400 Subject: [PATCH 230/300] Fix GitHub CI --- .github/workflows/workflow.yml | 12 +++++++++--- CHANGELOG.md | 1 + 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 393549ea6c24..5314ec33dbd1 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -14,7 +14,7 @@ on: jobs: build_test_mapl: - name: Build and Test MAPL + name: Build and Test MAPL GNU runs-on: ubuntu-latest container: image: gmao/ubuntu20-geos-env-mkl:v7.5.0-openmpi_4.1.2-gcc_11.2.0 @@ -34,9 +34,12 @@ jobs: with: access_token: ${{ github.token }} - name: Checkout - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: fetch-depth: 1 + - name: Set all directories as git safe + run: | + git config --global --add safe.directory '*' - name: Versions etc. run: | gfortran --version @@ -87,9 +90,12 @@ jobs: with: access_token: ${{ github.token }} - name: Checkout - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: fetch-depth: 1 + - name: Set all directories as git safe + run: | + git config --global --add safe.directory '*' - name: Versions etc. run: | ifort --version diff --git a/CHANGELOG.md b/CHANGELOG.md index 71ea3aeb9c24..f58f9016bf5b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -23,6 +23,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Fixed the History file existence detection to only run for netCDF output. For still unknown reasons, this detection has an issue with binary output (see https://github.com/GEOS-ESM/GEOSldas/pull/568) +- Fix GitHub Actions ## [2.23.0] - 2022-07-06 From 168e3515146db9379d859dc39783fb85658341eb Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 22 Jul 2022 15:37:08 -0400 Subject: [PATCH 231/300] fix issues 1607 1285 1376 626 --- CHANGELOG.md | 3 ++ base/MAPL_VerticalMethods.F90 | 2 +- gridcomps/History/MAPL_HistoryGridComp.F90 | 26 ++++++++++++++++-- griddedio/GriddedIO.F90 | 32 ++++++++++++++++++++++ 4 files changed, 59 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 4d2eb2e5c5c4..87268faa25fa 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added - Add tutorials +- Check for duplicate entries in the History.rc file +- Check that a user provided chunking in the History.rc is compatible with the output grid +- If a user request CFIOasync in the History.rc print warning and set to CFIO ### Changed diff --git a/base/MAPL_VerticalMethods.F90 b/base/MAPL_VerticalMethods.F90 index cba4dfb80418..6d5f9a3c49db 100644 --- a/base/MAPL_VerticalMethods.F90 +++ b/base/MAPL_VerticalMethods.F90 @@ -36,7 +36,7 @@ module MAPL_VerticalDataMod real, allocatable :: surface_level(:,:) real, allocatable :: ple3d(:,:,:) real, allocatable :: pl3d(:,:,:) - integer :: lm + integer :: lm = 0 integer :: regrid_type type(ESMF_Field) :: interp_var logical :: ascending diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 80d9d4f5c14c..81c261846c10 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -941,7 +941,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) if (old_fields_style) then field_set_name = trim(string) // 'fields' allocate(field_set) - call parse_fields(cfg, trim(field_set_name), field_set, list(n)%items, rc=status) + call parse_fields(cfg, trim(field_set_name), field_set, list(n)%items, _RC) end if list(n)%field_set => field_set @@ -2479,6 +2479,10 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) do n=1,nlist if (list(n)%disabled) cycle + if (list(n)%format == 'CFIOasync') then + list(n)%format = 'CFIO' + if (mapl_am_i_root()) write(*,*)'Chose CFIOasync setting to CFIO, update your History.rc file' + end if if (list(n)%format == 'CFIO') then call Get_Tdim (list(n), clock, tm) if (associated(list(n)%levels) .and. list(n)%vvars(1) /= "") then @@ -3178,8 +3182,8 @@ subroutine parse_fields(cfg, label, field_set, items, rc) type(GriddedIOitemVector), intent(inout), optional :: items integer, optional, intent(out) :: rc logical :: table_end - logical :: vectorDone - integer :: m + logical :: vectorDone,match_short_name,match_alias,match_component + integer :: m,i,j character(ESMF_MAXSTR), pointer:: fields (:,:) type(GriddedIOitem) :: item @@ -3323,6 +3327,22 @@ subroutine parse_fields(cfg, label, field_set, items, rc) if(present(items)) call items%push_back(item) enddo field_set%nfields = m +! check for duplicates + do i=1,field_set%nfields-1 + do j=i+1,field_set%nfields + match_short_name = trim(field_set%fields(1,i)) == trim(field_set%fields(1,j)) + match_alias = trim(field_set%fields(3,i)) == trim(field_set%fields(3,j)) + match_component = trim(field_set%fields(2,i)) == trim(field_set%fields(2,j)) + if (match_short_name) then + if (match_component) then + _FAIL("Caught collection with duplicate short name: "//trim(field_set%fields(1,i))//" and duplicate component") + end if + end if + if (match_alias) then + _FAIL("Caught collection with duplicate alias: "//trim(field_set%fields(3,i))) + end if + enddo + enddo end subroutine parse_fields diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index f41bf03d2879..f471f88b372b 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -65,6 +65,7 @@ module MAPL_GriddedIOMod procedure :: regridVector procedure :: set_param procedure :: set_default_chunking + procedure :: check_chunking procedure :: alphabatize_variables procedure :: request_data_from_file procedure :: process_data_from_file @@ -164,6 +165,8 @@ subroutine CreateFileMetaData(this,items,bundle,timeInfo,vdata,ogrid,global_attr if (.not.allocated(this%chunking)) then call this%set_default_chunking(rc=status) _VERIFY(status) + else + call this%check_chunking(this%vdata%lm,_RC) end if order = this%metadata%get_order(rc=status) @@ -254,6 +257,35 @@ subroutine set_default_chunking(this,rc) end subroutine set_default_chunking + subroutine check_chunking(this,lev_size,rc) + class (MAPL_GriddedIO), intent(inout) :: this + integer, intent(in) :: lev_size + integer, optional, intent(out) :: rc + + integer :: global_dim(3) + integer :: status + + call MAPL_GridGet(this%output_grid,globalCellCountPerDim=global_dim,rc=status) + _VERIFY(status) + if (global_dim(1)*6 == global_dim(2)) then + _ASSERT(this%chunking(1) <= global_dim(1), "Bad chunk size") + _ASSERT(this%chunking(2) <= global_dim(1), "Bad chunk size") + _ASSERT(this%chunking(3) <= 6, "Bad chunk size") + if (lev_size > 0) then + _ASSERT(this%chunking(4) <= lev_size, "Bad chunk size") + end if + _ASSERT(this%chunking(5) == 1, "Time must have chunk size of 1") + else + _ASSERT(this%chunking(1) <= global_dim(1), "Bad chunk size") + _ASSERT(this%chunking(2) <= global_dim(2), "Bad chunk size") + if (lev_size > 0) then + _ASSERT(this%chunking(3) <= lev_size, "Bad chunk size") + end if + _ASSERT(this%chunking(4) == 1, "Time must have chunk size of 1") + endif + _RETURN(ESMF_SUCCESS) + + end subroutine check_chunking subroutine CreateVariable(this,itemName,rc) class (MAPL_GriddedIO), intent(inout) :: this From dc2c60814c9be1697e964e4f21f39059ee3b2883 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 25 Jul 2022 11:17:55 -0400 Subject: [PATCH 232/300] updates for clarity --- gridcomps/History/MAPL_HistoryGridComp.F90 | 4 ++-- griddedio/GriddedIO.F90 | 26 ++++++++++++++++------ 2 files changed, 21 insertions(+), 9 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 81c261846c10..557918becab5 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -3330,9 +3330,9 @@ subroutine parse_fields(cfg, label, field_set, items, rc) ! check for duplicates do i=1,field_set%nfields-1 do j=i+1,field_set%nfields - match_short_name = trim(field_set%fields(1,i)) == trim(field_set%fields(1,j)) + match_short_name = field_set%fields(1,i) == field_set%fields(1,j) match_alias = trim(field_set%fields(3,i)) == trim(field_set%fields(3,j)) - match_component = trim(field_set%fields(2,i)) == trim(field_set%fields(2,j)) + match_component = field_set%fields(2,i) == field_set%fields(2,j) if (match_short_name) then if (match_component) then _FAIL("Caught collection with duplicate short name: "//trim(field_set%fields(1,i))//" and duplicate component") diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index f471f88b372b..4e4deef7c8bc 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -264,22 +264,34 @@ subroutine check_chunking(this,lev_size,rc) integer :: global_dim(3) integer :: status + character(len=5) :: c1,c2 call MAPL_GridGet(this%output_grid,globalCellCountPerDim=global_dim,rc=status) _VERIFY(status) if (global_dim(1)*6 == global_dim(2)) then - _ASSERT(this%chunking(1) <= global_dim(1), "Bad chunk size") - _ASSERT(this%chunking(2) <= global_dim(1), "Bad chunk size") - _ASSERT(this%chunking(3) <= 6, "Bad chunk size") + write(c2,'(I5)')global_dim(1) + write(c1,'(I5)')this%chunking(1) + _ASSERT(this%chunking(1) <= global_dim(1), "Chunk for Xdim "//c1//" must be less than or equal to "//c2) + write(c1,'(I5)')this%chunking(2) + _ASSERT(this%chunking(2) <= global_dim(1), "Chunk for Ydim "//c1//" must be less than or equal to "//c2) + _ASSERT(this%chunking(3) <= 6, "Chunksize for face dimension must be 6 or less") if (lev_size > 0) then - _ASSERT(this%chunking(4) <= lev_size, "Bad chunk size") + write(c2,'(I5)')lev_size + write(c1,'(I5)')this%chunking(4) + _ASSERT(this%chunking(4) <= lev_size, "Chunk for level size "//c1//" must be less than or equal to "//c2) end if _ASSERT(this%chunking(5) == 1, "Time must have chunk size of 1") else - _ASSERT(this%chunking(1) <= global_dim(1), "Bad chunk size") - _ASSERT(this%chunking(2) <= global_dim(2), "Bad chunk size") + write(c2,'(I5)')global_dim(1) + write(c1,'(I5)')this%chunking(1) + _ASSERT(this%chunking(1) <= global_dim(1), "Chunk for lon "//c1//" must be less than or equal to "//c2) + write(c2,'(I5)')global_dim(2) + write(c1,'(I5)')this%chunking(2) + _ASSERT(this%chunking(2) <= global_dim(2), "Chunk for lat "//c1//" must be less than or equal to "//c2) if (lev_size > 0) then - _ASSERT(this%chunking(3) <= lev_size, "Bad chunk size") + write(c2,'(I5)')lev_size + write(c1,'(I5)')this%chunking(3) + _ASSERT(this%chunking(3) <= lev_size, "Chunk for level size "//c1//" must be less than or equal to "//c2) end if _ASSERT(this%chunking(4) == 1, "Time must have chunk size of 1") endif From f983714c8a12a54b7a253b86ab8a839ee9098dae Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 25 Jul 2022 11:25:19 -0400 Subject: [PATCH 233/300] forgot to remove a trim --- gridcomps/History/MAPL_HistoryGridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 557918becab5..12d80b40f63d 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -3331,7 +3331,7 @@ subroutine parse_fields(cfg, label, field_set, items, rc) do i=1,field_set%nfields-1 do j=i+1,field_set%nfields match_short_name = field_set%fields(1,i) == field_set%fields(1,j) - match_alias = trim(field_set%fields(3,i)) == trim(field_set%fields(3,j)) + match_alias = field_set%fields(3,i) == field_set%fields(3,j) match_component = field_set%fields(2,i) == field_set%fields(2,j) if (match_short_name) then if (match_component) then From 4ae44ffad412d7828e7c81909de711bf5ba4b06a Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 26 Jul 2022 16:01:46 -0400 Subject: [PATCH 234/300] just some cleanup of ExtData2G --- CHANGELOG.md | 1 + gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 338 +++++++--------------- 2 files changed, 111 insertions(+), 228 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 87268faa25fa..98ae1868d4ae 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,6 +18,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Replaced depreciated __RC__ macro with _RC and remove unsed code in ExtData2G - Moved to `checkout@v3` action due to git safe directory issue - Added tutorials to CI diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index bdcfeb44b774..0785a3d30895 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -152,16 +152,13 @@ SUBROUTINE SetServices ( GC, RC ) type (MAPL_ExtData_wrap) :: wrap character(len=ESMF_MAXSTR) :: comp_name - character(len=ESMF_MAXSTR) :: Iam integer :: status ! ------------ ! Get my name and set-up traceback handle ! --------------------------------------- - Iam = 'SetServices' - call ESMF_GridCompGet( GC, name=comp_name, __RC__ ) - Iam = trim(comp_name) // '::' // trim(Iam) + call ESMF_GridCompGet( GC, name=comp_name, _RC ) ! Wrap internal state for storing in GC; rename legacyState ! ------------------------------------- @@ -175,9 +172,9 @@ SUBROUTINE SetServices ( GC, RC ) ! Set the Initialize, Run, Finalize entry points ! ---------------------------------------------- - call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_INITIALIZE, Initialize_, __RC__ ) - call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run_, __RC__ ) - call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_FINALIZE, Finalize_, __RC__ ) + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_INITIALIZE, Initialize_, _RC ) + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run_, _RC ) + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_FINALIZE, Finalize_, _RC ) ! Store internal state in GC ! -------------------------- @@ -226,7 +223,7 @@ SUBROUTINE SetServices ( GC, RC ) _VERIFY(STATUS) ! Generic Set Services ! -------------------- - call MAPL_GenericSetServices ( GC, __RC__ ) + call MAPL_GenericSetServices ( GC, _RC ) ! All done ! -------- @@ -278,7 +275,6 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(ESMF_Config) :: CF_master ! Universal Config character(len=ESMF_MAXSTR) :: comp_name - character(len=ESMF_MAXSTR) :: Iam integer :: Status type(PrimaryExport), pointer :: item @@ -313,14 +309,12 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! Get my name and set-up traceback handle ! --------------------------------------- - Iam = 'Initialize_' - call ESMF_GridCompGet( GC, name=comp_name, config=CF_master, vm=vm, __RC__ ) - Iam = trim(comp_name) // '::' // trim(Iam) - call MAPL_GetLogger(gc, extdata_lgr, __RC__) + call ESMF_GridCompGet( GC, name=comp_name, config=CF_master, vm=vm, _RC ) + call MAPL_GetLogger(gc, extdata_lgr, _RC) ! Extract relevant runtime information ! ------------------------------------ - call extract_ ( GC, self, CF_master, __RC__) + call extract_ ( GC, self, CF_master, _RC) self%CF = CF_master ! Start Some Timers @@ -333,7 +327,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call ESMF_ConfigGetAttribute(cf_master,new_rc_file,label="EXTDATA_YAML_FILE:",default="extdata.yaml",_RC) self%active = am_i_running(new_rc_file,_RC) - call ESMF_ClockGet(CLOCK, currTIME=time, __RC__) + call ESMF_ClockGet(CLOCK, currTIME=time, _RC) ! Get information from export state !---------------------------------- call ESMF_StateGet(EXPORT, ITEMCOUNT=ItemCount, RC=STATUS) @@ -350,13 +344,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) _RETURN(ESMF_SUCCESS) end if - config_yaml = ExtDataOldTypesCreator(new_rc_file,time,__RC__) -! Greetings -! --------- - if (MAPL_am_I_root()) then - print *, TRIM(Iam)//': ACTIVE' - print * - end if + config_yaml = ExtDataOldTypesCreator(new_rc_file,time,_RC) allocate(ITEMNAMES(ITEMCOUNT), STAT=STATUS) _VERIFY(STATUS) @@ -370,14 +358,14 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) ! -------- ! Initialize MAPL Generic ! ----------------------- - call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, clock, __RC__ ) + call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, clock, _RC ) call extdata_lgr%info("Using ExtData2G, note this is still in BETA stage") ! --------------------------- ! Parse ExtData Resource File ! --------------------------- - self%ExtDataState = ESMF_StateCreate(Name="ExtDataNameSpace",__RC__) + self%ExtDataState = ESMF_StateCreate(Name="ExtDataNameSpace",_RC) num_primary=0 num_derived=0 primaryitemcount=0 @@ -408,7 +396,7 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) if (state_item_type == ESMF_STATEITEM_NOTFOUND) then call ESMF_StateGet(export,derived_var_name,existing_field,_RC) new_field = MAPL_FieldCreate(existing_field,primary_var_name,doCOpy=.true.,_RC) - call MAPL_StateAdd(self%ExtDataState,new_field,__RC__) + call MAPL_StateAdd(self%ExtDataState,new_field,_RC) end if call siter%next() enddo @@ -440,19 +428,19 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) do j=1,num_rules num_primary=num_primary+1 write(sidx,'(I1)')j - call config_yaml%fillin_primary(current_base_name//"+"//sidx,current_base_name,self%primary%item(num_primary),time,clock,__RC__) + call config_yaml%fillin_primary(current_base_name//"+"//sidx,current_base_name,self%primary%item(num_primary),time,clock,_RC) allocate(self%primary%item(num_primary)%start_end_time(2)) self%primary%item(num_primary)%start_end_time(1)=time_ranges(j) self%primary%item(num_primary)%start_end_time(2)=time_ranges(j+1) enddo else num_primary=num_primary+1 - call config_yaml%fillin_primary(current_base_name,current_base_name,self%primary%item(num_primary),time,clock,__RC__) + call config_yaml%fillin_primary(current_base_name,current_base_name,self%primary%item(num_primary),time,clock,_RC) end if call ESMF_StateGet(Export,current_base_name,state_item_type,_RC) if (state_item_type /= ESMF_STATEITEM_NOTFOUND) then - call ESMF_StateGet(Export,current_base_name,field,__RC__) - call MAPL_StateAdd(self%ExtDataState,field,__RC__) + call ESMF_StateGet(Export,current_base_name,field,_RC) + call MAPL_StateAdd(self%ExtDataState,field,_RC) item_type = config_yaml%get_item_type(current_base_name) if (item_type == Primary_Type_Vector_comp1) then call ESMF_StateGet(Export,self%primary%item(num_primary)%vcomp2,field,_RC) @@ -463,9 +451,9 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) do i=1,self%derived%import_names%size() current_base_name => self%derived%import_names%at(i) num_derived=num_derived+1 - call config_yaml%fillin_derived(current_base_name,self%derived%item(num_derived),time,clock,__RC__) - call ESMF_StateGet(Export,current_base_name,field,__RC__) - call MAPL_StateAdd(self%ExtDataState,field,__RC__) + call config_yaml%fillin_derived(current_base_name,self%derived%item(num_derived),time,clock,_RC) + call ESMF_StateGet(Export,current_base_name,field,_RC) + call MAPL_StateAdd(self%ExtDataState,field,_RC) enddo PrimaryLoop: do i=1,self%primary%import_names%size() @@ -569,7 +557,6 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(ESMF_Config) :: CF ! Universal Config character(len=ESMF_MAXSTR) :: comp_name - character(len=ESMF_MAXSTR) :: Iam integer :: status type(PrimaryExport), pointer :: item @@ -596,19 +583,13 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) _UNUSED_DUMMY(IMPORT) _UNUSED_DUMMY(EXPORT) -! Declare pointers to IMPORT/EXPORT/INTERNAL states -! ------------------------------------------------- -! #include "MAPL_ExtData_DeclarePointer___.h" - ! Get my name and set-up traceback handle ! --------------------------------------- - Iam = 'Run_' - call ESMF_GridCompGet( GC, name=comp_name, config=CF_master, __RC__ ) - Iam = trim(comp_name) // '::' // trim(Iam) + call ESMF_GridCompGet( GC, name=comp_name, config=CF_master, _RC ) ! Extract relevant runtime information ! ------------------------------------ - call extract_ ( GC, self, CF, __RC__ ) + call extract_ ( GC, self, CF, _RC ) if (.not. self%active) then _RETURN(ESMF_SUCCESS) @@ -619,7 +600,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOn(MAPLSTATE,"TOTAL") call MAPL_TimerOn(MAPLSTATE,"Run") - call ESMF_ClockGet(CLOCK, currTIME=time0, __RC__) + call ESMF_ClockGet(CLOCK, currTIME=time0, _RC) ! Fill in the internal state with data from the files ! --------------------------------------------------- @@ -640,15 +621,6 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) current_base_name => self%primary%import_names%at(i) idx = self%primary%get_item_index(current_base_name,time0,_RC) item => self%primary%item(idx) - if (.not.item%initialized) then - item%pfioCollection_id = MAPL_DataAddCollection(item%file_template) - if (item%isConst) then - call set_constant_field(item,self%extDataState,_RC) - cycle - end if - call create_bracketing_fields(item,self%ExtDataState,cf_master, _RC) - item%initialized=.true. - end if nitems = self%primary%import_names%size() !call extdata_lgr%debug('ExtData Run_(): READ_LOOP: variable %i0 of %i0~: %a', i, nitems, trim(current_base_name)) @@ -662,16 +634,16 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call MAPL_TimerOn(MAPLSTATE,"--CheckUpd") - call item%update_freq%check_update(doUpdate(i),time,time0,.not.hasRun,__RC__) + call item%update_freq%check_update(doUpdate(i),time,time0,.not.hasRun,_RC) call MAPL_TimerOff(MAPLSTATE,"--CheckUpd") DO_UPDATE: if (doUpdate(i)) then !call extdata_lgr%info('Going to update %a with file template: %a ',current_base_name, item%file_template) call item%modelGridFields%comp1%reset() - call item%filestream%get_file_bracket(time,item%source_time, item%modelGridFields%comp1,__RC__) + call item%filestream%get_file_bracket(time,item%source_time, item%modelGridFields%comp1,_RC) if (item%vartype == MAPL_VectorField) then - call item%filestream%get_file_bracket(time,item%source_time, item%modelGridFields%comp2,__RC__) + call item%filestream%get_file_bracket(time,item%source_time, item%modelGridFields%comp2,_RC) end if call IOBundle_Add_Entry(IOBundles,item,idx) useTime(i)=time @@ -753,7 +725,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) call extdata_lgr%debug('ExtData Run_: INTERP_LOOP: interpolating between bracket times, variable: %a, file: %a', & & trim(current_base_name), trim(item%file_template)) - call MAPL_ExtDataInterpField(item,self%ExtDataState,useTime(i),__RC__) + call MAPL_ExtDataInterpField(item,self%ExtDataState,useTime(i),_RC) endif @@ -770,7 +742,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) derivedItem => self%derived%item(i) - call derivedItem%update_freq%check_update(doUpdate_,time,time0,.not.hasRun,__RC__) + call derivedItem%update_freq%check_update(doUpdate_,time,time0,.not.hasRun,_RC) if (doUpdate_) then @@ -837,23 +809,20 @@ SUBROUTINE Finalize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(ESMF_Config) :: CF ! Universal Config character(len=ESMF_MAXSTR) :: comp_name - character(len=ESMF_MAXSTR) :: Iam integer :: status ! Get my name and set-up traceback handle ! --------------------------------------- - Iam = 'Finalize_' - call ESMF_GridCompGet( GC, name=comp_name, __RC__ ) - Iam = trim(comp_name) // trim(Iam) + call ESMF_GridCompGet( GC, name=comp_name, _RC ) ! Finalize MAPL Generic ! --------------------- - call MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, __RC__ ) + call MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, _RC ) ! Extract relevant runtime information ! ------------------------------------ - call extract_ ( GC, self, CF, __RC__) + call extract_ ( GC, self, CF, _RC) ! Free the memory used to hold the primary export items ! ----------------------------------------------------- @@ -882,16 +851,13 @@ subroutine extract_ ( GC, self, CF, rc) ! --- character(len=ESMF_MAXSTR) :: comp_name - character(len=ESMF_MAXSTR) :: Iam integer :: status type(MAPL_ExtData_Wrap) :: wrap ! Get my name and set-up traceback handle ! --------------------------------------- - Iam = 'extract_' - call ESMF_GridCompGet( GC, NAME=comp_name, __RC__ ) - Iam = trim(COMP_NAME) // '::' // trim(Iam) + call ESMF_GridCompGet( GC, NAME=comp_name, _RC ) If (present(rc)) rc=ESMF_SUCCESS @@ -903,7 +869,7 @@ subroutine extract_ ( GC, self, CF, rc) ! Get the configuration ! --------------------- - call ESMF_GridCompGet ( GC, config=CF, __RC__ ) + call ESMF_GridCompGet ( GC, config=CF, _RC ) _RETURN(ESMF_SUCCESS) @@ -939,81 +905,6 @@ logical function DerivedExportIsConstant_(item) end function DerivedExportIsConstant_ - ! ............................................................................ - - type (ESMF_Time) function timestamp_(time, template, rc) - type(ESMF_Time), intent(inout) :: time - character(len=ESMF_MAXSTR), intent(in) :: template - integer, optional, intent(inout) :: rc - - ! locals - integer, parameter :: DATETIME_MAXSTR_ = 32 - integer :: yy, mm, dd, hs, ms, ss - character(len=DATETIME_MAXSTR_) :: buff, buff_date, buff_time - character(len=DATETIME_MAXSTR_) :: str_yy, str_mm, str_dd - character(len=DATETIME_MAXSTR_) :: str_hs, str_ms, str_ss - - integer :: i, il, ir - integer :: status - - ! test the length of the timestamp template - _ASSERT(len_trim(template) < DATETIME_MAXSTR_,'Timestamp template is greater than Maximum allowed len') - - buff = trim(template) - buff = ESMF_UtilStringLowerCase(buff, __RC__) - - ! test if the template is empty and return the current time as result - if (buff == '-' .or. buff == '--' .or. buff == '---' .or. & - buff == 'na' .or. buff == 'none' .or. buff == 'n/a') then - - timestamp_ = time - else - ! split the time stamp template into a date and time strings - i = scan(buff, 't') - If (.not.(i > 3)) Then - _FAIL('ERROR: Time stamp ' // trim(template) // ' uses the fixed format, and must therefore contain a T') - End If - - buff_date = buff(1:i-1) - buff_time = buff(i+1:) - - ! parse the date string - il = scan(buff_date, '-', back=.false.) - ir = scan(buff_date, '-', back=.true. ) - str_yy = trim(buff_date(1:il-1)) - str_mm = trim(buff_date(il+1:ir-1)) - str_dd = trim(buff_date(ir+1:)) - - ! parse the time string - il = scan(buff_time, ':', back=.false.) - ir = scan(buff_time, ':', back=.true. ) - str_hs = trim(buff_time(1:il-1)) - str_ms = trim(buff_time(il+1:ir-1)) - str_ss = trim(buff_time(ir+1:)) - - ! remove the trailing 'Z' from the seconds string - i = scan(str_ss, 'z') - if (i > 0) then - str_ss = trim(str_ss(1:i-1)) - end if - - ! apply the timestamp template - call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=hs, m=ms, s=ss, __RC__) - - i = scan(str_yy, '%'); if (i == 0) read (str_yy, '(I4)') yy - i = scan(str_mm, '%'); if (i == 0) read (str_mm, '(I2)') mm - i = scan(str_dd, '%'); if (i == 0) read (str_dd, '(I2)') dd - i = scan(str_hs, '%'); if (i == 0) read (str_hs, '(I2)') hs - i = scan(str_ms, '%'); if (i == 0) read (str_ms, '(I2)') ms - i = scan(str_ss, '%'); if (i == 0) read (str_ss, '(I2)') ss - - call ESMF_TimeSet(timestamp_, yy=yy, mm=mm, dd=dd, h=hs, m=ms, s=ss, __RC__) - end if - - _RETURN(ESMF_SUCCESS) - - end function timestamp_ - subroutine GetLevs(item, rc) type(PrimaryExport) , intent(inout) :: item @@ -1044,7 +935,7 @@ subroutine GetLevs(item, rc) levName = item%file_metadata%get_level_name(rc=status) _VERIFY(status) if (trim(levName) /='') then - call item%file_metadata%get_coordinate_info(levName,coordSize=item%lm,coordUnits=tLevUnits,coords=levFile,__RC__) + call item%file_metadata%get_coordinate_info(levName,coordSize=item%lm,coordUnits=tLevUnits,coords=levFile,_RC) levUnits=MAPL_TrimString(tlevUnits) ! check if pressure item%levUnit = ESMF_UtilStringLowerCase(levUnits) @@ -1054,7 +945,7 @@ subroutine GetLevs(item, rc) if (item%havePressure) then if (levFile(1)>levFile(size(levFile))) item%fileVDir="up" else - positive => item%file_metadata%get_variable_attribute(levName,'positive',__RC__) + positive => item%file_metadata%get_variable_attribute(levName,'positive',_RC) if (associated(positive)) then if (MAPL_TrimString(positive)=='up') item%fileVDir="up" end if @@ -1093,11 +984,11 @@ subroutine MAPL_ExtDataInterpField(item,state,time,rc) integer :: status type(ESMF_Field) :: field - call ESMF_StateGet(state,item%vcomp1,field,__RC__) - call item%modelGridFields%comp1%interpolate_to_time(field,time,__RC__) + call ESMF_StateGet(state,item%vcomp1,field,_RC) + call item%modelGridFields%comp1%interpolate_to_time(field,time,_RC) if (item%vartype == MAPL_VectorField) then - call ESMF_StateGet(state,item%vcomp2,field,__RC__) - call item%modelGridFields%comp2%interpolate_to_time(field,time,__RC__) + call ESMF_StateGet(state,item%vcomp2,field,_RC) + call item%modelGridFields%comp2%interpolate_to_time(field,time,_RC) end if _RETURN(ESMF_SUCCESS) end subroutine MAPL_ExtDataInterpField @@ -1189,7 +1080,6 @@ function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) integer, optional, intent(out) :: rc integer :: status - character(len=ESMF_MAXSTR) :: Iam character(len=ESMF_MAXSTR) :: gname, comp_name integer :: counts(3) @@ -1201,12 +1091,10 @@ function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) logical :: isPresent type(ESMF_Info) :: infoh - IAM = "MAPL_ExtDataGridChangeLev" - - call MAPL_GridGet(grid,globalCellCountPerDim=counts,__RC__) - call ESMF_GridGet(grid,name=gName,__RC__) - call ESMF_ConfigGetAttribute(CF, value = NX, Label="NX:", __RC__) - call ESMF_ConfigGetAttribute(CF, value = NY, Label="NY:", __RC__) + call MAPL_GridGet(grid,globalCellCountPerDim=counts,_RC) + call ESMF_GridGet(grid,name=gName,_RC) + call ESMF_ConfigGetAttribute(CF, value = NX, Label="NX:", _RC) + call ESMF_ConfigGetAttribute(CF, value = NY, Label="NY:", _RC) comp_name = "ExtData" cflocal = MAPL_ConfigCreate(rc=status) @@ -1283,13 +1171,10 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) integer, optional, intent(in ) :: vcomp integer, optional, intent(out ) :: rc - character(len=ESMF_MAXSTR) :: Iam integer :: status logical :: getRL_ - Iam = "MAPL_ExtDataGetBracket" - if (present(getRL)) then getRL_=getRL else @@ -1302,34 +1187,34 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) if (Bside == MAPL_ExtDataLeft .and. vcomp == 1) then if (getRL_) then - call item%modelGridFields%auxiliary1%get_parameters('L',field=field,__RC__) + call item%modelGridFields%auxiliary1%get_parameters('L',field=field,_RC) _RETURN(ESMF_SUCCESS) else - call item%modelGridFields%comp1%get_parameters('L',field=field,__RC__) + call item%modelGridFields%comp1%get_parameters('L',field=field,_RC) _RETURN(ESMF_SUCCESS) end if else if (Bside == MAPL_ExtDataLeft .and. vcomp == 2) then if (getRL_) then - call item%modelGridFields%auxiliary2%get_parameters('L',field=field,__RC__) + call item%modelGridFields%auxiliary2%get_parameters('L',field=field,_RC) _RETURN(ESMF_SUCCESS) else - call item%modelGridFields%comp2%get_parameters('L',field=field,__RC__) + call item%modelGridFields%comp2%get_parameters('L',field=field,_RC) _RETURN(ESMF_SUCCESS) end if else if (Bside == MAPL_ExtDataRight .and. vcomp == 1) then if (getRL_) then - call item%modelGridFields%auxiliary1%get_parameters('R',field=field,__RC__) + call item%modelGridFields%auxiliary1%get_parameters('R',field=field,_RC) _RETURN(ESMF_SUCCESS) else - call item%modelGridFields%comp1%get_parameters('R',field=field,__RC__) + call item%modelGridFields%comp1%get_parameters('R',field=field,_RC) _RETURN(ESMF_SUCCESS) end if else if (Bside == MAPL_ExtDataRight .and. vcomp == 2) then if (getRL_) then - call item%modelGridFields%auxiliary2%get_parameters('R',field=field,__RC__) + call item%modelGridFields%auxiliary2%get_parameters('R',field=field,_RC) _RETURN(ESMF_SUCCESS) else - call item%modelGridFields%comp2%get_parameters('R',field=field,__RC__) + call item%modelGridFields%comp2%get_parameters('R',field=field,_RC) _RETURN(ESMF_SUCCESS) end if end if @@ -1343,18 +1228,18 @@ subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) if (present(field)) then if (Bside == MAPL_ExtDataLeft) then if (getRL_) then - call item%modelGridFields%auxiliary1%get_parameters('L',field=field,__RC__) + call item%modelGridFields%auxiliary1%get_parameters('L',field=field,_RC) _RETURN(ESMF_SUCCESS) else - call item%modelGridFields%comp1%get_parameters('L',field=field,__RC__) + call item%modelGridFields%comp1%get_parameters('L',field=field,_RC) _RETURN(ESMF_SUCCESS) end if else if (Bside == MAPL_ExtDataRight) then if (getRL_) then - call item%modelGridFields%auxiliary1%get_parameters('R',field=field,__RC__) + call item%modelGridFields%auxiliary1%get_parameters('R',field=field,_RC) _RETURN(ESMF_SUCCESS) else - call item%modelGridFields%comp1%get_parameters('R',field=field,__RC__) + call item%modelGridFields%comp1%get_parameters('R',field=field,_RC) _RETURN(ESMF_SUCCESS) end if end if @@ -1381,14 +1266,11 @@ subroutine MAPL_ExtDataFillField(item,FieldF,FieldR,rc) type(ESMF_Field), intent(inout) :: FieldR integer, optional, intent(out) :: rc - character(len=ESMF_MAXSTR) :: Iam integer :: status real, pointer :: ptrF(:,:,:),ptrR(:,:,:) integer :: lm_in,lm_out,i - Iam = "MAPL_ExtDataFillField" - call ESMF_FieldGet(FieldF,0,farrayPtr=ptrF,rc=status) _VERIFY(STATUS) call ESMF_FieldGet(FieldR,0,farrayPtr=ptrR,rc=status) @@ -1438,11 +1320,11 @@ subroutine MAPL_ExtDataFlipVertical(item,filec,rc) if (item%isVector) then if (item%do_Fill .or. item%do_VertInterp) then - call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,getRL=.true.,__RC__) - call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,getRL=.true.,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,getRL=.true.,_RC) + call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,getRL=.true.,_RC) else - call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,__RC__) - call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,_RC) + call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,_RC) end if call ESMF_FieldGet(Field1,0,farrayPtr=ptr,rc=status) @@ -1463,9 +1345,9 @@ subroutine MAPL_ExtDataFlipVertical(item,filec,rc) else if (item%do_Fill .or. item%do_VertInterp) then - call MAPL_ExtDataGetBracket(item,filec,field=Field,getRL=.true.,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field,getRL=.true.,_RC) else - call MAPL_ExtDataGetBracket(item,filec,field=Field,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field,_RC) end if call ESMF_FieldGet(Field,0,farrayPtr=ptr,rc=status) @@ -1495,11 +1377,11 @@ subroutine MAPL_ExtDataPopulateBundle(item,filec,pbundle,rc) if (item%isVector) then if (item%do_Fill .or. item%do_VertInterp) then - call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,getRL=.true.,__RC__) - call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,getRL=.true.,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,getRL=.true.,_RC) + call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,getRL=.true.,_RC) else - call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,__RC__) - call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,_RC) + call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,_RC) end if call ESMF_FieldGet(Field1,grid=grid,rc=status) @@ -1514,9 +1396,9 @@ subroutine MAPL_ExtDataPopulateBundle(item,filec,pbundle,rc) else if (item%do_Fill .or. item%do_VertInterp) then - call MAPL_ExtDataGetBracket(item,filec,field=Field,getRL=.true.,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field,getRL=.true.,_RC) else - call MAPL_ExtDataGetBracket(item,filec,field=Field,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field,_RC) end if call ESMF_FieldGet(Field,grid=grid,rc=status) @@ -1543,7 +1425,7 @@ subroutine MAPL_ExtDataCreateCFIO(IOBundles, rc) bundle_iter = IOBundles%begin() do while (bundle_iter /= IOBundles%end()) io_bundle => bundle_iter%get() - call io_bundle%make_cfio(__RC__) + call io_bundle%make_cfio(_RC) call bundle_iter%next() enddo @@ -1562,7 +1444,7 @@ subroutine MAPL_ExtDataDestroyCFIO(IOBundles,rc) bundle_iter = IOBundles%begin() do while (bundle_iter /= IOBundles%end()) io_bundle => bundle_iter%get() - call io_bundle%clean(__RC__) + call io_bundle%clean(_RC) call bundle_iter%next enddo call IOBundles%clear() @@ -1620,17 +1502,17 @@ subroutine createFileLevBracket(item,cf,rc) type (ESMF_Grid) :: grid, newgrid type(ESMF_Field) :: field,new_field - call item%modelGridFields%comp1%get_parameters('L',field=field,__RC__) - newGrid = MAPL_ExtDataGridChangeLev(grid,cf,item%lm,__RC__) - new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp1),__RC__) - call item%modelGridFields%auxiliary1%set_parameters(left_field=new_field,__RC__) - new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp1),__RC__) - call item%modelGridFields%auxiliary1%set_parameters(right_field=new_field,__RC__) + call item%modelGridFields%comp1%get_parameters('L',field=field,_RC) + newGrid = MAPL_ExtDataGridChangeLev(grid,cf,item%lm,_RC) + new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp1),_RC) + call item%modelGridFields%auxiliary1%set_parameters(left_field=new_field,_RC) + new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp1),_RC) + call item%modelGridFields%auxiliary1%set_parameters(right_field=new_field,_RC) if (item%vartype==MAPL_VectorField) then - new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp2),__RC__) - call item%modelGridFields%auxiliary2%set_parameters(left_field=new_field,__RC__) - new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp2),__RC__) - call item%modelGridFields%auxiliary2%set_parameters(right_field=new_field,__RC__) + new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp2),_RC) + call item%modelGridFields%auxiliary2%set_parameters(left_field=new_field,_RC) + new_field = MAPL_FieldCreate(field,newGrid,lm=item%lm,newName=trim(item%fcomp2),_RC) + call item%modelGridFields%auxiliary2%set_parameters(right_field=new_field,_RC) end if _RETURN(_SUCCESS) @@ -1684,32 +1566,32 @@ subroutine set_constant_field(item,ExtDataState,rc) type(ESMF_Field) :: field if (item%vartype == MAPL_FieldItem) then - call ESMF_StateGet(ExtDataState,trim(item%name),field,__RC__) - call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) + call ESMF_StateGet(ExtDataState,trim(item%name),field,_RC) + call ESMF_FieldGet(field,dimCount=fieldRank,_RC) if (fieldRank == 2) then - call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%name),__RC__) + call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%name),_RC) ptr2d = item%const else if (fieldRank == 3) then - call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%name), __RC__) + call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%name), _RC) ptr3d = item%const endif else if (item%vartype == MAPL_VectorField) then - call ESMF_StateGet(ExtDataState,trim(item%vcomp1),field,__RC__) - call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) + call ESMF_StateGet(ExtDataState,trim(item%vcomp1),field,_RC) + call ESMF_FieldGet(field,dimCount=fieldRank,_RC) if (fieldRank == 2) then - call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%vcomp1),__RC__) + call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%vcomp1),_RC) ptr2d = item%const else if (fieldRank == 3) then - call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%vcomp1), __RC__) + call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%vcomp1), _RC) ptr3d = item%const endif - call ESMF_StateGet(ExtDataState,trim(item%vcomp2),field,__RC__) - call ESMF_FieldGet(field,dimCount=fieldRank,__RC__) + call ESMF_StateGet(ExtDataState,trim(item%vcomp2),field,_RC) + call ESMF_FieldGet(field,dimCount=fieldRank,_RC) if (fieldRank == 2) then - call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%vcomp2),__RC__) + call MAPL_GetPointer(ExtDataState, ptr2d, trim(item%vcomp2),_RC) ptr2d = item%const else if (fieldRank == 3) then - call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%vcomp2), __RC__) + call MAPL_GetPointer(ExtDataState, ptr3d, trim(item%vcomp2), _RC) ptr3d = item%const endif end if @@ -1728,16 +1610,16 @@ subroutine create_bracketing_fields(item,ExtDataState,cf,rc) type(ESMF_Grid) :: grid real(kind=REAL32), pointer :: ptr3d(:,:,:) - call GetLevs(item,__RC__) + call GetLevs(item,_RC) item%iclient_collection_id=i_clients%add_ext_collection(trim(item%file_template)) if (item%vartype == MAPL_FieldItem) then - call ESMF_StateGet(ExtDataState, trim(item%name), field,__RC__) - call ESMF_FieldGet(field,grid=grid,rank=fieldRank,__RC__) + call ESMF_StateGet(ExtDataState, trim(item%name), field,_RC) + call ESMF_FieldGet(field,grid=grid,rank=fieldRank,_RC) lm=0 if (fieldRank==3) then - call ESMF_FieldGet(field,0,farrayPtr=ptr3d,__RC__) + call ESMF_FieldGet(field,0,farrayPtr=ptr3d,_RC) lm = size(ptr3d,3) end if if (item%lm /= lm .and. lm /= 0 .and. item%havePressure) then @@ -1745,11 +1627,11 @@ subroutine create_bracketing_fields(item,ExtDataState,cf,rc) else if (item%lm /= lm .and. lm /= 0) then item%do_Fill = .true. end if - left_field = MAPL_FieldCreate(field,item%var,doCopy=.true.,__RC__) - right_field = MAPL_FieldCreate(field,item%var,doCopy=.true.,__RC__) - call item%modelGridFields%comp1%set_parameters(left_field=left_field,right_field=right_field, __RC__) + left_field = MAPL_FieldCreate(field,item%var,doCopy=.true.,_RC) + right_field = MAPL_FieldCreate(field,item%var,doCopy=.true.,_RC) + call item%modelGridFields%comp1%set_parameters(left_field=left_field,right_field=right_field, _RC) if (item%do_fill .or. item%do_vertInterp) then - call createFileLevBracket(item,cf,__RC__) + call createFileLevBracket(item,cf,_RC) end if else if (item%vartype == MAPL_VectorField) then @@ -1758,12 +1640,12 @@ subroutine create_bracketing_fields(item,ExtDataState,cf,rc) _FAIL('No conservative re-gridding with vectors') end if - call ESMF_StateGet(ExtDataState, trim(item%vcomp1), field,__RC__) - call ESMF_FieldGet(field,grid=grid,rank=fieldRank,__RC__) + call ESMF_StateGet(ExtDataState, trim(item%vcomp1), field,_RC) + call ESMF_FieldGet(field,grid=grid,rank=fieldRank,_RC) lm = 0 if (fieldRank==3) then - call ESMF_FieldGet(field,0,farrayPtr=ptr3d,__RC__) + call ESMF_FieldGet(field,0,farrayPtr=ptr3d,_RC) lm = size(ptr3d,3) end if if (item%lm /= lm .and. item%havePressure) then @@ -1772,16 +1654,16 @@ subroutine create_bracketing_fields(item,ExtDataState,cf,rc) item%do_Fill = .true. end if - left_field = MAPL_FieldCreate(field,item%fcomp1,doCopy=.true.,__RC__) - right_field = MAPL_FieldCreate(field,item%fcomp1,doCopy=.true.,__RC__) - call item%modelGridFields%comp1%set_parameters(left_field=left_field,right_field=right_field, __RC__) - call ESMF_StateGet(ExtDataState, trim(item%vcomp2), field,__RC__) - left_field = MAPL_FieldCreate(field,item%fcomp2,doCopy=.true.,__RC__) - right_field = MAPL_FieldCreate(field,item%fcomp2,doCopy=.true.,__RC__) - call item%modelGridFields%comp2%set_parameters(left_field=left_field,right_field=right_field, __RC__) + left_field = MAPL_FieldCreate(field,item%fcomp1,doCopy=.true.,_RC) + right_field = MAPL_FieldCreate(field,item%fcomp1,doCopy=.true.,_RC) + call item%modelGridFields%comp1%set_parameters(left_field=left_field,right_field=right_field, _RC) + call ESMF_StateGet(ExtDataState, trim(item%vcomp2), field,_RC) + left_field = MAPL_FieldCreate(field,item%fcomp2,doCopy=.true.,_RC) + right_field = MAPL_FieldCreate(field,item%fcomp2,doCopy=.true.,_RC) + call item%modelGridFields%comp2%set_parameters(left_field=left_field,right_field=right_field, _RC) if (item%do_fill .or. item%do_vertInterp) then - call createFileLevBracket(item,cf,__RC__) + call createFileLevBracket(item,cf,_RC) end if end if From 62ecf48cce3e2366d1d7bf59c4098889b5ab044c Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 27 Jul 2022 09:59:51 -0400 Subject: [PATCH 235/300] restore code that was needed :( --- gridcomps/ExtData2G/ExtDataGridCompNG.F90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 index 0785a3d30895..c1984c538e4c 100644 --- a/gridcomps/ExtData2G/ExtDataGridCompNG.F90 +++ b/gridcomps/ExtData2G/ExtDataGridCompNG.F90 @@ -622,6 +622,16 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) idx = self%primary%get_item_index(current_base_name,time0,_RC) item => self%primary%item(idx) + if (.not.item%initialized) then + item%pfioCollection_id = MAPL_DataAddCollection(item%file_template) + if (item%isConst) then + call set_constant_field(item,self%extDataState,_RC) + cycle + end if + call create_bracketing_fields(item,self%ExtDataState,cf_master, _RC) + item%initialized=.true. + end if + nitems = self%primary%import_names%size() !call extdata_lgr%debug('ExtData Run_(): READ_LOOP: variable %i0 of %i0~: %a', i, nitems, trim(current_base_name)) !call extdata_lgr%debug(' ==> file: %a', trim(item%file_template)) From 3603846ae3d160fb5f2146c68f29f8a57ac61258 Mon Sep 17 00:00:00 2001 From: Amidu Oloso Date: Mon, 1 Aug 2022 11:48:18 -0400 Subject: [PATCH 236/300] Added support for Real8 for MAPL_BalanceWork in MAPL_LoadBalance.F90 --- shared/MAPL_LoadBalance.F90 | 113 +++++++++++++++++++++++++++++++++++- 1 file changed, 111 insertions(+), 2 deletions(-) diff --git a/shared/MAPL_LoadBalance.F90 b/shared/MAPL_LoadBalance.F90 index 49a2576a0fe4..67c2a38e5fa1 100644 --- a/shared/MAPL_LoadBalance.F90 +++ b/shared/MAPL_LoadBalance.F90 @@ -5,6 +5,7 @@ module MAPL_LoadBalanceMod + use MAPL_Constants, only : MAPL_R8 use MAPL_SortMod use MAPL_ExceptionHandling use mpi @@ -16,6 +17,10 @@ module MAPL_LoadBalanceMod public MAPL_BalanceDestroy public MAPL_BalanceGet + interface MAPL_BalanceWork + module procedure MAPL_BalanceWork4 + module procedure MAPL_BalanceWork8 + end interface MAPL_BalanceWork integer, public, parameter :: MAPL_Distribute = 1 integer, public, parameter :: MAPL_Retrieve = 2 @@ -78,7 +83,7 @@ module MAPL_LoadBalanceMod contains - subroutine MAPL_BalanceWork(A, Idim, Direction, Handle, rc) + subroutine MAPL_BalanceWork4(A, Idim, Direction, Handle, rc) real, intent(INOUT) :: A(:) integer, intent(IN ) :: Idim, Direction integer, optional, intent(IN ) :: Handle @@ -178,7 +183,111 @@ subroutine MAPL_BalanceWork(A, Idim, Direction, Handle, rc) end if _RETURN(LDB_SUCCESS) - end subroutine MAPL_BalanceWork + end subroutine MAPL_BalanceWork4 + +!!!=============================================================== + + subroutine MAPL_BalanceWork8(A, Idim, Direction, Handle, rc) + real(kind=MAPL_R8), intent(INOUT) :: A(:) + integer, intent(IN ) :: Idim, Direction + integer, optional, intent(IN ) :: Handle + integer, optional, intent( OUT) :: rc + + integer :: PASS, LENGTH, PROCESSOR, CURSOR, ISTRAT + integer :: COMM, Vtype, VLength, STATUS, K1, K2, K3, Jdim + logical :: SEND, RECV + integer, pointer :: NOP(:,:) + +! Depending on the argument "Direction", this performs the actual distribution +! of work or the gathering of results for a given strategy. The strategy has to +! have been predefined by a call to MAPL_BalanceCreate. A strategy "Handle" +! obtained from that call can be optionally used to specify the strategy. Otherwise, +! a default strategy is assumed (see MAPL_BalanceCreate for details). +! Work (Results) is distributed (retrieved) using the buffer A, which is assumed +! to consist of Jdim contiguous blocks of size Idim. Of course, Jdim can be 1. +! The blocksize of A (Idim) must be at least as large as the BufLen associated +! with the strategy. This size can be obtained by quering the strategy using +! its handle or be saving it from the MAPL_BalanceCreate call. Again, see +! MAPL_BalanceCreate for details. + + Jdim = size(A)/Idim + + if(present(Handle)) then + ISTRAT = Handle + else + ISTRAT = 0 + endif + + if(THE_STRATEGIES(ISTRAT)%PASSES>0) then ! We have a defined strategy + _ASSERT(associated(THE_STRATEGIES(ISTRAT)%NOP),'needs informative message') + +! Initialize CURSOR, which is the location in the first block of A where +! the next read or write is to occur. K1 and K2 are the limits + + if (Direction==MAPL_Distribute) then + CURSOR = THE_STRATEGIES(ISTRAT)%UnBALANCED_LENGTH + 1 + k1=1 + k2=THE_STRATEGIES(ISTRAT)%PASSES + k3=1 + else + CURSOR = THE_STRATEGIES(ISTRAT)% BALANCED_LENGTH + 1 + k1=THE_STRATEGIES(ISTRAT)%PASSES + k2=1 + k3=-1 + end if + +! NOP contains the communication pattern for the strategy, i.e,, +! who passes what to whom within COMM. + + NOP => THE_STRATEGIES(ISTRAT)%NOP + COMM = THE_STRATEGIES(ISTRAT)%COMM + + do PASS=K1,K2,K3 + if(Direction==MAPL_Distribute) then + SEND = NOP(1,PASS)>0 + RECV = NOP(1,PASS)<0 + else + SEND = NOP(1,PASS)<0 + RECV = NOP(1,PASS)>0 + end if + + LENGTH = abs(NOP(1,PASS)) + PROCESSOR = NOP(2,PASS) + + if(Jdim==1) then + Vtype = MPI_DOUBLE_PRECISION + VLength = LENGTH + else + call MPI_Type_VECTOR(Jdim, Length, Idim, MPI_DOUBLE_PRECISION, Vtype, STATUS) + _ASSERT(STATUS==MPI_SUCCESS,'needs informative message') + call MPI_TYPE_COMMIT(Vtype,STATUS) + _ASSERT(STATUS==MPI_SUCCESS,'needs informative message') + VLength = 1 + end if + + if(SEND) then ! -- SENDER + CURSOR = CURSOR - LENGTH + call MPI_SEND(A(CURSOR), VLength, Vtype, PROCESSOR, PASS, COMM, STATUS) + _ASSERT(STATUS==MPI_SUCCESS,'needs informative message') + endif + + + if(RECV) then ! -- RECEIVER + call MPI_RECV(A(CURSOR), VLength, Vtype, PROCESSOR, PASS, COMM, & + MPI_STATUS_IGNORE, STATUS) + _ASSERT(STATUS==MPI_SUCCESS,'needs informative message') + CURSOR = CURSOR + LENGTH + endif + + if(Jdim>1) then + call MPI_TYPE_FREE(Vtype,STATUS) + _ASSERT(STATUS==MPI_SUCCESS,'needs informative message') + end if + enddo + end if + + _RETURN(LDB_SUCCESS) + end subroutine MAPL_BalanceWork8 !!!=============================================================== From 0bdcd66f5a1d99df0981a5c91c24d33e1c029bb0 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 1 Aug 2022 16:04:54 -0400 Subject: [PATCH 237/300] Fix error trapping in BundleIO test --- .circleci/config.yml | 3 +- CHANGELOG.md | 2 + base/tests/mapl_bundleio_test.F90 | 368 +++++++++++++----------------- 3 files changed, 168 insertions(+), 205 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 68383c174a69..268bff674e39 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -48,7 +48,8 @@ workflows: repo: MAPL mepodevelop: false run_unit_tests: true - ctest_options: "-E bundleio -LE 'PERFORMANCE|EXTDATA1G_BIG_TESTS|EXTDATA2G_BIG_TESTS' --output-on-failure" + #ctest_options: "-E bundleio -LE 'PERFORMANCE|EXTDATA1G_BIG_TESTS|EXTDATA2G_BIG_TESTS' --output-on-failure" + ctest_options: "-LE 'PERFORMANCE|EXTDATA1G_BIG_TESTS|EXTDATA2G_BIG_TESTS' --output-on-failure" persist_workspace: true # Needed for MAPL tutorials # Builds MAPL like UFS does (no FLAP and pFlogger, static) diff --git a/CHANGELOG.md b/CHANGELOG.md index 98ae1868d4ae..dc053c788d68 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Fix error trapping in bundleio test + ### Added - Add tutorials diff --git a/base/tests/mapl_bundleio_test.F90 b/base/tests/mapl_bundleio_test.F90 index 87e9e6c5c9de..9e77d3b52b64 100644 --- a/base/tests/mapl_bundleio_test.F90 +++ b/base/tests/mapl_bundleio_test.F90 @@ -1,6 +1,6 @@ #include "MAPL_Generic.h" - Program ut_ReGridding + module BundleTestSupport use mpi use ESMF @@ -18,167 +18,12 @@ Program ut_ReGridding use MAPL_ESMFFieldBundleRead use MAPL_ServerManager use MAPL_FileMetadataUtilsMod - + implicit NONE real, parameter :: cs_stretch_uninit = -1.0 - call main() - CONTAINS - - subroutine main() - -!CONTAINS - -! Basic ESMF objects being used in this example -! --------------------------------------------- - type(ESMF_Grid) :: grid_new - type(ESMF_VM) :: vm ! ESMF Virtual Machine - -! Basic information about the parallel environment -! PET = Persistent Execution Threads -! In the current implementation, a PET is equivalent -! to an MPI process -! ------------------------------------------------ - integer :: myPET ! The local PET number - integer :: nPET ! The total number of PETs you are running on - - integer :: status, rc - integer :: Nx,Ny,nargs - integer :: IM_World_new, JM_World_new, lm_world - - type(ESMF_FieldBundle) :: bundle,bundle_new - type(ESMF_Field) :: field - type(ESMF_Time) :: time - type(ESMF_TimeInterval) :: timeInterval - type(ESMF_Clock) :: clock - - character(len=ESMF_MAXSTR) :: Iam - character(len=ESMF_MAXSTR) :: filename - - integer :: i - - character(len=2) :: pole_new,dateline_new - character(len=ESMF_MAXSTR) :: gridname - character(len=ESMF_MAXPATHLEN) :: str,astr - type(ESMF_CONFIG) :: cfoutput - - type(FieldBundleWriter) :: newWriter - type(ServerManager) :: io_server - real, pointer :: ptr2d(:,:),ptr3d(:,:,:) - real :: cs_stretch_param(3) - integer :: exit_code - - Iam = "ut_ReGridding" - -! Initialize the ESMF. For performance reasons, it is important -! to turn OFF ESMF's automatic logging feature -! ------------------------------------------------------------- - call ESMF_Initialize (LogKindFlag=ESMF_LOGKIND_NONE, vm=vm, rc=STATUS) - _VERIFY(STATUS) - call ESMF_VMGet(vm, localPET=myPET, petCount=nPet) - call MAPL_Initialize(__RC__) - - call io_server%initialize(mpi_comm_world) - - nx=1 - ny=6 - cs_stretch_param=cs_stretch_uninit - nargs = command_argument_count() - do i=1,nargs - call get_command_argument(i,str) - select case(trim(str)) - case('-ogrid') - call get_command_argument(i+1,Gridname) - case('-nx') - call get_command_argument(i+1,astr) - read(astr,*)nx - case('-ny') - call get_command_argument(i+1,astr) - read(astr,*)ny - case('-o') - call get_command_argument(i+1,filename) - end select - enddo - - call MAPL_GetNodeInfo (comm=MPI_COMM_WORLD, rc=status) - _VERIFY(STATUS) - - call ESMF_CalendarSetDefault ( ESMF_CALKIND_GREGORIAN, rc=status ) - _VERIFY(STATUS) - - call ESMF_TimeSet(time, yy=2000, mm=3, dd=15, h=21, m=0, s=0,__RC__) - call ESMF_TimeIntervalSet( TimeInterval, h=6, m=0, s=0, rc=status ) - _VERIFY(STATUS) - Clock = ESMF_ClockCreate ( name="Eric", timeStep=TimeInterval, & - startTime=time, rc=status ) - _VERIFY(STATUS) - - call UnpackGridName(Gridname,im_world_new,jm_world_new,dateline_new,pole_new) - - lm_world=3 - cfoutput = create_cf(gridname,im_world_new,jm_world_new,nx,ny,lm_world,cs_stretch_param,__RC__) - grid_new=grid_manager%make_grid(cfoutput,prefix=trim(gridname)//".",__RC__) - bundle=ESMF_FieldBundleCreate(name="cfio_bundle",rc=status) - call ESMF_FieldBundleSet(bundle,grid=grid_new,rc=status) - _VERIFY(STATUS) - bundle_new=ESMF_FieldBundleCreate(name="cfio_bundle",rc=status) - call ESMF_FieldBundleSet(bundle_new,grid=grid_new,rc=status) - _VERIFY(STATUS) - - field=ESMF_FieldCreate(grid=grid_new,typekind=ESMF_TYPEKIND_R4,name="f2d",rc=status) - _VERIFY(status) - call ESMF_AttributeSet(FIELD, NAME='LONG_NAME', VALUE="what_am_i", RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeSet(FIELD, NAME='UNITS', VALUE="NA", RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeSet(FIELD, NAME='DIMS', VALUE=MAPL_DimsHorzOnly, RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeSet(FIELD, NAME='VLOCATION', & - VALUE=MAPL_VLocationNone, RC=STATUS) - _VERIFY(STATUS) - call ESMF_FieldGet(field,farrayPtr=ptr2d,__RC__) - ptr2d=17.0 - call MAPL_FieldBundleAdd(bundle,field,__RC__) - - field=ESMF_FieldCreate(grid=grid_new,typekind=ESMF_TYPEKIND_R4,name="f3d", & - ungriddedLBound=[1],ungriddedUBound=[lm_world],rc=status) - _VERIFY(status) - call ESMF_AttributeSet(FIELD, NAME='LONG_NAME', VALUE="what_am_i", RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeSet(FIELD, NAME='UNITS', VALUE="NA", RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeSet(FIELD, NAME='DIMS', VALUE=MAPL_DimsHorzVert, RC=STATUS) - _VERIFY(STATUS) - call ESMF_AttributeSet(FIELD, NAME='VLOCATION', & - VALUE=MAPL_VLocationCenter, RC=STATUS) - _VERIFY(STATUS) - call ESMF_FieldGet(field,farrayPtr=ptr3d,__RC__) - ptr3d=17.0 - call MAPL_FieldBundleAdd(bundle,field,__RC__) - - - call newWriter%create_from_bundle(bundle,clock,filename,rc=status) - _VERIFY(status) - call newWriter%write_to_file(rc=status) - _VERIFY(status) - call MAPL_Read_bundle(bundle_new,trim(filename),time=time,rc=status) - _VERIFY(status) - - call Compare_Bundle(bundle,bundle_new,1.0e6,rc=exit_code) - - call io_server%finalize() - call MAPL_Finalize(__RC__) - call ESMF_Finalize ( rc=status ) - _VERIFY(STATUS) - if (exit_code ==0) then - stop 0 - else - stop 1 - end if - - end subroutine main subroutine compare_bundle(State1,State2,tol,rc) type(ESMF_FieldBundle), intent(inout) :: State1 @@ -197,22 +42,20 @@ subroutine compare_bundle(State1,State2,tol,rc) logical, allocatable :: foundDiff(:) type(ESMF_Field) :: Field1,Field2 - call ESMF_FieldBundleGet(State1,fieldcount=itemCount,__RC__) - allocate(NameList(itemCount),stat=status) - _VERIFY(status) - allocate(foundDiff(itemCount),stat=status) - _VERIFY(status) - call ESMF_FieldBundleGet(State1,fieldNameList=NameList,__RC__) + call ESMF_FieldBundleGet(State1,fieldcount=itemCount,_RC) + allocate(NameList(itemCount),_STAT) + allocate(foundDiff(itemCount),_STAT) + call ESMF_FieldBundleGet(State1,fieldNameList=NameList,_RC) do ii=1,itemCount - call ESMF_FieldBundleGet(State1,trim(nameList(ii)),field=field1,__RC__) - call ESMF_FieldBundleGet(State2,trim(nameList(ii)),field=field2,__RC__) - call ESMF_FieldGet(field1,rank=rank1,__RC__) - call ESMF_FieldGet(field1,rank=rank2,__RC__) + call ESMF_FieldBundleGet(State1,trim(nameList(ii)),field=field1,_RC) + call ESMF_FieldBundleGet(State2,trim(nameList(ii)),field=field2,_RC) + call ESMF_FieldGet(field1,rank=rank1,_RC) + call ESMF_FieldGet(field1,rank=rank2,_RC) _ASSERT(rank1==rank2,'needs informative message') foundDiff(ii)=.false. if (rank1==2) then - call ESMF_FieldGet(field1,farrayPtr=ptr2_1,__RC__) - call ESMF_FieldGet(field2,farrayPtr=ptr2_2,__RC__) + call ESMF_FieldGet(field1,farrayPtr=ptr2_1,_RC) + call ESMF_FieldGet(field2,farrayPtr=ptr2_2,_RC) do i=1,size(ptr2_1,1) do j=1,size(ptr2_1,2) if (abs(ptr2_1(i,j)-ptr2_2(i,j)) .gt. tol) then @@ -222,8 +65,8 @@ subroutine compare_bundle(State1,State2,tol,rc) enddo enddo else if (rank1==3) then - call ESMF_FieldGet(field1,farrayPtr=ptr3_1,__RC__) - call ESMF_FieldGet(field2,farrayPtr=ptr3_2,__RC__) + call ESMF_FieldGet(field1,farrayPtr=ptr3_1,_RC) + call ESMF_FieldGet(field2,farrayPtr=ptr3_2,_RC) lb=lbound(ptr3_1) ub=ubound(ptr3_1) do i=1,size(ptr3_1,1) @@ -276,7 +119,6 @@ function create_cf(grid_name,im_world,jm_world,nx,ny,lm,cs_stretch_param,rc) res real, intent(in) :: cs_stretch_param(3) integer, optional, intent(out) :: rc - character(len=ESMF_MAXSTR),parameter :: Iam = "create_cf" integer :: status character(len=2) :: pole,dateline integer :: nn @@ -285,44 +127,31 @@ function create_cf(grid_name,im_world,jm_world,nx,ny,lm,cs_stretch_param,rc) res dateline=grid_name(nn-1:nn) pole=grid_name(1:2) - cf = MAPL_ConfigCreate(__RC__) - call MAPL_ConfigSetAttribute(cf,value=NX, label=trim(grid_name)//".NX:",rc=status) - VERIFY_(status) - call MAPL_ConfigSetAttribute(cf,value=lm, label=trim(grid_name)//".LM:",rc=status) - VERIFY_(status) + cf = MAPL_ConfigCreate(_RC) + call MAPL_ConfigSetAttribute(cf,value=NX, label=trim(grid_name)//".NX:",_RC) + call MAPL_ConfigSetAttribute(cf,value=lm, label=trim(grid_name)//".LM:",_RC) if (jm_world==6*im_world) then - call MAPL_ConfigSetAttribute(cf,value="Cubed-Sphere", label=trim(grid_name)//".GRID_TYPE:",rc=status) - VERIFY_(status) - call MAPL_ConfigSetAttribute(cf,value=6, label=trim(grid_name)//".NF:",rc=status) - VERIFY_(status) - call MAPL_ConfigSetAttribute(cf,value=im_world,label=trim(grid_name)//".IM_WORLD:",rc=status) - VERIFY_(status) - call MAPL_ConfigSetAttribute(cf,value=ny/6, label=trim(grid_name)//".NY:",rc=status) - VERIFY_(status) + call MAPL_ConfigSetAttribute(cf,value="Cubed-Sphere", label=trim(grid_name)//".GRID_TYPE:",_RC) + call MAPL_ConfigSetAttribute(cf,value=6, label=trim(grid_name)//".NF:",_RC) + call MAPL_ConfigSetAttribute(cf,value=im_world,label=trim(grid_name)//".IM_WORLD:",_RC) + call MAPL_ConfigSetAttribute(cf,value=ny/6, label=trim(grid_name)//".NY:",_RC) if (any(cs_stretch_param/=cs_stretch_uninit)) then - call MAPL_ConfigSetAttribute(cf,value=cs_stretch_param(1),label=trim(grid_name)//".STRETCH_FACTOR:",rc=status) - VERIFY_(status) - call MAPL_ConfigSetAttribute(cf,value=cs_stretch_param(2),label=trim(grid_name)//".TARGET_LON:",rc=status) - call MAPL_ConfigSetAttribute(cf,value=cs_stretch_param(3),label=trim(grid_name)//".TARGET_LAT:",rc=status) + call MAPL_ConfigSetAttribute(cf,value=cs_stretch_param(1),label=trim(grid_name)//".STRETCH_FACTOR:",_RC) + call MAPL_ConfigSetAttribute(cf,value=cs_stretch_param(2),label=trim(grid_name)//".TARGET_LON:",_RC) + call MAPL_ConfigSetAttribute(cf,value=cs_stretch_param(3),label=trim(grid_name)//".TARGET_LAT:",_RC) end if - + else - call MAPL_ConfigSetAttribute(cf,value="LatLon", label=trim(grid_name)//".GRID_TYPE:",rc=status) - VERIFY_(status) - call MAPL_ConfigSetAttribute(cf,value=im_world,label=trim(grid_name)//".IM_WORLD:",rc=status) - VERIFY_(status) - call MAPL_ConfigSetAttribute(cf,value=jm_world,label=trim(grid_name)//".JM_WORLD:",rc=status) - VERIFY_(status) - call MAPL_ConfigSetAttribute(cf,value=ny, label=trim(grid_name)//".NY:",rc=status) - VERIFY_(status) - call MAPL_ConfigSetAttribute(cf,value=pole, label=trim(grid_name)//".POLE:",rc=status) - VERIFY_(status) - call MAPL_ConfigSetAttribute(cf,value=dateline, label=trim(grid_name)//".DATELINE:",rc=status) - VERIFY_(status) + call MAPL_ConfigSetAttribute(cf,value="LatLon", label=trim(grid_name)//".GRID_TYPE:",_RC) + call MAPL_ConfigSetAttribute(cf,value=im_world,label=trim(grid_name)//".IM_WORLD:",_RC) + call MAPL_ConfigSetAttribute(cf,value=jm_world,label=trim(grid_name)//".JM_WORLD:",_RC) + call MAPL_ConfigSetAttribute(cf,value=ny, label=trim(grid_name)//".NY:",_RC) + call MAPL_ConfigSetAttribute(cf,value=pole, label=trim(grid_name)//".POLE:",_RC) + call MAPL_ConfigSetAttribute(cf,value=dateline, label=trim(grid_name)//".DATELINE:",_RC) end if - end function create_cf + end function create_cf function create_gridname(im,jm,date,pole) result(gridname) integer, intent(in) :: im @@ -338,4 +167,135 @@ function create_gridname(im,jm,date,pole) result(gridname) end function create_gridname - end program ut_ReGridding + end module BundleTestSupport + +! This is how you can "reset" the MAPL_Generic.h verify bits for a program. +! Program must be at the end of the file to do this and everything else in a module + +#undef MAPL_ErrLog_DONE +#define I_AM_MAIN +#include "MAPL_Generic.h" + + program ut_ReGridding + + use BundleTestSupport + implicit none + +!CONTAINS + +! Basic ESMF objects being used in this example +! --------------------------------------------- + type(ESMF_Grid) :: grid_new + type(ESMF_VM) :: vm ! ESMF Virtual Machine + +! Basic information about the parallel environment +! PET = Persistent Execution Threads +! In the current implementation, a PET is equivalent +! to an MPI process +! ------------------------------------------------ + integer :: myPET ! The local PET number + integer :: nPET ! The total number of PETs you are running on + + integer :: status + integer :: Nx,Ny,nargs + integer :: IM_World_new, JM_World_new, lm_world + + type(ESMF_FieldBundle) :: bundle,bundle_new + type(ESMF_Field) :: field + type(ESMF_Time) :: time + type(ESMF_TimeInterval) :: timeInterval + type(ESMF_Clock) :: clock + + character(len=ESMF_MAXSTR) :: filename + + integer :: i + + character(len=2) :: pole_new,dateline_new + character(len=ESMF_MAXSTR) :: gridname + character(len=ESMF_MAXPATHLEN) :: str,astr + type(ESMF_CONFIG) :: cfoutput + + type(FieldBundleWriter) :: newWriter + type(ServerManager) :: io_server + real, pointer :: ptr2d(:,:),ptr3d(:,:,:) + real :: cs_stretch_param(3) + +! Initialize the ESMF. For performance reasons, it is important +! to turn OFF ESMF's automatic logging feature +! ------------------------------------------------------------- + call ESMF_Initialize (LogKindFlag=ESMF_LOGKIND_NONE, vm=vm, _RC) + call ESMF_VMGet(vm, localPET=myPET, petCount=nPet, _RC) + call MAPL_Initialize(_RC) + + call io_server%initialize(mpi_comm_world) + + nx=1 + ny=6 + cs_stretch_param=cs_stretch_uninit + nargs = command_argument_count() + do i=1,nargs + call get_command_argument(i,str) + select case(trim(str)) + case('-ogrid') + call get_command_argument(i+1,Gridname) + case('-nx') + call get_command_argument(i+1,astr) + read(astr,*)nx + case('-ny') + call get_command_argument(i+1,astr) + read(astr,*)ny + case('-o') + call get_command_argument(i+1,filename) + end select + enddo + + call MAPL_GetNodeInfo (comm=MPI_COMM_WORLD, _RC) + + call ESMF_CalendarSetDefault ( ESMF_CALKIND_GREGORIAN, _RC ) + + call ESMF_TimeSet(time, yy=2000, mm=3, dd=15, h=21, m=0, s=0,_RC) + call ESMF_TimeIntervalSet( TimeInterval, h=6, m=0, s=0, _RC ) + Clock = ESMF_ClockCreate ( name="Eric", timeStep=TimeInterval, & + startTime=time, _RC ) + + call UnpackGridName(Gridname,im_world_new,jm_world_new,dateline_new,pole_new) + + lm_world=3 + cfoutput = create_cf(gridname,im_world_new,jm_world_new,nx,ny,lm_world,cs_stretch_param,_RC) + grid_new=grid_manager%make_grid(cfoutput,prefix=trim(gridname)//".",_RC) + bundle=ESMF_FieldBundleCreate(name="cfio_bundle",_RC) + call ESMF_FieldBundleSet(bundle,grid=grid_new,_RC) + bundle_new=ESMF_FieldBundleCreate(name="cfio_bundle",_RC) + call ESMF_FieldBundleSet(bundle_new,grid=grid_new,_RC) + + field=ESMF_FieldCreate(grid=grid_new,typekind=ESMF_TYPEKIND_R4,name="f2d",_RC) + call ESMF_AttributeSet(FIELD,'LONG_NAME','what_am_i',_RC) + call ESMF_AttributeSet(FIELD,'UNITS','NA',_RC) + call ESMF_AttributeSet(FIELD,'DIMS',MAPL_DimsHorzOnly,_RC) + call ESMF_AttributeSet(FIELD,'VLOCATION',MAPL_VLocationNone,_RC) + call ESMF_FieldGet(field,farrayPtr=ptr2d,_RC) + ptr2d=17.0 + call MAPL_FieldBundleAdd(bundle,field,_RC) + + field=ESMF_FieldCreate(grid=grid_new,typekind=ESMF_TYPEKIND_R4,name="f3d", & + ungriddedLBound=[1],ungriddedUBound=[lm_world],_RC) + call ESMF_AttributeSet(FIELD,'LONG_NAME','what_am_i',_RC) + call ESMF_AttributeSet(FIELD,'UNITS','NA',_RC) + call ESMF_AttributeSet(FIELD,'DIMS',MAPL_DimsHorzVert,_RC) + call ESMF_AttributeSet(FIELD,'VLOCATION',MAPL_VLocationCenter,_RC) + call ESMF_FieldGet(field,farrayPtr=ptr3d,_RC) + ptr3d=17.0 + call MAPL_FieldBundleAdd(bundle,field,_RC) + + + call newWriter%create_from_bundle(bundle,clock,filename,_RC) + call newWriter%write_to_file(_RC) + call MAPL_Read_bundle(bundle_new,trim(filename),time=time,_RC) + + call Compare_Bundle(bundle,bundle_new,1.0e6,_RC) + + call io_server%finalize() + call MAPL_Finalize(_RC) + call ESMF_Finalize(_RC) + + end program ut_ReGridding From 6863fa9a1b6158cfa8525025b0e5293f456a91f5 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 1 Aug 2022 16:24:19 -0400 Subject: [PATCH 238/300] Nope. Still an Open MPI issue --- .circleci/config.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 268bff674e39..68383c174a69 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -48,8 +48,7 @@ workflows: repo: MAPL mepodevelop: false run_unit_tests: true - #ctest_options: "-E bundleio -LE 'PERFORMANCE|EXTDATA1G_BIG_TESTS|EXTDATA2G_BIG_TESTS' --output-on-failure" - ctest_options: "-LE 'PERFORMANCE|EXTDATA1G_BIG_TESTS|EXTDATA2G_BIG_TESTS' --output-on-failure" + ctest_options: "-E bundleio -LE 'PERFORMANCE|EXTDATA1G_BIG_TESTS|EXTDATA2G_BIG_TESTS' --output-on-failure" persist_workspace: true # Needed for MAPL tutorials # Builds MAPL like UFS does (no FLAP and pFlogger, static) From 63cf1e87b16433fbc8a54ba34d1bf603eda83417 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 5 Aug 2022 13:57:48 -0400 Subject: [PATCH 239/300] fixes #1621 --- CHANGELOG.md | 1 + gridcomps/History/MAPL_HistoryGridComp.F90 | 10 +++++++--- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index dc053c788d68..b9938f3b1439 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Check for duplicate entries in the History.rc file - Check that a user provided chunking in the History.rc is compatible with the output grid - If a user request CFIOasync in the History.rc print warning and set to CFIO +- Make it optional for History to check for pre-existing files before writing ### Changed diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 12d80b40f63d..768566187f71 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -116,6 +116,7 @@ module MAPL_HistoryGridCompMod logical :: integer_time integer :: collectionWriteSplit integer :: serverSizeSplit + logical :: check_if_file_exists end type HISTORY_STATE type HISTORY_wrap @@ -537,6 +538,9 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) call ESMF_ConfigGetAttribute(config, value=cFileOrder, & label='FileOrder:', default='ABC', rc=status) _VERIFY(STATUS) + call ESMF_ConfigGetAttribute(config, value=intState%check_if_file_exists, & + label='Check_If_File_Exists:', default=.true., _RC) + if (trim(cFileOrder) == 'ABC') then intstate%fileOrderAlphabetical = .true. else if (trim(cFileOrder) == 'AddOrder') then @@ -3626,9 +3630,9 @@ subroutine Run ( gc, import, export, clock, rc ) else if( list(n)%unit.eq.0 ) then if (list(n)%format == 'CFIO') then - inquire (file=trim(filename(n)),exist=file_exists) - if (file_exists) then - _FAIL(trim(filename(n))//" being created for History output already exists") + if (intState%check_if_file_exists) then + inquire (file=trim(filename(n)),exist=file_exists) + _ASSERT(file_exists,trim(filename(n))//" being created for History output already exists") end if call list(n)%mGriddedIO%modifyTime(oClients=o_Clients,rc=status) _VERIFY(status) From 7654665929439c4b04382cbbe023358aacfbd3d5 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 5 Aug 2022 14:02:32 -0400 Subject: [PATCH 240/300] typo in last commit --- gridcomps/History/MAPL_HistoryGridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 768566187f71..1dbd5cb9ded7 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -3632,7 +3632,7 @@ subroutine Run ( gc, import, export, clock, rc ) if (list(n)%format == 'CFIO') then if (intState%check_if_file_exists) then inquire (file=trim(filename(n)),exist=file_exists) - _ASSERT(file_exists,trim(filename(n))//" being created for History output already exists") + _ASSERT(.not.file_exists,trim(filename(n))//" being created for History output already exists") end if call list(n)%mGriddedIO%modifyTime(oClients=o_Clients,rc=status) _VERIFY(status) From d193f8de3c14dfde31a57053ef38bd3d3ffafb37 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 5 Aug 2022 14:15:44 -0400 Subject: [PATCH 241/300] changes requested by Tom --- CHANGELOG.md | 2 +- gridcomps/History/MAPL_HistoryGridComp.F90 | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index b9938f3b1439..684106feb75d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,7 +17,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Check for duplicate entries in the History.rc file - Check that a user provided chunking in the History.rc is compatible with the output grid - If a user request CFIOasync in the History.rc print warning and set to CFIO -- Make it optional for History to check for pre-existing files before writing +- Added option allow writing to pre-existing files with History ### Changed diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 1dbd5cb9ded7..cc76cff5817c 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -116,7 +116,7 @@ module MAPL_HistoryGridCompMod logical :: integer_time integer :: collectionWriteSplit integer :: serverSizeSplit - logical :: check_if_file_exists + logical :: fail_if_file_exists end type HISTORY_STATE type HISTORY_wrap @@ -538,8 +538,8 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) call ESMF_ConfigGetAttribute(config, value=cFileOrder, & label='FileOrder:', default='ABC', rc=status) _VERIFY(STATUS) - call ESMF_ConfigGetAttribute(config, value=intState%check_if_file_exists, & - label='Check_If_File_Exists:', default=.true., _RC) + call ESMF_ConfigGetAttribute(config, value=intState%fail_if_file_exists, & + label='Fail_If_File_Exists:', default=.fail., _RC) if (trim(cFileOrder) == 'ABC') then intstate%fileOrderAlphabetical = .true. @@ -3630,7 +3630,7 @@ subroutine Run ( gc, import, export, clock, rc ) else if( list(n)%unit.eq.0 ) then if (list(n)%format == 'CFIO') then - if (intState%check_if_file_exists) then + if (intState%fail_if_file_exists) then inquire (file=trim(filename(n)),exist=file_exists) _ASSERT(.not.file_exists,trim(filename(n))//" being created for History output already exists") end if From 3e7041c029c4072da390988514f381c785742f6b Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 5 Aug 2022 14:17:03 -0400 Subject: [PATCH 242/300] typo in previous commit --- gridcomps/History/MAPL_HistoryGridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index cc76cff5817c..d6e4c7e49898 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -539,7 +539,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) label='FileOrder:', default='ABC', rc=status) _VERIFY(STATUS) call ESMF_ConfigGetAttribute(config, value=intState%fail_if_file_exists, & - label='Fail_If_File_Exists:', default=.fail., _RC) + label='Fail_If_File_Exists:', default=.false., _RC) if (trim(cFileOrder) == 'ABC') then intstate%fileOrderAlphabetical = .true. From 5100063ca42ae98f96cd24fd89987405430fe75c Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 5 Aug 2022 15:56:00 -0400 Subject: [PATCH 243/300] change name one more time --- gridcomps/History/MAPL_HistoryGridComp.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index d6e4c7e49898..c5b68118db15 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -116,7 +116,7 @@ module MAPL_HistoryGridCompMod logical :: integer_time integer :: collectionWriteSplit integer :: serverSizeSplit - logical :: fail_if_file_exists + logical :: allow_overwrite end type HISTORY_STATE type HISTORY_wrap @@ -538,8 +538,8 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) call ESMF_ConfigGetAttribute(config, value=cFileOrder, & label='FileOrder:', default='ABC', rc=status) _VERIFY(STATUS) - call ESMF_ConfigGetAttribute(config, value=intState%fail_if_file_exists, & - label='Fail_If_File_Exists:', default=.false., _RC) + call ESMF_ConfigGetAttribute(config, value=intState%allow_overwrite, & + label='Allow_Overwrite:', default=.false., _RC) if (trim(cFileOrder) == 'ABC') then intstate%fileOrderAlphabetical = .true. @@ -3630,7 +3630,7 @@ subroutine Run ( gc, import, export, clock, rc ) else if( list(n)%unit.eq.0 ) then if (list(n)%format == 'CFIO') then - if (intState%fail_if_file_exists) then + if (.not.intState%allow_overwrite) then inquire (file=trim(filename(n)),exist=file_exists) _ASSERT(.not.file_exists,trim(filename(n))//" being created for History output already exists") end if From 843944539672f2756b3ff442ea5d134e003b922c Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 5 Aug 2022 16:06:34 -0400 Subject: [PATCH 244/300] start of fixing #1620 --- pfio/HistoryCollection.F90 | 42 +++++++++++++++++++++++++++++++++++--- 1 file changed, 39 insertions(+), 3 deletions(-) diff --git a/pfio/HistoryCollection.F90 b/pfio/HistoryCollection.F90 index 7822ea810534..b15b33b4658a 100644 --- a/pfio/HistoryCollection.F90 +++ b/pfio/HistoryCollection.F90 @@ -9,6 +9,8 @@ module pFIO_HistoryCollectionMod use pFIO_FileMetadataMod use pFIO_StringVariableMapMod use pFIO_ConstantsMod + use gFTL_StringVector + use NetCDF implicit none private @@ -17,12 +19,14 @@ module pFIO_HistoryCollectionMod type :: HistoryCollection type (Filemetadata) :: fmd + type (StringVector) :: files_created type (StringNetCDF4_FileFormatterMap) :: formatters contains procedure :: find procedure :: ModifyMetadata procedure :: clear + procedure :: check_if_i_created end type HistoryCollection interface HistoryCollection @@ -51,18 +55,28 @@ function find(this, file_name,rc) result(formatter) type(StringNetCDF4_FileFormatterMapIterator) :: iter integer :: status character(len=*), parameter :: Iam = "HistoryCollection::find()" - logical :: f_exist + logical :: f_exist, i_created iter = this%formatters%find(trim(file_name)) if (iter == this%formatters%end()) then inquire(file=file_name, exist=f_exist) - if(.not. f_exist) then + if(.not. f_exist) then call fm%create(trim(file_name),rc=status) _VERIFY(status) call fm%write(this%fmd, rc=status) _VERIFY(status) + call this%files_created%push_back(file_name) else - call fm%open(trim(file_name), pFIO_WRITE) + i_created = this%check_if_i_created(file_name) + if (i_created) then + call fm%open(trim(file_name), pFIO_WRITE) + else + call fm%create(trim(file_name),mode=NF90_CLOBBER,rc=status) + _VERIFY(status) + call fm%write(this%fmd, rc=status) + _VERIFY(status) + call this%files_created%push_back(file_name) + end if endif call this%formatters%insert( trim(file_name),fm) iter = this%formatters%find(trim(file_name)) @@ -112,6 +126,28 @@ subroutine clear(this, rc) _RETURN(_SUCCESS) end subroutine clear + function check_if_i_created(this,input_file,rc) result(i_created) + logical :: i_created + class (HistoryCollection), intent(inout) :: this + character(len=*), intent(in) :: input_file + integer, optional, intent(out) :: rc + + integer :: status + character(len=:), pointer :: file_name + type(StringVectorIterator) :: iter + + i_created = .false. + iter = this%files_created%begin() + do while (iter /= this%files_created%end()) + file_name => iter%get() + if (file_name == input_file) i_created = .true. + call iter%next() + enddo + + _RETURN(_SUCCESS) + + end function + end module pFIO_HistoryCollectionMod From 89f0d5f0c97d44ec82e3ca32b8f22cc6abb1fb8a Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 8 Aug 2022 08:39:34 -0400 Subject: [PATCH 245/300] Update CHANGELOG and CMakeLists for 2.24.0 Release --- CHANGELOG.md | 16 ++++++++++++---- CMakeLists.txt | 2 +- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 684106feb75d..1c00cd30b652 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,18 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +### Added + +### Changed + +### Removed + +### Deprecated + +## [2.24.0] - 2022-08-08 + +### Fixed + - Fix error trapping in bundleio test ### Added @@ -25,10 +37,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Moved to `checkout@v3` action due to git safe directory issue - Added tutorials to CI -### Removed - -### Deprecated - ## [2.23.1] - 2022-07-15 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index 7ff5142a9446..78661e6b04e7 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.23.1 + VERSION 2.24.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the default build type to release From 00edc6832742dcadfc8bf0a82896dd7f6ca2516f Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 8 Aug 2022 08:43:15 -0400 Subject: [PATCH 246/300] Fix spelling --- CHANGELOG.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1c00cd30b652..74e5a80e5859 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -27,13 +27,13 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Add tutorials - Check for duplicate entries in the History.rc file -- Check that a user provided chunking in the History.rc is compatible with the output grid -- If a user request CFIOasync in the History.rc print warning and set to CFIO +- Check that a user-provided chunking in the History.rc is compatible with the output grid +- If a user requests CFIOasync in the History.rc, print warning and set to CFIO - Added option allow writing to pre-existing files with History ### Changed -- Replaced depreciated __RC__ macro with _RC and remove unsed code in ExtData2G +- Replaced deprecated __RC__ macro with _RC and remove unused code in ExtData2G - Moved to `checkout@v3` action due to git safe directory issue - Added tutorials to CI From 97952c38f39146b4270992a27db61427b6a07735 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 8 Aug 2022 10:03:22 -0400 Subject: [PATCH 247/300] don't need to store a list, just one --- pfio/HistoryCollection.F90 | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/pfio/HistoryCollection.F90 b/pfio/HistoryCollection.F90 index b15b33b4658a..d439b39dc494 100644 --- a/pfio/HistoryCollection.F90 +++ b/pfio/HistoryCollection.F90 @@ -19,7 +19,7 @@ module pFIO_HistoryCollectionMod type :: HistoryCollection type (Filemetadata) :: fmd - type (StringVector) :: files_created + character(len=:), allocatable :: file_created type (StringNetCDF4_FileFormatterMap) :: formatters contains @@ -65,7 +65,7 @@ function find(this, file_name,rc) result(formatter) _VERIFY(status) call fm%write(this%fmd, rc=status) _VERIFY(status) - call this%files_created%push_back(file_name) + this%file_created = trim(file_name) else i_created = this%check_if_i_created(file_name) if (i_created) then @@ -75,7 +75,7 @@ function find(this, file_name,rc) result(formatter) _VERIFY(status) call fm%write(this%fmd, rc=status) _VERIFY(status) - call this%files_created%push_back(file_name) + this%file_created=trim(file_name) end if endif call this%formatters%insert( trim(file_name),fm) @@ -133,16 +133,11 @@ function check_if_i_created(this,input_file,rc) result(i_created) integer, optional, intent(out) :: rc integer :: status - character(len=:), pointer :: file_name - type(StringVectorIterator) :: iter i_created = .false. - iter = this%files_created%begin() - do while (iter /= this%files_created%end()) - file_name => iter%get() - if (file_name == input_file) i_created = .true. - call iter%next() - enddo + if (allocated(this%file_created)) then + if (input_file == this%file_created) i_created=.true. + end if _RETURN(_SUCCESS) From ff80042816aabccc788470241a52b49d3d57fbd7 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 8 Aug 2022 10:15:59 -0400 Subject: [PATCH 248/300] choose beter variable name --- pfio/HistoryCollection.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/pfio/HistoryCollection.F90 b/pfio/HistoryCollection.F90 index d439b39dc494..47bf3af2bea1 100644 --- a/pfio/HistoryCollection.F90 +++ b/pfio/HistoryCollection.F90 @@ -19,7 +19,7 @@ module pFIO_HistoryCollectionMod type :: HistoryCollection type (Filemetadata) :: fmd - character(len=:), allocatable :: file_created + character(len=:), allocatable :: last_file_created type (StringNetCDF4_FileFormatterMap) :: formatters contains @@ -65,7 +65,7 @@ function find(this, file_name,rc) result(formatter) _VERIFY(status) call fm%write(this%fmd, rc=status) _VERIFY(status) - this%file_created = trim(file_name) + this%last_file_created = trim(file_name) else i_created = this%check_if_i_created(file_name) if (i_created) then @@ -75,7 +75,7 @@ function find(this, file_name,rc) result(formatter) _VERIFY(status) call fm%write(this%fmd, rc=status) _VERIFY(status) - this%file_created=trim(file_name) + this%last_file_created=trim(file_name) end if endif call this%formatters%insert( trim(file_name),fm) @@ -135,8 +135,8 @@ function check_if_i_created(this,input_file,rc) result(i_created) integer :: status i_created = .false. - if (allocated(this%file_created)) then - if (input_file == this%file_created) i_created=.true. + if (allocated(this%last_file_created)) then + if (input_file == this%last_file_created) i_created=.true. end if _RETURN(_SUCCESS) From 802c5d8d05bfac367b6f842cae2d5ec936f698b6 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 8 Aug 2022 11:26:25 -0400 Subject: [PATCH 249/300] overload client message for NOCLOBBER --- pfio/AddHistCollectionMessage.F90 | 4 +++- pfio/HistoryCollection.F90 | 13 ++++++++++--- pfio/ServerThread.F90 | 6 +++--- 3 files changed, 16 insertions(+), 7 deletions(-) diff --git a/pfio/AddHistCollectionMessage.F90 b/pfio/AddHistCollectionMessage.F90 index 1511958c2862..9895ca028fe5 100644 --- a/pfio/AddHistCollectionMessage.F90 +++ b/pfio/AddHistCollectionMessage.F90 @@ -13,8 +13,10 @@ module pFIO_AddHistCollectionMessageMod type, extends(AbstractMessage) :: AddHistCollectionMessage type(FileMetadata) :: fmd - ! WY node: -1 : add ( default ) + ! WY node: -1 : add (clobber, default ) ! other : replace + ! overload collection_id of the message + ! -2 : add and no_clobber for these series of files integer :: collection_id = -1 contains procedure, nopass :: get_type_id diff --git a/pfio/HistoryCollection.F90 b/pfio/HistoryCollection.F90 index 47bf3af2bea1..13ab72b32da6 100644 --- a/pfio/HistoryCollection.F90 +++ b/pfio/HistoryCollection.F90 @@ -21,7 +21,7 @@ module pFIO_HistoryCollectionMod type (Filemetadata) :: fmd character(len=:), allocatable :: last_file_created type (StringNetCDF4_FileFormatterMap) :: formatters - + integer :: create_mode contains procedure :: find procedure :: ModifyMetadata @@ -35,12 +35,19 @@ module pFIO_HistoryCollectionMod contains - function new_HistoryCollection(fmd) result(collection) + function new_HistoryCollection(fmd, option) result(collection) type (HistoryCollection) :: collection type (FilemetaData), intent(in) :: fmd + integer, optional, intent(in) :: option collection%fmd = fmd collection%formatters = StringNetCDF4_FileFormatterMap() + collection%create_mode = NF90_CLOBBER + if (present(option)) then + if (option == -2) then + collection%ceate_mode = NF90_NOCLOBBER + endif + endif end function new_HistoryCollection @@ -71,7 +78,7 @@ function find(this, file_name,rc) result(formatter) if (i_created) then call fm%open(trim(file_name), pFIO_WRITE) else - call fm%create(trim(file_name),mode=NF90_CLOBBER,rc=status) + call fm%create(trim(file_name),mode=this%create_mode,rc=status) _VERIFY(status) call fm%write(this%fmd, rc=status) _VERIFY(status) diff --git a/pfio/ServerThread.F90 b/pfio/ServerThread.F90 index ca33c9f8a877..ecf044930e96 100644 --- a/pfio/ServerThread.F90 +++ b/pfio/ServerThread.F90 @@ -531,14 +531,14 @@ subroutine handle_AddHistCollection(this, message, rc) class(AbstractSocket),pointer :: connection if (associated(ioserver_profiler)) call ioserver_profiler%start("add_Histcollection") - if ( message%collection_id == -1 ) then + if ( message%collection_id == -1 .or. message%collection_id == -2 ) then n = this%hist_collections%size()+1 else n = message%collection_id endif - hist_collection = HistoryCollection(message%fmd) - if ( message%collection_id == -1) then + hist_collection = HistoryCollection(message%fmd, message%collection_id) + if ( message%collection_id == -1 .or. message%collection_id == -2 ) then call this%hist_collections%push_back(hist_collection) else call this%hist_collections%set(n,hist_collection) From 116cd309e240e44eaf2ef44958d79cfbdcae934d Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 8 Aug 2022 11:59:03 -0400 Subject: [PATCH 250/300] Fixes #1564. Remove latlon basic constructor --- CHANGELOG.md | 2 + base/MAPL_LatLonGridFactory.F90 | 130 +++++++++----------------------- 2 files changed, 36 insertions(+), 96 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 74e5a80e5859..15fabaaf4ca5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,6 +15,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Removed +- Removed `LatLonGridFactory_basic` factory constructor (dead code) + ### Deprecated ## [2.24.0] - 2022-08-08 diff --git a/base/MAPL_LatLonGridFactory.F90 b/base/MAPL_LatLonGridFactory.F90 index 9cf017f3784c..f4df37d7cade 100644 --- a/base/MAPL_LatLonGridFactory.F90 +++ b/base/MAPL_LatLonGridFactory.F90 @@ -39,7 +39,7 @@ module MAPL_LatLonGridFactoryMod real(kind=REAL64), allocatable :: lon_corners(:) real(kind=REAL64), allocatable :: lat_corners(:) logical :: force_decomposition = .false. - + ! Domain decomposition: integer :: nx = MAPL_UNDEFINED_INTEGER integer :: ny = MAPL_UNDEFINED_INTEGER @@ -101,7 +101,6 @@ module MAPL_LatLonGridFactoryMod character(len=*), parameter :: MOD_NAME = 'MAPL_LatLonGridFactory::' interface LatLonGridFactory - module procedure LatLonGridFactory_basic module procedure LatLonGridFactory_from_parameters end interface LatLonGridFactory @@ -116,67 +115,6 @@ module MAPL_LatLonGridFactoryMod contains - ! Note: lats and lons must be in _radians_, as the ESMF_Grid - ! constructor is currently assuming that choice. - function Latlongridfactory_basic(grid_name, & - & lon_centers, lat_centers, lon_corners, lat_corners, & - & ims, jms, lm, unusable, rc) result(factory) - type (LatLonGridFactory) :: factory - character(len=*), intent(in) :: grid_name - real(kind=REAL64), intent(in) :: lon_centers(:) - real(kind=REAL64), intent(in) :: lat_centers(:) - real(kind=REAL64), intent(in) :: lon_corners(:) - real(kind=REAL64), intent(in) :: lat_corners(:) - integer, intent(in) :: ims(:) - integer, intent(in) :: jms(:) - integer, intent(in) :: lm - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - - type (ESMF_VM) :: vm - integer :: nPet - - integer :: status - character(*), parameter :: IAM = __FILE__ - - _UNUSED_DUMMY(unusable) - - factory%is_regular = .false. - - factory%grid_name = grid_name - factory%lon_centers = lon_centers - factory%lat_centers = lat_centers - factory%lon_corners = lon_corners - factory%lat_corners = lat_corners - - factory%im_world = size(lon_centers) - factory%jm_world = size(lon_centers) - factory%lm = lm - - ! Decomposition - factory%ims = ims - factory%jms = jms - factory%nx = size(ims) - factory%ny = size(jms) - - ! Check consistency - - _ASSERT(size(lon_corners) == size(lon_centers)+1, 'inconsistent shape') - _ASSERT(size(lat_corners) == size(lat_centers)+1, 'inconsistent shape') - - _ASSERT(sum(ims) == size(lon_centers),'inconcistent decomposition') - _ASSERT(sum(jms) == size(lat_centers),'inconcistent decomposition') - - call ESMF_VMGetCurrent(vm, rc=status) - _VERIFY(status) - call ESMF_VMGet(vm, PETcount=nPet, rc=status) - _VERIFY(status) - _ASSERT(factory%nx*factory%ny == nPet,'inconsistent process topology') - - _RETURN(_SUCCESS) - - end function LatLonGridFactory_basic - function LatLonGridFactory_from_parameters(unusable, grid_name, & & im_world, jm_world, lm, nx, ny, ims, jms, & @@ -199,7 +137,7 @@ function LatLonGridFactory_from_parameters(unusable, grid_name, & integer, optional, intent(in) :: ny integer, optional, intent(in) :: ims(:) integer, optional, intent(in) :: jms(:) - logical, optional, intent(in) :: force_decomposition + logical, optional, intent(in) :: force_decomposition integer, optional, intent(out) :: rc @@ -467,7 +405,7 @@ function compute_lon_corners(this, dateline, unusable, rc) result(lon_corners) regional = (dateline == 'XY') if (regional) then delta = (this%lon_range%max - this%lon_range%min) / this%im_world - min_coord = this%lon_range%min + min_coord = this%lon_range%min max_coord = this%lon_range%max else delta = 360.d0 / this%im_world @@ -732,11 +670,11 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi integer :: i logical :: hasLon, hasLat, hasLongitude, hasLatitude, hasLev,hasLevel,regLat,regLon real(kind=REAL64) :: del12,delij - + integer :: i_min, i_max real(kind=REAL64) :: d_lat, d_lat_temp, extrap_lat logical :: is_valid, use_file_coords, compute_lons, compute_lats - + _UNUSED_DUMMY(unusable) if (present(force_file_coordinates)) then @@ -747,7 +685,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi ! Cannot assume that lats and lons are evenly spaced this%is_regular = .false. - + associate (im => this%im_world, jm => this%jm_world, lm => this%lm) lon_name = 'lon' hasLon = file_metadata%has_dimension(lon_name) @@ -757,7 +695,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi else lon_name = 'longitude' hasLongitude = file_metadata%has_dimension(lon_name) - if (hasLongitude) then + if (hasLongitude) then im = file_metadata%get_dimension(lon_name, rc=status) _VERIFY(status) else @@ -772,7 +710,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi else lat_name = 'latitude' hasLatitude = file_metadata%has_dimension(lat_name) - if (hasLatitude) then + if (hasLatitude) then jm = file_metadata%get_dimension(lat_name, rc=status) _VERIFY(status) else @@ -793,11 +731,11 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi lm = file_metadata%get_dimension(lev_name,rc=status) _VERIFY(status) end if - end if - + end if + ! TODO: if 'lat' and 'lon' are not present then ! assume ... pole/dateline are ? - + ! TODO: check radians vs degrees. Assume degrees for now. @@ -865,12 +803,12 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi end if end if end if - + ! Corners are the midpoints of centers (and extrapolated at the ! poles for lats.) allocate(this%lon_corners(im+1), this%lat_corners(jm+1)) - + this%lon_corners(1) = (this%lon_centers(im) + this%lon_centers(1))/2 - 180 this%lon_corners(2:im) = (this%lon_centers(1:im-1) + this%lon_centers(2:im))/2 this%lon_corners(im+1) = (this%lon_centers(im) + this%lon_centers(1))/2 + 180 @@ -892,7 +830,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi this%lat_corners(1) = this%lat_centers(1) - (this%lat_centers(2)-this%lat_centers(1))/2 this%lat_corners(2:jm) = (this%lat_centers(1:jm-1) + this%lat_centers(2:jm))/2 this%lat_corners(jm+1) = this%lat_centers(jm) - (this%lat_centers(jm-1)-this%lat_centers(jm))/2 - + if (abs(this%lat_centers(1) + 90) < 1000*epsilon(1.0)) then this%pole = 'PC' else if (abs(this%lat_corners(1) + 90) < 1000*epsilon(1.0)) then @@ -928,10 +866,10 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi else compute_lons=.false. compute_lats=.false. - if (regLon .and. (this%dateline.ne.'XY')) then + if (regLon .and. (this%dateline.ne.'XY')) then compute_lons=.true. end if - if (regLat .and. (this%pole.ne.'XY')) then + if (regLat .and. (this%pole.ne.'XY')) then compute_lats=.true. end if if (compute_lons .and. compute_lats) then @@ -959,7 +897,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi end if end associate - + call this%make_arbitrary_decomposition(this%nx, this%ny, rc=status) _VERIFY(status) @@ -969,7 +907,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi allocate(this%jms(0:this%ny-1)) call MAPL_DecomposeDim(this%im_world, this%ims, this%nx, min_DE_extent=2) call MAPL_DecomposeDim(this%jm_world, this%jms, this%ny, min_DE_extent=2) - + call this%check_and_fill_consistency(rc=status) _VERIFY(status) @@ -995,7 +933,7 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc call ESMF_VmGetCurrent(VM, rc=status) _VERIFY(status) - + this%is_regular = .true. call ESMF_ConfigGetAttribute(config, tmp, label=prefix//'GRIDNAME:', default=MAPL_GRID_NAME_DEFAULT) this%grid_name = trim(tmp) @@ -1404,7 +1342,7 @@ subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, ! the code below is kluge to return DE/DC wheither or not the file lons are -180 to 180 or 0 360 ! it detects whether the first longitudes which are cell centers - ! If first longitude is 0 or -180 (DC) it is dateline center in that 0 or -180 is + ! If first longitude is 0 or -180 (DC) it is dateline center in that 0 or -180 is ! in the center of a grid cell. ! or shifted by half a grid box (DE) so 0 or -180 is the edge of a cell ! really should have 4 options dateline edge (DE), dateline center(DC) @@ -1439,7 +1377,7 @@ subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, nx_guess = nint(sqrt(real(nPet))) do nx = nx_guess,1,-1 - ny=nPet/nx + ny=nPet/nx if (nx*ny==nPet) then call MAPL_ConfigSetAttribute(config, nx, 'NX:') call MAPL_ConfigSetAttribute(config, ny, 'NY:') @@ -1514,7 +1452,7 @@ function physical_params_are_equal(this, a) result(equal) end if else equal = & - & all(a%lon_centers == this%lon_centers) .and. & + & all(a%lon_centers == this%lon_centers) .and. & & all(a%lon_corners == this%lon_corners) .and. & & all(a%lat_centers == this%lat_centers) .and. & & all(a%lat_corners == this%lat_corners) @@ -1612,7 +1550,7 @@ function generate_new_decomp(im,nd) result(n) integer, intent(in) :: im, nd integer :: n logical :: canNotDecomp - + canNotDecomp = .true. n = nd do while(canNotDecomp) @@ -1623,7 +1561,7 @@ function generate_new_decomp(im,nd) result(n) end if enddo end function generate_new_decomp - + subroutine init_halo(this, unusable, rc) class (LatLonGridFactory), target, intent(inout) :: this class (KeywordEnforcer), optional, intent(in) :: unusable @@ -1659,7 +1597,7 @@ subroutine init_halo(this, unusable, rc) this%py = pet / this%nx this%is_halo_initialized = .true. - + _RETURN(_SUCCESS) end subroutine init_halo @@ -1688,7 +1626,7 @@ subroutine halo(this, array, unusable, halo_width, rc) call this%init_halo(rc=status) _VERIFY(status) end if - + associate (nx => this%nx, ny => this% ny, px => this%px, py => this%py) ! Nearest neighbors processor' ids pet_north = get_pet(px, py+1, nx, ny) @@ -1729,7 +1667,7 @@ subroutine fill_north(array, rc) integer :: len, last - last = size(array,2)-1 + last = size(array,2)-1 len = size(array,1) call MAPL_CommsSendRecv(this%layout, & @@ -1754,7 +1692,7 @@ subroutine fill_south(array, rc) integer :: len, last - last = size(array,2)-1 + last = size(array,2)-1 len = size(array,1) call MAPL_CommsSendRecv(this%layout, & @@ -1780,7 +1718,7 @@ subroutine fill_east(array, rc) integer :: len, last - last = size(array,2)-1 + last = size(array,2)-1 len = size(array,1) call MAPL_CommsSendRecv(this%layout, & @@ -1826,7 +1764,7 @@ subroutine append_metadata(this, metadata) type (Variable) :: v real(kind=REAL64), allocatable :: temp_coords(:) - + ! Horizontal grid dimensions call metadata%add_dimension('lon', this%im_world) call metadata%add_dimension('lat', this%jm_world) @@ -1897,8 +1835,8 @@ subroutine generate_file_bounds(this,grid,local_start,global_start,global_count, allocate(local_start,source=[i1,j1]) allocate(global_start,source=[1,1]) allocate(global_count,source=[global_dim(1),global_dim(2)]) - - _RETURN(_SUCCESS) + + _RETURN(_SUCCESS) end subroutine generate_file_bounds @@ -1929,7 +1867,7 @@ function generate_file_reference2D(this,fpointer) result(ref) _UNUSED_DUMMY(this) ref = ArrayReference(fpointer) end function generate_file_reference2D - + function generate_file_reference3D(this,fpointer,metaData) result(ref) use pFIO type(ArrayReference) :: ref @@ -1939,6 +1877,6 @@ function generate_file_reference3D(this,fpointer,metaData) result(ref) _UNUSED_DUMMY(this) ref = ArrayReference(fpointer) end function generate_file_reference3D - + end module MAPL_LatLonGridFactoryMod From caf03d7e59e5b34868f268f8da9770f1cc4269ac Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 9 Aug 2022 09:58:01 -0400 Subject: [PATCH 251/300] fixed typo --- pfio/HistoryCollection.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pfio/HistoryCollection.F90 b/pfio/HistoryCollection.F90 index 13ab72b32da6..0225f133af86 100644 --- a/pfio/HistoryCollection.F90 +++ b/pfio/HistoryCollection.F90 @@ -45,7 +45,7 @@ function new_HistoryCollection(fmd, option) result(collection) collection%create_mode = NF90_CLOBBER if (present(option)) then if (option == -2) then - collection%ceate_mode = NF90_NOCLOBBER + collection%create_mode = NF90_NOCLOBBER endif endif From 9974f363f63e83ee0f3b6ccd46b90dd84ab3cfde Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 9 Aug 2022 14:37:20 -0400 Subject: [PATCH 252/300] pass mode to server --- pfio/AddHistCollectionMessage.F90 | 6 +++--- pfio/ClientManager.F90 | 5 +++-- pfio/ClientThread.F90 | 6 ++++-- 3 files changed, 10 insertions(+), 7 deletions(-) diff --git a/pfio/AddHistCollectionMessage.F90 b/pfio/AddHistCollectionMessage.F90 index 9895ca028fe5..4ce8e17e0a74 100644 --- a/pfio/AddHistCollectionMessage.F90 +++ b/pfio/AddHistCollectionMessage.F90 @@ -31,12 +31,12 @@ module pFIO_AddHistCollectionMessageMod contains - function new_AddHistCollectionMessage(fmd, collection_id) result(message) + function new_AddHistCollectionMessage(fmd, mode) result(message) type (AddHistCollectionMessage) :: message type(FileMetadata), intent(in) :: fmd - integer, optional, intent(in) :: collection_id + integer, optional, intent(in) :: mode message%fmd = fmd - if( present(collection_id)) message%collection_id = collection_id + if( present(mode)) message%collection_id = mode end function new_AddHistCollectionMessage diff --git a/pfio/ClientManager.F90 b/pfio/ClientManager.F90 index 6439a5ed91d2..6d2e70788018 100644 --- a/pfio/ClientManager.F90 +++ b/pfio/ClientManager.F90 @@ -130,18 +130,19 @@ function add_ext_collection(this, template, unusable, rc) result(collection_id) _UNUSED_DUMMY(unusable) end function add_ext_collection - function add_hist_collection(this, fmd, unusable, rc) result(hist_collection_id) + function add_hist_collection(this, fmd, unusable,mode, rc) result(hist_collection_id) integer :: hist_collection_id class (ClientManager), intent(inout) :: this type(FileMetadata),intent(in) :: fmd class (KeywordEnforcer), optional, intent(out) :: unusable + integer, optional, intent(in) :: mode integer, optional, intent(out) :: rc class (ClientThread), pointer :: clientPtr integer :: i do i = 1, this%size() ClientPtr => this%clients%at(i) - hist_collection_id = clientPtr%add_hist_collection(fmd) + hist_collection_id = clientPtr%add_hist_collection(fmd, mode=mode) enddo _RETURN(_SUCCESS) diff --git a/pfio/ClientThread.F90 b/pfio/ClientThread.F90 index 50adf0fff852..089015884d3e 100644 --- a/pfio/ClientThread.F90 +++ b/pfio/ClientThread.F90 @@ -128,10 +128,12 @@ function add_ext_collection(this, template, rc) result(collection_id) _RETURN(_SUCCESS) end function add_ext_collection - function add_hist_collection(this, fmd, rc) result(hist_collection_id) + function add_hist_collection(this, fmd, unusable, mode, rc) result(hist_collection_id) integer :: hist_collection_id class (ClientThread), intent(inout) :: this type(FileMetadata),intent(in) :: fmd + class (KeywordEnforcer), optional, intent(out) :: unusable + integer, optional, intent(in) :: mode integer, optional, intent(out) :: rc class (AbstractMessage), pointer :: message @@ -139,7 +141,7 @@ function add_hist_collection(this, fmd, rc) result(hist_collection_id) integer :: status connection=>this%get_connection() - call connection%send(AddHistCollectionMessage(fmd)) + call connection%send(AddHistCollectionMessage(fmd, mode=mode)) message => connection%receive() select type(message) From 3549a2a84c66dad54a9ebf152c34047fc2dbc1fd Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 10 Aug 2022 12:43:19 -0400 Subject: [PATCH 253/300] pass create_mode to pfio server --- gridcomps/History/MAPL_HistoryGridComp.F90 | 16 ++++++------- pfio/AddHistCollectionMessage.F90 | 16 ++++++------- pfio/ClientManager.F90 | 20 ---------------- pfio/ClientThread.F90 | 28 ---------------------- pfio/HistoryCollection.F90 | 10 +++----- pfio/ServerThread.F90 | 14 +++-------- 6 files changed, 21 insertions(+), 83 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index c5b68118db15..1e04bd84aeba 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -45,6 +45,7 @@ module MAPL_HistoryGridCompMod use regex_module use MAPL_TimeUtilsMod, only: is_valid_time, is_valid_date use gFTL_StringStringMap + use netcdf !use ESMF_CFIOMOD implicit none @@ -116,7 +117,6 @@ module MAPL_HistoryGridCompMod logical :: integer_time integer :: collectionWriteSplit integer :: serverSizeSplit - logical :: allow_overwrite end type HISTORY_STATE type HISTORY_wrap @@ -428,6 +428,8 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) type(StringStringMap) :: global_attributes character(len=ESMF_MAXSTR) :: name,regrid_method logical :: has_conservative_keyword, has_regrid_keyword + logical :: allow_overwrite + integer :: create_mode ! Begin !------ @@ -538,9 +540,11 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) call ESMF_ConfigGetAttribute(config, value=cFileOrder, & label='FileOrder:', default='ABC', rc=status) _VERIFY(STATUS) - call ESMF_ConfigGetAttribute(config, value=intState%allow_overwrite, & + call ESMF_ConfigGetAttribute(config, value=allow_overwrite, & label='Allow_Overwrite:', default=.false., _RC) - + create_mode = NF90_NOCLOBBER ! defaut no overwrite + if (allow_overwrite) create_mode = NF90_CLOBBER + if (trim(cFileOrder) == 'ABC') then intstate%fileOrderAlphabetical = .true. else if (trim(cFileOrder) == 'AddOrder') then @@ -2532,7 +2536,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) call list(n)%mGriddedIO%CreateFileMetaData(list(n)%items,list(n)%bundle,list(n)%timeInfo,vdata=list(n)%vdata,global_attributes=global_attributes,rc=status) _VERIFY(status) end if - collection_id = o_Clients%add_hist_collection(list(n)%mGriddedIO%metadata) + collection_id = o_Clients%add_hist_collection(list(n)%mGriddedIO%metadata, mode = create_mode) call list(n)%mGriddedIO%set_param(write_collection_id=collection_id) end if end if @@ -3630,10 +3634,6 @@ subroutine Run ( gc, import, export, clock, rc ) else if( list(n)%unit.eq.0 ) then if (list(n)%format == 'CFIO') then - if (.not.intState%allow_overwrite) then - inquire (file=trim(filename(n)),exist=file_exists) - _ASSERT(.not.file_exists,trim(filename(n))//" being created for History output already exists") - end if call list(n)%mGriddedIO%modifyTime(oClients=o_Clients,rc=status) _VERIFY(status) list(n)%currentFile = filename(n) diff --git a/pfio/AddHistCollectionMessage.F90 b/pfio/AddHistCollectionMessage.F90 index 4ce8e17e0a74..6ea7d07f391f 100644 --- a/pfio/AddHistCollectionMessage.F90 +++ b/pfio/AddHistCollectionMessage.F90 @@ -6,6 +6,7 @@ module pFIO_AddHistCollectionMessageMod use pFIO_UtilitiesMod use pFIO_AbstractMessageMod use pFIO_FileMetadataMod + use netcdf implicit none private @@ -13,11 +14,7 @@ module pFIO_AddHistCollectionMessageMod type, extends(AbstractMessage) :: AddHistCollectionMessage type(FileMetadata) :: fmd - ! WY node: -1 : add (clobber, default ) - ! other : replace - ! overload collection_id of the message - ! -2 : add and no_clobber for these series of files - integer :: collection_id = -1 + integer :: create_mode contains procedure, nopass :: get_type_id procedure :: get_length @@ -36,7 +33,8 @@ function new_AddHistCollectionMessage(fmd, mode) result(message) type(FileMetadata), intent(in) :: fmd integer, optional, intent(in) :: mode message%fmd = fmd - if( present(mode)) message%collection_id = mode + message%create_mode = NF90_NOCLOBBER + if( present(mode)) message%create_mode = mode end function new_AddHistCollectionMessage @@ -49,7 +47,7 @@ integer function get_length(this) result(length) class (AddHistCollectionMessage), intent(in) :: this integer,allocatable :: buffer(:) ! no-op call this%fmd%serialize(buffer) - length = size(buffer) + 1 ! 1 is the collection_id + length = size(buffer) + 1 ! 1 is the create_mode end function get_length @@ -62,7 +60,7 @@ subroutine serialize(this, buffer, rc) integer :: status call this%fmd%serialize(tmp_buffer, status) _VERIFY(status) - buffer = [tmp_buffer,serialize_intrinsic(this%collection_id)] + buffer = [tmp_buffer,serialize_intrinsic(this%create_mode)] _RETURN(_SUCCESS) end subroutine serialize @@ -78,7 +76,7 @@ subroutine deserialize(this, buffer,rc) _VERIFY(status) call deserialize_intrinsic(buffer(n:), length) n = n + length - call deserialize_intrinsic(buffer(n:), this%collection_id) + call deserialize_intrinsic(buffer(n:), this%create_mode) _RETURN(_SUCCESS) end subroutine deserialize diff --git a/pfio/ClientManager.F90 b/pfio/ClientManager.F90 index 6d2e70788018..fc19ebadb6b6 100644 --- a/pfio/ClientManager.F90 +++ b/pfio/ClientManager.F90 @@ -38,7 +38,6 @@ module pFIO_ClientManagerMod contains procedure :: add_ext_collection procedure :: add_hist_collection - procedure :: replace_hist_collection procedure :: modify_metadata procedure :: modify_metadata_all procedure :: prefetch_data @@ -149,25 +148,6 @@ function add_hist_collection(this, fmd, unusable,mode, rc) result(hist_collectio _UNUSED_DUMMY(unusable) end function add_hist_collection - subroutine replace_hist_collection(this, hist_collection_id, fmd, unusable, rc) - class (ClientManager), intent(inout) :: this - integer, intent(in) :: hist_collection_id - type(FileMetadata),intent(in) :: fmd - class (KeywordEnforcer), optional, intent(out) :: unusable - integer, optional, intent(out) :: rc - - class (ClientThread), pointer :: clientPtr - integer :: i - - do i = 1, this%size() - ClientPtr => this%clients%at(i) - call clientPtr%replace_hist_collection(hist_collection_id, fmd) - enddo - - _RETURN(_SUCCESS) - _UNUSED_DUMMY(unusable) - end subroutine replace_hist_collection - subroutine prefetch_data(this, collection_id, file_name, var_name, data_reference, & & unusable, start, rc) class (ClientManager), intent(inout) :: this diff --git a/pfio/ClientThread.F90 b/pfio/ClientThread.F90 index 089015884d3e..0a302bb552e1 100644 --- a/pfio/ClientThread.F90 +++ b/pfio/ClientThread.F90 @@ -56,7 +56,6 @@ module pFIO_ClientThreadMod contains procedure :: add_ext_collection procedure :: add_hist_collection - procedure :: replace_hist_collection procedure :: modify_metadata procedure :: prefetch_data procedure :: stage_data @@ -154,33 +153,6 @@ function add_hist_collection(this, fmd, unusable, mode, rc) result(hist_collect _RETURN(_SUCCESS) end function add_hist_collection - subroutine replace_hist_collection(this,hist_collection_id,fmd, rc) - class (ClientThread), intent(inout) :: this - integer, intent(in) :: hist_collection_id - type(FileMetadata),intent(in) :: fmd - integer, optional, intent(out) :: rc - - integer :: return_id - - class (AbstractMessage), pointer :: message - class(AbstractSocket),pointer :: connection - integer :: status - - connection=>this%get_connection() - call connection%send(AddHistCollectionMessage(fmd,hist_collection_id),_RC) - - message => connection%receive() - select type(message) - type is(IDMessage) - return_id = message%id - class default - _FAIL( " should get id message") - end select - - _ASSERT( return_id == hist_collection_id, "return id should be the same as the collection_id") - _RETURN(_SUCCESS) - end subroutine replace_hist_collection - function prefetch_data(this, collection_id, file_name, var_name, data_reference, & & unusable, start, rc) result(request_id) class (ClientThread), intent(inout) :: this diff --git a/pfio/HistoryCollection.F90 b/pfio/HistoryCollection.F90 index 0225f133af86..e8c4d9aff05a 100644 --- a/pfio/HistoryCollection.F90 +++ b/pfio/HistoryCollection.F90 @@ -35,19 +35,15 @@ module pFIO_HistoryCollectionMod contains - function new_HistoryCollection(fmd, option) result(collection) + function new_HistoryCollection(fmd, create_mode) result(collection) type (HistoryCollection) :: collection type (FilemetaData), intent(in) :: fmd - integer, optional, intent(in) :: option + integer, optional, intent(in) :: create_mode collection%fmd = fmd collection%formatters = StringNetCDF4_FileFormatterMap() collection%create_mode = NF90_CLOBBER - if (present(option)) then - if (option == -2) then - collection%create_mode = NF90_NOCLOBBER - endif - endif + if (present(create_mode)) collection%create_mode = create_mode end function new_HistoryCollection diff --git a/pfio/ServerThread.F90 b/pfio/ServerThread.F90 index ecf044930e96..d067f07c14e1 100644 --- a/pfio/ServerThread.F90 +++ b/pfio/ServerThread.F90 @@ -531,18 +531,10 @@ subroutine handle_AddHistCollection(this, message, rc) class(AbstractSocket),pointer :: connection if (associated(ioserver_profiler)) call ioserver_profiler%start("add_Histcollection") - if ( message%collection_id == -1 .or. message%collection_id == -2 ) then - n = this%hist_collections%size()+1 - else - n = message%collection_id - endif - hist_collection = HistoryCollection(message%fmd, message%collection_id) - if ( message%collection_id == -1 .or. message%collection_id == -2 ) then - call this%hist_collections%push_back(hist_collection) - else - call this%hist_collections%set(n,hist_collection) - endif + n = this%hist_collections%size()+1 + hist_collection = HistoryCollection(message%fmd, message%create_mode) + call this%hist_collections%push_back(hist_collection) connection=>this%get_connection() call connection%send(IdMessage(n),_RC) From e553399650d782547b92581210ca12375221e25c Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 10 Aug 2022 12:47:54 -0400 Subject: [PATCH 254/300] changelog --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 15fabaaf4ca5..a9ad546a31cb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +- Add an option to overwrite history output + ### Changed ### Removed From e4b945b7b979f7c8e24f43eb6ec74f8e29efa9ea Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang <52509753+weiyuan-jiang@users.noreply.github.com> Date: Wed, 10 Aug 2022 13:03:10 -0400 Subject: [PATCH 255/300] Update HistoryCollection.F90 --- pfio/HistoryCollection.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pfio/HistoryCollection.F90 b/pfio/HistoryCollection.F90 index e8c4d9aff05a..63f93cb4d544 100644 --- a/pfio/HistoryCollection.F90 +++ b/pfio/HistoryCollection.F90 @@ -42,7 +42,7 @@ function new_HistoryCollection(fmd, create_mode) result(collection) collection%fmd = fmd collection%formatters = StringNetCDF4_FileFormatterMap() - collection%create_mode = NF90_CLOBBER + collection%create_mode = NF90_NOCLOBBER if (present(create_mode)) collection%create_mode = create_mode end function new_HistoryCollection From fd1039fc612e6e19604581a2bf9c351ce83b0b95 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 10 Aug 2022 16:50:01 -0400 Subject: [PATCH 256/300] define some pfio constants to keep netcdf out of history --- gridcomps/History/MAPL_HistoryGridComp.F90 | 8 +++---- pfio/HistoryCollection.F90 | 2 +- pfio/NetCDF4_FileFormatter.F90 | 27 ++++++++++++++++++---- pfio/pFIO_Constants.F90 | 7 ++++++ 4 files changed, 34 insertions(+), 10 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 1e04bd84aeba..733f4e1abd06 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -40,12 +40,12 @@ module MAPL_HistoryGridCompMod use MAPL_GriddedIOitemMod use pFIO_ClientManagerMod, only: o_Clients use pFIO_DownbitMod, only: pFIO_DownBit + use pFIO_ConstantsMod use HistoryTrajectoryMod use MAPL_StringTemplate use regex_module use MAPL_TimeUtilsMod, only: is_valid_time, is_valid_date use gFTL_StringStringMap - use netcdf !use ESMF_CFIOMOD implicit none @@ -542,8 +542,8 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) _VERIFY(STATUS) call ESMF_ConfigGetAttribute(config, value=allow_overwrite, & label='Allow_Overwrite:', default=.false., _RC) - create_mode = NF90_NOCLOBBER ! defaut no overwrite - if (allow_overwrite) create_mode = NF90_CLOBBER + create_mode = PFIO_NOCLOBBER ! defaut no overwrite + if (allow_overwrite) create_mode = PFIO_CLOBBER if (trim(cFileOrder) == 'ABC') then intstate%fileOrderAlphabetical = .true. @@ -3393,7 +3393,7 @@ subroutine Run ( gc, import, export, clock, rc ) integer :: sec ! variables for "backwards" mode - logical :: fwd, file_exists + logical :: fwd logical, allocatable :: Ignore(:) ! ErrLog vars diff --git a/pfio/HistoryCollection.F90 b/pfio/HistoryCollection.F90 index 63f93cb4d544..3d600d3e584e 100644 --- a/pfio/HistoryCollection.F90 +++ b/pfio/HistoryCollection.F90 @@ -42,7 +42,7 @@ function new_HistoryCollection(fmd, create_mode) result(collection) collection%fmd = fmd collection%formatters = StringNetCDF4_FileFormatterMap() - collection%create_mode = NF90_NOCLOBBER + collection%create_mode = PFIO_NOCLOBBER if (present(create_mode)) collection%create_mode = create_mode end function new_HistoryCollection diff --git a/pfio/NetCDF4_FileFormatter.F90 b/pfio/NetCDF4_FileFormatter.F90 index 382921e4b9c3..ace66d4400dd 100644 --- a/pfio/NetCDF4_FileFormatter.F90 +++ b/pfio/NetCDF4_FileFormatter.F90 @@ -150,12 +150,21 @@ subroutine create(this, file, unusable, mode, rc) integer :: status integer :: mode_ + integer :: pfio_mode if (present(mode)) then - mode_=mode + pfio_mode=mode else - mode_=NF90_CLOBBER + pfio_mode=PFIO_CLOBBER end if + + select case (pfio_mode) + case (pFIO_CLOBBER) + mode_ = NF90_CLOBBER + case (pFIO_NOCLOBBER) + mode_ = NF90_NOCLOBBER + end select + !$omp critical status = nf90_create(file, IOR(mode_, NF90_NETCDF4), this%ncid) !$omp end critical @@ -175,17 +184,25 @@ subroutine create_par(this, file, unusable, mode, comm, info, rc) integer, optional, intent(in) :: info integer, optional, intent(out) :: rc - integer :: comm_ + integer :: comm_, integer :: info_ integer :: status integer :: mode_ + integer :: pfio_mode if (present(mode)) then - mode_=mode + pfio_mode=mode else - mode_=NF90_CLOBBER + pfio_mode=PFIO_CLOBBER end if + select case (pfio_mode) + case (pFIO_CLOBBER) + mode_ = NF90_CLOBBER + case (pFIO_NOCLOBBER) + mode_ = NF90_NOCLOBBER + end select + if (present(comm)) then comm_ = comm else diff --git a/pfio/pFIO_Constants.F90 b/pfio/pFIO_Constants.F90 index 1edb709377e5..ce3b8a1eaa9e 100644 --- a/pfio/pFIO_Constants.F90 +++ b/pfio/pFIO_Constants.F90 @@ -24,6 +24,8 @@ module pFIO_ConstantsMod ! IO modes public :: pFIO_WRITE public :: pFIO_READ + public :: pFIO_CLOBBER + public :: pFIO_NOCLOBBER public :: pFIO_s_tag public :: pFIO_m_w_tag public :: pFIO_w_m_tag @@ -58,6 +60,11 @@ module pFIO_ConstantsMod enumerator :: pFIO_WRITE end enum + enum, bind(C) + enumerator :: pFIO_CLOBBER + enumerator :: pFIO_NOCLOBBER + end enum + integer, parameter :: pFIO_s_tag = 9999 integer, parameter :: pFIO_m_w_tag = 8888 integer, parameter :: pFIO_w_m_tag = 7777 From 491f987d06d3544de035a3a2ee93eea28c8dec51 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 10 Aug 2022 16:55:41 -0400 Subject: [PATCH 257/300] fix bug --- pfio/AddHistCollectionMessage.F90 | 4 ++-- pfio/NetCDF4_FileFormatter.F90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/pfio/AddHistCollectionMessage.F90 b/pfio/AddHistCollectionMessage.F90 index 6ea7d07f391f..d4f813ac4465 100644 --- a/pfio/AddHistCollectionMessage.F90 +++ b/pfio/AddHistCollectionMessage.F90 @@ -6,7 +6,7 @@ module pFIO_AddHistCollectionMessageMod use pFIO_UtilitiesMod use pFIO_AbstractMessageMod use pFIO_FileMetadataMod - use netcdf + use pFIO_ConstantsMod implicit none private @@ -33,7 +33,7 @@ function new_AddHistCollectionMessage(fmd, mode) result(message) type(FileMetadata), intent(in) :: fmd integer, optional, intent(in) :: mode message%fmd = fmd - message%create_mode = NF90_NOCLOBBER + message%create_mode = PFIO_NOCLOBBER if( present(mode)) message%create_mode = mode end function new_AddHistCollectionMessage diff --git a/pfio/NetCDF4_FileFormatter.F90 b/pfio/NetCDF4_FileFormatter.F90 index ace66d4400dd..bddae585035b 100644 --- a/pfio/NetCDF4_FileFormatter.F90 +++ b/pfio/NetCDF4_FileFormatter.F90 @@ -184,7 +184,7 @@ subroutine create_par(this, file, unusable, mode, comm, info, rc) integer, optional, intent(in) :: info integer, optional, intent(out) :: rc - integer :: comm_, + integer :: comm_ integer :: info_ integer :: status integer :: mode_ From db0bb598147bfee41897eca7fe262fde675f0f07 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 10 Aug 2022 16:58:40 -0400 Subject: [PATCH 258/300] update changelog verbiage --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index a9ad546a31cb..3ed3ea5442d9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,7 +11,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added -- Add an option to overwrite history output +- Add an option to PFIO Server to allow for either clobbering or stopping execution if a pre-existing file exists before application starts ### Changed From c0845010390fcf296caf73f41226e431bc3ea0ab Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Thu, 11 Aug 2022 10:05:57 -0400 Subject: [PATCH 259/300] change default --- pfio/NetCDF4_FileFormatter.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pfio/NetCDF4_FileFormatter.F90 b/pfio/NetCDF4_FileFormatter.F90 index bddae585035b..740081c517e7 100644 --- a/pfio/NetCDF4_FileFormatter.F90 +++ b/pfio/NetCDF4_FileFormatter.F90 @@ -155,7 +155,7 @@ subroutine create(this, file, unusable, mode, rc) if (present(mode)) then pfio_mode=mode else - pfio_mode=PFIO_CLOBBER + pfio_mode=PFIO_NOCLOBBER end if select case (pfio_mode) @@ -193,7 +193,7 @@ subroutine create_par(this, file, unusable, mode, comm, info, rc) if (present(mode)) then pfio_mode=mode else - pfio_mode=PFIO_CLOBBER + pfio_mode=PFIO_NOCLOBBER end if select case (pfio_mode) From d230d986e03fdb47ce79faec59df59197495fe97 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 15 Aug 2022 14:59:15 -0400 Subject: [PATCH 260/300] revert changes to allow PFIO server to remember last file created and keep check in history --- CHANGELOG.md | 2 -- pfio/HistoryCollection.F90 | 44 +++++--------------------------------- pfio/ServerThread.F90 | 2 +- 3 files changed, 6 insertions(+), 42 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3ed3ea5442d9..15fabaaf4ca5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,8 +11,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added -- Add an option to PFIO Server to allow for either clobbering or stopping execution if a pre-existing file exists before application starts - ### Changed ### Removed diff --git a/pfio/HistoryCollection.F90 b/pfio/HistoryCollection.F90 index 3d600d3e584e..7822ea810534 100644 --- a/pfio/HistoryCollection.F90 +++ b/pfio/HistoryCollection.F90 @@ -9,8 +9,6 @@ module pFIO_HistoryCollectionMod use pFIO_FileMetadataMod use pFIO_StringVariableMapMod use pFIO_ConstantsMod - use gFTL_StringVector - use NetCDF implicit none private @@ -19,14 +17,12 @@ module pFIO_HistoryCollectionMod type :: HistoryCollection type (Filemetadata) :: fmd - character(len=:), allocatable :: last_file_created type (StringNetCDF4_FileFormatterMap) :: formatters - integer :: create_mode + contains procedure :: find procedure :: ModifyMetadata procedure :: clear - procedure :: check_if_i_created end type HistoryCollection interface HistoryCollection @@ -35,15 +31,12 @@ module pFIO_HistoryCollectionMod contains - function new_HistoryCollection(fmd, create_mode) result(collection) + function new_HistoryCollection(fmd) result(collection) type (HistoryCollection) :: collection type (FilemetaData), intent(in) :: fmd - integer, optional, intent(in) :: create_mode collection%fmd = fmd collection%formatters = StringNetCDF4_FileFormatterMap() - collection%create_mode = PFIO_NOCLOBBER - if (present(create_mode)) collection%create_mode = create_mode end function new_HistoryCollection @@ -58,28 +51,18 @@ function find(this, file_name,rc) result(formatter) type(StringNetCDF4_FileFormatterMapIterator) :: iter integer :: status character(len=*), parameter :: Iam = "HistoryCollection::find()" - logical :: f_exist, i_created + logical :: f_exist iter = this%formatters%find(trim(file_name)) if (iter == this%formatters%end()) then inquire(file=file_name, exist=f_exist) - if(.not. f_exist) then + if(.not. f_exist) then call fm%create(trim(file_name),rc=status) _VERIFY(status) call fm%write(this%fmd, rc=status) _VERIFY(status) - this%last_file_created = trim(file_name) else - i_created = this%check_if_i_created(file_name) - if (i_created) then - call fm%open(trim(file_name), pFIO_WRITE) - else - call fm%create(trim(file_name),mode=this%create_mode,rc=status) - _VERIFY(status) - call fm%write(this%fmd, rc=status) - _VERIFY(status) - this%last_file_created=trim(file_name) - end if + call fm%open(trim(file_name), pFIO_WRITE) endif call this%formatters%insert( trim(file_name),fm) iter = this%formatters%find(trim(file_name)) @@ -129,23 +112,6 @@ subroutine clear(this, rc) _RETURN(_SUCCESS) end subroutine clear - function check_if_i_created(this,input_file,rc) result(i_created) - logical :: i_created - class (HistoryCollection), intent(inout) :: this - character(len=*), intent(in) :: input_file - integer, optional, intent(out) :: rc - - integer :: status - - i_created = .false. - if (allocated(this%last_file_created)) then - if (input_file == this%last_file_created) i_created=.true. - end if - - _RETURN(_SUCCESS) - - end function - end module pFIO_HistoryCollectionMod diff --git a/pfio/ServerThread.F90 b/pfio/ServerThread.F90 index d067f07c14e1..e09e8a944229 100644 --- a/pfio/ServerThread.F90 +++ b/pfio/ServerThread.F90 @@ -533,7 +533,7 @@ subroutine handle_AddHistCollection(this, message, rc) if (associated(ioserver_profiler)) call ioserver_profiler%start("add_Histcollection") n = this%hist_collections%size()+1 - hist_collection = HistoryCollection(message%fmd, message%create_mode) + hist_collection = HistoryCollection(message%fmd) call this%hist_collections%push_back(hist_collection) connection=>this%get_connection() From 79f2f8aacecfcc692e128b06dbce3fcc773834af Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 15 Aug 2022 16:28:11 -0400 Subject: [PATCH 261/300] add back check for existence in history --- gridcomps/History/MAPL_HistoryGridComp.F90 | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 733f4e1abd06..bc96b7ab6e73 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -117,6 +117,7 @@ module MAPL_HistoryGridCompMod logical :: integer_time integer :: collectionWriteSplit integer :: serverSizeSplit + logical :: allow_overwrite end type HISTORY_STATE type HISTORY_wrap @@ -428,7 +429,6 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) type(StringStringMap) :: global_attributes character(len=ESMF_MAXSTR) :: name,regrid_method logical :: has_conservative_keyword, has_regrid_keyword - logical :: allow_overwrite integer :: create_mode ! Begin @@ -540,10 +540,10 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) call ESMF_ConfigGetAttribute(config, value=cFileOrder, & label='FileOrder:', default='ABC', rc=status) _VERIFY(STATUS) - call ESMF_ConfigGetAttribute(config, value=allow_overwrite, & + call ESMF_ConfigGetAttribute(config, value=intState%allow_overwrite, & label='Allow_Overwrite:', default=.false., _RC) create_mode = PFIO_NOCLOBBER ! defaut no overwrite - if (allow_overwrite) create_mode = PFIO_CLOBBER + if (intState%allow_overwrite) create_mode = PFIO_CLOBBER if (trim(cFileOrder) == 'ABC') then intstate%fileOrderAlphabetical = .true. @@ -3398,6 +3398,7 @@ subroutine Run ( gc, import, export, clock, rc ) ! ErrLog vars integer :: status + logical :: file_exists !============================================================================= @@ -3634,6 +3635,10 @@ subroutine Run ( gc, import, export, clock, rc ) else if( list(n)%unit.eq.0 ) then if (list(n)%format == 'CFIO') then + if (.not.intState%allow_overwrite) then + inquire (file=trim(filename(n)),exist=file_exists) + _ASSERT(.not.file_exists,trim(filename(n))//" being created for History output already exists") + end if call list(n)%mGriddedIO%modifyTime(oClients=o_Clients,rc=status) _VERIFY(status) list(n)%currentFile = filename(n) From babe3e5c8d3798c949d8281325d7b3f6d9f4752c Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 16 Aug 2022 11:42:54 -0400 Subject: [PATCH 262/300] Add INSTALL_SOURCE_TARFILE to MAPL standalone --- CHANGELOG.md | 3 +++ CMakeLists.txt | 15 ++++++++++++++- 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 15fabaaf4ca5..0b3f4b4c513c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +- Add option to build source tarfile when building MAPL standalone. By default this is `OFF`, but can be enabled with + `-DINSTALL_SOURCE_TARFILE=ON` + ### Changed ### Removed diff --git a/CMakeLists.txt b/CMakeLists.txt index 78661e6b04e7..bdeb2c5e796e 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -26,6 +26,7 @@ set (ESMA_CMAKE_DIRS foreach (dir IN LISTS ESMA_CMAKE_DIRS) if (EXISTS ${CMAKE_CURRENT_LIST_DIR}/${dir}) list (APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}/${dir}") + set (ESMA_CMAKE_PATH "${CMAKE_CURRENT_LIST_DIR}/${dir}" CACHE PATH "Path to ESMA_cmake code") include (esma) set(MAPL_STANDALONE TRUE) endif () @@ -220,5 +221,17 @@ ecbuild_install_project (NAME MAPL) # This must be after ecbuild_install_project if (MAPL_STANDALONE) - include (esma_cpack OPTIONAL) + include (esma_cpack OPTIONAL RESULT_VARIABLE esma_cpack_FOUND) + if (esma_cpack_FOUND) + message(STATUS "esma_cpack_FOUND: ${esma_cpack_FOUND}") + + # This installs a tarball of the source code + # in the installation directory. + # MUST BE THE LAST CODE IN THIS FILE + option(INSTALL_SOURCE_TARFILE "Create and install source tarfile" OFF) + if(INSTALL_SOURCE_TARFILE) + install(CODE "set(CMAKE_PROJECT_NAME \"${CMAKE_PROJECT_NAME}\")") + install(SCRIPT "${ESMA_CMAKE_PATH}/esma_postinstall.cmake") + endif() + endif () endif () From 979e779fde5fae3d5cf23f15e32405a8f2005a53 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 16 Aug 2022 12:34:08 -0400 Subject: [PATCH 263/300] Trivial commit to trigger new CI --- CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index bdeb2c5e796e..74dfa08e874f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -221,6 +221,7 @@ ecbuild_install_project (NAME MAPL) # This must be after ecbuild_install_project if (MAPL_STANDALONE) + # We only care about CPack if MAPL is a standalone include (esma_cpack OPTIONAL RESULT_VARIABLE esma_cpack_FOUND) if (esma_cpack_FOUND) message(STATUS "esma_cpack_FOUND: ${esma_cpack_FOUND}") From 20c27154ab12c2c6e22042482fe993a5d4bdacf9 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 16 Aug 2022 13:24:24 -0400 Subject: [PATCH 264/300] Update bcs version --- .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 68383c174a69..4f925518719d 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -2,7 +2,7 @@ version: 2.1 # Anchors to prevent forgetting to update a version baselibs_version: &baselibs_version v7.5.0 -bcs_version: &bcs_version v10.22.3 +bcs_version: &bcs_version v10.22.5 orbs: ci: geos-esm/circleci-tools@1 From 5bf52741751765835397090662c0477484c6048a Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 17 Aug 2022 10:09:19 -0400 Subject: [PATCH 265/300] Update .gitignore --- .gitignore | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/.gitignore b/.gitignore index d51c0ed63e21..86c0ee8b8263 100644 --- a/.gitignore +++ b/.gitignore @@ -8,3 +8,10 @@ /.mepo/ *.py.bak CMakeUserPresets.json + +*.swp +*.swo +.DS_Store +*# +.#* +**/CVS/ From 809f94357ad06126200e36b7f361b2e86e9d3f28 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 23 Aug 2022 09:02:10 -0400 Subject: [PATCH 266/300] Fixes 1636. Add History regrid_method attribute --- CHANGELOG.md | 1 + base/RegridMethods.F90 | 38 ++++++++++++++++++++++++++++- griddedio/GriddedIO.F90 | 53 +++++++++++++++++++++-------------------- 3 files changed, 65 insertions(+), 27 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0b3f4b4c513c..2e48a3167305 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Add option to build source tarfile when building MAPL standalone. By default this is `OFF`, but can be enabled with `-DINSTALL_SOURCE_TARFILE=ON` +- Added `regrid_method` metadata to History output ### Changed diff --git a/base/RegridMethods.F90 b/base/RegridMethods.F90 index b8b809adc77a..be0e70dbe19b 100644 --- a/base/RegridMethods.F90 +++ b/base/RegridMethods.F90 @@ -19,6 +19,7 @@ module mapl_RegridMethods public :: UNSPECIFIED_REGRID_METHOD public :: TILING_METHODS public :: get_regrid_method + public :: translate_regrid_method enum, bind(c) enumerator :: REGRID_METHOD_IDENTITY @@ -59,7 +60,7 @@ function get_regrid_method(string_regrid_method) result(int_regrid_method) case ("VOTE") int_regrid_method = REGRID_METHOD_VOTE case ("FRACTION") - int_regrid_method = REGRID_METHOD_FRACTION + int_regrid_method = REGRID_METHOD_FRACTION case ("CONSERVE_2ND") int_regrid_method = REGRID_METHOD_CONSERVE_2ND case ("PATCH") @@ -70,9 +71,44 @@ function get_regrid_method(string_regrid_method) result(int_regrid_method) int_regrid_method = REGRID_METHOD_CONSERVE_MONOTONIC case ("BILINEAR_MONOTONIC") int_regrid_method = REGRID_METHOD_BILINEAR_MONOTONIC + case ("NEAREST_STOD") + int_regrid_method = REGRID_METHOD_NEAREST_STOD case default int_regrid_method = UNSPECIFIED_REGRID_METHOD end select end function + function translate_regrid_method(int_regrid_method) result(string_regrid_method) + integer, intent(in) :: int_regrid_method + character(len=:), allocatable, intent(out) :: string_regrid_method + + select case (int_regrid_method) + case (REGRID_METHOD_IDENTITY) + string_regrid_method = "identity" + case (REGRID_METHOD_BILINEAR) + string_regrid_method = "bilinear" + case (REGRID_METHOD_BILINEAR_ROTATE) + string_regrid_method = "bilinear_rotate" + case (REGRID_METHOD_CONSERVE) + string_regrid_method = "conserve" + case (REGRID_METHOD_VOTE) + string_regrid_method = "vote" + case (REGRID_METHOD_FRACTION) + string_regrid_method = "fraction" + case (REGRID_METHOD_CONSERVE_2ND) + string_regrid_method = "conserve_2nd" + case (REGRID_METHOD_PATCH) + string_regrid_method = "patch" + case (REGRID_METHOD_CONSERVE_HFLUX) + string_regrid_method = "conserve_hflux" + case (REGRID_METHOD_CONSERVE_MONOTONIC) + string_regrid_method = "conserve_monotonic" + case (REGRID_METHOD_BILINEAR_MONOTONIC) + string_regrid_method = "bilinear_monotonic" + case (REGRID_METHOD_NEAREST_STOD) + string_regrid_method = "nearest_stod" + case default + string_regrid_method = "unspecified_regrid_method" + end select + end function end module mapl_RegridMethods diff --git a/griddedio/GriddedIO.F90 b/griddedio/GriddedIO.F90 index 4e4deef7c8bc..9b45d56d2d0c 100644 --- a/griddedio/GriddedIO.F90 +++ b/griddedio/GriddedIO.F90 @@ -26,7 +26,7 @@ module MAPL_GriddedIOMod use, intrinsic :: iso_fortran_env, only: REAL64 use ieee_arithmetic, only: isnan => ieee_is_nan implicit none - + private type, public :: MAPL_GriddedIO @@ -92,7 +92,7 @@ function new_MAPL_GriddedIO(metadata,input_bundle,output_bundle,write_collection type(GriddedIOitemVector), intent(in), optional :: items integer, intent(out), optional :: rc - if (present(metadata)) GriddedIO%metadata=metadata + if (present(metadata)) GriddedIO%metadata=metadata if (present(input_bundle)) GriddedIO%input_bundle=input_bundle if (present(output_bundle)) GriddedIO%output_bundle=output_bundle if (present(regrid_method)) GriddedIO%regrid_method=regrid_method @@ -172,10 +172,10 @@ subroutine CreateFileMetaData(this,items,bundle,timeInfo,vdata,ogrid,global_attr order = this%metadata%get_order(rc=status) _VERIFY(status) metadataVarsSize = order%size() - + do while (iter /= this%items%end()) item => iter%get() - if (item%itemType == ItemTypeScalar) then + if (item%itemType == ItemTypeScalar) then call this%CreateVariable(item%xname,rc=status) _VERIFY(status) else if (item%itemType == ItemTypeVector) then @@ -186,7 +186,7 @@ subroutine CreateFileMetaData(this,items,bundle,timeInfo,vdata,ogrid,global_attr end if call iter%next() enddo - + if (this%itemOrderAlphabetical) then call this%alphabatize_variables(metadataVarsSize,rc=status) _VERIFY(status) @@ -195,9 +195,9 @@ subroutine CreateFileMetaData(this,items,bundle,timeInfo,vdata,ogrid,global_attr if (present(global_attributes)) then s_iter = global_attributes%begin() do while(s_iter /= global_attributes%end()) - attr_name => s_iter%key() + attr_name => s_iter%key() attr_val => s_iter%value() - call this%metadata%add_attribute(attr_name,attr_val,_RC) + call this%metadata%add_attribute(attr_name,attr_val,_RC) call s_iter%next() enddo end if @@ -303,7 +303,7 @@ subroutine CreateVariable(this,itemName,rc) class (MAPL_GriddedIO), intent(inout) :: this character(len=*), intent(in) :: itemName integer, optional, intent(out) :: rc - + integer :: status type(ESMF_Field) :: field,newField @@ -345,7 +345,7 @@ subroutine CreateVariable(this,itemName,rc) vdims=grid_dims//",time" else if (fieldRank==3) then vdims=grid_dims//",lev,time" - else + else _FAIL( 'Unsupported field rank') end if v = Variable(type=PFIO_REAL32,dimensions=vdims,chunksizes=this%chunking,deflation=this%deflateLevel) @@ -360,6 +360,7 @@ subroutine CreateVariable(this,itemName,rc) call v%add_attribute('add_offset',0.0) call v%add_attribute('_FillValue',MAPL_UNDEF) call v%add_attribute('valid_range',(/-MAPL_UNDEF,MAPL_UNDEF/)) + call v%add_attribute('regrid_method', translate_regrid_method(this%regrid_method)) call factory%append_variable_metadata(v) call this%metadata%add_variable(trim(varName),v,rc=status) _VERIFY(status) @@ -379,11 +380,11 @@ subroutine CreateVariable(this,itemName,rc) end subroutine CreateVariable - subroutine modifyTime(this, oClients, rc) + subroutine modifyTime(this, oClients, rc) class(MAPL_GriddedIO), intent(inout) :: this type (ClientManager), optional, intent(inout) :: oClients integer, optional, intent(out) :: rc - + type(Variable) :: v type(StringVariableMap) :: var_map integer :: status @@ -401,11 +402,11 @@ subroutine modifyTime(this, oClients, rc) end subroutine modifyTime - subroutine modifyTimeIncrement(this, frequency, rc) + subroutine modifyTimeIncrement(this, frequency, rc) class(MAPL_GriddedIO), intent(inout) :: this integer, intent(in) :: frequency integer, optional, intent(out) :: rc - + integer :: status call this%timeInfo%setFrequency(frequency, rc=status) @@ -432,7 +433,7 @@ subroutine bundlepost(this,filename,oClients,rc) this%times = this%timeInfo%compute_time_vector(this%metadata,rc=status) _VERIFY(status) ref = ArrayReference(this%times) - call oClients%stage_nondistributed_data(this%write_collection_id,trim(filename),'time',ref) + call oClients%stage_nondistributed_data(this%write_collection_id,trim(filename),'time',ref) tindex = size(this%times) if (tindex==1) then @@ -578,7 +579,7 @@ subroutine RegridScalar(this,itemName,rc) call MAPL_FieldGetPointer(OutField,outptr3d,rc=status) _VERIFY(status) else - allocate(outptr3d(0,0,0)) + allocate(outptr3d(0,0,0)) end if if (gridIn==gridOut) then outPtr3d=Ptr3d @@ -776,10 +777,10 @@ subroutine stage2DLatLon(this, fileName, oClients, rc) integer, allocatable :: localStart(:),globalStart(:),globalCount(:) logical :: hasll class(Variable), pointer :: var_lat,var_lon - + var_lon => this%metadata%get_variable('lons') var_lat => this%metadata%get_variable('lats') - + hasll = associated(var_lon) .and. associated(var_lat) if (hasll) then factory => get_factory(this%output_grid,rc=status) @@ -809,7 +810,7 @@ subroutine stage2DLatLon(this, fileName, oClients, rc) var_lon => this%metadata%get_variable('corner_lons') var_lat => this%metadata%get_variable('corner_lats') - + hasll = associated(var_lon) .and. associated(var_lat) if (hasll) then factory => get_factory(this%output_grid,rc=status) @@ -838,8 +839,8 @@ subroutine stage2DLatLon(this, fileName, oClients, rc) _RETURN(_SUCCESS) end subroutine stage2DLatLon - - subroutine stageData(this, field, fileName, tIndex, oClients, rc) + + subroutine stageData(this, field, fileName, tIndex, oClients, rc) class (MAPL_GriddedIO), intent(inout) :: this type(ESMF_Field), intent(inout) :: field character(len=*), intent(in) :: fileName @@ -912,7 +913,7 @@ subroutine alphabatize_variables(this,nfixedVars,rc) class (MAPL_GriddedIO), intent(inout) :: this integer, intent(in) :: nFixedVars integer, optional, intent(out) :: rc - + type(StringVector) :: order type(StringVector) :: newOrder character(len=:), pointer :: v1 @@ -930,7 +931,7 @@ subroutine alphabatize_variables(this,nfixedVars,rc) v1 => order%at(i) if ( i > nFixedVars) temp(i)=trim(v1) enddo - + swapped = .true. do while(swapped) swapped = .false. @@ -957,7 +958,7 @@ subroutine alphabatize_variables(this,nfixedVars,rc) deallocate(temp) _RETURN(_SUCCESS) - + end subroutine alphabatize_variables subroutine request_data_from_file(this,filename,timeindex,rc) @@ -1045,7 +1046,7 @@ subroutine request_data_from_file(this,filename,timeindex,rc) ref=factory%generate_file_reference3D(ptr3d,metadata=this%current_file_metadata%filemetadata) allocate(localStart,source=[gridLocalStart,1,timeIndex]) allocate(globalStart,source=[gridGlobalStart,1,timeIndex]) - allocate(globalCount,source=[gridGlobalCount,lm,1]) + allocate(globalCount,source=[gridGlobalCount,lm,1]) end if call i_Clients%collective_prefetch_data( & this%read_collection_id, fileName, trim(names(i)), & @@ -1063,7 +1064,7 @@ subroutine process_data_from_file(this,rc) class(mapl_GriddedIO), intent(inout) :: this integer, intent(out), optional :: rc - integer :: status + integer :: status integer :: i,numVars character(len=ESMF_MAXSTR), allocatable :: names(:) type(ESMF_Field) :: field @@ -1124,7 +1125,7 @@ subroutine swap_undef_value(this,fname,rc) endif fill_value = this%current_file_metadata%var_get_missing_value(fname,_RC) - + call ESMF_FieldBundleGet(this%input_bundle,fname,field=field,_RC) call ESMF_FieldBundleGet(this%input_bundle,grid=gridIn,_RC) call ESMF_FieldGet(field,rank=fieldRank,_RC) From d13e7bc8f451201457033b68194a18b23ae0e46f Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 23 Aug 2022 09:43:06 -0400 Subject: [PATCH 267/300] Result of a function is not intent(out) --- base/RegridMethods.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/base/RegridMethods.F90 b/base/RegridMethods.F90 index be0e70dbe19b..0253ab893057 100644 --- a/base/RegridMethods.F90 +++ b/base/RegridMethods.F90 @@ -80,7 +80,7 @@ function get_regrid_method(string_regrid_method) result(int_regrid_method) function translate_regrid_method(int_regrid_method) result(string_regrid_method) integer, intent(in) :: int_regrid_method - character(len=:), allocatable, intent(out) :: string_regrid_method + character(len=:), allocatable :: string_regrid_method select case (int_regrid_method) case (REGRID_METHOD_IDENTITY) From ede44f005f7ce28546109738e9fc4fbf2d3ceb6d Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 25 Aug 2022 07:21:48 -0400 Subject: [PATCH 268/300] add more on FileMetadata --- pfio/FileMetadata.F90 | 40 +++++++++++++++++++++++++++++++++ pfio/tests/Test_FileMetadata.pf | 21 +++++++++++++++++ 2 files changed, 61 insertions(+) diff --git a/pfio/FileMetadata.F90 b/pfio/FileMetadata.F90 index ba8cb785da30..188fa476d2fc 100644 --- a/pfio/FileMetadata.F90 +++ b/pfio/FileMetadata.F90 @@ -32,6 +32,7 @@ module pFIO_FileMetadataMod contains procedure :: get_dimensions + procedure :: get_global procedure :: add_dimension procedure :: get_dimension procedure :: modify_dimension @@ -50,6 +51,7 @@ module pFIO_FileMetadataMod procedure :: get_order procedure :: set_order procedure :: modify_variable + procedure :: remove_variable procedure :: has_dimension procedure :: has_variable @@ -101,6 +103,14 @@ function get_dimensions(this) result(dimensions) end function get_dimensions + function get_global(this) result(global) + type (Variable), pointer :: global + class (FileMetadata), target, intent(in) :: this + + global => this%global + + end function get_global + subroutine add_dimension(this, dim_name, extent, unusable, rc) class (FileMetadata), target, intent(inout) :: this @@ -393,6 +403,36 @@ subroutine add_variable(this, var_name, var, unusable, rc) _UNUSED_DUMMY(unusable) end subroutine add_variable + + subroutine remove_variable(this, var_name, unusable, rc) + class (FileMetadata), target, intent(inout) :: this + character(len=*), intent(in) :: var_name + class (KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + type (StringVectorIterator) :: order_iter + type (StringVariableMapIterator) :: var_iter + character(len=:), pointer :: var_ptr + + + order_iter = this%order%begin() + do while (order_iter /= this%order%end()) + var_ptr => order_iter%get() + if (var_ptr == var_name) then + call this%order%erase(order_iter) + exit + endif + enddo + + _ASSERT(order_iter /= this%order%end(), " No such variable") + var_iter = this%variables%find(var_name) + _ASSERT(var_iter /= this%variables%end(), " No such variable") + call this%variables%erase(var_iter) + call this%order%erase(order_iter) + _RETURN(_SUCCESS) + _UNUSED_DUMMY(unusable) + + end subroutine remove_variable subroutine modify_variable(this, var_name, var, unusable, rc) class (FileMetadata), target, intent(inout) :: this diff --git a/pfio/tests/Test_FileMetadata.pf b/pfio/tests/Test_FileMetadata.pf index ac1a80bf0830..10ed08665c23 100644 --- a/pfio/tests/Test_FileMetadata.pf +++ b/pfio/tests/Test_FileMetadata.pf @@ -405,6 +405,27 @@ contains end subroutine test_equal_diff_variables + @test + subroutine test_remove_variable() + type (FileMetadata) :: cf1, cf2 + type (Variable) :: v1, v2, v3 + + call cf1%add_dimension('x', 10) + call cf1%add_dimension('y', 20) + call cf1%add_dimension('z', 30) + cf2 = cf1 + v1 = Variable(type=pFIO_INT32, dimensions='x') + v2 = Variable(type=pFIO_REAL64, dimensions='x,y,z') + + call cf1%add_variable('v1', v1) + call cf2%add_variable('v1', v1) + call cf2%add_variable('v2', v2) + @assertTrue(cf1 /= cf2) + call cf2%remove_variable('v2') + @assertTrue(cf1 == cf2) + + end subroutine test_remove_variable + @test subroutine test_serialize() type (FileMetadata) :: cf1, cf2 From 73240f6079d89cd98bb0ce345047da820649da7c Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 25 Aug 2022 09:02:17 -0400 Subject: [PATCH 269/300] change log --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0b3f4b4c513c..c6c273556c70 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +- Add more member functions to FileMetadata - Add option to build source tarfile when building MAPL standalone. By default this is `OFF`, but can be enabled with `-DINSTALL_SOURCE_TARFILE=ON` From 31db066f8a0afdad47eccb52444fa6281b8a27df Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 25 Aug 2022 10:00:50 -0400 Subject: [PATCH 270/300] remove remove_variable --- pfio/FileMetadata.F90 | 31 ------------------------------- pfio/tests/Test_FileMetadata.pf | 21 --------------------- 2 files changed, 52 deletions(-) diff --git a/pfio/FileMetadata.F90 b/pfio/FileMetadata.F90 index 188fa476d2fc..f8436b7c05a4 100644 --- a/pfio/FileMetadata.F90 +++ b/pfio/FileMetadata.F90 @@ -51,7 +51,6 @@ module pFIO_FileMetadataMod procedure :: get_order procedure :: set_order procedure :: modify_variable - procedure :: remove_variable procedure :: has_dimension procedure :: has_variable @@ -404,36 +403,6 @@ subroutine add_variable(this, var_name, var, unusable, rc) end subroutine add_variable - subroutine remove_variable(this, var_name, unusable, rc) - class (FileMetadata), target, intent(inout) :: this - character(len=*), intent(in) :: var_name - class (KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - - type (StringVectorIterator) :: order_iter - type (StringVariableMapIterator) :: var_iter - character(len=:), pointer :: var_ptr - - - order_iter = this%order%begin() - do while (order_iter /= this%order%end()) - var_ptr => order_iter%get() - if (var_ptr == var_name) then - call this%order%erase(order_iter) - exit - endif - enddo - - _ASSERT(order_iter /= this%order%end(), " No such variable") - var_iter = this%variables%find(var_name) - _ASSERT(var_iter /= this%variables%end(), " No such variable") - call this%variables%erase(var_iter) - call this%order%erase(order_iter) - _RETURN(_SUCCESS) - _UNUSED_DUMMY(unusable) - - end subroutine remove_variable - subroutine modify_variable(this, var_name, var, unusable, rc) class (FileMetadata), target, intent(inout) :: this character(len=*), intent(in) :: var_name diff --git a/pfio/tests/Test_FileMetadata.pf b/pfio/tests/Test_FileMetadata.pf index 10ed08665c23..ac1a80bf0830 100644 --- a/pfio/tests/Test_FileMetadata.pf +++ b/pfio/tests/Test_FileMetadata.pf @@ -405,27 +405,6 @@ contains end subroutine test_equal_diff_variables - @test - subroutine test_remove_variable() - type (FileMetadata) :: cf1, cf2 - type (Variable) :: v1, v2, v3 - - call cf1%add_dimension('x', 10) - call cf1%add_dimension('y', 20) - call cf1%add_dimension('z', 30) - cf2 = cf1 - v1 = Variable(type=pFIO_INT32, dimensions='x') - v2 = Variable(type=pFIO_REAL64, dimensions='x,y,z') - - call cf1%add_variable('v1', v1) - call cf2%add_variable('v1', v1) - call cf2%add_variable('v2', v2) - @assertTrue(cf1 /= cf2) - call cf2%remove_variable('v2') - @assertTrue(cf1 == cf2) - - end subroutine test_remove_variable - @test subroutine test_serialize() type (FileMetadata) :: cf1, cf2 From 82ea79356fa660b476556af8fb6f61c2ad7f4962 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 26 Aug 2022 13:13:47 -0400 Subject: [PATCH 271/300] Update to ESMA_env 4.4.0 (Intel 2022.1, TOSS4) and ESMA_cmake v3.18.0 --- CHANGELOG.md | 4 ++++ components.yaml | 4 ++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0b3f4b4c513c..d95f7dd761ca 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,6 +16,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Updated `components.yaml` to match GEOSgcm v10.22.1 + - ESMA_env v4.2.0 → v4.4.0 (Update to Intel 2022.1, Add TOSS4 Support at NAS) + - ESMA_cmake v3.17.0 → v3.18.0 (Updates to CPack and Provisional M2 Support) + ### Removed - Removed `LatLonGridFactory_basic` factory constructor (dead code) diff --git a/components.yaml b/components.yaml index fd2817d00890..d4ae66224621 100644 --- a/components.yaml +++ b/components.yaml @@ -5,13 +5,13 @@ MAPL: ESMA_env: local: ./ESMA_env remote: ../ESMA_env.git - tag: v4.2.0 + tag: v4.4.0 develop: main ESMA_cmake: local: ./ESMA_cmake remote: ../ESMA_cmake.git - tag: v3.17.0 + tag: v3.18.0 develop: develop ecbuild: From 60a8ff71d498530eb3042d0f8099edc55fbfa775 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 30 Aug 2022 12:35:10 -0400 Subject: [PATCH 272/300] Fix bug in setting target stretched grid lat/lon from restart file Signed-off-by: Lizzie Lundgren --- CHANGELOG.md | 2 ++ base/MAPL_CubedSphereGridFactory.F90 | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d95f7dd761ca..e46f354725f1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Fix setting stretched grid target latitude and longitude from restart file metadata + ### Added - Add option to build source tarfile when building MAPL standalone. By default this is `OFF`, but can be enabled with diff --git a/base/MAPL_CubedSphereGridFactory.F90 b/base/MAPL_CubedSphereGridFactory.F90 index 6dad03652172..abd24727098d 100644 --- a/base/MAPL_CubedSphereGridFactory.F90 +++ b/base/MAPL_CubedSphereGridFactory.F90 @@ -338,7 +338,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi attr_val => attr%get_values() select type(q=>attr_val) type is (real(kind=REAL32)) - this%target_lon = q(1) + this%target_lat = q(1) class default _FAIL('unsupport subclass for stretch params') end select @@ -346,7 +346,7 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, force_fi attr_val => attr%get_values() select type(q=>attr_val) type is (real(kind=REAL32)) - this%target_lat = q(1) + this%target_lon = q(1) class default _FAIL('unsupport subclass for stretch params') end select From a95e4a8fc5ef1e893b6fd282d8fce89833b7afa6 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 31 Aug 2022 08:16:12 -0400 Subject: [PATCH 273/300] change global to global_var --- CHANGELOG.md | 4 ++-- pfio/FileMetadata.F90 | 32 ++++++++++++++++---------------- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d432fc41465f..ef164e08aa96 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,8 +13,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added -- Add more member functions to FileMetadata -- Add option to build source tarfile when building MAPL standalone. By default this is `OFF`, but can be enabled with +- Added member function get_global_var to FileMetadata +- Added option to build source tarfile when building MAPL standalone. By default this is `OFF`, but can be enabled with `-DINSTALL_SOURCE_TARFILE=ON` ### Changed diff --git a/pfio/FileMetadata.F90 b/pfio/FileMetadata.F90 index f8436b7c05a4..c2cc01873782 100644 --- a/pfio/FileMetadata.F90 +++ b/pfio/FileMetadata.F90 @@ -26,13 +26,13 @@ module pFIO_FileMetadataMod type :: FileMetadata private type (StringIntegerMap) :: dimensions - type (Variable) :: global + type (Variable) :: global_var type (StringVariableMap) :: variables type (StringVector) :: order contains procedure :: get_dimensions - procedure :: get_global + procedure :: get_global_var procedure :: add_dimension procedure :: get_dimension procedure :: modify_dimension @@ -83,8 +83,8 @@ function new_FileMetadata(unusable, dimensions, global, variables, order) result fmd%dimensions = StringIntegerMap() if (present(dimensions)) fmd%dimensions = dimensions - fmd%global = Variable() - if (present(global)) fmd%global = global + fmd%global_var = Variable() + if (present(global)) fmd%global_var = global fmd%variables = StringVariableMap() if (present(variables)) fmd%variables = variables @@ -102,13 +102,13 @@ function get_dimensions(this) result(dimensions) end function get_dimensions - function get_global(this) result(global) - type (Variable), pointer :: global + function get_global_var(this) result(global_var) + type (Variable), pointer :: global_var class (FileMetadata), target, intent(in) :: this - global => this%global + global_var => this%global_var - end function get_global + end function get_global_var subroutine add_dimension(this, dim_name, extent, unusable, rc) @@ -184,7 +184,7 @@ subroutine add_attribute_0d(this, attr_name, attr_value, unusable, rc) class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc - call this%global%add_attribute(attr_name, attr_value) + call this%global_var%add_attribute(attr_name, attr_value) _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) end subroutine add_attribute_0d @@ -197,7 +197,7 @@ subroutine add_attribute_1d(this, attr_name, values, unusable, rc) class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc - call this%global%add_attribute(attr_name, values) + call this%global_var%add_attribute(attr_name, values) _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) end subroutine add_attribute_1d @@ -210,7 +210,7 @@ function get_attribute(this, attr_name, unusable, rc) result(ref) class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc - ref => this%global%get_attribute(attr_name) + ref => this%global_var%get_attribute(attr_name) _ASSERT(associated(ref),'FileMetadata::get_attribute() - no such attribute <'//attr_name//'>.') _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) @@ -222,7 +222,7 @@ logical function has_attribute(this, attr_name) class (FileMetadata), target, intent(in) :: this character(len=*), intent(in) :: attr_name - has_attribute = this%global%is_attribute_present(attr_name) + has_attribute = this%global_var%is_attribute_present(attr_name) end function has_attribute @@ -232,7 +232,7 @@ function get_attributes(this, rc ) result(attributes) class (FileMetadata), target, intent(in) :: this integer, optional, intent(out) :: rc - attributes => this%global%get_attributes() + attributes => this%global_var%get_attributes() _RETURN(_SUCCESS) end function get_attributes @@ -520,7 +520,7 @@ logical function same_attributes(a, b) result(equal) type (Attribute), pointer :: attr_a, attr_b character(len=:), pointer :: attr_name - equal = (a%global == b%global) + equal = (a%global_var == b%global_var) end function same_attributes @@ -573,7 +573,7 @@ subroutine serialize(this, buffer, rc) call StringIntegerMap_serialize(this%dimensions, tmp_buffer) buffer = [tmp_buffer] - call this%global%serialize(tmp_buffer) + call this%global_var%serialize(tmp_buffer) buffer = [buffer,tmp_buffer] call StringVariableMap_serialize(this%variables, tmp_buffer) buffer = [buffer,tmp_buffer] @@ -615,7 +615,7 @@ subroutine deserialize(this, buffer, rc) call deserialize_intrinsic(buffer(n:),length) n = n + length call deserialize_intrinsic(buffer(n:),length) - call Variable_deserialize(buffer(n:n+length-1),this%global, status) + call Variable_deserialize(buffer(n:n+length-1),this%global_var, status) _VERIFY(status) n = n + length call StringVariableMap_deserialize(buffer(n:), this%variables, status) From e045539ea8e4759f12152a4f8f97fb891a3ee84e Mon Sep 17 00:00:00 2001 From: Amidu Oloso Date: Wed, 31 Aug 2022 16:30:28 -0400 Subject: [PATCH 274/300] Added comment about the overloading of MAPL_BalanceWork --- CHANGELOG.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index e46f354725f1..a2aba322fef5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,9 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +### Added + +-Added an overloaded interface for MAPL_BalanceWork to handle both REAL32 and REAl64 ## [Unreleased] ### Fixed From 126d17abfbc62d80d0dd2f641cef6ab573a73089 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 1 Sep 2022 12:30:32 -0400 Subject: [PATCH 275/300] Update CHANGELOG and CMakeLists for 2.25.0 Release --- CHANGELOG.md | 19 +++++++++++++------ CMakeLists.txt | 2 +- 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 94c225d14040..56870cd2b93a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,10 +5,19 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [Unreleased] + +### Fixed + ### Added --Added an overloaded interface for MAPL_BalanceWork to handle both REAL32 and REAl64 -## [Unreleased] +### Changed + +### Removed + +### Deprecated + +## [2.25.0] - 2022-09-01 ### Fixed @@ -20,19 +29,17 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Added option to build source tarfile when building MAPL standalone. By default this is `OFF`, but can be enabled with `-DINSTALL_SOURCE_TARFILE=ON` - Added `regrid_method` metadata to History output +- Added an overloaded interface for MAPL_BalanceWork to handle both REAL32 and REAL64 ### Changed -- Updated `components.yaml` to match GEOSgcm v10.22.1 +- Updated `components.yaml` to match GEOSgcm v10.22.5 (actually a bit beyond) - ESMA_env v4.2.0 → v4.4.0 (Update to Intel 2022.1, Add TOSS4 Support at NAS) - ESMA_cmake v3.17.0 → v3.18.0 (Updates to CPack and Provisional M2 Support) ### Removed - Removed `LatLonGridFactory_basic` factory constructor (dead code) - -### Deprecated - ## [2.24.0] - 2022-08-08 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index 74dfa08e874f..ac743ceb9489 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.24.0 + VERSION 2.25.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the default build type to release From 9e12a289afbc234540d597b00ceaa3969b208342 Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Tue, 6 Sep 2022 16:47:56 -0400 Subject: [PATCH 276/300] Fixes #1654. We check first if we actually need to allocate the field, and only then require the grid to be set --- generic/MAPL_Generic.F90 | 66 +++++++++++++++++++++++----------------- 1 file changed, 38 insertions(+), 28 deletions(-) diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 0fd2d499d763..634193c8b64e 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -6260,7 +6260,9 @@ subroutine MAPL_StateCreateFromVarSpecNew(STATE,SPEC,GRID,TILEGRID,DEFER,range,R integer :: range_(2) type(MAPL_VarSpec), pointer :: varspec - + logical :: is_created + type(ESMF_Field) :: SPEC_FIELD + if (present(range)) then range_ = range else @@ -6278,37 +6280,45 @@ subroutine MAPL_StateCreateFromVarSpecNew(STATE,SPEC,GRID,TILEGRID,DEFER,range,R GRD = GRID else ! choose the grid - Dimensionality: select case(DIMS) - - case(MAPL_DimsHorzVert) - select case(LOCATION) - case(MAPL_VLocationCenter) + call MAPL_VarSpecGet(SPEC%var_specs%of(L), FIELD=SPEC_FIELD, _RC) + isCreated = ESMF_FieldIsCreated(SPEC_FIELD, _RC) + if (isCreated) then + call ESMF_FieldGet(field, grid=GRD, _RC) + else + + + Dimensionality: select case(DIMS) + + case(MAPL_DimsHorzVert) + select case(LOCATION) + case(MAPL_VLocationCenter) + GRD = GRID + case(MAPL_VLocationEdge ) + GRD = GRID + case default + _RETURN(ESMF_FAILURE) + end select + case(MAPL_DimsHorzOnly) + GRD = GRID + case(MAPL_DimsVertOnly) GRD = GRID - case(MAPL_VLocationEdge ) + case(MAPL_DimsNone) GRD = GRID + case(MAPL_DimsTileOnly) + if (.not. present(TILEGRID)) then + _RETURN(ESMF_FAILURE) + endif + GRD = TILEGRID + case(MAPL_DimsTileTile) + if (.not. present(TILEGRID)) then + _RETURN(ESMF_FAILURE) + endif + GRD = TILEGRID case default _RETURN(ESMF_FAILURE) - end select - case(MAPL_DimsHorzOnly) - GRD = GRID - case(MAPL_DimsVertOnly) - GRD = GRID - case(MAPL_DimsNone) - GRD = GRID - case(MAPL_DimsTileOnly) - if (.not. present(TILEGRID)) then - _RETURN(ESMF_FAILURE) - endif - GRD = TILEGRID - case(MAPL_DimsTileTile) - if (.not. present(TILEGRID)) then - _RETURN(ESMF_FAILURE) - endif - GRD = TILEGRID - case default - _RETURN(ESMF_FAILURE) - end select Dimensionality - end if + end select Dimensionality + end if ! if created + end if ! if ISTAT varspec => SPEC%var_specs%of(L) call MAPL_VarSpecSet(varspec, GRID=GRD, RC=status ) From 5f2d7fb2cd04d03652ab8f5544f31de6d836afc4 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 6 Sep 2022 16:56:10 -0400 Subject: [PATCH 277/300] fixes # 1656 --- CHANGELOG.md | 2 ++ gridcomps/History/MAPL_HistoryGridComp.F90 | 20 -------------------- 2 files changed, 2 insertions(+), 20 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 56870cd2b93a..4065a706b411 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,6 +15,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Removed +- Removed unused code from History GridComp + ### Deprecated ## [2.25.0] - 2022-09-01 diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index bc96b7ab6e73..4c6a1a168623 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -109,9 +109,6 @@ module MAPL_HistoryGridCompMod type(HistoryCollectionGlobalAttributes) :: global_atts integer :: CoresPerNode, mype, npes integer :: AvoidRootNodeThreshold - integer :: blocksize - integer :: MarkDone - integer :: PrePost integer :: version logical :: fileOrderAlphabetical logical :: integer_time @@ -533,10 +530,6 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) label ='AvoidRootNodeThreshold:', default=1024, rc=status ) _VERIFY(STATUS) - call ESMF_ConfigGetAttribute(config, value=INTSTATE%blocksize, & - label='BlockSize:', default=10, rc=status) - _VERIFY(STATUS) - call ESMF_ConfigGetAttribute(config, value=cFileOrder, & label='FileOrder:', default='ABC', rc=status) _VERIFY(STATUS) @@ -565,14 +558,6 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) n_hist_split = IntState%collectionWriteSplit,rc=status) _VERIFY(status) - call ESMF_ConfigGetAttribute(config, value=INTSTATE%MarkDone, & - label='MarkDone:', default=0, rc=status) - _VERIFY(STATUS) - call ESMF_ConfigGetAttribute(config, value=INTSTATE%PrePost, & - label='PrePost:', default=1, rc=status) - _VERIFY(STATUS) - - call ESMF_ConfigGetAttribute(config, value=snglcol, & label='SINGLE_COLUMN:', default=0, rc=status) _VERIFY(STATUS) @@ -585,9 +570,6 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) print *, 'EXPID: ',trim(INTSTATE%expid) print *, 'Descr: ',trim(INTSTATE%expdsc) print *, 'DisableSubVmChecks:', disableSubVmChecks - print *, 'BlockSize: ' , INTSTATE%blocksize - print *, 'MarkDone: ' , INTSTATE%MarkDone - print *, 'PrePost: ' , INTSTATE%PrePost print * endif @@ -3386,7 +3368,6 @@ subroutine Run ( gc, import, export, clock, rc ) type(ESMF_State) :: state_out integer :: nymd, nhms character(len=ESMF_MAXSTR) :: DateStamp - integer :: CollBlock type(ESMF_Time) :: current_time type(ESMF_Time) :: lastMonth type(ESMF_TimeInterval) :: dur, oneMonth @@ -3420,7 +3401,6 @@ subroutine Run ( gc, import, export, clock, rc ) list => IntState%list nlist = size(list) - CollBlock = IntState%blocksize ! Retrieve the pointer to the generic state !------------------------------------------ From b924ac685730d85d90709746f4d397d9100fe904 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 6 Sep 2022 16:58:52 -0400 Subject: [PATCH 278/300] fixes #1657 --- CHANGELOG.md | 2 ++ .../test_cases/case19/extdata.yaml | 2 +- gridcomps/ExtData2G/ExtDataRule.F90 | 14 +++++++------- 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 56870cd2b93a..c4a8aea712b6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Fixed bug that required a /dev/null ExtData entry to still have a file variable name + ### Added ### Changed diff --git a/Tests/ExtData_Testing_Framework/test_cases/case19/extdata.yaml b/Tests/ExtData_Testing_Framework/test_cases/case19/extdata.yaml index 47bc213019b6..e8f03193e4a7 100644 --- a/Tests/ExtData_Testing_Framework/test_cases/case19/extdata.yaml +++ b/Tests/ExtData_Testing_Framework/test_cases/case19/extdata.yaml @@ -1,2 +1,2 @@ Exports: - VAR2D: {variable: VAR2D, collection: "/dev/null", linear_transformation: [17.0,0.0]} + VAR2D: {collection: "/dev/null", linear_transformation: [17.0,0.0]} diff --git a/gridcomps/ExtData2G/ExtDataRule.F90 b/gridcomps/ExtData2G/ExtDataRule.F90 index c7c7a1c7a287..720a81f32d50 100644 --- a/gridcomps/ExtData2G/ExtDataRule.F90 +++ b/gridcomps/ExtData2G/ExtDataRule.F90 @@ -41,7 +41,7 @@ function new_ExtDataRule(config,sample_map,key,unusable,multi_rule,rc) result(ru integer, optional, intent(out) :: rc type(ExtDataRule) :: rule - logical :: is_present + logical :: collection_present, variable_present integer :: status class(YAML_Node), pointer ::config1 character(len=:), allocatable :: tempc @@ -56,20 +56,20 @@ function new_ExtDataRule(config,sample_map,key,unusable,multi_rule,rc) result(ru end if if (allocated(tempc)) deallocate(tempc) - is_present = config%has("collection") - _ASSERT(is_present,"no collection present in ExtData export") + collection_present = config%has("collection") + _ASSERT(collection_present,"no collection present in ExtData export") rule%collection = config%of("collection") if (allocated(tempc)) deallocate(tempc) - is_present = config%has("variable") + variable_present = config%has("variable") if (index(rule%collection,"/dev/null")==0) then - _ASSERT(is_present,"no variable present in ExtData export") + _ASSERT(variable_present,"no variable present in ExtData export") end if - if (is_present) then + if (variable_present) then tempc = config%of("variable") rule%file_var=tempc else - _FAIL("no variable name in rule") + rule%file_var='null' end if if (config%has("sample")) then From 4b937f827b0e0880c622e1e1a76536a2e2282c44 Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Tue, 6 Sep 2022 17:20:24 -0400 Subject: [PATCH 279/300] Added a line in CHANGELOG file --- CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 56870cd2b93a..24a1beab2a99 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,7 +20,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [2.25.0] - 2022-09-01 ### Fixed - +- Change the logic to check if the field is already connected to a valid grid. If yes, we bypass the checks for tilegrid (issue #1654) + - Fix setting stretched grid target latitude and longitude from restart file metadata ### Added From 6c4a96f4f8e9b8d61c21a21047aba4d60ff9edbd Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Tue, 6 Sep 2022 17:40:08 -0400 Subject: [PATCH 280/300] Fixes #1654. Fixed a typo --- generic/MAPL_Generic.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 634193c8b64e..7406dbc376f0 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -6281,8 +6281,8 @@ subroutine MAPL_StateCreateFromVarSpecNew(STATE,SPEC,GRID,TILEGRID,DEFER,range,R else ! choose the grid call MAPL_VarSpecGet(SPEC%var_specs%of(L), FIELD=SPEC_FIELD, _RC) - isCreated = ESMF_FieldIsCreated(SPEC_FIELD, _RC) - if (isCreated) then + is_created = ESMF_FieldIsCreated(SPEC_FIELD, _RC) + if (is_created) then call ESMF_FieldGet(field, grid=GRD, _RC) else From c6b0ab5292b9f01d64a422493855d1f79deb0903 Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Tue, 6 Sep 2022 17:57:31 -0400 Subject: [PATCH 281/300] Fixes #1654. Fixed another typo --- generic/MAPL_Generic.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 7406dbc376f0..6b17b06183b6 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -6283,7 +6283,7 @@ subroutine MAPL_StateCreateFromVarSpecNew(STATE,SPEC,GRID,TILEGRID,DEFER,range,R call MAPL_VarSpecGet(SPEC%var_specs%of(L), FIELD=SPEC_FIELD, _RC) is_created = ESMF_FieldIsCreated(SPEC_FIELD, _RC) if (is_created) then - call ESMF_FieldGet(field, grid=GRD, _RC) + call ESMF_FieldGet(SPEC_FIELD, GRID=GRD, _RC) else From fafbd971307c502ecf497b5f49c49da8bfad2692 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 8 Sep 2022 11:28:27 -0400 Subject: [PATCH 282/300] remove unnecessary DSO lib name assert --- CHANGELOG.md | 1 + generic/MAPL_Generic.F90 | 8 ++------ 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index fe0780abd204..2128aa276f54 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Removed unnecessary DSO extension assert - Fixed bug that required a /dev/null ExtData entry to still have a file variable name ### Added diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 6b17b06183b6..10780f805217 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -4826,10 +4826,8 @@ recursive integer function AddChildFromDSOMeta(meta, name, userRoutine, grid, sh call child_meta%t_profiler%start(__RC__) call child_meta%t_profiler%start('SetService',__RC__) - extension = get_file_extension(SharedObj) - _ASSERT(is_supported_dso_name(SharedObj), "AddChildFromDSO: Unsupported shared library extension '"//extension//",.") - if (.not. is_valid_dso_name(SharedObj)) then + extension = get_file_extension(SharedObj) lgr => logging%get_logger('MAPL.GENERIC') call lgr%warning("AddChildFromDSO: changing shared library extension from %a~ to system specific extension %a~", & "'"//extension//"'", "'"//SYSTEM_DSO_EXTENSION//"'") @@ -4893,10 +4891,8 @@ recursive integer function AddChildFromDSO(gc, name, userRoutine, grid, sharedOb call child_meta%t_profiler%start(__RC__) call child_meta%t_profiler%start('SetService',__RC__) - extension = get_file_extension(SharedObj) - _ASSERT(is_supported_dso_name(SharedObj), "AddChildFromDSO: Unsupported shared library extension '"//extension//",.") - if (.not. is_valid_dso_name(SharedObj)) then + extension = get_file_extension(SharedObj) lgr => logging%get_logger('MAPL.GENERIC') call lgr%warning("AddChildFromDSO: changing shared library extension from %a~ to system specific extension %a~", & "'"//extension//"'", "'"//SYSTEM_DSO_EXTENSION//"'") From 6be9fd8602d3d718378336efbe43ac25141f6782 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 9 Sep 2022 10:21:06 -0400 Subject: [PATCH 283/300] fix logic with checking for duplicates --- gridcomps/History/MAPL_HistoryGridComp.F90 | 24 ++++++++++++---------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 4c6a1a168623..4146eb2d7bb2 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -931,7 +931,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) if (old_fields_style) then field_set_name = trim(string) // 'fields' allocate(field_set) - call parse_fields(cfg, trim(field_set_name), field_set, list(n)%items, _RC) + call parse_fields(cfg, trim(field_set_name), field_set, collection_name = list(n)%collection, items = list(n)%items, _RC) end if list(n)%field_set => field_set @@ -3165,20 +3165,27 @@ function extract_unquoted_item(string_list) result(item) end function extract_unquoted_item - subroutine parse_fields(cfg, label, field_set, items, rc) + subroutine parse_fields(cfg, label, field_set, collection_name, items, rc) type(ESMF_Config), intent(inout) :: cfg character(*), intent(in) :: label type (FieldSet), intent(inout) :: field_set + character(*), intent(in), optional :: collection_name type(GriddedIOitemVector), intent(inout), optional :: items integer, optional, intent(out) :: rc logical :: table_end - logical :: vectorDone,match_short_name,match_alias,match_component + logical :: vectorDone,match_alias integer :: m,i,j character(ESMF_MAXSTR), pointer:: fields (:,:) type(GriddedIOitem) :: item integer :: status + character(len=:), allocatable :: usable_collection_name + if (present(collection_name)) then + usable_collection_name = trim(collection_name) + else + usable_collection_name = "unknown" + end if call ESMF_ConfigFindLabel ( cfg, label=label//':', rc=status) _VERIFY(status) @@ -3320,17 +3327,12 @@ subroutine parse_fields(cfg, label, field_set, items, rc) ! check for duplicates do i=1,field_set%nfields-1 do j=i+1,field_set%nfields - match_short_name = field_set%fields(1,i) == field_set%fields(1,j) + match_alias = field_set%fields(3,i) == field_set%fields(3,j) - match_component = field_set%fields(2,i) == field_set%fields(2,j) - if (match_short_name) then - if (match_component) then - _FAIL("Caught collection with duplicate short name: "//trim(field_set%fields(1,i))//" and duplicate component") - end if - end if if (match_alias) then - _FAIL("Caught collection with duplicate alias: "//trim(field_set%fields(3,i))) + _FAIL("Caught collection "//usable_collection_name//" with this duplicate alias or shortname if no alias provided: "//trim(field_set%fields(3,i))) end if + enddo enddo From bb6c948a5c6b7da5a1961231f9b9ec5579b5eced Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 9 Sep 2022 10:24:20 -0400 Subject: [PATCH 284/300] update changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index fe0780abd204..cedf2665d280 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed - Fixed bug that required a /dev/null ExtData entry to still have a file variable name +- Fixed bug with checking for duplicate alias in collection ### Added From 0173b97571b159b6a855788a145088e44797b0d9 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 9 Sep 2022 13:17:35 -0400 Subject: [PATCH 285/300] Fixes #1668. Only allow certain History modes --- CHANGELOG.md | 3 ++- gridcomps/History/MAPL_HistoryGridComp.F90 | 12 ++++++++---- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index cedf2665d280..cf7fcfbad323 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Fixed bug that required a /dev/null ExtData entry to still have a file variable name - Fixed bug with checking for duplicate alias in collection +- Added protection in History to only allow `instantaneous` or `time-averaged` modes ### Added @@ -26,7 +27,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed - Change the logic to check if the field is already connected to a valid grid. If yes, we bypass the checks for tilegrid (issue #1654) - + - Fix setting stretched grid target latitude and longitude from restart file metadata ### Added diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 4146eb2d7bb2..0dd9eb0a9284 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -537,7 +537,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) label='Allow_Overwrite:', default=.false., _RC) create_mode = PFIO_NOCLOBBER ! defaut no overwrite if (intState%allow_overwrite) create_mode = PFIO_CLOBBER - + if (trim(cFileOrder) == 'ABC') then intstate%fileOrderAlphabetical = .true. else if (trim(cFileOrder) == 'AddOrder') then @@ -1764,9 +1764,11 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) stateIntent = ESMF_STATEINTENT_IMPORT, & rc=status ) _VERIFY(STATUS) - if(list(n)%mode == "instantaneous") then + select case + + case ("instantaneous") IntState%average(n) = .false. - else + case ("time-averaged") IntState%average(n) = .true. IntState%CIM(n) = ESMF_StateCreate ( name=trim(list(n)%filename), & stateIntent = ESMF_STATEINTENT_IMPORT, & @@ -1774,7 +1776,9 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) _VERIFY(STATUS) NULLIFY(INTSTATE%SRCS(n)%SPEC) NULLIFY(INTSTATE%DSTS(n)%SPEC) - endif + case default + _FAIL("Invalid mode for output: "//trim(list(n)%mode)//" -- Only 'instantaneous' and 'time-averaged' are supported") + end select if (associated(IntState%Regrid(n)%PTR)) then _ASSERT(.not. list(n)%subVm,'needs informative message') ! ALT: currently we are not supporting regridding on subVM From bcac8e256eaaee8ba14a3362214423193a8165c9 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 9 Sep 2022 13:22:52 -0400 Subject: [PATCH 286/300] Convert to _RC --- gridcomps/History/MAPL_HistoryGridComp.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 0dd9eb0a9284..ee12ed3489bf 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -1771,9 +1771,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) case ("time-averaged") IntState%average(n) = .true. IntState%CIM(n) = ESMF_StateCreate ( name=trim(list(n)%filename), & - stateIntent = ESMF_STATEINTENT_IMPORT, & - rc=status ) - _VERIFY(STATUS) + stateIntent = ESMF_STATEINTENT_IMPORT, _RC) NULLIFY(INTSTATE%SRCS(n)%SPEC) NULLIFY(INTSTATE%DSTS(n)%SPEC) case default From a9a3325ec61af1f97f82988ae76077ceab01f369 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 9 Sep 2022 13:24:20 -0400 Subject: [PATCH 287/300] Helps to say what the case is selecting on --- gridcomps/History/MAPL_HistoryGridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index ee12ed3489bf..126e666033d8 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -1764,8 +1764,8 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) stateIntent = ESMF_STATEINTENT_IMPORT, & rc=status ) _VERIFY(STATUS) - select case + select case (list(n)%mode) case ("instantaneous") IntState%average(n) = .false. case ("time-averaged") From 1c4b5923432248baf96a8f6d00f65c9e36b8de64 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 9 Sep 2022 14:18:29 -0400 Subject: [PATCH 288/300] Name the collection that failed --- gridcomps/History/MAPL_HistoryGridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 126e666033d8..64a023904a72 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -1775,7 +1775,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) NULLIFY(INTSTATE%SRCS(n)%SPEC) NULLIFY(INTSTATE%DSTS(n)%SPEC) case default - _FAIL("Invalid mode for output: "//trim(list(n)%mode)//" -- Only 'instantaneous' and 'time-averaged' are supported") + _FAIL("Invalid mode <"//trim(list(n)%mode)//"> for collection <"//trim(list(n)%collection)//">. Only 'instantaneous' and 'time-averaged' are supported") end select if (associated(IntState%Regrid(n)%PTR)) then From 79accdfafa778869fbf35b1711b08e2d4a501df5 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 9 Sep 2022 14:34:10 -0400 Subject: [PATCH 289/300] Use square brackets --- gridcomps/History/MAPL_HistoryGridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 64a023904a72..c1cdcb45d46d 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -1775,7 +1775,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) NULLIFY(INTSTATE%SRCS(n)%SPEC) NULLIFY(INTSTATE%DSTS(n)%SPEC) case default - _FAIL("Invalid mode <"//trim(list(n)%mode)//"> for collection <"//trim(list(n)%collection)//">. Only 'instantaneous' and 'time-averaged' are supported") + _FAIL("Invalid mode ["//trim(list(n)%mode)//"] for collection ["//trim(list(n)%collection)//"]. Only 'instantaneous' and 'time-averaged' are supported") end select if (associated(IntState%Regrid(n)%PTR)) then From 3d665b90d3b1389eacc31b0896ba432633bd3075 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 12 Sep 2022 14:34:44 -0400 Subject: [PATCH 290/300] Fixes #1598. Have AddChildFromDSO call Meta --- CHANGELOG.md | 2 + generic/MAPL_Generic.F90 | 131 +++++++++++++-------------------------- 2 files changed, 46 insertions(+), 87 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 43a98cab6240..ee70e7097f55 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,6 +18,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Have `MAPL_AddChildFromDSO` call `MAPL_AddChildFromDSOMeta` + ### Removed - Removed unused code from History GridComp diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 10780f805217..5f770fa4818e 100644 --- a/generic/MAPL_Generic.F90 +++ b/generic/MAPL_Generic.F90 @@ -4599,9 +4599,6 @@ recursive integer function AddChildFromMeta(META, NAME, GRID, & _RETURN(ESMF_SUCCESS) - - contains - end function AddChildFromMeta recursive subroutine AddChild_preamble(meta, I, name, grid, configfile, parentGC, petlist, child_meta, unusable, rc) @@ -4630,10 +4627,10 @@ recursive subroutine AddChild_preamble(meta, I, name, grid, configfile, parentGC type(ESMF_VM) :: vm integer :: comm - call make_full_name(name, child_name, parentGC, __RC__) - call grow_children_names(meta%GCNamelist, child_name, __RC__) + call make_full_name(name, child_name, parentGC, _RC) + call grow_children_names(meta%GCNamelist, child_name, _RC) - allocate(tmp_meta, __STAT__) + allocate(tmp_meta, _STAT) tmp_framework => META%add_child(child_name, tmp_meta) deallocate(tmp_meta) _ASSERT(associated(tmp_framework),'add_child() failed') @@ -4650,38 +4647,38 @@ recursive subroutine AddChild_preamble(meta, I, name, grid, configfile, parentGC end if if (present(configfile)) then - child_meta%cf = ESMF_ConfigCreate(__RC__) - call ESMF_ConfigLoadFile(child_meta%cf, configfile, __RC__) + child_meta%cf = ESMF_ConfigCreate(_RC) + call ESMF_ConfigLoadFile(child_meta%cf, configfile, _RC) else ! use parents config child_meta%cf = meta%cf end if child_meta%gridcomp = ESMF_GridCompCreate ( & name = child_name, & - CONFIG = child_meta%cf, & + CONFIG = child_meta%cf, & grid = grid, & petList = petList, & contextFlag = contextFlag, & - __RC__) + _RC) ! Create each child's import/export state ! ---------------------------------- child_import_state => META%get_child_import_state(i) child_import_state = ESMF_StateCreate ( & name = trim(META%GCNameList(I)) // '_Imports', & - stateIntent = ESMF_STATEINTENT_IMPORT, __RC__) + stateIntent = ESMF_STATEINTENT_IMPORT, _RC) child_export_state => META%get_child_export_state(i) child_export_state = ESMF_StateCreate ( & name = trim(META%GCNameList(I)) // '_Exports', & - stateIntent = ESMF_STATEINTENT_EXPORT, __RC__) + stateIntent = ESMF_STATEINTENT_EXPORT, _RC) ! create MAPL_Meta - call MAPL_InternalStateCreate ( child_meta%gridcomp, child_meta, __RC__) + call MAPL_InternalStateCreate ( child_meta%gridcomp, child_meta, _RC) ! Create child components time profiler - call ESMF_VMGetCurrent(vm, __RC__) - call ESMF_VMGet(vm, mpiCommunicator=comm, __RC__) + call ESMF_VMGetCurrent(vm, _RC) + call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) CHILD_META%t_profiler = DistributedProfiler(trim(name), MpiTimerGauge(), comm=comm) end select @@ -4776,11 +4773,9 @@ recursive integer function AddChildFromGC(GC, name, SS, petList, configFile, RC) type(MAPL_MetaComp), pointer :: META - call MAPL_InternalStateRetrieve(GC, META, RC=status) - _VERIFY(status) + call MAPL_InternalStateRetrieve(GC, META, _RC) - AddChildFromGC = AddChildFromMeta(Meta, name, SS=SS, PARENTGC=GC, petList=petList, configFile=configFile, RC=status) - _VERIFY(status) + AddChildFromGC = AddChildFromMeta(Meta, name, SS=SS, PARENTGC=GC, petList=petList, configFile=configFile, _RC) _RETURN(ESMF_SUCCESS) end function AddChildFromGC @@ -4789,23 +4784,23 @@ recursive integer function AddChildFromDSOMeta(meta, name, userRoutine, grid, sh !ARGUMENTS: type(MAPL_MetaComp), target, intent(INOUT) :: META - character(len=*), intent(IN) :: name - character(len=*), intent(in) :: userRoutine - type(ESMF_Grid), optional, intent(INout) :: grid - character(len=*), optional, intent(in) :: sharedObj - - integer, optional , intent(IN ) :: petList(:) - character(len=*), optional, intent(IN ) :: configFile - type(ESMF_GridComp), optional, intent(IN ) :: parentGC - integer, optional , intent( OUT) :: rc + character(len=*), intent(IN) :: name + character(len=*), intent(in) :: userRoutine + type(ESMF_Grid), optional, intent(INOUT) :: grid + character(len=*), optional, intent(IN) :: sharedObj + + integer, optional, intent(IN) :: petList(:) + character(len=*), optional, intent(IN) :: configFile + type(ESMF_GridComp), optional, intent(IN) :: parentGC + integer, optional, intent(OUT) :: rc !EOP - integer :: status - integer :: userRC + integer :: status + integer :: userRC - integer :: I - type(MAPL_MetaComp), pointer :: child_meta - class(BaseProfiler), pointer :: t_p + integer :: I + type(MAPL_MetaComp), pointer :: child_meta + class(BaseProfiler), pointer :: t_p class(Logger), pointer :: lgr character(len=:), allocatable :: shared_object_library_to_load @@ -4813,18 +4808,18 @@ recursive integer function AddChildFromDSOMeta(meta, name, userRoutine, grid, sh if (.not.allocated(meta%GCNameList)) then ! this is the first child to be added - allocate(meta%GCNameList(0), __STAT__) + allocate(meta%GCNameList(0), _STAT) end if I = meta%get_num_children() + 1 AddChildFromDSOMeta = I - call AddChild_preamble(meta, I, name, grid=grid, configfile=configfile, parentGC=parentGC, petList=petlist, child_meta=child_meta,__RC__) + call AddChild_preamble(meta, I, name, grid=grid, configfile=configfile, parentGC=parentGC, petList=petlist, child_meta=child_meta, _RC) t_p => get_global_time_profiler() - call t_p%start(trim(name),__RC__) - call child_meta%t_profiler%start(__RC__) - call child_meta%t_profiler%start('SetService',__RC__) + call t_p%start(trim(name),_RC) + call child_meta%t_profiler%start(_RC) + call child_meta%t_profiler%start('SetService',_RC) if (.not. is_valid_dso_name(SharedObj)) then extension = get_file_extension(SharedObj) @@ -4835,12 +4830,12 @@ recursive integer function AddChildFromDSOMeta(meta, name, userRoutine, grid, sh shared_object_library_to_load = adjust_dso_name(sharedObj) call ESMF_GridCompSetServices ( child_meta%gridcomp, userRoutine, & - sharedObj=shared_object_library_to_load,userRC=userRC,__RC__) + sharedObj=shared_object_library_to_load,userRC=userRC,_RC) _VERIFY(userRC) - call child_meta%t_profiler%stop('SetService',__RC__) - call child_meta%t_profiler%stop(__RC__) - call t_p%stop(trim(name),__RC__) + call child_meta%t_profiler%stop('SetService',_RC) + call child_meta%t_profiler%stop(_RC) + call t_p%stop(trim(name),_RC) _RETURN(ESMF_SUCCESS) end function AddChildFromDSOMeta @@ -4862,50 +4857,12 @@ recursive integer function AddChildFromDSO(gc, name, userRoutine, grid, sharedOb !EOP integer :: status - integer :: userRC type(MAPL_MetaComp), pointer :: META - integer :: I - type(MAPL_MetaComp), pointer :: child_meta - class(BaseProfiler), pointer :: t_p + call MAPL_InternalStateRetrieve(gc, meta, _RC) - class(Logger), pointer :: lgr - character(len=:), allocatable :: shared_object_library_to_load - character(len=:), allocatable :: extension - - call MAPL_InternalStateRetrieve(gc, meta, __RC__) - - if (.not.allocated(meta%GCNameList)) then - ! this is the first child to be added - allocate(meta%GCNameList(0), __STAT__) - end if - - I = meta%get_num_children() + 1 - AddChildFromDSO = I - - call AddChild_preamble(meta, I, name, grid=grid, configfile=configfile, parentGC=gc, petList=petlist, child_meta=child_meta, __RC__) - - t_p => get_global_time_profiler() - call t_p%start(trim(name),__RC__) - call child_meta%t_profiler%start(__RC__) - call child_meta%t_profiler%start('SetService',__RC__) - - if (.not. is_valid_dso_name(SharedObj)) then - extension = get_file_extension(SharedObj) - lgr => logging%get_logger('MAPL.GENERIC') - call lgr%warning("AddChildFromDSO: changing shared library extension from %a~ to system specific extension %a~", & - "'"//extension//"'", "'"//SYSTEM_DSO_EXTENSION//"'") - end if - - shared_object_library_to_load = adjust_dso_name(sharedObj) - call ESMF_GridCompSetServices ( child_meta%gridcomp, userRoutine, & - sharedObj=shared_object_library_to_load,userRC=userRC,__RC__) - _VERIFY(userRC) - - call child_meta%t_profiler%stop('SetService',__RC__) - call child_meta%t_profiler%stop(__RC__) - call t_p%stop(trim(name),__RC__) + AddChildFromDSO = AddChildFromDSOMeta(meta, name, userRoutine, grid=grid, sharedObj=sharedObj, petList=petList, configFile=configFile, _RC) _RETURN(ESMF_SUCCESS) end function AddChildFromDSO @@ -4929,7 +4886,7 @@ recursive integer function AddChildFromDSO_old(name, userRoutine, grid, ParentGC integer :: status _ASSERT(present(ParentGC),'must have a parent to use this interface') - addchildfromdso_old = addChildFromDSO(parentGC, name, userRoutine, grid=grid, sharedObj=sharedObj, petList=petList, configFile=configFile, __RC__) + addchildfromdso_old = addChildFromDSO(parentGC, name, userRoutine, grid=grid, sharedObj=sharedObj, petList=petList, configFile=configFile, _RC) _RETURN(ESMF_SUCCESS) end function AddChildFromDSO_Old @@ -6258,7 +6215,7 @@ subroutine MAPL_StateCreateFromVarSpecNew(STATE,SPEC,GRID,TILEGRID,DEFER,range,R type(MAPL_VarSpec), pointer :: varspec logical :: is_created type(ESMF_Field) :: SPEC_FIELD - + if (present(range)) then range_ = range else @@ -6281,10 +6238,10 @@ subroutine MAPL_StateCreateFromVarSpecNew(STATE,SPEC,GRID,TILEGRID,DEFER,range,R if (is_created) then call ESMF_FieldGet(SPEC_FIELD, GRID=GRD, _RC) else - + Dimensionality: select case(DIMS) - + case(MAPL_DimsHorzVert) select case(LOCATION) case(MAPL_VLocationCenter) @@ -11442,7 +11399,7 @@ recursive subroutine MAPL_AddAttributeToFields_I4(gc,field_name,att_name,att_val child_gc => state%get_child_gridcomp(i) call MAPL_AddAttributeToFields_I4(child_gc,field_name,att_name,att_val,_RC) enddo - + _RETURN(_SUCCESS) end subroutine MAPL_AddAttributeToFields_I4 From 2bf0e0240f72bb1dcde6d32304e734dc1828556c Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 13 Sep 2022 08:51:30 -0400 Subject: [PATCH 291/300] Update changelog (to trigger CI) --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ee70e7097f55..98a50782bc8f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,7 +18,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed -- Have `MAPL_AddChildFromDSO` call `MAPL_AddChildFromDSOMeta` +- Have `MAPL_AddChildFromDSO` call `MAPL_AddChildFromDSOMeta` (#1598) ### Removed From b8b9e99893b7c82d333a4b3065198f7ef7a6b473 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 15 Sep 2022 09:48:51 -0400 Subject: [PATCH 292/300] Add Ninja build of MAPL --- .circleci/config.yml | 12 ++++++++---- CHANGELOG.md | 2 ++ 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 4f925518719d..2c8a2c245a44 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -5,7 +5,7 @@ baselibs_version: &baselibs_version v7.5.0 bcs_version: &bcs_version v10.22.5 orbs: - ci: geos-esm/circleci-tools@1 + ci: geos-esm/circleci-tools@dev:41752b0ab90727f6e939e8e0d1af0bb8c7675972 workflows: build-and-test: @@ -13,12 +13,13 @@ workflows: # Builds MAPL in a "default" way - Intel - ci/build: - name: build-and-test-MAPL-on-<< matrix.compiler >> + name: build-and-test-MAPL-on-<< matrix.compiler >>-using-<< matrix.cmake_generator >> context: - docker-hub-creds matrix: parameters: compiler: [ifort] + cmake_generator: ['Unix Makefiles', 'Ninja'] baselibs_version: *baselibs_version repo: MAPL mepodevelop: false @@ -38,12 +39,13 @@ workflows: # Open MPI 5 will not have this limitation - ci/build: - name: build-and-test-MAPL-on-<< matrix.compiler >> + name: build-and-test-MAPL-on-<< matrix.compiler >>-using-<< matrix.cmake_generator >> context: - docker-hub-creds matrix: parameters: compiler: [gfortran] + cmake_generator: ['Unix Makefiles', 'Ninja'] baselibs_version: *baselibs_version repo: MAPL mepodevelop: false @@ -143,6 +145,8 @@ workflows: - parent_one_child_import_via_extdata - parent_one_child_no_imports - parent_two_siblings_connect_import_export + # We will only run the tutorials with GNU make. No need to double up + # as Ninja is a build test only requires: - - build-and-test-MAPL-on-<< matrix.compiler >> + - build-and-test-MAPL-on-<< matrix.compiler >>-using-Unix Makefiles baselibs_version: *baselibs_version diff --git a/CHANGELOG.md b/CHANGELOG.md index 43a98cab6240..804f5029fdcb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,6 +16,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +- Added Ninja build of MAPL to CI + ### Changed ### Removed From bfea1bd9e36e0053701d3a2a0a8f1216da71f331 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 15 Sep 2022 11:41:46 -0400 Subject: [PATCH 293/300] Trivial commit to trigger CI --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 804f5029fdcb..f57835aafa74 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,7 +16,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added -- Added Ninja build of MAPL to CI +- Added Ninja build of MAPL to CI tests ### Changed From a101e9469012db92124e4138bc7a86e9dc23fef9 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 15 Sep 2022 13:59:06 -0400 Subject: [PATCH 294/300] Update ci bcs version --- .circleci/config.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 2c8a2c245a44..853b702077ad 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -2,10 +2,10 @@ version: 2.1 # Anchors to prevent forgetting to update a version baselibs_version: &baselibs_version v7.5.0 -bcs_version: &bcs_version v10.22.5 +bcs_version: &bcs_version v10.23.0 orbs: - ci: geos-esm/circleci-tools@dev:41752b0ab90727f6e939e8e0d1af0bb8c7675972 + ci: geos-esm/circleci-tools@dev:059907ef4b4f16189fad378cc69376a84a8456a4 workflows: build-and-test: From a02311e326d63c7733d93773db94bca34b47dcbf Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 15 Sep 2022 14:04:26 -0400 Subject: [PATCH 295/300] Update circleci orb dev version --- .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 853b702077ad..ede0d64ac867 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -5,7 +5,7 @@ baselibs_version: &baselibs_version v7.5.0 bcs_version: &bcs_version v10.23.0 orbs: - ci: geos-esm/circleci-tools@dev:059907ef4b4f16189fad378cc69376a84a8456a4 + ci: geos-esm/circleci-tools@dev:cd026e6dc431a4563424fdb39458afc480d7ab85 workflows: build-and-test: From f6f7f8aa16de609433d4817ab287c87c64177a3c Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 15 Sep 2022 15:01:35 -0400 Subject: [PATCH 296/300] Move to final orb --- .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index ede0d64ac867..bbf8acc4ca6d 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -5,7 +5,7 @@ baselibs_version: &baselibs_version v7.5.0 bcs_version: &bcs_version v10.23.0 orbs: - ci: geos-esm/circleci-tools@dev:cd026e6dc431a4563424fdb39458afc480d7ab85 + ci: geos-esm/circleci-tools@1 workflows: build-and-test: From 67691031f86e2abb47e7d2e12431d575691d76a6 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 15 Sep 2022 15:40:25 -0400 Subject: [PATCH 297/300] Prepare for MAPL 2.26.0 Release --- CHANGELOG.md | 14 ++++++++++++-- CMakeLists.txt | 2 +- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index fac09f57903d..f231a6148903 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,18 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +### Added + +### Changed + +### Removed + +### Deprecated + +## [2.26.0] - 2022-09-16 + +### Fixed + - Removed unnecessary DSO extension assert - Fixed bug that required a /dev/null ExtData entry to still have a file variable name - Fixed bug with checking for duplicate alias in collection @@ -26,8 +38,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Removed unused code from History GridComp -### Deprecated - ## [2.25.0] - 2022-09-01 ### Fixed diff --git a/CMakeLists.txt b/CMakeLists.txt index ac743ceb9489..aa272a799586 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.25.0 + VERSION 2.26.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the default build type to release From b90b8fa2ec2b212247bcfa28a48140ac51cd4f83 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 16 Sep 2022 14:17:57 -0400 Subject: [PATCH 298/300] Fix errant changelog entry --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f231a6148903..e80d4e505881 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -21,6 +21,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Change the logic to check if the field is already connected to a valid grid. If yes, we bypass the checks for tilegrid (issue #1654) - Removed unnecessary DSO extension assert - Fixed bug that required a /dev/null ExtData entry to still have a file variable name - Fixed bug with checking for duplicate alias in collection @@ -41,7 +42,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [2.25.0] - 2022-09-01 ### Fixed -- Change the logic to check if the field is already connected to a valid grid. If yes, we bypass the checks for tilegrid (issue #1654) - Fix setting stretched grid target latitude and longitude from restart file metadata From 8f1b6d6c9d19503114d48f3fe8a951140196a6d4 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Mon, 7 Nov 2022 11:38:17 -0500 Subject: [PATCH 299/300] Fix configure and build errors following merge Signed-off-by: Lizzie Lundgren --- CMakeLists.txt | 14 ++++++++------ pfio/CMakeLists.txt | 4 +++- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 11bacdc7eec6..656a205a50f5 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -93,9 +93,10 @@ if(USE_EXTDATA2G) if(NOT TARGET YAFYAML::yafyaml) find_package(YAFYAML 1.0.4 REQUIRED) else() - if (YAFYAML_VERSION VERSION_LESS 1.0.4) - message(FATAL_ERROR "yaFyaml must be at least 1.0.4") - endif () + # Remove version check error if using GCHP + #if (YAFYAML_VERSION VERSION_LESS 1.0.4) + # message(FATAL_ERROR "yaFyaml must be at least 1.0.4") + #endif () endif() message (STATUS "Building with ExtData2G") else() @@ -107,9 +108,10 @@ if (BUILD_WITH_PFLOGGER) if(NOT TARGET PFLOGGER::pflogger) find_package(PFLOGGER 1.9.1 REQUIRED) else() - if (PFLOGGER_VERSION VERSION_LESS 1.9.1) - message(FATAL_ERROR "pFlogger must be at least 1.9.1") - endif () + # Remove version check error if using GCHP + #if (PFLOGGER_VERSION VERSION_LESS 1.9.1) + # message(FATAL_ERROR "pFlogger must be at least 1.9.1") + #endif () endif() endif() diff --git a/pfio/CMakeLists.txt b/pfio/CMakeLists.txt index ae9cdb32728f..335620f4f11a 100644 --- a/pfio/CMakeLists.txt +++ b/pfio/CMakeLists.txt @@ -91,7 +91,9 @@ set (srcs StringVectorUtil.F90 ) -esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.profiler NetCDF::NetCDF_Fortran NetCDF::NetCDF_C TYPE ${MAPL_LIBRARY_TYPE}) +# Exclude NetCDF_C dependency since only needed for demos which are not used in GCHP +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.profiler NetCDF::NetCDF_Fortran TYPE ${MAPL_LIBRARY_TYPE}) +#esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.profiler NetCDF::NetCDF_Fortran NetCDF::NetCDF_C TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL_SHARED::gftl-shared PRIVATE MPI::MPI_Fortran) # CMake has an OpenMP issue with NAG Fortran: https://gitlab.kitware.com/cmake/cmake/-/issues/21280 if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "NAG") From 51a57308efc4737c9458092e751323240e67ceb2 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Mon, 7 Nov 2022 12:31:44 -0500 Subject: [PATCH 300/300] Fix GCHP run bug following merge Signed-off-by: Lizzie Lundgren --- gridcomps/ExtData2G/CMakeLists.txt | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/gridcomps/ExtData2G/CMakeLists.txt b/gridcomps/ExtData2G/CMakeLists.txt index e2ab97514db3..3e1a749be1be 100644 --- a/gridcomps/ExtData2G/CMakeLists.txt +++ b/gridcomps/ExtData2G/CMakeLists.txt @@ -24,7 +24,9 @@ set (srcs ) -esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.base MAPL.generic MAPL.griddedio TYPE SHARED) +# Replace SHARED with ${MAPL_LIBRARY_TYPE} if using GCHP +#esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.base MAPL.generic MAPL.griddedio TYPE SHARED) +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES MAPL.shared MAPL.base MAPL.generic MAPL.griddedio TYPE ${MAPL_LIBRARY_TYPE}) target_link_libraries (${this} PUBLIC GFTL::gftl GFTL_SHARED::gftl-shared YAFYAML::yafyaml esmf NetCDF::NetCDF_Fortran PRIVATE MPI::MPI_Fortran) target_include_directories (${this} PUBLIC $)