Skip to content

Porting DynCore to MAPL3 - continued #335

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
pchakraborty merged 7 commits into from
Jan 14, 2026
Merged

Porting DynCore to MAPL3 - continued #335

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
4074332
DynCore: Initialize fills exports U, V, T only when they have been re…
pchakraborty Dec 22, 2025
ba410e2
Removed all references to MAPL_GetPointer
pchakraborty Dec 23, 2025
e00b7e5
Removed call to MAPL_RemapBounds
pchakraborty Dec 23, 2025
470b902
Using MAPL_MemInfoWrite instead of MAPL_MemUtilsWrite
pchakraborty Jan 13, 2026
8091f85
Merge remote-tracking branch 'origin/release/MAPL-v3' into feature/pc…
pchakraborty Jan 13, 2026
86ad513
Removed references to standalones that crept in during an update
pchakraborty Jan 13, 2026
441f5b1
Back to using MAPL_RemapBounds - gfortran has trouble with bounds rem…
pchakraborty Jan 13, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 4 additions & 4 deletions CMakeLists.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -103,7 +103,10 @@ if (BUILD_GEOS_GTFV3_INTERFACE)

endif ()

set(dependencies MAPL MAPL.generic3g GFTL_SHARED::gftl-shared-v2 GMAO_hermes GEOS_Shared esmf OpenMP::OpenMP_Fortran)
set(dependencies
esmf MAPL MAPL.generic3g MAPL.utilities
GFTL_SHARED::gftl-shared-v2 GMAO_hermes GEOS_Shared
OpenMP::OpenMP_Fortran)

if (BUILD_GEOS_GTFV3_INTERFACE)
esma_add_library (${this}
Expand Down Expand Up @@ -181,10 +184,7 @@ ecbuild_add_executable (
# main library above.
if (FV_PRECISION STREQUAL R4R8)
foreach(executable
StandAlone_FV3_Dycore.x
rs_scale.x
StandAlone_AdvCore.x
StandAlone_DynAdvCore.x
c2c.x
interp_restarts.x
interp_restarts_bin.x)
Expand Down
146 changes: 65 additions & 81 deletions DynCore_GridCompMod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@ module FVdycoreCubed_GridComp
use MAPL_Constants, only: MAPL_VectorField ! pchakrab: TODO - need MAPL3 equivalent
use MAPL_Constants, only: MAPL_UNDEFINED_REAL

use ESMFL_Mod, only: ESMFL_StateGetPointerToData, ESMFL_BundleGetPointerToData, MAPL_AreaMean
use ESMFL_Mod, only: ESMFL_BundleGetPointerToData, MAPL_AreaMean

use MAPL_AbstractRegridderMod, only: AbstractRegridder
! pchakrab - TODO: need MAPL3 equivalent
Expand Down Expand Up @@ -444,13 +444,12 @@ subroutine Initialize(gc, import, export, clock, rc)
character(len=:), allocatable :: ReplayMode

real(r4), pointer :: pref(:)
! real(r4), pointer :: ple(:,:,:)
real(r4), pointer :: u(:,:,:), v(:,:,:), t(:,:,:)
real(r4), pointer :: temp2d(:,:)

real(r8), pointer :: ak(:), bk(:)
real(r8), pointer :: ud(:,:,:), vd(:,:,:)
real(r8), pointer :: pe(:,:,:), pt(:,:,:), pk(:,:,:)
real(r8), pointer :: pt(:,:,:), pk(:,:,:)
real(r8), allocatable :: ur(:,:,:), vr(:,:,:) ! rotated winds

real :: DNS_INTERVAL
Expand All @@ -459,9 +458,9 @@ subroutine Initialize(gc, import, export, clock, rc)
integer :: i, numTracers, status

! Setup FMS/FV3
call MAPL_GridCompTimerStart(gc, "DynSetup", _RC)
call MAPL_GridCompTimerStart(gc, "DYN_SETUP", _RC)
call DynSetup(gc, _RC)
call MAPL_GridCompTimerStop(gc, "DynSetup", _RC)
call MAPL_GridCompTimerStop(gc, "DYN_SETUP", _RC)

! Get the private state
_GET_NAMED_PRIVATE_STATE(gc, DynState, PRIVATE_STATE, self)
Expand All @@ -477,42 +476,40 @@ subroutine Initialize(gc, import, export, clock, rc)
! Set Private Internal State from Restart File
call MAPL_GridCompGetInternalState(gc, internal, _RC)

call MAPL_GridCompTimerStart(gc, "DynInit", _RC)
call MAPL_GridCompTimerStart(gc, "DYN_INIT", _RC)
call DynInit(self, clock, import, gc, _RC)
call MAPL_GridCompTimerStop(gc, "DynInit", _RC)
call MAPL_GridCompTimerStop(gc, "DYN_INIT", _RC)

! Create PLE and PREF EXPORT Coupling (Needs to be done only once per run)
! Create PREF EXPORT Coupling (Needs to be done only once per run)
call MAPL_StateGetPointer(internal, ak, "AK", _RC)
call MAPL_StateGetPointer(internal, bk, "BK", _RC)
call MAPL_StateGetPointer(export, pref, "PREF", _RC)
if (associated(pref)) pref = ak + bk * P00

call MAPL_StateGetPointer(internal, ud, "U", _RC)
call MAPL_StateGetPointer(internal, vd, "V", _RC)
call MAPL_StateGetPointer(internal, pe, "PE", _RC)
call MAPL_StateGetPointer(internal, pt, "PT", _RC)
call MAPL_StateGetPointer(internal, pk, "PKZ", _RC)

! pchakrab: TODO - how to handle `alloc=.true.` in MAPL3??
call MAPL_GetPointer(export, u, "U", alloc=.true., _RC)
call MAPL_GetPointer(export, v, "V", alloc=.true., _RC)
call MAPL_GetPointer(export, t, "T", alloc=.true., _RC)

! Create A-Grid Winds
ifirst = self%grid%is
ilast = self%grid%ie
jfirst = self%grid%js
jlast = self%grid%je
km = self%grid%npz

allocate(ur(ifirst:ilast, jfirst:jlast, km))
allocate(vr(ifirst:ilast, jfirst:jlast, km))
call getAllWinds(ud, vd, ur=ur, vr=vr)
u = ur
v = vr
t = pt*pk
! ple = pe
deallocate(ur, vr)
call MAPL_StateGetPointer(export, u, "U", _RC)
call MAPL_StateGetPointer(export, v, "V", _RC)
if (associated(u) .and. associated(v)) then
ifirst = self%grid%is; ilast = self%grid%ie
jfirst = self%grid%js; jlast = self%grid%je
km = self%grid%npz
allocate(ur(ifirst:ilast, jfirst:jlast, km))
allocate(vr(ifirst:ilast, jfirst:jlast, km))
call MAPL_StateGetPointer(internal, ud, "U", _RC)
call MAPL_StateGetPointer(internal, vd, "V", _RC)
call getAllWinds(ud, vd, ur=ur, vr=vr)
u = ur
v = vr
deallocate(ur, vr)
end if

! Temperature
call MAPL_StateGetPointer(export, t, "T", _RC)
if (associated(t)) then
call MAPL_StateGetPointer(internal, pt, "PT", _RC)
call MAPL_StateGetPointer(internal, pk, "PKZ", _RC)
t = pt*pk
end if

! Fill Grid-Cell Area Delta-X/Y
call MAPL_StateGetPointer(export, temp2d, "DXC", _RC)
Expand Down Expand Up @@ -560,21 +557,18 @@ subroutine Initialize(gc, import, export, clock, rc)
end if

!=====Begin intemittent replay=======================

! Set the intermittent replay alarm, if needed.
! Note that it is a non-sticky alarm
! and is set to ringing on first step. So it will
! work whether the clock is backed-up and ticked
! or not.

call MAPL_GridCompGetResource(gc, "REPLAY_MODE", ReplayMode, default="NoReplay", _RC)
if (adjustl(ReplayMode) == "Intermittent") then
call MAPL_GridCompGetResource(gc, "REPLAY_INTERVAL", DNS_INTERVAL, default=21600., _RC)
call ESMF_TimeIntervalSet(intv, s=nint(DNS_INTERVAL), _RC)
alarm = ESMF_AlarmCreate(name="INTERMITTENT", clock=clock, ringInterval=intv, sticky=.false., _RC)
call ESMF_AlarmRingerOn(alarm, _RC)
end if

!========End intermittent replay========================

_RETURN(_SUCCESS)
Expand Down Expand Up @@ -747,11 +741,10 @@ subroutine Run(gc, import, export, clock, rc)
real(r4), allocatable :: cubetemp3d(:,:,:)
real(r4), allocatable :: cubevtmp3d(:,:,:)

real(r4), pointer :: uh25(:,:)
real(r4), pointer :: uh03(:,:)
real(r4), pointer :: srh01(:,:)
real(r4), pointer :: srh03(:,:)
real(r4), pointer :: srh25(:,:)
real(r4), pointer :: uh25(:,:), uh03(:,:)
real(r4), pointer :: srh01(:,:), srh03(:,:), srh25(:,:)
real(r4), allocatable :: uh25tmp(:,:), uh03tmp(:,:)
real(r4), allocatable :: srh01tmp(:,:), srh03tmp(:,:), srh25tmp(:,:)

real(r8), allocatable :: uatmp(:,:,:)
real(r8), allocatable :: vatmp(:,:,:)
Expand Down Expand Up @@ -1036,7 +1029,7 @@ subroutine Run(gc, import, export, clock, rc)
! WMP Begin REPLAY/ANA section
call MAPL_GridCompGetResource(gc, "FV3_STANDALONE", FV3_STANDALONE, default=.false., _RC)
if (.not. FV3_STANDALONE) then
! call MAPL_TimerOn(MAPL, "-DYN_ANA")
call MAPL_GridCompTimerStart(gc, "DYN_ANA", _RC)
call ESMF_ClockGetAlarm(clock, "ReplayShutOff", alarm, _RC)
is_shutoff = ESMF_AlarmIsRinging(alarm, _RC)
else
Expand Down Expand Up @@ -1687,11 +1680,11 @@ subroutine Run(gc, import, export, clock, rc)
end if

endif
! if (.not. FV3_STANDALONE) then
! call MAPL_TimerOff(MAPL,"-DYN_ANA")
! endif
if (.not. FV3_STANDALONE) then
call MAPL_GridCompTimerStop(gc, "DYN_ANA", _RC)
endif

! call MAPL_TimerOn(MAPL,"-DYN_PROLOGUE")
call MAPL_GridCompTimerStart(gc,"DYN_PROLOGUE", _RC)
! Create FV Thermodynamic Variables
tempxy = vars%pt * vars%pkz ! Compute Dry Temperature

Expand Down Expand Up @@ -1859,18 +1852,18 @@ subroutine Run(gc, import, export, clock, rc)
! Get pressures before dynamics
pe0=vars%pe

! call MAPL_TimerOff(MAPL, "-DYN_PROLOGUE")
call MAPL_GridCompTimerStop(gc, "DYN_PROLOGUE", _RC)

!-------------------------------------------------------

! call MAPL_TimerOn(MAPL, "-DYN_CORE")
call MAPL_GridCompTimerStart(gc, "DYN_CORE", _RC)
t1 = MPI_Wtime(status)
call DynRun(self, export, clock, gc, PLE0=pe0, _RC)
t2 = MPI_Wtime(status)
dyn_run_timer = t2-t1
! call MAPL_TimerOff(MAPL, "-DYN_CORE")
call MAPL_GridCompTimerStop(gc, "DYN_CORE", _RC)

! call MAPL_TimerOn(MAPL, "-DYN_EPILOGUE")
call MAPL_GridCompTimerStart(gc, "DYN_EPILOGUE", _RC)
! Computational diagnostics
call MAPL_StateGetPointer(export, temp2d, "TIME_IN_DYN", _RC)
if(associated(temp2d)) temp2d = dyn_run_timer
Expand Down Expand Up @@ -2575,19 +2568,23 @@ subroutine Run(gc, import, export, clock, rc)
end if

! Updraft Helicty Exports
! pchakrab: TODO - how to handle `alloc=.true.` in MAPL3??
call MAPL_GetPointer(export, uh25, 'UH25', alloc=.true., _RC)
call MAPL_GetPointer(export, uh03, 'UH03', alloc=.true., _RC)
call MAPL_GetPointer(export, srh01,'SRH01', alloc=.true., _RC)
call MAPL_GetPointer(export, srh03,'SRH03', alloc=.true., _RC)
call MAPL_GetPointer(export, srh25,'SRH25', alloc=.true., _RC)
call MAPL_StateGetPointer(export, uh25, 'UH25', _RC)
call MAPL_StateGetPointer(export, uh03, 'UH03', _RC)
call MAPL_StateGetPointer(export, srh01,'SRH01', _RC)
call MAPL_StateGetPointer(export, srh03,'SRH03', _RC)
call MAPL_StateGetPointer(export, srh25,'SRH25', _RC)
! Per WMP, this calculation is not useful if running hydrostatic
if (.not. HYDROSTATIC) then
if( associated( uh25) .or. associated( uh03) .or. &
associated(srh01) .or. associated(srh03) .or. associated(srh25) ) then
call fv_getUpdraftHelicity(uh25, uh03, srh01, srh03, srh25)
if ( associated(uh25) .or. associated(uh03) .or. &
associated(srh01) .or. associated(srh03) .or. associated(srh03)) then
if (.not. HYDROSTATIC) then
call fv_getUpdraftHelicity(uh25tmp, uh03tmp, srh01tmp, srh03tmp, srh25tmp)
if (associated(uh25)) uh25 = uh25tmp
if (associated(uh03)) uh03 = uh03tmp
if (associated(srh01)) srh01 = srh01tmp
if (associated(srh03)) srh03 = srh03tmp
if (associated(srh25)) srh25 = srh25tmp
endif
endif
end if

! Divergence Exports
logpe = log(vars%pe)
Expand Down Expand Up @@ -2695,7 +2692,7 @@ subroutine Run(gc, import, export, clock, rc)

end if ! SW_DYNAMICS

! call MAPL_TimerOff(MAPL, "-DYN_EPILOGUE")
call MAPL_GridCompTimerStop(gc, "DYN_EPILOGUE", _RC)

! De-Allocate Arrays

Expand Down Expand Up @@ -3417,11 +3414,6 @@ subroutine state_remap_
call logger%info(trim(STRING))
endif
_ASSERT(nq3d>=2, "state_remap: invalid number of tracers")
! if (nq3d<2) then
! call WRITE_PARALLEL('state_remap: invalid number of tracers')
! status=999
! _VERIFY(STATUS)
! endif

iib = lbound(vars%pe,1)
iie = ubound(vars%pe,1)
Expand Down Expand Up @@ -3458,21 +3450,11 @@ subroutine state_remap_
if (rank==3) then
icnt=icnt+1
_ASSERT(icnt<=nq3d, "state_remap: number of tracers exceeds known value")
! if (icnt>nq3d) then
! call WRITE_PARALLEL('state_remap: number of tracers exceeds known value')
! status=999
! _VERIFY(STATUS)
! endif
call ESMFL_BundleGetPointerToData(BUNDLE, NAME, ptr3dr4, _RC)
ana_qq(:,:,:,icnt) = ptr3dr4
endif
enddo
_ASSERT(icnt==nq3d, "state_remap: inconsitent number of tracers")
! if (icnt/=nq3d) then
! call WRITE_PARALLEL('state_remap: inconsitent number of tracers')
! status=999
! _VERIFY(STATUS)
! endif
else
if( qqq%is_r4 ) then
ana_qq(:,:,:,1) = qqq%content_r4(:,:,:)
Expand Down Expand Up @@ -3602,6 +3584,9 @@ subroutine PULL_Q(self, import, QQQ, iNXQ, InFieldName, rc)
self%vars%TRACER(N)%TNAME = fieldname
if ( self%vars%TRACER(N)%IS_R4 ) then
call ESMF_ArrayGet(array, localDE=0, farrayptr=ptr_r4, _RC)
! gfortran has trouble with pointer bounds remapping
! (Error: Rank remapping target must be rank 1 or simply contiguous)
! self%vars%tracer(n)%content_r4(i1:in, j1:jn, 1:km) => ptr_r4
self%vars%tracer(n)%content_r4 => MAPL_RemapBounds(ptr_r4, i1, in, j1, jn, 1, km)
if (fieldname == QFieldName) then
qqq%is_r4 = .true.
Expand Down Expand Up @@ -3802,9 +3787,9 @@ subroutine RunAddIncs(gc, import, export, clock, rc)
endif

! Add Diabatic Forcing to State Variables
! call MAPL_TimerOn (GENSTATE,"PHYS_ADD_INCS")
call MAPL_GridCompTimerStart(gc, "PHYS_ADD_INCS", _RC)
call ADD_INCS(esmfgrid, self, import, DT)
! call MAPL_TimerOff(GENSTATE,"PHYS_ADD_INCS")
call MAPL_GridCompTimerStop(gc, "PHYS_ADD_INCS", _RC)

if (DYN_DEBUG) call DEBUG_FV_STATE('PHYSICS ADD_INCS', self)

Expand Down Expand Up @@ -4462,8 +4447,7 @@ subroutine ADD_INCS(esmfgrid, self, import, DT, is_weighted, rc)
tend_va(is:ie,js:je,1:km) = tend

!if (.not. HYDROSTATIC ) then
! call ESMFL_StateGetPointerToData ( import,TEND,'DWDT',RC=STATUS )
! VERIFY_(STATUS)
! call MAPL_StateGetPointer(import, TEND, 'DWDT', _RC)
! self%vars%W = self%vars%W + DT*TEND(is:ie,js:je,1:km)
!endif

Expand Down
Loading
Loading