UFS-dev PR#102

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 .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
 !!
@@ -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
@@ -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
@@ -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
 
@@ -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
 
@@ -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)
@@ -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

physics/GFS_rrtmg_pre.F90

@@ -976,7 +976,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
      &       imp_physics_mg, iovr, iovr_rand, iovr_maxrand, iovr_max,   &
      &       iovr_dcorr, iovr_exp, iovr_exprand, idcor, idcor_con,      &
      &       idcor_hogan, idcor_oreopoulos, lcrick, lcnorm,             &
-     &       imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_gf, do_mynnedmf,     &
+     &       imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_c3, do_mynnedmf,     &
      &       lgfdlmprad,                                                &
      &       uni_cld, lmfshal, lmfdeep2, cldcov, clouds1,               &
      &       effrl, effri, effrr, effrs, effr_in,                       &