From 1460e484d4b1170dd64145867902160c425c5d2f Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 30 Sep 2022 12:22:34 -0400 Subject: [PATCH 01/73] branch off v1.17.0 --- GEOSagcm_GridComp/GigaTraj_GridComp/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 GEOSagcm_GridComp/GigaTraj_GridComp/CMakeLists.txt diff --git a/GEOSagcm_GridComp/GigaTraj_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GigaTraj_GridComp/CMakeLists.txt new file mode 100644 index 000000000..058530995 --- /dev/null +++ b/GEOSagcm_GridComp/GigaTraj_GridComp/CMakeLists.txt @@ -0,0 +1 @@ +add_subdirectory (@GigaTraj) From 6487c104a2dedd8710689617cffc971e34f2c1d7 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 30 Sep 2022 13:53:22 -0400 Subject: [PATCH 02/73] add GigaTraj_GridComp --- GEOSagcm_GridComp/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/CMakeLists.txt index 5cbdbb1c7..968095ac1 100644 --- a/GEOSagcm_GridComp/CMakeLists.txt +++ b/GEOSagcm_GridComp/CMakeLists.txt @@ -3,6 +3,7 @@ esma_set_this() set (alldirs GEOSsuperdyn_GridComp GEOSphysics_GridComp + GigaTraj_GridComp ) if (EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/GEOS_AgcmGridComp.F90) From db6edf2c8acdf46a3bf6c2d6daa5e71bdba7b39d Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 3 Oct 2022 15:04:27 -0400 Subject: [PATCH 03/73] move Gigatraj up --- CMakeLists.txt | 7 + GEOS_GcmGridComp.F90 | 14 ++ GEOSagcm_GridComp/CMakeLists.txt | 1 - .../GigaTraj_GridComp/CMakeLists.txt | 1 - GigaTraj_GridComp/CMakeLists.txt | 10 + GigaTraj_GridComp/GigaTraj_GridComp.F90 | 211 ++++++++++++++++++ 6 files changed, 242 insertions(+), 2 deletions(-) delete mode 100644 GEOSagcm_GridComp/GigaTraj_GridComp/CMakeLists.txt create mode 100644 GigaTraj_GridComp/CMakeLists.txt create mode 100644 GigaTraj_GridComp/GigaTraj_GridComp.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 4c9699c3e..ae2161b3f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -7,6 +7,13 @@ set (alldirs GEOSogcm_GridComp ) +option(BUILD_WITH_GIGATRAJ "Build GEOSgcm with Gigigatraj" ON) + +if (BUILD_WITH_GIGATRAJ) + add_definitions (-DHAS_GIGATRAJ) + set (alldirs ${alldirs} GigaTraj_GridComp +endif + if (EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/GEOS_GcmGridComp.F90) diff --git a/GEOS_GcmGridComp.F90 b/GEOS_GcmGridComp.F90 index 27fa383f2..9f329486a 100644 --- a/GEOS_GcmGridComp.F90 +++ b/GEOS_GcmGridComp.F90 @@ -20,6 +20,10 @@ module GEOS_GcmGridCompMod use GEOS_AgcmGridCompMod, only: AGCM_SetServices => SetServices use GEOS_mkiauGridCompMod, only: AIAU_SetServices => SetServices use DFI_GridCompMod, only: ADFI_SetServices => SetServices +#ifdef HAS_GIGATRAJ + use GigaTraj_GridCompMod, only: GigaTraj_SetServices => SetServices +#endif + use GEOS_OgcmGridCompMod, only: OGCM_SetServices => SetServices use MAPL_HistoryGridCompMod, only: Hist_SetServices => SetServices use MAPL_HistoryGridCompMod, only: HISTORY_ExchangeListWrap @@ -53,6 +57,7 @@ module GEOS_GcmGridCompMod integer :: AIAU integer :: ADFI integer :: hist +integer :: gigatraj integer :: bypass_ogcm integer :: k @@ -235,6 +240,10 @@ subroutine SetServices ( GC, RC ) else AGCM = MAPL_AddChild(GC, NAME='AGCM', SS=Agcm_SetServices, RC=STATUS) VERIFY_(STATUS) +#ifdef HAS_GIGATRAJ + gigatraj = MAPL_AddChild(GC, NAME='GigaTraj', SS=GigaTraj_SetServices, RC=STATUS) + VERIFY_(STATUS) +#endif AIAU = MAPL_AddChild(GC, NAME='AIAU', SS=AIAU_SetServices, RC=STATUS) VERIFY_(STATUS) ADFI = MAPL_AddChild(GC, NAME='ADFI', SS=ADFI_SetServices, RC=STATUS) @@ -1890,6 +1899,11 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_GridCompRun ( GCS(AGCM), importState=GIM(AGCM), exportState=GEX(AGCM), clock=clock, userRC=status ) VERIFY_(STATUS) +#ifdef HAS_GIGATRAJ + ! use agcm export as gigatraj's import + call ESMF_GridCompRun ( GCS(gigatraj), importState=GEX(AGCM), exportState=GEX(gigatraj), clock=clock, userRC=status ) + VERIFY_(STATUS) +#endif if(DO_DATAATM/=0) then call MAPL_TimerOff(MAPL,"DATAATM" ) diff --git a/GEOSagcm_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/CMakeLists.txt index 968095ac1..5cbdbb1c7 100644 --- a/GEOSagcm_GridComp/CMakeLists.txt +++ b/GEOSagcm_GridComp/CMakeLists.txt @@ -3,7 +3,6 @@ esma_set_this() set (alldirs GEOSsuperdyn_GridComp GEOSphysics_GridComp - GigaTraj_GridComp ) if (EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/GEOS_AgcmGridComp.F90) diff --git a/GEOSagcm_GridComp/GigaTraj_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GigaTraj_GridComp/CMakeLists.txt deleted file mode 100644 index 058530995..000000000 --- a/GEOSagcm_GridComp/GigaTraj_GridComp/CMakeLists.txt +++ /dev/null @@ -1 +0,0 @@ -add_subdirectory (@GigaTraj) diff --git a/GigaTraj_GridComp/CMakeLists.txt b/GigaTraj_GridComp/CMakeLists.txt new file mode 100644 index 000000000..c31a7f9f1 --- /dev/null +++ b/GigaTraj_GridComp/CMakeLists.txt @@ -0,0 +1,10 @@ +esma_set_this() + + +set (dependencies MAPL esmf) + +esma_add_library (${this} + SRCS GigaTraj_GridComp.F90 + DEPENDENCIES ${dependencies}) + +add_subdirectory (@GigaTraj) diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 new file mode 100644 index 000000000..43111144d --- /dev/null +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -0,0 +1,211 @@ +#include "MAPL_Generic.h" + +!============================================================================= +!BOP + +! !MODULE: GigaTraj_GridCompMod -- A Module to run gigatraj + +! !INTERFACE: + +module GigaTraj_GridCompMod + +! !USES: + + use ESMF + use MAPL + + implicit none + private + +! !PUBLIC MEMBER FUNCTIONS: + + public :: SetServices + +contains + +!BOP + +! !IROUTINE: SetServices -- Sets ESMF services for this component + +! !INTERFACE: + + subroutine SetServices ( GC, RC ) + +! !ARGUMENTS: + + type(ESMF_GridComp), intent(INOUT) :: GC ! gridded component + integer, optional :: RC ! return code + + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + +! Begin... + +! Get my name and set-up traceback handle +! --------------------------------------- + + call ESMF_GridCompGet( GC, NAME=COMP_NAME, RC=STATUS ) + VERIFY_(STATUS) + Iam = trim(COMP_NAME) // 'SetServices' + +! Register services for this component +! ------------------------------------ + + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_INITIALIZE, Initialize, RC=STATUS ) + VERIFY_(STATUS) + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run , RC=STATUS ) + VERIFY_(STATUS) + +! Get the configuration from the component +!----------------------------------------- + + call ESMF_GridCompGet( GC, CONFIG = CF, RC=STATUS ) + VERIFY_(STATUS) + +! Set the state variable specs. +! ----------------------------- + call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS) + VERIFY_(STATUS) + + +! Clocks +!------- + + call MAPL_TimerAdd(GC, name="INITIALIZE" ,RC=STATUS) + VERIFY_(STATUS) + call MAPL_TimerAdd(GC, name="RUN" ,RC=STATUS) + VERIFY_(STATUS) + +! All done +!--------- + + RETURN_(ESMF_SUCCESS) + end subroutine SetServices + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!BOP + +! !IROUTINE: Initialize -- Initialize method for the composite GigaTraj Gridded Component + +! !INTERFACE: + + subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) + +! !ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_State), intent(inout) :: IMPORT ! Import state + type(ESMF_State), intent(inout) :: EXPORT ! Export state + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + integer, optional, intent( out) :: RC ! Error code + +! !DESCRIPTION: + + +!EOP + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + +! Local derived type aliases + + type (MAPL_MetaComp), pointer :: STATE + type (ESMF_State), pointer :: GIM(:) + type (ESMF_State), pointer :: GEX(:) + type (ESMF_Field) :: FIELD + type (ESMF_Time) :: CurrTime, RingTime + type (ESMF_TimeInterval) :: TIMEINT + type (ESMF_Alarm) :: ALARM + type (ESMF_Alarm) :: ALARM4D + type (ESMF_Config) :: cf + integer :: I, NQ + real :: POFFSET, DT + real, pointer, dimension(:,:) :: PHIS,SGH,VARFLT,PTR + real, pointer, dimension(:,:,:) :: TEND! + character(len=ESMF_MAXSTR) :: replayMode + real :: RPL_INTERVAL + real :: RPL_SHUTOFF + real :: IAU4dFREQ + integer :: PREDICTOR_DURATION + integer :: MKIAU_FREQUENCY + character(len=ESMF_MAXSTR), parameter :: INITIALIZED_EXPORTS(3) = & + (/'PHIS ', 'SGH ', 'VARFLT' /) + + logical :: DasMode + character(len=ESMF_MAXSTR) :: STRING + character(len=ESMF_MAXSTR) :: rplMode + +! ============================================================================= + +! Begin... + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + call ESMF_GridCompGet ( GC, name=COMP_NAME, config=cf, RC=STATUS ) + VERIFY_(STATUS) + Iam = trim(COMP_NAME) // "Initialize" + +! Get my MAPL_Generic state +!-------------------------- + + call MAPL_GetObjectFromGC ( GC, STATE, RC=STATUS) + VERIFY_(STATUS) + + + call MAPL_TimerOn(STATE,"INITIALIZE") + +! Call Initialize for every Child + + call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC=STATUS) + VERIFY_(STATUS) + + call MAPL_TimerOn(STATE,"TOTAL") + + call MAPL_TimerOff(STATE,"TOTAL") + call MAPL_TimerOff(STATE,"INITIALIZE") + + + RETURN_(ESMF_SUCCESS) + end subroutine Initialize + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!BOP + +! !IROUTINE: Run -- Run method for the composite Agcm Gridded Component + +! !INTERFACE: + + subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) + +! !ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_State), intent(inout) :: IMPORT ! Import state + type(ESMF_State), intent(inout) :: EXPORT ! Export state + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + integer, optional, intent( out) :: RC ! Error code + +! !DESCRIPTION: + + +!EOP + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + + + end subroutine Run + +end module GigaTraj_GridCompMod From 431b5957d978f38391aa5e8184b380caef979030 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 3 Oct 2022 18:31:45 -0400 Subject: [PATCH 04/73] fix trivial error --- CMakeLists.txt | 6 +++--- GigaTraj_GridComp/GigaTraj_GridComp.F90 | 3 +++ 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index ae2161b3f..26eb1c124 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -7,12 +7,12 @@ set (alldirs GEOSogcm_GridComp ) -option(BUILD_WITH_GIGATRAJ "Build GEOSgcm with Gigigatraj" ON) +option(BUILD_WITH_GIGATRAJ "Build GEOSgcm with Gigatraj" ON) if (BUILD_WITH_GIGATRAJ) add_definitions (-DHAS_GIGATRAJ) - set (alldirs ${alldirs} GigaTraj_GridComp -endif + set (alldirs ${alldirs} GigaTraj_GridComp) +endif() if (EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/GEOS_GcmGridComp.F90) diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 index 43111144d..af2dfead7 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -40,6 +40,9 @@ subroutine SetServices ( GC, RC ) integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME + type (ESMF_Config) :: CF + type (MAPL_MetaComp), pointer :: MAPL + ! Begin... ! Get my name and set-up traceback handle From 73aaf54a155a43231f6de8aeeb7e346df9a1fccd Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 10 Oct 2022 10:33:29 -0400 Subject: [PATCH 05/73] set grid for Gigatraj --- GEOS_GcmGridComp.F90 | 4 ++++ GigaTraj_GridComp/GigaTraj_GridComp.F90 | 12 ++++++++++++ 2 files changed, 16 insertions(+) diff --git a/GEOS_GcmGridComp.F90 b/GEOS_GcmGridComp.F90 index 9f329486a..81e8f8b93 100644 --- a/GEOS_GcmGridComp.F90 +++ b/GEOS_GcmGridComp.F90 @@ -922,6 +922,10 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Recursive setup of grids (should be disabled) call ESMF_GridCompSet(GCS(AGCM), grid=agrid, rc=status) VERIFY_(STATUS) +#ifdef HAS_GIGATRAJ + call ESMF_GridCompSet(GCS(gigatraj), grid=agrid, rc=status) + VERIFY_(STATUS) +#endif call ESMF_GridCompSet(GCS(OGCM), grid=ogrid, rc=status) VERIFY_(STATUS) if(DO_DATAATM==0) then diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 index af2dfead7..307aefada 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -71,7 +71,18 @@ subroutine SetServices ( GC, RC ) call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS) VERIFY_(STATUS) + call MAPL_AddExportSpec ( gc, & + SHORT_NAME = 'DVDT', & + LONG_NAME = 'northward_wind_bias_tendency', & + UNITS = 'm s-2', & + DIMS = MAPL_DimsHorzVert, & + FIELD_TYPE = MAPL_VectorField, & + VLOCATION = MAPL_VLocationCenter, RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_GenericSetServices ( GC, RC=STATUS ) + VERIFY_(STATUS) ! Clocks !------- @@ -209,6 +220,7 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=ESMF_MAXSTR) :: COMP_NAME + RETURN_(ESMF_SUCCESS) end subroutine Run end module GigaTraj_GridCompMod From 98cde3804e4712bb954296e76975bcee78e312b3 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 26 Oct 2022 14:59:01 -0400 Subject: [PATCH 06/73] add frame work for data exchange --- GigaTraj_GridComp/GigaTraj_GridComp.F90 | 238 ++++++++++++++++++++---- 1 file changed, 202 insertions(+), 36 deletions(-) diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 index 307aefada..65dc1f402 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -13,7 +13,7 @@ module GigaTraj_GridCompMod use ESMF use MAPL - + use mpi implicit none private @@ -21,6 +21,16 @@ module GigaTraj_GridCompMod public :: SetServices + type GigaTrajInternal + integer :: npes + type (ESMF_Grid) :: LatLonGrid + integer, allocatable :: CellToRank(:,:) + end type + + type GigatrajInternalWrap + type (GigaTrajInternal), pointer :: PTR + end type + contains !BOP @@ -43,6 +53,9 @@ subroutine SetServices ( GC, RC ) type (ESMF_Config) :: CF type (MAPL_MetaComp), pointer :: MAPL + type (GigaTrajInternal), pointer :: GigaTrajInternalPtr + type (GigatrajInternalWrap) :: wrap + ! Begin... ! Get my name and set-up traceback handle @@ -81,6 +94,11 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) + allocate(GigaTrajInternalPtr) + wrap%ptr => GigaTrajInternalPtr + call ESMF_UserCompSetInternalState ( GC, 'GigaTrajInternal', wrap, status ) + VERIFY_(STATUS) + call MAPL_GenericSetServices ( GC, RC=STATUS ) VERIFY_(STATUS) ! Clocks @@ -129,32 +147,15 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=ESMF_MAXSTR) :: COMP_NAME ! Local derived type aliases - - type (MAPL_MetaComp), pointer :: STATE - type (ESMF_State), pointer :: GIM(:) - type (ESMF_State), pointer :: GEX(:) - type (ESMF_Field) :: FIELD - type (ESMF_Time) :: CurrTime, RingTime - type (ESMF_TimeInterval) :: TIMEINT - type (ESMF_Alarm) :: ALARM - type (ESMF_Alarm) :: ALARM4D - type (ESMF_Config) :: cf - integer :: I, NQ - real :: POFFSET, DT - real, pointer, dimension(:,:) :: PHIS,SGH,VARFLT,PTR - real, pointer, dimension(:,:,:) :: TEND! - character(len=ESMF_MAXSTR) :: replayMode - real :: RPL_INTERVAL - real :: RPL_SHUTOFF - real :: IAU4dFREQ - integer :: PREDICTOR_DURATION - integer :: MKIAU_FREQUENCY - character(len=ESMF_MAXSTR), parameter :: INITIALIZED_EXPORTS(3) = & - (/'PHIS ', 'SGH ', 'VARFLT' /) - - logical :: DasMode - character(len=ESMF_MAXSTR) :: STRING - character(len=ESMF_MAXSTR) :: rplMode + type (MAPL_MetaComp), pointer :: STATE + type (ESMF_VM) :: vm + integer :: I1, I2, J1, J2, comm, npes, rank, ierror, NX, NY + type(ESMF_Grid) :: CubedGrid + integer, allocatable :: I1s(:), J1s(:), I2s(:),J2s(:) + integer :: DIMS(3) + type (GigaTrajInternal), pointer :: GigaTrajInternalPtr + type (GigatrajInternalWrap) :: wrap + ! ============================================================================= @@ -163,7 +164,7 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- - call ESMF_GridCompGet ( GC, name=COMP_NAME, config=cf, RC=STATUS ) + call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) VERIFY_(STATUS) Iam = trim(COMP_NAME) // "Initialize" @@ -174,6 +175,7 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) VERIFY_(STATUS) + call MAPL_TimerOn(STATE,"TOTAL") call MAPL_TimerOn(STATE,"INITIALIZE") ! Call Initialize for every Child @@ -181,10 +183,53 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC=STATUS) VERIFY_(STATUS) - call MAPL_TimerOn(STATE,"TOTAL") + call ESMF_VMGetCurrent(vm, rc=status) + call ESMF_VMGet(vm, mpiCommunicator=comm, __RC__) + call MPI_Comm_size(comm, npes, ierror); _VERIFY(ierror) - call MAPL_TimerOff(STATE,"TOTAL") + call ESMF_GridCompGet(GC, grid=CubedGrid, rc=status) + call MAPL_GridGet(CubedGrid, globalCellCountPerDim=DIMS, RC=status) + + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, status) + VERIFY_(STATUS) + GigaTrajInternalPtr => wrap%ptr + + GigaTrajInternalPtr%npes = npes + call MAPL_MakeDecomposition(NX,NY,rc=status) + VERIFY_(status) + GigaTrajInternalPtr%LatLonGrid = grid_manager%make_grid( & + LatLonGridFactory(im_world=DIMS(1)*4, jm_world=DIMS(1)*2, lm=DIMS(3), & + nx=NX, ny=NY, pole='PC', dateline= 'DC', rc=status) ) + + + call MAPL_Grid_interior(GigaTrajInternalPtr%LatLonGrid ,i1,i2,j1,j2) + + allocate(I1s(npes),J1s(npes)) + allocate(I2s(npes),J2s(npes)) + + call MPI_Allgather(i1, 1, MPI_INTEGER, I1s, 1, MPI_INTEGER, comm, ierror) + _VERIFY(ierror) + call MPI_Allgather(i2, 1, MPI_INTEGER, I2s, 1, MPI_INTEGER, comm, ierror) + _VERIFY(ierror) + call MPI_Allgather(j1, 1, MPI_INTEGER, J1s, 1, MPI_INTEGER, comm, ierror) + _VERIFY(ierror) + call MPI_Allgather(j2, 1, MPI_INTEGER, J2s, 1, MPI_INTEGER, comm, ierror) + _VERIFY(ierror) + + call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, globalCellCountPerDim=DIMS, RC=status) + + allocate(GigaTrajInternalPtr%CellToRank(DIMS(1),DIMS(2))) + + do rank = 0, npes -1 + I1 = I1s(rank+1) + I2 = I2s(rank+1) + J1 = J1s(rank+1) + J2 = J2s(rank+1) + GigaTrajInternalPtr%CellToRank(I1:I2,J1:J2) = rank + enddo + call MAPL_TimerOff(STATE,"INITIALIZE") + call MAPL_TimerOff(STATE,"TOTAL") RETURN_(ESMF_SUCCESS) @@ -194,7 +239,7 @@ end subroutine Initialize !BOP -! !IROUTINE: Run -- Run method for the composite Agcm Gridded Component +! !IROUTINE: Run -- Run method for Gigatraj GridComp ! !INTERFACE: @@ -210,17 +255,138 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) ! !DESCRIPTION: - !EOP ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm - integer :: STATUS - character(len=ESMF_MAXSTR) :: COMP_NAME + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + integer :: CSTAT, ESTAT, YY, MM, HH, DD, H, M,S, model_dtstep_m + character(512) :: CMSG + character(256) :: command_line + character(19) :: begdate, enddate + character(64) :: format_string + type(ESMF_TimeInterval) :: ModelTimeStep + type(ESMF_Time) :: CurrentTime + + type (GigaTrajInternal), pointer :: GigaTrajInternalPtr + type (GigatrajInternalWrap) :: wrap + type(ESMF_Grid) :: CubedGrid + + integer :: num_parcels, i + integer,parameter :: seed = 86456 + real, allocatable :: lats(:), lons(:), lons_send(:), lats_send(:), U(:), pos(:) + real, allocatable :: lons_recv(:), lats_recv(:), U_recv(:), U_send(:) + real :: rparcels, dlat, dlon + integer, allocatable :: counts_send(:),counts_recv(:), II(:), JJ(:), ranks(:) + integer, allocatable :: disp_send(:), disp_recv(:), tmp_position(:) + integer :: DIMS(3), rank, comm, ierror + type (ESMF_VM) :: vm + + call ESMF_ClockGet(clock, currTime=CurrentTime, rc=status) + _VERIFY(status) + + call ESMF_ClockGet(clock, timeStep=ModelTimeStep,rc=status) + _VERIFY(status) + + +!----------------- +! Step 1) given lat lon, where it should go ? +!----------------- + + + call ESMF_GridCompGet(GC, grid=CubedGrid, rc=status) + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, status) + VERIFY_(STATUS) + GigaTrajInternalPtr => wrap%ptr + + call random_seed() + call random_number(rparcels) + + num_parcels = nint(rparcels*10) + + allocate(lats(num_parcels), lons(num_parcels)) + + call random_number(lats) + call random_number(lons) + + lons = lons*2*MAPL_PI + lats = lats*MAPL_PI + + allocate(II(num_parcels),JJ(num_parcels), ranks(num_parcels)) + allocate(counts_send(GigaTrajInternalPtr%npes)) + allocate(counts_recv(GigaTrajInternalPtr%npes)) + allocate(disp_send(GigaTrajInternalPtr%npes)) + allocate(disp_recv(GigaTrajInternalPtr%npes)) + + call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, globalCellCountPerDim=DIMS, RC=status) + dlon = 2*MAPL_PI / DIMS(1) + dlat = MAPL_PI / DIMS(2) - RETURN_(ESMF_SUCCESS) + II = ceiling (lons/dlon) + JJ = ceiling (lats/dlat) + + if (any(II > DIMS(1)) .or. any(II<0)) stop ("wrong II") + if (any(JJ > DIMS(2)) .or. any(JJ<0)) stop ("wrong JJ") + do i = 1, num_parcels + ranks(i) = GigaTrajInternalPtr%CellToRank(II(i), JJ(i)) + enddo + + + do rank = 0, GigaTrajInternalPtr%npes-1 + counts_send(rank+1) = count(ranks == rank) + enddo + + +!--------------------- +!step 2) pack the location data and send them to where data sit +!--------------------- + + call ESMF_VMGetCurrent(vm, rc=status) + call ESMF_VMGet(vm, mpiCommunicator=comm, __RC__) + call MPI_AllToALL(counts_send, 1, MPI_INTEGER, counts_recv, 1, MPI_INTEGER, comm, ierror) + + disp_send = 0 + do rank = 1, GigaTrajInternalPtr%npes-1 + disp_send(rank+1) = disp_send(rank)+ counts_send(rank) + enddo + disp_recv = 0 + do rank = 1, GigaTrajInternalPtr%npes-1 + disp_recv(rank+1) = disp_recv(rank)+ counts_recv(rank) + enddo + + ! pack and regroup lats lons, and ids + tmp_position = disp_send + allocate(lons_send(num_parcels)) + allocate(lons_recv(sum(counts_recv))) + allocate(pos(num_parcels)) + do i = 1, num_parcels + rank = ranks(i) + pos(i) = tmp_position(rank+1) +1 + lons_send(pos(i)) = lons(i) + tmp_position(rank+1) = tmp_position(rank+1) + 1 + enddo + + call MPI_AllToALLv(lons_send, counts_send, disp_send, MPI_REAL, lons_recv, counts_recv, disp_recv, MPI_REAL, comm, ierror) + +!--------------------- +!step 3) Interpolate the data and send back where they request +!--------------------- + + allocate(U_recv(sum(counts_recv)), source = rank*1.0) + allocate(U_send(num_parcels), source = -1.0) + + call MPI_AllToALLv(U_recv, counts_recv, disp_recv, MPI_REAL, U_send, counts_send, disp_send, MPI_REAL, comm, ierror) + + + ! re-arrange U_send + allocate(U(num_parcels)) + U(:) = U_send(pos(:)) + + print*," Great, I am still alive" + RETURN_(ESMF_SUCCESS) end subroutine Run end module GigaTraj_GridCompMod From 824fa23f79c605b047aa0d04f095e336075999f2 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 31 Oct 2022 10:31:30 -0400 Subject: [PATCH 07/73] add halo --- GigaTraj_GridComp/GigaTraj_GridComp.F90 | 80 ++++++++++++++++++------- 1 file changed, 60 insertions(+), 20 deletions(-) diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 index 65dc1f402..b7244bf6b 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -24,6 +24,7 @@ module GigaTraj_GridCompMod type GigaTrajInternal integer :: npes type (ESMF_Grid) :: LatLonGrid + class (AbstractRegridder), pointer :: cube2latlon => null() integer, allocatable :: CellToRank(:,:) end type @@ -202,6 +203,7 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) nx=NX, ny=NY, pole='PC', dateline= 'DC', rc=status) ) + GigaTrajInternalPtr%cube2latlon => new_regridder_manager%make_regridder(CubedGrid, GigaTrajInternalPtr%LatLonGrid, REGRID_METHOD_CONSERVE, rc=status) call MAPL_Grid_interior(GigaTrajInternalPtr%LatLonGrid ,i1,i2,j1,j2) allocate(I1s(npes),J1s(npes)) @@ -284,22 +286,56 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: DIMS(3), rank, comm, ierror type (ESMF_VM) :: vm - call ESMF_ClockGet(clock, currTime=CurrentTime, rc=status) - _VERIFY(status) + real, dimension(:,:,:), pointer :: U_cube + real, dimension(:,:,:), allocatable :: U_latlon + real, dimension(:,:,:), pointer :: U_latlon_halo + integer :: halowidth(3) + type(ESMF_Field) :: U_field + type(ESMF_RouteHandle) :: rh + + call ESMF_VMGetCurrent(vm, _RC) + call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) + call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) + + call ESMF_ClockGet(clock, currTime=CurrentTime, _RC) - call ESMF_ClockGet(clock, timeStep=ModelTimeStep,rc=status) - _VERIFY(status) + call ESMF_ClockGet(clock, timeStep=ModelTimeStep, _RC) + call ESMF_GridCompGet(GC, grid=CubedGrid, _RC) -!----------------- -! Step 1) given lat lon, where it should go ? -!----------------- + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) + GigaTrajInternalPtr => wrap%ptr + call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=DIMS, _RC) - call ESMF_GridCompGet(GC, grid=CubedGrid, rc=status) - call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, status) - VERIFY_(STATUS) - GigaTrajInternalPtr => wrap%ptr + allocate(U_latlon(DIMS(1), DIMS(2),DIMS(3)), source = 0.0) + +!--------------- +! Step 1) Regrid the metData field from cubed to lat-lon +!--------------- + + call MAPL_GetPointer(Import, U_cube, "U", _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(U_cube, U_latlon, _RC) + +!--------------- +! Step 2) Get halo of latlon metData field +! After this step, the local field has distributed horizonal + halo +!--------------- + + U_field = ESMF_FieldCreate(GigaTrajInternalPtr%LatLonGrid, ESMF_TYPEKIND_R4, name='U', & + ungriddedLBound=[1],ungriddedUBound=[DIMS(3)], & + totalLWidth=[1,1],totalUWidth=[1,1]) + call ESMF_FieldHaloStore(U_field,rh,rc=status) + _VERIFY(status) + + call ESMF_FieldGet(U_field, farrayPtr=U_latlon_halo, _RC) + U_latlon_halo(2:DIMS(1)+1, 2:DIMS(2)+1, :) = U_latlon + call ESMF_FieldHalo(U_field,rh,rc=status) + _VERIFY(status) + +!----------------- +! Step 3) Given partical position (lat lon), find out which processor it should go ? +!----------------- call random_seed() call random_number(rparcels) @@ -334,16 +370,14 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) ranks(i) = GigaTrajInternalPtr%CellToRank(II(i), JJ(i)) enddo +!--------------------- +!step 4) Pack the location data and send them to where the metData sit +!--------------------- do rank = 0, GigaTrajInternalPtr%npes-1 counts_send(rank+1) = count(ranks == rank) enddo - -!--------------------- -!step 2) pack the location data and send them to where data sit -!--------------------- - call ESMF_VMGetCurrent(vm, rc=status) call ESMF_VMGet(vm, mpiCommunicator=comm, __RC__) call MPI_AllToALL(counts_send, 1, MPI_INTEGER, counts_recv, 1, MPI_INTEGER, comm, ierror) @@ -357,7 +391,7 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) disp_recv(rank+1) = disp_recv(rank)+ counts_recv(rank) enddo - ! pack and regroup lats lons, and ids + ! re-arranged lats lons, and ids tmp_position = disp_send allocate(lons_send(num_parcels)) allocate(lons_recv(sum(counts_recv))) @@ -372,19 +406,25 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call MPI_AllToALLv(lons_send, counts_send, disp_send, MPI_REAL, lons_recv, counts_recv, disp_recv, MPI_REAL, comm, ierror) !--------------------- -!step 3) Interpolate the data and send back where they request +!step 5) Interpolate the data ( horiontally and vertically) and send back where they are from !--------------------- allocate(U_recv(sum(counts_recv)), source = rank*1.0) allocate(U_send(num_parcels), source = -1.0) - + ! + ! Horizontal and vertical interpolator here + ! call MPI_AllToALLv(U_recv, counts_recv, disp_recv, MPI_REAL, U_send, counts_send, disp_send, MPI_REAL, comm, ierror) - ! re-arrange U_send +!--------------------- +!step 6) Rearrange data ( not necessary if ids was rearranged ins step 4) allocate(U(num_parcels)) U(:) = U_send(pos(:)) + !deallocate(U_latlon_halo) + call ESMF_FieldDestroy(U_field) + print*," Great, I am still alive" RETURN_(ESMF_SUCCESS) end subroutine Run From b705e5f161842a5b6cfdf43de55f5f8d89a767a9 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 10 Nov 2022 14:46:52 -0500 Subject: [PATCH 08/73] add init_run phase to get initial metdata from agcm --- GEOS_GcmGridComp.F90 | 9 +- GigaTraj_GridComp/GigaTraj_GridComp.F90 | 293 ++++++++++++++++++++---- 2 files changed, 254 insertions(+), 48 deletions(-) diff --git a/GEOS_GcmGridComp.F90 b/GEOS_GcmGridComp.F90 index 81e8f8b93..526b66f47 100644 --- a/GEOS_GcmGridComp.F90 +++ b/GEOS_GcmGridComp.F90 @@ -1901,11 +1901,18 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_TimerOn(MAPL,"AGCM" ) endif +#ifdef HAS_GIGATRAJ + ! use agcm export as gigatraj's import to get the initial state. + ! it only runs at the begining of the first time step + call ESMF_GridCompRun ( GCS(gigatraj), importState=GEX(AGCM), exportState=GEX(gigatraj), clock=clock, phase=1, userRC=status ) + VERIFY_(STATUS) +#endif + call ESMF_GridCompRun ( GCS(AGCM), importState=GIM(AGCM), exportState=GEX(AGCM), clock=clock, userRC=status ) VERIFY_(STATUS) #ifdef HAS_GIGATRAJ ! use agcm export as gigatraj's import - call ESMF_GridCompRun ( GCS(gigatraj), importState=GEX(AGCM), exportState=GEX(gigatraj), clock=clock, userRC=status ) + call ESMF_GridCompRun ( GCS(gigatraj), importState=GEX(AGCM), exportState=GEX(gigatraj), clock=clock, phase=2, userRC=status ) VERIFY_(STATUS) #endif diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 index b7244bf6b..20615a792 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -21,11 +21,19 @@ module GigaTraj_GridCompMod public :: SetServices + type horde + integer :: num_parcels + integer, allocatable :: IDS(:) + real, allocatable :: lats(:), lons(:), z(:) + end type + type GigaTrajInternal integer :: npes type (ESMF_Grid) :: LatLonGrid class (AbstractRegridder), pointer :: cube2latlon => null() integer, allocatable :: CellToRank(:,:) + real, dimension(:,:,:), allocatable :: preU, PreV, preW + type(horde) :: parcels end type type GigatrajInternalWrap @@ -71,7 +79,9 @@ subroutine SetServices ( GC, RC ) call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_INITIALIZE, Initialize, RC=STATUS ) VERIFY_(STATUS) - call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run , RC=STATUS ) + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, GetInitVars , RC=STATUS ) + VERIFY_(STATUS) + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run , RC=STATUS ) VERIFY_(STATUS) ! Get the configuration from the component @@ -221,7 +231,6 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, globalCellCountPerDim=DIMS, RC=status) allocate(GigaTrajInternalPtr%CellToRank(DIMS(1),DIMS(2))) - do rank = 0, npes -1 I1 = I1s(rank+1) I2 = I2s(rank+1) @@ -229,7 +238,44 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) J2 = J2s(rank+1) GigaTrajInternalPtr%CellToRank(I1:I2,J1:J2) = rank enddo - + +! initialize partical positions. It will be read and distribted across processors. +! for now, it is genrated randomly + block + real :: rparcels + integer :: num_parcels, my_rank, i + real, allocatable :: lats(:), lons(:) + integer, allocatable :: nums_all(:) + + !call random_seed() + !call random_number(rparcels) + + !num_parcels = nint(rparcels*10) + num_parcels = 20 + + allocate(lats(num_parcels), lons(num_parcels)) + + call random_number(lats) + call random_number(lons) + + lons = lons*2.0*MAPL_PI - MAPL_PI + lats = lats*MAPL_PI - 0.50*MAPL_PI + + GigaTrajInternalPtr%parcels%num_parcels = num_parcels + GigaTrajInternalPtr%parcels%lats = lats + GigaTrajInternalPtr%parcels%lons = lons + GigaTrajInternalPtr%parcels%IDS = [(i, i=1, num_parcels)] + + allocate(nums_all(npes)) + call MPI_AllGather(num_parcels, 1, MPI_INTEGER, nums_all, 1, MPI_INTEGER, comm, ierror) + + call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) + if (my_rank > 0) then + GigaTrajInternalPtr%parcels%IDS = GigaTrajInternalPtr%parcels%IDS + sum(nums_all(1:my_rank)) + endif + + end block + call MAPL_TimerOff(STATE,"INITIALIZE") call MAPL_TimerOff(STATE,"TOTAL") @@ -241,6 +287,91 @@ end subroutine Initialize !BOP +! !IROUTINE: GetInitVars -- GetInitVars method for Gigatraj GridComp to get initial state from AGCM's export + +! !INTERFACE: + + subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) + +! !ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_State), intent(inout) :: IMPORT ! Import state + type(ESMF_State), intent(inout) :: EXPORT ! Export state + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + integer, optional, intent( out) :: RC ! Error code + +! !DESCRIPTION: + +!EOP + + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS + logical, save :: first_time_run = .true. + type (GigaTrajInternal), pointer :: GigaTrajInternalPtr + type (GigatrajInternalWrap) :: wrap + + real, dimension(:,:,:), pointer :: U, V, W, with_halo + real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon + integer :: counts(3), dims(3) + type(ESMF_Field) :: field + type(ESMF_RouteHandle) :: rh + + if (.not. first_time_run) then + RETURN_(ESMF_SUCCESS) + endif + + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) + GigaTrajInternalPtr => wrap%ptr + call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts, _RC) + + call MAPL_GetPointer(Import, U, "U", _RC) + call MAPL_GetPointer(Import, V, "V", _RC) + call MAPL_GetPointer(Import, W, "W", _RC) + + allocate(U_latlon(counts(1),counts(2),counts(3))) + allocate(V_latlon(counts(1),counts(2),counts(3))) + allocate(W_latlon(counts(1),counts(2),counts(3))) + + call GigaTrajInternalPtr%cube2latlon%regrid(U, U_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(V, V_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(W, W_latlon, _RC) + + field = ESMF_FieldCreate(GigaTrajInternalPtr%LatLonGrid, ESMF_TYPEKIND_R4, name='halo_field', & + ungriddedLBound=[1],ungriddedUBound=[counts(3)], & + totalLWidth=[1,1],totalUWidth=[1,1]) + + call ESMF_FieldHaloStore(field,rh,rc=status) + _VERIFY(status) + + call ESMF_FieldGet(field, farrayPtr=with_halo, _RC) + with_halo(2:counts(1)+1, 2:counts(2)+1, :) = U_latlon + call ESMF_FieldHalo(field,rh,rc=status) + _VERIFY(status) + GigaTrajInternalPtr%preU = with_halo + + with_halo(2:counts(1)+1, 2:counts(2)+1, :) = V_latlon + call ESMF_FieldHalo(field,rh,rc=status) + _VERIFY(status) + GigaTrajInternalPtr%preV = with_halo + + with_halo(2:counts(1)+1, 2:counts(2)+1, :) = W_latlon + call ESMF_FieldHalo(field,rh,rc=status) + _VERIFY(status) + GigaTrajInternalPtr%preW = with_halo + + call ESMF_FieldDestroy(field) + + first_time_run = .false. + + RETURN_(ESMF_SUCCESS) + + end subroutine GetInitVars + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!BOP + ! !IROUTINE: Run -- Run method for Gigatraj GridComp ! !INTERFACE: @@ -249,11 +380,11 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) ! !ARGUMENTS: - type(ESMF_GridComp), intent(inout) :: GC ! Gridded component - type(ESMF_State), intent(inout) :: IMPORT ! Import state - type(ESMF_State), intent(inout) :: EXPORT ! Export state - type(ESMF_Clock), intent(inout) :: CLOCK ! The clock - integer, optional, intent( out) :: RC ! Error code + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_State), intent(inout) :: IMPORT ! Import state + type(ESMF_State), intent(inout) :: EXPORT ! Export state + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + integer, optional, intent( out) :: RC ! Error code ! !DESCRIPTION: @@ -276,23 +407,28 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) type (GigatrajInternalWrap) :: wrap type(ESMF_Grid) :: CubedGrid - integer :: num_parcels, i - integer,parameter :: seed = 86456 + integer :: num_parcels, my_rank, i, i1, i2, j1, j2 real, allocatable :: lats(:), lons(:), lons_send(:), lats_send(:), U(:), pos(:) real, allocatable :: lons_recv(:), lats_recv(:), U_recv(:), U_send(:) real :: rparcels, dlat, dlon integer, allocatable :: counts_send(:),counts_recv(:), II(:), JJ(:), ranks(:) integer, allocatable :: disp_send(:), disp_recv(:), tmp_position(:) - integer :: DIMS(3), rank, comm, ierror + integer ::counts(3), DIMS(3), rank, comm, ierror, npts type (ESMF_VM) :: vm - real, dimension(:,:,:), pointer :: U_cube - real, dimension(:,:,:), allocatable :: U_latlon - real, dimension(:,:,:), pointer :: U_latlon_halo + real, dimension(:,:,:), pointer :: U_cube, V_cube, W_cube, with_halo + real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon + + real, dimension(:,:,:), pointer :: U_latlon_halo, V_latlon_halo, W_latlon_halo + + real(ESMF_KIND_R8), allocatable :: lons8(:), lats8(:) + real(ESMF_KIND_R8) :: delta integer :: halowidth(3) - type(ESMF_Field) :: U_field + + type(ESMF_Field) :: halo_field type(ESMF_RouteHandle) :: rh + call ESMF_VMGetCurrent(vm, _RC) call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) @@ -306,49 +442,97 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) GigaTrajInternalPtr => wrap%ptr - call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=DIMS, _RC) - - allocate(U_latlon(DIMS(1), DIMS(2),DIMS(3)), source = 0.0) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! test MAPL_GetGlobalHorzIJindex block +!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! call MAPL_Grid_interior(CubedGrid ,i1,i2,j1,j2) +! npts = GigaTrajInternalPtr%parcels%num_parcels +! lons = GigaTrajInternalPtr%parcels%lons +! lats = GigaTrajInternalPtr%parcels%lats +! lons8 = lons +! lats8 = lats +! allocate(II(npts), JJ(npts)) +! call MAPL_GetHorzIJIndex(npts,II,JJ,lonr8=lons8,latr8=lats8,Grid=CubedGrid, _RC) + +! do i = 1, npts +! if (II (i) /= -1) print*,"Bens:", lons(I), lats(i), II(i)+i1 -1 , JJ(i)+j1 - 1 +! enddo + +! call MAPL_GetGlobalHorzIJIndex(npts,II,JJ,lonr8=lons8,latr8=lats8,Grid=CubedGrid, _RC) +! +! if (my_rank == 0) then +! do i = 1, npts +! print*, "Jiang: ", lons(i), lats(i), II(i), JJ(i) +! enddo +! endif +! +! RETURN_(ESMF_SUCCESS) + +!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!! + + call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts, _RC) + + allocate(U_latlon(counts(1), counts(2),counts(3)), source = 0.0) + allocate(V_latlon(counts(1), counts(2),counts(3)), source = 0.0) + allocate(W_latlon(counts(1), counts(2),counts(3)), source = 0.0) + + allocate(U_latlon_halo(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) + allocate(V_latlon_halo(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) + allocate(W_latlon_halo(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) !--------------- ! Step 1) Regrid the metData field from cubed to lat-lon !--------------- call MAPL_GetPointer(Import, U_cube, "U", _RC) + call MAPL_GetPointer(Import, V_cube, "V", _RC) + call MAPL_GetPointer(Import, W_cube, "W", _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(U_cube, U_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(V_cube, V_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(W_cube, W_latlon, _RC) !--------------- ! Step 2) Get halo of latlon metData field ! After this step, the local field has distributed horizonal + halo !--------------- - U_field = ESMF_FieldCreate(GigaTrajInternalPtr%LatLonGrid, ESMF_TYPEKIND_R4, name='U', & - ungriddedLBound=[1],ungriddedUBound=[DIMS(3)], & + halo_field = ESMF_FieldCreate(GigaTrajInternalPtr%LatLonGrid, ESMF_TYPEKIND_R4, name='halo_field', & + ungriddedLBound=[1],ungriddedUBound=[counts(3)], & totalLWidth=[1,1],totalUWidth=[1,1]) - call ESMF_FieldHaloStore(U_field,rh,rc=status) + call ESMF_FieldHaloStore(halo_field,rh,rc=status) + _VERIFY(status) + + call ESMF_FieldGet(halo_field, farrayPtr=with_halo, _RC) + + ! get U + halo + with_halo(2:counts(1)+1, 2:counts(2)+1, :) = U_latlon + call ESMF_FieldHalo(halo_field,rh,rc=status) + _VERIFY(status) + U_latlon_halo = with_halo + + ! get V + halo + with_halo(2:counts(1)+1, 2:counts(2)+1, :) = V_latlon + call ESMF_FieldHalo(halo_field,rh,rc=status) _VERIFY(status) + V_latlon_halo = with_halo - call ESMF_FieldGet(U_field, farrayPtr=U_latlon_halo, _RC) - U_latlon_halo(2:DIMS(1)+1, 2:DIMS(2)+1, :) = U_latlon - call ESMF_FieldHalo(U_field,rh,rc=status) - _VERIFY(status) + ! get W + halo + with_halo(2:counts(1)+1, 2:counts(2)+1, :) = W_latlon + call ESMF_FieldHalo(halo_field,rh,rc=status) + _VERIFY(status) + W_latlon_halo = with_halo !----------------- ! Step 3) Given partical position (lat lon), find out which processor it should go ? !----------------- - call random_seed() - call random_number(rparcels) - - num_parcels = nint(rparcels*10) + num_parcels = GigaTrajInternalPtr%parcels%num_parcels - allocate(lats(num_parcels), lons(num_parcels)) - - call random_number(lats) - call random_number(lons) - - lons = lons*2*MAPL_PI - lats = lats*MAPL_PI + lons = GigaTrajInternalPtr%parcels%lons + lats = GigaTrajInternalPtr%parcels%lats allocate(II(num_parcels),JJ(num_parcels), ranks(num_parcels)) allocate(counts_send(GigaTrajInternalPtr%npes)) @@ -356,16 +540,8 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) allocate(disp_send(GigaTrajInternalPtr%npes)) allocate(disp_recv(GigaTrajInternalPtr%npes)) - call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, globalCellCountPerDim=DIMS, RC=status) - - dlon = 2*MAPL_PI / DIMS(1) - dlat = MAPL_PI / DIMS(2) - - II = ceiling (lons/dlon) - JJ = ceiling (lats/dlat) + call get_latlon_ij_index(GigaTrajInternalPtr%LatLonGrid, lons, lats, II, JJ, _RC) - if (any(II > DIMS(1)) .or. any(II<0)) stop ("wrong II") - if (any(JJ > DIMS(2)) .or. any(JJ<0)) stop ("wrong JJ") do i = 1, num_parcels ranks(i) = GigaTrajInternalPtr%CellToRank(II(i), JJ(i)) enddo @@ -423,10 +599,33 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) U(:) = U_send(pos(:)) !deallocate(U_latlon_halo) - call ESMF_FieldDestroy(U_field) + call ESMF_FieldDestroy( halo_field) - print*," Great, I am still alive" + print*," Great, I am still alive" RETURN_(ESMF_SUCCESS) + + contains + subroutine get_latlon_ij_index(grid, lons, lats, II, JJ, rc) + type(ESMF_Grid), intent(in) :: grid + real, intent(in) :: lons(:) + real, intent(in) :: lats(:) + integer, intent(inout) :: II(:) + integer, intent(inout) :: JJ(:) + integer, optional, intent(out) :: rc + integer :: dims(3), status + real :: dlon, dlat + + call MAPL_GridGet(grid, globalCellCountPerDim=DIMS, _RC) + + dlon = 2*MAPL_PI / DIMS(1) + dlat = MAPL_PI / DIMS(2) + + II = min( max(ceiling (lons/dlon),1), DIMS(1)) + JJ = min( max(ceiling (lats/dlat),1), DIMS(2)) + + RETURN_(ESMF_SUCCESS) + end subroutine get_latlon_ij_index + end subroutine Run end module GigaTraj_GridCompMod From 4395f3be4500af3477e04aad38f290610316cec8 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 21 Nov 2022 09:50:02 -0500 Subject: [PATCH 09/73] add interOp --- GigaTraj_GridComp/CMakeLists.txt | 7 +- GigaTraj_GridComp/GEOS_Giga_InterOp.F90 | 30 +++++++ GigaTraj_GridComp/GigaTraj_GridComp.F90 | 103 +++++++++--------------- 3 files changed, 71 insertions(+), 69 deletions(-) create mode 100644 GigaTraj_GridComp/GEOS_Giga_InterOp.F90 diff --git a/GigaTraj_GridComp/CMakeLists.txt b/GigaTraj_GridComp/CMakeLists.txt index c31a7f9f1..b9008e703 100644 --- a/GigaTraj_GridComp/CMakeLists.txt +++ b/GigaTraj_GridComp/CMakeLists.txt @@ -1,10 +1,9 @@ esma_set_this() - -set (dependencies MAPL esmf) +set (dependencies MAPL esmf metsources) esma_add_library (${this} - SRCS GigaTraj_GridComp.F90 + SRCS GEOS_Giga_InterOp.F90 GigaTraj_GridComp.F90 DEPENDENCIES ${dependencies}) -add_subdirectory (@GigaTraj) +esma_add_subdirectories( @GigaTraj) diff --git a/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 b/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 new file mode 100644 index 000000000..e11baffa4 --- /dev/null +++ b/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 @@ -0,0 +1,30 @@ +module GEOS_Giga_InterOpMod + use, intrinsic :: iso_c_binding, only : c_int, c_ptr, c_null_ptr, c_associated + implicit none + private + + interface + + function initGigaGridField3d(nlons, nlats, nzs, lons_ptr, lats_ptr, levs_ptr) result (field_ptr) bind(C, name="initGigaGridField3d") + import :: c_int, c_ptr + implicit none + integer(c_int), intent(in), value :: nlons, nlats, nzs + type(c_ptr) :: lons_ptr, lats_ptr, levs_ptr, field_ptr + end function + + end interface + +type(c_ptr), save :: field3d_ptr = c_null_ptr + + +contains + + subroutine init_gigatraj_obj(nlons, nlats, nzs, lons, lats, levs) + integer, intent(in) :: nlons, nlats, nzs + real, dimension(:), intent(in) :: lons, lats, levs + + + + end subroutine + +end module GEOS_Giga_InterOpMod diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 index 20615a792..46e0c0116 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -70,30 +70,24 @@ subroutine SetServices ( GC, RC ) ! Get my name and set-up traceback handle ! --------------------------------------- - call ESMF_GridCompGet( GC, NAME=COMP_NAME, RC=STATUS ) - VERIFY_(STATUS) + call ESMF_GridCompGet( GC, NAME=COMP_NAME, _RC ) Iam = trim(COMP_NAME) // 'SetServices' ! Register services for this component ! ------------------------------------ - call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_INITIALIZE, Initialize, RC=STATUS ) - VERIFY_(STATUS) - call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, GetInitVars , RC=STATUS ) - VERIFY_(STATUS) - call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run , RC=STATUS ) - VERIFY_(STATUS) + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_INITIALIZE, Initialize, _RC ) + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, GetInitVars , _RC ) + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run , _RC ) ! Get the configuration from the component !----------------------------------------- - call ESMF_GridCompGet( GC, CONFIG = CF, RC=STATUS ) - VERIFY_(STATUS) + call ESMF_GridCompGet( GC, CONFIG = CF, _RC ) ! Set the state variable specs. ! ----------------------------- - call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS) - VERIFY_(STATUS) + call MAPL_GetObjectFromGC ( GC, MAPL, _RC) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'DVDT', & @@ -101,24 +95,20 @@ subroutine SetServices ( GC, RC ) UNITS = 'm s-2', & DIMS = MAPL_DimsHorzVert, & FIELD_TYPE = MAPL_VectorField, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationCenter, _RC ) allocate(GigaTrajInternalPtr) wrap%ptr => GigaTrajInternalPtr - call ESMF_UserCompSetInternalState ( GC, 'GigaTrajInternal', wrap, status ) - VERIFY_(STATUS) + call ESMF_UserCompSetInternalState ( GC, 'GigaTrajInternal', wrap, status ); _VERIFY(STATUS) + + call MAPL_GenericSetServices ( GC, _RC ) - call MAPL_GenericSetServices ( GC, RC=STATUS ) - VERIFY_(STATUS) ! Clocks !------- - 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="INITIALIZE" ,_RC) + call MAPL_TimerAdd(GC, name="RUN" ,_RC) ! All done !--------- @@ -175,15 +165,13 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- - call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) - VERIFY_(STATUS) + call ESMF_GridCompGet ( GC, name=COMP_NAME, _RC ) Iam = trim(COMP_NAME) // "Initialize" ! Get my MAPL_Generic state !-------------------------- - call MAPL_GetObjectFromGC ( GC, STATE, RC=STATUS) - VERIFY_(STATUS) + call MAPL_GetObjectFromGC ( GC, STATE, _RC) call MAPL_TimerOn(STATE,"TOTAL") @@ -191,44 +179,37 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Call Initialize for every Child - call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC=STATUS) - VERIFY_(STATUS) + call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, _RC) - call ESMF_VMGetCurrent(vm, rc=status) - call ESMF_VMGet(vm, mpiCommunicator=comm, __RC__) + call ESMF_VMGetCurrent(vm, _RC) + call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) call MPI_Comm_size(comm, npes, ierror); _VERIFY(ierror) - call ESMF_GridCompGet(GC, grid=CubedGrid, rc=status) - call MAPL_GridGet(CubedGrid, globalCellCountPerDim=DIMS, RC=status) + call ESMF_GridCompGet(GC, grid=CubedGrid, _RC) + call MAPL_GridGet(CubedGrid, globalCellCountPerDim=DIMS, _RC) - call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, status) - VERIFY_(STATUS) + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, status); _VERIFY(STATUS) GigaTrajInternalPtr => wrap%ptr GigaTrajInternalPtr%npes = npes - call MAPL_MakeDecomposition(NX,NY,rc=status) - VERIFY_(status) + call MAPL_MakeDecomposition(NX,NY,_RC) GigaTrajInternalPtr%LatLonGrid = grid_manager%make_grid( & LatLonGridFactory(im_world=DIMS(1)*4, jm_world=DIMS(1)*2, lm=DIMS(3), & - nx=NX, ny=NY, pole='PC', dateline= 'DC', rc=status) ) + nx=NX, ny=NY, pole='PC', dateline= 'DC', rc=status) ); _VERIFY(status) - GigaTrajInternalPtr%cube2latlon => new_regridder_manager%make_regridder(CubedGrid, GigaTrajInternalPtr%LatLonGrid, REGRID_METHOD_CONSERVE, rc=status) + GigaTrajInternalPtr%cube2latlon => new_regridder_manager%make_regridder(CubedGrid, GigaTrajInternalPtr%LatLonGrid, REGRID_METHOD_CONSERVE, _RC) call MAPL_Grid_interior(GigaTrajInternalPtr%LatLonGrid ,i1,i2,j1,j2) allocate(I1s(npes),J1s(npes)) allocate(I2s(npes),J2s(npes)) - call MPI_Allgather(i1, 1, MPI_INTEGER, I1s, 1, MPI_INTEGER, comm, ierror) - _VERIFY(ierror) - call MPI_Allgather(i2, 1, MPI_INTEGER, I2s, 1, MPI_INTEGER, comm, ierror) - _VERIFY(ierror) - call MPI_Allgather(j1, 1, MPI_INTEGER, J1s, 1, MPI_INTEGER, comm, ierror) - _VERIFY(ierror) - call MPI_Allgather(j2, 1, MPI_INTEGER, J2s, 1, MPI_INTEGER, comm, ierror) - _VERIFY(ierror) + call MPI_Allgather(i1, 1, MPI_INTEGER, I1s, 1, MPI_INTEGER, comm, ierror); _VERIFY(ierror) + call MPI_Allgather(i2, 1, MPI_INTEGER, I2s, 1, MPI_INTEGER, comm, ierror); _VERIFY(ierror) + call MPI_Allgather(j1, 1, MPI_INTEGER, J1s, 1, MPI_INTEGER, comm, ierror); _VERIFY(ierror) + call MPI_Allgather(j2, 1, MPI_INTEGER, J2s, 1, MPI_INTEGER, comm, ierror); _VERIFY(ierror) - call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, globalCellCountPerDim=DIMS, RC=status) + call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, globalCellCountPerDim=DIMS, _RC) allocate(GigaTrajInternalPtr%CellToRank(DIMS(1),DIMS(2))) do rank = 0, npes -1 @@ -341,23 +322,19 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) ungriddedLBound=[1],ungriddedUBound=[counts(3)], & totalLWidth=[1,1],totalUWidth=[1,1]) - call ESMF_FieldHaloStore(field,rh,rc=status) - _VERIFY(status) + call ESMF_FieldHaloStore(field,rh,_RC) call ESMF_FieldGet(field, farrayPtr=with_halo, _RC) with_halo(2:counts(1)+1, 2:counts(2)+1, :) = U_latlon - call ESMF_FieldHalo(field,rh,rc=status) - _VERIFY(status) + call ESMF_FieldHalo(field,rh,_RC) GigaTrajInternalPtr%preU = with_halo with_halo(2:counts(1)+1, 2:counts(2)+1, :) = V_latlon - call ESMF_FieldHalo(field,rh,rc=status) - _VERIFY(status) + call ESMF_FieldHalo(field,rh,_RC) GigaTrajInternalPtr%preV = with_halo with_halo(2:counts(1)+1, 2:counts(2)+1, :) = W_latlon - call ESMF_FieldHalo(field,rh,rc=status) - _VERIFY(status) + call ESMF_FieldHalo(field,rh,_RC) GigaTrajInternalPtr%preW = with_halo call ESMF_FieldDestroy(field) @@ -502,27 +479,23 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) halo_field = ESMF_FieldCreate(GigaTrajInternalPtr%LatLonGrid, ESMF_TYPEKIND_R4, name='halo_field', & ungriddedLBound=[1],ungriddedUBound=[counts(3)], & totalLWidth=[1,1],totalUWidth=[1,1]) - call ESMF_FieldHaloStore(halo_field,rh,rc=status) - _VERIFY(status) + call ESMF_FieldHaloStore(halo_field, rh, _RC) call ESMF_FieldGet(halo_field, farrayPtr=with_halo, _RC) ! get U + halo with_halo(2:counts(1)+1, 2:counts(2)+1, :) = U_latlon - call ESMF_FieldHalo(halo_field,rh,rc=status) - _VERIFY(status) + call ESMF_FieldHalo(halo_field, rh, _RC) U_latlon_halo = with_halo ! get V + halo with_halo(2:counts(1)+1, 2:counts(2)+1, :) = V_latlon - call ESMF_FieldHalo(halo_field,rh,rc=status) - _VERIFY(status) + call ESMF_FieldHalo(halo_field, rh, _RC) V_latlon_halo = with_halo ! get W + halo with_halo(2:counts(1)+1, 2:counts(2)+1, :) = W_latlon - call ESMF_FieldHalo(halo_field,rh,rc=status) - _VERIFY(status) + call ESMF_FieldHalo(halo_field, rh, _RC) W_latlon_halo = with_halo !----------------- @@ -554,8 +527,8 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) counts_send(rank+1) = count(ranks == rank) enddo - call ESMF_VMGetCurrent(vm, rc=status) - call ESMF_VMGet(vm, mpiCommunicator=comm, __RC__) + call ESMF_VMGetCurrent(vm, _RC) + call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) call MPI_AllToALL(counts_send, 1, MPI_INTEGER, counts_recv, 1, MPI_INTEGER, comm, ierror) disp_send = 0 From 2bbf4beb57da2550de9dcdbb8d5b654b527ae8e7 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 13 Dec 2022 08:54:41 -0500 Subject: [PATCH 10/73] first pass test dataflow and metData. Crash on RK4A --- GigaTraj_GridComp/CMakeLists.txt | 2 +- GigaTraj_GridComp/GEOS_Giga_InterOp.F90 | 161 +++++++++++++- GigaTraj_GridComp/GigaTraj_GridComp.F90 | 278 +++++++++++------------- 3 files changed, 284 insertions(+), 157 deletions(-) diff --git a/GigaTraj_GridComp/CMakeLists.txt b/GigaTraj_GridComp/CMakeLists.txt index b9008e703..d9d4061ca 100644 --- a/GigaTraj_GridComp/CMakeLists.txt +++ b/GigaTraj_GridComp/CMakeLists.txt @@ -1,6 +1,6 @@ esma_set_this() -set (dependencies MAPL esmf metsources) +set (dependencies MAPL esmf geos_giga metsources filters gigatraj) esma_add_library (${this} SRCS GEOS_Giga_InterOp.F90 GigaTraj_GridComp.F90 diff --git a/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 b/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 index e11baffa4..1ffc1f1e5 100644 --- a/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 +++ b/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 @@ -1,30 +1,171 @@ module GEOS_Giga_InterOpMod - use, intrinsic :: iso_c_binding, only : c_int, c_ptr, c_null_ptr, c_associated + use, intrinsic :: iso_c_binding, only : c_double, c_int, c_ptr, c_null_char, c_associated + use, intrinsic :: iso_c_binding, only : c_loc, c_null_ptr + use mpi implicit none private + public :: initGigaGridLatLonField3d + public :: initMetGEOSDistributedData + public :: updateFields + public :: rk4a_advance + + public :: test_Field3D + public :: test_dataflow + public :: test_metData + interface - function initGigaGridField3d(nlons, nlats, nzs, lons_ptr, lats_ptr, levs_ptr) result (field_ptr) bind(C, name="initGigaGridField3d") + function initGigaGridLatLonField3d(nlons, nlats, nzs, lons_ptr, lats_ptr, levs_ptr, name_ptr, & + units_ptr,ctime_ptr) result (field_ptr) bind(C, name="initGigaGridLatLonField3D") import :: c_int, c_ptr implicit none integer(c_int), intent(in), value :: nlons, nlats, nzs - type(c_ptr) :: lons_ptr, lats_ptr, levs_ptr, field_ptr + type(c_ptr), intent(in), value :: lons_ptr, lats_ptr, levs_ptr, name_ptr, units_ptr, ctime_ptr + type(c_ptr) :: field_ptr end function - end interface + function initMetGEOSDistributedData(comm, ijToRank, Ig, Jg, u0_ptr, v0_ptr, w0_ptr, u1_ptr, v1_ptr, w1_ptr) result (metdata_ptr) bind(C, name="initGigaGridDistributedData") + import :: c_int, c_ptr + implicit none + integer(c_int), intent(in), value :: comm, Ig, Jg + type(c_ptr), intent(in), value :: ijToRank, u0_ptr, v0_ptr, w0_ptr, u1_ptr,v1_ptr, w1_ptr + type(c_ptr) :: metdata_ptr + end function -type(c_ptr), save :: field3d_ptr = c_null_ptr + subroutine updateFields( ctime_ptr, u_ptr, v_ptr, w_ptr, u0_ptr, v0_ptr, w0_ptr, u1_ptr, v1_ptr, w1_ptr) bind(C, name="updateFields") + import :: c_ptr + implicit none + type(c_ptr), intent(in), value :: ctime_ptr, u_ptr, v_ptr, w_ptr, u0_ptr, v0_ptr, w0_ptr, u1_ptr, v1_ptr, w1_ptr + end subroutine + subroutine rk4a_advance(metsrc_ptr, ctime_ptr, dt, n, lons_ptr, lats_ptr, levs_ptr) bind( C, name='rk4a_advance') + import :: c_ptr, c_int, c_double + type(c_ptr), intent(in), value :: metsrc_ptr + real(c_double), intent(in), value :: dt + integer(c_int), intent(in), value :: n + type(c_ptr), intent(in), value :: ctime_ptr, lons_ptr, lats_ptr, levs_ptr + end subroutine + + subroutine test_Field3d(obj_ptr) bind(C, name="test_Field3D") + import :: c_ptr + implicit none + type(c_ptr), intent(in), value :: obj_ptr + end subroutine + + subroutine test_metData(obj_ptr, time, n, lons_ptr, lats_ptr, levs_ptr, u_ptr, v_ptr, w_ptr) bind(C, name="test_metData") + import :: c_ptr,c_int, c_double + type(c_ptr), intent(in), value :: obj_ptr + real(c_double), intent(in), value :: time + integer(c_int), intent(in), value :: n + type(c_ptr), intent(in), value :: lons_ptr, lats_ptr, levs_ptr, u_ptr, v_ptr, w_ptr + end subroutine + + end interface contains - subroutine init_gigatraj_obj(nlons, nlats, nzs, lons, lats, levs) - integer, intent(in) :: nlons, nlats, nzs - real, dimension(:), intent(in) :: lons, lats, levs + subroutine test_dataflow(num_parcels, lons, lats, zs, CellToRank, DIMS, comm) + integer :: num_parcels, comm, DIMS(3) + real, dimension(:), intent(in) :: lons, lats,zs + integer, dimension(:,:), intent(in) :: CellToRank - + integer :: i, npes, ierror, rank, my_rank + real :: dlon, dlat + real, allocatable :: lons_positive(:) + + real, allocatable :: lons_send(:), lats_send(:), zs_send(:) + real, allocatable :: lons_recv(:), lats_recv(:), zs_recv(:) + real, allocatable :: U_recv(:), U_send(:) + real, allocatable :: U(:), V(:), W(:), pos(:) + + integer, allocatable :: counts_send(:),counts_recv(:), II(:), JJ(:), ranks(:) + integer, allocatable :: disp_send(:), disp_recv(:), tmp_position(:) + + + dlon = 360.0 / DIMS(1) + dlat = 180.0 / DIMS(2) + + lons_positive = lons + where (lons_positive < 0) lons_positive=lons_positive + 360.0 + II = min( max(ceiling (lons_positive/dlon),1), DIMS(1)) + JJ = min( max(ceiling ((lats + 90.0)/dlat),1), DIMS(2)) + + call MPI_Comm_size(comm, npes, ierror) + call MPI_Comm_rank(comm, my_rank, ierror) + + allocate(ranks(num_parcels)) + allocate(counts_send(npes)) + allocate(counts_recv(npes)) + allocate(disp_send(npes)) + allocate(disp_recv(npes)) + + do i = 1, num_parcels + ranks(i) = CellToRank(II(i), JJ(i)) + enddo + +!-- ------------------- +!step 4) Pack the location data and send them to where the metData sit +!-- ------------------- + + do rank = 0, npes-1 + counts_send(rank+1) = count(ranks == rank) + enddo + + call MPI_AllToALL(counts_send, 1, MPI_INTEGER, counts_recv, 1, MPI_INTEGER, comm, ierror) + + disp_send = 0 + do rank = 1, npes-1 + disp_send(rank+1) = disp_send(rank)+ counts_send(rank) + enddo + disp_recv = 0 + do rank = 1, npes-1 + disp_recv(rank+1) = disp_recv(rank)+ counts_recv(rank) + enddo + + + ! re-arranged lats lons, and ids + tmp_position = disp_send + allocate(lons_send(num_parcels)) + allocate(lons_recv(sum(counts_recv))) + allocate(lats_send(num_parcels)) + allocate(lats_recv(sum(counts_recv))) + allocate(zs_send(num_parcels)) + allocate(zs_recv(sum(counts_recv))) + + allocate(pos(num_parcels)) + do i = 1, num_parcels + rank = ranks(i) + pos(i) = tmp_position(rank+1) +1 + lons_send(pos(i)) = lons(i) + lats_send(pos(i)) = lats(i) + zs_send(pos(i)) = zs(i) + tmp_position(rank+1) = tmp_position(rank+1) + 1 + enddo + + call MPI_AllToALLv(lons_send, counts_send, disp_send, MPI_REAL, lons_recv, counts_recv, disp_recv, MPI_REAL, comm, ierror) + call MPI_AllToALLv(lats_send, counts_send, disp_send, MPI_REAL, lats_recv, counts_recv, disp_recv, MPI_REAL, comm, ierror) + call MPI_AllToALLv(zs_send, counts_send, disp_send, MPI_REAL, zs_recv, counts_recv, disp_recv, MPI_REAL, comm, ierror) +!-- ------------------- +!step 5) Interpolate the data ( horiontally and vertically) and send back where they are from +!-- ------------------- + + allocate(U_recv(sum(counts_recv)), source = my_rank*1.0) + allocate(U_send(num_parcels), source = -1.0) + ! + ! Horizontal and vertical interpolator here + ! + call MPI_AllToALLv(U_recv, counts_recv, disp_recv, MPI_REAL, U_send, counts_send, disp_send, MPI_REAL, comm, ierror) + +!--------------------- +!step 6) Rearrange data ( not necessary if ids was rearranged ins step 4) +!--------------------- + + allocate(U(num_parcels)) + allocate(V(num_parcels)) + allocate(W(num_parcels)) + U(:) = U_send(pos(:)) - end subroutine + end subroutine end module GEOS_Giga_InterOpMod diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 index 46e0c0116..e88ad4eda 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -10,10 +10,12 @@ module GigaTraj_GridCompMod ! !USES: - + use, intrinsic :: iso_c_binding, only : c_int, c_ptr, c_null_ptr, c_associated + use, intrinsic :: iso_c_binding, only : c_loc use ESMF use MAPL use mpi + use GEOS_Giga_interOpMod implicit none private @@ -24,7 +26,7 @@ module GigaTraj_GridCompMod type horde integer :: num_parcels integer, allocatable :: IDS(:) - real, allocatable :: lats(:), lons(:), z(:) + real, allocatable :: lats(:), lons(:), zs(:) end type type GigaTrajInternal @@ -34,6 +36,8 @@ module GigaTraj_GridCompMod integer, allocatable :: CellToRank(:,:) real, dimension(:,:,:), allocatable :: preU, PreV, preW type(horde) :: parcels + type(c_ptr) :: u0_field, u1_field, v0_field, v1_field, w0_field, w1_field + type(c_ptr) :: metSrc end type type GigatrajInternalWrap @@ -149,14 +153,18 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Local derived type aliases type (MAPL_MetaComp), pointer :: STATE - type (ESMF_VM) :: vm + type (ESMF_VM) :: vm integer :: I1, I2, J1, J2, comm, npes, rank, ierror, NX, NY type(ESMF_Grid) :: CubedGrid integer, allocatable :: I1s(:), J1s(:), I2s(:),J2s(:) - integer :: DIMS(3) + integer :: DIMS(3), counts(3), i,j,k type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap - + real :: dlat, dlon + real, pointer :: lats_center(:), lons_center(:), levs_center(:) + type (ESMF_TIME) :: CurrentTime + character(len=20), target :: ctime + character(len=:), allocatable, target :: name_, unit_ ! ============================================================================= @@ -195,11 +203,51 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_MakeDecomposition(NX,NY,_RC) GigaTrajInternalPtr%LatLonGrid = grid_manager%make_grid( & LatLonGridFactory(im_world=DIMS(1)*4, jm_world=DIMS(1)*2, lm=DIMS(3), & - nx=NX, ny=NY, pole='PC', dateline= 'DC', rc=status) ); _VERIFY(status) + nx=NX, ny=NY, pole='PE', dateline= 'DE', rc=status) ); _VERIFY(status) GigaTrajInternalPtr%cube2latlon => new_regridder_manager%make_regridder(CubedGrid, GigaTrajInternalPtr%LatLonGrid, REGRID_METHOD_CONSERVE, _RC) + call MAPL_Grid_interior(GigaTrajInternalPtr%LatLonGrid ,i1,i2,j1,j2) + call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) + + allocate(lons_center(counts(1)+2)) + allocate(lats_center(counts(2)+2)) + allocate(levs_center(counts(3) )) + dlon = 360.0/dims(1) + lons_center = [(-dlon/2+ dlon*i, i= i1-1, i2+1)] + dlat = 180.0/dims(2) + lats_center = [(-dlat/2+ dlat*j-90.0, j= j1-1, j2+1)] + levs_center = [(k*1.0, k = 1, counts(3))] + + call ESMF_ClockGet(clock, currTime=CurrentTime, _RC) + call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) + ctime(20:20) = c_null_char + unit_="m/s"//c_null_char + + name_="U"//c_null_char + GigaTrajInternalPtr%u0_field= initGigaGridLatLonField3d(counts(1)+2, counts(2)+2, counts(3), & + c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), & + c_loc(name_), c_loc(unit_), c_loc(ctime)) + GigaTrajInternalPtr%u1_field= initGigaGridLatLonField3d(counts(1)+2, counts(2)+2, counts(3), & + c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), & + c_loc(name_), c_loc(unit_), c_loc(ctime)) + + name_="V"//c_null_char + GigaTrajInternalPtr%v0_field= initGigaGridLatLonField3d(counts(1)+2, counts(2)+2, counts(3), & + c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), & + c_loc(name_), c_loc(unit_), c_loc(ctime)) + GigaTrajInternalPtr%v1_field= initGigaGridLatLonField3d(counts(1)+2, counts(2)+2, counts(3), & + c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), & + c_loc(name_), c_loc(unit_), c_loc(ctime)) + + name_="W"//c_null_char + GigaTrajInternalPtr%w0_field= initGigaGridLatLonField3d(counts(1)+2, counts(2)+2, counts(3), & + c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), & + c_loc(name_), c_loc(unit_), c_loc(ctime)) + GigaTrajInternalPtr%w1_field= initGigaGridLatLonField3d(counts(1)+2, counts(2)+2, counts(3), & + c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), & + c_loc(name_), c_loc(unit_), c_loc(ctime)) allocate(I1s(npes),J1s(npes)) allocate(I2s(npes),J2s(npes)) @@ -220,12 +268,20 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) GigaTrajInternalPtr%CellToRank(I1:I2,J1:J2) = rank enddo + GigaTrajInternalPtr%metSrc = initMetGEOSDistributedData(comm, c_loc(GigaTrajInternalPtr%CellToRank), DIMS(1), DIMS(2), & + GigaTrajInternalPtr%u0_field, & + GigaTrajInternalPtr%v0_field, & + GigaTrajInternalPtr%w0_field, & + GigaTrajInternalPtr%u1_field, & + GigaTrajInternalPtr%v1_field, & + GigaTrajInternalPtr%w1_field) + ! initialize partical positions. It will be read and distribted across processors. ! for now, it is genrated randomly block real :: rparcels integer :: num_parcels, my_rank, i - real, allocatable :: lats(:), lons(:) + real, allocatable :: lats(:), lons(:), zs(:) integer, allocatable :: nums_all(:) !call random_seed() @@ -234,17 +290,20 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) !num_parcels = nint(rparcels*10) num_parcels = 20 - allocate(lats(num_parcels), lons(num_parcels)) + allocate(lats(num_parcels), lons(num_parcels), zs(num_parcels)) call random_number(lats) call random_number(lons) + call random_number(zs) - lons = lons*2.0*MAPL_PI - MAPL_PI - lats = lats*MAPL_PI - 0.50*MAPL_PI - + lons = lons*360.0 + !lats = lats*180.0 - 90.0 + lats = lats*20.0 - 10.0 + zs = ceiling(DIMS(3)*zs)*1.0 GigaTrajInternalPtr%parcels%num_parcels = num_parcels GigaTrajInternalPtr%parcels%lats = lats GigaTrajInternalPtr%parcels%lons = lons + GigaTrajInternalPtr%parcels%zs = zs GigaTrajInternalPtr%parcels%IDS = [(i, i=1, num_parcels)] allocate(nums_all(npes)) @@ -257,6 +316,8 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) end block + deallocate(lons_center, lats_center,levs_center) + call MAPL_TimerOff(STATE,"INITIALIZE") call MAPL_TimerOff(STATE,"TOTAL") @@ -287,24 +348,36 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) !EOP character(len=ESMF_MAXSTR) :: IAm - integer :: STATUS + type (ESMF_VM) :: VM + integer :: STATUS, Comm logical, save :: first_time_run = .true. type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap real, dimension(:,:,:), pointer :: U, V, W, with_halo real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon + real, dimension(:,:,:), allocatable, target :: preU, preV, preW integer :: counts(3), dims(3) type(ESMF_Field) :: field type(ESMF_RouteHandle) :: rh + real, pointer :: lats_center(:), lons_center(:), levs_center(:) + integer :: i1, i2, j1, j2, i,j,k + type (ESMF_TIME) :: CurrentTime + character(len=20), target :: ctime if (.not. first_time_run) then RETURN_(ESMF_SUCCESS) endif + call ESMF_VmGetCurrent(VM, _RC) + call ESMF_VMGet(VM, mpiCommunicator=Comm, _RC) + call ESMF_ClockGet(clock, currTime=CurrentTime, _RC) + call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) + ctime(20:20) = c_null_char + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) GigaTrajInternalPtr => wrap%ptr - call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts, _RC) + call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) call MAPL_GetPointer(Import, U, "U", _RC) call MAPL_GetPointer(Import, V, "V", _RC) @@ -327,15 +400,23 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_FieldGet(field, farrayPtr=with_halo, _RC) with_halo(2:counts(1)+1, 2:counts(2)+1, :) = U_latlon call ESMF_FieldHalo(field,rh,_RC) - GigaTrajInternalPtr%preU = with_halo + preU = with_halo with_halo(2:counts(1)+1, 2:counts(2)+1, :) = V_latlon call ESMF_FieldHalo(field,rh,_RC) - GigaTrajInternalPtr%preV = with_halo + preV = with_halo with_halo(2:counts(1)+1, 2:counts(2)+1, :) = W_latlon call ESMF_FieldHalo(field,rh,_RC) - GigaTrajInternalPtr%preW = with_halo + preW = with_halo + + call updateFields(c_loc(ctime), c_loc(preU), c_loc(preV), c_loc(preW), & + GigaTrajInternalPtr%u0_field, & + GigaTrajInternalPtr%v0_field, & + GigaTrajInternalPtr%w0_field, & + GigaTrajInternalPtr%u1_field, & + GigaTrajInternalPtr%v1_field, & + GigaTrajInternalPtr%w1_field) call ESMF_FieldDestroy(field) @@ -384,26 +465,22 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) type (GigatrajInternalWrap) :: wrap type(ESMF_Grid) :: CubedGrid - integer :: num_parcels, my_rank, i, i1, i2, j1, j2 - real, allocatable :: lats(:), lons(:), lons_send(:), lats_send(:), U(:), pos(:) - real, allocatable :: lons_recv(:), lats_recv(:), U_recv(:), U_send(:) - real :: rparcels, dlat, dlon - integer, allocatable :: counts_send(:),counts_recv(:), II(:), JJ(:), ranks(:) - integer, allocatable :: disp_send(:), disp_recv(:), tmp_position(:) - integer ::counts(3), DIMS(3), rank, comm, ierror, npts + integer :: num_parcels, my_rank + real, allocatable, target :: lats(:), lons(:), zs(:) + real, allocatable, target :: U(:), V(:), W(:) + integer ::counts(3), DIMS(3), rank, comm, ierror type (ESMF_VM) :: vm real, dimension(:,:,:), pointer :: U_cube, V_cube, W_cube, with_halo real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon + real, dimension(:,:,:), allocatable, target :: U_latlon_halo, V_latlon_halo, W_latlon_halo - real, dimension(:,:,:), pointer :: U_latlon_halo, V_latlon_halo, W_latlon_halo - - real(ESMF_KIND_R8), allocatable :: lons8(:), lats8(:) - real(ESMF_KIND_R8) :: delta - integer :: halowidth(3) + real(ESMF_KIND_R8) :: DT + integer :: halowidth(3), model_dtstep type(ESMF_Field) :: halo_field type(ESMF_RouteHandle) :: rh + character(len=20), target :: ctime call ESMF_VMGetCurrent(vm, _RC) @@ -411,45 +488,20 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) call ESMF_ClockGet(clock, currTime=CurrentTime, _RC) - call ESMF_ClockGet(clock, timeStep=ModelTimeStep, _RC) + call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) + ctime(20:20) = c_null_char + + call ESMF_TimeIntervalGet(ModelTimeStep, s=model_dtstep,d_r8=DT, _RC) + call ESMF_GridCompGet(GC, grid=CubedGrid, _RC) call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) GigaTrajInternalPtr => wrap%ptr -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! test MAPL_GetGlobalHorzIJindex block -!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! call MAPL_Grid_interior(CubedGrid ,i1,i2,j1,j2) -! npts = GigaTrajInternalPtr%parcels%num_parcels -! lons = GigaTrajInternalPtr%parcels%lons -! lats = GigaTrajInternalPtr%parcels%lats -! lons8 = lons -! lats8 = lats -! allocate(II(npts), JJ(npts)) -! call MAPL_GetHorzIJIndex(npts,II,JJ,lonr8=lons8,latr8=lats8,Grid=CubedGrid, _RC) - -! do i = 1, npts -! if (II (i) /= -1) print*,"Bens:", lons(I), lats(i), II(i)+i1 -1 , JJ(i)+j1 - 1 -! enddo - -! call MAPL_GetGlobalHorzIJIndex(npts,II,JJ,lonr8=lons8,latr8=lats8,Grid=CubedGrid, _RC) -! -! if (my_rank == 0) then -! do i = 1, npts -! print*, "Jiang: ", lons(i), lats(i), II(i), JJ(i) -! enddo -! endif -! -! RETURN_(ESMF_SUCCESS) - -!!!!!!!!!!!!!!!!!!!!!! -!!!!!!!!!!!!!!!!!!!!!! - - call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts, _RC) + call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts, & + globalCellCountPerDim=DIMS, _RC) allocate(U_latlon(counts(1), counts(2),counts(3)), source = 0.0) allocate(V_latlon(counts(1), counts(2),counts(3)), source = 0.0) @@ -497,108 +549,42 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) with_halo(2:counts(1)+1, 2:counts(2)+1, :) = W_latlon call ESMF_FieldHalo(halo_field, rh, _RC) W_latlon_halo = with_halo + + call updateFields(c_loc(ctime),c_loc(U_latlon_halo), c_loc(V_latlon_halo), c_loc(W_latlon_halo), & + GigaTrajInternalPtr%u0_field, & + GigaTrajInternalPtr%v0_field, & + GigaTrajInternalPtr%w0_field, & + GigaTrajInternalPtr%u1_field, & + GigaTrajInternalPtr%v1_field, & + GigaTrajInternalPtr%w1_field) -!----------------- -! Step 3) Given partical position (lat lon), find out which processor it should go ? -!----------------- num_parcels = GigaTrajInternalPtr%parcels%num_parcels lons = GigaTrajInternalPtr%parcels%lons lats = GigaTrajInternalPtr%parcels%lats + zs = GigaTrajInternalPtr%parcels%zs - allocate(II(num_parcels),JJ(num_parcels), ranks(num_parcels)) - allocate(counts_send(GigaTrajInternalPtr%npes)) - allocate(counts_recv(GigaTrajInternalPtr%npes)) - allocate(disp_send(GigaTrajInternalPtr%npes)) - allocate(disp_recv(GigaTrajInternalPtr%npes)) + call test_dataflow(num_parcels, lons, lats, zs, GigaTrajInternalPtr%CellToRank, DIMS, comm) - call get_latlon_ij_index(GigaTrajInternalPtr%LatLonGrid, lons, lats, II, JJ, _RC) - - do i = 1, num_parcels - ranks(i) = GigaTrajInternalPtr%CellToRank(II(i), JJ(i)) - enddo - -!--------------------- -!step 4) Pack the location data and send them to where the metData sit -!--------------------- + allocate(U(num_parcels)) + allocate(V(num_parcels)) + allocate(W(num_parcels)) - do rank = 0, GigaTrajInternalPtr%npes-1 - counts_send(rank+1) = count(ranks == rank) - enddo + call test_metData( GigaTrajInternalPtr%metSrc, 0.01d0, num_parcels, c_loc(lons), c_loc(lats), c_loc(zs), c_loc(U), c_loc(V), c_loc(W)) - call ESMF_VMGetCurrent(vm, _RC) - call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) - call MPI_AllToALL(counts_send, 1, MPI_INTEGER, counts_recv, 1, MPI_INTEGER, comm, ierror) + !call rk4a_advance( GigaTrajInternalPtr%metSrc, c_loc(ctime), DT, num_parcels, & + ! c_loc(GigaTrajInternalPtr%parcels%lons), & + ! c_loc(GigaTrajInternalPtr%parcels%lats), & + ! c_loc(GigaTrajInternalPtr%parcels%zs)) - disp_send = 0 - do rank = 1, GigaTrajInternalPtr%npes-1 - disp_send(rank+1) = disp_send(rank)+ counts_send(rank) - enddo - disp_recv = 0 - do rank = 1, GigaTrajInternalPtr%npes-1 - disp_recv(rank+1) = disp_recv(rank)+ counts_recv(rank) - enddo - - ! re-arranged lats lons, and ids - tmp_position = disp_send - allocate(lons_send(num_parcels)) - allocate(lons_recv(sum(counts_recv))) - allocate(pos(num_parcels)) - do i = 1, num_parcels - rank = ranks(i) - pos(i) = tmp_position(rank+1) +1 - lons_send(pos(i)) = lons(i) - tmp_position(rank+1) = tmp_position(rank+1) + 1 - enddo - - call MPI_AllToALLv(lons_send, counts_send, disp_send, MPI_REAL, lons_recv, counts_recv, disp_recv, MPI_REAL, comm, ierror) - -!--------------------- -!step 5) Interpolate the data ( horiontally and vertically) and send back where they are from -!--------------------- - - allocate(U_recv(sum(counts_recv)), source = rank*1.0) - allocate(U_send(num_parcels), source = -1.0) - ! - ! Horizontal and vertical interpolator here - ! - call MPI_AllToALLv(U_recv, counts_recv, disp_recv, MPI_REAL, U_send, counts_send, disp_send, MPI_REAL, comm, ierror) - - -!--------------------- -!step 6) Rearrange data ( not necessary if ids was rearranged ins step 4) - allocate(U(num_parcels)) - U(:) = U_send(pos(:)) - !deallocate(U_latlon_halo) call ESMF_FieldDestroy( halo_field) - print*," Great, I am still alive" - RETURN_(ESMF_SUCCESS) - - contains - subroutine get_latlon_ij_index(grid, lons, lats, II, JJ, rc) - type(ESMF_Grid), intent(in) :: grid - real, intent(in) :: lons(:) - real, intent(in) :: lats(:) - integer, intent(inout) :: II(:) - integer, intent(inout) :: JJ(:) - integer, optional, intent(out) :: rc - integer :: dims(3), status - real :: dlon, dlat - - call MAPL_GridGet(grid, globalCellCountPerDim=DIMS, _RC) + if (MAPL_AM_I_ROOT()) print*," Great, the end of the GigaTraj_GridCompMod run" - dlon = 2*MAPL_PI / DIMS(1) - dlat = MAPL_PI / DIMS(2) - - II = min( max(ceiling (lons/dlon),1), DIMS(1)) - JJ = min( max(ceiling (lats/dlat),1), DIMS(2)) + RETURN_(ESMF_SUCCESS) - RETURN_(ESMF_SUCCESS) - end subroutine get_latlon_ij_index - end subroutine Run end module GigaTraj_GridCompMod From 4ed321fb3a5f459ba6bb318e548d95a22f6a3aad Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 3 Jan 2023 09:13:27 -0500 Subject: [PATCH 11/73] first running (need more consideration of poles) --- GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 | 13 ++ GigaTraj_GridComp/GEOS_Giga_InterOp.F90 | 12 +- GigaTraj_GridComp/GigaTraj_GridComp.F90 | 161 ++++++++++++------------ 3 files changed, 95 insertions(+), 91 deletions(-) diff --git a/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 b/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 index 167ee57ac..a7b1bc7df 100644 --- a/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 +++ b/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 @@ -724,6 +724,19 @@ subroutine SetServices ( GC, RC ) RC = STATUS) VERIFY_(STATUS) +#ifdef HAS_GIGATRAJ + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'OMEGA', & + CHILD_ID = SDYN, & + RC = STATUS) + VERIFY_(STATUS) + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'PL', & + CHILD_ID = SDYN, & + RC = STATUS) + VERIFY_(STATUS) +#endif + call MAPL_AddExportSpec( GC, & SHORT_NAME = 'PS', & CHILD_ID = SDYN, & diff --git a/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 b/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 index 1ffc1f1e5..9b4f4e26e 100644 --- a/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 +++ b/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 @@ -25,18 +25,18 @@ function initGigaGridLatLonField3d(nlons, nlats, nzs, lons_ptr, lats_ptr, levs_p type(c_ptr) :: field_ptr end function - function initMetGEOSDistributedData(comm, ijToRank, Ig, Jg, u0_ptr, v0_ptr, w0_ptr, u1_ptr, v1_ptr, w1_ptr) result (metdata_ptr) bind(C, name="initGigaGridDistributedData") + function initMetGEOSDistributedData(comm, ijToRank, Ig, Jg,lev, nlon_local, nlat_local, nzs, lons_ptr, lats_ptr, eta_ptr, ctime_ptr) result (metdata_ptr) bind(C, name="initGigaGridDistributedData") import :: c_int, c_ptr implicit none - integer(c_int), intent(in), value :: comm, Ig, Jg - type(c_ptr), intent(in), value :: ijToRank, u0_ptr, v0_ptr, w0_ptr, u1_ptr,v1_ptr, w1_ptr + integer(c_int), intent(in), value :: comm, Ig, Jg, lev, nlon_local, nlat_local, nzs + type(c_ptr), intent(in), value :: ijToRank, lons_ptr, lats_ptr, eta_ptr, ctime_ptr type(c_ptr) :: metdata_ptr end function - subroutine updateFields( ctime_ptr, u_ptr, v_ptr, w_ptr, u0_ptr, v0_ptr, w0_ptr, u1_ptr, v1_ptr, w1_ptr) bind(C, name="updateFields") + subroutine updateFields( metSrc_ptr, ctime_ptr, u_ptr, v_ptr, w_ptr, p_ptr) bind(C, name="updateFields") import :: c_ptr implicit none - type(c_ptr), intent(in), value :: ctime_ptr, u_ptr, v_ptr, w_ptr, u0_ptr, v0_ptr, w0_ptr, u1_ptr, v1_ptr, w1_ptr + type(c_ptr), intent(in), value :: metSrc_ptr, ctime_ptr, u_ptr, v_ptr, w_ptr, p_ptr end subroutine subroutine rk4a_advance(metsrc_ptr, ctime_ptr, dt, n, lons_ptr, lats_ptr, levs_ptr) bind( C, name='rk4a_advance') @@ -81,7 +81,6 @@ subroutine test_dataflow(num_parcels, lons, lats, zs, CellToRank, DIMS, comm) integer, allocatable :: counts_send(:),counts_recv(:), II(:), JJ(:), ranks(:) integer, allocatable :: disp_send(:), disp_recv(:), tmp_position(:) - dlon = 360.0 / DIMS(1) dlat = 180.0 / DIMS(2) @@ -149,7 +148,6 @@ subroutine test_dataflow(num_parcels, lons, lats, zs, CellToRank, DIMS, comm) !-- ------------------- !step 5) Interpolate the data ( horiontally and vertically) and send back where they are from !-- ------------------- - allocate(U_recv(sum(counts_recv)), source = my_rank*1.0) allocate(U_send(num_parcels), source = -1.0) ! diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 index e88ad4eda..a98a6e005 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -31,12 +31,11 @@ module GigaTraj_GridCompMod type GigaTrajInternal integer :: npes + integer :: npz ! number of pressure levels type (ESMF_Grid) :: LatLonGrid class (AbstractRegridder), pointer :: cube2latlon => null() integer, allocatable :: CellToRank(:,:) - real, dimension(:,:,:), allocatable :: preU, PreV, preW type(horde) :: parcels - type(c_ptr) :: u0_field, u1_field, v0_field, v1_field, w0_field, w1_field type(c_ptr) :: metSrc end type @@ -154,7 +153,7 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Local derived type aliases type (MAPL_MetaComp), pointer :: STATE type (ESMF_VM) :: vm - integer :: I1, I2, J1, J2, comm, npes, rank, ierror, NX, NY + integer :: I1, I2, J1, J2, comm, npes, rank, ierror, NX, NY, NPZ type(ESMF_Grid) :: CubedGrid integer, allocatable :: I1s(:), J1s(:), I2s(:),J2s(:) integer :: DIMS(3), counts(3), i,j,k @@ -217,37 +216,17 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) dlon = 360.0/dims(1) lons_center = [(-dlon/2+ dlon*i, i= i1-1, i2+1)] dlat = 180.0/dims(2) - lats_center = [(-dlat/2+ dlat*j-90.0, j= j1-1, j2+1)] - levs_center = [(k*1.0, k = 1, counts(3))] + lats_center = [(-dlat/2+ dlat*j-90.0, j= j1-1, j2+1)] + npz = 42 + GigaTrajInternalPtr%npz = npz + allocate(levs_center(GigaTrajInternalPtr%npz)) + levs_center = [1000., 975., 950., 925., 900., 875., 850., 825., 800., 775., 750., 725.,700., 650., 600., 550., 500., & + 450., 400., 350., 300., 250., 200., 150., 100., 70., 50., 40., 30., 20., 10., 7., 5., 4., 3., 2., & + 1. , 0.7, 0.5, 0.4, 0.3, 0.1] call ESMF_ClockGet(clock, currTime=CurrentTime, _RC) call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) ctime(20:20) = c_null_char - unit_="m/s"//c_null_char - - name_="U"//c_null_char - GigaTrajInternalPtr%u0_field= initGigaGridLatLonField3d(counts(1)+2, counts(2)+2, counts(3), & - c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), & - c_loc(name_), c_loc(unit_), c_loc(ctime)) - GigaTrajInternalPtr%u1_field= initGigaGridLatLonField3d(counts(1)+2, counts(2)+2, counts(3), & - c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), & - c_loc(name_), c_loc(unit_), c_loc(ctime)) - - name_="V"//c_null_char - GigaTrajInternalPtr%v0_field= initGigaGridLatLonField3d(counts(1)+2, counts(2)+2, counts(3), & - c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), & - c_loc(name_), c_loc(unit_), c_loc(ctime)) - GigaTrajInternalPtr%v1_field= initGigaGridLatLonField3d(counts(1)+2, counts(2)+2, counts(3), & - c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), & - c_loc(name_), c_loc(unit_), c_loc(ctime)) - - name_="W"//c_null_char - GigaTrajInternalPtr%w0_field= initGigaGridLatLonField3d(counts(1)+2, counts(2)+2, counts(3), & - c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), & - c_loc(name_), c_loc(unit_), c_loc(ctime)) - GigaTrajInternalPtr%w1_field= initGigaGridLatLonField3d(counts(1)+2, counts(2)+2, counts(3), & - c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), & - c_loc(name_), c_loc(unit_), c_loc(ctime)) allocate(I1s(npes),J1s(npes)) allocate(I2s(npes),J2s(npes)) @@ -269,12 +248,9 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) enddo GigaTrajInternalPtr%metSrc = initMetGEOSDistributedData(comm, c_loc(GigaTrajInternalPtr%CellToRank), DIMS(1), DIMS(2), & - GigaTrajInternalPtr%u0_field, & - GigaTrajInternalPtr%v0_field, & - GigaTrajInternalPtr%w0_field, & - GigaTrajInternalPtr%u1_field, & - GigaTrajInternalPtr%v1_field, & - GigaTrajInternalPtr%w1_field) + dims(3), counts(1)+2, counts(2)+2, npz, & + c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), c_loc(ctime)) + ! initialize partical positions. It will be read and distribted across processors. ! for now, it is genrated randomly @@ -284,22 +260,33 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) real, allocatable :: lats(:), lons(:), zs(:) integer, allocatable :: nums_all(:) + + call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) + !call random_seed() !call random_number(rparcels) !num_parcels = nint(rparcels*10) - num_parcels = 20 + num_parcels = 1 allocate(lats(num_parcels), lons(num_parcels), zs(num_parcels)) - call random_number(lats) - call random_number(lons) - call random_number(zs) + !call random_number(lats) + !call random_number(lons) + !call random_number(zs) - lons = lons*360.0 + !lons = lons*360.0 !lats = lats*180.0 - 90.0 - lats = lats*20.0 - 10.0 - zs = ceiling(DIMS(3)*zs)*1.0 + !lats = lats*20.0 - 10.0 + !zs = (999.9*zs) + 0.1 + + call MAPL_Grid_interior(GigaTrajInternalPtr%LatLonGrid ,i1,i2,j1,j2) + dlon = 360.0/DIMS(1) + dlat = 180.0/DIMS(2) + lons = [(i1+i2)*dlon/2.0] + lats = [(j1+j2)*dlat/2.0 - 90.0] + zs = [my_rank*10.0+10.0] + GigaTrajInternalPtr%parcels%num_parcels = num_parcels GigaTrajInternalPtr%parcels%lats = lats GigaTrajInternalPtr%parcels%lons = lons @@ -309,7 +296,6 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) allocate(nums_all(npes)) call MPI_AllGather(num_parcels, 1, MPI_INTEGER, nums_all, 1, MPI_INTEGER, comm, ierror) - call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) if (my_rank > 0) then GigaTrajInternalPtr%parcels%IDS = GigaTrajInternalPtr%parcels%IDS + sum(nums_all(1:my_rank)) endif @@ -354,9 +340,9 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap - real, dimension(:,:,:), pointer :: U, V, W, with_halo - real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon - real, dimension(:,:,:), allocatable, target :: preU, preV, preW + real, dimension(:,:,:), pointer :: U, V, W, with_halo, P + real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon, P_latlon + real, dimension(:,:,:), allocatable, target :: preU, preV, preW, preP integer :: counts(3), dims(3) type(ESMF_Field) :: field type(ESMF_RouteHandle) :: rh @@ -381,15 +367,18 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(Import, U, "U", _RC) call MAPL_GetPointer(Import, V, "V", _RC) - call MAPL_GetPointer(Import, W, "W", _RC) + call MAPL_GetPointer(Import, W, "OMEGA", _RC) + call MAPL_GetPointer(Import, P, "PL", _RC) allocate(U_latlon(counts(1),counts(2),counts(3))) allocate(V_latlon(counts(1),counts(2),counts(3))) allocate(W_latlon(counts(1),counts(2),counts(3))) + allocate(P_latlon(counts(1),counts(2),counts(3))) call GigaTrajInternalPtr%cube2latlon%regrid(U, U_latlon, _RC) call GigaTrajInternalPtr%cube2latlon%regrid(V, V_latlon, _RC) call GigaTrajInternalPtr%cube2latlon%regrid(W, W_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(P, P_latlon, _RC) field = ESMF_FieldCreate(GigaTrajInternalPtr%LatLonGrid, ESMF_TYPEKIND_R4, name='halo_field', & ungriddedLBound=[1],ungriddedUBound=[counts(3)], & @@ -410,13 +399,11 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_FieldHalo(field,rh,_RC) preW = with_halo - call updateFields(c_loc(ctime), c_loc(preU), c_loc(preV), c_loc(preW), & - GigaTrajInternalPtr%u0_field, & - GigaTrajInternalPtr%v0_field, & - GigaTrajInternalPtr%w0_field, & - GigaTrajInternalPtr%u1_field, & - GigaTrajInternalPtr%v1_field, & - GigaTrajInternalPtr%w1_field) + with_halo(2:counts(1)+1, 2:counts(2)+1, :) = p_latlon + call ESMF_FieldHalo(field,rh,_RC) + preP = with_halo + + call updateFields( GigaTrajInternalPtr%metSrc, c_loc(ctime), c_loc(preU), c_loc(preV), c_loc(preW), c_loc(preP)) call ESMF_FieldDestroy(field) @@ -453,7 +440,7 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=ESMF_MAXSTR) :: IAm integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME - integer :: CSTAT, ESTAT, YY, MM, HH, DD, H, M,S, model_dtstep_m + integer :: CSTAT, ESTAT, YY, MM, HH, DD, H, M,S character(512) :: CMSG character(256) :: command_line character(19) :: begdate, enddate @@ -471,12 +458,11 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) integer ::counts(3), DIMS(3), rank, comm, ierror type (ESMF_VM) :: vm - real, dimension(:,:,:), pointer :: U_cube, V_cube, W_cube, with_halo - real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon - real, dimension(:,:,:), allocatable, target :: U_latlon_halo, V_latlon_halo, W_latlon_halo + real, dimension(:,:,:), pointer :: U_cube, V_cube, W_cube, p_cube, with_halo + real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon, P_latlon + real, dimension(:,:,:), allocatable, target :: U_latlon_halo, V_latlon_halo, W_latlon_halo, p_latlon_halo real(ESMF_KIND_R8) :: DT - integer :: halowidth(3), model_dtstep type(ESMF_Field) :: halo_field type(ESMF_RouteHandle) :: rh @@ -489,11 +475,14 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_ClockGet(clock, currTime=CurrentTime, _RC) call ESMF_ClockGet(clock, timeStep=ModelTimeStep, _RC) - + + ! W.J note: this run is after agcm's run. The clock is not yet ticked + ! So the values we are using are at (CurrentTime + ModelTimeStep) + CurrentTime = CurrentTime + ModelTimeStep call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) ctime(20:20) = c_null_char - call ESMF_TimeIntervalGet(ModelTimeStep, s=model_dtstep,d_r8=DT, _RC) + call ESMF_TimeIntervalGet(ModelTimeStep,d_r8=DT, _RC) call ESMF_GridCompGet(GC, grid=CubedGrid, _RC) @@ -506,10 +495,12 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) allocate(U_latlon(counts(1), counts(2),counts(3)), source = 0.0) allocate(V_latlon(counts(1), counts(2),counts(3)), source = 0.0) allocate(W_latlon(counts(1), counts(2),counts(3)), source = 0.0) + allocate(P_latlon(counts(1), counts(2),counts(3)), source = 0.0) allocate(U_latlon_halo(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) allocate(V_latlon_halo(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) allocate(W_latlon_halo(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) + allocate(P_latlon_halo(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) !--------------- ! Step 1) Regrid the metData field from cubed to lat-lon @@ -517,11 +508,13 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(Import, U_cube, "U", _RC) call MAPL_GetPointer(Import, V_cube, "V", _RC) - call MAPL_GetPointer(Import, W_cube, "W", _RC) + call MAPL_GetPointer(Import, W_cube, "OMEGA", _RC) + call MAPL_GetPointer(Import, P_cube, "PL", _RC) call GigaTrajInternalPtr%cube2latlon%regrid(U_cube, U_latlon, _RC) call GigaTrajInternalPtr%cube2latlon%regrid(V_cube, V_latlon, _RC) call GigaTrajInternalPtr%cube2latlon%regrid(W_cube, W_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(P_cube, P_latlon, _RC) !--------------- ! Step 2) Get halo of latlon metData field @@ -550,33 +543,33 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_FieldHalo(halo_field, rh, _RC) W_latlon_halo = with_halo - call updateFields(c_loc(ctime),c_loc(U_latlon_halo), c_loc(V_latlon_halo), c_loc(W_latlon_halo), & - GigaTrajInternalPtr%u0_field, & - GigaTrajInternalPtr%v0_field, & - GigaTrajInternalPtr%w0_field, & - GigaTrajInternalPtr%u1_field, & - GigaTrajInternalPtr%v1_field, & - GigaTrajInternalPtr%w1_field) - + ! get W + halo + with_halo(2:counts(1)+1, 2:counts(2)+1, :) = P_latlon + call ESMF_FieldHalo(halo_field, rh, _RC) + P_latlon_halo = with_halo + + call updateFields( GigaTrajInternalPtr%metSrc, c_loc(ctime),c_loc(U_latlon_halo), & + c_loc(V_latlon_halo), c_loc(W_latlon_halo), c_loc(P_latlon_halo)) + - num_parcels = GigaTrajInternalPtr%parcels%num_parcels + num_parcels = GigaTrajInternalPtr%parcels%num_parcels - lons = GigaTrajInternalPtr%parcels%lons - lats = GigaTrajInternalPtr%parcels%lats - zs = GigaTrajInternalPtr%parcels%zs + !lons = GigaTrajInternalPtr%parcels%lons + !lats = GigaTrajInternalPtr%parcels%lats + !zs = GigaTrajInternalPtr%parcels%zs - call test_dataflow(num_parcels, lons, lats, zs, GigaTrajInternalPtr%CellToRank, DIMS, comm) + !call test_dataflow(num_parcels, lons, lats, zs, GigaTrajInternalPtr%CellToRank, DIMS, comm) - allocate(U(num_parcels)) - allocate(V(num_parcels)) - allocate(W(num_parcels)) + !allocate(U(num_parcels)) + !allocate(V(num_parcels)) + !allocate(W(num_parcels)) - call test_metData( GigaTrajInternalPtr%metSrc, 0.01d0, num_parcels, c_loc(lons), c_loc(lats), c_loc(zs), c_loc(U), c_loc(V), c_loc(W)) + !call test_metData( GigaTrajInternalPtr%metSrc, 0.01d0, num_parcels, c_loc(lons), c_loc(lats), c_loc(zs), c_loc(U), c_loc(V), c_loc(W)) - !call rk4a_advance( GigaTrajInternalPtr%metSrc, c_loc(ctime), DT, num_parcels, & - ! c_loc(GigaTrajInternalPtr%parcels%lons), & - ! c_loc(GigaTrajInternalPtr%parcels%lats), & - ! c_loc(GigaTrajInternalPtr%parcels%zs)) + call rk4a_advance( GigaTrajInternalPtr%metSrc, c_loc(ctime), DT, num_parcels, & + c_loc(GigaTrajInternalPtr%parcels%lons), & + c_loc(GigaTrajInternalPtr%parcels%lats), & + c_loc(GigaTrajInternalPtr%parcels%zs)) call ESMF_FieldDestroy( halo_field) From 254a8528d0160abab5b995957a85c73557217fb5 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 3 Jan 2023 13:33:16 -0500 Subject: [PATCH 12/73] Change to Pole on Center and regridding UV --- GigaTraj_GridComp/GigaTraj_GridComp.F90 | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 index a98a6e005..5e6f8bb6d 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -201,8 +201,8 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) GigaTrajInternalPtr%npes = npes call MAPL_MakeDecomposition(NX,NY,_RC) GigaTrajInternalPtr%LatLonGrid = grid_manager%make_grid( & - LatLonGridFactory(im_world=DIMS(1)*4, jm_world=DIMS(1)*2, lm=DIMS(3), & - nx=NX, ny=NY, pole='PE', dateline= 'DE', rc=status) ); _VERIFY(status) + LatLonGridFactory(im_world=DIMS(1)*4, jm_world=DIMS(1)*2+1, lm=DIMS(3), & + nx=NX, ny=NY, pole='PC', dateline= 'DE', rc=status) ); _VERIFY(status) GigaTrajInternalPtr%cube2latlon => new_regridder_manager%make_regridder(CubedGrid, GigaTrajInternalPtr%LatLonGrid, REGRID_METHOD_CONSERVE, _RC) @@ -210,13 +210,15 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_Grid_interior(GigaTrajInternalPtr%LatLonGrid ,i1,i2,j1,j2) call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) + ! lat and lon centers need to hold the halo allocate(lons_center(counts(1)+2)) allocate(lats_center(counts(2)+2)) allocate(levs_center(counts(3) )) dlon = 360.0/dims(1) lons_center = [(-dlon/2+ dlon*i, i= i1-1, i2+1)] - dlat = 180.0/dims(2) - lats_center = [(-dlat/2+ dlat*j-90.0, j= j1-1, j2+1)] + ! for PC grid + dlat = 180.0/(dims(2)-1) + lats_center = [(-dlat + dlat*j-90.0, j= j1-1, j2+1)] npz = 42 GigaTrajInternalPtr%npz = npz allocate(levs_center(GigaTrajInternalPtr%npz)) @@ -282,7 +284,7 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_Grid_interior(GigaTrajInternalPtr%LatLonGrid ,i1,i2,j1,j2) dlon = 360.0/DIMS(1) - dlat = 180.0/DIMS(2) + dlat = 180.0/(DIMS(2)-1) lons = [(i1+i2)*dlon/2.0] lats = [(j1+j2)*dlat/2.0 - 90.0] zs = [my_rank*10.0+10.0] @@ -375,8 +377,7 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) allocate(W_latlon(counts(1),counts(2),counts(3))) allocate(P_latlon(counts(1),counts(2),counts(3))) - call GigaTrajInternalPtr%cube2latlon%regrid(U, U_latlon, _RC) - call GigaTrajInternalPtr%cube2latlon%regrid(V, V_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(U,V, U_latlon, V_latlon, _RC) call GigaTrajInternalPtr%cube2latlon%regrid(W, W_latlon, _RC) call GigaTrajInternalPtr%cube2latlon%regrid(P, P_latlon, _RC) From 1f6da6810c01cdc3bc39c17230c23a69788b36a3 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 19 Jan 2023 09:39:30 -0500 Subject: [PATCH 13/73] add internal, reading and writing parcels, halo, alarms and clean up --- GEOS_GcmGridComp.F90 | 2 +- GigaTraj_GridComp/GigaTraj_GridComp.F90 | 1066 ++++++++++++++++------- 2 files changed, 754 insertions(+), 314 deletions(-) diff --git a/GEOS_GcmGridComp.F90 b/GEOS_GcmGridComp.F90 index 526b66f47..12cf9523d 100644 --- a/GEOS_GcmGridComp.F90 +++ b/GEOS_GcmGridComp.F90 @@ -241,7 +241,7 @@ subroutine SetServices ( GC, RC ) AGCM = MAPL_AddChild(GC, NAME='AGCM', SS=Agcm_SetServices, RC=STATUS) VERIFY_(STATUS) #ifdef HAS_GIGATRAJ - gigatraj = MAPL_AddChild(GC, NAME='GigaTraj', SS=GigaTraj_SetServices, RC=STATUS) + gigatraj = MAPL_AddChild(GC, NAME='GIGATRAJ', SS=GigaTraj_SetServices, RC=STATUS) VERIFY_(STATUS) #endif AIAU = MAPL_AddChild(GC, NAME='AIAU', SS=AIAU_SetServices, RC=STATUS) diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 index 5e6f8bb6d..a6048aa34 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -1,15 +1,6 @@ #include "MAPL_Generic.h" -!============================================================================= -!BOP - -! !MODULE: GigaTraj_GridCompMod -- A Module to run gigatraj - -! !INTERFACE: - module GigaTraj_GridCompMod - -! !USES: use, intrinsic :: iso_c_binding, only : c_int, c_ptr, c_null_ptr, c_associated use, intrinsic :: iso_c_binding, only : c_loc use ESMF @@ -17,12 +8,10 @@ module GigaTraj_GridCompMod use mpi use GEOS_Giga_interOpMod implicit none - private - -! !PUBLIC MEMBER FUNCTIONS: public :: SetServices + private type horde integer :: num_parcels integer, allocatable :: IDS(:) @@ -37,6 +26,7 @@ module GigaTraj_GridCompMod integer, allocatable :: CellToRank(:,:) type(horde) :: parcels type(c_ptr) :: metSrc + type(ESMF_Time) :: startTime end type type GigatrajInternalWrap @@ -45,146 +35,137 @@ module GigaTraj_GridCompMod contains -!BOP - -! !IROUTINE: SetServices -- Sets ESMF services for this component - -! !INTERFACE: - - subroutine SetServices ( GC, RC ) - -! !ARGUMENTS: - + subroutine SetServices ( GC, RC ) type(ESMF_GridComp), intent(INOUT) :: GC ! gridded component integer, optional :: RC ! return code - character(len=ESMF_MAXSTR) :: IAm - integer :: STATUS - character(len=ESMF_MAXSTR) :: COMP_NAME - - type (ESMF_Config) :: CF - type (MAPL_MetaComp), pointer :: MAPL - - type (GigaTrajInternal), pointer :: GigaTrajInternalPtr - type (GigatrajInternalWrap) :: wrap - -! Begin... + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME -! Get my name and set-up traceback handle -! --------------------------------------- + type (GigaTrajInternal), pointer :: GigaTrajInternalPtr + type (GigatrajInternalWrap) :: wrap call ESMF_GridCompGet( GC, NAME=COMP_NAME, _RC ) Iam = trim(COMP_NAME) // 'SetServices' -! Register services for this component -! ------------------------------------ + ! Register services for this component + ! ------------------------------------ call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_INITIALIZE, Initialize, _RC ) call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, GetInitVars , _RC ) call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run , _RC ) -! Get the configuration from the component -!----------------------------------------- - call ESMF_GridCompGet( GC, CONFIG = CF, _RC ) + ! Internal state -! Set the state variable specs. -! ----------------------------- - call MAPL_GetObjectFromGC ( GC, MAPL, _RC) + call MAPL_AddInternalSpec(GC, & + SHORT_NAME = 'U', & + LONG_NAME = 'eastward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, _RC) - call MAPL_AddExportSpec ( gc, & - SHORT_NAME = 'DVDT', & - LONG_NAME = 'northward_wind_bias_tendency', & - UNITS = 'm s-2', & + call MAPL_AddInternalSpec(GC, & + SHORT_NAME = 'V', & + LONG_NAME = 'northward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, _RC) + + call MAPL_AddInternalSpec ( gc, & + SHORT_NAME = 'OMEGA', & + LONG_NAME = 'vertical_pressure_velocity', & + UNITS = 'Pa s-1', & DIMS = MAPL_DimsHorzVert, & - FIELD_TYPE = MAPL_VectorField, & - VLOCATION = MAPL_VLocationCenter, _RC ) + VLOCATION = MAPL_VLocationCenter, _RC) + call MAPL_AddInternalSpec ( gc, & + SHORT_NAME = 'PL', & + LONG_NAME = 'mid_level_pressure', & + UNITS = 'Pa', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, _RC) allocate(GigaTrajInternalPtr) wrap%ptr => GigaTrajInternalPtr - call ESMF_UserCompSetInternalState ( GC, 'GigaTrajInternal', wrap, status ); _VERIFY(STATUS) - - call MAPL_GenericSetServices ( GC, _RC ) + call ESMF_UserCompSetInternalState(GC, 'GigaTrajInternal', wrap, _RC) -! Clocks -!------- + call MAPL_GenericSetServices(GC, _RC ) call MAPL_TimerAdd(GC, name="INITIALIZE" ,_RC) call MAPL_TimerAdd(GC, name="RUN" ,_RC) -! All done -!--------- - RETURN_(ESMF_SUCCESS) end subroutine SetServices - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!BOP - -! !IROUTINE: Initialize -- Initialize method for the composite GigaTraj Gridded Component - -! !INTERFACE: - subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) - -! !ARGUMENTS: - - type(ESMF_GridComp), intent(inout) :: GC ! Gridded component - type(ESMF_State), intent(inout) :: IMPORT ! Import state - type(ESMF_State), intent(inout) :: EXPORT ! Export state - type(ESMF_Clock), intent(inout) :: CLOCK ! The clock - integer, optional, intent( out) :: RC ! Error code - -! !DESCRIPTION: - - -!EOP - -! ErrLog Variables - - character(len=ESMF_MAXSTR) :: IAm - integer :: STATUS - character(len=ESMF_MAXSTR) :: COMP_NAME - -! Local derived type aliases - type (MAPL_MetaComp), pointer :: STATE - type (ESMF_VM) :: vm - integer :: I1, I2, J1, J2, comm, npes, rank, ierror, NX, NY, NPZ - type(ESMF_Grid) :: CubedGrid - integer, allocatable :: I1s(:), J1s(:), I2s(:),J2s(:) - integer :: DIMS(3), counts(3), i,j,k - type (GigaTrajInternal), pointer :: GigaTrajInternalPtr - type (GigatrajInternalWrap) :: wrap - real :: dlat, dlon - real, pointer :: lats_center(:), lons_center(:), levs_center(:) - type (ESMF_TIME) :: CurrentTime - character(len=20), target :: ctime - character(len=:), allocatable, target :: name_, unit_ - -! ============================================================================= - -! Begin... - -! Get the target components name and set-up traceback handle. -! ----------------------------------------------------------- + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_State), intent(inout) :: IMPORT ! Import state + type(ESMF_State), intent(inout) :: EXPORT ! Export state + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + integer, optional, intent( out) :: RC ! Error code + + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + + ! Local derived type aliases + type (MAPL_MetaComp), pointer :: MPL + type (ESMF_VM) :: vm + integer :: I1, I2, J1, J2, comm, npes, rank, ierror, NX, NY, NPZ + type(ESMF_Grid) :: CubedGrid + integer, allocatable :: I1s(:), J1s(:), I2s(:),J2s(:) + integer :: DIMS(3), counts(3), i,j,k + type (GigaTrajInternal), pointer :: GigaTrajInternalPtr + type (GigatrajInternalWrap) :: wrap + real :: dlat, dlon + real, allocatable, target :: lats_center(:), lons_center(:), levs_center(:) + type (ESMF_TIME) :: CurrentTime + character(len=20), target :: ctime + character(len=:), allocatable, target :: name_, unit_ + type(ESMF_Alarm) :: GigaTrajOutAlarm, GigaTrajRebalanceAlarm + type(ESMF_TimeInterval) :: parcels_DT, Rebalance_DT + type(ESMF_TimeInterval) :: ModelTimeStep + type(ESMF_State) :: INTERNAL + integer :: minutes_ + character(len=ESMF_MAXSTR) :: parcels_file call ESMF_GridCompGet ( GC, name=COMP_NAME, _RC ) Iam = trim(COMP_NAME) // "Initialize" -! Get my MAPL_Generic state -!-------------------------- + call MAPL_GetObjectFromGC ( GC, MPL, _RC) + + call MAPL_TimerOn(MPL,"TOTAL") + call MAPL_TimerOn(MPL,"INITIALIZE") + + call ESMF_ClockGet(clock, currTime=CurrentTime, _RC) + call ESMF_ClockGet(clock, timeStep=ModelTimeStep, _RC) - call MAPL_GetObjectFromGC ( GC, STATE, _RC) + call MAPL_GetResource(MPL, minutes_, "GIGATRAJ_REBALANCE_MINUTES:", default=30, _RC) + call ESMF_TimeIntervalSet(Rebalance_DT, m= minutes_, _RC) + call MAPL_GetResource(MPL, minutes_, "GIGATRAJ_OUTPUT_MINUTES:", default=30, _RC) + call ESMF_TimeIntervalSet(parcels_DT, m= minutes_, _RC) + GigaTrajOutAlarm = ESMF_AlarmCreate( & + clock, & + name='GigatrajOut', & + ringTime= CurrentTime + parcels_DT-ModelTimeStep, & + ringInterval=parcels_DT, & + ringTimeStepCount=1, & + sticky=.false., _RC) - call MAPL_TimerOn(STATE,"TOTAL") - call MAPL_TimerOn(STATE,"INITIALIZE") + GigaTrajRebalanceAlarm = ESMF_AlarmCreate( & + clock, & + name='GigatrajRebalance', & + ringTime= CurrentTime + parcels_DT-ModelTimeStep, & + ringInterval=parcels_DT, & + ringTimeStepCount=1, & + sticky=.false., _RC) -! Call Initialize for every Child call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, _RC) @@ -200,33 +181,35 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) GigaTrajInternalPtr%npes = npes call MAPL_MakeDecomposition(NX,NY,_RC) - GigaTrajInternalPtr%LatLonGrid = grid_manager%make_grid( & - LatLonGridFactory(im_world=DIMS(1)*4, jm_world=DIMS(1)*2+1, lm=DIMS(3), & - nx=NX, ny=NY, pole='PC', dateline= 'DE', rc=status) ); _VERIFY(status) - + call MAPL_GridGet(CubedGrid, globalCellCountPerDim=DIMS, _RC) + GigaTrajInternalPtr%LatLonGrid = grid_manager%make_grid( & + LatLonGridFactory(im_world=DIMS(1)*4, jm_world=DIMS(1)*2, lm=DIMS(3), & + nx=NX, ny=NY, pole='PE', dateline= 'DE', rc=status) ); _VERIFY(status) + GigaTrajInternalPtr%cube2latlon => new_regridder_manager%make_regridder(CubedGrid, GigaTrajInternalPtr%LatLonGrid, REGRID_METHOD_CONSERVE, _RC) call MAPL_Grid_interior(GigaTrajInternalPtr%LatLonGrid ,i1,i2,j1,j2) call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) ! lat and lon centers need to hold the halo - allocate(lons_center(counts(1)+2)) - allocate(lats_center(counts(2)+2)) - allocate(levs_center(counts(3) )) dlon = 360.0/dims(1) lons_center = [(-dlon/2+ dlon*i, i= i1-1, i2+1)] - ! for PC grid - dlat = 180.0/(dims(2)-1) - lats_center = [(-dlat + dlat*j-90.0, j= j1-1, j2+1)] - npz = 42 - GigaTrajInternalPtr%npz = npz - allocate(levs_center(GigaTrajInternalPtr%npz)) + where(lons_center < 0. ) lons_center = 0. + where(lons_center >360.) lons_center = 360. + + dlat = 180.0/dims(2) + lats_center = [(-dlat/2. + dlat*j-90.0, j= j1-1, j2+1)] + where(lats_center <-90.) lats_center = -90. + where(lats_center >90. ) lats_center = 90. + levs_center = [1000., 975., 950., 925., 900., 875., 850., 825., 800., 775., 750., 725.,700., 650., 600., 550., 500., & 450., 400., 350., 300., 250., 200., 150., 100., 70., 50., 40., 30., 20., 10., 7., 5., 4., 3., 2., & - 1. , 0.7, 0.5, 0.4, 0.3, 0.1] + 1. , 0.6, 0.3, 0.1, 0.07, 0.04, 0.02, 0.01] + + npz = size(levs_center, 1) + GigaTrajInternalPtr%npz = npz - call ESMF_ClockGet(clock, currTime=CurrentTime, _RC) call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) ctime(20:20) = c_null_char @@ -253,191 +236,147 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) dims(3), counts(1)+2, counts(2)+2, npz, & c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), c_loc(ctime)) + deallocate(lons_center, lats_center,levs_center) -! initialize partical positions. It will be read and distribted across processors. -! for now, it is genrated randomly - block - real :: rparcels - integer :: num_parcels, my_rank, i - real, allocatable :: lats(:), lons(:), zs(:) - integer, allocatable :: nums_all(:) - - - call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) - - !call random_seed() - !call random_number(rparcels) - - !num_parcels = nint(rparcels*10) - num_parcels = 1 - - allocate(lats(num_parcels), lons(num_parcels), zs(num_parcels)) + call MAPL_GetResource(MPL, parcels_file, "GIGATRAJ_PARCELS_FILE:", default='parcels.nc4', _RC) - !call random_number(lats) - !call random_number(lons) - !call random_number(zs) + call read_parcels(parcels_file, GigaTrajInternalPtr, _RC) - !lons = lons*360.0 - !lats = lats*180.0 - 90.0 - !lats = lats*20.0 - 10.0 - !zs = (999.9*zs) + 0.1 + call MAPL_TimerOff(MPL,"INITIALIZE") + call MAPL_TimerOff(MPL,"TOTAL") - call MAPL_Grid_interior(GigaTrajInternalPtr%LatLonGrid ,i1,i2,j1,j2) - dlon = 360.0/DIMS(1) - dlat = 180.0/(DIMS(2)-1) - lons = [(i1+i2)*dlon/2.0] - lats = [(j1+j2)*dlat/2.0 - 90.0] - zs = [my_rank*10.0+10.0] + RETURN_(ESMF_SUCCESS) + end subroutine Initialize - GigaTrajInternalPtr%parcels%num_parcels = num_parcels - GigaTrajInternalPtr%parcels%lats = lats - GigaTrajInternalPtr%parcels%lons = lons - GigaTrajInternalPtr%parcels%zs = zs - GigaTrajInternalPtr%parcels%IDS = [(i, i=1, num_parcels)] +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - allocate(nums_all(npes)) - call MPI_AllGather(num_parcels, 1, MPI_INTEGER, nums_all, 1, MPI_INTEGER, comm, ierror) + subroutine GetInitVars ( 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, optional, intent( out) :: RC - if (my_rank > 0) then - GigaTrajInternalPtr%parcels%IDS = GigaTrajInternalPtr%parcels%IDS + sum(nums_all(1:my_rank)) - endif + integer :: status + character(len=ESMF_MAXSTR) :: IAm + type (ESMF_State) :: INTERNAL + type (GigaTrajInternal), pointer :: GigaTrajInternalPtr + type (GigatrajInternalWrap) :: wrap + character(len=ESMF_MAXSTR) :: GigaRstFile + type (ESMF_TIME) :: CurrentTime + character(len=20), target :: ctime + type (MAPL_MetaComp), pointer :: MAPL + logical, save :: init = .false. - end block + Iam = "getInitVars" - deallocate(lons_center, lats_center,levs_center) + if (init) then + RETURN_(ESMF_SUCCESS) + endif - call MAPL_TimerOff(STATE,"INITIALIZE") - call MAPL_TimerOff(STATE,"TOTAL") + call MAPL_GetObjectFromGC ( GC, MAPL, _RC) + call ESMF_ClockGet(clock, currTime=CurrentTime, _RC) + call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) + ctime(20:20) = c_null_char - RETURN_(ESMF_SUCCESS) - end subroutine Initialize - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + call MAPL_Get(MAPL, INTERNAL_ESMF_STATE=INTERNAL, _RC) -!BOP + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) + GigaTrajInternalPtr => wrap%ptr -! !IROUTINE: GetInitVars -- GetInitVars method for Gigatraj GridComp to get initial state from AGCM's export + call MAPL_GetResource(MAPL, GigaRstFile, 'GIGATRAJ_INTERNAL_RESTART_FILE:', default="NONE", RC=STATUS ) -! !INTERFACE: + if (trim(GigaRstFile) == 'NONE') then + ! without restart file, get value from import + call init_metsrc_field0(GC, IMPORT, ctime, 'PLE', _RC) + else + call init_metsrc_field0(GC, INTERNAL, ctime, 'PL', _RC) + endif - subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) + init = .true. -! !ARGUMENTS: + RETURN_(ESMF_SUCCESS) + end subroutine GetInitVars + subroutine Init_metsrc_field0 (GC, state, ctime, PL, RC ) type(ESMF_GridComp), intent(inout) :: GC ! Gridded component - type(ESMF_State), intent(inout) :: IMPORT ! Import state - type(ESMF_State), intent(inout) :: EXPORT ! Export state - type(ESMF_Clock), intent(inout) :: CLOCK ! The clock - integer, optional, intent( out) :: RC ! Error code + type(ESMF_State), intent(inout) :: state + character(*), target, intent(in) :: ctime + character(*), intent(in) :: PL + integer, optional, intent(out) :: RC ! Error code -! !DESCRIPTION: - -!EOP + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS - character(len=ESMF_MAXSTR) :: IAm - type (ESMF_VM) :: VM - integer :: STATUS, Comm - logical, save :: first_time_run = .true. - type (GigaTrajInternal), pointer :: GigaTrajInternalPtr + type(GigaTrajInternal), pointer :: GigaInternalPtr type (GigatrajInternalWrap) :: wrap - - real, dimension(:,:,:), pointer :: U, V, W, with_halo, P + real, dimension(:,:,:), pointer :: U, V, W, P, PL0, PLE real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon, P_latlon - real, dimension(:,:,:), allocatable, target :: preU, preV, preW, preP - integer :: counts(3), dims(3) - type(ESMF_Field) :: field - type(ESMF_RouteHandle) :: rh - real, pointer :: lats_center(:), lons_center(:), levs_center(:) - integer :: i1, i2, j1, j2, i,j,k - type (ESMF_TIME) :: CurrentTime - character(len=20), target :: ctime - - if (.not. first_time_run) then - RETURN_(ESMF_SUCCESS) + real, dimension(:,:,:), allocatable, target :: haloU, haloV, haloW, haloP + integer :: counts(3), dims(3), d1,d2,km + + Iam = "init_metsrc_field0" + + call MAPL_GetPointer(state, U, "U", _RC) + call MAPL_GetPointer(state, V, "V", _RC) + call MAPL_GetPointer(state, W, "OMEGA", _RC) + + PL0=>null() + if (PL == 'PL') then + call MAPL_GetPointer(state, P, "PL", _RC) + else if (PL == 'PLE') then + call MAPL_GetPointer(state, PLE, "PLE", _RC) + d1 =size(PLE,1) + d2 =size(PLE,2) + km =size(PLE,3)-1 + allocate(PL0(d1,d2,km)) + PL0 = (PLE(:,:,2:km+1)+PLE(:,:,1:km))*0.5 + ! WJ notes, Since PLE(:,:, km+1) =0, the above avg should be corrected for the last km + PL0(:,:,km) = PLE(:,:,km) + P => PL0 + W = 0.0 endif - call ESMF_VmGetCurrent(VM, _RC) - call ESMF_VMGet(VM, mpiCommunicator=Comm, _RC) - call ESMF_ClockGet(clock, currTime=CurrentTime, _RC) - call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) - ctime(20:20) = c_null_char - call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) - GigaTrajInternalPtr => wrap%ptr - call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) - - call MAPL_GetPointer(Import, U, "U", _RC) - call MAPL_GetPointer(Import, V, "V", _RC) - call MAPL_GetPointer(Import, W, "OMEGA", _RC) - call MAPL_GetPointer(Import, P, "PL", _RC) + GigaInternalPtr => wrap%ptr + call MAPL_GridGet(GigaInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) allocate(U_latlon(counts(1),counts(2),counts(3))) allocate(V_latlon(counts(1),counts(2),counts(3))) allocate(W_latlon(counts(1),counts(2),counts(3))) allocate(P_latlon(counts(1),counts(2),counts(3))) - call GigaTrajInternalPtr%cube2latlon%regrid(U,V, U_latlon, V_latlon, _RC) - call GigaTrajInternalPtr%cube2latlon%regrid(W, W_latlon, _RC) - call GigaTrajInternalPtr%cube2latlon%regrid(P, P_latlon, _RC) - - field = ESMF_FieldCreate(GigaTrajInternalPtr%LatLonGrid, ESMF_TYPEKIND_R4, name='halo_field', & - ungriddedLBound=[1],ungriddedUBound=[counts(3)], & - totalLWidth=[1,1],totalUWidth=[1,1]) + allocate(haloU(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) + allocate(haloV(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) + allocate(haloW(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) + allocate(haloP(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) - call ESMF_FieldHaloStore(field,rh,_RC) + call GigaInternalPtr%cube2latlon%regrid(U, V, U_latlon, V_latlon, _RC) + call GigaInternalPtr%cube2latlon%regrid(W, W_latlon, _RC) + call GigaInternalPtr%cube2latlon%regrid(P, P_latlon, _RC) - call ESMF_FieldGet(field, farrayPtr=with_halo, _RC) - with_halo(2:counts(1)+1, 2:counts(2)+1, :) = U_latlon - call ESMF_FieldHalo(field,rh,_RC) - preU = with_halo + call esmf_halo(GigaInternalPtr%LatLonGrid, U_Latlon, V_latlon, W_latlon, P_latlon, & + haloU, haloV, haloW, haloP, _RC) - with_halo(2:counts(1)+1, 2:counts(2)+1, :) = V_latlon - call ESMF_FieldHalo(field,rh,_RC) - preV = with_halo + call updateFields( GigaInternalPtr%metSrc, c_loc(ctime), c_loc(haloU), c_loc(haloV), c_loc(haloW), c_loc(haloP)) - with_halo(2:counts(1)+1, 2:counts(2)+1, :) = W_latlon - call ESMF_FieldHalo(field,rh,_RC) - preW = with_halo - - with_halo(2:counts(1)+1, 2:counts(2)+1, :) = p_latlon - call ESMF_FieldHalo(field,rh,_RC) - preP = with_halo - - call updateFields( GigaTrajInternalPtr%metSrc, c_loc(ctime), c_loc(preU), c_loc(preV), c_loc(preW), c_loc(preP)) - - call ESMF_FieldDestroy(field) - - first_time_run = .false. - + if(associated(PL0)) deallocate(PL0) RETURN_(ESMF_SUCCESS) - end subroutine GetInitVars + end subroutine init_metsrc_field0 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!BOP - -! !IROUTINE: Run -- Run method for Gigatraj GridComp - -! !INTERFACE: - - subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) - -! !ARGUMENTS: - + subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) type(ESMF_GridComp), intent(inout) :: GC ! Gridded component type(ESMF_State), intent(inout) :: IMPORT ! Import state type(ESMF_State), intent(inout) :: EXPORT ! Export state type(ESMF_Clock), intent(inout) :: CLOCK ! The clock integer, optional, intent( out) :: RC ! Error code -! !DESCRIPTION: - -!EOP - -! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME @@ -460,20 +399,28 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) type (ESMF_VM) :: vm real, dimension(:,:,:), pointer :: U_cube, V_cube, W_cube, p_cube, with_halo + real, dimension(:,:,:), pointer :: U_internal, V_internal, W_internal, P_internal + real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon, P_latlon - real, dimension(:,:,:), allocatable, target :: U_latlon_halo, V_latlon_halo, W_latlon_halo, p_latlon_halo + real, dimension(:,:,:), allocatable, target :: haloU, haloV, haloW, haloP real(ESMF_KIND_R8) :: DT type(ESMF_Field) :: halo_field type(ESMF_RouteHandle) :: rh character(len=20), target :: ctime + type(ESMF_State) :: INTERNAL + type(MAPL_MetaComp),pointer :: MPL + character(len=ESMF_MAXSTR) :: parcels_file call ESMF_VMGetCurrent(vm, _RC) call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) + call MAPL_GetObjectFromGC ( GC, MPL, _RC) + call MAPL_Get (MPL, INTERNAL_ESMF_STATE=INTERNAL, _RC) + call ESMF_ClockGet(clock, currTime=CurrentTime, _RC) call ESMF_ClockGet(clock, timeStep=ModelTimeStep, _RC) @@ -498,10 +445,10 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) allocate(W_latlon(counts(1), counts(2),counts(3)), source = 0.0) allocate(P_latlon(counts(1), counts(2),counts(3)), source = 0.0) - allocate(U_latlon_halo(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) - allocate(V_latlon_halo(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) - allocate(W_latlon_halo(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) - allocate(P_latlon_halo(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) + allocate(haloU(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) + allocate(haloV(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) + allocate(haloW(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) + allocate(haloP(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) !--------------- ! Step 1) Regrid the metData field from cubed to lat-lon @@ -512,73 +459,566 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(Import, W_cube, "OMEGA", _RC) call MAPL_GetPointer(Import, P_cube, "PL", _RC) - call GigaTrajInternalPtr%cube2latlon%regrid(U_cube, U_latlon, _RC) - call GigaTrajInternalPtr%cube2latlon%regrid(V_cube, V_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(U_cube,V_cube, U_latlon, V_latlon, _RC) call GigaTrajInternalPtr%cube2latlon%regrid(W_cube, W_latlon, _RC) call GigaTrajInternalPtr%cube2latlon%regrid(P_cube, P_latlon, _RC) !--------------- -! Step 2) Get halo of latlon metData field -! After this step, the local field has distributed horizonal + halo +! Step 2) Get halo +!--------------- + call esmf_halo(GigaTrajInternalPtr%LatLonGrid, U_Latlon, V_latlon, W_latlon, P_latlon, & + haloU, haloV, haloW, haloP, _RC) + +!--------------- +! Step 3) Update !--------------- + call updateFields( GigaTrajInternalPtr%metSrc, c_loc(ctime), c_loc(haloU), c_loc(haloV), c_loc(haloW), c_loc(haloP)) + +!--------------- +! Step 3) Time advance +!--------------- + call rk4a_advance( GigaTrajInternalPtr%metSrc, c_loc(ctime), DT, GigaTrajInternalPtr%parcels%num_parcels, & + c_loc(GigaTrajInternalPtr%parcels%lons), & + c_loc(GigaTrajInternalPtr%parcels%lats), & + c_loc(GigaTrajInternalPtr%parcels%zs)) + +!--------------- +! Step 4) Update internal +!--------------- + call MAPL_GetPointer(INTERNAL, U_internal, "U", _RC) + call MAPL_GetPointer(INTERNAL, V_internal, "V", _RC) + call MAPL_GetPointer(INTERNAL, W_internal, "OMEGA", _RC) + call MAPL_GetPointer(INTERNAL, P_internal, "PL", _RC) + + U_internal = U_cube + V_internal = V_cube + W_internal = W_cube + P_internal = P_cube + + deallocate( U_Latlon, V_latlon, W_latlon, P_latlon, haloU, haloV, haloW, haloP) - halo_field = ESMF_FieldCreate(GigaTrajInternalPtr%LatLonGrid, ESMF_TYPEKIND_R4, name='halo_field', & - ungriddedLBound=[1],ungriddedUBound=[counts(3)], & - totalLWidth=[1,1],totalUWidth=[1,1]) - call ESMF_FieldHaloStore(halo_field, rh, _RC) +!--------------- +! Step 5) rebalance parcels among processors ( configurable with alarm) +!--------------- + call rebalance_parcels(clock, GigaTrajInternalPtr%parcels, GigaTrajInternalPtr%CellToRank, comm, DIMS, _RC) - call ESMF_FieldGet(halo_field, farrayPtr=with_halo, _RC) +!--------------- +! Step 6) write out parcel positions ( configurable with alarm) +!--------------- + call MAPL_GetResource(MPL, parcels_file, "GIGATRAJ_PARCELS_FILE:", default='parcels.nc4', _RC) + call write_parcels(clock, parcels_file, GigaTrajInternalPtr%parcels,currentTime, GigaTrajInternalPtr%startTime, _RC) + + + RETURN_(ESMF_SUCCESS) + + end subroutine Run + + subroutine mapl_halo(grid, U, V, W, P, haloU, haloV, haloW, haloP, rc) + type(ESMF_Grid), intent(in) :: grid + real, dimension(:,:,:), intent(in) :: U, V, W, P + real, dimension(:,:,:), intent(inout) :: haloU, haloV, haloW, haloP + integer, optional, intent( out) :: RC + + character(len=ESMF_MAXSTR) :: IAm + integer :: counts(3), dims(3), k + integer :: status + class(AbstractGridFactory), pointer :: factory + + Iam = "Gigatraj Halo" + call MAPL_GridGet(grid, localCellCountPerDim=counts, & + globalCellCountPerDim=DIMS, _RC) + + haloU(2:counts(1)+1, 2:counts(2)+1, :) = U + haloV(2:counts(1)+1, 2:counts(2)+1, :) = V + haloW(2:counts(1)+1, 2:counts(2)+1, :) = W + haloP(2:counts(1)+1, 2:counts(2)+1, :) = P + + factory =>grid_manager%get_factory(grid) + do k =1, counts(3) + call factory%halo(haloU(:,:,k), halo_width=1, _RC) + call factory%halo(haloV(:,:,k), halo_width=1, _RC) + call factory%halo(haloW(:,:,k), halo_width=1, _RC) + call factory%halo(haloP(:,:,k), halo_width=1, _RC) + enddo + + RETURN_(ESMF_SUCCESS) + end subroutine + + subroutine esmf_halo(grid, U, V, W, P, haloU, haloV, haloW, haloP, rc) + type(ESMF_Grid), intent(in) :: grid + real, dimension(:,:,:), intent(in) :: U, V, W, P + real, dimension(:,:,:), intent(inout) :: haloU, haloV, haloW, haloP + integer, optional, intent( out) :: RC + + character(len=ESMF_MAXSTR) :: IAm + integer :: counts(3), dims(3), k + integer :: status + type(ESMF_Field) :: halo_field + type(ESMF_RouteHandle) :: rh + real, dimension(:,:,:), pointer :: with_halo + + Iam = "Gigatraj ESMF Halo" + call MAPL_GridGet(grid, localCellCountPerDim=counts, & + globalCellCountPerDim=DIMS, _RC) - ! get U + halo - with_halo(2:counts(1)+1, 2:counts(2)+1, :) = U_latlon - call ESMF_FieldHalo(halo_field, rh, _RC) - U_latlon_halo = with_halo + halo_field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R4, name='halo_field', & + ungriddedLBound=[1],ungriddedUBound=[counts(3)], & + totalLWidth=[1,1],totalUWidth=[1,1]) + call ESMF_FieldHaloStore(halo_field, rh, _RC) + + call ESMF_FieldGet(halo_field, farrayPtr=with_halo, _RC) + ! + ! W.Y note, the pointer with_halo's lbound is 0 + ! + ! get U + halo + with_halo(1:counts(1), 1:counts(2), :) = U + call ESMF_FieldHalo(halo_field, rh, _RC) + haloU = with_halo - ! get V + halo - with_halo(2:counts(1)+1, 2:counts(2)+1, :) = V_latlon - call ESMF_FieldHalo(halo_field, rh, _RC) - V_latlon_halo = with_halo + ! get V + halo + with_halo(1:counts(1), 1:counts(2), :) = V + call ESMF_FieldHalo(halo_field, rh, _RC) + haloV = with_halo - ! get W + halo - with_halo(2:counts(1)+1, 2:counts(2)+1, :) = W_latlon - call ESMF_FieldHalo(halo_field, rh, _RC) - W_latlon_halo = with_halo + ! get W + halo + with_halo(1:counts(1), 1:counts(2), :) = W + call ESMF_FieldHalo(halo_field, rh, _RC) + haloW = with_halo ! get W + halo - with_halo(2:counts(1)+1, 2:counts(2)+1, :) = P_latlon - call ESMF_FieldHalo(halo_field, rh, _RC) - P_latlon_halo = with_halo + with_halo(1:counts(1), 1:counts(2), :) = P + call ESMF_FieldHalo(halo_field, rh, _RC) + haloP = with_halo - call updateFields( GigaTrajInternalPtr%metSrc, c_loc(ctime),c_loc(U_latlon_halo), & - c_loc(V_latlon_halo), c_loc(W_latlon_halo), c_loc(P_latlon_halo)) + call ESMF_FieldDestroy( halo_field) + RETURN_(ESMF_SUCCESS) + end subroutine - num_parcels = GigaTrajInternalPtr%parcels%num_parcels + ! move the parcels to the PE where they belong to + subroutine rebalance_parcels(clock, parcels, CellToRank, comm, DIMS, rc) + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + type(horde), intent(inout) :: parcels + integer, dimension(:,:), intent(in) :: CellToRank + integer :: comm, DIMS(3) + integer, optional, intent(out) :: rc - !lons = GigaTrajInternalPtr%parcels%lons - !lats = GigaTrajInternalPtr%parcels%lats - !zs = GigaTrajInternalPtr%parcels%zs + integer :: status + character(len=:), allocatable :: Iam + integer :: num_parcels0, num_parcels + real, dimension(:), allocatable :: lons0, lats0, zs0 + integer, dimension(:), allocatable :: IDs0 - !call test_dataflow(num_parcels, lons, lats, zs, GigaTrajInternalPtr%CellToRank, DIMS, comm) + integer :: i, npes, ierror, rank, my_rank, pos + real :: dlon, dlat - !allocate(U(num_parcels)) - !allocate(V(num_parcels)) - !allocate(W(num_parcels)) + real, allocatable :: lons_send(:), lats_send(:), zs_send(:) + integer, allocatable :: ids_send(:) + type(ESMF_Alarm) :: GigaTrajRebalanceAlarm + integer, allocatable :: counts_send(:),counts_recv(:), II(:), JJ(:), ranks(:) + integer, allocatable :: disp_send(:), disp_recv(:), tmp_position(:) - !call test_metData( GigaTrajInternalPtr%metSrc, 0.01d0, num_parcels, c_loc(lons), c_loc(lats), c_loc(zs), c_loc(U), c_loc(V), c_loc(W)) + Iam = "rebalance_parcels" - call rk4a_advance( GigaTrajInternalPtr%metSrc, c_loc(ctime), DT, num_parcels, & - c_loc(GigaTrajInternalPtr%parcels%lons), & - c_loc(GigaTrajInternalPtr%parcels%lats), & - c_loc(GigaTrajInternalPtr%parcels%zs)) - + call ESMF_ClockGetAlarm(clock, 'GigatrajRebalance', GigaTrajRebalanceAlarm, _RC) + + if ( .not. ESMF_AlarmIsRinging(GigaTrajRebalanceAlarm)) then + RETURN_(ESMF_SUCCESS) + endif + + call move_alloc( parcels%lons, lons0) + call move_alloc( parcels%lats, lats0) + call move_alloc( parcels%zs, zs0) + call move_alloc( parcels%IDs, IDs0) + num_parcels0 = parcels%num_parcels + where (lons0 < 0) lons0 =lons0 + 360.0 + where (lons0 >360) lons0 =lons0 - 360.0 + + dlon = 360.0 / DIMS(1) + dlat = 180.0 / DIMS(2) + + II = min( max(ceiling (lons0 /dlon),1), DIMS(1)) + JJ = min( max(ceiling ((lats0 + 90.0)/dlat),1), DIMS(2)) + + call MPI_Comm_size(comm, npes, ierror) + call MPI_Comm_rank(comm, my_rank, ierror) + + allocate(ranks (num_parcels0)) + allocate(lons_send(num_parcels0)) + allocate(lats_send(num_parcels0)) + allocate(zs_send (num_parcels0)) + allocate(IDs_send (num_parcels0)) + + allocate(counts_send(npes)) + allocate(counts_recv(npes)) + allocate(disp_send(npes)) + allocate(disp_recv(npes)) + + do i = 1, num_parcels0 + ranks(i) = CellToRank(II(i), JJ(i)) + enddo + + do rank = 0, npes-1 + counts_send(rank+1) = count(ranks == rank) + enddo + + call MPI_AllToALL(counts_send, 1, MPI_INTEGER, counts_recv, 1, MPI_INTEGER, comm, ierror) + + disp_send = 0 + do rank = 1, npes-1 + disp_send(rank+1) = disp_send(rank)+ counts_send(rank) + enddo + disp_recv = 0 + do rank = 1, npes-1 + disp_recv(rank+1) = disp_recv(rank)+ counts_recv(rank) + enddo + + ! re-arranged lats lons, and ids + tmp_position = disp_send + parcels%num_parcels = sum(counts_recv) + num_parcels = parcels%num_parcels + allocate(parcels%lons(num_parcels )) + allocate(parcels%lats(num_parcels )) + allocate(parcels%zs (num_parcels )) + allocate(parcels%IDs (num_parcels )) + + do i = 1, num_parcels0 + rank = ranks(i) + pos = tmp_position(rank+1) +1 + lons_send(pos) = lons0(i) + lats_send(pos) = lats0(i) + zs_send(pos) = zs0(i) + IDs_send(pos) = IDs0(i) + tmp_position(rank+1) = tmp_position(rank+1) + 1 + enddo + + call MPI_AllToALLv(lons_send, counts_send, disp_send, MPI_REAL, parcels%lons, counts_recv, disp_recv, MPI_REAL, comm, ierror) + call MPI_AllToALLv(lats_send, counts_send, disp_send, MPI_REAL, parcels%lats, counts_recv, disp_recv, MPI_REAL, comm, ierror) + call MPI_AllToALLv(zs_send, counts_send, disp_send, MPI_REAL, parcels%zs, counts_recv, disp_recv, MPI_REAL, comm, ierror) + call MPI_AllToALLv(ids_send, counts_send, disp_send, MPI_INTEGER, parcels%IDs, counts_recv, disp_recv, MPI_INTEGER, comm, ierror) + + RETURN_(ESMF_SUCCESS) + end subroutine rebalance_parcels + + ! Scatter parcels from root after reading parcels file + subroutine scatter_parcels(num_parcels0, lons0, lats0, zs0, IDs0, CellToRank, DIMS, comm, lons, lats, zs, IDs, num_parcels) + integer :: num_parcels0 + real, dimension(:), intent(inout) :: lons0 + real, dimension(:), intent(in) :: lats0, zs0 + integer, dimension(:), intent(in) :: IDs0 + integer, dimension(:,:), intent(in) :: CellToRank + integer :: comm, DIMS(3) + real, dimension(:), allocatable, intent(out) :: lons, lats, zs + integer, dimension(:), allocatable, intent(out) :: IDs + integer, intent(out) :: num_parcels + + integer :: i, npes, ierror, rank, my_rank, counts_recv, pos + real :: dlon, dlat + + real, allocatable :: lons_send(:), lats_send(:), zs_send(:) + integer, allocatable :: ids_send(:) + + integer, allocatable :: counts_send(:), II(:), JJ(:), ranks(:) + integer, allocatable :: disp_send(:), tmp_position(:) + + call MPI_Comm_size(comm, npes, ierror) + call MPI_Comm_rank(comm, my_rank, ierror) + + allocate(counts_send(npes), source = 0) + allocate(disp_send(npes), source = 0) + if (my_rank == 0) then + dlon = 360.0 / DIMS(1) + dlat = 180.0 / DIMS(2) + + where (lons0 < 0) lons0 =lons0 + 360.0 + II = min( max(ceiling (lons0 /dlon),1), DIMS(1)) + JJ = min( max(ceiling ((lats0 + 90.0)/dlat),1), DIMS(2)) + + allocate(ranks(num_parcels0)) + do i = 1, num_parcels0 + ranks(i) = CellToRank(II(i), JJ(i)) + enddo + + do rank = 0, npes-1 + counts_send(rank+1) = count(ranks == rank) + enddo + + do rank = 1, npes-1 + disp_send(rank+1) = disp_send(rank)+ counts_send(rank) + enddo + endif + + call MPI_Scatter(counts_send, 1, MPI_INTEGER, counts_recv, 1, MPI_INTEGER, 0, comm, ierror) + + ! re-arranged lats lons, and ids + tmp_position = disp_send + num_parcels = counts_recv + + allocate(lons_send(num_parcels0)) + allocate(lons (num_parcels )) + allocate(lats_send(num_parcels0)) + allocate(lats (num_parcels )) + allocate(zs_send (num_parcels0)) + allocate(zs (num_parcels )) + allocate(IDs_send (num_parcels0)) + allocate(IDs (num_parcels )) + + do i = 1, num_parcels0 + rank = ranks(i) + pos = tmp_position(rank+1) +1 + lons_send(pos) = lons0(i) + lats_send(pos) = lats0(i) + zs_send(pos) = zs0(i) + IDs_send(pos) = IDs0(i) + tmp_position(rank+1) = tmp_position(rank+1) + 1 + enddo + + call MPI_ScatterV(lons_send, counts_send, disp_send, MPI_REAL, lons, counts_recv, MPI_REAL, 0, comm, ierror) + call MPI_ScatterV(lats_send, counts_send, disp_send, MPI_REAL, lats, counts_recv, MPI_REAL, 0, comm, ierror) + call MPI_ScatterV(zs_send, counts_send, disp_send, MPI_REAL, zs, counts_recv, MPI_REAL, 0, comm, ierror) + call MPI_ScatterV(ids_send, counts_send, disp_send, MPI_INTEGER, IDs, counts_recv, MPI_INTEGER,0, comm, ierror) + + end subroutine scatter_parcels + + ! gather parcels to root for writing + subroutine gather_parcels(num_parcels0, lons0, lats0, zs0, IDs0, comm, lons, lats, zs, IDs, num_parcels) + integer, intent(out) :: num_parcels0 + real, dimension(:), allocatable, intent(out) :: lons0, lats0,zs0 + integer, dimension(:), allocatable, intent(out) :: IDs0 + integer, intent(in) :: comm + real, dimension(:), intent(in) :: lons, lats, zs + integer, dimension(:), intent(in) :: IDs + integer, intent(in) :: num_parcels + + integer :: i, npes, ierror, my_rank + integer, allocatable :: nums_all(:), displ(:) + + call MPI_Comm_size(comm, npes, ierror) + call MPI_Comm_rank(comm, my_rank, ierror) + + allocate(nums_all(npes), source = 0) + call MPI_Gather(num_parcels, 1, MPI_INTEGER, nums_all, 1, MPI_INTEGER, 0, comm, ierror) + + num_parcels0 = sum(nums_all) + + allocate(lons0(num_parcels0)) + allocate(lats0(num_parcels0)) + allocate( zs0(num_parcels0)) + allocate( IDS0(num_parcels0)) + allocate( displ(npes), source =0) + do i =2, npes + displ(i) = displ(i-1)+nums_all(i-1) + enddo + + call MPI_GatherV(lons, num_parcels, MPI_REAL, lons0, nums_all, displ, MPI_REAL, 0, comm,ierror) + call MPI_GatherV(lats, num_parcels, MPI_REAL, lats0, nums_all, displ, MPI_REAL, 0, comm,ierror) + call MPI_GatherV(zs, num_parcels, MPI_REAL, zs0, nums_all, displ, MPI_REAL, 0, comm,ierror) + call MPI_GatherV(IDS, num_parcels, MPI_INTEGER, IDs0,nums_all, displ, MPI_INTEGER, 0, comm,ierror) + + end subroutine gather_parcels + + subroutine write_parcels(CLOCK, fname, parcels, currentTime, startTime, rc) + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + character(*), intent(in):: fname + type(horde), intent(in) :: parcels + type(ESMF_TIME), intent(in) :: currentTime + type(ESMF_TIME), intent(in) :: startTime + integer, optional, intent(out) :: rc - call ESMF_FieldDestroy( halo_field) + character(len=:), allocatable :: Iam + type (ESMF_VM) :: vm + type(Netcdf4_fileformatter) :: formatter + integer :: comm, my_rank, total_num, status, last_time, ierror + real, allocatable :: lats0(:), lons0(:), zs0(:), ids0_r(:) + integer, allocatable :: ids0(:) + type(ESMF_Alarm) :: GigaTrajOutAlarm + type(FileMetadata) :: meta + real(ESMF_KIND_R8) :: tint_m + type(ESMF_TimeInterval) :: tint + + call ESMF_ClockGetAlarm(clock, 'GigatrajOut', GigaTrajOutAlarm, _RC) + + if ( .not. ESMF_AlarmIsRinging(GigaTrajOutAlarm)) then + RETURN_(ESMF_SUCCESS) + endif - if (MAPL_AM_I_ROOT()) print*," Great, the end of the GigaTraj_GridCompMod run" + call ESMF_VMGetCurrent(vm, _RC) + call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) - RETURN_(ESMF_SUCCESS) + call gather_parcels(total_num, lons0, lats0, zs0, IDs0, & + comm, & + parcels%lons, & + parcels%lats, & + parcels%zs, & + parcels%IDS, & + parcels%num_parcels ) - end subroutine Run + call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) + if (my_rank ==0) then + ids0_r = real(ids0) + call formatter%open(fname, pFIO_WRITE, _RC) + meta = formatter%read(_RC) + last_time = meta%get_dimension('time', _RC) + tint = CurrentTime - startTime + call ESMF_TimeIntervalGet(tint,m_r8=tint_m,rc=status) + call formatter%put_var('lats', lats0, start=[1, last_time+1], _RC) + call formatter%put_var('lons', lons0, start=[1, last_time+1], _RC) + call formatter%put_var('zs', zs0, start=[1, last_time+1], _RC) + call formatter%put_var('ids', ids0_r, start=[1, last_time+1], _RC) + call formatter%put_var('time', [tint_m], start=[last_time+1], _RC) + call formatter%close(_RC) + endif + + RETURN_(ESMF_SUCCESS) + end subroutine write_parcels + + subroutine read_parcels(fname, internal, rc) + character(*), intent(in) :: fname + type(GigaTrajInternal), intent(inout) :: internal + integer, optional, intent(out) :: rc + + type(Netcdf4_fileformatter) :: formatter + type(FileMetadata) :: meta + integer :: comm, my_rank, total_num, ierror, last_time, DIMS(3) + real, allocatable :: lats(:), lons(:), zs(:), lats0(:), lons0(:), zs0(:), ids0_r(:) + integer, allocatable :: ids0(:) + integer :: status + type (ESMF_VM) :: vm + class(Variable), pointer :: v + type(Attribute), pointer :: attr + class(*), pointer :: units + character(len=ESMF_MAXSTR) :: Iam ="read_parcels" + + call ESMF_VMGetCurrent(vm, _RC) + call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) + + call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) + + total_num = 0 + if (my_rank ==0) then + call formatter%open(fname, pFIO_READ, _RC) + meta = formatter%read(_RC) + total_num = meta%get_dimension('id', _RC) + last_time = meta%get_dimension('time', _RC) + v => meta%get_variable('time', _RC) + attr => v%get_attribute('units') + units => attr%get_value() + select type(units) + type is (character(*)) + internal%startTime = parse_time_string(units, _RC) + class default + _FAIL('unsupported subclass for units') + end select + endif + + allocate(lats0(total_num), lons0(total_num), zs0(total_num), ids0_r(total_num)) + + if (my_rank ==0) then + call formatter%get_var('lats', lats0, start = [1,last_time], _RC) + call formatter%get_var('lons', lons0, start = [1,last_time], _RC) + call formatter%get_var('zs', zs0, start = [1,last_time], _RC) + call formatter%get_var('ids', ids0_r,start = [1,last_time], _RC) + call formatter%close(_RC) + ids0 = int(ids0_r) + endif + call MAPL_GridGet(internal%LatLonGrid, globalCellCountPerDim=DIMS, _RC) + call scatter_parcels(total_num, lons0, lats0, zs0, IDs0, internal%CellToRank, DIMS, comm, & + Internal%parcels%lons, & + Internal%parcels%lats, & + Internal%parcels%zs, & + Internal%parcels%IDS, & + Internal%parcels%num_parcels) + + deallocate(lats0, lons0, zs0, ids0_r) + RETURN_(ESMF_SUCCESS) + contains + ! a copy from MAPL_TimeMod + function parse_time_string(timeUnits,rc) result(time) + character(len=*), intent(inout) :: timeUnits + integer, optional, intent(out) :: rc + + type(ESMF_Time) :: time + integer :: status + + integer year ! 4-digit year + integer month ! month + integer day ! day + integer hour ! hour + integer min ! minute + integer sec ! second + + integer ypos(2), mpos(2), dpos(2), hpos(2), spos(2) + integer strlen + integer firstdash, lastdash + integer firstcolon, lastcolon + integer lastspace + strlen = LEN_TRIM (TimeUnits) + + firstdash = index(TimeUnits, '-') + lastdash = index(TimeUnits, '-', BACK=.TRUE.) + if (firstdash .LE. 0 .OR. lastdash .LE. 0) then + _FAIL('time string is not a valid format') + 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 ( TimeUnits(ypos(1):ypos(2)), * ) year + read ( TimeUnits(mpos(1):mpos(2)), * ) month + read ( TimeUnits(dpos(1):dpos(2)), * ) day + + firstcolon = index(TimeUnits, ':') + 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 (TimeUnits(strlen:strlen) /= char(0)) then + TimeUnits = trim(TimeUnits)//char(0) + strlen=len_trim(TimeUnits) + endif + lastspace = index(TRIM(TimeUnits), ' ', BACK=.TRUE.) + if ((strlen-lastspace).eq.2 .or. (strlen-lastspace).eq.3) then + hpos(1) = lastspace+1 + hpos(2) = strlen-1 + read (TimeUnits(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(TimeUnits, ':', BACK=.TRUE.) + if ( lastcolon .EQ. firstcolon ) then + mpos(1) = firstcolon + 1 + mpos(2) = firstcolon + 2 + read (TimeUnits(hpos(1):hpos(2)), * ) hour + read (TimeUnits(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 (TimeUnits(hpos(1):hpos(2)), * ) hour + read (TimeUnits(mpos(1):mpos(2)), * ) min + read (TimeUnits(spos(1):spos(2)), * ) sec + endif + endif + + call ESMF_TimeSet(time,yy=year,mm=month,dd=day,h=hour,m=min,s=sec,rc=status) + _VERIFY(status) + RETURN_(ESMF_SUCCESS) + end function parse_time_string + end subroutine read_parcels end module GigaTraj_GridCompMod From b79dacbd4fcdc95751444a78d5aee0f5386f60ab Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 25 Jan 2023 09:52:18 -0500 Subject: [PATCH 14/73] bug fix. PLE's lower bound on edge is 0 --- GigaTraj_GridComp/GigaTraj_GridComp.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 index a6048aa34..3ed3fff2a 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -332,9 +332,8 @@ subroutine Init_metsrc_field0 (GC, state, ctime, PL, RC ) d2 =size(PLE,2) km =size(PLE,3)-1 allocate(PL0(d1,d2,km)) - PL0 = (PLE(:,:,2:km+1)+PLE(:,:,1:km))*0.5 - ! WJ notes, Since PLE(:,:, km+1) =0, the above avg should be corrected for the last km - PL0(:,:,km) = PLE(:,:,km) + ! WJ notes, PLE's lower bound is (1,1,0) + PL0 = (PLE(:,:,1:km)+PLE(:,:,0:km-1))*0.5 P => PL0 W = 0.0 endif From d44a59e433639b83d5e48eace49bb2513201d558 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 31 Jan 2023 12:41:45 -0500 Subject: [PATCH 15/73] comply with position nc4 format --- GigaTraj_GridComp/GigaTraj_GridComp.F90 | 32 ++++++++++++++----------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 index 3ed3fff2a..09b02d93e 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -832,7 +832,7 @@ subroutine write_parcels(CLOCK, fname, parcels, currentTime, startTime, rc) integer, allocatable :: ids0(:) type(ESMF_Alarm) :: GigaTrajOutAlarm type(FileMetadata) :: meta - real(ESMF_KIND_R8) :: tint_m + real(ESMF_KIND_R8) :: tint_d type(ESMF_TimeInterval) :: tint call ESMF_ClockGetAlarm(clock, 'GigatrajOut', GigaTrajOutAlarm, _RC) @@ -854,17 +854,20 @@ subroutine write_parcels(CLOCK, fname, parcels, currentTime, startTime, rc) call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) if (my_rank ==0) then - ids0_r = real(ids0) + ! reorder + lats0 = lats0(ids0(:)+1) ! id is zero-bases, plus 1 Fortran + lons0 = lons0(ids0(:)+1) + zs0 = zs0(ids0(:)+1) call formatter%open(fname, pFIO_WRITE, _RC) meta = formatter%read(_RC) last_time = meta%get_dimension('time', _RC) tint = CurrentTime - startTime - call ESMF_TimeIntervalGet(tint,m_r8=tint_m,rc=status) - call formatter%put_var('lats', lats0, start=[1, last_time+1], _RC) - call formatter%put_var('lons', lons0, start=[1, last_time+1], _RC) - call formatter%put_var('zs', zs0, start=[1, last_time+1], _RC) - call formatter%put_var('ids', ids0_r, start=[1, last_time+1], _RC) - call formatter%put_var('time', [tint_m], start=[last_time+1], _RC) + call ESMF_TimeIntervalGet(tint,d_r8=tint_d,rc=status) + + call formatter%put_var('lat', lats0, start=[1, last_time+1], _RC) + call formatter%put_var('lon', lons0, start=[1, last_time+1], _RC) + call formatter%put_var('pressure', zs0, start=[1, last_time+1], _RC) + call formatter%put_var('time', [tint_d], start=[last_time+1], _RC) call formatter%close(_RC) endif @@ -879,7 +882,8 @@ subroutine read_parcels(fname, internal, rc) type(Netcdf4_fileformatter) :: formatter type(FileMetadata) :: meta integer :: comm, my_rank, total_num, ierror, last_time, DIMS(3) - real, allocatable :: lats(:), lons(:), zs(:), lats0(:), lons0(:), zs0(:), ids0_r(:) + real, allocatable :: lats(:), lons(:), zs(:), lats0(:), lons0(:), zs0(:) + real(kind=ESMF_KIND_R8), allocatable :: ids0_r(:) integer, allocatable :: ids0(:) integer :: status type (ESMF_VM) :: vm @@ -900,7 +904,7 @@ subroutine read_parcels(fname, internal, rc) total_num = meta%get_dimension('id', _RC) last_time = meta%get_dimension('time', _RC) v => meta%get_variable('time', _RC) - attr => v%get_attribute('units') + attr => v%get_attribute('long_name') units => attr%get_value() select type(units) type is (character(*)) @@ -913,10 +917,10 @@ subroutine read_parcels(fname, internal, rc) allocate(lats0(total_num), lons0(total_num), zs0(total_num), ids0_r(total_num)) if (my_rank ==0) then - call formatter%get_var('lats', lats0, start = [1,last_time], _RC) - call formatter%get_var('lons', lons0, start = [1,last_time], _RC) - call formatter%get_var('zs', zs0, start = [1,last_time], _RC) - call formatter%get_var('ids', ids0_r,start = [1,last_time], _RC) + call formatter%get_var('lat', lats0, start = [1,last_time], _RC) + call formatter%get_var('lon', lons0, start = [1,last_time], _RC) + call formatter%get_var('pressure', zs0, start = [1,last_time], _RC) + call formatter%get_var('id', ids0_r,start = [1,last_time], _RC) call formatter%close(_RC) ids0 = int(ids0_r) endif From 8c0087846d210427c7c75371cbc6a1497b1fe451 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Sun, 5 Feb 2023 11:08:42 -0500 Subject: [PATCH 16/73] change esmf_halo and add 'TH" export --- GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 | 5 +++ GigaTraj_GridComp/GigaTraj_GridComp.F90 | 44 ++++++++++--------------- 2 files changed, 22 insertions(+), 27 deletions(-) diff --git a/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 b/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 index a7b1bc7df..c597df0c7 100644 --- a/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 +++ b/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 @@ -735,6 +735,11 @@ subroutine SetServices ( GC, RC ) CHILD_ID = SDYN, & RC = STATUS) VERIFY_(STATUS) + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'TH', & + CHILD_ID = SDYN, & + RC = STATUS) + VERIFY_(STATUS) #endif call MAPL_AddExportSpec( GC, & diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 index 09b02d93e..73dbb5703 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -356,8 +356,10 @@ subroutine Init_metsrc_field0 (GC, state, ctime, PL, RC ) call GigaInternalPtr%cube2latlon%regrid(W, W_latlon, _RC) call GigaInternalPtr%cube2latlon%regrid(P, P_latlon, _RC) - call esmf_halo(GigaInternalPtr%LatLonGrid, U_Latlon, V_latlon, W_latlon, P_latlon, & - haloU, haloV, haloW, haloP, _RC) + call esmf_halo(GigaInternalPtr%LatLonGrid, U_Latlon, haloU, _RC) + call esmf_halo(GigaInternalPtr%LatLonGrid, V_Latlon, haloV, _RC) + call esmf_halo(GigaInternalPtr%LatLonGrid, W_Latlon, haloW, _RC) + call esmf_halo(GigaInternalPtr%LatLonGrid, P_Latlon, haloP, _RC) call updateFields( GigaInternalPtr%metSrc, c_loc(ctime), c_loc(haloU), c_loc(haloV), c_loc(haloW), c_loc(haloP)) @@ -465,8 +467,12 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) !--------------- ! Step 2) Get halo !--------------- - call esmf_halo(GigaTrajInternalPtr%LatLonGrid, U_Latlon, V_latlon, W_latlon, P_latlon, & - haloU, haloV, haloW, haloP, _RC) + + call esmf_halo(GigaTrajInternalPtr%LatLonGrid, U_Latlon, haloU, _RC) + call esmf_halo(GigaTrajInternalPtr%LatLonGrid, V_Latlon, haloV, _RC) + call esmf_halo(GigaTrajInternalPtr%LatLonGrid, W_Latlon, haloW, _RC) + call esmf_halo(GigaTrajInternalPtr%LatLonGrid, P_Latlon, haloP, _RC) + !--------------- ! Step 3) Update @@ -543,10 +549,10 @@ subroutine mapl_halo(grid, U, V, W, P, haloU, haloV, haloW, haloP, rc) RETURN_(ESMF_SUCCESS) end subroutine - subroutine esmf_halo(grid, U, V, W, P, haloU, haloV, haloW, haloP, rc) + subroutine esmf_halo(grid, Field,haloField, rc) type(ESMF_Grid), intent(in) :: grid - real, dimension(:,:,:), intent(in) :: U, V, W, P - real, dimension(:,:,:), intent(inout) :: haloU, haloV, haloW, haloP + real, dimension(:,:,:), intent(in) :: Field + real, dimension(:,:,:), intent(inout) :: haloField integer, optional, intent( out) :: RC character(len=ESMF_MAXSTR) :: IAm @@ -555,7 +561,7 @@ subroutine esmf_halo(grid, U, V, W, P, haloU, haloV, haloW, haloP, rc) type(ESMF_Field) :: halo_field type(ESMF_RouteHandle) :: rh real, dimension(:,:,:), pointer :: with_halo - + Iam = "Gigatraj ESMF Halo" call MAPL_GridGet(grid, localCellCountPerDim=counts, & globalCellCountPerDim=DIMS, _RC) @@ -569,30 +575,14 @@ subroutine esmf_halo(grid, U, V, W, P, haloU, haloV, haloW, haloP, rc) ! ! W.Y note, the pointer with_halo's lbound is 0 ! - ! get U + halo - with_halo(1:counts(1), 1:counts(2), :) = U + with_halo(1:counts(1), 1:counts(2), :) = Field call ESMF_FieldHalo(halo_field, rh, _RC) - haloU = with_halo - - ! get V + halo - with_halo(1:counts(1), 1:counts(2), :) = V - call ESMF_FieldHalo(halo_field, rh, _RC) - haloV = with_halo - - ! get W + halo - with_halo(1:counts(1), 1:counts(2), :) = W - call ESMF_FieldHalo(halo_field, rh, _RC) - haloW = with_halo - - ! get W + halo - with_halo(1:counts(1), 1:counts(2), :) = P - call ESMF_FieldHalo(halo_field, rh, _RC) - haloP = with_halo + haloField = with_halo call ESMF_FieldDestroy( halo_field) RETURN_(ESMF_SUCCESS) - end subroutine + end subroutine esmf_halo ! move the parcels to the PE where they belong to subroutine rebalance_parcels(clock, parcels, CellToRank, comm, DIMS, rc) From 26aa97952735063409df90c5f28c95b917440a12 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 6 Feb 2023 08:38:32 -0500 Subject: [PATCH 17/73] add get_metsrc_data ( setData and getData) --- GigaTraj_GridComp/GEOS_Giga_InterOp.F90 | 13 +++++++ GigaTraj_GridComp/GigaTraj_GridComp.F90 | 45 +++++++++++++++++++++++++ 2 files changed, 58 insertions(+) diff --git a/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 b/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 index 9b4f4e26e..0668f0168 100644 --- a/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 +++ b/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 @@ -9,6 +9,8 @@ module GEOS_Giga_InterOpMod public :: initMetGEOSDistributedData public :: updateFields public :: rk4a_advance + public :: setData + public :: getData public :: test_Field3D public :: test_dataflow @@ -60,6 +62,17 @@ subroutine test_metData(obj_ptr, time, n, lons_ptr, lats_ptr, levs_ptr, u_ptr, v integer(c_int), intent(in), value :: n type(c_ptr), intent(in), value :: lons_ptr, lats_ptr, levs_ptr, u_ptr, v_ptr, w_ptr end subroutine + + subroutine setData ( metSrc_ptr, ctime, quantity_ptr, data_ptr) bind(C, name="setData") + import :: c_ptr + type(c_ptr), intent(in), value :: metSrc_ptr, ctime, quantity_ptr, data_ptr + end subroutine setData + + subroutine getData ( metSrc_ptr, ctime, quantity_ptr, n, lons_ptr, lats_ptr, levs_ptr, values_ptr) bind(C, name="getData") + import :: c_ptr, c_int + integer(c_int), intent(in), value :: n + type(c_ptr), intent(in), value :: metSrc_ptr, ctime, quantity_ptr, lons_ptr, lats_ptr, levs_ptr, values_ptr + end subroutine getData end interface diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 index 73dbb5703..5c9b18a26 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -1014,4 +1014,49 @@ function parse_time_string(timeUnits,rc) result(time) end function parse_time_string end subroutine read_parcels + subroutine get_metsrc_data (GC, state, ctime, fieldname, values, RC ) + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_State), intent(inout) :: state + character(*), target, intent(in) :: ctime + character(*), target, intent(in) :: fieldname + real, target, intent(inout) :: values(:) + integer, optional, intent(out) :: RC ! Error code + + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS + + type(GigaTrajInternal), pointer :: GigaInternalPtr + type (GigatrajInternalWrap) :: wrap + real, dimension(:,:,:), pointer :: field + real, dimension(:,:,:), allocatable :: field_latlon + real, dimension(:,:,:), allocatable, target :: haloField + integer :: counts(3), dims(3), d1,d2,km + + Iam = "get_metsrc_data" + + call MAPL_GetPointer(state, field, fieldname, _RC) + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) + GigaInternalPtr => wrap%ptr + call MAPL_GridGet(GigaInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) + + allocate(field_latlon(counts(1),counts(2),counts(3))) + allocate(haloField(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) + + call GigaInternalPtr%cube2latlon%regrid(field, Field_latlon, _RC) + + call esmf_halo(GigaInternalPtr%LatLonGrid, field_Latlon, haloField, _RC) + + call setData( GigaInternalPtr%metSrc, c_loc(ctime), c_loc(fieldname), c_loc(haloField)) + + call getData(GigaInternalPtr%metSrc, c_loc(ctime), c_loc(fieldname), & + GigaInternalPtr%parcels%num_parcels, & + c_loc(GigaInternalPtr%parcels%lons), & + c_loc(GigaInternalPtr%parcels%lats), & + c_loc(GigaInternalPtr%parcels%zs), & + c_loc(values)) + + RETURN_(ESMF_SUCCESS) + + end subroutine get_metsrc_data + end module GigaTraj_GridCompMod From a87b146c807772b1f80bb887bca9a8c39d7a245c Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 7 Feb 2023 16:14:44 -0500 Subject: [PATCH 18/73] can output T, TH --- GigaTraj_GridComp/GigaTraj_GridComp.F90 | 174 ++++++++++++++++++++---- 1 file changed, 148 insertions(+), 26 deletions(-) diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 index 5c9b18a26..864106ed4 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -391,7 +391,6 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap - type(ESMF_Grid) :: CubedGrid integer :: num_parcels, my_rank real, allocatable, target :: lats(:), lons(:), zs(:) @@ -414,7 +413,6 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) type(MAPL_MetaComp),pointer :: MPL character(len=ESMF_MAXSTR) :: parcels_file - call ESMF_VMGetCurrent(vm, _RC) call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) @@ -433,8 +431,6 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_TimeIntervalGet(ModelTimeStep,d_r8=DT, _RC) - call ESMF_GridCompGet(GC, grid=CubedGrid, _RC) - call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) GigaTrajInternalPtr => wrap%ptr @@ -477,6 +473,7 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) !--------------- ! Step 3) Update !--------------- + call updateFields( GigaTrajInternalPtr%metSrc, c_loc(ctime), c_loc(haloU), c_loc(haloV), c_loc(haloW), c_loc(haloP)) !--------------- @@ -508,10 +505,10 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call rebalance_parcels(clock, GigaTrajInternalPtr%parcels, GigaTrajInternalPtr%CellToRank, comm, DIMS, _RC) !--------------- -! Step 6) write out parcel positions ( configurable with alarm) +! Step 6) write out parcel positions and related fields ( configurable with alarm) !--------------- - call MAPL_GetResource(MPL, parcels_file, "GIGATRAJ_PARCELS_FILE:", default='parcels.nc4', _RC) - call write_parcels(clock, parcels_file, GigaTrajInternalPtr%parcels,currentTime, GigaTrajInternalPtr%startTime, _RC) + + call write_parcels(GC, import, clock, currentTime, _RC) RETURN_(ESMF_SUCCESS) @@ -806,41 +803,82 @@ subroutine gather_parcels(num_parcels0, lons0, lats0, zs0, IDs0, comm, lons, lat end subroutine gather_parcels - subroutine write_parcels(CLOCK, fname, parcels, currentTime, startTime, rc) + subroutine gather_onefield(num_parcels0, field0, comm, field, num_parcels) + integer, intent(out) :: num_parcels0 + real, dimension(:), allocatable, intent(out) :: field0 + integer, intent(in) :: comm + real, dimension(:), intent(in) :: field + integer, intent(in) :: num_parcels + + integer :: i, npes, ierror, my_rank + integer, allocatable :: nums_all(:), displ(:) + + call MPI_Comm_size(comm, npes, ierror) + call MPI_Comm_rank(comm, my_rank, ierror) + + allocate(nums_all(npes), source = 0) + call MPI_Gather(num_parcels, 1, MPI_INTEGER, nums_all, 1, MPI_INTEGER, 0, comm, ierror) + + num_parcels0 = sum(nums_all) + + allocate(field0(num_parcels0)) + allocate( displ(npes), source =0) + do i =2, npes + displ(i) = displ(i-1)+nums_all(i-1) + enddo + + call MPI_GatherV(field, num_parcels, MPI_REAL, field0, nums_all, displ, MPI_REAL, 0, comm,ierror) + + end subroutine gather_onefield + + subroutine write_parcels(GC, state, CLOCK, currentTime, rc) + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_State), intent(inout) :: state ! Import state type(ESMF_Clock), intent(inout) :: CLOCK ! The clock - character(*), intent(in):: fname - type(horde), intent(in) :: parcels type(ESMF_TIME), intent(in) :: currentTime - type(ESMF_TIME), intent(in) :: startTime integer, optional, intent(out) :: rc character(len=:), allocatable :: Iam - type (ESMF_VM) :: vm + type (ESMF_VM) :: vm type(Netcdf4_fileformatter) :: formatter - integer :: comm, my_rank, total_num, status, last_time, ierror - real, allocatable :: lats0(:), lons0(:), zs0(:), ids0_r(:) + integer :: comm, my_rank, total_num, i, status, last_time, ierror + real, allocatable :: lats0(:), lons0(:), zs0(:), ids0_r(:), values(:), values0(:) integer, allocatable :: ids0(:) type(ESMF_Alarm) :: GigaTrajOutAlarm type(FileMetadata) :: meta real(ESMF_KIND_R8) :: tint_d type(ESMF_TimeInterval) :: tint + type(MAPL_MetaComp),pointer :: MPL + character(len=ESMF_MAXSTR) :: parcels_file, other_fields + character(len=:), allocatable:: fieldname, fields, var_name + + type (GigaTrajInternal), pointer :: GigaTrajInternalPtr + type (GigatrajInternalWrap) :: wrap + character(len=20), target :: ctime + Iam = "write_parcels" call ESMF_ClockGetAlarm(clock, 'GigatrajOut', GigaTrajOutAlarm, _RC) if ( .not. ESMF_AlarmIsRinging(GigaTrajOutAlarm)) then RETURN_(ESMF_SUCCESS) endif + call MAPL_GetObjectFromGC ( GC, MPL, _RC) + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) + GigaTrajInternalPtr => wrap%ptr + + call MAPL_GetResource(MPL, parcels_file, "GIGATRAJ_PARCELS_FILE:", default='parcels.nc4', _RC) + call ESMF_VMGetCurrent(vm, _RC) call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) call gather_parcels(total_num, lons0, lats0, zs0, IDs0, & comm, & - parcels%lons, & - parcels%lats, & - parcels%zs, & - parcels%IDS, & - parcels%num_parcels ) + GigaTrajInternalPtr%parcels%lons, & + GigaTrajInternalPtr%parcels%lats, & + GigaTrajInternalPtr%parcels%zs, & + GigaTrajInternalPtr%parcels%IDS, & + GigaTrajInternalPtr%parcels%num_parcels ) call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) if (my_rank ==0) then @@ -848,20 +886,102 @@ subroutine write_parcels(CLOCK, fname, parcels, currentTime, startTime, rc) lats0 = lats0(ids0(:)+1) ! id is zero-bases, plus 1 Fortran lons0 = lons0(ids0(:)+1) zs0 = zs0(ids0(:)+1) - call formatter%open(fname, pFIO_WRITE, _RC) + call formatter%open(trim(parcels_file), pFIO_WRITE, _RC) meta = formatter%read(_RC) last_time = meta%get_dimension('time', _RC) - tint = CurrentTime - startTime + tint = CurrentTime - GigaTrajInternalPtr%startTime call ESMF_TimeIntervalGet(tint,d_r8=tint_d,rc=status) call formatter%put_var('lat', lats0, start=[1, last_time+1], _RC) call formatter%put_var('lon', lons0, start=[1, last_time+1], _RC) call formatter%put_var('pressure', zs0, start=[1, last_time+1], _RC) call formatter%put_var('time', [tint_d], start=[last_time+1], _RC) - call formatter%close(_RC) endif + ! extra fields + call MAPL_GetResource(MPL, other_fields, "GIGATRAJ_EXTRA_FIELDS:", default='NONE', _RC) + fields = trim(adjustl(other_fields)) + if (fields /='NONE') then + call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) + ctime(20:20) = c_null_char + do while ( .true.) + i = index(fields, ';') + if (i == 0) then + fieldname = trim(adjustl(fields)) + else + fieldname = fields(1:i-1) + fields = trim(adjustl(fields(i+1:))) + endif + if (fieldname == '') exit + select case (fieldname) + case('TH') + var_name = 'theta' + case('T') + var_name = 't' + case('PALT') + var_name = 'palt' + case default + var_name = fieldname + end select + + allocate(values(GigaTrajInternalPtr%parcels%num_parcels)) + call get_metsrc_data (GC, state, ctime, fieldname, values, RC ) + call gather_onefield(total_num, values0, comm, values, GigaTrajInternalPtr%parcels%num_parcels) + + if (my_rank == 0) then + values0 = values0(ids0(:)+1) + if ( meta%has_variable(var_name)) then + call formatter%put_var( var_name, values0, start=[1, last_time+1], _RC) + else + print*, "Please provide "//var_name // " in the file "//trim(parcels_file) + endif + endif + + deallocate(values) + if (i == 0) exit + enddo + endif + + if (my_rank ==0) then + call formatter%close(_RC) + endif RETURN_(ESMF_SUCCESS) + contains + subroutine create_var(fieldname) + character(*), intent(in) :: fieldname + type(Variable) :: var + character(len=:), allocatable :: long_name, units, var_name + + select case (fieldname) + case('TH') + var_name = 'theta' + long_name = "air_potential_temperature" + units = "K" + case('T') + var_name = 't' + long_name = "air_temperature" + units = "K" + case('PALT') + var_name = 'palt' + long_name = "pressure_altitude" + units = "km" + case default + var_name = fieldname + long_name = "unkown" + units = "1" + print*, "Not yet define attribute of "//var_name + end select + + if( meta%has_variable(var_name)) return + var = variable(type=pFIO_REAL32, dimensions='id,time') + call var%add_attribute('long_name', long_name) + call var%add_attribute('units', units) + call var%add_attribute('positive', "up") + call var%add_attribute('_FillValue', -999.99) + call var%add_attribute('missing_value', -999.99) + call meta%add_variable(var_name, var) + end subroutine create_var + end subroutine write_parcels subroutine read_parcels(fname, internal, rc) @@ -1018,7 +1138,7 @@ subroutine get_metsrc_data (GC, state, ctime, fieldname, values, RC ) type(ESMF_GridComp), intent(inout) :: GC ! Gridded component type(ESMF_State), intent(inout) :: state character(*), target, intent(in) :: ctime - character(*), target, intent(in) :: fieldname + character(*), intent(in) :: fieldname real, target, intent(inout) :: values(:) integer, optional, intent(out) :: RC ! Error code @@ -1031,6 +1151,7 @@ subroutine get_metsrc_data (GC, state, ctime, fieldname, values, RC ) real, dimension(:,:,:), allocatable :: field_latlon real, dimension(:,:,:), allocatable, target :: haloField integer :: counts(3), dims(3), d1,d2,km + character(len=:), target, allocatable :: field_ Iam = "get_metsrc_data" @@ -1046,15 +1167,16 @@ subroutine get_metsrc_data (GC, state, ctime, fieldname, values, RC ) call esmf_halo(GigaInternalPtr%LatLonGrid, field_Latlon, haloField, _RC) - call setData( GigaInternalPtr%metSrc, c_loc(ctime), c_loc(fieldname), c_loc(haloField)) + field_ = trim(fieldname)//c_null_char + call setData( GigaInternalPtr%metSrc, c_loc(ctime), c_loc(field_), c_loc(haloField)) - call getData(GigaInternalPtr%metSrc, c_loc(ctime), c_loc(fieldname), & + call getData(GigaInternalPtr%metSrc, c_loc(ctime), c_loc(field_), & GigaInternalPtr%parcels%num_parcels, & c_loc(GigaInternalPtr%parcels%lons), & c_loc(GigaInternalPtr%parcels%lats), & c_loc(GigaInternalPtr%parcels%zs), & c_loc(values)) - + deallocate(field_latlon, haloField) RETURN_(ESMF_SUCCESS) end subroutine get_metsrc_data From 94b3762dbecc133c34125b8131459f647cc8a273 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 28 Feb 2023 14:39:41 -0500 Subject: [PATCH 19/73] add more output from GOCART --- GigaTraj_GridComp/GEOS_Giga_InterOp.F90 | 6 + GigaTraj_GridComp/GigaTraj_GridComp.F90 | 386 +++++++++++++++++++----- 2 files changed, 309 insertions(+), 83 deletions(-) diff --git a/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 b/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 index 0668f0168..c5d4ec861 100644 --- a/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 +++ b/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 @@ -11,6 +11,7 @@ module GEOS_Giga_InterOpMod public :: rk4a_advance public :: setData public :: getData + public :: getData2d public :: test_Field3D public :: test_dataflow @@ -74,6 +75,11 @@ subroutine getData ( metSrc_ptr, ctime, quantity_ptr, n, lons_ptr, lats_ptr, lev type(c_ptr), intent(in), value :: metSrc_ptr, ctime, quantity_ptr, lons_ptr, lats_ptr, levs_ptr, values_ptr end subroutine getData + subroutine getData2d ( metSrc_ptr, ctime, quantity_ptr, n, lons_ptr, lats_ptr, values_ptr) bind(C, name="getData2d") + import :: c_ptr, c_int + integer(c_int), intent(in), value :: n + type(c_ptr), intent(in), value :: metSrc_ptr, ctime, quantity_ptr, lons_ptr, lats_ptr, values_ptr + end subroutine getData2d end interface contains diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 index 864106ed4..5defcdd93 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -27,6 +27,7 @@ module GigaTraj_GridCompMod type(horde) :: parcels type(c_ptr) :: metSrc type(ESMF_Time) :: startTime + character(len=ESMF_MAXSTR), allocatable :: ExtraFieldNames(:) end type type GigatrajInternalWrap @@ -258,16 +259,26 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) type(ESMF_Clock), intent(inout) :: CLOCK integer, optional, intent( out) :: RC - integer :: status + integer :: i, status, k, FC character(len=ESMF_MAXSTR) :: IAm - type (ESMF_State) :: INTERNAL + type (ESMF_State) :: INTERNAL, leaf_export type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap character(len=ESMF_MAXSTR) :: GigaRstFile + character(len=ESMF_MAXSTR) :: other_fields + character(len=ESMF_MAXSTR) :: NAME + type(ESMF_Field) :: tmp_field type (ESMF_TIME) :: CurrentTime character(len=20), target :: ctime - type (MAPL_MetaComp), pointer :: MAPL + type (MAPL_MetaComp), pointer :: MPL logical, save :: init = .false. + real, dimension(:,:,:) , pointer :: ptr3d + type(Netcdf4_fileformatter) :: formatter + type(FileMetadata) :: meta + character(len=ESMF_MAXSTR) :: parcels_file + character(len=:), allocatable :: fieldname + character(len=20) :: diffusions(4) + type (ESMF_FieldBundle) :: TRI Iam = "getInitVars" @@ -275,18 +286,18 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) RETURN_(ESMF_SUCCESS) endif - call MAPL_GetObjectFromGC ( GC, MAPL, _RC) + call MAPL_GetObjectFromGC ( GC, MPL, _RC) call ESMF_ClockGet(clock, currTime=CurrentTime, _RC) call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) ctime(20:20) = c_null_char - call MAPL_Get(MAPL, INTERNAL_ESMF_STATE=INTERNAL, _RC) + call MAPL_Get(MPL, INTERNAL_ESMF_STATE=INTERNAL, _RC) call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) GigaTrajInternalPtr => wrap%ptr - call MAPL_GetResource(MAPL, GigaRstFile, 'GIGATRAJ_INTERNAL_RESTART_FILE:', default="NONE", RC=STATUS ) + call MAPL_GetResource(MPL, GigaRstFile, 'GIGATRAJ_INTERNAL_RESTART_FILE:', default="NONE", RC=STATUS ) if (trim(GigaRstFile) == 'NONE') then ! without restart file, get value from import @@ -295,9 +306,177 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) call init_metsrc_field0(GC, INTERNAL, ctime, 'PL', _RC) endif + call MAPL_GetResource(MPL, other_fields, "GIGATRAJ_EXTRA_FIELDS:", default='NONE', _RC) + if (other_fields /= 'NONE') then + + call MAPL_GetResource(MPL, parcels_file, "GIGATRAJ_PARCELS_FILE:", default='parcels.nc4', _RC) + if (MAPL_AM_I_ROOT()) then + call formatter%open(trim(parcels_file), pFIO_WRITE, _RC) + meta = formatter%read(_RC) + endif + + call getExtraFieldNames(other_fields,GigaTrajInternalPtr%ExtraFieldNames) + + do i = 1, size(GigaTrajInternalPtr%ExtraFieldNames) + + if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'CA.bc') /=0 ) then + call MAPL_ExportStateGet([import], 'CA.bc', leaf_export, _RC) + call ESMF_StateGet(leaf_export, trim(GigaTrajInternalPtr%ExtraFieldNames(i)), tmp_field, _RC) + call ESMF_FieldGet(tmp_field,farrayPtr=ptr3d,rc=status) + if( .not. associated(ptr3d)) then + call MAPL_AllocateCoupling(tmp_field, _RC) + endif + call ESMF_StateAddReplace(import, [tmp_field], _RC) + + if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'phobic') /=0 .or. & + index(GigaTrajInternalPtr%ExtraFieldNames(i), 'philic') /=0 ) then + fieldname = trim(GigaTrajInternalPtr%ExtraFieldNames(i)) + call create_extra_var(fieldname) + cycle + endif + do k = 1, size(ptr3d, 3) + fieldname = trim(GigaTrajInternalPtr%ExtraFieldNames(i))//'00'//i_to_string(k) + call create_extra_var(fieldname) + enddo + cycle + endif + if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'CA.oc') /=0) then + call MAPL_ExportStateGet([import], 'CA.oc', leaf_export, _RC) + call ESMF_StateGet(leaf_export, trim(GigaTrajInternalPtr%ExtraFieldNames(i)), tmp_field, _RC) + call ESMF_FieldGet(tmp_field,farrayPtr=ptr3d,rc=status) + if( .not. associated(ptr3d)) then + call MAPL_AllocateCoupling(tmp_field, _RC) + endif + call ESMF_StateAddReplace(import, [tmp_field], _RC) + if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'phobic') /=0 .or. & + index(GigaTrajInternalPtr%ExtraFieldNames(i), 'philic') /=0 ) then + fieldname = trim(GigaTrajInternalPtr%ExtraFieldNames(i)) + call create_extra_var(fieldname) + cycle + endif + do k = 1, size(ptr3d, 3) + fieldname = trim(GigaTrajInternalPtr%ExtraFieldNames(i))//'00'//i_to_string(k) + call create_extra_var(fieldname) + enddo + cycle + endif + enddo + endif + + if (MAPL_AM_I_Root()) then + call formatter%close() + endif + init = .true. RETURN_(ESMF_SUCCESS) + contains + subroutine getExtraFieldNames(other_fields, Fieldnames) + character(*), intent(in) :: other_fields + character(len=ESMF_MAXSTR), allocatable, intent(out) :: Fieldnames(:) + integer :: num_field, i, k, endl, num_ + num_field = 1 + k = 1 + do + i = index(other_fields(k:),';') + if (i == 0) exit + k = k+i + num_field = num_field+1 + enddo + + allocate(Fieldnames(num_field)) + k = 1 + num_ = 1 + do + i = index(other_fields(k:),';') + if (i == 0) then + endl = len(other_fields) + else + endl = (k-1)+i-1 + endif + FieldNames(num_) = trim(adjustl(other_fields(k:endl))) + num_ = num_ + 1 + k = endl + 2 + if (num_ > num_field) exit + enddo + end subroutine getExtraFieldNames + + ! if the field name is not in original file + subroutine create_extra_var(fieldname) + character(*), intent(in) :: fieldname + type(Variable) :: var + character(len=:), allocatable :: long_name, units, var_name + real, allocatable :: tmp(:) + select case (fieldname) + case('TH') + var_name = 'theta' + long_name = "air_potential_temperature" + units = "K" + case('T') + var_name = 't' + long_name = "air_temperature" + units = "K" + case('PALT') + var_name = 'palt' + long_name = "pressure_altitude" + units = "km" + case default + var_name = trim(fieldname) + long_name = "unkown" + units = "1" + !print*, "Not yet define attribute of "//var_name + end select + + if (index(var_name, 'CA.bcSD') /=0) then + long_name = "Carbonaceous_Aerosol_Sedimentation_bin" + units = "kg m-2 s-1" + endif + if (index(var_name, 'CA.bcSV') /=0) then + long_name = "Carbonaceous_Aerosol_Convective_Scavenging_bin" + units = "kg m-2 s-1" + endif + if (index(var_name, 'CA.bcDP') /=0) then + long_name = "Carbonaceous_Aerosol_Dry_Deposition_bin" + units = "kg m-2 s-1" + endif + if (index(var_name, 'CA.bcWT') /=0) then + long_name = "Carbonaceous_Aerosol_Wet_Deposition_bin" + units = "kg m-2 s-1" + endif + + if (index(var_name, 'CA.ocSD') /=0) then + long_name = "Carbonaceous_Aerosol_Sedimentation_bin" + units = "kg m-2 s-1" + endif + if (index(var_name, 'CA.ocSV') /=0) then + long_name = "Carbonaceous_Aerosol_Convective_Scavenging_bin" + units = "kg m-2 s-1" + endif + if (index(var_name, 'CA.ocDP') /=0) then + long_name = "Carbonaceous_Aerosol_Dry_Deposition_bin" + units = "kg m-2 s-1" + endif + if (index(var_name, 'CA.ocWT') /=0) then + long_name = "Carbonaceous_Aerosol_Wet_Deposition_bin" + units = "kg m-2 s-1" + endif + if (index(var_name, 'phobic') /=0 .or. index(var_name, 'philic')/=0) then + long_name = "Carbonaceous_Aerosol_Mixing_Ratio" + units = "kg kg-1" + endif + + if( meta%has_variable(var_name)) return + if (MAPL_AM_I_Root()) then + var = variable(type=pFIO_REAL32, dimensions='id,time') + call var%add_attribute('long_name', long_name) + call var%add_attribute('units', units) + call var%add_attribute('positive', "up") + call var%add_attribute('_FillValue', -999.99) + call var%add_attribute('missing_value', -999.99) + call meta%add_variable(var_name, var) + call formatter%add_variable(meta, var_name) + endif + end subroutine create_extra_var end subroutine GetInitVars subroutine Init_metsrc_field0 (GC, state, ctime, PL, RC ) @@ -413,6 +592,7 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) type(MAPL_MetaComp),pointer :: MPL character(len=ESMF_MAXSTR) :: parcels_file + !RETURN_(ESMF_SUCCESS) call ESMF_VMGetCurrent(vm, _RC) call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) @@ -510,7 +690,6 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call write_parcels(GC, import, clock, currentTime, _RC) - RETURN_(ESMF_SUCCESS) end subroutine Run @@ -553,18 +732,19 @@ subroutine esmf_halo(grid, Field,haloField, rc) integer, optional, intent( out) :: RC character(len=ESMF_MAXSTR) :: IAm - integer :: counts(3), dims(3), k + integer :: counts(3), k, count3 integer :: status type(ESMF_Field) :: halo_field type(ESMF_RouteHandle) :: rh real, dimension(:,:,:), pointer :: with_halo Iam = "Gigatraj ESMF Halo" - call MAPL_GridGet(grid, localCellCountPerDim=counts, & - globalCellCountPerDim=DIMS, _RC) + call MAPL_GridGet(grid, localCellCountPerDim=counts, _RC) + + count3 = size(field,3) ! may be nbins halo_field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R4, name='halo_field', & - ungriddedLBound=[1],ungriddedUBound=[counts(3)], & + ungriddedLBound=[1],ungriddedUBound=[count3], & totalLWidth=[1,1],totalUWidth=[1,1]) call ESMF_FieldHaloStore(halo_field, rh, _RC) @@ -841,8 +1021,10 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) character(len=:), allocatable :: Iam type (ESMF_VM) :: vm type(Netcdf4_fileformatter) :: formatter - integer :: comm, my_rank, total_num, i, status, last_time, ierror + integer :: comm, my_rank, total_num, i, k,status, last_time, ierror, count3 real, allocatable :: lats0(:), lons0(:), zs0(:), ids0_r(:), values(:), values0(:) + real,target, allocatable :: values_2d(:,:) + real,pointer :: field(:,:,:) integer, allocatable :: ids0(:) type(ESMF_Alarm) :: GigaTrajOutAlarm type(FileMetadata) :: meta @@ -850,7 +1032,8 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) type(ESMF_TimeInterval) :: tint type(MAPL_MetaComp),pointer :: MPL character(len=ESMF_MAXSTR) :: parcels_file, other_fields - character(len=:), allocatable:: fieldname, fields, var_name + character(len=ESMF_MAXSTR), allocatable :: names(:) + character(len=:), allocatable:: var_name, var_ type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap @@ -899,21 +1082,11 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) endif ! extra fields - call MAPL_GetResource(MPL, other_fields, "GIGATRAJ_EXTRA_FIELDS:", default='NONE', _RC) - fields = trim(adjustl(other_fields)) - if (fields /='NONE') then + if (allocated(GigaTrajInternalPtr%ExtraFieldNames)) then call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) ctime(20:20) = c_null_char - do while ( .true.) - i = index(fields, ';') - if (i == 0) then - fieldname = trim(adjustl(fields)) - else - fieldname = fields(1:i-1) - fields = trim(adjustl(fields(i+1:))) - endif - if (fieldname == '') exit - select case (fieldname) + do k = 1, size(GigaTrajInternalPtr%ExtraFieldNames) + select case (trim(GigaTrajInternalPtr%ExtraFieldNames(k))) case('TH') var_name = 'theta' case('T') @@ -921,24 +1094,51 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) case('PALT') var_name = 'palt' case default - var_name = fieldname + var_name = trim(GigaTrajInternalPtr%ExtraFieldNames(k)) end select - allocate(values(GigaTrajInternalPtr%parcels%num_parcels)) - call get_metsrc_data (GC, state, ctime, fieldname, values, RC ) - call gather_onefield(total_num, values0, comm, values, GigaTrajInternalPtr%parcels%num_parcels) - - if (my_rank == 0) then - values0 = values0(ids0(:)+1) - if ( meta%has_variable(var_name)) then - call formatter%put_var( var_name, values0, start=[1, last_time+1], _RC) - else - print*, "Please provide "//var_name // " in the file "//trim(parcels_file) - endif + if ( index(GigaTrajInternalPtr%ExtraFieldNames(k), 'bcDP') /= 0 .or. & + index(GigaTrajInternalPtr%ExtraFieldNames(k), 'ocDP') /= 0 .or. & + index(GigaTrajInternalPtr%ExtraFieldNames(k), 'bcWT') /= 0 .or. & + index(GigaTrajInternalPtr%ExtraFieldNames(k), 'ocWT') /= 0 .or. & + index(GigaTrajInternalPtr%ExtraFieldNames(k), 'bcSD') /= 0 .or. & + index(GigaTrajInternalPtr%ExtraFieldNames(k), 'ocSD') /= 0 .or. & + index(GigaTrajInternalPtr%ExtraFieldNames(k), 'bcSV') /= 0 .or. & + index(GigaTrajInternalPtr%ExtraFieldNames(k), 'ocSV') /= 0 ) then + + call MAPL_GetPointer(state, field, GigaTrajInternalPtr%ExtraFieldNames(k) , _RC) + count3 = size(field,3) + allocate(values_2d(GigaTrajInternalPtr%parcels%num_parcels, count3)) + call get_metsrc_data2d (GC, state, ctime, GigaTrajInternalPtr%ExtraFieldNames(k), values_2d, RC ) + do i = 1, size(values_2d,2) + call gather_onefield(total_num, values0, comm, values_2d(:,i), GigaTrajInternalPtr%parcels%num_parcels) + + if (my_rank == 0) then + values0 = values0(ids0(:)+1) + var_ = var_name //'00'//i_to_string(i) + if ( meta%has_variable(var_)) then + call formatter%put_var( var_, values0, start=[1, last_time+1], _RC) + else + print*, "Please provide "//var_ // " in the file "//trim(parcels_file) + endif + endif + enddo + deallocate(values_2d) + else + allocate(values(GigaTrajInternalPtr%parcels%num_parcels)) + call get_metsrc_data (GC, state, ctime, trim(GigaTrajInternalPtr%ExtraFieldNames(k)), values, RC ) + call gather_onefield(total_num, values0, comm, values, GigaTrajInternalPtr%parcels%num_parcels) + + if (my_rank == 0) then + values0 = values0(ids0(:)+1) + if ( meta%has_variable(var_name)) then + call formatter%put_var( var_name, values0, start=[1, last_time+1], _RC) + else + print*, "Please provide "//var_name // " in the file "//trim(parcels_file) + endif + endif + deallocate(values) endif - - deallocate(values) - if (i == 0) exit enddo endif @@ -947,40 +1147,6 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) endif RETURN_(ESMF_SUCCESS) contains - subroutine create_var(fieldname) - character(*), intent(in) :: fieldname - type(Variable) :: var - character(len=:), allocatable :: long_name, units, var_name - - select case (fieldname) - case('TH') - var_name = 'theta' - long_name = "air_potential_temperature" - units = "K" - case('T') - var_name = 't' - long_name = "air_temperature" - units = "K" - case('PALT') - var_name = 'palt' - long_name = "pressure_altitude" - units = "km" - case default - var_name = fieldname - long_name = "unkown" - units = "1" - print*, "Not yet define attribute of "//var_name - end select - - if( meta%has_variable(var_name)) return - var = variable(type=pFIO_REAL32, dimensions='id,time') - call var%add_attribute('long_name', long_name) - call var%add_attribute('units', units) - call var%add_attribute('positive', "up") - call var%add_attribute('_FillValue', -999.99) - call var%add_attribute('missing_value', -999.99) - call meta%add_variable(var_name, var) - end subroutine create_var end subroutine write_parcels @@ -1150,18 +1316,20 @@ subroutine get_metsrc_data (GC, state, ctime, fieldname, values, RC ) real, dimension(:,:,:), pointer :: field real, dimension(:,:,:), allocatable :: field_latlon real, dimension(:,:,:), allocatable, target :: haloField - integer :: counts(3), dims(3), d1,d2,km + integer :: counts(3), dims(3), d1,d2,km, count3 character(len=:), target, allocatable :: field_ Iam = "get_metsrc_data" call MAPL_GetPointer(state, field, fieldname, _RC) + count3 = size(field,3) + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) GigaInternalPtr => wrap%ptr call MAPL_GridGet(GigaInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) - allocate(field_latlon(counts(1),counts(2),counts(3))) - allocate(haloField(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) + allocate(field_latlon(counts(1),counts(2),count3)) + allocate(haloField(counts(1)+2, counts(2)+2,count3), source = 0.0) call GigaInternalPtr%cube2latlon%regrid(field, Field_latlon, _RC) @@ -1169,16 +1337,68 @@ subroutine get_metsrc_data (GC, state, ctime, fieldname, values, RC ) field_ = trim(fieldname)//c_null_char call setData( GigaInternalPtr%metSrc, c_loc(ctime), c_loc(field_), c_loc(haloField)) - call getData(GigaInternalPtr%metSrc, c_loc(ctime), c_loc(field_), & + GigaInternalPtr%parcels%num_parcels, & + c_loc(GigaInternalPtr%parcels%lons), & + c_loc(GigaInternalPtr%parcels%lats), & + c_loc(GigaInternalPtr%parcels%zs), & + c_loc(values)) + + deallocate(field_latlon, haloField) + RETURN_(ESMF_SUCCESS) + + end subroutine get_metsrc_data + + subroutine get_metsrc_data2d (GC, state, ctime, fieldname, values, RC ) + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_State), intent(inout) :: state + character(*), target, intent(in) :: ctime + character(*), intent(in) :: fieldname + real, target, intent(inout) :: values(:,:) + integer, optional, intent(out) :: RC ! Error code + + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS + + type(GigaTrajInternal), pointer :: GigaInternalPtr + type (GigatrajInternalWrap) :: wrap + real, dimension(:,:,:), pointer :: field + real, dimension(:,:,:), allocatable :: field_latlon + real, dimension(:,:,:), allocatable, target :: haloField + integer :: counts(3), i, count3 + character(len=:), target, allocatable :: field_ + + Iam = "get_metsrc_data" + + call MAPL_GetPointer(state, field, fieldname, _RC) + count3 = size(field,3) + + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) + GigaInternalPtr => wrap%ptr + call MAPL_GridGet(GigaInternalPtr%LatLonGrid, localCellCountPerDim=counts, _RC) + + allocate(field_latlon(counts(1),counts(2),count3)) + allocate(haloField(counts(1)+2, counts(2)+2,count3), source = 0.0) + + call GigaInternalPtr%cube2latlon%regrid(field, Field_latlon, _RC) + + call esmf_halo(GigaInternalPtr%LatLonGrid, field_Latlon, haloField, _RC) + + field_ = trim(fieldname)//'_2D'//c_null_char + + do i = 1,count3 + + call setData( GigaInternalPtr%metSrc, c_loc(ctime), c_loc(field_), c_loc(haloField(1,1,i))) + call getData2d(GigaInternalPtr%metSrc, c_loc(ctime), c_loc(field_), & GigaInternalPtr%parcels%num_parcels, & c_loc(GigaInternalPtr%parcels%lons), & c_loc(GigaInternalPtr%parcels%lats), & - c_loc(GigaInternalPtr%parcels%zs), & - c_loc(values)) + c_loc(values(1,i))) + + enddo deallocate(field_latlon, haloField) RETURN_(ESMF_SUCCESS) - end subroutine get_metsrc_data - + end subroutine get_metsrc_data2d + end module GigaTraj_GridCompMod From 5d36eb8b3b00aa3f8dbd6af50389fe7701419cb0 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 14 Mar 2023 13:29:08 -0400 Subject: [PATCH 20/73] add options for 0 or -180 lon start files --- GigaTraj_GridComp/GigaTraj_GridComp.F90 | 51 ++++++++++++++----------- 1 file changed, 29 insertions(+), 22 deletions(-) diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GigaTraj_GridComp/GigaTraj_GridComp.F90 index 5defcdd93..a7efe7f20 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GigaTraj_GridComp/GigaTraj_GridComp.F90 @@ -193,8 +193,8 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_Grid_interior(GigaTrajInternalPtr%LatLonGrid ,i1,i2,j1,j2) call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) + dlon = 360.0/dims(1) ! lat and lon centers need to hold the halo - dlon = 360.0/dims(1) lons_center = [(-dlon/2+ dlon*i, i= i1-1, i2+1)] where(lons_center < 0. ) lons_center = 0. where(lons_center >360.) lons_center = 360. @@ -239,9 +239,7 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) deallocate(lons_center, lats_center,levs_center) - call MAPL_GetResource(MPL, parcels_file, "GIGATRAJ_PARCELS_FILE:", default='parcels.nc4', _RC) - - call read_parcels(parcels_file, GigaTrajInternalPtr, _RC) + call read_parcels(GC, GigaTrajInternalPtr, _RC) call MAPL_TimerOff(MPL,"INITIALIZE") call MAPL_TimerOff(MPL,"TOTAL") @@ -1037,6 +1035,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap + real :: lon_start character(len=20), target :: ctime Iam = "write_parcels" @@ -1051,6 +1050,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) GigaTrajInternalPtr => wrap%ptr call MAPL_GetResource(MPL, parcels_file, "GIGATRAJ_PARCELS_FILE:", default='parcels.nc4', _RC) + call MAPL_GetResource(MPL, lon_start , "GIGATRAJ_LON_START:", default= 0. , _RC) call ESMF_VMGetCurrent(vm, _RC) call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) @@ -1068,6 +1068,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) ! reorder lats0 = lats0(ids0(:)+1) ! id is zero-bases, plus 1 Fortran lons0 = lons0(ids0(:)+1) + if (lon_start < 0 ) lons0 = lons0 - 180.0 ! temperary fix zs0 = zs0(ids0(:)+1) call formatter%open(trim(parcels_file), pFIO_WRITE, _RC) meta = formatter%read(_RC) @@ -1077,7 +1078,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) call formatter%put_var('lat', lats0, start=[1, last_time+1], _RC) call formatter%put_var('lon', lons0, start=[1, last_time+1], _RC) - call formatter%put_var('pressure', zs0, start=[1, last_time+1], _RC) + call formatter%put_var('p', zs0, start=[1, last_time+1], _RC) call formatter%put_var('time', [tint_d], start=[last_time+1], _RC) endif @@ -1150,8 +1151,8 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) end subroutine write_parcels - subroutine read_parcels(fname, internal, rc) - character(*), intent(in) :: fname + subroutine read_parcels(GC,internal, rc) + type(ESMF_GridComp), intent(inout) :: GC type(GigaTrajInternal), intent(inout) :: internal integer, optional, intent(out) :: rc @@ -1162,9 +1163,12 @@ subroutine read_parcels(fname, internal, rc) real(kind=ESMF_KIND_R8), allocatable :: ids0_r(:) integer, allocatable :: ids0(:) integer :: status + character(len=ESMF_MAXSTR) :: parcels_file + type(MAPL_MetaComp),pointer :: MPL type (ESMF_VM) :: vm class(Variable), pointer :: v type(Attribute), pointer :: attr + real :: lon_start class(*), pointer :: units character(len=ESMF_MAXSTR) :: Iam ="read_parcels" @@ -1172,10 +1176,12 @@ subroutine read_parcels(fname, internal, rc) call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) - - total_num = 0 - if (my_rank ==0) then - call formatter%open(fname, pFIO_READ, _RC) + call MAPL_GetObjectFromGC ( GC, MPL, _RC) + call MAPL_GetResource(MPL, parcels_file, "GIGATRAJ_PARCELS_FILE:", default='parcels.nc4', _RC) + call MAPL_GetResource(MPL, lon_start , "GIGATRAJ_LON_START:", default= 0. , _RC) + total_num = 0 + if (my_rank ==0) then + call formatter%open(parcels_file, pFIO_READ, _RC) meta = formatter%read(_RC) total_num = meta%get_dimension('id', _RC) last_time = meta%get_dimension('time', _RC) @@ -1187,30 +1193,31 @@ subroutine read_parcels(fname, internal, rc) internal%startTime = parse_time_string(units, _RC) class default _FAIL('unsupported subclass for units') - end select - endif + end select + endif - allocate(lats0(total_num), lons0(total_num), zs0(total_num), ids0_r(total_num)) + allocate(lats0(total_num), lons0(total_num), zs0(total_num), ids0_r(total_num)) - if (my_rank ==0) then + if (my_rank ==0) then call formatter%get_var('lat', lats0, start = [1,last_time], _RC) call formatter%get_var('lon', lons0, start = [1,last_time], _RC) - call formatter%get_var('pressure', zs0, start = [1,last_time], _RC) + call formatter%get_var('p', zs0, start = [1,last_time], _RC) call formatter%get_var('id', ids0_r,start = [1,last_time], _RC) call formatter%close(_RC) ids0 = int(ids0_r) - endif - call MAPL_GridGet(internal%LatLonGrid, globalCellCountPerDim=DIMS, _RC) - call scatter_parcels(total_num, lons0, lats0, zs0, IDs0, internal%CellToRank, DIMS, comm, & + if (lon_start < 0) lons0 = lons0+180. + endif + call MAPL_GridGet(internal%LatLonGrid, globalCellCountPerDim=DIMS, _RC) + call scatter_parcels(total_num, lons0, lats0, zs0, IDs0, internal%CellToRank, DIMS, comm, & Internal%parcels%lons, & Internal%parcels%lats, & Internal%parcels%zs, & Internal%parcels%IDS, & Internal%parcels%num_parcels) - deallocate(lats0, lons0, zs0, ids0_r) - RETURN_(ESMF_SUCCESS) - contains + deallocate(lats0, lons0, zs0, ids0_r) + RETURN_(ESMF_SUCCESS) + contains ! a copy from MAPL_TimeMod function parse_time_string(timeUnits,rc) result(time) character(len=*), intent(inout) :: timeUnits From c1b3009dbefd167d1cf418e38681909b0fc51589 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 14 Mar 2023 15:56:00 -0400 Subject: [PATCH 21/73] rename to GEOSgigatraj_GridComp --- CMakeLists.txt | 2 +- GEOS_GcmGridComp.F90 | 2 +- {GigaTraj_GridComp => GEOSgigatraj_GridComp}/CMakeLists.txt | 2 +- .../GEOS_Giga_InterOp.F90 | 0 .../GEOS_GigatrajGridComp.F90 | 4 ++-- 5 files changed, 5 insertions(+), 5 deletions(-) rename {GigaTraj_GridComp => GEOSgigatraj_GridComp}/CMakeLists.txt (76%) rename {GigaTraj_GridComp => GEOSgigatraj_GridComp}/GEOS_Giga_InterOp.F90 (100%) rename GigaTraj_GridComp/GigaTraj_GridComp.F90 => GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 (99%) diff --git a/CMakeLists.txt b/CMakeLists.txt index 26eb1c124..20fa54e5f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -11,7 +11,7 @@ option(BUILD_WITH_GIGATRAJ "Build GEOSgcm with Gigatraj" ON) if (BUILD_WITH_GIGATRAJ) add_definitions (-DHAS_GIGATRAJ) - set (alldirs ${alldirs} GigaTraj_GridComp) + set (alldirs ${alldirs} GEOSgigatraj_GridComp) endif() diff --git a/GEOS_GcmGridComp.F90 b/GEOS_GcmGridComp.F90 index 12cf9523d..effe6762a 100644 --- a/GEOS_GcmGridComp.F90 +++ b/GEOS_GcmGridComp.F90 @@ -21,7 +21,7 @@ module GEOS_GcmGridCompMod use GEOS_mkiauGridCompMod, only: AIAU_SetServices => SetServices use DFI_GridCompMod, only: ADFI_SetServices => SetServices #ifdef HAS_GIGATRAJ - use GigaTraj_GridCompMod, only: GigaTraj_SetServices => SetServices + use GEOS_GigatrajGridCompMod, only: GigaTraj_SetServices => SetServices #endif use GEOS_OgcmGridCompMod, only: OGCM_SetServices => SetServices diff --git a/GigaTraj_GridComp/CMakeLists.txt b/GEOSgigatraj_GridComp/CMakeLists.txt similarity index 76% rename from GigaTraj_GridComp/CMakeLists.txt rename to GEOSgigatraj_GridComp/CMakeLists.txt index d9d4061ca..870944a03 100644 --- a/GigaTraj_GridComp/CMakeLists.txt +++ b/GEOSgigatraj_GridComp/CMakeLists.txt @@ -3,7 +3,7 @@ esma_set_this() set (dependencies MAPL esmf geos_giga metsources filters gigatraj) esma_add_library (${this} - SRCS GEOS_Giga_InterOp.F90 GigaTraj_GridComp.F90 + SRCS GEOS_Giga_InterOp.F90 GEOS_GigatrajGridComp.F90 DEPENDENCIES ${dependencies}) esma_add_subdirectories( @GigaTraj) diff --git a/GigaTraj_GridComp/GEOS_Giga_InterOp.F90 b/GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 similarity index 100% rename from GigaTraj_GridComp/GEOS_Giga_InterOp.F90 rename to GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 diff --git a/GigaTraj_GridComp/GigaTraj_GridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 similarity index 99% rename from GigaTraj_GridComp/GigaTraj_GridComp.F90 rename to GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index a7efe7f20..37a549fdc 100644 --- a/GigaTraj_GridComp/GigaTraj_GridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -1,6 +1,6 @@ #include "MAPL_Generic.h" -module GigaTraj_GridCompMod +module GEOS_GigatrajGridCompMod use, intrinsic :: iso_c_binding, only : c_int, c_ptr, c_null_ptr, c_associated use, intrinsic :: iso_c_binding, only : c_loc use ESMF @@ -1408,4 +1408,4 @@ subroutine get_metsrc_data2d (GC, state, ctime, fieldname, values, RC ) end subroutine get_metsrc_data2d -end module GigaTraj_GridCompMod +end module GEOS_GigatrajGridComp.F90 From dd092a2e49ab2bc6f2eeafc128e31af05867ff76 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 14 Mar 2023 17:06:29 -0400 Subject: [PATCH 22/73] correct typo --- GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index 37a549fdc..1da039fc0 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -1408,4 +1408,4 @@ subroutine get_metsrc_data2d (GC, state, ctime, fieldname, values, RC ) end subroutine get_metsrc_data2d -end module GEOS_GigatrajGridComp.F90 +end module GEOS_GigatrajGridCompMod From b86b2b3bcc40de0c3c61c4ce2713bc737ee169d9 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 8 May 2023 12:59:02 -0400 Subject: [PATCH 23/73] added turbulence mix increment --- .../GEOS_GigatrajGridComp.F90 | 128 +++++++++++++----- 1 file changed, 93 insertions(+), 35 deletions(-) diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index 1da039fc0..499a4deae 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -266,6 +266,7 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=ESMF_MAXSTR) :: other_fields character(len=ESMF_MAXSTR) :: NAME type(ESMF_Field) :: tmp_field + type (ESMF_FieldBundle) :: TRI type (ESMF_TIME) :: CurrentTime character(len=20), target :: ctime type (MAPL_MetaComp), pointer :: MPL @@ -276,7 +277,9 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=ESMF_MAXSTR) :: parcels_file character(len=:), allocatable :: fieldname character(len=20) :: diffusions(4) - type (ESMF_FieldBundle) :: TRI + character (len=ESMF_MAXSTR), allocatable :: itemNameList(:) + character (len=ESMF_MAXSTR), allocatable :: fieldnames(:) + integer :: nitems Iam = "getInitVars" @@ -305,8 +308,8 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) endif call MAPL_GetResource(MPL, other_fields, "GIGATRAJ_EXTRA_FIELDS:", default='NONE', _RC) - if (other_fields /= 'NONE') then + if (other_fields /= 'NONE') then call MAPL_GetResource(MPL, parcels_file, "GIGATRAJ_PARCELS_FILE:", default='parcels.nc4', _RC) if (MAPL_AM_I_ROOT()) then call formatter%open(trim(parcels_file), pFIO_WRITE, _RC) @@ -316,8 +319,7 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) call getExtraFieldNames(other_fields,GigaTrajInternalPtr%ExtraFieldNames) do i = 1, size(GigaTrajInternalPtr%ExtraFieldNames) - - if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'CA.bc') /=0 ) then + if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'CA.bc') /=0) then call MAPL_ExportStateGet([import], 'CA.bc', leaf_export, _RC) call ESMF_StateGet(leaf_export, trim(GigaTrajInternalPtr%ExtraFieldNames(i)), tmp_field, _RC) call ESMF_FieldGet(tmp_field,farrayPtr=ptr3d,rc=status) @@ -325,19 +327,13 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_AllocateCoupling(tmp_field, _RC) endif call ESMF_StateAddReplace(import, [tmp_field], _RC) - - if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'phobic') /=0 .or. & - index(GigaTrajInternalPtr%ExtraFieldNames(i), 'philic') /=0 ) then - fieldname = trim(GigaTrajInternalPtr%ExtraFieldNames(i)) - call create_extra_var(fieldname) - cycle - endif do k = 1, size(ptr3d, 3) fieldname = trim(GigaTrajInternalPtr%ExtraFieldNames(i))//'00'//i_to_string(k) call create_extra_var(fieldname) enddo cycle endif + if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'CA.oc') /=0) then call MAPL_ExportStateGet([import], 'CA.oc', leaf_export, _RC) call ESMF_StateGet(leaf_export, trim(GigaTrajInternalPtr%ExtraFieldNames(i)), tmp_field, _RC) @@ -346,18 +342,49 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_AllocateCoupling(tmp_field, _RC) endif call ESMF_StateAddReplace(import, [tmp_field], _RC) - if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'phobic') /=0 .or. & - index(GigaTrajInternalPtr%ExtraFieldNames(i), 'philic') /=0 ) then - fieldname = trim(GigaTrajInternalPtr%ExtraFieldNames(i)) - call create_extra_var(fieldname) - cycle - endif do k = 1, size(ptr3d, 3) fieldname = trim(GigaTrajInternalPtr%ExtraFieldNames(i))//'00'//i_to_string(k) call create_extra_var(fieldname) enddo cycle endif + + if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'TRI') /=0) then + call ESMF_StateGet(import, 'PHYSICS_Exports/TURBULENCE_Exports/TRI', TRI, _RC) + !call ESMF_FieldBundleGet(TRI, fieldCount=nitems, _RC) + !allocate(itemNameList(nitems)) + !call ESMF_FieldBundleGet(TRI,fieldnamelist=itemNameList,rc=status) + allocate(fieldnames(4)) + fieldnames(1) = "CA.bc::CA.bcphilicIT" + fieldnames(2) = "CA.bc::CA.bcphobicIT" + fieldnames(3) = "CA.oc::CA.ocphilicIT" + fieldnames(4) = "CA.oc::CA.ocphobicIT" + do k = 1, 4 + !call ESMF_FieldBundleGet(TRI, trim(itemNameList(k)), field=tmp_field, _RC) + !call ESMF_FieldBundleGet(TRI, trim(fieldnames(k)), field=tmp_field, _RC) + fieldname = trim(fieldnames(k)) + call ESMF_FieldBundleGet(TRI, fieldname, field=tmp_field, _RC) + + !call MAPL_AllocateCoupling(tmp_field, _RC) + + call ESMF_FieldGet(tmp_field,farrayPtr=ptr3d, rc=status) + !if (MAPL_AM_I_Root()) then + if ( status /=0 )then + print*, 'status, associated(ptr3d)', status, associated(ptr3d) + print*, "not created: ", fieldname + print*, "Add to historty.rc to triger the allocation" + _FAIL(" Not allocated diffusion tendency") + !else + ! print*, "createded: ", itemNameList(k) + ! print*, "assocated: ", associated(ptr3d), itemNameList(k) + endif + !endif + call create_extra_var(fieldname(8:)) + enddo + deallocate(fieldnames) + cycle + endif + call create_extra_var(trim(GigaTrajInternalPtr%ExtraFieldNames(i))) enddo endif @@ -1030,7 +1057,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) type(ESMF_TimeInterval) :: tint type(MAPL_MetaComp),pointer :: MPL character(len=ESMF_MAXSTR) :: parcels_file, other_fields - character(len=ESMF_MAXSTR), allocatable :: names(:) + character(len=ESMF_MAXSTR), allocatable :: varnames(:) character(len=:), allocatable:: var_name, var_ type (GigaTrajInternal), pointer :: GigaTrajInternalPtr @@ -1098,20 +1125,20 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) var_name = trim(GigaTrajInternalPtr%ExtraFieldNames(k)) end select - if ( index(GigaTrajInternalPtr%ExtraFieldNames(k), 'bcDP') /= 0 .or. & - index(GigaTrajInternalPtr%ExtraFieldNames(k), 'ocDP') /= 0 .or. & - index(GigaTrajInternalPtr%ExtraFieldNames(k), 'bcWT') /= 0 .or. & - index(GigaTrajInternalPtr%ExtraFieldNames(k), 'ocWT') /= 0 .or. & - index(GigaTrajInternalPtr%ExtraFieldNames(k), 'bcSD') /= 0 .or. & - index(GigaTrajInternalPtr%ExtraFieldNames(k), 'ocSD') /= 0 .or. & - index(GigaTrajInternalPtr%ExtraFieldNames(k), 'bcSV') /= 0 .or. & - index(GigaTrajInternalPtr%ExtraFieldNames(k), 'ocSV') /= 0 ) then - - call MAPL_GetPointer(state, field, GigaTrajInternalPtr%ExtraFieldNames(k) , _RC) + if ( index(var_name, 'bcDP') /= 0 .or. & + index(var_name, 'ocDP') /= 0 .or. & + index(var_name, 'bcWT') /= 0 .or. & + index(var_name, 'ocWT') /= 0 .or. & + index(var_name, 'bcSD') /= 0 .or. & + index(var_name, 'ocSD') /= 0 .or. & + index(var_name, 'bcSV') /= 0 .or. & + index(var_name, 'ocSV') /= 0 ) then + + call MAPL_GetPointer(state, field, var_name, _RC) count3 = size(field,3) allocate(values_2d(GigaTrajInternalPtr%parcels%num_parcels, count3)) - call get_metsrc_data2d (GC, state, ctime, GigaTrajInternalPtr%ExtraFieldNames(k), values_2d, RC ) - do i = 1, size(values_2d,2) + call get_metsrc_data2d (GC, state, ctime, var_name, values_2d, RC ) + do i = 1, count3 call gather_onefield(total_num, values0, comm, values_2d(:,i), GigaTrajInternalPtr%parcels%num_parcels) if (my_rank == 0) then @@ -1125,9 +1152,31 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) endif enddo deallocate(values_2d) + else if ( index(var_name, 'TRI') /= 0) then + allocate(values(GigaTrajInternalPtr%parcels%num_parcels)) + allocate(varnames(4)) + varnames(1) = "CA.bc::CA.bcphilicIT" + varnames(2) = "CA.bc::CA.bcphobicIT" + varnames(3) = "CA.oc::CA.ocphilicIT" + varnames(4) = "CA.oc::CA.ocphobicIT" + do i = 1, 4 + var_ = varnames(i)(8:) + call get_metsrc_data (GC, state, ctime, varnames(i), values, _RC) + call gather_onefield(total_num, values0, comm, values, GigaTrajInternalPtr%parcels%num_parcels) + + if (my_rank == 0) then + values0 = values0(ids0(:)+1) + if ( meta%has_variable(var_)) then + call formatter%put_var( var_, values0, start=[1, last_time+1], _RC) + else + print*, "Please provide "//var_ // " in the file "//trim(parcels_file) + endif + endif + enddo + deallocate(values, varnames) else allocate(values(GigaTrajInternalPtr%parcels%num_parcels)) - call get_metsrc_data (GC, state, ctime, trim(GigaTrajInternalPtr%ExtraFieldNames(k)), values, RC ) + call get_metsrc_data (GC, state, ctime, var_name, values, _RC ) call gather_onefield(total_num, values0, comm, values, GigaTrajInternalPtr%parcels%num_parcels) if (my_rank == 0) then @@ -1320,7 +1369,9 @@ subroutine get_metsrc_data (GC, state, ctime, fieldname, values, RC ) type(GigaTrajInternal), pointer :: GigaInternalPtr type (GigatrajInternalWrap) :: wrap - real, dimension(:,:,:), pointer :: field + type (ESMF_FieldBundle) :: TRI + type (ESMF_Field) :: field + real, dimension(:,:,:), pointer :: ptr3d real, dimension(:,:,:), allocatable :: field_latlon real, dimension(:,:,:), allocatable, target :: haloField integer :: counts(3), dims(3), d1,d2,km, count3 @@ -1328,8 +1379,15 @@ subroutine get_metsrc_data (GC, state, ctime, fieldname, values, RC ) Iam = "get_metsrc_data" - call MAPL_GetPointer(state, field, fieldname, _RC) - count3 = size(field,3) + if (index(fieldname,'philicIT') /=0 .or. index(fieldname,'phobicIT') /=0) then + call ESMF_StateGet(state, 'PHYSICS_Exports/TURBULENCE_Exports/TRI', TRI, _RC) + call ESMF_FieldBundleGet(TRI, fieldname, field=field, _RC) + call ESMF_FieldGet(field,farrayPtr=ptr3d, _RC) + else + call MAPL_GetPointer(state, ptr3d, fieldname, _RC) + endif + + count3 = size(ptr3d,3) call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) GigaInternalPtr => wrap%ptr @@ -1338,7 +1396,7 @@ subroutine get_metsrc_data (GC, state, ctime, fieldname, values, RC ) allocate(field_latlon(counts(1),counts(2),count3)) allocate(haloField(counts(1)+2, counts(2)+2,count3), source = 0.0) - call GigaInternalPtr%cube2latlon%regrid(field, Field_latlon, _RC) + call GigaInternalPtr%cube2latlon%regrid(ptr3d, Field_latlon, _RC) call esmf_halo(GigaInternalPtr%LatLonGrid, field_Latlon, haloField, _RC) From 1e792cf426392d6f0c2fec132551b933511c554e Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 26 Jul 2023 09:28:09 -0400 Subject: [PATCH 24/73] Interpolating from 72 to 48 levels to match Histroy output --- GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 | 18 +- .../GEOS_GigatrajGridComp.F90 | 310 ++++++++++++------ 2 files changed, 216 insertions(+), 112 deletions(-) diff --git a/GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 b/GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 index c5d4ec861..609e61b79 100644 --- a/GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 @@ -5,7 +5,7 @@ module GEOS_Giga_InterOpMod implicit none private - public :: initGigaGridLatLonField3d +! public :: initGigaGridLatLonField3d public :: initMetGEOSDistributedData public :: updateFields public :: rk4a_advance @@ -19,14 +19,14 @@ module GEOS_Giga_InterOpMod interface - function initGigaGridLatLonField3d(nlons, nlats, nzs, lons_ptr, lats_ptr, levs_ptr, name_ptr, & - units_ptr,ctime_ptr) result (field_ptr) bind(C, name="initGigaGridLatLonField3D") - import :: c_int, c_ptr - implicit none - integer(c_int), intent(in), value :: nlons, nlats, nzs - type(c_ptr), intent(in), value :: lons_ptr, lats_ptr, levs_ptr, name_ptr, units_ptr, ctime_ptr - type(c_ptr) :: field_ptr - end function +! function initGigaGridLatLonField3d(nlons, nlats, nzs, lons_ptr, lats_ptr, levs_ptr, name_ptr, & +! units_ptr,ctime_ptr) result (field_ptr) bind(C, name="initGigaGridLatLonField3D") +! import :: c_int, c_ptr +! implicit none +! integer(c_int), intent(in), value :: nlons, nlats, nzs +! type(c_ptr), intent(in), value :: lons_ptr, lats_ptr, levs_ptr, name_ptr, units_ptr, ctime_ptr +! type(c_ptr) :: field_ptr +! end function function initMetGEOSDistributedData(comm, ijToRank, Ig, Jg,lev, nlon_local, nlat_local, nzs, lons_ptr, lats_ptr, eta_ptr, ctime_ptr) result (metdata_ptr) bind(C, name="initGigaGridDistributedData") import :: c_int, c_ptr diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index 499a4deae..40dde5ab7 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -5,6 +5,7 @@ module GEOS_GigatrajGridCompMod use, intrinsic :: iso_c_binding, only : c_loc use ESMF use MAPL + use MAPL_VerticalDataMod use mpi use GEOS_Giga_interOpMod implicit none @@ -22,18 +23,21 @@ module GEOS_GigatrajGridCompMod integer :: npes integer :: npz ! number of pressure levels type (ESMF_Grid) :: LatLonGrid + type (ESMF_Grid) :: CubedGrid class (AbstractRegridder), pointer :: cube2latlon => null() integer, allocatable :: CellToRank(:,:) type(horde) :: parcels type(c_ptr) :: metSrc type(ESMF_Time) :: startTime character(len=ESMF_MAXSTR), allocatable :: ExtraFieldNames(:) + type(VerticalData) :: vdata end type type GigatrajInternalWrap type (GigaTrajInternal), pointer :: PTR end type + contains subroutine SetServices ( GC, RC ) @@ -88,6 +92,13 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, _RC) + call MAPL_AddInternalSpec ( gc, & + SHORT_NAME = 'PLE', & + LONG_NAME = 'edge_pressure', & + UNITS = 'Pa', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationEdge, _RC) + allocate(GigaTrajInternalPtr) wrap%ptr => GigaTrajInternalPtr call ESMF_UserCompSetInternalState(GC, 'GigaTrajInternal', wrap, _RC) @@ -120,11 +131,12 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: I1, I2, J1, J2, comm, npes, rank, ierror, NX, NY, NPZ type(ESMF_Grid) :: CubedGrid integer, allocatable :: I1s(:), J1s(:), I2s(:),J2s(:) - integer :: DIMS(3), counts(3), i,j,k + integer :: DIMS(3), counts(3), i,j,k, l type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap real :: dlat, dlon real, allocatable, target :: lats_center(:), lons_center(:), levs_center(:) + real, pointer :: levs_ptr(:) type (ESMF_TIME) :: CurrentTime character(len=20), target :: ctime character(len=:), allocatable, target :: name_, unit_ @@ -134,6 +146,9 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) type(ESMF_State) :: INTERNAL integer :: minutes_ character(len=ESMF_MAXSTR) :: parcels_file + character(len=ESMF_MAXSTR) :: grid_name + real(ESMF_KIND_R8), pointer :: centerX(:,:) + real(ESMF_KIND_R8), pointer :: centerY(:,:) call ESMF_GridCompGet ( GC, name=COMP_NAME, _RC ) Iam = trim(COMP_NAME) // "Initialize" @@ -176,39 +191,80 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_GridCompGet(GC, grid=CubedGrid, _RC) call MAPL_GridGet(CubedGrid, globalCellCountPerDim=DIMS, _RC) - + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, status); _VERIFY(STATUS) GigaTrajInternalPtr => wrap%ptr - GigaTrajInternalPtr%npes = npes call MAPL_MakeDecomposition(NX,NY,_RC) call MAPL_GridGet(CubedGrid, globalCellCountPerDim=DIMS, _RC) + levs_center = [1000., 975., 950., 925., 900., 875., 850., 825., 800., 775., 750., 725.,700., 650., 600., 550., 500., & + 450., 400., 350., 300., 250., 200., 150., 100., 70., 50., 40., 30., 20., 10., 7., 5., 4., 3., 2., & + 1., 0.7, 0.5, 0.4, 0.3, 0.2, 0.1, 0.07, 0.05, 0.04, 0.03, 0.02] + npz = size(levs_center, 1) + GigaTrajInternalPtr%LatLonGrid = grid_manager%make_grid( & - LatLonGridFactory(im_world=DIMS(1)*4, jm_world=DIMS(1)*2, lm=DIMS(3), & - nx=NX, ny=NY, pole='PE', dateline= 'DE', rc=status) ); _VERIFY(status) - - GigaTrajInternalPtr%cube2latlon => new_regridder_manager%make_regridder(CubedGrid, GigaTrajInternalPtr%LatLonGrid, REGRID_METHOD_CONSERVE, _RC) + LatLonGridFactory(im_world=DIMS(1)*4, jm_world=DIMS(1)*2+1, lm=npz, & + nx=NX, ny=NY, pole='PC', dateline= 'DC', rc=status) ); _VERIFY(status) + + call MAPL_GetResource(MPL, NX, "NX:", _RC) + call MAPL_GetResource(MPL, grid_name, "AGCM_GRIDNAME:", _RC) + + GigaTrajInternalPtr%CubedGrid = grid_manager%make_grid(& + CubedSphereGridFactory(grid_name=trim(grid_name),im_world = DIMS(1), lm=npz, nx=NX, ny=NX, rc=status)); _VERIFY(status) + + GigaTrajInternalPtr%cube2latlon => new_regridder_manager%make_regridder(GigaTrajInternalPtr%CubedGrid, GigaTrajInternalPtr%LatLonGrid, REGRID_METHOD_CONSERVE, _RC) call MAPL_Grid_interior(GigaTrajInternalPtr%LatLonGrid ,i1,i2,j1,j2) + !call ESMF_GridGetCoord(GigaTrajInternalPtr%LatLonGrid , coordDim=1, localDE=0, & + ! staggerloc=ESMF_STAGGERLOC_CENTER, & + ! farrayPtr=centerX, rc=status) + !VERIFY_(STATUS) + + !if (I1==1 .and. J1==1) then + ! do i = 1, I2 + ! do j = j1, j2 + ! print*, "centerX: ", centerX(i, j-j1+1), i, j-j1+1 + ! enddo + ! enddo + !endif + + !call ESMF_GridGetCoord(GigaTrajInternalPtr%LatLonGrid , coordDim=2, localDE=0, & + ! staggerloc=ESMF_STAGGERLOC_CENTER, & + ! farrayPtr=centerY, rc=status) + !VERIFY_(STATUS) + + !if (I1==1 .and. J1==1) then + ! do i = 1, I2 + ! do j = j1, j2 + ! print*, "centerY: ", centerY(i, j-j1+1), i, j-j1+1 + ! enddo + ! enddo + !endif + call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) + ! lat and lon centers need to hold the halo with width 1 + dlon = 360.0/dims(1) - ! lat and lon centers need to hold the halo - lons_center = [(-dlon/2+ dlon*i, i= i1-1, i2+1)] - where(lons_center < 0. ) lons_center = 0. - where(lons_center >360.) lons_center = 360. + ! DE + !lons_center = [(dlon*(i-1)+dlon/2., i= i1-1, i2+1)] + ! DC + lons_center = [(dlon*(i-1), i= i1-1, i2+1)] - dlat = 180.0/dims(2) - lats_center = [(-dlat/2. + dlat*j-90.0, j= j1-1, j2+1)] - where(lats_center <-90.) lats_center = -90. - where(lats_center >90. ) lats_center = 90. + !where(lons_center < 0. ) lons_center = 0. + !where(lons_center >360.) lons_center = 360. + + !PE + !dlat = 180.0/dims(2) + !lats_center = [(-dlat/2. + dlat*j-90.0, j= j1-1, j2+1)] + !PC + dlat = 180.0/(dims(2)-1) ! PC + lats_center = [(-90.0 + (j-1)*dlat, j= j1-1, j2+1)] + !where(lats_center <-90.) lats_center = -90. + !where(lats_center >90. ) lats_center = 90. - levs_center = [1000., 975., 950., 925., 900., 875., 850., 825., 800., 775., 750., 725.,700., 650., 600., 550., 500., & - 450., 400., 350., 300., 250., 200., 150., 100., 70., 50., 40., 30., 20., 10., 7., 5., 4., 3., 2., & - 1. , 0.6, 0.3, 0.1, 0.07, 0.04, 0.02, 0.01] - npz = size(levs_center, 1) GigaTrajInternalPtr%npz = npz call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) @@ -233,8 +289,12 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) GigaTrajInternalPtr%CellToRank(I1:I2,J1:J2) = rank enddo + ! WJiang notes: the vcoord should be consistent with the HISTORY.rc + levs_ptr=>levs_center + GigaTrajInternalPtr%vdata = VerticalData(levs_ptr, vcoord = 'log(PLE)', vscale = 100.0, vunit = 'hPa',_RC) + GigaTrajInternalPtr%metSrc = initMetGEOSDistributedData(comm, c_loc(GigaTrajInternalPtr%CellToRank), DIMS(1), DIMS(2), & - dims(3), counts(1)+2, counts(2)+2, npz, & + npz, counts(1)+2, counts(2)+2, npz, & c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), c_loc(ctime)) deallocate(lons_center, lats_center,levs_center) @@ -257,14 +317,14 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) type(ESMF_Clock), intent(inout) :: CLOCK integer, optional, intent( out) :: RC - integer :: i, status, k, FC + integer :: i, status, k, FC, l, lm character(len=ESMF_MAXSTR) :: IAm type (ESMF_State) :: INTERNAL, leaf_export type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap character(len=ESMF_MAXSTR) :: GigaRstFile character(len=ESMF_MAXSTR) :: other_fields - character(len=ESMF_MAXSTR) :: NAME + character(len=ESMF_MAXSTR) :: NAME type(ESMF_Field) :: tmp_field type (ESMF_FieldBundle) :: TRI type (ESMF_TIME) :: CurrentTime @@ -514,12 +574,13 @@ subroutine Init_metsrc_field0 (GC, state, ctime, PL, RC ) character(len=ESMF_MAXSTR) :: IAm integer :: STATUS - type(GigaTrajInternal), pointer :: GigaInternalPtr + type(GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap real, dimension(:,:,:), pointer :: U, V, W, P, PL0, PLE real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon, P_latlon + real, dimension(:,:,:), allocatable :: U_inter, V_inter, W_inter, P_inter real, dimension(:,:,:), allocatable, target :: haloU, haloV, haloW, haloP - integer :: counts(3), dims(3), d1,d2,km + integer :: counts(3), dims(3), d1,d2,km,lm,l Iam = "init_metsrc_field0" @@ -527,6 +588,7 @@ subroutine Init_metsrc_field0 (GC, state, ctime, PL, RC ) call MAPL_GetPointer(state, V, "V", _RC) call MAPL_GetPointer(state, W, "OMEGA", _RC) + PL0=>null() if (PL == 'PL') then call MAPL_GetPointer(state, P, "PL", _RC) @@ -543,29 +605,47 @@ subroutine Init_metsrc_field0 (GC, state, ctime, PL, RC ) endif call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) - GigaInternalPtr => wrap%ptr - call MAPL_GridGet(GigaInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) + GigaTrajInternalPtr => wrap%ptr + call ESMF_StateGet(state, 'PLE', field=GigaTrajInternalPtr%vdata%interp_var, rc=status) + call GigaTrajInternalPtr%vdata%setup_eta_to_pressure(_RC) + + call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) + !#lm = counts(3) + lm = size(GigaTrajInternalPtr%vdata%levs) - allocate(U_latlon(counts(1),counts(2),counts(3))) - allocate(V_latlon(counts(1),counts(2),counts(3))) - allocate(W_latlon(counts(1),counts(2),counts(3))) - allocate(P_latlon(counts(1),counts(2),counts(3))) + d1 =size(U,1) + d2 =size(U,2) - allocate(haloU(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) - allocate(haloV(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) - allocate(haloW(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) - allocate(haloP(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) + allocate(U_latlon(counts(1),counts(2),lm)) + allocate(V_latlon(counts(1),counts(2),lm)) + allocate(W_latlon(counts(1),counts(2),lm)) + allocate(P_latlon(counts(1),counts(2),lm)) - call GigaInternalPtr%cube2latlon%regrid(U, V, U_latlon, V_latlon, _RC) - call GigaInternalPtr%cube2latlon%regrid(W, W_latlon, _RC) - call GigaInternalPtr%cube2latlon%regrid(P, P_latlon, _RC) + allocate(U_inter(d1,d2,lm)) + allocate(V_inter(d1,d2,lm)) + allocate(W_inter(d1,d2,lm)) + allocate(P_inter(d1,d2,lm)) - call esmf_halo(GigaInternalPtr%LatLonGrid, U_Latlon, haloU, _RC) - call esmf_halo(GigaInternalPtr%LatLonGrid, V_Latlon, haloV, _RC) - call esmf_halo(GigaInternalPtr%LatLonGrid, W_Latlon, haloW, _RC) - call esmf_halo(GigaInternalPtr%LatLonGrid, P_Latlon, haloP, _RC) + allocate(haloU(counts(1)+2, counts(2)+2,lm), source = 0.0) + allocate(haloV(counts(1)+2, counts(2)+2,lm), source = 0.0) + allocate(haloW(counts(1)+2, counts(2)+2,lm), source = 0.0) + allocate(haloP(counts(1)+2, counts(2)+2,lm), source = 0.0) - call updateFields( GigaInternalPtr%metSrc, c_loc(ctime), c_loc(haloU), c_loc(haloV), c_loc(haloW), c_loc(haloP)) + call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(U, U_inter,rc=status) + call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(V, V_inter,rc=status) + call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(W, W_inter,rc=status) + call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(P, P_inter,rc=status) + + call GigaTrajInternalPtr%cube2latlon%regrid(U_inter, V_inter, U_latlon, V_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(W_inter, W_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(P_inter, P_latlon, _RC) + + call esmf_halo(GigaTrajInternalPtr%LatLonGrid, U_Latlon, haloU, _RC) + call esmf_halo(GigaTrajInternalPtr%LatLonGrid, V_Latlon, haloV, _RC) + call esmf_halo(GigaTrajInternalPtr%LatLonGrid, W_Latlon, haloW, _RC) + call esmf_halo(GigaTrajInternalPtr%LatLonGrid, P_Latlon, haloP, _RC) + + call updateFields( GigaTrajInternalPtr%metSrc, c_loc(ctime), c_loc(haloU), c_loc(haloV), c_loc(haloW), c_loc(haloP)) if(associated(PL0)) deallocate(PL0) RETURN_(ESMF_SUCCESS) @@ -596,23 +676,24 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap - integer :: num_parcels, my_rank + integer :: num_parcels, my_rank,lm, l, d1,d2 real, allocatable, target :: lats(:), lons(:), zs(:) real, allocatable, target :: U(:), V(:), W(:) integer ::counts(3), DIMS(3), rank, comm, ierror type (ESMF_VM) :: vm - real, dimension(:,:,:), pointer :: U_cube, V_cube, W_cube, p_cube, with_halo - real, dimension(:,:,:), pointer :: U_internal, V_internal, W_internal, P_internal + real, dimension(:,:,:), pointer :: U_cube, V_cube, W_cube, P_cube, PLE_Cube, with_halo + real, dimension(:,:,:), pointer :: U_internal, V_internal, W_internal, P_internal, PLE_internal real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon, P_latlon + real, dimension(:,:,:), allocatable :: U_inter, V_inter, W_inter, P_inter real, dimension(:,:,:), allocatable, target :: haloU, haloV, haloW, haloP real(ESMF_KIND_R8) :: DT type(ESMF_Field) :: halo_field type(ESMF_RouteHandle) :: rh - character(len=20), target :: ctime + character(len=20), target :: ctime, ctime0 type(ESMF_State) :: INTERNAL type(MAPL_MetaComp),pointer :: MPL character(len=ESMF_MAXSTR) :: parcels_file @@ -630,28 +711,14 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) ! W.J note: this run is after agcm's run. The clock is not yet ticked ! So the values we are using are at (CurrentTime + ModelTimeStep) + call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime0) + ctime0(20:20) = c_null_char CurrentTime = CurrentTime + ModelTimeStep call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) ctime(20:20) = c_null_char call ESMF_TimeIntervalGet(ModelTimeStep,d_r8=DT, _RC) - call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) - GigaTrajInternalPtr => wrap%ptr - - call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts, & - globalCellCountPerDim=DIMS, _RC) - - allocate(U_latlon(counts(1), counts(2),counts(3)), source = 0.0) - allocate(V_latlon(counts(1), counts(2),counts(3)), source = 0.0) - allocate(W_latlon(counts(1), counts(2),counts(3)), source = 0.0) - allocate(P_latlon(counts(1), counts(2),counts(3)), source = 0.0) - - allocate(haloU(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) - allocate(haloV(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) - allocate(haloW(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) - allocate(haloP(counts(1)+2, counts(2)+2,counts(3)), source = 0.0) - !--------------- ! Step 1) Regrid the metData field from cubed to lat-lon !--------------- @@ -660,10 +727,44 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(Import, V_cube, "V", _RC) call MAPL_GetPointer(Import, W_cube, "OMEGA", _RC) call MAPL_GetPointer(Import, P_cube, "PL", _RC) + call MAPL_GetPointer(Import, PLE_cube, "PLE", _RC) - call GigaTrajInternalPtr%cube2latlon%regrid(U_cube,V_cube, U_latlon, V_latlon, _RC) - call GigaTrajInternalPtr%cube2latlon%regrid(W_cube, W_latlon, _RC) - call GigaTrajInternalPtr%cube2latlon%regrid(P_cube, P_latlon, _RC) + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) + GigaTrajInternalPtr => wrap%ptr + + call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts, & + globalCellCountPerDim=DIMS, _RC) + !lm = counts(3) + lm = size(GigaTrajInternalPtr%vdata%levs) + d1 = size(u_cube,1) + d2 = size(u_cube,2) + allocate(U_inter(d1, d2,lm), source = 0.0) + allocate(V_inter(d1, d2,lm), source = 0.0) + allocate(W_inter(d1, d2,lm), source = 0.0) + allocate(P_inter(d1, d2,lm), source = 0.0) + + allocate(U_latlon(counts(1), counts(2),lm), source = 0.0) + allocate(V_latlon(counts(1), counts(2),lm), source = 0.0) + allocate(W_latlon(counts(1), counts(2),lm), source = 0.0) + allocate(P_latlon(counts(1), counts(2),lm), source = 0.0) + + allocate(haloU(counts(1)+2, counts(2)+2,lm), source = 0.0) + allocate(haloV(counts(1)+2, counts(2)+2,lm), source = 0.0) + allocate(haloW(counts(1)+2, counts(2)+2,lm), source = 0.0) + allocate(haloP(counts(1)+2, counts(2)+2,lm), source = 0.0) + + + call ESMF_StateGet(import, 'PLE', field=GigaTrajInternalPtr%vdata%interp_var, rc=status) + call GigaTrajInternalPtr%vdata%setup_eta_to_pressure(_RC) + + call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(U_cube, U_inter,rc=status) + call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(V_cube, V_inter,rc=status) + call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(W_cube, W_inter,rc=status) + call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(P_cube, P_inter,rc=status) + + call GigaTrajInternalPtr%cube2latlon%regrid(U_inter,V_inter, U_latlon, V_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(W_inter, W_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(P_inter, P_latlon, _RC) !--------------- ! Step 2) Get halo @@ -678,13 +779,13 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) !--------------- ! Step 3) Update !--------------- - + call updateFields( GigaTrajInternalPtr%metSrc, c_loc(ctime), c_loc(haloU), c_loc(haloV), c_loc(haloW), c_loc(haloP)) !--------------- ! Step 3) Time advance !--------------- - call rk4a_advance( GigaTrajInternalPtr%metSrc, c_loc(ctime), DT, GigaTrajInternalPtr%parcels%num_parcels, & + call rk4a_advance( GigaTrajInternalPtr%metSrc, c_loc(ctime0), DT, GigaTrajInternalPtr%parcels%num_parcels, & c_loc(GigaTrajInternalPtr%parcels%lons), & c_loc(GigaTrajInternalPtr%parcels%lats), & c_loc(GigaTrajInternalPtr%parcels%zs)) @@ -696,11 +797,13 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(INTERNAL, V_internal, "V", _RC) call MAPL_GetPointer(INTERNAL, W_internal, "OMEGA", _RC) call MAPL_GetPointer(INTERNAL, P_internal, "PL", _RC) + call MAPL_GetPointer(INTERNAL, PLE_internal, "PLE", _RC) U_internal = U_cube V_internal = V_cube W_internal = W_cube P_internal = P_cube + PLE_internal = PLE_cube deallocate( U_Latlon, V_latlon, W_latlon, P_latlon, haloU, haloV, haloW, haloP) @@ -826,10 +929,10 @@ subroutine rebalance_parcels(clock, parcels, CellToRank, comm, DIMS, rc) where (lons0 >360) lons0 =lons0 - 360.0 dlon = 360.0 / DIMS(1) - dlat = 180.0 / DIMS(2) - - II = min( max(ceiling (lons0 /dlon),1), DIMS(1)) - JJ = min( max(ceiling ((lats0 + 90.0)/dlat),1), DIMS(2)) + dlat = 180.0 / (DIMS(2)-1) + ! DC + II = min( max(ceiling ((lons0+dlon/2.)/dlon),1), DIMS(1)) + JJ = min( max(ceiling ((lats0+dlat/2.+ 90.0)/dlat),1), DIMS(2)) call MPI_Comm_size(comm, npes, ierror) call MPI_Comm_rank(comm, my_rank, ierror) @@ -919,11 +1022,12 @@ subroutine scatter_parcels(num_parcels0, lons0, lats0, zs0, IDs0, CellToRank, DI allocate(disp_send(npes), source = 0) if (my_rank == 0) then dlon = 360.0 / DIMS(1) - dlat = 180.0 / DIMS(2) + dlat = 180.0 / (DIMS(2)-1) !PC - where (lons0 < 0) lons0 =lons0 + 360.0 - II = min( max(ceiling (lons0 /dlon),1), DIMS(1)) - JJ = min( max(ceiling ((lats0 + 90.0)/dlat),1), DIMS(2)) + where (lons0 < 0) lons0 =lons0 + 360.0 + where (lons0 > 360) lons0 =lons0 - 360.0 + II = min( max(ceiling ((lons0+dlon/2.0) /dlon),1), DIMS(1)) + JJ = min( max(ceiling ((lats0+90.0+dlat/2.0)/dlat),1), DIMS(2)) allocate(ranks(num_parcels0)) do i = 1, num_parcels0 @@ -1095,7 +1199,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) ! reorder lats0 = lats0(ids0(:)+1) ! id is zero-bases, plus 1 Fortran lons0 = lons0(ids0(:)+1) - if (lon_start < 0 ) lons0 = lons0 - 180.0 ! temperary fix + lons0 = lons0 + lon_start zs0 = zs0(ids0(:)+1) call formatter%open(trim(parcels_file), pFIO_WRITE, _RC) meta = formatter%read(_RC) @@ -1105,7 +1209,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) call formatter%put_var('lat', lats0, start=[1, last_time+1], _RC) call formatter%put_var('lon', lons0, start=[1, last_time+1], _RC) - call formatter%put_var('p', zs0, start=[1, last_time+1], _RC) + call formatter%put_var('P', zs0, start=[1, last_time+1], _RC) call formatter%put_var('time', [tint_d], start=[last_time+1], _RC) endif @@ -1215,7 +1319,7 @@ subroutine read_parcels(GC,internal, rc) character(len=ESMF_MAXSTR) :: parcels_file type(MAPL_MetaComp),pointer :: MPL type (ESMF_VM) :: vm - class(Variable), pointer :: v + class(Variable), pointer :: t type(Attribute), pointer :: attr real :: lon_start class(*), pointer :: units @@ -1234,8 +1338,8 @@ subroutine read_parcels(GC,internal, rc) meta = formatter%read(_RC) total_num = meta%get_dimension('id', _RC) last_time = meta%get_dimension('time', _RC) - v => meta%get_variable('time', _RC) - attr => v%get_attribute('long_name') + t => meta%get_variable('time', _RC) + attr => t%get_attribute('long_name') units => attr%get_value() select type(units) type is (character(*)) @@ -1250,11 +1354,11 @@ subroutine read_parcels(GC,internal, rc) if (my_rank ==0) then call formatter%get_var('lat', lats0, start = [1,last_time], _RC) call formatter%get_var('lon', lons0, start = [1,last_time], _RC) - call formatter%get_var('p', zs0, start = [1,last_time], _RC) + call formatter%get_var('P', zs0, start = [1,last_time], _RC) call formatter%get_var('id', ids0_r,start = [1,last_time], _RC) call formatter%close(_RC) ids0 = int(ids0_r) - if (lon_start < 0) lons0 = lons0+180. + lons0 = lons0 - lon_start endif call MAPL_GridGet(internal%LatLonGrid, globalCellCountPerDim=DIMS, _RC) call scatter_parcels(total_num, lons0, lats0, zs0, IDs0, internal%CellToRank, DIMS, comm, & @@ -1367,7 +1471,7 @@ subroutine get_metsrc_data (GC, state, ctime, fieldname, values, RC ) character(len=ESMF_MAXSTR) :: IAm integer :: STATUS - type(GigaTrajInternal), pointer :: GigaInternalPtr + type(GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap type (ESMF_FieldBundle) :: TRI type (ESMF_Field) :: field @@ -1390,23 +1494,23 @@ subroutine get_metsrc_data (GC, state, ctime, fieldname, values, RC ) count3 = size(ptr3d,3) call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) - GigaInternalPtr => wrap%ptr - call MAPL_GridGet(GigaInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) + GigaTrajInternalPtr => wrap%ptr + call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) allocate(field_latlon(counts(1),counts(2),count3)) allocate(haloField(counts(1)+2, counts(2)+2,count3), source = 0.0) - call GigaInternalPtr%cube2latlon%regrid(ptr3d, Field_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(ptr3d, Field_latlon, _RC) - call esmf_halo(GigaInternalPtr%LatLonGrid, field_Latlon, haloField, _RC) + call esmf_halo(GigaTrajInternalPtr%LatLonGrid, field_Latlon, haloField, _RC) field_ = trim(fieldname)//c_null_char - call setData( GigaInternalPtr%metSrc, c_loc(ctime), c_loc(field_), c_loc(haloField)) - call getData(GigaInternalPtr%metSrc, c_loc(ctime), c_loc(field_), & - GigaInternalPtr%parcels%num_parcels, & - c_loc(GigaInternalPtr%parcels%lons), & - c_loc(GigaInternalPtr%parcels%lats), & - c_loc(GigaInternalPtr%parcels%zs), & + call setData( GigaTrajInternalPtr%metSrc, c_loc(ctime), c_loc(field_), c_loc(haloField)) + call getData(GigaTrajInternalPtr%metSrc, c_loc(ctime), c_loc(field_), & + GigaTrajInternalPtr%parcels%num_parcels, & + c_loc(GigaTrajInternalPtr%parcels%lons), & + c_loc(GigaTrajInternalPtr%parcels%lats), & + c_loc(GigaTrajInternalPtr%parcels%zs), & c_loc(values)) deallocate(field_latlon, haloField) @@ -1425,7 +1529,7 @@ subroutine get_metsrc_data2d (GC, state, ctime, fieldname, values, RC ) character(len=ESMF_MAXSTR) :: IAm integer :: STATUS - type(GigaTrajInternal), pointer :: GigaInternalPtr + type(GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap real, dimension(:,:,:), pointer :: field real, dimension(:,:,:), allocatable :: field_latlon @@ -1439,25 +1543,25 @@ subroutine get_metsrc_data2d (GC, state, ctime, fieldname, values, RC ) count3 = size(field,3) call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) - GigaInternalPtr => wrap%ptr - call MAPL_GridGet(GigaInternalPtr%LatLonGrid, localCellCountPerDim=counts, _RC) + GigaTrajInternalPtr => wrap%ptr + call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts, _RC) allocate(field_latlon(counts(1),counts(2),count3)) allocate(haloField(counts(1)+2, counts(2)+2,count3), source = 0.0) - call GigaInternalPtr%cube2latlon%regrid(field, Field_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(field, Field_latlon, _RC) - call esmf_halo(GigaInternalPtr%LatLonGrid, field_Latlon, haloField, _RC) + call esmf_halo(GigaTrajInternalPtr%LatLonGrid, field_Latlon, haloField, _RC) field_ = trim(fieldname)//'_2D'//c_null_char do i = 1,count3 - call setData( GigaInternalPtr%metSrc, c_loc(ctime), c_loc(field_), c_loc(haloField(1,1,i))) - call getData2d(GigaInternalPtr%metSrc, c_loc(ctime), c_loc(field_), & - GigaInternalPtr%parcels%num_parcels, & - c_loc(GigaInternalPtr%parcels%lons), & - c_loc(GigaInternalPtr%parcels%lats), & + call setData( GigaTrajInternalPtr%metSrc, c_loc(ctime), c_loc(field_), c_loc(haloField(1,1,i))) + call getData2d(GigaTrajInternalPtr%metSrc, c_loc(ctime), c_loc(field_), & + GigaTrajInternalPtr%parcels%num_parcels, & + c_loc(GigaTrajInternalPtr%parcels%lons), & + c_loc(GigaTrajInternalPtr%parcels%lats), & c_loc(values(1,i))) enddo From b6604e7d0326cf93f6d82da438690ee7ae1dba23 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 5 Sep 2023 11:26:18 -0400 Subject: [PATCH 25/73] added feature without regridding to latlon --- GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 | 21 +- .../GEOS_GigatrajGridComp.F90 | 332 ++++++++++++------ 2 files changed, 226 insertions(+), 127 deletions(-) diff --git a/GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 b/GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 index 609e61b79..e1a12e741 100644 --- a/GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 @@ -5,8 +5,8 @@ module GEOS_Giga_InterOpMod implicit none private -! public :: initGigaGridLatLonField3d - public :: initMetGEOSDistributedData + public :: initMetGEOSDistributedLatLonData + public :: initMetGEOSDistributedCubedData public :: updateFields public :: rk4a_advance public :: setData @@ -19,16 +19,15 @@ module GEOS_Giga_InterOpMod interface -! function initGigaGridLatLonField3d(nlons, nlats, nzs, lons_ptr, lats_ptr, levs_ptr, name_ptr, & -! units_ptr,ctime_ptr) result (field_ptr) bind(C, name="initGigaGridLatLonField3D") -! import :: c_int, c_ptr -! implicit none -! integer(c_int), intent(in), value :: nlons, nlats, nzs -! type(c_ptr), intent(in), value :: lons_ptr, lats_ptr, levs_ptr, name_ptr, units_ptr, ctime_ptr -! type(c_ptr) :: field_ptr -! end function + function initMetGEOSDistributedCubedData(comm, ijToRank, Ig, lev, i1, i2, j1, j2, nzs, lons_ptr, lats_ptr, eta_ptr, ctime_ptr) result (metdata_ptr) bind(C, name="initGigaGridDistributedCubedData") + import :: c_int, c_ptr + implicit none + integer(c_int), intent(in), value :: comm, Ig, lev, i1,i2,j1,j2, nzs + type(c_ptr), intent(in), value :: ijToRank, lons_ptr, lats_ptr, eta_ptr, ctime_ptr + type(c_ptr) :: metdata_ptr + end function - function initMetGEOSDistributedData(comm, ijToRank, Ig, Jg,lev, nlon_local, nlat_local, nzs, lons_ptr, lats_ptr, eta_ptr, ctime_ptr) result (metdata_ptr) bind(C, name="initGigaGridDistributedData") + function initMetGEOSDistributedLatLonData(comm, ijToRank, Ig, Jg,lev, nlon_local, nlat_local, nzs, lons_ptr, lats_ptr, eta_ptr, ctime_ptr) result (metdata_ptr) bind(C, name="initGigaGridDistributedLatLonData") import :: c_int, c_ptr implicit none integer(c_int), intent(in), value :: comm, Ig, Jg, lev, nlon_local, nlat_local, nzs diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index 40dde5ab7..02954bfb0 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -31,6 +31,7 @@ module GEOS_GigatrajGridCompMod type(ESMF_Time) :: startTime character(len=ESMF_MAXSTR), allocatable :: ExtraFieldNames(:) type(VerticalData) :: vdata + logical :: regrid_to_latlon end type type GigatrajInternalWrap @@ -128,15 +129,16 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Local derived type aliases type (MAPL_MetaComp), pointer :: MPL type (ESMF_VM) :: vm - integer :: I1, I2, J1, J2, comm, npes, rank, ierror, NX, NY, NPZ + integer :: I1, I2, J1, J2, comm, npes, my_rank, rank, ierror, NX, NY, NPZ type(ESMF_Grid) :: CubedGrid integer, allocatable :: I1s(:), J1s(:), I2s(:),J2s(:) - integer :: DIMS(3), counts(3), i,j,k, l + integer :: DIMS(3), counts(3), i, j, k, l type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap - real :: dlat, dlon + real :: dlat, dlon, lon_start real, allocatable, target :: lats_center(:), lons_center(:), levs_center(:) - real, pointer :: levs_ptr(:) + real, allocatable, target :: cube_lats_center(:, :), cube_lons_center(:,:) + real, pointer :: levs_ptr(:), ptr(:,:) type (ESMF_TIME) :: CurrentTime character(len=20), target :: ctime character(len=:), allocatable, target :: name_, unit_ @@ -144,11 +146,14 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) type(ESMF_TimeInterval) :: parcels_DT, Rebalance_DT type(ESMF_TimeInterval) :: ModelTimeStep type(ESMF_State) :: INTERNAL - integer :: minutes_ + integer :: minutes_, imc, jmc character(len=ESMF_MAXSTR) :: parcels_file character(len=ESMF_MAXSTR) :: grid_name + character(len=ESMF_MAXSTR) :: regrid_to_latlon real(ESMF_KIND_R8), pointer :: centerX(:,:) real(ESMF_KIND_R8), pointer :: centerY(:,:) + type(ESMF_Field) :: field + type(ESMF_RouteHandle) :: rh call ESMF_GridCompGet ( GC, name=COMP_NAME, _RC ) Iam = trim(COMP_NAME) // "Initialize" @@ -188,24 +193,20 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_VMGetCurrent(vm, _RC) call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) call MPI_Comm_size(comm, npes, ierror); _VERIFY(ierror) - - call ESMF_GridCompGet(GC, grid=CubedGrid, _RC) - call MAPL_GridGet(CubedGrid, globalCellCountPerDim=DIMS, _RC) + call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, status); _VERIFY(STATUS) GigaTrajInternalPtr => wrap%ptr GigaTrajInternalPtr%npes = npes - call MAPL_MakeDecomposition(NX,NY,_RC) + + call ESMF_GridCompGet(GC, grid=CubedGrid, _RC) call MAPL_GridGet(CubedGrid, globalCellCountPerDim=DIMS, _RC) levs_center = [1000., 975., 950., 925., 900., 875., 850., 825., 800., 775., 750., 725.,700., 650., 600., 550., 500., & 450., 400., 350., 300., 250., 200., 150., 100., 70., 50., 40., 30., 20., 10., 7., 5., 4., 3., 2., & 1., 0.7, 0.5, 0.4, 0.3, 0.2, 0.1, 0.07, 0.05, 0.04, 0.03, 0.02] npz = size(levs_center, 1) - - GigaTrajInternalPtr%LatLonGrid = grid_manager%make_grid( & - LatLonGridFactory(im_world=DIMS(1)*4, jm_world=DIMS(1)*2+1, lm=npz, & - nx=NX, ny=NY, pole='PC', dateline= 'DC', rc=status) ); _VERIFY(status) + GigaTrajInternalPtr%npz = npz call MAPL_GetResource(MPL, NX, "NX:", _RC) call MAPL_GetResource(MPL, grid_name, "AGCM_GRIDNAME:", _RC) @@ -213,59 +214,88 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) GigaTrajInternalPtr%CubedGrid = grid_manager%make_grid(& CubedSphereGridFactory(grid_name=trim(grid_name),im_world = DIMS(1), lm=npz, nx=NX, ny=NX, rc=status)); _VERIFY(status) - GigaTrajInternalPtr%cube2latlon => new_regridder_manager%make_regridder(GigaTrajInternalPtr%CubedGrid, GigaTrajInternalPtr%LatLonGrid, REGRID_METHOD_CONSERVE, _RC) - - call MAPL_Grid_interior(GigaTrajInternalPtr%LatLonGrid ,i1,i2,j1,j2) - !call ESMF_GridGetCoord(GigaTrajInternalPtr%LatLonGrid , coordDim=1, localDE=0, & - ! staggerloc=ESMF_STAGGERLOC_CENTER, & - ! farrayPtr=centerX, rc=status) - !VERIFY_(STATUS) - - !if (I1==1 .and. J1==1) then - ! do i = 1, I2 - ! do j = j1, j2 - ! print*, "centerX: ", centerX(i, j-j1+1), i, j-j1+1 - ! enddo - ! enddo - !endif - - !call ESMF_GridGetCoord(GigaTrajInternalPtr%LatLonGrid , coordDim=2, localDE=0, & - ! staggerloc=ESMF_STAGGERLOC_CENTER, & - ! farrayPtr=centerY, rc=status) - !VERIFY_(STATUS) - - !if (I1==1 .and. J1==1) then - ! do i = 1, I2 - ! do j = j1, j2 - ! print*, "centerY: ", centerY(i, j-j1+1), i, j-j1+1 - ! enddo - ! enddo - !endif + call MAPL_GetResource(MPL, regrid_to_latlon, "GIGATRAJ_REGRID_TO_LATLON:", default='YES', _RC) + GigaTrajInternalPtr%regrid_to_latlon = .true. - call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) + if (trim(regrid_to_latlon) == "NO") GigaTrajInternalPtr%regrid_to_latlon = .false. + + if ( GigaTrajInternalPtr%regrid_to_latlon ) then - ! lat and lon centers need to hold the halo with width 1 + call MAPL_MakeDecomposition(NX,NY,_RC) - dlon = 360.0/dims(1) - ! DE - !lons_center = [(dlon*(i-1)+dlon/2., i= i1-1, i2+1)] - ! DC - lons_center = [(dlon*(i-1), i= i1-1, i2+1)] + GigaTrajInternalPtr%LatLonGrid = grid_manager%make_grid( & + LatLonGridFactory(im_world=DIMS(1)*4, jm_world=DIMS(1)*2+1, lm=npz, & + nx=NX, ny=NY, pole='PC', dateline= 'DC', rc=status) ); _VERIFY(status) - !where(lons_center < 0. ) lons_center = 0. - !where(lons_center >360.) lons_center = 360. + GigaTrajInternalPtr%cube2latlon => new_regridder_manager%make_regridder(GigaTrajInternalPtr%CubedGrid, GigaTrajInternalPtr%LatLonGrid, REGRID_METHOD_CONSERVE, _RC) - !PE - !dlat = 180.0/dims(2) - !lats_center = [(-dlat/2. + dlat*j-90.0, j= j1-1, j2+1)] - !PC - dlat = 180.0/(dims(2)-1) ! PC - lats_center = [(-90.0 + (j-1)*dlat, j= j1-1, j2+1)] - !where(lats_center <-90.) lats_center = -90. - !where(lats_center >90. ) lats_center = 90. + call MAPL_Grid_interior(GigaTrajInternalPtr%LatLonGrid ,i1,i2,j1,j2) + call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) - GigaTrajInternalPtr%npz = npz + ! lat and lon centers need to hold the halo with width 1 + + dlon = 360.0/dims(1) + ! DE + !lons_center = [(dlon*(i-1)+dlon/2., i= i1-1, i2+1)] + ! DC + lons_center = [(dlon*(i-1), i= i1-1, i2+1)] + + !where(lons_center < 0. ) lons_center = 0. + !where(lons_center >360.) lons_center = 360. + + !PE + !dlat = 180.0/dims(2) + !lats_center = [(-dlat/2. + dlat*j-90.0, j= j1-1, j2+1)] + !PC + dlat = 180.0/(dims(2)-1) ! PC + lats_center = [(-90.0 + (j-1)*dlat, j= j1-1, j2+1)] + !where(lats_center <-90.) lats_center = -90. + !where(lats_center >90. ) lats_center = 90. + + else + + call MAPL_Grid_interior(CubedGrid ,i1,i2,j1,j2) + imc = i2-i1 + 1 + jmc = j2-j1 + 1 + allocate(cube_lats_center(imc+2, jmc+2)) + allocate(cube_lons_center(imc+2, jmc+2)) + allocate(ptr(0:imc+1, 0:jmc+1)) + + call ESMF_GridGetCoord(CubedGrid, coordDim=1, localDE=0, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=centerX, rc=status) + VERIFY_(STATUS) + + field = ESMF_FieldCreate(CubedGrid,ptr,staggerLoc=ESMF_STAGGERLOC_CENTER,totalLWidth=[1,1],totalUWidth=[1,1],rc=status) + _VERIFY(status) + call ESMF_FieldHaloStore(field,rh,rc=status) + _VERIFY(status) + + ptr(1:imc,1:jmc)=centerX + call ESMF_FieldHalo(field,rh,rc=status) + _VERIFY(status) + cube_lons_center = ptr + + call ESMF_GridGetCoord(CubedGrid , coordDim=2, localDE=0, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=centerY, rc=status) + VERIFY_(STATUS) + ptr(1:imc,1:jmc)=centerY + call ESMF_FieldHalo(field,rh,rc=status) + _VERIFY(status) + cube_lats_center = ptr + + deallocate(ptr) + call ESMF_FieldDestroy(field,rc=status) + _VERIFY(status) + call ESMF_FieldHaloRelease(rh,rc=status) + _VERIFY(status) + + cube_lons_center = cube_lons_center*180.0/MAPL_PI + cube_lats_center = cube_lats_center*180.0/MAPL_PI + + endif call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) ctime(20:20) = c_null_char @@ -278,9 +308,8 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call MPI_Allgather(j1, 1, MPI_INTEGER, J1s, 1, MPI_INTEGER, comm, ierror); _VERIFY(ierror) call MPI_Allgather(j2, 1, MPI_INTEGER, J2s, 1, MPI_INTEGER, comm, ierror); _VERIFY(ierror) - call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, globalCellCountPerDim=DIMS, _RC) + allocate(GigaTrajInternalPtr%CellToRank(DIMS(1),DIMS(2))) - allocate(GigaTrajInternalPtr%CellToRank(DIMS(1),DIMS(2))) do rank = 0, npes -1 I1 = I1s(rank+1) I2 = I2s(rank+1) @@ -293,17 +322,25 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) levs_ptr=>levs_center GigaTrajInternalPtr%vdata = VerticalData(levs_ptr, vcoord = 'log(PLE)', vscale = 100.0, vunit = 'hPa',_RC) - GigaTrajInternalPtr%metSrc = initMetGEOSDistributedData(comm, c_loc(GigaTrajInternalPtr%CellToRank), DIMS(1), DIMS(2), & + if (GigaTrajInternalPtr%regrid_to_latlon) then + call MAPL_Grid_interior(GigaTrajInternalPtr%LatLonGrid,i1,i2,j1,j2) + GigaTrajInternalPtr%metSrc = initMetGEOSDistributedLatLonData(comm, c_loc(GigaTrajInternalPtr%CellToRank), DIMS(1), DIMS(2), & npz, counts(1)+2, counts(2)+2, npz, & c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), c_loc(ctime)) + deallocate(lons_center, lats_center,levs_center) + else + call MAPL_Grid_interior(CubedGrid ,i1,i2,j1,j2) + GigaTrajInternalPtr%metSrc = initMetGEOSDistributedCubedData(comm, c_loc(GigaTrajInternalPtr%CellToRank), DIMS(1), & + npz, i1, i2, j1, j2, npz, & + c_loc(cube_lons_center), c_loc(cube_lats_center), c_loc(levs_center), c_loc(ctime)) + deallocate(cube_lons_center, cube_lats_center,levs_center) - deallocate(lons_center, lats_center,levs_center) + endif call read_parcels(GC, GigaTrajInternalPtr, _RC) call MAPL_TimerOff(MPL,"INITIALIZE") call MAPL_TimerOff(MPL,"TOTAL") - RETURN_(ESMF_SUCCESS) end subroutine Initialize @@ -609,7 +646,11 @@ subroutine Init_metsrc_field0 (GC, state, ctime, PL, RC ) call ESMF_StateGet(state, 'PLE', field=GigaTrajInternalPtr%vdata%interp_var, rc=status) call GigaTrajInternalPtr%vdata%setup_eta_to_pressure(_RC) - call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) + if (GigaTrajInternalPtr%regrid_to_latlon) then + call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) + else + call MAPL_GridGet(GigaTrajInternalPtr%CubedGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) + endif !#lm = counts(3) lm = size(GigaTrajInternalPtr%vdata%levs) @@ -635,15 +676,21 @@ subroutine Init_metsrc_field0 (GC, state, ctime, PL, RC ) call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(V, V_inter,rc=status) call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(W, W_inter,rc=status) call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(P, P_inter,rc=status) - - call GigaTrajInternalPtr%cube2latlon%regrid(U_inter, V_inter, U_latlon, V_latlon, _RC) - call GigaTrajInternalPtr%cube2latlon%regrid(W_inter, W_latlon, _RC) - call GigaTrajInternalPtr%cube2latlon%regrid(P_inter, P_latlon, _RC) - - call esmf_halo(GigaTrajInternalPtr%LatLonGrid, U_Latlon, haloU, _RC) - call esmf_halo(GigaTrajInternalPtr%LatLonGrid, V_Latlon, haloV, _RC) - call esmf_halo(GigaTrajInternalPtr%LatLonGrid, W_Latlon, haloW, _RC) - call esmf_halo(GigaTrajInternalPtr%LatLonGrid, P_Latlon, haloP, _RC) + if ( GigaTrajInternalPtr%regrid_to_latlon) then + call GigaTrajInternalPtr%cube2latlon%regrid(U_inter, V_inter, U_latlon, V_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(W_inter, W_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(P_inter, P_latlon, _RC) + + call esmf_halo(GigaTrajInternalPtr%LatLonGrid, U_Latlon, haloU, _RC) + call esmf_halo(GigaTrajInternalPtr%LatLonGrid, V_Latlon, haloV, _RC) + call esmf_halo(GigaTrajInternalPtr%LatLonGrid, W_Latlon, haloW, _RC) + call esmf_halo(GigaTrajInternalPtr%LatLonGrid, P_Latlon, haloP, _RC) + else + call esmf_halo(GigaTrajInternalPtr%CubedGrid, U_inter, haloU, _RC) + call esmf_halo(GigaTrajInternalPtr%CubedGrid, V_inter, haloV, _RC) + call esmf_halo(GigaTrajInternalPtr%CubedGrid, W_inter, haloW, _RC) + call esmf_halo(GigaTrajInternalPtr%CubedGrid, P_inter, haloP, _RC) + endif call updateFields( GigaTrajInternalPtr%metSrc, c_loc(ctime), c_loc(haloU), c_loc(haloV), c_loc(haloW), c_loc(haloP)) @@ -672,6 +719,7 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) character(64) :: format_string type(ESMF_TimeInterval) :: ModelTimeStep type(ESMF_Time) :: CurrentTime + type(ESMF_Grid) :: grid_ type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap @@ -732,9 +780,6 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) GigaTrajInternalPtr => wrap%ptr - call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts, & - globalCellCountPerDim=DIMS, _RC) - !lm = counts(3) lm = size(GigaTrajInternalPtr%vdata%levs) d1 = size(u_cube,1) d2 = size(u_cube,2) @@ -743,10 +788,20 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) allocate(W_inter(d1, d2,lm), source = 0.0) allocate(P_inter(d1, d2,lm), source = 0.0) - allocate(U_latlon(counts(1), counts(2),lm), source = 0.0) - allocate(V_latlon(counts(1), counts(2),lm), source = 0.0) - allocate(W_latlon(counts(1), counts(2),lm), source = 0.0) - allocate(P_latlon(counts(1), counts(2),lm), source = 0.0) + if (GigaTrajInternalPtr%regrid_to_latlon) then + grid_ = GigaTrajInternalPtr%LatLonGrid + call MAPL_GridGet(grid_, localCellCountPerDim=counts, & + globalCellCountPerDim=DIMS, _RC) + + allocate(U_latlon(counts(1), counts(2),lm), source = 0.0) + allocate(V_latlon(counts(1), counts(2),lm), source = 0.0) + allocate(W_latlon(counts(1), counts(2),lm), source = 0.0) + allocate(P_latlon(counts(1), counts(2),lm), source = 0.0) + else + grid_ = GigaTrajInternalPtr%CubedGrid + call MAPL_GridGet(grid_, localCellCountPerDim=counts, & + globalCellCountPerDim=DIMS, _RC) + endif allocate(haloU(counts(1)+2, counts(2)+2,lm), source = 0.0) allocate(haloV(counts(1)+2, counts(2)+2,lm), source = 0.0) @@ -762,19 +817,29 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(W_cube, W_inter,rc=status) call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(P_cube, P_inter,rc=status) - call GigaTrajInternalPtr%cube2latlon%regrid(U_inter,V_inter, U_latlon, V_latlon, _RC) - call GigaTrajInternalPtr%cube2latlon%regrid(W_inter, W_latlon, _RC) - call GigaTrajInternalPtr%cube2latlon%regrid(P_inter, P_latlon, _RC) + if (GigaTrajInternalPtr%regrid_to_latlon) then + + call GigaTrajInternalPtr%cube2latlon%regrid(U_inter,V_inter, U_latlon, V_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(W_inter, W_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(P_inter, P_latlon, _RC) + endif !--------------- ! Step 2) Get halo !--------------- - call esmf_halo(GigaTrajInternalPtr%LatLonGrid, U_Latlon, haloU, _RC) - call esmf_halo(GigaTrajInternalPtr%LatLonGrid, V_Latlon, haloV, _RC) - call esmf_halo(GigaTrajInternalPtr%LatLonGrid, W_Latlon, haloW, _RC) - call esmf_halo(GigaTrajInternalPtr%LatLonGrid, P_Latlon, haloP, _RC) + if (GigaTrajInternalPtr%regrid_to_latlon) then + call esmf_halo(grid_, U_Latlon, haloU, _RC) + call esmf_halo(grid_, V_Latlon, haloV, _RC) + call esmf_halo(grid_, W_Latlon, haloW, _RC) + call esmf_halo(grid_, P_Latlon, haloP, _RC) + else + call esmf_halo(grid_, U_inter, haloU, _RC) + call esmf_halo(grid_, V_inter, haloV, _RC) + call esmf_halo(grid_, W_inter, haloW, _RC) + call esmf_halo(grid_, P_inter, haloP, _RC) + endif !--------------- ! Step 3) Update @@ -804,14 +869,14 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) W_internal = W_cube P_internal = P_cube PLE_internal = PLE_cube - - deallocate( U_Latlon, V_latlon, W_latlon, P_latlon, haloU, haloV, haloW, haloP) + + if (allocated(U_Latlon)) deallocate( U_Latlon, V_latlon, W_latlon, P_latlon) + deallocate(haloU, haloV, haloW, haloP) !--------------- ! Step 5) rebalance parcels among processors ( configurable with alarm) !--------------- - call rebalance_parcels(clock, GigaTrajInternalPtr%parcels, GigaTrajInternalPtr%CellToRank, comm, DIMS, _RC) - + call rebalance_parcels(clock, GigaTrajInternalPtr%parcels, GigaTrajInternalPtr%CellToRank, comm, grid_, _RC) !--------------- ! Step 6) write out parcel positions and related fields ( configurable with alarm) !--------------- @@ -890,14 +955,16 @@ subroutine esmf_halo(grid, Field,haloField, rc) end subroutine esmf_halo ! move the parcels to the PE where they belong to - subroutine rebalance_parcels(clock, parcels, CellToRank, comm, DIMS, rc) + subroutine rebalance_parcels(clock, parcels, CellToRank, comm, grid, rc) type(ESMF_Clock), intent(inout) :: CLOCK ! The clock type(horde), intent(inout) :: parcels integer, dimension(:,:), intent(in) :: CellToRank - integer :: comm, DIMS(3) + integer :: comm + type(ESMF_Grid), intent(inout) :: grid integer, optional, intent(out) :: rc integer :: status + integer :: DIMS(3) character(len=:), allocatable :: Iam integer :: num_parcels0, num_parcels real, dimension(:), allocatable :: lons0, lats0, zs0 @@ -925,14 +992,23 @@ subroutine rebalance_parcels(clock, parcels, CellToRank, comm, DIMS, rc) call move_alloc( parcels%zs, zs0) call move_alloc( parcels%IDs, IDs0) num_parcels0 = parcels%num_parcels + where (lons0 < 0) lons0 =lons0 + 360.0 where (lons0 >360) lons0 =lons0 - 360.0 - dlon = 360.0 / DIMS(1) - dlat = 180.0 / (DIMS(2)-1) - ! DC - II = min( max(ceiling ((lons0+dlon/2.)/dlon),1), DIMS(1)) - JJ = min( max(ceiling ((lats0+dlat/2.+ 90.0)/dlat),1), DIMS(2)) + allocate(II(num_parcels0), JJ(num_parcels0)) + call MAPL_GridGet(Grid, globalCellCountPerDim=DIMS) + if (DIMS(2) == 6*DIMS(1)) then + call MAPL_GetGlobalHorzIJIndex(num_parcels0, II, JJ, lons0/180.0*MAPL_PI, lats0/180.0*MAPL_PI, Grid=Grid, rc=status) + else + + dlon = 360.0 / DIMS(1) + dlat = 180.0 / (DIMS(2)-1) + ! DC + II = min( max(ceiling ((lons0+dlon/2.)/dlon),1), DIMS(1)) + JJ = min( max(ceiling ((lats0+dlat/2.+ 90.0)/dlat),1), DIMS(2)) + + endif call MPI_Comm_size(comm, npes, ierror) call MPI_Comm_rank(comm, my_rank, ierror) @@ -995,18 +1071,20 @@ subroutine rebalance_parcels(clock, parcels, CellToRank, comm, DIMS, rc) end subroutine rebalance_parcels ! Scatter parcels from root after reading parcels file - subroutine scatter_parcels(num_parcels0, lons0, lats0, zs0, IDs0, CellToRank, DIMS, comm, lons, lats, zs, IDs, num_parcels) + subroutine scatter_parcels(num_parcels0, lons0, lats0, zs0, IDs0, CellToRank, Grid, comm, lons, lats, zs, IDs, num_parcels) integer :: num_parcels0 real, dimension(:), intent(inout) :: lons0 real, dimension(:), intent(in) :: lats0, zs0 integer, dimension(:), intent(in) :: IDs0 integer, dimension(:,:), intent(in) :: CellToRank - integer :: comm, DIMS(3) + type(ESMF_GRID), intent(inout) :: Grid + integer, intent(in) :: comm real, dimension(:), allocatable, intent(out) :: lons, lats, zs integer, dimension(:), allocatable, intent(out) :: IDs integer, intent(out) :: num_parcels - integer :: i, npes, ierror, rank, my_rank, counts_recv, pos + integer :: DIMS(3) + integer :: i, npes, ierror, rank, my_rank, counts_recv, pos, status real :: dlon, dlat real, allocatable :: lons_send(:), lats_send(:), zs_send(:) @@ -1018,16 +1096,24 @@ subroutine scatter_parcels(num_parcels0, lons0, lats0, zs0, IDs0, CellToRank, DI call MPI_Comm_size(comm, npes, ierror) call MPI_Comm_rank(comm, my_rank, ierror) + call MAPL_GridGet(Grid, globalCellCountPerDim=DIMS) + + allocate(II(num_parcels0), JJ(num_parcels0)) + allocate(counts_send(npes), source = 0) allocate(disp_send(npes), source = 0) if (my_rank == 0) then - dlon = 360.0 / DIMS(1) - dlat = 180.0 / (DIMS(2)-1) !PC - - where (lons0 < 0) lons0 =lons0 + 360.0 - where (lons0 > 360) lons0 =lons0 - 360.0 - II = min( max(ceiling ((lons0+dlon/2.0) /dlon),1), DIMS(1)) - JJ = min( max(ceiling ((lats0+90.0+dlat/2.0)/dlat),1), DIMS(2)) + if (DIMS(2) == 6*DIMS(1)) then + call MAPL_GetGlobalHorzIJIndex(num_parcels0, II, JJ, lons0/180.0*MAPL_PI, lats0/180.0*MAPL_PI, Grid=Grid, rc=status) + else + dlon = 360.0 / DIMS(1) + dlat = 180.0 / (DIMS(2)-1) !PC + + where (lons0 < 0) lons0 =lons0 + 360.0 + where (lons0 > 360) lons0 =lons0 - 360.0 + II = min( max(ceiling ((lons0+dlon/2.0) /dlon),1), DIMS(1)) + JJ = min( max(ceiling ((lats0+90.0+dlat/2.0)/dlat),1), DIMS(2)) + endif allocate(ranks(num_parcels0)) do i = 1, num_parcels0 @@ -1199,7 +1285,10 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) ! reorder lats0 = lats0(ids0(:)+1) ! id is zero-bases, plus 1 Fortran lons0 = lons0(ids0(:)+1) - lons0 = lons0 + lon_start + !lons0 = lons0 + lon_start + if (lon_start < 0.) then + where (lons0 > 180.0) lons0 = lons0 - 360. + endif zs0 = zs0(ids0(:)+1) call formatter%open(trim(parcels_file), pFIO_WRITE, _RC) meta = formatter%read(_RC) @@ -1317,6 +1406,7 @@ subroutine read_parcels(GC,internal, rc) integer, allocatable :: ids0(:) integer :: status character(len=ESMF_MAXSTR) :: parcels_file + character(len=ESMF_MAXSTR) :: regrid_to_latlon type(MAPL_MetaComp),pointer :: MPL type (ESMF_VM) :: vm class(Variable), pointer :: t @@ -1358,19 +1448,29 @@ subroutine read_parcels(GC,internal, rc) call formatter%get_var('id', ids0_r,start = [1,last_time], _RC) call formatter%close(_RC) ids0 = int(ids0_r) - lons0 = lons0 - lon_start + !lons0 = lons0 - lon_start + where (lons0<0) lons0 = lons0 + 360. endif - call MAPL_GridGet(internal%LatLonGrid, globalCellCountPerDim=DIMS, _RC) - call scatter_parcels(total_num, lons0, lats0, zs0, IDs0, internal%CellToRank, DIMS, comm, & + call MAPL_GetResource(MPL, regrid_to_latlon, "GIGATRAJ_REGRID_TO_LATLON:", default= 'YES' , _RC) + if (trim (regrid_to_latlon) == 'YES') then + call scatter_parcels(total_num, lons0, lats0, zs0, IDs0, internal%CellToRank, internal%LatLonGrid, comm, & Internal%parcels%lons, & Internal%parcels%lats, & Internal%parcels%zs, & Internal%parcels%IDS, & Internal%parcels%num_parcels) + else + call scatter_parcels(total_num, lons0, lats0, zs0, IDs0, internal%CellToRank, internal%CubedGrid, comm, & + Internal%parcels%lons, & + Internal%parcels%lats, & + Internal%parcels%zs, & + Internal%parcels%IDS, & + Internal%parcels%num_parcels) + endif - deallocate(lats0, lons0, zs0, ids0_r) - RETURN_(ESMF_SUCCESS) - contains + deallocate(lats0, lons0, zs0, ids0_r) + RETURN_(ESMF_SUCCESS) + contains ! a copy from MAPL_TimeMod function parse_time_string(timeUnits,rc) result(time) character(len=*), intent(inout) :: timeUnits From 81a6c4f4b3d8e26eb34d9edfab4ee107eb1e9044 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 13 Sep 2023 15:15:43 -0400 Subject: [PATCH 26/73] report error when gigatraj restart file conflict with rc file --- GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index 02954bfb0..7c0724cbc 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -377,6 +377,7 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) character (len=ESMF_MAXSTR), allocatable :: itemNameList(:) character (len=ESMF_MAXSTR), allocatable :: fieldnames(:) integer :: nitems + logical :: file_exists Iam = "getInitVars" @@ -401,6 +402,8 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) ! without restart file, get value from import call init_metsrc_field0(GC, IMPORT, ctime, 'PLE', _RC) else + INQUIRE(FILE= GigaRstFile, EXIST=file_exists) + _ASSERT( file_exists, " GIGATRAJ_INTERNAL_RESTART_FILE does not exist") call init_metsrc_field0(GC, INTERNAL, ctime, 'PL', _RC) endif From 774a09b9491c22e19e45cffdb191593a433d23c2 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 15 Sep 2023 11:41:34 -0400 Subject: [PATCH 27/73] add cubed other 3d fields --- .../GEOS_GigatrajGridComp.F90 | 61 ++++++++++++------- 1 file changed, 39 insertions(+), 22 deletions(-) diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index 7c0724cbc..c3dc58f30 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -534,15 +534,15 @@ subroutine create_extra_var(fieldname) real, allocatable :: tmp(:) select case (fieldname) case('TH') - var_name = 'theta' + var_name = 'TH' long_name = "air_potential_temperature" units = "K" case('T') - var_name = 't' + var_name = 'T' long_name = "air_temperature" units = "K" case('PALT') - var_name = 'palt' + var_name = 'PALT' long_name = "pressure_altitude" units = "km" case default @@ -1312,11 +1312,11 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) do k = 1, size(GigaTrajInternalPtr%ExtraFieldNames) select case (trim(GigaTrajInternalPtr%ExtraFieldNames(k))) case('TH') - var_name = 'theta' + var_name = 'TH' case('T') - var_name = 't' + var_name = 'T' case('PALT') - var_name = 'palt' + var_name = 'PALT' case default var_name = trim(GigaTrajInternalPtr%ExtraFieldNames(k)) end select @@ -1412,6 +1412,7 @@ subroutine read_parcels(GC,internal, rc) character(len=ESMF_MAXSTR) :: regrid_to_latlon type(MAPL_MetaComp),pointer :: MPL type (ESMF_VM) :: vm + type (ESMF_GRID) :: grid_ class(Variable), pointer :: t type(Attribute), pointer :: attr real :: lon_start @@ -1456,20 +1457,16 @@ subroutine read_parcels(GC,internal, rc) endif call MAPL_GetResource(MPL, regrid_to_latlon, "GIGATRAJ_REGRID_TO_LATLON:", default= 'YES' , _RC) if (trim (regrid_to_latlon) == 'YES') then - call scatter_parcels(total_num, lons0, lats0, zs0, IDs0, internal%CellToRank, internal%LatLonGrid, comm, & - Internal%parcels%lons, & - Internal%parcels%lats, & - Internal%parcels%zs, & - Internal%parcels%IDS, & - Internal%parcels%num_parcels) + grid_ = internal%LatLonGrid else - call scatter_parcels(total_num, lons0, lats0, zs0, IDs0, internal%CellToRank, internal%CubedGrid, comm, & + grid_ = internal%CubedGrid + endif + call scatter_parcels(total_num, lons0, lats0, zs0, IDs0, internal%CellToRank, grid_, comm, & Internal%parcels%lons, & Internal%parcels%lats, & Internal%parcels%zs, & Internal%parcels%IDS, & Internal%parcels%num_parcels) - endif deallocate(lats0, lons0, zs0, ids0_r) RETURN_(ESMF_SUCCESS) @@ -1578,6 +1575,7 @@ subroutine get_metsrc_data (GC, state, ctime, fieldname, values, RC ) type (GigatrajInternalWrap) :: wrap type (ESMF_FieldBundle) :: TRI type (ESMF_Field) :: field + type (ESMF_GRID) :: grid_ real, dimension(:,:,:), pointer :: ptr3d real, dimension(:,:,:), allocatable :: field_latlon real, dimension(:,:,:), allocatable, target :: haloField @@ -1598,14 +1596,23 @@ subroutine get_metsrc_data (GC, state, ctime, fieldname, values, RC ) call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) GigaTrajInternalPtr => wrap%ptr - call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) + if (GigaTrajInternalPtr%regrid_to_latlon) then + grid_ = GigaTrajInternalPtr%LatLonGrid + else + grid_ = GigaTrajInternalPtr%CubedGrid + endif + + call MAPL_GridGet(grid_, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) allocate(field_latlon(counts(1),counts(2),count3)) allocate(haloField(counts(1)+2, counts(2)+2,count3), source = 0.0) - call GigaTrajInternalPtr%cube2latlon%regrid(ptr3d, Field_latlon, _RC) - - call esmf_halo(GigaTrajInternalPtr%LatLonGrid, field_Latlon, haloField, _RC) + if (GigaTrajInternalPtr%regrid_to_latlon) then + call GigaTrajInternalPtr%cube2latlon%regrid(ptr3d, Field_latlon, _RC) + call esmf_halo(grid_, Field_latlon, haloField, _RC) + else + call esmf_halo(grid_, ptr3d, haloField, _RC) + endif field_ = trim(fieldname)//c_null_char call setData( GigaTrajInternalPtr%metSrc, c_loc(ctime), c_loc(field_), c_loc(haloField)) @@ -1634,6 +1641,7 @@ subroutine get_metsrc_data2d (GC, state, ctime, fieldname, values, RC ) type(GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap + type (ESMF_GRID) :: grid_ real, dimension(:,:,:), pointer :: field real, dimension(:,:,:), allocatable :: field_latlon real, dimension(:,:,:), allocatable, target :: haloField @@ -1647,14 +1655,23 @@ subroutine get_metsrc_data2d (GC, state, ctime, fieldname, values, RC ) call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) GigaTrajInternalPtr => wrap%ptr - call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts, _RC) + if (GigaTrajInternalPtr%regrid_to_latlon) then + grid_ = GigaTrajInternalPtr%LatLonGrid + else + grid_ = GigaTrajInternalPtr%CubedGrid + endif + + call MAPL_GridGet(grid_, localCellCountPerDim=counts, _RC) allocate(field_latlon(counts(1),counts(2),count3)) allocate(haloField(counts(1)+2, counts(2)+2,count3), source = 0.0) - call GigaTrajInternalPtr%cube2latlon%regrid(field, Field_latlon, _RC) - - call esmf_halo(GigaTrajInternalPtr%LatLonGrid, field_Latlon, haloField, _RC) + if (GigaTrajInternalPtr%regrid_to_latlon) then + call GigaTrajInternalPtr%cube2latlon%regrid(field, Field_latlon, _RC) + call esmf_halo(grid_, Field_latlon, haloField, _RC) + else + call esmf_halo(grid_, field, haloField, _RC) + endif field_ = trim(fieldname)//'_2D'//c_null_char From df822db8fb1d37da2730703bb8c4d4c15628a739 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 24 Oct 2023 14:01:15 -0400 Subject: [PATCH 28/73] change tendency varaibles name --- .../GEOS_GigatrajGridComp.F90 | 101 +++++++++++------- 1 file changed, 64 insertions(+), 37 deletions(-) diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index c3dc58f30..4b419ac2a 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -419,6 +419,33 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) call getExtraFieldNames(other_fields,GigaTrajInternalPtr%ExtraFieldNames) do i = 1, size(GigaTrajInternalPtr%ExtraFieldNames) + + if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'CA.bcphobic') /=0 .or. & + index(GigaTrajInternalPtr%ExtraFieldNames(i), 'CA.bcphilic') /=0) then + call MAPL_ExportStateGet([import], 'CA.bc', leaf_export, _RC) + call ESMF_StateGet(leaf_export, trim(GigaTrajInternalPtr%ExtraFieldNames(i)), tmp_field, _RC) + call ESMF_FieldGet(tmp_field,farrayPtr=ptr3d,rc=status) + if( .not. associated(ptr3d)) then + call MAPL_AllocateCoupling(tmp_field, _RC) + endif + call ESMF_StateAddReplace(import, [tmp_field], _RC) + call create_extra_var(fieldname) + cycle + endif + + if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'CA.ocphobic') /=0 .or. & + index(GigaTrajInternalPtr%ExtraFieldNames(i), 'CA.ocphilic') /=0) then + call MAPL_ExportStateGet([import], 'CA.oc', leaf_export, _RC) + call ESMF_StateGet(leaf_export, trim(GigaTrajInternalPtr%ExtraFieldNames(i)), tmp_field, _RC) + call ESMF_FieldGet(tmp_field,farrayPtr=ptr3d,rc=status) + if( .not. associated(ptr3d)) then + call MAPL_AllocateCoupling(tmp_field, _RC) + endif + call ESMF_StateAddReplace(import, [tmp_field], _RC) + call create_extra_var(fieldname) + cycle + endif + if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'CA.bc') /=0) then call MAPL_ExportStateGet([import], 'CA.bc', leaf_export, _RC) call ESMF_StateGet(leaf_export, trim(GigaTrajInternalPtr%ExtraFieldNames(i)), tmp_field, _RC) @@ -449,43 +476,43 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) cycle endif - if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'TRI') /=0) then - call ESMF_StateGet(import, 'PHYSICS_Exports/TURBULENCE_Exports/TRI', TRI, _RC) - !call ESMF_FieldBundleGet(TRI, fieldCount=nitems, _RC) - !allocate(itemNameList(nitems)) - !call ESMF_FieldBundleGet(TRI,fieldnamelist=itemNameList,rc=status) - allocate(fieldnames(4)) - fieldnames(1) = "CA.bc::CA.bcphilicIT" - fieldnames(2) = "CA.bc::CA.bcphobicIT" - fieldnames(3) = "CA.oc::CA.ocphilicIT" - fieldnames(4) = "CA.oc::CA.ocphobicIT" - do k = 1, 4 - !call ESMF_FieldBundleGet(TRI, trim(itemNameList(k)), field=tmp_field, _RC) - !call ESMF_FieldBundleGet(TRI, trim(fieldnames(k)), field=tmp_field, _RC) - fieldname = trim(fieldnames(k)) - call ESMF_FieldBundleGet(TRI, fieldname, field=tmp_field, _RC) - - !call MAPL_AllocateCoupling(tmp_field, _RC) - - call ESMF_FieldGet(tmp_field,farrayPtr=ptr3d, rc=status) - !if (MAPL_AM_I_Root()) then - if ( status /=0 )then - print*, 'status, associated(ptr3d)', status, associated(ptr3d) - print*, "not created: ", fieldname - print*, "Add to historty.rc to triger the allocation" - _FAIL(" Not allocated diffusion tendency") - !else - ! print*, "createded: ", itemNameList(k) - ! print*, "assocated: ", associated(ptr3d), itemNameList(k) - endif - !endif - call create_extra_var(fieldname(8:)) - enddo - deallocate(fieldnames) - cycle - endif - call create_extra_var(trim(GigaTrajInternalPtr%ExtraFieldNames(i))) - enddo +! if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'TRI') /=0) then +! call ESMF_StateGet(import, 'PHYSICS_Exports/TURBULENCE_Exports/TRI', TRI, _RC) +! !call ESMF_FieldBundleGet(TRI, fieldCount=nitems, _RC) +! !allocate(itemNameList(nitems)) +! !call ESMF_FieldBundleGet(TRI,fieldnamelist=itemNameList,rc=status) +! allocate(fieldnames(4)) +! fieldnames(1) = "CA.bc::CA.bcphilicIT" +! fieldnames(2) = "CA.bc::CA.bcphobicIT" +! fieldnames(3) = "CA.oc::CA.ocphilicIT" +! fieldnames(4) = "CA.oc::CA.ocphobicIT" +! do k = 1, 4 +! !call ESMF_FieldBundleGet(TRI, trim(itemNameList(k)), field=tmp_field, _RC) +! !call ESMF_FieldBundleGet(TRI, trim(fieldnames(k)), field=tmp_field, _RC) +! fieldname = trim(fieldnames(k)) +! call ESMF_FieldBundleGet(TRI, fieldname, field=tmp_field, _RC) +! +! !call MAPL_AllocateCoupling(tmp_field, _RC) +! +! call ESMF_FieldGet(tmp_field,farrayPtr=ptr3d, rc=status) +! !if (MAPL_AM_I_Root()) then +! if ( status /=0 )then +! print*, 'status, associated(ptr3d)', status, associated(ptr3d) +! print*, "not created: ", fieldname +! print*, "Add to historty.rc to triger the allocation" +! _FAIL(" Not allocated diffusion tendency") +! !else +! ! print*, "createded: ", itemNameList(k) +! ! print*, "assocated: ", associated(ptr3d), itemNameList(k) +! endif +! !endif +! call create_extra_var(fieldname(8:)) +! enddo +! deallocate(fieldnames) +! cycle +! endif + call create_extra_var(trim(GigaTrajInternalPtr%ExtraFieldNames(i))) + enddo endif if (MAPL_AM_I_Root()) then From 23cf07cc78aa5a5e6d0bf6d685e5fc15927d735a Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 3 Nov 2023 12:42:23 -0400 Subject: [PATCH 29/73] release halo handler. change 3d to 2d --- .../GEOS_GigatrajGridComp.F90 | 58 ++++--------------- 1 file changed, 12 insertions(+), 46 deletions(-) diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index 4b419ac2a..296cb0b35 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -725,6 +725,9 @@ subroutine Init_metsrc_field0 (GC, state, ctime, PL, RC ) call updateFields( GigaTrajInternalPtr%metSrc, c_loc(ctime), c_loc(haloU), c_loc(haloV), c_loc(haloW), c_loc(haloP)) if(associated(PL0)) deallocate(PL0) + deallocate(U_latlon, V_latlon, W_latlon, P_latlon) + deallocate(U_inter, V_inter, W_inter, P_inter) + deallocate(haloU, haloV, haloW, haloP) RETURN_(ESMF_SUCCESS) end subroutine init_metsrc_field0 @@ -755,8 +758,6 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) type (GigatrajInternalWrap) :: wrap integer :: num_parcels, my_rank,lm, l, d1,d2 - real, allocatable, target :: lats(:), lons(:), zs(:) - real, allocatable, target :: U(:), V(:), W(:) integer ::counts(3), DIMS(3), rank, comm, ierror type (ESMF_VM) :: vm @@ -769,14 +770,11 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) real(ESMF_KIND_R8) :: DT - type(ESMF_Field) :: halo_field - type(ESMF_RouteHandle) :: rh character(len=20), target :: ctime, ctime0 type(ESMF_State) :: INTERNAL type(MAPL_MetaComp),pointer :: MPL character(len=ESMF_MAXSTR) :: parcels_file - !RETURN_(ESMF_SUCCESS) call ESMF_VMGetCurrent(vm, _RC) call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) @@ -868,13 +866,11 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call esmf_halo(grid_, V_inter, haloV, _RC) call esmf_halo(grid_, W_inter, haloW, _RC) call esmf_halo(grid_, P_inter, haloP, _RC) - endif !--------------- ! Step 3) Update !--------------- - call updateFields( GigaTrajInternalPtr%metSrc, c_loc(ctime), c_loc(haloU), c_loc(haloV), c_loc(haloW), c_loc(haloP)) !--------------- @@ -884,7 +880,6 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) c_loc(GigaTrajInternalPtr%parcels%lons), & c_loc(GigaTrajInternalPtr%parcels%lats), & c_loc(GigaTrajInternalPtr%parcels%zs)) - !--------------- ! Step 4) Update internal !--------------- @@ -912,42 +907,10 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) !--------------- call write_parcels(GC, import, clock, currentTime, _RC) - RETURN_(ESMF_SUCCESS) end subroutine Run - subroutine mapl_halo(grid, U, V, W, P, haloU, haloV, haloW, haloP, rc) - type(ESMF_Grid), intent(in) :: grid - real, dimension(:,:,:), intent(in) :: U, V, W, P - real, dimension(:,:,:), intent(inout) :: haloU, haloV, haloW, haloP - integer, optional, intent( out) :: RC - - character(len=ESMF_MAXSTR) :: IAm - integer :: counts(3), dims(3), k - integer :: status - class(AbstractGridFactory), pointer :: factory - - Iam = "Gigatraj Halo" - call MAPL_GridGet(grid, localCellCountPerDim=counts, & - globalCellCountPerDim=DIMS, _RC) - - haloU(2:counts(1)+1, 2:counts(2)+1, :) = U - haloV(2:counts(1)+1, 2:counts(2)+1, :) = V - haloW(2:counts(1)+1, 2:counts(2)+1, :) = W - haloP(2:counts(1)+1, 2:counts(2)+1, :) = P - - factory =>grid_manager%get_factory(grid) - do k =1, counts(3) - call factory%halo(haloU(:,:,k), halo_width=1, _RC) - call factory%halo(haloV(:,:,k), halo_width=1, _RC) - call factory%halo(haloW(:,:,k), halo_width=1, _RC) - call factory%halo(haloP(:,:,k), halo_width=1, _RC) - enddo - - RETURN_(ESMF_SUCCESS) - end subroutine - subroutine esmf_halo(grid, Field,haloField, rc) type(ESMF_Grid), intent(in) :: grid real, dimension(:,:,:), intent(in) :: Field @@ -959,7 +922,7 @@ subroutine esmf_halo(grid, Field,haloField, rc) integer :: status type(ESMF_Field) :: halo_field type(ESMF_RouteHandle) :: rh - real, dimension(:,:,:), pointer :: with_halo + real, dimension(:,:), pointer :: with_halo Iam = "Gigatraj ESMF Halo" call MAPL_GridGet(grid, localCellCountPerDim=counts, _RC) @@ -967,7 +930,7 @@ subroutine esmf_halo(grid, Field,haloField, rc) count3 = size(field,3) ! may be nbins halo_field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R4, name='halo_field', & - ungriddedLBound=[1],ungriddedUBound=[count3], & + !ungriddedLBound=[1],ungriddedUBound=[count3], & totalLWidth=[1,1],totalUWidth=[1,1]) call ESMF_FieldHaloStore(halo_field, rh, _RC) @@ -975,11 +938,14 @@ subroutine esmf_halo(grid, Field,haloField, rc) ! ! W.Y note, the pointer with_halo's lbound is 0 ! - with_halo(1:counts(1), 1:counts(2), :) = Field - call ESMF_FieldHalo(halo_field, rh, _RC) - haloField = with_halo + do k = 1, count3 + with_halo(1:counts(1), 1:counts(2)) = Field(:,:,k) + call ESMF_FieldHalo(halo_field, rh, _RC) + haloField(:,:,k) = with_halo + enddo call ESMF_FieldDestroy( halo_field) + call ESMF_FieldHaloRelease(rh, _RC) RETURN_(ESMF_SUCCESS) end subroutine esmf_halo @@ -1712,7 +1678,7 @@ subroutine get_metsrc_data2d (GC, state, ctime, fieldname, values, RC ) c_loc(values(1,i))) enddo - deallocate(field_latlon, haloField) + deallocate(field_latlon, haloField, field_) RETURN_(ESMF_SUCCESS) end subroutine get_metsrc_data2d From df7b42e2542b88d1d75b2fb7b090c6399dfada42 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 8 Nov 2023 12:47:40 -0500 Subject: [PATCH 30/73] add integrate_DT --- .../GEOS_GigatrajGridComp.F90 | 124 +++++++++++------- 1 file changed, 79 insertions(+), 45 deletions(-) diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index 296cb0b35..40eff5529 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -29,6 +29,7 @@ module GEOS_GigatrajGridCompMod type(horde) :: parcels type(c_ptr) :: metSrc type(ESMF_Time) :: startTime + type(ESMF_TimeInterval) :: Integrate_DT character(len=ESMF_MAXSTR), allocatable :: ExtraFieldNames(:) type(VerticalData) :: vdata logical :: regrid_to_latlon @@ -142,11 +143,12 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) type (ESMF_TIME) :: CurrentTime character(len=20), target :: ctime character(len=:), allocatable, target :: name_, unit_ - type(ESMF_Alarm) :: GigaTrajOutAlarm, GigaTrajRebalanceAlarm - type(ESMF_TimeInterval) :: parcels_DT, Rebalance_DT + type(ESMF_Alarm) :: GigaTrajOutAlarm, GigaTrajRebalanceAlarm, GigaTrajIntegrateAlarm + type(ESMF_TimeInterval) :: parcelsOut_DT, Rebalance_DT, Integrate_DT type(ESMF_TimeInterval) :: ModelTimeStep type(ESMF_State) :: INTERNAL - integer :: minutes_, imc, jmc + integer :: imc, jmc, HH, MM, SS + integer :: integrate_time, r_time, o_time character(len=ESMF_MAXSTR) :: parcels_file character(len=ESMF_MAXSTR) :: grid_name character(len=ESMF_MAXSTR) :: regrid_to_latlon @@ -166,27 +168,49 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_ClockGet(clock, currTime=CurrentTime, _RC) call ESMF_ClockGet(clock, timeStep=ModelTimeStep, _RC) - call MAPL_GetResource(MPL, minutes_, "GIGATRAJ_REBALANCE_MINUTES:", default=30, _RC) - call ESMF_TimeIntervalSet(Rebalance_DT, m= minutes_, _RC) - call MAPL_GetResource(MPL, minutes_, "GIGATRAJ_OUTPUT_MINUTES:", default=30, _RC) - call ESMF_TimeIntervalSet(parcels_DT, m= minutes_, _RC) + call ESMF_TimeIntervalGet(ModelTimeStep, h = hh, m = mm, s = ss, _RC) + + call MAPL_GetResource(MPL, integrate_time, "GIGATRAJ_INTEGRATE_DT:", default = hh*10000+mm*100+ss, _RC) + hh = integrate_time/10000 + mm = mod(integrate_time, 10000)/100 + ss = mod(integrate_time, 100) + call ESMF_TimeIntervalSet(Integrate_DT, h = hh, m = mm, s = ss, _RC) + + call MAPL_GetResource(MPL, r_time, "GIGATRAJ_REBALANCE_DT:", default = integrate_time, _RC) + hh = r_time/10000 + mm = mod(r_time, 10000)/100 + ss = mod(r_time, 100) + call ESMF_TimeIntervalSet(Rebalance_DT, h = hh, m = mm, s = ss, _RC) + + call MAPL_GetResource(MPL, o_time, "GIGATRAJ_OUTPUT_DT:", default = integrate_time, _RC) + hh = o_time/10000 + mm = mod(o_time, 10000)/100 + ss = mod(o_time, 100) + call ESMF_TimeIntervalSet(parcelsOut_DT, h = hh, m = mm, s = ss, _RC) GigaTrajOutAlarm = ESMF_AlarmCreate( & clock, & name='GigatrajOut', & - ringTime= CurrentTime + parcels_DT-ModelTimeStep, & - ringInterval=parcels_DT, & + ringTime= CurrentTime + parcelsOut_DT-ModelTimeStep, & + ringInterval=parcelsOut_DT, & ringTimeStepCount=1, & sticky=.false., _RC) - GigaTrajRebalanceAlarm = ESMF_AlarmCreate( & + GigaTrajRebalanceAlarm = ESMF_AlarmCreate( & clock, & - name='GigatrajRebalance', & - ringTime= CurrentTime + parcels_DT-ModelTimeStep, & - ringInterval=parcels_DT, & + name='GigatrajRebalance', & + ringTime= CurrentTime + Rebalance_DT-ModelTimeStep, & + ringInterval=Rebalance_DT, & ringTimeStepCount=1, & sticky=.false., _RC) + GigaTrajIntegrateAlarm = ESMF_AlarmCreate( & + clock, & + name='GigatrajIntegrate', & + ringTime= CurrentTime + integrate_DT-ModelTimeStep, & + ringInterval=integrate_DT, & + ringTimeStepCount=1, & + sticky=.false., _RC) call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, _RC) @@ -207,6 +231,7 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) 1., 0.7, 0.5, 0.4, 0.3, 0.2, 0.1, 0.07, 0.05, 0.04, 0.03, 0.02] npz = size(levs_center, 1) GigaTrajInternalPtr%npz = npz + GigaTrajInternalPtr%Integrate_DT = Integrate_DT call MAPL_GetResource(MPL, NX, "NX:", _RC) call MAPL_GetResource(MPL, grid_name, "AGCM_GRIDNAME:", _RC) @@ -751,13 +776,13 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) character(19) :: begdate, enddate character(64) :: format_string type(ESMF_TimeInterval) :: ModelTimeStep - type(ESMF_Time) :: CurrentTime + type(ESMF_Time) :: CurrentTime, preTime type(ESMF_Grid) :: grid_ type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap - integer :: num_parcels, my_rank,lm, l, d1,d2 + integer :: num_parcels, lm, l, d1,d2 integer ::counts(3), DIMS(3), rank, comm, ierror type (ESMF_VM) :: vm @@ -774,40 +799,64 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) type(ESMF_State) :: INTERNAL type(MAPL_MetaComp),pointer :: MPL character(len=ESMF_MAXSTR) :: parcels_file + type(ESMF_Alarm) :: GigaTrajIntegrateAlarm - call ESMF_VMGetCurrent(vm, _RC) - call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) - call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) +!--------------- +! Update internal +!--------------- + call MAPL_GetPointer(Import, U_cube, "U", _RC) + call MAPL_GetPointer(Import, V_cube, "V", _RC) + call MAPL_GetPointer(Import, W_cube, "OMEGA", _RC) + call MAPL_GetPointer(Import, P_cube, "PL", _RC) + call MAPL_GetPointer(Import, PLE_cube, "PLE", _RC) call MAPL_GetObjectFromGC ( GC, MPL, _RC) call MAPL_Get (MPL, INTERNAL_ESMF_STATE=INTERNAL, _RC) + call MAPL_GetPointer(INTERNAL, U_internal, "U", _RC) + call MAPL_GetPointer(INTERNAL, V_internal, "V", _RC) + call MAPL_GetPointer(INTERNAL, W_internal, "OMEGA", _RC) + call MAPL_GetPointer(INTERNAL, P_internal, "PL", _RC) + call MAPL_GetPointer(INTERNAL, PLE_internal, "PLE", _RC) + + U_internal = U_cube + V_internal = V_cube + W_internal = W_cube + P_internal = P_cube + PLE_internal = PLE_cube + + call ESMF_ClockGetAlarm(clock, 'GigatrajIntegrate', GigaTrajIntegrateAlarm, _RC) + + if ( .not. ESMF_AlarmIsRinging(GigaTrajIntegrateAlarm)) then + RETURN_(ESMF_SUCCESS) + endif + + call ESMF_VMGetCurrent(vm, _RC) + call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) + + call ESMF_ClockGet(clock, currTime=CurrentTime, _RC) call ESMF_ClockGet(clock, timeStep=ModelTimeStep, _RC) ! W.J note: this run is after agcm's run. The clock is not yet ticked ! So the values we are using are at (CurrentTime + ModelTimeStep) - call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime0) - ctime0(20:20) = c_null_char + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) + GigaTrajInternalPtr => wrap%ptr + CurrentTime = CurrentTime + ModelTimeStep call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) ctime(20:20) = c_null_char - call ESMF_TimeIntervalGet(ModelTimeStep,d_r8=DT, _RC) + preTime = CurrentTime - GigaTrajInternalPtr%Integrate_DT + call ESMF_TimeGet(preTime, timeStringISOFrac=ctime0) + ctime0(20:20) = c_null_char + + call ESMF_TimeIntervalGet(GigaTrajInternalPtr%Integrate_DT, d_r8=DT, _RC) !--------------- ! Step 1) Regrid the metData field from cubed to lat-lon !--------------- - call MAPL_GetPointer(Import, U_cube, "U", _RC) - call MAPL_GetPointer(Import, V_cube, "V", _RC) - call MAPL_GetPointer(Import, W_cube, "OMEGA", _RC) - call MAPL_GetPointer(Import, P_cube, "PL", _RC) - call MAPL_GetPointer(Import, PLE_cube, "PLE", _RC) - - call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) - GigaTrajInternalPtr => wrap%ptr - lm = size(GigaTrajInternalPtr%vdata%levs) d1 = size(u_cube,1) d2 = size(u_cube,2) @@ -846,7 +895,6 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(P_cube, P_inter,rc=status) if (GigaTrajInternalPtr%regrid_to_latlon) then - call GigaTrajInternalPtr%cube2latlon%regrid(U_inter,V_inter, U_latlon, V_latlon, _RC) call GigaTrajInternalPtr%cube2latlon%regrid(W_inter, W_latlon, _RC) call GigaTrajInternalPtr%cube2latlon%regrid(P_inter, P_latlon, _RC) @@ -880,20 +928,6 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) c_loc(GigaTrajInternalPtr%parcels%lons), & c_loc(GigaTrajInternalPtr%parcels%lats), & c_loc(GigaTrajInternalPtr%parcels%zs)) -!--------------- -! Step 4) Update internal -!--------------- - call MAPL_GetPointer(INTERNAL, U_internal, "U", _RC) - call MAPL_GetPointer(INTERNAL, V_internal, "V", _RC) - call MAPL_GetPointer(INTERNAL, W_internal, "OMEGA", _RC) - call MAPL_GetPointer(INTERNAL, P_internal, "PL", _RC) - call MAPL_GetPointer(INTERNAL, PLE_internal, "PLE", _RC) - - U_internal = U_cube - V_internal = V_cube - W_internal = W_cube - P_internal = P_cube - PLE_internal = PLE_cube if (allocated(U_Latlon)) deallocate( U_Latlon, V_latlon, W_latlon, P_latlon) deallocate(haloU, haloV, haloW, haloP) From 827e5def1aebf3eaf32d829ee97d6c3db251fd07 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 23 Feb 2024 09:01:31 -0500 Subject: [PATCH 31/73] benched with offline --- .../GEOS_GigatrajGridComp.F90 | 253 +++++++++--------- 1 file changed, 130 insertions(+), 123 deletions(-) diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index 40eff5529..16e1a245d 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -133,20 +133,19 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: I1, I2, J1, J2, comm, npes, my_rank, rank, ierror, NX, NY, NPZ type(ESMF_Grid) :: CubedGrid integer, allocatable :: I1s(:), J1s(:), I2s(:),J2s(:) - integer :: DIMS(3), counts(3), i, j, k, l + integer :: DIMS(3), counts(3), i, j, l type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap - real :: dlat, dlon, lon_start + real :: dlat, dlon real, allocatable, target :: lats_center(:), lons_center(:), levs_center(:) real, allocatable, target :: cube_lats_center(:, :), cube_lons_center(:,:) - real, pointer :: levs_ptr(:), ptr(:,:) + real, allocatable :: lats_2dcenter(:, :), lons_2dcenter(:,:) + real, pointer :: levs_ptr(:) type (ESMF_TIME) :: CurrentTime character(len=20), target :: ctime - character(len=:), allocatable, target :: name_, unit_ type(ESMF_Alarm) :: GigaTrajOutAlarm, GigaTrajRebalanceAlarm, GigaTrajIntegrateAlarm type(ESMF_TimeInterval) :: parcelsOut_DT, Rebalance_DT, Integrate_DT type(ESMF_TimeInterval) :: ModelTimeStep - type(ESMF_State) :: INTERNAL integer :: imc, jmc, HH, MM, SS integer :: integrate_time, r_time, o_time character(len=ESMF_MAXSTR) :: parcels_file @@ -154,8 +153,10 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=ESMF_MAXSTR) :: regrid_to_latlon real(ESMF_KIND_R8), pointer :: centerX(:,:) real(ESMF_KIND_R8), pointer :: centerY(:,:) + real(ESMF_KIND_R8), pointer :: ptr(:,:) type(ESMF_Field) :: field type(ESMF_RouteHandle) :: rh + type(ESMF_Grid) :: grid_ call ESMF_GridCompGet ( GC, name=COMP_NAME, _RC ) Iam = trim(COMP_NAME) // "Initialize" @@ -233,93 +234,97 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) GigaTrajInternalPtr%npz = npz GigaTrajInternalPtr%Integrate_DT = Integrate_DT + + + call MAPL_GetResource(MPL, NX, "NX:", _RC) call MAPL_GetResource(MPL, grid_name, "AGCM_GRIDNAME:", _RC) + ! the level is differtent from the original grid GigaTrajInternalPtr%CubedGrid = grid_manager%make_grid(& CubedSphereGridFactory(grid_name=trim(grid_name),im_world = DIMS(1), lm=npz, nx=NX, ny=NX, rc=status)); _VERIFY(status) call MAPL_GetResource(MPL, regrid_to_latlon, "GIGATRAJ_REGRID_TO_LATLON:", default='YES', _RC) - GigaTrajInternalPtr%regrid_to_latlon = .true. + GigaTrajInternalPtr%regrid_to_latlon = .true. if (trim(regrid_to_latlon) == "NO") GigaTrajInternalPtr%regrid_to_latlon = .false. - + if ( GigaTrajInternalPtr%regrid_to_latlon ) then - call MAPL_MakeDecomposition(NX,NY,_RC) + call MAPL_MakeDecomposition(NX,NY,_RC) - GigaTrajInternalPtr%LatLonGrid = grid_manager%make_grid( & + GigaTrajInternalPtr%LatLonGrid = grid_manager%make_grid( & LatLonGridFactory(im_world=DIMS(1)*4, jm_world=DIMS(1)*2+1, lm=npz, & nx=NX, ny=NY, pole='PC', dateline= 'DC', rc=status) ); _VERIFY(status) - GigaTrajInternalPtr%cube2latlon => new_regridder_manager%make_regridder(GigaTrajInternalPtr%CubedGrid, GigaTrajInternalPtr%LatLonGrid, REGRID_METHOD_CONSERVE, _RC) + GigaTrajInternalPtr%cube2latlon => new_regridder_manager%make_regridder(GigaTrajInternalPtr%CubedGrid, GigaTrajInternalPtr%LatLonGrid, REGRID_METHOD_CONSERVE, _RC) - call MAPL_Grid_interior(GigaTrajInternalPtr%LatLonGrid ,i1,i2,j1,j2) + grid_ = GigaTrajInternalPtr%LatLonGrid + call MAPL_GridGet(grid_, globalCellCountPerDim=DIMS, _RC) + else + grid_ = CubedGrid + endif + + call MAPL_GridGet(grid_, localCellCountPerDim=counts, _RC) + call MAPL_Grid_interior(grid_, i1,i2,j1,j2) - call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) + imc = i2-i1 + 1 + jmc = j2-j1 + 1 + allocate(lats_2dcenter(imc+2, jmc+2)) + allocate(lons_2dcenter(imc+2, jmc+2)) - ! lat and lon centers need to hold the halo with width 1 + field = ESMF_FieldCreate(grid_, ESMF_TYPEKIND_R8, name='halo', staggerLoc=ESMF_STAGGERLOC_CENTER,totalLWidth=[1,1],totalUWidth=[1,1],rc=status) + _VERIFY(status) - dlon = 360.0/dims(1) - ! DE - !lons_center = [(dlon*(i-1)+dlon/2., i= i1-1, i2+1)] - ! DC - lons_center = [(dlon*(i-1), i= i1-1, i2+1)] - - !where(lons_center < 0. ) lons_center = 0. - !where(lons_center >360.) lons_center = 360. + call ESMF_FieldGet(field,farrayPtr=ptr,rc=status) + ptr = 0.0d0 + call ESMF_FieldHaloStore(field,rh,rc=status) + _VERIFY(status) - !PE - !dlat = 180.0/dims(2) - !lats_center = [(-dlat/2. + dlat*j-90.0, j= j1-1, j2+1)] - !PC - dlat = 180.0/(dims(2)-1) ! PC - lats_center = [(-90.0 + (j-1)*dlat, j= j1-1, j2+1)] - !where(lats_center <-90.) lats_center = -90. - !where(lats_center >90. ) lats_center = 90. + call ESMF_GridGetCoord(grid_ , coordDim=1, localDE=0, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=centerX, rc=status) + VERIFY_(STATUS) - else + ptr(2:imc+1,2:jmc+1)=centerX + call ESMF_FieldHalo(field,rh,rc=status) + _VERIFY(status) + lons_2dcenter = ptr - call MAPL_Grid_interior(CubedGrid ,i1,i2,j1,j2) - imc = i2-i1 + 1 - jmc = j2-j1 + 1 - allocate(cube_lats_center(imc+2, jmc+2)) - allocate(cube_lons_center(imc+2, jmc+2)) - allocate(ptr(0:imc+1, 0:jmc+1)) - - call ESMF_GridGetCoord(CubedGrid, coordDim=1, localDE=0, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=centerX, rc=status) - VERIFY_(STATUS) - - field = ESMF_FieldCreate(CubedGrid,ptr,staggerLoc=ESMF_STAGGERLOC_CENTER,totalLWidth=[1,1],totalUWidth=[1,1],rc=status) - _VERIFY(status) - call ESMF_FieldHaloStore(field,rh,rc=status) - _VERIFY(status) - - ptr(1:imc,1:jmc)=centerX - call ESMF_FieldHalo(field,rh,rc=status) - _VERIFY(status) - cube_lons_center = ptr - - call ESMF_GridGetCoord(CubedGrid , coordDim=2, localDE=0, & + call ESMF_GridGetCoord(grid_ , coordDim=2, localDE=0, & staggerloc=ESMF_STAGGERLOC_CENTER, & farrayPtr=centerY, rc=status) - VERIFY_(STATUS) - ptr(1:imc,1:jmc)=centerY - call ESMF_FieldHalo(field,rh,rc=status) - _VERIFY(status) - cube_lats_center = ptr + VERIFY_(STATUS) + ptr(2:imc+1,2:jmc+1)=centerY + call ESMF_FieldHalo(field,rh,rc=status) + _VERIFY(status) + lats_2dcenter = ptr - deallocate(ptr) - call ESMF_FieldDestroy(field,rc=status) - _VERIFY(status) - call ESMF_FieldHaloRelease(rh,rc=status) - _VERIFY(status) + call ESMF_FieldDestroy(field,rc=status) + _VERIFY(status) + call ESMF_FieldHaloRelease(rh,rc=status) + _VERIFY(status) - cube_lons_center = cube_lons_center*180.0/MAPL_PI - cube_lats_center = cube_lats_center*180.0/MAPL_PI + if ( GigaTrajInternalPtr%regrid_to_latlon ) then + !lons_center = lons_2dcenter(:,1)/MAPL_PI*180.0 + !lats_center = lats_2dcenter(1,:)/MAPL_PI*180.0 + dlon = 360.0/dims(1) + ! DE + !lons_center = [(dlon*(i-1)+dlon/2., i= i1-1, i2+1)] + ! DC + lons_center = [(dlon*(i-1) - 180.0 , i= i1-1, i2+1)] + !PE + !dlat = 180.0/dims(2) + !lats_center = [(-dlat/2. + dlat*j-90.0, j= j1-1, j2+1)] + !PC + dlat = 180.0/(dims(2)-1) ! PC + lats_center = [(-90.0 + (j-1)*dlat, j= j1-1, j2+1)] + where(lats_center <-90.) lats_center = -90. + where(lats_center >90. ) lats_center = 90. + else + cube_lons_center = lons_2dcenter/MAPL_PI*180.0 + cube_lats_center = lats_2dcenter/MAPL_PI*180.0 endif call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) @@ -347,14 +352,13 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) levs_ptr=>levs_center GigaTrajInternalPtr%vdata = VerticalData(levs_ptr, vcoord = 'log(PLE)', vscale = 100.0, vunit = 'hPa',_RC) + call MAPL_Grid_interior(Grid_,i1,i2,j1,j2) if (GigaTrajInternalPtr%regrid_to_latlon) then - call MAPL_Grid_interior(GigaTrajInternalPtr%LatLonGrid,i1,i2,j1,j2) GigaTrajInternalPtr%metSrc = initMetGEOSDistributedLatLonData(comm, c_loc(GigaTrajInternalPtr%CellToRank), DIMS(1), DIMS(2), & npz, counts(1)+2, counts(2)+2, npz, & c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), c_loc(ctime)) deallocate(lons_center, lats_center,levs_center) else - call MAPL_Grid_interior(CubedGrid ,i1,i2,j1,j2) GigaTrajInternalPtr%metSrc = initMetGEOSDistributedCubedData(comm, c_loc(GigaTrajInternalPtr%CellToRank), DIMS(1), & npz, i1, i2, j1, j2, npz, & c_loc(cube_lons_center), c_loc(cube_lats_center), c_loc(levs_center), c_loc(ctime)) @@ -362,7 +366,7 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) endif - call read_parcels(GC, GigaTrajInternalPtr, _RC) + call read_parcels(GC, GigaTrajInternalPtr, _RC) call MAPL_TimerOff(MPL,"INITIALIZE") call MAPL_TimerOff(MPL,"TOTAL") @@ -379,14 +383,13 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) type(ESMF_Clock), intent(inout) :: CLOCK integer, optional, intent( out) :: RC - integer :: i, status, k, FC, l, lm + integer :: i, status, k character(len=ESMF_MAXSTR) :: IAm type (ESMF_State) :: INTERNAL, leaf_export type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap character(len=ESMF_MAXSTR) :: GigaRstFile character(len=ESMF_MAXSTR) :: other_fields - character(len=ESMF_MAXSTR) :: NAME type(ESMF_Field) :: tmp_field type (ESMF_FieldBundle) :: TRI type (ESMF_TIME) :: CurrentTime @@ -538,10 +541,9 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) ! endif call create_extra_var(trim(GigaTrajInternalPtr%ExtraFieldNames(i))) enddo - endif - - if (MAPL_AM_I_Root()) then - call formatter%close() + if (MAPL_AM_I_Root()) then + call formatter%close() + endif endif init = .true. @@ -672,7 +674,7 @@ subroutine Init_metsrc_field0 (GC, state, ctime, PL, RC ) real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon, P_latlon real, dimension(:,:,:), allocatable :: U_inter, V_inter, W_inter, P_inter real, dimension(:,:,:), allocatable, target :: haloU, haloV, haloW, haloP - integer :: counts(3), dims(3), d1,d2,km,lm,l + integer :: counts(3), dims(3), d1,d2,km,lm Iam = "init_metsrc_field0" @@ -769,8 +771,7 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=ESMF_MAXSTR) :: IAm integer :: STATUS - character(len=ESMF_MAXSTR) :: COMP_NAME - integer :: CSTAT, ESTAT, YY, MM, HH, DD, H, M,S + integer :: CSTAT, ESTAT, YY, DD character(512) :: CMSG character(256) :: command_line character(19) :: begdate, enddate @@ -782,8 +783,8 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap - integer :: num_parcels, lm, l, d1,d2 - integer ::counts(3), DIMS(3), rank, comm, ierror + integer :: lm, d1,d2 + integer ::counts(3), DIMS(3), comm, ierror type (ESMF_VM) :: vm real, dimension(:,:,:), pointer :: U_cube, V_cube, W_cube, P_cube, PLE_Cube, with_halo @@ -798,7 +799,6 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=20), target :: ctime, ctime0 type(ESMF_State) :: INTERNAL type(MAPL_MetaComp),pointer :: MPL - character(len=ESMF_MAXSTR) :: parcels_file type(ESMF_Alarm) :: GigaTrajIntegrateAlarm !--------------- @@ -919,10 +919,11 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) !--------------- ! Step 3) Update !--------------- + call updateFields( GigaTrajInternalPtr%metSrc, c_loc(ctime), c_loc(haloU), c_loc(haloV), c_loc(haloW), c_loc(haloP)) !--------------- -! Step 3) Time advance +! Step 4) Time advance !--------------- call rk4a_advance( GigaTrajInternalPtr%metSrc, c_loc(ctime0), DT, GigaTrajInternalPtr%parcels%num_parcels, & c_loc(GigaTrajInternalPtr%parcels%lons), & @@ -936,6 +937,7 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Step 5) rebalance parcels among processors ( configurable with alarm) !--------------- call rebalance_parcels(clock, GigaTrajInternalPtr%parcels, GigaTrajInternalPtr%CellToRank, comm, grid_, _RC) + !--------------- ! Step 6) write out parcel positions and related fields ( configurable with alarm) !--------------- @@ -964,11 +966,10 @@ subroutine esmf_halo(grid, Field,haloField, rc) count3 = size(field,3) ! may be nbins halo_field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R4, name='halo_field', & - !ungriddedLBound=[1],ungriddedUBound=[count3], & totalLWidth=[1,1],totalUWidth=[1,1]) - call ESMF_FieldHaloStore(halo_field, rh, _RC) - call ESMF_FieldGet(halo_field, farrayPtr=with_halo, _RC) + with_halo = 0.0 + call ESMF_FieldHaloStore(halo_field, rh, _RC) ! ! W.Y note, the pointer with_halo's lbound is 0 ! @@ -978,7 +979,7 @@ subroutine esmf_halo(grid, Field,haloField, rc) haloField(:,:,k) = with_halo enddo - call ESMF_FieldDestroy( halo_field) + call ESMF_FieldDestroy(halo_field) call ESMF_FieldHaloRelease(rh, _RC) RETURN_(ESMF_SUCCESS) @@ -1023,8 +1024,8 @@ subroutine rebalance_parcels(clock, parcels, CellToRank, comm, grid, rc) call move_alloc( parcels%IDs, IDs0) num_parcels0 = parcels%num_parcels - where (lons0 < 0) lons0 =lons0 + 360.0 - where (lons0 >360) lons0 =lons0 - 360.0 + where (lons0 < -180.0) lons0 =lons0 + 360.0 + where (lons0 > 180.0) lons0 =lons0 - 360.0 allocate(II(num_parcels0), JJ(num_parcels0)) call MAPL_GridGet(Grid, globalCellCountPerDim=DIMS) @@ -1035,7 +1036,7 @@ subroutine rebalance_parcels(clock, parcels, CellToRank, comm, grid, rc) dlon = 360.0 / DIMS(1) dlat = 180.0 / (DIMS(2)-1) ! DC - II = min( max(ceiling ((lons0+dlon/2.)/dlon),1), DIMS(1)) + II = min( max(ceiling ((lons0+dlon/2.+180.0)/dlon),1), DIMS(1)) JJ = min( max(ceiling ((lats0+dlat/2.+ 90.0)/dlat),1), DIMS(2)) endif @@ -1132,6 +1133,9 @@ subroutine scatter_parcels(num_parcels0, lons0, lats0, zs0, IDs0, CellToRank, Gr allocate(counts_send(npes), source = 0) allocate(disp_send(npes), source = 0) + where (lons0 < -180.0) lons0 =lons0 + 360.0 + where (lons0 > 180.0 ) lons0 =lons0 - 360.0 + if (my_rank == 0) then if (DIMS(2) == 6*DIMS(1)) then call MAPL_GetGlobalHorzIJIndex(num_parcels0, II, JJ, lons0/180.0*MAPL_PI, lats0/180.0*MAPL_PI, Grid=Grid, rc=status) @@ -1139,10 +1143,8 @@ subroutine scatter_parcels(num_parcels0, lons0, lats0, zs0, IDs0, CellToRank, Gr dlon = 360.0 / DIMS(1) dlat = 180.0 / (DIMS(2)-1) !PC - where (lons0 < 0) lons0 =lons0 + 360.0 - where (lons0 > 360) lons0 =lons0 - 360.0 - II = min( max(ceiling ((lons0+dlon/2.0) /dlon),1), DIMS(1)) - JJ = min( max(ceiling ((lats0+90.0+dlat/2.0)/dlat),1), DIMS(2)) + II = min( max(ceiling ((lons0+dlon/2.0 + 180.0)/dlon),1), DIMS(1)) + JJ = min( max(ceiling ((lats0+dlat/2.0 + 90.0 )/dlat),1), DIMS(2)) endif allocate(ranks(num_parcels0)) @@ -1174,15 +1176,17 @@ subroutine scatter_parcels(num_parcels0, lons0, lats0, zs0, IDs0, CellToRank, Gr allocate(IDs_send (num_parcels0)) allocate(IDs (num_parcels )) - do i = 1, num_parcels0 - rank = ranks(i) - pos = tmp_position(rank+1) +1 - lons_send(pos) = lons0(i) - lats_send(pos) = lats0(i) - zs_send(pos) = zs0(i) - IDs_send(pos) = IDs0(i) - tmp_position(rank+1) = tmp_position(rank+1) + 1 - enddo + if (my_rank == 0) then + do i = 1, num_parcels0 + rank = ranks(i) + pos = tmp_position(rank+1) +1 + lons_send(pos) = lons0(i) + lats_send(pos) = lats0(i) + zs_send(pos) = zs0(i) + IDs_send(pos) = IDs0(i) + tmp_position(rank+1) = tmp_position(rank+1) + 1 + enddo + endif call MPI_ScatterV(lons_send, counts_send, disp_send, MPI_REAL, lons, counts_recv, MPI_REAL, 0, comm, ierror) call MPI_ScatterV(lats_send, counts_send, disp_send, MPI_REAL, lats, counts_recv, MPI_REAL, 0, comm, ierror) @@ -1270,7 +1274,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) real, allocatable :: lats0(:), lons0(:), zs0(:), ids0_r(:), values(:), values0(:) real,target, allocatable :: values_2d(:,:) real,pointer :: field(:,:,:) - integer, allocatable :: ids0(:) + integer, allocatable :: ids0(:), ids0_in(:) type(ESMF_Alarm) :: GigaTrajOutAlarm type(FileMetadata) :: meta real(ESMF_KIND_R8) :: tint_d @@ -1282,7 +1286,6 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap - real :: lon_start character(len=20), target :: ctime Iam = "write_parcels" @@ -1297,11 +1300,9 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) GigaTrajInternalPtr => wrap%ptr call MAPL_GetResource(MPL, parcels_file, "GIGATRAJ_PARCELS_FILE:", default='parcels.nc4', _RC) - call MAPL_GetResource(MPL, lon_start , "GIGATRAJ_LON_START:", default= 0. , _RC) call ESMF_VMGetCurrent(vm, _RC) call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) - call gather_parcels(total_num, lons0, lats0, zs0, IDs0, & comm, & GigaTrajInternalPtr%parcels%lons, & @@ -1312,14 +1313,24 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) if (my_rank ==0) then - ! reorder - lats0 = lats0(ids0(:)+1) ! id is zero-bases, plus 1 Fortran - lons0 = lons0(ids0(:)+1) - !lons0 = lons0 + lon_start - if (lon_start < 0.) then - where (lons0 > 180.0) lons0 = lons0 - 360. - endif - zs0 = zs0(ids0(:)+1) + ! reorder + ids0 = ids0 + 1 ! element start 0, make it to 1 for ordering + ids0(ids0) = [(k, k=1,size(ids0))] + + ! test if ordering is right + ! ids0_in = ids0 + ! ids0_in = ids0_in(ids0) + ! do k = 1, size(ids0) + ! if (k /= ids0_in(k)) then + ! RETURN_(-1) + ! endif + ! enddo + + lats0 = lats0(ids0(:)) ! id is zero-bases, plus 1 Fortran + lons0 = lons0(ids0(:)) + where (lons0 > 180.0) lons0 = lons0 - 360. + where (lons0 < -180.0) lons0 = lons0 + 360. + zs0 = zs0(ids0(:)) call formatter%open(trim(parcels_file), pFIO_WRITE, _RC) meta = formatter%read(_RC) last_time = meta%get_dimension('time', _RC) @@ -1365,7 +1376,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) call gather_onefield(total_num, values0, comm, values_2d(:,i), GigaTrajInternalPtr%parcels%num_parcels) if (my_rank == 0) then - values0 = values0(ids0(:)+1) + values0 = values0(ids0(:)) var_ = var_name //'00'//i_to_string(i) if ( meta%has_variable(var_)) then call formatter%put_var( var_, values0, start=[1, last_time+1], _RC) @@ -1388,7 +1399,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) call gather_onefield(total_num, values0, comm, values, GigaTrajInternalPtr%parcels%num_parcels) if (my_rank == 0) then - values0 = values0(ids0(:)+1) + values0 = values0(ids0(:)) if ( meta%has_variable(var_)) then call formatter%put_var( var_, values0, start=[1, last_time+1], _RC) else @@ -1403,7 +1414,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) call gather_onefield(total_num, values0, comm, values, GigaTrajInternalPtr%parcels%num_parcels) if (my_rank == 0) then - values0 = values0(ids0(:)+1) + values0 = values0(ids0(:)) if ( meta%has_variable(var_name)) then call formatter%put_var( var_name, values0, start=[1, last_time+1], _RC) else @@ -1430,8 +1441,8 @@ subroutine read_parcels(GC,internal, rc) type(Netcdf4_fileformatter) :: formatter type(FileMetadata) :: meta - integer :: comm, my_rank, total_num, ierror, last_time, DIMS(3) - real, allocatable :: lats(:), lons(:), zs(:), lats0(:), lons0(:), zs0(:) + integer :: comm, my_rank, total_num, ierror, last_time + real, allocatable :: lats0(:), lons0(:), zs0(:) real(kind=ESMF_KIND_R8), allocatable :: ids0_r(:) integer, allocatable :: ids0(:) integer :: status @@ -1442,7 +1453,6 @@ subroutine read_parcels(GC,internal, rc) type (ESMF_GRID) :: grid_ class(Variable), pointer :: t type(Attribute), pointer :: attr - real :: lon_start class(*), pointer :: units character(len=ESMF_MAXSTR) :: Iam ="read_parcels" @@ -1452,7 +1462,6 @@ subroutine read_parcels(GC,internal, rc) call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) call MAPL_GetObjectFromGC ( GC, MPL, _RC) call MAPL_GetResource(MPL, parcels_file, "GIGATRAJ_PARCELS_FILE:", default='parcels.nc4', _RC) - call MAPL_GetResource(MPL, lon_start , "GIGATRAJ_LON_START:", default= 0. , _RC) total_num = 0 if (my_rank ==0) then call formatter%open(parcels_file, pFIO_READ, _RC) @@ -1470,7 +1479,7 @@ subroutine read_parcels(GC,internal, rc) end select endif - allocate(lats0(total_num), lons0(total_num), zs0(total_num), ids0_r(total_num)) + allocate(lats0(total_num), lons0(total_num), zs0(total_num),ids0(total_num), ids0_r(total_num)) if (my_rank ==0) then call formatter%get_var('lat', lats0, start = [1,last_time], _RC) @@ -1479,8 +1488,6 @@ subroutine read_parcels(GC,internal, rc) call formatter%get_var('id', ids0_r,start = [1,last_time], _RC) call formatter%close(_RC) ids0 = int(ids0_r) - !lons0 = lons0 - lon_start - where (lons0<0) lons0 = lons0 + 360. endif call MAPL_GetResource(MPL, regrid_to_latlon, "GIGATRAJ_REGRID_TO_LATLON:", default= 'YES' , _RC) if (trim (regrid_to_latlon) == 'YES') then From f1c39484ec362536e8c8e4e94a973f65ed4f371e Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 21 May 2024 12:49:00 -0400 Subject: [PATCH 32/73] new RK4. correct center halo --- GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 | 4 ++-- GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 | 10 +++++++--- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 b/GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 index e1a12e741..0ec4dee68 100644 --- a/GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 @@ -8,7 +8,7 @@ module GEOS_Giga_InterOpMod public :: initMetGEOSDistributedLatLonData public :: initMetGEOSDistributedCubedData public :: updateFields - public :: rk4a_advance + public :: RK4_advance public :: setData public :: getData public :: getData2d @@ -41,7 +41,7 @@ subroutine updateFields( metSrc_ptr, ctime_ptr, u_ptr, v_ptr, w_ptr, p_ptr) bind type(c_ptr), intent(in), value :: metSrc_ptr, ctime_ptr, u_ptr, v_ptr, w_ptr, p_ptr end subroutine - subroutine rk4a_advance(metsrc_ptr, ctime_ptr, dt, n, lons_ptr, lats_ptr, levs_ptr) bind( C, name='rk4a_advance') + subroutine RK4_advance(metsrc_ptr, ctime_ptr, dt, n, lons_ptr, lats_ptr, levs_ptr) bind( C, name='RK4_advance') import :: c_ptr, c_int, c_double type(c_ptr), intent(in), value :: metsrc_ptr real(c_double), intent(in), value :: dt diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index 16e1a245d..2151bc7b3 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -286,7 +286,7 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) farrayPtr=centerX, rc=status) VERIFY_(STATUS) - ptr(2:imc+1,2:jmc+1)=centerX + ptr(1:imc,1:jmc)=centerX call ESMF_FieldHalo(field,rh,rc=status) _VERIFY(status) lons_2dcenter = ptr @@ -295,7 +295,8 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) staggerloc=ESMF_STAGGERLOC_CENTER, & farrayPtr=centerY, rc=status) VERIFY_(STATUS) - ptr(2:imc+1,2:jmc+1)=centerY + ptr = 0.0d0 + ptr(1:imc,1:jmc)=centerY call ESMF_FieldHalo(field,rh,rc=status) _VERIFY(status) lats_2dcenter = ptr @@ -325,6 +326,8 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) else cube_lons_center = lons_2dcenter/MAPL_PI*180.0 cube_lats_center = lats_2dcenter/MAPL_PI*180.0 + where (cube_lons_center < -180.) cube_lons_center = cube_lons_center + 360. + where (cube_lons_center > 180.) cube_lons_center = cube_lons_center - 360. endif call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) @@ -362,6 +365,7 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) GigaTrajInternalPtr%metSrc = initMetGEOSDistributedCubedData(comm, c_loc(GigaTrajInternalPtr%CellToRank), DIMS(1), & npz, i1, i2, j1, j2, npz, & c_loc(cube_lons_center), c_loc(cube_lats_center), c_loc(levs_center), c_loc(ctime)) + deallocate(cube_lons_center, cube_lats_center,levs_center) endif @@ -925,7 +929,7 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) !--------------- ! Step 4) Time advance !--------------- - call rk4a_advance( GigaTrajInternalPtr%metSrc, c_loc(ctime0), DT, GigaTrajInternalPtr%parcels%num_parcels, & + call RK4_advance( GigaTrajInternalPtr%metSrc, c_loc(ctime0), DT, GigaTrajInternalPtr%parcels%num_parcels, & c_loc(GigaTrajInternalPtr%parcels%lons), & c_loc(GigaTrajInternalPtr%parcels%lats), & c_loc(GigaTrajInternalPtr%parcels%zs)) From a17f900679834230649f133be55640caf211eed6 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 27 Aug 2024 14:41:10 -0400 Subject: [PATCH 33/73] temporary check in --- .../GEOS_GigatrajGridComp.F90 | 182 +++++++++--------- 1 file changed, 90 insertions(+), 92 deletions(-) diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index 2151bc7b3..2d8a75ad0 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -1,7 +1,7 @@ #include "MAPL_Generic.h" module GEOS_GigatrajGridCompMod - use, intrinsic :: iso_c_binding, only : c_int, c_ptr, c_null_ptr, c_associated + use, intrinsic :: iso_c_binding, only : c_int, c_ptr, c_null_ptr, c_associated, c_null_char use, intrinsic :: iso_c_binding, only : c_loc use ESMF use MAPL @@ -234,9 +234,6 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) GigaTrajInternalPtr%npz = npz GigaTrajInternalPtr%Integrate_DT = Integrate_DT - - - call MAPL_GetResource(MPL, NX, "NX:", _RC) call MAPL_GetResource(MPL, grid_name, "AGCM_GRIDNAME:", _RC) @@ -267,7 +264,6 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GridGet(grid_, localCellCountPerDim=counts, _RC) call MAPL_Grid_interior(grid_, i1,i2,j1,j2) - imc = i2-i1 + 1 jmc = j2-j1 + 1 allocate(lats_2dcenter(imc+2, jmc+2)) @@ -350,7 +346,6 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) J2 = J2s(rank+1) GigaTrajInternalPtr%CellToRank(I1:I2,J1:J2) = rank enddo - ! WJiang notes: the vcoord should be consistent with the HISTORY.rc levs_ptr=>levs_center GigaTrajInternalPtr%vdata = VerticalData(levs_ptr, vcoord = 'log(PLE)', vscale = 100.0, vunit = 'hPa',_RC) @@ -404,10 +399,12 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) type(Netcdf4_fileformatter) :: formatter type(FileMetadata) :: meta character(len=ESMF_MAXSTR) :: parcels_file - character(len=:), allocatable :: fieldname + character(len=:), allocatable :: fieldname, tmp_name character(len=20) :: diffusions(4) character (len=ESMF_MAXSTR), allocatable :: itemNameList(:) + character (len=ESMF_MAXSTR) :: LONG_NAME, UNITS character (len=ESMF_MAXSTR), allocatable :: fieldnames(:) + character (len=ESMF_MAXSTR), allocatable :: compnames(:) integer :: nitems logical :: file_exists @@ -448,65 +445,34 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) meta = formatter%read(_RC) endif - call getExtraFieldNames(other_fields,GigaTrajInternalPtr%ExtraFieldNames) - - do i = 1, size(GigaTrajInternalPtr%ExtraFieldNames) - - if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'CA.bcphobic') /=0 .or. & - index(GigaTrajInternalPtr%ExtraFieldNames(i), 'CA.bcphilic') /=0) then - call MAPL_ExportStateGet([import], 'CA.bc', leaf_export, _RC) - call ESMF_StateGet(leaf_export, trim(GigaTrajInternalPtr%ExtraFieldNames(i)), tmp_field, _RC) - call ESMF_FieldGet(tmp_field,farrayPtr=ptr3d,rc=status) - if( .not. associated(ptr3d)) then - call MAPL_AllocateCoupling(tmp_field, _RC) - endif - call ESMF_StateAddReplace(import, [tmp_field], _RC) - call create_extra_var(fieldname) - cycle - endif - - if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'CA.ocphobic') /=0 .or. & - index(GigaTrajInternalPtr%ExtraFieldNames(i), 'CA.ocphilic') /=0) then - call MAPL_ExportStateGet([import], 'CA.oc', leaf_export, _RC) - call ESMF_StateGet(leaf_export, trim(GigaTrajInternalPtr%ExtraFieldNames(i)), tmp_field, _RC) - call ESMF_FieldGet(tmp_field,farrayPtr=ptr3d,rc=status) - if( .not. associated(ptr3d)) then - call MAPL_AllocateCoupling(tmp_field, _RC) - endif - call ESMF_StateAddReplace(import, [tmp_field], _RC) - call create_extra_var(fieldname) - cycle - endif + call getCompsAndFields(other_fields, compnames, fieldnames) - if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'CA.bc') /=0) then - call MAPL_ExportStateGet([import], 'CA.bc', leaf_export, _RC) - call ESMF_StateGet(leaf_export, trim(GigaTrajInternalPtr%ExtraFieldNames(i)), tmp_field, _RC) - call ESMF_FieldGet(tmp_field,farrayPtr=ptr3d,rc=status) - if( .not. associated(ptr3d)) then - call MAPL_AllocateCoupling(tmp_field, _RC) - endif - call ESMF_StateAddReplace(import, [tmp_field], _RC) - do k = 1, size(ptr3d, 3) - fieldname = trim(GigaTrajInternalPtr%ExtraFieldNames(i))//'00'//i_to_string(k) - call create_extra_var(fieldname) - enddo - cycle + do i = 1, size(FieldNames) + call MAPL_ExportStateGet([import], trim(compnames(i)), leaf_export, _RC) + call ESMF_StateGet(leaf_export, trim(FieldNames(i)), tmp_field, _RC) + call MAPL_AllocateCoupling(tmp_field, _RC) + call ESMF_AttributeGet(tmp_field, NAME='LONG_NAME', VALUE=LONG_NAME, _RC) + call ESMF_AttributeGet(tmp_field, NAME='UNITS', VALUE=UNITS, _RC) + + tmp_name =trim(fieldnames(i)) + + if ( index(compnames(i), 'CA.oc') /=0 .or. & + index(compnames(i), 'CA.bc') /=0 ) then + + if (index(tmp_name,'phobic') ==0 .or. & + index(tmp_name,'philic') ==0 ) then + + call ESMF_FieldGet(tmp_field,farrayPtr=ptr3d,rc=status) + do k = 1, size(ptr3d, 3) + fieldname = trim(FieldNames(i))//'00'//i_to_string(k) + call create_new_vars( trim(long_name), trim(fieldname), trim(units)) + enddo + cycle + endif endif - if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'CA.oc') /=0) then - call MAPL_ExportStateGet([import], 'CA.oc', leaf_export, _RC) - call ESMF_StateGet(leaf_export, trim(GigaTrajInternalPtr%ExtraFieldNames(i)), tmp_field, _RC) - call ESMF_FieldGet(tmp_field,farrayPtr=ptr3d,rc=status) - if( .not. associated(ptr3d)) then - call MAPL_AllocateCoupling(tmp_field, _RC) - endif - call ESMF_StateAddReplace(import, [tmp_field], _RC) - do k = 1, size(ptr3d, 3) - fieldname = trim(GigaTrajInternalPtr%ExtraFieldNames(i))//'00'//i_to_string(k) - call create_extra_var(fieldname) - enddo - cycle - endif + call create_new_vars( trim(long_name), trim(fieldnames(i)), trim(units)) + ! if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'TRI') /=0) then ! call ESMF_StateGet(import, 'PHYSICS_Exports/TURBULENCE_Exports/TRI', TRI, _RC) @@ -543,7 +509,6 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) ! deallocate(fieldnames) ! cycle ! endif - call create_extra_var(trim(GigaTrajInternalPtr%ExtraFieldNames(i))) enddo if (MAPL_AM_I_Root()) then call formatter%close() @@ -554,35 +519,67 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) RETURN_(ESMF_SUCCESS) contains - subroutine getExtraFieldNames(other_fields, Fieldnames) - character(*), intent(in) :: other_fields - character(len=ESMF_MAXSTR), allocatable, intent(out) :: Fieldnames(:) - integer :: num_field, i, k, endl, num_ - num_field = 1 - k = 1 - do - i = index(other_fields(k:),';') - if (i == 0) exit - k = k+i - num_field = num_field+1 - enddo - allocate(Fieldnames(num_field)) - k = 1 - num_ = 1 - do - i = index(other_fields(k:),';') - if (i == 0) then - endl = len(other_fields) - else - endl = (k-1)+i-1 - endif - FieldNames(num_) = trim(adjustl(other_fields(k:endl))) - num_ = num_ + 1 - k = endl + 2 - if (num_ > num_field) exit - enddo - end subroutine getExtraFieldNames + subroutine getCompsAndFields(other_fields, CompNames, Fieldnames) + character(*), intent(in) :: other_fields + character(len=ESMF_MAXSTR), allocatable, intent(out) :: CompNames(:) + character(len=ESMF_MAXSTR), allocatable, intent(out) :: Fieldnames(:) + integer :: num_field, i,j, k, endl, num_ + character(len=:), allocatable :: tmp + num_field = 1 + k = 1 + do + i = index(other_fields(k:),';') + if (i == 0) exit + if (trim(other_fields(i+1:)) =='') exit ! take care of the last unnecessay ";" + k = k+i + num_field = num_field+1 + enddo + + allocate(Fieldnames(num_field)) + allocate(Compnames(num_field)) + + k = 1 + num_ = 1 + + do + i = index(other_fields(k:),';') + if (i == 0) then + endl = len(other_fields) + else + endl = (k-1)+i-1 + endif + tmp = other_fields(k:endl) + + j = index(tmp, '%%') + if (j == 0) print*, "Wrong format of the comp%%field" + Compnames(num_) = trim(adjustl(tmp(1:j-1))) + FieldNames(num_) = trim(adjustl(tmp(j+2:))) + num_ = num_ + 1 + k = endl + 2 + if (num_ > num_field) exit + enddo + end subroutine getCompsAndFields + + subroutine create_new_vars(long_name, short_name, units) + character(*), intent(in) :: long_name + character(*), intent(in) :: short_name + character(*), intent(in) :: units + type(Variable) :: var + character(len=:), allocatable :: var_name + if( meta%has_variable(short_name)) return + var_name = short_name + if (MAPL_AM_I_Root()) then + var = variable(type=pFIO_REAL32, dimensions='id,time') + call var%add_attribute('long_name', long_name) + call var%add_attribute('units', units) + call var%add_attribute('positive', "up") + call var%add_attribute('_FillValue', -999.99) + call var%add_attribute('missing_value', -999.99) + call meta%add_variable(var_name, var) + call formatter%add_variable(meta, short_name) + endif + end subroutine create_new_vars ! if the field name is not in original file subroutine create_extra_var(fieldname) @@ -659,6 +656,7 @@ subroutine create_extra_var(fieldname) call meta%add_variable(var_name, var) call formatter%add_variable(meta, var_name) endif + end subroutine create_extra_var end subroutine GetInitVars From f8375bb3c3f07b48d3c14a894c14880e39ab898e Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 20 Sep 2024 09:20:07 -0400 Subject: [PATCH 34/73] 1) add bundle 2) do not allocated field in the bundle --- .../mk_LakeLandiceSaltRestarts.F90 | 3 + .../GEOS_GigatrajGridComp.F90 | 304 +++++++----------- 2 files changed, 124 insertions(+), 183 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_LakeLandiceSaltRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_LakeLandiceSaltRestarts.F90 index 8682376ef..edcb8bf3d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_LakeLandiceSaltRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_LakeLandiceSaltRestarts.F90 @@ -88,6 +88,9 @@ program mk_LakeLandiceSaltRestarts call InFmt%open(InRestart,pFIO_READ,rc=rc) InCfg = InFmt%read(rc=rc) + i = Incfg%get_dimension('tile', _RC) + _ASSERT( i == itiles, "The tile number in restart is inconsistent with the tile file: mk_LakeLandiceSaltRestarts") + call MAPL_IOChangeRes(InCfg,OutCfg,(/'tile'/),(/otiles/),rc=rc) i = index(InRestart,'/',back=.true.) diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index 2d8a75ad0..c22d55c22 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -31,6 +31,9 @@ module GEOS_GigatrajGridCompMod type(ESMF_Time) :: startTime type(ESMF_TimeInterval) :: Integrate_DT character(len=ESMF_MAXSTR), allocatable :: ExtraFieldNames(:) + character(len=ESMF_MAXSTR), allocatable :: ExtraCompNames(:) + character(len=ESMF_MAXSTR), allocatable :: ExtrabundleNames(:) + character(len=ESMF_MAXSTR), allocatable :: ExtraAliasNames(:) type(VerticalData) :: vdata logical :: regrid_to_latlon end type @@ -390,7 +393,7 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=ESMF_MAXSTR) :: GigaRstFile character(len=ESMF_MAXSTR) :: other_fields type(ESMF_Field) :: tmp_field - type (ESMF_FieldBundle) :: TRI + type (ESMF_FieldBundle) :: bdle type (ESMF_TIME) :: CurrentTime character(len=20), target :: ctime type (MAPL_MetaComp), pointer :: MPL @@ -404,7 +407,9 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) character (len=ESMF_MAXSTR), allocatable :: itemNameList(:) character (len=ESMF_MAXSTR) :: LONG_NAME, UNITS character (len=ESMF_MAXSTR), allocatable :: fieldnames(:) + character (len=ESMF_MAXSTR), allocatable :: bundlenames(:) character (len=ESMF_MAXSTR), allocatable :: compnames(:) + character (len=ESMF_MAXSTR), allocatable :: aliasnames(:) integer :: nitems logical :: file_exists @@ -445,70 +450,47 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) meta = formatter%read(_RC) endif - call getCompsAndFields(other_fields, compnames, fieldnames) + call getCompsAndFields(other_fields, compnames, bundlenames, fieldnames, aliasnames) + GigaTrajInternalPtr%ExtraCompNames = compnames + GigaTrajInternalPtr%ExtraBundleNames = bundlenames + GigaTrajInternalPtr%ExtraFieldNames = fieldnames + GigaTrajInternalPtr%ExtraAliasNames = aliasnames do i = 1, size(FieldNames) call MAPL_ExportStateGet([import], trim(compnames(i)), leaf_export, _RC) - call ESMF_StateGet(leaf_export, trim(FieldNames(i)), tmp_field, _RC) + if ( trim(bundlenames(i)) == 'NONE') then + call ESMF_StateGet(leaf_export, trim(FieldNames(i)), tmp_field, _RC) + else + call ESMF_StateGet(leaf_export, trim(bundlenames(i)), bdle, _RC) + call ESMFL_BundleGetPointerToData(bdle , trim(FieldNames(i)) , ptr3d, _RC) + if ( .not. associated(ptr3d)) then + _ASSERT(.false., trim(FieldNames(i)) // " in bundle "//trim(bundlenames(i)) // " is not allocated, gigatraj cannot output this field") + endif + call ESMF_FieldBundleGet(bdle, trim(FieldNames(i)), field=tmp_field, _RC) + endif call MAPL_AllocateCoupling(tmp_field, _RC) call ESMF_AttributeGet(tmp_field, NAME='LONG_NAME', VALUE=LONG_NAME, _RC) call ESMF_AttributeGet(tmp_field, NAME='UNITS', VALUE=UNITS, _RC) - tmp_name =trim(fieldnames(i)) - - if ( index(compnames(i), 'CA.oc') /=0 .or. & - index(compnames(i), 'CA.bc') /=0 ) then - - if (index(tmp_name,'phobic') ==0 .or. & - index(tmp_name,'philic') ==0 ) then - - call ESMF_FieldGet(tmp_field,farrayPtr=ptr3d,rc=status) - do k = 1, size(ptr3d, 3) - fieldname = trim(FieldNames(i))//'00'//i_to_string(k) - call create_new_vars( trim(long_name), trim(fieldname), trim(units)) - enddo - cycle - endif - endif - - call create_new_vars( trim(long_name), trim(fieldnames(i)), trim(units)) - + !tmp_name =trim(fieldnames(i)) + + !if ( index(compnames(i), 'CA.oc') /=0 .or. & + ! index(compnames(i), 'CA.bc') /=0 ) then + ! + ! if (index(tmp_name,'phobic') ==0 .or. & + ! index(tmp_name,'philic') ==0 ) then + + ! call ESMF_FieldGet(tmp_field,farrayPtr=ptr3d,rc=status) + ! do k = 1, size(ptr3d, 3) + ! fieldname = trim(FieldNames(i))//'00'//i_to_string(k) + ! call create_new_vars( trim(long_name), trim(fieldname), trim(units)) + ! enddo + ! cycle + ! endif + !endif + + call create_new_vars( trim(long_name), trim(aliasnames(i)), trim(units)) -! if (index(GigaTrajInternalPtr%ExtraFieldNames(i), 'TRI') /=0) then -! call ESMF_StateGet(import, 'PHYSICS_Exports/TURBULENCE_Exports/TRI', TRI, _RC) -! !call ESMF_FieldBundleGet(TRI, fieldCount=nitems, _RC) -! !allocate(itemNameList(nitems)) -! !call ESMF_FieldBundleGet(TRI,fieldnamelist=itemNameList,rc=status) -! allocate(fieldnames(4)) -! fieldnames(1) = "CA.bc::CA.bcphilicIT" -! fieldnames(2) = "CA.bc::CA.bcphobicIT" -! fieldnames(3) = "CA.oc::CA.ocphilicIT" -! fieldnames(4) = "CA.oc::CA.ocphobicIT" -! do k = 1, 4 -! !call ESMF_FieldBundleGet(TRI, trim(itemNameList(k)), field=tmp_field, _RC) -! !call ESMF_FieldBundleGet(TRI, trim(fieldnames(k)), field=tmp_field, _RC) -! fieldname = trim(fieldnames(k)) -! call ESMF_FieldBundleGet(TRI, fieldname, field=tmp_field, _RC) -! -! !call MAPL_AllocateCoupling(tmp_field, _RC) -! -! call ESMF_FieldGet(tmp_field,farrayPtr=ptr3d, rc=status) -! !if (MAPL_AM_I_Root()) then -! if ( status /=0 )then -! print*, 'status, associated(ptr3d)', status, associated(ptr3d) -! print*, "not created: ", fieldname -! print*, "Add to historty.rc to triger the allocation" -! _FAIL(" Not allocated diffusion tendency") -! !else -! ! print*, "createded: ", itemNameList(k) -! ! print*, "assocated: ", associated(ptr3d), itemNameList(k) -! endif -! !endif -! call create_extra_var(fieldname(8:)) -! enddo -! deallocate(fieldnames) -! cycle -! endif enddo if (MAPL_AM_I_Root()) then call formatter%close() @@ -520,12 +502,14 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) RETURN_(ESMF_SUCCESS) contains - subroutine getCompsAndFields(other_fields, CompNames, Fieldnames) + subroutine getCompsAndFields(other_fields, CompNames, BundleNames, FieldNames, AliasNames) character(*), intent(in) :: other_fields character(len=ESMF_MAXSTR), allocatable, intent(out) :: CompNames(:) - character(len=ESMF_MAXSTR), allocatable, intent(out) :: Fieldnames(:) - integer :: num_field, i,j, k, endl, num_ - character(len=:), allocatable :: tmp + character(len=ESMF_MAXSTR), allocatable, intent(out) :: BundleNames(:) + character(len=ESMF_MAXSTR), allocatable, intent(out) :: FieldNames(:) + character(len=ESMF_MAXSTR), allocatable, intent(out) :: AliasNames(:) + integer :: num_field, i, j, k, l, endl, num_ + character(len=:), allocatable :: tmp, tmp_bnf, tmp_f, tmp_alias num_field = 1 k = 1 do @@ -538,6 +522,8 @@ subroutine getCompsAndFields(other_fields, CompNames, Fieldnames) allocate(Fieldnames(num_field)) allocate(Compnames(num_field)) + allocate(BundleNames(num_field)) + allocate(AliasNames(num_field)) k = 1 num_ = 1 @@ -554,7 +540,29 @@ subroutine getCompsAndFields(other_fields, CompNames, Fieldnames) j = index(tmp, '%%') if (j == 0) print*, "Wrong format of the comp%%field" Compnames(num_) = trim(adjustl(tmp(1:j-1))) - FieldNames(num_) = trim(adjustl(tmp(j+2:))) + tmp_bnf = trim(adjustl(tmp(j+2:))) + + l = index(tmp_bnf, '%') + if (l /=0) then + BundleNames(num_) = tmp_bnf(1:l-1) + tmp_f = tmp_bnf(l+1:) + else + BundleNames(num_) = 'NONE' + tmp_f = tmp_bnf + endif + + ! Aliasing....., Hard coded here + l = index(tmp_f, '|') + if (l /=0) then + FieldNames(num_) = tmp_f(1:l-1) + tmp_alias = tmp_f(l+1:) + else + FieldNames(num_) = tmp_f + tmp_alias = tmp_f + endif + + AliasNames(num_) = tmp_alias + num_ = num_ + 1 k = endl + 2 if (num_ > num_field) exit @@ -581,83 +589,6 @@ subroutine create_new_vars(long_name, short_name, units) endif end subroutine create_new_vars - ! if the field name is not in original file - subroutine create_extra_var(fieldname) - character(*), intent(in) :: fieldname - type(Variable) :: var - character(len=:), allocatable :: long_name, units, var_name - real, allocatable :: tmp(:) - select case (fieldname) - case('TH') - var_name = 'TH' - long_name = "air_potential_temperature" - units = "K" - case('T') - var_name = 'T' - long_name = "air_temperature" - units = "K" - case('PALT') - var_name = 'PALT' - long_name = "pressure_altitude" - units = "km" - case default - var_name = trim(fieldname) - long_name = "unkown" - units = "1" - !print*, "Not yet define attribute of "//var_name - end select - - if (index(var_name, 'CA.bcSD') /=0) then - long_name = "Carbonaceous_Aerosol_Sedimentation_bin" - units = "kg m-2 s-1" - endif - if (index(var_name, 'CA.bcSV') /=0) then - long_name = "Carbonaceous_Aerosol_Convective_Scavenging_bin" - units = "kg m-2 s-1" - endif - if (index(var_name, 'CA.bcDP') /=0) then - long_name = "Carbonaceous_Aerosol_Dry_Deposition_bin" - units = "kg m-2 s-1" - endif - if (index(var_name, 'CA.bcWT') /=0) then - long_name = "Carbonaceous_Aerosol_Wet_Deposition_bin" - units = "kg m-2 s-1" - endif - - if (index(var_name, 'CA.ocSD') /=0) then - long_name = "Carbonaceous_Aerosol_Sedimentation_bin" - units = "kg m-2 s-1" - endif - if (index(var_name, 'CA.ocSV') /=0) then - long_name = "Carbonaceous_Aerosol_Convective_Scavenging_bin" - units = "kg m-2 s-1" - endif - if (index(var_name, 'CA.ocDP') /=0) then - long_name = "Carbonaceous_Aerosol_Dry_Deposition_bin" - units = "kg m-2 s-1" - endif - if (index(var_name, 'CA.ocWT') /=0) then - long_name = "Carbonaceous_Aerosol_Wet_Deposition_bin" - units = "kg m-2 s-1" - endif - if (index(var_name, 'phobic') /=0 .or. index(var_name, 'philic')/=0) then - long_name = "Carbonaceous_Aerosol_Mixing_Ratio" - units = "kg kg-1" - endif - - if( meta%has_variable(var_name)) return - if (MAPL_AM_I_Root()) then - var = variable(type=pFIO_REAL32, dimensions='id,time') - call var%add_attribute('long_name', long_name) - call var%add_attribute('units', units) - call var%add_attribute('positive', "up") - call var%add_attribute('_FillValue', -999.99) - call var%add_attribute('missing_value', -999.99) - call meta%add_variable(var_name, var) - call formatter%add_variable(meta, var_name) - endif - - end subroutine create_extra_var end subroutine GetInitVars subroutine Init_metsrc_field0 (GC, state, ctime, PL, RC ) @@ -672,11 +603,11 @@ subroutine Init_metsrc_field0 (GC, state, ctime, PL, RC ) type(GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap - real, dimension(:,:,:), pointer :: U, V, W, P, PL0, PLE + real, dimension(:,:,:), pointer :: U, V, W, P, PL0, PLE, TH real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon, P_latlon real, dimension(:,:,:), allocatable :: U_inter, V_inter, W_inter, P_inter real, dimension(:,:,:), allocatable, target :: haloU, haloV, haloW, haloP - integer :: counts(3), dims(3), d1,d2,km,lm + integer :: counts(3), dims(3), d1,d2,km,lm, i1,i2,j1,j2 Iam = "init_metsrc_field0" @@ -700,6 +631,9 @@ subroutine Init_metsrc_field0 (GC, state, ctime, PL, RC ) W = 0.0 endif + + + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) GigaTrajInternalPtr => wrap%ptr call ESMF_StateGet(state, 'PLE', field=GigaTrajInternalPtr%vdata%interp_var, rc=status) @@ -785,7 +719,7 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap - integer :: lm, d1,d2 + integer :: lm, d1, d2 integer ::counts(3), DIMS(3), comm, ierror type (ESMF_VM) :: vm @@ -1273,7 +1207,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) type (ESMF_VM) :: vm type(Netcdf4_fileformatter) :: formatter integer :: comm, my_rank, total_num, i, k,status, last_time, ierror, count3 - real, allocatable :: lats0(:), lons0(:), zs0(:), ids0_r(:), values(:), values0(:) + real, allocatable :: lats0(:), lons0(:), zs0(:), values(:), values0(:) real,target, allocatable :: values_2d(:,:) real,pointer :: field(:,:,:) integer, allocatable :: ids0(:), ids0_in(:) @@ -1284,7 +1218,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) type(MAPL_MetaComp),pointer :: MPL character(len=ESMF_MAXSTR) :: parcels_file, other_fields character(len=ESMF_MAXSTR), allocatable :: varnames(:) - character(len=:), allocatable:: var_name, var_ + character(len=:), allocatable:: var_name, var_, comp_name, var_alias, bdlename type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap @@ -1350,16 +1284,10 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) ctime(20:20) = c_null_char do k = 1, size(GigaTrajInternalPtr%ExtraFieldNames) - select case (trim(GigaTrajInternalPtr%ExtraFieldNames(k))) - case('TH') - var_name = 'TH' - case('T') - var_name = 'T' - case('PALT') - var_name = 'PALT' - case default - var_name = trim(GigaTrajInternalPtr%ExtraFieldNames(k)) - end select + comp_name = trim(GigaTrajInternalPtr%ExtraCompNames(k)) + var_name = trim(GigaTrajInternalPtr%ExtraFieldNames(k)) + bdlename = trim(GigaTrajInternalPtr%ExtraBundleNames(k)) + var_alias = trim(GigaTrajInternalPtr%ExtraAliasNames(k)) if ( index(var_name, 'bcDP') /= 0 .or. & index(var_name, 'ocDP') /= 0 .or. & @@ -1379,7 +1307,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) if (my_rank == 0) then values0 = values0(ids0(:)) - var_ = var_name //'00'//i_to_string(i) + var_ = var_alias //'00'//i_to_string(i) if ( meta%has_variable(var_)) then call formatter%put_var( var_, values0, start=[1, last_time+1], _RC) else @@ -1397,7 +1325,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) varnames(4) = "CA.oc::CA.ocphobicIT" do i = 1, 4 var_ = varnames(i)(8:) - call get_metsrc_data (GC, state, ctime, varnames(i), values, _RC) + call get_metsrc_data (GC, state, ctime, comp_name, bdlename, varnames(i), values, _RC) call gather_onefield(total_num, values0, comm, values, GigaTrajInternalPtr%parcels%num_parcels) if (my_rank == 0) then @@ -1412,15 +1340,14 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) deallocate(values, varnames) else allocate(values(GigaTrajInternalPtr%parcels%num_parcels)) - call get_metsrc_data (GC, state, ctime, var_name, values, _RC ) + call get_metsrc_data (GC, state, ctime, comp_name, bdlename, var_name, values, _RC ) call gather_onefield(total_num, values0, comm, values, GigaTrajInternalPtr%parcels%num_parcels) - if (my_rank == 0) then values0 = values0(ids0(:)) - if ( meta%has_variable(var_name)) then - call formatter%put_var( var_name, values0, start=[1, last_time+1], _RC) + if ( meta%has_variable(var_alias)) then + call formatter%put_var( var_alias, values0, start=[1, last_time+1], _RC) else - print*, "Please provide "//var_name // " in the file "//trim(parcels_file) + print*, "Please provide "//var_alias // " in the file "//trim(parcels_file) endif endif deallocate(values) @@ -1445,9 +1372,9 @@ subroutine read_parcels(GC,internal, rc) type(FileMetadata) :: meta integer :: comm, my_rank, total_num, ierror, last_time real, allocatable :: lats0(:), lons0(:), zs0(:) - real(kind=ESMF_KIND_R8), allocatable :: ids0_r(:) + !real(kind=ESMF_KIND_R8), allocatable :: ids0_r(:) integer, allocatable :: ids0(:) - integer :: status + integer :: status, k character(len=ESMF_MAXSTR) :: parcels_file character(len=ESMF_MAXSTR) :: regrid_to_latlon type(MAPL_MetaComp),pointer :: MPL @@ -1481,15 +1408,15 @@ subroutine read_parcels(GC,internal, rc) end select endif - allocate(lats0(total_num), lons0(total_num), zs0(total_num),ids0(total_num), ids0_r(total_num)) + allocate(lats0(total_num), lons0(total_num), zs0(total_num),ids0(total_num)) if (my_rank ==0) then call formatter%get_var('lat', lats0, start = [1,last_time], _RC) call formatter%get_var('lon', lons0, start = [1,last_time], _RC) call formatter%get_var('P', zs0, start = [1,last_time], _RC) - call formatter%get_var('id', ids0_r,start = [1,last_time], _RC) + !call formatter%get_var('id', ids0_r,start = [1,last_time], _RC) call formatter%close(_RC) - ids0 = int(ids0_r) + ids0 = [(k, k=0,total_num-1)] endif call MAPL_GetResource(MPL, regrid_to_latlon, "GIGATRAJ_REGRID_TO_LATLON:", default= 'YES' , _RC) if (trim (regrid_to_latlon) == 'YES') then @@ -1504,7 +1431,6 @@ subroutine read_parcels(GC,internal, rc) Internal%parcels%IDS, & Internal%parcels%num_parcels) - deallocate(lats0, lons0, zs0, ids0_r) RETURN_(ESMF_SUCCESS) contains ! a copy from MAPL_TimeMod @@ -1596,10 +1522,12 @@ function parse_time_string(timeUnits,rc) result(time) end function parse_time_string end subroutine read_parcels - subroutine get_metsrc_data (GC, state, ctime, fieldname, values, RC ) + subroutine get_metsrc_data (GC, state, ctime, compname, bundlename, fieldname, values, RC ) type(ESMF_GridComp), intent(inout) :: GC ! Gridded component type(ESMF_State), intent(inout) :: state character(*), target, intent(in) :: ctime + character(*), intent(in) :: compname + character(*), intent(in) :: bundlename character(*), intent(in) :: fieldname real, target, intent(inout) :: values(:) integer, optional, intent(out) :: RC ! Error code @@ -1609,27 +1537,34 @@ subroutine get_metsrc_data (GC, state, ctime, fieldname, values, RC ) type(GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap - type (ESMF_FieldBundle) :: TRI - type (ESMF_Field) :: field + type (ESMF_FieldBundle) :: bdle type (ESMF_GRID) :: grid_ + type(ESMF_State) :: leaf_export real, dimension(:,:,:), pointer :: ptr3d - real, dimension(:,:,:), allocatable :: field_latlon + real, dimension(:,:,:), allocatable :: field_latlon, field_inter + real, dimension(:,:,:), allocatable, target :: haloField integer :: counts(3), dims(3), d1,d2,km, count3 character(len=:), target, allocatable :: field_ Iam = "get_metsrc_data" - if (index(fieldname,'philicIT') /=0 .or. index(fieldname,'phobicIT') /=0) then - call ESMF_StateGet(state, 'PHYSICS_Exports/TURBULENCE_Exports/TRI', TRI, _RC) - call ESMF_FieldBundleGet(TRI, fieldname, field=field, _RC) - call ESMF_FieldGet(field,farrayPtr=ptr3d, _RC) + !if (index(fieldname,'philicIT') /=0 .or. index(fieldname,'phobicIT') /=0) then + ! call ESMF_StateGet(state, 'PHYSICS_Exports/TURBULENCE_Exports/TRI', TRI, _RC) + ! call ESMF_FieldBundleGet(TRI, fieldname, field=field, _RC) + ! call ESMF_FieldGet(field,farrayPtr=ptr3d, _RC) + !else + ! call MAPL_GetPointer(state, ptr3d, fieldname, _RC) + !endif + + call MAPL_ExportStateGet([state], trim(compname), leaf_export, _RC) + if (trim(bundlename) /= 'NONE') then + call ESMF_StateGet(leaf_export, trim(bundlename), bdle, _RC) + call ESMFL_BundleGetPointerToData(bdle, fieldname, ptr3d, _RC) else - call MAPL_GetPointer(state, ptr3d, fieldname, _RC) + call MAPL_GetPointer(leaf_export, ptr3d, fieldname, _RC) endif - count3 = size(ptr3d,3) - call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) GigaTrajInternalPtr => wrap%ptr if (GigaTrajInternalPtr%regrid_to_latlon) then @@ -1640,14 +1575,17 @@ subroutine get_metsrc_data (GC, state, ctime, fieldname, values, RC ) call MAPL_GridGet(grid_, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) - allocate(field_latlon(counts(1),counts(2),count3)) - allocate(haloField(counts(1)+2, counts(2)+2,count3), source = 0.0) + allocate(field_inter(counts(1),counts(2),DIMS(3))) + call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(ptr3d, field_inter,rc=status) + + allocate(field_latlon(counts(1),counts(2),dims(3))) + allocate(haloField(counts(1)+2, counts(2)+2,dims(3)), source = 0.0) if (GigaTrajInternalPtr%regrid_to_latlon) then - call GigaTrajInternalPtr%cube2latlon%regrid(ptr3d, Field_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(field_inter, Field_latlon, _RC) call esmf_halo(grid_, Field_latlon, haloField, _RC) else - call esmf_halo(grid_, ptr3d, haloField, _RC) + call esmf_halo(grid_, field_inter, haloField, _RC) endif field_ = trim(fieldname)//c_null_char @@ -1659,7 +1597,7 @@ subroutine get_metsrc_data (GC, state, ctime, fieldname, values, RC ) c_loc(GigaTrajInternalPtr%parcels%zs), & c_loc(values)) - deallocate(field_latlon, haloField) + deallocate(field_latlon, haloField, field_inter) RETURN_(ESMF_SUCCESS) end subroutine get_metsrc_data From 6fbbceac6cab04b63e4543830c3ace09fd0c8b4e Mon Sep 17 00:00:00 2001 From: Mike Manyin Date: Wed, 30 Oct 2024 13:44:59 -0400 Subject: [PATCH 35/73] Added ZLCL and ZLFC connectivity from MOIST to CHEM --- .../GEOSphysics_GridComp/GEOS_PhysicsGridComp.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOS_PhysicsGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOS_PhysicsGridComp.F90 index 36dd7c3f6..068af3a61 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOS_PhysicsGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOS_PhysicsGridComp.F90 @@ -1215,8 +1215,8 @@ subroutine SetServices ( GC, RC ) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/ 'RL ', 'QL ', 'QLTOT ', 'DQLDT ', & 'RI ', 'QI ', 'QITOT ', 'DQIDT ', & - 'QLCN ', 'PFL_CN ', 'PFL_LSAN', & - 'QICN ', 'PFI_CN ', 'PFI_LSAN', & + 'QLCN ', 'PFL_CN ', 'PFL_LSAN', 'ZLCL ', & + 'QICN ', 'PFI_CN ', 'PFI_LSAN', 'ZLFC ', & 'FCLD ', 'QCTOT ', 'CNV_QC ', & 'REV_LS ', 'REV_AN ', 'REV_CN ', 'TPREC ', & 'Q ', 'DQDT ', 'DQRL ', 'DQRC ', & From a3defaae8fd3c9a87579cccf5157f09343a1f261 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 31 Oct 2024 12:00:25 -0400 Subject: [PATCH 36/73] change vscale, no edge, correct the third values --- GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 | 5 + .../GEOS_GigatrajGridComp.F90 | 165 +++++++++--------- 2 files changed, 89 insertions(+), 81 deletions(-) diff --git a/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 b/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 index 6336d6830..48a061ff2 100644 --- a/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 +++ b/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 @@ -806,6 +806,11 @@ subroutine SetServices ( GC, RC ) CHILD_ID = SDYN, & RC = STATUS) VERIFY_(STATUS) + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DTDTDYN', & + CHILD_ID = SDYN, & + RC = STATUS) + VERIFY_(STATUS) #endif call MAPL_AddExportSpec( GC, & diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index c22d55c22..f0dc97150 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -34,6 +34,10 @@ module GEOS_GigatrajGridCompMod character(len=ESMF_MAXSTR), allocatable :: ExtraCompNames(:) character(len=ESMF_MAXSTR), allocatable :: ExtrabundleNames(:) character(len=ESMF_MAXSTR), allocatable :: ExtraAliasNames(:) + + character(len=ESMF_MAXSTR) :: vertical_coord + character(len=ESMF_MAXSTR) :: vertical_tendency + type(VerticalData) :: vdata logical :: regrid_to_latlon end type @@ -230,9 +234,22 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_GridCompGet(GC, grid=CubedGrid, _RC) call MAPL_GridGet(CubedGrid, globalCellCountPerDim=DIMS, _RC) - levs_center = [1000., 975., 950., 925., 900., 875., 850., 825., 800., 775., 750., 725.,700., 650., 600., 550., 500., & + call MAPL_GetResource(MPL, GigaTrajInternalPtr%vertical_coord, "GIGATRAJ_VERTICAL_COORD:", default='PL', rc=status) + select case(trim(GigaTrajInternalPtr%vertical_coord)) + case ('PL') + levs_center = [1000., 975., 950., 925., 900., 875., 850., 825., 800., 775., 750., 725.,700., 650., 600., 550., 500., & + 450., 400., 350., 300., 250., 200., 150., 100., 70., 50., 40., 30., 20., 10., 7., 5., 4., 3., 2., & + 1., 0.7, 0.5, 0.4, 0.3, 0.2, 0.1, 0.07, 0.05, 0.04, 0.03, 0.02]*100 + GigaTrajInternalPtr%vertical_tendency = 'OMEGA' + case('TH') + levs_center = [1000., 975., 950., 925., 900., 875., 850., 825., 800., 775., 750., 725.,700., 650., 600., 550., 500., & 450., 400., 350., 300., 250., 200., 150., 100., 70., 50., 40., 30., 20., 10., 7., 5., 4., 3., 2., & 1., 0.7, 0.5, 0.4, 0.3, 0.2, 0.1, 0.07, 0.05, 0.04, 0.03, 0.02] + GigaTrajInternalPtr%vertical_tendency = 'DTDTDYN' + case default + _ASSERT(.false., "vertical coordinate is needed") + end select + npz = size(levs_center, 1) GigaTrajInternalPtr%npz = npz GigaTrajInternalPtr%Integrate_DT = Integrate_DT @@ -283,7 +300,7 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_GridGetCoord(grid_ , coordDim=1, localDE=0, & staggerloc=ESMF_STAGGERLOC_CENTER, & farrayPtr=centerX, rc=status) - VERIFY_(STATUS) + _VERIFY(STATUS) ptr(1:imc,1:jmc)=centerX call ESMF_FieldHalo(field,rh,rc=status) @@ -351,7 +368,12 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) enddo ! WJiang notes: the vcoord should be consistent with the HISTORY.rc levs_ptr=>levs_center - GigaTrajInternalPtr%vdata = VerticalData(levs_ptr, vcoord = 'log(PLE)', vscale = 100.0, vunit = 'hPa',_RC) + select case (trim(GigaTrajInternalPtr%vertical_coord)) + case ('PL') + GigaTrajInternalPtr%vdata = VerticalData(levs_ptr, vcoord = 'log(PL)', vscale = 1.0, vunit = 'Pa',_RC) + case ('TH') + GigaTrajInternalPtr%vdata = VerticalData(levs_ptr, vcoord = 'TH', vscale = 1.0, vunit = 'K',_RC) + end select call MAPL_Grid_interior(Grid_,i1,i2,j1,j2) if (GigaTrajInternalPtr%regrid_to_latlon) then @@ -434,11 +456,11 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) if (trim(GigaRstFile) == 'NONE') then ! without restart file, get value from import - call init_metsrc_field0(GC, IMPORT, ctime, 'PLE', _RC) + call init_metsrc_field0(GC, IMPORT, ctime, _RC) else INQUIRE(FILE= GigaRstFile, EXIST=file_exists) _ASSERT( file_exists, " GIGATRAJ_INTERNAL_RESTART_FILE does not exist") - call init_metsrc_field0(GC, INTERNAL, ctime, 'PL', _RC) + call init_metsrc_field0(GC, INTERNAL, ctime, _RC) endif call MAPL_GetResource(MPL, other_fields, "GIGATRAJ_EXTRA_FIELDS:", default='NONE', _RC) @@ -472,23 +494,6 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_AttributeGet(tmp_field, NAME='LONG_NAME', VALUE=LONG_NAME, _RC) call ESMF_AttributeGet(tmp_field, NAME='UNITS', VALUE=UNITS, _RC) - !tmp_name =trim(fieldnames(i)) - - !if ( index(compnames(i), 'CA.oc') /=0 .or. & - ! index(compnames(i), 'CA.bc') /=0 ) then - ! - ! if (index(tmp_name,'phobic') ==0 .or. & - ! index(tmp_name,'philic') ==0 ) then - - ! call ESMF_FieldGet(tmp_field,farrayPtr=ptr3d,rc=status) - ! do k = 1, size(ptr3d, 3) - ! fieldname = trim(FieldNames(i))//'00'//i_to_string(k) - ! call create_new_vars( trim(long_name), trim(fieldname), trim(units)) - ! enddo - ! cycle - ! endif - !endif - call create_new_vars( trim(long_name), trim(aliasnames(i)), trim(units)) enddo @@ -591,11 +596,10 @@ end subroutine create_new_vars end subroutine GetInitVars - subroutine Init_metsrc_field0 (GC, state, ctime, PL, RC ) + subroutine Init_metsrc_field0 (GC, state, ctime, RC ) type(ESMF_GridComp), intent(inout) :: GC ! Gridded component type(ESMF_State), intent(inout) :: state character(*), target, intent(in) :: ctime - character(*), intent(in) :: PL integer, optional, intent(out) :: RC ! Error code character(len=ESMF_MAXSTR) :: IAm @@ -608,35 +612,22 @@ subroutine Init_metsrc_field0 (GC, state, ctime, PL, RC ) real, dimension(:,:,:), allocatable :: U_inter, V_inter, W_inter, P_inter real, dimension(:,:,:), allocatable, target :: haloU, haloV, haloW, haloP integer :: counts(3), dims(3), d1,d2,km,lm, i1,i2,j1,j2 + character(len=:), allocatable :: vcoord Iam = "init_metsrc_field0" + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) + GigaTrajInternalPtr => wrap%ptr + call MAPL_GetPointer(state, U, "U", _RC) call MAPL_GetPointer(state, V, "V", _RC) - call MAPL_GetPointer(state, W, "OMEGA", _RC) - - - PL0=>null() - if (PL == 'PL') then - call MAPL_GetPointer(state, P, "PL", _RC) - else if (PL == 'PLE') then - call MAPL_GetPointer(state, PLE, "PLE", _RC) - d1 =size(PLE,1) - d2 =size(PLE,2) - km =size(PLE,3)-1 - allocate(PL0(d1,d2,km)) - ! WJ notes, PLE's lower bound is (1,1,0) - PL0 = (PLE(:,:,1:km)+PLE(:,:,0:km-1))*0.5 - P => PL0 - W = 0.0 - endif - - + call MAPL_GetPointer(state, W, trim(GigaTrajInternalPtr%vertical_tendency), _RC) + call MAPL_GetPointer(state, P, trim(GigaTrajInternalPtr%vertical_coord), _RC) + vcoord = "PL" + if (trim(GigaTrajInternalPtr%vertical_coord) == "TH") vcoord = "ZLE" - call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) - GigaTrajInternalPtr => wrap%ptr - call ESMF_StateGet(state, 'PLE', field=GigaTrajInternalPtr%vdata%interp_var, rc=status) + call ESMF_StateGet(state, vcoord , field=GigaTrajInternalPtr%vdata%interp_var, rc=status) call GigaTrajInternalPtr%vdata%setup_eta_to_pressure(_RC) if (GigaTrajInternalPtr%regrid_to_latlon) then @@ -719,12 +710,12 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap - integer :: lm, d1, d2 + integer :: lm, d1, d2, k integer ::counts(3), DIMS(3), comm, ierror type (ESMF_VM) :: vm real, dimension(:,:,:), pointer :: U_cube, V_cube, W_cube, P_cube, PLE_Cube, with_halo - real, dimension(:,:,:), pointer :: U_internal, V_internal, W_internal, P_internal, PLE_internal + real, dimension(:,:,:), pointer :: internal_field, model_field real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon, P_latlon real, dimension(:,:,:), allocatable :: U_inter, V_inter, W_inter, P_inter @@ -736,30 +727,25 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) type(ESMF_State) :: INTERNAL type(MAPL_MetaComp),pointer :: MPL type(ESMF_Alarm) :: GigaTrajIntegrateAlarm + type(MAPL_VarSpec ), pointer:: internal_specs(:) + character(len=ESMF_MAXSTR) :: SHORT_NAME + character(len=:), allocatable :: vcoord !--------------- ! Update internal !--------------- - call MAPL_GetPointer(Import, U_cube, "U", _RC) - call MAPL_GetPointer(Import, V_cube, "V", _RC) - call MAPL_GetPointer(Import, W_cube, "OMEGA", _RC) - call MAPL_GetPointer(Import, P_cube, "PL", _RC) - call MAPL_GetPointer(Import, PLE_cube, "PLE", _RC) - + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) + GigaTrajInternalPtr => wrap%ptr call MAPL_GetObjectFromGC ( GC, MPL, _RC) call MAPL_Get (MPL, INTERNAL_ESMF_STATE=INTERNAL, _RC) - call MAPL_GetPointer(INTERNAL, U_internal, "U", _RC) - call MAPL_GetPointer(INTERNAL, V_internal, "V", _RC) - call MAPL_GetPointer(INTERNAL, W_internal, "OMEGA", _RC) - call MAPL_GetPointer(INTERNAL, P_internal, "PL", _RC) - call MAPL_GetPointer(INTERNAL, PLE_internal, "PLE", _RC) - - U_internal = U_cube - V_internal = V_cube - W_internal = W_cube - P_internal = P_cube - PLE_internal = PLE_cube + call MAPL_GridCompGetVarSpecs(GC, INTERNAL=internal_specs, _RC) + do K=1,size(internal_specs) + call MAPL_VarSpecGet(internal_specs(k), SHORT_NAME=SHORT_NAME, _RC) + call MAPL_GetPointer(Import, model_field, trim(short_name), _RC) + call MAPL_GetPointer(INTERNAL, internal_field, trim(short_name), _RC) + internal_field(:,:,:) = model_field(:,:,:) + enddo call ESMF_ClockGetAlarm(clock, 'GigatrajIntegrate', GigaTrajIntegrateAlarm, _RC) @@ -776,8 +762,6 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) ! W.J note: this run is after agcm's run. The clock is not yet ticked ! So the values we are using are at (CurrentTime + ModelTimeStep) - call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) - GigaTrajInternalPtr => wrap%ptr CurrentTime = CurrentTime + ModelTimeStep call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) @@ -792,6 +776,10 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) !--------------- ! Step 1) Regrid the metData field from cubed to lat-lon !--------------- + call MAPL_GetPointer(Import, U_cube, "U", _RC) + call MAPL_GetPointer(Import, V_cube, "V", _RC) + call MAPL_GetPointer(Import, W_cube, trim(GigaTrajInternalPtr%vertical_tendency), _RC) + call MAPL_GetPointer(Import, P_cube, trim(GigaTrajInternalPtr%vertical_coord), _RC) lm = size(GigaTrajInternalPtr%vdata%levs) d1 = size(u_cube,1) @@ -821,8 +809,9 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) allocate(haloW(counts(1)+2, counts(2)+2,lm), source = 0.0) allocate(haloP(counts(1)+2, counts(2)+2,lm), source = 0.0) - - call ESMF_StateGet(import, 'PLE', field=GigaTrajInternalPtr%vdata%interp_var, rc=status) + vcoord = 'PL' + if (trim(GigaTrajInternalPtr%vertical_coord) == 'TH') vcoord = 'ZLE' + call ESMF_StateGet(import, vcoord, field=GigaTrajInternalPtr%vdata%interp_var, _RC) call GigaTrajInternalPtr%vdata%setup_eta_to_pressure(_RC) call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(U_cube, U_inter,rc=status) @@ -1223,6 +1212,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap character(len=20), target :: ctime + character(len=:), allocatable :: vAlias Iam = "write_parcels" call ESMF_ClockGetAlarm(clock, 'GigatrajOut', GigaTrajOutAlarm, _RC) @@ -1249,6 +1239,11 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) if (my_rank ==0) then + if (trim(GigaTrajInternalPtr%vertical_coord) == 'PL') then + vAlias = 'P' + zs0 = zs0 / 100.0 ! hard coded, conert Pa back to hPa + endif + if (trim(GigaTrajInternalPtr%vertical_coord) == 'TH') vAlias = 'Theta' ! reorder ids0 = ids0 + 1 ! element start 0, make it to 1 for ordering ids0(ids0) = [(k, k=1,size(ids0))] @@ -1275,7 +1270,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) call formatter%put_var('lat', lats0, start=[1, last_time+1], _RC) call formatter%put_var('lon', lons0, start=[1, last_time+1], _RC) - call formatter%put_var('P', zs0, start=[1, last_time+1], _RC) + call formatter%put_var(vAlias, zs0, start=[1, last_time+1], _RC) call formatter%put_var('time', [tint_d], start=[last_time+1], _RC) endif @@ -1383,6 +1378,7 @@ subroutine read_parcels(GC,internal, rc) class(Variable), pointer :: t type(Attribute), pointer :: attr class(*), pointer :: units + character(len=:), allocatable :: vAlias character(len=ESMF_MAXSTR) :: Iam ="read_parcels" call ESMF_VMGetCurrent(vm, _RC) @@ -1409,12 +1405,14 @@ subroutine read_parcels(GC,internal, rc) endif allocate(lats0(total_num), lons0(total_num), zs0(total_num),ids0(total_num)) - + if (trim(internal%vertical_coord) == 'PL') vAlias = 'P' + if (trim(internal%vertical_coord) == 'TH') vAlias = 'Theta' + if (my_rank ==0) then call formatter%get_var('lat', lats0, start = [1,last_time], _RC) call formatter%get_var('lon', lons0, start = [1,last_time], _RC) - call formatter%get_var('P', zs0, start = [1,last_time], _RC) - !call formatter%get_var('id', ids0_r,start = [1,last_time], _RC) + call formatter%get_var(vAlias,zs0, start = [1,last_time], _RC) + if (vAlias == 'P') zs0 = zs0*100.0 ! hard coded from hPa to Pa call formatter%close(_RC) ids0 = [(k, k=0,total_num-1)] endif @@ -1544,7 +1542,7 @@ subroutine get_metsrc_data (GC, state, ctime, compname, bundlename, fieldname, v real, dimension(:,:,:), allocatable :: field_latlon, field_inter real, dimension(:,:,:), allocatable, target :: haloField - integer :: counts(3), dims(3), d1,d2,km, count3 + integer :: counts(3), dims(3), d1, d2, lm, count3 character(len=:), target, allocatable :: field_ Iam = "get_metsrc_data" @@ -1567,19 +1565,24 @@ subroutine get_metsrc_data (GC, state, ctime, compname, bundlename, fieldname, v call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) GigaTrajInternalPtr => wrap%ptr + + lm = size(GigaTrajInternalPtr%vdata%levs) + d1 = size(ptr3d,1) + d2 = size(ptr3d,2) + + allocate(field_inter(d1,d2,lm), source = 0.0) + call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(ptr3d, field_inter,rc=status) + if (GigaTrajInternalPtr%regrid_to_latlon) then grid_ = GigaTrajInternalPtr%LatLonGrid + call MAPL_GridGet(grid_, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) + allocate(field_latlon(counts(1),counts(2), lm)) else grid_ = GigaTrajInternalPtr%CubedGrid + call MAPL_GridGet(grid_, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) endif - call MAPL_GridGet(grid_, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) - - allocate(field_inter(counts(1),counts(2),DIMS(3))) - call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(ptr3d, field_inter,rc=status) - - allocate(field_latlon(counts(1),counts(2),dims(3))) - allocate(haloField(counts(1)+2, counts(2)+2,dims(3)), source = 0.0) + allocate(haloField(counts(1)+2, counts(2)+2, lm), source = 0.0) if (GigaTrajInternalPtr%regrid_to_latlon) then call GigaTrajInternalPtr%cube2latlon%regrid(field_inter, Field_latlon, _RC) From 5f24af454258116dc2cdd1e19fcd139a6bee5a48 Mon Sep 17 00:00:00 2001 From: bzhao Date: Thu, 31 Oct 2024 12:44:24 -0400 Subject: [PATCH 37/73] changed refresh method registration to using newly introduced MAPL flag; now rewind uses official MAPL facility --- .../CICE_GEOSPlug/CICE_GEOSPlug.F90 | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/GEOSogcm_GridComp/GEOSseaice_GridComp/CICE_GEOSPlug/CICE_GEOSPlug.F90 b/GEOSogcm_GridComp/GEOSseaice_GridComp/CICE_GEOSPlug/CICE_GEOSPlug.F90 index 46e2af25b..68eb74d71 100644 --- a/GEOSogcm_GridComp/GEOSseaice_GridComp/CICE_GEOSPlug/CICE_GEOSPlug.F90 +++ b/GEOSogcm_GridComp/GEOSseaice_GridComp/CICE_GEOSPlug/CICE_GEOSPlug.F90 @@ -94,7 +94,7 @@ subroutine SetServices ( GC, 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_WRITERESTART, Record, _RC) - call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_READRESTART, Refresh, _RC) + call MAPL_GridCompSetEntryPoint ( GC, MAPL_METHOD_REFRESH, Refresh, _RC) ! Set the state variable specs. ! ----------------------------- @@ -946,7 +946,10 @@ subroutine Record ( GC, IMPORT, EXPORT, CLOCK, RC ) ! ----------------------------------------------------------- call ESMF_GridCompGet( GC, NAME=COMP_NAME, _RC) - Iam = trim(COMP_NAME)//'::'//Iam + + ! for some reason, this causes Iam growing with CICE6 prefix + ! disable it for now + ! Iam = trim(COMP_NAME)//'::'//Iam ! Get my internal MAPL_Generic state !----------------------------------- @@ -1020,7 +1023,9 @@ subroutine Refresh ( GC, IMPORT, EXPORT, CLOCK, RC ) ! ----------------------------------------------------------- call ESMF_GridCompGet( GC, NAME=COMP_NAME, _RC) - Iam = trim(COMP_NAME)//'::'//Iam + ! for some reason, this causes Iam growing with CICE6 prefix + ! disable it for now + !Iam = trim(COMP_NAME)//'::'//Iam ! Get my internal MAPL_Generic state !----------------------------------- From 8701801f260e72cdf4d8980c3a5b36d40e699a1f Mon Sep 17 00:00:00 2001 From: bzhao Date: Thu, 31 Oct 2024 13:37:54 -0400 Subject: [PATCH 38/73] fixed Iam string --- .../CICE_GEOSPlug/CICE_GEOSPlug.F90 | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/GEOSogcm_GridComp/GEOSseaice_GridComp/CICE_GEOSPlug/CICE_GEOSPlug.F90 b/GEOSogcm_GridComp/GEOSseaice_GridComp/CICE_GEOSPlug/CICE_GEOSPlug.F90 index 68eb74d71..18f714055 100644 --- a/GEOSogcm_GridComp/GEOSseaice_GridComp/CICE_GEOSPlug/CICE_GEOSPlug.F90 +++ b/GEOSogcm_GridComp/GEOSseaice_GridComp/CICE_GEOSPlug/CICE_GEOSPlug.F90 @@ -933,6 +933,8 @@ subroutine Record ( GC, IMPORT, EXPORT, CLOCK, RC ) type(MAPL_MetaComp), pointer :: MAPL ! ErrLog Variables + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME @@ -940,16 +942,13 @@ subroutine Record ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=14) :: timeStamp logical :: doRecord - __Iam__('Record') + Iam = "Record" ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- call ESMF_GridCompGet( GC, NAME=COMP_NAME, _RC) - - ! for some reason, this causes Iam growing with CICE6 prefix - ! disable it for now - ! Iam = trim(COMP_NAME)//'::'//Iam + Iam = trim(COMP_NAME)//'::'//Iam ! Get my internal MAPL_Generic state !----------------------------------- @@ -1006,26 +1005,24 @@ subroutine Refresh ( GC, IMPORT, EXPORT, CLOCK, RC ) integer, optional, intent( OUT) :: RC ! Error code !EOP - type(MAPL_MetaComp), pointer :: MAPL ! ErrLog Variables - + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME ! Locals character(len=14) :: timeStamp logical :: doRecord - __Iam__('Restore') + IAm = "Restore" ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- call ESMF_GridCompGet( GC, NAME=COMP_NAME, _RC) - ! for some reason, this causes Iam growing with CICE6 prefix - ! disable it for now - !Iam = trim(COMP_NAME)//'::'//Iam + Iam = trim(COMP_NAME)//'::'//Iam ! Get my internal MAPL_Generic state !----------------------------------- From 23923cc065c96f8ac4fbc4e9f99c4e4668efd7a9 Mon Sep 17 00:00:00 2001 From: bzhao Date: Tue, 5 Nov 2024 09:20:19 -0500 Subject: [PATCH 39/73] do not terminate SURFSTAT when running with CICE6 --- GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 b/GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 index 551aadeb9..58a424810 100644 --- a/GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 +++ b/GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 @@ -270,7 +270,12 @@ subroutine SetServices ( GC, RC ) ! This call is needed only when we use ReadForcing. ! If we switch to use ExtData, next line has be commented out - call MAPL_TerminateImport ( GC, ALL=.true., __RC__ ) + if (DO_CICE_THERMO == 2) then + call MAPL_TerminateImport ( GC, SHORT_NAMES=['SURFSTATE'], & + CHILD_IDS=[SURF], __RC__ ) + else + call MAPL_TerminateImport ( GC, ALL=.true., __RC__ ) + endif call MAPL_GenericSetServices ( GC, __RC__) From 6da8f54747123978fe64c63c9bf8d24ba35c6e0e Mon Sep 17 00:00:00 2001 From: bzhao Date: Tue, 5 Nov 2024 09:58:00 -0500 Subject: [PATCH 40/73] only CICE4 needs this dealloc --- GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 b/GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 index 58a424810..09e030a3b 100644 --- a/GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 +++ b/GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 @@ -1075,7 +1075,7 @@ subroutine Finalize ( gc, import, export, clock, rc ) call MAPL_TimerOn(MAPL,"TOTAL" ) call MAPL_TimerOn(MAPL,"FINALIZE") - if (DO_CICE_THERMO /= 0) call dealloc_column_physics( MAPL_AM_I_Root(), Iam ) + if (DO_CICE_THERMO == 1) call dealloc_column_physics( MAPL_AM_I_Root(), Iam ) call MAPL_TimerOff(MAPL,"FINALIZE") call MAPL_TimerOff(MAPL,"TOTAL" ) From 22238e2a011417edcd9f02cae2a5414446813ed8 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 6 Nov 2024 16:37:15 -0500 Subject: [PATCH 41/73] update exports to match M21C filespecs (GEOS_SurfaceGridComp.F90) --- .../GEOS_SurfaceGridComp.F90 | 115 +++++++++++------- 1 file changed, 72 insertions(+), 43 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 index 191bd636e..f04f7110c 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 @@ -552,7 +552,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'DRPARN', & - LONG_NAME = 'normalized_surface_downwelling_par_beam_flux', & + LONG_NAME = 'normalized_surface_downwelling_PAR_beam_flux', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -561,7 +561,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'DFPARN', & - LONG_NAME = 'normalized_surface_downwelling_par_diffuse_flux', & + LONG_NAME = 'normalized_surface_downwelling_PAR_diffuse_flux', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -683,7 +683,7 @@ subroutine SetServices ( GC, RC ) ! !EXPORT STATE: call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_visible_beam', & + LONG_NAME = 'surface_reflectivity_for_visible_beam', & UNITS = '1', & SHORT_NAME = 'ALBVR', & DIMS = MAPL_DimsHorzOnly, & @@ -692,7 +692,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_visible_diffuse',& + LONG_NAME = 'surface_reflectivity_for_visible_diffuse',& UNITS = '1', & SHORT_NAME = 'ALBVF', & DIMS = MAPL_DimsHorzOnly, & @@ -701,7 +701,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_nearinfrared_beam', & + LONG_NAME = 'surface_reflectivity_for_near_infrared_beam', & UNITS = '1', & SHORT_NAME = 'ALBNR', & DIMS = MAPL_DimsHorzOnly, & @@ -710,7 +710,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_nearinfraed_diffuse', & + LONG_NAME = 'surface_reflectivity_for_near_infrared_diffuse', & UNITS = '1', & SHORT_NAME = 'ALBNF', & DIMS = MAPL_DimsHorzOnly, & @@ -766,7 +766,16 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'FRACI', & - LONG_NAME = 'ice_covered_fraction_of_tile', & + LONG_NAME = 'ice_covered_fraction_of_grid_cell', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'OFRACI', & + LONG_NAME = 'ice_covered_fraction_of_ocean_area',& UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -938,7 +947,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TSOIL1', & - LONG_NAME = 'soil_temperatures_layer_1' ,& + LONG_NAME = 'soil_temperature_layer_1' ,& UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -947,7 +956,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TSOIL2', & - LONG_NAME = 'soil_temperatures_layer_2' ,& + LONG_NAME = 'soil_temperature_layer_2' ,& UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -956,7 +965,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TSOIL3', & - LONG_NAME = 'soil_temperatures_layer_3' ,& + LONG_NAME = 'soil_temperature_layer_3' ,& UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -965,7 +974,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TSOIL4', & - LONG_NAME = 'soil_temperatures_layer_4' ,& + LONG_NAME = 'soil_temperature_layer_4' ,& UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -974,7 +983,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TSOIL5', & - LONG_NAME = 'soil_temperatures_layer_5' ,& + LONG_NAME = 'soil_temperature_layer_5' ,& UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -983,7 +992,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TSOIL6', & - LONG_NAME = 'soil_temperatures_layer_6' ,& + LONG_NAME = 'soil_temperature_layer_6' ,& UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -992,7 +1001,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'fractional_area_of_land_snowcover',& + LONG_NAME = 'fractional_area_of_snow_on_land',& UNITS = '1' ,& SHORT_NAME = 'ASNOW' ,& DIMS = MAPL_DimsHorzOnly ,& @@ -1019,7 +1028,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_temperature_of_snow',& + LONG_NAME = 'surface_temperature_of_snow_on_land',& UNITS = 'K' ,& SHORT_NAME = 'TPSNOW' ,& DIMS = MAPL_DimsHorzOnly ,& @@ -1046,7 +1055,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_temperature_of_wilted_zone',& + LONG_NAME = 'surface_temperature_of_wilting_zone',& UNITS = 'K' ,& SHORT_NAME = 'TPWLT' ,& DIMS = MAPL_DimsHorzOnly ,& @@ -1100,7 +1109,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'surface_soil_wetness' ,& + LONG_NAME = 'soil_wetness_surface' ,& UNITS = '1' ,& SHORT_NAME = 'WET1' ,& DIMS = MAPL_DimsHorzOnly ,& @@ -1109,7 +1118,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'surface_soil_wetness_for_chem' ,& + LONG_NAME = 'soil_wetness_surface_for_chem' ,& UNITS = '1' ,& SHORT_NAME = 'WET1_FOR_CHEM' ,& DIMS = MAPL_DimsHorzOnly ,& @@ -1118,7 +1127,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'root_zone_soil_wetness' ,& + LONG_NAME = 'soil_wetness_rootzone' ,& UNITS = '1' ,& SHORT_NAME = 'WET2' ,& DIMS = MAPL_DimsHorzOnly ,& @@ -1127,7 +1136,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'ave_prof_soil_moisture' ,& + LONG_NAME = 'soil_wetness_profile' ,& UNITS = '1' ,& SHORT_NAME = 'WET3' ,& DIMS = MAPL_DimsHorzOnly ,& @@ -1136,7 +1145,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'water_surface_layer' ,& + LONG_NAME = 'soil_moisture_surface' ,& UNITS = 'm3 m-3' ,& SHORT_NAME = 'WCSF' ,& DIMS = MAPL_DimsHorzOnly ,& @@ -1145,7 +1154,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'water_root_zone' ,& + LONG_NAME = 'soil_moisture_rootzone' ,& UNITS = 'm3 m-3' ,& SHORT_NAME = 'WCRZ' ,& DIMS = MAPL_DimsHorzOnly ,& @@ -1154,7 +1163,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'water_profile' ,& + LONG_NAME = 'soil_moisture_profile' ,& UNITS = 'm3 m-3' ,& SHORT_NAME = 'WCPR' ,& DIMS = MAPL_DimsHorzOnly ,& @@ -1172,7 +1181,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'greenness_fraction' ,& + LONG_NAME = 'vegetation_greenness_fraction' ,& UNITS = '1' ,& SHORT_NAME = 'GRN' ,& DIMS = MAPL_DimsHorzOnly ,& @@ -1418,7 +1427,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'snow_depth_within_snow_covered_area_fraction' ,& + LONG_NAME = 'snow_depth_within_snow_covered_area_fraction_on_land' ,& UNITS = 'm' ,& SHORT_NAME = 'SNOWDP' ,& DIMS = MAPL_DimsHorzOnly ,& @@ -1603,7 +1612,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'runoff_flux',& + LONG_NAME = 'runoff_total_flux' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'RUNOFF' ,& DIMS = MAPL_DimsHorzOnly ,& @@ -1693,7 +1702,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'baseflow_flux' ,& + LONG_NAME = 'baseflow_flux_land' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'BASEFLOW' ,& DIMS = MAPL_DimsHorzOnly ,& @@ -1712,7 +1721,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'EVLAND', & - LONG_NAME = 'Total_evapotranspiration_land', & + LONG_NAME = 'total_evapotranspiration_land', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -1739,7 +1748,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DRPARLAND', & - LONG_NAME = 'surface_downwelling_par_beam_flux', & + LONG_NAME = 'surface_downwelling_PAR_beam_flux', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -1748,7 +1757,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DFPARLAND', & - LONG_NAME = 'surface_downwelling_par_diffuse_flux', & + LONG_NAME = 'surface_downwelling_PAR_diffuse_flux', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -1793,7 +1802,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SWNETSNOW', & - LONG_NAME = 'Net_shortwave_snow', & + LONG_NAME = 'Net_shortwave_flux_snow', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -1820,7 +1829,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'GHSNOW', & - LONG_NAME = 'Ground_heating_snow', & + LONG_NAME = 'Ground_heating_flux_snow', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -1847,7 +1856,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SWLAND', & - LONG_NAME = 'Net_shortwave_land', & + LONG_NAME = 'Net_shortwave_flux_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -1856,7 +1865,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SWDOWNLAND', & - LONG_NAME = 'Incident_shortwave_land', & + LONG_NAME = 'Incident_shortwave_flux_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -1865,7 +1874,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'LWLAND', & - LONG_NAME = 'Net_longwave_land', & + LONG_NAME = 'Net_longwave_flux_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -1874,7 +1883,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'GHLAND', & - LONG_NAME = 'Ground_heating_land', & + LONG_NAME = 'Ground_heating_flux_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -1883,7 +1892,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'GHTSKIN', & - LONG_NAME = 'Ground_heating_for_skin_temp',& + LONG_NAME = 'Ground_heating_flux_for_skin_temp',& UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -1910,7 +1919,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TWLAND', & - LONG_NAME = 'Avail_water_storage_land', & + LONG_NAME = 'total_water_storage_land', & UNITS = 'kg m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & @@ -2395,7 +2404,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'interception_reservoir_capac', & + LONG_NAME = 'vegetation_interception_water_storage', & UNITS = 'kg m-2', & SHORT_NAME = 'CAPAC', & DIMS = MAPL_DimsHorzOnly, & @@ -3343,7 +3352,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'TS', & - LONG_NAME = 'surface_skin_temperature', & + LONG_NAME = 'surface_temperature', & UNITS = 'K', & FriendlyTO = trim(COMP_NAME), & DIMS = MAPL_DimsHorzOnly, & @@ -5384,6 +5393,7 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer, dimension(:,:) :: LST => NULL() real, pointer, dimension(:,:) :: FRI => NULL() + real, pointer, dimension(:,:) :: OFRI => NULL() real, pointer, dimension(:,:) :: EMISS => NULL() real, pointer, dimension(:,:) :: ALBVR => NULL() real, pointer, dimension(:,:) :: ALBVF => NULL() @@ -5738,6 +5748,7 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer, dimension(:) :: LSTTILE => NULL() real, pointer, dimension(:) :: FRTILE => NULL() + real, pointer, dimension(:) :: OFRTILE => NULL() real, pointer, dimension(:) :: EMISSTILE => NULL() real, pointer, dimension(:) :: ALBVRTILE => NULL() real, pointer, dimension(:) :: ALBVFTILE => NULL() @@ -6425,7 +6436,7 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) ! call MAPL_CFIORead( PRECIP_FILE, CurrentTime, Bundle, RC=STATUS) ! VERIFY_(STATUS) - call MAPL_read_bundle( Bundle,PRECIP_FILE, CurrentTime, RC=status) + call MAPL_read_bundle( Bundle, PRECIP_FILE, CurrentTime, regrid_method=REGRID_METHOD_CONSERVE, RC=status) VERIFY_(STATUS) call ESMFL_BundleGetPointerToData(Bundle,'PRECTOT',PTTe, RC=STATUS) VERIFY_(STATUS) @@ -6879,6 +6890,10 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(EXPORT , FRI , 'FRACI' , alloc=associated(LWI) , rC=STATUS) VERIFY_(STATUS) +! Not sure about why alloc of FRI depends on LWI, but copy the logic anyway + call MAPL_GetPointer(EXPORT , OFRI , 'OFRACI' , alloc=associated(LWI) , rC=STATUS) + VERIFY_(STATUS) + ! FRI = max(min(FRI,1.0),0.0) ! RiverRouting: force allocations of RUNOFF from continental components, @@ -7249,6 +7264,7 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MKTILE(ALBNF ,ALBNFTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(EMISS ,EMISSTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(FRI ,FRTILE ,NT,RC=STATUS); VERIFY_(STATUS) + call MKTILE(OFRI ,OFRTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(TSOIL1 ,TSOIL1TILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(TSOIL2 ,TSOIL2TILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(TSOIL3 ,TSOIL3TILE ,NT,RC=STATUS); VERIFY_(STATUS) @@ -7492,7 +7508,8 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) end if - FRTILE = 0.0 + FRTILE = 0.0 + OFRTILE = MAPL_UNDEF ! Cycle through all continental children (skip ocean), ! collecting RUNOFFTILE exports. @@ -7677,7 +7694,11 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) VERIFY_(STATUS) endif if(associated( FRI )) then - call MAPL_LocStreamTransform( LOCSTREAM, FRI , FRTILE, RC=STATUS) + call MAPL_LocStreamTransform( LOCSTREAM, FRI , FRTILE, RC=STATUS) + VERIFY_(STATUS) + endif + if(associated( OFRI )) then + call MAPL_LocStreamTransform( LOCSTREAM, OFRI , OFRTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(TSOIL1)) then @@ -9030,6 +9051,7 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) if(associated(ALBVRTILE )) deallocate(ALBVRTILE) if(associated(EMISSTILE )) deallocate(EMISSTILE) if(associated(FRTILE )) deallocate(FRTILE ) + if(associated(OFRTILE )) deallocate(OFRTILE ) if(associated(DUDP)) deallocate( DUDP ) if(associated(DUWT)) deallocate( DUWT ) @@ -9300,6 +9322,9 @@ subroutine DOTYPE(type,RC) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'FRACI' , ALLOC=associated( FRTILE ), notFoundOK=.true., RC=STATUS) VERIFY_(STATUS) +! in case FRACI removed in future + call MAPL_GetPointer(GEX(type), dum, 'FRACI' , ALLOC=associated( OFRTILE ), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'RDU001' , ALLOC=associated(RDU001TILE ), notFoundOK=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'RDU002' , ALLOC=associated(RDU002TILE ), notFoundOK=.true., RC=STATUS) @@ -9680,6 +9705,10 @@ subroutine DOTYPE(type,RC) call FILLOUT_TILE(GEX(type), 'FRACI', FRTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if + if(associated( OFRTILE)) then + call FILLOUT_TILE(GEX(type), 'FRACI', OFRTILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if if(associated(TSOIL1TILE)) then call FILLOUT_TILE(GEX(type), 'TP1', TSOIL1TILE, XFORM, RC=STATUS) VERIFY_(STATUS) From 6ee4ffabc0b8376a09e9d3f452296f4b73061031 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 6 Nov 2024 17:04:22 -0500 Subject: [PATCH 42/73] update exports to match M21C filespecs (GEOS_CatchGridComp.F90) --- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 92 +++++++++---------- 1 file changed, 46 insertions(+), 46 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index 99fd7f8d3..097ecfbce 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -321,7 +321,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'surface_downwelling_par_beam_flux',& + LONG_NAME = 'surface_downwelling_PAR_beam_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'DRPAR' ,& DIMS = MAPL_DimsTileOnly ,& @@ -330,7 +330,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'surface_downwelling_par_diffuse_flux',& + LONG_NAME = 'surface_downwelling_PAR_diffuse_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'DFPAR' ,& DIMS = MAPL_DimsTileOnly ,& @@ -411,7 +411,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'greeness_fraction' ,& + LONG_NAME = 'vegetation_greenness_fraction',& UNITS = '1' ,& SHORT_NAME = 'GRN' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1112,7 +1112,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'interception_reservoir_capac',& + LONG_NAME = 'vegetation_interception_water_storage',& UNITS = 'kg m-2' ,& SHORT_NAME = 'CAPAC' ,& FRIENDLYTO = trim(COMP_NAME) ,& @@ -1564,7 +1564,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'runoff_flux' ,& + LONG_NAME = 'runoff_total_flux' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'RUNOFF' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1619,7 +1619,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'totoal soil moisture' ,& + LONG_NAME = 'total_soil_moisture' ,& UNITS = 'kg m-2' ,& SHORT_NAME = 'WATSOI' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1645,7 +1645,7 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'baseflow_flux' ,& + LONG_NAME = 'baseflow_flux_land' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'BASEFLOW' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1780,7 +1780,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'ave_catchment_temp_incl_snw',& + LONG_NAME = 'surface_temperature_of_land_incl_snow',& UNITS = 'K' ,& SHORT_NAME = 'TPSURF' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1789,7 +1789,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'temperature_top_snow_layer',& + LONG_NAME = 'surface_temperature_of_snow_on_land',& UNITS = 'K' ,& SHORT_NAME = 'TPSNOW' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1798,7 +1798,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'temperature_unsaturated_zone',& + LONG_NAME = 'surface_temperature_of_unsaturated_zone',& UNITS = 'K' ,& SHORT_NAME = 'TPUNST' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1807,7 +1807,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'temperature_saturated_zone',& + LONG_NAME = 'surface_temperature_of_saturated_zone',& UNITS = 'K' ,& SHORT_NAME = 'TPSAT' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1816,7 +1816,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'temperature_wilted_zone' ,& + LONG_NAME = 'surface_temperature_of_wilting_zone' ,& UNITS = 'K' ,& SHORT_NAME = 'TPWLT' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1825,7 +1825,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'fractional_area_of_land_snowcover',& + LONG_NAME = 'fractional_area_of_snow_on_land',& UNITS = '1' ,& SHORT_NAME = 'ASNOW' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1888,7 +1888,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'snow_depth_within_snow_covered_area_fraction' ,& + LONG_NAME = 'snow_depth_within_snow_covered_area_fraction_on_land' ,& UNITS = 'm' ,& SHORT_NAME = 'SNOWDP' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1897,7 +1897,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_soil_wetness' ,& + LONG_NAME = 'soil_wetness_surface' ,& UNITS = '1' ,& SHORT_NAME = 'WET1' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1906,7 +1906,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'root_zone_soil_wetness' ,& + LONG_NAME = 'soil_wetness_rootzone' ,& UNITS = '1' ,& SHORT_NAME = 'WET2' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1915,7 +1915,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'ave_prof_soil__moisture' ,& + LONG_NAME = 'soil_wetness_profile' ,& UNITS = '1' ,& SHORT_NAME = 'WET3' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1924,7 +1924,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'water_surface_layer' ,& + LONG_NAME = 'soil_moisture_surface' ,& UNITS = 'm3 m-3' ,& SHORT_NAME = 'WCSF' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1933,7 +1933,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'water_root_zone' ,& + LONG_NAME = 'soil_moisture_rootzone' ,& UNITS = 'm3 m-3' ,& SHORT_NAME = 'WCRZ' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1942,8 +1942,8 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'water_ave_prof' ,& - UNITS = 'm3 m-3' ,& + LONG_NAME = 'soil_moisture_profile' ,& + UNITS = 'm3 m-3' ,& SHORT_NAME = 'WCPR' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -1951,7 +1951,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'soil_temperatures_layer_1' ,& + LONG_NAME = 'soil_temperature_layer_1' ,& UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 SHORT_NAME = 'TP1' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1960,7 +1960,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'soil_temperatures_layer_2' ,& + LONG_NAME = 'soil_temperature_layer_2' ,& UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 SHORT_NAME = 'TP2' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1969,7 +1969,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'soil_temperatures_layer_3' ,& + LONG_NAME = 'soil_temperature_layer_3' ,& UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 SHORT_NAME = 'TP3' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1978,7 +1978,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'soil_temperatures_layer_4' ,& + LONG_NAME = 'soil_temperature_layer_4' ,& UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 SHORT_NAME = 'TP4' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1987,7 +1987,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'soil_temperatures_layer_5' ,& + LONG_NAME = 'soil_temperature_layer_5' ,& UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 SHORT_NAME = 'TP5' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1996,7 +1996,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'soil_temperatures_layer_6' ,& + LONG_NAME = 'soil_temperature_layer_6' ,& UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 SHORT_NAME = 'TP6' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2014,7 +2014,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_visible_beam',& + LONG_NAME = 'surface_reflectivity_visible_beam',& UNITS = '1' ,& SHORT_NAME = 'ALBVR' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2023,7 +2023,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_visible_diffuse',& + LONG_NAME = 'surface_reflectivity_visible_diffuse',& UNITS = '1' ,& SHORT_NAME = 'ALBVF' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2032,7 +2032,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_near_infrared_beam',& + LONG_NAME = 'surface_reflectivity_near_infrared_beam',& UNITS = '1' ,& SHORT_NAME = 'ALBNR' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2041,7 +2041,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_near_infrared_diffuse',& + LONG_NAME = 'surface_reflectivity_near_infrared_diffuse',& UNITS = '1' ,& SHORT_NAME = 'ALBNF' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2323,7 +2323,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'EVLAND', & - LONG_NAME = 'Total_evapotranspiration_land', & + LONG_NAME = 'total_evapotranspiration_land', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -2350,7 +2350,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DRPARLAND', & - LONG_NAME = 'surface_downwelling_par_beam_flux', & + LONG_NAME = 'surface_downwelling_PAR_beam_flux', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -2359,7 +2359,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DFPARLAND', & - LONG_NAME = 'surface_downwelling_par_diffuse_flux', & + LONG_NAME = 'surface_downwelling_PAR_diffuse_flux', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -2378,7 +2378,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SWNETSNOW', & - LONG_NAME = 'Net_shortwave_snow', & + LONG_NAME = 'Net_shortwave_flux_snow', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -2462,7 +2462,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SWLAND', & - LONG_NAME = 'Net_shortwave_land', & + LONG_NAME = 'Net_shortwave_flux_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -2471,7 +2471,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SWDOWNLAND', & - LONG_NAME = 'Incident_shortwave_land', & + LONG_NAME = 'Incident_shortwave_flux_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -2481,7 +2481,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'LWLAND', & - LONG_NAME = 'Net_longwave_land', & + LONG_NAME = 'Net_longwave_flux_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -2491,7 +2491,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'GHLAND', & - LONG_NAME = 'Ground_heating_land', & + LONG_NAME = 'Ground_heating_flux_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -2500,7 +2500,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'GHTSKIN', & - LONG_NAME = 'Ground_heating_skin_temp', & + LONG_NAME = 'Ground_heating_flux_for_skin_temp_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -2519,7 +2519,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TWLAND', & - LONG_NAME = 'Avail_water_storage_land', & + LONG_NAME = 'total_water_storage_land', & UNITS = 'kg m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -2921,7 +2921,7 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_TimerOn(MAPL,"INITIALIZE") - ! retrieve interal state + ! retrieve internal state call ESMF_UserCompGetInternalState ( GC, 'CatchInternal',wrap,status ) VERIFY_(STATUS) @@ -5159,15 +5159,15 @@ subroutine Driver ( RC ) QC(:,FSNW) = QSAT(:,FSNW) -! -------------------------------------------------------------------------- + ! -------------------------------------------------------------------------- ! get total solid precip ! -------------------------------------------------------------------------- SLDTOT = SNO+ICE+FRZR -! protect the forcing from unsavory values, as per practice in offline -! driver -! -------------------------------------------------------------------------- + ! protect the forcing from unsavory values, as per practice in offline + ! driver + ! -------------------------------------------------------------------------- _ASSERT(count(PLS<0.)==0,'needs informative message') _ASSERT(count(PCU<0.)==0,'needs informative message') From f423cacc30a90d7b7340f3596ec665c51cd1d238 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 7 Nov 2024 12:40:38 -0500 Subject: [PATCH 43/73] update exports to match M21C filespecs (GEOS_CatchCNGridComp.F90) --- .../GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 index 96d970073..05b20561d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 @@ -245,7 +245,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'surface_downwelling_par_beam_flux',& + LONG_NAME = 'surface_downwelling_PAR_beam_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'DRPAR' ,& DIMS = MAPL_DimsTileOnly ,& @@ -254,7 +254,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'surface_downwelling_par_diffuse_flux',& + LONG_NAME = 'surface_downwelling_PAR_diffuse_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'DFPAR' ,& DIMS = MAPL_DimsTileOnly ,& @@ -346,7 +346,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'greeness_fraction' ,& + LONG_NAME = 'vegetation_greenness_fraction',& UNITS = '1' ,& SHORT_NAME = 'GRN' ,& DIMS = MAPL_DimsTileOnly ,& From dbfa076afd30f7e6404033c8eda47798359f11eb Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 7 Nov 2024 12:52:54 -0500 Subject: [PATCH 44/73] update exports to match M21C filespecs (GEOS_CatchCNCLM40GridComp.F90) --- .../GEOS_CatchCNCLM40GridComp.F90 | 88 +++++++++---------- 1 file changed, 44 insertions(+), 44 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index 775e2de57..0ad501f22 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -344,7 +344,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'surface_downwelling_par_beam_flux',& + LONG_NAME = 'surface_downwelling_PAR_beam_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'DRPAR' ,& DIMS = MAPL_DimsTileOnly ,& @@ -353,7 +353,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'surface_downwelling_par_diffuse_flux',& + LONG_NAME = 'surface_downwelling_PAR_diffuse_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'DFPAR' ,& DIMS = MAPL_DimsTileOnly ,& @@ -445,7 +445,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'greeness_fraction' ,& + LONG_NAME = 'vegetation_greenness_fraction' ,& UNITS = '1' ,& SHORT_NAME = 'GRN' ,& DIMS = MAPL_DimsTileOnly ,& @@ -1161,7 +1161,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'interception_reservoir_capac',& + LONG_NAME = 'vegetation_interception_water_storage',& UNITS = 'kg m-2' ,& SHORT_NAME = 'CAPAC' ,& FRIENDLYTO = trim(COMP_NAME) ,& @@ -2172,7 +2172,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'runoff_flux' ,& + LONG_NAME = 'runoff_total_flux' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'RUNOFF' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2208,7 +2208,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'snow_ice_evaporation_energy_flux',& + LONG_NAME = 'snow_ice_evaporation_energy_flux_on_land',& UNITS = 'W m-2' ,& SHORT_NAME = 'EVPICE' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2227,7 +2227,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'totoal soil moisture' ,& + LONG_NAME = 'total_soil_moisture' ,& UNITS = 'kg m-2' ,& SHORT_NAME = 'WATSOI' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2253,7 +2253,7 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'baseflow_flux' ,& + LONG_NAME = 'baseflow_flux_land' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'BASEFLOW' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2389,7 +2389,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'ave_catchment_temp_incl_snw',& + LONG_NAME = 'surface_temperature_of_land_incl_snow',& UNITS = 'K' ,& SHORT_NAME = 'TPSURF' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2398,7 +2398,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'temperature_top_snow_layer',& + LONG_NAME = 'surface_temperature_of_snow_on_land',& UNITS = 'K' ,& SHORT_NAME = 'TPSNOW' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2407,7 +2407,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'temperature_unsaturated_zone',& + LONG_NAME = 'surface_temperature_of_unsaturated_zone',& UNITS = 'K' ,& SHORT_NAME = 'TPUNST' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2416,7 +2416,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'temperature_saturated_zone',& + LONG_NAME = 'surface_temperature_of_saturated_zone',& UNITS = 'K' ,& SHORT_NAME = 'TPSAT' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2425,7 +2425,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'temperature_wilted_zone' ,& + LONG_NAME = 'surface_temperature_of_wilting_zone' ,& UNITS = 'K' ,& SHORT_NAME = 'TPWLT' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2434,7 +2434,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'fractional_area_of_land_snowcover',& + LONG_NAME = 'fractional_area_of_snow_on_land',& UNITS = '1' ,& SHORT_NAME = 'ASNOW' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2497,7 +2497,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'snow_depth_within_snow_covered_area_fraction' ,& + LONG_NAME = 'snow_depth_within_snow_covered_area_fraction_on_land' ,& UNITS = 'm' ,& SHORT_NAME = 'SNOWDP' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2506,7 +2506,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_soil_wetness' ,& + LONG_NAME = 'soil_wetness_surface' ,& UNITS = '1' ,& SHORT_NAME = 'WET1' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2515,7 +2515,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'root_zone_soil_wetness' ,& + LONG_NAME = 'soil_wetness_rootzone' ,& UNITS = '1' ,& SHORT_NAME = 'WET2' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2524,7 +2524,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'ave_prof_soil__moisture' ,& + LONG_NAME = 'soil_wetness_profile' ,& UNITS = '1' ,& SHORT_NAME = 'WET3' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2533,7 +2533,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'water_surface_layer' ,& + LONG_NAME = 'soil_moisture_surface' ,& UNITS = 'm3 m-3' ,& SHORT_NAME = 'WCSF' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2542,7 +2542,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'water_root_zone' ,& + LONG_NAME = 'soil_moisture_rootzone' ,& UNITS = 'm3 m-3' ,& SHORT_NAME = 'WCRZ' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2551,7 +2551,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'water_ave_prof' ,& + LONG_NAME = 'soil_moisture_profile' ,& UNITS = 'm3 m-3' ,& SHORT_NAME = 'WCPR' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2560,7 +2560,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'soil_temperatures_layer_1' ,& + LONG_NAME = 'soil_temperature_layer_1' ,& UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 SHORT_NAME = 'TP1' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2569,7 +2569,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'soil_temperatures_layer_2' ,& + LONG_NAME = 'soil_temperature_layer_2' ,& UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 SHORT_NAME = 'TP2' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2578,7 +2578,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'soil_temperatures_layer_3' ,& + LONG_NAME = 'soil_temperature_layer_3' ,& UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 SHORT_NAME = 'TP3' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2587,7 +2587,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'soil_temperatures_layer_4' ,& + LONG_NAME = 'soil_temperature_layer_4' ,& UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 SHORT_NAME = 'TP4' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2596,7 +2596,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'soil_temperatures_layer_5' ,& + LONG_NAME = 'soil_temperature_layer_5' ,& UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 SHORT_NAME = 'TP5' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2605,7 +2605,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'soil_temperatures_layer_6' ,& + LONG_NAME = 'soil_temperature_layer_6' ,& UNITS = 'K' ,& ! units now K, rreichle & borescan, 6 Nov 2020 SHORT_NAME = 'TP6' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2623,7 +2623,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_visible_beam',& + LONG_NAME = 'surface_reflectivity_visible_beam',& UNITS = '1' ,& SHORT_NAME = 'ALBVR' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2632,7 +2632,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_visible_diffuse',& + LONG_NAME = 'surface_reflectivity_visible_diffuse',& UNITS = '1' ,& SHORT_NAME = 'ALBVF' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2641,7 +2641,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_near_infrared_beam',& + LONG_NAME = 'surface_reflectivity_near_infrared_beam',& UNITS = '1' ,& SHORT_NAME = 'ALBNR' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2650,7 +2650,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_near_infrared_diffuse',& + LONG_NAME = 'surface_reflectivity_near_infrared_diffuse',& UNITS = '1' ,& SHORT_NAME = 'ALBNF' ,& DIMS = MAPL_DimsTileOnly ,& @@ -2932,7 +2932,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'EVLAND', & - LONG_NAME = 'Evaporation_land', & + LONG_NAME = 'total_evapotranspiration_land', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -2959,7 +2959,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DRPARLAND', & - LONG_NAME = 'surface_downwelling_par_beam_flux', & + LONG_NAME = 'surface_downwelling_PAR_beam_flux', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -2968,7 +2968,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DFPARLAND', & - LONG_NAME = 'surface_downwelling_par_diffuse_flux', & + LONG_NAME = 'surface_downwelling_PAR_diffuse_flux', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -2987,7 +2987,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SWNETSNOW', & - LONG_NAME = 'Net_shortwave_snow', & + LONG_NAME = 'Net_shortwave_flux_snow', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -3071,7 +3071,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SWLAND', & - LONG_NAME = 'Net_shortwave_land', & + LONG_NAME = 'Net_shortwave_flux_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -3080,7 +3080,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SWDOWNLAND', & - LONG_NAME = 'Incident_shortwave_land', & + LONG_NAME = 'Incident_shortwave_flux_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -3090,7 +3090,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'LWLAND', & - LONG_NAME = 'Net_longwave_land', & + LONG_NAME = 'Net_longwave_flux_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -3100,7 +3100,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'GHLAND', & - LONG_NAME = 'Ground_heating_land', & + LONG_NAME = 'Ground_heating_flux_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -3109,7 +3109,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'GHTSKIN', & - LONG_NAME = 'Ground_heating_skin_temp', & + LONG_NAME = 'Ground_heating_flux_for_skin_temp_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -3128,7 +3128,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TWLAND', & - LONG_NAME = 'Avail_water_storage_land', & + LONG_NAME = 'total_water_storage_land', & UNITS = 'kg m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -3174,7 +3174,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SPLAND', & - LONG_NAME = 'rate_of_spurious_land_energy_source',& + LONG_NAME = 'rate_of_spurious_energy_source_land',& UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -3183,7 +3183,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SPWATR', & - LONG_NAME = 'rate_of_spurious_land_water_source',& + LONG_NAME = 'rate_of_spurious_water_source_land',& UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -3192,7 +3192,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SPSNOW', & - LONG_NAME = 'rate_of_spurious_snow_energy',& + LONG_NAME = 'rate_of_spurious_snow_energy_source_land',& UNITS = 'W m-2', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & From d1929a0ca936ffb75820046d7809aa4b7cd81921 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 7 Nov 2024 12:58:53 -0500 Subject: [PATCH 45/73] update exports to match M21C filespecs (GEOS_LakeGridComp.F90) --- .../GEOSlake_GridComp/GEOS_LakeGridComp.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlake_GridComp/GEOS_LakeGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlake_GridComp/GEOS_LakeGridComp.F90 index 564beefe7..8af0fc45a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlake_GridComp/GEOS_LakeGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlake_GridComp/GEOS_LakeGridComp.F90 @@ -137,7 +137,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_visible_beam', & + LONG_NAME = 'surface_reflectivity_for_visible_beam', & UNITS = '1', & SHORT_NAME = 'ALBVR', & DIMS = MAPL_DimsTileOnly, & @@ -146,7 +146,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_visible_diffuse',& + LONG_NAME = 'surface_reflectivity_for_visible_diffuse',& UNITS = '1', & SHORT_NAME = 'ALBVF', & DIMS = MAPL_DimsTileOnly, & @@ -155,7 +155,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_near_infrared_beam', & + LONG_NAME = 'surface_reflectivity_for_near_infrared_beam', & UNITS = '1', & SHORT_NAME = 'ALBNR', & DIMS = MAPL_DimsTileOnly, & @@ -164,7 +164,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_near_infrared_diffuse', & + LONG_NAME = 'surface_reflectivity_for_near_infrared_diffuse', & UNITS = '1', & SHORT_NAME = 'ALBNF', & DIMS = MAPL_DimsTileOnly, & @@ -192,7 +192,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'runoff_flux',& + LONG_NAME = 'runoff_total_flux' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'RUNOFF' ,& DIMS = MAPL_DimsTileOnly ,& From f0f8634b8ab1d8c0b2eae2d22dcf123a3c83a3a4 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 7 Nov 2024 13:09:27 -0500 Subject: [PATCH 46/73] update exports to match M21C filespecs (GEOS_RouteGridComp.F90) --- .../GEOSland_GridComp/GEOSroute_GridComp/GEOS_RouteGridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSroute_GridComp/GEOS_RouteGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSroute_GridComp/GEOS_RouteGridComp.F90 index ad2be4db2..4a28c0da2 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSroute_GridComp/GEOS_RouteGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSroute_GridComp/GEOS_RouteGridComp.F90 @@ -178,7 +178,7 @@ subroutine SetServices ( GC, RC ) ! ----------------------------------------------------------- call MAPL_AddImportSpec(GC, & - LONG_NAME = 'runoff_flux' ,& + LONG_NAME = 'runoff_total_flux' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'RUNOFF' ,& DIMS = MAPL_DimsTileOnly ,& From 0bee7cb494038259316dda31b6ced1b66d08fb25 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 7 Nov 2024 13:11:31 -0500 Subject: [PATCH 47/73] update exports to match M21C filespecs (GEOS_VegDynGridComp.F90) --- .../GEOSvegdyn_GridComp/GEOS_VegdynGridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSvegdyn_GridComp/GEOS_VegdynGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSvegdyn_GridComp/GEOS_VegdynGridComp.F90 index 83e575269..063d9ab13 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSvegdyn_GridComp/GEOS_VegdynGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSvegdyn_GridComp/GEOS_VegdynGridComp.F90 @@ -217,7 +217,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC ,& SHORT_NAME = 'GRN' ,& - LONG_NAME = 'greeness_fraction' ,& + LONG_NAME = 'vegetation_greenness_fraction' ,& UNITS = '1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& From 587a97c56fe2cb47546905e8a82e5cb48c91c3a6 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 7 Nov 2024 13:17:14 -0500 Subject: [PATCH 48/73] update exports to match M21C filespecs (GEOS_LandiceGridComp.F90) --- .../GEOS_LandIceGridComp.F90 | 26 +++++++++---------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlandice_GridComp/GEOS_LandIceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlandice_GridComp/GEOS_LandIceGridComp.F90 index 96841911a..ed505fb4a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlandice_GridComp/GEOS_LandIceGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlandice_GridComp/GEOS_LandIceGridComp.F90 @@ -198,7 +198,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_visible_beam', & + LONG_NAME = 'surface_reflectivity_for_visible_beam', & UNITS = '1', & SHORT_NAME = 'ALBVR', & DIMS = MAPL_DimsTileOnly, & @@ -207,7 +207,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_visible_diffuse',& + LONG_NAME = 'surface_reflectivity_for_visible_diffuse',& UNITS = '1', & SHORT_NAME = 'ALBVF', & DIMS = MAPL_DimsTileOnly, & @@ -216,7 +216,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_near_infrared_beam', & + LONG_NAME = 'surface_reflectivity_for_near_infrared_beam', & UNITS = '1', & SHORT_NAME = 'ALBNR', & DIMS = MAPL_DimsTileOnly, & @@ -225,7 +225,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_near_infrared_diffuse', & + LONG_NAME = 'surface_reflectivity_for_near_infrared_diffuse', & UNITS = '1', & SHORT_NAME = 'ALBNF', & DIMS = MAPL_DimsTileOnly, & @@ -235,7 +235,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TST', & - LONG_NAME = 'surface_skin_temperature', & + LONG_NAME = 'surface_temperature', & UNITS = 'K', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & @@ -397,7 +397,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'fractional_area_of_glaciated_surface_snowcover',& + LONG_NAME = 'fractional_snow_covered_area_of_glaciated_surface',& UNITS = '1' ,& SHORT_NAME = 'ASNOW_GL' ,& DIMS = MAPL_DimsTileOnly ,& @@ -485,7 +485,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'top_snow_layer_mass_change_due_to_sub_con', & + LONG_NAME = 'top_snow_layer_mass_change_due_to_sublimation_and_condensation', & UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'WESNSC' ,& DIMS = MAPL_DimsTileOnly ,& @@ -569,7 +569,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'contribution_to_smb_from_refreezed_rain_over_bare_ice', & + LONG_NAME = 'contribution_to_surface_mass_balance_from_rain_frozen_onto_bare_ice', & UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'RAINRFZ' ,& DIMS = MAPL_DimsTileOnly ,& @@ -578,7 +578,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'snowmelt_flux' ,& + LONG_NAME = 'snow_melt_flux' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'SMELT' ,& DIMS = MAPL_DimsTileOnly ,& @@ -587,7 +587,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'icemelt_flux' ,& + LONG_NAME = 'ice_melt_flux' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'IMELT' ,& DIMS = MAPL_DimsTileOnly ,& @@ -623,7 +623,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'melt_water_content', & + LONG_NAME = 'snowpack_meltwater_content', & UNITS = 'kg m-2' ,& SHORT_NAME = 'MELTWTRCONT' ,& DIMS = MAPL_DimsTileOnly ,& @@ -641,7 +641,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'runoff_flux' ,& + LONG_NAME = 'runoff_total_flux' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'RUNOFF' ,& DIMS = MAPL_DimsTileOnly ,& @@ -848,7 +848,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'Ground_heating_for_tskin' ,& + LONG_NAME = 'glacier_ice_heating_flux' ,& UNITS = 'W m-2' ,& SHORT_NAME = 'GHTSKIN' ,& DIMS = MAPL_DimsTileOnly ,& From e31cda3931f6e250e6a80baaa165dc95f80529e6 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 7 Nov 2024 13:49:34 -0500 Subject: [PATCH 49/73] update exports to match M21C filespecs (GEOSsaltwater_GridComp/*.F90) --- .../GEOS_CICE4ColumnPhysGridComp.F90 | 16 ++++++++-------- .../GEOS_OpenWaterGridComp.F90 | 8 ++++---- .../GEOS_SaltWaterGridComp.F90 | 8 ++++---- .../GEOS_SeaiceInterfaceGridComp.F90 | 12 ++++++------ .../GEOS_SimpleSeaiceGridComp.F90 | 16 ++++++++-------- 5 files changed, 30 insertions(+), 30 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_CICE4ColumnPhysGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_CICE4ColumnPhysGridComp.F90 index bc5a7c044..b6fbdea25 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_CICE4ColumnPhysGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_CICE4ColumnPhysGridComp.F90 @@ -181,7 +181,7 @@ subroutine SetServices ( GC, RC ) _RC ) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_visible_beam', & + LONG_NAME = 'surface_reflectivity_for_visible_beam', & UNITS = '1', & SHORT_NAME = 'ALBVR', & DIMS = MAPL_DimsTileOnly, & @@ -189,7 +189,7 @@ subroutine SetServices ( GC, RC ) _RC ) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_visible_diffuse',& + LONG_NAME = 'surface_reflectivity_for_visible_diffuse',& UNITS = '1', & SHORT_NAME = 'ALBVF', & DIMS = MAPL_DimsTileOnly, & @@ -197,7 +197,7 @@ subroutine SetServices ( GC, RC ) _RC ) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_near_infrared_beam', & + LONG_NAME = 'surface_reflectivity_for_near_infrared_beam', & UNITS = '1', & SHORT_NAME = 'ALBNR', & DIMS = MAPL_DimsTileOnly, & @@ -205,7 +205,7 @@ subroutine SetServices ( GC, RC ) _RC ) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_near_infrared_diffuse', & + LONG_NAME = 'surface_reflectivity_for_near_infrared_diffuse', & UNITS = '1', & SHORT_NAME = 'ALBNF', & DIMS = MAPL_DimsTileOnly, & @@ -1266,7 +1266,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SIALB' ,& - LONG_NAME = 'broad_band_sea_ice_albedo' ,& + LONG_NAME = 'broad_band_sea_ice_reflectivity' ,& UNITS = '1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -1388,7 +1388,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'ialb_CMIP5' ,& - LONG_NAME = 'bare_sea_ice_albedo' ,& + LONG_NAME = 'bare_sea_ice_reflectivity' ,& UNITS = '1' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& @@ -1527,7 +1527,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'ALBIN' ,& - LONG_NAME = 'ice_surface_albedo_over_ice_categories' ,& + LONG_NAME = 'ice_surface_reflectivity_over_ice_categories' ,& UNITS = '1' ,& DIMS = MAPL_DimsTileOnly ,& UNGRIDDED_DIMS = (/NUM_ICE_CATEGORIES/) ,& @@ -1536,7 +1536,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'ALBSN' ,& - LONG_NAME = 'snow_surface_albedo_over_ice_categories' ,& + LONG_NAME = 'snow_surface_reflectivity_over_ice_categories' ,& UNITS = '1' ,& DIMS = MAPL_DimsTileOnly ,& UNGRIDDED_DIMS = (/NUM_ICE_CATEGORIES/) ,& diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_OpenWaterGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_OpenWaterGridComp.F90 index 436045ac7..ce89b0429 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_OpenWaterGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_OpenWaterGridComp.F90 @@ -192,7 +192,7 @@ subroutine SetServices ( GC, RC ) _RC) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_visible_beam', & + LONG_NAME = 'surface_reflectivity_for_visible_beam', & UNITS = '1', & SHORT_NAME = 'ALBVR', & DIMS = MAPL_DimsTileOnly, & @@ -200,7 +200,7 @@ subroutine SetServices ( GC, RC ) _RC) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_visible_diffuse',& + LONG_NAME = 'surface_reflectivity_for_visible_diffuse',& UNITS = '1', & SHORT_NAME = 'ALBVF', & DIMS = MAPL_DimsTileOnly, & @@ -208,7 +208,7 @@ subroutine SetServices ( GC, RC ) _RC) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_near_infrared_beam', & + LONG_NAME = 'surface_reflectivity_for_near_infrared_beam', & UNITS = '1', & SHORT_NAME = 'ALBNR', & DIMS = MAPL_DimsTileOnly, & @@ -216,7 +216,7 @@ subroutine SetServices ( GC, RC ) _RC) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_near_infrared_diffuse', & + LONG_NAME = 'surface_reflectivity_for_near_infrared_diffuse', & UNITS = '1', & SHORT_NAME = 'ALBNF', & DIMS = MAPL_DimsTileOnly, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SaltWaterGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SaltWaterGridComp.F90 index fa66715ec..de266edd7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SaltWaterGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SaltWaterGridComp.F90 @@ -183,7 +183,7 @@ subroutine SetServices ( GC, RC ) _RC) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_visible_beam', & + LONG_NAME = 'surface_reflectivity_for_visible_beam', & UNITS = '1', & SHORT_NAME = 'ALBVR', & DIMS = MAPL_DimsTileOnly, & @@ -191,7 +191,7 @@ subroutine SetServices ( GC, RC ) _RC) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_visible_diffuse',& + LONG_NAME = 'surface_reflectivity_for_visible_diffuse',& UNITS = '1', & SHORT_NAME = 'ALBVF', & DIMS = MAPL_DimsTileOnly, & @@ -199,7 +199,7 @@ subroutine SetServices ( GC, RC ) _RC) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_near_infrared_beam', & + LONG_NAME = 'surface_reflectivity_for_near_infrared_beam', & UNITS = '1', & SHORT_NAME = 'ALBNR', & DIMS = MAPL_DimsTileOnly, & @@ -207,7 +207,7 @@ subroutine SetServices ( GC, RC ) _RC) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_near_infrared_diffuse', & + LONG_NAME = 'surface_reflectivity_for_near_infrared_diffuse', & UNITS = '1', & SHORT_NAME = 'ALBNF', & DIMS = MAPL_DimsTileOnly, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SeaiceInterfaceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SeaiceInterfaceGridComp.F90 index 33ca3bc35..9a28956cc 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SeaiceInterfaceGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SeaiceInterfaceGridComp.F90 @@ -164,7 +164,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_visible_beam', & + LONG_NAME = 'surface_reflectivity_for_visible_beam', & UNITS = '1', & SHORT_NAME = 'ALBVR', & DIMS = MAPL_DimsTileOnly, & @@ -173,7 +173,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_visible_diffuse',& + LONG_NAME = 'surface_reflectivity_for_visible_diffuse',& UNITS = '1', & SHORT_NAME = 'ALBVF', & DIMS = MAPL_DimsTileOnly, & @@ -182,7 +182,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_near_infrared_beam', & + LONG_NAME = 'surface_reflectivity_for_near_infrared_beam', & UNITS = '1', & SHORT_NAME = 'ALBNR', & DIMS = MAPL_DimsTileOnly, & @@ -191,7 +191,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'surface_albedo_for_near_infrared_diffuse', & + LONG_NAME = 'surface_reflectivity_for_near_infrared_diffuse', & UNITS = '1', & SHORT_NAME = 'ALBNF', & DIMS = MAPL_DimsTileOnly, & @@ -1283,7 +1283,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'ALBIN' ,& - LONG_NAME = 'ice_surface_albedo_over_ice_categories' ,& + LONG_NAME = 'ice_surface_reflectivity_over_ice_categories' ,& UNITS = '1' ,& DIMS = MAPL_DimsTileOnly ,& UNGRIDDED_DIMS = (/NUM_ICE_CATEGORIES/) ,& @@ -1293,7 +1293,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'ALBSN' ,& - LONG_NAME = 'snow_surface_albedo_over_ice_categories' ,& + LONG_NAME = 'snow_surface_reflectivity_over_ice_categories' ,& UNITS = '1' ,& DIMS = MAPL_DimsTileOnly ,& UNGRIDDED_DIMS = (/NUM_ICE_CATEGORIES/) ,& diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SimpleSeaiceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SimpleSeaiceGridComp.F90 index a86e02fa4..3833e8698 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SimpleSeaiceGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SimpleSeaiceGridComp.F90 @@ -135,33 +135,33 @@ subroutine SetServices ( GC, RC ) VLOCATION = MAPL_VLocationNone, & _RC) - call MAPL_AddExportSpec(GC, & + call MAPL_AddExportSpec(GC, & SHORT_NAME = 'ALBVR', & - LONG_NAME = 'surface_albedo_for_visible_beam', & + LONG_NAME = 'surface_reflectivity_for_visible_beam', & UNITS = '1', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & _RC) - call MAPL_AddExportSpec(GC, & + call MAPL_AddExportSpec(GC, & SHORT_NAME = 'ALBVF', & - LONG_NAME = 'surface_albedo_for_visible_diffuse',& + LONG_NAME = 'surface_reflectivity_for_visible_diffuse', & UNITS = '1', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & _RC) - call MAPL_AddExportSpec(GC, & + call MAPL_AddExportSpec(GC, & SHORT_NAME = 'ALBNR', & - LONG_NAME = 'surface_albedo_for_near_infrared_beam', & + LONG_NAME = 'surface_reflectivity_for_near_infrared_beam', & UNITS = '1', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & _RC) - call MAPL_AddExportSpec(GC, & + call MAPL_AddExportSpec(GC, & SHORT_NAME = 'ALBNF', & - LONG_NAME = 'surface_albedo_for_near_infrared_diffuse', & + LONG_NAME = 'surface_reflectivity_for_near_infrared_diffuse', & UNITS = '1', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, & From 3790723abae6e09cdfede8d0f8e349ab97fdbc9e Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 7 Nov 2024 14:02:46 -0500 Subject: [PATCH 50/73] update exports to match M21C filespecs [stray LONG_NAME occurrences of _albedo -> _reflectivity] (GEOS_CatchGridComp.F90, GEOS_CatchCNCLM40GridComp.F90, GEOS_LandIceGridComp.F90, CatchmentRst.F90) --- .../GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 | 2 +- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 2 +- .../GEOSlandice_GridComp/GEOS_LandIceGridComp.F90 | 4 ++-- .../GEOSsurface_GridComp/Utils/mk_restarts/CatchmentRst.F90 | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index 0ad501f22..96639fe1d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -1381,7 +1381,7 @@ subroutine SetServices ( GC, RC ) if (SNOW_ALBEDO_INFO == 1) then call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'effective_snow_albedo' ,& + LONG_NAME = 'effective_snow_reflectivity',& UNITS = '1' ,& SHORT_NAME = 'SNOWALB' ,& FRIENDLYTO = trim(COMP_NAME) ,& diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index 097ecfbce..df829ab53 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -1332,7 +1332,7 @@ subroutine SetServices ( GC, RC ) if (CATCH_INTERNAL_STATE%SNOW_ALBEDO_INFO == 1) then call MAPL_AddInternalSpec(GC ,& - LONG_NAME = 'effective_snow_albedo' ,& + LONG_NAME = 'effective_snow_reflectivity' ,& UNITS = '1' ,& SHORT_NAME = 'SNOWALB' ,& FRIENDLYTO = trim(COMP_NAME) ,& diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlandice_GridComp/GEOS_LandIceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlandice_GridComp/GEOS_LandIceGridComp.F90 index ed505fb4a..a7725436a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlandice_GridComp/GEOS_LandIceGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSlandice_GridComp/GEOS_LandIceGridComp.F90 @@ -596,7 +596,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'snow_broadband_albedo', & + LONG_NAME = 'snow_broadband_reflectivity', & UNITS = '1' ,& SHORT_NAME = 'SNOWALB' ,& DIMS = MAPL_DimsTileOnly ,& @@ -605,7 +605,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - LONG_NAME = 'aggregated_snow_ice_broadband_albedo', & + LONG_NAME = 'aggregated_snow_ice_broadband_reflectivity', & UNITS = '1' ,& SHORT_NAME = 'SNICEALB' ,& DIMS = MAPL_DimsTileOnly ,& diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentRst.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentRst.F90 index 3af5915f7..4d07ddf7e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentRst.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/CatchmentRst.F90 @@ -577,7 +577,7 @@ subroutine add_bcs_to_rst(this, surflay, DataDir, rc) call MAPL_VarRead ( CatchFmt ,'SNOWALB', this%snowalb, __RC__) if ( .not. this%meta%has_variable('SNOWALB')) then var = Variable(type=pFIO_REAL32, dimensions='tile') - call var%add_attribute('long_name', 'snow_albedo') + call var%add_attribute('long_name', 'snow_reflectivity') call var%add_attribute('units', '1') call this%meta%add_variable('SNOWALB', var) endif From 0700c6ca16090f6e9ee4453885810b8445e2b538 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 12 Nov 2024 10:44:40 -0500 Subject: [PATCH 51/73] before removing levels --- GEOSgigatraj_GridComp/CMakeLists.txt | 2 +- .../GEOS_GigatrajGridComp.F90 | 172 +++++------------- GEOSgigatraj_GridComp/Gigatraj_Utils.F90 | 98 ++++++++++ 3 files changed, 147 insertions(+), 125 deletions(-) create mode 100644 GEOSgigatraj_GridComp/Gigatraj_Utils.F90 diff --git a/GEOSgigatraj_GridComp/CMakeLists.txt b/GEOSgigatraj_GridComp/CMakeLists.txt index 870944a03..ec9f7579d 100644 --- a/GEOSgigatraj_GridComp/CMakeLists.txt +++ b/GEOSgigatraj_GridComp/CMakeLists.txt @@ -3,7 +3,7 @@ esma_set_this() set (dependencies MAPL esmf geos_giga metsources filters gigatraj) esma_add_library (${this} - SRCS GEOS_Giga_InterOp.F90 GEOS_GigatrajGridComp.F90 + SRCS GEOS_Giga_InterOp.F90 Gigatraj_Utils.F90 GEOS_GigatrajGridComp.F90 DEPENDENCIES ${dependencies}) esma_add_subdirectories( @GigaTraj) diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index f0dc97150..80a6b51b0 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -8,6 +8,7 @@ module GEOS_GigatrajGridCompMod use MAPL_VerticalDataMod use mpi use GEOS_Giga_interOpMod + use Gigatraj_UtilsMod implicit none public :: SetServices @@ -35,8 +36,9 @@ module GEOS_GigatrajGridCompMod character(len=ESMF_MAXSTR), allocatable :: ExtrabundleNames(:) character(len=ESMF_MAXSTR), allocatable :: ExtraAliasNames(:) - character(len=ESMF_MAXSTR) :: vertical_coord - character(len=ESMF_MAXSTR) :: vertical_tendency + character(len=:), allocatable :: vCoord + character(len=:), allocatable :: vAlias + character(len=:), allocatable :: vTendency type(VerticalData) :: vdata logical :: regrid_to_latlon @@ -108,6 +110,21 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationEdge, _RC) + call MAPL_AddInternalSpec ( gc, & + SHORT_NAME = 'TH', & + LONG_NAME = 'potential_temperature', & + UNITS = 'K', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, _RC) + + call MAPL_AddInternalSpec ( gc, & + SHORT_NAME = 'DTDTDYN', & + LONG_NAME = 'tendency_of_air_temperature_due_to_dynamics', & + UNITS = 'K s-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, RC=STATUS ) + VERIFY_(STATUS) + allocate(GigaTrajInternalPtr) wrap%ptr => GigaTrajInternalPtr call ESMF_UserCompSetInternalState(GC, 'GigaTrajInternal', wrap, _RC) @@ -156,8 +173,9 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: imc, jmc, HH, MM, SS integer :: integrate_time, r_time, o_time character(len=ESMF_MAXSTR) :: parcels_file - character(len=ESMF_MAXSTR) :: grid_name + character(len=ESMF_MAXSTR) :: grid_name, vCoord character(len=ESMF_MAXSTR) :: regrid_to_latlon + character(len=ESMF_MAXSTR), allocatable :: cName(:), bName(:), fName(:), aName(:) real(ESMF_KIND_R8), pointer :: centerX(:,:) real(ESMF_KIND_R8), pointer :: centerY(:,:) real(ESMF_KIND_R8), pointer :: ptr(:,:) @@ -234,18 +252,22 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_GridCompGet(GC, grid=CubedGrid, _RC) call MAPL_GridGet(CubedGrid, globalCellCountPerDim=DIMS, _RC) - call MAPL_GetResource(MPL, GigaTrajInternalPtr%vertical_coord, "GIGATRAJ_VERTICAL_COORD:", default='PL', rc=status) - select case(trim(GigaTrajInternalPtr%vertical_coord)) + call MAPL_GetResource(MPL, vCoord, "GIGATRAJ_VERTICAL_COORD:", default='DYN%%PL|P', rc=status) + call parseCompsAndFieldsName(vCoord, cName, bName, fName, aName) + GigaTrajInternalPtr%vCoord = trim(fName(1)) + GigaTrajInternalPtr%vAlias = trim(aName(1)) + select case(GigaTrajInternalPtr%vCoord) case ('PL') levs_center = [1000., 975., 950., 925., 900., 875., 850., 825., 800., 775., 750., 725.,700., 650., 600., 550., 500., & 450., 400., 350., 300., 250., 200., 150., 100., 70., 50., 40., 30., 20., 10., 7., 5., 4., 3., 2., & 1., 0.7, 0.5, 0.4, 0.3, 0.2, 0.1, 0.07, 0.05, 0.04, 0.03, 0.02]*100 - GigaTrajInternalPtr%vertical_tendency = 'OMEGA' + GigaTrajInternalPtr%vTendency = 'OMEGA' case('TH') - levs_center = [1000., 975., 950., 925., 900., 875., 850., 825., 800., 775., 750., 725.,700., 650., 600., 550., 500., & - 450., 400., 350., 300., 250., 200., 150., 100., 70., 50., 40., 30., 20., 10., 7., 5., 4., 3., 2., & - 1., 0.7, 0.5, 0.4, 0.3, 0.2, 0.1, 0.07, 0.05, 0.04, 0.03, 0.02] - GigaTrajInternalPtr%vertical_tendency = 'DTDTDYN' + levs_center = [4999., 4708., 4434., 4175., 3932., 3703., 3487., 3284., 3092., 2912., 2742., 2582., 2432., 2290., 2157., & + 2031., 1912., 1801., 1696., 1597., 1504., 1416., 1334., 1256., 1183., 1114., 1049., 988. , 930. , 876., & + 825. , 777. , 731., 689., 649., 611., 575., 542., 510., 480., 452., 426., 401. , 378. , 356. , & + 335. , 315. , 297., 279.] + GigaTrajInternalPtr%vTendency = 'DTDTDYN' case default _ASSERT(.false., "vertical coordinate is needed") end select @@ -368,11 +390,11 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) enddo ! WJiang notes: the vcoord should be consistent with the HISTORY.rc levs_ptr=>levs_center - select case (trim(GigaTrajInternalPtr%vertical_coord)) + select case (GigaTrajInternalPtr%vCoord) case ('PL') GigaTrajInternalPtr%vdata = VerticalData(levs_ptr, vcoord = 'log(PL)', vscale = 1.0, vunit = 'Pa',_RC) case ('TH') - GigaTrajInternalPtr%vdata = VerticalData(levs_ptr, vcoord = 'TH', vscale = 1.0, vunit = 'K',_RC) + GigaTrajInternalPtr%vdata = VerticalData(levs_ptr, vcoord = 'log(TH)', vscale = 1.0, vunit = 'K',_RC) end select call MAPL_Grid_interior(Grid_,i1,i2,j1,j2) @@ -472,7 +494,7 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) meta = formatter%read(_RC) endif - call getCompsAndFields(other_fields, compnames, bundlenames, fieldnames, aliasnames) + call parseCompsAndFieldsName(other_fields, compnames, bundlenames, fieldnames, aliasnames) GigaTrajInternalPtr%ExtraCompNames = compnames GigaTrajInternalPtr%ExtraBundleNames = bundlenames GigaTrajInternalPtr%ExtraFieldNames = fieldnames @@ -494,7 +516,7 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_AttributeGet(tmp_field, NAME='LONG_NAME', VALUE=LONG_NAME, _RC) call ESMF_AttributeGet(tmp_field, NAME='UNITS', VALUE=UNITS, _RC) - call create_new_vars( trim(long_name), trim(aliasnames(i)), trim(units)) + call create_new_vars( meta, formatter, trim(long_name), trim(aliasnames(i)), trim(units)) enddo if (MAPL_AM_I_Root()) then @@ -505,94 +527,6 @@ subroutine GetInitVars ( GC, IMPORT, EXPORT, CLOCK, RC ) init = .true. RETURN_(ESMF_SUCCESS) - contains - - subroutine getCompsAndFields(other_fields, CompNames, BundleNames, FieldNames, AliasNames) - character(*), intent(in) :: other_fields - character(len=ESMF_MAXSTR), allocatable, intent(out) :: CompNames(:) - character(len=ESMF_MAXSTR), allocatable, intent(out) :: BundleNames(:) - character(len=ESMF_MAXSTR), allocatable, intent(out) :: FieldNames(:) - character(len=ESMF_MAXSTR), allocatable, intent(out) :: AliasNames(:) - integer :: num_field, i, j, k, l, endl, num_ - character(len=:), allocatable :: tmp, tmp_bnf, tmp_f, tmp_alias - num_field = 1 - k = 1 - do - i = index(other_fields(k:),';') - if (i == 0) exit - if (trim(other_fields(i+1:)) =='') exit ! take care of the last unnecessay ";" - k = k+i - num_field = num_field+1 - enddo - - allocate(Fieldnames(num_field)) - allocate(Compnames(num_field)) - allocate(BundleNames(num_field)) - allocate(AliasNames(num_field)) - - k = 1 - num_ = 1 - - do - i = index(other_fields(k:),';') - if (i == 0) then - endl = len(other_fields) - else - endl = (k-1)+i-1 - endif - tmp = other_fields(k:endl) - - j = index(tmp, '%%') - if (j == 0) print*, "Wrong format of the comp%%field" - Compnames(num_) = trim(adjustl(tmp(1:j-1))) - tmp_bnf = trim(adjustl(tmp(j+2:))) - - l = index(tmp_bnf, '%') - if (l /=0) then - BundleNames(num_) = tmp_bnf(1:l-1) - tmp_f = tmp_bnf(l+1:) - else - BundleNames(num_) = 'NONE' - tmp_f = tmp_bnf - endif - - ! Aliasing....., Hard coded here - l = index(tmp_f, '|') - if (l /=0) then - FieldNames(num_) = tmp_f(1:l-1) - tmp_alias = tmp_f(l+1:) - else - FieldNames(num_) = tmp_f - tmp_alias = tmp_f - endif - - AliasNames(num_) = tmp_alias - - num_ = num_ + 1 - k = endl + 2 - if (num_ > num_field) exit - enddo - end subroutine getCompsAndFields - - subroutine create_new_vars(long_name, short_name, units) - character(*), intent(in) :: long_name - character(*), intent(in) :: short_name - character(*), intent(in) :: units - type(Variable) :: var - character(len=:), allocatable :: var_name - if( meta%has_variable(short_name)) return - var_name = short_name - if (MAPL_AM_I_Root()) then - var = variable(type=pFIO_REAL32, dimensions='id,time') - call var%add_attribute('long_name', long_name) - call var%add_attribute('units', units) - call var%add_attribute('positive', "up") - call var%add_attribute('_FillValue', -999.99) - call var%add_attribute('missing_value', -999.99) - call meta%add_variable(var_name, var) - call formatter%add_variable(meta, short_name) - endif - end subroutine create_new_vars end subroutine GetInitVars @@ -612,7 +546,6 @@ subroutine Init_metsrc_field0 (GC, state, ctime, RC ) real, dimension(:,:,:), allocatable :: U_inter, V_inter, W_inter, P_inter real, dimension(:,:,:), allocatable, target :: haloU, haloV, haloW, haloP integer :: counts(3), dims(3), d1,d2,km,lm, i1,i2,j1,j2 - character(len=:), allocatable :: vcoord Iam = "init_metsrc_field0" @@ -621,13 +554,10 @@ subroutine Init_metsrc_field0 (GC, state, ctime, RC ) call MAPL_GetPointer(state, U, "U", _RC) call MAPL_GetPointer(state, V, "V", _RC) - call MAPL_GetPointer(state, W, trim(GigaTrajInternalPtr%vertical_tendency), _RC) - call MAPL_GetPointer(state, P, trim(GigaTrajInternalPtr%vertical_coord), _RC) - - vcoord = "PL" - if (trim(GigaTrajInternalPtr%vertical_coord) == "TH") vcoord = "ZLE" + call MAPL_GetPointer(state, W, trim(GigaTrajInternalPtr%vTendency), _RC) + call MAPL_GetPointer(state, P, trim(GigaTrajInternalPtr%vCoord), _RC) - call ESMF_StateGet(state, vcoord , field=GigaTrajInternalPtr%vdata%interp_var, rc=status) + call ESMF_StateGet(state, GigaTrajInternalPtr%vCoord , field=GigaTrajInternalPtr%vdata%interp_var, rc=status) call GigaTrajInternalPtr%vdata%setup_eta_to_pressure(_RC) if (GigaTrajInternalPtr%regrid_to_latlon) then @@ -729,7 +659,6 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) type(ESMF_Alarm) :: GigaTrajIntegrateAlarm type(MAPL_VarSpec ), pointer:: internal_specs(:) character(len=ESMF_MAXSTR) :: SHORT_NAME - character(len=:), allocatable :: vcoord !--------------- ! Update internal @@ -778,8 +707,8 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) !--------------- call MAPL_GetPointer(Import, U_cube, "U", _RC) call MAPL_GetPointer(Import, V_cube, "V", _RC) - call MAPL_GetPointer(Import, W_cube, trim(GigaTrajInternalPtr%vertical_tendency), _RC) - call MAPL_GetPointer(Import, P_cube, trim(GigaTrajInternalPtr%vertical_coord), _RC) + call MAPL_GetPointer(Import, W_cube, GigaTrajInternalPtr%vTendency, _RC) + call MAPL_GetPointer(Import, P_cube, GigaTrajInternalPtr%vCoord, _RC) lm = size(GigaTrajInternalPtr%vdata%levs) d1 = size(u_cube,1) @@ -809,9 +738,7 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) allocate(haloW(counts(1)+2, counts(2)+2,lm), source = 0.0) allocate(haloP(counts(1)+2, counts(2)+2,lm), source = 0.0) - vcoord = 'PL' - if (trim(GigaTrajInternalPtr%vertical_coord) == 'TH') vcoord = 'ZLE' - call ESMF_StateGet(import, vcoord, field=GigaTrajInternalPtr%vdata%interp_var, _RC) + call ESMF_StateGet(import, GigaTrajInternalPtr%vCoord, field=GigaTrajInternalPtr%vdata%interp_var, _RC) call GigaTrajInternalPtr%vdata%setup_eta_to_pressure(_RC) call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(U_cube, U_inter,rc=status) @@ -1239,11 +1166,9 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) call MPI_Comm_rank(comm, my_rank, ierror); _VERIFY(ierror) if (my_rank ==0) then - if (trim(GigaTrajInternalPtr%vertical_coord) == 'PL') then - vAlias = 'P' + if (GigaTrajInternalPtr%vCoord == 'PL') then zs0 = zs0 / 100.0 ! hard coded, conert Pa back to hPa endif - if (trim(GigaTrajInternalPtr%vertical_coord) == 'TH') vAlias = 'Theta' ! reorder ids0 = ids0 + 1 ! element start 0, make it to 1 for ordering ids0(ids0) = [(k, k=1,size(ids0))] @@ -1270,7 +1195,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) call formatter%put_var('lat', lats0, start=[1, last_time+1], _RC) call formatter%put_var('lon', lons0, start=[1, last_time+1], _RC) - call formatter%put_var(vAlias, zs0, start=[1, last_time+1], _RC) + call formatter%put_var(GigaTrajInternalPtr%vAlias, zs0, start=[1, last_time+1], _RC) call formatter%put_var('time', [tint_d], start=[last_time+1], _RC) endif @@ -1340,6 +1265,7 @@ subroutine write_parcels(GC, state, CLOCK, currentTime, rc) if (my_rank == 0) then values0 = values0(ids0(:)) if ( meta%has_variable(var_alias)) then + if(var_alias == 'P') values0 = values0/100.0 ! hard coded to hPa call formatter%put_var( var_alias, values0, start=[1, last_time+1], _RC) else print*, "Please provide "//var_alias // " in the file "//trim(parcels_file) @@ -1378,7 +1304,6 @@ subroutine read_parcels(GC,internal, rc) class(Variable), pointer :: t type(Attribute), pointer :: attr class(*), pointer :: units - character(len=:), allocatable :: vAlias character(len=ESMF_MAXSTR) :: Iam ="read_parcels" call ESMF_VMGetCurrent(vm, _RC) @@ -1405,14 +1330,12 @@ subroutine read_parcels(GC,internal, rc) endif allocate(lats0(total_num), lons0(total_num), zs0(total_num),ids0(total_num)) - if (trim(internal%vertical_coord) == 'PL') vAlias = 'P' - if (trim(internal%vertical_coord) == 'TH') vAlias = 'Theta' if (my_rank ==0) then call formatter%get_var('lat', lats0, start = [1,last_time], _RC) call formatter%get_var('lon', lons0, start = [1,last_time], _RC) - call formatter%get_var(vAlias,zs0, start = [1,last_time], _RC) - if (vAlias == 'P') zs0 = zs0*100.0 ! hard coded from hPa to Pa + call formatter%get_var(internal%vAlias,zs0, start = [1,last_time], _RC) + if (internal%vCoord == 'PL') zs0 = zs0*100.0 ! hard coded from hPa to Pa call formatter%close(_RC) ids0 = [(k, k=0,total_num-1)] endif @@ -1571,6 +1494,7 @@ subroutine get_metsrc_data (GC, state, ctime, compname, bundlename, fieldname, v d2 = size(ptr3d,2) allocate(field_inter(d1,d2,lm), source = 0.0) + call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(ptr3d, field_inter,rc=status) if (GigaTrajInternalPtr%regrid_to_latlon) then diff --git a/GEOSgigatraj_GridComp/Gigatraj_Utils.F90 b/GEOSgigatraj_GridComp/Gigatraj_Utils.F90 new file mode 100644 index 000000000..1921e4195 --- /dev/null +++ b/GEOSgigatraj_GridComp/Gigatraj_Utils.F90 @@ -0,0 +1,98 @@ +module Gigatraj_UtilsMod + use MAPL + implicit none + public :: parseCompsAndFieldsName + public :: create_new_vars + +contains + + subroutine parseCompsAndFieldsName(fields_line, CompNames, BundleNames, FieldNames, AliasNames) + character(*), intent(in) :: fields_line + character(len=ESMF_MAXSTR), allocatable, intent(out) :: CompNames(:) + character(len=ESMF_MAXSTR), allocatable, intent(out) :: BundleNames(:) + character(len=ESMF_MAXSTR), allocatable, intent(out) :: FieldNames(:) + character(len=ESMF_MAXSTR), allocatable, intent(out) :: AliasNames(:) + integer :: num_field, i, j, k, l, endl, num_ + character(len=:), allocatable :: tmp, tmp_bnf, tmp_f, tmp_alias + num_field = 1 + k = 1 + do + i = index(fields_line(k:),';') + if (i == 0) exit + if (trim(fields_line(i+1:)) =='') exit ! take care of the last unnecessay ";" + k = k+i + num_field = num_field+1 + enddo + + allocate(Fieldnames(num_field)) + allocate(Compnames(num_field)) + allocate(BundleNames(num_field)) + allocate(AliasNames(num_field)) + + k = 1 + num_ = 1 + + do + i = index(fields_line(k:),';') + if (i == 0) then + endl = len(fields_line) + else + endl = (k-1)+i-1 + endif + tmp = fields_line(k:endl) + + j = index(tmp, '%%') + if (j == 0) print*, "Wrong format of the comp%%field" + Compnames(num_) = trim(adjustl(tmp(1:j-1))) + tmp_bnf = trim(adjustl(tmp(j+2:))) + + l = index(tmp_bnf, '%') + if (l /=0) then + BundleNames(num_) = tmp_bnf(1:l-1) + tmp_f = tmp_bnf(l+1:) + else + BundleNames(num_) = 'NONE' + tmp_f = tmp_bnf + endif + + ! Aliasing....., Hard coded here + l = index(tmp_f, '|') + if (l /=0) then + FieldNames(num_) = tmp_f(1:l-1) + tmp_alias = tmp_f(l+1:) + else + FieldNames(num_) = tmp_f + tmp_alias = tmp_f + endif + + AliasNames(num_) = tmp_alias + + num_ = num_ + 1 + k = endl + 2 + if (num_ > num_field) exit + enddo + end subroutine parseCompsAndFieldsName + + subroutine create_new_vars(meta, formatter, long_name, short_name, units) + type(FileMetadata), intent(inout) :: meta + type(Netcdf4_fileformatter), intent(inout) :: formatter + character(*), intent(in) :: long_name + character(*), intent(in) :: short_name + character(*), intent(in) :: units + type(Variable) :: var + character(len=:), allocatable :: var_name + if (MAPL_AM_I_Root()) then + if( meta%has_variable(short_name)) return + var_name = short_name + var = variable(type=pFIO_REAL32, dimensions='id,time') + call var%add_attribute('long_name', long_name) + call var%add_attribute('units', units) + call var%add_attribute('positive', "up") + call var%add_attribute('_FillValue', -999.99) + call var%add_attribute('missing_value', -999.99) + call meta%add_variable(var_name, var) + call formatter%add_variable(meta, short_name) + endif + end subroutine create_new_vars + +end module From 9a66e72f0112544805f80170c5c24c8752a205d4 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 14 Nov 2024 15:48:58 -0500 Subject: [PATCH 52/73] remove vertical interpolation on GEOS side --- .../GEOS_GigatrajGridComp.F90 | 109 ++++++------------ 1 file changed, 35 insertions(+), 74 deletions(-) diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index 80a6b51b0..73eb5ec85 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -40,7 +40,6 @@ module GEOS_GigatrajGridCompMod character(len=:), allocatable :: vAlias character(len=:), allocatable :: vTendency - type(VerticalData) :: vdata logical :: regrid_to_latlon end type @@ -160,11 +159,10 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: DIMS(3), counts(3), i, j, l type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap - real :: dlat, dlon + real :: dlat, dlon, delt real, allocatable, target :: lats_center(:), lons_center(:), levs_center(:) real, allocatable, target :: cube_lats_center(:, :), cube_lons_center(:,:) real, allocatable :: lats_2dcenter(:, :), lons_2dcenter(:,:) - real, pointer :: levs_ptr(:) type (ESMF_TIME) :: CurrentTime character(len=20), target :: ctime type(ESMF_Alarm) :: GigaTrajOutAlarm, GigaTrajRebalanceAlarm, GigaTrajIntegrateAlarm @@ -272,7 +270,9 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) _ASSERT(.false., "vertical coordinate is needed") end select - npz = size(levs_center, 1) + npz = Dims(3) + delt = (log(100000.)-log(2.))/npz + levs_center=[(exp(log(100000.)-(i-1)*delt), i=1, npz)] GigaTrajInternalPtr%npz = npz GigaTrajInternalPtr%Integrate_DT = Integrate_DT @@ -388,14 +388,6 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) J2 = J2s(rank+1) GigaTrajInternalPtr%CellToRank(I1:I2,J1:J2) = rank enddo - ! WJiang notes: the vcoord should be consistent with the HISTORY.rc - levs_ptr=>levs_center - select case (GigaTrajInternalPtr%vCoord) - case ('PL') - GigaTrajInternalPtr%vdata = VerticalData(levs_ptr, vcoord = 'log(PL)', vscale = 1.0, vunit = 'Pa',_RC) - case ('TH') - GigaTrajInternalPtr%vdata = VerticalData(levs_ptr, vcoord = 'log(TH)', vscale = 1.0, vunit = 'K',_RC) - end select call MAPL_Grid_interior(Grid_,i1,i2,j1,j2) if (GigaTrajInternalPtr%regrid_to_latlon) then @@ -543,7 +535,6 @@ subroutine Init_metsrc_field0 (GC, state, ctime, RC ) type (GigatrajInternalWrap) :: wrap real, dimension(:,:,:), pointer :: U, V, W, P, PL0, PLE, TH real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon, P_latlon - real, dimension(:,:,:), allocatable :: U_inter, V_inter, W_inter, P_inter real, dimension(:,:,:), allocatable, target :: haloU, haloV, haloW, haloP integer :: counts(3), dims(3), d1,d2,km,lm, i1,i2,j1,j2 @@ -557,60 +548,46 @@ subroutine Init_metsrc_field0 (GC, state, ctime, RC ) call MAPL_GetPointer(state, W, trim(GigaTrajInternalPtr%vTendency), _RC) call MAPL_GetPointer(state, P, trim(GigaTrajInternalPtr%vCoord), _RC) - call ESMF_StateGet(state, GigaTrajInternalPtr%vCoord , field=GigaTrajInternalPtr%vdata%interp_var, rc=status) - call GigaTrajInternalPtr%vdata%setup_eta_to_pressure(_RC) - if (GigaTrajInternalPtr%regrid_to_latlon) then call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) else call MAPL_GridGet(GigaTrajInternalPtr%CubedGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) endif - !#lm = counts(3) - lm = size(GigaTrajInternalPtr%vdata%levs) + lm =size(U,3) d1 =size(U,1) d2 =size(U,2) - allocate(U_latlon(counts(1),counts(2),lm)) - allocate(V_latlon(counts(1),counts(2),lm)) - allocate(W_latlon(counts(1),counts(2),lm)) - allocate(P_latlon(counts(1),counts(2),lm)) - - allocate(U_inter(d1,d2,lm)) - allocate(V_inter(d1,d2,lm)) - allocate(W_inter(d1,d2,lm)) - allocate(P_inter(d1,d2,lm)) allocate(haloU(counts(1)+2, counts(2)+2,lm), source = 0.0) allocate(haloV(counts(1)+2, counts(2)+2,lm), source = 0.0) allocate(haloW(counts(1)+2, counts(2)+2,lm), source = 0.0) allocate(haloP(counts(1)+2, counts(2)+2,lm), source = 0.0) - call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(U, U_inter,rc=status) - call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(V, V_inter,rc=status) - call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(W, W_inter,rc=status) - call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(P, P_inter,rc=status) if ( GigaTrajInternalPtr%regrid_to_latlon) then - call GigaTrajInternalPtr%cube2latlon%regrid(U_inter, V_inter, U_latlon, V_latlon, _RC) - call GigaTrajInternalPtr%cube2latlon%regrid(W_inter, W_latlon, _RC) - call GigaTrajInternalPtr%cube2latlon%regrid(P_inter, P_latlon, _RC) + allocate(U_latlon(counts(1),counts(2),lm)) + allocate(V_latlon(counts(1),counts(2),lm)) + allocate(W_latlon(counts(1),counts(2),lm)) + allocate(P_latlon(counts(1),counts(2),lm)) + call GigaTrajInternalPtr%cube2latlon%regrid(U, V, U_latlon, V_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(W, W_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(P, P_latlon, _RC) call esmf_halo(GigaTrajInternalPtr%LatLonGrid, U_Latlon, haloU, _RC) call esmf_halo(GigaTrajInternalPtr%LatLonGrid, V_Latlon, haloV, _RC) call esmf_halo(GigaTrajInternalPtr%LatLonGrid, W_Latlon, haloW, _RC) call esmf_halo(GigaTrajInternalPtr%LatLonGrid, P_Latlon, haloP, _RC) + deallocate(U_latlon, V_latlon, W_latlon, P_latlon) else - call esmf_halo(GigaTrajInternalPtr%CubedGrid, U_inter, haloU, _RC) - call esmf_halo(GigaTrajInternalPtr%CubedGrid, V_inter, haloV, _RC) - call esmf_halo(GigaTrajInternalPtr%CubedGrid, W_inter, haloW, _RC) - call esmf_halo(GigaTrajInternalPtr%CubedGrid, P_inter, haloP, _RC) + call esmf_halo(GigaTrajInternalPtr%CubedGrid, U, haloU, _RC) + call esmf_halo(GigaTrajInternalPtr%CubedGrid, V, haloV, _RC) + call esmf_halo(GigaTrajInternalPtr%CubedGrid, W, haloW, _RC) + call esmf_halo(GigaTrajInternalPtr%CubedGrid, P, haloP, _RC) endif call updateFields( GigaTrajInternalPtr%metSrc, c_loc(ctime), c_loc(haloU), c_loc(haloV), c_loc(haloW), c_loc(haloP)) if(associated(PL0)) deallocate(PL0) - deallocate(U_latlon, V_latlon, W_latlon, P_latlon) - deallocate(U_inter, V_inter, W_inter, P_inter) deallocate(haloU, haloV, haloW, haloP) RETURN_(ESMF_SUCCESS) @@ -710,13 +687,9 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(Import, W_cube, GigaTrajInternalPtr%vTendency, _RC) call MAPL_GetPointer(Import, P_cube, GigaTrajInternalPtr%vCoord, _RC) - lm = size(GigaTrajInternalPtr%vdata%levs) + lm = size(u_cube,3) d1 = size(u_cube,1) d2 = size(u_cube,2) - allocate(U_inter(d1, d2,lm), source = 0.0) - allocate(V_inter(d1, d2,lm), source = 0.0) - allocate(W_inter(d1, d2,lm), source = 0.0) - allocate(P_inter(d1, d2,lm), source = 0.0) if (GigaTrajInternalPtr%regrid_to_latlon) then grid_ = GigaTrajInternalPtr%LatLonGrid @@ -738,34 +711,26 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) allocate(haloW(counts(1)+2, counts(2)+2,lm), source = 0.0) allocate(haloP(counts(1)+2, counts(2)+2,lm), source = 0.0) - call ESMF_StateGet(import, GigaTrajInternalPtr%vCoord, field=GigaTrajInternalPtr%vdata%interp_var, _RC) - call GigaTrajInternalPtr%vdata%setup_eta_to_pressure(_RC) - - call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(U_cube, U_inter,rc=status) - call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(V_cube, V_inter,rc=status) - call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(W_cube, W_inter,rc=status) - call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(P_cube, P_inter,rc=status) - - if (GigaTrajInternalPtr%regrid_to_latlon) then - call GigaTrajInternalPtr%cube2latlon%regrid(U_inter,V_inter, U_latlon, V_latlon, _RC) - call GigaTrajInternalPtr%cube2latlon%regrid(W_inter, W_latlon, _RC) - call GigaTrajInternalPtr%cube2latlon%regrid(P_inter, P_latlon, _RC) - endif - !--------------- ! Step 2) Get halo !--------------- - if (GigaTrajInternalPtr%regrid_to_latlon) then + + call GigaTrajInternalPtr%cube2latlon%regrid(U_cube,V_cube, U_latlon, V_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(W_cube, W_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(P_cube, P_latlon, _RC) + call esmf_halo(grid_, U_Latlon, haloU, _RC) call esmf_halo(grid_, V_Latlon, haloV, _RC) call esmf_halo(grid_, W_Latlon, haloW, _RC) call esmf_halo(grid_, P_Latlon, haloP, _RC) + + deallocate( U_Latlon, V_latlon, W_latlon, P_latlon) else - call esmf_halo(grid_, U_inter, haloU, _RC) - call esmf_halo(grid_, V_inter, haloV, _RC) - call esmf_halo(grid_, W_inter, haloW, _RC) - call esmf_halo(grid_, P_inter, haloP, _RC) + call esmf_halo(grid_, U_cube, haloU, _RC) + call esmf_halo(grid_, V_cube, haloV, _RC) + call esmf_halo(grid_, W_cube, haloW, _RC) + call esmf_halo(grid_, P_cube, haloP, _RC) endif !--------------- @@ -782,7 +747,6 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) c_loc(GigaTrajInternalPtr%parcels%lats), & c_loc(GigaTrajInternalPtr%parcels%zs)) - if (allocated(U_Latlon)) deallocate( U_Latlon, V_latlon, W_latlon, P_latlon) deallocate(haloU, haloV, haloW, haloP) !--------------- @@ -1462,7 +1426,7 @@ subroutine get_metsrc_data (GC, state, ctime, compname, bundlename, fieldname, v type (ESMF_GRID) :: grid_ type(ESMF_State) :: leaf_export real, dimension(:,:,:), pointer :: ptr3d - real, dimension(:,:,:), allocatable :: field_latlon, field_inter + real, dimension(:,:,:), allocatable :: field_latlon real, dimension(:,:,:), allocatable, target :: haloField integer :: counts(3), dims(3), d1, d2, lm, count3 @@ -1489,14 +1453,10 @@ subroutine get_metsrc_data (GC, state, ctime, compname, bundlename, fieldname, v call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) GigaTrajInternalPtr => wrap%ptr - lm = size(GigaTrajInternalPtr%vdata%levs) + lm = size(ptr3d,3) d1 = size(ptr3d,1) d2 = size(ptr3d,2) - allocate(field_inter(d1,d2,lm), source = 0.0) - - call GigaTrajInternalPtr%vdata%regrid_eta_to_pressure(ptr3d, field_inter,rc=status) - if (GigaTrajInternalPtr%regrid_to_latlon) then grid_ = GigaTrajInternalPtr%LatLonGrid call MAPL_GridGet(grid_, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) @@ -1509,10 +1469,11 @@ subroutine get_metsrc_data (GC, state, ctime, compname, bundlename, fieldname, v allocate(haloField(counts(1)+2, counts(2)+2, lm), source = 0.0) if (GigaTrajInternalPtr%regrid_to_latlon) then - call GigaTrajInternalPtr%cube2latlon%regrid(field_inter, Field_latlon, _RC) + call GigaTrajInternalPtr%cube2latlon%regrid(ptr3d, Field_latlon, _RC) call esmf_halo(grid_, Field_latlon, haloField, _RC) + deallocate(Field_latlon) else - call esmf_halo(grid_, field_inter, haloField, _RC) + call esmf_halo(grid_, ptr3d, haloField, _RC) endif field_ = trim(fieldname)//c_null_char @@ -1524,7 +1485,7 @@ subroutine get_metsrc_data (GC, state, ctime, compname, bundlename, fieldname, v c_loc(GigaTrajInternalPtr%parcels%zs), & c_loc(values)) - deallocate(field_latlon, haloField, field_inter) + deallocate(haloField) RETURN_(ESMF_SUCCESS) end subroutine get_metsrc_data From 461de4ffcfcfae2cacf0f01d8cc5446abbdcd4f5 Mon Sep 17 00:00:00 2001 From: Florian Deconinck Date: Mon, 25 Nov 2024 14:05:35 -0500 Subject: [PATCH 53/73] Initial prototype of a CFFI-based fortran/python bridge Bogus data code to show usage Ships with an f_py memory converted and a Timer capable of GPU via `cupy` --- GEOSmkiau_GridComp/CMakeLists.txt | 90 ++++++- GEOSmkiau_GridComp/GEOS_mkiauGridComp.F90 | 34 ++- GEOSmkiau_GridComp/pyMKIAU/.gitignore | 12 + GEOSmkiau_GridComp/pyMKIAU/README.md | 39 ++++ .../pyMKIAU/interface/interface.c | 31 +++ .../pyMKIAU/interface/interface.f90 | 43 ++++ .../pyMKIAU/interface/interface.h | 40 ++++ .../pyMKIAU/interface/interface.py | 46 ++++ .../pyMKIAU/pyMKIAU/__init__.py | 0 GEOSmkiau_GridComp/pyMKIAU/pyMKIAU/core.py | 74 ++++++ .../pyMKIAU/pyMKIAU/cuda_profiler.py | 76 ++++++ .../pyMKIAU/pyMKIAU/f_py_conversion.py | 219 ++++++++++++++++++ GEOSmkiau_GridComp/pyMKIAU/setup.py | 33 +++ 13 files changed, 733 insertions(+), 4 deletions(-) create mode 100644 GEOSmkiau_GridComp/pyMKIAU/.gitignore create mode 100644 GEOSmkiau_GridComp/pyMKIAU/README.md create mode 100644 GEOSmkiau_GridComp/pyMKIAU/interface/interface.c create mode 100644 GEOSmkiau_GridComp/pyMKIAU/interface/interface.f90 create mode 100644 GEOSmkiau_GridComp/pyMKIAU/interface/interface.h create mode 100644 GEOSmkiau_GridComp/pyMKIAU/interface/interface.py create mode 100644 GEOSmkiau_GridComp/pyMKIAU/pyMKIAU/__init__.py create mode 100644 GEOSmkiau_GridComp/pyMKIAU/pyMKIAU/core.py create mode 100644 GEOSmkiau_GridComp/pyMKIAU/pyMKIAU/cuda_profiler.py create mode 100644 GEOSmkiau_GridComp/pyMKIAU/pyMKIAU/f_py_conversion.py create mode 100644 GEOSmkiau_GridComp/pyMKIAU/setup.py diff --git a/GEOSmkiau_GridComp/CMakeLists.txt b/GEOSmkiau_GridComp/CMakeLists.txt index 213c2776d..283c5981a 100644 --- a/GEOSmkiau_GridComp/CMakeLists.txt +++ b/GEOSmkiau_GridComp/CMakeLists.txt @@ -1,5 +1,7 @@ esma_set_this() +option(BUILD_PYMKIAU_INTERFACE "Build pyMKIAU interface" OFF) + set (srcs IAU_GridCompMod.F90 GEOS_mkiauGridComp.F90 @@ -8,6 +10,90 @@ set (srcs DynVec_GridComp.F90 ) -set(dependencies MAPL_cfio_r4 NCEP_sp_r4i4 GEOS_Shared GMAO_mpeu MAPL FVdycoreCubed_GridComp ESMF::ESMF NetCDF::NetCDF_Fortran) -esma_add_library (${this} SRCS ${srcs} DEPENDENCIES ${dependencies}) +if (BUILD_PYMKIAU_INTERFACE) + list (APPEND srcs + pyMKIAU/interface/interface.f90 + pyMKIAU/interface/interface.c) + + message(STATUS "Building pyMKIAU interface") + + add_definitions(-DPYMKIAU_INTEGRATION) + + # The Python library creation requires mpiexec/mpirun to run on a + # compute node. Probably a weird SLURM thing? + find_package(Python3 COMPONENTS Interpreter REQUIRED) + + # Set up some variables in case names change + set(PYMKIAU_INTERFACE_LIBRARY ${CMAKE_CURRENT_BINARY_DIR}/libpyMKIAU_interface_py.so) + set(PYMKIAU_INTERFACE_HEADER_FILE ${CMAKE_CURRENT_BINARY_DIR}/pyMKIAU_interface_py.h) + set(PYMKIAU_INTERFACE_FLAG_HEADER_FILE ${CMAKE_CURRENT_SOURCE_DIR}/pyMKIAU/interface/interface.h) + set(PYMKIAU_INTERFACE_SRCS ${CMAKE_CURRENT_SOURCE_DIR}/pyMKIAU/interface/interface.py) + + # This command creates the shared object library from Python + add_custom_command( + OUTPUT ${PYMKIAU_INTERFACE_LIBRARY} + # Note below is essentially: + # mpirun -np 1 python file + # but we use the CMake options as much as we can for flexibility + COMMAND ${CMAKE_COMMAND} -E copy_if_different ${PYMKIAU_INTERFACE_FLAG_HEADER_FILE} ${CMAKE_CURRENT_BINARY_DIR} + COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} 1 ${Python3_EXECUTABLE} ${PYMKIAU_INTERFACE_SRCS} + BYPRODUCTS ${PYMKIAU_INTERFACE_HEADER_FILE} + WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} + MAIN_DEPENDENCY ${PYMKIAU_INTERFACE_SRCS} + COMMENT "Building pyMKIAU interface library with Python" + VERBATIM + ) + + # This creates a target we can use for dependencies and post build + add_custom_target(generate_pyMKIAU_interface_library DEPENDS ${PYMKIAU_INTERFACE_LIBRARY}) + # Because of the weird hacking of INTERFACE libraries below, we cannot + # use the "usual" CMake calls to install() the .so. I think it's because + # INTERFACE libraries don't actually produce any artifacts as far as + # CMake is concerned. So we add a POST_BUILD custom command to "install" + # the library into install/lib + add_custom_command(TARGET generate_pyMKIAU_interface_library + POST_BUILD + # We first need to make a lib dir if it doesn't exist. If not, then + # the next command can copy the script into a *file* called lib because + # of a race condition (if install/lib/ isn't mkdir'd first) + COMMAND ${CMAKE_COMMAND} -E make_directory ${CMAKE_INSTALL_PREFIX}/lib + # Now we copy the file (if different...though not sure if this is useful) + COMMAND ${CMAKE_COMMAND} -E copy_if_different "${PYMKIAU_INTERFACE_LIBRARY}" ${CMAKE_INSTALL_PREFIX}/lib + ) + + # We use INTERFACE libraries to create a sort of "fake" target library we can use + # to make libFVdycoreCubed_GridComp.a depend on. It seems to work! + add_library(pyMKIAU_interface_py INTERFACE) + + # The target_include_directories bits were essentially stolen from the esma_add_library + # code... + target_include_directories(pyMKIAU_interface_py INTERFACE + $ + $ # stubs + # modules and copied *.h, *.inc + $ + $ + ) + target_link_libraries(pyMKIAU_interface_py INTERFACE ${PYMKIAU_INTERFACE_LIBRARY}) + + # This makes sure the library is built first + add_dependencies(pyMKIAU_interface_py generate_pyMKIAU_interface_library) + + # This bit is to resolve an issue and Google told me to do this. I'm not + # sure that the LIBRARY DESTINATION bit actually does anything since + # this is using INTERFACE + install(TARGETS pyMKIAU_interface_py + EXPORT ${PROJECT_NAME}-targets + LIBRARY DESTINATION ${CMAKE_INSTALL_PREFIX}/lib + ) + +endif () + +if (BUILD_PYMKIAU_INTERFACE) + set(dependencies pyMKIAU_interface_py MAPL_cfio_r4 NCEP_sp_r4i4 GEOS_Shared GMAO_mpeu MAPL FVdycoreCubed_GridComp ESMF::ESMF NetCDF::NetCDF_Fortran) +else () + set(dependencies MAPL_cfio_r4 NCEP_sp_r4i4 GEOS_Shared GMAO_mpeu MAPL FVdycoreCubed_GridComp ESMF::ESMF NetCDF::NetCDF_Fortran) +endif () + +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES ${dependencies}) diff --git a/GEOSmkiau_GridComp/GEOS_mkiauGridComp.F90 b/GEOSmkiau_GridComp/GEOS_mkiauGridComp.F90 index 08c36a967..6ed4dbb9e 100644 --- a/GEOSmkiau_GridComp/GEOS_mkiauGridComp.F90 +++ b/GEOSmkiau_GridComp/GEOS_mkiauGridComp.F90 @@ -19,6 +19,10 @@ module GEOS_mkiauGridCompMod use GEOS_UtilsMod ! use GEOS_RemapMod, only: myremap => remap use m_set_eta, only: set_eta +#ifdef PYMKIAU_INTEGRATION + use pyMKIAU_interface_mod + use ieee_exceptions, only: ieee_get_halting_mode, ieee_set_halting_mode, ieee_all +#endif implicit none private @@ -91,8 +95,15 @@ subroutine SetServices ( GC, RC ) type (ESMF_Config) :: CF logical :: BLEND_AT_PBL - -!============================================================================= +#ifdef PYMKIAU_INTEGRATION + ! IEEE trapping see below + logical :: halting_mode(5) + ! BOGUS DATA TO SHOW USAGE + type(a_pod_struct_type) :: options + real, allocatable, dimension(:,:,:) :: in_buffer + real, allocatable, dimension(:,:,:) :: out_buffer +#endif + !============================================================================= ! Begin... @@ -459,6 +470,25 @@ subroutine SetServices ( GC, RC ) call MAPL_GenericSetServices ( gc, RC=STATUS) VERIFY_(STATUS) +#ifdef PYMKIAU_INTEGRATION + ! Spin the interface - we have to deactivate the ieee error + ! to be able to load numpy, scipy and other numpy packages + ! that generate NaN as an init mechanism for numerical solving + call ieee_get_halting_mode(ieee_all, halting_mode) + call ieee_set_halting_mode(ieee_all, .false.) + call pyMKIAU_interface_f_setservice() + call ieee_set_halting_mode(ieee_all, halting_mode) + + ! BOGUS CODE TO SHOW USAGE + options%npx = 10 + options%npy = 11 + options%npz = 12 + allocate (in_buffer(10,11,12), source = 42.42 ) + allocate (out_buffer(10,11,12), source = 0.0 ) + call pyMKIAU_interface_f_run(options, in_buffer, out_buffer) + write(*,*) "[pyMKIAU] From fortran OUT[5,5,5] is ", out_buffer(5,5,5) +#endif + RETURN_(ESMF_SUCCESS) end subroutine SetServices diff --git a/GEOSmkiau_GridComp/pyMKIAU/.gitignore b/GEOSmkiau_GridComp/pyMKIAU/.gitignore new file mode 100644 index 000000000..9ae227288 --- /dev/null +++ b/GEOSmkiau_GridComp/pyMKIAU/.gitignore @@ -0,0 +1,12 @@ +__pycache__/ +*.py[cod] +*$py.class +.pytest_cache +*.egg-info/ +test_data/ +.gt_cache_* +.translate-*/ +.vscode +test_data/ +sandbox/ +*.mod diff --git a/GEOSmkiau_GridComp/pyMKIAU/README.md b/GEOSmkiau_GridComp/pyMKIAU/README.md new file mode 100644 index 000000000..7da29e7d7 --- /dev/null +++ b/GEOSmkiau_GridComp/pyMKIAU/README.md @@ -0,0 +1,39 @@ +# Fortran - Python bridge prototype + +Nomenclatura: we call the brige "fpy" and "c", "f" and "py" denotes functions in their respective language. + +Building: you have to pass `-DBUILD_PYMKIAU_INTERFACE=ON` to your `cmake` command to turn on the interface build and execution. + +## Pipeline + +Here's a quick rundown of how a buffer travels through the interface and back. + +- From Fortran in `GEOS_MKIAUGridComp:488` we call `pyMKIAU_interface_f_run` with the buffer passed as argument +- This pings the interface, located at `pyMKIAU/interface/interface.f90`. This interface uses the `iso_c_binding` to marshall the parameters downward (careful about the user type, look at the code) +- Fortran then call into C at `pyMKIAU/interface/interface.c`. Those functions now expect that a few `extern` hooks have been made available on the python side, they are define in `pyMKIAU/interface/interface.h` +- At runtime, the hooks are found and code carries to the python thanks to cffi. The .so that exposes the hooks is in `pyMKIAU/interface/interface.py`. Within this code, we: expose extern functions via `ffi.extern`, build a shared library to link for runtime and pass the code down to the `pyMKIAU` python package which lives at `pyMKIAU/pyMKIAU` +- In the package, the `serservices` or `run` function is called. + +## Fortran <--> C: iso_c_binding + +We leverage Fortan `iso_c_binding` extension to do conform Fortran and C calling structure. Which comes with a bunch of easy type casting and some pretty steep potholes. +The two big ones are: + +- strings need to be send/received as a buffer plus a length, +- pointers/buffers are _not_ able to be pushed into a user type. + +## C <->Python: CFFI based glue + +The interface is based on CFFI which is reponsible for the heavy lifting of + +- spinning a python interpreter +- passing memory between C and Python without a copy + +## Running python + +The last trick is to make sure your package is callable by the `interface.py`. Basically your code has to be accessible by the interpreter, be via virtual env, conda env or PYTHONPATH. The easy way to know is that you need to be able to get into your environment and run in a python terminal + +```python +from pyMKIAU.core import pyMKIAU_init +pyMKIAU_init() +``` diff --git a/GEOSmkiau_GridComp/pyMKIAU/interface/interface.c b/GEOSmkiau_GridComp/pyMKIAU/interface/interface.c new file mode 100644 index 000000000..28ebad972 --- /dev/null +++ b/GEOSmkiau_GridComp/pyMKIAU/interface/interface.c @@ -0,0 +1,31 @@ +#include +#include +#include "interface.h" + +extern int pyMKIAU_interface_c_setservice() +{ + // Check magic number + int return_code = pyMKIAU_interface_py_setservices(); + + if (return_code < 0) + { + exit(return_code); + } +} + +extern int pyMKIAU_interface_c_run(a_pod_struct_t *options, const float *in_buffer, float *out_buffer) +{ + // Check magic number + if (options->mn_123456789 != 123456789) + { + printf("Magic number failed, pyMKIAU interface is broken on the C side\n"); + exit(-1); + } + + int return_code = pyMKIAU_interface_py_run(options, in_buffer, out_buffer); + + if (return_code < 0) + { + exit(return_code); + } +} diff --git a/GEOSmkiau_GridComp/pyMKIAU/interface/interface.f90 b/GEOSmkiau_GridComp/pyMKIAU/interface/interface.f90 new file mode 100644 index 000000000..c94b4a06b --- /dev/null +++ b/GEOSmkiau_GridComp/pyMKIAU/interface/interface.f90 @@ -0,0 +1,43 @@ +module pyMKIAU_interface_mod + + use iso_c_binding, only: c_int, c_float, c_double, c_bool, c_ptr + + implicit none + + private + public :: pyMKIAU_interface_f_setservice, pyMKIAU_interface_f_run + public :: a_pod_struct_type + + !----------------------------------------------------------------------- + ! See `interface.h` for explanation of the POD-strict struct + !----------------------------------------------------------------------- + type, bind(c) :: a_pod_struct_type + integer(kind=c_int) :: npx + integer(kind=c_int) :: npy + integer(kind=c_int) :: npz + ! Magic number + integer(kind=c_int) :: make_flags_C_interop = 123456789 + end type + + + interface + + subroutine pyMKIAU_interface_f_setservice() bind(c, name='pyMKIAU_interface_c_setservice') + end subroutine pyMKIAU_interface_f_setservice + + subroutine pyMKIAU_interface_f_run(options, in_buffer, out_buffer) bind(c, name='pyMKIAU_interface_c_run') + + import c_float, a_pod_struct_type + + implicit none + ! This is an interface to a C function, the intent ARE NOT enforced + ! by the compiler. Consider them developer hints + type(a_pod_struct_type), intent(in) :: options + real(kind=c_float), dimension(*), intent(in) :: in_buffer + real(kind=c_float), dimension(*), intent(out) :: out_buffer + + end subroutine pyMKIAU_interface_f_run + + end interface + +end module pyMKIAU_interface_mod diff --git a/GEOSmkiau_GridComp/pyMKIAU/interface/interface.h b/GEOSmkiau_GridComp/pyMKIAU/interface/interface.h new file mode 100644 index 000000000..ce8dfb179 --- /dev/null +++ b/GEOSmkiau_GridComp/pyMKIAU/interface/interface.h @@ -0,0 +1,40 @@ +#pragma once + +/*** + * C Header for the interface to python. + * Define here any POD-strict structures and external functions + * that will get exported by cffi from python (see interface.py) + ***/ + +#include +#include + +// POD-strict structure to pack options and flags efficiently +// Struct CANNOT hold pointers. The iso_c_binding does not allow for foolproof +// pointer memory packing. +// We use the low-embedded trick of the magic number to attempt to catch +// any type mismatch betweeen Fortran and C. This is not a foolproof method +// but it bring a modicum of check at the cost of a single integer. +typedef struct +{ + int npx; + int npy; + int npz; + // Magic number needs to be last item + int mn_123456789; +} a_pod_struct_t; + +// For complex type that can be exported with different +// types (like the MPI communication object), you can rely on C `union` +typedef union +{ + int comm_int; + void *comm_ptr; +} MPI_Comm_t; + +// Python hook functions: defined as external so that the .so can link out ot them +// Though we define `in_buffer` as a `const float*` it is _not_ enforced +// by the interface. Treat as a developer hint only. + +extern int pyMKIAU_interface_py_run(a_pod_struct_t *options, const float *in_buffer, float *out_buffer); +extern int pyMKIAU_interface_py_setservices(); diff --git a/GEOSmkiau_GridComp/pyMKIAU/interface/interface.py b/GEOSmkiau_GridComp/pyMKIAU/interface/interface.py new file mode 100644 index 000000000..c0bfc1c03 --- /dev/null +++ b/GEOSmkiau_GridComp/pyMKIAU/interface/interface.py @@ -0,0 +1,46 @@ +import cffi # type: ignore + +TMPFILEBASE = "pyMKIAU_interface_py" + +ffi = cffi.FFI() + +source = """ +from {} import ffi +from datetime import datetime +from pyMKIAU.core import pyMKIAU_init, pyMKIAU_run #< User code starts here +import traceback + +@ffi.def_extern() +def pyMKIAU_interface_py_setservices() -> int: + + try: + # Calling out off the bridge into the python + pyMKIAU_init() + except Exception as err: + print("Error in Python:") + print(traceback.format_exc()) + return -1 + return 0 + +@ffi.def_extern() +def pyMKIAU_interface_py_run(options, in_buffer, out_buffer) -> int: + + try: + # Calling out off the bridge into the python + pyMKIAU_run(options, in_buffer, out_buffer) + except Exception as err: + print("Error in Python:") + print(traceback.format_exc()) + return -1 + return 0 +""".format(TMPFILEBASE) + +with open("interface.h") as f: + data = "".join([line for line in f if not line.startswith("#")]) + data = data.replace("CFFI_DLLEXPORT", "") + ffi.embedding_api(data) + +ffi.set_source(TMPFILEBASE, '#include "interface.h"') + +ffi.embedding_init_code(source) +ffi.compile(target="lib" + TMPFILEBASE + ".so", verbose=True) diff --git a/GEOSmkiau_GridComp/pyMKIAU/pyMKIAU/__init__.py b/GEOSmkiau_GridComp/pyMKIAU/pyMKIAU/__init__.py new file mode 100644 index 000000000..e69de29bb diff --git a/GEOSmkiau_GridComp/pyMKIAU/pyMKIAU/core.py b/GEOSmkiau_GridComp/pyMKIAU/pyMKIAU/core.py new file mode 100644 index 000000000..c3f9684d4 --- /dev/null +++ b/GEOSmkiau_GridComp/pyMKIAU/pyMKIAU/core.py @@ -0,0 +1,74 @@ +from _cffi_backend import _CDataBase as CFFIObj # type: ignore +import dataclasses +from pyMKIAU.f_py_conversion import FortranPythonConversion +from pyMKIAU.cuda_profiler import TimedCUDAProfiler +import numpy as np +from typing import Dict, List + + +@dataclasses.dataclass +class FPYOptions: + npx: int = 0 + npy: int = 0 + npz: int = 0 + mn_123456789: int = 0 + + +def options_fortran_to_python( + f_options: CFFIObj, +) -> FPYOptions: + if f_options.mn_123456789 != 123456789: # type:ignore + raise RuntimeError( + "Magic number failed, pyMoist interface is broken on the python side" + ) + + py_flags = FPYOptions() + keys = list(filter(lambda k: not k.startswith("__"), dir(type(py_flags)))) + for k in keys: + if hasattr(f_options, k): + setattr(py_flags, k, getattr(f_options, k)) + return py_flags + + +F_PY_MEMORY_CONV = None + + +def pyMKIAU_init(): + print("[pyMKIAU] Init called") + + +def pyMKIAU_run( + f_options: CFFIObj, + f_in_buffer: CFFIObj, + f_out_buffer: CFFIObj, +): + print("[pyMKIAU] Run called") + options = options_fortran_to_python(f_options) + print(f"[pyMKIAU] Options: {options}") + + # Dev Note: this should be doen better in it's own class + # and the `np` should be driven by the user code requirements + # for GPU or CPU memory + global F_PY_MEMORY_CONV + if F_PY_MEMORY_CONV is None: + F_PY_MEMORY_CONV = FortranPythonConversion( + options.npx, + options.npy, + options.npz, + np, + ) + + # Move memory into a manipulable numpy array + in_buffer = F_PY_MEMORY_CONV.fortran_to_python(f_in_buffer) + out_buffer = F_PY_MEMORY_CONV.fortran_to_python(f_out_buffer) + + # Here goes math and dragons + timings: Dict[str, List[float]] = {} + with TimedCUDAProfiler("pyMKIAU bogus math", timings): + out_buffer[:, :, :] = in_buffer[:, :, :] * 2 + + print(f"[pyMKIAU] At 5,5,5 in python OUT is: {out_buffer[5,5,5]}") + print(f"[pyMKIAU] Timers: {timings}") + + # Go back to fortran + F_PY_MEMORY_CONV.python_to_fortran(out_buffer, f_out_buffer) diff --git a/GEOSmkiau_GridComp/pyMKIAU/pyMKIAU/cuda_profiler.py b/GEOSmkiau_GridComp/pyMKIAU/pyMKIAU/cuda_profiler.py new file mode 100644 index 000000000..5a6e41a71 --- /dev/null +++ b/GEOSmkiau_GridComp/pyMKIAU/pyMKIAU/cuda_profiler.py @@ -0,0 +1,76 @@ +import time +from typing import Dict, List + + +# Conditional cupy import for non-GPU machines +try: + import cupy as cp +except ModuleNotFoundError: + cp = None + +# Run a deviceSynchronize() to check +# that the GPU is present and ready to run +if cp is not None: + try: + cp.cuda.runtime.deviceSynchronize() + GPU_AVAILABLE = True + except cp.cuda.runtime.CUDARuntimeError: + GPU_AVAILABLE = False +else: + GPU_AVAILABLE = False + + +class CUDAProfiler: + """Leverages NVTX & NSYS to profile CUDA kernels.""" + + def __init__(self, label: str) -> None: + self.label = label + + def __enter__(self): + if GPU_AVAILABLE: + cp.cuda.runtime.deviceSynchronize() + cp.cuda.nvtx.RangePush(self.label) + + def __exit__(self, _type, _val, _traceback): + if GPU_AVAILABLE: + cp.cuda.runtime.deviceSynchronize() + cp.cuda.nvtx.RangePop() + + @classmethod + def sync_device(cls): + if GPU_AVAILABLE: + cp.cuda.runtime.deviceSynchronize() + + @classmethod + def start_cuda_profiler(cls): + if GPU_AVAILABLE: + cp.cuda.profiler.start() + + @classmethod + def stop_cuda_profiler(cls): + if GPU_AVAILABLE: + cp.cuda.profiler.stop() + + @classmethod + def mark_cuda_profiler(cls, message: str): + if GPU_AVAILABLE: + cp.cuda.nvtx.Mark(message) + + +class TimedCUDAProfiler(CUDAProfiler): + def __init__(self, label: str, timings: Dict[str, List[float]]) -> None: + super().__init__(label) + self._start_time = 0 + self._timings = timings + + def __enter__(self): + super().__enter__() + self._start_time = time.perf_counter() + + def __exit__(self, _type, _val, _traceback): + super().__exit__(_type, _val, _traceback) + t = time.perf_counter() - self._start_time + if self.label not in self._timings: + self._timings[self.label] = [t] + else: + self._timings[self.label].append(t) diff --git a/GEOSmkiau_GridComp/pyMKIAU/pyMKIAU/f_py_conversion.py b/GEOSmkiau_GridComp/pyMKIAU/pyMKIAU/f_py_conversion.py new file mode 100644 index 000000000..47a17e731 --- /dev/null +++ b/GEOSmkiau_GridComp/pyMKIAU/pyMKIAU/f_py_conversion.py @@ -0,0 +1,219 @@ +from math import prod +from types import ModuleType +from typing import List, Optional, Tuple, TypeAlias + +import cffi +import numpy as np + +# Conditional cupy import for non-GPU machines +try: + import cupy as cp +except ModuleNotFoundError: + cp = None + + +# Dev note: we would like to use cp.ndarray for Device and +# Union of np and cp ndarray for Python but we can't +# because cp might not be importable! +DeviceArray: TypeAlias = np.ndarray +PythonArray: TypeAlias = np.ndarray + +# Default floating point cast +BaseFloat = np.float32 + + +class NullStream: + def __init__(self): + pass + + def synchronize(self): + pass + + def __enter__(self): + pass + + def __exit__(self, exc_type, exc_value, traceback): + pass + + +class FortranPythonConversion: + """ + Convert Fortran arrays to NumPy and vice-versa + """ + + def __init__( + self, + npx: int, + npy: int, + npz: int, + numpy_module: ModuleType, + ): + # Python numpy-like module is given by the caller leaving + # optional control of upload/download in the case + # of GPU/CPU system + self._target_np = numpy_module + + # Device parameters + # Pace targets gpu: we want the Pace layout to be on device + self._python_targets_gpu = self._target_np == cp + if self._python_targets_gpu: + self._stream_A = cp.cuda.Stream(non_blocking=True) + self._stream_B = cp.cuda.Stream(non_blocking=True) + else: + self._stream_A = NullStream() + self._stream_B = NullStream() + self._current_stream = self._stream_A + + # Layout & indexing + self._npx, self._npy, self._npz = npx, npy, npz + + # cffi init + self._ffi = cffi.FFI() + self._TYPEMAP = { + "float": np.float32, + "double": np.float64, + "int": np.int32, + } + + def device_sync(self): + """Synchronize the working CUDA streams""" + self._stream_A.synchronize() + self._stream_B.synchronize() + + def _fortran_to_numpy( + self, + fptr: "cffi.FFI.CData", + dim: Optional[List[int]] = None, + ) -> np.ndarray: + """ + Input: Fortran data pointed to by fptr and of shape dim = (i, j, k) + Output: C-ordered double precision NumPy data of shape (i, j, k) + """ + if not dim: + dim = [self._npx, self._npy, self._npz] + ftype = self._ffi.getctype(self._ffi.typeof(fptr).item) + assert ftype in self._TYPEMAP + return np.frombuffer( + self._ffi.buffer(fptr, prod(dim) * self._ffi.sizeof(ftype)), + self._TYPEMAP[ftype], + ) + + def _upload_and_transform( + self, + host_array: np.ndarray, + dim: Optional[List[int]] = None, + swap_axes: Optional[Tuple[int, int]] = None, + ) -> DeviceArray: + """Upload to device & transform to Pace compatible layout""" + with self._current_stream: + device_array = cp.asarray(host_array) + final_array = self._transform_from_fortran_layout( + device_array, + dim, + swap_axes, + ) + self._current_stream = ( + self._stream_A + if self._current_stream == self._stream_B + else self._stream_B + ) + return final_array + + def _transform_from_fortran_layout( + self, + array: PythonArray, + dim: Optional[List[int]] = None, + swap_axes: Optional[Tuple[int, int]] = None, + ) -> PythonArray: + """Transform from Fortran layout into a Pace compatible layout""" + if not dim: + dim = [self._npx, self._npy, self._npz] + trf_array = array.reshape(tuple(reversed(dim))).transpose().astype(BaseFloat) + if swap_axes: + trf_array = self._target_np.swapaxes( + trf_array, + swap_axes[0], + swap_axes[1], + ) + return trf_array + + def fortran_to_python( + self, + fptr: "cffi.FFI.CData", + dim: Optional[List[int]] = None, + swap_axes: Optional[Tuple[int, int]] = None, + ) -> PythonArray: + """Move fortran memory into python space""" + np_array = self._fortran_to_numpy(fptr, dim) + if self._python_targets_gpu: + return self._upload_and_transform(np_array, dim, swap_axes) + else: + return self._transform_from_fortran_layout( + np_array, + dim, + swap_axes, + ) + + def _transform_and_download( + self, + device_array: DeviceArray, + dtype: type, + swap_axes: Optional[Tuple[int, int]] = None, + ) -> np.ndarray: + with self._current_stream: + if swap_axes: + device_array = cp.swapaxes( + device_array, + swap_axes[0], + swap_axes[1], + ) + host_array = cp.asnumpy( + device_array.astype(dtype).flatten(order="F"), + ) + self._current_stream = ( + self._stream_A + if self._current_stream == self._stream_B + else self._stream_B + ) + return host_array + + def _transform_from_python_layout( + self, + array: PythonArray, + dtype: type, + swap_axes: Optional[Tuple[int, int]] = None, + ) -> np.ndarray: + """Copy back a numpy array in python layout to Fortran""" + + if self._python_targets_gpu: + numpy_array = self._transform_and_download(array, dtype, swap_axes) + else: + numpy_array = array.astype(dtype).flatten(order="F") + if swap_axes: + numpy_array = np.swapaxes( + numpy_array, + swap_axes[0], + swap_axes[1], + ) + return numpy_array + + def python_to_fortran( + self, + array: PythonArray, + fptr: "cffi.FFI.CData", + ptr_offset: int = 0, + swap_axes: Optional[Tuple[int, int]] = None, + ) -> np.ndarray: + """ + Input: Fortran data pointed to by fptr and of shape dim = (i, j, k) + Output: C-ordered double precision NumPy data of shape (i, j, k) + """ + ftype = self._ffi.getctype(self._ffi.typeof(fptr).item) + assert ftype in self._TYPEMAP + dtype = self._TYPEMAP[ftype] + numpy_array = self._transform_from_python_layout( + array, + dtype, + swap_axes, + ) + self._ffi.memmove(fptr + ptr_offset, numpy_array, 4 * numpy_array.size) diff --git a/GEOSmkiau_GridComp/pyMKIAU/setup.py b/GEOSmkiau_GridComp/pyMKIAU/setup.py new file mode 100644 index 000000000..851e0b1b6 --- /dev/null +++ b/GEOSmkiau_GridComp/pyMKIAU/setup.py @@ -0,0 +1,33 @@ +#!/usr/bin/env python +# -*- coding: utf-8 -*- + +"""pyMKIAU - python sub-component of GEOS MKIAU.""" + +from setuptools import find_namespace_packages, setup + + +with open("README.md", encoding="utf-8") as readme_file: + readme = readme_file.read() + +setup( + author="NASA", + python_requires=">=3.11", + classifiers=[ + "Development Status :: 2 - Pre-Alpha", + "Intended Audience :: Developers", + "License :: OSI Approved :: Apache 2 License", + "Natural Language :: English", + "Programming Language :: Python :: 3.11", + ], + description=("pyMKIAU - python sub-component of GEOS MKIAU."), + install_requires=[], + extras_require={}, + long_description=readme, + include_package_data=True, + name="pyMKIAU", + packages=find_namespace_packages(include=["pyMKIAU", "pyMKIAU.*"]), + setup_requires=[], + url="https://github.com/GEOS-ESM/GEOSgcm_GridComp", + version="0.0.0", + zip_safe=False, +) From fc85026137bc914b9db81e1065e4c9ee8e16048b Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Mon, 2 Dec 2024 14:47:54 -0500 Subject: [PATCH 54/73] Fixed the RUNOFF logic. In particular, the conditions for allocating and initialing RUNOFFTILE --- .../GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 index f04f7110c..a5aa010e1 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 @@ -6052,6 +6052,7 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) real, allocatable :: PRECSUM(:,:) character(len=ESMF_MAXPATHLEN) :: SolCycFileName logical :: PersistSolar + logical :: allocateRunoff !============================================================================= @@ -7366,12 +7367,19 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MKTILE(LWNDSRF ,LWNDSRFTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(SWNDSRF ,SWNDSRFTILE ,NT,RC=STATUS); VERIFY_(STATUS) + allocateRunoff = .false. + if (associated(RUNOFF)) allocateRunoff = .true. + if (associated(SURF_INTERNAL_STATE%RoutingType) .or. DO_DATA_ATM4OCN) then ! routing file exists or we run DataAtm allocate(DISCHARGETILE(NT),stat=STATUS); VERIFY_(STATUS) DISCHARGETILE=MAPL_Undef + allocateRunoff = .true. + end if + if (allocateRunoff) then allocate(RUNOFFTILE(NT),stat=STATUS); VERIFY_(STATUS) - RUNOFFTILE=MAPL_Undef + RUNOFFTILE = 0.0 end if + call MKTILE(RUNSURF ,RUNSURFTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(BASEFLOW,BASEFLOWTILE,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(ACCUM ,ACCUMTILE ,NT,RC=STATUS); VERIFY_(STATUS) @@ -7514,8 +7522,6 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Cycle through all continental children (skip ocean), ! collecting RUNOFFTILE exports. - if (associated(RUNOFFTILE)) RUNOFFTILE = 0.0 - do I = 1, NUM_CHILDREN if (I == OCEAN) cycle call DOTYPE(I,RC=STATUS) From 6e5c1e4436746c5a73f7e614012d37b65ef5d856 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 3 Dec 2024 22:40:14 -0500 Subject: [PATCH 55/73] Three vcoords are working --- GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 | 9 +- .../GEOS_SuperdynGridComp.F90 | 9 + .../GEOS_GigatrajGridComp.F90 | 136 +++---- GEOSgigatraj_GridComp/Gigatraj_Utils.F90 | 370 +++++++++++++----- 4 files changed, 363 insertions(+), 161 deletions(-) diff --git a/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 b/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 index 48a061ff2..26d96fdc2 100644 --- a/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 +++ b/GEOSagcm_GridComp/GEOS_AgcmGridComp.F90 @@ -792,12 +792,12 @@ subroutine SetServices ( GC, RC ) #ifdef HAS_GIGATRAJ call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'OMEGA', & + SHORT_NAME = 'PL', & CHILD_ID = SDYN, & RC = STATUS) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'PL', & + SHORT_NAME = 'OMEGA', & CHILD_ID = SDYN, & RC = STATUS) VERIFY_(STATUS) @@ -811,6 +811,11 @@ subroutine SetServices ( GC, RC ) CHILD_ID = SDYN, & RC = STATUS) VERIFY_(STATUS) + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'ZL', & + CHILD_ID = SDYN, & + RC = STATUS) + VERIFY_(STATUS) #endif call MAPL_AddExportSpec( GC, & diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOS_SuperdynGridComp.F90 b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOS_SuperdynGridComp.F90 index 670b5fa9c..9d10e6eaf 100644 --- a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOS_SuperdynGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/GEOS_SuperdynGridComp.F90 @@ -274,6 +274,15 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) +#ifdef HAS_GIGATRAJ + call MAPL_AddExportSpec ( GC , & + SHORT_NAME = 'ZL', & + CHILD_ID = DYN, & + RC=STATUS ) + VERIFY_(STATUS) +#endif + + call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'PREF', & CHILD_ID = DYN, & diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index 73eb5ec85..7843b038d 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -13,41 +13,6 @@ module GEOS_GigatrajGridCompMod public :: SetServices - private - type horde - integer :: num_parcels - integer, allocatable :: IDS(:) - real, allocatable :: lats(:), lons(:), zs(:) - end type - - type GigaTrajInternal - integer :: npes - integer :: npz ! number of pressure levels - type (ESMF_Grid) :: LatLonGrid - type (ESMF_Grid) :: CubedGrid - class (AbstractRegridder), pointer :: cube2latlon => null() - integer, allocatable :: CellToRank(:,:) - type(horde) :: parcels - type(c_ptr) :: metSrc - type(ESMF_Time) :: startTime - type(ESMF_TimeInterval) :: Integrate_DT - character(len=ESMF_MAXSTR), allocatable :: ExtraFieldNames(:) - character(len=ESMF_MAXSTR), allocatable :: ExtraCompNames(:) - character(len=ESMF_MAXSTR), allocatable :: ExtrabundleNames(:) - character(len=ESMF_MAXSTR), allocatable :: ExtraAliasNames(:) - - character(len=:), allocatable :: vCoord - character(len=:), allocatable :: vAlias - character(len=:), allocatable :: vTendency - - logical :: regrid_to_latlon - end type - - type GigatrajInternalWrap - type (GigaTrajInternal), pointer :: PTR - end type - - contains subroutine SetServices ( GC, RC ) @@ -256,16 +221,11 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) GigaTrajInternalPtr%vAlias = trim(aName(1)) select case(GigaTrajInternalPtr%vCoord) case ('PL') - levs_center = [1000., 975., 950., 925., 900., 875., 850., 825., 800., 775., 750., 725.,700., 650., 600., 550., 500., & - 450., 400., 350., 300., 250., 200., 150., 100., 70., 50., 40., 30., 20., 10., 7., 5., 4., 3., 2., & - 1., 0.7, 0.5, 0.4, 0.3, 0.2, 0.1, 0.07, 0.05, 0.04, 0.03, 0.02]*100 GigaTrajInternalPtr%vTendency = 'OMEGA' case('TH') - levs_center = [4999., 4708., 4434., 4175., 3932., 3703., 3487., 3284., 3092., 2912., 2742., 2582., 2432., 2290., 2157., & - 2031., 1912., 1801., 1696., 1597., 1504., 1416., 1334., 1256., 1183., 1114., 1049., 988. , 930. , 876., & - 825. , 777. , 731., 689., 649., 611., 575., 542., 510., 480., 452., 426., 401. , 378. , 356. , & - 335. , 315. , 297., 279.] GigaTrajInternalPtr%vTendency = 'DTDTDYN' + case('ZL') + GigaTrajInternalPtr%vTendency = 'W' case default _ASSERT(.false., "vertical coordinate is needed") end select @@ -389,21 +349,6 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) GigaTrajInternalPtr%CellToRank(I1:I2,J1:J2) = rank enddo - call MAPL_Grid_interior(Grid_,i1,i2,j1,j2) - if (GigaTrajInternalPtr%regrid_to_latlon) then - GigaTrajInternalPtr%metSrc = initMetGEOSDistributedLatLonData(comm, c_loc(GigaTrajInternalPtr%CellToRank), DIMS(1), DIMS(2), & - npz, counts(1)+2, counts(2)+2, npz, & - c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), c_loc(ctime)) - deallocate(lons_center, lats_center,levs_center) - else - GigaTrajInternalPtr%metSrc = initMetGEOSDistributedCubedData(comm, c_loc(GigaTrajInternalPtr%CellToRank), DIMS(1), & - npz, i1, i2, j1, j2, npz, & - c_loc(cube_lons_center), c_loc(cube_lats_center), c_loc(levs_center), c_loc(ctime)) - - deallocate(cube_lons_center, cube_lats_center,levs_center) - - endif - call read_parcels(GC, GigaTrajInternalPtr, _RC) call MAPL_TimerOff(MPL,"INITIALIZE") @@ -536,10 +481,18 @@ subroutine Init_metsrc_field0 (GC, state, ctime, RC ) real, dimension(:,:,:), pointer :: U, V, W, P, PL0, PLE, TH real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon, P_latlon real, dimension(:,:,:), allocatable, target :: haloU, haloV, haloW, haloP - integer :: counts(3), dims(3), d1,d2,km,lm, i1,i2,j1,j2 + integer :: counts(3), dims(3), d1,d2,km,lm, i1,i2,j1,j2,i + real, allocatable, target :: lats_center(:), lons_center(:), levs_center(:) + real, allocatable, target :: cube_lats_center(:, :), cube_lons_center(:,:) + integer :: comm + real :: delt, High, low + type(ESMF_VM) :: vm + type(ESMF_Grid) :: grid_ Iam = "init_metsrc_field0" + call ESMF_VMGetCurrent(vm, _RC) + call ESMF_VMGet(vm, mpiCommunicator=comm, _RC) call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, _RC) GigaTrajInternalPtr => wrap%ptr @@ -549,26 +502,66 @@ subroutine Init_metsrc_field0 (GC, state, ctime, RC ) call MAPL_GetPointer(state, P, trim(GigaTrajInternalPtr%vCoord), _RC) if (GigaTrajInternalPtr%regrid_to_latlon) then - call MAPL_GridGet(GigaTrajInternalPtr%LatLonGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) + grid_ = GigaTrajInternalPtr%LatLonGrid else - call MAPL_GridGet(GigaTrajInternalPtr%CubedGrid, localCellCountPerDim=counts,globalCellCountPerDim=DIMS, _RC) + grid_ = GigaTrajInternalPtr%CubedGrid endif - lm =size(U,3) - d1 =size(U,1) - d2 =size(U,2) + call MAPL_GridGet( grid_, localCellCountPerDim=counts, globalCellCountPerDim=dims, _RC) + + select case ( trim(GigaTrajInternalPtr%vCoord)) + case ("PL") + High = 100000. + Low = 2. + case ("TH") + High = 5000. + Low = 200. + case ("ZL") + High = 78000. + Low = 1. + end select + + delt = (log(High)-log(low))/dims(3) + levs_center=[(exp(log(High)-(i-1)*delt), i=1, dims(3))] + + if (MAPL_AM_I_ROOT()) then + do i = 1, dims(3) + print*, levs_center(i) + enddo + endif + if (GigaTrajInternalPtr%regrid_to_latlon) then + call get_latlon_centers(gc, lons_center, lats_center, _RC) + GigaTrajInternalPtr%metSrc = initMetGEOSDistributedLatLonData(comm, c_loc(GigaTrajInternalPtr%CellToRank), DIMS(1), DIMS(2), & + dims(3), counts(1)+2, counts(2)+2, dims(3), & + c_loc(lons_center), c_loc(lats_center), c_loc(levs_center), c_loc(ctime)) + deallocate(lons_center, lats_center) + else + call MAPL_Grid_interior(grid_, i1, i2, j1, j2) + call get_cube_centers(gc, cube_lons_center, cube_lats_center, _RC) + GigaTrajInternalPtr%metSrc = initMetGEOSDistributedCubedData(comm, c_loc(GigaTrajInternalPtr%CellToRank), DIMS(1), & + dims(3), i1, i2, j1, j2, dims(3), & + c_loc(cube_lons_center), c_loc(cube_lats_center), c_loc(levs_center), c_loc(ctime)) - allocate(haloU(counts(1)+2, counts(2)+2,lm), source = 0.0) - allocate(haloV(counts(1)+2, counts(2)+2,lm), source = 0.0) - allocate(haloW(counts(1)+2, counts(2)+2,lm), source = 0.0) - allocate(haloP(counts(1)+2, counts(2)+2,lm), source = 0.0) + deallocate(cube_lons_center, cube_lats_center) + + endif + deallocate(levs_center) + + lm = dims(3) + d1 = counts(1) + d2 = counts(2) + + allocate(haloU(d1+2, d2+2,lm), source = 0.0) + allocate(haloV(d1+2, d2+2,lm), source = 0.0) + allocate(haloW(d1+2, d2+2,lm), source = 0.0) + allocate(haloP(d1+2, d2+2,lm), source = 0.0) if ( GigaTrajInternalPtr%regrid_to_latlon) then - allocate(U_latlon(counts(1),counts(2),lm)) - allocate(V_latlon(counts(1),counts(2),lm)) - allocate(W_latlon(counts(1),counts(2),lm)) - allocate(P_latlon(counts(1),counts(2),lm)) + allocate(U_latlon(d1,d2,lm)) + allocate(V_latlon(d1,d2,lm)) + allocate(W_latlon(d1,d2,lm)) + allocate(P_latlon(d1,d2,lm)) call GigaTrajInternalPtr%cube2latlon%regrid(U, V, U_latlon, V_latlon, _RC) call GigaTrajInternalPtr%cube2latlon%regrid(W, W_latlon, _RC) call GigaTrajInternalPtr%cube2latlon%regrid(P, P_latlon, _RC) @@ -623,6 +616,7 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) real, dimension(:,:,:), pointer :: U_cube, V_cube, W_cube, P_cube, PLE_Cube, with_halo real, dimension(:,:,:), pointer :: internal_field, model_field + real, dimension(:,:,:), pointer :: tmp_ptr real, dimension(:,:,:), allocatable :: U_latlon, V_latlon, W_latlon, P_latlon real, dimension(:,:,:), allocatable :: U_inter, V_inter, W_inter, P_inter diff --git a/GEOSgigatraj_GridComp/Gigatraj_Utils.F90 b/GEOSgigatraj_GridComp/Gigatraj_Utils.F90 index 1921e4195..5b13e8700 100644 --- a/GEOSgigatraj_GridComp/Gigatraj_Utils.F90 +++ b/GEOSgigatraj_GridComp/Gigatraj_Utils.F90 @@ -1,98 +1,292 @@ +#include "MAPL_Generic.h" + module Gigatraj_UtilsMod + use, intrinsic :: iso_c_binding, only : c_int, c_ptr, c_null_ptr, c_associated, c_null_char + use, intrinsic :: iso_c_binding, only : c_loc + + use ESMF use MAPL + use mpi implicit none public :: parseCompsAndFieldsName public :: create_new_vars + public :: get_levels + public :: get_latlon_centers + public :: get_cube_centers + public :: horde + public :: GigaTrajInternal + public :: GigatrajInternalWrap + + type horde + integer :: num_parcels + integer, allocatable :: IDS(:) + real, allocatable :: lats(:), lons(:), zs(:) + end type + + type GigaTrajInternal + integer :: npes + integer :: npz ! number of pressure levels + type (ESMF_Grid) :: LatLonGrid + type (ESMF_Grid) :: CubedGrid + class (AbstractRegridder), pointer :: cube2latlon => null() + integer, allocatable :: CellToRank(:,:) + type(horde) :: parcels + type(c_ptr) :: metSrc + type(ESMF_Time) :: startTime + type(ESMF_TimeInterval) :: Integrate_DT + character(len=ESMF_MAXSTR), allocatable :: ExtraFieldNames(:) + character(len=ESMF_MAXSTR), allocatable :: ExtraCompNames(:) + character(len=ESMF_MAXSTR), allocatable :: ExtrabundleNames(:) + character(len=ESMF_MAXSTR), allocatable :: ExtraAliasNames(:) + + character(len=:), allocatable :: vCoord + character(len=:), allocatable :: vAlias + character(len=:), allocatable :: vTendency + + logical :: regrid_to_latlon + end type + + type GigatrajInternalWrap + type (GigaTrajInternal), pointer :: PTR + end type contains - subroutine parseCompsAndFieldsName(fields_line, CompNames, BundleNames, FieldNames, AliasNames) - character(*), intent(in) :: fields_line - character(len=ESMF_MAXSTR), allocatable, intent(out) :: CompNames(:) - character(len=ESMF_MAXSTR), allocatable, intent(out) :: BundleNames(:) - character(len=ESMF_MAXSTR), allocatable, intent(out) :: FieldNames(:) - character(len=ESMF_MAXSTR), allocatable, intent(out) :: AliasNames(:) - integer :: num_field, i, j, k, l, endl, num_ - character(len=:), allocatable :: tmp, tmp_bnf, tmp_f, tmp_alias - num_field = 1 - k = 1 - do - i = index(fields_line(k:),';') - if (i == 0) exit - if (trim(fields_line(i+1:)) =='') exit ! take care of the last unnecessay ";" - k = k+i - num_field = num_field+1 - enddo - - allocate(Fieldnames(num_field)) - allocate(Compnames(num_field)) - allocate(BundleNames(num_field)) - allocate(AliasNames(num_field)) - - k = 1 - num_ = 1 - - do - i = index(fields_line(k:),';') - if (i == 0) then - endl = len(fields_line) - else - endl = (k-1)+i-1 - endif - tmp = fields_line(k:endl) - - j = index(tmp, '%%') - if (j == 0) print*, "Wrong format of the comp%%field" - Compnames(num_) = trim(adjustl(tmp(1:j-1))) - tmp_bnf = trim(adjustl(tmp(j+2:))) - - l = index(tmp_bnf, '%') - if (l /=0) then - BundleNames(num_) = tmp_bnf(1:l-1) - tmp_f = tmp_bnf(l+1:) - else - BundleNames(num_) = 'NONE' - tmp_f = tmp_bnf - endif - - ! Aliasing....., Hard coded here - l = index(tmp_f, '|') - if (l /=0) then - FieldNames(num_) = tmp_f(1:l-1) - tmp_alias = tmp_f(l+1:) - else - FieldNames(num_) = tmp_f - tmp_alias = tmp_f - endif - - AliasNames(num_) = tmp_alias - - num_ = num_ + 1 - k = endl + 2 - if (num_ > num_field) exit - enddo - end subroutine parseCompsAndFieldsName - - subroutine create_new_vars(meta, formatter, long_name, short_name, units) - type(FileMetadata), intent(inout) :: meta - type(Netcdf4_fileformatter), intent(inout) :: formatter - character(*), intent(in) :: long_name - character(*), intent(in) :: short_name - character(*), intent(in) :: units - type(Variable) :: var - character(len=:), allocatable :: var_name - if (MAPL_AM_I_Root()) then - if( meta%has_variable(short_name)) return - var_name = short_name - var = variable(type=pFIO_REAL32, dimensions='id,time') - call var%add_attribute('long_name', long_name) - call var%add_attribute('units', units) - call var%add_attribute('positive', "up") - call var%add_attribute('_FillValue', -999.99) - call var%add_attribute('missing_value', -999.99) - call meta%add_variable(var_name, var) - call formatter%add_variable(meta, short_name) - endif - end subroutine create_new_vars + subroutine parseCompsAndFieldsName(fields_line, CompNames, BundleNames, FieldNames, AliasNames) + character(*), intent(in) :: fields_line + character(len=ESMF_MAXSTR), allocatable, intent(out) :: CompNames(:) + character(len=ESMF_MAXSTR), allocatable, intent(out) :: BundleNames(:) + character(len=ESMF_MAXSTR), allocatable, intent(out) :: FieldNames(:) + character(len=ESMF_MAXSTR), allocatable, intent(out) :: AliasNames(:) + integer :: num_field, i, j, k, l, endl, num_ + character(len=:), allocatable :: tmp, tmp_bnf, tmp_f, tmp_alias + num_field = 1 + k = 1 + do + i = index(fields_line(k:),';') + if (i == 0) exit + if (trim(fields_line(i+1:)) =='') exit ! take care of the last unnecessay ";" + k = k+i + num_field = num_field+1 + enddo + + allocate(Fieldnames(num_field)) + allocate(Compnames(num_field)) + allocate(BundleNames(num_field)) + allocate(AliasNames(num_field)) + + k = 1 + num_ = 1 + + do + i = index(fields_line(k:),';') + if (i == 0) then + endl = len(fields_line) + else + endl = (k-1)+i-1 + endif + tmp = fields_line(k:endl) + + j = index(tmp, '%%') + if (j == 0) print*, "Wrong format of the comp%%field" + Compnames(num_) = trim(adjustl(tmp(1:j-1))) + tmp_bnf = trim(adjustl(tmp(j+2:))) + + l = index(tmp_bnf, '%') + if (l /=0) then + BundleNames(num_) = tmp_bnf(1:l-1) + tmp_f = tmp_bnf(l+1:) + else + BundleNames(num_) = 'NONE' + tmp_f = tmp_bnf + endif + + ! Aliasing....., Hard coded here + l = index(tmp_f, '|') + if (l /=0) then + FieldNames(num_) = tmp_f(1:l-1) + tmp_alias = tmp_f(l+1:) + else + FieldNames(num_) = tmp_f + tmp_alias = tmp_f + endif + + AliasNames(num_) = tmp_alias + + num_ = num_ + 1 + k = endl + 2 + if (num_ > num_field) exit + enddo + end subroutine parseCompsAndFieldsName + + subroutine create_new_vars(meta, formatter, long_name, short_name, units) + type(FileMetadata), intent(inout) :: meta + type(Netcdf4_fileformatter), intent(inout) :: formatter + character(*), intent(in) :: long_name + character(*), intent(in) :: short_name + character(*), intent(in) :: units + type(Variable) :: var + character(len=:), allocatable :: var_name + if (MAPL_AM_I_Root()) then + if( meta%has_variable(short_name)) return + var_name = short_name + var = variable(type=pFIO_REAL32, dimensions='id,time') + call var%add_attribute('long_name', long_name) + call var%add_attribute('units', units) + call var%add_attribute('positive', "up") + call var%add_attribute('_FillValue', -999.99) + call var%add_attribute('missing_value', -999.99) + call meta%add_variable(var_name, var) + call formatter%add_variable(meta, short_name) + endif + end subroutine create_new_vars + + subroutine get_levels(P, func, levels, rc) + real, dimension(:,:,:), intent(in) :: P + character(*), intent(in) :: func + real, dimension(:), intent(out) :: levels + integer, optional, intent(out) :: rc + logical :: positive + type (ESMF_VM) :: vm + integer :: comm, lm, status, i, ll + real :: local_min_val, local_max_val, lev01, levLm, delt + real, allocatable :: temp(:,:) + character(:), allocatable :: Iam + + Iam = "get_levels" + + lm = size(P,3) + + call ESMF_VMgetCurrent(vm) + call ESMF_VMGet(vm, mpiCommunicator = comm, rc = status) + positive = P(1,1,1) < P(1,1,2) + print*, "wjiang:positive", positive + if (positive) then + local_min_val = maxval(P(:,:,1)) + print*, "local_min_val:", local_max_val + call MPI_Allreduce(lev01, local_min_val,1, MPI_FLOAT, MPI_MIN, comm, status) + temp = P(:,:,lm) + where(temp >= MAPL_UNDEF) temp = -MAPL_UNDEF + local_max_val = maxval(temp) + print*, "local_max_val:", local_max_val + call MPI_Allreduce(levLm, local_max_val,1, MPI_FLOAT, MPI_MAX, comm, status) + else + local_min_val = minval(P(:,:,lm)) + print*, "local_min_val:", local_max_val + call MPI_Allreduce(levLm, local_min_val,1, MPI_FLOAT, MPI_MIN, comm, status) + temp = P(:,:,1) + where(temp >= MAPL_UNDEF) temp = -MAPL_UNDEF + local_max_val = maxval(temp) + print*, "local_max_val:", local_max_val + call MPI_Allreduce(lev01, local_max_val,1, MPI_FLOAT, MPI_MAX, comm, status) + endif + + ll = size(levels) + + if (trim(func) == 'log') then + delt = (log(levLm)-log(lev01))/(lm-1) + levels =[ (exp(log(lev01)+i*delt), i=0, ll-1)] + else + delt = (levLm-lev01)/(lm-1) + levels =[ (lev01 + i*delt, i=0, ll-1)] + endif + + end subroutine get_levels + + subroutine get_cube_centers(GC, lon_center, lat_center, rc) + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + real, allocatable, intent(out) :: lat_center(:,:), lon_center(:,:) + integer, optional, intent( out) :: RC + integer :: i1, i2, j1, j2, imc, jmc, status + real(ESMF_KIND_R8), pointer :: centerX(:,:) + real(ESMF_KIND_R8), pointer :: centerY(:,:) + real(ESMF_KIND_R8), pointer :: ptr(:,:) + type(ESMF_Field) :: field + type(ESMF_RouteHandle) :: rh + type (GigaTrajInternal), pointer :: GigaTrajInternalPtr + type (GigatrajInternalWrap) :: wrap + type(ESMF_Grid) :: grid_ + character(:), allocatable :: Iam + Iam="get_cube_centers,cube with halo" + + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, status); _VERIFY(STATUS) + GigaTrajInternalPtr => wrap%ptr + grid_ = GigaTrajInternalPtr%CubedGrid + call MAPL_Grid_interior(Grid_, i1,i2,j1,j2) + imc = i2-i1 + 1 + jmc = j2-j1 + 1 + + allocate(lon_center(imc+2, jmc+2)) + allocate(lat_center(imc+2, jmc+2)) + + field = ESMF_FieldCreate(Grid_, ESMF_TYPEKIND_R8, name='halo', staggerLoc=ESMF_STAGGERLOC_CENTER,totalLWidth=[1,1],totalUWidth=[1,1],_RC) + call ESMF_FieldGet(field,farrayPtr=ptr,_RC) + ptr = 0.0d0 + call ESMF_FieldHaloStore(field,rh,_RC) + + call ESMF_GridGetCoord(grid_ , coordDim=1, localDE=0, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=centerX, _RC) + + ptr(1:imc,1:jmc)=centerX + call ESMF_FieldHalo(field,rh, _RC) + lon_center = ptr + + call ESMF_GridGetCoord(grid_ , coordDim=2, localDE=0, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=centerY, _RC) + ptr = 0.0d0 + ptr(1:imc,1:jmc)=centerY + call ESMF_FieldHalo(field,rh, _RC) + lat_center = ptr + + lon_center = lon_center/MAPL_PI*180.0 + lat_center = lat_center/MAPL_PI*180.0 + where (lon_center < -180.) lon_center = lon_center + 360. + where (lon_center > 180.) lon_center = lon_center - 360. + call ESMF_FieldDestroy(field,_RC) + call ESMF_FieldHaloRelease(rh,_RC) + _RETURN(_SUCCESS) + end subroutine get_cube_centers + + subroutine get_latlon_centers(GC, lon_center, lat_center, rc) + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + real, allocatable, intent(out) :: lat_center(:), lon_center(:) + integer, optional, intent( out) :: RC + integer :: i1, i2, j1, j2, imc, jmc, i, j, status, DIMS(3) + real :: dlon, dlat + type (GigaTrajInternal), pointer :: GigaTrajInternalPtr + type (GigatrajInternalWrap) :: wrap + type(ESMF_Grid) :: grid_ + character(len=:), allocatable :: Iam + Iam="get_latlon_centers, latlon with halo" + + + call ESMF_UserCompGetInternalState(GC, 'GigaTrajInternal', wrap, status); _VERIFY(STATUS) + GigaTrajInternalPtr => wrap%ptr + grid_ = GigaTrajInternalPtr%LatLonGrid + call MAPL_GridGet(Grid_, globalCellCountPerDim=DIMS, _RC) + call MAPL_Grid_interior(Grid_, i1,i2,j1,j2) + imc = i2-i1 + 1 + jmc = j2-j1 + 1 + + allocate(lon_center(imc+2)) + allocate(lat_center(jmc+2)) + + dlon = 360.0/dims(1) + ! DE + !lons_center = [(dlon*(i-1)+dlon/2., i= i1-1, i2+1)] + ! DC + lon_center = [(dlon*(i-1) - 180.0 , i= i1-1, i2+1)] + !PE + !dlat = 180.0/dims(2) + !lats_center = [(-dlat/2. + dlat*j-90.0, j= j1-1, j2+1)] + !PC + dlat = 180.0/(dims(2)-1) ! PC + lat_center = [(-90.0 + (j-1)*dlat, j= j1-1, j2+1)] + where(lat_center <-90.) lat_center = -90. + where(lat_center >90. ) lat_center = 90. + _RETURN(_SUCCESS) + end subroutine get_latlon_centers end module From bd420ae8b8ebe5ab64ab0fd5086fa28833f7b704 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 4 Dec 2024 09:48:35 -0500 Subject: [PATCH 56/73] change the formatting. comp%%bundle%field|alias --- GEOSgigatraj_GridComp/Gigatraj_Utils.F90 | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/GEOSgigatraj_GridComp/Gigatraj_Utils.F90 b/GEOSgigatraj_GridComp/Gigatraj_Utils.F90 index 5b13e8700..2f9025681 100644 --- a/GEOSgigatraj_GridComp/Gigatraj_Utils.F90 +++ b/GEOSgigatraj_GridComp/Gigatraj_Utils.F90 @@ -88,17 +88,21 @@ subroutine parseCompsAndFieldsName(fields_line, CompNames, BundleNames, FieldNam tmp = fields_line(k:endl) j = index(tmp, '%%') - if (j == 0) print*, "Wrong format of the comp%%field" - Compnames(num_) = trim(adjustl(tmp(1:j-1))) - tmp_bnf = trim(adjustl(tmp(j+2:))) - - l = index(tmp_bnf, '%') - if (l /=0) then - BundleNames(num_) = tmp_bnf(1:l-1) - tmp_f = tmp_bnf(l+1:) + if (j /= 0) then ! there is bundle + Compnames(num_) = trim(adjustl(tmp(1:j-1))) + tmp_bnf = trim(adjustl(tmp(j+2:))) + l = index(tmp_bnf, '%') + if (l /=0) then + BundleNames(num_) = tmp_bnf(1:l-1) + tmp_f = tmp_bnf(l+1:) + else + print*, "%field is a must" + endif else BundleNames(num_) = 'NONE' - tmp_f = tmp_bnf + j = index(tmp, '%') + Compnames(num_) = trim(adjustl(tmp(1:j-1))) + tmp_f = tmp(j+1:) endif ! Aliasing....., Hard coded here From 7777f09aa3810715d33dc9e89cc20c6f63e82771 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 4 Dec 2024 12:49:39 -0500 Subject: [PATCH 57/73] add more internal variables --- GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index 7843b038d..20e30da46 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -68,11 +68,18 @@ subroutine SetServices ( GC, RC ) VLOCATION = MAPL_VLocationCenter, _RC) call MAPL_AddInternalSpec ( gc, & - SHORT_NAME = 'PLE', & - LONG_NAME = 'edge_pressure', & - UNITS = 'Pa', & + SHORT_NAME = 'ZL', & + LONG_NAME = 'mid_layer_heights', & + UNITS = 'm', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, _RC) + + call MAPL_AddInternalSpec ( gc, & + SHORT_NAME = 'W', & + LONG_NAME = 'vertical_velocity', & + UNITS = 'm s-1', & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationEdge, _RC) + VLOCATION = MAPL_VLocationCenter, _RC) call MAPL_AddInternalSpec ( gc, & SHORT_NAME = 'TH', & From 3fea19e6e8ef0f6ba67a3bc82e9ecbce43d11ad2 Mon Sep 17 00:00:00 2001 From: Florian Deconinck Date: Wed, 4 Dec 2024 13:07:16 -0500 Subject: [PATCH 58/73] README light touch --- GEOSmkiau_GridComp/pyMKIAU/README.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSmkiau_GridComp/pyMKIAU/README.md b/GEOSmkiau_GridComp/pyMKIAU/README.md index 7da29e7d7..61f039520 100644 --- a/GEOSmkiau_GridComp/pyMKIAU/README.md +++ b/GEOSmkiau_GridComp/pyMKIAU/README.md @@ -31,7 +31,8 @@ The interface is based on CFFI which is reponsible for the heavy lifting of ## Running python -The last trick is to make sure your package is callable by the `interface.py`. Basically your code has to be accessible by the interpreter, be via virtual env, conda env or PYTHONPATH. The easy way to know is that you need to be able to get into your environment and run in a python terminal +The last trick is to make sure your package is callable by the `interface.py`. Basically your code has to be accessible by the interpreter, be via virtual env, conda env or PYTHONPATH. +The easy way to know is that you need to be able to get into your environment and run in a python terminal: ```python from pyMKIAU.core import pyMKIAU_init From 89d876bba4da226ddbe6494ad66dda9af60c9435 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 4 Dec 2024 15:21:06 -0500 Subject: [PATCH 59/73] refactoring... --- .../GEOS_GigatrajGridComp.F90 | 87 +------------------ 1 file changed, 2 insertions(+), 85 deletions(-) diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index 20e30da46..9fee09999 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -128,29 +128,19 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: I1, I2, J1, J2, comm, npes, my_rank, rank, ierror, NX, NY, NPZ type(ESMF_Grid) :: CubedGrid integer, allocatable :: I1s(:), J1s(:), I2s(:),J2s(:) - integer :: DIMS(3), counts(3), i, j, l + integer :: DIMS(3) type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap - real :: dlat, dlon, delt - real, allocatable, target :: lats_center(:), lons_center(:), levs_center(:) - real, allocatable, target :: cube_lats_center(:, :), cube_lons_center(:,:) - real, allocatable :: lats_2dcenter(:, :), lons_2dcenter(:,:) type (ESMF_TIME) :: CurrentTime - character(len=20), target :: ctime type(ESMF_Alarm) :: GigaTrajOutAlarm, GigaTrajRebalanceAlarm, GigaTrajIntegrateAlarm type(ESMF_TimeInterval) :: parcelsOut_DT, Rebalance_DT, Integrate_DT type(ESMF_TimeInterval) :: ModelTimeStep - integer :: imc, jmc, HH, MM, SS + integer :: HH, MM, SS integer :: integrate_time, r_time, o_time character(len=ESMF_MAXSTR) :: parcels_file character(len=ESMF_MAXSTR) :: grid_name, vCoord character(len=ESMF_MAXSTR) :: regrid_to_latlon character(len=ESMF_MAXSTR), allocatable :: cName(:), bName(:), fName(:), aName(:) - real(ESMF_KIND_R8), pointer :: centerX(:,:) - real(ESMF_KIND_R8), pointer :: centerY(:,:) - real(ESMF_KIND_R8), pointer :: ptr(:,:) - type(ESMF_Field) :: field - type(ESMF_RouteHandle) :: rh type(ESMF_Grid) :: grid_ call ESMF_GridCompGet ( GC, name=COMP_NAME, _RC ) @@ -238,8 +228,6 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) end select npz = Dims(3) - delt = (log(100000.)-log(2.))/npz - levs_center=[(exp(log(100000.)-(i-1)*delt), i=1, npz)] GigaTrajInternalPtr%npz = npz GigaTrajInternalPtr%Integrate_DT = Integrate_DT @@ -271,72 +259,7 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) grid_ = CubedGrid endif - call MAPL_GridGet(grid_, localCellCountPerDim=counts, _RC) call MAPL_Grid_interior(grid_, i1,i2,j1,j2) - imc = i2-i1 + 1 - jmc = j2-j1 + 1 - allocate(lats_2dcenter(imc+2, jmc+2)) - allocate(lons_2dcenter(imc+2, jmc+2)) - - field = ESMF_FieldCreate(grid_, ESMF_TYPEKIND_R8, name='halo', staggerLoc=ESMF_STAGGERLOC_CENTER,totalLWidth=[1,1],totalUWidth=[1,1],rc=status) - _VERIFY(status) - - call ESMF_FieldGet(field,farrayPtr=ptr,rc=status) - ptr = 0.0d0 - call ESMF_FieldHaloStore(field,rh,rc=status) - _VERIFY(status) - - call ESMF_GridGetCoord(grid_ , coordDim=1, localDE=0, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=centerX, rc=status) - _VERIFY(STATUS) - - ptr(1:imc,1:jmc)=centerX - call ESMF_FieldHalo(field,rh,rc=status) - _VERIFY(status) - lons_2dcenter = ptr - - call ESMF_GridGetCoord(grid_ , coordDim=2, localDE=0, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=centerY, rc=status) - VERIFY_(STATUS) - ptr = 0.0d0 - ptr(1:imc,1:jmc)=centerY - call ESMF_FieldHalo(field,rh,rc=status) - _VERIFY(status) - lats_2dcenter = ptr - - call ESMF_FieldDestroy(field,rc=status) - _VERIFY(status) - call ESMF_FieldHaloRelease(rh,rc=status) - _VERIFY(status) - - if ( GigaTrajInternalPtr%regrid_to_latlon ) then - !lons_center = lons_2dcenter(:,1)/MAPL_PI*180.0 - !lats_center = lats_2dcenter(1,:)/MAPL_PI*180.0 - dlon = 360.0/dims(1) - ! DE - !lons_center = [(dlon*(i-1)+dlon/2., i= i1-1, i2+1)] - ! DC - lons_center = [(dlon*(i-1) - 180.0 , i= i1-1, i2+1)] - !PE - !dlat = 180.0/dims(2) - !lats_center = [(-dlat/2. + dlat*j-90.0, j= j1-1, j2+1)] - !PC - dlat = 180.0/(dims(2)-1) ! PC - lats_center = [(-90.0 + (j-1)*dlat, j= j1-1, j2+1)] - where(lats_center <-90.) lats_center = -90. - where(lats_center >90. ) lats_center = 90. - - else - cube_lons_center = lons_2dcenter/MAPL_PI*180.0 - cube_lats_center = lats_2dcenter/MAPL_PI*180.0 - where (cube_lons_center < -180.) cube_lons_center = cube_lons_center + 360. - where (cube_lons_center > 180.) cube_lons_center = cube_lons_center - 360. - endif - - call ESMF_TimeGet(CurrentTime, timeStringISOFrac=ctime) - ctime(20:20) = c_null_char allocate(I1s(npes),J1s(npes)) allocate(I2s(npes),J2s(npes)) @@ -531,12 +454,6 @@ subroutine Init_metsrc_field0 (GC, state, ctime, RC ) delt = (log(High)-log(low))/dims(3) levs_center=[(exp(log(High)-(i-1)*delt), i=1, dims(3))] - if (MAPL_AM_I_ROOT()) then - do i = 1, dims(3) - print*, levs_center(i) - enddo - endif - if (GigaTrajInternalPtr%regrid_to_latlon) then call get_latlon_centers(gc, lons_center, lats_center, _RC) GigaTrajInternalPtr%metSrc = initMetGEOSDistributedLatLonData(comm, c_loc(GigaTrajInternalPtr%CellToRank), DIMS(1), DIMS(2), & From 3700d2dca53e22ee7c73e2df88418c030eacd246 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 6 Dec 2024 08:54:15 -0500 Subject: [PATCH 60/73] set BUILD_WITH_GIGATRAJ OFF --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index eb584c7f1..74d534030 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -8,7 +8,7 @@ set (alldirs GEOSwgcm_GridComp ) -option(BUILD_WITH_GIGATRAJ "Build GEOSgcm with Gigatraj" ON) +option(BUILD_WITH_GIGATRAJ "Build GEOSgcm with Gigatraj" OFF) if (BUILD_WITH_GIGATRAJ) add_definitions (-DHAS_GIGATRAJ) From bb45875167c60d032da1f90b98f051300a5798c1 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang <52509753+weiyuan-jiang@users.noreply.github.com> Date: Fri, 6 Dec 2024 09:01:36 -0500 Subject: [PATCH 61/73] Update GEOSgigatraj_GridComp/CMakeLists.txt Co-authored-by: Tom Clune --- GEOSgigatraj_GridComp/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSgigatraj_GridComp/CMakeLists.txt b/GEOSgigatraj_GridComp/CMakeLists.txt index ec9f7579d..27c7be156 100644 --- a/GEOSgigatraj_GridComp/CMakeLists.txt +++ b/GEOSgigatraj_GridComp/CMakeLists.txt @@ -1,6 +1,6 @@ esma_set_this() -set (dependencies MAPL esmf geos_giga metsources filters gigatraj) +set (dependencies MAPL ESMF::ESMF geos_giga metsources filters gigatraj) esma_add_library (${this} SRCS GEOS_Giga_InterOp.F90 Gigatraj_Utils.F90 GEOS_GigatrajGridComp.F90 From 36cdebacec3b711bf668aa43972e3a94221f4ae1 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 6 Dec 2024 10:14:52 -0500 Subject: [PATCH 62/73] add comments --- GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 b/GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 index 0ec4dee68..0c914dc53 100644 --- a/GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_Giga_InterOp.F90 @@ -1,3 +1,6 @@ +! This module define the interface bewteen GEOS and gigatraj +! The functions are defined in gigatraj + module GEOS_Giga_InterOpMod use, intrinsic :: iso_c_binding, only : c_double, c_int, c_ptr, c_null_char, c_associated use, intrinsic :: iso_c_binding, only : c_loc, c_null_ptr From 52fffb5d6ba2b7cc687884406082112149880a9d Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 6 Dec 2024 13:36:06 -0500 Subject: [PATCH 63/73] replace the subroutine to avoid changing MAPL --- GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index 9fee09999..fe03a61d3 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -534,7 +534,7 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) type (GigaTrajInternal), pointer :: GigaTrajInternalPtr type (GigatrajInternalWrap) :: wrap - integer :: lm, d1, d2, k + integer :: lm, d1, d2, k, itemCount integer ::counts(3), DIMS(3), comm, ierror type (ESMF_VM) :: vm @@ -554,6 +554,7 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) type(ESMF_Alarm) :: GigaTrajIntegrateAlarm type(MAPL_VarSpec ), pointer:: internal_specs(:) character(len=ESMF_MAXSTR) :: SHORT_NAME + character(len=ESMF_MAXSTR), allocatable :: item_names(:) !--------------- ! Update internal @@ -563,13 +564,17 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetObjectFromGC ( GC, MPL, _RC) call MAPL_Get (MPL, INTERNAL_ESMF_STATE=INTERNAL, _RC) - call MAPL_GridCompGetVarSpecs(GC, INTERNAL=internal_specs, _RC) - do K=1,size(internal_specs) - call MAPL_VarSpecGet(internal_specs(k), SHORT_NAME=SHORT_NAME, _RC) - call MAPL_GetPointer(Import, model_field, trim(short_name), _RC) - call MAPL_GetPointer(INTERNAL, internal_field, trim(short_name), _RC) + call ESMF_StateGet(INTERNAL, itemCount=itemCount, _RC) + allocate(item_names(itemCount)) + call ESMF_StateGet(INTERNAL, itemNameList=item_names, _RC) + + do k=1, ItemCount + print*, "wjiang: shortname:",trim(item_names(k)) + call MAPL_GetPointer(Import, model_field, trim(item_names(k)), _RC) + call MAPL_GetPointer(INTERNAL, internal_field, trim(item_names(k)), _RC) internal_field(:,:,:) = model_field(:,:,:) enddo + deallocate(item_names) call ESMF_ClockGetAlarm(clock, 'GigatrajIntegrate', GigaTrajIntegrateAlarm, _RC) From f60a4dbf58f1ca291aef7f90a67d2d379c5fda94 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 10 Dec 2024 13:06:05 -0500 Subject: [PATCH 64/73] Update CMake to be more in GEOS style --- CMakeLists.txt | 6 +++--- GEOSagcm_GridComp/CMakeLists.txt | 2 ++ GEOSagcm_GridComp/GEOSsuperdyn_GridComp/CMakeLists.txt | 2 ++ GEOSgigatraj_GridComp/.gitignore | 3 +++ GEOSgigatraj_GridComp/CMakeLists.txt | 4 ++-- 5 files changed, 12 insertions(+), 5 deletions(-) create mode 100644 GEOSgigatraj_GridComp/.gitignore diff --git a/CMakeLists.txt b/CMakeLists.txt index 7839dba3d..bba3fcd40 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -11,11 +11,9 @@ set (alldirs option(BUILD_WITH_GIGATRAJ "Build GEOSgcm with Gigatraj" OFF) if (BUILD_WITH_GIGATRAJ) - add_definitions (-DHAS_GIGATRAJ) - set (alldirs ${alldirs} GEOSgigatraj_GridComp) + list(APPEND alldirs GEOSgigatraj_GridComp) endif() - if (EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/GEOS_GcmGridComp.F90) ecbuild_declare_project() @@ -24,6 +22,8 @@ if (EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/GEOS_GcmGridComp.F90) SUBCOMPONENTS ${alldirs} DEPENDENCIES MAPL ESMF::ESMF) + target_compile_definitions (${this} PRIVATE $<$:HAS_GIGATRAJ>) + ecbuild_install_project( NAME GEOSgcm_GridComp) else () diff --git a/GEOSagcm_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/CMakeLists.txt index 7e0783090..f28aaff0c 100644 --- a/GEOSagcm_GridComp/CMakeLists.txt +++ b/GEOSagcm_GridComp/CMakeLists.txt @@ -20,6 +20,8 @@ elseif (EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/GEOS_AgcmGridComp.F90) SUBCOMPONENTS ${alldirs} DEPENDENCIES MAPL GEOS_Shared Chem_Shared ESMF::ESMF) + target_compile_definitions (${this} PRIVATE $<$:HAS_GIGATRAJ>) + else () esma_add_subdirectories (${alldirs}) diff --git a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/CMakeLists.txt index 968ceaf51..c59826405 100644 --- a/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSsuperdyn_GridComp/CMakeLists.txt @@ -20,6 +20,8 @@ if (EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/GEOS_SuperdynGridComp.F90) SUBCOMPONENTS ${alldirs} DEPENDENCIES MAPL GEOS_Shared ESMF::ESMF) + target_compile_definitions (${this} PRIVATE $<$:HAS_GIGATRAJ>) + else () esma_add_subdirectories (${alldirs}) diff --git a/GEOSgigatraj_GridComp/.gitignore b/GEOSgigatraj_GridComp/.gitignore new file mode 100644 index 000000000..7bf7f4af4 --- /dev/null +++ b/GEOSgigatraj_GridComp/.gitignore @@ -0,0 +1,3 @@ +@GigaTraj/ +GigaTraj/ +GigaTraj@/ diff --git a/GEOSgigatraj_GridComp/CMakeLists.txt b/GEOSgigatraj_GridComp/CMakeLists.txt index 27c7be156..3b4d5db38 100644 --- a/GEOSgigatraj_GridComp/CMakeLists.txt +++ b/GEOSgigatraj_GridComp/CMakeLists.txt @@ -3,7 +3,7 @@ esma_set_this() set (dependencies MAPL ESMF::ESMF geos_giga metsources filters gigatraj) esma_add_library (${this} - SRCS GEOS_Giga_InterOp.F90 Gigatraj_Utils.F90 GEOS_GigatrajGridComp.F90 + SRCS GEOS_Giga_InterOp.F90 Gigatraj_Utils.F90 GEOS_GigatrajGridComp.F90 DEPENDENCIES ${dependencies}) -esma_add_subdirectories( @GigaTraj) +esma_add_subdirectories(GigaTraj) From b8d2878a1a9f15636a75eef22e523653002bd179 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 10 Dec 2024 14:16:51 -0500 Subject: [PATCH 65/73] v11: Add dependency to fms_r4 --- .../GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt index 1366abb01..057f0d07a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt @@ -36,6 +36,12 @@ esma_add_library (${this} SRCS ${srcs} DEPENDENCIES GEOS_Shared GMAO_mpeu MAPL Chem_Shared Chem_Base ESMF::ESMF) +# We need to add_dependencies for fms_r4 because CMake doesn't know we +# need it for include purposes. In R4R8, we only ever link against +# fms_r4, so it doesn't know we need to build it. +# NOTE NOTE NOTE: This should *not* be included in GEOSgcm v12 +# because FMS is pre-built library in that case. +add_dependencies (${this} fms_r4) get_target_property (extra_incs fms_r4 INCLUDE_DIRECTORIES) target_include_directories(${this} PRIVATE $ From e22256bab982b55d990a7a0d9faf30d888ce7542 Mon Sep 17 00:00:00 2001 From: "Michael F. Mehari" Date: Wed, 11 Dec 2024 16:25:16 -0500 Subject: [PATCH 66/73] .yaml file for JRA55-DO dataset --- GEOSdataatm_GridComp/CMakeLists.txt | 2 +- .../JRA55-DO_DataAtm_Forcings_ExtData.yaml | 105 ++++++++++++++++++ 2 files changed, 106 insertions(+), 1 deletion(-) create mode 100755 GEOSdataatm_GridComp/JRA55-DO_DataAtm_Forcings_ExtData.yaml diff --git a/GEOSdataatm_GridComp/CMakeLists.txt b/GEOSdataatm_GridComp/CMakeLists.txt index 10298c385..407031c05 100644 --- a/GEOSdataatm_GridComp/CMakeLists.txt +++ b/GEOSdataatm_GridComp/CMakeLists.txt @@ -11,6 +11,6 @@ esma_add_library (${this} target_compile_definitions (${this} PRIVATE USE_CICE USE_R8) install( - FILES CORE_NYF_Data_AtmForcings_ExtData.yaml + FILES JRA55-DO_DataAtm_Forcings_ExtData.yaml CORE_NYF_Data_AtmForcings_ExtData.yaml DESTINATION etc ) diff --git a/GEOSdataatm_GridComp/JRA55-DO_DataAtm_Forcings_ExtData.yaml b/GEOSdataatm_GridComp/JRA55-DO_DataAtm_Forcings_ExtData.yaml new file mode 100755 index 000000000..57eaf33ab --- /dev/null +++ b/GEOSdataatm_GridComp/JRA55-DO_DataAtm_Forcings_ExtData.yaml @@ -0,0 +1,105 @@ +Collections: + psl_1_5_0: + template: ExtData/JRA55-DO/v1-5-0/psl/psl_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010000-%y412312100.nc + valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + psl_1_5_0_1: + template: ExtData/JRA55-DO/v1-5-0-1/psl/psl_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010000-%y412312100.nc + valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + tas_1_5_0: + template: ExtData/JRA55-DO/v1-5-0/tas/tas_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010000-%y412312100.nc + valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + tas_1_5_0_1: + template: ExtData/JRA55-DO/v1-5-0-1/tas/tas_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010000-%y412312100.nc + valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + huss_1_5_0: + template: ExtData/JRA55-DO/v1-5-0/huss/huss_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010000-%y412312100.nc + valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + huss_1_5_0_1: + template: ExtData/JRA55-DO/v1-5-0-1/huss/huss_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010000-%y412312100.nc + valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + uas_1_5_0: + template: ExtData/JRA55-DO/v1-5-0/uas/uas_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010000-%y412312100.nc + valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + uas_1_5_0_1: + template: ExtData/JRA55-DO/v1-5-0-1/uas/uas_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010000-%y412312100.nc + valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + vas_1_5_0: + template: ExtData/JRA55-DO/v1-5-0/vas/vas_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010000-%y412312100.nc + valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + vas_1_5_0_1: + template: ExtData/JRA55-DO/v1-5-0-1/vas/vas_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010000-%y412312100.nc + valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + friver_1_5_0: + template: ExtData/JRA55-DO/v1-5-0/friver/friver_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y40101-%y41231.nc + valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + friver_1_5_0_1: + template: ExtData/JRA55-DO/v1-5-0-1/friver/friver_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y40101-%y41231.nc + valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + prra_1_5_0: + template: ExtData/JRA55-DO/v1-5-0/prra/prra_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010130-%y412312230.nc + valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + prra_1_5_0_1: + template: ExtData/JRA55-DO/v1-5-0-1/prra/prra_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010130-%y412312230.nc + valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + prsn_1_5_0: + template: ExtData/JRA55-DO/v1-5-0/prsn/prsn_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010130-%y412312230.nc + valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + prsn_1_5_0_1: + template: ExtData/JRA55-DO/v1-5-0-1/prsn/prsn_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010130-%y412312230.nc + valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + rlds_1_5_0: + template: ExtData/JRA55-DO/v1-5-0/rlds/rlds_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010130-%y412312230.nc + valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + rlds_1_5_0_1: + template: ExtData/JRA55-DO/v1-5-0-1/rlds/rlds_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010130-%y412312230.nc + valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + rsds_1_5_0: + template: ExtData/JRA55-DO/v1-5-0/rsds/rsds_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010130-%y412312230.nc + valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + rsds_1_5_0_1: + template: ExtData/JRA55-DO/v1-5-0-1/rsds/rsds_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010130-%y412312230.nc + valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + +Samplings: + interannual_sample: + flux_conserve_sample: + time_interpolation: false + update_offset: "PT1H30M" + river_conserve_sample: + time_interpolation: false + update_offset: "PT12H" + +Exports: + PS: + - {starting: "1958-01-01T00:00:00", collection: psl_1_5_0, sample: interannual_sample, variable: psl} + - {starting: "2020-01-01T00:00:00", collection: psl_1_5_0_1, sample: interannual_sample, variable: psl} + TA: + - {starting: "1958-01-01T00:00:00", collection: tas_1_5_0, sample: interannual_sample, variable: tas} + - {starting: "2020-01-01T00:00:00", collection: tas_1_5_0_1, sample: interannual_sample, variable: tas} + QA: + - {starting: "1958-01-01T00:00:00", collection: huss_1_5_0, sample: interannual_sample, variable: huss} + - {starting: "2020-01-01T00:00:00", collection: huss_1_5_0_1, sample: interannual_sample, variable: huss} + UA: + - {starting: "1958-01-01T00:00:00", collection: uas_1_5_0, regrid: PATCH, sample: interannual_sample, variable: uas} + - {starting: "2020-01-01T00:00:00", collection: uas_1_5_0_1, regrid: PATCH, sample: interannual_sample, variable: uas} + VA: + - {starting: "1958-01-01T00:00:00", collection: vas_1_5_0, regrid: PATCH, sample: interannual_sample, variable: vas} + - {starting: "2020-01-01T00:00:00", collection: vas_1_5_0_1, regrid: PATCH, sample: interannual_sample, variable: vas} + RUNOFF: + - {starting: "1958-01-01T00:00:00", collection: friver_1_5_0, regrid: CONSERVE, sample: river_conserve_sample, variable: friver} + - {starting: "2020-01-01T00:00:00", collection: friver_1_5_0_1, regrid: CONSERVE, sample: river_conserve_sample, variable: friver} + PCU: + - {starting: "1958-01-01T00:00:00", collection: prra_1_5_0, regrid: CONSERVE, sample: flux_conserve_sample, variable: prra} + - {starting: "2020-01-01T00:00:00", collection: prra_1_5_0_1, regrid: CONSERVE, sample: flux_conserve_sample, variable: prra} + PLS: + - {starting: "1958-01-01T00:00:00", collection: prra_1_5_0, regrid: CONSERVE, sample: flux_conserve_sample, variable: prra} + - {starting: "2020-01-01T00:00:00", collection: prra_1_5_0_1, regrid: CONSERVE, sample: flux_conserve_sample, variable: prra} + SNO: + - {starting: "1958-01-01T00:00:00", collection: prsn_1_5_0, regrid: CONSERVE, sample: flux_conserve_sample, variable: prsn} + - {starting: "2020-01-01T00:00:00", collection: prsn_1_5_0_1, regrid: CONSERVE, sample: flux_conserve_sample, variable: prsn} + LWDN: + - {starting: "1958-01-01T00:00:00", collection: rlds_1_5_0, regrid: CONSERVE, sample: flux_conserve_sample, variable: rlds} + - {starting: "2020-01-01T00:00:00", collection: rlds_1_5_0_1, regrid: CONSERVE, sample: flux_conserve_sample, variable: rlds} + SWGDWN: + - {starting: "1958-01-01T00:00:00", collection: rsds_1_5_0, regrid: CONSERVE, sample: flux_conserve_sample, variable: rsds} + - {starting: "2020-01-01T00:00:00", collection: rsds_1_5_0_1, regrid: CONSERVE, sample: flux_conserve_sample, variable: rsds} From 70f3ff43ee8a81dfae857944b02dc2d54ee8bd18 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 12 Dec 2024 12:02:43 -0500 Subject: [PATCH 67/73] rm some prints --- GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 | 1 - GEOSgigatraj_GridComp/Gigatraj_Utils.F90 | 5 ----- 2 files changed, 6 deletions(-) diff --git a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 index fe03a61d3..ba2f62b1d 100644 --- a/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 +++ b/GEOSgigatraj_GridComp/GEOS_GigatrajGridComp.F90 @@ -569,7 +569,6 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_StateGet(INTERNAL, itemNameList=item_names, _RC) do k=1, ItemCount - print*, "wjiang: shortname:",trim(item_names(k)) call MAPL_GetPointer(Import, model_field, trim(item_names(k)), _RC) call MAPL_GetPointer(INTERNAL, internal_field, trim(item_names(k)), _RC) internal_field(:,:,:) = model_field(:,:,:) diff --git a/GEOSgigatraj_GridComp/Gigatraj_Utils.F90 b/GEOSgigatraj_GridComp/Gigatraj_Utils.F90 index 2f9025681..bb77ed1a3 100644 --- a/GEOSgigatraj_GridComp/Gigatraj_Utils.F90 +++ b/GEOSgigatraj_GridComp/Gigatraj_Utils.F90 @@ -164,24 +164,19 @@ subroutine get_levels(P, func, levels, rc) call ESMF_VMgetCurrent(vm) call ESMF_VMGet(vm, mpiCommunicator = comm, rc = status) positive = P(1,1,1) < P(1,1,2) - print*, "wjiang:positive", positive if (positive) then local_min_val = maxval(P(:,:,1)) - print*, "local_min_val:", local_max_val call MPI_Allreduce(lev01, local_min_val,1, MPI_FLOAT, MPI_MIN, comm, status) temp = P(:,:,lm) where(temp >= MAPL_UNDEF) temp = -MAPL_UNDEF local_max_val = maxval(temp) - print*, "local_max_val:", local_max_val call MPI_Allreduce(levLm, local_max_val,1, MPI_FLOAT, MPI_MAX, comm, status) else local_min_val = minval(P(:,:,lm)) - print*, "local_min_val:", local_max_val call MPI_Allreduce(levLm, local_min_val,1, MPI_FLOAT, MPI_MIN, comm, status) temp = P(:,:,1) where(temp >= MAPL_UNDEF) temp = -MAPL_UNDEF local_max_val = maxval(temp) - print*, "local_max_val:", local_max_val call MPI_Allreduce(lev01, local_max_val,1, MPI_FLOAT, MPI_MAX, comm, status) endif From df175366085b9010f14a5605e8a95250764b7f81 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 13 Dec 2024 13:03:57 -0500 Subject: [PATCH 68/73] Clarify comment --- .../GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt index 057f0d07a..7992821cb 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt @@ -38,7 +38,7 @@ esma_add_library (${this} # We need to add_dependencies for fms_r4 because CMake doesn't know we # need it for include purposes. In R4R8, we only ever link against -# fms_r4, so it doesn't know we need to build it. +# fms_r8, so it doesn't know to build the target fms_r4 # NOTE NOTE NOTE: This should *not* be included in GEOSgcm v12 # because FMS is pre-built library in that case. add_dependencies (${this} fms_r4) From 2b4c3dd80c9d43338fb52f06dc05702f7fc98173 Mon Sep 17 00:00:00 2001 From: "Michael F. Mehari" Date: Thu, 19 Dec 2024 15:05:46 -0500 Subject: [PATCH 69/73] PLS is set to zero --- GEOSdataatm_GridComp/JRA55-DO_DataAtm_Forcings_ExtData.yaml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/GEOSdataatm_GridComp/JRA55-DO_DataAtm_Forcings_ExtData.yaml b/GEOSdataatm_GridComp/JRA55-DO_DataAtm_Forcings_ExtData.yaml index 57eaf33ab..7186385c8 100755 --- a/GEOSdataatm_GridComp/JRA55-DO_DataAtm_Forcings_ExtData.yaml +++ b/GEOSdataatm_GridComp/JRA55-DO_DataAtm_Forcings_ExtData.yaml @@ -91,9 +91,7 @@ Exports: PCU: - {starting: "1958-01-01T00:00:00", collection: prra_1_5_0, regrid: CONSERVE, sample: flux_conserve_sample, variable: prra} - {starting: "2020-01-01T00:00:00", collection: prra_1_5_0_1, regrid: CONSERVE, sample: flux_conserve_sample, variable: prra} - PLS: - - {starting: "1958-01-01T00:00:00", collection: prra_1_5_0, regrid: CONSERVE, sample: flux_conserve_sample, variable: prra} - - {starting: "2020-01-01T00:00:00", collection: prra_1_5_0_1, regrid: CONSERVE, sample: flux_conserve_sample, variable: prra} + PLS: {collection: /dev/null} SNO: - {starting: "1958-01-01T00:00:00", collection: prsn_1_5_0, regrid: CONSERVE, sample: flux_conserve_sample, variable: prsn} - {starting: "2020-01-01T00:00:00", collection: prsn_1_5_0_1, regrid: CONSERVE, sample: flux_conserve_sample, variable: prsn} From ab245cbd25b4ac5293f52a2ace51b9e7dff92f29 Mon Sep 17 00:00:00 2001 From: bzhao Date: Mon, 23 Dec 2024 10:47:09 -0500 Subject: [PATCH 70/73] change UA/VA to vector rule --- .../JRA55-DO_DataAtm_Forcings_ExtData.yaml | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/GEOSdataatm_GridComp/JRA55-DO_DataAtm_Forcings_ExtData.yaml b/GEOSdataatm_GridComp/JRA55-DO_DataAtm_Forcings_ExtData.yaml index 7186385c8..a2c6aaeac 100755 --- a/GEOSdataatm_GridComp/JRA55-DO_DataAtm_Forcings_ExtData.yaml +++ b/GEOSdataatm_GridComp/JRA55-DO_DataAtm_Forcings_ExtData.yaml @@ -29,6 +29,12 @@ Collections: vas_1_5_0_1: template: ExtData/JRA55-DO/v1-5-0-1/vas/vas_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010000-%y412312100.nc valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + uvas_1_5_0: + template: ExtData/JRA55-DO/v1-5-0/uvas/uvas_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010000-%y412312100.nc + valid_range: "1958-01-01T00:00:00/2020-01-01T00:00:00" + uvas_1_5_0_1: + template: ExtData/JRA55-DO/v1-5-0-1/uvas/uvas_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010000-%y412312100.nc + valid_range: "2020-01-01T00:00:00/2024-02-02T00:00:00" friver_1_5_0: template: ExtData/JRA55-DO/v1-5-0/friver/friver_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y40101-%y41231.nc valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" @@ -79,12 +85,9 @@ Exports: QA: - {starting: "1958-01-01T00:00:00", collection: huss_1_5_0, sample: interannual_sample, variable: huss} - {starting: "2020-01-01T00:00:00", collection: huss_1_5_0_1, sample: interannual_sample, variable: huss} - UA: - - {starting: "1958-01-01T00:00:00", collection: uas_1_5_0, regrid: PATCH, sample: interannual_sample, variable: uas} - - {starting: "2020-01-01T00:00:00", collection: uas_1_5_0_1, regrid: PATCH, sample: interannual_sample, variable: uas} - VA: - - {starting: "1958-01-01T00:00:00", collection: vas_1_5_0, regrid: PATCH, sample: interannual_sample, variable: vas} - - {starting: "2020-01-01T00:00:00", collection: vas_1_5_0_1, regrid: PATCH, sample: interannual_sample, variable: vas} + UA;VA: + - {starting: "1958-01-01T00:00:00", collection: uvas_1_5_0, sample: interannual_sample, variable: uas;vas} + - {starting: "2020-01-01T00:00:00", collection: uvas_1_5_0_1, sample: interannual_sample, variable: uas;vas} RUNOFF: - {starting: "1958-01-01T00:00:00", collection: friver_1_5_0, regrid: CONSERVE, sample: river_conserve_sample, variable: friver} - {starting: "2020-01-01T00:00:00", collection: friver_1_5_0_1, regrid: CONSERVE, sample: river_conserve_sample, variable: friver} From 8f2ba70b996b7651212895d3f51a50a78d7dd405 Mon Sep 17 00:00:00 2001 From: bzhao Date: Mon, 23 Dec 2024 10:55:28 -0500 Subject: [PATCH 71/73] corrected valid_range for all collections --- .../JRA55-DO_DataAtm_Forcings_ExtData.yaml | 40 +++++++++---------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/GEOSdataatm_GridComp/JRA55-DO_DataAtm_Forcings_ExtData.yaml b/GEOSdataatm_GridComp/JRA55-DO_DataAtm_Forcings_ExtData.yaml index a2c6aaeac..5da6f8658 100755 --- a/GEOSdataatm_GridComp/JRA55-DO_DataAtm_Forcings_ExtData.yaml +++ b/GEOSdataatm_GridComp/JRA55-DO_DataAtm_Forcings_ExtData.yaml @@ -1,34 +1,34 @@ Collections: psl_1_5_0: template: ExtData/JRA55-DO/v1-5-0/psl/psl_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010000-%y412312100.nc - valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + valid_range: "1958-01-01T00:00:00/2020-01-01T00:00:00" psl_1_5_0_1: template: ExtData/JRA55-DO/v1-5-0-1/psl/psl_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010000-%y412312100.nc - valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + valid_range: "2020-01-01T00:00:00/2024-02-02T00:00:00" tas_1_5_0: template: ExtData/JRA55-DO/v1-5-0/tas/tas_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010000-%y412312100.nc - valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + valid_range: "1958-01-01T00:00:00/2020-01-01T00:00:00" tas_1_5_0_1: template: ExtData/JRA55-DO/v1-5-0-1/tas/tas_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010000-%y412312100.nc - valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + valid_range: "2020-01-01T00:00:00/2024-02-02T00:00:00" huss_1_5_0: template: ExtData/JRA55-DO/v1-5-0/huss/huss_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010000-%y412312100.nc - valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + valid_range: "1958-01-01T00:00:00/2020-01-01T00:00:00" huss_1_5_0_1: template: ExtData/JRA55-DO/v1-5-0-1/huss/huss_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010000-%y412312100.nc - valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + valid_range: "2020-01-01T00:00:00/2024-02-02T00:00:00" uas_1_5_0: template: ExtData/JRA55-DO/v1-5-0/uas/uas_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010000-%y412312100.nc - valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + valid_range: "1958-01-01T00:00:00/2020-01-01T00:00:00" uas_1_5_0_1: template: ExtData/JRA55-DO/v1-5-0-1/uas/uas_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010000-%y412312100.nc - valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + valid_range: "2020-01-01T00:00:00/2024-02-02T00:00:00" vas_1_5_0: template: ExtData/JRA55-DO/v1-5-0/vas/vas_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010000-%y412312100.nc - valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + valid_range: "1958-01-01T00:00:00/2020-01-01T00:00:00" vas_1_5_0_1: template: ExtData/JRA55-DO/v1-5-0-1/vas/vas_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010000-%y412312100.nc - valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + valid_range: "2020-01-01T00:00:00/2024-02-02T00:00:00" uvas_1_5_0: template: ExtData/JRA55-DO/v1-5-0/uvas/uvas_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010000-%y412312100.nc valid_range: "1958-01-01T00:00:00/2020-01-01T00:00:00" @@ -37,34 +37,34 @@ Collections: valid_range: "2020-01-01T00:00:00/2024-02-02T00:00:00" friver_1_5_0: template: ExtData/JRA55-DO/v1-5-0/friver/friver_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y40101-%y41231.nc - valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + valid_range: "1958-01-01T00:00:00/2020-01-01T00:00:00" friver_1_5_0_1: template: ExtData/JRA55-DO/v1-5-0-1/friver/friver_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y40101-%y41231.nc - valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + valid_range: "2020-01-01T00:00:00/2024-02-02T00:00:00" prra_1_5_0: template: ExtData/JRA55-DO/v1-5-0/prra/prra_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010130-%y412312230.nc - valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + valid_range: "1958-01-01T00:00:00/2020-01-01T00:00:00" prra_1_5_0_1: template: ExtData/JRA55-DO/v1-5-0-1/prra/prra_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010130-%y412312230.nc - valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + valid_range: "2020-01-01T00:00:00/2024-02-02T00:00:00" prsn_1_5_0: template: ExtData/JRA55-DO/v1-5-0/prsn/prsn_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010130-%y412312230.nc - valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + valid_range: "1958-01-01T00:00:00/2020-01-01T00:00:00" prsn_1_5_0_1: template: ExtData/JRA55-DO/v1-5-0-1/prsn/prsn_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010130-%y412312230.nc - valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + valid_range: "2020-01-01T00:00:00/2024-02-02T00:00:00" rlds_1_5_0: template: ExtData/JRA55-DO/v1-5-0/rlds/rlds_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010130-%y412312230.nc - valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + valid_range: "1958-01-01T00:00:00/2020-01-01T00:00:00" rlds_1_5_0_1: template: ExtData/JRA55-DO/v1-5-0-1/rlds/rlds_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010130-%y412312230.nc - valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + valid_range: "2020-01-01T00:00:00/2024-02-02T00:00:00" rsds_1_5_0: template: ExtData/JRA55-DO/v1-5-0/rsds/rsds_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0_gr_%y401010130-%y412312230.nc - valid_range: "1958-01-01T00:00:00/2020-07-15T21:00:00" + valid_range: "1958-01-01T00:00:00/2020-01-01T00:00:00" rsds_1_5_0_1: template: ExtData/JRA55-DO/v1-5-0-1/rsds/rsds_input4MIPs_atmosphericState_OMIP_MRI-JRA55-do-1-5-0-1_gr_%y401010130-%y412312230.nc - valid_range: "2020-01-01T00:00:00/2024-02-01T21:00:00" + valid_range: "2020-01-01T00:00:00/2024-02-02T00:00:00" Samplings: interannual_sample: From cb804d26a88c6cc54cb09ab4d9b3df93a7482e8e Mon Sep 17 00:00:00 2001 From: bzhao Date: Mon, 23 Dec 2024 11:49:24 -0500 Subject: [PATCH 72/73] a few fixes to DataAtm with input from Andrea and Atnas --- GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 | 23 +++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 b/GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 index 09e030a3b..95964a7e4 100644 --- a/GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 +++ b/GEOSdataatm_GridComp/GEOS_DataAtmGridComp.F90 @@ -202,6 +202,7 @@ subroutine SetServices ( GC, RC ) LONG_NAME = 'surface_temperature', & UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & + DEFAULT = -1000.0, & VLOCATION = MAPL_VLocationNone, __RC__) call MAPL_AddInternalSpec(GC, & @@ -424,6 +425,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) real, dimension(:,:), pointer :: ALW, BLW, SPEED, DISCHARGE, rPCU, rPLS, sSNO real, dimension(:,:), pointer :: CT, CQ, CM, SH, EVAP, TAUX, TAUY, Tskin, lwdnsrf real, dimension(:,:), pointer :: DRPARN, DFPARN, DRNIRN, DFNIRN, DRUVRN, DFUVRN + real, dimension(:,:), pointer :: DSH, DEVAP real, dimension(:,:), pointer :: EMISSRF real, allocatable, dimension(:,:) :: ZTH @@ -479,7 +481,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) ! real LATSO, LONSO real, parameter :: HW_hack = 2. - logical :: firsttime = .true. + logical :: firsttime = .false. real :: TAU_TS real :: DT @@ -614,11 +616,13 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) call SetVarToZero('DEWL', __RC__) call SetVarToZero('FRSL', __RC__) + call MAPL_GetPointer(SurfImport, DSH, 'DSH', __RC__) + call MAPL_GetPointer(SurfImport, DEVAP, 'DEVAP', __RC__) ! these should be set to 0 (for now) - call SetVarToZero('DSH', __RC__) + !call SetVarToZero('DSH', __RC__) call SetVarToZero('DFU', __RC__) call SetVarToZero('DFV', __RC__) - call SetVarToZero('DEVAP', __RC__) + !call SetVarToZero('DEVAP', __RC__) call SetVarToZero('DDEWL', __RC__) call SetVarToZero('DFRSL', __RC__) @@ -658,7 +662,10 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) !------------------------------------------------------ call ESMF_ClockGet(CLOCK, TIMESTEP=DELT, __RC__) - DELT = DELT * NINT((86400./DT)) ! emulate daily Solar + ! the line below only works for daily forcing e..g. CORE I + ! for JRA55-DO or any dataset at higher frequency, this line makes SW much + ! higher than what data prescribed + !DELT = DELT * NINT((86400./DT)) ! emulate daily Solar call MAPL_SunGetInsolation(LONS, LATS, & ORBIT, ZTH, SLR, & @@ -716,6 +723,10 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(SurfImport, ALW, 'ALW', __RC__) call MAPL_GetPointer(SurfImport, BLW, 'BLW', __RC__) + if(any(Tskin<0.0)) then !only when DATAATM restart is bootstrapped + firsttime = .true. + end if + if (firsttime) then firsttime = .false. Tskin = TA @@ -773,6 +784,10 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) TAUX = CM * (Uskin - Uair) TAUY = CM * (Vskin - Vair) + ! these derivatives are important for sea ice + DSH = CT !* MAPL_CP (MAPL_CP got multiplied in Surf) + DEVAP = CQ + 101 format (A, e20.12, 3I3.2) !!! if (mapl_am_i_root()) PRINT*, __FILE__, __LINE__ From f011060f0eaaa1d77f2683f38a65a65de21c8fc1 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 9 Jan 2025 15:18:18 -0500 Subject: [PATCH 73/73] Update CI to orb 4 --- .circleci/config.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 5c89ea615..7c7d0d6a4 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -1,11 +1,11 @@ version: 2.1 # Anchors in case we need to override the defaults from the orb -#baselibs_version: &baselibs_version v7.17.0 -#bcs_version: &bcs_version v11.4.0 +#baselibs_version: &baselibs_version v7.27.0 +#bcs_version: &bcs_version v11.6.0 orbs: - ci: geos-esm/circleci-tools@2 + ci: geos-esm/circleci-tools@4 workflows: build-test: