From c80ebd360e9c0d5722e677837f4a23f89cab2cc6 Mon Sep 17 00:00:00 2001 From: Steven Brus Date: Fri, 29 Mar 2024 07:50:17 -0700 Subject: [PATCH 1/4] Add provis_state subpool at RK4 init - Avoids create/destroy at each timestep --- .../src/framework/mpas_pool_routines.F | 196 ++++++++++++------ .../mpas_ocn_time_integration_rk4.F | 80 ++++--- 2 files changed, 165 insertions(+), 111 deletions(-) diff --git a/components/mpas-framework/src/framework/mpas_pool_routines.F b/components/mpas-framework/src/framework/mpas_pool_routines.F index 9611129c8eae..161ddcb0488e 100644 --- a/components/mpas-framework/src/framework/mpas_pool_routines.F +++ b/components/mpas-framework/src/framework/mpas_pool_routines.F @@ -932,20 +932,32 @@ end subroutine mpas_pool_clone_pool!}}} !> copy the data from the members of srcPool into the members of destPool. ! !----------------------------------------------------------------------- - recursive subroutine mpas_pool_copy_pool(srcPool, destPool)!{{{ + recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevel)!{{{ implicit none type (mpas_pool_type), pointer :: srcPool type (mpas_pool_type), pointer :: destPool + integer, intent(in), optional :: overrideTimeLevel integer :: i, j, threadNum + integer :: timeLevel type (mpas_pool_member_type), pointer :: ptr type (mpas_pool_data_type), pointer :: dptr type (mpas_pool_data_type), pointer :: mem threadNum = mpas_threading_get_thread_num() + timeLevel = 2 + + if (present(overrideTimeLevel)) then + timeLevel = overrideTimeLevel + + if (timeLevel < 1) then + call mpas_pool_set_error_level(MPAS_POOL_FATAL) + call pool_mesg('ERROR in mpas_pool_clone_pool: Input time levels cannot be less than 1.') + end if + end if if ( threadNum == 0 ) then do i=1,srcPool % size @@ -1014,83 +1026,135 @@ recursive subroutine mpas_pool_copy_pool(srcPool, destPool)!{{{ else if (associated(dptr % l0)) then call mpas_duplicate_field(dptr % l0, mem % l0, copy_array_only=.true.) else if (associated(dptr % r0a)) then - do j=1,mem % contentsTimeLevs - mem % r0 => mem % r0a(j) - call mpas_duplicate_field(dptr % r0a(j), mem % r0, copy_array_only=.true.) - nullify(mem % r0) - end do + if (timeLevel > 1) then + do j=1,mem % contentsTimeLevs + mem % r0 => mem % r0a(j) + call mpas_duplicate_field(dptr % r0a(j), mem % r0, copy_array_only=.true.) + nullify(mem % r0) + end do + else + call mpas_duplicate_field(dptr % r0a(1), mem % r0, copy_array_only=.true.) + end if else if (associated(dptr % r1a)) then - do j=1,mem % contentsTimeLevs - mem % r1 => mem % r1a(j) - call mpas_duplicate_field(dptr % r1a(j), mem % r1, copy_array_only=.true.) - nullify(mem % r1) - end do + if (timeLevel > 1) then + do j=1,mem % contentsTimeLevs + mem % r1 => mem % r1a(j) + call mpas_duplicate_field(dptr % r1a(j), mem % r1, copy_array_only=.true.) + nullify(mem % r1) + end do + else + call mpas_duplicate_field(dptr % r1a(1), mem % r1, copy_array_only=.true.) + end if else if (associated(dptr % r2a)) then - do j=1,mem % contentsTimeLevs - mem % r2 => mem % r2a(j) - call mpas_duplicate_field(dptr % r2a(j), mem % r2, copy_array_only=.true.) - nullify(mem % r2) - end do + if (timeLevel > 1) then + do j=1,mem % contentsTimeLevs + mem % r2 => mem % r2a(j) + call mpas_duplicate_field(dptr % r2a(j), mem % r2, copy_array_only=.true.) + nullify(mem % r2) + end do + else + call mpas_duplicate_field(dptr % r2a(1), mem % r2, copy_array_only=.true.) + end if else if (associated(dptr % r3a)) then - do j=1,mem % contentsTimeLevs - mem % r3 => mem % r3a(j) - call mpas_duplicate_field(dptr % r3a(j), mem % r3, copy_array_only=.true.) - nullify(mem % r3) - end do + if (timeLevel > 1) then + do j=1,mem % contentsTimeLevs + mem % r3 => mem % r3a(j) + call mpas_duplicate_field(dptr % r3a(j), mem % r3, copy_array_only=.true.) + nullify(mem % r3) + end do + else + call mpas_duplicate_field(dptr % r3a(1), mem % r3, copy_array_only=.true.) + end if else if (associated(dptr % r4a)) then - do j=1,mem % contentsTimeLevs - mem % r4 => mem % r4a(j) - call mpas_duplicate_field(dptr % r4a(j), mem % r4, copy_array_only=.true.) - nullify(mem % r4) - end do + if (timeLevel > 1) then + do j=1,mem % contentsTimeLevs + mem % r4 => mem % r4a(j) + call mpas_duplicate_field(dptr % r4a(j), mem % r4, copy_array_only=.true.) + nullify(mem % r4) + end do + else + call mpas_duplicate_field(dptr % r4a(1), mem % r4, copy_array_only=.true.) + end if else if (associated(dptr % r5a)) then - do j=1,mem % contentsTimeLevs - mem % r5 => mem % r5a(j) - call mpas_duplicate_field(dptr % r5a(j), mem % r5, copy_array_only=.true.) - nullify(mem % r5) - end do + if (timeLevel > 1) then + do j=1,mem % contentsTimeLevs + mem % r5 => mem % r5a(j) + call mpas_duplicate_field(dptr % r5a(j), mem % r5, copy_array_only=.true.) + nullify(mem % r5) + end do + else + call mpas_duplicate_field(dptr % r5a(1), mem % r5, copy_array_only=.true.) + end if else if (associated(dptr % i0a)) then - do j=1,mem % contentsTimeLevs - mem % i0 => mem % i0a(j) - call mpas_duplicate_field(dptr % i0a(j), mem % i0, copy_array_only=.true.) - nullify(mem % i0) - end do + if (timeLevel > 1) then + do j=1,mem % contentsTimeLevs + mem % i0 => mem % i0a(j) + call mpas_duplicate_field(dptr % i0a(j), mem % i0, copy_array_only=.true.) + nullify(mem % i0) + end do + else + call mpas_duplicate_field(dptr % i0a(1), mem % i0, copy_array_only=.true.) + end if else if (associated(dptr % i1a)) then - do j=1,mem % contentsTimeLevs - mem % i1 => mem % i1a(j) - call mpas_duplicate_field(dptr % i1a(j), mem % i1, copy_array_only=.true.) - nullify(mem % i1) - end do + if (timeLevel > 1) then + do j=1,mem % contentsTimeLevs + mem % i1 => mem % i1a(j) + call mpas_duplicate_field(dptr % i1a(j), mem % i1, copy_array_only=.true.) + nullify(mem % i1) + end do + else + call mpas_duplicate_field(dptr % i1a(1), mem % i1, copy_array_only=.true.) + end if else if (associated(dptr % i2a)) then - do j=1,mem % contentsTimeLevs - mem % i2 => mem % i2a(j) - call mpas_duplicate_field(dptr % i2a(j), mem % i2, copy_array_only=.true.) - nullify(mem % i2) - end do + if (timeLevel > 1) then + do j=1,mem % contentsTimeLevs + mem % i2 => mem % i2a(j) + call mpas_duplicate_field(dptr % i2a(j), mem % i2, copy_array_only=.true.) + nullify(mem % i2) + end do + else + call mpas_duplicate_field(dptr % i2a(1), mem % i2, copy_array_only=.true.) + end if else if (associated(dptr % i3a)) then - do j=1,mem % contentsTimeLevs - mem % i3 => mem % i3a(j) - call mpas_duplicate_field(dptr % i3a(j), mem % i3, copy_array_only=.true.) - nullify(mem % i3) - end do + if (timeLevel > 1) then + do j=1,mem % contentsTimeLevs + mem % i3 => mem % i3a(j) + call mpas_duplicate_field(dptr % i3a(j), mem % i3, copy_array_only=.true.) + nullify(mem % i3) + end do + else + call mpas_duplicate_field(dptr % i3a(1), mem % i3, copy_array_only=.true.) + end if else if (associated(dptr % c0a)) then - do j=1,mem % contentsTimeLevs - mem % c0 => mem % c0a(j) - call mpas_duplicate_field(dptr % c0a(j), mem % c0, copy_array_only=.true.) - nullify(mem % c0) - end do + if (timeLevel > 1) then + do j=1,mem % contentsTimeLevs + mem % c0 => mem % c0a(j) + call mpas_duplicate_field(dptr % c0a(j), mem % c0, copy_array_only=.true.) + nullify(mem % c0) + end do + else + call mpas_duplicate_field(dptr % c0a(1), mem % c0, copy_array_only=.true.) + end if else if (associated(dptr % c1a)) then - do j=1,mem % contentsTimeLevs - mem % c1 => mem % c1a(j) - call mpas_duplicate_field(dptr % c1a(j), mem % c1, copy_array_only=.true.) - nullify(mem % c1) - end do + if (timeLevel > 1) then + do j=1,mem % contentsTimeLevs + mem % c1 => mem % c1a(j) + call mpas_duplicate_field(dptr % c1a(j), mem % c1, copy_array_only=.true.) + nullify(mem % c1) + end do + else + call mpas_duplicate_field(dptr % c1a(1), mem % c1, copy_array_only=.true.) + end if else if (associated(dptr % l0a)) then - do j=1,mem % contentsTimeLevs - mem % l0 => mem % l0a(j) - call mpas_duplicate_field(dptr % l0a(j), mem % l0, copy_array_only=.true.) - nullify(mem % l0) - end do + if (timeLevel > 1) then + do j=1,mem % contentsTimeLevs + mem % l0 => mem % l0a(j) + call mpas_duplicate_field(dptr % l0a(j), mem % l0, copy_array_only=.true.) + nullify(mem % l0) + end do + else + call mpas_duplicate_field(dptr % l0a(1), mem % l0, copy_array_only=.true.) + end if else call pool_mesg('While copying pool, member '//trim(ptr % key)//' has no valid field pointers.') end if diff --git a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_rk4.F b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_rk4.F index af583448157c..d4f4021eb67f 100644 --- a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_rk4.F +++ b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_rk4.F @@ -228,10 +228,9 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{ call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) call mpas_pool_get_subpool(block % structs, 'diagnostics', diagnosticsPool) - call mpas_pool_create_pool(provisStatePool) + call mpas_pool_get_subpool(block % structs, 'provis_state', provisStatePool) - call mpas_pool_clone_pool(statePool, provisStatePool, 1) - call mpas_pool_add_subpool(block % structs, 'provis_state', provisStatePool) + call mpas_pool_copy_pool(statePool, provisStatePool, 1) call mpas_pool_get_dimension(block % dimensions, 'nCells', nCells) call mpas_pool_get_dimension(block % dimensions, 'nEdges', nEdges) @@ -315,37 +314,6 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{ block => block % next end do - block => domain % blocklist - do while(associated(block)) - if (associated(block % prev)) then - call mpas_pool_get_subpool(block % prev % structs, 'provis_state', prevProvisPool) - else - nullify(prevProvisPool) - end if - - if (associated(block % next)) then - call mpas_pool_get_subpool(block % next % structs, 'provis_state', nextProvisPool) - else - nullify(nextProvisPool) - end if - - call mpas_pool_get_subpool(block % structs, 'provis_state', provisStatePool) - - if (associated(prevProvisPool) .and. associated(nextProvisPool)) then - call mpas_pool_link_pools(provisStatePool, prevProvisPool, nextProvisPool) - else if (associated(prevProvisPool)) then - call mpas_pool_link_pools(provisStatePool, prevProvisPool) - else if (associated(nextProvisPool)) then - call mpas_pool_link_pools(provisStatePool, nextPool=nextProvisPool) - else - call mpas_pool_link_pools(provisStatePool) - end if - - call mpas_pool_link_parinfo(block, provisStatePool) - - block => block % next - end do - ! Fourth-order Runge-Kutta, solving dy/dt = f(t,y) is typically written as follows ! where h = delta t is the large time step. Here f(t,y) is the right hand side, ! called the tendencies in the code below. @@ -853,16 +821,6 @@ subroutine ocn_time_integrator_rk4(domain, dt)!{{{ call mpas_timer_stop("RK4-cleanup phase") - block => domain % blocklist - do while(associated(block)) - call mpas_pool_get_subpool(block % structs, 'provis_state', provisStatePool) - - call mpas_pool_destroy_pool(provisStatePool) - - call mpas_pool_remove_subpool(block % structs, 'provis_state') - block => block % next - end do - end subroutine ocn_time_integrator_rk4!}}} subroutine ocn_time_integrator_rk4_compute_vel_tends(domain, block, dt, & @@ -1731,7 +1689,8 @@ subroutine ocn_time_integration_rk4_init(domain)!{{{ ! local variables !----------------------------------------------------------------- type (block_type), pointer :: block - type (mpas_pool_type), pointer :: meshPool + type (mpas_pool_type), pointer :: meshPool, statePool, provisStatePool + type (mpas_pool_type), pointer :: nextProvisPool, prevProvisPool logical, pointer :: config_use_debugTracers integer, pointer :: nVertLevels ! End preamble @@ -1742,12 +1701,43 @@ subroutine ocn_time_integration_rk4_init(domain)!{{{ block => domain % blocklist do while (associated(block)) call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(block % structs, 'state', statePool) call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels) if (config_use_debugTracers .and. nVertLevels == 1) then call mpas_log_write('Debug tracers may cause failures in a ' & // 'single layer case. Consider setting ' & // 'config_use_debugTracers to .false.', MPAS_LOG_WARN) endif + + call mpas_pool_create_pool(provisStatePool) + call mpas_pool_clone_pool(statePool, provisStatePool, 1) + call mpas_pool_add_subpool(block % structs, 'provis_state', provisStatePool) + + if (associated(block % prev)) then + call mpas_pool_get_subpool(block % prev % structs, 'provis_state', prevProvisPool) + else + nullify(prevProvisPool) + end if + + if (associated(block % next)) then + call mpas_pool_get_subpool(block % next % structs, 'provis_state', nextProvisPool) + else + nullify(nextProvisPool) + end if + + call mpas_pool_get_subpool(block % structs, 'provis_state', provisStatePool) + + if (associated(prevProvisPool) .and. associated(nextProvisPool)) then + call mpas_pool_link_pools(provisStatePool, prevProvisPool, nextProvisPool) + else if (associated(prevProvisPool)) then + call mpas_pool_link_pools(provisStatePool, prevProvisPool) + else if (associated(nextProvisPool)) then + call mpas_pool_link_pools(provisStatePool, nextPool=nextProvisPool) + else + call mpas_pool_link_pools(provisStatePool) + end if + + call mpas_pool_link_parinfo(block, provisStatePool) block => block % next end do From 12368b9d7f71efad9cb16dc9444fdc587a6a3497 Mon Sep 17 00:00:00 2001 From: Steven Brus Date: Wed, 3 Apr 2024 09:55:10 -0700 Subject: [PATCH 2/4] Improve overrideTimeLevels option for mpas_pool_copy_pool --- .../src/framework/mpas_pool_routines.F | 76 ++++++++++--------- 1 file changed, 41 insertions(+), 35 deletions(-) diff --git a/components/mpas-framework/src/framework/mpas_pool_routines.F b/components/mpas-framework/src/framework/mpas_pool_routines.F index 161ddcb0488e..89a489ca3088 100644 --- a/components/mpas-framework/src/framework/mpas_pool_routines.F +++ b/components/mpas-framework/src/framework/mpas_pool_routines.F @@ -932,30 +932,30 @@ end subroutine mpas_pool_clone_pool!}}} !> copy the data from the members of srcPool into the members of destPool. ! !----------------------------------------------------------------------- - recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevel)!{{{ + recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevels)!{{{ implicit none type (mpas_pool_type), pointer :: srcPool type (mpas_pool_type), pointer :: destPool - integer, intent(in), optional :: overrideTimeLevel + integer, intent(in), optional :: overrideTimeLevels integer :: i, j, threadNum - integer :: timeLevel + integer :: timeLevels type (mpas_pool_member_type), pointer :: ptr type (mpas_pool_data_type), pointer :: dptr type (mpas_pool_data_type), pointer :: mem threadNum = mpas_threading_get_thread_num() - timeLevel = 2 + timeLevels = -1 - if (present(overrideTimeLevel)) then - timeLevel = overrideTimeLevel + if (present(overrideTimeLevels)) then + timeLevels = overrideTimeLevels - if (timeLevel < 1) then + if (timeLevels < 1) then call mpas_pool_set_error_level(MPAS_POOL_FATAL) - call pool_mesg('ERROR in mpas_pool_clone_pool: Input time levels cannot be less than 1.') + call pool_mesg('ERROR in mpas_pool_copy_pool: Input time levels cannot be less than 1.') end if end if @@ -997,8 +997,14 @@ recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevel)!{ dptr => ptr % data - ! Do this through brute force... mem => pool_get_member(destPool, ptr % key, MPAS_POOL_FIELD) + + ! Allow for overrideTimeLevels + if (timeLevels == -1) then + timeLevels = mem % contentsTimeLevs + endif + + ! Do this through brute force... if (associated(dptr % r0)) then call mpas_duplicate_field(dptr % r0, mem % r0, copy_array_only=.true.) else if (associated(dptr % r1)) then @@ -1026,8 +1032,8 @@ recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevel)!{ else if (associated(dptr % l0)) then call mpas_duplicate_field(dptr % l0, mem % l0, copy_array_only=.true.) else if (associated(dptr % r0a)) then - if (timeLevel > 1) then - do j=1,mem % contentsTimeLevs + if (timeLevels > 1) then + do j=1,timeLevels mem % r0 => mem % r0a(j) call mpas_duplicate_field(dptr % r0a(j), mem % r0, copy_array_only=.true.) nullify(mem % r0) @@ -1036,8 +1042,8 @@ recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevel)!{ call mpas_duplicate_field(dptr % r0a(1), mem % r0, copy_array_only=.true.) end if else if (associated(dptr % r1a)) then - if (timeLevel > 1) then - do j=1,mem % contentsTimeLevs + if (timeLevels > 1) then + do j=1,timeLevels mem % r1 => mem % r1a(j) call mpas_duplicate_field(dptr % r1a(j), mem % r1, copy_array_only=.true.) nullify(mem % r1) @@ -1046,8 +1052,8 @@ recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevel)!{ call mpas_duplicate_field(dptr % r1a(1), mem % r1, copy_array_only=.true.) end if else if (associated(dptr % r2a)) then - if (timeLevel > 1) then - do j=1,mem % contentsTimeLevs + if (timeLevels > 1) then + do j=1,timeLevels mem % r2 => mem % r2a(j) call mpas_duplicate_field(dptr % r2a(j), mem % r2, copy_array_only=.true.) nullify(mem % r2) @@ -1056,8 +1062,8 @@ recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevel)!{ call mpas_duplicate_field(dptr % r2a(1), mem % r2, copy_array_only=.true.) end if else if (associated(dptr % r3a)) then - if (timeLevel > 1) then - do j=1,mem % contentsTimeLevs + if (timeLevels > 1) then + do j=1,timeLevels mem % r3 => mem % r3a(j) call mpas_duplicate_field(dptr % r3a(j), mem % r3, copy_array_only=.true.) nullify(mem % r3) @@ -1066,8 +1072,8 @@ recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevel)!{ call mpas_duplicate_field(dptr % r3a(1), mem % r3, copy_array_only=.true.) end if else if (associated(dptr % r4a)) then - if (timeLevel > 1) then - do j=1,mem % contentsTimeLevs + if (timeLevels > 1) then + do j=1,timeLevels mem % r4 => mem % r4a(j) call mpas_duplicate_field(dptr % r4a(j), mem % r4, copy_array_only=.true.) nullify(mem % r4) @@ -1076,8 +1082,8 @@ recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevel)!{ call mpas_duplicate_field(dptr % r4a(1), mem % r4, copy_array_only=.true.) end if else if (associated(dptr % r5a)) then - if (timeLevel > 1) then - do j=1,mem % contentsTimeLevs + if (timeLevels > 1) then + do j=1,timeLevels mem % r5 => mem % r5a(j) call mpas_duplicate_field(dptr % r5a(j), mem % r5, copy_array_only=.true.) nullify(mem % r5) @@ -1086,8 +1092,8 @@ recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevel)!{ call mpas_duplicate_field(dptr % r5a(1), mem % r5, copy_array_only=.true.) end if else if (associated(dptr % i0a)) then - if (timeLevel > 1) then - do j=1,mem % contentsTimeLevs + if (timeLevels > 1) then + do j=1,timeLevels mem % i0 => mem % i0a(j) call mpas_duplicate_field(dptr % i0a(j), mem % i0, copy_array_only=.true.) nullify(mem % i0) @@ -1096,8 +1102,8 @@ recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevel)!{ call mpas_duplicate_field(dptr % i0a(1), mem % i0, copy_array_only=.true.) end if else if (associated(dptr % i1a)) then - if (timeLevel > 1) then - do j=1,mem % contentsTimeLevs + if (timeLevels > 1) then + do j=1,timeLevels mem % i1 => mem % i1a(j) call mpas_duplicate_field(dptr % i1a(j), mem % i1, copy_array_only=.true.) nullify(mem % i1) @@ -1106,8 +1112,8 @@ recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevel)!{ call mpas_duplicate_field(dptr % i1a(1), mem % i1, copy_array_only=.true.) end if else if (associated(dptr % i2a)) then - if (timeLevel > 1) then - do j=1,mem % contentsTimeLevs + if (timeLevels > 1) then + do j=1,timeLevels mem % i2 => mem % i2a(j) call mpas_duplicate_field(dptr % i2a(j), mem % i2, copy_array_only=.true.) nullify(mem % i2) @@ -1116,8 +1122,8 @@ recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevel)!{ call mpas_duplicate_field(dptr % i2a(1), mem % i2, copy_array_only=.true.) end if else if (associated(dptr % i3a)) then - if (timeLevel > 1) then - do j=1,mem % contentsTimeLevs + if (timeLevels > 1) then + do j=1,timeLevels mem % i3 => mem % i3a(j) call mpas_duplicate_field(dptr % i3a(j), mem % i3, copy_array_only=.true.) nullify(mem % i3) @@ -1126,8 +1132,8 @@ recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevel)!{ call mpas_duplicate_field(dptr % i3a(1), mem % i3, copy_array_only=.true.) end if else if (associated(dptr % c0a)) then - if (timeLevel > 1) then - do j=1,mem % contentsTimeLevs + if (timeLevels > 1) then + do j=1,timeLevels mem % c0 => mem % c0a(j) call mpas_duplicate_field(dptr % c0a(j), mem % c0, copy_array_only=.true.) nullify(mem % c0) @@ -1136,8 +1142,8 @@ recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevel)!{ call mpas_duplicate_field(dptr % c0a(1), mem % c0, copy_array_only=.true.) end if else if (associated(dptr % c1a)) then - if (timeLevel > 1) then - do j=1,mem % contentsTimeLevs + if (timeLevels > 1) then + do j=1,timeLevels mem % c1 => mem % c1a(j) call mpas_duplicate_field(dptr % c1a(j), mem % c1, copy_array_only=.true.) nullify(mem % c1) @@ -1146,8 +1152,8 @@ recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevel)!{ call mpas_duplicate_field(dptr % c1a(1), mem % c1, copy_array_only=.true.) end if else if (associated(dptr % l0a)) then - if (timeLevel > 1) then - do j=1,mem % contentsTimeLevs + if (timeLevels > 1) then + do j=1,timeLevels mem % l0 => mem % l0a(j) call mpas_duplicate_field(dptr % l0a(j), mem % l0, copy_array_only=.true.) nullify(mem % l0) From 2f49d4920706c1ba5e4088c6da4cd2f9728f7c1a Mon Sep 17 00:00:00 2001 From: Steven Brus Date: Fri, 5 Apr 2024 07:02:25 -0700 Subject: [PATCH 3/4] Add addtional subpools for LTS and FBLTS at init --- .../mpas_ocn_time_integration_fblts.F | 119 +++++----- .../mpas_ocn_time_integration_lts.F | 204 +++++++++--------- 2 files changed, 174 insertions(+), 149 deletions(-) diff --git a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_fblts.F b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_fblts.F index 36b6dc05766f..5b0db3848cb4 100644 --- a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_fblts.F +++ b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_fblts.F @@ -224,13 +224,12 @@ subroutine ocn_time_integrator_fblts(domain, dt)!{{{ call mpas_pool_get_array(LTSPool, 'nEdgesInLTSRegion', nEdgesInLTSRegion) ! Create and retrieve additional pools for LTS - call mpas_pool_create_pool(tendSum3rdPool) - call mpas_pool_clone_pool(tendPool, tendSum3rdPool, 1) - call mpas_pool_create_pool(tendSlowPool) - call mpas_pool_clone_pool(tendPool, tendSlowPool, 1) + call mpas_pool_get_subpool(block % structs, 'tend_sum_3rd', tendSum3rdPool) + call mpas_pool_get_subpool(block % structs, 'tend_slow', tendSlowPool) + + call mpas_pool_copy_pool(tendPool, tendSum3rdPool, 1) + call mpas_pool_copy_pool(tendPool, tendSlowPool, 1) - call mpas_pool_add_subpool(block % structs, 'tend_sum_3rd', tendSum3rdPool) - call mpas_pool_add_subpool(block % structs, 'tend_slow', tendSlowPool) call mpas_pool_get_array(tendSlowPool, 'normalVelocity', & normalVelocityTendSlow) @@ -259,47 +258,6 @@ subroutine ocn_time_integrator_fblts(domain, dt)!{{{ normalVelocityTendSum3rd(:,:) = 0.0_RKIND layerThicknessTendSum3rd(:,:) = 0.0_RKIND - if (associated(block % prev)) then - call mpas_pool_get_subpool(block % prev % structs, 'tend_sum_3rd', tendSum3rdPool) - call mpas_pool_get_subpool(block % prev % structs, 'tend_slow', tendSlowPool) - else - nullify(prevTendSum3rdPool) - nullify(prevTendSlowPool) - end if - - if (associated(block % next)) then - call mpas_pool_get_subpool(block % next % structs, 'tend_sum_3rd', nextTendSum3rdPool) - call mpas_pool_get_subpool(block % next % structs, 'tend_slow', nextTendSlowPool) - else - nullify(nextTendSum3rdPool) - nullify(nextTendSlowPool) - end if - - call mpas_pool_get_subpool(block % structs, 'tend_sum_3rd', tendSum3rdPool) - call mpas_pool_get_subpool(block % structs, 'tend_slow', tendSlowPool) - - if (associated(prevTendSum3rdPool) .and. associated(nextTendSum3rdPool)) then - call mpas_pool_link_pools(tendSum3rdPool, prevTendSum3rdPool, nextTendSum3rdPool) - else if (associated(prevTendSum3rdPool)) then - call mpas_pool_link_pools(tendSum3rdPool, prevTendSum3rdPool) - else if (associated(nextTendSum3rdPool)) then - call mpas_pool_link_pools(tendSum3rdPool,nextPool=nextTendSum3rdPool) - else - call mpas_pool_link_pools(tendSum3rdPool) - end if - - if (associated(prevTendSlowPool) .and. associated(nextTendSlowPool)) then - call mpas_pool_link_pools(tendSlowPool, prevTendSlowPool, nextTendSlowPool) - else if (associated(prevTendSlowPool)) then - call mpas_pool_link_pools(tendSlowPool, prevTendSlowPool) - else if (associated(nextTendSlowPool)) then - call mpas_pool_link_pools(tendSlowPool,nextPool=nextTendSlowPool) - else - call mpas_pool_link_pools(tendSlowPool) - end if - - call mpas_pool_link_parinfo(block, tendSum3rdPool) - call mpas_pool_link_parinfo(block, tendSlowPool) call mpas_timer_stop("FB_LTS time-step prep") @@ -1367,12 +1325,6 @@ subroutine ocn_time_integrator_fblts(domain, dt)!{{{ call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, & verticalMeshPool, scratchPool, tracersPool, 2) - call mpas_pool_destroy_pool(tendSum3rdPool) - call mpas_pool_destroy_pool(tendSlowPool) - - call mpas_pool_remove_subpool(block % structs, 'tend_sum_3rd') - call mpas_pool_remove_subpool(block % structs, 'tend_slow') - call mpas_timer_stop("FB_LTS cleanup") end subroutine ocn_time_integrator_fblts!}}} @@ -1415,6 +1367,15 @@ subroutine ocn_time_integration_fblts_init(domain)!{{{ type (mpas_pool_type), pointer :: & LTSPool + + type (mpas_pool_type), pointer :: & + tendSlowPool, & + tendSum3rdPool, & + prevTendSlowPool, nextTendSlowPool, & + prevTendSum3rdPool, nextTendSum3rdPool + + type (mpas_pool_type), pointer :: & + tendPool integer, dimension(:), allocatable :: & isLTSRegionEdgeAssigned @@ -1445,6 +1406,58 @@ subroutine ocn_time_integration_fblts_init(domain)!{{{ minMaxLTSRegion(2) = 2 block => domain % blocklist + call mpas_pool_get_subpool(block%structs, 'tend', tendPool) + + call mpas_pool_create_pool(tendSum3rdPool) + call mpas_pool_clone_pool(tendPool, tendSum3rdPool, 1) + call mpas_pool_create_pool(tendSlowPool) + call mpas_pool_clone_pool(tendPool, tendSlowPool, 1) + + call mpas_pool_add_subpool(block % structs, 'tend_sum_3rd', tendSum3rdPool) + call mpas_pool_add_subpool(block % structs, 'tend_slow', tendSlowPool) + + if (associated(block % prev)) then + call mpas_pool_get_subpool(block % prev % structs, 'tend_sum_3rd', tendSum3rdPool) + call mpas_pool_get_subpool(block % prev % structs, 'tend_slow', tendSlowPool) + else + nullify(prevTendSum3rdPool) + nullify(prevTendSlowPool) + end if + + if (associated(block % next)) then + call mpas_pool_get_subpool(block % next % structs, 'tend_sum_3rd', nextTendSum3rdPool) + call mpas_pool_get_subpool(block % next % structs, 'tend_slow', nextTendSlowPool) + else + nullify(nextTendSum3rdPool) + nullify(nextTendSlowPool) + end if + + call mpas_pool_get_subpool(block % structs, 'tend_sum_3rd', tendSum3rdPool) + call mpas_pool_get_subpool(block % structs, 'tend_slow', tendSlowPool) + + if (associated(prevTendSum3rdPool) .and. associated(nextTendSum3rdPool)) then + call mpas_pool_link_pools(tendSum3rdPool, prevTendSum3rdPool, nextTendSum3rdPool) + else if (associated(prevTendSum3rdPool)) then + call mpas_pool_link_pools(tendSum3rdPool, prevTendSum3rdPool) + else if (associated(nextTendSum3rdPool)) then + call mpas_pool_link_pools(tendSum3rdPool,nextPool=nextTendSum3rdPool) + else + call mpas_pool_link_pools(tendSum3rdPool) + end if + + if (associated(prevTendSlowPool) .and. associated(nextTendSlowPool)) then + call mpas_pool_link_pools(tendSlowPool, prevTendSlowPool, nextTendSlowPool) + else if (associated(prevTendSlowPool)) then + call mpas_pool_link_pools(tendSlowPool, prevTendSlowPool) + else if (associated(nextTendSlowPool)) then + call mpas_pool_link_pools(tendSlowPool,nextPool=nextTendSlowPool) + else + call mpas_pool_link_pools(tendSlowPool) + end if + + call mpas_pool_link_parinfo(block, tendSum3rdPool) + call mpas_pool_link_parinfo(block, tendSlowPool) + call mpas_pool_get_subpool(block % structs, 'LTS', LTSPool) call mpas_pool_get_array(LTSPool, 'LTSRegion', LTSRegion) diff --git a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_lts.F b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_lts.F index d123c69aecb5..24f9f208ab3b 100644 --- a/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_lts.F +++ b/components/mpas-ocean/src/mode_forward/mpas_ocn_time_integration_lts.F @@ -254,20 +254,18 @@ subroutine ocn_time_integrator_lts(domain,dt)!{{{ call mpas_pool_get_array(LTSPool, 'nEdgesInLTSRegion', & nEdgesInLTSRegion) - !--- Create additional pools for LTS - call mpas_pool_create_pool(tendSum1stPool) - call mpas_pool_clone_pool(tendPool, tendSum1stPool, 1) - call mpas_pool_create_pool(tendSum2ndPool) - call mpas_pool_clone_pool(tendPool, tendSum2ndPool, 1) - call mpas_pool_create_pool(tendSum3rdPool) - call mpas_pool_clone_pool(tendPool, tendSum3rdPool, 1) - call mpas_pool_create_pool(tendSlowPool) - call mpas_pool_clone_pool(tendPool, tendSlowPool, 1) + !--- Update additional pools for LTS + call mpas_pool_get_subpool(block % structs, 'tend_sum_1st', tendSum1stPool) + call mpas_pool_get_subpool(block % structs, 'tend_sum_2nd', tendSum2ndPool) + call mpas_pool_get_subpool(block % structs, 'tend_sum_3rd', tendSum3rdPool) + call mpas_pool_get_subpool(block % structs, 'tend_slow', tendSlowPool) + + + call mpas_pool_copy_pool(tendPool, tendSum1stPool, 1) + call mpas_pool_copy_pool(tendPool, tendSum2ndPool, 1) + call mpas_pool_copy_pool(tendPool, tendSum3rdPool, 1) + call mpas_pool_copy_pool(tendPool, tendSlowPool, 1) - call mpas_pool_add_subpool(block % structs, 'tend_sum_1st', tendSum1stPool) - call mpas_pool_add_subpool(block % structs, 'tend_sum_2nd', tendSum2ndPool) - call mpas_pool_add_subpool(block % structs, 'tend_sum_3rd', tendSum3rdPool) - call mpas_pool_add_subpool(block % structs, 'tend_slow', tendSlowPool) call mpas_pool_get_array(tendSlowPool, 'normalVelocity', normalVelocityTendSlow) @@ -307,79 +305,6 @@ subroutine ocn_time_integrator_lts(domain,dt)!{{{ normalVelocityTendSum3rd(:,:) = 0.0_RKIND layerThicknessTendSum3rd(:,:) = 0.0_RKIND - if (associated(block % prev)) then - call mpas_pool_get_subpool(block % prev % structs, 'tend_sum_1st', tendSum1stPool) - call mpas_pool_get_subpool(block % prev % structs, 'tend_sum_2nd', tendSum2ndPool) - call mpas_pool_get_subpool(block % prev % structs, 'tend_sum_3rd', tendSum3rdPool) - call mpas_pool_get_subpool(block % prev % structs, 'tend_slow', tendSlowPool) - else - nullify(prevTendSum1stPool) - nullify(prevTendSum2ndPool) - nullify(prevTendSum3rdPool) - nullify(prevTendSlowPool) - end if - - if (associated(block % next)) then - call mpas_pool_get_subpool(block % next % structs, 'tend_sum_1st', nextTendSum1stPool) - call mpas_pool_get_subpool(block % next % structs, 'tend_sum_2nd', nextTendSum2ndPool) - call mpas_pool_get_subpool(block % next % structs, 'tend_sum_3rd', nextTendSum3rdPool) - call mpas_pool_get_subpool(block % next % structs, 'tend_slow', nextTendSlowPool) - else - nullify(nextTendSum1stPool) - nullify(nextTendSum2ndPool) - nullify(nextTendSum3rdPool) - nullify(nextTendSlowPool) - end if - - call mpas_pool_get_subpool(block % structs, 'tend_sum_1st', tendSum1stPool) - call mpas_pool_get_subpool(block % structs, 'tend_sum_2nd', tendSum2ndPool) - call mpas_pool_get_subpool(block % structs, 'tend_sum_3rd', tendSum3rdPool) - call mpas_pool_get_subpool(block % structs, 'tend_slow', tendSlowPool) - - if (associated(prevTendSum1stPool) .and. associated(nextTendSum1stPool)) then - call mpas_pool_link_pools(tendSum1stPool, prevTendSum1stPool, nextTendSum1stPool) - else if (associated(prevTendSum1stPool)) then - call mpas_pool_link_pools(tendSum1stPool, prevTendSum1stPool) - else if (associated(nextTendSum1stPool)) then - call mpas_pool_link_pools(tendSum1stPool,nextPool=nextTendSum1stPool) - else - call mpas_pool_link_pools(tendSum1stPool) - end if - - if (associated(prevTendSum2ndPool) .and. associated(nextTendSum2ndPool)) then - call mpas_pool_link_pools(tendSum2ndPool, prevTendSum2ndPool, nextTendSum2ndPool) - else if (associated(prevTendSum2ndPool)) then - call mpas_pool_link_pools(tendSum2ndPool, prevTendSum2ndPool) - else if (associated(nextTendSum2ndPool)) then - call mpas_pool_link_pools(tendSum2ndPool,nextPool=nextTendSum2ndPool) - else - call mpas_pool_link_pools(tendSum2ndPool) - end if - - if (associated(prevTendSum3rdPool) .and. associated(nextTendSum3rdPool)) then - call mpas_pool_link_pools(tendSum3rdPool, prevTendSum3rdPool, nextTendSum3rdPool) - else if (associated(prevTendSum3rdPool)) then - call mpas_pool_link_pools(tendSum3rdPool, prevTendSum3rdPool) - else if (associated(nextTendSum3rdPool)) then - call mpas_pool_link_pools(tendSum3rdPool,nextPool=nextTendSum3rdPool) - else - call mpas_pool_link_pools(tendSum3rdPool) - end if - - if (associated(prevTendSlowPool) .and. associated(nextTendSlowPool)) then - call mpas_pool_link_pools(tendSlowPool, prevTendSlowPool, nextTendSlowPool) - else if (associated(prevTendSlowPool)) then - call mpas_pool_link_pools(tendSlowPool, prevTendSlowPool) - else if (associated(nextTendSlowPool)) then - call mpas_pool_link_pools(tendSlowPool,nextPool=nextTendSlowPool) - else - call mpas_pool_link_pools(tendSlowPool) - end if - - call mpas_pool_link_parinfo(block, tendSum1stPool) - call mpas_pool_link_parinfo(block, tendSum2ndPool) - call mpas_pool_link_parinfo(block, tendSum3rdPool) - call mpas_pool_link_parinfo(block, tendSlowPool) call mpas_timer_stop("lts time-step prep") @@ -1084,16 +1009,6 @@ subroutine ocn_time_integrator_lts(domain,dt)!{{{ ! DIAGNOSTICS UPDATE --- call ocn_diagnostic_solve(dt, statePool, forcingPool, meshPool, verticalMeshPool, scratchPool, tracersPool, 2) - call mpas_pool_destroy_pool(tendSum1stPool) - call mpas_pool_destroy_pool(tendSum2ndPool) - call mpas_pool_destroy_pool(tendSum3rdPool) - call mpas_pool_destroy_pool(tendSlowPool) - - call mpas_pool_remove_subpool(block % structs, 'tend_sum_1st') - call mpas_pool_remove_subpool(block % structs, 'tend_sum_2nd') - call mpas_pool_remove_subpool(block % structs, 'tend_sum_3rd') - call mpas_pool_remove_subpool(block % structs, 'tend_slow') - call mpas_timer_stop("lts cleanup phase") @@ -1123,6 +1038,16 @@ subroutine ocn_time_integration_lts_init(domain)!{{{ type (block_type), pointer :: block type (mpas_pool_type), pointer :: LTSPool + type (mpas_pool_type), pointer :: tendPool + type (mpas_pool_type), pointer :: & + tendSlowPool, & + tendSum1stPool, & + tendSum2ndPool, & + tendSum3rdPool, & + prevTendSlowPool, nextTendSlowPool, & + prevTendSum1stPool, nextTendSum1stPool, & + prevTendSum2ndPool, nextTendSum2ndPool, & + prevTendSum3rdPool, nextTendSum3rdPool integer, dimension(:), allocatable :: isLTSRegionEdgeAssigned integer :: i, iCell, iEdge, iRegion, coarseRegions, fineRegions, fineRegionsM1 integer, dimension(:), pointer :: LTSRegion @@ -1134,6 +1059,93 @@ subroutine ocn_time_integration_lts_init(domain)!{{{ minMaxLTSRegion(2) = 2 block => domain % blocklist + + ! Create additional pools + call mpas_pool_get_subpool(block%structs, 'tend', tendPool) + + call mpas_pool_create_pool(tendSum1stPool) + call mpas_pool_clone_pool(tendPool, tendSum1stPool, 1) + call mpas_pool_create_pool(tendSum2ndPool) + call mpas_pool_clone_pool(tendPool, tendSum2ndPool, 1) + call mpas_pool_create_pool(tendSum3rdPool) + call mpas_pool_clone_pool(tendPool, tendSum3rdPool, 1) + call mpas_pool_create_pool(tendSlowPool) + call mpas_pool_clone_pool(tendPool, tendSlowPool, 1) + + call mpas_pool_add_subpool(block % structs, 'tend_sum_1st', tendSum1stPool) + call mpas_pool_add_subpool(block % structs, 'tend_sum_2nd', tendSum2ndPool) + call mpas_pool_add_subpool(block % structs, 'tend_sum_3rd', tendSum3rdPool) + call mpas_pool_add_subpool(block % structs, 'tend_slow', tendSlowPool) + + if (associated(block % prev)) then + call mpas_pool_get_subpool(block % prev % structs, 'tend_sum_1st', tendSum1stPool) + call mpas_pool_get_subpool(block % prev % structs, 'tend_sum_2nd', tendSum2ndPool) + call mpas_pool_get_subpool(block % prev % structs, 'tend_sum_3rd', tendSum3rdPool) + call mpas_pool_get_subpool(block % prev % structs, 'tend_slow', tendSlowPool) + else + nullify(prevTendSum1stPool) + nullify(prevTendSum2ndPool) + nullify(prevTendSum3rdPool) + nullify(prevTendSlowPool) + end if + + if (associated(block % next)) then + call mpas_pool_get_subpool(block % next % structs, 'tend_sum_1st', nextTendSum1stPool) + call mpas_pool_get_subpool(block % next % structs, 'tend_sum_2nd', nextTendSum2ndPool) + call mpas_pool_get_subpool(block % next % structs, 'tend_sum_3rd', nextTendSum3rdPool) + call mpas_pool_get_subpool(block % next % structs, 'tend_slow', nextTendSlowPool) + else + nullify(nextTendSum1stPool) + nullify(nextTendSum2ndPool) + nullify(nextTendSum3rdPool) + nullify(nextTendSlowPool) + end if + + if (associated(prevTendSum1stPool) .and. associated(nextTendSum1stPool)) then + call mpas_pool_link_pools(tendSum1stPool, prevTendSum1stPool, nextTendSum1stPool) + else if (associated(prevTendSum1stPool)) then + call mpas_pool_link_pools(tendSum1stPool, prevTendSum1stPool) + else if (associated(nextTendSum1stPool)) then + call mpas_pool_link_pools(tendSum1stPool,nextPool=nextTendSum1stPool) + else + call mpas_pool_link_pools(tendSum1stPool) + end if + + if (associated(prevTendSum2ndPool) .and. associated(nextTendSum2ndPool)) then + call mpas_pool_link_pools(tendSum2ndPool, prevTendSum2ndPool, nextTendSum2ndPool) + else if (associated(prevTendSum2ndPool)) then + call mpas_pool_link_pools(tendSum2ndPool, prevTendSum2ndPool) + else if (associated(nextTendSum2ndPool)) then + call mpas_pool_link_pools(tendSum2ndPool,nextPool=nextTendSum2ndPool) + else + call mpas_pool_link_pools(tendSum2ndPool) + end if + + if (associated(prevTendSum3rdPool) .and. associated(nextTendSum3rdPool)) then + call mpas_pool_link_pools(tendSum3rdPool, prevTendSum3rdPool, nextTendSum3rdPool) + else if (associated(prevTendSum3rdPool)) then + call mpas_pool_link_pools(tendSum3rdPool, prevTendSum3rdPool) + else if (associated(nextTendSum3rdPool)) then + call mpas_pool_link_pools(tendSum3rdPool,nextPool=nextTendSum3rdPool) + else + call mpas_pool_link_pools(tendSum3rdPool) + end if + + if (associated(prevTendSlowPool) .and. associated(nextTendSlowPool)) then + call mpas_pool_link_pools(tendSlowPool, prevTendSlowPool, nextTendSlowPool) + else if (associated(prevTendSlowPool)) then + call mpas_pool_link_pools(tendSlowPool, prevTendSlowPool) + else if (associated(nextTendSlowPool)) then + call mpas_pool_link_pools(tendSlowPool,nextPool=nextTendSlowPool) + else + call mpas_pool_link_pools(tendSlowPool) + end if + + call mpas_pool_link_parinfo(block, tendSum1stPool) + call mpas_pool_link_parinfo(block, tendSum2ndPool) + call mpas_pool_link_parinfo(block, tendSum3rdPool) + call mpas_pool_link_parinfo(block, tendSlowPool) + call mpas_pool_get_subpool(block % structs, 'LTS', LTSPool) call mpas_pool_get_array(LTSPool, 'LTSRegion', LTSRegion) From 6f1a75db08372557092e3190c0420496817c599f Mon Sep 17 00:00:00 2001 From: Steven Brus Date: Tue, 23 Apr 2024 15:03:16 -0700 Subject: [PATCH 4/4] Add comment explaining overrideTimeLevels --- components/mpas-framework/src/framework/mpas_pool_routines.F | 2 ++ 1 file changed, 2 insertions(+) diff --git a/components/mpas-framework/src/framework/mpas_pool_routines.F b/components/mpas-framework/src/framework/mpas_pool_routines.F index 89a489ca3088..7c01125bf7f2 100644 --- a/components/mpas-framework/src/framework/mpas_pool_routines.F +++ b/components/mpas-framework/src/framework/mpas_pool_routines.F @@ -930,6 +930,8 @@ end subroutine mpas_pool_clone_pool!}}} !> \details !> This routine assumes srcPool and destPool have identical members. It will !> copy the data from the members of srcPool into the members of destPool. +!> The overrideTimeLevels argument enables a given time level of a srcPool +!> with >1 time level to be copied into a destPool with a single time level. ! !----------------------------------------------------------------------- recursive subroutine mpas_pool_copy_pool(srcPool, destPool, overrideTimeLevels)!{{{