Skip to content
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

Jump to bottom

Fix for updating stochastic physics on separate time-step. #199

Merged
merged 9 commits into from
Nov 30, 2020
Merged

Fix for updating stochastic physics on separate time-step. #199

Changes from 1 commit
Commits
Show all changes
9 commits
Select commit Hold shift + click to select a range
86ae68c
move allocation of sppt_wts etc to init section
pjpegion Nov 16, 2020
1b6fda1
add finialize subroutine for stochastic physics
pjpegion Nov 16, 2020
fd61855
move call finalize_stochastic_phyiscs inside if statement
pjpegion Nov 16, 2020
55d1b35
add if allocated statements to stochastic_physics_wrapper_end
pjpegion Nov 20, 2020
9765808
Merge pull request #6 from NOAA-EMC/develop
pjpegion Nov 25, 2020
42b2bd3
point to updated submodules
pjpegion Nov 25, 2020
86e7788
update to correct ccpp submodules
pjpegion Nov 25, 2020
f3f8b1b
update to correct atmos_cubed_sphere
pjpegion Nov 26, 2020
6aa7c9d
clean up documentation in stochastic physic wrapper
pjpegion Nov 27, 2020
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
74 changes: 28 additions & 46 deletions stochastic_physics/stochastic_physics_wrapper.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -92,25 +92,45 @@ 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)
! Copy contiguous data back; no need to copy xlat/xlon, these are intent(in) - just deallocate
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
Expand All @@ -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)
Expand All @@ -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(:,:)
Expand All @@ -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)
pjpegion marked this conversation as resolved.
Show resolved Hide resolved
end if

endif initalize_stochastic_physics
Expand Down