Sync from NCAR/main + Thompson params

physics/GWD/cires_ugwpv1_oro.F90

@@ -120,7 +120,7 @@ subroutine orogw_v1 (im, km,  imx,   me,  master, dtp, kdt, do_tofd,   &
       real(kind=kind_phys),dimension(im),intent(out) :: zobl, zogw, zlwb, tau_ogw
 
       character(len=*), intent(out) :: errmsg
-      integer,          intent(out) :: errflg		    
+      integer,          intent(out) :: errflg
 !
 ! 
 ! locals vars for SSO
@@ -1009,13 +1009,12 @@ subroutine orogw_v1 (im, km,  imx,   me,  master, dtp, kdt, do_tofd,   &
         endif
        endif
 
-      return
       end subroutine orogw_v1 
 !
 !      
      subroutine ugwp_tofd1d(levs, con_cp, dtp, sigflt, zsurf, zpbl,  u, v, &
                             zmid, utofd, vtofd, epstofd, krf_tofd)
-			    
+
       use machine ,       only : kind_phys 
       use ugwp_oro_init,  only : n_tofd, const_tofd, ze_tofd, a12_tofd, ztop_tofd
 !

physics/GWD/ugwpv1_gsldrag.F90

@@ -591,6 +591,8 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp,
                  index_of_y_wind, ldiag3d, ldiag_ugwp,               &
                  ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg)
      endif
+     if(errflg/=0) return
+
 !
 ! dusfcg = du_ogwcol + du_oblcol + du_osscol + du_ofdcol
 !
@@ -640,6 +642,8 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp,
                       dudt_obl, dvdt_obl,dudt_ofd, dvdt_ofd,              &
                       du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol,         &
                       du_ofdcol, dv_ofdcol, errmsg,errflg           )
+       if(errflg/=0) return
+
 !
 ! orogw_v1: dusfcg = du_ogwcol + du_oblcol  + du_ofdcol                           only 3 terms
 !

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90

@@ -215,6 +215,9 @@ subroutine GFS_phys_time_vary_init (
          ! Initialize CCPP error handling variables
          errmsg = ''
          errflg = 0
+         ! Initialize copy_error variables
+         myerrflg = 0
+         myerrmsg = 'Error in GFS_phys_time_vary'
 
          if (is_initialized) return
          iamin=999
@@ -226,15 +229,13 @@ subroutine GFS_phys_time_vary_init (
 !>  added coupled gocart and radiation option to initializing aer_nm
          if (iaerclm) then
            ntrcaer = ntrcaerm
-           myerrflg = 0
-           myerrmsg = 'read_aerdata failed without a message'
            if(iaermdl == 1) then
-             call read_aerdata (me,master,iflip,idate,myerrmsg,myerrflg)
+             call read_aerdata (me,master,iflip,idate,errmsg,errflg)
            elseif (iaermdl == 6) then
              call read_aerdata_dl(me,master,iflip,                       &
-                                 idate,fhour, myerrmsg,myerrflg)
+                                 idate,fhour, errmsg,errflg)
            end if
-           call copy_error(myerrmsg, myerrflg, errmsg, errflg)
+           if(errflg/=0) return
          else if(iaermdl ==2 ) then
            do ix=1,ntrcaerm
              do j=1,levs
@@ -257,24 +258,18 @@ 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)
+            call read_tau_amf(me, master, errmsg, errflg)
+            if(errflg/=0) return
          endif
 
 !> - 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)
+         call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg)
+         if(errflg/=0) return
 
 !> - read in NoahMP table (needed for NoahMP init)
          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)
+           call read_mp_table_parameters(errmsg, errflg)
+           if(errflg/=0) return
          endif
 
 
@@ -913,21 +908,19 @@ subroutine GFS_phys_time_vary_timestep_init (
            ! aerinterpol is using threading inside, don't
            ! move into OpenMP parallel section above
            if (iaermdl==1) then
-             call aerinterpol (me, master, nthrds, im, idate,        &
-                               fhour, iflip, jindx1_aer, jindx2_aer, &
-                               ddy_aer, iindx1_aer,                  &
-                               iindx2_aer, ddx_aer,                  &
-                               levs, prsl, aer_nm, errmsg, errflg)
+             call aerinterpol (me, master, nthrds, im, idate, &
+                              fhour, iflip, jindx1_aer, jindx2_aer, &
+                              ddy_aer, iindx1_aer,           &
+                              iindx2_aer, ddx_aer,           &
+                              levs, prsl, aer_nm, errmsg, errflg)
            else if (iaermdl==6) then
              call aerinterpol_dl (me, master, nthrds, im, idate,       &
                                  fhour, iflip, jindx1_aer, jindx2_aer, &
                                  ddy_aer, iindx1_aer,                  &
                                  iindx2_aer, ddx_aer,                  &
                                  levs, prsl, aer_nm, errmsg, errflg)
            endif
-           if(errflg /= 0) then
-             return
-           endif
+           if(errflg /= 0) return
          endif
 
 !> - Call gcycle() to repopulate specific time-varying surface properties for AMIP/forecast runs

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90

@@ -212,7 +212,7 @@ subroutine GFS_phys_time_vary_init (
                if(iaermdl==1) then
                  call read_aerdata (me,master,iflip,idate,errmsg,errflg)
                elseif(iaermdl==6) then
-                 call read_aerdata_dl (me,master,iflip,idate,errmsg,errflg)
+                 call read_aerdata_dl (me,master,iflip,idate,fhour,errmsg,errflg)
                end if
             endif
             if (errflg /= 0) return
@@ -816,13 +816,13 @@ subroutine GFS_phys_time_vary_timestep_init (
                                fhour, iflip, jindx1_aer, jindx2_aer, &
                                ddy_aer, iindx1_aer,           &
                                iindx2_aer, ddx_aer,           &
-                               levs, prsl, aer_nm)
+                               levs, prsl, aer_nm, errmsg, errflg)
            elseif (iaermdl==6) then
              call aerinterpol_dl (me, master, nthrds, im, idate, &
                                fhour, iflip, jindx1_aer, jindx2_aer, &
                                ddy_aer, iindx1_aer,           &
                                iindx2_aer, ddx_aer,           &
-                               levs, prsl, aer_nm)
+                               levs, prsl, aer_nm, errmsg, errflg)
            endif
          endif
 

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90

@@ -73,19 +73,19 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
       use surface_perturbation,      only: cdfnor,ppfbet
 
       ! For Thompson MP
-      use module_mp_thompson,        only: calc_effectRad_thmpsn     => calc_effectRad, &
-                                           Nt_c_l_thmpsn             => Nt_c_l,         &
-                                           Nt_c_o_thmpsn             => Nt_c_o,         &
-                                           re_qc_min_thmpsn          => re_qc_min,      &
-                                           re_qc_max_thmpsn          => re_qc_max,      &
-                                           re_qi_min_thmpsn          => re_qi_min,      &
-                                           re_qi_max_thmpsn          => re_qi_max,      &
-                                           re_qs_min_thmpsn          => re_qs_min,      &
-                                           re_qs_max_thmpsn          => re_qs_max
+      use module_mp_thompson,        only: calc_effectRad_thompson     => calc_effectRad, &
+                                           Nt_c_l_thompson             => Nt_c_l,         &
+                                           Nt_c_o_thompson             => Nt_c_o,         &
+                                           re_qc_min_thompson          => re_qc_min,      &
+                                           re_qc_max_thompson          => re_qc_max,      &
+                                           re_qi_min_thompson          => re_qi_min,      &
+                                           re_qi_max_thompson          => re_qi_max,      &
+                                           re_qs_min_thompson          => re_qs_min,      &
+                                           re_qs_max_thompson          => re_qs_max
       use module_mp_thompson_make_number_concentrations, only:       &
-                                           make_IceNumber_thmpsn     => make_IceNumber,     &
-                                           make_DropletNumber_thmpsn => make_DropletNumber, &
-                                           make_RainNumber_thmpsn    => make_RainNumber
+                                           make_IceNumber_thompson     => make_IceNumber,     &
+                                           make_DropletNumber_thompson => make_DropletNumber, &
+                                           make_RainNumber_thompson    => make_RainNumber
 
       use module_mp_tempo_params, only: &
            ty_tempo_cfg, &
@@ -792,13 +792,13 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
                 qs_mp (i,k) = tracer1(i,k,ntsw)/(1.-qvs)
                 if(nint(slmsk(i)) == 1) then
                    if (imp_physics == imp_physics_thompson) then
-                      nc_mp (i,k) = Nt_c_l_thmpsn*orho(i,k)
+                      nc_mp (i,k) = Nt_c_l_thompson*orho(i,k)
                    else
                       nc_mp (i,k) = Nt_c_l_tempo*orho(i,k)
                    endif
                 else
                    if (imp_physics == imp_physics_thompson) then
-                      nc_mp (i,k) = Nt_c_o_thmpsn*orho(i,k)
+                      nc_mp (i,k) = Nt_c_o_thompson*orho(i,k)
                    else
                       nc_mp (i,k) = Nt_c_o_tempo*orho(i,k)
                    endif
@@ -923,14 +923,14 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
             do i=1,im
                if ((ltaerosol .or. mraerosol) .and. qc_mp(i,k)>1.e-12 .and. nc_mp(i,k)<100.) then
                   if (imp_physics == imp_physics_thompson) then
-                     nc_mp(i,k) = make_DropletNumber_thmpsn(qc_mp(i,k)*rho(i,k), nwfa(i,k)*rho(i,k)) * orho(i,k)
+                     nc_mp(i,k) = make_DropletNumber_thompson(qc_mp(i,k)*rho(i,k), nwfa(i,k)*rho(i,k)) * orho(i,k)
                   else
                      nc_mp(i,k) = make_DropletNumber_tempo(qc_mp(i,k)*rho(i,k), nwfa(i,k)*rho(i,k)) * orho(i,k)
                   endif
               endif
               if (qi_mp(i,k)>1.e-12 .and. ni_mp(i,k)<100.) then
                  if (imp_physics == imp_physics_thompson) then
-                    ni_mp(i,k) = make_IceNumber_thmpsn(qi_mp(i,k)*rho(i,k), tlyr(i,k)) * orho(i,k)
+                    ni_mp(i,k) = make_IceNumber_thompson(qi_mp(i,k)*rho(i,k), tlyr(i,k)) * orho(i,k)
                  else
                     ni_mp(i,k) = make_IceNumber_tempo(qi_mp(i,k)*rho(i,k), tlyr(i,k)) * orho(i,k)
                  endif
@@ -946,18 +946,18 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
             !     it will raise the low limit from 5 to 10, but the high limit will remain 125.
 
             if (imp_physics == imp_physics_thompson) then
-               call calc_effectRad_thmpsn(tlyr(i,:), plyr(i,:)*100., qv_mp(i,:), qc_mp(i,:),   &
+               call calc_effectRad_thompson(tlyr(i,:), plyr(i,:)*100., qv_mp(i,:), qc_mp(i,:),   &
                     nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), &
                     effrl(i,:), effri(i,:), effrs(i,:), islmsk, 1, lm )
                ! Scale Thompson's effective radii from meter to micron
                do k=1,lm
-                  effrl(i,k) = MAX(re_qc_min_thmpsn, MIN(effrl(i,k), re_qc_max_thmpsn))*1.e6
-                  effri(i,k) = MAX(re_qi_min_thmpsn, MIN(effri(i,k), re_qi_max_thmpsn))*1.e6
-                  effrs(i,k) = MAX(re_qs_min_thmpsn, MIN(effrs(i,k), re_qs_max_thmpsn))*1.e6
+                  effrl(i,k) = MAX(re_qc_min_thompson, MIN(effrl(i,k), re_qc_max_thompson))*1.e6
+                  effri(i,k) = MAX(re_qi_min_thompson, MIN(effri(i,k), re_qi_max_thompson))*1.e6
+                  effrs(i,k) = MAX(re_qs_min_thompson, MIN(effrs(i,k), re_qs_max_thompson))*1.e6
                end do
-               effrl(i,lmk) = re_qc_min_thmpsn*1.e6
-               effri(i,lmk) = re_qi_min_thmpsn*1.e6
-               effrs(i,lmk) = re_qs_min_thmpsn*1.e6
+               effrl(i,lmk) = re_qc_min_thompson*1.e6
+               effri(i,lmk) = re_qi_min_thompson*1.e6
+               effrs(i,lmk) = re_qs_min_thompson*1.e6
             else
                call calc_effectRad_tempo(t1d=tlyr(i,:), p1d=plyr(i,:)*100., qv1d=qv_mp(i,:), qc1d=qc_mp(i,:),   &
                     nc1d=nc_mp(i,:), qi1d=qi_mp(i,:), ni1d=ni_mp(i,:), qs1d=qs_mp(i,:), &

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90

@@ -212,14 +212,23 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, &
            con_pi )
       call aer_init ( levr, me, iaermdl, iaerflg, lalw1bd, aeros_file,  &
            con_pi, con_t0c, con_c, con_boltz, con_plnk, errflg, errmsg)
+      if(errflg/=0) return
+
       call gas_init ( me, co2usr_file, co2cyc_file, ico2, ictm, con_pi, errflg, errmsg )
+      if(errflg/=0) return
+
       call cld_init ( si, levr, imp_physics, me, con_g, con_rd, errflg, errmsg)
+      if(errflg/=0) return
+
       call rlwinit ( me, rad_hr_units, inc_minor_gas, icliq_lw, isubcsw, &
            iovr, iovr_rand, iovr_maxrand, iovr_max, iovr_dcorr,         &
            iovr_exp, iovr_exprand, errflg, errmsg )
+      if(errflg/=0) return
+
       call rswinit ( me, rad_hr_units, inc_minor_gas, icliq_sw, isubclw, &
            iovr, iovr_rand, iovr_maxrand, iovr_max, iovr_dcorr,         &
            iovr_exp, iovr_exprand,iswmode, errflg, errmsg )
+      if(errflg/=0) return
 
       if ( me == 0 ) then
         print *,'  Radiation sub-cloud initial seed =',ipsd0,           &
@@ -229,8 +238,6 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, &
 !
       is_initialized = .true.
 !
-      return
-
    end subroutine GFS_rrtmg_setup_init
 
 !> \section arg_table_GFS_rrtmg_setup_timestep_init Argument Table
@@ -440,13 +447,15 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,&
 !  ---  outputs:
      &       slag,sdec,cdec,solcon,con_pi,errmsg,errflg                 &
      &     )
+        if(errflg/=0) return
 
       endif  ! end_if_lsswr_block
 
 !> -# Call module_radiation_aerosols::aer_update(), monthly update, no
 !! time interpolation
       if ( lmon_chg ) then
         call aer_update ( iyear, imon, me, iaermdl, aeros_file, errflg, errmsg )
+        if(errflg/=0) return
       endif
 
 !> -# Call co2 and other gases update routine:
@@ -460,6 +469,8 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,&
 
       call gas_update ( kyear,kmon,kday,khour,lco2_chg, me, co2dat_file, &
            co2gbl_file, ictm, ico2, errflg, errmsg )
+      if(errflg/=0) return
+
       if (ntoz == 0) then
          call ozphys%update_o3clim(kmon, kday, khour, loz1st)
       endif
@@ -472,7 +483,6 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,&
 !> -# Call clouds update routine (currently not needed)
 !     call cld_update ( iyear, imon, me )
 !
-      return
 !...................................
       end subroutine radupdate
 !-----------------------------------

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90

@@ -123,15 +123,16 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires,
     call sol_init ( me, isol, solar_file, con_solr_2008, con_solr_2002, con_pi )
     call aer_init ( levr, me, iaermdl, iaerflg, lalw1bd, aeros_file, con_pi, con_t0c,    &
          con_c, con_boltz, con_plnk, errflg, errmsg)
+    if(errflg/=0) return
     call gas_init ( me, co2usr_file, co2cyc_file, ico2, ictm, con_pi, errflg, errmsg )
+    if(errflg/=0) return
 
     if ( me == 0 ) then
        print *,' return from rad_initialize (GFS_rrtmgp_setup_init) - after calling radinit'
     endif
 
     is_initialized = .true.
 
-    return
   end subroutine GFS_rrtmgp_setup_init
 
 !> \section arg_table_GFS_rrtmgp_setup_timestep_init Argument Table
@@ -217,11 +218,13 @@ subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad
        endif
        iyear0 = iyear
        call sol_update(jdate, kyear, deltsw, deltim, lsol_chg, me, slag, sdec, cdec, solcon, con_pi, errmsg, errflg)
+       if(errflg/=0) return
     endif
 
     ! Update aerosols...
     if ( lmon_chg ) then
        call aer_update ( iyear, imon, me, iaermdl, aeros_file, errflg, errmsg)
+       if(errflg/=0) return
     endif
 
     ! Update trace gases (co2 only)...
@@ -233,13 +236,13 @@ subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad
     endif
     call gas_update (kyear, kmon, kday, khour, lco2_chg, me, co2dat_file, co2gbl_file, ictm,&
          ico2, errflg, errmsg )
+    if(errflg/=0) return
     if (ntoz == 0) then
        call ozphys%update_o3clim(kmon, kday, khour, loz1st)
     endif
 
     if ( loz1st ) loz1st = .false.
 
-    return
   end subroutine GFS_rrtmgp_setup_timestep_init
 
 !> \section arg_table_GFS_rrtmgp_setup_finalize Argument Table