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

Fix the broken error detection in GFS_phys_time_vary.fv3.F90 and pointer issues in c3 scheme #106

Merged
merged 8 commits into from
Oct 3, 2023
Merged

Fix the broken error detection in GFS_phys_time_vary.fv3.F90 and pointer issues in c3 scheme #106

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
315d3cc
stop FV3_HRRR_c3 from crashing with gnu debug
SamuelTrahanNOAA Sep 6, 2023
5612a96
Fix race condition in GFS_phys_time_vary.fv3.F90 error detection
SamuelTrahanNOAA Sep 21, 2023
3ec61d3
detect empty errmsg in GFS_phys_time_vary.fv3.F90
SamuelTrahanNOAA Sep 21, 2023
7912a19
Initialize err variables in set_soilveg.f
SamuelTrahanNOAA Sep 21, 2023
7332c8e
initialize errmsg & errflg in noahmp_tables.f90
SamuelTrahanNOAA Sep 21, 2023
374996e
only read h2odata, ozdata and noahmp table when they are needed
SamuelTrahanNOAA Sep 22, 2023
f7efdce
Merge remote-tracking branch 'upstream/ufs/dev' into c3-pointer-fix
SamuelTrahanNOAA Sep 25, 2023
671b5f0
Merge remote-tracking branch 'sam/bugfix/errmsgflg-race-condition' in…
SamuelTrahanNOAA Sep 25, 2023
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
79 changes: 62 additions & 17 deletions physics/GFS_phys_time_vary.fv3.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -61,6 +61,22 @@ module GFS_phys_time_vary

contains

subroutine copy_error(myerrmsg, myerrflg, errmsg, errflg)
implicit none
character(*), intent(in) :: myerrmsg
integer, intent(in) :: myerrflg
character(*), intent(out) :: errmsg
integer, intent(inout) :: errflg
if(myerrflg /= 0 .and. errflg == 0) then
!$OMP CRITICAL
if(errflg == 0) then
errmsg = myerrmsg
errflg = myerrflg
endif
!$OMP END CRITICAL
endif
end subroutine copy_error

!> \section arg_table_GFS_phys_time_vary_init Argument Table
!! \htmlinclude GFS_phys_time_vary_init.html
!!
Expand Down Expand Up @@ -192,6 +208,9 @@ subroutine GFS_phys_time_vary_init (
real(kind=kind_phys), dimension(:), allocatable :: dzsno
real(kind=kind_phys), dimension(:), allocatable :: dzsnso

integer :: myerrflg
character(len=255) :: myerrmsg

! Initialize CCPP error handling variables
errmsg = ''
errflg = 0
Expand All @@ -207,64 +226,75 @@ subroutine GFS_phys_time_vary_init (
!$OMP shared (xlat_d,xlon_d,imap,jmap,errmsg,errflg) &
!$OMP shared (levozp,oz_coeff,oz_pres,ozpl) &
!$OMP shared (levh2o,h2o_coeff,h2o_pres,h2opl) &
!$OMP shared (iamin, iamax, jamin, jamax) &
!$OMP shared (iamin, iamax, jamin, jamax, lsm_noahmp) &
!$OMP shared (iaerclm,iaermdl,ntrcaer,aer_nm,iflip,iccn) &
!$OMP shared (jindx1_o3,jindx2_o3,ddy_o3,jindx1_h,jindx2_h,ddy_h) &
!$OMP shared (jindx1_aer,jindx2_aer,ddy_aer,iindx1_aer,iindx2_aer,ddx_aer) &
!$OMP shared (jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci,ddx_ci) &
!$OMP shared (do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau,ddy_j2tau) &
!$OMP shared (isot,ivegsrc,nlunit,sncovr,sncovr_ice,lsm,lsm_ruc) &
!$OMP shared (min_seaice,fice,landfrac,vtype,weasd,snupx,salp_data) &
!$OMP private (ix,i,j,rsnow,vegtyp)
!$OMP private (ix,i,j,rsnow,vegtyp,myerrmsg,myerrflg)

!$OMP sections

!$OMP section
!> - Call read_o3data() to read ozone data
need_o3data: if(ntoz > 0) then
call read_o3data (ntoz, me, master)

! Consistency check that the hardcoded values for levozp and
! oz_coeff in GFS_typedefs.F90 match what is set by read_o3data
! in GFS_typedefs.F90: allocate (Tbd%ozpl (IM,levozp,oz_coeff))
if (size(ozpl, dim=2).ne.levozp) then
write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", &
myerrflg = 1
write(myerrmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", &
"levozp from read_o3data does not match value in GFS_typedefs.F90: ", &
levozp, " /= ", size(ozpl, dim=2)
errflg = 1
call copy_error(myerrmsg, myerrflg, errmsg, errflg)
end if
if (size(ozpl, dim=3).ne.oz_coeff) then
write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", &
myerrflg = 1
write(myerrmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", &
"oz_coeff from read_o3data does not match value in GFS_typedefs.F90: ", &
oz_coeff, " /= ", size(ozpl, dim=3)
errflg = 1
call copy_error(myerrmsg, myerrflg, errmsg, errflg)
end if
endif need_o3data

!$OMP section
!> - Call read_h2odata() to read stratospheric water vapor data
need_h2odata: if(h2o_phys) then
call read_h2odata (h2o_phys, me, master)

! Consistency check that the hardcoded values for levh2o and
! h2o_coeff in GFS_typedefs.F90 match what is set by read_o3data
! in GFS_typedefs.F90: allocate (Tbd%h2opl (IM,levh2o,h2o_coeff))
if (size(h2opl, dim=2).ne.levh2o) then
write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", &
write(myerrmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", &
"levh2o from read_h2odata does not match value in GFS_typedefs.F90: ", &
levh2o, " /= ", size(h2opl, dim=2)
errflg = 1
myerrflg = 1
call copy_error(myerrmsg, myerrflg, errmsg, errflg)
end if
if (size(h2opl, dim=3).ne.h2o_coeff) then
write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", &
write(myerrmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", &
"h2o_coeff from read_h2odata does not match value in GFS_typedefs.F90: ", &
h2o_coeff, " /= ", size(h2opl, dim=3)
errflg = 1
myerrflg = 1
call copy_error(myerrmsg, myerrflg, errmsg, errflg)
end if
endif need_h2odata

!$OMP section
!> - Call read_aerdata() to read aerosol climatology, Anning added coupled
!> added coupled gocart and radiation option to initializing aer_nm
if (iaerclm) then
ntrcaer = ntrcaerm
call read_aerdata (me,master,iflip,idate,errmsg,errflg)
myerrflg = 0
myerrmsg = 'read_aerdata failed without a message'
call read_aerdata (me,master,iflip,idate,myerrmsg,myerrflg)
call copy_error(myerrmsg, myerrflg, errmsg, errflg)
else if(iaermdl ==2 ) then
do ix=1,ntrcaerm
do j=1,levs
Expand All @@ -289,16 +319,27 @@ subroutine GFS_phys_time_vary_init (
!$OMP section
!> - Call tau_amf dats for ugwp_v1
if (do_ugwp_v1) then
call read_tau_amf(me, master, errmsg, errflg)
myerrflg = 0
myerrmsg = 'read_tau_amf failed without a message'
call read_tau_amf(me, master, myerrmsg, myerrflg)
call copy_error(myerrmsg, myerrflg, errmsg, errflg)
endif

!$OMP section
!> - Initialize soil vegetation (needed for sncovr calculation further down)
call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg)
myerrflg = 0
myerrmsg = 'set_soilveg failed without a message'
call set_soilveg(me, isot, ivegsrc, nlunit, myerrmsg, myerrflg)
call copy_error(myerrmsg, myerrflg, errmsg, errflg)

!$OMP section
!> - read in NoahMP table (needed for NoahMP init)
call read_mp_table_parameters(errmsg, errflg)
if(lsm == lsm_noahmp) then
myerrflg = 0
myerrmsg = 'read_mp_table_parameters failed without a message'
call read_mp_table_parameters(myerrmsg, myerrflg)
call copy_error(myerrmsg, myerrflg, errmsg, errflg)
endif

!$OMP end sections

Expand Down Expand Up @@ -393,7 +434,9 @@ subroutine GFS_phys_time_vary_init (
if (errflg/=0) return

if (iaerclm) then
! This call is outside the OpenMP section, so it should access errmsg & errflg directly.
call read_aerdataf (me, master, iflip, idate, fhour, errmsg, errflg)
! If it is moved to an OpenMP section, it must use myerrmsg, myerrflg, and copy_error.
if (errflg/=0) return
end if

Expand Down Expand Up @@ -479,7 +522,8 @@ subroutine GFS_phys_time_vary_init (
!$omp shared(dwsat_table,dksat_table,psisat_table,smoiseq) &
!$OMP shared(smcwtdxy,deeprechxy,rechxy,errmsg,errflg) &
!$OMP private(vegtyp,masslai,masssai,snd,dzsno,dzsnso,isnow) &
!$OMP private(soiltyp,bexp,smcmax,smcwlt,dwsat,dksat,psisat,ddz)
!$OMP private(soiltyp,bexp,smcmax,smcwlt,dwsat,dksat,psisat) &
!$OMP private(myerrmsg,myerrflg,ddz)
do ix=1,im
if (landfrac(ix) >= drythresh) then
tvxy(ix) = tsfcl(ix)
Expand Down Expand Up @@ -594,8 +638,9 @@ subroutine GFS_phys_time_vary_init (
dzsno(-1) = 0.20_kind_phys
dzsno(0) = snd - 0.05_kind_phys - 0.20_kind_phys
else
errmsg = 'Error in GFS_phys_time_vary.fv3.F90: Problem with the logic assigning snow layers in Noah MP initialization'
errflg = 1
myerrmsg = 'Error in GFS_phys_time_vary.fv3.F90: Problem with the logic assigning snow layers in Noah MP initialization'
myerrflg = 1
call copy_error(myerrmsg, myerrflg, errmsg, errflg)
endif

! Now we have the snowxy field
Expand Down
Loading
Loading