From 86ae68cce2c9c93b9c3a0a2da34d4864c6f38b0c Mon Sep 17 00:00:00 2001 From: pjpegion Date: Mon, 16 Nov 2020 15:37:20 +0000 Subject: [PATCH 1/8] move allocation of sppt_wts etc to init section --- .../stochastic_physics_wrapper.F90 | 74 +++++++------------ 1 file changed, 28 insertions(+), 46 deletions(-) diff --git a/stochastic_physics/stochastic_physics_wrapper.F90 b/stochastic_physics/stochastic_physics_wrapper.F90 index b5a1be065..277fb8b38 100644 --- a/stochastic_physics/stochastic_physics_wrapper.F90 +++ b/stochastic_physics/stochastic_physics_wrapper.F90 @@ -92,16 +92,38 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) return endif end if + allocate(xlat(1:Atm_block%nblks,maxval(GFS_Control%blksz))) + allocate(xlon(1:Atm_block%nblks,maxval(GFS_Control%blksz))) + ! Copy blocked data into contiguous arrays; no need to copy weights in (intent(out)) + if (GFS_Control%do_sppt) then + allocate(sppt_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),1:GFS_Control%levs)) + end if + if (GFS_Control%do_shum) then + allocate(shum_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),1:GFS_Control%levs)) + end if + if (GFS_Control%do_skeb) then + allocate(skebu_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),1:GFS_Control%levs)) + allocate(skebv_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),1:GFS_Control%levs)) + end if + if ( GFS_Control%lndp_type .EQ. 2 ) then ! this scheme updates through forecast + allocate(sfc_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),1:GFS_Control%n_var_lndp)) + end if + if (GFS_Control%lndp_type .EQ. 2) then ! save wts, and apply lndp scheme + allocate(smc(1:Atm_block%nblks,maxval(GFS_Control%blksz),GFS_Control%lsoil)) + allocate(slc(1:Atm_block%nblks,maxval(GFS_Control%blksz),GFS_Control%lsoil)) + allocate(stc(1:Atm_block%nblks,maxval(GFS_Control%blksz),GFS_Control%lsoil)) + allocate(stype(1:Atm_block%nblks,maxval(GFS_Control%blksz))) + allocate(vfrac(1:Atm_block%nblks,maxval(GFS_Control%blksz))) + endif + + do nb=1,Atm_block%nblks + xlat(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Grid%xlat(:) + xlon(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Grid%xlon(:) + end do if ( GFS_Control%lndp_type .EQ. 1 ) then ! this scheme sets perts once ! Copy blocked data into contiguous arrays; no need to copy sfc_wts in (intent out) - allocate(xlat(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(xlon(1:Atm_block%nblks,maxval(GFS_Control%blksz))) allocate(sfc_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),GFS_Control%n_var_lndp)) - do nb=1,Atm_block%nblks - xlat(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Grid%xlat(:) - xlon(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Grid%xlon(:) - end do call run_stochastic_physics(GFS_Control%levs, GFS_Control%kdt, GFS_Control%phour, GFS_Control%blksz, xlat=xlat, xlon=xlon, & sppt_wts=sppt_wts, shum_wts=shum_wts, skebu_wts=skebu_wts, skebv_wts=skebv_wts, sfc_wts=sfc_wts, & nthreads=nthreads) @@ -109,8 +131,6 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) do nb=1,Atm_block%nblks GFS_Data(nb)%Coupling%sfc_wts(:,:) = sfc_wts(nb,1:GFS_Control%blksz(nb),:) end do - deallocate(xlat) - deallocate(xlon) deallocate(sfc_wts) end if ! Consistency check for cellular automata @@ -126,27 +146,6 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) else initalize_stochastic_physics if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type .EQ. 2) ) then - ! Copy blocked data into contiguous arrays; no need to copy weights in (intent(out)) - allocate(xlat(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(xlon(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - do nb=1,Atm_block%nblks - xlat(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Grid%xlat(:) - xlon(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Grid%xlon(:) - end do - if (GFS_Control%do_sppt) then - allocate(sppt_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),1:GFS_Control%levs)) - end if - if (GFS_Control%do_shum) then - allocate(shum_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),1:GFS_Control%levs)) - end if - if (GFS_Control%do_skeb) then - allocate(skebu_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),1:GFS_Control%levs)) - allocate(skebv_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),1:GFS_Control%levs)) - end if - if ( GFS_Control%lndp_type .EQ. 2 ) then ! this scheme updates through forecast - allocate(sfc_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),1:GFS_Control%n_var_lndp)) - end if - call run_stochastic_physics(GFS_Control%levs, GFS_Control%kdt, GFS_Control%phour, GFS_Control%blksz, xlat=xlat, xlon=xlon, & sppt_wts=sppt_wts, shum_wts=shum_wts, skebu_wts=skebu_wts, skebv_wts=skebv_wts, sfc_wts=sfc_wts, & nthreads=nthreads) @@ -155,32 +154,23 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) do nb=1,Atm_block%nblks GFS_Data(nb)%Coupling%sppt_wts(:,:) = sppt_wts(nb,1:GFS_Control%blksz(nb),:) end do - deallocate(sppt_wts) end if if (GFS_Control%do_shum) then do nb=1,Atm_block%nblks GFS_Data(nb)%Coupling%shum_wts(:,:) = shum_wts(nb,1:GFS_Control%blksz(nb),:) end do - deallocate(shum_wts) end if if (GFS_Control%do_skeb) then do nb=1,Atm_block%nblks GFS_Data(nb)%Coupling%skebu_wts(:,:) = skebu_wts(nb,1:GFS_Control%blksz(nb),:) GFS_Data(nb)%Coupling%skebv_wts(:,:) = skebv_wts(nb,1:GFS_Control%blksz(nb),:) end do - deallocate(skebu_wts) - deallocate(skebv_wts) end if if (GFS_Control%lndp_type .EQ. 2) then ! save wts, and apply lndp scheme do nb=1,Atm_block%nblks GFS_Data(nb)%Coupling%sfc_wts(:,:) = sfc_wts(nb,1:GFS_Control%blksz(nb),:) end do - allocate(smc(1:Atm_block%nblks,maxval(GFS_Control%blksz),GFS_Control%lsoil)) - allocate(slc(1:Atm_block%nblks,maxval(GFS_Control%blksz),GFS_Control%lsoil)) - allocate(stc(1:Atm_block%nblks,maxval(GFS_Control%blksz),GFS_Control%lsoil)) - allocate(stype(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(vfrac(1:Atm_block%nblks,maxval(GFS_Control%blksz))) do nb=1,Atm_block%nblks stype(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%stype(:) smc(nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Sfcprop%smc(:,:) @@ -202,21 +192,13 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) write(6,*) 'call to GFS_apply_lndp failed' return endif - deallocate(stype) - deallocate(sfc_wts) do nb=1,Atm_block%nblks GFS_Data(nb)%Sfcprop%smc(:,:) = smc(nb,1:GFS_Control%blksz(nb),:) GFS_Data(nb)%Sfcprop%slc(:,:) = slc(nb,1:GFS_Control%blksz(nb),:) GFS_Data(nb)%Sfcprop%stc(:,:) = stc(nb,1:GFS_Control%blksz(nb),:) GFS_Data(nb)%Sfcprop%vfrac(:) = vfrac(nb,1:GFS_Control%blksz(nb)) enddo - deallocate(smc) - deallocate(slc) - deallocate(stc) - deallocate(vfrac) endif ! lndp block - deallocate(xlat) - deallocate(xlon) end if endif initalize_stochastic_physics From 1b6fda1e200d0e429d7d4e5d5ef81641d4de4ebd Mon Sep 17 00:00:00 2001 From: pjpegion Date: Mon, 16 Nov 2020 18:34:32 +0000 Subject: [PATCH 2/8] add finialize subroutine for stochastic physics --- atmos_model.F90 | 5 ++- .../stochastic_physics_wrapper.F90 | 39 +++++++++++++++++++ 2 files changed, 43 insertions(+), 1 deletion(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 860079949..f61735eb8 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -100,7 +100,7 @@ module atmos_model_mod use IPD_driver, only: IPD_initialize, IPD_initialize_rst use CCPP_driver, only: CCPP_step, non_uniform_blocks -use stochastic_physics_wrapper_mod, only: stochastic_physics_wrapper +use stochastic_physics_wrapper_mod, only: stochastic_physics_wrapper,stochastic_physics_wrapper_end #else use IPD_driver, only: IPD_initialize, IPD_initialize_rst, IPD_step use physics_abstraction_layer, only: time_vary_step, radiation_step1, physics_step1, physics_step2 @@ -962,6 +962,9 @@ subroutine atmos_model_end (Atmos) !---- termination routine for atmospheric model ---- call atmosphere_end (Atmos % Time, Atmos%grid, restart_endfcst) + + call stochastic_physics_wrapper_end(IPD_Control) + if(restart_endfcst) then call FV3GFS_restart_write (IPD_Data, IPD_Restart, Atm_block, & IPD_Control, Atmos%domain) diff --git a/stochastic_physics/stochastic_physics_wrapper.F90 b/stochastic_physics/stochastic_physics_wrapper.F90 index 277fb8b38..bce839d44 100644 --- a/stochastic_physics/stochastic_physics_wrapper.F90 +++ b/stochastic_physics/stochastic_physics_wrapper.F90 @@ -291,4 +291,43 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) end subroutine stochastic_physics_wrapper + + subroutine stochastic_physics_wrapper_end (GFS_Control) + + use GFS_typedefs, only: GFS_control_type, GFS_data_type + use stochastic_physics, only: finalize_stochastic_physics + + implicit none + + type(GFS_control_type), intent(inout) :: GFS_Control + + if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type .GT. 0) ) then + print*,'in stochastic_physics_wrapper_end' + deallocate(xlat) + deallocate(xlon) + ! Copy blocked data into contiguous arrays; no need to copy weights in (intent(out)) + if (GFS_Control%do_sppt) then + deallocate(sppt_wts) + end if + if (GFS_Control%do_shum) then + deallocate(shum_wts) + end if + if (GFS_Control%do_skeb) then + deallocate(skebu_wts) + deallocate(skebv_wts) + end if + if ( GFS_Control%lndp_type .EQ. 2 ) then ! this scheme updates through forecast + deallocate(sfc_wts) + end if + if (GFS_Control%lndp_type .EQ. 2) then ! save wts, and apply lndp scheme + deallocate(smc) + deallocate(slc) + deallocate(stc) + deallocate(stype) + deallocate(vfrac) + endif + endif + call finalize_stochastic_physics() + end subroutine stochastic_physics_wrapper_end + end module stochastic_physics_wrapper_mod From fd61855b350584206dfe255d2c440e40c5829078 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Mon, 16 Nov 2020 23:36:29 +0000 Subject: [PATCH 3/8] move call finalize_stochastic_phyiscs inside if statement --- stochastic_physics/stochastic_physics_wrapper.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/stochastic_physics/stochastic_physics_wrapper.F90 b/stochastic_physics/stochastic_physics_wrapper.F90 index bce839d44..3195d7e47 100644 --- a/stochastic_physics/stochastic_physics_wrapper.F90 +++ b/stochastic_physics/stochastic_physics_wrapper.F90 @@ -302,7 +302,6 @@ subroutine stochastic_physics_wrapper_end (GFS_Control) type(GFS_control_type), intent(inout) :: GFS_Control if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type .GT. 0) ) then - print*,'in stochastic_physics_wrapper_end' deallocate(xlat) deallocate(xlon) ! Copy blocked data into contiguous arrays; no need to copy weights in (intent(out)) @@ -326,8 +325,8 @@ subroutine stochastic_physics_wrapper_end (GFS_Control) deallocate(stype) deallocate(vfrac) endif + call finalize_stochastic_physics() endif - call finalize_stochastic_physics() end subroutine stochastic_physics_wrapper_end end module stochastic_physics_wrapper_mod From 55d1b359fbf7babbd0f30aae9dc6326c87378147 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Fri, 20 Nov 2020 18:20:03 +0000 Subject: [PATCH 4/8] add if allocated statements to stochastic_physics_wrapper_end --- .../stochastic_physics_wrapper.F90 | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/stochastic_physics/stochastic_physics_wrapper.F90 b/stochastic_physics/stochastic_physics_wrapper.F90 index 3195d7e47..f1bcbe659 100644 --- a/stochastic_physics/stochastic_physics_wrapper.F90 +++ b/stochastic_physics/stochastic_physics_wrapper.F90 @@ -302,28 +302,28 @@ subroutine stochastic_physics_wrapper_end (GFS_Control) type(GFS_control_type), intent(inout) :: GFS_Control if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type .GT. 0) ) then - deallocate(xlat) - deallocate(xlon) + if (allocated(xlat)) deallocate(xlat) + if (allocated(xlon)) deallocate(xlon) ! Copy blocked data into contiguous arrays; no need to copy weights in (intent(out)) if (GFS_Control%do_sppt) then - deallocate(sppt_wts) + if (allocated(sppt_wts)) deallocate(sppt_wts) end if if (GFS_Control%do_shum) then - deallocate(shum_wts) + if (allocated(shum_wts)) deallocate(shum_wts) end if if (GFS_Control%do_skeb) then - deallocate(skebu_wts) - deallocate(skebv_wts) + if (allocated(skebu_wts)) deallocate(skebu_wts) + if (allocated(skebv_wts)) deallocate(skebv_wts) end if if ( GFS_Control%lndp_type .EQ. 2 ) then ! this scheme updates through forecast - deallocate(sfc_wts) + if (allocated(sfc_wts)) deallocate(sfc_wts) end if if (GFS_Control%lndp_type .EQ. 2) then ! save wts, and apply lndp scheme - deallocate(smc) - deallocate(slc) - deallocate(stc) - deallocate(stype) - deallocate(vfrac) + if (allocated(smc)) deallocate(smc) + if (allocated(slc)) deallocate(slc) + if (allocated(stc)) deallocate(stc) + if (allocated(stype)) deallocate(stype) + if (allocated(vfrac)) deallocate(vfrac) endif call finalize_stochastic_physics() endif From 42b2bd3beb40415532a22d5bac92f5489accf831 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Wed, 25 Nov 2020 19:18:05 +0000 Subject: [PATCH 5/8] point to updated submodules --- atmos_cubed_sphere | 2 +- ccpp/framework | 2 +- ccpp/physics | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 61875852b..f06c1767a 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 61875852b52951f6c6215603a19c826b952fc534 +Subproject commit f06c1767ad1c44bc34960227405cd65d471973a0 diff --git a/ccpp/framework b/ccpp/framework index f1dc8d6f0..dca1240e6 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit f1dc8d6f038e590508c272070f673d1fd7ea566f +Subproject commit dca1240e6f19a5bbcfa0b14aa8526f36e99ed135 diff --git a/ccpp/physics b/ccpp/physics index 4e39b50a2..8ef88ca46 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 4e39b50a248fc093c055fc6a8ae245065da7c730 +Subproject commit 8ef88ca46c11535fc7984d39ec38d1582f9db5ff From 86e7788287dc4f4805d56f447acdff4fd4fea288 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Wed, 25 Nov 2020 21:02:05 +0000 Subject: [PATCH 6/8] update to correct ccpp submodules --- ccpp/framework | 2 +- ccpp/physics | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/ccpp/framework b/ccpp/framework index dca1240e6..f1dc8d6f0 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit dca1240e6f19a5bbcfa0b14aa8526f36e99ed135 +Subproject commit f1dc8d6f038e590508c272070f673d1fd7ea566f diff --git a/ccpp/physics b/ccpp/physics index 8ef88ca46..4e39b50a2 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 8ef88ca46c11535fc7984d39ec38d1582f9db5ff +Subproject commit 4e39b50a248fc093c055fc6a8ae245065da7c730 From f3f8b1b453fa018e9de57156c62fdee8e9d85292 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Thu, 26 Nov 2020 00:10:03 +0000 Subject: [PATCH 7/8] update to correct atmos_cubed_sphere --- atmos_cubed_sphere | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index f06c1767a..61875852b 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit f06c1767ad1c44bc34960227405cd65d471973a0 +Subproject commit 61875852b52951f6c6215603a19c826b952fc534 From 6aa7c9d88cd689c721bc748b6cdd25bbc511f36b Mon Sep 17 00:00:00 2001 From: pjpegion Date: Fri, 27 Nov 2020 15:26:27 +0000 Subject: [PATCH 8/8] clean up documentation in stochastic physic wrapper --- stochastic_physics/stochastic_physics_wrapper.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/stochastic_physics/stochastic_physics_wrapper.F90 b/stochastic_physics/stochastic_physics_wrapper.F90 index f1bcbe659..5a3701aa8 100644 --- a/stochastic_physics/stochastic_physics_wrapper.F90 +++ b/stochastic_physics/stochastic_physics_wrapper.F90 @@ -94,7 +94,6 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) end if allocate(xlat(1:Atm_block%nblks,maxval(GFS_Control%blksz))) allocate(xlon(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - ! Copy blocked data into contiguous arrays; no need to copy weights in (intent(out)) if (GFS_Control%do_sppt) then allocate(sppt_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),1:GFS_Control%levs)) end if @@ -122,7 +121,6 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) end do if ( GFS_Control%lndp_type .EQ. 1 ) then ! this scheme sets perts once - ! Copy blocked data into contiguous arrays; no need to copy sfc_wts in (intent out) allocate(sfc_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),GFS_Control%n_var_lndp)) call run_stochastic_physics(GFS_Control%levs, GFS_Control%kdt, GFS_Control%phour, GFS_Control%blksz, xlat=xlat, xlon=xlon, & sppt_wts=sppt_wts, shum_wts=shum_wts, skebu_wts=skebu_wts, skebv_wts=skebv_wts, sfc_wts=sfc_wts, & @@ -304,7 +302,6 @@ subroutine stochastic_physics_wrapper_end (GFS_Control) if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type .GT. 0) ) then if (allocated(xlat)) deallocate(xlat) if (allocated(xlon)) deallocate(xlon) - ! Copy blocked data into contiguous arrays; no need to copy weights in (intent(out)) if (GFS_Control%do_sppt) then if (allocated(sppt_wts)) deallocate(sppt_wts) end if