From 5612a96edecac3fe931cdc3a8754dfd6e1532df0 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 21 Sep 2023 20:53:34 +0000 Subject: [PATCH 1/5] Fix race condition in GFS_phys_time_vary.fv3.F90 error detection --- physics/GFS_phys_time_vary.fv3.F90 | 67 +++++++++++++++++++++++------- physics/noahmp_tables.f90 | 18 ++++---- 2 files changed, 60 insertions(+), 25 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index a10c10d1b..04348f6dc 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -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) return + if(errflg /= 0) return + !$OMP CRITICAL + if(errflg == 0) then + errmsg = myerrmsg + errflg = myerrflg + endif + !$OMP END CRITICAL + end subroutine copy_error + !> \section arg_table_GFS_phys_time_vary_init Argument Table !! \htmlinclude GFS_phys_time_vary_init.html !! @@ -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(255) :: myerrmsg + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -215,7 +234,7 @@ subroutine GFS_phys_time_vary_init ( !$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 @@ -227,16 +246,18 @@ subroutine GFS_phys_time_vary_init ( ! 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 !$OMP section @@ -247,16 +268,18 @@ subroutine GFS_phys_time_vary_init ( ! 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 !$OMP section @@ -264,7 +287,9 @@ subroutine GFS_phys_time_vary_init ( !> 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 + 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 @@ -289,16 +314,22 @@ 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 + 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 + 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) + myerrflg = 0 + call read_mp_table_parameters(myerrmsg, myerrflg) + call copy_error(myerrmsg, myerrflg, errmsg, errflg) !$OMP end sections @@ -393,7 +424,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 @@ -479,7 +512,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) @@ -594,8 +628,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 diff --git a/physics/noahmp_tables.f90 b/physics/noahmp_tables.f90 index 3b06d7f53..7b536a1d7 100644 --- a/physics/noahmp_tables.f90 +++ b/physics/noahmp_tables.f90 @@ -783,7 +783,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")') @@ -914,7 +914,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")') @@ -957,7 +957,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")') @@ -982,7 +982,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")') @@ -1011,7 +1011,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")') @@ -1069,7 +1069,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")') @@ -1096,7 +1096,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")') @@ -1249,7 +1249,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")') @@ -1278,7 +1278,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")') From 3ec61d39e75bf9f83a1e232e762909964a687767 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 21 Sep 2023 22:23:47 +0000 Subject: [PATCH 2/5] detect empty errmsg in GFS_phys_time_vary.fv3.F90 --- physics/GFS_phys_time_vary.fv3.F90 | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 04348f6dc..e6bf24186 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -67,14 +67,14 @@ subroutine copy_error(myerrmsg, myerrflg, errmsg, errflg) integer, intent(in) :: myerrflg character(*), intent(out) :: errmsg integer, intent(inout) :: errflg - if(myerrflg == 0) return - if(errflg /= 0) return - !$OMP CRITICAL - if(errflg == 0) then - errmsg = myerrmsg - errflg = myerrflg + if(myerrflg /= 0 .and. errflg == 0) then + !$OMP CRITICAL + if(errflg == 0) then + errmsg = myerrmsg + errflg = myerrflg + endif + !$OMP END CRITICAL endif - !$OMP END CRITICAL end subroutine copy_error !> \section arg_table_GFS_phys_time_vary_init Argument Table @@ -209,7 +209,7 @@ subroutine GFS_phys_time_vary_init ( real(kind=kind_phys), dimension(:), allocatable :: dzsnso integer :: myerrflg - character(255) :: myerrmsg + character(len=255) :: myerrmsg ! Initialize CCPP error handling variables errmsg = '' @@ -288,6 +288,7 @@ subroutine GFS_phys_time_vary_init ( if (iaerclm) then ntrcaer = ntrcaerm 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 @@ -315,6 +316,7 @@ subroutine GFS_phys_time_vary_init ( !> - Call tau_amf dats for ugwp_v1 if (do_ugwp_v1) then 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 @@ -322,12 +324,14 @@ subroutine GFS_phys_time_vary_init ( !$OMP section !> - Initialize soil vegetation (needed for sncovr calculation further down) 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) 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) From 7912a1954983010f1f2ee5ce552139b8dda0b669 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 21 Sep 2023 22:24:02 +0000 Subject: [PATCH 3/5] Initialize err variables in set_soilveg.f --- physics/set_soilveg.f | 3 +++ 1 file changed, 3 insertions(+) diff --git a/physics/set_soilveg.f b/physics/set_soilveg.f index 37f2c2a73..35f4ace37 100644 --- a/physics/set_soilveg.f +++ b/physics/set_soilveg.f @@ -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 From 7332c8e7ac3d5eec9d48947ec9c1bbd035d9dfeb Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 21 Sep 2023 23:32:27 +0000 Subject: [PATCH 4/5] initialize errmsg & errflg in noahmp_tables.f90 --- physics/noahmp_tables.f90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/physics/noahmp_tables.f90 b/physics/noahmp_tables.f90 index 7b536a1d7..753c8ff24 100644 --- a/physics/noahmp_tables.f90 +++ b/physics/noahmp_tables.f90 @@ -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 From 374996ecc45f138ff48ed1812fee3dc59837c556 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 22 Sep 2023 13:42:46 +0000 Subject: [PATCH 5/5] only read h2odata, ozdata and noahmp table when they are needed --- physics/GFS_phys_time_vary.fv3.F90 | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index e6bf24186..4100bdf6e 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -226,7 +226,7 @@ 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) & @@ -240,6 +240,7 @@ subroutine GFS_phys_time_vary_init ( !$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 @@ -259,9 +260,11 @@ subroutine GFS_phys_time_vary_init ( oz_coeff, " /= ", size(ozpl, dim=3) 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 @@ -281,6 +284,7 @@ subroutine GFS_phys_time_vary_init ( 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 @@ -330,10 +334,12 @@ subroutine GFS_phys_time_vary_init ( !$OMP section !> - read in NoahMP table (needed for NoahMP init) - 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) + 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