Skip to content

Commit

Permalink
Merge remote-tracking branch 'sam/bugfix/errmsgflg-race-condition' in…
Browse files Browse the repository at this point in the history 
…to c3-pointer-fix
  • Loading branch information
@SamuelTrahanNOAA
SamuelTrahanNOAA committed Sep 25, 2023
2 parents f7efdce + 374996e commit 671b5f0
Show file tree
Hide file tree
Showing 3 changed files with 77 additions and 26 deletions.
79 changes: 62 additions & 17 deletions physics/GFS_phys_time_vary.fv3.F90
View file
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
21 changes: 12 additions & 9 deletions physics/noahmp_tables.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -484,6 +484,9 @@ subroutine read_mp_table_parameters(errmsg, errflg)
sr2006_psi_e_a, sr2006_psi_e_b, sr2006_psi_e_c, sr2006_smcmax_a, &
sr2006_smcmax_b

errmsg = ''
errflg = 0

! initialize our variables to bad values, so that if the namelist read fails, we come to a screeching halt as soon as we try to use anything.
! vegetation parameters
isurban_table = -99999
Expand Down Expand Up @@ -783,7 +786,7 @@ subroutine read_mp_table_parameters(errmsg, errflg)
open(15, status='old', form='formatted', action='read', iostat=ierr)
end if
if ( ierr /= 0 ) then
errmsg = 'warning: cannot find file noahmptable.tb'
errmsg = 'warning: cannot find file noahmptable.tbl'
errflg = 1
return
! write(*,'("warning: cannot find file noahmptable.tbl")')
Expand Down Expand Up @@ -914,7 +917,7 @@ subroutine read_mp_table_parameters(errmsg, errflg)
open(15, status='old', form='formatted', action='read', iostat=ierr)
end if
if ( ierr /= 0 ) then
errmsg = 'warning: cannot find file noahmptable.tb'
errmsg = 'warning: cannot find file noahmptable.tbl'
errflg = 1
return
! write(*,'("warning: cannot find file noahmptable.tbl")')
Expand Down Expand Up @@ -957,7 +960,7 @@ subroutine read_mp_table_parameters(errmsg, errflg)
open(15, status='old', form='formatted', action='read', iostat=ierr)
end if
if ( ierr /= 0 ) then
errmsg = 'warning: cannot find file noahmptable.tb'
errmsg = 'warning: cannot find file noahmptable.tbl'
errflg = 1
return
! write(*,'("warning: cannot find file noahmptable.tbl")')
Expand All @@ -982,7 +985,7 @@ subroutine read_mp_table_parameters(errmsg, errflg)
open(15, status='old', form='formatted', action='read', iostat=ierr)
end if
if (ierr /= 0) then
errmsg = 'warning: cannot find file noahmptable.tb'
errmsg = 'warning: cannot find file noahmptable.tbl'
errflg = 1
return
! write(*,'("warning: cannot find file noahmptable.tbl")')
Expand Down Expand Up @@ -1011,7 +1014,7 @@ subroutine read_mp_table_parameters(errmsg, errflg)
open(15, status='old', form='formatted', action='read', iostat=ierr)
end if
if (ierr /= 0) then
errmsg = 'warning: cannot find file noahmptable.tb'
errmsg = 'warning: cannot find file noahmptable.tbl'
errflg = 1
return
! write(*,'("warning: cannot find file noahmptable.tbl")')
Expand Down Expand Up @@ -1069,7 +1072,7 @@ subroutine read_mp_table_parameters(errmsg, errflg)
open(15, status='old', form='formatted', action='read', iostat=ierr)
end if
if (ierr /= 0) then
errmsg = 'warning: cannot find file noahmptable.tb'
errmsg = 'warning: cannot find file noahmptable.tbl'
errflg = 1
return
! write(*,'("warning: cannot find file noahmptable.tbl")')
Expand All @@ -1096,7 +1099,7 @@ subroutine read_mp_table_parameters(errmsg, errflg)
open(15, status='old', form='formatted', action='read', iostat=ierr)
end if
if (ierr /= 0) then
errmsg = 'warning: cannot find file noahmptable.tb'
errmsg = 'warning: cannot find file noahmptable.tbl'
errflg = 1
return
! write(*,'("warning: cannot find file noahmptable.tbl")')
Expand Down Expand Up @@ -1249,7 +1252,7 @@ subroutine read_mp_table_parameters(errmsg, errflg)
open(15, status='old', form='formatted', action='read', iostat=ierr)
end if
if (ierr /= 0) then
errmsg = 'warning: cannot find file noahmptable.tb'
errmsg = 'warning: cannot find file noahmptable.tbl'
errflg = 1
return
! write(*,'("warning: cannot find file noahmptable.tbl")')
Expand Down Expand Up @@ -1278,7 +1281,7 @@ subroutine read_mp_table_parameters(errmsg, errflg)
open(15, status='old', form='formatted', action='read', iostat=ierr)
end if
if (ierr /= 0) then
errmsg = 'warning: cannot find file noahmptable.tb'
errmsg = 'warning: cannot find file noahmptable.tbl'
errflg = 1
return
! write(*,'("warning: cannot find file noahmptable.tbl")')
Expand Down
3 changes: 3 additions & 0 deletions physics/set_soilveg.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,9 @@ subroutine set_soilveg(me,isot,ivet,nlunit,errmsg,errflg)
& DEFINED_SLOPE, FXEXP_DATA, NROOT_DATA, REFKDT_DATA, Z0_DATA,
& CZIL_DATA, LAI_DATA, CSOIL_DATA

errmsg = ''
errflg = 0

cmy end locals
if(ivet.eq.2) then

Expand Down

0 comments on commit 671b5f0

Please sign in to comment.