From 4c601576b39e9b0ecdf81efa9a2a866d227f979c Mon Sep 17 00:00:00 2001 From: Matus Martini Date: Thu, 5 Jun 2025 04:48:27 +0000 Subject: [PATCH 1/6] Insert return calls if an error occurs --- .../UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 | 9 ++++++--- .../UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 | 16 +++++++++++++--- .../UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 | 7 +++++-- 3 files changed, 24 insertions(+), 8 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 index 0c90478be..a22b0c5ae 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 @@ -229,6 +229,7 @@ subroutine GFS_phys_time_vary_init ( myerrmsg = 'read_aerdata failed without a message' call read_aerdata (me,master,iflip,idate,myerrmsg,myerrflg) call copy_error(myerrmsg, myerrflg, errmsg, errflg) + if(errflg/=0) return else if(iaermdl ==2 ) then do ix=1,ntrcaerm do j=1,levs @@ -255,6 +256,7 @@ subroutine GFS_phys_time_vary_init ( myerrmsg = 'read_tau_amf failed without a message' call read_tau_amf(me, master, myerrmsg, myerrflg) call copy_error(myerrmsg, myerrflg, errmsg, errflg) + if(errflg/=0) return endif !> - Initialize soil vegetation (needed for sncovr calculation further down) @@ -262,6 +264,7 @@ subroutine GFS_phys_time_vary_init ( myerrmsg = 'set_soilveg failed without a message' call set_soilveg(me, isot, ivegsrc, nlunit, myerrmsg, myerrflg) call copy_error(myerrmsg, myerrflg, errmsg, errflg) + if(errflg/=0) return !> - read in NoahMP table (needed for NoahMP init) if(lsm == lsm_noahmp) then @@ -269,6 +272,7 @@ subroutine GFS_phys_time_vary_init ( myerrmsg = 'read_mp_table_parameters failed without a message' call read_mp_table_parameters(myerrmsg, myerrflg) call copy_error(myerrmsg, myerrflg, errmsg, errflg) + if(errflg/=0) return endif @@ -557,6 +561,7 @@ subroutine GFS_phys_time_vary_init ( 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) + if(errflg/=0) return endif ! Now we have the snowxy field @@ -911,9 +916,7 @@ subroutine GFS_phys_time_vary_timestep_init ( ddy_aer, iindx1_aer, & iindx2_aer, ddx_aer, & levs, prsl, aer_nm, errmsg, errflg) - if(errflg /= 0) then - return - endif + if(errflg /= 0) return endif !> - Call gcycle() to repopulate specific time-varying surface properties for AMIP/forecast runs diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 index cc8e950e8..5b6e5ad4f 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 @@ -218,14 +218,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, & @@ -235,8 +244,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 @@ -446,6 +453,7 @@ 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 @@ -453,6 +461,7 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,& !! 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: @@ -466,6 +475,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 @@ -478,7 +489,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 !----------------------------------- diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 index 0ed936410..117914f59 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 @@ -128,7 +128,9 @@ 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' @@ -136,7 +138,6 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, is_initialized = .true. - return end subroutine GFS_rrtmgp_setup_init !> \section arg_table_GFS_rrtmgp_setup_timestep_init Argument Table @@ -222,11 +223,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)... @@ -238,13 +241,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 From f97089710a1bc58519b83749b0ed15147a635fdb Mon Sep 17 00:00:00 2001 From: Matus Martini Date: Thu, 5 Jun 2025 05:49:24 +0000 Subject: [PATCH 2/6] Insert return calls if an error occurs, remove unnecessary returns at the end of subroutines, remove duplicate print statements --- .../UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 | 1 - physics/Radiation/radiation_aerosols.f | 51 ++++++------------- physics/Radiation/radiation_astronomy.f | 5 -- 3 files changed, 16 insertions(+), 41 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 index 5b6e5ad4f..c3482b15c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 @@ -185,7 +185,6 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & endif iaermdl = iaer/1000 ! control flag for aerosol scheme selection if ( iaermdl < 0 .or. (iaermdl>2 .and. iaermdl/=5) ) then - print *, ' Error -- IAER flag is incorrect, Abort' errflg = 1 errmsg = 'ERROR(GFS_rrtmg_setup): IAER flag is incorrect' return diff --git a/physics/Radiation/radiation_aerosols.f b/physics/Radiation/radiation_aerosols.f index 983d592c1..f4c4fed24 100644 --- a/physics/Radiation/radiation_aerosols.f +++ b/physics/Radiation/radiation_aerosols.f @@ -574,6 +574,7 @@ subroutine aer_init & call wrt_aerlog(iaermdl, iaerflg, lalw1bd, errflg, errmsg) ! write aerosol param info to log file ! --- inputs: (in scope variables) ! --- outputs: (CCPP error handling) + if(errflg/=0) return endif @@ -627,6 +628,7 @@ subroutine aer_init & & errflg, errmsg) ! --- inputs: (module constants) ! --- outputs: (ccpp error handling) + if(errflg/=0) return !> -# Call clim_aerinit() to invoke tropospheric aerosol initialization. @@ -636,6 +638,7 @@ subroutine aer_init & & ( solfwv, eirfwv, me, aeros_file, & ! --- outputs: & errflg, errmsg) + if(errflg/=0) return elseif ( iaermdl==1 .or. iaermdl==2 ) then ! gocart clim/prog scheme @@ -644,6 +647,7 @@ subroutine aer_init & & ( solfwv, eirfwv, me, & ! --- outputs: & errflg, errmsg) + if(errflg/=0) return else if ( me == 0 ) then @@ -776,7 +780,6 @@ subroutine wrt_aerlog(iaermdl, iaerflg, lalw1bd, errflg, errmsg) endif endif ! end if_iaerflg_block ! - return !................................ end subroutine wrt_aerlog !-------------------------------- @@ -887,7 +890,6 @@ subroutine set_spectrum(con_pi, con_t0c, con_c, con_boltz, & eirfwv(nw) = (tmp1 * tmp3**3) / (exp(tmp2*tmp3) - 1.0) enddo ! - return !................................ end subroutine set_spectrum !-------------------------------- @@ -935,7 +937,6 @@ subroutine set_volcaer(errflg, errmsg) allocate ( ivolae(12,4,10) ) ! for 12-mon,4-lat_zone,10-year endif ! - return !................................ end subroutine set_volcaer !-------------------------------- @@ -1155,9 +1156,6 @@ subroutine set_aercoef(aeros_file,errflg, errmsg) & action='read',form='FORMATTED') rewind (NIAERCM) else - print *,' Requested aerosol data file "',aeros_file, & - & '" not found!' - print *,' *** Stopped in subroutine aero_init !!' errflg = 1 errmsg = 'ERROR(set_aercoef): Requested aerosol data file '// & & aeros_file//' not found' @@ -1485,7 +1483,6 @@ subroutine set_aercoef(aeros_file,errflg, errmsg) ! print *,' extstra:', extstra(ii) ! enddo ! - return !................................ end subroutine set_aercoef !-------------------------------- @@ -1743,7 +1740,6 @@ subroutine optavg enddo ! end do_nb_block for lw endif ! end if_lalwflg_block ! - return !................................ end subroutine optavg !-------------------------------- @@ -1809,7 +1805,6 @@ subroutine aer_update & if ( imon < 1 .or. imon > 12 ) then print *,' ***** ERROR in specifying requested month !!! ', & & 'imon=', imon - print *,' ***** STOPPED in subroutinte aer_update !!!' errflg = 1 errmsg = 'ERROR(aer_update): Requested month not valid' return @@ -1820,6 +1815,7 @@ subroutine aer_update & if ( iaermdl == 0 .or. iaermdl==5 ) then ! opac-climatology scheme call trop_update(aeros_file, errflg, errmsg) + if(errflg/=0) return endif endif @@ -1911,9 +1907,6 @@ subroutine trop_update(aeros_file, errflg, errmsg) print *,' Opened aerosol data file: ',aeros_file endif else - print *,' Requested aerosol data file "',aeros_file, & - & '" not found!' - print *,' *** Stopped in subroutine trop_update !!' errflg = 1 errmsg = 'ERROR(trop_update):Requested aerosol data file '// & & aeros_file // ' not found.' @@ -2000,7 +1993,6 @@ subroutine trop_update(aeros_file, errflg, errmsg) ! print 17,kprfg ! 17 format(8e16.9) ! - return !................................ end subroutine trop_update !-------------------------------- @@ -2120,9 +2112,6 @@ subroutine volc_update(errflg, errmsg) close (NIAERCM) else - print *,' Requested volcanic data file "', & - & volcano_file,'" not found!' - print *,' *** Stopped in subroutine VOLC_AERINIT !!' errflg = 1 errmsg = 'ERROR(volc_update): Requested volcanic data '// & & 'file '//volcano_file//' not found!' @@ -2140,7 +2129,6 @@ subroutine volc_update(errflg, errmsg) print *, ivolae(kmonsav,:,k) endif ! - return !................................ end subroutine volc_update !-------------------------------- @@ -2392,7 +2380,7 @@ subroutine setaer & !! subroutine computes sw + lw aerosol optical properties for gocart !! aerosol species (merged from fcst and clim fields). - if ( iaermdl==0 .or. iaermdl==5 ) then ! use opac aerosol climatology + if ( iaermdl==0 .or. iaermdl==5 ) then ! use opac aerosol climatology call aer_property & ! --- inputs: @@ -2405,7 +2393,7 @@ subroutine setaer & & ) ! - elseif ( iaermdl==1 .or. iaermdl==2) then ! use gocart aerosols + elseif ( iaermdl==1 .or. iaermdl==2) then ! use gocart aerosols call aer_property_gocart & ! --- inputs: @@ -2416,6 +2404,7 @@ subroutine setaer & & aerosw,aerolw,aerodp,ext550,errflg,errmsg & & ) endif ! end if_iaerflg_block + if(errflg/=0) return ! --- check print @@ -2739,7 +2728,6 @@ subroutine setaer & endif ! end if_lavoflg_block ! - return !................................... end subroutine setaer !----------------------------------- @@ -2913,7 +2901,7 @@ subroutine aer_property & print *,' ERROR! In setclimaer alon>360. ipt =',i, & & ', dltg,alon,tlon,dlon =',dltg,alon(i),tmp1,dtmp errflg = 1 - errmsg = 'ERROR(aer_property)' + errmsg = 'ERROR(aer_property) alon > 360' return endif elseif ( dtmp >= f_zero ) then @@ -2933,7 +2921,7 @@ subroutine aer_property & print *,' ERROR! In setclimaer alon< 0. ipt =',i, & & ', dltg,alon,tlon,dlon =',dltg,alon(i),tmp1,dtmp errflg = 1 - errmsg = 'ERROR(aer_property)' + errmsg = 'ERROR(aer_property) alon < 0' return endif endif @@ -2954,7 +2942,7 @@ subroutine aer_property & print *,' ERROR! In setclimaer alat<-90. ipt =',i, & & ', dltg,alat,tlat,dlat =',dltg,alat(i),tmp2,dtmp errflg = 1 - errmsg = 'ERROR(aer_property)' + errmsg = 'ERROR(aer_property) alat < -90' return endif elseif ( dtmp >= f_zero ) then @@ -2974,7 +2962,7 @@ subroutine aer_property & print *,' ERROR! In setclimaer alat>90. ipt =',i, & & ', dltg,alat,tlat,dlat =',dltg,alat(i),tmp2,dtmp errflg = 1 - errmsg = 'ERROR(aer_property)' + errmsg = 'ERROR(aer_property) alat > 90' return endif endif @@ -3509,7 +3497,6 @@ subroutine radclimaer(top_at_1) endif ! - return !................................ end subroutine radclimaer !-------------------------------- @@ -3937,10 +3924,9 @@ subroutine rd_gocart_luts open (unit=niaercm, file=fin, status='OLD') rewind(niaercm) else - print *,' Requested luts file ',trim(fin),' not found' - print *,' ** Stopped in rd_gocart_luts ** ' errflg = 1 - errmsg = 'Requested luts file '//trim(fin)//' not found' + errmsg = 'ERROR(rd_gocart_luts): Requested luts file '// & + & trim(fin)//' not found' return endif ! end if_file_exist_block @@ -4004,10 +3990,9 @@ subroutine rd_gocart_luts open (unit=niaercm, file=fin, status='OLD') rewind(niaercm) else - print *,' Requested luts file ',trim(fin),' not found' - print *,' ** Stopped in rd_gocart_luts ** ' errflg = 1 - errmsg = 'Requested luts file '//trim(fin)//' not found' + errmsg = 'ERROR(rd_gocart_luts): Requested luts file '// & + & trim(fin)//' not found' return endif ! end if_file_exist_block @@ -4069,7 +4054,6 @@ subroutine rd_gocart_luts enddo !! ib-loop - return !................................... end subroutine rd_gocart_luts !----------------------------------- @@ -4296,8 +4280,6 @@ subroutine optavg_gocart enddo ! end do_nb_block for lw endif ! end if_lalwflg_block ! - return - return !................................... end subroutine optavg_gocart !----------------------------------- @@ -4690,7 +4672,6 @@ subroutine aeropt enddo ! end_do_ib_loop ! - return !................................ end subroutine aeropt !-------------------------------- diff --git a/physics/Radiation/radiation_astronomy.f b/physics/Radiation/radiation_astronomy.f index b25c89a8c..8f87e1b6a 100644 --- a/physics/Radiation/radiation_astronomy.f +++ b/physics/Radiation/radiation_astronomy.f @@ -304,7 +304,6 @@ subroutine sol_init & endif endif ! end if_isolar_block ! - return !................................... end subroutine sol_init !----------------------------------- @@ -641,7 +640,6 @@ subroutine sol_update & ! if (me == 0) print*,'in sol_update completed sr solar' ! - return !................................... end subroutine sol_update !----------------------------------- @@ -805,7 +803,6 @@ subroutine solar & if (sun < 0.0) sun = sun + tpi sollag = sun - alp - 0.03255e0 ! - return !................................... end subroutine solar !----------------------------------- @@ -904,7 +901,6 @@ subroutine coszmn & endif enddo ! - return !................................... end subroutine coszmn !----------------------------------- @@ -1030,7 +1026,6 @@ subroutine prtime & & ' SOLAR CONSTANT',8X,F12.7,' (DISTANCE AJUSTED)'//) ! - return !................................... end subroutine prtime !----------------------------------- From 98d8ecaaa2c422ca643d63d4f7e7ad8328c7e68f Mon Sep 17 00:00:00 2001 From: Matus Martini Date: Thu, 5 Jun 2025 15:54:56 +0000 Subject: [PATCH 3/6] Remove return call from inside OpenMP region --- physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 index a22b0c5ae..e77811644 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 @@ -561,7 +561,6 @@ subroutine GFS_phys_time_vary_init ( 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) - if(errflg/=0) return endif ! Now we have the snowxy field From b7e3e94ee300c8461c6670a63b4e19ebb74cef8a Mon Sep 17 00:00:00 2001 From: Matus Martini Date: Thu, 5 Jun 2025 17:31:47 +0000 Subject: [PATCH 4/6] Insert return calls if an error occurs, remove unnecessary return statements. More cleanup --- physics/GWD/cires_ugwpv1_oro.F90 | 5 +- physics/GWD/ugwpv1_gsldrag.F90 | 4 ++ .../Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 | 4 +- .../MP/GFDL/module_gfdl_cloud_microphys.F90 | 1 - physics/MP/Morrison_Gettelman/aer_cloud.F | 38 +------------ physics/MP/Morrison_Gettelman/m_micro.F90 | 2 - physics/Radiation/RRTMG/radlw_main.F90 | 3 - physics/Radiation/radiation_astronomy.f | 1 - physics/Radiation/radiation_clouds.f | 12 ---- physics/Radiation/radiation_gases.f | 31 +++-------- physics/SFC_Layer/GFDL/gfdl_sfc_layer.F90 | 3 + physics/SFC_Layer/GFDL/module_sf_exchcoef.f90 | 1 - physics/SFC_Layer/MYJ/module_SF_JSFC.F90 | 6 +- physics/SFC_Layer/MYJ/myjsfc_wrapper.F90 | 1 + physics/SFC_Layer/MYNN/module_sf_mynn.F90 | 55 +------------------ physics/SFC_Layer/UFS/sfc_diff.f | 2 - physics/SFC_Models/Land/Noah/lsm_noah.f | 2 +- physics/SFC_Models/Land/Noah/set_soilveg.f | 1 - physics/SFC_Models/Land/Noah/sflx.f | 32 +---------- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 6 +- physics/SFC_Models/Land/RUC/lsm_ruc.F90 | 4 +- .../SFC_Models/Land/RUC/set_soilveg_ruc.F90 | 4 -- 22 files changed, 35 insertions(+), 183 deletions(-) diff --git a/physics/GWD/cires_ugwpv1_oro.F90 b/physics/GWD/cires_ugwpv1_oro.F90 index 423a21348..16ff8f9af 100644 --- a/physics/GWD/cires_ugwpv1_oro.F90 +++ b/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 @@ -1008,13 +1008,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 ! diff --git a/physics/GWD/ugwpv1_gsldrag.F90 b/physics/GWD/ugwpv1_gsldrag.F90 index 094588a35..f66893858 100644 --- a/physics/GWD/ugwpv1_gsldrag.F90 +++ b/physics/GWD/ugwpv1_gsldrag.F90 @@ -586,6 +586,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 ! @@ -635,6 +637,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 ! diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 index 101977960..03055b436 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 @@ -225,7 +225,6 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml, #ifndef INTERNAL_FILE_NML inquire (file=trim(fn_nml),exist=exists) if (.not. exists) then - write(6,*) 'gcycle:: namelist file: ',trim(fn_nml),' does not exist' errflg = 1 errmsg = 'ERROR(gcycle): namelist file: ',trim(fn_nml),' does not exist.' return @@ -299,7 +298,6 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml, ! ! if (Model%me .eq. 0) print*,'executed gcycle during hour=',fhour ! - RETURN - END + end subroutine gcycle end module gcycle_mod diff --git a/physics/MP/GFDL/module_gfdl_cloud_microphys.F90 b/physics/MP/GFDL/module_gfdl_cloud_microphys.F90 index 09e3c4b31..33eaaf743 100644 --- a/physics/MP/GFDL/module_gfdl_cloud_microphys.F90 +++ b/physics/MP/GFDL/module_gfdl_cloud_microphys.F90 @@ -3601,7 +3601,6 @@ subroutine gfdl_cloud_microphys_mod_init (me, master, nlunit, input_nml_file, lo #else inquire (file = trim (fn_nml), exist = exists) if (.not. exists) then - write (6, *) 'gfdl - mp :: namelist file: ', trim (fn_nml), ' does not exist' errflg = 1 errmsg = 'ERROR(gfdl_cloud_microphys_mod_init): namelist file '//trim (fn_nml)//' does not exist' return diff --git a/physics/MP/Morrison_Gettelman/aer_cloud.F b/physics/MP/Morrison_Gettelman/aer_cloud.F index a334428d1..d6bf6a078 100644 --- a/physics/MP/Morrison_Gettelman/aer_cloud.F +++ b/physics/MP/Morrison_Gettelman/aer_cloud.F @@ -621,7 +621,6 @@ subroutine aerosol_activate(tparc_in, pparc_in, sigwparc_in, & ! deallocate (kappa_par) - 2033 return END subroutine aerosol_activate @@ -808,7 +807,6 @@ SUBROUTINE AerConversion_base () AerPr_base_clean%dpg(9:11) = DPGI_aux(9:11) AerPr_base_clean%sig(9:11) = SIGI_aux(9:11) - RETURN ! END SUBROUTINE AerConversion_base @@ -920,7 +918,6 @@ SUBROUTINE AerConversion (aer_mass, AerPr, kappa, SULFATE, ORG, & end do end do - RETURN ! END SUBROUTINE AerConversion @@ -1013,7 +1010,6 @@ SUBROUTINE AerConversion1 (aer_mass, AerPr) end do end do - RETURN ! END SUBROUTINE AerConversion1 @@ -1382,7 +1378,6 @@ subroutine ccnspec (tparc,pparc,nmodes, ! *** end of subroutine ccnspec **************************************** ! - return end subroutine ccnspec @@ -1469,7 +1464,6 @@ subroutine pdfactiv (wparc,sigw, nact,smax,nmodes, smax = smax*scal endif ! - return ! ! *** end of subroutine pdfactiv **************************************** ! @@ -1591,7 +1585,6 @@ subroutine activate (wparc,ndroplet,smax,nmodes, smax = x3 ndroplet=ndrpl - return ! ! *** end of subroutine activate **************************************** ! @@ -1678,7 +1671,6 @@ subroutine sintegral (spar, summa, sum, summat,wparcel,nmodes, summa = summa + nd(j) 999 continue ! - return end subroutine sintegral !======================================================================= @@ -1732,7 +1724,6 @@ subroutine props(pres_par,temp_par,surt_par,dv_par,act_param, end if ! - return ! ! *** end of subroutine props ******************************************* ! @@ -1783,7 +1774,6 @@ real*8 function vpres (t) ! ! end of function vpres ! - return end function vpres @@ -1819,7 +1809,6 @@ real*8 function sft (t) tpars = t-273.15d0 sft = 0.0761-1.55e-4*tpars ! - return end function sft @@ -1859,7 +1848,6 @@ subroutine gauleg (x,w,n) w(i)=2.d0*xl/((1.d0-z*z)*pp*pp) w(n+1-i)=w(i) 12 continue - return end subroutine gauleg !C======================================================================= @@ -1885,7 +1873,6 @@ REAL*8 FUNCTION erf(x) else erf = axx endif - RETURN END FUNCTION @@ -1907,7 +1894,6 @@ REAL*8 FUNCTION erf(x) ! else ! erf=gammp(.5d0,x**2) ! endif -! return ! end function erf @@ -1934,7 +1920,6 @@ real*8 function gammln(xx) ser=ser+cof(j)/x 11 continue gammln=tmp+log(stp*ser) - return end function gammln @@ -1955,7 +1940,6 @@ end function gammln ! call gcf(gammcf,a,x,gln) ! gammp=1.d0-gammcf ! endif -! return ! end function gammp @@ -1996,7 +1980,6 @@ end function gammln !1 continue ! pause 'a too large, itmax too small' ! gammcf=exp(-x+a*log(x)-gln)*g -! return ! end subroutine gcf @@ -2030,7 +2013,6 @@ end function gammln !1 continue ! pause 'a too large, itmax too small' ! gamser=sum*exp(-x+a*log(x)-gln) -! return ! end subroutine gser ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -2146,7 +2128,6 @@ SUBROUTINE IceParam (sigma_w, denice_ice,ddry_ice,np_ice, end if - return END subroutine IceParam @@ -2239,7 +2220,6 @@ subroutine nice_Vdist(denice_ice,ddry_ice,np_ice, nhet=sum3*(vmax_ice-vmin_ice)*0.5d0 nlim=sum4*(vmax_ice-vmin_ice)*0.5d0 sc_ice=sum5*(vmax_ice-vmin_ice)*0.5d0 - RETURN END subroutine nice_Vdist @@ -2591,8 +2571,6 @@ subroutine nice_param(wpar_icex,denice_ice,ddry_ice,np_ice, sc_ice=min(shom_ice+1.0, sc_ice) - return - END subroutine nice_param !************************************************************* real*8 function FINDSMAX(SX,DSH, @@ -2670,7 +2648,6 @@ real*8 function VPRESWATER_ice(T) VPRESWATER_ice=EXP(VPRESWATER_ice) - return END function VPRESWATER_ice !************************************************************* @@ -2690,7 +2667,6 @@ real*8 function VPRESICE(T) VPRESICE = A(0)+(A(1)/T)+(A(2)*LOG(T))+(A(3)*T) VPRESICE=EXP(VPRESICE) - return END function VPRESICE !************************************************************* @@ -2711,7 +2687,7 @@ real*8 function DHSUB_ice(T) & A(4))**2))) DHSUB_ice=1000d0*DHSUB_ice/18d0 - return + END function DHSUB_ice !************************************************************* @@ -2730,7 +2706,7 @@ real*8 function DENSITYICE(T) TTEMP=T-273d0 DENSITYICE= 1000d0*(A(0)+(A(1)*TTEMP)+(A(2)*TTEMP*TTEMP)) - return + END function DENSITYICE !************************************************************* @@ -2768,7 +2744,7 @@ real*8 function WATDENSITY_ice(T) WATDENSITY=WATDENSITY*1000d0 WATDENSITY_ice=WATDENSITY - return + END function WATDENSITY_ice @@ -2914,8 +2890,6 @@ SUBROUTINE prop_ice(T, P, denice_ice,ddry_ice, del1bc_ice=cubicint_ice(Tc, T0bc, T0bc+5d0, 1d0, hbc) end if - RETURN - END SUBROUTINE prop_ice !************************************************************* @@ -2937,8 +2911,6 @@ SUBROUTINE gausspdf(x, dp, sigmav_ice,miuv_ice,normv_ice) &sigmav_ice/sq2pi_par/(normv_ice + 0.001) - RETURN - END SUBROUTINE gausspdf @@ -3967,7 +3939,6 @@ real function H_1(X, X_1, X_2, Hlo) if( X_2 <= X_1) stop 91919 - return end function @@ -3999,13 +3970,10 @@ real function H_1_smooth(X, X_1, X_2, Hlo, Hhi,dH1smooth) if( X_2 <= X_1) stop 91919 - return end function - - ! END ICE PARAMETERIZATION DONIF ! !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC diff --git a/physics/MP/Morrison_Gettelman/m_micro.F90 b/physics/MP/Morrison_Gettelman/m_micro.F90 index 9a1a24923..1cc866689 100644 --- a/physics/MP/Morrison_Gettelman/m_micro.F90 +++ b/physics/MP/Morrison_Gettelman/m_micro.F90 @@ -1987,7 +1987,6 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & end do end do - return end subroutine gw_prof !> @} @@ -2023,7 +2022,6 @@ subroutine find_cldtop(ncol, pver, cf, kcldtop) return endif - end subroutine find_cldtop end module m_micro diff --git a/physics/Radiation/RRTMG/radlw_main.F90 b/physics/Radiation/RRTMG/radlw_main.F90 index 2d6f64d3d..1c24ad814 100644 --- a/physics/Radiation/RRTMG/radlw_main.F90 +++ b/physics/Radiation/RRTMG/radlw_main.F90 @@ -1830,7 +1830,6 @@ subroutine cldprop & endif ! end if_isubclw_block - return ! .................................. end subroutine cldprop ! ---------------------------------- @@ -2103,7 +2102,6 @@ subroutine mcica_subcol & enddo enddo - return ! .................................. end subroutine mcica_subcol ! ---------------------------------- @@ -2402,7 +2400,6 @@ subroutine setcoef & enddo ! end do_k layer loop - return ! .................................. end subroutine setcoef ! ---------------------------------- diff --git a/physics/Radiation/radiation_astronomy.f b/physics/Radiation/radiation_astronomy.f index 8f87e1b6a..90ed7cd45 100644 --- a/physics/Radiation/radiation_astronomy.f +++ b/physics/Radiation/radiation_astronomy.f @@ -432,7 +432,6 @@ subroutine sol_update & inquire (file=solar_fname, exist=file_exist) if ( .not. file_exist ) then - print *,' !!! ERROR! Can not find solar constant file!!!' errflg = 1 errmsg = "ERROR(radiation_astronomy): solar constant file"//& & " not found" diff --git a/physics/Radiation/radiation_clouds.f b/physics/Radiation/radiation_clouds.f index 11f0a1204..c141db4bf 100644 --- a/physics/Radiation/radiation_clouds.f +++ b/physics/Radiation/radiation_clouds.f @@ -328,7 +328,6 @@ subroutine cld_init & endif endif ! - return !................................... end subroutine cld_init !----------------------------------- @@ -874,7 +873,6 @@ subroutine radiation_clouds_prop & & clds, mtop, mbot & & ) - return !................................... end subroutine radiation_clouds_prop @@ -1171,7 +1169,6 @@ subroutine progcld_zhao_carr & enddo enddo ! - return !................................... end subroutine progcld_zhao_carr !----------------------------------- @@ -1465,7 +1462,6 @@ subroutine progcld_zhao_carr_pdf & enddo enddo ! - return !................................... end subroutine progcld_zhao_carr_pdf !----------------------------------- @@ -1707,7 +1703,6 @@ subroutine progcld_gfdl_lin & enddo enddo ! - return !................................... end subroutine progcld_gfdl_lin !----------------------------------- @@ -1955,7 +1950,6 @@ subroutine progcld_fer_hires & enddo enddo ! - return !................................... end subroutine progcld_fer_hires !................................... @@ -2269,8 +2263,6 @@ subroutine progcld_thompson_wsm6 & enddo enddo - return - !............................................ end subroutine progcld_thompson_wsm6 !............................................ @@ -2555,8 +2547,6 @@ subroutine progcld_thompson & iwp_ex(i) = iwp_ex(i)*1.E-3 enddo ! - return - !............................................ end subroutine progcld_thompson !............................................ @@ -2842,7 +2832,6 @@ subroutine progclduni & enddo enddo ! - return !................................... end subroutine progclduni !----------------------------------- @@ -3301,7 +3290,6 @@ subroutine gethml & endif ! end_if_top_at_1 ! - return !................................... end subroutine gethml !----------------------------------- diff --git a/physics/Radiation/radiation_gases.f b/physics/Radiation/radiation_gases.f index 4c626b348..449c3b958 100644 --- a/physics/Radiation/radiation_gases.f +++ b/physics/Radiation/radiation_gases.f @@ -281,9 +281,9 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & inquire (file=co2usr_file, exist=file_exist) if ( .not. file_exist ) then - print *,' Can not find user CO2 data file: ',co2usr_file errflg = 1 - errmsg = 'ERROR(gas_init): Can not find user CO2 data file' + errmsg = 'ERROR(gas_init): Cannot find user CO2 data file'//& + & ': '//co2usr_file return else close (NICO2CN) @@ -327,7 +327,7 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & else print *,' ICO2=',ico2flg,' is not a valid selection' errflg = 1 - errmsg = 'ERROR(gas_init): ICO2 is not valid' + errmsg = 'ERROR(gas_init): ICO2 is not a valid selection' return endif ! endif_ico2flg_block @@ -349,20 +349,16 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & else print *,' ICO2=',ico2flg,' is not a valid selection' errflg = 1 - errmsg = 'ERROR(gas_init): ICO2 is not valid' + errmsg = 'ERROR(gas_init): ICO2 is not a valid selection' return endif if ( ictmflg == -2 ) then inquire (file=co2cyc_file, exist=file_exist) if ( .not. file_exist ) then - if ( me == 0 ) then - print *,' Can not find seasonal cycle CO2 data: ', & - & co2cyc_file - endif errflg = 1 errmsg = 'ERROR(gas_init): Can not find seasonal cycle '//& - & 'CO2 data' + & 'CO2 data file: '//co2cyc_file return else allocate( co2cyc_sav(IMXCO2,JMXCO2,12) ) @@ -404,8 +400,6 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & endif lab_ictm endif lab_ico2 - - return ! !................................... end subroutine gas_init @@ -550,11 +544,9 @@ subroutine gas_update(iyear, imon, iday, ihour, ldoco2, & inquire (file=co2gbl_file, exist=file_exist) if ( .not. file_exist ) then - print *,' Requested co2 data file "',co2gbl_file, & - & '" not found' errflg = 1 errmsg = 'ERROR(gas_update): Requested co2 data file not '// & - & 'found' + & 'found: '//co2gbl_file return else close(NICO2CN) @@ -648,12 +640,9 @@ subroutine gas_update(iyear, imon, iday, ihour, ldoco2, & enddo Lab_dowhile2 if ( .not. file_exist ) then - if ( me == 0 ) then - print *,' Can not find co2 data source file' - endif errflg = 1 - errmsg = 'ERROR(gas_update): Can not find co2 data '// & - & 'source file' + errmsg = 'ERROR(gas_update): Cannot find co2 data '// & + & 'source file: '//co2dat_file return endif endif Lab_if_ictm @@ -767,8 +756,6 @@ subroutine gas_update(iyear, imon, iday, ihour, ldoco2, & close ( NICO2CN ) endif Lab_if_idyr - - return ! !................................... end subroutine gas_update @@ -934,9 +921,7 @@ subroutine getgases( plvl, xlon, xlat, IMAX, LMAX, ico2flg, & endif enddo endif - ! - return !................................... end subroutine getgases !----------------------------------- diff --git a/physics/SFC_Layer/GFDL/gfdl_sfc_layer.F90 b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.F90 index ce6501908..7b9945673 100644 --- a/physics/SFC_Layer/GFDL/gfdl_sfc_layer.F90 +++ b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.F90 @@ -1149,6 +1149,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m zoc(i) = -100.*znotm zot(i) = -100* znott endif + if(errflg/=0) return endif !------------------------------------------------------------------------ ! where necessary modify zo values over ocean. @@ -1783,6 +1784,8 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m if ( iwavecpl .eq. 1 .and. zoc(i) .le. 0.0 ) then windmks = wind10(i) * 0.01 call znot_wind10m(windmks,znott,znotm,icoef_sf,errmsg,errflg) + if(errflg/=0) return + !Check if Charnock parameter ratio is received in a proper range. if ( alpha(i) .ge. 0.2 .and. alpha(i) .le. 5. ) then znotm = znotm*alpha(i) diff --git a/physics/SFC_Layer/GFDL/module_sf_exchcoef.f90 b/physics/SFC_Layer/GFDL/module_sf_exchcoef.f90 index e82fd4371..8ae67954d 100644 --- a/physics/SFC_Layer/GFDL/module_sf_exchcoef.f90 +++ b/physics/SFC_Layer/GFDL/module_sf_exchcoef.f90 @@ -729,7 +729,6 @@ SUBROUTINE znot_wind10m(w10m,znott,znotm,icoef_sf,errmsg,errflg) call znot_m_v8(windmks,zm1) call znot_t_v8(windmks,zt1) else - write(0,*)'stop, icoef_sf must be one of 0,1,2,3,4,5,6,7,8' errflg = 1 errmsg = 'ERROR(znot_wind10m): icoef_sf must be one of 0,1,2,3,4,5,6,7,8' return diff --git a/physics/SFC_Layer/MYJ/module_SF_JSFC.F90 b/physics/SFC_Layer/MYJ/module_SF_JSFC.F90 index fdf188b96..674883e16 100644 --- a/physics/SFC_Layer/MYJ/module_SF_JSFC.F90 +++ b/physics/SFC_Layer/MYJ/module_SF_JSFC.F90 @@ -715,12 +715,11 @@ SUBROUTINE SFCDIF(NTSD,SEAMASK,THS,QS,PSFC & print*,'ZSLU,ZSLT,RLMO,ZU,ZT=',ZSLU,ZSLT,RLMO,ZU,ZT print*,'A,B,DTHV,DU2,RIB=',A,B,DTHV,DU2,RIB errflg = 1 - errmsg = 'ERROR(SFCDIF): ' + errmsg = 'ERROR(SFCDIF): in module_SF_JSFC.F90' return end if - AKMS=MAX(USTARK/SIMM,CXCHS) AKHS=MAX(USTARK/SIMH,CXCHS) ! @@ -872,9 +871,6 @@ SUBROUTINE SFCDIF(NTSD,SEAMASK,THS,QS,PSFC & ! stop ! end if - - - ! RZ=(ZETAT-ZTMIN2)/DZETA2 K=INT(RZ) diff --git a/physics/SFC_Layer/MYJ/myjsfc_wrapper.F90 b/physics/SFC_Layer/MYJ/myjsfc_wrapper.F90 index 4f122ef88..d8f6b543c 100644 --- a/physics/SFC_Layer/MYJ/myjsfc_wrapper.F90 +++ b/physics/SFC_Layer/MYJ/myjsfc_wrapper.F90 @@ -335,6 +335,7 @@ SUBROUTINE myjsfc_wrapper_run( & ,1,im,1,1,1,levs & ,1,im,1,1,1,levs & ,1,im,1,1,1,levs, errmsg, errflg) + if(errflg/=0) return do i = 1, im if(flag_iter(i))then diff --git a/physics/SFC_Layer/MYNN/module_sf_mynn.F90 b/physics/SFC_Layer/MYNN/module_sf_mynn.F90 index 7b1458688..cb066dc31 100644 --- a/physics/SFC_Layer/MYNN/module_sf_mynn.F90 +++ b/physics/SFC_Layer/MYNN/module_sf_mynn.F90 @@ -1345,6 +1345,8 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ELSEIF ( ISFTCFLX .EQ. 4 ) THEN !GFS zt formulation CALL GFS_zt_wat(ZT_wat(i),ZNTstoch_wat(i),restar,WSPD(i),ZA(i),sfc_z0_type,device_errmsg,device_errflg) + if(errflg/=0) return + ZQ_wat(i)=ZT_wat(i) ENDIF ELSE @@ -2630,8 +2632,6 @@ SUBROUTINE zilitinkevich_1995(Z_0,Zt,Zq,restar,ustar,KARMAN,& ENDIF - return - END SUBROUTINE zilitinkevich_1995 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -2663,8 +2663,6 @@ SUBROUTINE davis_etal_2008(Z_0,ustar) Z_0 = MAX( Z_0, 1.27e-7_kind_phys) !These max/mins were suggested by Z_0 = MIN( Z_0, 2.85e-3_kind_phys) !Davis et al. (2008) - return - END SUBROUTINE davis_etal_2008 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -2689,8 +2687,6 @@ SUBROUTINE Taylor_Yelland_2001(Z_0,ustar,wsp10) Z_0 = MAX( Z_0, 1.27e-7_kind_phys) !These max/mins were suggested by Z_0 = MIN( Z_0, 2.85e-3_kind_phys) !Davis et al. (2008) - return - END SUBROUTINE Taylor_Yelland_2001 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -2714,8 +2710,6 @@ SUBROUTINE charnock_1955(Z_0,ustar,wsp10,visc,zu) Z_0 = MAX( Z_0, 1.27e-7_kind_phys) !These max/mins were suggested by Z_0 = MIN( Z_0, 2.85e-3_kind_phys) !Davis et al. (2008) - return - END SUBROUTINE charnock_1955 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -2741,8 +2735,6 @@ SUBROUTINE edson_etal_2013(Z_0,ustar,wsp10,visc,zu) Z_0 = MAX( Z_0, 1.27e-7_kind_phys) !These max/mins were suggested by Z_0 = MIN( Z_0, 2.85e-3_kind_phys) !Davis et al. (2008) - return - END SUBROUTINE edson_etal_2013 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -2774,8 +2766,6 @@ SUBROUTINE garratt_1992(Zt,Zq,Z_0,Ren,landsea) Zt = Zq ENDIF - return - END SUBROUTINE garratt_1992 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -2822,8 +2812,6 @@ SUBROUTINE fairall_etal_2003(Zt,Zq,Ren,ustar,visc,rstoch,spp_sfc) Zq = MIN(Zt,1.0e-4_kind_phys) Zq = MAX(Zt,2.0e-9_kind_phys) - return - END SUBROUTINE fairall_etal_2003 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -2851,8 +2839,6 @@ SUBROUTINE fairall_etal_2014(Zt,Zq,Ren,ustar,visc,rstoch,spp_sfc) Zq = MAX(Zt,2.0e-9_kind_phys) ENDIF - return - END SUBROUTINE fairall_etal_2014 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -2909,8 +2895,6 @@ SUBROUTINE Yang_2008(Z_0,Zt,Zq,ustar,tstar,qst,Ren,visc) Zt = MIN(Zt, Z_0/2.0) Zq = MIN(Zq, Z_0/2.0) - return - END SUBROUTINE Yang_2008 !-------------------------------------------------------------------- ! Taken from the GFS (sfc_diff.f) for comparison @@ -3109,7 +3093,7 @@ SUBROUTINE GFS_zt_wat(ztmax,z0rl_wat,restar,WSPD,z1,sfc_z0_type,device_errmsg,de else if (sfc_z0_type == 7) then call znot_t_v7(wind10m, ztmax) ! 10-m wind,m/s, ztmax(m) else if (sfc_z0_type > 0) then - write(0,*)'no option for sfc_z0_type=',sfc_z0_type + write(0,*)'not a valid option for sfc_z0_type=',sfc_z0_type ! errflg = 1 ! errmsg = 'ERROR(GFS_zt_wat): sfc_z0_type not valid.' device_errflg = 1 @@ -3402,8 +3386,6 @@ SUBROUTINE Andreas_2002(Z_0,bvisc,ustar,Zt,Zq) ENDIF - return - END SUBROUTINE Andreas_2002 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -3438,8 +3420,6 @@ SUBROUTINE PSI_Hogstrom_1996(psi_m, psi_h, zL, Zt, Z_0, Za) ENDIF - return - END SUBROUTINE PSI_Hogstrom_1996 !-------------------------------------------------------------------- !> \ingroup mynn_sfc @@ -3477,8 +3457,6 @@ SUBROUTINE PSI_DyerHicks(psi_m, psi_h, zL, Zt, Z_0, Za) ENDIF - return - END SUBROUTINE PSI_DyerHicks !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -3508,8 +3486,6 @@ SUBROUTINE PSI_Beljaars_Holtslag_1991(psi_m, psi_h, zL) ENDIF - return - END SUBROUTINE PSI_Beljaars_Holtslag_1991 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -3539,8 +3515,6 @@ SUBROUTINE PSI_Zilitinkevich_Esau_2007(psi_m, psi_h, zL) ENDIF - return - END SUBROUTINE PSI_Zilitinkevich_Esau_2007 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -3571,8 +3545,6 @@ SUBROUTINE PSI_Businger_1971(psi_m, psi_h, zL) ENDIF - return - END SUBROUTINE PSI_Businger_1971 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -3604,8 +3576,6 @@ SUBROUTINE PSI_Suselj_Sood_2010(psi_m, psi_h, zL) ENDIF - return - END SUBROUTINE PSI_Suselj_Sood_2010 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -3623,8 +3593,6 @@ SUBROUTINE PSI_CB2005(psim1,psih1,zL,z0L) psih1 = -5.5*log(zL + (1.+ zL**1.1)**0.90909090909) & -5.5*log(z0L + (1.+ z0L**1.1)**0.90909090909) - return - END SUBROUTINE PSI_CB2005 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -3688,8 +3656,6 @@ SUBROUTINE Li_etal_2010(zL, Rib, zaz0, z0zt) zL = MAX(zL,1._kind_phys) ENDIF - return - END SUBROUTINE Li_etal_2010 !------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -3745,7 +3711,6 @@ REAL(kind_phys) function zolri(ri,za,z0,zt,zol1,psi_opt) !print*,"SUCCESS,n=",n," Ri=",ri," z0=",z0 endif - return end function !------------------------------------------------------------------- REAL(kind_phys) function zolri2(zol2,ri2,za,z0,zt,psi_opt) @@ -3786,7 +3751,6 @@ REAL(kind_phys) function zolri2(zol2,ri2,za,z0,zt,psi_opt) zolri2=zol2*psit2/psix2**2 - ri2 !print*," target ri=",ri2," est ri=",zol2*psit2/psix2**2 - return end function !==================================================================== @@ -3863,7 +3827,6 @@ REAL(kind_phys) function zolrib(ri,za,z0,zt,logz0,logzt,zol1,psi_opt) !print*,"SUCCESS,n=",n," Ri=",ri," z0=",z0 endif - return end function !==================================================================== !>\ingroup mynn_sfc @@ -3923,7 +3886,6 @@ real(kind_phys) function psim_stable_full(zolf) !psim_stable_full=-6.1*log(zolf+(1+zolf**2.5)**(1./2.5)) psim_stable_full=-6.1*log(zolf+(1+zolf**2.5)**0.4) - return end function !>\ingroup mynn_sfc @@ -3934,7 +3896,6 @@ real(kind_phys) function psih_stable_full(zolf) !psih_stable_full=-5.3*log(zolf+(1+zolf**1.1)**(1./1.1)) psih_stable_full=-5.3*log(zolf+(1+zolf**1.1)**0.9090909090909090909) - return end function !>\ingroup mynn_sfc @@ -3953,7 +3914,6 @@ real(kind_phys) function psim_unstable_full(zolf) psim_unstable_full=(psimk+zolf**2*(psimc))/(1+zolf**2.) - return end function !>\ingroup mynn_sfc @@ -3971,7 +3931,6 @@ real(kind_phys) function psih_unstable_full(zolf) psih_unstable_full=(psihk+zolf**2*(psihc))/(1+zolf**2) - return end function ! ================================================================== @@ -3988,7 +3947,6 @@ REAL(kind_phys) function psim_stable_full_gfs(zolf) aa = sqrt(1. + alpha4 * zolf) psim_stable_full_gfs = -1.*aa + log(aa + 1.) - return end function !>\ingroup mynn_sfc @@ -4002,7 +3960,6 @@ real(kind_phys) function psih_stable_full_gfs(zolf) bb = sqrt(1. + alpha4 * zolf) psih_stable_full_gfs = -1.*bb + log(bb + 1.) - return end function !>\ingroup mynn_sfc @@ -4023,7 +3980,6 @@ real(kind_phys) function psim_unstable_full_gfs(zolf) psim_unstable_full_gfs = log(hl1) + 2. * sqrt(tem1) - .8776 end if - return end function !>\ingroup mynn_sfc @@ -4044,7 +4000,6 @@ real(kind_phys) function psih_unstable_full_gfs(zolf) psih_unstable_full_gfs = log(hl1) + .5 * tem1 + 1.386 end if - return end function !>\ingroup mynn_sfc @@ -4066,7 +4021,6 @@ real(kind_phys) function psim_stable(zolf,psi_opt) endif endif - return end function !>\ingroup mynn_sfc @@ -4087,7 +4041,6 @@ real(kind_phys) function psih_stable(zolf,psi_opt) endif endif - return end function !>\ingroup mynn_sfc @@ -4108,7 +4061,6 @@ real(kind_phys) function psim_unstable(zolf,psi_opt) endif endif - return end function !>\ingroup mynn_sfc @@ -4129,7 +4081,6 @@ real(kind_phys) function psih_unstable(zolf,psi_opt) endif endif - return end function !======================================================================== diff --git a/physics/SFC_Layer/UFS/sfc_diff.f b/physics/SFC_Layer/UFS/sfc_diff.f index 2b1d285f3..cbca525f6 100644 --- a/physics/SFC_Layer/UFS/sfc_diff.f +++ b/physics/SFC_Layer/UFS/sfc_diff.f @@ -467,7 +467,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) endif ! end of if(flagiter) loop enddo - return end subroutine sfc_diff_run !---------------------------------------- @@ -642,7 +641,6 @@ subroutine stability & stress = cm * wind * wind ustar = sqrt(stress) - return !................................. end subroutine stability !--------------------------------- diff --git a/physics/SFC_Models/Land/Noah/lsm_noah.f b/physics/SFC_Models/Land/Noah/lsm_noah.f index 6ff83c67f..9f41b83d0 100644 --- a/physics/SFC_Models/Land/Noah/lsm_noah.f +++ b/physics/SFC_Models/Land/Noah/lsm_noah.f @@ -546,6 +546,7 @@ subroutine lsm_noah_run & & snomlt, sncovr, rc, pc, rsmin, xlai, rcs, rct, rcq, & & rcsoil, soilw, soilm, smcwlt, smcdry, smcref, smcmax, & & errmsg, errflg ) + if(errflg/=0) return !> - Noah LSM: prepare variables for return to parent model and unit conversion. ! - 6. output (o): @@ -677,7 +678,6 @@ subroutine lsm_noah_run & endif ! land enddo ! - return !................................... end subroutine lsm_noah_run !----------------------------- diff --git a/physics/SFC_Models/Land/Noah/set_soilveg.f b/physics/SFC_Models/Land/Noah/set_soilveg.f index 8f9c4e782..b772c91f2 100644 --- a/physics/SFC_Models/Land/Noah/set_soilveg.f +++ b/physics/SFC_Models/Land/Noah/set_soilveg.f @@ -430,7 +430,6 @@ subroutine set_soilveg(me,isot,ivet,nlunit,errmsg,errflg) END DO ! if (me == 0) write(6,soil_veg) - return end subroutine set_soilveg end module set_soilveg_mod diff --git a/physics/SFC_Models/Land/Noah/sflx.f b/physics/SFC_Models/Land/Noah/sflx.f index c6822c0eb..efb2cb91a 100644 --- a/physics/SFC_Models/Land/Noah/sflx.f +++ b/physics/SFC_Models/Land/Noah/sflx.f @@ -422,6 +422,8 @@ subroutine gfssflx &! --- input !> - Call redprm() to set the land-surface paramters, !! including soil-type and veg-type dependent parameters. call redprm(errmsg, errflg) + if(errflg/=0) return + if(ivegsrc == 1) then !only igbp type has urban !urban @@ -1058,7 +1060,6 @@ subroutine alcalc ! endif ! - return !................................... end subroutine alcalc !----------------------------------- @@ -1216,7 +1217,6 @@ subroutine canres pc = (rr + delta) / (rr*(1.0 + rc*ch) + delta) ! - return !................................... end subroutine canres !----------------------------------- @@ -1279,7 +1279,6 @@ subroutine csnow ! sncond = 0.021 + 2.51 * sndens**2 ! - return !................................... end subroutine csnow !----------------------------------- @@ -1559,7 +1558,6 @@ subroutine nopac flx1 = 0.0 flx3 = 0.0 ! - return !................................... end subroutine nopac !----------------------------------- @@ -1671,7 +1669,6 @@ subroutine penman epsca = (a*rr + rad*delta) / (delta + rr) etp = epsca * rch / lsubc ! - return !................................... end subroutine penman !----------------------------------- @@ -1960,7 +1957,6 @@ subroutine redprm(errmsg, errflg) if (vegtyp == bare) shdfac = 0.0 if (nroot > nsoil) then - write(*,*) 'warning: too many root layers' errflg = 1 errmsg = 'ERROR(sflx.f): too many root layers' return @@ -1977,7 +1973,6 @@ subroutine redprm(errmsg, errflg) slope = slope_data(slopetyp) ! - return !................................... end subroutine redprm !----------------------------------- @@ -2265,7 +2260,6 @@ subroutine sfcdif ! print*,'ch=',ch ! print*,'----------------------------' ! - return !................................... end subroutine sfcdif !----------------------------------- @@ -2336,7 +2330,6 @@ subroutine snfrac ! sncovr = sneqv / (sneqv + 2.0*z0n) ! - return !................................... end subroutine snfrac !----------------------------------- @@ -2865,7 +2858,6 @@ subroutine snopac endif ! end if_ice_block ! - return !................................... end subroutine snopac !----------------------------------- @@ -2944,7 +2936,6 @@ subroutine snow_new snowhc = snowhc + hnewc snowh = snowhc * 0.01 ! - return !................................... end subroutine snow_new !----------------------------------- @@ -2996,7 +2987,6 @@ subroutine snowz0 z0 = (1.0 - sncovr)*z0 + sncovr*z0s ! - return !................................... end subroutine snowz0 !----------------------------------- @@ -3135,7 +3125,6 @@ subroutine tdfcnd & df = ake * (thksat - thkdry) + thkdry ! - return !................................... end subroutine tdfcnd !----------------------------------- @@ -3291,7 +3280,6 @@ subroutine evapo & eta1 = edir1 + ett1 + ec1 ! - return !................................... end subroutine evapo !----------------------------------- @@ -3462,7 +3450,6 @@ subroutine shflx & ssoil = df1*(stc(1) - t1) / (0.5*zsoil(1)) ! - return !................................... end subroutine shflx !----------------------------------- @@ -3675,7 +3662,6 @@ subroutine smflx & ! runof = runoff ! - return !................................... end subroutine smflx !----------------------------------- @@ -3837,7 +3823,6 @@ subroutine snowpack & snowh = snowhc * 0.01 ! - return !................................... end subroutine snowpack !----------------------------------- @@ -3912,7 +3897,6 @@ subroutine devap & edir1 = fx * ( 1.0 - shdfac ) * etp1 ! - return !................................... end subroutine devap !----------------------------------- @@ -4074,7 +4058,6 @@ subroutine frh2o & endif ! end if_tkelv_block ! - return !................................... end subroutine frh2o !----------------------------------- @@ -4448,7 +4431,6 @@ subroutine hrt & enddo ! end do_k_loop ! - return !................................... end subroutine hrt !----------------------------------- @@ -4623,7 +4605,6 @@ subroutine hrtice & enddo ! end do_k_loop ! - return !................................... end subroutine hrtice !----------------------------------- @@ -4723,7 +4704,6 @@ subroutine hstep & stcout(k) = stcin(k) + ci(k) enddo ! - return !................................... end subroutine hstep !----------------------------------- @@ -4826,7 +4806,6 @@ subroutine rosr12 & p(kk) = p(kk)*p(kk+1) + delta(kk) enddo ! - return !................................... end subroutine rosr12 !----------------------------------- @@ -4963,7 +4942,6 @@ subroutine snksrc & tsrc = -dh2o * lsubf * dz * (xh2o - sh2o) / dt sh2o = xh2o ! - return !................................... end subroutine snksrc !----------------------------------- @@ -5277,7 +5255,6 @@ subroutine srt & endif enddo ! end do_k_loop ! - return !................................... end subroutine srt !----------------------------------- @@ -5425,7 +5402,6 @@ subroutine sstep & if (cmc < 1.e-20) cmc = 0.0 cmc = min( cmc, cmcmax ) ! - return !................................... end subroutine sstep !----------------------------------- @@ -5497,7 +5473,6 @@ subroutine tbnd & tbnd1 = tu + (tb-tu)*(zup-zsoil(k))/(zup-zb) ! - return !................................... end subroutine tbnd !----------------------------------- @@ -5606,7 +5581,6 @@ subroutine tmpavg & endif ! end if_tup_block ! - return !................................... end subroutine tmpavg !----------------------------------- @@ -5739,7 +5713,6 @@ subroutine transp & ! enddo ! - return !................................... end subroutine transp !----------------------------------- @@ -5823,7 +5796,6 @@ subroutine wdfcnd & expon = (2.0 * bexp) + 3.0 wcnd = dksat * factr2 ** expon ! - return !................................... end subroutine wdfcnd !----------------------------------- diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index c7d14c3ca..0ba8e5523 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -110,14 +110,16 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, isot, ivegsrc, & !--- initialize soil vegetation call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg) + if(errflg/=0) return !--- read in noahmp table call read_mp_table_parameters(errmsg, errflg) + if(errflg/=0) return ! initialize psih and psim - if ( do_mynnsfclay ) then - call psi_init(psi_opt,errmsg,errflg) + call psi_init(psi_opt,errmsg,errflg) + if(errflg/=0) return endif pores (:) = maxsmc (:) diff --git a/physics/SFC_Models/Land/RUC/lsm_ruc.F90 b/physics/SFC_Models/Land/RUC/lsm_ruc.F90 index b24e72758..71264e7db 100644 --- a/physics/SFC_Models/Land/RUC/lsm_ruc.F90 +++ b/physics/SFC_Models/Land/RUC/lsm_ruc.F90 @@ -164,6 +164,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & !--- initialize soil vegetation call set_soilveg_ruc(me, isot, ivegsrc, nlunit, errmsg, errflg) + if(errflg/=0) return pores (:) = maxsmc (:) resid (:) = drysmc (:) @@ -213,6 +214,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & zs, dzs, smc, slc, stc, & ! in sh2o, smfrkeep, tslb, smois, & ! out wetness, errmsg, errflg) + if(errflg/=0) return if (lsm_cold_start) then do i = 1, im ! i - horizontal loop @@ -1622,7 +1624,6 @@ subroutine lsm_ruc_run & ! inputs enddo ! i enddo ! j ! - return !................................... end subroutine lsm_ruc_run !----------------------------------- @@ -2022,5 +2023,4 @@ subroutine rucinit (lsm_cold_start, im, lsoil_ruc, lsoil, & ! in end subroutine rucinit - end module lsm_ruc diff --git a/physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 b/physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 index 8e2f3f54a..cf0780cb3 100644 --- a/physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 +++ b/physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 @@ -441,25 +441,21 @@ subroutine set_soilveg_ruc(me,isot,ivet,nlunit,errmsg,errflg) LPARAM =.FALSE. IF (DEFINED_SOIL .GT. MAX_SOILTYP) THEN - WRITE(0,*) 'Warning: DEFINED_SOIL too large in namelist' errflg = 1 errmsg = 'ERROR(set_soilveg_ruc): DEFINED_SOIL too large in namelist' return ENDIF IF (DEFINED_VEG .GT. MAX_VEGTYP) THEN - WRITE(0,*) 'Warning: DEFINED_VEG too large in namelist' errflg = 1 errmsg = 'ERROR(set_soilveg_ruc): DEFINED_VEG too large in namelist' return ENDIF IF (DEFINED_SLOPE .GT. MAX_SLOPETYP) THEN - WRITE(0,*) 'Warning: DEFINED_SLOPE too large in namelist' errflg = 1 errmsg = 'ERROR(set_soilveg_ruc): DEFINED_SLOPE too large in namelist' return ENDIF ! if (me == 0) write(6,soil_veg_ruc) - return end subroutine set_soilveg_ruc end module set_soilveg_ruc_mod From 8030eaa5202f3e20eac15b0964d25852992510da Mon Sep 17 00:00:00 2001 From: Matus Martini Date: Thu, 5 Jun 2025 19:29:27 +0000 Subject: [PATCH 5/6] Remove unused label and unnecessary return statement. Change one more "can not" to cannot. --- physics/MP/Morrison_Gettelman/aer_cloud.F | 3 --- physics/Radiation/radiation_gases.f | 2 +- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/physics/MP/Morrison_Gettelman/aer_cloud.F b/physics/MP/Morrison_Gettelman/aer_cloud.F index d6bf6a078..36bdf47ac 100644 --- a/physics/MP/Morrison_Gettelman/aer_cloud.F +++ b/physics/MP/Morrison_Gettelman/aer_cloud.F @@ -620,9 +620,6 @@ subroutine aerosol_activate(tparc_in, pparc_in, sigwparc_in, & ! deallocate (kappa_par) - -2033 return - END subroutine aerosol_activate ! diff --git a/physics/Radiation/radiation_gases.f b/physics/Radiation/radiation_gases.f index 449c3b958..784e8917e 100644 --- a/physics/Radiation/radiation_gases.f +++ b/physics/Radiation/radiation_gases.f @@ -357,7 +357,7 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & inquire (file=co2cyc_file, exist=file_exist) if ( .not. file_exist ) then errflg = 1 - errmsg = 'ERROR(gas_init): Can not find seasonal cycle '//& + errmsg = 'ERROR(gas_init): Cannot find seasonal cycle '// & & 'CO2 data file: '//co2cyc_file return else From 717d83e0d9f75e91749d3d55a59cba7b45136e9b Mon Sep 17 00:00:00 2001 From: Matus Martini Date: Wed, 25 Jun 2025 17:51:50 +0000 Subject: [PATCH 6/6] Remove copy_error calls from one-thread region. Access errmsg and errflg directly. On branch return-on-error --- .../GFS_phys_time_vary.fv3.F90 | 23 ++++++------------- 1 file changed, 7 insertions(+), 16 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 index b093fa0b1..b9c07f34b 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 @@ -214,6 +214,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 @@ -225,10 +228,7 @@ 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' - call read_aerdata (me,master,iflip,idate,myerrmsg,myerrflg) - call copy_error(myerrmsg, myerrflg, errmsg, errflg) + call read_aerdata (me,master,iflip,idate,errmsg,errflg) if(errflg/=0) return else if(iaermdl ==2 ) then do ix=1,ntrcaerm @@ -252,26 +252,17 @@ 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