From 1ef7f721f64f7f444a8a3b2d9f6610d97ac1d337 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Fri, 19 Jan 2024 11:18:32 -0500 Subject: [PATCH] fix double allocation problem in stochastic_physics_wrapper.F90 --- .../stochastic_physics_wrapper.F90 | 41 +++++++++++-------- 1 file changed, 25 insertions(+), 16 deletions(-) diff --git a/stochastic_physics/stochastic_physics_wrapper.F90 b/stochastic_physics/stochastic_physics_wrapper.F90 index 0730de520..5604c944c 100644 --- a/stochastic_physics/stochastic_physics_wrapper.F90 +++ b/stochastic_physics/stochastic_physics_wrapper.F90 @@ -158,6 +158,7 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) else allocate(spp_wts(0,0,0,0)) end if + if ( GFS_Control%lndp_type == 2 ) then allocate(sfc_wts(1:nblks,maxblk,1:GFS_Control%n_var_lndp)) if ( (GFS_Control%lsm == GFS_Control%lsm_noah) .or. (GFS_Control%lsm == GFS_Control%lsm_noahmp)) then @@ -247,6 +248,29 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) allocate(semis (0,0)) endselect enddo + elseif ( GFS_Control%lndp_type == 1 ) then ! this scheme sets perts once + allocate(sfc_wts(1:nblks, maxblk, GFS_Control%n_var_lndp)) + call run_stochastic_physics(levs, GFS_Control%kdt, GFS_Control%fhour, GFS_Control%blksz, & + sppt_wts=sppt_wts, shum_wts=shum_wts, skebu_wts=skebu_wts, & + skebv_wts=skebv_wts, sfc_wts=sfc_wts, & + spp_wts=spp_wts, nthreads=nthreads) + ! Copy contiguous data back + do nb=1,nblks + GFS_Data(nb)%Coupling%sfc_wts(:,:) = sfc_wts(nb,1:GFS_Control%blksz(nb),:) + end do + !deallocate(sfc_wts) + + allocate(smc (0,0,0)) + + allocate(slc (0,0,0)) + allocate(stype (0,0)) + allocate(stc (0,0,0)) + allocate(vfrac (0,0)) + allocate(alnsf (0,0)) + allocate(alnwf (0,0)) + allocate(snoalb(0,0)) + allocate(semis (0,0)) + allocate(zorll (0,0)) else allocate(sfc_wts(0,0,0)) allocate(smc (0,0,0)) @@ -261,22 +285,7 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) allocate(semis (0,0)) allocate(zorll (0,0)) endif - - - if ( GFS_Control%lndp_type == 1 ) then ! this scheme sets perts once - allocate(sfc_wts(1:nblks, maxblk, GFS_Control%n_var_lndp)) - call run_stochastic_physics(levs, GFS_Control%kdt, GFS_Control%fhour, GFS_Control%blksz, & - sppt_wts=sppt_wts, shum_wts=shum_wts, skebu_wts=skebu_wts, & - skebv_wts=skebv_wts, sfc_wts=sfc_wts, & - spp_wts=spp_wts, nthreads=nthreads) - ! Copy contiguous data back - do nb=1,nblks - GFS_Data(nb)%Coupling%sfc_wts(:,:) = sfc_wts(nb,1:GFS_Control%blksz(nb),:) - end do - deallocate(sfc_wts) - else - allocate(sfc_wts(0,0,0)) - end if + ! Consistency check for cellular automata if(GFS_Control%do_ca)then if(GFS_Control%ca_sgs)then