From 756f2cf9be15b4f4d840299380b367ddd6ed03e5 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Fri, 26 Mar 2021 19:45:14 +0000 Subject: [PATCH 01/74] Consistent use of emissivity and albedo between RUC LSM and the radiation. --- physics/GFS_rrtmgp_sw_pre.F90 | 27 +++-- physics/GFS_rrtmgp_sw_pre.meta | 60 ++++++++++ physics/GFS_surface_composites.F90 | 28 ++++- physics/GFS_surface_composites.meta | 50 ++++++++ physics/module_sf_ruclsm.F90 | 46 +++++--- physics/radiation_surface.f | 170 ++++++++++++++++++++++------ physics/radlw_main.F90 | 66 +++++------ physics/rrtmg_lw_pre.F90 | 23 ++-- physics/rrtmg_lw_pre.meta | 82 ++++++++++++-- physics/rrtmg_sw_pre.F90 | 21 ++-- physics/rrtmg_sw_pre.meta | 60 ++++++++++ physics/rrtmgp_lw_pre.F90 | 24 +++- physics/rrtmgp_lw_pre.meta | 74 +++++++++++- physics/sfc_drv_ruc.F90 | 95 ++++++++++------ physics/sfc_drv_ruc.meta | 112 ++++++++++++++---- physics/sfc_noahmp_drv.meta | 6 +- 16 files changed, 766 insertions(+), 178 deletions(-) diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 457080536..93fc43dbb 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -27,18 +27,23 @@ end subroutine GFS_rrtmgp_sw_pre_init !> \section arg_table_GFS_rrtmgp_sw_pre_run !! \htmlinclude GFS_rrtmgp_sw_pre.html !! - subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_list, & - lndp_prt_list, doSWrad, solhr, lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, & - tsfg, tsfa, hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, albdvis, & + subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp, lndp_var_list, & + lndp_prt_list, lsm, lsm_noahmp, lsm_ruc, doSWrad, solhr, lon, coslat, sinlat, & + snowd, sncovr, sncovr_ice, snoalb, zorl, tsfg, tsfa, hprime, & + alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, albdvis, & albdnir, albivis, albinir, lsmask, sfc_wts, p_lay, tv_lay, relhum, p_lev, & nday, idxday, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, & - sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, errmsg, errflg) + sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, alb_ice, alb_sno_ice, & + sfalb_lnd_bck, errmsg, errflg) ! Inputs integer, intent(in) :: & me, & ! Current MPI rank nCol, & ! Number of horizontal grid points nLev, & ! Number of vertical layers + lsm, & ! LSM option + lsm_noahmp, & ! option for Noah MP LSM + lsm_ruc, & ! option for RUC LSM n_var_lndp, & ! Number of surface variables perturbed lndp_type ! Type of land perturbations scheme used character(len=3), dimension(n_var_lndp), intent(in) :: & @@ -55,7 +60,8 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ coslat, & ! Cosine(latitude) sinlat, & ! Sine(latitude) snowd, & ! Water equivalent snow depth (mm) - sncovr, & ! Surface snow area fraction (frac) + sncovr, & ! Surface snow area fraction over land (frac) + sncovr_ice, & ! Surface snow area fraction over ice (frac) snoalb, & ! Maximum snow albedo (frac) zorl, & ! Surface roughness length (cm) tsfg, & ! Surface ground temperature for radiation (K) @@ -83,6 +89,10 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ relhum ! Layer relative-humidity real(kind_phys), dimension(nCol,nLev+1),intent(in) :: & p_lev ! Pressure @ layer interfaces (Pa) + real(kind_phys), dimension(ncol), intent(inout) :: & + alb_ice, & ! Albedo of snow-free ice + alb_sno_ice, & ! Albedo of snow cover on ice + sfalb_lnd_bck ! Albedo of snow-free land ! Outputs integer, intent(out) :: & @@ -137,9 +147,10 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ ! #################################################################################### alb1d(:) = 0. lndp_alb = -999. - call setalb (lsmask, snowd, sncovr, snoalb, zorl, coszen, tsfg, tsfa, hprime, alvsf, & - alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, albdvis, albdnir, albivis, & - albinir, NCOL, alb1d, lndp_alb, sfcalb) + call setalb (lsmask, lsm, lsm_noahmp, lsm_ruc, snowd, sncovr, sncovr_ice, snoalb, zorl, & + coszen, tsfg, tsfa, hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, & + tisfc, albdvis, albdnir, albivis, albinir, NCOL, alb1d, lndp_alb, & ! mg, sfc-perts + sfcalb, alb_ice, alb_sno_ice, sfalb_lnd_bck ) ! --- outputs ! Approximate mean surface albedo from vis- and nir- diffuse values. sfc_alb_dif(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 5a165f9ad..63368dba8 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -56,6 +56,30 @@ kind = kind_phys intent = in optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F [lndp_var_list] standard_name = variables_to_be_perturbed_for_landperts long_name = variables to be perturbed for landperts @@ -136,6 +160,15 @@ kind = kind_phys intent = in optional = F +[sncovr_ice] + standard_name = surface_snow_area_fraction_over_ice + long_name = surface snow area fraction over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [snoalb] standard_name = upper_bound_on_max_albedo_over_deep_snow long_name = maximum snow albedo @@ -413,6 +446,33 @@ kind = kind_phys intent = inout optional = F +[alb_ice] + standard_name =surface_snow_free_albedo_over_ice + long_name = surface snow-free albedo over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[alb_sno_ice] + standard_name =surface_snow_albedo_over_ice + long_name = surface snow albedo over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[sfalb_lnd_bck] + standard_name =surface_snow_free_albedo_over_land + long_name = surface snow-free albedo over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index d0f1829df..435e416d3 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -4,6 +4,7 @@ module GFS_surface_composites_pre use machine, only: kind_phys + use physparam, only : iemsflg implicit none @@ -24,22 +25,24 @@ end subroutine GFS_surface_composites_pre_finalize !> \section arg_table_GFS_surface_composites_pre_run Argument Table !! \htmlinclude GFS_surface_composites_pre_run.html !! - subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx, cplwav2atm, & - landfrac, lakefrac, lakedepth, oceanfrac, frland, & + subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, lsm_ruc, frac_grid, & + flag_cice, cplflx, cplwav2atm, landfrac, lakefrac, lakedepth, oceanfrac, frland, & dry, icy, lake, ocean, wet, hice, cice, zorl, zorlo, zorll, zorli, zorl_wat, & zorl_lnd, zorl_ice, snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & tprcp_lnd, tprcp_ice, uustar, uustar_wat, uustar_lnd, uustar_ice, & weasd, weasd_wat, weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_wat, & tsfc_lnd, tsfc_ice, tisfc, tice, tsurf, tsurf_wat, tsurf_lnd, tsurf_ice, & gflx_ice, tgice, islmsk, islmsk_cice, slmsk, semis_rad, semis_wat, semis_lnd, semis_ice, & - qss, qss_wat, qss_lnd, qss_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, & + emis_lnd, emis_ice, qss, qss_wat, qss_lnd, qss_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, & min_lakeice, min_seaice, errmsg, errflg) implicit none ! Interface variables integer, intent(in ) :: im, lkm + integer, intent(in ) :: lsm, lsm_noahmp, lsm_ruc logical, intent(in ) :: frac_grid, cplflx, cplwav2atm + logical, intent(in ) :: flag_init logical, dimension(im), intent(inout) :: flag_cice logical, dimension(im), intent(inout) :: dry, icy, lake, ocean, wet real(kind=kind_phys), dimension(im), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac @@ -57,6 +60,7 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx integer, dimension(im), intent(inout) :: islmsk, islmsk_cice real(kind=kind_phys), dimension(im), intent(in ) :: semis_rad real(kind=kind_phys), dimension(im), intent(inout) :: semis_wat, semis_lnd, semis_ice, slmsk + real(kind=kind_phys), dimension(im), intent(inout) :: emis_lnd, emis_ice real(kind=kind_phys), intent(in ) :: min_lakeice, min_seaice real(kind=kind_phys), parameter :: timin = 173.0_kind_phys ! minimum temperature allowed for snow/ice @@ -195,7 +199,15 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx ! snowd_wat(i) = snowd(i) weasd_wat(i) = zero snowd_wat(i) = zero - semis_wat(i) = 0.984_kind_phys + !-- reference emiss value for surface emissivity in setemis + ! 1-open water, 2-grass/shrub land, 3-bare soil, tundra, + ! 4-sandy desert, 5-rocky desert, 6-forest, 7-ice, 8-snow + !data emsref / 0.97, 0.95, 0.94, 0.90, 0.93, 0.96, 0.96, 0.99 / + if(iemsflg == 2) then + semis_wat(i) = 0.97_kind_phys ! consistent with setemis + else + semis_wat(i) = 0.984_kind_phys + endif qss_wat(i) = qss(i) hflx_wat(i) = hflx(i) endif @@ -207,6 +219,10 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx tsurf_lnd(i) = tsfcl(i) snowd_lnd(i) = snowd(i) semis_lnd(i) = semis_rad(i) + if ( iemsflg == 2 .and. .not. flag_init ) then + !-- use land emissivity from the LSM + semis_lnd(i) = emis_lnd(i) + endif qss_lnd(i) = qss(i) hflx_lnd(i) = hflx(i) end if @@ -220,6 +236,10 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx ep1d_ice(i) = zero gflx_ice(i) = zero semis_ice(i) = 0.95_kind_phys + if ( iemsflg == 2 .and. .not. flag_init .and. lsm == lsm_ruc) then + !-- use emis_ice from RUC LSM with snow effect + semis_ice(i) = emis_ice(i) + endif qss_ice(i) = qss(i) hflx_ice(i) = hflx(i) endif diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 21b308357..65411d8e9 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -15,6 +15,14 @@ type = integer intent = in optional = F +[flag_init] + standard_name = flag_for_first_time_step + long_name = flag signaling first time step for time integration loop + units = flag + dimensions = () + type = logical + intent = in + optional = F [lkm] standard_name = flag_for_lake_surface_scheme long_name = flag for lake surface model @@ -23,6 +31,30 @@ type = integer intent = in optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F [frac_grid] standard_name = flag_for_fractional_grid long_name = flag for fractional grid @@ -561,6 +593,24 @@ kind = kind_phys intent = inout optional = F +[emis_lnd] + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[emis_ice] + standard_name = surface_longwave_emissivity_over_ice + long_name = surface lw emissivity in fraction over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [qss] standard_name = surface_specific_humidity long_name = surface air saturation specific humidity diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 1eceaf183..5683db7c0 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -64,8 +64,8 @@ SUBROUTINE LSMRUC( & graupelncv,snowncv,rainncv,raincv, & ZS,RAINBL,SNOW,SNOWH,SNOWC,FRZFRAC,frpcpn, & rhosnf,precipfr, & - Z3D,P8W,T3D,QV3D,QC3D,RHO3D, & - GLW,GSW,EMISS,CHKLOWQ, CHS, & + Z3D,P8W,T3D,QV3D,QC3D,RHO3D,EMISBCK, & + GLW,GSWdn,GSW,EMISS,CHKLOWQ, CHS, & FLQC,FLHC,MAVAIL,CANWAT,VEGFRA,ALB,ZNT, & Z0,SNOALB,ALBBCK,LAI, & landusef, nlcat, & ! mosaic_lu, mosaic_soil, & @@ -185,6 +185,7 @@ SUBROUTINE LSMRUC( & REAL, DIMENSION( ims:ime , jms:jme ), & INTENT(IN ) :: RAINBL, & GLW, & + GSWdn, & GSW, & ALBBCK, & FLHC, & @@ -220,6 +221,7 @@ SUBROUTINE LSMRUC( & ALB, & LAI, & EMISS, & + EMISBCK, & MAVAIL, & SFCEXC, & Z0 , & @@ -706,11 +708,18 @@ SUBROUTINE LSMRUC( & ENDIF !> - Call soilvegin() to initialize soil and surface properties - CALL SOILVEGIN ( debug_print, & + IF((XLAND(I,J)-1.5).LT.0..and. xice(i,j).lt.xice_threshold)THEN + !-- land + CALL SOILVEGIN ( debug_print, & soilfrac,nscat,shdmin(i,j),shdmax(i,j),mosaic_lu, mosaic_soil,& NLCAT,ILAND,ISOIL,iswater,MYJ,IFOREST,lufrac,VEGFRA(I,J), & EMISSL(I,J),PC(I,J),ZNT(I,J),LAI(I,J),RDLAI2D, & QWRTZ,RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT,i,j ) + + !-- update background emissivity for land points, can have vegetation mosaic effect + EMISBCK(I,J) = EMISSL(I,J) + ENDIF + IF (debug_print ) THEN if(init) & print *,'after SOILVEGIN - z0,znt(1,26),lai(1,26)',z0(i,j),znt(i,j),lai(i,j) @@ -839,12 +848,13 @@ SUBROUTINE LSMRUC( & ISOIL = 16 ! STATSGO endif ZNT(I,J) = 0.011 - snoalb(i,j) = 0.75 + ! in FV3 albedo and emiss are defined for ice + !snoalb(i,j) = snoalb(i,j) + emissl(i,j) = emisbck(i,j) ! no snow impact, old 0.98 used in WRF dqm = 1. ref = 1. qmin = 0. wilt = 0. - emissl(i,j) = 0.98 patmb=P8w(i,1,j)*1.e-2 qvg (i,j) = QSN(SOILT(i,j),TBQ)/PATMB @@ -900,12 +910,13 @@ SUBROUTINE LSMRUC( & CALL SFCTMP (debug_print, dt,ktau,conflx,i,j, & !--- input variables nzs,nddzs,nroot,meltfactor, & !added meltfactor - iland,isoil,ivgtyp(i,j),isltyp(i,j), & + iland,isoil,ivgtyp(i,j),isltyp(i,j), & PRCPMS, NEWSNMS,SNWE,SNHEI,SNOWFRAC, & RHOSN,RHONEWSN,RHOSNFALL, & snowrat,grauprat,icerat,curat, & PATM,TABS,QVATM,QCATM,RHO, & - GLW(I,J),GSW(I,J),EMISSL(I,J), & + GLW(I,J),GSWdn(i,j),GSW(I,J), & + EMISSL(I,J),EMISBCK(I,J), & QKMS,TKMS,PC(I,J),LMAVAIL(I,J), & canwatr,vegfra(I,J),alb(I,J),znt(I,J), & snoalb(i,j),albbck(i,j),lai(i,j), & !new @@ -1046,7 +1057,7 @@ SUBROUTINE LSMRUC( & endif ENDIF - if(snow(i,j)==0.) EMISSL(i,j) = LEMITBL(IVGTYP(i,j)) + if(snow(i,j)==0.) EMISSL(i,j) = EMISBCK(i,j) EMISS (I,J) = EMISSL(I,J) ! SNOW is in [mm], SNWE is in [m]; CANWAT is in mm, CANWATR is in m SNOW (i,j) = SNWE*1000. @@ -1172,7 +1183,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia RHOSN,RHONEWSN,RHOSNFALL, & snowrat,grauprat,icerat,curat, & PATM,TABS,QVATM,QCATM,rho, & - GLW,GSW,EMISS,QKMS,TKMS,PC, & + GLW,GSWdn,GSW,EMISS,EMISBCK,QKMS,TKMS,PC, & MAVAIL,CST,VEGFRA,ALB,ZNT, & ALB_SNOW,ALB_SNOW_FREE,lai, & MYJ,SEAICE,ISICE, & @@ -1208,6 +1219,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia REAL , & INTENT(IN ) :: GLW, & GSW, & + GSWdn, & PC, & VEGFRA, & ALB_SNOW_FREE, & @@ -1221,6 +1233,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia !--- 2-D variables REAL , & INTENT(INOUT) :: EMISS, & + EMISBCK, & MAVAIL, & SNOWFRAC, & ALB_SNOW, & @@ -1420,11 +1433,11 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia enddo GSWnew=GSW - GSWin=GSW/(1.-alb) + GSWin=GSWdn !/(1.-alb) ALBice=ALB_SNOW_FREE ALBsn=alb_snow - EMISSN = 0.98 - EMISS_snowfree = LEMITBL(IVGTYP) + EMISSN = 0.99 ! from setemis, from WRF - 0.98 + EMISS_snowfree = EMISBCK ! LEMITBL(IVGTYP) !--- sea ice properties !--- N.N Zubov "Arctic Ice" @@ -1725,8 +1738,9 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia ALBsn = MAX(keep_snow_albedo*alb_snow, & MIN((albice + (alb_snow - albice) * snowfrac), alb_snow)) Emiss = MAX(keep_snow_albedo*emissn, & + !-- emiss_snowfree=0.96 in setemis MIN((emiss_snowfree + & - (emissn - emiss_snowfree) * snowfrac), emissn)) + (emissn - emiss_snowfree) * snowfrac), emissn)) endif IF (debug_print ) THEN @@ -2576,7 +2590,7 @@ SUBROUTINE SOIL (debug_print, & ! endif alfa=1. ! field capacity -! 20jun18 - beta in Eq. (4) is called soilres here - it limits soil evaporation +! 20jun18 - beta in Eq. (5) is called soilres in the code - it limits soil evaporation ! when soil moisture is below field capacity. [Lee and Pielke, 1992] ! This formulation agrees with obsevations when top layer is < 2 cm thick. ! Soilres = 1 for snow, glaciers and wetland. @@ -2586,7 +2600,9 @@ SUBROUTINE SOIL (debug_print, & ! evaporation, effects sparsely vegetated areas--> cooler during the day ! fc=max(qmin,ref*0.25) ! ! For now we'll go back to ref*0.5 -! Replace 0.5 with 0.7 2021/03/15 +! 3feb21 - in RRFS testing (fv3-based), ref*0.5 gives too much direct +! evaporation. Therefore , it is replaced with ref*0.7. + !fc=max(qmin,ref*0.5) fc=max(qmin,ref*0.7) fex_fc=1. if((soilmois(1)+qmin) > fc .or. (qvatm-qvg) > 0.) then diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 11b9741c5..e70ab22b9 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -329,11 +329,12 @@ end subroutine sfc_init !! @{ !----------------------------------- subroutine setalb & - & ( slmsk,snowf,sncovr,snoalb,zorlf,coszf,tsknf,tairf,hprif, & ! --- inputs: + & ( slmsk,lsm,lsm_noahmp,lsm_ruc,snowf,sncovr,sncovr_ice, & + & snoalb,zorlf,coszf,tsknf,tairf,hprif, & ! --- inputs: & alvsf,alnsf,alvwf,alnwf,facsf,facwf,fice,tisfc, & & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir,IMAX, & & albPpert, pertalb, & ! sfc-perts, mgehne - & sfcalb & ! --- outputs: + & sfcalb, alb_ice, alb_sno_ice, sfalb_lnd_bck & ! --- outputs: & ) ! =================================================================== ! @@ -355,6 +356,8 @@ subroutine setalb & ! snowf (IMAX) - snow depth water equivalent in mm ! ! sncovr(IMAX) - ialgflg=0: not used ! ! ialgflg=1: snow cover over land in fraction ! +! sncovr_ice(IMAX) - ialgflg=0: not used ! +! ialgflg=1: snow cover over ice in fraction ! ! snoalb(IMAX) - ialbflg=0: not used ! ! ialgflg=1: max snow albedo over land in fraction ! ! zorlf (IMAX) - surface roughness in cm ! @@ -397,15 +400,19 @@ subroutine setalb & ! --- inputs integer, intent(in) :: IMAX + integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc real (kind=kind_phys), dimension(:), intent(in) :: & & slmsk, snowf, zorlf, coszf, tsknf, tairf, hprif, & & alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, & - & sncovr, snoalb, albPpert ! sfc-perts, mgehne + & sncovr, sncovr_ice, snoalb, albPpert ! sfc-perts, mgehne real (kind=kind_phys), intent(in) :: pertalb ! sfc-perts, mgehne ! --- outputs + real (kind=kind_phys), dimension(:), intent(inout) :: alb_ice, & + & alb_sno_ice, & + & sfalb_lnd_bck real (kind=kind_phys), dimension(IMAX,NF_ALBD), intent(out) :: & & sfcalb ! real (kind=kind_phys), dimension(:,:), intent(out) :: sfcalb @@ -457,6 +464,11 @@ subroutine setalb & asevd = 0.7 - 4.0*a1 asend = 0.65 - 3.6875*a1 endif + if(lsm == lsm_ruc) then + !-- output alb_ice for use in LSMs (diffused albedo adjusted + ! for T around freezing) + alb_ice(i) = max(0.6, 0.5 * (asend + asevd)) + endif !> - Calculate diffused snow albedo. @@ -489,6 +501,11 @@ subroutine setalb & asnvb = asnvd asnnb = asnnd endif + if(lsm == lsm_ruc) then + !-- alb_sno_ice (diffused and direct) for use in LSMs + alb_sno_ice(i) = min(0.98, 0.5 * (0.65 + b1 + & + 0.5 * (asnvb+asnnb))) + endif !> - Calculate direct sea surface albedo. @@ -522,34 +539,44 @@ subroutine setalb & sfcalb(i,2) = (a2 + b2) * 0.96 *flnd + asend*fsea + asnnd*fsno sfcalb(i,3) = min(0.99, ab1bm) *flnd + asevb*fsea + asnvb*fsno sfcalb(i,4) = (a1 + b1) * 0.96 *flnd + asevd*fsea + asnvd*fsno + if(lsm == lsm_ruc) then + !-- alb_lnd (diffused and direct) for snow-free areas for use + !in LSMs + sfalb_lnd_bck(i) = 0.25*(ab1bm + alnwf(i) + ab2bm + alvwf(i)) + endif enddo ! end_do_i_loop !> - If use modis based albedo for land area: - elseif ( ialbflg == 1 ) then + elseif ( ialbflg == 1 ) then ! tgs: use this option for RUC LSM do i = 1, IMAX !> - Calculate snow cover input directly for land model, no !! conversion needed. - fsno0 = sncovr(i) + fsno0 = sncovr(i) ! snow fraction on land if (nint(slmsk(i))==0 .and. tsknf(i)>con_tice) fsno0 = f_zero if (nint(slmsk(i)) == 2) then - asnow = 0.02*snowf(i) - argh = min(0.50, max(.025, 0.01*zorlf(i))) - hrgh = min(f_one, max(0.20, 1.0577-1.1538e-3*hprif(i) ) ) - fsno0 = asnow / (argh + asnow) * hrgh + if(lsm == lsm_ruc) then + !-- use RUC LSM's snow-cover fraction for ice + fsno0 = sncovr_ice(i) ! snow fraction on ice + else + asnow = 0.02*snowf(i) + argh = min(0.50, max(.025, 0.01*zorlf(i))) + hrgh = min(f_one, max(0.20, 1.0577-1.1538e-3*hprif(i) ) ) + fsno0 = asnow / (argh + asnow) * hrgh + endif endif - fsno1 = f_one - fsno0 - flnd0 = min(f_one, facsf(i)+facwf(i)) - fsea0 = max(f_zero, f_one-flnd0) - fsno = fsno0 - fsea = fsea0 * fsno1 - flnd = flnd0 * fsno1 + fsno1 = f_one - fsno0 ! snow-free fraction (land or ice), 1-sea + flnd0 = min(f_one, facsf(i)+facwf(i)) ! 1-land, 0-sea/ice + fsea0 = max(f_zero, f_one-flnd0)! ! 1-sea/ice, 0-land + fsno = fsno0 ! snow cover, >0 - land/ice + fsea = fsea0 * fsno1 ! 1-sea/ice, 0-land + flnd = flnd0 * fsno1 ! <=1-land,0-sea/ice !> - Calculate diffused sea surface albedo. @@ -564,6 +591,11 @@ subroutine setalb & asevd = 0.7 - 4.0*a1 asend = 0.65 - 3.6875*a1 endif + if(lsm == lsm_ruc) then + !-- output alb_ice for use in RUC LSM (diffused albedo adjusted + ! for T around freezing) + alb_ice(i) = max(0.6, 0.5 * (asend + asevd)) + endif !> - Calculate diffused snow albedo, land area use input max snow !! albedo. @@ -598,6 +630,11 @@ subroutine setalb & asnvb = asnvd asnnb = asnnd endif + if(lsm == lsm_ruc) then + !-- alb_sno_ice (diffused and direct) for use in LSMs + alb_sno_ice(i) = min(0.98, 0.5 * (0.65 + b1 + & + 0.5 * (asnvb+asnnb))) + endif else asnvb = snoalb(i) asnnb = snoalb(i) @@ -613,30 +650,39 @@ subroutine setalb & rfcs = 1.775/(1.0+1.55*coszf(i)) if (tsknf(i) >= con_t0c) then + !- sea asevb = max(asevd, 0.026/(coszf(i)**1.7+0.065) & & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & & * (coszf(i)-f_one)) asenb = asevb else + !- ice asevb = asevd asenb = asend endif else + !- no sun rfcs = f_one asevb = asevd asenb = asend endif + !- zenith dependence is applied only to direct beam albedo ab1bm = min(0.99, alnsf(i)*rfcs) ab2bm = min(0.99, alvsf(i)*rfcs) sfcalb(i,1) = ab1bm *flnd + asenb*fsea + asnnb*fsno - sfcalb(i,2) = alnwf(i) *flnd + asend*fsea + asnnd*fsno + sfcalb(i,2) = alnwf(i)*flnd + asend*fsea + asnnd*fsno sfcalb(i,3) = ab2bm *flnd + asevb*fsea + asnvb*fsno - sfcalb(i,4) = alvwf(i) *flnd + asevd*fsea + asnvd*fsno + sfcalb(i,4) = alvwf(i)*flnd + asevd*fsea + asnvd*fsno + + if(lsm == lsm_ruc) then + !-- alb_lnd (diffused and direct) for snow-free areas for use in LSMs + sfalb_lnd_bck(i) = 0.25*(ab1bm + alnwf(i) + ab2bm + alvwf(i)) + endif enddo ! end_do_i_loop -!> -# use land model output for land area: +!> -# use land model output for land area: Noah MP elseif ( ialbflg == 2 ) then do i = 1, IMAX @@ -647,10 +693,10 @@ subroutine setalb & if (nint(slmsk(i))==0 .and. tsknf(i)>con_tice) fsno0 = f_zero if (nint(slmsk(i)) == 2) then - asnow = 0.02*snowf(i) - argh = min(0.50, max(.025, 0.01*zorlf(i))) - hrgh = min(f_one, max(0.20, 1.0577-1.1538e-3*hprif(i) ) ) - fsno0 = asnow / (argh + asnow) * hrgh + asnow = 0.02*snowf(i) + argh = min(0.50, max(.025, 0.01*zorlf(i))) + hrgh = min(f_one, max(0.20, 1.0577-1.1538e-3*hprif(i) ) ) + fsno0 = asnow / (argh + asnow) * hrgh endif fsno1 = f_one - fsno0 @@ -765,6 +811,17 @@ subroutine setalb & call ppfbet(albPpert(i),alpha,beta,iflag,albtmp) sfcalb(i,kk) = albtmp enddo + if(lsm == lsm_ruc) then + ! perturb mean surface albedo + m = sfalb_lnd_bck(i) + s = pertalb*m*(1.-m) + alpha = m*m*(1.-m)/(s*s)-m + beta = alpha*(1.-m)/m + ! compute beta distribution value corresponding + ! to the given percentile albPpert to use as new albedo + call ppfbet(albPpert(i),alpha,beta,iflag,albtmp) + sfalb_lnd_bck(i) = albtmp + endif enddo ! end_do_i_loop endif @@ -796,9 +853,11 @@ end subroutine setalb !! @{ !----------------------------------- subroutine setemis & - & ( xlon,xlat,slmsk,snowf,sncovr,zorlf,tsknf,tairf,hprif, & ! --- inputs: - & lsmemiss,IMAX, & - & sfcemis & ! --- outputs: + & ( kdt,lsm,lsm_noahmp,lsm_ruc,vtype, & ! --- inputs: + & xlon,xlat,slmsk,snowf,sncovr,sncovr_ice, & + & zorlf,tsknf,tairf,hprif, & + & semis_lnd,semis_ice,IMAX, & + & semisbase, sfcemis & ! --- outputs: & ) ! =================================================================== ! @@ -819,11 +878,12 @@ subroutine setemis & ! slmsk (IMAX) - sea(0),land(1),ice(2) mask on fcst model grid ! ! snowf (IMAX) - snow depth water equivalent in mm ! ! sncovr(IMAX) - ialbflg=1: snow cover over land in fraction ! +! sncovr_ice(IMAX) - snow cover over ice in fraction ! ! zorlf (IMAX) - surface roughness in cm ! ! tsknf (IMAX) - ground surface temperature in k ! ! tairf (IMAX) - lowest model layer air temperature in k ! ! hprif (IMAX) - topographic sdv in m ! -! lsmemiss(IMAX)- emissivity from lsm ! +! semis_lnd (IMAX) - emissivity from lsm ! ! IMAX - array horizontal dimension ! ! ! ! outputs: ! @@ -841,20 +901,27 @@ subroutine setemis & ! ! ! ==================== end of description ===================== ! ! + use set_soilveg_ruc_mod, only: set_soilveg_ruc + use namelist_soilveg_ruc + implicit none ! --- inputs integer, intent(in) :: IMAX + integer, intent(in) :: kdt, lsm, lsm_noahmp, lsm_ruc + real (kind=kind_phys), dimension(:), intent(in) :: vtype real (kind=kind_phys), dimension(:), intent(in) :: & - & xlon,xlat, slmsk, snowf,sncovr, zorlf, tsknf, tairf, hprif,& - & lsmemiss + & xlon,xlat, slmsk, snowf,sncovr, sncovr_ice, & + & zorlf, tsknf, tairf, hprif, semis_lnd, semis_ice ! --- outputs + real (kind=kind_phys), dimension(:), intent(out) :: semisbase real (kind=kind_phys), dimension(:), intent(out) :: sfcemis ! --- locals: integer :: i, i1, i2, j1, j2, idx + integer :: ivgtyp real (kind=kind_phys) :: dltg, hdlt, tmp1, tmp2, & & asnow, argh, hrgh, fsno, fsno0, fsno1 @@ -929,12 +996,13 @@ subroutine setemis & idx = max( 2, idxems(i2,j2) ) if ( idx >= 7 ) idx = 2 sfcemis(i) = emsref(idx) + semisbase(i) = sfcemis(i) endif ! end if_slmsk_block !> -# Check for snow covered area. - if ( ialbflg==1 .and. nint(slmsk(i))==1 ) then ! input land area snow cover + if ( iemslw==1 .and. nint(slmsk(i))==1 ) then ! input land area snow cover fsno0 = sncovr(i) fsno1 = f_one - fsno0 @@ -956,7 +1024,7 @@ subroutine setemis & enddo lab_do_IMAX - elseif ( iemslw == 2 ) then ! sfc emiss updated in land model + elseif ( iemslw == 2 ) then ! sfc emiss updated in land model: Noah MP or RUC do i = 1, IMAX @@ -966,11 +1034,49 @@ subroutine setemis & else if ( nint(slmsk(i)) == 2 ) then ! sea-ice - sfcemis(i) = emsref(7) + if (lsm == lsm_ruc) then + !-- RUC lsm has sea-ice component + if (kdt == 1 ) then + semisbase(i) = emsref(7) + sfcemis(i) = semisbase(i)*(1.-sncovr_ice(i)) + & + emsref(8)*sncovr_ice(i) + else + sfcemis(i) = semis_ice(i) ! with snow effect + endif + else + !-- should come from the ice model, for now defined from + !-- the surface type + if ( snowf(i) > f_zero ) then + !-- snow on ice + asnow = 0.02*snowf(i) + argh = min(0.50, max(.025, 0.01*zorlf(i))) + hrgh = min(f_one, max(0.20, 1.0577-1.1538e-3*hprif(i))) + fsno0 = asnow / (argh + asnow) * hrgh + if (nint(slmsk(i)) == 0 .and. tsknf(i) > 271.2) & + & fsno0=f_zero + fsno1 = f_one - fsno0 + sfcemis(i) = emsref(7)*fsno1 + emsref(8)*fsno0 + else + !-- no snow on ice + sfcemis(i) = emsref(7) + endif + endif else ! land - sfcemis(i) = lsmemiss(i) + if (lsm == lsm_noahmp .or. lsm == lsm_ruc) then + !-- Noah MP or RUC LSM + if (kdt == 1 ) then + ivgtyp = int( vtype(i)+0.5 ) + semisbase(i) = lemitbl(ivgtyp) + sfcemis(i) = semisbase(i)*(1.-sncovr(i)) + & + emsref(8)*sncovr(i) + else + sfcemis(i) = semis_lnd(i)! with snow effect + endif + else + write(0,'(*(a))')'This LSM is not supported with iemslw=2' + endif endif ! end if_slmsk_block enddo diff --git a/physics/radlw_main.F90 b/physics/radlw_main.F90 index 7655e76d2..de8d9e973 100644 --- a/physics/radlw_main.F90 +++ b/physics/radlw_main.F90 @@ -1250,7 +1250,7 @@ subroutine rrtmg_lw_run & endif !mz* HWRF: calculate taucmc with mcica - if (iovr == 4) then + if (iovr == 4) then call cldprmc(nlay, inflglw, iceflglw, liqflglw, & & cldfmc, ciwpmc, & & clwpmc, cswpmc, reicmc, relqmc, resnmc, & @@ -8854,25 +8854,25 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & abscosno(ig) = 0.0_rb elseif (iceflag .eq. 0) then -! if (radice .lt. 10.0_rb) stop 'ICE RADIUS TOO SMALL' - abscoice(ig) = absice0(1) + absice0(2)/max(radice,10.0_rb) + if (radice .lt. 10.0_rb) stop 'ICE RADIUS TOO SMALL' + abscoice(ig) = absice0(1) + absice0(2)/radice abscosno(ig) = 0.0_rb elseif (iceflag .eq. 1) then -! if (radice .lt. 13.0_rb .or. radice .gt. 130._rb) stop& -! & 'ICE RADIUS OUT OF BOUNDS' + if (radice .lt. 13.0_rb .or. radice .gt. 130._rb) stop& + & 'ICE RADIUS OUT OF BOUNDS' ncbands = 5 ib = icb(ngb(ig)) - abscoice(ig) = absice1(1,ib) + absice1(2,ib)/min(max(radice,13.0_rb),130._rb) + abscoice(ig) = absice1(1,ib) + absice1(2,ib)/radice abscosno(ig) = 0.0_rb ! For iceflag=2 option, ice particle effective radius is limited to 5.0 to 131.0 microns elseif (iceflag .eq. 2) then -! if (radice .lt. 5.0_rb .or. radice .gt. 131.0_rb) stop& -! & 'ICE RADIUS OUT OF BOUNDS' + if (radice .lt. 5.0_rb .or. radice .gt. 131.0_rb) stop& + & 'ICE RADIUS OUT OF BOUNDS' ncbands = 16 - factor = (min(max(radice,5.0_rb),131._rb) - 2._rb)/3._rb + factor = (radice - 2._rb)/3._rb index = int(factor) if (index .eq. 43) index = 42 fint = factor - float(index) @@ -8885,15 +8885,15 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & ! For iceflag=3 option, ice particle generalized effective size is limited to 5.0 to 140.0 microns elseif (iceflag .ge. 3) then -! if (radice .lt. 5.0_rb .or. radice .gt. 140.0_rb) then -! write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & -! & 'ERROR: ICE GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS' & -! & ,ig, lay, ciwpmc(ig,lay), radice -! errflg = 1 -! return -! end if + if (radice .lt. 5.0_rb .or. radice .gt. 140.0_rb) then + write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & + & 'ERROR: ICE GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS' & + & ,ig, lay, ciwpmc(ig,lay), radice + errflg = 1 + return + end if ncbands = 16 - factor = (min(max(radice,5.0_rb),140._rb) - 2._rb)/3._rb + factor = (radice - 2._rb)/3._rb index = int(factor) if (index .eq. 46) index = 45 fint = factor - float(index) @@ -8908,15 +8908,15 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & !..Incorporate additional effects due to snow. if (cswpmc(ig,lay).gt.0.0_rb .and. iceflag .eq. 5) then radsno = resnmc(lay) -! if (radsno .lt. 5.0_rb .or. radsno .gt. 140.0_rb) then -! write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & -! & 'ERROR: SNOW GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS' & -! & ,ig, lay, cswpmc(ig,lay), radsno -! errflg = 1 -! return -! end if + if (radsno .lt. 5.0_rb .or. radsno .gt. 140.0_rb) then + write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & + & 'ERROR: SNOW GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS' & + & ,ig, lay, cswpmc(ig,lay), radsno + errflg = 1 + return + end if ncbands = 16 - factor = (min(max(radsno,5.0_rb),140.0_rb) - 2._rb)/3._rb + factor = (radsno - 2._rb)/3._rb index = int(factor) if (index .eq. 46) index = 45 fint = factor - float(index) @@ -8937,14 +8937,14 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & elseif (liqflag .eq. 1) then radliq = relqmc(lay) -! if (radliq .lt. 2.5_rb .or. radliq .gt. 60._rb) then -! write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & -!& 'ERROR: LIQUID EFFECTIVE SIZE OUT OF BOUNDS' & -!& ,ig, lay, clwpmc(ig,lay), radliq -! errflg = 1 -! return -! end if - index = int(min(max(radliq,2.5_rb),60._rb) - 1.5_rb) + if (radliq .lt. 2.5_rb .or. radliq .gt. 60._rb) then + write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & +& 'ERROR: LIQUID EFFECTIVE SIZE OUT OF BOUNDS' & +& ,ig, lay, clwpmc(ig,lay), radliq + errflg = 1 + return + end if + index = int(radliq - 1.5_rb) if (index .eq. 0) index = 1 if (index .eq. 58) index = 57 fint = radliq - 1.5_rb - float(index) diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index 276a0a5bd..accd4aa73 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -12,8 +12,9 @@ end subroutine rrtmg_lw_pre_init !> \section arg_table_rrtmg_lw_pre_run Argument Table !! \htmlinclude rrtmg_lw_pre_run.html !! - subroutine rrtmg_lw_pre_run (im, lslwr, xlat, xlon, slmsk, snowd, sncovr,& - zorl, hprime, tsfg, tsfa, semis, emiss, errmsg, errflg) + subroutine rrtmg_lw_pre_run (im, lslwr, kdt, lsm, lsm_noahmp, lsm_ruc, vtype, & + xlat, xlon, slmsk, snowd, sncovr, sncovr_ice, zorl, hprime, tsfg, tsfa, & + semis_lnd, semis_ice, semisbase, semis, errmsg, errflg) use machine, only: kind_phys use module_radiation_surface, only: setemis @@ -22,9 +23,13 @@ subroutine rrtmg_lw_pre_run (im, lslwr, xlat, xlon, slmsk, snowd, sncovr,& integer, intent(in) :: im logical, intent(in) :: lslwr - real(kind=kind_phys), dimension(im), intent(in) :: xlat, xlon, slmsk, & - snowd, sncovr, zorl, hprime, tsfg, tsfa - real(kind=kind_phys), dimension(:), intent(in) :: emiss + integer, intent(in) :: kdt, lsm, lsm_noahmp, lsm_ruc + + real(kind=kind_phys), dimension(im), intent(in) :: xlat, xlon, vtype, slmsk,& + snowd, sncovr, sncovr_ice, zorl, hprime, tsfg, tsfa + real(kind=kind_phys), dimension(:), intent(in) :: semis_lnd + real(kind=kind_phys), dimension(:), intent(in) :: semis_ice + real(kind=kind_phys), dimension(im), intent(out) :: semisbase real(kind=kind_phys), dimension(im), intent(out) :: semis character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -36,9 +41,11 @@ subroutine rrtmg_lw_pre_run (im, lslwr, xlat, xlon, slmsk, snowd, sncovr,& if (lslwr) then !> - Call module_radiation_surface::setemis(),to setup surface !! emissivity for LW radiation. - call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfg, tsfa, & - hprime, emiss, im, & ! --- inputs - semis) ! --- outputs + call setemis (kdt, lsm, lsm_noahmp, lsm_ruc, vtype, xlon, xlat, slmsk, & + snowd, sncovr, sncovr_ice, zorl, tsfg, tsfa, & + hprime, semis_lnd, semis_ice, im, & ! --- inputs + semisbase, semis) ! --- outputs + endif end subroutine rrtmg_lw_pre_run diff --git a/physics/rrtmg_lw_pre.meta b/physics/rrtmg_lw_pre.meta index d62d9881c..e2752d42e 100644 --- a/physics/rrtmg_lw_pre.meta +++ b/physics/rrtmg_lw_pre.meta @@ -23,6 +23,47 @@ type = logical intent = in optional = F +[kdt] + standard_name = index_of_time_step + long_name = current number of time steps + units = index + dimensions = () + type = integer + intent = in + optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[vtype] + standard_name = vegetation_type_classification_real + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [xlat] standard_name = latitude long_name = latitude @@ -68,6 +109,15 @@ kind = kind_phys intent = in optional = F +[sncovr_ice] + standard_name = surface_snow_area_fraction_over_ice + long_name = surface snow area fraction over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [zorl] standard_name = surface_roughness_length long_name = surface roughness length @@ -104,24 +154,42 @@ kind = kind_phys intent = in optional = F -[semis] - standard_name = surface_longwave_emissivity - long_name = surface lw emissivity in fraction +[semis_lnd] + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = in optional = F -[emiss] - standard_name = surface_emissivity_lsm - long_name = surface emissivity from lsm +[semis_ice] + standard_name = surface_longwave_emissivity_over_ice + long_name = surface lw emissivity in fraction over ice units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F +[semisbase] + standard_name = baseline_surface_longwave_emissivity + long_name = baseline surface lw emissivity in fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[semis] + standard_name = surface_longwave_emissivity + long_name = surface lw emissivity in fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index b281d42a7..634f59d70 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -13,9 +13,10 @@ end subroutine rrtmg_sw_pre_init !! \htmlinclude rrtmg_sw_pre_run.html !! subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, lndp_prt_list, tsfg, tsfa, coszen, & - alb1d, slmsk, snowd, sncovr, snoalb, zorl, hprime, alvsf, alnsf, alvwf, & - alnwf, facsf, facwf, fice, tisfc, albdvis, albdnir, albivis, albinir, & - sfalb, nday, idxday, sfcalb1, sfcalb2, sfcalb3, sfcalb4, errmsg, errflg) + lsm, lsm_noahmp, lsm_ruc, alb1d, slmsk, snowd, sncovr, sncovr_ice, snoalb, zorl, & + hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & + albdvis, albdnir, albivis, albinir, sfalb, alb_ice, alb_sno_ice, sfalb_lnd_bck, & + nday, idxday, sfcalb1, sfcalb2, sfcalb3, sfcalb4, errmsg, errflg) use machine, only: kind_phys @@ -24,6 +25,7 @@ subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, ln implicit none integer, intent(in) :: im, lndp_type, n_var_lndp + integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc character(len=3) , dimension(:), intent(in) :: lndp_var_list logical, intent(in) :: lsswr real(kind=kind_phys), dimension(:), intent(in) :: lndp_prt_list @@ -35,10 +37,14 @@ subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, ln alvsf, alnsf, & alvwf, alnwf, & facsf, facwf, & + sncovr_ice, & fice, tisfc real(kind=kind_phys), dimension(:), intent(in) :: albdvis, albdnir, & albivis, albinir real(kind=kind_phys), dimension(im), intent(inout) :: sfalb + real(kind=kind_phys), dimension(im), intent(inout) :: alb_ice, & + alb_sno_ice, & + sfalb_lnd_bck integer, intent(out) :: nday integer, dimension(im), intent(out) :: idxday real(kind=kind_phys), dimension(im), intent(out) :: sfcalb1, sfcalb2, & @@ -83,10 +89,11 @@ subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, ln !> - Call module_radiation_surface::setalb() to setup surface albedo. !! for SW radiation. - call setalb (slmsk, snowd, sncovr, snoalb, zorl, coszen, tsfg, tsfa, & ! --- inputs - hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, & - tisfc, albdvis, albdnir, albivis, albinir,IM, alb1d, & ! mg, sfc-perts - lndp_alb, sfcalb) ! --- outputs + call setalb (slmsk, lsm, lsm_noahmp, lsm_ruc, snowd, sncovr, sncovr_ice, snoalb, & + zorl, coszen, tsfg, tsfa, hprime, alvsf, alnsf, alvwf, alnwf, & + facsf, facwf, fice, tisfc, albdvis, albdnir, albivis, albinir, & + IM, alb1d, lndp_alb, & ! mg, sfc-perts + sfcalb, alb_ice, alb_sno_ice, sfalb_lnd_bck ) ! --- outputs !> -# Approximate mean surface albedo from vis- and nir- diffuse values. diff --git a/physics/rrtmg_sw_pre.meta b/physics/rrtmg_sw_pre.meta index 49d83ff89..244490ef1 100644 --- a/physics/rrtmg_sw_pre.meta +++ b/physics/rrtmg_sw_pre.meta @@ -84,6 +84,30 @@ kind = kind_phys intent = in optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F [alb1d] standard_name = surface_albedo_perturbation long_name = surface albedo perturbation @@ -120,6 +144,15 @@ kind = kind_phys intent = in optional = F +[sncovr_ice] + standard_name = surface_snow_area_fraction_over_ice + long_name = surface snow area fraction over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [snoalb] standard_name = upper_bound_on_max_albedo_over_deep_snow long_name = maximum snow albedo @@ -264,6 +297,33 @@ kind = kind_phys intent = inout optional = F +[alb_ice] + standard_name =surface_snow_free_albedo_over_ice + long_name = surface snow-free albedo over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[alb_sno_ice] + standard_name =surface_snow_albedo_over_ice + long_name = surface snow albedo over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[sfalb_lnd_bck] + standard_name =surface_snow_free_albedo_over_land + long_name = surface snow-free albedo over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [nday] standard_name = daytime_points_dimension long_name = daytime points dimension diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index f4ee288f7..4a7fe0f1c 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -25,26 +25,34 @@ end subroutine rrtmgp_lw_pre_init !> \section arg_table_rrtmgp_lw_pre_run !! \htmlinclude rrtmgp_lw_pre_run.html !! - subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, & - tsfg, tsfa, hprime, sfc_emiss_byband, emiss, semis, errmsg, errflg) + subroutine rrtmgp_lw_pre_run ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, doLWrad, & + nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, sncovr_ice, & + tsfg, tsfa, hprime, sfc_emiss_byband, semis_land, semis_ice, & + semisbase, semis, errmsg, errflg) ! Inputs logical, intent(in) :: & doLWrad ! Logical flag for longwave radiation call integer, intent(in) :: & nCol ! Number of horizontal grid points + integer, intent(in) :: kdt, lsm, lsm_noahmp, lsm_ruc + real(kind_phys), dimension(nCol), intent(in) :: & + vtype, & ! vegetation type xlon, & ! Longitude xlat, & ! Latitude slmsk, & ! Land/sea/sea-ice mask zorl, & ! Surface roughness length (cm) snowd, & ! water equivalent snow depth (mm) sncovr, & ! Surface snow are fraction (1) + sncovr_ice, & ! Surface snow fraction over ice (1) tsfg, & ! Surface ground temperature for radiation (K) tsfa, & ! Lowest model layer air temperature for radiation (K) hprime ! Standard deviation of subgrid orography - real(kind_phys), dimension(:), intent(in) :: & - emiss ! Surface emissivity from Noah MP + + real(kind_phys), dimension(nCol), intent(in) :: & + semis_land, & ! Surface emissivity over land + semis_ice ! Surface emissivity over ice ! Outputs real(kind_phys), dimension(lw_gas_props%get_nband(),ncol), intent(out) :: & @@ -54,7 +62,7 @@ subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, snc integer, intent(out) :: & errflg ! Error flag real(kind_phys), dimension(nCol), intent(out) :: & - semis + semisbase, semis ! Local variables integer :: iBand @@ -68,7 +76,11 @@ subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, snc ! ####################################################################################### ! Call module_radiation_surface::setemis(),to setup surface emissivity for LW radiation. ! ####################################################################################### - call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfg, tsfa, hprime, emiss, nCol, semis) + call setemis ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, xlon, xlat, slmsk, & + snowd, sncovr, sncovr_ice, zorl, tsfg, tsfa, hprime, & + semis_land, semis_ice, nCol, & ! --- inputs + semisbase, semis) ! --- outputs + ! Assign same emissivity to all bands do iBand=1,lw_gas_props%get_nband() diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index 5446580df..6bda951af 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -23,6 +23,47 @@ type = integer intent = in optional = F +[kdt] + standard_name = index_of_time_step + long_name = current number of time steps + units = index + dimensions = () + type = integer + intent = in + optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[vtype] + standard_name = vegetation_type_classification_real + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [xlon] standard_name = longitude long_name = longitude @@ -77,6 +118,15 @@ kind = kind_phys intent = in optional = F +[sncovr_ice] + standard_name = surface_snow_area_fraction_over_ice + long_name = surface snow area fraction over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [tsfg] standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation @@ -104,15 +154,33 @@ kind = kind_phys intent = in optional = F -[emiss] - standard_name = surface_emissivity_lsm - long_name = surface emissivity from lsm +[semis_land] + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F +[semis_ice] + standard_name = surface_longwave_emissivity_over_ice + long_name = surface lw emissivity in fraction over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[semisbase] + standard_name = baseline_surface_longwave_emissivity + long_name = baseline surface lw emissivity in fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [semis] standard_name = surface_longwave_emissivity long_name = surface lw emissivity in fraction diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 23d99d6ef..eaec9d542 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -268,17 +268,19 @@ subroutine lsm_ruc_run & ! inputs & do_mynnsfclay, lsoil_ruc, lsoil, rdlai, zs, & & t1, q1, qc, soiltyp, vegtype, sigmaf, laixy, & & dlwflx, dswsfc, snet, tg3, & - & land, icy, lake, & + & land, icy, lake, alb_ice_snowfree, alb_ice_snow, & & rainnc, rainc, ice, snow, graupel, & - & prsl1, zf, wind, shdmin, shdmax, alvwf, alnwf, & - & srflag, snoalb, isot, ivegsrc, fice, smcwlt2, smcref2, & + & prsl1, zf, wind, shdmin, shdmax, & + & srflag, sfalb_lnd_bck, snoalb, & + & albdvis, albdnir, albivis, albinir, & !out + & isot, ivegsrc, fice, smcwlt2, smcref2, & ! --- constants & con_cp, con_rd, con_rv, con_g, con_pi, con_hvap, & & con_fvirt, & ! for water & ch_wat, tskin_wat, & ! --- in/outs for ice and land - & semis_lnd, semis_ice, & + & semisbase, semis_lnd, semis_ice, sfalb_lnd, sfalb_ice, & & sncovr1_lnd, weasd_lnd, snwdph_lnd, tskin_lnd, & & sncovr1_ice, weasd_ice, snwdph_ice, tskin_ice, & ! for land @@ -320,7 +322,7 @@ subroutine lsm_ruc_run & ! inputs real (kind=kind_phys), dimension(im), intent(in) :: & & t1, sigmaf, laixy, dlwflx, dswsfc, snet, tg3, & & prsl1, wind, shdmin, shdmax, & - & snoalb, alvwf, alnwf, zf, qc, q1, & + & sfalb_lnd_bck, snoalb, zf, qc, q1, & ! for land & cm_lnd, ch_lnd, & ! for water @@ -356,6 +358,8 @@ subroutine lsm_ruc_run & ! inputs & sfcqc_ice, sfcqv_ice, fice, tice ! --- in + real (kind=kind_phys), dimension(im), intent(in) :: & + alb_ice_snowfree, alb_ice_snow real (kind=kind_phys), dimension(im), intent(in) :: & & rainnc, rainc, ice, snow, graupel ! --- in/out: @@ -366,7 +370,8 @@ subroutine lsm_ruc_run & ! inputs ! --- output: real (kind=kind_phys), dimension(im), intent(inout) :: & & rhosnf, runof, drain, runoff, srunoff, evbs, evcw, & - & stm, wetness, semis_lnd, semis_ice, & + & stm, wetness, semisbase, semis_lnd, semis_ice, & + & sfalb_lnd, sfalb_ice, & ! for land & sncovr1_lnd, qsurf_lnd, gflux_lnd, evap_lnd, & & cmm_lnd, chh_lnd, hflx_lnd, sbsno, & @@ -374,6 +379,8 @@ subroutine lsm_ruc_run & ! inputs ! for ice & sncovr1_ice, qsurf_ice, gflux_ice, evap_ice, ep1d_ice, & & cmm_ice, chh_ice, hflx_ice, snowfallac_ice + real (kind=kind_phys), dimension(im), intent(in ) :: & + & albdvis, albdnir, albivis, albinir, & logical, intent(in) :: flag_init, flag_restart character(len=*), intent(out) :: errmsg @@ -413,7 +420,7 @@ subroutine lsm_ruc_run & ! inputs & ffrozp, lwdn, prcp, xland, xland_wat, xice, xice_lnd, & & graupelncv, snowncv, rainncv, raincv, & & solnet_lnd, sfcexc, & - & runoff1, runoff2, acrunoff, & + & runoff1, runoff2, acrunoff, semis_bck, & & sfcems_lnd, hfx_lnd, shdfac, shdmin1d, shdmax1d, & & sneqv_lnd, snoalb1d_lnd, snowh_lnd, snoh_lnd, tsnav_lnd, & & snomlt_lnd, sncovr_lnd, soilw, soilm, ssoil_lnd, & @@ -761,9 +768,9 @@ subroutine lsm_ruc_run & ! inputs !> - 3. canopy/soil characteristics (s): !!\n \a vegtyp - vegetation type (integer index) -> vtype !!\n \a soiltyp - soil type (integer index) -> stype -!!\n \a sfcems - surface emmisivity -> sfcemis -!!\n \a 0.5*(alvwf + alnwf) - backround snow-free surface albedo (fraction) -> albbck -!!\n \a snoalb - upper bound on maximum albedo over deep snow -> snoalb1d +!!\n \a sfcems - surface emmisivity -> sfcemis +!!\n \a sfalb_lnd_bck - backround snow-free surface albedo (fraction) -> albbck_lnd +!!\n \a snoalb - upper bound on maximum albedo over deep snow -> snoalb1d_lnd if(ivegsrc == 1) then ! IGBP - MODIS vtype_wat(i,j) = 17 ! 17 - water (oceans and lakes) in MODIS @@ -799,6 +806,8 @@ subroutine lsm_ruc_run & ! inputs xlai(i,j) = 0. endif + semis_bck(i,j) = semisbase(i) + if (land(i)) then ! at least some land in the grid cell !> - 4. history (state) variables (h): @@ -826,18 +835,25 @@ subroutine lsm_ruc_run & ! inputs qsfc_lnd(i,j) = sfcqv_lnd(i)/(1.+sfcqv_lnd(i)) qsg_lnd(i,j) = rslf(prsl1(i),tsurf_lnd(i)) qcg_lnd(i,j) = sfcqc_lnd(i) - sfcems_lnd(i,j) = semis_lnd(i) sncovr_lnd(i,j) = sncovr1_lnd(i) + if (kdt == 1) then + sfcems_lnd(i,j) = semisbase(i) * (1.-sncovr_lnd(i,j)) + 0.99 * sncovr_lnd(i,j) + else + sfcems_lnd(i,j) = semis_lnd(i) + endif snoalb1d_lnd(i,j) = snoalb(i) - albbck_lnd(i,j) = max(0.01, 0.5 * (alvwf(i) + alnwf(i))) + albbck_lnd(i,j) = sfalb_lnd_bck(i) ! alb_lnd takes into account snow on the ground - if (sncovr_lnd(i,j) > 0.) then - !- averaged of snow-free and snow-covered - alb_lnd(i,j) = albbck_lnd(i,j) * (1.-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) + if (kdt == 1) then + if (dswsfc(i) > 0.) then + alb_lnd(i,j) = max(0.01, 1. - snet(i)/dswsfc(i)) + else + alb_lnd(i,j) = albbck_lnd(i,j) * (1.-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) + endif else - alb_lnd(i,j) = albbck_lnd(i,j) + alb_lnd(i,j) = sfalb_lnd(i) endif - solnet_lnd(i,j) = dswsfc(i)*(1.-alb_lnd(i,j)) !snet(i) !..net sw rad flx (dn-up) at sfc in w/m2 + solnet_lnd(i,j) = snet(i) !dswsfc(i)*(1.-alb_lnd(i,j)) !..net sw rad flx (dn-up) at sfc in w/m2 cmc(i,j) = canopy(i) ! [mm] soilt_lnd(i,j) = tsurf_lnd(i) ! clu_q2m_iter @@ -956,8 +972,8 @@ subroutine lsm_ruc_run & ! inputs & rhosnfr(i,j), precipfr(i,j), & ! --- inputs: & conflx2(i,1,j), sfcprs(i,1,j), sfctmp(i,1,j), q2(i,1,j), & - & qcatm(i,1,j), rho2(i,1,j), & - & lwdn(i,j), solnet_lnd(i,j), sfcems_lnd(i,j), chklowq(i,j), & + & qcatm(i,1,j), rho2(i,1,j), semis_bck(i,j), lwdn(i,j), & + & swdn(i,j), solnet_lnd(i,j), sfcems_lnd(i,j), chklowq(i,j), & & chs_lnd(i,j), flqc_lnd(i,j), flhc_lnd(i,j), & ! --- input/outputs: & wet(i,j), cmc(i,j), shdfac(i,j), alb_lnd(i,j), znt_lnd(i,j), & @@ -1094,6 +1110,12 @@ subroutine lsm_ruc_run & ! inputs ! ---- ... outside RUC LSM, roughness uses cm as unit ! (update after snow's effect) z0rl_lnd(i) = znt_lnd(i,j)*100. + !-- semis_lnd is with snow effect + semis_lnd(i) = sfcems_lnd(i,j) + !-- semisbas is without snow effect, but can have vegetation mosaic effect + semisbase(i) = semis_bck(i,j) + !-- sfalb_lnd has snow effect + sfalb_lnd(i) = alb_lnd(i,j) do k = 1, lsoil_ruc smois(i,k) = smsoil(i,k,j) @@ -1113,23 +1135,28 @@ subroutine lsm_ruc_run & ! inputs !-- ice point sncovr_ice(i,j) = sncovr1_ice(i) - snoalb1d_ice(i,j) = 0.75 ! RAP value for max snow alb on ice - albbck_ice(i,j) = 0.55 ! RAP value for ice alb - if (sncovr_ice(i,j) > 0.) then - !- averaged of snow-free and snow-covered ice - alb_ice(i,j) = albbck_ice(i,j) * (1.-sncovr_ice(i,j)) + snoalb1d_ice(i,j) * sncovr_ice(i,j) + !-- alb_ice* is computed in setalb called from rrtmg_sw_pre. + snoalb1d_ice(i,j) = alb_ice_snow(i) !0.75 is RAP value for max snow alb on ice + albbck_ice(i,j) = alb_ice_snowfree(i) !0.55 is RAP value for ice alb + if (kdt == 1) then + if (dswsfc(i) > 0.) then + alb_ice(i,j) = max(0.01, 1. - snet(i)/dswsfc(i)) + else + alb_ice(i,j) = albbck_ice(i,j) * (1.-sncovr_ice(i,j)) + snoalb1d_ice(i,j) * sncovr_ice(i,j) + endif else - ! snow-free ice - alb_ice(i,j) = albbck_ice(i,j) + alb_ice(i,j) = sfalb_ice(i) endif - - solnet_ice(i,j) = dswsfc(i)*(1.-alb_ice(i,j)) + solnet_ice(i,j) = snet(i) !dswsfc(i)*(1.-alb_ice(i,j)) qvg_ice(i,j) = sfcqv_ice(i) qsfc_ice(i,j) = sfcqv_ice(i)/(1.+sfcqv_ice(i)) qsg_ice(i,j) = rslf(prsl1(i),tsurf_ice(i)) qcg_ice(i,j) = sfcqc_ice(i) - sfcems_ice(i,j) = semis_ice(i) - + if (kdt == 1) then + sfcems_ice(i,j) = semisbase(i) * (1.-sncovr_ice(i,j)) + 0.99 * sncovr_ice(i,j) + else + sfcems_ice(i,j) = semis_ice(i) + endif cmc(i,j) = canopy(i) ! [mm] soilt_ice(i,j) = tsurf_ice(i) ! clu_q2m_iter if (tsnow_ice(i) > 0. .and. tsnow_ice(i) < 273.15) then @@ -1188,8 +1215,8 @@ subroutine lsm_ruc_run & ! inputs & rhosnfr(i,j), precipfr(i,j), & ! --- inputs: & conflx2(i,1,j), sfcprs(i,1,j), sfctmp(i,1,j), q2(i,1,j), & - & qcatm(i,1,j), rho2(i,1,j), & - & lwdn(i,j), solnet_ice(i,j), sfcems_ice(i,j), chklowq(i,j), & + & qcatm(i,1,j), rho2(i,1,j), semis_bck(i,j), lwdn(i,j), & + & swdn(i,j), solnet_ice(i,j), sfcems_ice(i,j), chklowq(i,j), & & chs_ice(i,j), flqc_ice(i,j), flhc_ice(i,j), & ! --- input/outputs: & wet_ice(i,j), cmc(i,j), shdfac(i,j), alb_ice(i,j), & @@ -1234,6 +1261,10 @@ subroutine lsm_ruc_run & ! inputs weasd_ice(i) = sneqv_ice(i,j) ! mm sncovr1_ice(i) = sncovr_ice(i,j) z0rl_ice(i) = znt_ice(i,j)*100. + !-- semis_ice is with snow effect + semis_ice(i) = sfcems_ice(i,j) + !-- sfalb_ice is with snow effect + sfalb_ice(i) = alb_ice(i,j) do k = 1, lsoil_ruc tsice(i,k) = stsice(i,k,j) diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 229bce1fc..d82e40384 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -582,6 +582,24 @@ type = logical intent = in optional = F +[alb_ice_snowfree] + standard_name =surface_snow_free_albedo_over_ice + long_name = surface snow-free albedo over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[alb_ice_snow] + standard_name =surface_snow_albedo_over_ice + long_name = surface snow albedo over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [rainnc] standard_name = lwe_thickness_of_explicit_rainfall_amount_from_previous_timestep long_name = explicit rainfall from previous timestep @@ -672,41 +690,68 @@ kind = kind_phys intent = in optional = F -[alvwf] - standard_name = mean_vis_albedo_with_weak_cosz_dependency - long_name = mean vis albedo with weak cosz dependency - units = frac +[srflag] + standard_name = flag_for_precipitation_type + long_name = snow/rain flag for precipitation + units = flag dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F -[alnwf] - standard_name = mean_nir_albedo_with_weak_cosz_dependency - long_name = mean nir albedo with weak cosz dependency +[sfalb_lnd_bck] + standard_name =surface_snow_free_albedo_over_land + long_name = surface snow-free albedo over ice units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = inout optional = F -[srflag] - standard_name = flag_for_precipitation_type - long_name = snow/rain flag for precipitation - units = flag +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo + units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F -[snoalb] - standard_name = upper_bound_on_max_albedo_over_deep_snow - long_name = maximum snow albedo +[albdvis] + standard_name = surface_albedo_direct_visible + long_name = direct surface albedo visible band units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = out + optional = F +[albdnir] + standard_name = surface_albedo_direct_NIR + long_name = direct surface albedo NIR band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albivis] + standard_name = surface_albedo_diffuse_visible + long_name = diffuse surface albedo visible band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albinir] + standard_name = surface_albedo_diffuse_NIR + long_name = diffuse surface albedo NIR band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out optional = F [isot] standard_name = soil_type_dataset_choice @@ -832,9 +877,18 @@ kind = kind_phys intent = in optional = F +[semisbase] + standard_name = baseline_surface_longwave_emissivity + long_name = baseline surface lw emissivity in fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [semis_lnd] - standard_name = surface_longwave_emissivity_over_land_interstitial - long_name = surface lw emissivity in fraction over land (temporary use as interstitial) + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land units = frac dimensions = (horizontal_loop_extent) type = real @@ -842,8 +896,26 @@ intent = inout optional = F [semis_ice] - standard_name = surface_longwave_emissivity_over_ice_interstitial - long_name = surface lw emissivity in fraction over ice (temporary use as interstitial) + standard_name = surface_longwave_emissivity_over_ice + long_name = surface lw emissivity in fraction over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[sfalb_lnd] + standard_name = surface_diffused_shortwave_albedo_over_land + long_name = mean surface diffused sw albedo over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[sfalb_ice] + standard_name = surface_diffused_shortwave_albedo_over_ice + long_name = mean surface diffused sw albedo over ice units = frac dimensions = (horizontal_loop_extent) type = real diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta index c0a6393fa..021394bbe 100644 --- a/physics/sfc_noahmp_drv.meta +++ b/physics/sfc_noahmp_drv.meta @@ -1046,13 +1046,13 @@ intent = out optional = F [emiss] - standard_name = surface_emissivity_lsm - long_name = surface emissivity from lsm + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [sncovr1] standard_name = surface_snow_area_fraction_over_land From 67ddbbd09f602c2f0356b023499e26da5246dc82 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Fri, 26 Mar 2021 21:57:36 +0000 Subject: [PATCH 02/74] Merged Moorthi's changes for fractional grid in setemis. --- physics/radiation_surface.f | 61 ++++++++++++++++++++++++------------- physics/rrtmg_lw_pre.F90 | 8 ++--- physics/rrtmg_lw_pre.meta | 17 ++++++++--- physics/rrtmgp_lw_pre.F90 | 13 ++++---- physics/rrtmgp_lw_pre.meta | 17 ++++++++--- 5 files changed, 76 insertions(+), 40 deletions(-) diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index e70ab22b9..a644fbd28 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -122,6 +122,7 @@ module module_radiation_surface integer, parameter, public :: JMXEMS = 180 !< number of latitude points in global emis-type map real (kind=kind_phys), parameter :: f_zero = 0.0 real (kind=kind_phys), parameter :: f_one = 1.0 + real (kind=kind_phys), parameter :: epsln = 1.0e-6 real (kind=kind_phys), parameter :: rad2dg= 180.0 / con_pi integer, allocatable :: idxems(:,:) !< global surface emissivity index array integer :: iemslw = 0 !< global surface emissivity control flag set up in 'sfc_init' @@ -840,7 +841,8 @@ end subroutine setalb !! or -pi -> +pi ranges !!\param xlat (IMAX), latitude in radiance, default to pi/2 -> !! -pi/2 range, otherwise see in-line comment -!!\param slmsk (IMAX), sea(0),land(1),ice(2) mask on fcst model grid +!!\param lanfrac (IMAX), +!!!\parction of grid that is land !!\param snowf (IMAX), snow depth water equivalent in mm !!\param sncovr (IMAX), snow cover over land !!\param zorlf (IMAX), surface roughness in cm @@ -854,7 +856,7 @@ end subroutine setalb !----------------------------------- subroutine setemis & & ( kdt,lsm,lsm_noahmp,lsm_ruc,vtype, & ! --- inputs: - & xlon,xlat,slmsk,snowf,sncovr,sncovr_ice, & + & xlon,xlat,slmsk,snowf,sncovr,sncovr_ice,fice, & & zorlf,tsknf,tairf,hprif, & & semis_lnd,semis_ice,IMAX, & & semisbase, sfcemis & ! --- outputs: @@ -876,8 +878,10 @@ subroutine setemis & ! xlat (IMAX) - latitude in radiance, default to pi/2 -> -pi/2 ! ! range, otherwise see in-line comment ! ! slmsk (IMAX) - sea(0),land(1),ice(2) mask on fcst model grid ! +! landfrac (IMAX) - fraction of land on on fcst model grid ! ! snowf (IMAX) - snow depth water equivalent in mm ! ! sncovr(IMAX) - ialbflg=1: snow cover over land in fraction ! +! fice (IMAX) - sea/lake ice fraction ! ! sncovr_ice(IMAX) - snow cover over ice in fraction ! ! zorlf (IMAX) - surface roughness in cm ! ! tsknf (IMAX) - ground surface temperature in k ! @@ -887,7 +891,7 @@ subroutine setemis & ! IMAX - array horizontal dimension ! ! ! ! outputs: ! -! sfcemis(IMAX) - surface emissivity ! +! sfcemis(IMAX) - surface emissivity ! ! ! ! ------------------------------------------------------------------- ! ! ! @@ -912,7 +916,7 @@ subroutine setemis & real (kind=kind_phys), dimension(:), intent(in) :: vtype real (kind=kind_phys), dimension(:), intent(in) :: & - & xlon,xlat, slmsk, snowf,sncovr, sncovr_ice, & + & xlon,xlat, slmsk, snowf,sncovr, sncovr_ice, fice, & & zorlf, tsknf, tairf, hprif, semis_lnd, semis_ice ! --- outputs @@ -924,7 +928,7 @@ subroutine setemis & integer :: ivgtyp real (kind=kind_phys) :: dltg, hdlt, tmp1, tmp2, & - & asnow, argh, hrgh, fsno, fsno0, fsno1 + & asnow, argh, hrgh, fsno, fsno0, fracl, fraco, fraci ! --- reference emiss value for diff surface emiss index ! 1-open water, 2-grass/shrub land, 3-bare soil, tundra, @@ -949,19 +953,25 @@ subroutine setemis & ! --- ... mapping input data onto model grid ! note: this is a simple mapping method, an upgrade is needed if -! the model grid is much corcer than the 1-deg data resolution +! the model grid is much coarser than the 1-deg data resolution lab_do_IMAX : do i = 1, IMAX - if ( nint(slmsk(i)) == 0 ) then ! sea point - - sfcemis(i) = emsref(1) - - else if ( nint(slmsk(i)) == 2 ) then ! sea-ice + fracl = landfrac(i) + fraco = max(f_zero, f_one - fracl) + fraci = fraco * fice(i) + fraco = max(f_zero, fraco-fraci) - sfcemis(i) = emsref(7) + if (fracl < epsln) then ! no land + if ( abs(fraco-f_one) < epsln ) then ! open water point + sfcemis(i) = emsref(1) + elseif ( abs(fraci-f_one) > epsln ) then ! complete sea/lake ice + sfcemis(i) = emsref(7) + else + sfcemis(i) = fraco*emsref(1) + fraci*emsref(7) + endif - else ! land + else ! land or fractional grid ! --- map grid in longitude direction i2 = 1 @@ -992,21 +1002,26 @@ subroutine setemis & endif enddo lab_do_JMXEMS - idx = max( 2, idxems(i2,j2) ) if ( idx >= 7 ) idx = 2 - sfcemis(i) = emsref(idx) + + if (abs(fracl-f_one) < epsln) then + sfcemis(i) = emsref(idx) + else + sfcemis(i) = fracl*emsref(idx) + fraco*emsref(1) & + & + fraci*emsref(7) + endif semisbase(i) = sfcemis(i) endif ! end if_slmsk_block !> -# Check for snow covered area. - if ( iemslw==1 .and. nint(slmsk(i))==1 ) then ! input land area snow cover +! if ( ialbflg==1 .and. nint(slmsk(i))==1 ) then ! input land area snow cover + if ( sncovr(i) > f_zero ) then ! input land/ice area snow cover fsno0 = sncovr(i) - fsno1 = f_one - fsno0 - sfcemis(i) = sfcemis(i)*fsno1 + emsref(8)*fsno0 + sfcemis(i) = sfcemis(i)*(f_one - fsno0) + emsref(8)*fsno0 else ! compute snow cover from snow depth if ( snowf(i) > f_zero ) then @@ -1014,10 +1029,12 @@ subroutine setemis & argh = min(0.50, max(.025, 0.01*zorlf(i))) hrgh = min(f_one, max(0.20, 1.0577-1.1538e-3*hprif(i) ) ) fsno0 = asnow / (argh + asnow) * hrgh - if (nint(slmsk(i)) == 0 .and. tsknf(i) > 271.2) & - & fsno0=f_zero - fsno1 = f_one - fsno0 - sfcemis(i) = sfcemis(i)*fsno1 + emsref(8)*fsno0 + +! if (nint(slmsk(i)) == 0 .and. tsknf(i) > 271.2) & +! & fsno0=f_zero + + if (abs(fraco-f_one) < epsln) fsno0 = f_zero ! no snow over open water + sfcemis(i) = sfcemis(i)*(f_one - fsno0) + emsref(8)*fsno0 endif endif ! end if_ialbflg diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index accd4aa73..94820a33b 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -12,8 +12,8 @@ end subroutine rrtmg_lw_pre_init !> \section arg_table_rrtmg_lw_pre_run Argument Table !! \htmlinclude rrtmg_lw_pre_run.html !! - subroutine rrtmg_lw_pre_run (im, lslwr, kdt, lsm, lsm_noahmp, lsm_ruc, vtype, & - xlat, xlon, slmsk, snowd, sncovr, sncovr_ice, zorl, hprime, tsfg, tsfa, & + subroutine rrtmg_lw_pre_run (im, lslwr, kdt, lsm, lsm_noahmp, lsm_ruc, vtype, & + xlat, xlon, slmsk, snowd, sncovr, sncovr_ice, fice, zorl, hprime, tsfg, tsfa, & semis_lnd, semis_ice, semisbase, semis, errmsg, errflg) use machine, only: kind_phys @@ -26,7 +26,7 @@ subroutine rrtmg_lw_pre_run (im, lslwr, kdt, lsm, lsm_noahmp, lsm_ruc, vtype, & integer, intent(in) :: kdt, lsm, lsm_noahmp, lsm_ruc real(kind=kind_phys), dimension(im), intent(in) :: xlat, xlon, vtype, slmsk,& - snowd, sncovr, sncovr_ice, zorl, hprime, tsfg, tsfa + snowd, sncovr, sncovr_ice, fice, zorl, hprime, tsfg, tsfa real(kind=kind_phys), dimension(:), intent(in) :: semis_lnd real(kind=kind_phys), dimension(:), intent(in) :: semis_ice real(kind=kind_phys), dimension(im), intent(out) :: semisbase @@ -42,7 +42,7 @@ subroutine rrtmg_lw_pre_run (im, lslwr, kdt, lsm, lsm_noahmp, lsm_ruc, vtype, & !> - Call module_radiation_surface::setemis(),to setup surface !! emissivity for LW radiation. call setemis (kdt, lsm, lsm_noahmp, lsm_ruc, vtype, xlon, xlat, slmsk, & - snowd, sncovr, sncovr_ice, zorl, tsfg, tsfa, & + snowd, sncovr, sncovr_ice, fice, zorl, tsfg, tsfa, & hprime, semis_lnd, semis_ice, im, & ! --- inputs semisbase, semis) ! --- outputs diff --git a/physics/rrtmg_lw_pre.meta b/physics/rrtmg_lw_pre.meta index e2752d42e..9c0972638 100644 --- a/physics/rrtmg_lw_pre.meta +++ b/physics/rrtmg_lw_pre.meta @@ -82,10 +82,10 @@ kind = kind_phys intent = in optional = F -[slmsk] - standard_name = sea_land_ice_mask_real - long_name = landmask: sea/land/ice=0/1/2 - units = flag +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -118,6 +118,15 @@ kind = kind_phys intent = in optional = F +[fice] + standard_name = sea_ice_concentration + long_name = sea-ice concentration [0,1] + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [zorl] standard_name = surface_roughness_length long_name = surface roughness length diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index 4a7fe0f1c..6353f5aba 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -26,7 +26,7 @@ end subroutine rrtmgp_lw_pre_init !! \htmlinclude rrtmgp_lw_pre_run.html !! subroutine rrtmgp_lw_pre_run ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, doLWrad, & - nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, sncovr_ice, & + nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, sncovr_ice, fice, & tsfg, tsfa, hprime, sfc_emiss_byband, semis_land, semis_ice, & semisbase, semis, errmsg, errflg) @@ -41,11 +41,12 @@ subroutine rrtmgp_lw_pre_run ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, doLWrad, & vtype, & ! vegetation type xlon, & ! Longitude xlat, & ! Latitude - slmsk, & ! Land/sea/sea-ice mask + landfrac, & ! Land fraction zorl, & ! Surface roughness length (cm) snowd, & ! water equivalent snow depth (mm) sncovr, & ! Surface snow are fraction (1) sncovr_ice, & ! Surface snow fraction over ice (1) + fice, & ! Fration of sea ice tsfg, & ! Surface ground temperature for radiation (K) tsfa, & ! Lowest model layer air temperature for radiation (K) hprime ! Standard deviation of subgrid orography @@ -76,10 +77,10 @@ subroutine rrtmgp_lw_pre_run ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, doLWrad, & ! ####################################################################################### ! Call module_radiation_surface::setemis(),to setup surface emissivity for LW radiation. ! ####################################################################################### - call setemis ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, xlon, xlat, slmsk, & - snowd, sncovr, sncovr_ice, zorl, tsfg, tsfa, hprime, & - semis_land, semis_ice, nCol, & ! --- inputs - semisbase, semis) ! --- outputs + call setemis ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, xlon, xlat, slmsk, & + snowd, sncovr, sncovr_ice, fice, zorl, tsfg, tsfa, hprime, & + semis_land, semis_ice, nCol, & ! --- inputs + semisbase, semis) ! --- outputs ! Assign same emissivity to all bands diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index 6bda951af..2a7b1e4f2 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -82,10 +82,10 @@ kind = kind_phys intent = in optional = F -[slmsk] - standard_name = sea_land_ice_mask_real - long_name = landmask: sea/land/ice=0/1/2 - units = flag +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -127,6 +127,15 @@ kind = kind_phys intent = in optional = F +[fice] + standard_name = sea_ice_concentration + long_name = sea-ice concentration [0,1] + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [tsfg] standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation From 25611d7801898d2ff2fe62fa1a5e7eb5af056b85 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 30 Mar 2021 19:05:59 +0000 Subject: [PATCH 03/74] Step forward towards fractional albedo and emissivity in the LSM option. --- physics/radiation_surface.f | 295 +++++++++++++++++++----------------- physics/sfc_drv_ruc.F90 | 65 +++++--- physics/sfc_drv_ruc.meta | 117 +++++++++----- physics/sfc_noahmp_drv.meta | 16 +- 4 files changed, 289 insertions(+), 204 deletions(-) diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index a644fbd28..44d98b098 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -331,10 +331,11 @@ end subroutine sfc_init !----------------------------------- subroutine setalb & & ( slmsk,lsm,lsm_noahmp,lsm_ruc,snowf,sncovr,sncovr_ice, & - & snoalb,zorlf,coszf,tsknf,tairf,hprif, & ! --- inputs: + & snoalb,zorlf,coszf,tsknf,tairf,hprif,landfrac, & ! --- inputs: & alvsf,alnsf,alvwf,alnwf,facsf,facwf,fice,tisfc, & - & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir,IMAX, & - & albPpert, pertalb, & ! sfc-perts, mgehne + & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, & + & icealbdvis, icealbdnir, icealbivis, icealbinir, & + & IMAX, albPpert, pertalb, & ! sfc-perts, mgehne & sfcalb, alb_ice, alb_sno_ice, sfalb_lnd_bck & ! --- outputs: & ) @@ -404,9 +405,10 @@ subroutine setalb & integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc real (kind=kind_phys), dimension(:), intent(in) :: & - & slmsk, snowf, zorlf, coszf, tsknf, tairf, hprif, & + & slmsk, snowf, zorlf, coszf, tsknf, tairf, hprif, landfrac, & & alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, & + & icealbdvis, icealbdnir, icealbivis, icealbinir, & & sncovr, sncovr_ice, snoalb, albPpert ! sfc-perts, mgehne real (kind=kind_phys), intent(in) :: pertalb ! sfc-perts, mgehne @@ -423,6 +425,8 @@ subroutine setalb & &, asenb, asevd, asend, fsno, fsea, rfcs, rfcw, flnd & &, asnow, argh, hrgh, fsno0, fsno1, flnd0, fsea0, csnow & &, a1, a2, b1, b2, b3, ab1bm, ab2bm, m, s, alpha, beta, albtmp + real (kind=kind_phys) :: asevb_wat,asenb_wat,asevd_wat,asend_wat, & + asevb_ice,asenb_ice,asevd_ice,asend_ice real (kind=kind_phys) ffw, dtgd @@ -683,114 +687,99 @@ subroutine setalb & enddo ! end_do_i_loop -!> -# use land model output for land area: Noah MP +!> -# use land model output for land area: Noah MP, RUC (land and ice). elseif ( ialbflg == 2 ) then do i = 1, IMAX -!> - albedo from noah mp already includes the snow portion - - fsno0 = f_zero - - if (nint(slmsk(i))==0 .and. tsknf(i)>con_tice) fsno0 = f_zero - - if (nint(slmsk(i)) == 2) then - asnow = 0.02*snowf(i) - argh = min(0.50, max(.025, 0.01*zorlf(i))) - hrgh = min(f_one, max(0.20, 1.0577-1.1538e-3*hprif(i) ) ) - fsno0 = asnow / (argh + asnow) * hrgh - endif - - fsno1 = f_one - fsno0 - flnd0 = min(f_one, facsf(i)+facwf(i)) - fsea0 = max(f_zero, f_one-flnd0) - fsno = fsno0 - fsea = fsea0 * fsno1 - flnd = flnd0 * fsno1 - -!> - Calculate diffused sea surface albedo. - - if (tsknf(i) >= 271.5) then - asevd = 0.06 - asend = 0.06 - elseif (tsknf(i) < 271.1) then - asevd = 0.70 - asend = 0.65 - else - a1 = (tsknf(i) - 271.1)**2 - asevd = 0.7 - 4.0*a1 - asend = 0.65 - 3.6875*a1 - endif - -!> - Calculate diffused snow albedo, land area use input max snow -!! albedo. + fracl = landfrac(i) + fraco = max(f_zero, f_one - fracl) + fraci = fraco * fice(i) + ffw = max(f_zero, f_one - fraci) + fraco = max(f_zero, fraco-fraci) - if (nint(slmsk(i)) == 2) then - ffw = f_one - fice(i) - if (ffw < f_one) then - dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) )) - b1 = 0.03 * dtgd + if ( fraco > f_zero ) then + !-- open water fraction + asevd_wat = 0.06 + asend_wat = 0.06 + + ! direct albedo CZA dependence + if (coszf(i) > 0.0001) then + if (tsknf(i) >= con_t0c) then + asevb_wat = max (asevd_wat, 0.026/(coszf(i)**1.7+0.065) & + & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & + & * (coszf(i)-f_one)) + asenb_wat = asevb_wat + endif else - b1 = f_zero + asevb_wat = asevd_wat + asenb_wat = asevd_wat endif - b3 = 0.06 * ffw - asnvd = (0.70 + b1) * fice(i) + b3 - asnnd = (0.60 + b1) * fice(i) + b3 - asevd = 0.70 * fice(i) + b3 - asend = 0.60 * fice(i) + b3 - else - asnvd = snoalb(i) - asnnd = snoalb(i) - endif - -!> - Calculate direct snow albedo. - - if (nint(slmsk(i)) == 2) then - if (coszf(i) < 0.5) then - csnow = 0.5 * (3.0 / (f_one+4.0*coszf(i)) - f_one) - asnvb = min( 0.98, asnvd+(f_one-asnvd)*csnow ) - asnnb = min( 0.98, asnnd+(f_one-asnnd)*csnow ) - else - asnvb = asnvd - asnnb = asnnd - endif - else - asnvb = asnvd - asnnb = asnnd - endif - -!> - Calculate direct sea surface albedo, use fanglin's zenith angle -!! treatment. - - if (coszf(i) > 0.0001) then - -! rfcs = 1.89 - 3.34*coszf(i) + 4.13*coszf(i)*coszf(i) & -! & - 2.02*coszf(i)*coszf(i)*coszf(i) - rfcs = 1.775/(1.0+1.55*coszf(i)) - - if (tsknf(i) >= con_t0c) then - asevb = max(asevd, 0.026/(coszf(i)**1.7+0.065) & - & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & - & * (coszf(i)-f_one)) - asenb = asevb + elseif (fraci > min_seaice) then ! full or fractional ice + !-- tgs: this part of the code needs the input from the ice + ! model. Otherwise it uses the backup albedo computation + ! from ialbflg = 1. + if(lsm == lsm_ruc) then + !-- use ice albedo from the RUC ice model + asevd_ice = icealbivis(i) + asend_ice = icealbinir(i) + asevb_ice = icealbdvis(i) + asenb_ice = icealbdnir(i) else - asevb = asevd - asenb = asend - endif - else - rfcs = f_one - asevb = asevd - asenb = asend - endif - - sfcalb(i,1) = min(0.99,max(0.01,lsmalbdnir(i)))*flnd & - & + asenb*fsea + asnnb*fsno - sfcalb(i,2) = min(0.99,max(0.01,lsmalbinir(i)))*flnd & - & + asend*fsea + asnnd*fsno - sfcalb(i,3) = min(0.99,max(0.01,lsmalbdvis(i)))*flnd & - & + asevb*fsea + asnvb*fsno - sfcalb(i,4) = min(0.99,max(0.01,lsmalbivis(i)))*flnd & - & + asevd*fsea + asnvd*fsno + !-- Computation of ice albedo + asnow = 0.02*snowf(i) + argh = min(0.50, max(.025, 0.01*zorlf(i))) + hrgh = min(f_one,max(0.20,1.0577-1.1538e-3*hprif(i))) + fsno0 = asnow / (argh + asnow) * hrgh + ! diffused + if (tsknf(i) < 271.1) then + asevd_ice = 0.70 + asend_ice = 0.65 + else + a1 = (tsknf(i) - 271.1)**2 + asevd_ice = 0.7 - 4.0*a1 + asend_ice = 0.65 - 3.6875*a1 + endif + ! direct + asevb_ice = asevd_ice + asenb_ice = asend_ice + + if (fsno0 > epsln) then ! fractional snow + ! Snow on ice + dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) )) + b1 = 0.03 * dtgd + asnvd = (asevd_ice + b1) ! diffused snow albedo + asnnd = (asend_ice + b1) + + if (coszf(i) > 0.0001 .and. coszf(i) < 0.5) then ! direct snow albedo + csnow = 0.5 * (3.0 / (f_one+4.0*coszf(i)) - f_one) + asnvb = min( 0.98, asnvd+(f_one-asnvd)*csnow ) + asnnb = min( 0.98, asnnd+(f_one-asnnd)*csnow ) + else + asnvb = asnvd + asnnb = asnnd + endif + + ! composite ice albedo and snow albedos + asevd_ice = asevd_ice * (1. - fsno0) + asnvd * fsno0 + asend_ice = asend_ice * (1. - fsno0) + asnnd * fsno0 + asevb_ice = asevb_ice * (1. - fsno0) + asnvb * fsno0 + asenb_ice = asenb_ice * (1. - fsno0) + asnnb * fsno0 + endif ! snow + endif ! ice model + + endif ! water or ice + + !-- Composite mean surface albedo from land, open water and + !-- ice fractions + sfcalb(i,1) = min(0.99,max(0.01,lsmalbdnir(i)))*fracl & + & + asenb_wat*fraco + asenb_ice*fraci + sfcalb(i,2) = min(0.99,max(0.01,lsmalbinir(i)))*fracl & + & + asend_wat*fraco + asend_ice*fraci + sfcalb(i,3) = min(0.99,max(0.01,lsmalbdvis(i)))*fracl & + & + asevb_wat*fraco + asenb_ice*fraci + sfcalb(i,4) = min(0.99,max(0.01,lsmalbivis(i)))*fracl & + & + asevd_wat*fraco + asend_ice*fraci enddo ! end_do_i_loop @@ -930,6 +919,8 @@ subroutine setemis & real (kind=kind_phys) :: dltg, hdlt, tmp1, tmp2, & & asnow, argh, hrgh, fsno, fsno0, fracl, fraco, fraci + real (kind=kind_phys) :: sfcemis_land, sfcemis_ice + ! --- reference emiss value for diff surface emiss index ! 1-open water, 2-grass/shrub land, 3-bare soil, tundra, ! 4-sandy desert, 5-rocky desert, 6-forest, 7-ice, 8-snow @@ -1045,57 +1036,79 @@ subroutine setemis & do i = 1, IMAX - if ( nint(slmsk(i)) == 0 ) then ! sea point - - sfcemis(i) = emsref(1) - - else if ( nint(slmsk(i)) == 2 ) then ! sea-ice + fracl = landfrac(i) + fraco = max(f_zero, f_one - fracl) + fraci = fraco * fice(i) + fraco = max(f_zero, fraco-fraci) - if (lsm == lsm_ruc) then - !-- RUC lsm has sea-ice component - if (kdt == 1 ) then - semisbase(i) = emsref(7) - sfcemis(i) = semisbase(i)*(1.-sncovr_ice(i)) - & + emsref(8)*sncovr_ice(i) - else - sfcemis(i) = semis_ice(i) ! with snow effect - endif - else - !-- should come from the ice model, for now defined from - !-- the surface type - if ( snowf(i) > f_zero ) then - !-- snow on ice - asnow = 0.02*snowf(i) - argh = min(0.50, max(.025, 0.01*zorlf(i))) - hrgh = min(f_one, max(0.20, 1.0577-1.1538e-3*hprif(i))) - fsno0 = asnow / (argh + asnow) * hrgh - if (nint(slmsk(i)) == 0 .and. tsknf(i) > 271.2) & - & fsno0=f_zero - fsno1 = f_one - fsno0 - sfcemis(i) = emsref(7)*fsno1 + emsref(8)*fsno0 - else - !-- no snow on ice - sfcemis(i) = emsref(7) + if (fracl < epsln) then ! no land + if ( abs(fraco-f_one) < epsln ) then + !-- open water point + sfcemis(i) = emsref(1) + elseif (fraci > epsln) then + !-- full or fractional ice + if (lsm == lsm_noahmp) then + !-- ice emissivity from the table + sfcemis_ice = emsref(7) + if ( snowf(i) > f_zero ) then + asnow = 0.02*snowf(i) + argh = min(0.50, max(.025,0.01*zorlf(i))) + hrgh = min(f_one,max(0.20,1.0577-1.1538e-3*hprif(i))) + fsno0 = asnow / (argh + asnow) * hrgh + sfcemis(i) = sfcemis_ice*(f_one-fsno0)+emsref(8)*fsno0 + endif + elseif (lsm == lsm_ruc) then + !-- ruc lsm has a sea-ice component + if (kdt == 1 ) then + sfcemis_ice = emsref(7) * (1.-sncovr_ice(i)) + & + emsref(8) * sncovr_ice(i) + else + sfcemis_ice = semis_ice(i) ! emissivity for ice with snow effect + endif + sfcemis(i) = sfcemis_ice + endif ! lsm check + + if ( abs(fraci-f_one) > epsln ) then + !-- fractional sea ice + sfcemis(i) = fraco*emsref(1) + fraci*sfcemis(i) endif - endif - else ! land + else ! land or fractional grid if (lsm == lsm_noahmp .or. lsm == lsm_ruc) then !-- Noah MP or RUC LSM + if (lsm == lsm_noahmp) then + sfcemis_land = semis_lnd(i)! with snow effect + sfcemi_ice = emsref(7) + else + ! ruc lsm if (kdt == 1 ) then ivgtyp = int( vtype(i)+0.5 ) semisbase(i) = lemitbl(ivgtyp) - sfcemis(i) = semisbase(i)*(1.-sncovr(i)) - & + emsref(8)*sncovr(i) + sfcemis_land = semisbase(i)*(1.-sncovr(i)) + & + emsref(8)*sncovr(i) + sfcemis_ice = emsref(8)*(1.-sncovr_ice(i)) + & + emsref(8)*sncovr_ice(i) else - sfcemis(i) = semis_lnd(i)! with snow effect + sfcemis_land = semis_lnd(i) ! with snow effect + sfcemis_ice = semis_ice(i) ! with snow effect + endif ! ruc + + if (abs(fracl-f_one) < epsln) then + !-- land only + sfcemis(i) = sfcemis_land ! with snow effect + else + !-- land is a fraction + sfcemis(i) = fracl*sfcemis_land + fraco*emsref(1) & + & + fraci*sfcemis_ice + endif endif else - write(0,'(*(a))')'This LSM is not supported with iemslw=2' + write(0,'(*(a))')'This LSM is not supported with iemslw=2' endif - endif ! end if_slmsk_block + endif ! fractional land + enddo diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index eaec9d542..72afe961c 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -17,6 +17,9 @@ module lsm_ruc public :: lsm_ruc_init, lsm_ruc_run, lsm_ruc_finalize real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0, epsln = 1.0d-10 + real(kind=kind_phys), dimension (2), parameter :: d = (/0.1,0.25/) + + integer, parameter :: istwe = (/5*1,2,2,1,1,5*2,1,2,2,1,2,2/) ! for 20 IGBP classes contains @@ -267,12 +270,11 @@ subroutine lsm_ruc_run & ! inputs & imp_physics, imp_physics_gfdl, imp_physics_thompson, & & do_mynnsfclay, lsoil_ruc, lsoil, rdlai, zs, & & t1, q1, qc, soiltyp, vegtype, sigmaf, laixy, & - & dlwflx, dswsfc, snet, tg3, & + & dlwflx, dswsfc, snet, tg3, coszen, & & land, icy, lake, alb_ice_snowfree, alb_ice_snow, & & rainnc, rainc, ice, snow, graupel, & & prsl1, zf, wind, shdmin, shdmax, & & srflag, sfalb_lnd_bck, snoalb, & - & albdvis, albdnir, albivis, albinir, & !out & isot, ivegsrc, fice, smcwlt2, smcref2, & ! --- constants & con_cp, con_rd, con_rv, con_g, con_pi, con_hvap, & @@ -291,11 +293,13 @@ subroutine lsm_ruc_run & ! inputs & runof, runoff, srunoff, drain, & & cm_lnd, ch_lnd, evbs, evcw, stm, wetness, & & snowfallac_lnd, & + & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & ! for ice & sfcqc_ice, sfcqv_ice, & & tice, tsurf_ice, tsnow_ice, z0rl_ice, & & qsurf_ice, gflux_ice, evap_ice, ep1d_ice, hflx_ice, & & cm_ice, ch_ice, snowfallac_ice, & + & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & ! --- out & rhosnf, sbsno, & & cmm_lnd, chh_lnd, cmm_ice, chh_ice, & @@ -321,7 +325,7 @@ subroutine lsm_ruc_run & ! inputs real (kind=kind_phys), dimension(im), intent(in) :: & & t1, sigmaf, laixy, dlwflx, dswsfc, snet, tg3, & - & prsl1, wind, shdmin, shdmax, & + & coszen, prsl1, wind, shdmin, shdmax, & & sfalb_lnd_bck, snoalb, zf, qc, q1, & ! for land & cm_lnd, ch_lnd, & @@ -379,8 +383,10 @@ subroutine lsm_ruc_run & ! inputs ! for ice & sncovr1_ice, qsurf_ice, gflux_ice, evap_ice, ep1d_ice, & & cmm_ice, chh_ice, hflx_ice, snowfallac_ice - real (kind=kind_phys), dimension(im), intent(in ) :: & - & albdvis, albdnir, albivis, albinir, & + + real (kind=kind_phys), dimension(im), intent( out) :: & + & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & + & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice logical, intent(in) :: flag_init, flag_restart character(len=*), intent(out) :: errmsg @@ -388,7 +394,7 @@ subroutine lsm_ruc_run & ! inputs ! --- locals: real (kind=kind_phys), dimension(im) :: rho, & - & q0, qs1, & + & q0, qs1, albbcksol, & & tprcp_old, srflag_old, sr_old, canopy_old, wetness_old, & ! for land & weasd_lnd_old, snwdph_lnd_old, tskin_lnd_old, & @@ -458,8 +464,9 @@ subroutine lsm_ruc_run & ! inputs ! local integer :: ims,ime, its,ite, jms,jme, jts,jte, kms,kme, kts,kte - integer :: l, k, i, j, fractional_seaice - + integer :: l, k, i, j, fractional_seaice, ilst + integer, dimension (1:nlcat) :: istwe + real (kind=kind_phys) :: dm logical :: flag(im), flag_ice_uncoupled(im) logical :: rdlai2d, myj, frpcpn logical :: debug_print @@ -841,18 +848,26 @@ subroutine lsm_ruc_run & ! inputs else sfcems_lnd(i,j) = semis_lnd(i) endif + + if(coszen(i) > 0. .and. sneqv_lnd(i) < 1.e-4) then + !-- solar zenith angle dependence when no snow + ilst=istwe(vegtype(i)) ! 1 or 2 + dm = (1.+2.*d(ilst))/(1.+2.*d(ilst)*coszen(i,j)) + albbcksol(i) = sfalb_lnd_bck(i)*dm + endif ! coszen > 0. + snoalb1d_lnd(i,j) = snoalb(i) - albbck_lnd(i,j) = sfalb_lnd_bck(i) + albbck_lnd(i,j) = albbcksol(i) !sfalb_lnd_bck(i) ! alb_lnd takes into account snow on the ground - if (kdt == 1) then - if (dswsfc(i) > 0.) then - alb_lnd(i,j) = max(0.01, 1. - snet(i)/dswsfc(i)) - else - alb_lnd(i,j) = albbck_lnd(i,j) * (1.-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) - endif - else - alb_lnd(i,j) = sfalb_lnd(i) - endif + !if (kdt == 1) then + ! if (dswsfc(i) > 0.) then + ! alb_lnd(i,j) = max(0.01, 1. - snet(i)/dswsfc(i)) + ! else + ! alb_lnd(i,j) = albbck_lnd(i,j) * (1.-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) + ! endif + !else + alb_lnd(i,j) = albbck_lnd(i,j) * (1.-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) ! sfalb_lnd(i) + !endif solnet_lnd(i,j) = snet(i) !dswsfc(i)*(1.-alb_lnd(i,j)) !..net sw rad flx (dn-up) at sfc in w/m2 cmc(i,j) = canopy(i) ! [mm] @@ -902,7 +917,8 @@ subroutine lsm_ruc_run & ! inputs sneqv_lnd(i,j) = 300. * snowh_lnd(i,j) endif endif - ! ---- ... outside sflx, roughness uses cm as unit + + !-- z0rl is in [cm] z0_lnd(i,j) = z0rl_lnd(i)/100. znt_lnd(i,j) = z0rl_lnd(i)/100. @@ -1116,6 +1132,11 @@ subroutine lsm_ruc_run & ! inputs semisbase(i) = semis_bck(i,j) !-- sfalb_lnd has snow effect sfalb_lnd(i) = alb_lnd(i,j) + !-- fill in albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, + albdvis_lnd(i) = sfalb_lnd(i) + albdnir_lnd(i) = sfalb_lnd(i) + albinir_lnd(i) = sfalb_lnd(i) + albinir_lnd(i) = sfalb_lnd(i) do k = 1, lsoil_ruc smois(i,k) = smsoil(i,k,j) @@ -1152,6 +1173,7 @@ subroutine lsm_ruc_run & ! inputs qsfc_ice(i,j) = sfcqv_ice(i)/(1.+sfcqv_ice(i)) qsg_ice(i,j) = rslf(prsl1(i),tsurf_ice(i)) qcg_ice(i,j) = sfcqc_ice(i) + semis_bck(i,j) = 0.99 if (kdt == 1) then sfcems_ice(i,j) = semisbase(i) * (1.-sncovr_ice(i,j)) + 0.99 * sncovr_ice(i,j) else @@ -1265,6 +1287,11 @@ subroutine lsm_ruc_run & ! inputs semis_ice(i) = sfcems_ice(i,j) !-- sfalb_ice is with snow effect sfalb_ice(i) = alb_ice(i,j) + albdvis_ice(i) = sfalb_ice(i) + albdnir_ice(i) = sfalb_ice(i) + albinir_ice(i) = sfalb_ice(i) + albinir_ice(i) = sfalb_ice(i) + do k = 1, lsoil_ruc tsice(i,k) = stsice(i,k,j) diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index d82e40384..9ab17172e 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -558,6 +558,15 @@ kind = kind_phys intent = in optional = F +[coszen] + standard_name = instantaneous_cosine_of_zenith_angle + long_name = cosine of zenith angle at current time + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [land] standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction @@ -717,42 +726,6 @@ kind = kind_phys intent = in optional = F -[albdvis] - standard_name = surface_albedo_direct_visible - long_name = direct surface albedo visible band - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[albdnir] - standard_name = surface_albedo_direct_NIR - long_name = direct surface albedo NIR band - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[albivis] - standard_name = surface_albedo_diffuse_visible - long_name = diffuse surface albedo visible band - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[albinir] - standard_name = surface_albedo_diffuse_NIR - long_name = diffuse surface albedo NIR band - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F [isot] standard_name = soil_type_dataset_choice long_name = soil type dataset choice @@ -1246,6 +1219,42 @@ kind = kind_phys intent = inout optional = F +[albdvis_lnd] + standard_name = surface_albedo_direct_visible_over_land + long_name = direct surface albedo visible band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albdnir_lnd] + standard_name = surface_albedo_direct_NIR_over_land + long_name = direct surface albedo NIR band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albivis_lnd] + standard_name = surface_albedo_diffuse_visible_over_land + long_name = diffuse surface albedo visible band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albinir_lnd] + standard_name = surface_albedo_diffuse_NIR_over_land + long_name = diffuse surface albedo NIR band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F [sfcqc_ice] standard_name = cloud_condensed_water_mixing_ratio_at_surface_over_ice long_name = moist cloud water mixing ratio at surface over ice @@ -1372,6 +1381,42 @@ kind = kind_phys intent = inout optional = F +[albdvis_ice] + standard_name = surface_albedo_direct_visible_over_ice + long_name = direct surface albedo visible band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albdnir_ice] + standard_name = surface_albedo_direct_NIR_over_ice + long_name = direct surface albedo NIR band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albivis_ice] + standard_name = surface_albedo_diffuse_visible_over_ice + long_name = diffuse surface albedo visible band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albinir_ice] + standard_name = surface_albedo_diffuse_NIR_over_ice + long_name = diffuse surface albedo NIR band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F [rhosnf] standard_name = density_of_frozen_precipitation long_name = density of frozen precipitation diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta index 021394bbe..195276620 100644 --- a/physics/sfc_noahmp_drv.meta +++ b/physics/sfc_noahmp_drv.meta @@ -1010,8 +1010,8 @@ intent = inout optional = F [albdvis] - standard_name = surface_albedo_direct_visible - long_name = direct surface albedo visible band + standard_name = surface_albedo_direct_visible_over_land + long_name = direct surface albedo visible band over land units = frac dimensions = (horizontal_loop_extent) type = real @@ -1019,8 +1019,8 @@ intent = out optional = F [albdnir] - standard_name = surface_albedo_direct_NIR - long_name = direct surface albedo NIR band + standard_name = surface_albedo_direct_NIR_over_land + long_name = direct surface albedo NIR band over land units = frac dimensions = (horizontal_loop_extent) type = real @@ -1028,8 +1028,8 @@ intent = out optional = F [albivis] - standard_name = surface_albedo_diffuse_visible - long_name = diffuse surface albedo visible band + standard_name = surface_albedo_diffuse_visible_over_land + long_name = diffuse surface albedo visible band over land units = frac dimensions = (horizontal_loop_extent) type = real @@ -1037,8 +1037,8 @@ intent = out optional = F [albinir] - standard_name = surface_albedo_diffuse_NIR - long_name = diffuse surface albedo NIR band + standard_name = surface_albedo_diffuse_NIR_over_land + long_name = diffuse surface albedo NIR band over land units = frac dimensions = (horizontal_loop_extent) type = real From ed7db4dbdd50ba427e4fd0a090a74a500bf57fab Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Mon, 5 Apr 2021 21:03:59 +0000 Subject: [PATCH 04/74] Added initialization of 4 albedo components over land and ice to GFS_phys_time_vary_init. --- physics/GFS_phys_time_vary.fv3.F90 | 66 +++++--- physics/GFS_phys_time_vary.fv3.meta | 95 ++++++++--- physics/GFS_rrtmgp_sw_pre.F90 | 37 +++-- physics/GFS_rrtmgp_sw_pre.meta | 105 +++++++----- physics/radiation_surface.f | 241 +++++++++++----------------- physics/rrtmg_lw_pre.F90 | 18 ++- physics/rrtmg_lw_pre.meta | 26 ++- physics/rrtmg_sw_pre.F90 | 26 +-- physics/rrtmg_sw_pre.meta | 89 ++++++---- physics/rrtmgp_lw_pre.F90 | 12 +- physics/rrtmgp_lw_pre.meta | 26 ++- physics/sfc_drv_ruc.F90 | 91 ++++++++--- physics/sfc_drv_ruc.meta | 225 +++++++++++++++++++++++--- 13 files changed, 709 insertions(+), 348 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 94fc5e36b..7009b1eae 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -75,7 +75,8 @@ subroutine GFS_phys_time_vary_init ( isot, ivegsrc, nlunit, sncovr, sncovr_ice, lsm, lsm_noahmp, lsm_ruc, min_seaice, & fice, landfrac, vtype, weasd, lsoil, zs, dzs, lsnow_lsm_lbound, lsnow_lsm_ubound, & tvxy, tgxy, tahxy, canicexy, canliqxy, eahxy, cmxy, chxy, fwetxy, sneqvoxy, alboldxy,& - qsnowxy, wslakexy, albdvis, albdnir, albivis, albinir, emiss, taussxy, waxy, wtxy, & + qsnowxy, wslakexy, albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, albdvis_ice, & + albdnir_ice, albivis_ice, albinir_ice, emiss_lnd, emiss_ice, taussxy, waxy, wtxy, & zwtxy, xlaixy, xsaixy, lfmassxy, stmassxy, rtmassxy, woodxy, stblcpxy, fastcpxy, & smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, & slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, nthrds, errmsg, errflg) @@ -125,11 +126,16 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(inout) :: alboldxy(:) real(kind_phys), intent(inout) :: qsnowxy(:) real(kind_phys), intent(inout) :: wslakexy(:) - real(kind_phys), intent(inout) :: albdvis(:) - real(kind_phys), intent(inout) :: albdnir(:) - real(kind_phys), intent(inout) :: albivis(:) - real(kind_phys), intent(inout) :: albinir(:) - real(kind_phys), intent(inout) :: emiss(:) + real(kind_phys), intent(out) :: albdvis_lnd(:) + real(kind_phys), intent(out) :: albdnir_lnd(:) + real(kind_phys), intent(out) :: albivis_lnd(:) + real(kind_phys), intent(out) :: albinir_lnd(:) + real(kind_phys), intent(out) :: albdvis_ice(:) + real(kind_phys), intent(out) :: albdnir_ice(:) + real(kind_phys), intent(out) :: albivis_ice(:) + real(kind_phys), intent(out) :: albinir_ice(:) + real(kind_phys), intent(out) :: emiss_lnd(:) + real(kind_phys), intent(out) :: emiss_ice(:) real(kind_phys), intent(inout) :: taussxy(:) real(kind_phys), intent(inout) :: waxy(:) real(kind_phys), intent(inout) :: wtxy(:) @@ -363,11 +369,46 @@ subroutine GFS_phys_time_vary_init ( sncovr_ice(:) = sncovr(:) endif endif - !$OMP end sections !$OMP end parallel + + !--- For Noah MP or RUC LSMs: initialize four components of albedo for + !--- land and ice + if (lsm == lsm_noahmp .or. lsm == lsm_ruc) then + if (all(albdvis_lnd < zero)) then + if (me == master ) write(0,'(a)') 'GFS_phys_time_vary_init: initialize albedo for land and ice' + albdvis_lnd(:) = missing_value + albdnir_lnd(:) = missing_value + albivis_lnd(:) = missing_value + albinir_lnd(:) = missing_value + emiss_lnd(:) = missing_value + + do ix=1,im + albdvis_lnd(ix) = 0.2_kind_phys + albdnir_lnd(ix) = 0.2_kind_phys + albivis_lnd(ix) = 0.2_kind_phys + albinir_lnd(ix) = 0.2_kind_phys + emiss_lnd(ix) = 0.95_kind_phys + enddo + + albdvis_ice(:) = missing_value + albdnir_ice(:) = missing_value + albivis_ice(:) = missing_value + albinir_ice(:) = missing_value + emiss_ice(:) = missing_value + + do ix=1,im + albdvis_ice(ix) = 0.6_kind_phys + albdnir_ice(ix) = 0.6_kind_phys + albivis_ice(ix) = 0.6_kind_phys + albinir_ice(ix) = 0.6_kind_phys + emiss_ice(ix) = 0.97_kind_phys + enddo + endif + endif + if (lsm == lsm_noahmp) then if (all(tvxy < zero)) then @@ -389,11 +430,6 @@ subroutine GFS_phys_time_vary_init ( alboldxy(:) = missing_value qsnowxy(:) = missing_value wslakexy(:) = missing_value - albdvis(:) = missing_value - albdnir(:) = missing_value - albivis(:) = missing_value - albinir(:) = missing_value - emiss(:) = missing_value taussxy(:) = missing_value waxy(:) = missing_value wtxy(:) = missing_value @@ -447,12 +483,6 @@ subroutine GFS_phys_time_vary_init ( ! already set to 0.0 wslakexy(ix) = zero taussxy(ix) = zero - albdvis(ix) = 0.2_kind_phys - albdnir(ix) = 0.2_kind_phys - albivis(ix) = 0.2_kind_phys - albinir(ix) = 0.2_kind_phys - emiss(ix) = 0.95_kind_phys - waxy(ix) = 4900.0_kind_phys wtxy(ix) = waxy(ix) diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index 06192eb6a..b02766caa 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -755,50 +755,95 @@ kind = kind_phys intent = inout optional = F -[albdvis] - standard_name = surface_albedo_direct_visible - long_name = direct surface albedo visible band +[albdvis_lnd] + standard_name = surface_albedo_direct_visible_over_land + long_name = direct surface albedo visible band over land units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = out optional = F -[albdnir] - standard_name = surface_albedo_direct_NIR - long_name = direct surface albedo NIR band +[albdnir_lnd] + standard_name = surface_albedo_direct_NIR_over_land + long_name = direct surface albedo NIR band over land units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = out optional = F -[albivis] - standard_name = surface_albedo_diffuse_visible - long_name = diffuse surface albedo visible band +[albivis_lnd] + standard_name = surface_albedo_diffuse_visible_over_land + long_name = diffuse surface albedo visible band over land units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = out optional = F -[albinir] - standard_name = surface_albedo_diffuse_NIR - long_name = diffuse surface albedo NIR band +[albinir_lnd] + standard_name = surface_albedo_diffuse_NIR_over_land + long_name = diffuse surface albedo NIR band over land units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = out optional = F -[emiss] - standard_name = surface_emissivity_lsm - long_name = surface emissivity from lsm +[albdvis_ice] + standard_name = surface_albedo_direct_visible_over_ice + long_name = direct surface albedo visible band over ice units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = out + optional = F +[albdnir_ice] + standard_name = surface_albedo_direct_NIR_over_ice + long_name = direct surface albedo NIR band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albivis_ice] + standard_name = surface_albedo_diffuse_visible_over_ice + long_name = diffuse surface albedo visible band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albinir_ice] + standard_name = surface_albedo_diffuse_NIR_over_ice + long_name = diffuse surface albedo NIR band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[emiss_lnd] + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[emiss_ice] + standard_name = surface_longwave_emissivity_over_ice + long_name = surface lw emissivity in fraction over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out optional = F [snowxy] standard_name = number_of_snow_layers diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 93fc43dbb..cba742ad0 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -29,12 +29,12 @@ end subroutine GFS_rrtmgp_sw_pre_init !! subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp, lndp_var_list, & lndp_prt_list, lsm, lsm_noahmp, lsm_ruc, doSWrad, solhr, lon, coslat, sinlat, & - snowd, sncovr, sncovr_ice, snoalb, zorl, tsfg, tsfa, hprime, & - alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, albdvis, & - albdnir, albivis, albinir, lsmask, sfc_wts, p_lay, tv_lay, relhum, p_lev, & + snowd, sncovr, sncovr_ice, snoalb, zorl, tsfg, tsfa, hprime, landfrac, min_seaice, & + alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, albdvis_lnd, & + albdnir_lnd, albivis_lnd, albinir_lnd, albdvis_ice, albdnir_lnd, albivis_ice, & + albinir_ice, lsmask, sfc_wts, p_lay, tv_lay, relhum, p_lev, & nday, idxday, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, & - sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, alb_ice, alb_sno_ice, & - sfalb_lnd_bck, errmsg, errflg) + sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -54,6 +54,8 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp, lndp_var doSWrad ! Call RRTMGP SW radiation? real(kind_phys), intent(in) :: & solhr ! Time in hours after 00z at the current timestep + real(kind_phys), intent(in) :: & + min_seaice ! Sea ice threashold real(kind_phys), dimension(nCol), intent(in) :: & lsmask, & ! Landmask: sea/land/ice=0/1/2 lon, & ! Longitude @@ -67,6 +69,7 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp, lndp_var tsfg, & ! Surface ground temperature for radiation (K) tsfa, & ! Lowest model layer air temperature for radiation (K) hprime, & ! Standard deviation of subgrid orography (m) + landfrac, & ! Fraction of land in the grid cell (frac) alvsf, & ! Mean vis albedo with strong cosz dependency (frac) alnsf, & ! Mean nir albedo with strong cosz dependency (frac) alvwf, & ! Mean vis albedo with weak cosz dependency (frac) @@ -76,10 +79,14 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp, lndp_var fice, & ! Ice fraction over open water (frac) tisfc ! Sea ice surface skin temperature (K) real(kind_phys), dimension(:), intent(in) :: & - albdvis, & ! surface albedo from lsm (direct,vis) (frac) - albdnir, & ! surface albedo from lsm (direct,nir) (frac) - albivis, & ! surface albedo from lsm (diffuse,vis) (frac) - albinir ! surface albedo from lsm (diffuse,nir) (frac) + albdvis_lnd, & ! surface albedo from lsm (direct,vis) (frac) + albdnir_lnd, & ! surface albedo from lsm (direct,nir) (frac) + albivis_lnd, & ! surface albedo from lsm (diffuse,vis) (frac) + albinir_lnd, & ! surface albedo from lsm (diffuse,nir) (frac) + albdvis_ice, & ! surface albedo from ice model (direct,vis) (frac) + albdnir_ice, & ! surface albedo from ice model (direct,nir) (frac) + albivis_ice, & ! surface albedo from ice model (diffuse,vis) (frac) + albinir_ice ! surface albedo from ice model (diffuse,nir) (frac) real(kind_phys), dimension(nCol,n_var_lndp), intent(in) :: & sfc_wts ! Weights for stochastic surface physics perturbation () @@ -89,10 +96,6 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp, lndp_var relhum ! Layer relative-humidity real(kind_phys), dimension(nCol,nLev+1),intent(in) :: & p_lev ! Pressure @ layer interfaces (Pa) - real(kind_phys), dimension(ncol), intent(inout) :: & - alb_ice, & ! Albedo of snow-free ice - alb_sno_ice, & ! Albedo of snow cover on ice - sfalb_lnd_bck ! Albedo of snow-free land ! Outputs integer, intent(out) :: & @@ -148,9 +151,11 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp, lndp_var alb1d(:) = 0. lndp_alb = -999. call setalb (lsmask, lsm, lsm_noahmp, lsm_ruc, snowd, sncovr, sncovr_ice, snoalb, zorl, & - coszen, tsfg, tsfa, hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, & - tisfc, albdvis, albdnir, albivis, albinir, NCOL, alb1d, lndp_alb, & ! mg, sfc-perts - sfcalb, alb_ice, alb_sno_ice, sfalb_lnd_bck ) ! --- outputs + coszen, tsfg, tsfa, hprime, landfrac, min_seaice, & + alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & + albdvis_lnd, albdnir_ldn, albivis_lnd, albinir_lnd, & + albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, NCOL, alb1d, lndp_alb, & ! mg, sfc-perts + sfcalb ) ! --- outputs ! Approximate mean surface albedo from vis- and nir- diffuse values. sfc_alb_dif(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 63368dba8..da96fbf80 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -214,6 +214,24 @@ kind = kind_phys intent = in optional = F +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[min_seaice] + standard_name = sea_ice_minimum + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [alvsf] standard_name = mean_vis_albedo_with_strong_cosz_dependency long_name = mean vis albedo with strong cosz dependency @@ -286,36 +304,72 @@ kind = kind_phys intent = in optional = F -[albdvis] - standard_name = surface_albedo_direct_visible - long_name = direct surface albedo visible band +[albdvis_lnd] + standard_name = surface_albedo_direct_visible_over_land + long_name = direct surface albedo visible band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albdnir_lnd] + standard_name = surface_albedo_direct_NIR_over_land + long_name = direct surface albedo NIR band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albivis_lnd] + standard_name = surface_albedo_diffuse_visible_over_land + long_name = diffuse surface albedo visible band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albinir_lnd] + standard_name = surface_albedo_diffuse_NIR_over_land + long_name = diffuse surface albedo NIR band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albdvis_ice] + standard_name = surface_albedo_direct_visible_over_ice + long_name = direct surface albedo visible band over ice units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F -[albdnir] - standard_name = surface_albedo_direct_NIR - long_name = direct surface albedo NIR band +[albdnir_ice] + standard_name = surface_albedo_direct_NIR_over_ice + long_name = direct surface albedo NIR band over ice units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F -[albivis] - standard_name = surface_albedo_diffuse_visible - long_name = diffuse surface albedo visible band +[albivis_ice] + standard_name = surface_albedo_diffuse_visible_over_ice + long_name = diffuse surface albedo visible band over ice units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F -[albinir] - standard_name = surface_albedo_diffuse_NIR - long_name = diffuse surface albedo NIR band +[albinir_ice] + standard_name = surface_albedo_diffuse_NIR_over_ice + long_name = diffuse surface albedo NIR band over ice units = frac dimensions = (horizontal_loop_extent) type = real @@ -446,33 +500,6 @@ kind = kind_phys intent = inout optional = F -[alb_ice] - standard_name =surface_snow_free_albedo_over_ice - long_name = surface snow-free albedo over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F -[alb_sno_ice] - standard_name =surface_snow_albedo_over_ice - long_name = surface snow albedo over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F -[sfalb_lnd_bck] - standard_name =surface_snow_free_albedo_over_land - long_name = surface snow-free albedo over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 44d98b098..64d7b3914 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -331,12 +331,12 @@ end subroutine sfc_init !----------------------------------- subroutine setalb & & ( slmsk,lsm,lsm_noahmp,lsm_ruc,snowf,sncovr,sncovr_ice, & - & snoalb,zorlf,coszf,tsknf,tairf,hprif,landfrac, & ! --- inputs: + & snoalb,zorlf,coszf,tsknf,tairf,hprif,landfrac,min_seaice, & ! --- inputs: & alvsf,alnsf,alvwf,alnwf,facsf,facwf,fice,tisfc, & & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, & & icealbdvis, icealbdnir, icealbivis, icealbinir, & & IMAX, albPpert, pertalb, & ! sfc-perts, mgehne - & sfcalb, alb_ice, alb_sno_ice, sfalb_lnd_bck & ! --- outputs: + & sfcalb & ! --- outputs: & ) ! =================================================================== ! @@ -409,29 +409,29 @@ subroutine setalb & & alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, & & icealbdvis, icealbdnir, icealbivis, icealbinir, & - & sncovr, sncovr_ice, snoalb, albPpert ! sfc-perts, mgehne - real (kind=kind_phys), intent(in) :: pertalb ! sfc-perts, mgehne + & sncovr, sncovr_ice, snoalb, albPpert ! sfc-perts, mgehne + real (kind=kind_phys), intent(in) :: pertalb ! sfc-perts, mgehne + real (kind=kind_phys), intent(in) :: min_seaice ! --- outputs - real (kind=kind_phys), dimension(:), intent(inout) :: alb_ice, & - & alb_sno_ice, & - & sfalb_lnd_bck real (kind=kind_phys), dimension(IMAX,NF_ALBD), intent(out) :: & & sfcalb -! real (kind=kind_phys), dimension(:,:), intent(out) :: sfcalb ! --- locals: real (kind=kind_phys) :: asnvb, asnnb, asnvd, asnnd, asevb & &, asenb, asevd, asend, fsno, fsea, rfcs, rfcw, flnd & &, asnow, argh, hrgh, fsno0, fsno1, flnd0, fsea0, csnow & &, a1, a2, b1, b2, b3, ab1bm, ab2bm, m, s, alpha, beta, albtmp + real (kind=kind_phys) :: asevb_wat,asenb_wat,asevd_wat,asend_wat, & - asevb_ice,asenb_ice,asevd_ice,asend_ice + & asevb_ice,asenb_ice,asevd_ice,asend_ice real (kind=kind_phys) ffw, dtgd + real (kind=kind_phys) :: fracl, fraco, fraci integer :: i, k, kk, iflag + logical, dimension(imax) :: icy ! !===> ... begin here ! @@ -469,11 +469,6 @@ subroutine setalb & asevd = 0.7 - 4.0*a1 asend = 0.65 - 3.6875*a1 endif - if(lsm == lsm_ruc) then - !-- output alb_ice for use in LSMs (diffused albedo adjusted - ! for T around freezing) - alb_ice(i) = max(0.6, 0.5 * (asend + asevd)) - endif !> - Calculate diffused snow albedo. @@ -506,11 +501,6 @@ subroutine setalb & asnvb = asnvd asnnb = asnnd endif - if(lsm == lsm_ruc) then - !-- alb_sno_ice (diffused and direct) for use in LSMs - alb_sno_ice(i) = min(0.98, 0.5 * (0.65 + b1 - & + 0.5 * (asnvb+asnnb))) - endif !> - Calculate direct sea surface albedo. @@ -544,11 +534,6 @@ subroutine setalb & sfcalb(i,2) = (a2 + b2) * 0.96 *flnd + asend*fsea + asnnd*fsno sfcalb(i,3) = min(0.99, ab1bm) *flnd + asevb*fsea + asnvb*fsno sfcalb(i,4) = (a1 + b1) * 0.96 *flnd + asevd*fsea + asnvd*fsno - if(lsm == lsm_ruc) then - !-- alb_lnd (diffused and direct) for snow-free areas for use - !in LSMs - sfalb_lnd_bck(i) = 0.25*(ab1bm + alnwf(i) + ab2bm + alvwf(i)) - endif enddo ! end_do_i_loop @@ -596,11 +581,6 @@ subroutine setalb & asevd = 0.7 - 4.0*a1 asend = 0.65 - 3.6875*a1 endif - if(lsm == lsm_ruc) then - !-- output alb_ice for use in RUC LSM (diffused albedo adjusted - ! for T around freezing) - alb_ice(i) = max(0.6, 0.5 * (asend + asevd)) - endif !> - Calculate diffused snow albedo, land area use input max snow !! albedo. @@ -635,11 +615,6 @@ subroutine setalb & asnvb = asnvd asnnb = asnnd endif - if(lsm == lsm_ruc) then - !-- alb_sno_ice (diffused and direct) for use in LSMs - alb_sno_ice(i) = min(0.98, 0.5 * (0.65 + b1 - & + 0.5 * (asnvb+asnnb))) - endif else asnvb = snoalb(i) asnnb = snoalb(i) @@ -680,11 +655,6 @@ subroutine setalb & sfcalb(i,3) = ab2bm *flnd + asevb*fsea + asnvb*fsno sfcalb(i,4) = alvwf(i)*flnd + asevd*fsea + asnvd*fsno - if(lsm == lsm_ruc) then - !-- alb_lnd (diffused and direct) for snow-free areas for use in LSMs - sfalb_lnd_bck(i) = 0.25*(ab1bm + alnwf(i) + ab2bm + alvwf(i)) - endif - enddo ! end_do_i_loop !> -# use land model output for land area: Noah MP, RUC (land and ice). @@ -693,33 +663,38 @@ subroutine setalb & fracl = landfrac(i) fraco = max(f_zero, f_one - fracl) - fraci = fraco * fice(i) - ffw = max(f_zero, f_one - fraci) + if(fice(i) < min_seaice) then + fraci = 0. + else + fraci = fraco * fice(i) + endif fraco = max(f_zero, fraco-fraci) - if ( fraco > f_zero ) then - !-- open water fraction - asevd_wat = 0.06 - asend_wat = 0.06 - - ! direct albedo CZA dependence - if (coszf(i) > 0.0001) then - if (tsknf(i) >= con_t0c) then - asevb_wat = max (asevd_wat, 0.026/(coszf(i)**1.7+0.065) & - & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & - & * (coszf(i)-f_one)) - asenb_wat = asevb_wat - endif - else - asevb_wat = asevd_wat - asenb_wat = asevd_wat + icy(i) = .false. + if (fraci > f_zero) icy(i) = .true. + + !-- water albedo + asevd_wat = 0.06 + asend_wat = 0.06 + asevb_wat = asevd_wat + asenb_wat = asevd_wat + + ! direct albedo CZA dependence over water + if (fraco > f_zero .and. coszf(i) > 0.0001) then + if (tsknf(i) >= con_t0c) then + asevb_wat = max (asevd_wat, 0.026/(coszf(i)**1.7 + 0.065) & + & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & + & * (coszf(i)-f_one)) + asenb_wat = asevb_wat endif + endif - elseif (fraci > min_seaice) then ! full or fractional ice - !-- tgs: this part of the code needs the input from the ice - ! model. Otherwise it uses the backup albedo computation - ! from ialbflg = 1. - if(lsm == lsm_ruc) then + !-- ice albedo + !tgs: this part of the code needs the input from the ice + ! model. Otherwise it uses the backup albedo computation + ! from ialbflg = 1. + if (icy(i)) then + if(lsm == lsm_ruc ) then !-- use ice albedo from the RUC ice model asevd_ice = icealbivis(i) asend_ice = icealbinir(i) @@ -744,7 +719,7 @@ subroutine setalb & asevb_ice = asevd_ice asenb_ice = asend_ice - if (fsno0 > epsln) then ! fractional snow + if (fsno0 > f_zero) then ! Snow on ice dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) )) b1 = 0.03 * dtgd @@ -760,18 +735,25 @@ subroutine setalb & asnnb = asnnd endif - ! composite ice albedo and snow albedos + ! composite ice albedo and snow albedos asevd_ice = asevd_ice * (1. - fsno0) + asnvd * fsno0 asend_ice = asend_ice * (1. - fsno0) + asnnd * fsno0 asevb_ice = asevb_ice * (1. - fsno0) + asnvb * fsno0 asenb_ice = asenb_ice * (1. - fsno0) + asnnb * fsno0 endif ! snow - endif ! ice model + endif ! lsm + else + ! icy = false + asevd_ice = 0.70 + asend_ice = 0.65 + asevb_ice = 0.70 + asenb_ice = 0.65 + endif ! icy - endif ! water or ice - !-- Composite mean surface albedo from land, open water and !-- ice fractions + print*,'i,asenb_wat,asenb_ice',i,asenb_wat,asenb_ice + print*,'lsmalbdnir(i)=',i,lsmalbdnir(i) sfcalb(i,1) = min(0.99,max(0.01,lsmalbdnir(i)))*fracl & & + asenb_wat*fraco + asenb_ice*fraci sfcalb(i,2) = min(0.99,max(0.01,lsmalbinir(i)))*fracl & @@ -801,17 +783,6 @@ subroutine setalb & call ppfbet(albPpert(i),alpha,beta,iflag,albtmp) sfcalb(i,kk) = albtmp enddo - if(lsm == lsm_ruc) then - ! perturb mean surface albedo - m = sfalb_lnd_bck(i) - s = pertalb*m*(1.-m) - alpha = m*m*(1.-m)/(s*s)-m - beta = alpha*(1.-m)/m - ! compute beta distribution value corresponding - ! to the given percentile albPpert to use as new albedo - call ppfbet(albPpert(i),alpha,beta,iflag,albtmp) - sfalb_lnd_bck(i) = albtmp - endif enddo ! end_do_i_loop endif @@ -844,7 +815,7 @@ end subroutine setalb !! @{ !----------------------------------- subroutine setemis & - & ( kdt,lsm,lsm_noahmp,lsm_ruc,vtype, & ! --- inputs: + & ( kdt,lsm,lsm_noahmp,lsm_ruc,vtype,landfrac,min_seaice, & ! --- inputs: & xlon,xlat,slmsk,snowf,sncovr,sncovr_ice,fice, & & zorlf,tsknf,tairf,hprif, & & semis_lnd,semis_ice,IMAX, & @@ -903,6 +874,8 @@ subroutine setemis & integer, intent(in) :: IMAX integer, intent(in) :: kdt, lsm, lsm_noahmp, lsm_ruc real (kind=kind_phys), dimension(:), intent(in) :: vtype + real (kind=kind_phys), dimension(:), intent(in) :: landfrac + real (kind=kind_phys), intent(in) :: min_seaice real (kind=kind_phys), dimension(:), intent(in) :: & & xlon,xlat, slmsk, snowf,sncovr, sncovr_ice, fice, & @@ -920,6 +893,7 @@ subroutine setemis & & asnow, argh, hrgh, fsno, fsno0, fracl, fraco, fraci real (kind=kind_phys) :: sfcemis_land, sfcemis_ice + logical, dimension(imax) :: icy ! --- reference emiss value for diff surface emiss index ! 1-open water, 2-grass/shrub land, 3-bare soil, tundra, @@ -950,9 +924,16 @@ subroutine setemis & fracl = landfrac(i) fraco = max(f_zero, f_one - fracl) - fraci = fraco * fice(i) + if(fice(i) < min_seaice) then + fraci = 0. + else + fraci = fraco * fice(i) + endif fraco = max(f_zero, fraco-fraci) + icy(i) = .false. + if (fice(i) > min_seaice) icy(i) = .true. + if (fracl < epsln) then ! no land if ( abs(fraco-f_one) < epsln ) then ! open water point sfcemis(i) = emsref(1) @@ -1034,82 +1015,48 @@ subroutine setemis & elseif ( iemslw == 2 ) then ! sfc emiss updated in land model: Noah MP or RUC - do i = 1, IMAX + do i = 1, IMAX fracl = landfrac(i) fraco = max(f_zero, f_one - fracl) - fraci = fraco * fice(i) - fraco = max(f_zero, fraco-fraci) + if(fice(i) < min_seaice) then + fraci = 0. + else + fraci = fraco * fice(i) + endif - if (fracl < epsln) then ! no land - if ( abs(fraco-f_one) < epsln ) then - !-- open water point - sfcemis(i) = emsref(1) - elseif (fraci > epsln) then - !-- full or fractional ice - if (lsm == lsm_noahmp) then - !-- ice emissivity from the table - sfcemis_ice = emsref(7) - if ( snowf(i) > f_zero ) then - asnow = 0.02*snowf(i) - argh = min(0.50, max(.025,0.01*zorlf(i))) - hrgh = min(f_one,max(0.20,1.0577-1.1538e-3*hprif(i))) - fsno0 = asnow / (argh + asnow) * hrgh - sfcemis(i) = sfcemis_ice*(f_one-fsno0)+emsref(8)*fsno0 - endif - elseif (lsm == lsm_ruc) then - !-- ruc lsm has a sea-ice component - if (kdt == 1 ) then - sfcemis_ice = emsref(7) * (1.-sncovr_ice(i)) - & + emsref(8) * sncovr_ice(i) - else - sfcemis_ice = semis_ice(i) ! emissivity for ice with snow effect - endif - sfcemis(i) = sfcemis_ice - endif ! lsm check + fraco = max(f_zero, fraco-fraci) - if ( abs(fraci-f_one) > epsln ) then - !-- fractional sea ice - sfcemis(i) = fraco*emsref(1) + fraci*sfcemis(i) + icy(i) = .false. + if (fice(i) > min_seaice) icy(i) = .true. + + !-- ice albedo + sfcemis_ice = emsref(7) + + if ( icy(i) ) then + !-- complete or fractional ice + if (lsm == lsm_noahmp) then + if ( snowf(i) > f_zero ) then + asnow = 0.02*snowf(i) + argh = min(0.50, max(.025,0.01*zorlf(i))) + hrgh = min(f_one,max(0.20,1.0577-1.1538e-3*hprif(i))) + fsno0 = asnow / (argh + asnow) * hrgh + sfcemis_ice = sfcemis_ice*(f_one-fsno0)+emsref(8)*fsno0 endif + elseif (lsm == lsm_ruc) then + sfcemis_ice = semis_ice(i) ! output from lsm (with snow effect) + endif ! lsm check + endif ! icy - else ! land or fractional grid - - if (lsm == lsm_noahmp .or. lsm == lsm_ruc) then - !-- Noah MP or RUC LSM - if (lsm == lsm_noahmp) then - sfcemis_land = semis_lnd(i)! with snow effect - sfcemi_ice = emsref(7) - else - ! ruc lsm - if (kdt == 1 ) then - ivgtyp = int( vtype(i)+0.5 ) - semisbase(i) = lemitbl(ivgtyp) - sfcemis_land = semisbase(i)*(1.-sncovr(i)) - & + emsref(8)*sncovr(i) - sfcemis_ice = emsref(8)*(1.-sncovr_ice(i)) - & + emsref(8)*sncovr_ice(i) - else - sfcemis_land = semis_lnd(i) ! with snow effect - sfcemis_ice = semis_ice(i) ! with snow effect - endif ! ruc - - if (abs(fracl-f_one) < epsln) then - !-- land only - sfcemis(i) = sfcemis_land ! with snow effect - else - !-- land is a fraction - sfcemis(i) = fracl*sfcemis_land + fraco*emsref(1) & - & + fraci*sfcemis_ice - endif - endif - else - write(0,'(*(a))')'This LSM is not supported with iemslw=2' - endif + !-- land emissivity + !-- from Noah MP or RUC lsms + sfcemis_land = semis_lnd(i) ! albedo with snow effect from LSM - endif ! fractional land + !-- Composite emissivity from land, water and ice fractions. + sfcemis(i) = fracl*sfcemis_land + fraco*emsref(1) & + & + fraci*sfcemis_ice - enddo + enddo ! i endif ! end if_iemslw_block diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index 94820a33b..3025feb3f 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -12,8 +12,9 @@ end subroutine rrtmg_lw_pre_init !> \section arg_table_rrtmg_lw_pre_run Argument Table !! \htmlinclude rrtmg_lw_pre_run.html !! - subroutine rrtmg_lw_pre_run (im, lslwr, kdt, lsm, lsm_noahmp, lsm_ruc, vtype, & - xlat, xlon, slmsk, snowd, sncovr, sncovr_ice, fice, zorl, hprime, tsfg, tsfa, & + subroutine rrtmg_lw_pre_run (im, lslwr, kdt, lsm, lsm_noahmp, lsm_ruc, vtype, & + xlat, xlon, slmsk, snowd, sncovr, sncovr_ice, fice, zorl, hprime, & + landfrac, min_seaice, tsfg, tsfa, & semis_lnd, semis_ice, semisbase, semis, errmsg, errflg) use machine, only: kind_phys @@ -26,7 +27,8 @@ subroutine rrtmg_lw_pre_run (im, lslwr, kdt, lsm, lsm_noahmp, lsm_ruc, vtype, integer, intent(in) :: kdt, lsm, lsm_noahmp, lsm_ruc real(kind=kind_phys), dimension(im), intent(in) :: xlat, xlon, vtype, slmsk,& - snowd, sncovr, sncovr_ice, fice, zorl, hprime, tsfg, tsfa + snowd, sncovr, sncovr_ice, fice, zorl, hprime, landfrac, tsfg, tsfa + real(kind=kind_phys), intent(in) :: min_seaice real(kind=kind_phys), dimension(:), intent(in) :: semis_lnd real(kind=kind_phys), dimension(:), intent(in) :: semis_ice real(kind=kind_phys), dimension(im), intent(out) :: semisbase @@ -41,11 +43,11 @@ subroutine rrtmg_lw_pre_run (im, lslwr, kdt, lsm, lsm_noahmp, lsm_ruc, vtype, if (lslwr) then !> - Call module_radiation_surface::setemis(),to setup surface !! emissivity for LW radiation. - call setemis (kdt, lsm, lsm_noahmp, lsm_ruc, vtype, xlon, xlat, slmsk, & - snowd, sncovr, sncovr_ice, fice, zorl, tsfg, tsfa, & - hprime, semis_lnd, semis_ice, im, & ! --- inputs - semisbase, semis) ! --- outputs - + call setemis (kdt, lsm, lsm_noahmp, lsm_ruc, vtype, landfrac, & + min_seaice, xlon, xlat, slmsk, & + snowd, sncovr, sncovr_ice, fice, zorl, tsfg, tsfa, & + hprime, semis_lnd, semis_ice, im, & ! --- inputs + semisbase, semis) ! --- outputs endif end subroutine rrtmg_lw_pre_run diff --git a/physics/rrtmg_lw_pre.meta b/physics/rrtmg_lw_pre.meta index 9c0972638..f75e40793 100644 --- a/physics/rrtmg_lw_pre.meta +++ b/physics/rrtmg_lw_pre.meta @@ -82,10 +82,10 @@ kind = kind_phys intent = in optional = F -[landfrac] - standard_name = land_area_fraction - long_name = fraction of horizontal grid area occupied by land - units = frac +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -145,6 +145,24 @@ kind = kind_phys intent = in optional = F +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[min_seaice] + standard_name = sea_ice_minimum + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [tsfg] standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index 634f59d70..28b37c7ad 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -14,8 +14,9 @@ end subroutine rrtmg_sw_pre_init !! subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, lndp_prt_list, tsfg, tsfa, coszen, & lsm, lsm_noahmp, lsm_ruc, alb1d, slmsk, snowd, sncovr, sncovr_ice, snoalb, zorl, & - hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & - albdvis, albdnir, albivis, albinir, sfalb, alb_ice, alb_sno_ice, sfalb_lnd_bck, & + hprime, landfrac, min_seaice, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc,& + albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & + albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, sfalb, & nday, idxday, sfcalb1, sfcalb2, sfcalb3, sfcalb4, errmsg, errflg) use machine, only: kind_phys @@ -30,7 +31,7 @@ subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, ln logical, intent(in) :: lsswr real(kind=kind_phys), dimension(:), intent(in) :: lndp_prt_list real(kind=kind_phys), dimension(im), intent(in) :: tsfg, tsfa, coszen - real(kind=kind_phys), dimension(im), intent(in) :: alb1d + real(kind=kind_phys), dimension(im), intent(in) :: alb1d, landfrac real(kind=kind_phys), dimension(im), intent(in) :: slmsk, snowd, & sncovr, snoalb, & zorl, hprime, & @@ -39,12 +40,13 @@ subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, ln facsf, facwf, & sncovr_ice, & fice, tisfc - real(kind=kind_phys), dimension(:), intent(in) :: albdvis, albdnir, & - albivis, albinir + real(kind=kind_phys), dimension(:), intent(in) :: albdvis_lnd, albdnir_lnd, & + albivis_lnd, albinir_lnd + real(kind=kind_phys), dimension(:), intent(in) :: albdvis_ice, albdnir_ice, & + albivis_ice, albinir_ice + real(kind=kind_phys), intent(in) :: min_seaice + real(kind=kind_phys), dimension(im), intent(inout) :: sfalb - real(kind=kind_phys), dimension(im), intent(inout) :: alb_ice, & - alb_sno_ice, & - sfalb_lnd_bck integer, intent(out) :: nday integer, dimension(im), intent(out) :: idxday real(kind=kind_phys), dimension(im), intent(out) :: sfcalb1, sfcalb2, & @@ -90,10 +92,12 @@ subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, ln !! for SW radiation. call setalb (slmsk, lsm, lsm_noahmp, lsm_ruc, snowd, sncovr, sncovr_ice, snoalb, & - zorl, coszen, tsfg, tsfa, hprime, alvsf, alnsf, alvwf, alnwf, & - facsf, facwf, fice, tisfc, albdvis, albdnir, albivis, albinir, & + zorl, coszen, tsfg, tsfa, hprime, landfrac, min_seaice, & + alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & + albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & + albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & IM, alb1d, lndp_alb, & ! mg, sfc-perts - sfcalb, alb_ice, alb_sno_ice, sfalb_lnd_bck ) ! --- outputs + sfcalb ) ! --- outputs !> -# Approximate mean surface albedo from vis- and nir- diffuse values. diff --git a/physics/rrtmg_sw_pre.meta b/physics/rrtmg_sw_pre.meta index 244490ef1..d8a5addb2 100644 --- a/physics/rrtmg_sw_pre.meta +++ b/physics/rrtmg_sw_pre.meta @@ -180,6 +180,24 @@ kind = kind_phys intent = in optional = F +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[min_seaice] + standard_name = sea_ice_minimum + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [alvsf] standard_name = mean_vis_albedo_with_strong_cosz_dependency long_name = mean vis albedo with strong cosz dependency @@ -252,72 +270,81 @@ kind = kind_phys intent = in optional = F -[albdvis] - standard_name = surface_albedo_direct_visible - long_name = direct surface albedo visible band +[albdvis_lnd] + standard_name = surface_albedo_direct_visible_over_land + long_name = direct surface albedo visible band over land units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = out optional = F -[albdnir] - standard_name = surface_albedo_direct_NIR - long_name = direct surface albedo NIR band +[albdnir_lnd] + standard_name = surface_albedo_direct_NIR_over_land + long_name = direct surface albedo NIR band over land units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = out optional = F -[albivis] - standard_name = surface_albedo_diffuse_visible - long_name = diffuse surface albedo visible band +[albivis_lnd] + standard_name = surface_albedo_diffuse_visible_over_land + long_name = diffuse surface albedo visible band over land units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = out optional = F -[albinir] - standard_name = surface_albedo_diffuse_NIR - long_name = diffuse surface albedo NIR band +[albinir_lnd] + standard_name = surface_albedo_diffuse_NIR_over_land + long_name = diffuse surface albedo NIR band over land units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = out optional = F -[sfalb] - standard_name = surface_diffused_shortwave_albedo - long_name = mean surface diffused sw albedo +[albdvis_ice] + standard_name = surface_albedo_direct_visible_over_ice + long_name = direct surface albedo visible band over ice units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = out optional = F -[alb_ice] - standard_name =surface_snow_free_albedo_over_ice - long_name = surface snow-free albedo over ice +[albdnir_ice] + standard_name = surface_albedo_direct_NIR_over_ice + long_name = direct surface albedo NIR band over ice units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = out optional = F -[alb_sno_ice] - standard_name =surface_snow_albedo_over_ice - long_name = surface snow albedo over ice +[albivis_ice] + standard_name = surface_albedo_diffuse_visible_over_ice + long_name = diffuse surface albedo visible band over ice units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = out optional = F -[sfalb_lnd_bck] - standard_name =surface_snow_free_albedo_over_land - long_name = surface snow-free albedo over ice +[albinir_ice] + standard_name = surface_albedo_diffuse_NIR_over_ice + long_name = diffuse surface albedo NIR band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[sfalb] + standard_name = surface_diffused_shortwave_albedo + long_name = mean surface diffused sw albedo units = frac dimensions = (horizontal_loop_extent) type = real diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index 6353f5aba..6da7f77df 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -27,7 +27,8 @@ end subroutine rrtmgp_lw_pre_init !! subroutine rrtmgp_lw_pre_run ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, doLWrad, & nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, sncovr_ice, fice, & - tsfg, tsfa, hprime, sfc_emiss_byband, semis_land, semis_ice, & + tsfg, tsfa, hprime, landfrac, min_seaice, & + sfc_emiss_byband, semis_land, semis_ice, & semisbase, semis, errmsg, errflg) ! Inputs @@ -41,6 +42,7 @@ subroutine rrtmgp_lw_pre_run ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, doLWrad, & vtype, & ! vegetation type xlon, & ! Longitude xlat, & ! Latitude + slmsk, & ! Surface mask: 0-water, 1-land, 2-ice landfrac, & ! Land fraction zorl, & ! Surface roughness length (cm) snowd, & ! water equivalent snow depth (mm) @@ -62,7 +64,7 @@ subroutine rrtmgp_lw_pre_run ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, doLWrad, & errmsg ! Error message integer, intent(out) :: & errflg ! Error flag - real(kind_phys), dimension(nCol), intent(out) :: & + real(kind_phys), dimension(nCol), intent(inout) :: & semisbase, semis ! Local variables @@ -77,9 +79,9 @@ subroutine rrtmgp_lw_pre_run ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, doLWrad, & ! ####################################################################################### ! Call module_radiation_surface::setemis(),to setup surface emissivity for LW radiation. ! ####################################################################################### - call setemis ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, xlon, xlat, slmsk, & - snowd, sncovr, sncovr_ice, fice, zorl, tsfg, tsfa, hprime, & - semis_land, semis_ice, nCol, & ! --- inputs + call setemis ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, landfrac, min_seaice, & + xlon, xlat, slmsk, snowd, sncovr, sncovr_ice, fice, zorl, & + tsfg, tsfa, hprime, semis_land, semis_ice, nCol, & ! --- inputs semisbase, semis) ! --- outputs diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index 2a7b1e4f2..bc11229cc 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -82,10 +82,10 @@ kind = kind_phys intent = in optional = F -[landfrac] - standard_name = land_area_fraction - long_name = fraction of horizontal grid area occupied by land - units = frac +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -163,6 +163,24 @@ kind = kind_phys intent = in optional = F +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[min_seaice] + standard_name = sea_ice_minimum + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [semis_land] standard_name = surface_longwave_emissivity_over_land long_name = surface lw emissivity in fraction over land diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 72afe961c..f5a5e9c4f 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -17,9 +17,11 @@ module lsm_ruc public :: lsm_ruc_init, lsm_ruc_run, lsm_ruc_finalize real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0, epsln = 1.0d-10 - real(kind=kind_phys), dimension (2), parameter :: d = (/0.1,0.25/) + real(kind=kind_phys), dimension (2), parameter, private :: d = (/0.1,0.25/) + integer, dimension(20), parameter, private:: & + istwe = (/1,1,1,1,1,2,2,1,1,2,2,2,2,2,1,2,2,1,2,2/) ! IGBP 20 classes + - integer, parameter :: istwe = (/5*1,2,2,1,1,5*2,1,2,2,1,2,2/) ! for 20 IGBP classes contains @@ -28,13 +30,19 @@ module lsm_ruc !! \section arg_table_lsm_ruc_init Argument Table !! \htmlinclude lsm_ruc_init.html !! - subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & - flag_restart, flag_init, & - im, lsoil_ruc, lsoil, kice, nlev, & ! in - lsm_ruc, lsm, slmsk, stype, vtype, & ! in - tsfc_lnd, tsfc_wat, & ! in - tg3, smc, slc, stc, & ! in - zs, sh2o, smfrkeep, tslb, smois, wetness, & ! out + subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & + flag_restart, flag_init, & + im, lsoil_ruc, lsoil, kice, nlev, & ! in + lsm_ruc, lsm, slmsk, stype, vtype, & ! in + tsfc_lnd, tsfc_wat, & ! in + tg3, smc, slc, stc, fice, min_seaice, & ! in + sncovr_lnd, sncovr_ice, snoalb, & ! in + facsf, facwf, alvsf, alvwf, alnsf, alnwf, & ! in + sfalb_lnd_bck, & ! out + albdvis_lnd,albdnir_lnd,albivis_lnd,albinir_lnd, & ! out + albdvis_ice,albdnir_ice,albivis_ice,albinir_ice, & ! out + semisbase, semis_lnd, semis_ice, & ! out + zs, sh2o, smfrkeep, tslb, smois, wetness, & ! out tsice, pores, resid, errmsg, errflg) implicit none @@ -56,18 +64,36 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & real (kind=kind_phys), dimension(im), intent(in) :: tsfc_lnd real (kind=kind_phys), dimension(im), intent(in) :: tsfc_wat real (kind=kind_phys), dimension(im), intent(in) :: tg3 + real (kind=kind_phys), dimension(im), intent(in) :: sncovr_lnd + real (kind=kind_phys), dimension(im), intent(in) :: sncovr_ice + real (kind=kind_phys), dimension(im), intent(in) :: snoalb + real (kind=kind_phys), dimension(im), intent(in) :: fice + real (kind=kind_phys), dimension(im), intent(in) :: facsf + real (kind=kind_phys), dimension(im), intent(in) :: facwf + real (kind=kind_phys), dimension(im), intent(in) :: alvsf + real (kind=kind_phys), dimension(im), intent(in) :: alvwf + real (kind=kind_phys), dimension(im), intent(in) :: alnsf + real (kind=kind_phys), dimension(im), intent(in) :: alnwf real (kind=kind_phys), dimension(im,lsoil), intent(in) :: smc,slc,stc - + real (kind=kind_phys), intent(in) :: min_seaice ! --- in/out: real (kind=kind_phys), dimension(im), intent(inout) :: wetness -! --- out - real (kind=kind_phys), dimension(:), intent(out) :: zs +! --- inout real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: sh2o, smfrkeep real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: tslb, smois - real (kind=kind_phys), dimension(im,kice), intent(out) :: tsice + real (kind=kind_phys), dimension(im), intent(inout) :: semis_lnd + real (kind=kind_phys), dimension(im), intent(inout) :: semis_ice + real (kind=kind_phys), dimension(im), intent(inout) :: & + albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & + albdvis_ice, albdnir_ice, albivis_ice, albinir_ice +! --- out + real (kind=kind_phys), dimension(:), intent(out) :: zs + real (kind=kind_phys), dimension(im), intent(out) :: sfalb_lnd_bck + real (kind=kind_phys), dimension(im,kice), intent(out) :: tsice + real (kind=kind_phys), dimension(im), intent(out) :: semisbase real (kind=kind_phys), dimension(:), intent(out) :: pores, resid character(len=*), intent(out) :: errmsg @@ -75,6 +101,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & ! --- local real (kind=kind_phys), dimension(lsoil_ruc) :: dzs + real (kind=kind_phys) :: alb_lnd, alb_ice integer :: ipr, i, k logical :: debug_print integer, dimension(im) :: soiltyp, vegtype @@ -144,6 +171,30 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & if (soiltyp(i) < 1) soiltyp(i) = 14 if (vegtype(i) < 1) vegtype(i) = 17 endif + !-- initialize background and actual emissivity + semisbase(i) = lemitbl(vegtype(i)) ! no snow effect + sfalb_lnd_bck(i) = 0.25*(alnsf(i) + alnwf(i) + alvsf(i) + alvwf(i)) & + * min(1., facsf(i)+facwf(i)) + + write(0,*)'sfalb_lnd_bck(i)=',i,sfalb_lnd_bck(i) + !-- land + semis_lnd(i) = semisbase(i) * (1.-sncovr_lnd(i)) & + + 0.99 * sncovr_lnd(i) + alb_lnd = sfalb_lnd_bck(i) * (1. - sncovr_lnd(i)) & + + snoalb(i) * sncovr_lnd(i) + albdvis_lnd(i) = alb_lnd + albdnir_lnd(i) = alb_lnd + albivis_lnd(i) = alb_lnd + albinir_lnd(i) = alb_lnd + !-- ice + semis_ice(i) = 0.97 * (1. - sncovr_ice(i)) + 0.99 * sncovr_ice(i) + alb_ice = 0.55 * (1. - sncovr_ice(i)) + 0.75 * sncovr_ice(i) + albdvis_ice(i) = alb_ice + albdnir_ice(i) = alb_ice + albivis_ice(i) = alb_ice + albinir_ice(i) = alb_ice + + write(0,*)'albinir_lnd(i),albinir_ice(i)',i,alb_lnd,albinir_lnd(i),alb_ice,albinir_ice(i) enddo call init_soil_depth_3 ( zs , dzs , lsoil_ruc ) @@ -270,8 +321,7 @@ subroutine lsm_ruc_run & ! inputs & imp_physics, imp_physics_gfdl, imp_physics_thompson, & & do_mynnsfclay, lsoil_ruc, lsoil, rdlai, zs, & & t1, q1, qc, soiltyp, vegtype, sigmaf, laixy, & - & dlwflx, dswsfc, snet, tg3, coszen, & - & land, icy, lake, alb_ice_snowfree, alb_ice_snow, & + & dlwflx, dswsfc, snet, tg3, coszen, land, icy, lake, & & rainnc, rainc, ice, snow, graupel, & & prsl1, zf, wind, shdmin, shdmax, & & srflag, sfalb_lnd_bck, snoalb, & @@ -362,8 +412,6 @@ subroutine lsm_ruc_run & ! inputs & sfcqc_ice, sfcqv_ice, fice, tice ! --- in - real (kind=kind_phys), dimension(im), intent(in) :: & - alb_ice_snowfree, alb_ice_snow real (kind=kind_phys), dimension(im), intent(in) :: & & rainnc, rainc, ice, snow, graupel ! --- in/out: @@ -465,7 +513,6 @@ subroutine lsm_ruc_run & ! inputs ! local integer :: ims,ime, its,ite, jms,jme, jts,jte, kms,kme, kts,kte integer :: l, k, i, j, fractional_seaice, ilst - integer, dimension (1:nlcat) :: istwe real (kind=kind_phys) :: dm logical :: flag(im), flag_ice_uncoupled(im) logical :: rdlai2d, myj, frpcpn @@ -849,10 +896,10 @@ subroutine lsm_ruc_run & ! inputs sfcems_lnd(i,j) = semis_lnd(i) endif - if(coszen(i) > 0. .and. sneqv_lnd(i) < 1.e-4) then + if(coszen(i) > 0. .and. weasd_lnd(i) < 1.e-4) then !-- solar zenith angle dependence when no snow ilst=istwe(vegtype(i)) ! 1 or 2 - dm = (1.+2.*d(ilst))/(1.+2.*d(ilst)*coszen(i,j)) + dm = (1.+2.*d(ilst))/(1.+2.*d(ilst)*coszen(i)) albbcksol(i) = sfalb_lnd_bck(i)*dm endif ! coszen > 0. @@ -1157,8 +1204,8 @@ subroutine lsm_ruc_run & ! inputs sncovr_ice(i,j) = sncovr1_ice(i) !-- alb_ice* is computed in setalb called from rrtmg_sw_pre. - snoalb1d_ice(i,j) = alb_ice_snow(i) !0.75 is RAP value for max snow alb on ice - albbck_ice(i,j) = alb_ice_snowfree(i) !0.55 is RAP value for ice alb + snoalb1d_ice(i,j) = 0.75 !alb_ice_snow(i) !0.75 is RAP value for max snow alb on ice + albbck_ice(i,j) = 0.55 !alb_ice_snowfree(i) !0.55 is RAP value for ice alb if (kdt == 1) then if (dswsfc(i) > 0.) then alb_ice(i,j) = max(0.01, 1. - snet(i)/dswsfc(i)) diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 9ab17172e..8198a3c99 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -200,6 +200,213 @@ kind = kind_phys intent = in optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[min_seaice] + standard_name = sea_ice_minimum + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[sncovr_lnd] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sncovr_ice] + standard_name = surface_snow_area_fraction_over_ice + long_name = surface snow area fraction over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[facsf] + standard_name =fractional_coverage_with_strong_cosz_dependency + long_name = fractional coverage with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[facwf] + standard_name = fractional_coverage_with_weak_cosz_dependency + long_name = fractional coverage with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[alvsf] + standard_name = mean_vis_albedo_with_strong_cosz_dependency + long_name = mean vis albedo with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[alvwf] + standard_name = mean_vis_albedo_with_weak_cosz_dependency + long_name = mean vis albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[alnsf] + standard_name = mean_nir_albedo_with_strong_cosz_dependency + long_name = mean nir albedo with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[alnwf] + standard_name = mean_nir_albedo_with_weak_cosz_dependency + long_name = mean nir albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sfalb_lnd_bck] + standard_name =surface_snow_free_albedo_over_land + long_name = surface snow-free albedo over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[semisbase] + standard_name = baseline_surface_longwave_emissivity + long_name = baseline surface lw emissivity in fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[semis_lnd] + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[semis_ice] + standard_name = surface_longwave_emissivity_over_ice + long_name = surface lw emissivity in fraction over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[albdvis_lnd] + standard_name = surface_albedo_direct_visible_over_land + long_name = direct surface albedo visible band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[albdnir_lnd] + standard_name = surface_albedo_direct_NIR_over_land + long_name = direct surface albedo NIR band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[albivis_lnd] + standard_name = surface_albedo_diffuse_visible_over_land + long_name = diffuse surface albedo visible band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[albinir_lnd] + standard_name = surface_albedo_diffuse_NIR_over_land + long_name = diffuse surface albedo NIR band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[albdvis_ice] + standard_name = surface_albedo_direct_visible_over_ice + long_name = direct surface albedo visible band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[albdnir_ice] + standard_name = surface_albedo_direct_NIR_over_ice + long_name = direct surface albedo NIR band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[albivis_ice] + standard_name = surface_albedo_diffuse_visible_over_ice + long_name = diffuse surface albedo visible band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[albinir_ice] + standard_name = surface_albedo_diffuse_NIR_over_ice + long_name = diffuse surface albedo NIR band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [zs] standard_name = depth_of_soil_levels_for_land_surface_model long_name = depth of soil levels for land surface model @@ -591,24 +798,6 @@ type = logical intent = in optional = F -[alb_ice_snowfree] - standard_name =surface_snow_free_albedo_over_ice - long_name = surface snow-free albedo over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F -[alb_ice_snow] - standard_name =surface_snow_albedo_over_ice - long_name = surface snow albedo over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [rainnc] standard_name = lwe_thickness_of_explicit_rainfall_amount_from_previous_timestep long_name = explicit rainfall from previous timestep From ad1ad675f8985c8a8287aca3c0a4e8870d9bd1f9 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Mon, 5 Apr 2021 21:39:18 +0000 Subject: [PATCH 05/74] Change intent from out to inout for albedo. --- physics/GFS_phys_time_vary.fv3.F90 | 20 ++++++++++---------- physics/GFS_phys_time_vary.fv3.meta | 20 ++++++++++---------- 2 files changed, 20 insertions(+), 20 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 7009b1eae..5e59fbd9e 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -126,16 +126,16 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(inout) :: alboldxy(:) real(kind_phys), intent(inout) :: qsnowxy(:) real(kind_phys), intent(inout) :: wslakexy(:) - real(kind_phys), intent(out) :: albdvis_lnd(:) - real(kind_phys), intent(out) :: albdnir_lnd(:) - real(kind_phys), intent(out) :: albivis_lnd(:) - real(kind_phys), intent(out) :: albinir_lnd(:) - real(kind_phys), intent(out) :: albdvis_ice(:) - real(kind_phys), intent(out) :: albdnir_ice(:) - real(kind_phys), intent(out) :: albivis_ice(:) - real(kind_phys), intent(out) :: albinir_ice(:) - real(kind_phys), intent(out) :: emiss_lnd(:) - real(kind_phys), intent(out) :: emiss_ice(:) + real(kind_phys), intent(inout) :: albdvis_lnd(:) + real(kind_phys), intent(inout) :: albdnir_lnd(:) + real(kind_phys), intent(inout) :: albivis_lnd(:) + real(kind_phys), intent(inout) :: albinir_lnd(:) + real(kind_phys), intent(inout) :: albdvis_ice(:) + real(kind_phys), intent(inout) :: albdnir_ice(:) + real(kind_phys), intent(inout) :: albivis_ice(:) + real(kind_phys), intent(inout) :: albinir_ice(:) + real(kind_phys), intent(inout) :: emiss_lnd(:) + real(kind_phys), intent(inout) :: emiss_ice(:) real(kind_phys), intent(inout) :: taussxy(:) real(kind_phys), intent(inout) :: waxy(:) real(kind_phys), intent(inout) :: wtxy(:) diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index b02766caa..39de45cf7 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -762,7 +762,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [albdnir_lnd] standard_name = surface_albedo_direct_NIR_over_land @@ -771,7 +771,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [albivis_lnd] standard_name = surface_albedo_diffuse_visible_over_land @@ -780,7 +780,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [albinir_lnd] standard_name = surface_albedo_diffuse_NIR_over_land @@ -789,7 +789,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [albdvis_ice] standard_name = surface_albedo_direct_visible_over_ice @@ -798,7 +798,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [albdnir_ice] standard_name = surface_albedo_direct_NIR_over_ice @@ -807,7 +807,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [albivis_ice] standard_name = surface_albedo_diffuse_visible_over_ice @@ -816,7 +816,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [albinir_ice] standard_name = surface_albedo_diffuse_NIR_over_ice @@ -825,7 +825,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [emiss_lnd] standard_name = surface_longwave_emissivity_over_land @@ -834,7 +834,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [emiss_ice] standard_name = surface_longwave_emissivity_over_ice @@ -843,7 +843,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [snowxy] standard_name = number_of_snow_layers From ea0c6f0f4868c2d140f41721f8539b00aa7e3db1 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Thu, 8 Apr 2021 16:58:52 +0000 Subject: [PATCH 06/74] Fixed problems with the initialization of albedo and emissivity. --- physics/GFS_phys_time_vary.fv3.F90 | 4 ++-- physics/module_sf_ruclsm.F90 | 2 +- physics/radiation_surface.f | 6 ++---- physics/sfc_drv_ruc.F90 | 6 +++--- 4 files changed, 8 insertions(+), 10 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 5e59fbd9e..aadf33b3f 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -377,7 +377,6 @@ subroutine GFS_phys_time_vary_init ( !--- For Noah MP or RUC LSMs: initialize four components of albedo for !--- land and ice if (lsm == lsm_noahmp .or. lsm == lsm_ruc) then - if (all(albdvis_lnd < zero)) then if (me == master ) write(0,'(a)') 'GFS_phys_time_vary_init: initialize albedo for land and ice' albdvis_lnd(:) = missing_value albdnir_lnd(:) = missing_value @@ -392,7 +391,9 @@ subroutine GFS_phys_time_vary_init ( albinir_lnd(ix) = 0.2_kind_phys emiss_lnd(ix) = 0.95_kind_phys enddo + endif + if (lsm == lsm_ruc) then albdvis_ice(:) = missing_value albdnir_ice(:) = missing_value albivis_ice(:) = missing_value @@ -406,7 +407,6 @@ subroutine GFS_phys_time_vary_init ( albinir_ice(ix) = 0.6_kind_phys emiss_ice(ix) = 0.97_kind_phys enddo - endif endif if (lsm == lsm_noahmp) then diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 5683db7c0..1e0ec2fe2 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -718,7 +718,6 @@ SUBROUTINE LSMRUC( & !-- update background emissivity for land points, can have vegetation mosaic effect EMISBCK(I,J) = EMISSL(I,J) - ENDIF IF (debug_print ) THEN if(init) & @@ -785,6 +784,7 @@ SUBROUTINE LSMRUC( & print *,'NROOT, meltfactor, iforest, ivgtyp, i,j ', nroot,meltfactor,iforest,ivgtyp(I,J),I,J ENDIF + ENDIF ! land !!*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS ! if(i.eq.397.and.j.eq.562) then ! print *,'RUC LSM - xland(i,j),xice(i,j),snow(i,j)',i,j,xland(i,j),xice(i,j),snow(i,j) diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 64d7b3914..cac8585d8 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -743,17 +743,15 @@ subroutine setalb & endif ! snow endif ! lsm else - ! icy = false + ! icy = false, fill in values asevd_ice = 0.70 asend_ice = 0.65 asevb_ice = 0.70 asenb_ice = 0.65 - endif ! icy + endif ! end icy !-- Composite mean surface albedo from land, open water and !-- ice fractions - print*,'i,asenb_wat,asenb_ice',i,asenb_wat,asenb_ice - print*,'lsmalbdnir(i)=',i,lsmalbdnir(i) sfcalb(i,1) = min(0.99,max(0.01,lsmalbdnir(i)))*fracl & & + asenb_wat*fraco + asenb_ice*fraci sfcalb(i,2) = min(0.99,max(0.01,lsmalbinir(i)))*fracl & diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index f5a5e9c4f..8586737c9 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -176,7 +176,6 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & sfalb_lnd_bck(i) = 0.25*(alnsf(i) + alnwf(i) + alvsf(i) + alvwf(i)) & * min(1., facsf(i)+facwf(i)) - write(0,*)'sfalb_lnd_bck(i)=',i,sfalb_lnd_bck(i) !-- land semis_lnd(i) = semisbase(i) * (1.-sncovr_lnd(i)) & + 0.99 * sncovr_lnd(i) @@ -194,8 +193,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & albivis_ice(i) = alb_ice albinir_ice(i) = alb_ice - write(0,*)'albinir_lnd(i),albinir_ice(i)',i,alb_lnd,albinir_lnd(i),alb_ice,albinir_ice(i) - enddo + enddo ! i call init_soil_depth_3 ( zs , dzs , lsoil_ruc ) @@ -901,6 +899,8 @@ subroutine lsm_ruc_run & ! inputs ilst=istwe(vegtype(i)) ! 1 or 2 dm = (1.+2.*d(ilst))/(1.+2.*d(ilst)*coszen(i)) albbcksol(i) = sfalb_lnd_bck(i)*dm + else + albbcksol(i) = sfalb_lnd_bck(i) endif ! coszen > 0. snoalb1d_lnd(i,j) = snoalb(i) From d4531cd5a3cdb7a5969bda3f59875cb790e74401 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Fri, 9 Apr 2021 23:14:23 +0000 Subject: [PATCH 07/74] Added the code to compute land, water and ice fractions when frac_grid=.false. --- physics/GFS_rrtmgp_sw_pre.F90 | 14 ++-- physics/GFS_rrtmgp_sw_pre.meta | 8 ++ physics/radiation_surface.f | 142 ++++++++++++++++++++++++--------- physics/rrtmg_lw_pre.F90 | 6 +- physics/rrtmg_lw_pre.meta | 8 ++ physics/rrtmg_sw_pre.F90 | 7 +- physics/rrtmg_sw_pre.meta | 8 ++ physics/rrtmgp_lw_pre.F90 | 12 +-- physics/rrtmgp_lw_pre.meta | 8 ++ 9 files changed, 159 insertions(+), 54 deletions(-) diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index cba742ad0..572ea08da 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -29,8 +29,8 @@ end subroutine GFS_rrtmgp_sw_pre_init !! subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp, lndp_var_list, & lndp_prt_list, lsm, lsm_noahmp, lsm_ruc, doSWrad, solhr, lon, coslat, sinlat, & - snowd, sncovr, sncovr_ice, snoalb, zorl, tsfg, tsfa, hprime, landfrac, min_seaice, & - alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, albdvis_lnd, & + snowd, sncovr, sncovr_ice, snoalb, zorl, tsfg, tsfa, hprime, landfrac, frac_grid, & + min_seaice, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, albdvis_lnd, & albdnir_lnd, albivis_lnd, albinir_lnd, albdvis_ice, albdnir_lnd, albivis_ice, & albinir_ice, lsmask, sfc_wts, p_lay, tv_lay, relhum, p_lev, & nday, idxday, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, & @@ -51,11 +51,13 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp, lndp_var real(kind_phys), dimension(n_var_lndp), intent(in) :: & lndp_prt_list logical,intent(in) :: & - doSWrad ! Call RRTMGP SW radiation? + doSWrad ! Call RRTMGP SW radiation? + logical,intent(in) :: & + frac_grid ! Logical flag for fractional grid real(kind_phys), intent(in) :: & - solhr ! Time in hours after 00z at the current timestep + solhr ! Time in hours after 00z at the current timestep real(kind_phys), intent(in) :: & - min_seaice ! Sea ice threashold + min_seaice ! Sea ice threashold real(kind_phys), dimension(nCol), intent(in) :: & lsmask, & ! Landmask: sea/land/ice=0/1/2 lon, & ! Longitude @@ -151,7 +153,7 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp, lndp_var alb1d(:) = 0. lndp_alb = -999. call setalb (lsmask, lsm, lsm_noahmp, lsm_ruc, snowd, sncovr, sncovr_ice, snoalb, zorl, & - coszen, tsfg, tsfa, hprime, landfrac, min_seaice, & + coszen, tsfg, tsfa, hprime, landfrac, frac_grid, min_seaice, & alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & albdvis_lnd, albdnir_ldn, albivis_lnd, albinir_lnd, & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, NCOL, alb1d, lndp_alb, & ! mg, sfc-perts diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index da96fbf80..71a1dca8c 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -223,6 +223,14 @@ kind = kind_phys intent = in optional = F +[frac_grid] + standard_name = flag_for_fractional_grid + long_name = flag for fractional grid + units = flag + dimensions = () + type = logical + intent = in + optional = F [min_seaice] standard_name = sea_ice_minimum long_name = minimum sea ice value diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index cac8585d8..80edd5559 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -330,8 +330,9 @@ end subroutine sfc_init !! @{ !----------------------------------- subroutine setalb & - & ( slmsk,lsm,lsm_noahmp,lsm_ruc,snowf,sncovr,sncovr_ice, & - & snoalb,zorlf,coszf,tsknf,tairf,hprif,landfrac,min_seaice, & ! --- inputs: + & ( slmsk,lsm,lsm_noahmp,lsm_ruc,snowf, & ! --- inputs: + & sncovr,sncovr_ice,snoalb,zorlf,coszf, & + & tsknf,tairf,hprif,landfrac,frac_grid,min_seaice, & & alvsf,alnsf,alvwf,alnwf,facsf,facwf,fice,tisfc, & & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, & & icealbdvis, icealbdnir, icealbivis, icealbinir, & @@ -403,6 +404,7 @@ subroutine setalb & ! --- inputs integer, intent(in) :: IMAX integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc + logical, intent(in) :: frac_grid real (kind=kind_phys), dimension(:), intent(in) :: & & slmsk, snowf, zorlf, coszf, tsknf, tairf, hprif, landfrac, & @@ -661,17 +663,38 @@ subroutine setalb & elseif ( ialbflg == 2 ) then do i = 1, IMAX - fracl = landfrac(i) - fraco = max(f_zero, f_one - fracl) - if(fice(i) < min_seaice) then - fraci = 0. + if (.not. frac_grid) then + !-- non-fractional grid + if (slmsk(i) == 1) then + fracl = f_one + fraci = f_zero + fraco = f_zero + icy(i) = .false. + else + fracl = f_zero + fraco = f_one + if(fice(i) < min_seaice) then + fraci = f_zero + icy(i) = .false. + else + fraci = fraco * fice(i) + icy(i) = .true. + endif + fraco = max(f_zero, fraco-fraci) + endif else - fraci = fraco * fice(i) - endif - fraco = max(f_zero, fraco-fraci) - - icy(i) = .false. - if (fraci > f_zero) icy(i) = .true. + !-- fractional grid + fracl = landfrac(i) + fraco = max(f_zero, f_one - fracl) + if(fice(i) < min_seaice) then + fraci = f_zero + icy(i) = .false. + else + fraci = fraco * fice(i) + icy(i) = .true. + endif + fraco = max(f_zero, fraco-fraci) + endif! frac_grid !-- water albedo asevd_wat = 0.06 @@ -813,8 +836,8 @@ end subroutine setalb !! @{ !----------------------------------- subroutine setemis & - & ( kdt,lsm,lsm_noahmp,lsm_ruc,vtype,landfrac,min_seaice, & ! --- inputs: - & xlon,xlat,slmsk,snowf,sncovr,sncovr_ice,fice, & + & ( kdt,lsm,lsm_noahmp,lsm_ruc,vtype,landfrac,frac_grid, & ! --- inputs: + & min_seaice,xlon,xlat,slmsk,snowf,sncovr,sncovr_ice,fice, & & zorlf,tsknf,tairf,hprif, & & semis_lnd,semis_ice,IMAX, & & semisbase, sfcemis & ! --- outputs: @@ -871,6 +894,7 @@ subroutine setemis & ! --- inputs integer, intent(in) :: IMAX integer, intent(in) :: kdt, lsm, lsm_noahmp, lsm_ruc + logical, intent(in) :: frac_grid real (kind=kind_phys), dimension(:), intent(in) :: vtype real (kind=kind_phys), dimension(:), intent(in) :: landfrac real (kind=kind_phys), intent(in) :: min_seaice @@ -920,24 +944,46 @@ subroutine setemis & lab_do_IMAX : do i = 1, IMAX - fracl = landfrac(i) - fraco = max(f_zero, f_one - fracl) - if(fice(i) < min_seaice) then - fraci = 0. + if (.not. frac_grid) then + !-- non-fractional grid + if (slmsk(i) == 1) then + fracl = f_one + fraci = f_zero + fraco = f_zero + icy(i) = .false. + else + fracl = f_zero + fraco = f_one + if(fice(i) < min_seaice) then + fraci = f_zero + icy(i) = .false. + else + fraci = fraco * fice(i) + icy(i) = .true. + endif + fraco = max(f_zero, fraco-fraci) + endif else - fraci = fraco * fice(i) - endif - fraco = max(f_zero, fraco-fraci) - - icy(i) = .false. - if (fice(i) > min_seaice) icy(i) = .true. + !-- fractional grid + fracl = landfrac(i) + fraco = max(f_zero, f_one - fracl) + if(fice(i) < min_seaice) then + fraci = f_zero + icy(i) = .false. + else + fraci = fraco * fice(i) + icy(i) = .true. + endif + fraco = max(f_zero, fraco-fraci) + endif! frac_grid - if (fracl < epsln) then ! no land + if (fracl < epsln) then ! no land if ( abs(fraco-f_one) < epsln ) then ! open water point sfcemis(i) = emsref(1) elseif ( abs(fraci-f_one) > epsln ) then ! complete sea/lake ice sfcemis(i) = emsref(7) else + !-- fractional sea ice sfcemis(i) = fraco*emsref(1) + fraci*emsref(7) endif @@ -1015,20 +1061,40 @@ subroutine setemis & do i = 1, IMAX - fracl = landfrac(i) - fraco = max(f_zero, f_one - fracl) - if(fice(i) < min_seaice) then - fraci = 0. + if (.not. frac_grid) then + !-- non-fractional grid + if (slmsk(i) == 1) then + fracl = f_one + fraci = f_zero + fraco = f_zero + icy(i) = .false. + else + fracl = f_zero + fraco = f_one + if(fice(i) < min_seaice) then + fraci = f_zero + icy(i) = .false. + else + fraci = fraco * fice(i) + icy(i) = .true. + endif + fraco = max(f_zero, fraco-fraci) + endif else - fraci = fraco * fice(i) - endif - - fraco = max(f_zero, fraco-fraci) - - icy(i) = .false. - if (fice(i) > min_seaice) icy(i) = .true. + !-- fractional grid + fracl = landfrac(i) + fraco = max(f_zero, f_one - fracl) + if(fice(i) < min_seaice) then + fraci = f_zero + icy(i) = .false. + else + fraci = fraco * fice(i) + icy(i) = .true. + endif + fraco = max(f_zero, fraco-fraci) + endif! frac_grid - !-- ice albedo + !-- ice emissivity sfcemis_ice = emsref(7) if ( icy(i) ) then @@ -1048,7 +1114,7 @@ subroutine setemis & !-- land emissivity !-- from Noah MP or RUC lsms - sfcemis_land = semis_lnd(i) ! albedo with snow effect from LSM + sfcemis_land = semis_lnd(i) ! albedo with snow effect from LSM !-- Composite emissivity from land, water and ice fractions. sfcemis(i) = fracl*sfcemis_land + fraco*emsref(1) & diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index 3025feb3f..4bc33fd82 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -14,7 +14,7 @@ end subroutine rrtmg_lw_pre_init !! subroutine rrtmg_lw_pre_run (im, lslwr, kdt, lsm, lsm_noahmp, lsm_ruc, vtype, & xlat, xlon, slmsk, snowd, sncovr, sncovr_ice, fice, zorl, hprime, & - landfrac, min_seaice, tsfg, tsfa, & + landfrac, frac_grid, min_seaice, tsfg, tsfa, & semis_lnd, semis_ice, semisbase, semis, errmsg, errflg) use machine, only: kind_phys @@ -24,10 +24,12 @@ subroutine rrtmg_lw_pre_run (im, lslwr, kdt, lsm, lsm_noahmp, lsm_ruc, vtype, integer, intent(in) :: im logical, intent(in) :: lslwr + integer, intent(in) :: kdt, lsm, lsm_noahmp, lsm_ruc real(kind=kind_phys), dimension(im), intent(in) :: xlat, xlon, vtype, slmsk,& snowd, sncovr, sncovr_ice, fice, zorl, hprime, landfrac, tsfg, tsfa + logical, intent(in) :: frac_grid real(kind=kind_phys), intent(in) :: min_seaice real(kind=kind_phys), dimension(:), intent(in) :: semis_lnd real(kind=kind_phys), dimension(:), intent(in) :: semis_ice @@ -44,7 +46,7 @@ subroutine rrtmg_lw_pre_run (im, lslwr, kdt, lsm, lsm_noahmp, lsm_ruc, vtype, !> - Call module_radiation_surface::setemis(),to setup surface !! emissivity for LW radiation. call setemis (kdt, lsm, lsm_noahmp, lsm_ruc, vtype, landfrac, & - min_seaice, xlon, xlat, slmsk, & + frac_grid, min_seaice, xlon, xlat, slmsk, & snowd, sncovr, sncovr_ice, fice, zorl, tsfg, tsfa, & hprime, semis_lnd, semis_ice, im, & ! --- inputs semisbase, semis) ! --- outputs diff --git a/physics/rrtmg_lw_pre.meta b/physics/rrtmg_lw_pre.meta index f75e40793..1ac9ffef8 100644 --- a/physics/rrtmg_lw_pre.meta +++ b/physics/rrtmg_lw_pre.meta @@ -154,6 +154,14 @@ kind = kind_phys intent = in optional = F +[frac_grid] + standard_name = flag_for_fractional_grid + long_name = flag for fractional grid + units = flag + dimensions = () + type = logical + intent = in + optional = F [min_seaice] standard_name = sea_ice_minimum long_name = minimum sea ice value diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index 28b37c7ad..bf8f3f1a3 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -14,8 +14,8 @@ end subroutine rrtmg_sw_pre_init !! subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, lndp_prt_list, tsfg, tsfa, coszen, & lsm, lsm_noahmp, lsm_ruc, alb1d, slmsk, snowd, sncovr, sncovr_ice, snoalb, zorl, & - hprime, landfrac, min_seaice, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc,& - albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & + hprime, landfrac, frac_grid, min_seaice, alvsf, alnsf, alvwf, alnwf, facsf, facwf, & + fice, tisfc, albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, sfalb, & nday, idxday, sfcalb1, sfcalb2, sfcalb3, sfcalb4, errmsg, errflg) @@ -27,6 +27,7 @@ subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, ln integer, intent(in) :: im, lndp_type, n_var_lndp integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc + logical, intent(in) :: frac_grid character(len=3) , dimension(:), intent(in) :: lndp_var_list logical, intent(in) :: lsswr real(kind=kind_phys), dimension(:), intent(in) :: lndp_prt_list @@ -92,7 +93,7 @@ subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, ln !! for SW radiation. call setalb (slmsk, lsm, lsm_noahmp, lsm_ruc, snowd, sncovr, sncovr_ice, snoalb, & - zorl, coszen, tsfg, tsfa, hprime, landfrac, min_seaice, & + zorl, coszen, tsfg, tsfa, hprime, landfrac, frac_grid, min_seaice, & alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & diff --git a/physics/rrtmg_sw_pre.meta b/physics/rrtmg_sw_pre.meta index d8a5addb2..bb51c7f1c 100644 --- a/physics/rrtmg_sw_pre.meta +++ b/physics/rrtmg_sw_pre.meta @@ -189,6 +189,14 @@ kind = kind_phys intent = in optional = F +[frac_grid] + standard_name = flag_for_fractional_grid + long_name = flag for fractional grid + units = flag + dimensions = () + type = logical + intent = in + optional = F [min_seaice] standard_name = sea_ice_minimum long_name = minimum sea ice value diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index 6da7f77df..efbd0bf37 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -27,13 +27,15 @@ end subroutine rrtmgp_lw_pre_init !! subroutine rrtmgp_lw_pre_run ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, doLWrad, & nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, sncovr_ice, fice, & - tsfg, tsfa, hprime, landfrac, min_seaice, & + tsfg, tsfa, hprime, landfrac, frac_grid, min_seaice, & sfc_emiss_byband, semis_land, semis_ice, & semisbase, semis, errmsg, errflg) ! Inputs logical, intent(in) :: & doLWrad ! Logical flag for longwave radiation call + logical, intent(in) :: & + frac_grid ! Logical flag for fractional grid integer, intent(in) :: & nCol ! Number of horizontal grid points integer, intent(in) :: kdt, lsm, lsm_noahmp, lsm_ruc @@ -79,10 +81,10 @@ subroutine rrtmgp_lw_pre_run ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, doLWrad, & ! ####################################################################################### ! Call module_radiation_surface::setemis(),to setup surface emissivity for LW radiation. ! ####################################################################################### - call setemis ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, landfrac, min_seaice, & - xlon, xlat, slmsk, snowd, sncovr, sncovr_ice, fice, zorl, & - tsfg, tsfa, hprime, semis_land, semis_ice, nCol, & ! --- inputs - semisbase, semis) ! --- outputs + call setemis ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, landfrac, frac_grid, min_seaice, & + xlon, xlat, slmsk, snowd, sncovr, sncovr_ice, fice, zorl, & + tsfg, tsfa, hprime, semis_land, semis_ice, nCol, & ! --- inputs + semisbase, semis) ! --- outputs ! Assign same emissivity to all bands diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index bc11229cc..555d4d182 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -172,6 +172,14 @@ kind = kind_phys intent = in optional = F +[frac_grid] + standard_name = flag_for_fractional_grid + long_name = flag for fractional grid + units = flag + dimensions = () + type = logical + intent = in + optional = F [min_seaice] standard_name = sea_ice_minimum long_name = minimum sea ice value From e140651f2fa1d9a42c02f1d6e4afe038e7281bf1 Mon Sep 17 00:00:00 2001 From: Ben Green Date: Mon, 12 Apr 2021 19:59:29 +0000 Subject: [PATCH 08/74] Adding composite changes on top of Tanya's changes --- physics/GFS_surface_composites.F90 | 42 ++++--- physics/GFS_surface_composites.meta | 54 +++++++++ physics/sfc_diff.f | 180 +++++++++++++++++++++++----- physics/sfc_diff.meta | 124 +++++++++++++++++++ 4 files changed, 352 insertions(+), 48 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 435e416d3..2855d1e68 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -355,7 +355,7 @@ module GFS_surface_composites_post public GFS_surface_composites_post_init, GFS_surface_composites_post_finalize, GFS_surface_composites_post_run - real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys, qmin = 1.0e-8_kind_phys contains @@ -371,7 +371,8 @@ end subroutine GFS_surface_composites_post_finalize !! #endif subroutine GFS_surface_composites_post_run ( & - im, kice, km, cplflx, cplwav2atm, frac_grid, flag_cice, islmsk, dry, wet, icy, landfrac, lakefrac, oceanfrac, & + im, kice, km, cplflx, cplwav2atm, frac_grid, flag_cice, islmsk, dry, wet, icy, wind, t1, q1, prsl1, & + rd, rvrdm1, landfrac, lakefrac, oceanfrac, & zorl, zorlo, zorll, zorli, zorl_wat, zorl_lnd, zorl_ice, & cd, cd_wat, cd_lnd, cd_ice, cdq, cdq_wat, cdq_lnd, cdq_ice, rb, rb_wat, rb_lnd, rb_ice, stress, stress_wat, stress_lnd, & stress_ice, ffmm, ffmm_wat, ffmm_lnd, ffmm_ice, ffhh, ffhh_wat, ffhh_lnd, ffhh_ice, uustar, uustar_wat, uustar_lnd, & @@ -387,7 +388,7 @@ subroutine GFS_surface_composites_post_run ( logical, intent(in) :: cplflx, frac_grid, cplwav2atm logical, dimension(im), intent(in) :: flag_cice, dry, wet, icy integer, dimension(im), intent(in) :: islmsk - real(kind=kind_phys), dimension(im), intent(in) :: landfrac, lakefrac, oceanfrac, & + real(kind=kind_phys), dimension(im), intent(in) :: wind, t1, q1, prsl1, landfrac, lakefrac, oceanfrac, & zorl_wat, zorl_lnd, zorl_ice, cd_wat, cd_lnd, cd_ice, cdq_wat, cdq_lnd, cdq_ice, rb_wat, rb_lnd, rb_ice, stress_wat, & stress_lnd, stress_ice, ffmm_wat, ffmm_lnd, ffmm_ice, ffhh_wat, ffhh_lnd, ffhh_ice, uustar_wat, uustar_lnd, uustar_ice, & fm10_wat, fm10_lnd, fm10_ice, fh2_wat, fh2_lnd, fh2_ice, tsurf_wat, tsurf_lnd, tsurf_ice, cmm_wat, cmm_lnd, cmm_ice, & @@ -401,6 +402,7 @@ subroutine GFS_surface_composites_post_run ( real(kind=kind_phys), dimension(im), intent(in ) :: tice ! interstitial sea ice temperature real(kind=kind_phys), dimension(im), intent(inout) :: hice, cice real(kind=kind_phys), intent(in ) :: min_seaice + real(kind=kind_phys), intent(in ) :: rd, rvrdm1 real(kind=kind_phys), dimension(im, kice), intent(in ) :: tiice real(kind=kind_phys), dimension(im, km), intent(inout) :: stc @@ -410,7 +412,7 @@ subroutine GFS_surface_composites_post_run ( ! Local variables integer :: i, k - real(kind=kind_phys) :: txl, txi, txo, wfrac + real(kind=kind_phys) :: txl, txi, txo, wfrac, q0, rho ! Initialize CCPP error handling variables errmsg = '' @@ -428,20 +430,26 @@ subroutine GFS_surface_composites_post_run ( txi = cice(i) * wfrac ! txi = ice fraction wrt whole cell txo = max(zero, wfrac-txi) ! txo = open water fraction - zorl(i) = txl*zorl_lnd(i) + txi*zorl_ice(i) + txo*zorl_wat(i) - cd(i) = txl*cd_lnd(i) + txi*cd_ice(i) + txo*cd_wat(i) - cdq(i) = txl*cdq_lnd(i) + txi*cdq_ice(i) + txo*cdq_wat(i) - rb(i) = txl*rb_lnd(i) + txi*rb_ice(i) + txo*rb_wat(i) - stress(i) = txl*stress_lnd(i) + txi*stress_ice(i) + txo*stress_wat(i) - ffmm(i) = txl*ffmm_lnd(i) + txi*ffmm_ice(i) + txo*ffmm_wat(i) - ffhh(i) = txl*ffhh_lnd(i) + txi*ffhh_ice(i) + txo*ffhh_wat(i) - uustar(i) = txl*uustar_lnd(i) + txi*uustar_ice(i) + txo*uustar_wat(i) - fm10(i) = txl*fm10_lnd(i) + txi*fm10_ice(i) + txo*fm10_wat(i) - fh2(i) = txl*fh2_lnd(i) + txi*fh2_ice(i) + txo*fh2_wat(i) +! BWG zorl(i) = txl*zorl_lnd(i) + txi*zorl_ice(i) + txo*zorl_wat(i) +! BWG cd(i) = txl*cd_lnd(i) + txi*cd_ice(i) + txo*cd_wat(i) +! BWG cdq(i) = txl*cdq_lnd(i) + txi*cdq_ice(i) + txo*cdq_wat(i) +! BWG rb(i) = txl*rb_lnd(i) + txi*rb_ice(i) + txo*rb_wat(i) +! BWG stress(i) = txl*stress_lnd(i) + txi*stress_ice(i) + txo*stress_wat(i) +! BWG ffmm(i) = txl*ffmm_lnd(i) + txi*ffmm_ice(i) + txo*ffmm_wat(i) +! BWG ffhh(i) = txl*ffhh_lnd(i) + txi*ffhh_ice(i) + txo*ffhh_wat(i) +! BWG uustar(i) = txl*uustar_lnd(i) + txi*uustar_ice(i) + txo*uustar_wat(i) +! BWG fm10(i) = txl*fm10_lnd(i) + txi*fm10_ice(i) + txo*fm10_wat(i) +! BWG fh2(i) = txl*fh2_lnd(i) + txi*fh2_ice(i) + txo*fh2_wat(i) + !tsurf(i) = txl*tsurf_lnd(i) + txi*tice(i) + txo*tsurf_wat(i) !tsurf(i) = txl*tsurf_lnd(i) + txi*tsurf_ice(i) + txo*tsurf_wat(i) ! not used again! Moorthi - cmm(i) = txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_wat(i) - chh(i) = txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_wat(i) + +! BWG, 2021/02/25: cmm=cd*wind, chh=cdq*wind, so use composite cd, cdq + q0 = max( q1(i), qmin ) + rho = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0)) + cmm(i) = cd(i)*wind(i) !txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_wat(i) + chh(i) = rho*cdq(i)*wind(i) !txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_wat(i) + !gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_wat(i) ep1d(i) = txl*ep1d_lnd(i) + txi*ep1d_ice(i) + txo*ep1d_wat(i) !weasd(i) = txl*weasd_lnd(i) + txi*weasd_ice(i) + txo*weasd_wat(i) @@ -461,6 +469,8 @@ subroutine GFS_surface_composites_post_run ( qss(i) = txl*qss_lnd(i) + txi*qss_ice(i) + txo*qss_wat(i) gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_wat(i) endif + +! BWG, 2021/02/25: Need to change composite skin temperature base on ULW (Fanglin) tsfc(i) = txl*tsfc_lnd(i) + txi*tice(i) + txo*tsfc_wat(i) zorll(i) = zorl_lnd(i) diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 65411d8e9..852b4e8ee 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -903,6 +903,24 @@ type = integer intent = in optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rvrdm1] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [cplflx] standard_name = flag_for_flux_coupling long_name = flag controlling cplflx collection (default off) @@ -967,6 +985,42 @@ type = logical intent = in optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer + long_name = surface layer mean temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = surface layer mean specific humidity + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[prsl1] + standard_name = air_pressure_at_lowest_model_layer + long_name = surface layer mean pressure + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [landfrac] standard_name = land_area_fraction long_name = fraction of horizontal grid area occupied by land diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index b7ef1ea68..f52001434 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -71,17 +71,19 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & tskin_wat, tskin_lnd, tskin_ice, & !intent(in) & tsurf_wat, tsurf_lnd, tsurf_ice, & !intent(in) & snwdph_wat,snwdph_lnd,snwdph_ice, & !intent(in) + & landfrac, cice, & !intent(in) -- for use with frac_grid + & islmsk, frac_grid, & !intent(in) -- for use with frac_grid & z0rl_wat, z0rl_lnd, z0rl_ice, & !intent(inout) - & z0rl_wav, & !intent(inout) - & ustar_wat, ustar_lnd, ustar_ice, & !intent(inout) - & cm_wat, cm_lnd, cm_ice, & !intent(inout) - & ch_wat, ch_lnd, ch_ice, & !intent(inout) - & rb_wat, rb_lnd, rb_ice, & !intent(inout) - & stress_wat,stress_lnd,stress_ice, & !intent(inout) - & fm_wat, fm_lnd, fm_ice, & !intent(inout) - & fh_wat, fh_lnd, fh_ice, & !intent(inout) - & fm10_wat, fm10_lnd, fm10_ice, & !intent(inout) - & fh2_wat, fh2_lnd, fh2_ice, & !intent(inout) + & z0rl_wav, z0rl_cmp, & !intent(inout) + & ustar_wat, ustar_lnd, ustar_ice, ustar_cmp, & !intent(inout) + & cm_wat, cm_lnd, cm_ice, cm_cmp, & !intent(inout) + & ch_wat, ch_lnd, ch_ice, ch_cmp, & !intent(inout) + & rb_wat, rb_lnd, rb_ice, rb_cmp, & !intent(inout) + & stress_wat,stress_lnd,stress_ice,stress_cmp, & !intent(inout) + & fm_wat, fm_lnd, fm_ice, fm_cmp, & !intent(inout) + & fh_wat, fh_lnd, fh_ice, fh_cmp, & !intent(inout) + & fm10_wat, fm10_lnd, fm10_ice, fm10_cmp, & !intent(inout) + & fh2_wat, fh2_lnd, fh2_ice, fh2_cmp, & !intent(inout) & errmsg, errflg) !intent(out) ! implicit none @@ -107,17 +109,25 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & snwdph_wat,snwdph_lnd,snwdph_ice real(kind=kind_phys), dimension(im), intent(in) :: z0rl_wav + + real(kind=kind_phys), dimension(im), intent(in) :: & + & landfrac, cice + + integer, dimension(im), intent(in) :: islmsk ! For compositing + + logical, intent(in) :: frac_grid ! For compositing + real(kind=kind_phys), dimension(im), intent(inout) :: & - & z0rl_wat, z0rl_lnd, z0rl_ice, & - & ustar_wat, ustar_lnd, ustar_ice, & - & cm_wat, cm_lnd, cm_ice, & - & ch_wat, ch_lnd, ch_ice, & - & rb_wat, rb_lnd, rb_ice, & - & stress_wat,stress_lnd,stress_ice, & - & fm_wat, fm_lnd, fm_ice, & - & fh_wat, fh_lnd, fh_ice, & - & fm10_wat, fm10_lnd, fm10_ice, & - & fh2_wat, fh2_lnd, fh2_ice + & z0rl_wat, z0rl_lnd, z0rl_ice, z0rl_cmp, & + & ustar_wat, ustar_lnd, ustar_ice, ustar_cmp, & + & cm_wat, cm_lnd, cm_ice, cm_cmp, & + & ch_wat, ch_lnd, ch_ice, ch_cmp, & + & rb_wat, rb_lnd, rb_ice, rb_cmp, & + & stress_wat,stress_lnd,stress_ice,stress_cmp, & + & fm_wat, fm_lnd, fm_ice, fm_cmp, & + & fh_wat, fh_lnd, fh_ice, fh_cmp, & + & fm10_wat, fm10_lnd, fm10_ice, fm10_cmp, & + & fh2_wat, fh2_lnd, fh2_ice, fh2_cmp character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -128,7 +138,14 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) real(kind=kind_phys) :: rat, thv1, restar, wind10m, & czilc, tem1, tem2, virtfac - real(kind=kind_phys) :: tvs, z0, z0max, ztmax + real(kind=kind_phys) :: tvs, z0, z0max + + real(kind=kind_phys), dimension(im) :: & + & ztmax_wat, ztmax_lnd, ztmax_ice + + real(kind=kind_phys) :: txl, txi, txo, wfrac ! For fractional + real(kind=kind_phys) :: snwdph_cmp, ztmax_cmp! For fractional + real(kind=kind_phys) :: tskin_cmp, tsurf_cmp ! For fractional ! real(kind=kind_phys), parameter :: & one=1.0_kp, zero=0.0_kp, half=0.5_kp, qmin=1.0e-8_kp @@ -166,6 +183,12 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) do i=1,im if(flag_iter(i)) then + + ! BWG: Need to initialize ztmax arrays + ztmax_lnd(i) = 1. ! log(1) = 0 + ztmax_ice(i) = 1. ! log(1) = 0 + ztmax_wat(i) = 1. ! log(1) = 0 + virtfac = one + rvrdm1 * max(q1(i),qmin) thv1 = t1(i) * prslki(i) * virtfac @@ -229,20 +252,20 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) czilc = 0.8_kp tem1 = 1.0_kp - sigmaf(i) - ztmax = z0max*exp( - tem1*tem1 + ztmax_lnd(i) = z0max*exp( - tem1*tem1 & * czilc*ca*sqrt(ustar_lnd(i)*(0.01/1.5e-05))) ! mg, sfc-perts: add surface perturbations to ztmax/z0max ratio over land if (ztpert(i) /= zero) then - ztmax = ztmax * (10.0_kp**ztpert(i)) + ztmax_lnd(i) = ztmax_lnd(i) * (10.0_kp**ztpert(i)) endif - ztmax = max(ztmax, zmin) + ztmax_lnd(i) = max(ztmax_lnd(i), zmin) ! call stability ! --- inputs: & (z1(i), snwdph_lnd(i), thv1, wind(i), - & z0max, ztmax, tvs, grav, + & z0max, ztmax_lnd(i), tvs, grav, ! --- outputs: & rb_lnd(i), fm_lnd(i), fh_lnd(i), fm10_lnd(i), fh2_lnd(i), & cm_lnd(i), ch_lnd(i), stress_lnd(i), ustar_lnd(i)) @@ -270,14 +293,14 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) czilc = 0.8_kp tem1 = 1.0_kp - sigmaf(i) - ztmax = z0max*exp( - tem1*tem1 + ztmax_ice(i) = z0max*exp( - tem1*tem1 & * czilc*ca*sqrt(ustar_ice(i)*(0.01/1.5e-05))) - ztmax = max(ztmax, 1.0e-6) + ztmax_ice(i) = max(ztmax_ice(i), 1.0e-6) ! call stability ! --- inputs: & (z1(i), snwdph_ice(i), thv1, wind(i), - & z0max, ztmax, tvs, grav, + & z0max, ztmax_ice(i), tvs, grav, ! --- outputs: & rb_ice(i), fm_ice(i), fh_ice(i), fm10_ice(i), fh2_ice(i), & cm_ice(i), ch_ice(i), stress_ice(i), ustar_ice(i)) @@ -307,12 +330,12 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! rat taken from zeng, zhao and dickinson 1997 rat = min(7.0_kp, 2.67_kp * sqrt(sqrt(restar)) - 2.57_kp) - ztmax = max(z0max * exp(-rat), zmin) + ztmax_wat(i) = max(z0max * exp(-rat), zmin) ! if (sfc_z0_type == 6) then - call znot_t_v6(wind10m, ztmax) ! 10-m wind,m/s, ztmax(m) + call znot_t_v6(wind10m, ztmax_wat(i)) ! 10-m wind,m/s, ztmax(m) else if (sfc_z0_type == 7) then - call znot_t_v7(wind10m, ztmax) ! 10-m wind,m/s, ztmax(m) + call znot_t_v7(wind10m, ztmax_wat(i)) ! 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 stop @@ -321,7 +344,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) call stability ! --- inputs: & (z1(i), snwdph_wat(i), thv1, wind(i), - & z0max, ztmax, tvs, grav, + & z0max, ztmax_wat(i), tvs, grav, ! --- outputs: & rb_wat(i), fm_wat(i), fh_wat(i), fm10_wat(i), fh2_wat(i), & cm_wat(i), ch_wat(i), stress_wat(i), ustar_wat(i)) @@ -372,6 +395,99 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) endif ! end of if(flagiter) loop enddo + ! BWG, 2021/02/23: For fractional grid, get composite values + if (frac_grid) then ! If fractional grid is on... + do i=1,im ! Loop over horizontal + if(flag_iter(i)) then + virtfac = one + rvrdm1 * max(q1(i),qmin) +#ifdef GSD_SURFACE_FLUXES_BUGFIX + thv1 = t1(i) / prslk1(i) * virtfac ! Theta-v at lowest level +#else + thv1 = t1(i) * prslki(i) * virtfac ! Theta-v at lowest level +#endif + + ! Three-way composites (fields from sfc_diff) + txl = landfrac(i) ! land fraction + wfrac = one - txl ! ocean fraction + txi = cice(i) * wfrac ! txi = ice fraction wrt whole cell + txo = max(zero, wfrac-txi) ! txo = open water fraction + + ! Composite inputs to "stability" function + snwdph_cmp = txl*snwdph_lnd(i) + txi*snwdph_ice(i) + tsurf_cmp = (txl * ch_lnd(i) * tsurf_lnd(i) & + & + txi * ch_ice(i) * tsurf_ice(i) & + & + txo * ch_wat(i) * tsurf_wat(i)) & + & / (txl * ch_lnd(i) + txi * ch_ice(i) + txo * ch_wat(i)) + tskin_cmp = (txl * ch_lnd(i) * tskin_lnd(i) & + & + txi * ch_ice(i) * tskin_ice(i) & + & + txo * ch_wat(i) * tskin_wat(i)) & + & / (txl * ch_lnd(i) + txi * ch_ice(i) + txo * ch_wat(i)) +#ifdef GSD_SURFACE_FLUXES_BUGFIX + tvs = half * (tsurf_cmp+tskin_cmp)/prsik1(i) + & * virtfac +#else + tvs = half * (tsurf_cmp+tskin_cmp) * virtfac +#endif + z0rl_cmp(i) = txl*log(z0rl_lnd(i)) + txi*log(z0rl_ice(i)) & + & + txo*log(z0rl_wat(i)) + z0rl_cmp(i) = exp(z0rl_cmp(i)) + z0max = 0.01_kp * z0rl_cmp(i) + + ztmax_cmp = txl*log(ztmax_lnd(i))+txi*log(ztmax_ice(i)) & + & + txo*log(ztmax_wat(i)) + ztmax_cmp = exp(ztmax_cmp) +! + call stability +! --- inputs: + & (z1(i), snwdph_cmp, thv1, wind(i), + & z0max, ztmax_cmp, tvs, grav, +! --- outputs: + & rb_cmp(i), fm_cmp(i), fh_cmp(i), fm10_cmp(i), fh2_cmp(i), + & cm_cmp(i), ch_cmp(i), stress_cmp(i), ustar_cmp(i)) + + endif ! end of if(flagiter) loop + enddo ! End of loop over horizontal + else ! If frac_grid is false + do i=1,im ! Loop over horizontal + if(flag_iter(i)) then + if (islmsk(i) == 1) then ! Land + z0rl_cmp(i) = z0rl_lnd(i) + ustar_cmp(i) = ustar_lnd(i) + cm_cmp(i) = cm_lnd(i) + ch_cmp(i) = ch_lnd(i) + rb_cmp(i) = rb_lnd(i) + stress_cmp(i) = stress_lnd(i) + fm_cmp(i) = fm_lnd(i) + fh_cmp(i) = fh_lnd(i) + fm10_cmp(i) = fm10_lnd(i) + fh2_cmp(i) = fh2_lnd(i) + elseif (islmsk(i) == 0) then ! Open water + z0rl_cmp(i) = z0rl_wat(i) + ustar_cmp(i) = ustar_wat(i) + cm_cmp(i) = cm_wat(i) + ch_cmp(i) = ch_wat(i) + rb_cmp(i) = rb_wat(i) + stress_cmp(i) = stress_wat(i) + fm_cmp(i) = fm_wat(i) + fh_cmp(i) = fh_wat(i) + fm10_cmp(i) = fm10_wat(i) + fh2_cmp(i) = fh2_wat(i) + else ! if (islmsk(i) == 2) ! Ice + z0rl_cmp(i) = z0rl_ice(i) + ustar_cmp(i) = ustar_ice(i) + cm_cmp(i) = cm_ice(i) + ch_cmp(i) = ch_ice(i) + rb_cmp(i) = rb_ice(i) + stress_cmp(i) = stress_ice(i) + fm_cmp(i) = fm_ice(i) + fh_cmp(i) = fh_ice(i) + fm10_cmp(i) = fm10_ice(i) + fh2_cmp(i) = fh2_ice(i) + endif + endif ! end of if(flagiter) loop + enddo ! End of loop over horizontal + endif ! End of getting composite values for fractional grid + return end subroutine sfc_diff_run !> @} diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 9f03b3bf1..4a090fa9c 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -331,6 +331,40 @@ kind = kind_phys intent = in optional = F +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[cice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[islmsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F +[frac_grid] + standard_name = flag_for_fractional_grid + long_name = flag for fractional grid + units = flag + dimensions = () + type = logical + intent = in + optional = F [z0rl_wat] standard_name = surface_roughness_length_over_ocean_interstitial long_name = surface roughness length over ocean (temporary use as interstitial) @@ -367,6 +401,15 @@ kind = kind_phys intent = in optional = F +[z0rl_cmp] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [ustar_wat] standard_name = surface_friction_velocity_over_ocean long_name = surface friction velocity over ocean @@ -394,6 +437,15 @@ kind = kind_phys intent = inout optional = F +[ustar_cmp] + standard_name = surface_friction_velocity + long_name = boundary layer parameter + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [cm_wat] standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean long_name = surface exchange coeff for momentum over ocean @@ -421,6 +473,15 @@ kind = kind_phys intent = inout optional = F +[cm_cmp] + standard_name = surface_drag_coefficient_for_momentum_in_air + long_name = surface exchange coeff for momentum + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [ch_wat] standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean long_name = surface exchange coeff heat & moisture over ocean @@ -448,6 +509,15 @@ kind = kind_phys intent = inout optional = F +[ch_cmp] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air + long_name = surface exchange coeff heat & moisture + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [rb_wat] standard_name = bulk_richardson_number_at_lowest_model_level_over_ocean long_name = bulk Richardson number at the surface over ocean @@ -475,6 +545,15 @@ kind = kind_phys intent = inout optional = F +[rb_cmp] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [stress_wat] standard_name = surface_wind_stress_over_ocean long_name = surface wind stress over ocean @@ -502,6 +581,15 @@ kind = kind_phys intent = inout optional = F +[stress_cmp] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [fm_wat] standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ocean long_name = Monin-Obukhov similarity function for momentum over ocean @@ -529,6 +617,15 @@ kind = kind_phys intent = inout optional = F +[fm_cmp] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [fh_wat] standard_name = Monin_Obukhov_similarity_function_for_heat_over_ocean long_name = Monin-Obukhov similarity function for heat over ocean @@ -556,6 +653,15 @@ kind = kind_phys intent = inout optional = F +[fh_cmp] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [fm10_wat] standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ocean long_name = Monin-Obukhov similarity parameter for momentum at 10m over ocean @@ -583,6 +689,15 @@ kind = kind_phys intent = inout optional = F +[fm10_cmp] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m + long_name = Monin-Obukhov similarity parameter for momentum at 10m + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [fh2_wat] standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ocean long_name = Monin-Obukhov similarity parameter for heat at 2m over ocean @@ -610,6 +725,15 @@ kind = kind_phys intent = inout optional = F +[fh2_cmp] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m + long_name = Monin-Obukhov similarity parameter for heat at 2m + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From e87157316861a4992bda5b5e86f112ee735e59b7 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 15 Apr 2021 16:25:43 -0600 Subject: [PATCH 09/74] Move calculation of surface albedo/emissivity out of rrtmg(p) pre schemes into GFS_radiation_surface, consolidate, fix bugs --- CODEOWNERS | 2 +- physics/GFS_phys_time_vary.fv3.F90 | 1 + physics/GFS_radiation_surface.F90 | 201 +++++++++++ physics/GFS_radiation_surface.meta | 513 +++++++++++++++++++++++++++++ physics/GFS_rrtmg_setup.F90 | 57 +--- physics/GFS_rrtmg_setup.meta | 20 +- physics/GFS_rrtmgp_setup.F90 | 28 +- physics/GFS_rrtmgp_setup.meta | 18 +- physics/GFS_rrtmgp_sw_pre.F90 | 126 ++----- physics/GFS_rrtmgp_sw_pre.meta | 422 ++---------------------- physics/GFS_surface_composites.F90 | 11 +- physics/radiation_surface.f | 368 +++++---------------- physics/radiation_surface.meta | 15 + physics/radlw_main.F90 | 66 ++-- physics/rrtmg_lw_pre.F90 | 43 +-- physics/rrtmg_lw_pre.meta | 221 +------------ physics/rrtmg_sw_pre.F90 | 76 +---- physics/rrtmg_sw_pre.meta | 363 -------------------- physics/rrtmgp_lw_pre.F90 | 51 +-- physics/rrtmgp_lw_pre.meta | 205 +----------- physics/sfc_noahmp_drv.meta | 2 +- 21 files changed, 947 insertions(+), 1862 deletions(-) create mode 100644 physics/GFS_radiation_surface.F90 create mode 100644 physics/GFS_radiation_surface.meta create mode 100644 physics/radiation_surface.meta diff --git a/CODEOWNERS b/CODEOWNERS index b6c597371..0d5230f89 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -3,7 +3,7 @@ # These owners will be the default owners for everything in the repo. #* @defunkt -* @DomHeinzeller +* @climbfuji @llpcarson @grantfirl @JulieSchramm # Order is important. The last matching pattern has the most precedence. # So if a pull request only touches javascript files, only these owners diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 67c266e7e..a23c359b5 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -378,6 +378,7 @@ subroutine GFS_phys_time_vary_init ( sncovr_ice(:) = sncovr(:) endif endif + !$OMP end sections !$OMP end parallel diff --git a/physics/GFS_radiation_surface.F90 b/physics/GFS_radiation_surface.F90 new file mode 100644 index 000000000..4412407b8 --- /dev/null +++ b/physics/GFS_radiation_surface.F90 @@ -0,0 +1,201 @@ +!>\file GFS_radiation_surface.f90 +!! This file contains calls to module_radiation_surface::setemis() to set up +!! surface emissivity for LW radiation and to module_radiation_surface::setalb() +!! to set up surface albedo for SW radiation. + module GFS_radiation_surface + + use machine, only: kind_phys + + contains + +!>\defgroup GFS_radiation_surface GFS radiation surface +!! @{ +!> \section arg_table_GFS_radiation_surface_init Argument Table +!! \htmlinclude GFS_radiation_surface_init.html +!! + subroutine GFS_radiation_surface_init (me, sfcalb, ialb, iems, errmsg, errflg) + + use physparam, only: ialbflg, iemsflg + use module_radiation_surface, only: NF_ALBD, sfc_init + + implicit none + + integer, intent(in) :: me, ialb, iems + real(kind=kind_phys), dimension(:,:), intent(in) :: sfcalb + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Consistency check that the number of albedo components in array + ! sfcalb matches the parameter NF_ALBD from radiation_surface.f + if (size(sfcalb,dim=2)/=NF_ALBD) then + errmsg = 'Error in GFS_radiation_surface_init: second' // & + ' dimension of array sfcalb does not match' // & + ' parameter NF_ALBD in radiation_surface.f' + errflg = 1 + end if + + ialbflg= ialb ! surface albedo control flag + iemsflg= iems ! surface emissivity control flag + + if ( me == 0 ) then + print *,' In GFS_radiation_surface_init, before calling sfc_init' + print *,' ialb=',ialb,' iems=',iems + end if + + ! Call surface initialization routine + call sfc_init ( me, errmsg, errflg ) + + end subroutine GFS_radiation_surface_init + + +!> \section arg_table_GFS_radiation_surface_run Argument Table +!! \htmlinclude GFS_radiation_surface_run.html +!! + subroutine GFS_radiation_surface_run ( & + im, frac_grid, lslwr, lsswr, lsm, lsm_noahmp, lsm_ruc, & + vtype, xlat, xlon, slmsk, lndp_type, n_var_lndp, sfc_alb_pert, & + lndp_var_list, lndp_prt_list, landfrac, snowd, sncovr, & + sncovr_ice, fice, zorl, hprime, tsfg, tsfa, tisfc, coszen, & + min_seaice, alvsf, alnsf, alvwf, alnwf, facsf, facwf, & + semis_lnd, semis_ice, snoalb, & + albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & + albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & + semisbase, semis, sfcalb, sfc_alb_dif, errmsg, errflg) + + use module_radiation_surface, only: f_zero, f_one, & + epsln, NF_ALBD, & + setemis, setalb + + implicit none + + integer, intent(in) :: im + logical, intent(in) :: frac_grid, lslwr, lsswr + integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc, lndp_type, n_var_lndp + real(kind=kind_phys), intent(in) :: min_seaice + + real(kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, vtype, slmsk, & + sfc_alb_pert, lndp_prt_list, & + landfrac, snowd, sncovr, & + sncovr_ice, fice, zorl, & + hprime, tsfg, tsfa, tisfc, & + coszen, alvsf, alnsf, alvwf, & + alnwf, facsf, facwf, & + semis_lnd, semis_ice, snoalb + character(len=3) , dimension(:), intent(in) :: lndp_var_list + real(kind=kind_phys), dimension(:), intent(in) :: albdvis_lnd, albdnir_lnd, & + albivis_lnd, albinir_lnd + real(kind=kind_phys), dimension(:), intent(in) :: albdvis_ice, albdnir_ice, & + albivis_ice, albinir_ice + real(kind=kind_phys), dimension(im), intent(out) :: semisbase, semis + real(kind=kind_phys), dimension(:,:), intent(out) :: sfcalb + real(kind=kind_phys), dimension(:), intent(out) :: sfc_alb_dif + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: i + real(kind=kind_phys) :: lndp_alb + real(kind=kind_phys), dimension(im) :: fracl, fraci, fraco + logical, dimension(im) :: icy + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Intialize intent(out) variables + sfcalb = 0.0 + + ! Return immediately if neither shortwave nor longwave radiation are called + if (.not. lsswr .and. .not. lslwr) return + + ! Set up land/ice/ocean fractions for emissivity and albedo calculations + if (.not. frac_grid) then + do i=1,im + if (slmsk(i) == 1) then + fracl(i) = f_one + fraci(i) = f_zero + fraco(i) = f_zero + icy(i) = .false. + else + fracl(i) = f_zero + fraco(i) = f_one + if(fice(i) < min_seaice) then + fraci(i) = f_zero + icy(i) = .false. + else + fraci(i) = fraco(i) * fice(i) + icy(i) = .true. + endif + fraco(i) = max(f_zero, fraco(i)-fraci(i)) + endif + enddo + else + do i=1,im + fracl(i) = landfrac(i) + fraco(i) = max(f_zero, f_one - fracl(i)) + if(fice(i) < min_seaice) then + fraci(i) = f_zero + icy(i) = .false. + else + fraci(i) = fraco(i) * fice(i) + icy(i) = .true. + endif + fraco(i) = max(f_zero, fraco(i)-fraci(i)) + enddo + endif + + if (lslwr) then +!> - Call module_radiation_surface::setemis(),to set up surface +!! emissivity for LW radiation. + call setemis (lsm, lsm_noahmp, lsm_ruc, vtype, landfrac, & + frac_grid, min_seaice, xlon, xlat, slmsk, & + snowd, sncovr, sncovr_ice, zorl, tsfg, tsfa, & + hprime, semis_lnd, semis_ice, im, & + fracl, fraco, fraci, icy, & ! --- inputs + semisbase, semis) ! --- outputs + ! DH* required? or a bad idea? wasn't there beforehand, neither for RRTMG nor RRTMGP + else + semis = 0.0 + ! *DH + endif + + if (lsswr) then +!> - Set surface albedo perturbation, if requested + lndp_alb = -999. + if (lndp_type==1) then + do i =1,n_var_lndp + if (lndp_var_list(i) == 'alb') then + lndp_alb = lndp_prt_list(i) + endif + enddo + endif + +!> - Call module_radiation_surface::setalb(),to set up surface +!! albedor for SW radiation. + + call setalb (slmsk, lsm, lsm_noahmp, lsm_ruc, snowd, sncovr, sncovr_ice, snoalb, & + zorl, coszen, tsfg, tsfa, hprime, landfrac, frac_grid, min_seaice, & + alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & + albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & + albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & + IM, sfc_alb_pert, lndp_alb, fracl, fraco, fraci, icy, & ! --- inputs + sfcalb ) ! --- outputs + +!> -# Approximate mean surface albedo from vis- and nir- diffuse values. + sfc_alb_dif(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) + ! DH* needed? RRTMGP was doing this, RRTMG not + else + sfc_alb_dif(:) = 0.0 + ! *DH + endif + + end subroutine GFS_radiation_surface_run + + subroutine GFS_radiation_surface_finalize () + end subroutine GFS_radiation_surface_finalize +!! @} + end module GFS_radiation_surface diff --git a/physics/GFS_radiation_surface.meta b/physics/GFS_radiation_surface.meta new file mode 100644 index 000000000..6c770575c --- /dev/null +++ b/physics/GFS_radiation_surface.meta @@ -0,0 +1,513 @@ +[ccpp-table-properties] + name = GFS_radiation_surface + type = scheme + dependencies = iounitdef.f,machine.F,physparam.f,radiation_surface.f,set_soilveg_ruc.F90,namelist_soilveg_ruc.F90 + +######################################################################## +[ccpp-arg-table] + name = GFS_radiation_surface_init + type = scheme +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[sfcalb] + standard_name = surface_albedo_components + long_name = surface albedo IR/UV/VIS components + units = frac + dimensions = (horizontal_dimension,number_of_components_for_surface_albedo) + type = real + kind = kind_phys + intent = in + optional = F +[ialb] + standard_name = flag_for_using_climatology_albedo + long_name = flag for using climatology alb, based on sfc type + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iems] + standard_name = flag_for_surface_emissivity_control + long_name = surface emissivity control flag, use fixed value of 1 + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_radiation_surface_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[frac_grid] + standard_name = flag_for_fractional_grid + long_name = flag for fractional grid + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[vtype] + standard_name = vegetation_type_classification_real + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[xlat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[xlon] + standard_name = longitude + long_name = longitude + units = radian + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[lndp_type] + standard_name = index_for_stochastic_land_surface_perturbation_type + long_name = index for stochastic land surface perturbations type + units = index + dimensions = () + type = integer + intent = in + optional = F +[n_var_lndp] + standard_name = number_of_land_surface_variables_perturbed + long_name = number of land surface variables perturbed + units = count + dimensions = () + type = integer + intent = in + optional = F +[sfc_alb_pert] + standard_name = surface_albedo_perturbation + long_name = surface albedo perturbation + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[lndp_var_list] + standard_name = variables_to_be_perturbed_for_landperts + long_name = variables to be perturbed for landperts + units = none + dimensions = (number_of_land_surface_variables_perturbed) + type = character + kind = len=3 + intent = in + optional = F +[lndp_prt_list] + standard_name = magnitude_of_perturbations_for_landperts + long_name = magnitude of perturbations for landperts + units = variable + dimensions = (number_of_land_surface_variables_perturbed) + type = real + kind = kind_phys + intent = in + optional = F +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[snowd] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sncovr] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sncovr_ice] + standard_name = surface_snow_area_fraction_over_ice + long_name = surface snow area fraction over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[hprime] + standard_name = standard_deviation_of_subgrid_orography + long_name = standard deviation of subgrid orography + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tsfg] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tisfc] + standard_name = sea_ice_temperature + long_name = sea ice surface skin temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[coszen] + standard_name = cosine_of_zenith_angle + long_name = mean cos of zenith angle over rad call period + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[min_seaice] + standard_name = sea_ice_minimum + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[alvsf] + standard_name = mean_vis_albedo_with_strong_cosz_dependency + long_name = mean vis albedo with strong cosz dependency + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[alnsf] + standard_name = mean_nir_albedo_with_strong_cosz_dependency + long_name = mean nir albedo with strong cosz dependency + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[alvwf] + standard_name = mean_vis_albedo_with_weak_cosz_dependency + long_name = mean vis albedo with weak cosz dependency + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[alnwf] + standard_name = mean_nir_albedo_with_weak_cosz_dependency + long_name = mean nir albedo with weak cosz dependency + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[facsf] + standard_name =fractional_coverage_with_strong_cosz_dependency + long_name = fractional coverage with strong cosz dependency + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[facwf] + standard_name = fractional_coverage_with_weak_cosz_dependency + long_name = fractional coverage with weak cosz dependency + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[semis_lnd] + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[semis_ice] + standard_name = surface_longwave_emissivity_over_ice + long_name = surface lw emissivity in fraction over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albdvis_lnd] + standard_name = surface_albedo_direct_visible_over_land + long_name = direct surface albedo visible band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albdnir_lnd] + standard_name = surface_albedo_direct_NIR_over_land + long_name = direct surface albedo NIR band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albivis_lnd] + standard_name = surface_albedo_diffuse_visible_over_land + long_name = diffuse surface albedo visible band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albinir_lnd] + standard_name = surface_albedo_diffuse_NIR_over_land + long_name = diffuse surface albedo NIR band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albdvis_ice] + standard_name = surface_albedo_direct_visible_over_ice + long_name = direct surface albedo visible band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albdnir_ice] + standard_name = surface_albedo_direct_NIR_over_ice + long_name = direct surface albedo NIR band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albivis_ice] + standard_name = surface_albedo_diffuse_visible_over_ice + long_name = diffuse surface albedo visible band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albinir_ice] + standard_name = surface_albedo_diffuse_NIR_over_ice + long_name = diffuse surface albedo NIR band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[semisbase] + standard_name = baseline_surface_longwave_emissivity + long_name = baseline surface lw emissivity in fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[semis] + standard_name = surface_longwave_emissivity + long_name = surface lw emissivity in fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[sfcalb] + standard_name = surface_albedo_components + long_name = surface albedo IR/UV/VIS components + units = frac + dimensions = (horizontal_loop_extent,number_of_components_for_surface_albedo) + type = real + kind = kind_phys + intent = out + optional = F +[sfc_alb_dif] + standard_name = surface_diffused_shortwave_albedo + long_name = mean surface diffused sw albedo + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/GFS_rrtmg_setup.F90 index 85ffe7d67..68760f59e 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -2,11 +2,10 @@ !! This file contains module GFS_rrtmg_setup - use physparam, only : isolar , ictmflg, ico2flg, ioznflg, iaerflg,& -! & iaermdl, laswflg, lalwflg, lavoflg, icldflg, & + use physparam, only : isolar , ictmflg, ico2flg, ioznflg, iaerflg, & & iaermdl, icldflg, & & iovrRad=>iovr, lcrick , lcnorm , lnoprec, & - & ialbflg, iemsflg, isubcsw, isubclw, ivflip , ipsd0, & + & isubcsw, isubclw, ivflip , ipsd0, & & iswcliq, & & kind_phys @@ -44,7 +43,7 @@ module GFS_rrtmg_setup !! \htmlinclude GFS_rrtmg_setup_init.html !! subroutine GFS_rrtmg_setup_init ( & - si, levr, ictm, isol, ico2, iaer, ialb, iems, ntcw, & + si, levr, ictm, isol, ico2, iaer, ntcw, & num_p3d, npdf3d, ntoz, iovr, isubc_sw, isubc_lw, & icliq_sw, crick_proof, ccnorm, & imp_physics, & @@ -106,15 +105,6 @@ subroutine GFS_rrtmg_setup_init ( & ! =1 include tropspheric aerosols for lw ! ! c: =0 no topospheric aerosol in sw radiation ! ! =1 include tropspheric aerosols for sw ! -! ialb : control flag for surface albedo schemes ! -! =0: climatology, based on surface veg types ! -! =1: modis retrieval based surface albedo scheme ! -! iems : ab 2-digit control flag ! -! a: =0 set sfc air/ground t same for lw radiation ! -! =1 set sfc air/ground t diff for lw radiation ! -! b: =0 use fixed sfc emissivity=1.0 (black-body) ! -! =1 use varying climtology sfc emiss (veg based)! -! =2 future development (not yet) ! ! ntcw :=0 no cloud condensate calculated ! ! >0 array index location for cloud condensate ! ! num_p3d :=3: ferrier's microphysics cloud scheme ! @@ -158,9 +148,6 @@ subroutine GFS_rrtmg_setup_init ( & use module_radsw_parameters, only: NBDSW use module_radlw_parameters, only: NBDLW use module_radiation_aerosols,only: NF_AELW, NF_AESW, NSPC1 - use module_radiation_clouds, only: NF_CLDS - use module_radiation_gases, only: NF_VGAS - use module_radiation_surface, only: NF_ALBD implicit none @@ -171,8 +158,6 @@ subroutine GFS_rrtmg_setup_init ( & integer, intent(in) :: isol integer, intent(in) :: ico2 integer, intent(in) :: iaer - integer, intent(in) :: ialb - integer, intent(in) :: iems integer, intent(in) :: ntcw integer, intent(in) :: num_p3d integer, intent(in) :: npdf3d @@ -277,9 +262,6 @@ subroutine GFS_rrtmg_setup_init ( & isubcsw = isubc_sw ! sub-column cloud approx flag in sw radiation isubclw = isubc_lw ! sub-column cloud approx flag in lw radiation - ialbflg= ialb ! surface albedo control flag - iemsflg= iems ! surface emissivity control flag - ivflip = iflip ! vertical index direction control flag ! --- assign initial permutation seed for mcica cloud-radiation @@ -292,7 +274,7 @@ subroutine GFS_rrtmg_setup_init ( & print *,' In rad_initialize (GFS_rrtmg_setup_init), before calling radinit' print *,' si =',si print *,' levr=',levr,' ictm=',ictm,' isol=',isol,' ico2=',ico2,& - & ' iaer=',iaer,' ialb=',ialb,' iems=',iems,' ntcw=',ntcw + & ' iaer=',iaer,' ntcw=',ntcw print *,' np3d=',num_p3d,' ntoz=',ntoz, & & ' iovr=',iovr,' isubc_sw=',isubc_sw, & & ' isubc_lw=',isubc_lw,' icliq_sw=',icliq_sw, & @@ -448,15 +430,6 @@ subroutine radinit( si, NLAY, imp_physics, me ) ! ioznflg : ozone data source control flag ! ! =0: use climatological ozone profile ! ! =1: use interactive ozone profile ! -! ialbflg : albedo scheme control flag ! -! =0: climatology, based on surface veg types ! -! =1: modis retrieval based surface albedo scheme ! -! iemsflg : emissivity scheme cntrl flag (ab 2-digit integer) ! -! a:=0 set sfc air/ground t same for lw radiation ! -! =1 set sfc air/ground t diff for lw radiation ! -! b:=0 use fixed sfc emissivity=1.0 (black-body) ! -! =1 use varying climtology sfc emiss (veg based) ! -! =2 future development (not yet) ! ! icldflg : cloud optical property scheme control flag ! ! =0: use diagnostic cloud scheme ! ! =1: use prognostic cloud scheme (default) ! @@ -489,7 +462,7 @@ subroutine radinit( si, NLAY, imp_physics, me ) ! =1: index from surface to toa ! ! ! ! subroutines called: sol_init, aer_init, gas_init, cld_init, ! -! sfc_init, rlwinit, rswinit ! +! rlwinit, rswinit ! ! ! ! usage: call radinit ! ! ! @@ -499,9 +472,7 @@ subroutine radinit( si, NLAY, imp_physics, me ) use module_radiation_astronomy, only : sol_init use module_radiation_aerosols, only : aer_init use module_radiation_gases, only : gas_init - use module_radiation_surface, only : sfc_init use module_radiation_clouds, only : cld_init - ! DH* these should be called by rrtmg_lw_init and rrtmg_sw_init! use rrtmg_lw, only : rlwinit use rrtmg_sw, only : rswinit @@ -521,16 +492,6 @@ subroutine radinit( si, NLAY, imp_physics, me ) ! !> -# Set up control variables and external module variables in !! module physparam -#if 0 - ! DH* WHAT IS THIS? - ! GFS_radiation_driver.F90 may in the future initialize air/ground - ! temperature differently; however, this is not used at the moment - ! and as such we avoid the difficulty of dealing with exchanging - ! itsfc between GFS_rrtmg_setup and a yet-to-be-created/-used - ! interstitial routine (or GFS_radiation_driver.F90) - itsfc = iemsflg / 10 ! sfc air/ground temp control - ! *DH -#endif loz1st = (ioznflg == 0) ! first-time clim ozone data read flag month0 = 0 iyear0 = 0 @@ -543,7 +504,7 @@ subroutine radinit( si, NLAY, imp_physics, me ) print *, VTAGRAD !print out version tag print *,' - Selected Control Flag settings: ICTMflg=',ictmflg, & & ' ISOLar =',isolar, ' ICO2flg=',ico2flg,' IAERflg=',iaerflg, & - & ' IALBflg=',ialbflg,' IEMSflg=',iemsflg,' ICLDflg=',icldflg, & + & ' ICLDflg=',icldflg, & & ' IMP_PHYSICS=',imp_physics,' IOZNflg=',ioznflg print *,' IVFLIP=',ivflip,' IOVR=',iovrRad, & & ' ISUBCSW=',isubcsw,' ISUBCLW=',isubclw @@ -598,8 +559,6 @@ subroutine radinit( si, NLAY, imp_physics, me ) !! call module_radiation_aerosols::aer_init() !! - CO2 and other gases intialization routine: !! call module_radiation_gases::gas_init() -!! - surface intialization routine: -!! call module_radiation_surface::sfc_init() !! - cloud initialization routine: !! call module_radiation_clouds::cld_init() !! - LW radiation initialization routine: @@ -614,8 +573,6 @@ subroutine radinit( si, NLAY, imp_physics, me ) call gas_init ( me ) ! --- ... co2 and other gases initialization routine - call sfc_init ( me ) ! --- ... surface initialization routine - call cld_init ( si, NLAY, imp_physics, me) ! --- ... cloud initialization routine call rlwinit ( me ) ! --- ... lw radiation initialization routine @@ -623,7 +580,7 @@ subroutine radinit( si, NLAY, imp_physics, me ) call rswinit ( me ) ! --- ... sw radiation initialization routine ! return -!................................... +! end subroutine radinit !----------------------------------- diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index 513594ab2..e2543513c 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -1,8 +1,8 @@ [ccpp-table-properties] name = GFS_rrtmg_setup type = scheme - dependencies = iounitdef.f,module_bfmicrophysics.f,physparam.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f, - dependencies = module_mp_thompson.F90,radiation_gases.f,radiation_surface.f,radlw_main.F90,radlw_param.f,radsw_main.F90,radsw_param.f, + dependencies = iounitdef.f,module_bfmicrophysics.f,physparam.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f + dependencies = module_mp_thompson.F90,radiation_gases.f,radlw_main.F90,radlw_param.f,radsw_main.F90,radsw_param.f ######################################################################## [ccpp-arg-table] @@ -57,22 +57,6 @@ type = integer intent = in optional = F -[ialb] - standard_name = flag_for_using_climatology_albedo - long_name = flag for using climatology alb, based on sfc type - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iems] - standard_name = flag_for_surface_emissivity_control - long_name = surface emissivity control flag, use fixed value of 1 - units = flag - dimensions = () - type = integer - intent = in - optional = F [ntcw] standard_name = index_for_liquid_cloud_condensate long_name = tracer index for cloud condensate (or liquid water) diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index 308456e06..6849bb144 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -5,12 +5,11 @@ module GFS_rrtmgp_setup use module_radiation_astronomy, only : sol_init, sol_update use module_radiation_aerosols, only : aer_init, aer_update use module_radiation_gases, only : gas_init, gas_update - use module_radiation_surface, only : sfc_init use GFS_cloud_diagnostics, only : hml_cloud_diagnostics_initialize ! *NOTE* These parameters below are required radiation_****** modules. They are not ! directly used by the RRTMGP routines. use physparam, only : isolar, ictmflg, ico2flg, ioznflg, iaerflg, & - iaermdl, ialbflg, iemsflg, ivflip + iaermdl, ivflip implicit none public GFS_rrtmgp_setup_init, GFS_rrtmgp_setup_timestep_init, GFS_rrtmgp_setup_finalize @@ -40,10 +39,10 @@ module GFS_rrtmgp_setup !! \section arg_table_GFS_rrtmgp_setup_init !! \htmlinclude GFS_rrtmgp_setup_init.html !! - subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics_gfdl, & - imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & - imp_physics_zhao_carr_pdf, imp_physics_mg, si, levr, ictm, isol, ico2, iaer, ialb, & - iems, ntcw, num_p3d, ntoz, iovr, isubc_sw, isubc_lw, icliq_sw, crick_proof, ccnorm, & + subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics_gfdl, & + imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & + imp_physics_zhao_carr_pdf, imp_physics_mg, si, levr, ictm, isol, ico2, iaer, & + ntcw, num_p3d, ntoz, iovr, isubc_sw, isubc_lw, icliq_sw, crick_proof, ccnorm, & norad_precip, idate, iflip, me, errmsg, errflg) ! Inputs @@ -58,8 +57,8 @@ subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics imp_physics_mg ! Flag for MG scheme real(kind_phys), dimension(levr+1), intent(in) :: & si - integer, intent(in) :: levr, ictm, isol, ico2, iaer, ialb, iems, & - ntcw, num_p3d, ntoz, iovr, isubc_sw, isubc_lw, & + integer, intent(in) :: levr, ictm, isol, ico2, iaer, & + ntcw, num_p3d, ntoz, iovr, isubc_sw, isubc_lw, & icliq_sw, iflip, me logical, intent(in) :: & crick_proof, ccnorm, norad_precip @@ -81,8 +80,6 @@ subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics ictmflg = ictm ! data ic time/date control flag ico2flg = ico2 ! co2 data source control flag ioznflg = ntoz ! ozone data source control flag - ialbflg = ialb ! surface albedo control flag - iemsflg = iems ! surface emissivity control flag ivflip = iflip ! vertical index direction control flag if ( ictm==0 .or. ictm==-2 ) then @@ -105,8 +102,6 @@ subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics ' isol = ',isol, & ' ico2 = ',ico2, & ' iaer = ',iaer, & - ' ialb = ',ialb, & - ' iems = ',iems, & ' ntcw = ',ntcw print *,' np3d = ',num_p3d, & ' ntoz = ',ntoz, & @@ -118,14 +113,6 @@ subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics ' me = ',me endif -#if 0 - ! GFS_radiation_driver.F90 may in the future initialize air/ground - ! temperature differently; however, this is not used at the moment - ! and as such we avoid the difficulty of dealing with exchanging - ! itsfc between GFS_rrtmgp_setup and a yet-to-be-created/-used - ! interstitial routine (or GFS_radiation_driver.F90) - itsfc = iemsflg / 10 ! sfc air/ground temp control -#endif loz1st = (ioznflg == 0) ! first-time clim ozone data read flag month0 = 0 iyear0 = 0 @@ -135,7 +122,6 @@ subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics call sol_init ( me ) call aer_init ( levr, me ) call gas_init ( me ) - call sfc_init ( me ) call hml_cloud_diagnostics_initialize(imp_physics, imp_physics_fer_hires, & imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_mg, levr, me, si,& diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index 1237184d8..923027716 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -2,7 +2,7 @@ name = GFS_rrtmgp_setup type = scheme dependencies = iounitdef.f,machine.F,module_bfmicrophysics.f,physparam.f,radiation_aerosols.f,radiation_astronomy.f - dependencies = module_mp_thompson.F90,radiation_clouds.f,radiation_gases.f,radiation_surface.f + dependencies = module_mp_thompson.F90,radiation_clouds.f,radiation_gases.f ######################################################################## [ccpp-arg-table] @@ -121,22 +121,6 @@ type = integer intent = in optional = F -[ialb] - standard_name = flag_for_using_climatology_albedo - long_name = flag for using climatology alb, based on sfc type - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iems] - standard_name = flag_for_surface_emissivity_control - long_name = surface emissivity control flag, use fixed value of 1 - units = flag - dimensions = () - type = integer - intent = in - optional = F [ntcw] standard_name = index_for_liquid_cloud_condensate long_name = tracer index for cloud condensate (or liquid water) diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 572ea08da..0a91a48b0 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -1,18 +1,13 @@ module GFS_rrtmgp_sw_pre use machine, only: & kind_phys ! Working type - use module_radiation_astronomy,only: & + use module_radiation_astronomy, only: & coszmn ! Function to compute cos(SZA) - use module_radiation_surface, only: & - NF_ALBD, & ! Number of surface albedo categories (4; nir-direct, nir-diffuse, uvvis-direct, uvvis-diffuse) - setalb ! Routine to compute surface albedo - use surface_perturbation, only: & - cdfnor ! Routine to compute CDF (used to compute percentiles) use mo_gas_optics_rrtmgp, only: & ty_gas_optics_rrtmgp use rrtmgp_sw_gas_optics, only: sw_gas_props - public GFS_rrtmgp_sw_pre_run,GFS_rrtmgp_sw_pre_init,GFS_rrtmgp_sw_pre_finalize - + public GFS_rrtmgp_sw_pre_run, GFS_rrtmgp_sw_pre_init, GFS_rrtmgp_sw_pre_finalize + contains ! ######################################################################################### @@ -27,77 +22,25 @@ end subroutine GFS_rrtmgp_sw_pre_init !> \section arg_table_GFS_rrtmgp_sw_pre_run !! \htmlinclude GFS_rrtmgp_sw_pre.html !! - subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp, lndp_var_list, & - lndp_prt_list, lsm, lsm_noahmp, lsm_ruc, doSWrad, solhr, lon, coslat, sinlat, & - snowd, sncovr, sncovr_ice, snoalb, zorl, tsfg, tsfa, hprime, landfrac, frac_grid, & - min_seaice, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, albdvis_lnd, & - albdnir_lnd, albivis_lnd, albinir_lnd, albdvis_ice, albdnir_lnd, albivis_ice, & - albinir_ice, lsmask, sfc_wts, p_lay, tv_lay, relhum, p_lev, & - nday, idxday, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, & - sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, errmsg, errflg) - - ! Inputs + subroutine GFS_rrtmgp_sw_pre_run(me, nCol, doSWrad, solhr, lon, coslat, sinlat, & + nday, idxday, coszen, coszdg, sfcalb, sfc_alb_nir_dir, sfc_alb_nir_dif, & + sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, errmsg, errflg) + + ! Input integer, intent(in) :: & me, & ! Current MPI rank - nCol, & ! Number of horizontal grid points - nLev, & ! Number of vertical layers - lsm, & ! LSM option - lsm_noahmp, & ! option for Noah MP LSM - lsm_ruc, & ! option for RUC LSM - n_var_lndp, & ! Number of surface variables perturbed - lndp_type ! Type of land perturbations scheme used - character(len=3), dimension(n_var_lndp), intent(in) :: & - lndp_var_list - real(kind_phys), dimension(n_var_lndp), intent(in) :: & - lndp_prt_list + nCol ! Number of horizontal grid points + logical,intent(in) :: & doSWrad ! Call RRTMGP SW radiation? - logical,intent(in) :: & - frac_grid ! Logical flag for fractional grid real(kind_phys), intent(in) :: & solhr ! Time in hours after 00z at the current timestep - real(kind_phys), intent(in) :: & - min_seaice ! Sea ice threashold real(kind_phys), dimension(nCol), intent(in) :: & - lsmask, & ! Landmask: sea/land/ice=0/1/2 lon, & ! Longitude coslat, & ! Cosine(latitude) - sinlat, & ! Sine(latitude) - snowd, & ! Water equivalent snow depth (mm) - sncovr, & ! Surface snow area fraction over land (frac) - sncovr_ice, & ! Surface snow area fraction over ice (frac) - snoalb, & ! Maximum snow albedo (frac) - zorl, & ! Surface roughness length (cm) - tsfg, & ! Surface ground temperature for radiation (K) - tsfa, & ! Lowest model layer air temperature for radiation (K) - hprime, & ! Standard deviation of subgrid orography (m) - landfrac, & ! Fraction of land in the grid cell (frac) - alvsf, & ! Mean vis albedo with strong cosz dependency (frac) - alnsf, & ! Mean nir albedo with strong cosz dependency (frac) - alvwf, & ! Mean vis albedo with weak cosz dependency (frac) - alnwf, & ! Mean nir albedo with weak cosz dependency (frac) - facsf, & ! Fractional coverage with strong cosz dependency (frac) - facwf, & ! Fractional coverage with weak cosz dependency (frac) - fice, & ! Ice fraction over open water (frac) - tisfc ! Sea ice surface skin temperature (K) - real(kind_phys), dimension(:), intent(in) :: & - albdvis_lnd, & ! surface albedo from lsm (direct,vis) (frac) - albdnir_lnd, & ! surface albedo from lsm (direct,nir) (frac) - albivis_lnd, & ! surface albedo from lsm (diffuse,vis) (frac) - albinir_lnd, & ! surface albedo from lsm (diffuse,nir) (frac) - albdvis_ice, & ! surface albedo from ice model (direct,vis) (frac) - albdnir_ice, & ! surface albedo from ice model (direct,nir) (frac) - albivis_ice, & ! surface albedo from ice model (diffuse,vis) (frac) - albinir_ice ! surface albedo from ice model (diffuse,nir) (frac) - - real(kind_phys), dimension(nCol,n_var_lndp), intent(in) :: & - sfc_wts ! Weights for stochastic surface physics perturbation () - real(kind_phys), dimension(nCol,nLev),intent(in) :: & - p_lay, & ! Layer pressure - tv_lay, & ! Layer virtual-temperature - relhum ! Layer relative-humidity - real(kind_phys), dimension(nCol,nLev+1),intent(in) :: & - p_lev ! Pressure @ layer interfaces (Pa) + sinlat ! Sine(latitude) + + real(kind_phys), dimension(:,:), intent(in) :: sfcalb ! Outputs integer, intent(out) :: & @@ -106,23 +49,19 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp, lndp_var idxday ! Indices for daylit points real(kind_phys), dimension(ncol), intent(inout) :: & coszen, & ! Cosine of SZA - coszdg, & ! Cosine of SZA, daytime - sfc_alb_dif ! Mean surface diffused (nIR+uvvis) sw albedo + coszdg ! Cosine of SZA, daytime real(kind_phys), dimension(sw_gas_props%get_nband(),ncol), intent(out) :: & - sfc_alb_nir_dir, & ! Surface albedo (direct) + sfc_alb_nir_dir, & ! Surface albedo (direct) sfc_alb_nir_dif, & ! Surface albedo (diffuse) sfc_alb_uvvis_dir, & ! Surface albedo (direct) sfc_alb_uvvis_dif ! Surface albedo (diffuse) character(len=*), intent(out) :: & errmsg ! Error message - integer, intent(out) :: & + integer, intent(out) :: & errflg ! Error flag ! Local variables - integer :: i, j, iCol, iBand, iLay - real(kind_phys), dimension(ncol, NF_ALBD) :: sfcalb - real(kind_phys), dimension(ncol) :: alb1d - real(kind_phys) :: lndp_alb + integer :: i, iBand ! Initialize CCPP error handling variables errmsg = '' @@ -140,34 +79,19 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp, lndp_var ! #################################################################################### nday = 0 idxday = 0 - do i = 1, NCOL + do i = 1, nCol if (coszen(i) >= 0.0001) then nday = nday + 1 idxday(nday) = i endif enddo - - ! #################################################################################### - ! Call module_radiation_surface::setalb() to setup surface albedo. - ! #################################################################################### - alb1d(:) = 0. - lndp_alb = -999. - call setalb (lsmask, lsm, lsm_noahmp, lsm_ruc, snowd, sncovr, sncovr_ice, snoalb, zorl, & - coszen, tsfg, tsfa, hprime, landfrac, frac_grid, min_seaice, & - alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & - albdvis_lnd, albdnir_ldn, albivis_lnd, albinir_lnd, & - albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, NCOL, alb1d, lndp_alb, & ! mg, sfc-perts - sfcalb ) ! --- outputs - - ! Approximate mean surface albedo from vis- and nir- diffuse values. - sfc_alb_dif(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) - + ! Spread across all SW bands do iBand=1,sw_gas_props%get_nband() - sfc_alb_nir_dir(iBand,1:NCOL) = sfcalb(1:NCOL,1) - sfc_alb_nir_dif(iBand,1:NCOL) = sfcalb(1:NCOL,2) - sfc_alb_uvvis_dir(iBand,1:NCOL) = sfcalb(1:NCOL,3) - sfc_alb_uvvis_dif(iBand,1:NCOL) = sfcalb(1:NCOL,4) + sfc_alb_nir_dir(iBand,1:nCol) = sfcalb(1:nCol,1) + sfc_alb_nir_dif(iBand,1:nCol) = sfcalb(1:nCol,2) + sfc_alb_uvvis_dir(iBand,1:nCol) = sfcalb(1:nCol,3) + sfc_alb_uvvis_dif(iBand,1:nCol) = sfcalb(1:nCol,4) enddo else nday = 0 @@ -176,12 +100,10 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp, lndp_var sfc_alb_nir_dif(:,1:nCol) = 0. sfc_alb_uvvis_dir(:,1:nCol) = 0. sfc_alb_uvvis_dif(:,1:nCol) = 0. - sfc_alb_dif(1:nCol) = 0. endif - end subroutine GFS_rrtmgp_sw_pre_run - + ! ######################################################################################### ! SUBROUTINE GFS_rrtmgp_sw_pre_finalize ! ######################################################################################### diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 71a1dca8c..f709dd915 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -1,9 +1,9 @@ [ccpp-table-properties] name = GFS_rrtmgp_sw_pre type = scheme - dependencies = iounitdef.f,machine.F,physparam.f,radiation_astronomy.f,radiation_surface.f + dependencies = iounitdef.f,machine.F,physparam.f,radiation_astronomy.f -######################################################################## +######################################################################## DH* TODO CHECK IF the dependencies are all required [ccpp-arg-table] name = GFS_rrtmgp_sw_pre_run type = scheme @@ -12,7 +12,7 @@ long_name = current MPI-rank units = index dimensions = () - type = integer + type = integer intent = in optional = F [ncol] @@ -23,72 +23,6 @@ type = integer intent = in optional = F -[nLev] - standard_name = vertical_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in - optional = F -[n_var_lndp] - standard_name = number_of_land_surface_variables_perturbed - long_name = number of land surface variables perturbed - units = count - dimensions = () - type = integer - intent = in - optional = F -[lndp_type] - standard_name = index_for_stochastic_land_surface_perturbation_type - long_name = index for stochastic land surface perturbations type - units = index - dimensions = () - type = integer - intent = in - optional = F -[lndp_prt_list] - standard_name =magnitude_of_perturbations_for_landperts - long_name = magnitude of perturbations for landperts - units = variable - dimensions = (number_of_land_surface_variables_perturbed) - type = real - kind = kind_phys - intent = in - optional = F -[lsm] - standard_name = flag_for_land_surface_scheme - long_name = flag for land surface model - units = flag - dimensions = () - type = integer - intent = in - optional = F -[lsm_noahmp] - standard_name = flag_for_noahmp_land_surface_scheme - long_name = flag for NOAH MP land surface model - units = flag - dimensions = () - type = integer - intent = in - optional = F -[lsm_ruc] - standard_name = flag_for_ruc_land_surface_scheme - long_name = flag for RUC land surface model - units = flag - dimensions = () - type = integer - intent = in - optional = F -[lndp_var_list] - standard_name = variables_to_be_perturbed_for_landperts - long_name = variables to be perturbed for landperts - units = none - dimensions = (number_of_land_surface_variables_perturbed) - type = character - kind = len=3 - intent = in - optional = F [doSWrad] standard_name = flag_to_calc_sw long_name = logical flags for sw radiation calls @@ -132,299 +66,46 @@ type = real kind = kind_phys intent = in - optional = F -[lsmask] - standard_name = sea_land_ice_mask_real - long_name = landmask: sea/land/ice=0/1/2 - units = flag - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[snowd] - standard_name = surface_snow_thickness_water_equivalent - long_name = water equivalent snow depth - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[sncovr] - standard_name = surface_snow_area_fraction_over_land - long_name = surface snow area fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[sncovr_ice] - standard_name = surface_snow_area_fraction_over_ice - long_name = surface snow area fraction over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[snoalb] - standard_name = upper_bound_on_max_albedo_over_deep_snow - long_name = maximum snow albedo - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[zorl] - standard_name = surface_roughness_length - long_name = surface roughness length - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tsfg] - standard_name = surface_ground_temperature_for_radiation - long_name = surface ground temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tsfa] - standard_name = surface_air_temperature_for_radiation - long_name = lowest model layer air temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[hprime] - standard_name = standard_deviation_of_subgrid_orography - long_name = standard deviation of subgrid orography - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[landfrac] - standard_name = land_area_fraction - long_name = fraction of horizontal grid area occupied by land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[frac_grid] - standard_name = flag_for_fractional_grid - long_name = flag for fractional grid - units = flag - dimensions = () - type = logical - intent = in optional = F -[min_seaice] - standard_name = sea_ice_minimum - long_name = minimum sea ice value - units = frac +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[alvsf] - standard_name = mean_vis_albedo_with_strong_cosz_dependency - long_name = mean vis albedo with strong cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[alnsf] - standard_name = mean_nir_albedo_with_strong_cosz_dependency - long_name = mean nir albedo with strong cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[alvwf] - standard_name = mean_vis_albedo_with_weak_cosz_dependency - long_name = mean vis albedo with weak cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[alnwf] - standard_name = mean_nir_albedo_with_weak_cosz_dependency - long_name = mean nir albedo with weak cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[facsf] - standard_name =fractional_coverage_with_strong_cosz_dependency - long_name = fractional coverage with strong cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[facwf] - standard_name = fractional_coverage_with_weak_cosz_dependency - long_name = fractional coverage with weak cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[fice] - standard_name = sea_ice_concentration - long_name = ice fraction over open water - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tisfc] - standard_name = sea_ice_temperature - long_name = sea ice surface skin temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[albdvis_lnd] - standard_name = surface_albedo_direct_visible_over_land - long_name = direct surface albedo visible band over land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[albdnir_lnd] - standard_name = surface_albedo_direct_NIR_over_land - long_name = direct surface albedo NIR band over land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[albivis_lnd] - standard_name = surface_albedo_diffuse_visible_over_land - long_name = diffuse surface albedo visible band over land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[albinir_lnd] - standard_name = surface_albedo_diffuse_NIR_over_land - long_name = diffuse surface albedo NIR band over land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[albdvis_ice] - standard_name = surface_albedo_direct_visible_over_ice - long_name = direct surface albedo visible band over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[albdnir_ice] - standard_name = surface_albedo_direct_NIR_over_ice - long_name = direct surface albedo NIR band over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in + type = integer + intent = out optional = F -[albivis_ice] - standard_name = surface_albedo_diffuse_visible_over_ice - long_name = diffuse surface albedo visible band over ice - units = frac +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in + type = integer + intent = out optional = F -[albinir_ice] - standard_name = surface_albedo_diffuse_NIR_over_ice - long_name = diffuse surface albedo NIR band over ice - units = frac +[coszen] + standard_name = cosine_of_zenith_angle + long_name = mean cos of zenith angle over rad call period + units = none dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = inout optional = F -[sfc_wts] - standard_name = weights_for_stochastic_surface_physics_perturbation - long_name = weights for stochastic surface physics perturbation +[coszdg] + standard_name = daytime_mean_cosz_over_rad_call_period + long_name = daytime mean cosz over rad call period units = none - dimensions = (horizontal_loop_extent,number_of_surface_perturbations) - type = real - kind = kind_phys - intent = in - optional = F -[tv_lay] - standard_name = virtual_temperature - long_name = layer virtual temperature - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = inout optional = F -[relhum] - standard_name = relative_humidity - long_name = layer relative humidity +[sfcalb] + standard_name = surface_albedo_components + long_name = surface albedo IR/UV/VIS components units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa - long_name = air pressure at vertical layer for radiation calculation - units = hPa - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa - long_name = air pressure at vertical interface for radiation calculation - units = hPa - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,number_of_components_for_surface_albedo) type = real kind = kind_phys intent = in @@ -440,7 +121,7 @@ optional = F [sfc_alb_nir_dif] standard_name = surface_albedo_nearIR_diffuse - long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) + long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) units = none dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real @@ -465,49 +146,6 @@ kind = kind_phys intent = out optional = F -[nday] - standard_name = daytime_points_dimension - long_name = daytime points dimension - units = count - dimensions = () - type = integer - intent = out - optional = F -[idxday] - standard_name = daytime_points - long_name = daytime points - units = index - dimensions = (horizontal_loop_extent) - type = integer - intent = out - optional = F -[coszen] - standard_name = cosine_of_zenith_angle - long_name = mean cos of zenith angle over rad call period - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F -[coszdg] - standard_name = daytime_mean_cosz_over_rad_call_period - long_name = daytime mean cosz over rad call period - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F -[sfc_alb_dif] - standard_name = surface_diffused_shortwave_albedo - long_name = mean surface diffused sw albedo - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 2855d1e68..35045610c 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -372,8 +372,7 @@ end subroutine GFS_surface_composites_post_finalize #endif subroutine GFS_surface_composites_post_run ( & im, kice, km, cplflx, cplwav2atm, frac_grid, flag_cice, islmsk, dry, wet, icy, wind, t1, q1, prsl1, & - rd, rvrdm1, landfrac, lakefrac, oceanfrac, & - zorl, zorlo, zorll, zorli, zorl_wat, zorl_lnd, zorl_ice, & + rd, rvrdm1, landfrac, lakefrac, oceanfrac, zorl, zorlo, zorll, zorli, zorl_wat, zorl_lnd, zorl_ice, & cd, cd_wat, cd_lnd, cd_ice, cdq, cdq_wat, cdq_lnd, cdq_ice, rb, rb_wat, rb_lnd, rb_ice, stress, stress_wat, stress_lnd, & stress_ice, ffmm, ffmm_wat, ffmm_lnd, ffmm_ice, ffhh, ffhh_wat, ffhh_lnd, ffhh_ice, uustar, uustar_wat, uustar_lnd, & uustar_ice, fm10, fm10_wat, fm10_lnd, fm10_ice, fh2, fh2_wat, fh2_lnd, fh2_ice, tsurf, tsurf_wat, tsurf_lnd, tsurf_ice, & @@ -445,10 +444,10 @@ subroutine GFS_surface_composites_post_run ( !tsurf(i) = txl*tsurf_lnd(i) + txi*tsurf_ice(i) + txo*tsurf_wat(i) ! not used again! Moorthi ! BWG, 2021/02/25: cmm=cd*wind, chh=cdq*wind, so use composite cd, cdq - q0 = max( q1(i), qmin ) - rho = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0)) - cmm(i) = cd(i)*wind(i) !txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_wat(i) - chh(i) = rho*cdq(i)*wind(i) !txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_wat(i) + q0 = max( q1(i), qmin ) + rho = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0)) + cmm(i) = cd(i)*wind(i) !txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_wat(i) + chh(i) = rho*cdq(i)*wind(i) !txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_wat(i) !gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_wat(i) ep1d(i) = txl*ep1d_lnd(i) + txi*ep1d_ice(i) + txo*ep1d_wat(i) diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 80edd5559..41d647796 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -1,3 +1,6 @@ +! DH* +! TODO - UPDATE "DOCUMENTATION" / argument descriptions for individual routines +! *DH !> \file radiation_surface.f !! This file contains routines that set up surface albedo for SW !! radiation and surface emissivity for LW radiation. @@ -87,13 +90,12 @@ !! - setemis(): set up surface emissivity for lw radiation !! !! SW surface albedo (namelist control parameter - \b IALB=1) -!!\n IALB=0: surface vegetation type based climatology scheme (monthly -!! data in \f$1^o\f$ horizontal resolution) !!\n IALB=1: MODIS retrievals based monthly mean climatology +!!\n IALB=2: use surface albedo from land model !! !! LW surface emissivity (namelist control parameter - \b IEMS=1) -!!\n IEMS=0: black-body emissivity (=1.0) !!\n IEMS=1: surface type based climatology in \f$1^o\f$ horizontal resolution +!!\n IEMS=2: use surface emissivity from land model !! !!\version NCEP-Radiation_surface v5.1 Nov 2012 @@ -101,6 +103,9 @@ !! emissivity for LW radiation. module module_radiation_surface ! +!! \section arg_table_module_radiation_surface +!! \htmlinclude module_radiation_surface.html +!! use physparam, only : ialbflg, iemsflg, semis_file, & & kind_phys use physcons, only : con_t0c, con_ttp, con_pi, con_tice @@ -125,9 +130,10 @@ module module_radiation_surface real (kind=kind_phys), parameter :: epsln = 1.0e-6 real (kind=kind_phys), parameter :: rad2dg= 180.0 / con_pi integer, allocatable :: idxems(:,:) !< global surface emissivity index array - integer :: iemslw = 0 !< global surface emissivity control flag set up in 'sfc_init' + integer :: iemslw = 1 !< global surface emissivity control flag set up in 'sfc_init' ! public sfc_init, setalb, setemis + public f_zero, f_one, epsln ! ================= contains @@ -141,9 +147,8 @@ module module_radiation_surface !! @{ !----------------------------------- subroutine sfc_init & - & ( me )! --- inputs: -! --- outputs: ( none ) - + & ( me, errmsg, errflg )! --- inputs/outputs: +! ! =================================================================== ! ! ! ! this program is the initialization program for surface radiation ! @@ -162,13 +167,13 @@ subroutine sfc_init & ! ! ! external module variables: ! ! ialbflg - control flag for surface albedo schemes ! -! =0: climatology, based on surface veg types ! -! =1: ! +! =1: use modis based surface albedo ! +! =2: use surface albedo from land model ! ! iemsflg - control flag for sfc emissivity schemes (ab:2-dig)! ! a:=0 set sfc air/ground t same for lw radiation ! ! =1 set sfc air/ground t diff for lw radiation ! -! b:=0 use fixed sfc emissivity=1.0 (black-body) ! -! =1 use varying climtology sfc emiss (veg based) ! +! b:=1 use varying climtology sfc emiss (veg based) ! +! =2 use surface emissivity from land model ! ! ! ! ==================== end of description ===================== ! ! @@ -178,6 +183,8 @@ subroutine sfc_init & integer, intent(in) :: me ! --- outputs: ( none ) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg ! --- locals: integer :: i, k @@ -186,21 +193,18 @@ subroutine sfc_init & character :: cline*80 ! !===> ... begin here +! + errmsg = '' + errflg = 0 ! if ( me == 0 ) print *, VTAGSFC ! print out version tag !> - Initialization of surface albedo section !! \n physparam::ialbflg -!! - = 0: using climatology surface albedo scheme for SW !! - = 1: using MODIS based land surface albedo for SW +!! - = 2: using albedo from land model - if ( ialbflg == 0 ) then - - if ( me == 0 ) then - print *,' - Using climatology surface albedo scheme for sw' - endif - - else if ( ialbflg == 1 ) then + if ( ialbflg == 1 ) then if ( me == 0 ) then print *,' - Using MODIS based land surface albedo for sw' @@ -213,27 +217,25 @@ subroutine sfc_init & endif else - print *,' !! ERROR in Albedo Scheme Setting, IALB=',ialbflg - stop + + errmsg = 'module_radiation_surface: invalid ialbflg option' + errflg = 1 + return + endif ! end if_ialbflg_block !> - Initialization of surface emissivity section !! \n physparam::iemsflg -!! - = 0: fixed SFC emissivity at 1.0 !! - = 1: input SFC emissivity type map from "semis_file" +!! - = 2: input SFC emissivity from land model iemslw = mod(iemsflg, 10) ! emissivity control - if ( iemslw == 0 ) then ! fixed sfc emis at 1.0 - - if ( me == 0 ) then - print *,' - Using Fixed Surface Emissivity = 1.0 for lw' - endif - elseif ( iemslw == 1 ) then ! input sfc emiss type map + if ( iemslw == 1 ) then ! input sfc emiss type map ! --- allocate data space if ( .not. allocated(idxems) ) then - allocate ( idxems(IMXEMS,JMXEMS) ) + allocate ( idxems(IMXEMS,JMXEMS) ) endif ! --- check to see if requested emissivity data file existed @@ -279,8 +281,11 @@ subroutine sfc_init & endif else - print *,' !! ERROR in Emissivity Scheme Setting, IEMS=',iemsflg - stop + + errmsg = 'module_radiation_surface: invalid iemslw option' + errflg = 1 + return + endif ! end if_iemslw_block ! @@ -336,7 +341,7 @@ subroutine setalb & & alvsf,alnsf,alvwf,alnwf,facsf,facwf,fice,tisfc, & & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, & & icealbdvis, icealbdnir, icealbivis, icealbinir, & - & IMAX, albPpert, pertalb, & ! sfc-perts, mgehne + & IMAX, albPpert, pertalb, fracl, fraco, fraci, icy, & & sfcalb & ! --- outputs: & ) @@ -414,6 +419,10 @@ subroutine setalb & & sncovr, sncovr_ice, snoalb, albPpert ! sfc-perts, mgehne real (kind=kind_phys), intent(in) :: pertalb ! sfc-perts, mgehne real (kind=kind_phys), intent(in) :: min_seaice + real (kind=kind_phys), dimension(:), intent(in) :: & + & fracl, fraco, fraci + logical, dimension(:), intent(in) :: & + & icy ! --- outputs real (kind=kind_phys), dimension(IMAX,NF_ALBD), intent(out) :: & @@ -429,118 +438,14 @@ subroutine setalb & & asevb_ice,asenb_ice,asevd_ice,asend_ice real (kind=kind_phys) ffw, dtgd - real (kind=kind_phys) :: fracl, fraco, fraci integer :: i, k, kk, iflag - logical, dimension(imax) :: icy ! !===> ... begin here ! - -!> - If use climatological albedo scheme: - if ( ialbflg == 0 ) then ! use climatological albedo scheme - - do i = 1, IMAX - -!> - Modified snow albedo scheme - units convert to m (originally -!! snowf in mm; zorlf in cm) - - asnow = 0.02*snowf(i) - argh = min(0.50, max(.025, 0.01*zorlf(i))) - hrgh = min(f_one, max(0.20, 1.0577-1.1538e-3*hprif(i) ) ) - fsno0 = asnow / (argh + asnow) * hrgh - if (nint(slmsk(i))==0 .and. tsknf(i)>con_tice) fsno0 = f_zero - fsno1 = f_one - fsno0 - flnd0 = min(f_one, facsf(i)+facwf(i)) - fsea0 = max(f_zero, f_one-flnd0) - fsno = fsno0 - fsea = fsea0 * fsno1 - flnd = flnd0 * fsno1 - -!> - Calculate diffused sea surface albedo - - if (tsknf(i) >= 271.5) then - asevd = 0.06 - asend = 0.06 - elseif (tsknf(i) < 271.1) then - asevd = 0.70 - asend = 0.65 - else - a1 = (tsknf(i) - 271.1)**2 - asevd = 0.7 - 4.0*a1 - asend = 0.65 - 3.6875*a1 - endif - -!> - Calculate diffused snow albedo. - - if (nint(slmsk(i)) == 2) then - ffw = f_one - fice(i) - if (ffw < f_one) then - dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) )) - b1 = 0.03 * dtgd - else - b1 = f_zero - endif - - b3 = 0.06 * ffw - asnvd = (0.70 + b1) * fice(i) + b3 - asnnd = (0.60 + b1) * fice(i) + b3 - asevd = 0.70 * fice(i) + b3 - asend = 0.60 * fice(i) + b3 - else - asnvd = 0.90 - asnnd = 0.75 - endif - -!> - Calculate direct snow albedo. - - if (coszf(i) < 0.5) then - csnow = 0.5 * (3.0 / (f_one+4.0*coszf(i)) - f_one) - asnvb = min( 0.98, asnvd+(1.0-asnvd)*csnow ) - asnnb = min( 0.98, asnnd+(1.0-asnnd)*csnow ) - else - asnvb = asnvd - asnnb = asnnd - endif - -!> - Calculate direct sea surface albedo. - - if (coszf(i) > 0.0001) then - rfcs = 1.4 / (f_one + 0.8*coszf(i)) - rfcw = 1.1 / (f_one + 0.2*coszf(i)) - - if (tsknf(i) >= con_t0c) then - asevb = max(asevd, 0.026/(coszf(i)**1.7+0.065) & - & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & - & * (coszf(i)-f_one)) - asenb = asevb - else - asevb = asevd - asenb = asend - endif - else - rfcs = f_one - rfcw = f_one - asevb = asevd - asenb = asend - endif - - a1 = alvsf(i) * facsf(i) - b1 = alvwf(i) * facwf(i) - a2 = alnsf(i) * facsf(i) - b2 = alnwf(i) * facwf(i) - ab1bm = a1*rfcs + b1*rfcw - ab2bm = a2*rfcs + b2*rfcw - sfcalb(i,1) = min(0.99, ab2bm) *flnd + asenb*fsea + asnnb*fsno - sfcalb(i,2) = (a2 + b2) * 0.96 *flnd + asend*fsea + asnnd*fsno - sfcalb(i,3) = min(0.99, ab1bm) *flnd + asevb*fsea + asnvb*fsno - sfcalb(i,4) = (a1 + b1) * 0.96 *flnd + asevd*fsea + asnvd*fsno - - enddo ! end_do_i_loop - -!> - If use modis based albedo for land area: - elseif ( ialbflg == 1 ) then ! tgs: use this option for RUC LSM +!> - Use modis based albedo for land area: + if ( ialbflg == 1 ) then do i = 1, IMAX @@ -663,39 +568,6 @@ subroutine setalb & elseif ( ialbflg == 2 ) then do i = 1, IMAX - if (.not. frac_grid) then - !-- non-fractional grid - if (slmsk(i) == 1) then - fracl = f_one - fraci = f_zero - fraco = f_zero - icy(i) = .false. - else - fracl = f_zero - fraco = f_one - if(fice(i) < min_seaice) then - fraci = f_zero - icy(i) = .false. - else - fraci = fraco * fice(i) - icy(i) = .true. - endif - fraco = max(f_zero, fraco-fraci) - endif - else - !-- fractional grid - fracl = landfrac(i) - fraco = max(f_zero, f_one - fracl) - if(fice(i) < min_seaice) then - fraci = f_zero - icy(i) = .false. - else - fraci = fraco * fice(i) - icy(i) = .true. - endif - fraco = max(f_zero, fraco-fraci) - endif! frac_grid - !-- water albedo asevd_wat = 0.06 asend_wat = 0.06 @@ -703,7 +575,7 @@ subroutine setalb & asenb_wat = asevd_wat ! direct albedo CZA dependence over water - if (fraco > f_zero .and. coszf(i) > 0.0001) then + if (fraco(i) > f_zero .and. coszf(i) > 0.0001) then if (tsknf(i) >= con_t0c) then asevb_wat = max (asevd_wat, 0.026/(coszf(i)**1.7 + 0.065) & & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & @@ -717,7 +589,7 @@ subroutine setalb & ! model. Otherwise it uses the backup albedo computation ! from ialbflg = 1. if (icy(i)) then - if(lsm == lsm_ruc ) then + if(lsm == lsm_ruc ) then !-- use ice albedo from the RUC ice model asevd_ice = icealbivis(i) asend_ice = icealbinir(i) @@ -775,14 +647,14 @@ subroutine setalb & !-- Composite mean surface albedo from land, open water and !-- ice fractions - sfcalb(i,1) = min(0.99,max(0.01,lsmalbdnir(i)))*fracl & - & + asenb_wat*fraco + asenb_ice*fraci - sfcalb(i,2) = min(0.99,max(0.01,lsmalbinir(i)))*fracl & - & + asend_wat*fraco + asend_ice*fraci - sfcalb(i,3) = min(0.99,max(0.01,lsmalbdvis(i)))*fracl & - & + asevb_wat*fraco + asenb_ice*fraci - sfcalb(i,4) = min(0.99,max(0.01,lsmalbivis(i)))*fracl & - & + asevd_wat*fraco + asend_ice*fraci + sfcalb(i,1) = min(0.99,max(0.01,lsmalbdnir(i)))*fracl(i) & + & + asenb_wat*fraco(i) + asenb_ice*fraci(i) + sfcalb(i,2) = min(0.99,max(0.01,lsmalbinir(i)))*fracl(i) & + & + asend_wat*fraco(i) + asend_ice*fraci(i) + sfcalb(i,3) = min(0.99,max(0.01,lsmalbdvis(i)))*fracl(i) & + & + asevb_wat*fraco(i) + asenb_ice*fraci(i) + sfcalb(i,4) = min(0.99,max(0.01,lsmalbivis(i)))*fracl(i) & + & + asevd_wat*fraco(i) + asend_ice*fraci(i) enddo ! end_do_i_loop @@ -836,10 +708,10 @@ end subroutine setalb !! @{ !----------------------------------- subroutine setemis & - & ( kdt,lsm,lsm_noahmp,lsm_ruc,vtype,landfrac,frac_grid, & ! --- inputs: - & min_seaice,xlon,xlat,slmsk,snowf,sncovr,sncovr_ice,fice, & + & ( lsm,lsm_noahmp,lsm_ruc,vtype,landfrac,frac_grid, & ! --- inputs: + & min_seaice,xlon,xlat,slmsk,snowf,sncovr,sncovr_ice, & & zorlf,tsknf,tairf,hprif, & - & semis_lnd,semis_ice,IMAX, & + & semis_lnd,semis_ice,IMAX,fracl,fraco,fraci,icy, & & semisbase, sfcemis & ! --- outputs: & ) @@ -862,17 +734,16 @@ subroutine setemis & ! landfrac (IMAX) - fraction of land on on fcst model grid ! ! snowf (IMAX) - snow depth water equivalent in mm ! ! sncovr(IMAX) - ialbflg=1: snow cover over land in fraction ! -! fice (IMAX) - sea/lake ice fraction ! ! sncovr_ice(IMAX) - snow cover over ice in fraction ! ! zorlf (IMAX) - surface roughness in cm ! ! tsknf (IMAX) - ground surface temperature in k ! ! tairf (IMAX) - lowest model layer air temperature in k ! ! hprif (IMAX) - topographic sdv in m ! -! semis_lnd (IMAX) - emissivity from lsm ! +! semis_lnd (IMAX) - emissivity from lsm ! ! IMAX - array horizontal dimension ! ! ! ! outputs: ! -! sfcemis(IMAX) - surface emissivity ! +! sfcemis(IMAX) - surface emissivity ! ! ! ! ------------------------------------------------------------------- ! ! ! @@ -893,15 +764,19 @@ subroutine setemis & ! --- inputs integer, intent(in) :: IMAX - integer, intent(in) :: kdt, lsm, lsm_noahmp, lsm_ruc + integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc logical, intent(in) :: frac_grid real (kind=kind_phys), dimension(:), intent(in) :: vtype real (kind=kind_phys), dimension(:), intent(in) :: landfrac real (kind=kind_phys), intent(in) :: min_seaice real (kind=kind_phys), dimension(:), intent(in) :: & - & xlon,xlat, slmsk, snowf,sncovr, sncovr_ice, fice, & + & xlon,xlat, slmsk, snowf,sncovr, sncovr_ice, & & zorlf, tsknf, tairf, hprif, semis_lnd, semis_ice + real (kind=kind_phys), dimension(:), intent(in) :: & + & fracl, fraco, fraci + logical, dimension(:), intent(in) :: & + & icy ! --- outputs real (kind=kind_phys), dimension(:), intent(out) :: semisbase @@ -912,10 +787,9 @@ subroutine setemis & integer :: ivgtyp real (kind=kind_phys) :: dltg, hdlt, tmp1, tmp2, & - & asnow, argh, hrgh, fsno, fsno0, fracl, fraco, fraci + & asnow, argh, hrgh, fsno real (kind=kind_phys) :: sfcemis_land, sfcemis_ice - logical, dimension(imax) :: icy ! --- reference emiss value for diff surface emiss index ! 1-open water, 2-grass/shrub land, 3-bare soil, tundra, @@ -927,13 +801,8 @@ subroutine setemis & ! !===> ... begin here ! -!> -# Set sfcemis default to 1.0 or by surface type and condition. - if ( iemslw == 0 ) then ! sfc emiss default to 1.0 - - sfcemis(:) = f_one - return - - elseif ( iemslw == 1 ) then ! emiss set by sfc type and condition +!> -# Set emissivity by surface type and conditions + if ( iemslw == 1 ) then dltg = 360.0 / float(IMXEMS) hdlt = 0.5 * dltg @@ -944,47 +813,14 @@ subroutine setemis & lab_do_IMAX : do i = 1, IMAX - if (.not. frac_grid) then - !-- non-fractional grid - if (slmsk(i) == 1) then - fracl = f_one - fraci = f_zero - fraco = f_zero - icy(i) = .false. - else - fracl = f_zero - fraco = f_one - if(fice(i) < min_seaice) then - fraci = f_zero - icy(i) = .false. - else - fraci = fraco * fice(i) - icy(i) = .true. - endif - fraco = max(f_zero, fraco-fraci) - endif - else - !-- fractional grid - fracl = landfrac(i) - fraco = max(f_zero, f_one - fracl) - if(fice(i) < min_seaice) then - fraci = f_zero - icy(i) = .false. - else - fraci = fraco * fice(i) - icy(i) = .true. - endif - fraco = max(f_zero, fraco-fraci) - endif! frac_grid - - if (fracl < epsln) then ! no land - if ( abs(fraco-f_one) < epsln ) then ! open water point + if (fracl(i) < epsln) then ! no land + if ( abs(fraco(i)-f_one) < epsln ) then ! open water point sfcemis(i) = emsref(1) - elseif ( abs(fraci-f_one) > epsln ) then ! complete sea/lake ice + elseif ( abs(fraci(i)-f_one) > epsln ) then ! complete sea/lake ice sfcemis(i) = emsref(7) else !-- fractional sea ice - sfcemis(i) = fraco*emsref(1) + fraci*emsref(7) + sfcemis(i) = fraco(i)*emsref(1) + fraci(i)*emsref(7) endif else ! land or fractional grid @@ -1021,11 +857,11 @@ subroutine setemis & idx = max( 2, idxems(i2,j2) ) if ( idx >= 7 ) idx = 2 - if (abs(fracl-f_one) < epsln) then + if (abs(fracl(i)-f_one) < epsln) then sfcemis(i) = emsref(idx) else - sfcemis(i) = fracl*emsref(idx) + fraco*emsref(1) & - & + fraci*emsref(7) + sfcemis(i) = fracl(i)*emsref(idx) + fraco(i)*emsref(1) & + & + fraci(i)*emsref(7) endif semisbase(i) = sfcemis(i) @@ -1033,24 +869,20 @@ subroutine setemis & !> -# Check for snow covered area. -! if ( ialbflg==1 .and. nint(slmsk(i))==1 ) then ! input land area snow cover if ( sncovr(i) > f_zero ) then ! input land/ice area snow cover - fsno0 = sncovr(i) - sfcemis(i) = sfcemis(i)*(f_one - fsno0) + emsref(8)*fsno0 + fsno = sncovr(i) + sfcemis(i) = sfcemis(i)*(f_one - fsno) + emsref(8)*fsno else ! compute snow cover from snow depth if ( snowf(i) > f_zero ) then asnow = 0.02*snowf(i) argh = min(0.50, max(.025, 0.01*zorlf(i))) hrgh = min(f_one, max(0.20, 1.0577-1.1538e-3*hprif(i) ) ) - fsno0 = asnow / (argh + asnow) * hrgh + fsno = asnow / (argh + asnow) * hrgh -! if (nint(slmsk(i)) == 0 .and. tsknf(i) > 271.2) & -! & fsno0=f_zero - - if (abs(fraco-f_one) < epsln) fsno0 = f_zero ! no snow over open water - sfcemis(i) = sfcemis(i)*(f_one - fsno0) + emsref(8)*fsno0 + if (abs(fraco(i)-f_one) < epsln) fsno = f_zero ! no snow over open water + sfcemis(i) = sfcemis(i)*(f_one - fsno) + emsref(8)*fsno endif endif ! end if_ialbflg @@ -1061,39 +893,6 @@ subroutine setemis & do i = 1, IMAX - if (.not. frac_grid) then - !-- non-fractional grid - if (slmsk(i) == 1) then - fracl = f_one - fraci = f_zero - fraco = f_zero - icy(i) = .false. - else - fracl = f_zero - fraco = f_one - if(fice(i) < min_seaice) then - fraci = f_zero - icy(i) = .false. - else - fraci = fraco * fice(i) - icy(i) = .true. - endif - fraco = max(f_zero, fraco-fraci) - endif - else - !-- fractional grid - fracl = landfrac(i) - fraco = max(f_zero, f_one - fracl) - if(fice(i) < min_seaice) then - fraci = f_zero - icy(i) = .false. - else - fraci = fraco * fice(i) - icy(i) = .true. - endif - fraco = max(f_zero, fraco-fraci) - endif! frac_grid - !-- ice emissivity sfcemis_ice = emsref(7) @@ -1104,8 +903,8 @@ subroutine setemis & asnow = 0.02*snowf(i) argh = min(0.50, max(.025,0.01*zorlf(i))) hrgh = min(f_one,max(0.20,1.0577-1.1538e-3*hprif(i))) - fsno0 = asnow / (argh + asnow) * hrgh - sfcemis_ice = sfcemis_ice*(f_one-fsno0)+emsref(8)*fsno0 + fsno = asnow / (argh + asnow) * hrgh + sfcemis_ice = sfcemis_ice*(f_one-fsno)+emsref(8)*fsno endif elseif (lsm == lsm_ruc) then sfcemis_ice = semis_ice(i) ! output from lsm (with snow effect) @@ -1117,12 +916,11 @@ subroutine setemis & sfcemis_land = semis_lnd(i) ! albedo with snow effect from LSM !-- Composite emissivity from land, water and ice fractions. - sfcemis(i) = fracl*sfcemis_land + fraco*emsref(1) & - & + fraci*sfcemis_ice + sfcemis(i) = fracl(i)*sfcemis_land + fraco(i)*emsref(1) & + & + fraci(i)*sfcemis_ice enddo ! i - endif ! end if_iemslw_block !chk print *,' In setemis, iemsflg, sfcemis =',iemsflg,sfcemis diff --git a/physics/radiation_surface.meta b/physics/radiation_surface.meta new file mode 100644 index 000000000..beab83ce9 --- /dev/null +++ b/physics/radiation_surface.meta @@ -0,0 +1,15 @@ +[ccpp-table-properties] + name = module_radiation_surface + type = module + dependencies = + +######################################################################## +[ccpp-arg-table] + name = module_radiation_surface + type = module +[nf_albd] + standard_name = number_of_components_for_surface_albedo + long_name = number of IR/VIS/UV compinents for surface albedo + units = none + dimensions = () + type = integer diff --git a/physics/radlw_main.F90 b/physics/radlw_main.F90 index de8d9e973..7655e76d2 100644 --- a/physics/radlw_main.F90 +++ b/physics/radlw_main.F90 @@ -1250,7 +1250,7 @@ subroutine rrtmg_lw_run & endif !mz* HWRF: calculate taucmc with mcica - if (iovr == 4) then + if (iovr == 4) then call cldprmc(nlay, inflglw, iceflglw, liqflglw, & & cldfmc, ciwpmc, & & clwpmc, cswpmc, reicmc, relqmc, resnmc, & @@ -8854,25 +8854,25 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & abscosno(ig) = 0.0_rb elseif (iceflag .eq. 0) then - if (radice .lt. 10.0_rb) stop 'ICE RADIUS TOO SMALL' - abscoice(ig) = absice0(1) + absice0(2)/radice +! if (radice .lt. 10.0_rb) stop 'ICE RADIUS TOO SMALL' + abscoice(ig) = absice0(1) + absice0(2)/max(radice,10.0_rb) abscosno(ig) = 0.0_rb elseif (iceflag .eq. 1) then - if (radice .lt. 13.0_rb .or. radice .gt. 130._rb) stop& - & 'ICE RADIUS OUT OF BOUNDS' +! if (radice .lt. 13.0_rb .or. radice .gt. 130._rb) stop& +! & 'ICE RADIUS OUT OF BOUNDS' ncbands = 5 ib = icb(ngb(ig)) - abscoice(ig) = absice1(1,ib) + absice1(2,ib)/radice + abscoice(ig) = absice1(1,ib) + absice1(2,ib)/min(max(radice,13.0_rb),130._rb) abscosno(ig) = 0.0_rb ! For iceflag=2 option, ice particle effective radius is limited to 5.0 to 131.0 microns elseif (iceflag .eq. 2) then - if (radice .lt. 5.0_rb .or. radice .gt. 131.0_rb) stop& - & 'ICE RADIUS OUT OF BOUNDS' +! if (radice .lt. 5.0_rb .or. radice .gt. 131.0_rb) stop& +! & 'ICE RADIUS OUT OF BOUNDS' ncbands = 16 - factor = (radice - 2._rb)/3._rb + factor = (min(max(radice,5.0_rb),131._rb) - 2._rb)/3._rb index = int(factor) if (index .eq. 43) index = 42 fint = factor - float(index) @@ -8885,15 +8885,15 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & ! For iceflag=3 option, ice particle generalized effective size is limited to 5.0 to 140.0 microns elseif (iceflag .ge. 3) then - if (radice .lt. 5.0_rb .or. radice .gt. 140.0_rb) then - write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & - & 'ERROR: ICE GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS' & - & ,ig, lay, ciwpmc(ig,lay), radice - errflg = 1 - return - end if +! if (radice .lt. 5.0_rb .or. radice .gt. 140.0_rb) then +! write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & +! & 'ERROR: ICE GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS' & +! & ,ig, lay, ciwpmc(ig,lay), radice +! errflg = 1 +! return +! end if ncbands = 16 - factor = (radice - 2._rb)/3._rb + factor = (min(max(radice,5.0_rb),140._rb) - 2._rb)/3._rb index = int(factor) if (index .eq. 46) index = 45 fint = factor - float(index) @@ -8908,15 +8908,15 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & !..Incorporate additional effects due to snow. if (cswpmc(ig,lay).gt.0.0_rb .and. iceflag .eq. 5) then radsno = resnmc(lay) - if (radsno .lt. 5.0_rb .or. radsno .gt. 140.0_rb) then - write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & - & 'ERROR: SNOW GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS' & - & ,ig, lay, cswpmc(ig,lay), radsno - errflg = 1 - return - end if +! if (radsno .lt. 5.0_rb .or. radsno .gt. 140.0_rb) then +! write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & +! & 'ERROR: SNOW GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS' & +! & ,ig, lay, cswpmc(ig,lay), radsno +! errflg = 1 +! return +! end if ncbands = 16 - factor = (radsno - 2._rb)/3._rb + factor = (min(max(radsno,5.0_rb),140.0_rb) - 2._rb)/3._rb index = int(factor) if (index .eq. 46) index = 45 fint = factor - float(index) @@ -8937,14 +8937,14 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & elseif (liqflag .eq. 1) then radliq = relqmc(lay) - if (radliq .lt. 2.5_rb .or. radliq .gt. 60._rb) then - write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & -& 'ERROR: LIQUID EFFECTIVE SIZE OUT OF BOUNDS' & -& ,ig, lay, clwpmc(ig,lay), radliq - errflg = 1 - return - end if - index = int(radliq - 1.5_rb) +! if (radliq .lt. 2.5_rb .or. radliq .gt. 60._rb) then +! write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & +!& 'ERROR: LIQUID EFFECTIVE SIZE OUT OF BOUNDS' & +!& ,ig, lay, clwpmc(ig,lay), radliq +! errflg = 1 +! return +! end if + index = int(min(max(radliq,2.5_rb),60._rb) - 1.5_rb) if (index .eq. 0) index = 1 if (index .eq. 58) index = 57 fint = radliq - 1.5_rb - float(index) diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index 4bc33fd82..3ace48c0b 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -7,54 +7,25 @@ module rrtmg_lw_pre !>\defgroup rrtmg_lw_pre GFS RRTMG scheme pre !! @{ subroutine rrtmg_lw_pre_init () - end subroutine rrtmg_lw_pre_init + end subroutine rrtmg_lw_pre_init !> \section arg_table_rrtmg_lw_pre_run Argument Table !! \htmlinclude rrtmg_lw_pre_run.html !! - subroutine rrtmg_lw_pre_run (im, lslwr, kdt, lsm, lsm_noahmp, lsm_ruc, vtype, & - xlat, xlon, slmsk, snowd, sncovr, sncovr_ice, fice, zorl, hprime, & - landfrac, frac_grid, min_seaice, tsfg, tsfa, & - semis_lnd, semis_ice, semisbase, semis, errmsg, errflg) - - use machine, only: kind_phys - use module_radiation_surface, only: setemis + subroutine rrtmg_lw_pre_run (errmsg, errflg) implicit none - - integer, intent(in) :: im - logical, intent(in) :: lslwr - integer, intent(in) :: kdt, lsm, lsm_noahmp, lsm_ruc - - real(kind=kind_phys), dimension(im), intent(in) :: xlat, xlon, vtype, slmsk,& - snowd, sncovr, sncovr_ice, fice, zorl, hprime, landfrac, tsfg, tsfa - logical, intent(in) :: frac_grid - real(kind=kind_phys), intent(in) :: min_seaice - real(kind=kind_phys), dimension(:), intent(in) :: semis_lnd - real(kind=kind_phys), dimension(:), intent(in) :: semis_ice - real(kind=kind_phys), dimension(im), intent(out) :: semisbase - real(kind=kind_phys), dimension(im), intent(out) :: semis - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (lslwr) then -!> - Call module_radiation_surface::setemis(),to setup surface -!! emissivity for LW radiation. - call setemis (kdt, lsm, lsm_noahmp, lsm_ruc, vtype, landfrac, & - frac_grid, min_seaice, xlon, xlat, slmsk, & - snowd, sncovr, sncovr_ice, fice, zorl, tsfg, tsfa, & - hprime, semis_lnd, semis_ice, im, & ! --- inputs - semisbase, semis) ! --- outputs - endif - end subroutine rrtmg_lw_pre_run - subroutine rrtmg_lw_pre_finalize () - end subroutine rrtmg_lw_pre_finalize + subroutine rrtmg_lw_pre_finalize () + end subroutine rrtmg_lw_pre_finalize !! @} - end module rrtmg_lw_pre + end module rrtmg_lw_pre diff --git a/physics/rrtmg_lw_pre.meta b/physics/rrtmg_lw_pre.meta index 1ac9ffef8..fb84cb4c9 100644 --- a/physics/rrtmg_lw_pre.meta +++ b/physics/rrtmg_lw_pre.meta @@ -1,230 +1,12 @@ [ccpp-table-properties] name = rrtmg_lw_pre type = scheme - dependencies = iounitdef.f,machine.F,radiation_surface.f + dependencies = ######################################################################## [ccpp-arg-table] name = rrtmg_lw_pre_run type = scheme -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - optional = F -[lslwr] - standard_name = flag_to_calc_lw - long_name = logical flags for lw radiation calls - units = flag - dimensions = () - type = logical - intent = in - optional = F -[kdt] - standard_name = index_of_time_step - long_name = current number of time steps - units = index - dimensions = () - type = integer - intent = in - optional = F -[lsm] - standard_name = flag_for_land_surface_scheme - long_name = flag for land surface model - units = flag - dimensions = () - type = integer - intent = in - optional = F -[lsm_noahmp] - standard_name = flag_for_noahmp_land_surface_scheme - long_name = flag for NOAH MP land surface model - units = flag - dimensions = () - type = integer - intent = in - optional = F -[lsm_ruc] - standard_name = flag_for_ruc_land_surface_scheme - long_name = flag for RUC land surface model - units = flag - dimensions = () - type = integer - intent = in - optional = F -[vtype] - standard_name = vegetation_type_classification_real - long_name = vegetation type for lsm - units = index - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[xlat] - standard_name = latitude - long_name = latitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[xlon] - standard_name = longitude - long_name = longitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[slmsk] - standard_name = sea_land_ice_mask_real - long_name = landmask: sea/land/ice=0/1/2 - units = flag - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[snowd] - standard_name = surface_snow_thickness_water_equivalent - long_name = water equivalent snow depth - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[sncovr] - standard_name = surface_snow_area_fraction_over_land - long_name = surface snow area fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[sncovr_ice] - standard_name = surface_snow_area_fraction_over_ice - long_name = surface snow area fraction over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[fice] - standard_name = sea_ice_concentration - long_name = sea-ice concentration [0,1] - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[zorl] - standard_name = surface_roughness_length - long_name = surface roughness length - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[hprime] - standard_name = standard_deviation_of_subgrid_orography - long_name = standard deviation of subgrid orography - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[landfrac] - standard_name = land_area_fraction - long_name = fraction of horizontal grid area occupied by land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[frac_grid] - standard_name = flag_for_fractional_grid - long_name = flag for fractional grid - units = flag - dimensions = () - type = logical - intent = in - optional = F -[min_seaice] - standard_name = sea_ice_minimum - long_name = minimum sea ice value - units = frac - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[tsfg] - standard_name = surface_ground_temperature_for_radiation - long_name = surface ground temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tsfa] - standard_name = surface_air_temperature_for_radiation - long_name = lowest model layer air temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[semis_lnd] - standard_name = surface_longwave_emissivity_over_land - long_name = surface lw emissivity in fraction over land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[semis_ice] - standard_name = surface_longwave_emissivity_over_ice - long_name = surface lw emissivity in fraction over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[semisbase] - standard_name = baseline_surface_longwave_emissivity - long_name = baseline surface lw emissivity in fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F -[semis] - standard_name = surface_longwave_emissivity - long_name = surface lw emissivity in fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -242,4 +24,3 @@ type = integer intent = out optional = F - diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index bf8f3f1a3..7e9e5e7ea 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -12,53 +12,22 @@ end subroutine rrtmg_sw_pre_init !> \section arg_table_rrtmg_sw_pre_run Argument Table !! \htmlinclude rrtmg_sw_pre_run.html !! - subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, lndp_prt_list, tsfg, tsfa, coszen, & - lsm, lsm_noahmp, lsm_ruc, alb1d, slmsk, snowd, sncovr, sncovr_ice, snoalb, zorl, & - hprime, landfrac, frac_grid, min_seaice, alvsf, alnsf, alvwf, alnwf, facsf, facwf, & - fice, tisfc, albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & - albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, sfalb, & - nday, idxday, sfcalb1, sfcalb2, sfcalb3, sfcalb4, errmsg, errflg) + subroutine rrtmg_sw_pre_run (im, lsswr, coszen, nday, idxday, errmsg, errflg) use machine, only: kind_phys - use module_radiation_surface, only: NF_ALBD, setalb - implicit none - integer, intent(in) :: im, lndp_type, n_var_lndp - integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc - logical, intent(in) :: frac_grid - character(len=3) , dimension(:), intent(in) :: lndp_var_list + integer, intent(in) :: im logical, intent(in) :: lsswr - real(kind=kind_phys), dimension(:), intent(in) :: lndp_prt_list - real(kind=kind_phys), dimension(im), intent(in) :: tsfg, tsfa, coszen - real(kind=kind_phys), dimension(im), intent(in) :: alb1d, landfrac - real(kind=kind_phys), dimension(im), intent(in) :: slmsk, snowd, & - sncovr, snoalb, & - zorl, hprime, & - alvsf, alnsf, & - alvwf, alnwf, & - facsf, facwf, & - sncovr_ice, & - fice, tisfc - real(kind=kind_phys), dimension(:), intent(in) :: albdvis_lnd, albdnir_lnd, & - albivis_lnd, albinir_lnd - real(kind=kind_phys), dimension(:), intent(in) :: albdvis_ice, albdnir_ice, & - albivis_ice, albinir_ice - real(kind=kind_phys), intent(in) :: min_seaice - - real(kind=kind_phys), dimension(im), intent(inout) :: sfalb + real(kind=kind_phys), dimension(im), intent(in) :: coszen integer, intent(out) :: nday - integer, dimension(im), intent(out) :: idxday - real(kind=kind_phys), dimension(im), intent(out) :: sfcalb1, sfcalb2, & - sfcalb3, sfcalb4 + integer, dimension(:), intent(out) :: idxday character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + ! Local variables integer :: i - real(kind=kind_phys), dimension(im,NF_ALBD) :: sfcalb - - real(kind=kind_phys) :: lndp_alb ! Initialize CCPP error handling variables errmsg = '' @@ -66,9 +35,9 @@ subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, ln ! --- ... start radiation calculations ! remember to set heating rate unit to k/sec! + !> -# Start SW radiation calculations if (lsswr) then - !> - Check for daytime points for SW radiation. nday = 0 idxday = 0 @@ -78,44 +47,11 @@ subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, ln idxday(nday) = i endif enddo - -! set albedo pert, if requested. - lndp_alb = -999. - if (lndp_type==1) then - do i =1,n_var_lndp - if (lndp_var_list(i) == 'alb') then - lndp_alb = lndp_prt_list(i) - endif - enddo - endif - -!> - Call module_radiation_surface::setalb() to setup surface albedo. -!! for SW radiation. - - call setalb (slmsk, lsm, lsm_noahmp, lsm_ruc, snowd, sncovr, sncovr_ice, snoalb, & - zorl, coszen, tsfg, tsfa, hprime, landfrac, frac_grid, min_seaice, & - alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & - albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & - albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & - IM, alb1d, lndp_alb, & ! mg, sfc-perts - sfcalb ) ! --- outputs - - -!> -# Approximate mean surface albedo from vis- and nir- diffuse values. - sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) else nday = 0 idxday = 0 - sfcalb = 0.0 endif - do i = 1, im - sfcalb1(i) = sfcalb(i,1) - sfcalb2(i) = sfcalb(i,2) - sfcalb3(i) = sfcalb(i,3) - sfcalb4(i) = sfcalb(i,4) - enddo - end subroutine rrtmg_sw_pre_run subroutine rrtmg_sw_pre_finalize () diff --git a/physics/rrtmg_sw_pre.meta b/physics/rrtmg_sw_pre.meta index bb51c7f1c..c24cecfbd 100644 --- a/physics/rrtmg_sw_pre.meta +++ b/physics/rrtmg_sw_pre.meta @@ -15,22 +15,6 @@ type = integer intent = in optional = F -[lndp_type] - standard_name = index_for_stochastic_land_surface_perturbation_type - long_name = index for stochastic land surface perturbations type - units = index - dimensions = () - type = integer - intent = in - optional = F -[n_var_lndp] - standard_name = number_of_land_surface_variables_perturbed - long_name = number of land surface variables perturbed - units = count - dimensions = () - type = integer - intent = in - optional = F [lsswr] standard_name = flag_to_calc_sw long_name = logical flags for sw radiation calls @@ -39,42 +23,6 @@ type = logical intent = in optional = F -[lndp_var_list] - standard_name = variables_to_be_perturbed_for_landperts - long_name = variables to be perturbed for landperts - units = none - dimensions = (number_of_land_surface_variables_perturbed) - type = character - kind = len=3 - intent = in - optional = F -[lndp_prt_list] - standard_name = magnitude_of_perturbations_for_landperts - long_name = magnitude of perturbations for landperts - units = variable - dimensions = (number_of_land_surface_variables_perturbed) - type = real - kind = kind_phys - intent = in - optional = F -[tsfg] - standard_name = surface_ground_temperature_for_radiation - long_name = surface ground temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tsfa] - standard_name = surface_air_temperature_for_radiation - long_name = lowest model layer air temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F [coszen] standard_name = cosine_of_zenith_angle long_name = mean cos of zenith angle over rad call period @@ -84,281 +32,6 @@ kind = kind_phys intent = in optional = F -[lsm] - standard_name = flag_for_land_surface_scheme - long_name = flag for land surface model - units = flag - dimensions = () - type = integer - intent = in - optional = F -[lsm_noahmp] - standard_name = flag_for_noahmp_land_surface_scheme - long_name = flag for NOAH MP land surface model - units = flag - dimensions = () - type = integer - intent = in - optional = F -[lsm_ruc] - standard_name = flag_for_ruc_land_surface_scheme - long_name = flag for RUC land surface model - units = flag - dimensions = () - type = integer - intent = in - optional = F -[alb1d] - standard_name = surface_albedo_perturbation - long_name = surface albedo perturbation - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[slmsk] - standard_name = sea_land_ice_mask_real - long_name = landmask: sea/land/ice=0/1/2 - units = flag - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[snowd] - standard_name = surface_snow_thickness_water_equivalent - long_name = water equivalent snow depth - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[sncovr] - standard_name = surface_snow_area_fraction_over_land - long_name = surface snow area fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[sncovr_ice] - standard_name = surface_snow_area_fraction_over_ice - long_name = surface snow area fraction over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[snoalb] - standard_name = upper_bound_on_max_albedo_over_deep_snow - long_name = maximum snow albedo - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[zorl] - standard_name = surface_roughness_length - long_name = surface roughness length - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[hprime] - standard_name = standard_deviation_of_subgrid_orography - long_name = standard deviation of subgrid orography - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[landfrac] - standard_name = land_area_fraction - long_name = fraction of horizontal grid area occupied by land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[frac_grid] - standard_name = flag_for_fractional_grid - long_name = flag for fractional grid - units = flag - dimensions = () - type = logical - intent = in - optional = F -[min_seaice] - standard_name = sea_ice_minimum - long_name = minimum sea ice value - units = frac - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[alvsf] - standard_name = mean_vis_albedo_with_strong_cosz_dependency - long_name = mean vis albedo with strong cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[alnsf] - standard_name = mean_nir_albedo_with_strong_cosz_dependency - long_name = mean nir albedo with strong cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[alvwf] - standard_name = mean_vis_albedo_with_weak_cosz_dependency - long_name = mean vis albedo with weak cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[alnwf] - standard_name = mean_nir_albedo_with_weak_cosz_dependency - long_name = mean nir albedo with weak cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[facsf] - standard_name = fractional_coverage_with_strong_cosz_dependency - long_name = fractional coverage with strong cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[facwf] - standard_name = fractional_coverage_with_weak_cosz_dependency - long_name = fractional coverage with weak cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[fice] - standard_name = sea_ice_concentration - long_name = ice fraction over open water - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tisfc] - standard_name = sea_ice_temperature - long_name = sea ice surface skin temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[albdvis_lnd] - standard_name = surface_albedo_direct_visible_over_land - long_name = direct surface albedo visible band over land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[albdnir_lnd] - standard_name = surface_albedo_direct_NIR_over_land - long_name = direct surface albedo NIR band over land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[albivis_lnd] - standard_name = surface_albedo_diffuse_visible_over_land - long_name = diffuse surface albedo visible band over land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[albinir_lnd] - standard_name = surface_albedo_diffuse_NIR_over_land - long_name = diffuse surface albedo NIR band over land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[albdvis_ice] - standard_name = surface_albedo_direct_visible_over_ice - long_name = direct surface albedo visible band over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[albdnir_ice] - standard_name = surface_albedo_direct_NIR_over_ice - long_name = direct surface albedo NIR band over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[albivis_ice] - standard_name = surface_albedo_diffuse_visible_over_ice - long_name = diffuse surface albedo visible band over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[albinir_ice] - standard_name = surface_albedo_diffuse_NIR_over_ice - long_name = diffuse surface albedo NIR band over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[sfalb] - standard_name = surface_diffused_shortwave_albedo - long_name = mean surface diffused sw albedo - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [nday] standard_name = daytime_points_dimension long_name = daytime points dimension @@ -375,42 +48,6 @@ type = integer intent = out optional = F -[sfcalb1] - standard_name = surface_albedo_due_to_near_IR_direct - long_name = surface albedo due to near IR direct beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[sfcalb2] - standard_name = surface_albedo_due_to_near_IR_diffused - long_name = surface albedo due to near IR diffused beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[sfcalb3] - standard_name = surface_albedo_due_to_UV_and_VIS_direct - long_name = surface albedo due to UV+VIS direct beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[sfcalb4] - standard_name = surface_albedo_due_to_UV_and_VIS_diffused - long_name = surface albedo due to UV+VIS diffused beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index efbd0bf37..99318c1b8 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -25,49 +25,21 @@ end subroutine rrtmgp_lw_pre_init !> \section arg_table_rrtmgp_lw_pre_run !! \htmlinclude rrtmgp_lw_pre_run.html !! - subroutine rrtmgp_lw_pre_run ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, doLWrad, & - nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, sncovr_ice, fice, & - tsfg, tsfa, hprime, landfrac, frac_grid, min_seaice, & - sfc_emiss_byband, semis_land, semis_ice, & - semisbase, semis, errmsg, errflg) + subroutine rrtmgp_lw_pre_run (doLWrad, semis, sfc_emiss_byband, errmsg, errflg) ! Inputs logical, intent(in) :: & - doLWrad ! Logical flag for longwave radiation call - logical, intent(in) :: & - frac_grid ! Logical flag for fractional grid - integer, intent(in) :: & - nCol ! Number of horizontal grid points - integer, intent(in) :: kdt, lsm, lsm_noahmp, lsm_ruc - - real(kind_phys), dimension(nCol), intent(in) :: & - vtype, & ! vegetation type - xlon, & ! Longitude - xlat, & ! Latitude - slmsk, & ! Surface mask: 0-water, 1-land, 2-ice - landfrac, & ! Land fraction - zorl, & ! Surface roughness length (cm) - snowd, & ! water equivalent snow depth (mm) - sncovr, & ! Surface snow are fraction (1) - sncovr_ice, & ! Surface snow fraction over ice (1) - fice, & ! Fration of sea ice - tsfg, & ! Surface ground temperature for radiation (K) - tsfa, & ! Lowest model layer air temperature for radiation (K) - hprime ! Standard deviation of subgrid orography - - real(kind_phys), dimension(nCol), intent(in) :: & - semis_land, & ! Surface emissivity over land - semis_ice ! Surface emissivity over ice + doLWrad + real(kind_phys), dimension(:), intent(in) :: & + semis - ! Outputs - real(kind_phys), dimension(lw_gas_props%get_nband(),ncol), intent(out) :: & + ! Outputs + real(kind_phys), dimension(:,:), intent(inout) :: & sfc_emiss_byband ! Surface emissivity in each band character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & errflg ! Error flag - real(kind_phys), dimension(nCol), intent(inout) :: & - semisbase, semis ! Local variables integer :: iBand @@ -75,17 +47,8 @@ subroutine rrtmgp_lw_pre_run ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, doLWrad, & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - - if (.not. doLWrad) return - - ! ####################################################################################### - ! Call module_radiation_surface::setemis(),to setup surface emissivity for LW radiation. - ! ####################################################################################### - call setemis ( kdt, lsm, lsm_noahmp, lsm_ruc, vtype, landfrac, frac_grid, min_seaice, & - xlon, xlat, slmsk, snowd, sncovr, sncovr_ice, fice, zorl, & - tsfg, tsfa, hprime, semis_land, semis_ice, nCol, & ! --- inputs - semisbase, semis) ! --- outputs + if (.not. doLWrad) return ! Assign same emissivity to all bands do iBand=1,lw_gas_props%get_nband() diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index 555d4d182..914c1dafc 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -15,207 +15,6 @@ type = logical intent = in optional = F -[nCol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - optional = F -[kdt] - standard_name = index_of_time_step - long_name = current number of time steps - units = index - dimensions = () - type = integer - intent = in - optional = F -[lsm] - standard_name = flag_for_land_surface_scheme - long_name = flag for land surface model - units = flag - dimensions = () - type = integer - intent = in - optional = F -[lsm_noahmp] - standard_name = flag_for_noahmp_land_surface_scheme - long_name = flag for NOAH MP land surface model - units = flag - dimensions = () - type = integer - intent = in - optional = F -[lsm_ruc] - standard_name = flag_for_ruc_land_surface_scheme - long_name = flag for RUC land surface model - units = flag - dimensions = () - type = integer - intent = in - optional = F -[vtype] - standard_name = vegetation_type_classification_real - long_name = vegetation type for lsm - units = index - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[xlon] - standard_name = longitude - long_name = longitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[xlat] - standard_name = latitude - long_name = latitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[slmsk] - standard_name = sea_land_ice_mask_real - long_name = landmask: sea/land/ice=0/1/2 - units = flag - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[zorl] - standard_name = surface_roughness_length - long_name = surface roughness length - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[snowd] - standard_name = surface_snow_thickness_water_equivalent - long_name = water equivalent snow depth - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[sncovr] - standard_name = surface_snow_area_fraction_over_land - long_name = surface snow area fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[sncovr_ice] - standard_name = surface_snow_area_fraction_over_ice - long_name = surface snow area fraction over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[fice] - standard_name = sea_ice_concentration - long_name = sea-ice concentration [0,1] - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tsfg] - standard_name = surface_ground_temperature_for_radiation - long_name = surface ground temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tsfa] - standard_name = surface_air_temperature_for_radiation - long_name = lowest model layer air temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[hprime] - standard_name = standard_deviation_of_subgrid_orography - long_name = standard deviation of subgrid orography - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[landfrac] - standard_name = land_area_fraction - long_name = fraction of horizontal grid area occupied by land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[frac_grid] - standard_name = flag_for_fractional_grid - long_name = flag for fractional grid - units = flag - dimensions = () - type = logical - intent = in - optional = F -[min_seaice] - standard_name = sea_ice_minimum - long_name = minimum sea ice value - units = frac - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[semis_land] - standard_name = surface_longwave_emissivity_over_land - long_name = surface lw emissivity in fraction over land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[semis_ice] - standard_name = surface_longwave_emissivity_over_ice - long_name = surface lw emissivity in fraction over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[semisbase] - standard_name = baseline_surface_longwave_emissivity - long_name = baseline surface lw emissivity in fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [semis] standard_name = surface_longwave_emissivity long_name = surface lw emissivity in fraction @@ -223,7 +22,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = in optional = F [sfc_emiss_byband] standard_name = surface_emissivity_in_each_RRTMGP_LW_band @@ -232,7 +31,7 @@ dimensions = (number_of_lw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [errmsg] standard_name = ccpp_error_message diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta index 195276620..22d03dc1f 100644 --- a/physics/sfc_noahmp_drv.meta +++ b/physics/sfc_noahmp_drv.meta @@ -1052,7 +1052,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = out optional = F [sncovr1] standard_name = surface_snow_area_fraction_over_land From c4e0873b447287cd69b56bfafded2d9bb42388aa Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Fri, 16 Apr 2021 18:49:23 +0000 Subject: [PATCH 10/74] Add initialization of water vapor mixing ratio at the surface to lsm_ruc_init. This is needed for MYNN surface layer scheme at the first time step. --- physics/sfc_drv_ruc.F90 | 28 +++++++++++++--- physics/sfc_drv_ruc.meta | 72 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 96 insertions(+), 4 deletions(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 8586737c9..517581c56 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -31,17 +31,18 @@ module lsm_ruc !! \htmlinclude lsm_ruc_init.html !! subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & - flag_restart, flag_init, & + flag_restart, flag_init, con_fvirt, con_rd, & im, lsoil_ruc, lsoil, kice, nlev, & ! in lsm_ruc, lsm, slmsk, stype, vtype, & ! in - tsfc_lnd, tsfc_wat, & ! in + t1, q1, prsl1, tsfc_lnd, tsfc_ice, tsfc_wat, & ! in tg3, smc, slc, stc, fice, min_seaice, & ! in sncovr_lnd, sncovr_ice, snoalb, & ! in facsf, facwf, alvsf, alvwf, alnsf, alnwf, & ! in + sfcqv_lnd, sfcqv_ice, & ! out sfalb_lnd_bck, & ! out + semisbase, semis_lnd, semis_ice, & ! out albdvis_lnd,albdnir_lnd,albivis_lnd,albinir_lnd, & ! out albdvis_ice,albdnir_ice,albivis_ice,albinir_ice, & ! out - semisbase, semis_lnd, semis_ice, & ! out zs, sh2o, smfrkeep, tslb, smois, wetness, & ! out tsice, pores, resid, errmsg, errflg) @@ -56,12 +57,18 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & integer, intent(in) :: kice integer, intent(in) :: nlev integer, intent(in) :: lsm_ruc, lsm + real (kind=kind_phys),intent(in) :: con_fvirt + real (kind=kind_phys),intent(in) :: con_rd real (kind=kind_phys), dimension(im), intent(in) :: slmsk real (kind=kind_phys), dimension(im), intent(in) :: stype real (kind=kind_phys), dimension(im), intent(in) :: vtype + real (kind=kind_phys), dimension(im), intent(in) :: t1 + real (kind=kind_phys), dimension(im), intent(in) :: q1 + real (kind=kind_phys), dimension(im), intent(in) :: prsl1 real (kind=kind_phys), dimension(im), intent(in) :: tsfc_lnd + real (kind=kind_phys), dimension(im), intent(in) :: tsfc_ice real (kind=kind_phys), dimension(im), intent(in) :: tsfc_wat real (kind=kind_phys), dimension(im), intent(in) :: tg3 real (kind=kind_phys), dimension(im), intent(in) :: sncovr_lnd @@ -87,7 +94,8 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & real (kind=kind_phys), dimension(im), intent(inout) :: semis_ice real (kind=kind_phys), dimension(im), intent(inout) :: & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & - albdvis_ice, albdnir_ice, albivis_ice, albinir_ice + albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & + sfcqv_lnd, sfcqv_ice ! --- out real (kind=kind_phys), dimension(:), intent(out) :: zs @@ -102,6 +110,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & ! --- local real (kind=kind_phys), dimension(lsoil_ruc) :: dzs real (kind=kind_phys) :: alb_lnd, alb_ice + real (kind=kind_phys) :: q0, qs1, rho integer :: ipr, i, k logical :: debug_print integer, dimension(im) :: soiltyp, vegtype @@ -193,6 +202,17 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & albivis_ice(i) = alb_ice albinir_ice(i) = alb_ice + if (.not.flag_restart) then + !-- initialize QV mixing ratio at the surface from atm. 1st level + q0 = max(q1(i)/(1.-q1(i)), 1.e-8) ! q1=specific humidity at level 1 (kg/kg) + rho = prsl1(i) / (con_rd*t1(i)*(1.0+con_fvirt*q0)) + qs1 = rslf(prsl1(i),tsfc_lnd(i)) !* qs1=sat. mixing ratio at level 1 (kg/kg) + q0 = min(qs1, q0) + sfcqv_lnd(i) = q0 + qs1 = rslf(prsl1(i),tsfc_ice(i)) + sfcqv_ice(i) = qs1 + endif + enddo ! i call init_soil_depth_3 ( zs , dzs , lsoil_ruc ) diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 8198a3c99..e622b0372 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -63,6 +63,24 @@ type = logical intent = in optional = F +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -146,6 +164,33 @@ kind = kind_phys intent = inout optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer + long_name = mean temperature at lowest model layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = water vapor specific humidity at lowest model layer + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[prsl1] + standard_name = air_pressure_at_lowest_model_layer + long_name = mean pressure at lowest model layer + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [tsfc_lnd] standard_name = surface_skin_temperature long_name = surface skin temperature @@ -155,6 +200,15 @@ kind = kind_phys intent = inout optional = F +[tsfc_ice] + standard_name = surface_skin_temperature_over_ice_interstitial + long_name = surface skin temperature over ice (temporary use as interstitial) + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [tsfc_wat] standard_name = sea_surface_temperature long_name = sea surface temperature @@ -299,6 +353,24 @@ kind = kind_phys intent = inout optional = F +[sfcqv_lnd] + standard_name = water_vapor_mixing_ratio_at_surface_over_land + long_name = water vapor mixing ratio at surface over land + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[sfcqv_ice] + standard_name = water_vapor_mixing_ratio_at_surface_over_ice + long_name = water vapor mixing ratio at surface over ice + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F [sfalb_lnd_bck] standard_name =surface_snow_free_albedo_over_land long_name = surface snow-free albedo over ice From cbbafc58e888a42642720c6e1de62cc7085e6040 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Fri, 16 Apr 2021 20:58:53 +0000 Subject: [PATCH 11/74] Bug fix in the composite for ialb=2 option. --- physics/radiation_surface.f | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 41d647796..8e098b37d 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -647,14 +647,14 @@ subroutine setalb & !-- Composite mean surface albedo from land, open water and !-- ice fractions - sfcalb(i,1) = min(0.99,max(0.01,lsmalbdnir(i)))*fracl(i) & - & + asenb_wat*fraco(i) + asenb_ice*fraci(i) - sfcalb(i,2) = min(0.99,max(0.01,lsmalbinir(i)))*fracl(i) & + sfcalb(i,1) = min(0.99,max(0.01,lsmalbdnir(i)))*fracl(i) & ! direct beam NIR + & + asenb_wat*fraco(i) + asenb_ice*fraci(i) + sfcalb(i,2) = min(0.99,max(0.01,lsmalbinir(i)))*fracl(i) & ! diffuse NIR & + asend_wat*fraco(i) + asend_ice*fraci(i) - sfcalb(i,3) = min(0.99,max(0.01,lsmalbdvis(i)))*fracl(i) & - & + asevb_wat*fraco(i) + asenb_ice*fraci(i) - sfcalb(i,4) = min(0.99,max(0.01,lsmalbivis(i)))*fracl(i) & - & + asevd_wat*fraco(i) + asend_ice*fraci(i) + sfcalb(i,3) = min(0.99,max(0.01,lsmalbdvis(i)))*fracl(i) & ! direct beam visible + & + asevb_wat*fraco(i) + asevb_ice*fraci(i) + sfcalb(i,4) = min(0.99,max(0.01,lsmalbivis(i)))*fracl(i) & ! diffuse visible + & + asevd_wat*fraco(i) + asevd_ice*fraci(i) enddo ! end_do_i_loop From 836712320895255e318750a255a5abe378323a0c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 19 Apr 2021 07:16:53 -0600 Subject: [PATCH 12/74] Move call to 'stability' for composites from sfc_diff to GFS_surface_composites_post, add necessary new interstitial variables, clean up old/unused interstitial variables --- physics/GFS_debug.F90 | 4 +- physics/GFS_surface_composites.F90 | 78 ++++++++----- physics/GFS_surface_composites.meta | 72 +++++++++--- physics/GFS_surface_generic.F90 | 5 +- physics/GFS_surface_generic.meta | 9 -- physics/sfc_diff.f | 167 ++++++---------------------- physics/sfc_diff.meta | 141 ++++------------------- 7 files changed, 165 insertions(+), 311 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index af3f4e147..7f0f46a35 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -1231,7 +1231,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsfc_land ', Interstitial%tsfc_land ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsfc_ocean ', Interstitial%tsfc_ocean ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsfg ', Interstitial%tsfg ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsurf ', Interstitial%tsurf ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsurf_ice ', Interstitial%tsurf_ice ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsurf_land ', Interstitial%tsurf_land ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsurf_ocean ', Interstitial%tsurf_ocean ) @@ -1258,6 +1257,9 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zorl_land ', Interstitial%zorl_land ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zorl_ocean ', Interstitial%zorl_ocean ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zt1d ', Interstitial%zt1d ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ztmax_ice ', Interstitial%ztmax_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ztmax_land ', Interstitial%ztmax_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ztmax_water ', Interstitial%ztmax_water ) ! UGWP call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_mtb ', Interstitial%tau_mtb ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ogw ', Interstitial%tau_ogw ) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 35045610c..ba61bc83b 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -31,7 +31,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, zorl_lnd, zorl_ice, snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & tprcp_lnd, tprcp_ice, uustar, uustar_wat, uustar_lnd, uustar_ice, & weasd, weasd_wat, weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_wat, & - tsfc_lnd, tsfc_ice, tisfc, tice, tsurf, tsurf_wat, tsurf_lnd, tsurf_ice, & + tsfc_lnd, tsfc_ice, tisfc, tice, tsurf_wat, tsurf_lnd, tsurf_ice, & gflx_ice, tgice, islmsk, islmsk_cice, slmsk, semis_rad, semis_wat, semis_lnd, semis_ice, & emis_lnd, emis_ice, qss, qss_wat, qss_lnd, qss_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, & min_lakeice, min_seaice, errmsg, errflg) @@ -50,7 +50,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, real(kind=kind_phys), dimension(im), intent( out) :: frland real(kind=kind_phys), dimension(im), intent(in ) :: zorl, snowd, tprcp, uustar, weasd, qss, hflx - real(kind=kind_phys), dimension(im), intent(inout) :: zorlo, zorll, zorli, tsfc, tsfco, tsfcl, tisfc, tsurf + real(kind=kind_phys), dimension(im), intent(inout) :: zorlo, zorll, zorli, tsfc, tsfco, tsfcl, tisfc real(kind=kind_phys), dimension(im), intent(inout) :: snowd_wat, snowd_lnd, snowd_ice, tprcp_wat, & tprcp_lnd, tprcp_ice, zorl_wat, zorl_lnd, zorl_ice, tsfc_wat, tsfc_lnd, tsfc_ice, tsurf_wat, & tsurf_lnd, tsurf_ice, uustar_wat, uustar_lnd, uustar_ice, weasd_wat, weasd_lnd, weasd_ice, & @@ -349,13 +349,17 @@ module GFS_surface_composites_post use machine, only: kind_phys + ! For consistent calculations of composite surface properties + use sfc_diff, only: stability + implicit none private public GFS_surface_composites_post_init, GFS_surface_composites_post_finalize, GFS_surface_composites_post_run - real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys, qmin = 1.0e-8_kind_phys + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys, & + half = 0.5_kind_phys, qmin = 1.0e-8_kind_phys contains @@ -375,11 +379,12 @@ subroutine GFS_surface_composites_post_run ( rd, rvrdm1, landfrac, lakefrac, oceanfrac, zorl, zorlo, zorll, zorli, zorl_wat, zorl_lnd, zorl_ice, & cd, cd_wat, cd_lnd, cd_ice, cdq, cdq_wat, cdq_lnd, cdq_ice, rb, rb_wat, rb_lnd, rb_ice, stress, stress_wat, stress_lnd, & stress_ice, ffmm, ffmm_wat, ffmm_lnd, ffmm_ice, ffhh, ffhh_wat, ffhh_lnd, ffhh_ice, uustar, uustar_wat, uustar_lnd, & - uustar_ice, fm10, fm10_wat, fm10_lnd, fm10_ice, fh2, fh2_wat, fh2_lnd, fh2_ice, tsurf, tsurf_wat, tsurf_lnd, tsurf_ice, & + uustar_ice, fm10, fm10_wat, fm10_lnd, fm10_ice, fh2, fh2_wat, fh2_lnd, fh2_ice, tsurf_wat, tsurf_lnd, tsurf_ice, & cmm, cmm_wat, cmm_lnd, cmm_ice, chh, chh_wat, chh_lnd, chh_ice, gflx, gflx_wat, gflx_lnd, gflx_ice, ep1d, ep1d_wat, & ep1d_lnd, ep1d_ice, weasd, weasd_wat, weasd_lnd, weasd_ice, snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & tprcp_lnd, tprcp_ice, evap, evap_wat, evap_lnd, evap_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, qss, qss_wat, qss_lnd, & - qss_ice, tsfc, tsfco, tsfcl, tsfc_wat, tsfc_lnd, tsfc_ice, tisfc, tice, hice, cice, min_seaice, tiice, stc, errmsg, errflg) + qss_ice, tsfc, tsfco, tsfcl, tsfc_wat, tsfc_lnd, tsfc_ice, tisfc, tice, hice, cice, min_seaice, tiice, stc, & + grav, prslki, z1, ztmax_wat, ztmax_lnd, ztmax_ice, errmsg, errflg) implicit none @@ -396,7 +401,7 @@ subroutine GFS_surface_composites_post_run ( hflx_ice, qss_wat, qss_lnd, qss_ice, tsfc_wat, tsfc_lnd, tsfc_ice real(kind=kind_phys), dimension(im), intent(inout) :: zorl, zorlo, zorll, zorli, cd, cdq, rb, stress, ffmm, ffhh, uustar, fm10, & - fh2, tsurf, cmm, chh, gflx, ep1d, weasd, snowd, tprcp, evap, hflx, qss, tsfc, tsfco, tsfcl, tisfc + fh2, cmm, chh, gflx, ep1d, weasd, snowd, tprcp, evap, hflx, qss, tsfc, tsfco, tsfcl, tisfc real(kind=kind_phys), dimension(im), intent(in ) :: tice ! interstitial sea ice temperature real(kind=kind_phys), dimension(im), intent(inout) :: hice, cice @@ -406,12 +411,18 @@ subroutine GFS_surface_composites_post_run ( real(kind=kind_phys), dimension(im, kice), intent(in ) :: tiice real(kind=kind_phys), dimension(im, km), intent(inout) :: stc + ! Additional data needed for calling "stability" + real(kind=kind_phys), intent(in ) :: grav + real(kind=kind_phys), dimension(:), intent(in ) :: prslki, z1, ztmax_wat, ztmax_lnd, ztmax_ice + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables integer :: i, k real(kind=kind_phys) :: txl, txi, txo, wfrac, q0, rho + ! For calling "stability" + real(kind=kind_phys) :: tsurf, virtfac, thv1, tvs, z0max, ztmax ! Initialize CCPP error handling variables errmsg = '' @@ -429,20 +440,6 @@ subroutine GFS_surface_composites_post_run ( txi = cice(i) * wfrac ! txi = ice fraction wrt whole cell txo = max(zero, wfrac-txi) ! txo = open water fraction -! BWG zorl(i) = txl*zorl_lnd(i) + txi*zorl_ice(i) + txo*zorl_wat(i) -! BWG cd(i) = txl*cd_lnd(i) + txi*cd_ice(i) + txo*cd_wat(i) -! BWG cdq(i) = txl*cdq_lnd(i) + txi*cdq_ice(i) + txo*cdq_wat(i) -! BWG rb(i) = txl*rb_lnd(i) + txi*rb_ice(i) + txo*rb_wat(i) -! BWG stress(i) = txl*stress_lnd(i) + txi*stress_ice(i) + txo*stress_wat(i) -! BWG ffmm(i) = txl*ffmm_lnd(i) + txi*ffmm_ice(i) + txo*ffmm_wat(i) -! BWG ffhh(i) = txl*ffhh_lnd(i) + txi*ffhh_ice(i) + txo*ffhh_wat(i) -! BWG uustar(i) = txl*uustar_lnd(i) + txi*uustar_ice(i) + txo*uustar_wat(i) -! BWG fm10(i) = txl*fm10_lnd(i) + txi*fm10_ice(i) + txo*fm10_wat(i) -! BWG fh2(i) = txl*fh2_lnd(i) + txi*fh2_ice(i) + txo*fh2_wat(i) - - !tsurf(i) = txl*tsurf_lnd(i) + txi*tice(i) + txo*tsurf_wat(i) - !tsurf(i) = txl*tsurf_lnd(i) + txi*tsurf_ice(i) + txo*tsurf_wat(i) ! not used again! Moorthi - ! BWG, 2021/02/25: cmm=cd*wind, chh=cdq*wind, so use composite cd, cdq q0 = max( q1(i), qmin ) rho = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0)) @@ -468,9 +465,43 @@ subroutine GFS_surface_composites_post_run ( qss(i) = txl*qss_lnd(i) + txi*qss_ice(i) + txo*qss_wat(i) gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_wat(i) endif - + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Call stability for consistent surface properties. Currently this comes from ! +! the GFS surface layere scheme (sfc_diff), regardless of the actual surface ! +! layer parameterization being used - to be extended in the future ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! BWG, 2021/02/25: Need to change composite skin temperature base on ULW (Fanglin) - tsfc(i) = txl*tsfc_lnd(i) + txi*tice(i) + txo*tsfc_wat(i) + !tsfc(i) = txl*tsfc_lnd(i) + txi*tice(i) + txo*tsfc_wat(i) + tsfc(i) = ( txl * cdq_lnd(i) * tsfc_lnd(i) & + + txi * cdq_ice(i) * tice(i) & ! DH* Ben had tsurf_ice(i), but GFS_surface_composites_post_run uses tice instead + + txo * cdq_wat(i) * tsfc_wat(i)) & + / (txl * cdq_lnd(i) + txi * cdq_ice(i) + txo * cdq_wat(i) ) + tsurf = ( txl * cdq_lnd(i) * tsurf_lnd(i) & + + txi * cdq_ice(i) * tsurf_ice(i) & + + txo * cdq_wat(i) * tsurf_wat(i)) & + / (txl * cdq_lnd(i) + txi * cdq_ice(i) + txo * cdq_wat(i) ) + + virtfac = one + rvrdm1 * max(q1(i),qmin) +#ifdef GSD_SURFACE_FLUXES_BUGFIX + thv1 = t1(i) / prslk1(i) * virtfac ! Theta-v at lowest level + tvs = half * (tsfc(i)+tsurf)/prsik1(i) * virtfac + +#else + thv1 = t1(i) * prslki(i) * virtfac ! Theta-v at lowest level + tvs = half * (tsfc(i)+tsurf) * virtfac +#endif + + zorl(i) = exp(txl*log(zorl_lnd(i)) + txi*log(zorl_ice(i)) + txo*log(zorl_wat(i))) + z0max = 0.01_kind_phys * zorl(i) + ztmax = exp(txl*log(ztmax_lnd(i)) + txi*log(ztmax_ice(i)) + txo*log(ztmax_wat(i))) + + call stability(z1(i), snowd(i), thv1, wind(i), z0max, ztmax, tvs, grav, & ! inputs + rb(i), ffmm(i), ffhh(i), fm10(i), fh2(i), cd(i), cdq(i), & ! outputs + stress(i), uustar(i)) + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! zorll(i) = zorl_lnd(i) zorli(i) = zorl_ice(i) @@ -535,7 +566,6 @@ subroutine GFS_surface_composites_post_run ( uustar(i) = uustar_lnd(i) fm10(i) = fm10_lnd(i) fh2(i) = fh2_lnd(i) - !tsurf(i) = tsurf_lnd(i) tsfcl(i) = tsfc_lnd(i) ! over land tsfc(i) = tsfcl(i) tsfco(i) = tsfc(i) @@ -563,7 +593,6 @@ subroutine GFS_surface_composites_post_run ( uustar(i) = uustar_wat(i) fm10(i) = fm10_wat(i) fh2(i) = fh2_wat(i) - !tsurf(i) = tsurf_wat(i) tsfco(i) = tsfc_wat(i) ! over lake (and ocean when uncoupled) tsfc(i) = tsfco(i) tsfcl(i) = tsfc(i) @@ -591,7 +620,6 @@ subroutine GFS_surface_composites_post_run ( fm10(i) = fm10_ice(i) fh2(i) = fh2_ice(i) stress(i) = stress_ice(i) - !tsurf(i) = tsurf_ice(i) cmm(i) = cmm_ice(i) chh(i) = chh_ice(i) gflx(i) = gflx_ice(i) diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 852b4e8ee..bbfa97d47 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -478,15 +478,6 @@ kind = kind_phys intent = out optional = F -[tsurf] - standard_name = surface_skin_temperature_after_iteration - long_name = surface skin temperature after iteration - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [tsurf_wat] standard_name = surface_skin_temperature_after_iteration_over_ocean long_name = surface skin temperature after iteration over ocean @@ -1435,15 +1426,6 @@ kind = kind_phys intent = in optional = F -[tsurf] - standard_name = surface_skin_temperature_after_iteration - long_name = surface skin temperature after iteration - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [tsurf_wat] standard_name = surface_skin_temperature_after_iteration_over_ocean long_name = surface skin temperature after iteration over ocean @@ -1947,6 +1929,60 @@ kind = kind_phys intent = inout optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[z1] + standard_name = height_above_ground_at_lowest_model_layer + long_name = height above ground at 1st model layer + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[ztmax_wat] + standard_name = ztmax_whatever_that_is_over_water + long_name = zxtmax whatever that is over water + units = ??? + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[ztmax_lnd] + standard_name = ztmax_whatever_that_is_over_land + long_name = zxtmax whatever that is over land + units = ??? + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[ztmax_ice] + standard_name = ztmax_whatever_that_is_over_ice + long_name = zxtmax whatever that is over ice + units = ??? + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 483eccdf8..3013346a0 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -26,7 +26,7 @@ end subroutine GFS_surface_generic_pre_finalize !! subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, stype, vtype, slope, & prsik_1, prslk_1, tsfc, phil, con_g, & - sigmaf, soiltyp, vegtype, slopetyp, work3, tsurf, zlvl, & + sigmaf, soiltyp, vegtype, slopetyp, work3, zlvl, & drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, lndp_type, n_var_lndp, sfc_wts, & lndp_var_list, lndp_prt_list, & z01d, zt1d, bexp1d, xlai1d, vegf1d, lndp_vgf, sfc_wts_inv, & @@ -48,7 +48,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, real(kind=kind_phys), dimension(im), intent(inout) :: tsfc real(kind=kind_phys), dimension(im,levs), intent(in) :: phil - real(kind=kind_phys), dimension(im), intent(inout) :: sigmaf, work3, tsurf, zlvl + real(kind=kind_phys), dimension(im), intent(inout) :: sigmaf, work3, zlvl ! Stochastic physics / surface perturbations real(kind=kind_phys), dimension(im), intent(out) :: drain_cpl @@ -160,7 +160,6 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, work3(i) = prsik_1(i) / prslk_1(i) - !tsurf(i) = tsfc(i) zlvl(i) = phil(i,1) * onebg smcwlt2(i) = zero smcref2(i) = zero diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index d4c8b1bca..5168b2dd6 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -170,15 +170,6 @@ kind = kind_phys intent = inout optional = F -[tsurf] - standard_name = surface_skin_temperature_after_iteration - long_name = surface skin temperature after iteration - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [zlvl] standard_name = height_above_ground_at_lowest_model_layer long_name = layer 1 height above ground (not MSL) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index f52001434..669262982 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -11,6 +11,7 @@ module sfc_diff implicit none public :: sfc_diff_init, sfc_diff_run, sfc_diff_finalize + public :: stability private @@ -70,20 +71,19 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & wet,dry,icy, & !intent(in) & tskin_wat, tskin_lnd, tskin_ice, & !intent(in) & tsurf_wat, tsurf_lnd, tsurf_ice, & !intent(in) - & snwdph_wat,snwdph_lnd,snwdph_ice, & !intent(in) - & landfrac, cice, & !intent(in) -- for use with frac_grid - & islmsk, frac_grid, & !intent(in) -- for use with frac_grid - & z0rl_wat, z0rl_lnd, z0rl_ice, & !intent(inout) - & z0rl_wav, z0rl_cmp, & !intent(inout) - & ustar_wat, ustar_lnd, ustar_ice, ustar_cmp, & !intent(inout) - & cm_wat, cm_lnd, cm_ice, cm_cmp, & !intent(inout) - & ch_wat, ch_lnd, ch_ice, ch_cmp, & !intent(inout) - & rb_wat, rb_lnd, rb_ice, rb_cmp, & !intent(inout) - & stress_wat,stress_lnd,stress_ice,stress_cmp, & !intent(inout) - & fm_wat, fm_lnd, fm_ice, fm_cmp, & !intent(inout) - & fh_wat, fh_lnd, fh_ice, fh_cmp, & !intent(inout) - & fm10_wat, fm10_lnd, fm10_ice, fm10_cmp, & !intent(inout) - & fh2_wat, fh2_lnd, fh2_ice, fh2_cmp, & !intent(inout) + & snwdph_wat,snwdph_lnd,snwdph_ice, & !intent(in) + & z0rl_wat, z0rl_lnd, z0rl_ice, & !intent(inout) + & z0rl_wav, & !intent(inout) + & ustar_wat, ustar_lnd, ustar_ice, & !intent(inout) + & cm_wat, cm_lnd, cm_ice, & !intent(inout) + & ch_wat, ch_lnd, ch_ice, & !intent(inout) + & rb_wat, rb_lnd, rb_ice, & !intent(inout) + & stress_wat,stress_lnd,stress_ice, & !intent(inout) + & fm_wat, fm_lnd, fm_ice, & !intent(inout) + & fh_wat, fh_lnd, fh_ice, & !intent(inout) + & fm10_wat, fm10_lnd, fm10_ice, & !intent(inout) + & fh2_wat, fh2_lnd, fh2_ice, & !intent(inout) + & ztmax_wat, ztmax_lnd, ztmax_ice, & !intent(inout) & errmsg, errflg) !intent(out) ! implicit none @@ -109,25 +109,20 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & snwdph_wat,snwdph_lnd,snwdph_ice real(kind=kind_phys), dimension(im), intent(in) :: z0rl_wav - - real(kind=kind_phys), dimension(im), intent(in) :: & - & landfrac, cice - - integer, dimension(im), intent(in) :: islmsk ! For compositing - - logical, intent(in) :: frac_grid ! For compositing - + real(kind=kind_phys), dimension(im), intent(inout) :: & - & z0rl_wat, z0rl_lnd, z0rl_ice, z0rl_cmp, & - & ustar_wat, ustar_lnd, ustar_ice, ustar_cmp, & - & cm_wat, cm_lnd, cm_ice, cm_cmp, & - & ch_wat, ch_lnd, ch_ice, ch_cmp, & - & rb_wat, rb_lnd, rb_ice, rb_cmp, & - & stress_wat,stress_lnd,stress_ice,stress_cmp, & - & fm_wat, fm_lnd, fm_ice, fm_cmp, & - & fh_wat, fh_lnd, fh_ice, fh_cmp, & - & fm10_wat, fm10_lnd, fm10_ice, fm10_cmp, & - & fh2_wat, fh2_lnd, fh2_ice, fh2_cmp + & z0rl_wat, z0rl_lnd, z0rl_ice, & + & ustar_wat, ustar_lnd, ustar_ice, & + & cm_wat, cm_lnd, cm_ice, & + & ch_wat, ch_lnd, ch_ice, & + & rb_wat, rb_lnd, rb_ice, & + & stress_wat,stress_lnd,stress_ice, & + & fm_wat, fm_lnd, fm_ice, & + & fh_wat, fh_lnd, fh_ice, & + & fm10_wat, fm10_lnd, fm10_ice, & + & fh2_wat, fh2_lnd, fh2_ice, & + & ztmax_wat, ztmax_lnd, ztmax_ice +! character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -137,15 +132,8 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! real(kind=kind_phys) :: rat, thv1, restar, wind10m, & czilc, tem1, tem2, virtfac - +! real(kind=kind_phys) :: tvs, z0, z0max - - real(kind=kind_phys), dimension(im) :: & - & ztmax_wat, ztmax_lnd, ztmax_ice - - real(kind=kind_phys) :: txl, txi, txo, wfrac ! For fractional - real(kind=kind_phys) :: snwdph_cmp, ztmax_cmp! For fractional - real(kind=kind_phys) :: tskin_cmp, tsurf_cmp ! For fractional ! real(kind=kind_phys), parameter :: & one=1.0_kp, zero=0.0_kp, half=0.5_kp, qmin=1.0e-8_kp @@ -183,12 +171,12 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) do i=1,im if(flag_iter(i)) then - - ! BWG: Need to initialize ztmax arrays + + ! Need to initialize ztmax arrays ztmax_lnd(i) = 1. ! log(1) = 0 ztmax_ice(i) = 1. ! log(1) = 0 ztmax_wat(i) = 1. ! log(1) = 0 - + virtfac = one + rvrdm1 * max(q1(i),qmin) thv1 = t1(i) * prslki(i) * virtfac @@ -395,99 +383,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) endif ! end of if(flagiter) loop enddo - ! BWG, 2021/02/23: For fractional grid, get composite values - if (frac_grid) then ! If fractional grid is on... - do i=1,im ! Loop over horizontal - if(flag_iter(i)) then - virtfac = one + rvrdm1 * max(q1(i),qmin) -#ifdef GSD_SURFACE_FLUXES_BUGFIX - thv1 = t1(i) / prslk1(i) * virtfac ! Theta-v at lowest level -#else - thv1 = t1(i) * prslki(i) * virtfac ! Theta-v at lowest level -#endif - - ! Three-way composites (fields from sfc_diff) - txl = landfrac(i) ! land fraction - wfrac = one - txl ! ocean fraction - txi = cice(i) * wfrac ! txi = ice fraction wrt whole cell - txo = max(zero, wfrac-txi) ! txo = open water fraction - - ! Composite inputs to "stability" function - snwdph_cmp = txl*snwdph_lnd(i) + txi*snwdph_ice(i) - tsurf_cmp = (txl * ch_lnd(i) * tsurf_lnd(i) & - & + txi * ch_ice(i) * tsurf_ice(i) & - & + txo * ch_wat(i) * tsurf_wat(i)) & - & / (txl * ch_lnd(i) + txi * ch_ice(i) + txo * ch_wat(i)) - tskin_cmp = (txl * ch_lnd(i) * tskin_lnd(i) & - & + txi * ch_ice(i) * tskin_ice(i) & - & + txo * ch_wat(i) * tskin_wat(i)) & - & / (txl * ch_lnd(i) + txi * ch_ice(i) + txo * ch_wat(i)) -#ifdef GSD_SURFACE_FLUXES_BUGFIX - tvs = half * (tsurf_cmp+tskin_cmp)/prsik1(i) - & * virtfac -#else - tvs = half * (tsurf_cmp+tskin_cmp) * virtfac -#endif - z0rl_cmp(i) = txl*log(z0rl_lnd(i)) + txi*log(z0rl_ice(i)) & - & + txo*log(z0rl_wat(i)) - z0rl_cmp(i) = exp(z0rl_cmp(i)) - z0max = 0.01_kp * z0rl_cmp(i) - - ztmax_cmp = txl*log(ztmax_lnd(i))+txi*log(ztmax_ice(i)) & - & + txo*log(ztmax_wat(i)) - ztmax_cmp = exp(ztmax_cmp) -! - call stability -! --- inputs: - & (z1(i), snwdph_cmp, thv1, wind(i), - & z0max, ztmax_cmp, tvs, grav, -! --- outputs: - & rb_cmp(i), fm_cmp(i), fh_cmp(i), fm10_cmp(i), fh2_cmp(i), - & cm_cmp(i), ch_cmp(i), stress_cmp(i), ustar_cmp(i)) - - endif ! end of if(flagiter) loop - enddo ! End of loop over horizontal - else ! If frac_grid is false - do i=1,im ! Loop over horizontal - if(flag_iter(i)) then - if (islmsk(i) == 1) then ! Land - z0rl_cmp(i) = z0rl_lnd(i) - ustar_cmp(i) = ustar_lnd(i) - cm_cmp(i) = cm_lnd(i) - ch_cmp(i) = ch_lnd(i) - rb_cmp(i) = rb_lnd(i) - stress_cmp(i) = stress_lnd(i) - fm_cmp(i) = fm_lnd(i) - fh_cmp(i) = fh_lnd(i) - fm10_cmp(i) = fm10_lnd(i) - fh2_cmp(i) = fh2_lnd(i) - elseif (islmsk(i) == 0) then ! Open water - z0rl_cmp(i) = z0rl_wat(i) - ustar_cmp(i) = ustar_wat(i) - cm_cmp(i) = cm_wat(i) - ch_cmp(i) = ch_wat(i) - rb_cmp(i) = rb_wat(i) - stress_cmp(i) = stress_wat(i) - fm_cmp(i) = fm_wat(i) - fh_cmp(i) = fh_wat(i) - fm10_cmp(i) = fm10_wat(i) - fh2_cmp(i) = fh2_wat(i) - else ! if (islmsk(i) == 2) ! Ice - z0rl_cmp(i) = z0rl_ice(i) - ustar_cmp(i) = ustar_ice(i) - cm_cmp(i) = cm_ice(i) - ch_cmp(i) = ch_ice(i) - rb_cmp(i) = rb_ice(i) - stress_cmp(i) = stress_ice(i) - fm_cmp(i) = fm_ice(i) - fh_cmp(i) = fh_ice(i) - fm10_cmp(i) = fm10_ice(i) - fh2_cmp(i) = fh2_ice(i) - endif - endif ! end of if(flagiter) loop - enddo ! End of loop over horizontal - endif ! End of getting composite values for fractional grid - return end subroutine sfc_diff_run !> @} diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 4a090fa9c..22c734a85 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -331,40 +331,6 @@ kind = kind_phys intent = in optional = F -[landfrac] - standard_name = land_area_fraction - long_name = fraction of horizontal grid area occupied by land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[cice] - standard_name = sea_ice_concentration - long_name = ice fraction over open water - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F -[islmsk] - standard_name = sea_land_ice_mask - long_name = sea/land/ice mask (=0/1/2) - units = flag - dimensions = (horizontal_loop_extent) - type = integer - intent = in - optional = F -[frac_grid] - standard_name = flag_for_fractional_grid - long_name = flag for fractional grid - units = flag - dimensions = () - type = logical - intent = in - optional = F [z0rl_wat] standard_name = surface_roughness_length_over_ocean_interstitial long_name = surface roughness length over ocean (temporary use as interstitial) @@ -401,15 +367,6 @@ kind = kind_phys intent = in optional = F -[z0rl_cmp] - standard_name = surface_roughness_length - long_name = surface roughness length - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [ustar_wat] standard_name = surface_friction_velocity_over_ocean long_name = surface friction velocity over ocean @@ -437,15 +394,6 @@ kind = kind_phys intent = inout optional = F -[ustar_cmp] - standard_name = surface_friction_velocity - long_name = boundary layer parameter - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [cm_wat] standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean long_name = surface exchange coeff for momentum over ocean @@ -473,15 +421,6 @@ kind = kind_phys intent = inout optional = F -[cm_cmp] - standard_name = surface_drag_coefficient_for_momentum_in_air - long_name = surface exchange coeff for momentum - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [ch_wat] standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean long_name = surface exchange coeff heat & moisture over ocean @@ -509,15 +448,6 @@ kind = kind_phys intent = inout optional = F -[ch_cmp] - standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air - long_name = surface exchange coeff heat & moisture - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [rb_wat] standard_name = bulk_richardson_number_at_lowest_model_level_over_ocean long_name = bulk Richardson number at the surface over ocean @@ -545,15 +475,6 @@ kind = kind_phys intent = inout optional = F -[rb_cmp] - standard_name = bulk_richardson_number_at_lowest_model_level - long_name = bulk Richardson number at the surface - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [stress_wat] standard_name = surface_wind_stress_over_ocean long_name = surface wind stress over ocean @@ -581,15 +502,6 @@ kind = kind_phys intent = inout optional = F -[stress_cmp] - standard_name = surface_wind_stress - long_name = surface wind stress - units = m2 s-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [fm_wat] standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ocean long_name = Monin-Obukhov similarity function for momentum over ocean @@ -617,15 +529,6 @@ kind = kind_phys intent = inout optional = F -[fm_cmp] - standard_name = Monin_Obukhov_similarity_function_for_momentum - long_name = Monin-Obukhov similarity function for momentum - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [fh_wat] standard_name = Monin_Obukhov_similarity_function_for_heat_over_ocean long_name = Monin-Obukhov similarity function for heat over ocean @@ -653,15 +556,6 @@ kind = kind_phys intent = inout optional = F -[fh_cmp] - standard_name = Monin_Obukhov_similarity_function_for_heat - long_name = Monin-Obukhov similarity function for heat - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [fm10_wat] standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ocean long_name = Monin-Obukhov similarity parameter for momentum at 10m over ocean @@ -689,15 +583,6 @@ kind = kind_phys intent = inout optional = F -[fm10_cmp] - standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m - long_name = Monin-Obukhov similarity parameter for momentum at 10m - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [fh2_wat] standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ocean long_name = Monin-Obukhov similarity parameter for heat at 2m over ocean @@ -725,10 +610,28 @@ kind = kind_phys intent = inout optional = F -[fh2_cmp] - standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m - long_name = Monin-Obukhov similarity parameter for heat at 2m - units = none +[ztmax_wat] + standard_name = ztmax_whatever_that_is_over_water + long_name = zxtmax whatever that is over water + units = ??? + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[ztmax_lnd] + standard_name = ztmax_whatever_that_is_over_land + long_name = zxtmax whatever that is over land + units = ??? + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[ztmax_ice] + standard_name = ztmax_whatever_that_is_over_ice + long_name = zxtmax whatever that is over ice + units = ??? dimensions = (horizontal_loop_extent) type = real kind = kind_phys From ff766e5f17f5fc4ef6f1c62f26d2cb6f9ae687e4 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 19 Apr 2021 09:12:28 -0600 Subject: [PATCH 13/74] Fix merge conflicts --- physics/GFS_surface_composites.F90 | 11 +++--- physics/radiation_surface.f | 60 +++++++++++++++++++++++------- 2 files changed, 51 insertions(+), 20 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index f64883932..52f97f4d4 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -27,11 +27,10 @@ end subroutine GFS_surface_composites_pre_finalize !> \section arg_table_GFS_surface_composites_pre_run Argument Table !! \htmlinclude GFS_surface_composites_pre_run.html !! -<<<<<<< HEAD subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, lsm_ruc, frac_grid, & flag_cice, cplflx, cplwav2atm, landfrac, lakefrac, lakedepth, oceanfrac, frland, & - dry, icy, use_lake, ocean, wet, hice, cice, zorl, zorlo, zorll, zorli, zorl_wat, & - zorl_lnd, zorl_ice, snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & + dry, icy, use_flake, ocean, wet, hice, cice, zorlo, zorll, zorli, & + snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & tprcp_lnd, tprcp_ice, uustar, uustar_wat, uustar_lnd, uustar_ice, & weasd, weasd_wat, weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_wat, & tsfc_lnd, tsfc_ice, tisfc, tice, tsurf_wat, tsurf_lnd, tsurf_ice, & @@ -397,9 +396,9 @@ subroutine GFS_surface_composites_post_run ( fm10_wat, fm10_lnd, fm10_ice, fh2_wat, fh2_lnd, fh2_ice, tsurf_wat, tsurf_lnd, tsurf_ice, cmm_wat, cmm_lnd, cmm_ice, & chh_wat, chh_lnd, chh_ice, gflx_wat, gflx_lnd, gflx_ice, ep1d_wat, ep1d_lnd, ep1d_ice, weasd_wat, weasd_lnd, weasd_ice, & snowd_wat, snowd_lnd, snowd_ice,tprcp_wat, tprcp_lnd, tprcp_ice, evap_wat, evap_lnd, evap_ice, hflx_wat, hflx_lnd, & - hflx_ice, qss_wat, qss_lnd, qss_ice, tsfc_wat, tsfc_lnd, tsfc_ice + hflx_ice, qss_wat, qss_lnd, qss_ice, tsfc_wat, tsfc_lnd, tsfc_ice, zorlo, zorll, zorli - real(kind=kind_phys), dimension(im), intent(inout) :: zorl, zorlo, zorll, zorli, cd, cdq, rb, stress, ffmm, ffhh, uustar, fm10, & + real(kind=kind_phys), dimension(im), intent(inout) :: zorl, cd, cdq, rb, stress, ffmm, ffhh, uustar, fm10, & fh2, cmm, chh, gflx, ep1d, weasd, snowd, tprcp, evap, hflx, qss, tsfc, tsfco, tsfcl, tisfc real(kind=kind_phys), dimension(im), intent(in ) :: tice ! interstitial sea ice temperature @@ -492,7 +491,7 @@ subroutine GFS_surface_composites_post_run ( tvs = half * (tsfc(i)+tsurf) * virtfac #endif - zorl(i) = exp(txl*log(zorl_lnd(i)) + txi*log(zorl_ice(i)) + txo*log(zorl_wat(i))) + zorl(i) = exp(txl*log(zorll(i)) + txi*log(zorli(i)) + txo*log(zorlo(i))) z0max = 0.01_kind_phys * zorl(i) ztmax = exp(txl*log(ztmax_lnd(i)) + txi*log(ztmax_ice(i)) + txo*log(ztmax_wat(i))) diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 41d647796..7e6d69fd5 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -1,6 +1,3 @@ -! DH* -! TODO - UPDATE "DOCUMENTATION" / argument descriptions for individual routines -! *DH !> \file radiation_surface.f !! This file contains routines that set up surface albedo for SW !! radiation and surface emissivity for LW radiation. @@ -468,12 +465,12 @@ subroutine setalb & endif endif - fsno1 = f_one - fsno0 ! snow-free fraction (land or ice), 1-sea + fsno1 = f_one - fsno0 ! snow-free fraction (land or ice), 1-sea flnd0 = min(f_one, facsf(i)+facwf(i)) ! 1-land, 0-sea/ice - fsea0 = max(f_zero, f_one-flnd0)! ! 1-sea/ice, 0-land - fsno = fsno0 ! snow cover, >0 - land/ice - fsea = fsea0 * fsno1 ! 1-sea/ice, 0-land - flnd = flnd0 * fsno1 ! <=1-land,0-sea/ice + fsea0 = max(f_zero, f_one-flnd0) ! 1-sea/ice, 0-land + fsno = fsno0 ! snow cover, >0 - land/ice + fsea = fsea0 * fsno1 ! 1-sea/ice, 0-land + flnd = flnd0 * fsno1 ! <=1-land,0-sea/ice !> - Calculate diffused sea surface albedo. @@ -694,8 +691,7 @@ end subroutine setalb !! or -pi -> +pi ranges !!\param xlat (IMAX), latitude in radiance, default to pi/2 -> !! -pi/2 range, otherwise see in-line comment -!!\param lanfrac (IMAX), -!!!\parction of grid that is land +!!\param landfrac (IMAX), fraction of grid that is land !!\param snowf (IMAX), snow depth water equivalent in mm !!\param sncovr (IMAX), snow cover over land !!\param zorlf (IMAX), surface roughness in cm @@ -731,7 +727,7 @@ subroutine setemis & ! xlat (IMAX) - latitude in radiance, default to pi/2 -> -pi/2 ! ! range, otherwise see in-line comment ! ! slmsk (IMAX) - sea(0),land(1),ice(2) mask on fcst model grid ! -! landfrac (IMAX) - fraction of land on on fcst model grid ! +! landfrac (IMAX) - fraction of land on on fcst model grid ! ! snowf (IMAX) - snow depth water equivalent in mm ! ! sncovr(IMAX) - ialbflg=1: snow cover over land in fraction ! ! sncovr_ice(IMAX) - snow cover over ice in fraction ! @@ -788,7 +784,9 @@ subroutine setemis & real (kind=kind_phys) :: dltg, hdlt, tmp1, tmp2, & & asnow, argh, hrgh, fsno - +#if 1 + real (kind=kind_phys) :: fsno0, fsno1 +#endif real (kind=kind_phys) :: sfcemis_land, sfcemis_ice ! --- reference emiss value for diff surface emiss index @@ -813,6 +811,7 @@ subroutine setemis & lab_do_IMAX : do i = 1, IMAX +#if 0 if (fracl(i) < epsln) then ! no land if ( abs(fraco(i)-f_one) < epsln ) then ! open water point sfcemis(i) = emsref(1) @@ -822,7 +821,15 @@ subroutine setemis & !-- fractional sea ice sfcemis(i) = fraco(i)*emsref(1) + fraci(i)*emsref(7) endif +#else + if ( nint(slmsk(i)) == 0 ) then ! sea point + + sfcemis(i) = emsref(1) + else if ( nint(slmsk(i)) == 2 ) then ! sea-ice + + sfcemis(i) = emsref(7) +#endif else ! land or fractional grid ! --- map grid in longitude direction @@ -856,7 +863,7 @@ subroutine setemis & idx = max( 2, idxems(i2,j2) ) if ( idx >= 7 ) idx = 2 - +#if 0 if (abs(fracl(i)-f_one) < epsln) then sfcemis(i) = emsref(idx) else @@ -864,11 +871,15 @@ subroutine setemis & & + fraci(i)*emsref(7) endif semisbase(i) = sfcemis(i) +#else + sfcemis(i) = emsref(idx) +#endif endif ! end if_slmsk_block -!> -# Check for snow covered area. +!> - Check for snow covered area. +#if 0 if ( sncovr(i) > f_zero ) then ! input land/ice area snow cover fsno = sncovr(i) @@ -886,6 +897,27 @@ subroutine setemis & endif endif ! end if_ialbflg +#else + if ( ialbflg==1 .and. nint(slmsk(i))==1 ) then ! input land area snow cover + + fsno0 = sncovr(i) + fsno1 = f_one - fsno0 + sfcemis(i) = sfcemis(i)*fsno1 + emsref(8)*fsno0 + + else ! compute snow cover from snow depth + if ( snowf(i) > f_zero ) then + asnow = 0.02*snowf(i) + argh = min(0.50, max(.025, 0.01*zorlf(i))) + hrgh = min(f_one, max(0.20, 1.0577-1.1538e-3*hprif(i) ) ) + fsno0 = asnow / (argh + asnow) * hrgh + if (nint(slmsk(i)) == 0 .and. tsknf(i) > 271.2) & + & fsno0=f_zero + fsno1 = f_one - fsno0 + sfcemis(i) = sfcemis(i)*fsno1 + emsref(8)*fsno0 + endif + + endif ! end if_ialbflg +#endif enddo lab_do_IMAX From 1a2d365c7afeccbd12f76de93f53333a0d44c1bb Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 19 Apr 2021 10:02:42 -0600 Subject: [PATCH 14/74] Bugfix in physics/GFS_phys_time_vary.fv3.F90: remove old variables from OpenMP --- physics/GFS_phys_time_vary.fv3.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index b70ce0004..12e10d80c 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -477,7 +477,7 @@ subroutine GFS_phys_time_vary_init ( !$OMP shared(im,lsoil,con_t0c,landfrac,tsfcl,tvxy,tgxy,tahxy) & !$OMP shared(snowd,canicexy,canliqxy,canopy,eahxy,cmxy,chxy) & !$OMP shared(fwetxy,sneqvoxy,weasd,alboldxy,qsnowxy,wslakexy) & -!$OMP shared(taussxy,albdvis,albdnir,albivis,albinir,emiss) & +!$OMP shared(taussxy) & !$OMP shared(waxy,wtxy,zwtxy,imn,vtype,xlaixy,xsaixy,lfmassxy) & !$OMP shared(stmassxy,rtmassxy,woodxy,stblcpxy,fastcpxy) & !$OMP shared(isbarren_table,isice_table,isurban_table) & From a6ade33cd6bae37d5a08060f48423b7d043c7da7 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 19 Apr 2021 10:58:33 -0600 Subject: [PATCH 15/74] physics/GFS_surface_composites.F90: move computation of cmm and chh after call to stability --- physics/GFS_surface_composites.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 52f97f4d4..1a514de8b 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -438,12 +438,6 @@ subroutine GFS_surface_composites_post_run ( txi = cice(i) * wfrac ! txi = ice fraction wrt whole cell txo = max(zero, wfrac-txi) ! txo = open water fraction -! BWG, 2021/02/25: cmm=cd*wind, chh=cdq*wind, so use composite cd, cdq - q0 = max( q1(i), qmin ) - rho = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0)) - cmm(i) = cd(i)*wind(i) !txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_wat(i) - chh(i) = rho*cdq(i)*wind(i) !txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_wat(i) - !gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_wat(i) ep1d(i) = txl*ep1d_lnd(i) + txi*ep1d_ice(i) + txo*ep1d_wat(i) !weasd(i) = txl*weasd_lnd(i) + txi*weasd_ice(i) + txo*weasd_wat(i) @@ -499,6 +493,12 @@ subroutine GFS_surface_composites_post_run ( rb(i), ffmm(i), ffhh(i), fm10(i), fh2(i), cd(i), cdq(i), & ! outputs stress(i), uustar(i)) + ! BWG, 2021/02/25: cmm=cd*wind, chh=cdq*wind, so use composite cd, cdq + q0 = max( q1(i), qmin ) + rho = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0)) + cmm(i) = cd(i)*wind(i) !txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_wat(i) + chh(i) = rho*cdq(i)*wind(i) !txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_wat(i) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! if (dry(i)) then From d83c1a154c12094c61758e27cfe802b6b73369bc Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Mon, 19 Apr 2021 18:19:45 +0000 Subject: [PATCH 16/74] Add fractional code to ialb=1 option used with the Noah LSM. --- physics/radiation_surface.f | 205 ++++++++++++++++++------------------ 1 file changed, 100 insertions(+), 105 deletions(-) diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 8e098b37d..66911c71c 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -449,118 +449,113 @@ subroutine setalb & do i = 1, IMAX -!> - Calculate snow cover input directly for land model, no -!! conversion needed. + !-- water albedo + asevd_wat = 0.06 + asend_wat = 0.06 + asevb_wat = asevd_wat + asenb_wat = asevd_wat + + ! direct albedo CZA dependence over water + if (fraco(i) > f_zero .and. coszf(i) > 0.0001) then + if (tsknf(i) >= con_t0c) then + asevb_wat = max (asevd_wat, 0.026/(coszf(i)**1.7 + 0.065) & + & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & + & * (coszf(i)-f_one)) + asenb_wat = asevb_wat + endif - fsno0 = sncovr(i) ! snow fraction on land - - if (nint(slmsk(i))==0 .and. tsknf(i)>con_tice) fsno0 = f_zero - - if (nint(slmsk(i)) == 2) then - if(lsm == lsm_ruc) then - !-- use RUC LSM's snow-cover fraction for ice - fsno0 = sncovr_ice(i) ! snow fraction on ice - else - asnow = 0.02*snowf(i) - argh = min(0.50, max(.025, 0.01*zorlf(i))) - hrgh = min(f_one, max(0.20, 1.0577-1.1538e-3*hprif(i) ) ) - fsno0 = asnow / (argh + asnow) * hrgh - endif - endif - - fsno1 = f_one - fsno0 ! snow-free fraction (land or ice), 1-sea - flnd0 = min(f_one, facsf(i)+facwf(i)) ! 1-land, 0-sea/ice - fsea0 = max(f_zero, f_one-flnd0)! ! 1-sea/ice, 0-land - fsno = fsno0 ! snow cover, >0 - land/ice - fsea = fsea0 * fsno1 ! 1-sea/ice, 0-land - flnd = flnd0 * fsno1 ! <=1-land,0-sea/ice - -!> - Calculate diffused sea surface albedo. - - if (tsknf(i) >= 271.5) then - asevd = 0.06 - asend = 0.06 - elseif (tsknf(i) < 271.1) then - asevd = 0.70 - asend = 0.65 - else - a1 = (tsknf(i) - 271.1)**2 - asevd = 0.7 - 4.0*a1 - asend = 0.65 - 3.6875*a1 - endif - -!> - Calculate diffused snow albedo, land area use input max snow -!! albedo. - - if (nint(slmsk(i)) == 2) then - ffw = f_one - fice(i) - if (ffw < f_one) then - dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) )) - b1 = 0.03 * dtgd + if (icy(i)) then + !-- Computation of ice albedo + asnow = 0.02*snowf(i) + argh = min(0.50, max(.025, 0.01*zorlf(i))) + hrgh = min(f_one,max(0.20,1.0577-1.1538e-3*hprif(i))) + fsno0 = asnow / (argh + asnow) * hrgh + ! diffused + if (tsknf(i) < 271.1) then + asevd_ice = 0.70 + asend_ice = 0.65 else - b1 = f_zero + a1 = (tsknf(i) - 271.1)**2 + asevd_ice = 0.7 - 4.0*a1 + asend_ice = 0.65 - 3.6875*a1 endif + ! direct + asevb_ice = asevd_ice + asenb_ice = asend_ice + + if (fsno0 > f_zero) then + ! Snow on ice + dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) )) + b1 = 0.03 * dtgd + asnvd = (asevd_ice + b1) ! diffused snow albedo + asnnd = (asend_ice + b1) + if (coszf(i) > 0.0001 .and. coszf(i) < 0.5) then ! direct snow albedo + csnow = 0.5 * (3.0 / (f_one+4.0*coszf(i)) - f_one) + asnvb = min( 0.98, asnvd+(f_one-asnvd)*csnow ) + asnnb = min( 0.98, asnnd+(f_one-asnnd)*csnow ) + else + asnvb = asnvd + asnnb = asnnd + endif - b3 = 0.06 * ffw - asnvd = (0.70 + b1) * fice(i) + b3 - asnnd = (0.60 + b1) * fice(i) + b3 - asevd = 0.70 * fice(i) + b3 - asend = 0.60 * fice(i) + b3 - else - asnvd = snoalb(i) - asnnd = snoalb(i) - endif - -!> - Calculate direct snow albedo. - - if (nint(slmsk(i)) == 2) then - if (coszf(i) < 0.5) then - csnow = 0.5 * (3.0 / (f_one+4.0*coszf(i)) - f_one) - asnvb = min( 0.98, asnvd+(f_one-asnvd)*csnow ) - asnnb = min( 0.98, asnnd+(f_one-asnnd)*csnow ) - else - asnvb = asnvd - asnnb = asnnd - endif - else - asnvb = snoalb(i) - asnnb = snoalb(i) - endif - -!> - Calculate direct sea surface albedo, use fanglin's zenith angle -!! treatment. - - if (coszf(i) > 0.0001) then - -! rfcs = 1.89 - 3.34*coszf(i) + 4.13*coszf(i)*coszf(i) & -! & - 2.02*coszf(i)*coszf(i)*coszf(i) - rfcs = 1.775/(1.0+1.55*coszf(i)) + ! composite ice and snow albedos + asevd_ice = asevd_ice * (1. - fsno0) + asnvd * fsno0 + asend_ice = asend_ice * (1. - fsno0) + asnnd * fsno0 + asevb_ice = asevb_ice * (1. - fsno0) + asnvb * fsno0 + asenb_ice = asenb_ice * (1. - fsno0) + asnnb * fsno0 + endif ! snow + else + ! icy = false, fill in values + asevd_ice = 0.70 + asend_ice = 0.65 + asevb_ice = 0.70 + asenb_ice = 0.65 + endif ! end icy - if (tsknf(i) >= con_t0c) then - !- sea - asevb = max(asevd, 0.026/(coszf(i)**1.7+0.065) & - & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & - & * (coszf(i)-f_one)) - asenb = asevb + if (fracl(i) > f_zero) then +!> - Calculate snow cover input directly for land model, no +!! conversion needed. + + fsno0 = sncovr(i) ! snow fraction on land + + fsno1 = f_one - fsno0 + flnd0 = min(f_one, facsf(i)+facwf(i)) + flnd = flnd0 * fsno1 ! snow-free fraction + fsno = f_one - flnd ! snow-covered fraction + + !> - use Fanglin's zenith angle treatment. + if (coszf(i) > 0.0001) then + rfcs = 1.775/(1.0+1.55*coszf(i)) else - !- ice - asevb = asevd - asenb = asend + !- no sun + rfcs = f_one endif - else - !- no sun - rfcs = f_one - asevb = asevd - asenb = asend - endif - - !- zenith dependence is applied only to direct beam albedo - ab1bm = min(0.99, alnsf(i)*rfcs) - ab2bm = min(0.99, alvsf(i)*rfcs) - sfcalb(i,1) = ab1bm *flnd + asenb*fsea + asnnb*fsno - sfcalb(i,2) = alnwf(i)*flnd + asend*fsea + asnnd*fsno - sfcalb(i,3) = ab2bm *flnd + asevb*fsea + asnvb*fsno - sfcalb(i,4) = alvwf(i)*flnd + asevd*fsea + asnvd*fsno + !- zenith dependence is applied only to direct beam albedo + ab1bm = min(0.99, alnsf(i)*rfcs) + ab2bm = min(0.99, alvsf(i)*rfcs) + + alndnb = ab1bm *flnd + snoalb(i) * fsno + alndnd = alnwf(i)*flnd + snoalb(i) * fsno + alndvb = ab2bm *flnd + snoalb(i) * fsno + alndvd = alvwf(i)*flnd + snoalb(i) * fsno + else + !-- fill in values of land albedo + alndnb = 0. + alndnd = 0. + alndvb = 0. + alndvd = 0. + endif ! end land + + !-- Composite mean surface albedo from land, open water and + !-- ice fractions + sfcalb(i,1) = min(0.99,max(0.01,alndnb))*fracl(i) & ! direct beam NIR + & + asenb_wat*fraco(i) + asenb_ice*fraci(i) + sfcalb(i,2) = min(0.99,max(0.01,alndnd))*fracl(i) & ! diffuse NIR + & + asend_wat*fraco(i) + asend_ice*fraci(i) + sfcalb(i,3) = min(0.99,max(0.01,alndvb))*fracl & ! direct beam visible + & + asevb_wat*fraco(i) + asevb_ice*fraci(i) + sfcalb(i,4) = min(0.99,max(0.01,alndvd))*fracl & ! diffuse visible + & + asevd_wat*fraco(i) + asevd_ice*fraci(i) enddo ! end_do_i_loop From 21c87c497b8be6c66926ad1d1d63c295c7f17081 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 19 Apr 2021 11:42:45 -0600 Subject: [PATCH 17/74] Address reviewer comments --- physics/GFS_surface_composites.F90 | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 1a514de8b..d5dc67f54 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -464,8 +464,6 @@ subroutine GFS_surface_composites_post_run ( ! layer parameterization being used - to be extended in the future ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! BWG, 2021/02/25: Need to change composite skin temperature base on ULW (Fanglin) - !tsfc(i) = txl*tsfc_lnd(i) + txi*tice(i) + txo*tsfc_wat(i) tsfc(i) = ( txl * cdq_lnd(i) * tsfc_lnd(i) & + txi * cdq_ice(i) * tice(i) & ! DH* Ben had tsurf_ice(i), but GFS_surface_composites_post_run uses tice instead + txo * cdq_wat(i) * tsfc_wat(i)) & @@ -475,15 +473,15 @@ subroutine GFS_surface_composites_post_run ( + txo * cdq_wat(i) * tsurf_wat(i)) & / (txl * cdq_lnd(i) + txi * cdq_ice(i) + txo * cdq_wat(i) ) - virtfac = one + rvrdm1 * max(q1(i),qmin) + q0 = max( q1(i), qmin ) + virtfac = one + rvrdm1 * q0 #ifdef GSD_SURFACE_FLUXES_BUGFIX thv1 = t1(i) / prslk1(i) * virtfac ! Theta-v at lowest level tvs = half * (tsfc(i)+tsurf)/prsik1(i) * virtfac - #else thv1 = t1(i) * prslki(i) * virtfac ! Theta-v at lowest level tvs = half * (tsfc(i)+tsurf) * virtfac -#endif +#endif zorl(i) = exp(txl*log(zorll(i)) + txi*log(zorli(i)) + txo*log(zorlo(i))) z0max = 0.01_kind_phys * zorl(i) @@ -494,7 +492,6 @@ subroutine GFS_surface_composites_post_run ( stress(i), uustar(i)) ! BWG, 2021/02/25: cmm=cd*wind, chh=cdq*wind, so use composite cd, cdq - q0 = max( q1(i), qmin ) rho = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0)) cmm(i) = cd(i)*wind(i) !txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_wat(i) chh(i) = rho*cdq(i)*wind(i) !txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_wat(i) From 4f4be0e5cca3567b63599cb03e2c07a235d55f08 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 19 Apr 2021 14:48:37 -0600 Subject: [PATCH 18/74] Fix bugs in latest ialbflg==1 code, provide CPP option to switch between original ialbflg==1/iemslw==1 code and new code --- physics/radiation_surface.f | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 12f261677..173e7fe81 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -1,3 +1,7 @@ +! DH* +!# ! commented out ! define ORIG_ALB_EMS_OPTION_ONE +! *DH + !> \file radiation_surface.f !! This file contains routines that set up surface albedo for SW !! radiation and surface emissivity for LW radiation. @@ -434,6 +438,8 @@ subroutine setalb & real (kind=kind_phys) :: asevb_wat,asenb_wat,asevd_wat,asend_wat, & & asevb_ice,asenb_ice,asevd_ice,asend_ice + real (kind=kind_phys) :: alndnb, alndnd, alndvb, alndvd + real (kind=kind_phys) ffw, dtgd integer :: i, k, kk, iflag @@ -445,7 +451,8 @@ subroutine setalb & if ( ialbflg == 1 ) then do i = 1, IMAX -#if 0 + +#ifndef ORIG_ALB_EMS_OPTION_ONE !-- water albedo asevd_wat = 0.06 asend_wat = 0.06 @@ -460,6 +467,7 @@ subroutine setalb & & * (coszf(i)-f_one)) asenb_wat = asevb_wat endif + endif if (icy(i)) then !-- Computation of ice albedo @@ -545,13 +553,13 @@ subroutine setalb & !-- Composite mean surface albedo from land, open water and !-- ice fractions - sfcalb(i,1) = min(0.99,max(0.01,alndnb))*fracl(i) & ! direct beam NIR + sfcalb(i,1) = min(0.99,max(0.01,alndnb))*fracl(i) & ! direct beam NIR & + asenb_wat*fraco(i) + asenb_ice*fraci(i) - sfcalb(i,2) = min(0.99,max(0.01,alndnd))*fracl(i) & ! diffuse NIR + sfcalb(i,2) = min(0.99,max(0.01,alndnd))*fracl(i) & ! diffuse NIR & + asend_wat*fraco(i) + asend_ice*fraci(i) - sfcalb(i,3) = min(0.99,max(0.01,alndvb))*fracl & ! direct beam visible + sfcalb(i,3) = min(0.99,max(0.01,alndvb))*fracl(i) & ! direct beam visible & + asevb_wat*fraco(i) + asevb_ice*fraci(i) - sfcalb(i,4) = min(0.99,max(0.01,alndvd))*fracl & ! diffuse visible + sfcalb(i,4) = min(0.99,max(0.01,alndvd))*fracl(i) & ! diffuse visible & + asevd_wat*fraco(i) + asevd_ice*fraci(i) #else @@ -895,7 +903,7 @@ subroutine setemis & real (kind=kind_phys) :: dltg, hdlt, tmp1, tmp2, & & asnow, argh, hrgh, fsno -#if 1 +#ifdef ORIG_ALB_EMS_OPTION_ONE real (kind=kind_phys) :: fsno0, fsno1 #endif real (kind=kind_phys) :: sfcemis_land, sfcemis_ice @@ -922,7 +930,7 @@ subroutine setemis & lab_do_IMAX : do i = 1, IMAX -#if 0 +#ifndef ORIG_ALB_EMS_OPTION_ONE if (fracl(i) < epsln) then ! no land if ( abs(fraco(i)-f_one) < epsln ) then ! open water point sfcemis(i) = emsref(1) @@ -974,7 +982,7 @@ subroutine setemis & idx = max( 2, idxems(i2,j2) ) if ( idx >= 7 ) idx = 2 -#if 0 +#ifndef ORIG_ALB_EMS_OPTION_ONE if (abs(fracl(i)-f_one) < epsln) then sfcemis(i) = emsref(idx) else @@ -990,7 +998,7 @@ subroutine setemis & !> - Check for snow covered area. -#if 0 +#ifndef ORIG_ALB_EMS_OPTION_ONE if ( sncovr(i) > f_zero ) then ! input land/ice area snow cover fsno = sncovr(i) From 0119e95e0c1eb60ef90a9c782b657d3e363843cb Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Wed, 21 Apr 2021 17:26:37 +0000 Subject: [PATCH 19/74] Small bug fixes and changes in comments in setalb for ialb=1 or 2. --- physics/radiation_surface.f | 48 ++++++++++++++++++------------------- 1 file changed, 23 insertions(+), 25 deletions(-) diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 173e7fe81..97e34224d 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -461,12 +461,10 @@ subroutine setalb & ! direct albedo CZA dependence over water if (fraco(i) > f_zero .and. coszf(i) > 0.0001) then - if (tsknf(i) >= con_t0c) then - asevb_wat = max (asevd_wat, 0.026/(coszf(i)**1.7 + 0.065) & - & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & - & * (coszf(i)-f_one)) - asenb_wat = asevb_wat - endif + asevb_wat = max (asevd_wat, 0.026/(coszf(i)**1.7 + 0.065) & + & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & + & * (coszf(i)-f_one)) + asenb_wat = asevb_wat endif if (icy(i)) then @@ -474,15 +472,16 @@ subroutine setalb & asnow = 0.02*snowf(i) argh = min(0.50, max(.025, 0.01*zorlf(i))) hrgh = min(f_one,max(0.20,1.0577-1.1538e-3*hprif(i))) - fsno0 = asnow / (argh + asnow) * hrgh + fsno0 = asnow / (argh + asnow) * hrgh ! snow fraction on ice ! diffused - if (tsknf(i) < 271.1) then - asevd_ice = 0.70 - asend_ice = 0.65 - else + if (tsknf(i) > 271.1 .and. tsknf(i) < 271.5) then + !tgs: looks like albedo reduction from puddles on ice a1 = (tsknf(i) - 271.1)**2 asevd_ice = 0.7 - 4.0*a1 asend_ice = 0.65 - 3.6875*a1 + else + asevd_ice = 0.70 + asend_ice = 0.65 endif ! direct asevb_ice = asevd_ice @@ -518,7 +517,7 @@ subroutine setalb & endif ! end icy if (fracl(i) > f_zero) then -!> - Calculate snow cover input directly for land model, no +!> - Use snow cover input directly for land model, no !! conversion needed. fsno0 = sncovr(i) ! snow fraction on land @@ -544,7 +543,7 @@ subroutine setalb & alndvb = ab2bm *flnd + snoalb(i) * fsno alndvd = alvwf(i)*flnd + snoalb(i) * fsno else - !-- fill in values of land albedo + !-- fill in values for land albedo alndnb = 0. alndnd = 0. alndvb = 0. @@ -692,12 +691,10 @@ subroutine setalb & ! direct albedo CZA dependence over water if (fraco(i) > f_zero .and. coszf(i) > 0.0001) then - if (tsknf(i) >= con_t0c) then - asevb_wat = max (asevd_wat, 0.026/(coszf(i)**1.7 + 0.065) & - & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & - & * (coszf(i)-f_one)) - asenb_wat = asevb_wat - endif + asevb_wat = max (asevd_wat, 0.026/(coszf(i)**1.7 + 0.065) & + & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & + & * (coszf(i)-f_one)) + asenb_wat = asevb_wat endif !-- ice albedo @@ -718,13 +715,14 @@ subroutine setalb & hrgh = min(f_one,max(0.20,1.0577-1.1538e-3*hprif(i))) fsno0 = asnow / (argh + asnow) * hrgh ! diffused - if (tsknf(i) < 271.1) then - asevd_ice = 0.70 - asend_ice = 0.65 - else + if (tsknf(i) > 271.1 .and. tsknf(i) < 271.5) then + !tgs: looks like albedo reduction from puddles on ice a1 = (tsknf(i) - 271.1)**2 asevd_ice = 0.7 - 4.0*a1 asend_ice = 0.65 - 3.6875*a1 + else + asevd_ice = 0.70 + asend_ice = 0.65 endif ! direct asevb_ice = asevd_ice @@ -746,13 +744,13 @@ subroutine setalb & asnnb = asnnd endif - ! composite ice albedo and snow albedos + ! composite ice and snow albedos asevd_ice = asevd_ice * (1. - fsno0) + asnvd * fsno0 asend_ice = asend_ice * (1. - fsno0) + asnnd * fsno0 asevb_ice = asevb_ice * (1. - fsno0) + asnvb * fsno0 asenb_ice = asenb_ice * (1. - fsno0) + asnnb * fsno0 endif ! snow - endif ! lsm + endif ! ice option from LSM or otherwise else ! icy = false, fill in values asevd_ice = 0.70 From 11daddb8343f009bf3712c52a4bcd07dc294332c Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Wed, 21 Apr 2021 21:17:16 +0000 Subject: [PATCH 20/74] Removed t1 from lsm_ruc_init. Some clean-up. --- physics/sfc_drv_ruc.F90 | 42 +++++++++++++++++++--------------------- physics/sfc_drv_ruc.meta | 9 --------- 2 files changed, 20 insertions(+), 31 deletions(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 517581c56..3b626154d 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -34,7 +34,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & flag_restart, flag_init, con_fvirt, con_rd, & im, lsoil_ruc, lsoil, kice, nlev, & ! in lsm_ruc, lsm, slmsk, stype, vtype, & ! in - t1, q1, prsl1, tsfc_lnd, tsfc_ice, tsfc_wat, & ! in + q1, prsl1, tsfc_lnd, tsfc_ice, tsfc_wat, & ! in tg3, smc, slc, stc, fice, min_seaice, & ! in sncovr_lnd, sncovr_ice, snoalb, & ! in facsf, facwf, alvsf, alvwf, alnsf, alnwf, & ! in @@ -64,7 +64,6 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & real (kind=kind_phys), dimension(im), intent(in) :: slmsk real (kind=kind_phys), dimension(im), intent(in) :: stype real (kind=kind_phys), dimension(im), intent(in) :: vtype - real (kind=kind_phys), dimension(im), intent(in) :: t1 real (kind=kind_phys), dimension(im), intent(in) :: q1 real (kind=kind_phys), dimension(im), intent(in) :: prsl1 real (kind=kind_phys), dimension(im), intent(in) :: tsfc_lnd @@ -110,7 +109,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & ! --- local real (kind=kind_phys), dimension(lsoil_ruc) :: dzs real (kind=kind_phys) :: alb_lnd, alb_ice - real (kind=kind_phys) :: q0, qs1, rho + real (kind=kind_phys) :: q0, qs1 integer :: ipr, i, k logical :: debug_print integer, dimension(im) :: soiltyp, vegtype @@ -185,33 +184,32 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & sfalb_lnd_bck(i) = 0.25*(alnsf(i) + alnwf(i) + alvsf(i) + alvwf(i)) & * min(1., facsf(i)+facwf(i)) - !-- land - semis_lnd(i) = semisbase(i) * (1.-sncovr_lnd(i)) & - + 0.99 * sncovr_lnd(i) - alb_lnd = sfalb_lnd_bck(i) * (1. - sncovr_lnd(i)) & - + snoalb(i) * sncovr_lnd(i) - albdvis_lnd(i) = alb_lnd - albdnir_lnd(i) = alb_lnd - albivis_lnd(i) = alb_lnd - albinir_lnd(i) = alb_lnd - !-- ice - semis_ice(i) = 0.97 * (1. - sncovr_ice(i)) + 0.99 * sncovr_ice(i) - alb_ice = 0.55 * (1. - sncovr_ice(i)) + 0.75 * sncovr_ice(i) - albdvis_ice(i) = alb_ice - albdnir_ice(i) = alb_ice - albivis_ice(i) = alb_ice - albinir_ice(i) = alb_ice - if (.not.flag_restart) then + !-- land + semis_lnd(i) = semisbase(i) * (1.-sncovr_lnd(i)) & + + 0.99 * sncovr_lnd(i) + alb_lnd = sfalb_lnd_bck(i) * (1. - sncovr_lnd(i)) & + + snoalb(i) * sncovr_lnd(i) + albdvis_lnd(i) = alb_lnd + albdnir_lnd(i) = alb_lnd + albivis_lnd(i) = alb_lnd + albinir_lnd(i) = alb_lnd + !-- ice + semis_ice(i) = 0.97 * (1. - sncovr_ice(i)) + 0.99 * sncovr_ice(i) + alb_ice = 0.55 * (1. - sncovr_ice(i)) + 0.75 * sncovr_ice(i) + albdvis_ice(i) = alb_ice + albdnir_ice(i) = alb_ice + albivis_ice(i) = alb_ice + albinir_ice(i) = alb_ice + !-- initialize QV mixing ratio at the surface from atm. 1st level q0 = max(q1(i)/(1.-q1(i)), 1.e-8) ! q1=specific humidity at level 1 (kg/kg) - rho = prsl1(i) / (con_rd*t1(i)*(1.0+con_fvirt*q0)) qs1 = rslf(prsl1(i),tsfc_lnd(i)) !* qs1=sat. mixing ratio at level 1 (kg/kg) q0 = min(qs1, q0) sfcqv_lnd(i) = q0 qs1 = rslf(prsl1(i),tsfc_ice(i)) sfcqv_ice(i) = qs1 - endif + endif ! .not. restart enddo ! i diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 2e7ce830a..d6dbeefec 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -164,15 +164,6 @@ kind = kind_phys intent = inout optional = F -[t1] - standard_name = air_temperature_at_lowest_model_layer - long_name = mean temperature at lowest model layer - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F [q1] standard_name = water_vapor_specific_humidity_at_lowest_model_layer long_name = water vapor specific humidity at lowest model layer From 2ed6a7c7f88a08acfd33673892c682e7748bc0a8 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 26 Apr 2021 11:14:21 -0600 Subject: [PATCH 21/74] Add missing dependency to physics/GFS_surface_composites.meta --- physics/GFS_surface_composites.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 8db70e7e6..34766e9cb 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_surface_composites_pre type = scheme - dependencies = machine.F + dependencies = machine.F,sfc_diff.f ######################################################################## [ccpp-arg-table] From b51c5b314d3af2d6ee01aa2cd7545c25dd8eccb0 Mon Sep 17 00:00:00 2001 From: Ben Green Date: Mon, 26 Apr 2021 18:45:22 +0000 Subject: [PATCH 22/74] Removing GSD_SURFACE_FLUXES_BUGFIX and replacing with flag thsfc_loc --- physics/GFS_surface_composites.F90 | 24 ++++++---- physics/GFS_surface_composites.meta | 8 ++++ physics/sfc_diag.f | 14 +++--- physics/sfc_diag.meta | 8 ++++ physics/sfc_diff.f | 71 +++++++++++++++++++++-------- physics/sfc_diff.meta | 8 ++++ physics/sfc_nst.f | 41 ++++++++++------- physics/sfc_nst.meta | 8 ++++ physics/sfc_sice.f | 46 +++++++++++-------- physics/sfc_sice.meta | 8 ++++ 10 files changed, 164 insertions(+), 72 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index d5dc67f54..81d9ebf60 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -373,7 +373,7 @@ end subroutine GFS_surface_composites_post_finalize !! \htmlinclude GFS_surface_composites_post_run.html !! subroutine GFS_surface_composites_post_run ( & - im, kice, km, cplflx, cplwav2atm, frac_grid, flag_cice, islmsk, dry, wet, icy, wind, t1, q1, prsl1, & + im, kice, km, cplflx, cplwav2atm, frac_grid, flag_cice, thsfc_loc, islmsk, dry, wet, icy, wind, t1, q1, prsl1, & rd, rvrdm1, landfrac, lakefrac, oceanfrac, zorl, zorlo, zorll, zorli, & cd, cd_wat, cd_lnd, cd_ice, cdq, cdq_wat, cdq_lnd, cdq_ice, rb, rb_wat, rb_lnd, rb_ice, stress, stress_wat, stress_lnd, & stress_ice, ffmm, ffmm_wat, ffmm_lnd, ffmm_ice, ffhh, ffhh_wat, ffhh_lnd, ffhh_ice, uustar, uustar_wat, uustar_lnd, & @@ -410,6 +410,7 @@ subroutine GFS_surface_composites_post_run ( real(kind=kind_phys), dimension(im, km), intent(inout) :: stc ! Additional data needed for calling "stability" + logical, intent(in ) :: thsfc_loc real(kind=kind_phys), intent(in ) :: grav real(kind=kind_phys), dimension(:), intent(in ) :: prslki, z1, ztmax_wat, ztmax_lnd, ztmax_ice @@ -420,7 +421,7 @@ subroutine GFS_surface_composites_post_run ( integer :: i, k real(kind=kind_phys) :: txl, txi, txo, wfrac, q0, rho ! For calling "stability" - real(kind=kind_phys) :: tsurf, virtfac, thv1, tvs, z0max, ztmax + real(kind=kind_phys) :: tsurf, virtfac, tv1, thv1, tvs, z0max, ztmax ! Initialize CCPP error handling variables errmsg = '' @@ -475,24 +476,27 @@ subroutine GFS_surface_composites_post_run ( q0 = max( q1(i), qmin ) virtfac = one + rvrdm1 * q0 -#ifdef GSD_SURFACE_FLUXES_BUGFIX - thv1 = t1(i) / prslk1(i) * virtfac ! Theta-v at lowest level - tvs = half * (tsfc(i)+tsurf)/prsik1(i) * virtfac -#else - thv1 = t1(i) * prslki(i) * virtfac ! Theta-v at lowest level - tvs = half * (tsfc(i)+tsurf) * virtfac -#endif + tv1 = t1(i) * virtfac + + if(thsfc_loc) then ! Use local potential temperature + thv1 = t1(i) * prslki(i) * virtfac ! Theta-v at lowest level + tvs = half * (tsfc(i)+tsurf) * virtfac + else ! Use potential temperature referenced to 1000 hPa + thv1 = t1(i) / prslk1(i) * virtfac ! Theta-v at lowest level + tvs = half * (tsfc(i)+tsurf)/prsik1(i) * virtfac + endif zorl(i) = exp(txl*log(zorll(i)) + txi*log(zorli(i)) + txo*log(zorlo(i))) z0max = 0.01_kind_phys * zorl(i) ztmax = exp(txl*log(ztmax_lnd(i)) + txi*log(ztmax_ice(i)) + txo*log(ztmax_wat(i))) call stability(z1(i), snowd(i), thv1, wind(i), z0max, ztmax, tvs, grav, & ! inputs + tv1, thsfc_loc, & ! inputs rb(i), ffmm(i), ffhh(i), fm10(i), fh2(i), cd(i), cdq(i), & ! outputs stress(i), uustar(i)) ! BWG, 2021/02/25: cmm=cd*wind, chh=cdq*wind, so use composite cd, cdq - rho = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0)) + rho = prsl1(i) / (rd*t1(i)*virtfac) cmm(i) = cd(i)*wind(i) !txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_wat(i) chh(i) = rho*cdq(i)*wind(i) !txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_wat(i) diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 34766e9cb..1ad173852 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -71,6 +71,14 @@ type = logical intent = in optional = F +[thsfc_loc] + standard_name = flag_for_reference_pressure_theta + long_name = flag for reference pressure in theta calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [cplflx] standard_name = flag_for_flux_coupling long_name = flag controlling cplflx collection (default off) diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index b78c9b2f7..ceeaf1be8 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -23,7 +23,7 @@ end subroutine sfc_diag_finalize !! @{ subroutine sfc_diag_run & & (im,grav,cp,eps,epsm1,ps,u1,v1,t1,q1,prslki, & - & evap,fm,fh,fm10,fh2,tskin,qsurf, & + & evap,fm,fh,fm10,fh2,tskin,qsurf,thsfc_loc, & & f10m,u10m,v10m,t2m,q2m,errmsg,errflg & & ) ! @@ -32,6 +32,7 @@ subroutine sfc_diag_run & implicit none ! integer, intent(in) :: im + logical, intent(in) :: thsfc_loc ! Flag for reference pot. temp. real(kind=kind_phys), intent(in) :: grav,cp,eps,epsm1 real(kind=kind_phys), dimension(im), intent(in) :: & & ps, u1, v1, t1, q1, tskin, & @@ -74,11 +75,12 @@ subroutine sfc_diag_run & ! t2m(i) = t2m(i) * sig2k wrk = 1.0 - fhi -#ifdef GSD_SURFACE_FLUXES_BUGFIX - t2m(i) = tskin(i)*wrk + t1(i)*fhi - (grav+grav)/cp -#else - t2m(i) = tskin(i)*wrk + t1(i)*prslki(i)*fhi - (grav+grav)/cp -#endif + + if(thsfc_loc) then ! Use local potential temperature + t2m(i) = tskin(i)*wrk + t1(i)*prslki(i)*fhi - (grav+grav)/cp + else ! Use potential temperature referenced to 1000 hPa + t2m(i) = tskin(i)*wrk + t1(i)*fhi - (grav+grav)/cp + endif if(evap(i) >= 0.) then ! for evaporation>0, use inferred qsurf to deduce q2m q2m(i) = qsurf(i)*wrk + max(qmin,q1(i))*fhi diff --git a/physics/sfc_diag.meta b/physics/sfc_diag.meta index deebf23df..9c1e72433 100644 --- a/physics/sfc_diag.meta +++ b/physics/sfc_diag.meta @@ -168,6 +168,14 @@ kind = kind_phys intent = in optional = F +[thsfc_loc] + standard_name = flag_for_reference_pressure_theta + long_name = flag for reference pressure in theta calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [f10m] standard_name = ratio_of_wind_at_lowest_model_layer_and_wind_at_10m long_name = ratio of fm10 and fm diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 669262982..12441e23a 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -69,6 +69,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & flag_iter,redrag, & !intent(in) & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) & wet,dry,icy, & !intent(in) + & thsfc_loc, & !intent(in) & tskin_wat, tskin_lnd, tskin_ice, & !intent(in) & tsurf_wat, tsurf_lnd, tsurf_ice, & !intent(in) & snwdph_wat,snwdph_lnd,snwdph_ice, & !intent(in) @@ -97,6 +98,8 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) logical, dimension(im), intent(in) :: flag_iter, wet, dry, icy + logical, intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation + real(kind=kind_phys), dimension(im), intent(in) :: u10m,v10m real(kind=kind_phys), intent(in) :: rvrdm1, eps, epsm1, grav real(kind=kind_phys), dimension(im), intent(in) :: & @@ -133,6 +136,9 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) real(kind=kind_phys) :: rat, thv1, restar, wind10m, & czilc, tem1, tem2, virtfac ! + + real(kind=kind_phys) :: tv1 + real(kind=kind_phys) :: tvs, z0, z0max ! real(kind=kind_phys), parameter :: @@ -178,18 +184,26 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ztmax_wat(i) = 1. ! log(1) = 0 virtfac = one + rvrdm1 * max(q1(i),qmin) - thv1 = t1(i) * prslki(i) * virtfac + + tv1 = t1(i) * virtfac ! Virtual temperature in middle of lowest layer + if(thsfc_loc) then ! Use local potential temperature + thv1 = t1(i) * prslki(i) * virtfac + else ! Use potential temperature reference to 1000 hPa + thv1 = t1(i) / prslk1(i) * virtfac + endif ! compute stability dependent exchange coefficients ! this portion of the code is presently suppressed ! if (dry(i)) then ! Some land -#ifdef GSD_SURFACE_FLUXES_BUGFIX - tvs = half * (tsurf_lnd(i)+tskin_lnd(i))/prsik1(i) - & * virtfac -#else - tvs = half * (tsurf_lnd(i)+tskin_lnd(i)) * virtfac -#endif + + if(thsfc_loc) then ! Use local potential temperature + tvs = half * (tsurf_lnd(i)+tskin_lnd(i)) * virtfac + else ! Use potential temperature referenced to 1000 hPa + tvs = half * (tsurf_lnd(i)+tskin_lnd(i))/prsik1(i) + & * virtfac + endif + z0max = max(zmin, min(0.01_kp * z0rl_lnd(i), z1(i))) !** xubin's new z0 over land tem1 = one - shdmax(i) @@ -253,14 +267,21 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) call stability ! --- inputs: & (z1(i), snwdph_lnd(i), thv1, wind(i), - & z0max, ztmax_lnd(i), tvs, grav, + & z0max, ztmax_lnd(i), tvs, grav, tv1, thsfc_loc, ! --- outputs: & rb_lnd(i), fm_lnd(i), fh_lnd(i), fm10_lnd(i), fh2_lnd(i), & cm_lnd(i), ch_lnd(i), stress_lnd(i), ustar_lnd(i)) endif ! Dry points if (icy(i)) then ! Some ice - tvs = half * (tsurf_ice(i)+tskin_ice(i)) * virtfac + + if(thsfc_loc) then ! Use local potential temperature + tvs = half * (tsurf_ice(i)+tskin_ice(i)) * virtfac + else ! Use potential temperature referenced to 1000 hPa + tvs = half * (tsurf_ice(i)+tskin_ice(i))/prsik1(i) + & * virtfac + endif + z0max = max(zmin, min(0.01_kp * z0rl_ice(i), z1(i))) !** xubin's new z0 over land and sea ice tem1 = one - shdmax(i) @@ -288,7 +309,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) call stability ! --- inputs: & (z1(i), snwdph_ice(i), thv1, wind(i), - & z0max, ztmax_ice(i), tvs, grav, + & z0max, ztmax_ice(i), tvs, grav, tv1, thsfc_loc, ! --- outputs: & rb_ice(i), fm_ice(i), fh_ice(i), fm10_ice(i), fh2_ice(i), & cm_ice(i), ch_ice(i), stress_ice(i), ustar_ice(i)) @@ -298,7 +319,14 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! the stuff now put into "stability" if (wet(i)) then ! Some open ocean - tvs = half * (tsurf_wat(i)+tskin_wat(i)) * virtfac + + if(thsfc_loc) then ! Use local potential temperature + tvs = half * (tsurf_wat(i)+tskin_wat(i)) * virtfac + else + tvs = half * (tsurf_wat(i)+tskin_wat(i))/prsik1(i) + & * virtfac + endif + z0 = 0.01_kp * z0rl_wat(i) z0max = max(zmin, min(z0,z1(i))) ustar_wat(i) = sqrt(grav * z0 / charnock) @@ -332,7 +360,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) call stability ! --- inputs: & (z1(i), snwdph_wat(i), thv1, wind(i), - & z0max, ztmax_wat(i), tvs, grav, + & z0max, ztmax_wat(i), tvs, grav, tv1, thsfc_loc, ! --- outputs: & rb_wat(i), fm_wat(i), fh_wat(i), fm10_wat(i), fh2_wat(i), & cm_wat(i), ch_wat(i), stress_wat(i), ustar_wat(i)) @@ -392,6 +420,7 @@ end subroutine sfc_diff_run subroutine stability & ! --- inputs: & ( z1, snwdph, thv1, wind, z0max, ztmax, tvs, grav, & + & tv1, thsfc_loc, & ! --- outputs: & rb, fm, fh, fm10, fh2, cm, ch, stress, ustar) !----- @@ -400,6 +429,8 @@ subroutine stability & ! --- inputs: real(kind=kind_phys), intent(in) :: & & z1, snwdph, thv1, wind, z0max, ztmax, tvs, grav + real(kind=kind_phys), intent(in) :: tv1 + logical, intent(in) :: thsfc_loc ! --- outputs: real(kind=kind_phys), intent(out) :: & @@ -435,13 +466,15 @@ subroutine stability & dtv = thv1 - tvs adtv = max(abs(dtv),0.001_kp) dtv = sign(1.,dtv) * adtv -#ifdef GSD_SURFACE_FLUXES_BUGFIX - rb = max(-5000.0_kp, grav * dtv * z1 - & / (thv1 * wind * wind)) -#else - rb = max(-5000.0_kp, (grav+grav) * dtv * z1 - & / ((thv1 + tvs) * wind * wind)) -#endif + + if(thsfc_loc) then ! Use local potential temperature + rb = max(-5000.0_kp, (grav+grav) * dtv * z1 + & / ((thv1 + tvs) * wind * wind)) + else ! Use potential temperature referenced to 1000 hPa + rb = max(-5000.0_kp, grav * dtv * z1 + & / (tv1 * wind * wind)) + endif + tem1 = one / z0max tem2 = one / ztmax fm = log((z0max+z1) * tem1) diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 63935ac11..17a30f28c 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -250,6 +250,14 @@ type = logical intent = in optional = F +[thsfc_loc] + standard_name = flag_for_reference_pressure_theta + long_name = flag for reference pressure in theta calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [tskin_wat] standard_name = surface_skin_temperature_over_water_interstitial long_name = surface skin temperature over water (temporary use as interstitial) diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index 517aa7ff0..99aab7dd0 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -32,7 +32,7 @@ subroutine sfc_nst_run & & sinlat, stress, & & sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, & & wind, flag_iter, flag_guess, nstf_name1, nstf_name4, & - & nstf_name5, lprnt, ipr, & + & nstf_name5, lprnt, ipr, thsfc_loc, & & tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & ! --- input/output: & z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, & & qsurf, gflux, cmm, chh, evap, hflx, ep, errmsg, errflg & ! --- outputs: @@ -50,7 +50,7 @@ subroutine sfc_nst_run & ! prsl1, prslki, wet, use_flake, xlon, sinlat, stress, ! ! sfcemis, dlwflx, sfcnsw, rain, timestep, kdt,solhr,xcosz, ! ! wind, flag_iter, flag_guess, nstf_name1, nstf_name4, ! -! nstf_name5, lprnt, ipr, ! +! nstf_name5, lprnt, ipr, thsfc_loc, ! ! input/outputs: ! ! tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, ! ! z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, ! @@ -123,6 +123,7 @@ subroutine sfc_nst_run & ! nstf_name5 : zsea2 in mm 1 ! ! lprnt - logical, control flag for check print out 1 ! ! ipr - integer, grid index for check print out 1 ! +! thsfc_loc- logical, flag for reference pressure in theta 1 ! ! ! ! input/outputs: ! li added for oceanic components @@ -199,6 +200,7 @@ subroutine sfc_nst_run & & use_flake ! &, icy logical, intent(in) :: lprnt + logical, intent(in) :: thsfc_loc ! --- input/outputs: ! control variables of dtl system (5+2) and sl (2) and coefficients for d(tz)/d(ts) calculation @@ -297,11 +299,13 @@ subroutine sfc_nst_run & wndmag(i) = sqrt(u1(i)*u1(i) + v1(i)*v1(i)) q0(i) = max(q1(i), 1.0e-8_kp) -#ifdef GSD_SURFACE_FLUXES_BUGFIX - theta1(i) = t1(i) / prslk1(i) ! potential temperature at the middle of lowest model layer -#else - theta1(i) = t1(i) * prslki(i) -#endif + + if(thsfc_loc) then ! Use local potential temperature + theta1(i) = t1(i) * prslki(i) + else ! Use potential temperature referenced to 1000 hPa + theta1(i) = t1(i) / prslk1(i) ! potential temperature at the middle of lowest model layer + endif + tv1(i) = t1(i) * (one + rvrdm1*q0(i)) rho_a(i) = prsl1(i) / (rd*tv1(i)) qss(i) = fpvs(tsurf(i)) ! pa @@ -322,11 +326,12 @@ subroutine sfc_nst_run & ! at previous time step evap(i) = elocp * rch(i) * (qss(i) - q0(i)) qsurf(i) = qss(i) -#ifdef GSD_SURFACE_FLUXES_BUGFIX - hflx(i) = rch(i) * (tsurf(i)/prsik1(i) - theta1(i)) -#else - hflx(i) = rch(i) * (tsurf(i) - theta1(i)) -#endif + + if(thsfc_loc) then ! Use local potential temperature + hflx(i) = rch(i) * (tsurf(i) - theta1(i)) + else ! Use potential temperature referenced to 1000 hPa + hflx(i) = rch(i) * (tsurf(i)/prsik1(i) - theta1(i)) + endif ! if (lprnt .and. i == ipr) print *,' tskin=',tskin(i),' theta1=', ! & theta1(i),' hflx=',hflx(i),' t1=',t1(i),'prslki=',prslki(i) @@ -621,11 +626,13 @@ subroutine sfc_nst_run & qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) qsurf(i) = qss(i) evap(i) = elocp*rch(i) * (qss(i) - q0(i)) -#ifdef GSD_SURFACE_FLUXES_BUGFIX - hflx(i) = rch(i) * (tskin(i)/prsik1(i) - theta1(i)) -#else - hflx(i) = rch(i) * (tskin(i) - theta1(i)) -#endif + + if(thsfc_loc) then ! Use local potential temperature + hflx(i) = rch(i) * (tskin(i) - theta1(i)) + else ! Use potential temperature referenced to 1000 hPa + hflx(i) = rch(i) * (tskin(i)/prsik1(i) - theta1(i)) + endif + endif enddo endif ! if ( nstf_name1 > 1 ) then diff --git a/physics/sfc_nst.meta b/physics/sfc_nst.meta index a29f10f90..dc0056aeb 100644 --- a/physics/sfc_nst.meta +++ b/physics/sfc_nst.meta @@ -410,6 +410,14 @@ type = integer intent = in optional = F +[thsfc_loc] + standard_name = flag_for_reference_pressure_theta + long_name = flag for reference pressure in theta calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [tskin] standard_name = surface_skin_temperature_for_nsst long_name = ocean surface skin temperature diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index 081bbf48e..7b40c9d25 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -44,7 +44,7 @@ subroutine sfc_sice_run & & t0c, rd, ps, t1, q1, delt, & & sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, & & cm, ch, prsl1, prslki, prsik1, prslk1, wind, & - & flag_iter, lprnt, ipr, & + & flag_iter, lprnt, ipr, thsfc_loc, & & hice, fice, tice, weasd, tskin, tprcp, tiice, ep, & ! --- input/outputs: & snwdph, qsurf, snowmt, gflux, cmm, chh, evap, hflx, & ! & frac_grid, icy, islmsk_cice, & @@ -110,6 +110,7 @@ subroutine sfc_sice_run & ! islimsk - integer, sea/land/ice mask (=0/1/2) im ! ! wind - real, im ! ! flag_iter- logical, im ! +! thsfc_loc- logical, reference pressure for potential temp im ! ! ! ! input/outputs: ! ! hice - real, sea-ice thickness im ! @@ -152,6 +153,7 @@ subroutine sfc_sice_run & ! --- inputs: integer, intent(in) :: im, kice, ipr logical, intent(in) :: lprnt + logical, intent(in) :: thsfc_loc logical, intent(in) :: frac_grid real (kind=kind_phys), intent(in) :: sbc, hvap, tgice, cp, eps, & @@ -276,11 +278,13 @@ subroutine sfc_sice_run & q0 = max(q1(i), qmin) ! tsurf(i) = tskin(i) -#ifdef GSD_SURFACE_FLUXES_BUGFIX - theta1(i) = t1(i) / prslk1(i) ! potential temperature in middle of lowest atm. layer -#else - theta1(i) = t1(i) * prslki(i) -#endif + + if(thsfc_loc) then ! Use local potential temperature + theta1(i) = t1(i) * prslki(i) + else ! Use potential temperature referenced to 1000 hPa + theta1(i) = t1(i) / prslk1(i) ! potential temperature in middle of lowest atm. layer + endif + rho(i) = prsl1(i) / (rd*t1(i)*(one+rvrdm1*q0)) qs1 = fpvs(t1(i)) qs1 = max(eps*qs1 / (prsl1(i) + epsm1*qs1), qmin) @@ -333,13 +337,14 @@ subroutine sfc_sice_run & !> - Calculate net non-solar and upir heat flux @ ice surface \a hfi. -#ifdef GSD_SURFACE_FLUXES_BUGFIX - hfi(i) = -dlwflx(i) + sfcemis(i)*sbc*t14 + evapi(i) & - & + rch(i)*(tice(i)/prsik1(i) - theta1(i)) -#else - hfi(i) = -dlwflx(i) + sfcemis(i)*sbc*t14 + evapi(i) & - & + rch(i)*(tice(i) - theta1(i)) -#endif + if(thsfc_loc) then ! Use local potential temperature + hfi(i) = -dlwflx(i) + sfcemis(i)*sbc*t14 + evapi(i) & + & + rch(i)*(tice(i) - theta1(i)) + else ! Use potential temperature referenced to 1000 hPa + hfi(i) = -dlwflx(i) + sfcemis(i)*sbc*t14 + evapi(i) & + & + rch(i)*(tice(i)/prsik1(i) - theta1(i)) + endif + !> - Calculate heat flux derivative at surface \a hfd. hfd(i) = 4.0_kind_phys*sfcemis(i)*sbc*tice(i)*t12 & & + (one + elocp*eps*hvap*qs1/(rd*t12)) * rch(i) @@ -415,13 +420,14 @@ subroutine sfc_sice_run & if (flag(i)) then ! --- ... calculate sensible heat flux (& evap over sea ice) -#ifdef GSD_SURFACE_FLUXES_BUGFIX - hflxi = rch(i) * (tice(i)/prsik1(i) - theta1(i)) - hflxw = rch(i) * (tgice / prsik1(i) - theta1(i)) -#else - hflxi = rch(i) * (tice(i) - theta1(i)) - hflxw = rch(i) * (tgice - theta1(i)) -#endif + if(thsfc_loc) then ! Use local potential temperature + hflxi = rch(i) * (tice(i) - theta1(i)) + hflxw = rch(i) * (tgice - theta1(i)) + else ! Use potential temperature referenced to 1000 hPa + hflxi = rch(i) * (tice(i)/prsik1(i) - theta1(i)) + hflxw = rch(i) * (tgice / prsik1(i) - theta1(i)) + endif + hflx(i) = fice(i)*hflxi + ffw(i)*hflxw evap(i) = fice(i)*evapi(i) + ffw(i)*evapw(i) ! diff --git a/physics/sfc_sice.meta b/physics/sfc_sice.meta index 4ce931bac..b256d54ff 100644 --- a/physics/sfc_sice.meta +++ b/physics/sfc_sice.meta @@ -281,6 +281,14 @@ type = integer intent = in optional = F +[thsfc_loc] + standard_name = flag_for_reference_pressure_theta + long_name = flag for reference pressure in theta calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [hice] standard_name = sea_ice_thickness long_name = sea-ice thickness From b6d0ede38a4d0c231999b0cc3d9241452e5b6fa3 Mon Sep 17 00:00:00 2001 From: Ben Green Date: Mon, 26 Apr 2021 18:52:56 +0000 Subject: [PATCH 23/74] Bugfix --- physics/GFS_surface_composites.F90 | 2 +- physics/GFS_surface_composites.meta | 16 ++++++++-------- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 81d9ebf60..70515cf9b 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -476,8 +476,8 @@ subroutine GFS_surface_composites_post_run ( q0 = max( q1(i), qmin ) virtfac = one + rvrdm1 * q0 - tv1 = t1(i) * virtfac + tv1 = t1(i) * virtfac ! Virtual temperature in middle of lowest layer if(thsfc_loc) then ! Use local potential temperature thv1 = t1(i) * prslki(i) * virtfac ! Theta-v at lowest level tvs = half * (tsfc(i)+tsurf) * virtfac diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 1ad173852..10e19ec4c 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -71,14 +71,6 @@ type = logical intent = in optional = F -[thsfc_loc] - standard_name = flag_for_reference_pressure_theta - long_name = flag for reference pressure in theta calculation - units = flag - dimensions = () - type = logical - intent = in - optional = F [cplflx] standard_name = flag_for_flux_coupling long_name = flag controlling cplflx collection (default off) @@ -916,6 +908,14 @@ type = logical intent = in optional = F +[thsfc_loc] + standard_name = flag_for_reference_pressure_theta + long_name = flag for reference pressure in theta calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [islmsk] standard_name = sea_land_ice_mask long_name = sea/land/ice mask (=0/1/2) From d2100a49478eed9e83178bbac62c183af38941a5 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 26 Apr 2021 15:04:20 -0600 Subject: [PATCH 24/74] Add missing variables to physics/GFS_surface_composites.* --- physics/GFS_surface_composites.F90 | 5 +++-- physics/GFS_surface_composites.meta | 18 ++++++++++++++++++ 2 files changed, 21 insertions(+), 2 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 70515cf9b..d29353cde 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -382,7 +382,7 @@ subroutine GFS_surface_composites_post_run ( ep1d_lnd, ep1d_ice, weasd, weasd_wat, weasd_lnd, weasd_ice, snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & tprcp_lnd, tprcp_ice, evap, evap_wat, evap_lnd, evap_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, qss, qss_wat, qss_lnd, & qss_ice, tsfc, tsfco, tsfcl, tsfc_wat, tsfc_lnd, tsfc_ice, tisfc, tice, hice, cice, min_seaice, tiice, stc, & - grav, prslki, z1, ztmax_wat, ztmax_lnd, ztmax_ice, errmsg, errflg) + grav, prsik1, prslk1, prslki, z1, ztmax_wat, ztmax_lnd, ztmax_ice, errmsg, errflg) implicit none @@ -412,7 +412,8 @@ subroutine GFS_surface_composites_post_run ( ! Additional data needed for calling "stability" logical, intent(in ) :: thsfc_loc real(kind=kind_phys), intent(in ) :: grav - real(kind=kind_phys), dimension(:), intent(in ) :: prslki, z1, ztmax_wat, ztmax_lnd, ztmax_ice + real(kind=kind_phys), dimension(:), intent(in ) :: prsik1, prslk1, prslki, z1 + real(kind=kind_phys), dimension(:), intent(in ) :: ztmax_wat, ztmax_lnd, ztmax_ice character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 10e19ec4c..416ddb573 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -1883,6 +1883,24 @@ kind = kind_phys intent = in optional = F +[prsik1] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at the ground surface + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[prslk1] + standard_name = dimensionless_exner_function_at_lowest_model_layer + long_name = dimensionless Exner function at the lowest model layer + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [prslki] standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer long_name = Exner function ratio bt midlayer and interface at 1st layer From c14375b3e648d0c2fb8086643b86a705ba916e96 Mon Sep 17 00:00:00 2001 From: XiaSun-NOAA Date: Tue, 27 Apr 2021 18:21:43 +0000 Subject: [PATCH 25/74] add imp_physics consistency check for Zhao-Carr under physics dir --- physics/gscond.f | 36 ++++++++++++++++++++++++++++++++++-- physics/gscond.meta | 38 ++++++++++++++++++++++++++++++++++++++ physics/precpd.f | 34 +++++++++++++++++++++++++++++++++- physics/precpd.meta | 38 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 143 insertions(+), 3 deletions(-) diff --git a/physics/gscond.f b/physics/gscond.f index 28f24763c..c82508c8e 100644 --- a/physics/gscond.f +++ b/physics/gscond.f @@ -5,14 +5,46 @@ !> This module contains the CCPP-compliant zhao_carr_gscond scheme. module zhaocarr_gscond - contains + + implicit none + public :: zhaocarr_gscond_init, zhaocarr_gscond_run, & + & zhaocarr_gscond_finalize + private + logical :: is_initialized = .False. + contains ! \brief Brief description of the subroutine ! !> \section arg_table_gscond_init Argument Table !! - subroutine zhaocarr_gscond_init + subroutine zhaocarr_gscond_init (imp_physics, & + & imp_physics_zhao_carr, & + & errmsg, errflg) + implicit none + + ! Interface variables + integer, intent(in ) :: imp_physics + integer, intent(in ) :: imp_physics_zhao_carr + ! CCPP error handling + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + if (is_initialized) return + + ! Consistency checks + if (imp_physics/=imp_physics_zhao_carr) then + write(errmsg,'(*(a))') "Logic error: namelist choice of & + & microphysics is different from Zhao-Carr MP" + errflg = 1 + return + end if + + is_initialized = .true. end subroutine zhaocarr_gscond_init ! \brief Brief description of the subroutine diff --git a/physics/gscond.meta b/physics/gscond.meta index 75b2d3a89..f13a41a74 100644 --- a/physics/gscond.meta +++ b/physics/gscond.meta @@ -3,6 +3,44 @@ type = scheme dependencies = funcphys.f90,machine.F,physcons.F90 +######################################################################## +[ccpp-arg-table] + name = zhaocarr_gscond_init + type = scheme +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr] + standard_name = flag_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = zhaocarr_gscond_run diff --git a/physics/precpd.f b/physics/precpd.f index c64474c01..1ce8491ee 100644 --- a/physics/precpd.f +++ b/physics/precpd.f @@ -4,9 +4,41 @@ !> This module contains the CCPP-compliant zhao_carr_precpd scheme. module zhaocarr_precpd + + implicit none + public :: zhaocarr_precpd_init, zhaocarr_precpd_run, & + & zhaocarr_precpd_finalize + private + logical :: is_initialized = .False. contains - subroutine zhaocarr_precpd_init () + subroutine zhaocarr_precpd_init (imp_physics, & + & imp_physics_zhao_carr, & + & errmsg, errflg) + implicit none + + ! Interface variables + integer, intent(in ) :: imp_physics + integer, intent(in ) :: imp_physics_zhao_carr + ! CCPP error handling + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + if (is_initialized) return + + ! Consistency checks + if (imp_physics/=imp_physics_zhao_carr) then + write(errmsg,'(*(a))') "Logic error: namelist choice of & + & microphysics is different from Zhao-Carr MP" + errflg = 1 + return + end if + + is_initialized = .true. end subroutine zhaocarr_precpd_init !> \defgroup precip GFS precpd Main diff --git a/physics/precpd.meta b/physics/precpd.meta index 715991990..bf78254f2 100644 --- a/physics/precpd.meta +++ b/physics/precpd.meta @@ -3,6 +3,44 @@ type = scheme dependencies = funcphys.f90,machine.F,physcons.F90 +######################################################################## +[ccpp-arg-table] + name = zhaocarr_precpd_init + type = scheme +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr] + standard_name = flag_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = zhaocarr_precpd_run From 45849a9859fca65d803ea7502e307cd092127a0a Mon Sep 17 00:00:00 2001 From: Ben Green Date: Wed, 28 Apr 2021 16:31:05 +0000 Subject: [PATCH 26/74] Only do 4th call to stability if multiple surface types exist --- physics/GFS_surface_composites.F90 | 43 ++++++++++++++++++++++++++---- 1 file changed, 38 insertions(+), 5 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index d29353cde..d9bae5e44 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -491,13 +491,46 @@ subroutine GFS_surface_composites_post_run ( z0max = 0.01_kind_phys * zorl(i) ztmax = exp(txl*log(ztmax_lnd(i)) + txi*log(ztmax_ice(i)) + txo*log(ztmax_wat(i))) - call stability(z1(i), snowd(i), thv1, wind(i), z0max, ztmax, tvs, grav, & ! inputs - tv1, thsfc_loc, & ! inputs - rb(i), ffmm(i), ffhh(i), fm10(i), fh2(i), cd(i), cdq(i), & ! outputs - stress(i), uustar(i)) + ! Only actually need to call "stability" if multiple surface types exist... + if(txl .eq. one) then ! 100% land + rb(i) = rb_lnd(i) + ffmm(i) = ffmm_lnd(i) + ffhh(i) = ffhh_lnd(i) + fm10(i) = fm10_lnd(i) + fh2(i) = fh2_lnd(i) + cd(i) = cd_lnd(i) + cdq(i) = cdq_lnd(i) + stress(i) = stress_lnd(i) + uustar(i) = uustar_lnd(i) + elseif(txo .eq. one) then ! 100% open water + rb(i) = rb_wat(i) + ffmm(i) = ffmm_wat(i) + ffhh(i) = ffhh_wat(i) + fm10(i) = fm10_wat(i) + fh2(i) = fh2_wat(i) + cd(i) = cd_wat(i) + cdq(i) = cdq_wat(i) + stress(i) = stress_wat(i) + uustar(i) = uustar_wat(i) + elseif(txi .eq. one) then ! 100% ice + rb(i) = rb_ice(i) + ffmm(i) = ffmm_ice(i) + ffhh(i) = ffhh_ice(i) + fm10(i) = fm10_ice(i) + fh2(i) = fh2_ice(i) + cd(i) = cd_ice(i) + cdq(i) = cdq_ice(i) + stress(i) = stress_ice(i) + uustar(i) = uustar_ice(i) + else ! Mix of multiple surface types (land, water, and/or ice) + call stability(z1(i), snowd(i), thv1, wind(i), z0max, ztmax, tvs, grav, & ! inputs + tv1, thsfc_loc, & ! inputs + rb(i), ffmm(i), ffhh(i), fm10(i), fh2(i), cd(i), cdq(i), & ! outputs + stress(i), uustar(i)) + endif ! Checking to see if point is one or multiple surface types ! BWG, 2021/02/25: cmm=cd*wind, chh=cdq*wind, so use composite cd, cdq - rho = prsl1(i) / (rd*t1(i)*virtfac) + rho = prsl1(i) / (rd*tv1) cmm(i) = cd(i)*wind(i) !txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_wat(i) chh(i) = rho*cdq(i)*wind(i) !txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_wat(i) From 5da36fc2cb5226176609454f2da829dcf450a41c Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Wed, 28 Apr 2021 17:14:03 +0000 Subject: [PATCH 27/74] Removed interstitial variable from lsm_ruc_init. Use threasholds for lake and sea ice to define the point where RUC ice model is called in the uncoupled case. --- physics/sfc_drv_ruc.F90 | 46 ++++++++++++++++++++++++++-------------- physics/sfc_drv_ruc.meta | 31 +++++++++++++++++++++++++-- 2 files changed, 59 insertions(+), 18 deletions(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 3b626154d..4bd407193 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -16,7 +16,7 @@ module lsm_ruc public :: lsm_ruc_init, lsm_ruc_run, lsm_ruc_finalize - real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0, epsln = 1.0d-10 + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys, epsln = 1.0e-10_kind_phys real(kind=kind_phys), dimension (2), parameter, private :: d = (/0.1,0.25/) integer, dimension(20), parameter, private:: & istwe = (/1,1,1,1,1,2,2,1,1,2,2,2,2,2,1,2,2,1,2,2/) ! IGBP 20 classes @@ -342,6 +342,7 @@ subroutine lsm_ruc_run & ! inputs & prsl1, zf, wind, shdmin, shdmax, & & srflag, sfalb_lnd_bck, snoalb, & & isot, ivegsrc, fice, smcwlt2, smcref2, & + & min_lakeice, min_seaice, oceanfrac, & ! --- constants & con_cp, con_rd, con_rv, con_g, con_pi, con_hvap, & & con_fvirt, & @@ -379,8 +380,6 @@ subroutine lsm_ruc_run & ! inputs ! --- constant parameters: real(kind=kind_phys), parameter :: rhoh2o = 1000.0 real(kind=kind_phys), parameter :: stbolt = 5.670400e-8 - real(kind=kind_phys), parameter :: cimin = 0.15 !--- in GFS - !real(kind=kind_phys), parameter :: cimin = 0.02 !--- minimum ice concentration, 0.15 in GFS real(kind=kind_phys), parameter :: con_tice = 271.2 ! --- input: @@ -396,11 +395,11 @@ subroutine lsm_ruc_run & ! inputs ! for land & cm_lnd, ch_lnd, & ! for water - & ch_wat, tskin_wat, & + & ch_wat, tskin_wat, oceanfrac, & ! for ice & cm_ice, ch_ice - real (kind=kind_phys), intent(in) :: delt + real (kind=kind_phys), intent(in) :: delt, min_seaice, min_lakeice real (kind=kind_phys), intent(in) :: con_cp, con_rv, con_g, & con_pi, con_rd, & con_hvap, con_fvirt @@ -476,6 +475,8 @@ subroutine lsm_ruc_run & ! inputs real (kind=kind_phys), dimension(im,lsoil_ruc,1) :: smsoil, & slsoil, stsoil, smfrsoil, keepfrsoil, stsice + real (kind=kind_phys), dimension(im,lsoil_ruc,1) :: smice, & + slice, stice, smfrice, keepfrice real (kind=kind_phys), dimension(im,lsoil_ruc) :: smois_old, & & tsice_old, tslb_old, sh2o_old, & @@ -529,8 +530,8 @@ subroutine lsm_ruc_run & ! inputs ! local integer :: ims,ime, its,ite, jms,jme, jts,jte, kms,kme, kts,kte integer :: l, k, i, j, fractional_seaice, ilst - real (kind=kind_phys) :: dm - logical :: flag(im), flag_ice_uncoupled(im) + real (kind=kind_phys) :: dm, cimin + logical :: flag(im), flag_ice(im), flag_ice_uncoupled(im) logical :: rdlai2d, myj, frpcpn logical :: debug_print ! @@ -545,9 +546,22 @@ subroutine lsm_ruc_run & ! inputs chklowq = 1. do i = 1, im ! i - horizontal loop + flag_ice(i) = .false. + if (icy(i) .and. .not. flag_cice(i)) then + ! - uncoupled ice model + if (oceanfrac(i) > zero) then + cimin = min_seaice + else + cimin = min_lakeice + endif + if (fice(i) >= cimin) then + ! - ice fraction is above the threshold for ice + flag_ice(i) = .true. + endif + endif ! - Set flag for ice points for uncoupled model (islmsk(i) == 4 when coupled to CICE) ! - Exclude ice on the lakes if the lake model is turned on. - flag_ice_uncoupled(i) = (icy(i) .and. .not. flag_cice(i) .and. .not. lake(i)) + flag_ice_uncoupled(i) = (flag_ice(i) .and. .not. lake(i)) !> - Set flag for land and ice points. !- 10may19 - ice points are turned off. flag(i) = land(i) .or. flag_ice_uncoupled(i) @@ -1254,10 +1268,10 @@ subroutine lsm_ruc_run & ! inputs tsnav_ice(i,j) = 0.5*(soilt_ice(i,j) + soilt1_ice(i,j)) - 273.15 do k = 1, lsoil_ruc stsice (i,k,j) = tsice(i,k) - smsoil (i,k,j) = 1. - slsoil (i,k,j) = 0. - smfrsoil(i,k,j) = 1. - keepfrsoil(i,k,j) = 1. + smice (i,k,j) = 1. + slice (i,k,j) = 0. + smfrice (i,k,j) = 1. + keepfrice(i,k,j) = 1. enddo wet_ice(i,j) = 1. @@ -1319,13 +1333,13 @@ subroutine lsm_ruc_run & ! inputs ! --- constants & con_cp, con_rv, con_rd, con_g, con_pi, con_hvap, stbolt, & ! --- input/outputs: - & smsoil(i,:,j), slsoil(i,:,j), soilm(i,j), smmax(i,j), & + & smice(i,:,j), slice(i,:,j), soilm(i,j), smmax(i,j), & & stsice(i,:,j), soilt_ice(i,j), & & hfx_ice(i,j), qfx_ice(i,j), lh_ice(i,j), & & infiltr(i,j), runoff1(i,j), runoff2(i,j), acrunoff(i,j), & & sfcexc(i,j), acceta(i,j), ssoil_ice(i,j), & - & snfallac_ice(i,j), acsn(i,j), snomlt_ice(i,j), & - & smfrsoil(i,:,j),keepfrsoil(i,:,j), .false., & + & snfallac_ice(i,j), acsn(i,j), snomlt_ice(i,j), & + & smfrice(i,:,j),keepfrice(i,:,j), .false., & & shdmin1d(i,j), shdmax1d(i,j), rdlai2d, & & ims,ime, jms,jme, kms,kme, & & its,ite, jts,jte, kts,kte ) @@ -1360,7 +1374,7 @@ subroutine lsm_ruc_run & ! inputs do k = 1, lsoil_ruc tsice(i,k) = stsice(i,k,j) - if(.not. frac_grid) then + if(.not. frac_grid .or. .not. land(i)) then smois(i,k) = 1. sh2o(i,k) = 0. tslb(i,k) = stsice(i,k,j) diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index d6dbeefec..692a9cf63 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -192,8 +192,8 @@ intent = inout optional = F [tsfc_ice] - standard_name = surface_skin_temperature_over_ice_interstitial - long_name = surface skin temperature over ice (temporary use as interstitial) + standard_name = sea_ice_temperature + long_name = sea ice surface skin temperature units = K dimensions = (horizontal_loop_extent) type = real @@ -1021,6 +1021,33 @@ kind = kind_phys intent = inout optional = F +[min_lakeice] + standard_name = lake_ice_minimum + long_name = minimum lake ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[min_seaice] + standard_name = sea_ice_minimum + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[oceanfrac] + standard_name = sea_area_fraction + long_name = fraction of horizontal grid area occupied by ocean + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [con_cp] standard_name = specific_heat_of_dry_air_at_constant_pressure long_name = specific heat !of dry air at constant pressure From d39a04defd699db64d8c51db6e123d790c0d71a9 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 11:57:41 -0600 Subject: [PATCH 28/74] Consistency check for RRTMG scheme --- physics/GFS_rrtmg_setup.F90 | 10 +++++++++- physics/GFS_rrtmg_setup.meta | 8 ++++++++ 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/GFS_rrtmg_setup.F90 index 9d0e42643..84b2549f1 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -49,7 +49,7 @@ subroutine GFS_rrtmg_setup_init ( & icliq_sw, crick_proof, ccnorm, & imp_physics, & norad_precip, idate, iflip, & - im, faerlw, faersw, aerodp, & ! for consistency checks + do_RRTMGP, im, faerlw, faersw, aerodp, & ! for consistency checks me, errmsg, errflg) ! ================= subprogram documentation block ================ ! ! ! @@ -188,6 +188,8 @@ subroutine GFS_rrtmg_setup_init ( & integer, intent(in) :: idate(:) integer, intent(in) :: iflip ! For consistency checks + + logical, intent(in) :: do_RRTMGP integer, intent(in) :: im real(kind_phys), intent(in) :: faerlw(:,:,:,:) real(kind_phys), intent(in) :: faersw(:,:,:,:) @@ -208,6 +210,12 @@ subroutine GFS_rrtmg_setup_init ( & errflg = 0 if (is_initialized) return + + if (do_RRTMGP) then + write(errmsg,'(*(a))') "Logic error: do_RRTMGP should be set false" + errflg = 1 + return + end if ! Consistency checks for dimensions of arrays, this is required ! to detect differences in FV3's parameters that are used to diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index 513594ab2..b75c8b044 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -185,6 +185,14 @@ type = integer intent = in optional = F +[do_RRTMGP] + standard_name = flag_for_rrtmgp_radiation_scheme + long_name = flag for RRTMGP scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F [im] standard_name = horizontal_dimension long_name = horizontal dimension From e2b89742d2e30446518636b02f86ad0bb86584eb Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 11:58:29 -0600 Subject: [PATCH 29/74] Consistency check for RRTMGP scheme --- physics/GFS_rrtmgp_setup.F90 | 14 +++++++++++--- physics/GFS_rrtmgp_setup.meta | 8 ++++++++ 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index a55c84ae7..2eb2e6933 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -40,13 +40,14 @@ module GFS_rrtmgp_setup !! \section arg_table_GFS_rrtmgp_setup_init !! \htmlinclude GFS_rrtmgp_setup_init.html !! - subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics_gfdl, & - imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & + subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, & + imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & imp_physics_zhao_carr_pdf, imp_physics_mg, si, levr, ictm, isol, ico2, iaer, ialb, & iems, ntcw, num_p3d, ntoz, iovr, isubc_sw, isubc_lw, icliq_sw, crick_proof, ccnorm, & norad_precip, idate, iflip, me, errmsg, errflg) ! Inputs + logical, intent(in) :: do_RRTMGP integer, intent(in) :: & imp_physics, & ! Flag for MP scheme imp_physics_fer_hires, & ! Flag for fer-hires scheme @@ -75,7 +76,14 @@ subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics errflg = 0 if (is_initialized) return - + + ! Consistency checks + if (.not. do_RRTMGP) then + write(errmsg,'(*(a))') "Logic error: do_RRTMGP should be set true" + errflg = 1 + return + end if + ! Set radiation parameters isolar = isol ! solar constant control flag ictmflg = ictm ! data ic time/date control flag diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index 7890d3d48..8c436fe62 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -8,6 +8,14 @@ [ccpp-arg-table] name = GFS_rrtmgp_setup_init type = scheme +[do_RRTMGP] + standard_name = flag_for_rrtmgp_radiation_scheme + long_name = flag for RRTMGP scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F [imp_physics] standard_name = flag_for_microphysics_scheme long_name = choice of microphysics scheme From 0c7022d5926b9b669881e5147705541677ec2cda Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 12:02:47 -0600 Subject: [PATCH 30/74] Consistency check for G-F convection --- physics/cu_gf_driver.F90 | 21 +++++++++++++++++++-- physics/cu_gf_driver.meta | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 51 insertions(+), 2 deletions(-) diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 27165e067..758969fbd 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -23,10 +23,13 @@ module cu_gf_driver !! \section arg_table_cu_gf_driver_init Argument Table !! \htmlinclude cu_gf_driver_init.html !! - subroutine cu_gf_driver_init(mpirank, mpiroot, errmsg, errflg) + subroutine cu_gf_driver_init(imfshalcnv, imfshalcnv_gf, imfdeepcnv, & + imfdeepcnv_gf,mpirank, mpiroot, errmsg, errflg) implicit none - + + integer, intent(in) :: imfshalcnv, imfshalcnv_gf + integer, intent(in) :: imfdeepcnv, imfdeepcnv_gf integer, intent(in) :: mpirank integer, intent(in) :: mpiroot character(len=*), intent( out) :: errmsg @@ -44,6 +47,20 @@ subroutine cu_gf_driver_init(mpirank, mpiroot, errmsg, errflg) end if ! *DH temporary + ! Consistency checks + if (imfshalcnv/=imfshalcnv_gf) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of', & + & ' shallow convection is different from Grell-Freitas scheme' + errflg = 1 + return + end if + + if (imfdeepcnv/=imfdeepcnv_gf) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of', & + & ' deep convection is different from Grell-Freitas scheme' + errflg = 1 + return + end if end subroutine cu_gf_driver_init subroutine cu_gf_driver_finalize() diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index f27b2cc91..73ce19754 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -7,6 +7,38 @@ [ccpp-arg-table] name = cu_gf_driver_init type = scheme +[imfshalcnv] + standard_name = flag_for_mass_flux_shallow_convection_scheme + long_name = flag for mass-flux shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfshalcnv_gf] + standard_name = flag_for_gf_shallow_convection_scheme + long_name = flag for Grell-Freitas shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv_gf] + standard_name = flag_for_gf_deep_convection_scheme + long_name = flag for Grell-Freitas deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [mpirank] standard_name = mpi_rank long_name = current MPI-rank From 5d70274607c421090fcb22a8422e366a78b000b9 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 12:03:30 -0600 Subject: [PATCH 31/74] Consistency check for ntiedke convection schemes --- physics/cu_ntiedtke.F90 | 20 +++++++++++++++++++- physics/cu_ntiedtke.meta | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 51 insertions(+), 1 deletion(-) diff --git a/physics/cu_ntiedtke.F90 b/physics/cu_ntiedtke.F90 index 0fab755dc..c9b95a816 100644 --- a/physics/cu_ntiedtke.F90 +++ b/physics/cu_ntiedtke.F90 @@ -106,10 +106,13 @@ module cu_ntiedtke !! \section arg_table_cu_ntiedtke_init Argument Table !! \htmlinclude cu_ntiedtke_init.html !! - subroutine cu_ntiedtke_init(mpirank, mpiroot, errmsg, errflg) + subroutine cu_ntiedtke_init(imfshalcnv, imfshalcnv_ntiedtke, imfdeepcnv, & + imfdeepcnv_ntiedtke,mpirank, mpiroot, errmsg, errflg) implicit none + integer, intent(in) :: imfshalcnv, imfshalcnv_ntiedtke + integer, intent(in) :: imfdeepcnv, imfdeepcnv_ntiedtke integer, intent(in) :: mpirank integer, intent(in) :: mpiroot character(len=*), intent( out) :: errmsg @@ -127,6 +130,21 @@ subroutine cu_ntiedtke_init(mpirank, mpiroot, errmsg, errflg) end if ! *DH temporary + ! Consistency checks + if (imfshalcnv/=imfshalcnv_ntiedtke) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of', & + & ' shallow convection is different from new Tiedtke scheme' + errflg = 1 + return + end if + + if (imfdeepcnv/=imfdeepcnv_ntiedtke) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of', & + & ' deep convection is different from new Tiedtke scheme' + errflg = 1 + return + end if + end subroutine cu_ntiedtke_init subroutine cu_ntiedtke_finalize() diff --git a/physics/cu_ntiedtke.meta b/physics/cu_ntiedtke.meta index 70e977eed..4d4c6597a 100644 --- a/physics/cu_ntiedtke.meta +++ b/physics/cu_ntiedtke.meta @@ -7,6 +7,38 @@ [ccpp-arg-table] name = cu_ntiedtke_init type = scheme +[imfshalcnv] + standard_name = flag_for_mass_flux_shallow_convection_scheme + long_name = flag for mass-flux shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfshalcnv_ntiedtke] + standard_name = flag_for_ntiedtke_shallow_convection_scheme + long_name = flag for new Tiedtke shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv_ntiedtke] + standard_name = flag_for_ntiedtke_deep_convection_scheme + long_name = flag for new Tiedtke deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [mpirank] standard_name = mpi_rank long_name = current MPI-rank From a30acf71f92829e7dcf329eb9053e297f5e0c682 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 12:04:08 -0600 Subject: [PATCH 32/74] Consistency check for GSL drag suite --- physics/drag_suite.F90 | 19 ++++++++++++++++++- physics/drag_suite.meta | 30 ++++++++++++++++++++++++++++++ 2 files changed, 48 insertions(+), 1 deletion(-) diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 92a1c0bd3..8b8b16523 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -7,7 +7,24 @@ module drag_suite contains - subroutine drag_suite_init() + subroutine drag_suite_init(gwd_opt, errmsg, errflg) + + integer, intent(in) :: gwd_opt + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Consistency checks + if (gwd_opt/=3 .or. gwd_opt/=33) then + write(errmsg,'(*(a))') "Logic error: namelist choice of gravity wave & + & drag is different from drag_suite scheme" + errflg = 1 + return + end if end subroutine drag_suite_init ! \defgroup GFS_ogwd GFS Orographic Gravity Wave Drag diff --git a/physics/drag_suite.meta b/physics/drag_suite.meta index 26912cee4..28b0269e9 100644 --- a/physics/drag_suite.meta +++ b/physics/drag_suite.meta @@ -3,6 +3,36 @@ type = scheme dependencies = +######################################################################## +[ccpp-arg-table] + name = unified_ugwp_init + type = scheme +[gwd_opt] + standard_name = gwd_opt + long_name = flag to choose gwd scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = drag_suite_run From 15f0002c9f749fd883272c74c1101fda7c3a4c1d Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 12:05:02 -0600 Subject: [PATCH 33/74] Consistency check for H2O physics --- physics/h2ophys.f | 17 ++++++++++++++++- physics/h2ophys.meta | 30 ++++++++++++++++++++++++++++++ 2 files changed, 46 insertions(+), 1 deletion(-) diff --git a/physics/h2ophys.f b/physics/h2ophys.f index 502ef9796..40294184f 100644 --- a/physics/h2ophys.f +++ b/physics/h2ophys.f @@ -12,7 +12,22 @@ module h2ophys contains - subroutine h2ophys_init() + subroutine h2ophys_init(h2o_phys, errmsg, errflg) + + implicit none + logical, intent(in) :: h2o_phys + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not.h2ophys) then + write (errmsg,'(*(a))') 'Logic error: h2ophys == .false.' + errflg = 1 + return + endif end subroutine h2ophys_init !>\defgroup GFS_h2ophys GFS Water Vapor Photochemical Production and Loss Module diff --git a/physics/h2ophys.meta b/physics/h2ophys.meta index 62db330f4..76451d537 100644 --- a/physics/h2ophys.meta +++ b/physics/h2ophys.meta @@ -3,6 +3,36 @@ type = scheme dependencies = machine.F +######################################################################## +[ccpp-arg-table] + name = h2ophys_init + type = scheme +[h2o_phys] + standard_name = flag_for_stratospheric_water_vapor_physics + long_name = flag for stratospheric water vapor physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = h2ophys_run From 0cde3fba8d002506a9341fed33aa324218e49826 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 12:06:17 -0600 Subject: [PATCH 34/74] Consistency check for SAMF deep convection --- physics/samfdeepcnv.f | 18 +++++++++++++++++- physics/samfdeepcnv.meta | 38 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 55 insertions(+), 1 deletion(-) diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index a0d884e03..425aa92a9 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -10,7 +10,23 @@ module samfdeepcnv contains - subroutine samfdeepcnv_init() + subroutine samfdeepcnv_init(imfdeepcnv,imfdeepcnv_samf, & + & errmsg, errflg) + + integer, intent(in) :: imfdeepcnv + integer, intent(in) :: imfdeepcnv_samf + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + + ! Consistency checks + if (imfdeepcnv/=imfdeepcnv_samf) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of', & + & ' deep convection is different from SAMF scheme' + errflg = 1 + return + end if + end subroutine samfdeepcnv_init subroutine samfdeepcnv_finalize() diff --git a/physics/samfdeepcnv.meta b/physics/samfdeepcnv.meta index 802aeb50a..ff3c0d115 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/samfdeepcnv.meta @@ -3,6 +3,44 @@ type = scheme dependencies = funcphys.f90,machine.F,samfaerosols.F +######################################################################## +[ccpp-arg-table] + name = samfdeepcnv_init + type = scheme +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv_samf] + standard_name = flag_for_samf_deep_convection_scheme + long_name = flag for SAMF deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = samfdeepcnv_run From 9b0a91a5c628279223b9c1003a34e9e9681c7c13 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 12:06:51 -0600 Subject: [PATCH 35/74] Add consistency check for SAMF shallow convection --- physics/samfshalcnv.f | 18 +++++++++++++++++- physics/samfshalcnv.meta | 38 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 55 insertions(+), 1 deletion(-) diff --git a/physics/samfshalcnv.f b/physics/samfshalcnv.f index f2a22b38c..1697cfe35 100644 --- a/physics/samfshalcnv.f +++ b/physics/samfshalcnv.f @@ -9,7 +9,23 @@ module samfshalcnv contains - subroutine samfshalcnv_init() + subroutine samfshalcnv_init(imfshalcnv, imfshalcnv_samf, & + & errmsg, errflg) + + integer, intent(in) :: imfshalcnv + integer, intent(in) :: imfshalcnv_samf + + ! CCPP error handling + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Consistency checks + if (imfshalcnv/=imfshalcnv_samf) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of', & + & ' shallow convection is different from SAMF' + errflg = 1 + return + end if end subroutine samfshalcnv_init subroutine samfshalcnv_finalize() diff --git a/physics/samfshalcnv.meta b/physics/samfshalcnv.meta index 7f5421b70..a454da3e7 100644 --- a/physics/samfshalcnv.meta +++ b/physics/samfshalcnv.meta @@ -3,6 +3,44 @@ type = scheme dependencies = funcphys.f90,machine.F,samfaerosols.F +######################################################################## +[ccpp-arg-table] + name = samfshalcnv_init + type = scheme +[imfshalcnv] + standard_name = flag_for_mass_flux_shallow_convection_scheme + long_name = flag for mass-flux shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfshalcnv_samf] + standard_name = flag_for_samf_shallow_convection_scheme + long_name = flag for SAMF shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = samfshalcnv_run From 68b7b20fc1ee5be901c53b60cbcdd25a36ef8e13 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 12:08:30 -0600 Subject: [PATCH 36/74] Consistency check for Noah LSM --- physics/sfc_drv.f | 12 +++++++++++- physics/sfc_drv.meta | 16 ++++++++++++++++ 2 files changed, 27 insertions(+), 1 deletion(-) diff --git a/physics/sfc_drv.f b/physics/sfc_drv.f index 1f786b496..d50a8505e 100644 --- a/physics/sfc_drv.f +++ b/physics/sfc_drv.f @@ -21,10 +21,12 @@ module lsm_noah !! \section arg_table_lsm_noah_init Argument Table !! \htmlinclude lsm_noah_init.html !! - subroutine lsm_noah_init(me, isot, ivegsrc, nlunit, + subroutine lsm_noah_init(lsm, lsm_noah, me, isot, ivegsrc, nlunit, & pores, resid, errmsg, errflg) implicit none + integer, intent(in) :: lsm + integer, intent(in) :: lsm_noah integer, intent(in) :: me, isot, ivegsrc, nlunit @@ -37,6 +39,14 @@ subroutine lsm_noah_init(me, isot, ivegsrc, nlunit, errmsg = '' errflg = 0 + ! Consistency checks + if (lsm/=lsm_noah) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of ', + & 'LSM is different from Noah' + errflg = 1 + return + end if + if (ivegsrc > 2) then errmsg = 'The NOAH LSM expects that the ivegsrc physics '// & 'namelist parameter is 0, 1, or 2. Exiting...' diff --git a/physics/sfc_drv.meta b/physics/sfc_drv.meta index 9f2e51df3..c68102e7e 100644 --- a/physics/sfc_drv.meta +++ b/physics/sfc_drv.meta @@ -7,6 +7,22 @@ [ccpp-arg-table] name = lsm_noah_init type = scheme +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noah] + standard_name = flag_for_noah_land_surface_scheme + long_name = flag for NOAH land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F [me] standard_name = mpi_rank long_name = current MPI-rank From cb3567e6f601da666c34fe36358c505baf194d1a Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 12:08:49 -0600 Subject: [PATCH 37/74] Consistency check for RUC LSM --- physics/sfc_drv_ruc.F90 | 13 ++++++++++++- physics/sfc_drv_ruc.meta | 16 ++++++++++++++++ 2 files changed, 28 insertions(+), 1 deletion(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 916144cf5..655308d3a 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -25,7 +25,8 @@ module lsm_ruc !! \section arg_table_lsm_ruc_init Argument Table !! \htmlinclude lsm_ruc_init.html !! - subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & + subroutine lsm_ruc_init (lsm, lsm_ruc, & + me, master, isot, ivegsrc, nlunit, & flag_restart, flag_init, & im, lsoil_ruc, lsoil, kice, nlev, & ! in lsm_ruc, lsm, slmsk, stype, vtype, & ! in @@ -36,6 +37,8 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & implicit none ! --- in + integer, intent(in) :: lsm + integer, intent(in) :: lsm_ruc integer, intent(in) :: me, master, isot, ivegsrc, nlunit logical, intent(in) :: flag_restart logical, intent(in) :: flag_init @@ -79,6 +82,14 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + + ! Consistency checks + if (lsm/=lsm_ruc) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of ', + & 'LSM is different from RUC' + errflg = 1 + return + end if ipr = 10 debug_print = .false. diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index e504c0700..f085dd0bc 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -7,6 +7,22 @@ [ccpp-arg-table] name = lsm_ruc_init type = scheme +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F [me] standard_name = mpi_rank long_name = current MPI-rank From caa28fd48e9ea59986769556ec72da88f755cac1 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 12:09:35 -0600 Subject: [PATCH 38/74] Consistency check for Noah-MP LSM --- physics/sfc_noahmp_drv.F90 | 14 ++++++++++++-- physics/sfc_noahmp_drv.meta | 16 ++++++++++++++++ 2 files changed, 28 insertions(+), 2 deletions(-) diff --git a/physics/sfc_noahmp_drv.F90 b/physics/sfc_noahmp_drv.F90 index a1f65f26a..129601e94 100644 --- a/physics/sfc_noahmp_drv.F90 +++ b/physics/sfc_noahmp_drv.F90 @@ -25,7 +25,8 @@ module noahmpdrv !! \section arg_table_noahmpdrv_init Argument Table !! \htmlinclude noahmpdrv_init.html !! - subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, pores, resid, & + subroutine noahmpdrv_init(lsm, lsm_noahmp, me, isot, ivegsrc, & + nlunit, pores, resid, & errmsg, errflg) use machine, only: kind_phys @@ -33,7 +34,8 @@ subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, pores, resid, & use namelist_soilveg implicit none - + integer, intent(in) :: lsm + integer, intent(in) :: lsm_noahmp integer, intent(in) :: me, isot, ivegsrc, nlunit real (kind=kind_phys), dimension(:), intent(out) :: pores, resid @@ -45,6 +47,14 @@ subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, pores, resid, & errmsg = '' errflg = 0 + ! Consistency checks + if (lsm/=lsm_noahmp) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of ', & + & 'LSM is different from Noah' + errflg = 1 + return + end if + if (ivegsrc /= 1) then errmsg = 'The NOAHMP LSM expects that the ivegsrc physics '// & 'namelist parameter is 1. Exiting...' diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta index 76811a378..1e225ddf2 100644 --- a/physics/sfc_noahmp_drv.meta +++ b/physics/sfc_noahmp_drv.meta @@ -7,6 +7,22 @@ [ccpp-arg-table] name = noahmpdrv_init type = scheme +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F [me] standard_name = mpi_rank long_name = current MPI-rank From f0e023a3f13a1d27821b49f63f989cc09a83adec Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 12:10:32 -0600 Subject: [PATCH 39/74] Consistency check for unified_ugwp --- physics/unified_ugwp.F90 | 12 ++++++++++-- physics/unified_ugwp.meta | 8 ++++++++ 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index 288227c8c..c799f0384 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -63,7 +63,7 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & fn_nml2, jdat, lonr, latr, levs, ak, bk, dtp, cdmbgwd, cgwf, & con_pi, con_rerth, pa_rf_in, tau_rf_in, con_p0, do_ugwp, & do_ugwp_v0, do_ugwp_v0_orog_only, do_ugwp_v0_nst_only, & - do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & + do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, gwd_opt, & errmsg, errflg) !---- initialization of unified_ugwp @@ -96,7 +96,8 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & logical :: exists real :: dxsg integer :: k - + + integer, intent(in) :: gwd_opt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -104,6 +105,13 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & errmsg = '' errflg = 0 + ! Consistency checks + if (gwd_opt/=2 .or. gwd_opt/=22) then + write(errmsg,'(*(a))') "Logic error: namelist choice of gravity wave & + & drag is different from unified_ugwp scheme" + errflg = 1 + return + end if ! Test to make sure that at most only one large-scale/blocking ! orographic drag scheme is chosen diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index c51b35c91..f675d1131 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -238,6 +238,14 @@ type = logical intent = in optional = F +[gwd_opt] + standard_name = gwd_opt + long_name = flag to choose gwd scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From fe70d7b6040b1a86479c04bbe16260f176dcac87 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 13:47:09 -0600 Subject: [PATCH 40/74] Consistency check for SHOC PBL scheme --- physics/gcm_shoc.F90 | 17 ++++++++++++++++- physics/gcm_shoc.meta | 30 ++++++++++++++++++++++++++++++ 2 files changed, 46 insertions(+), 1 deletion(-) diff --git a/physics/gcm_shoc.F90 b/physics/gcm_shoc.F90 index 97d12c3f6..4852310fc 100644 --- a/physics/gcm_shoc.F90 +++ b/physics/gcm_shoc.F90 @@ -14,7 +14,22 @@ module shoc contains -subroutine shoc_init () +subroutine shoc_init (do_shoc, errmsg, errflg) + implicit none + logical, intent(in) :: do_shoc + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + +! Consistency checks + if (.not. do_shoc) then + errflg = 1 + write(errmsg,'(*(a))') 'Logic error: do_shoc == .false.' + return + end if end subroutine shoc_init subroutine shoc_finalize () diff --git a/physics/gcm_shoc.meta b/physics/gcm_shoc.meta index 047286317..b021fa306 100644 --- a/physics/gcm_shoc.meta +++ b/physics/gcm_shoc.meta @@ -3,6 +3,36 @@ type = scheme dependencies = funcphys.f90,machine.F +######################################################################## +[ccpp-arg-table] + name = shoc_init + type = scheme +[do_shoc] + standard_name = flag_for_shoc + long_name = flag for SHOC + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = shoc_run From 3da5e497f4ae1fa9e2ccfa3401078a73f9165717 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 13:54:21 -0600 Subject: [PATCH 41/74] Consistency check for MYJ PBL scheme --- physics/module_MYJPBL_wrapper.F90 | 17 ++++++++++++++++- physics/module_MYJPBL_wrapper.meta | 30 ++++++++++++++++++++++++++++++ 2 files changed, 46 insertions(+), 1 deletion(-) diff --git a/physics/module_MYJPBL_wrapper.F90 b/physics/module_MYJPBL_wrapper.F90 index e789ac035..11cbde679 100644 --- a/physics/module_MYJPBL_wrapper.F90 +++ b/physics/module_MYJPBL_wrapper.F90 @@ -8,7 +8,22 @@ MODULE myjpbl_wrapper contains - subroutine myjpbl_wrapper_init () + subroutine myjpbl_wrapper_init (do_myjpbl,errmsg,errflg) + + logical, intent(in) :: do_myjpbl + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Consistency checks + if (.not. do_myjpbl) then + write(errmsg,fmt='(*(a))') 'Logic error: do_myjpbl=.false.' + errflg = 1 + return + end if end subroutine myjpbl_wrapper_init subroutine myjpbl_wrapper_finalize () diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index d241c6f7e..9d70397e7 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -3,6 +3,36 @@ type = scheme dependencies = module_BL_MYJPBL.F90 +######################################################################## +[ccpp-arg-table] + name = myjpbl_wrapper_init + type = scheme +[do_myjpbl] + standard_name = do_myjpbl + long_name = flag to activate MYJ PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = myjpbl_wrapper_run From ad1e4c8483724f7aa13ff6f701069ff7c3d6bfd0 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 13:54:48 -0600 Subject: [PATCH 42/74] Consistency check for MYMM PBL scheme --- physics/module_MYNNPBL_wrapper.F90 | 12 ++++++++++-- physics/module_MYNNPBL_wrapper.meta | 8 ++++++++ 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 837cf8594..3101f79e3 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -13,9 +13,10 @@ MODULE mynnedmf_wrapper !> \section arg_table_mynnedmf_wrapper_init Argument Table !! \htmlinclude mynnedmf_wrapper_init.html !! - subroutine mynnedmf_wrapper_init (lheatstrg, errmsg, errflg) + subroutine mynnedmf_wrapper_init (do_mynnedmf, lheatstrg, errmsg, errflg) implicit none - + + logical, intent(in) :: do_mynnedmf logical, intent(in) :: lheatstrg character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -24,6 +25,13 @@ subroutine mynnedmf_wrapper_init (lheatstrg, errmsg, errflg) errmsg = '' errflg = 0 + ! Consistency checks + if (.not. do_mynnedmf) then + errmsg = 'Logic error: do_mynnedmf = .false.' + errflg = 1 + return + end if + if (lheatstrg) then errmsg = 'Logic error: lheatstrg not implemented for MYNN PBL' errflg = 1 diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 36ff3b067..de24fcbef 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -7,6 +7,14 @@ [ccpp-arg-table] name = mynnedmf_wrapper_init type = scheme +[do_mynnedmf] + standard_name = do_mynnedmf + long_name = flag to activate MYNN-EDMF + units = flag + dimensions = () + type = logical + intent = in + optional = F [lheatstrg] standard_name = flag_for_canopy_heat_storage long_name = flag for canopy heat storage parameterization From b8e35915c73f3cd59d8d0c78db5b43fac6e5a201 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 14:02:10 -0600 Subject: [PATCH 43/74] Consistency check for HEDMF PBL scheme --- physics/moninedmf.f | 14 ++++++++++++-- physics/moninedmf.meta | 8 ++++++++ 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 2abd2226c..326a96953 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -11,16 +11,26 @@ module hedmf !> \section arg_table_hedmf_init Argument Table !! \htmlinclude hedmf_init.html !! - subroutine hedmf_init (moninq_fac,errmsg,errflg) + subroutine hedmf_init (hybedmf,moninq_fac,errmsg,errflg) use machine, only : kind_phys implicit none - real(kind=kind_phys), intent(in ) :: moninq_fac + + logical, intent(in) :: hybedmf + + real(kind=kind_phys), intent(in) :: moninq_fac character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + ! Consistency checks + if (.not. hybedmf) then + errflg = 1 + write(errmsg,'(*(a))') 'Logic error: hybedmf = .false.' + return + end if + if (moninq_fac == 0) then errflg = 1 write(errmsg,'(*(a))') 'Logic error: moninq_fac == 0', diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 7cda18a5c..24096cbe6 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -7,6 +7,14 @@ [ccpp-arg-table] name = hedmf_init type = scheme +[hybedmf] + standard_name = flag_for_hedmf + long_name = flag for hybrid edmf pbl scheme (moninedmf) + units = flag + dimensions = () + type = logical + intent = in + optional = F [moninq_fac] standard_name = atmosphere_diffusivity_coefficient_factor long_name = multiplicative constant for atmospheric diffusivities From ab814f837db217d1c4d4d04c4ebab01327ef4397 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 14:02:31 -0600 Subject: [PATCH 44/74] Consistency check for SHOC PBL scheme --- physics/moninshoc.f | 19 ++++++++++++++++++- physics/moninshoc.meta | 30 ++++++++++++++++++++++++++++++ 2 files changed, 48 insertions(+), 1 deletion(-) diff --git a/physics/moninshoc.f b/physics/moninshoc.f index 7fe652d1b..199c85aa2 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -6,7 +6,24 @@ module moninshoc contains - subroutine moninshoc_init () + subroutine moninshoc_init (do_shoc, errmsg, errflg) + + implicit none + logical, intent(in) :: do_shoc + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Consistency checks + if (.not. do_shoc) then + errflg = 1 + write(errmsg,'(*(a))') 'Logic error: do_shoc = .false.' + return + end if + end subroutine moninshoc_init subroutine moninshoc_finalize () diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index 5cff902d7..51f2c4536 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -3,6 +3,36 @@ type = scheme dependencies = funcphys.f90,machine.F,tridi.f +######################################################################## +[ccpp-arg-table] + name = moninshoc_init + type = scheme +[do_shoc] + standard_name = flag_for_shoc + long_name = flag for SHOC + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = moninshoc_run From a81e22fc8e024a4b769f8d5b3e1341eb1952d236 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 14:06:21 -0600 Subject: [PATCH 45/74] Consistency check for TKE-Based EDMF PBL scheme --- physics/satmedmfvdif.F | 11 ++++++++++- physics/satmedmfvdif.meta | 10 ++++++++++ physics/satmedmfvdifq.F | 12 +++++++++++- physics/satmedmfvdifq.meta | 8 ++++++++ 4 files changed, 39 insertions(+), 2 deletions(-) diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index b3e9af21f..610d79bfe 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -10,9 +10,11 @@ module satmedmfvdif !> \section arg_table_satmedmfvdif_init Argument Table !! \htmlinclude satmedmfvdif_init.html !! - subroutine satmedmfvdif_init (isatmedmf,isatmedmf_vdif, + subroutine satmedmfvdif_init (satmedmf, + & isatmedmf,isatmedmf_vdif, & errmsg,errflg) + logical, intent(in) :: satmedmf integer, intent(in) :: isatmedmf,isatmedmf_vdif character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -21,6 +23,13 @@ subroutine satmedmfvdif_init (isatmedmf,isatmedmf_vdif, errmsg = '' errflg = 0 +! Consistency checks + if (.not. satmedmf) then + write(errmsg,fmt='(*(a))') 'Logic error: satmedmf = .false.' + errflg = 1 + return + end if + if (.not. isatmedmf==isatmedmf_vdif) then write(errmsg,fmt='(*(a))') 'Logic error: satmedmfvdif is ', & 'called, but isatmedmf/=isatmedmf_vdif.' diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index d860e3310..baea94ad5 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -7,6 +7,16 @@ [ccpp-arg-table] name = satmedmfvdif_init type = scheme +[satmedmf] + standard_name = flag_for_scale_aware_TKE_moist_EDMF_PBL + long_name = flag for scale-aware TKE moist EDMF PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F + intent = in + optional = F [isatmedmf] standard_name = choice_of_scale_aware_TKE_moist_EDMF_PBL long_name = choice of scale-aware TKE moist EDMF PBL scheme diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 106c89377..4bbfe61cc 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -19,10 +19,13 @@ module satmedmfvdifq !> \section arg_table_satmedmfvdifq_init Argument Table !! \htmlinclude satmedmfvdifq_init.html !! - subroutine satmedmfvdifq_init (isatmedmf,isatmedmf_vdifq, + subroutine satmedmfvdifq_init (satmedmf, + & isatmedmf,isatmedmf_vdifq, & errmsg,errflg) + logical, intent(in ) :: satmedmf integer, intent(in) :: isatmedmf,isatmedmf_vdifq + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -30,6 +33,13 @@ subroutine satmedmfvdifq_init (isatmedmf,isatmedmf_vdifq, errmsg = '' errflg = 0 +! Consistency checks + if (.not. satmedmf) then + write(errmsg,fmt='(*(a))') 'Logic error: satmedmf = .false.' + errflg = 1 + return + end if + if (.not. isatmedmf==isatmedmf_vdifq) then write(errmsg,fmt='(*(a))') 'Logic error: satmedmfvdif is ', & 'called, but isatmedmf/=isatmedmf_vdifq.' diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index a4a71eed5..fd2dbe887 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -7,6 +7,14 @@ [ccpp-arg-table] name = satmedmfvdifq_init type = scheme +[satmedmf] + standard_name = flag_for_scale_aware_TKE_moist_EDMF_PBL + long_name = flag for scale-aware TKE moist EDMF PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F [isatmedmf] standard_name = choice_of_scale_aware_TKE_moist_EDMF_PBL long_name = choice of scale-aware TKE moist EDMF PBL scheme From 49561292837c8e5b2cc4d9fb0e0004092adcbb51 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 14:08:08 -0600 Subject: [PATCH 46/74] Consistency check for Shinhong PBL scheme --- physics/shinhongvdif.F90 | 17 ++++++++++++++++- physics/shinhongvdif.meta | 30 ++++++++++++++++++++++++++++++ 2 files changed, 46 insertions(+), 1 deletion(-) diff --git a/physics/shinhongvdif.F90 b/physics/shinhongvdif.F90 index e93ad3245..5a3e52db3 100644 --- a/physics/shinhongvdif.F90 +++ b/physics/shinhongvdif.F90 @@ -11,7 +11,22 @@ module shinhongvdif contains - subroutine shinhongvdif_init () + subroutine shinhongvdif_init (shinhong,errmsg,errflg) + + logical, intent(in) :: shinhong + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Consistency checks + if (.not. shinhong) then + write(errmsg,fmt='(*(a))') 'Logic error: shinhong = .false.' + errflg = 1 + return + end if end subroutine shinhongvdif_init subroutine shinhongvdif_finalize () diff --git a/physics/shinhongvdif.meta b/physics/shinhongvdif.meta index 6783fd800..6b12b64f5 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -3,6 +3,36 @@ type = scheme dependencies = machine.F +######################################################################## +[ccpp-arg-table] + name = shinhongvdif_init + type = scheme +[shinhong] + standard_name = flag_for_scale_aware_Shinhong_PBL + long_name = flag for scale-aware Shinhong PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = shinhongvdif_run From 317e311e2ef2a507e5df65892af2752857bbf40a Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 14:10:05 -0600 Subject: [PATCH 47/74] Consistency check for YSU PBL scheme --- physics/ysuvdif.F90 | 17 ++++++++++++++++- physics/ysuvdif.meta | 30 ++++++++++++++++++++++++++++++ 2 files changed, 46 insertions(+), 1 deletion(-) diff --git a/physics/ysuvdif.F90 b/physics/ysuvdif.F90 index e427eb0eb..443137615 100644 --- a/physics/ysuvdif.F90 +++ b/physics/ysuvdif.F90 @@ -11,7 +11,22 @@ module ysuvdif contains - subroutine ysuvdif_init () + subroutine ysuvdif_init (do_ysu,errmsg,errflg) + + integer, intent(in) :: do_ysu + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Consistency checks + if (.not. do_ysu) then + write(errmsg,fmt='(*(a))') 'Logic error: do_ysu = .false.' + errflg = 1 + return + end if end subroutine ysuvdif_init subroutine ysuvdif_finalize () diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index bf684dcbe..1ee952d45 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -3,6 +3,36 @@ type = scheme dependencies = machine.F +######################################################################## +[ccpp-arg-table] + name = ysuvdif_init + type = scheme +[do_ysu] + standard_name = flag_for_ysu + long_name = flag for YSU PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = ysuvdif_run From fd48665ef3e8938891df52579db4fcca0223d7a7 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 14:12:40 -0600 Subject: [PATCH 48/74] Consistency check for MYJ sfclay scheme --- physics/module_MYJSFC_wrapper.F90 | 17 ++++++++++++++++- physics/module_MYJSFC_wrapper.meta | 30 ++++++++++++++++++++++++++++++ 2 files changed, 46 insertions(+), 1 deletion(-) diff --git a/physics/module_MYJSFC_wrapper.F90 b/physics/module_MYJSFC_wrapper.F90 index d908900c4..c392e239e 100644 --- a/physics/module_MYJSFC_wrapper.F90 +++ b/physics/module_MYJSFC_wrapper.F90 @@ -8,7 +8,22 @@ MODULE myjsfc_wrapper contains - subroutine myjsfc_wrapper_init () + subroutine myjsfc_wrapper_init (do_myjsfc, & + & errmsg,errflg) + + logical, intent(in) :: do_myjsfc + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Consistency checks + if (.not. do_myjsfc) then + write(errmsg,fmt='(*(a))') 'Logic error: do_myjsfc = .false.' + errflg = 1 + return end subroutine myjsfc_wrapper_init subroutine myjsfc_wrapper_finalize () diff --git a/physics/module_MYJSFC_wrapper.meta b/physics/module_MYJSFC_wrapper.meta index f3ec33193..828e584e1 100644 --- a/physics/module_MYJSFC_wrapper.meta +++ b/physics/module_MYJSFC_wrapper.meta @@ -3,6 +3,36 @@ type = scheme dependencies = module_SF_JSFC.F90 +######################################################################## +[ccpp-arg-table] + name = myjsfc_wrapper_init + type = scheme +[do_myjsfc] + standard_name = do_myjsfc + long_name = flag to activate MYJ surface layer scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = myjsfc_wrapper_run From 39e21ead70c81d09bf499bc385fd3dc3bce3ce49 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Mon, 10 May 2021 14:15:14 -0600 Subject: [PATCH 49/74] Consistency check for MYNN sfclay scheme --- physics/module_MYNNSFC_wrapper.F90 | 11 ++++++++++- physics/module_MYNNSFC_wrapper.meta | 8 ++++++++ 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index 2de8cd408..a27b02e0d 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -15,8 +15,10 @@ MODULE mynnsfc_wrapper !! \htmlinclude mynnsfc_wrapper_init.html !! - subroutine mynnsfc_wrapper_init(errmsg, errflg) + subroutine mynnsfc_wrapper_init(do_mynnsfclay, & + & errmsg, errflg) + logical, intent(in) :: do_mynnsfclay character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -24,6 +26,13 @@ subroutine mynnsfc_wrapper_init(errmsg, errflg) errmsg = '' errflg = 0 + ! Consistency checks + if (.not. do_mynnsfclay) then + write(errmsg,fmt='(*(a))') 'Logic error: do_mynnsfclay = .false.' + errflg = 1 + return + end if + ! initialize tables for psih and psim (stable and unstable) CALL PSI_INIT(psi_opt,errmsg,errflg) diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 1f16ff161..0bb56a07b 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -7,6 +7,14 @@ [ccpp-arg-table] name = mynnsfc_wrapper_init type = scheme +[do_mynnsfclay] + standard_name = do_mynnsfclay + long_name = flag to activate MYNN surface layer + units = flag + dimensions = () + type = logical + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From c88f128b1bf04e6e5c8ee56dbcb3a5c27d9c1e1d Mon Sep 17 00:00:00 2001 From: XiaSun-NOAA Date: Tue, 11 May 2021 22:58:42 +0000 Subject: [PATCH 50/74] typo fixes --- physics/h2ophys.f | 4 ++-- physics/sfc_drv_ruc.F90 | 5 +---- physics/sfc_drv_ruc.meta | 16 ---------------- 3 files changed, 3 insertions(+), 22 deletions(-) diff --git a/physics/h2ophys.f b/physics/h2ophys.f index 40294184f..863f4f45a 100644 --- a/physics/h2ophys.f +++ b/physics/h2ophys.f @@ -23,8 +23,8 @@ subroutine h2ophys_init(h2o_phys, errmsg, errflg) errmsg = '' errflg = 0 - if (.not.h2ophys) then - write (errmsg,'(*(a))') 'Logic error: h2ophys == .false.' + if (.not.h2o_phys) then + write (errmsg,'(*(a))') 'Logic error: h2o_phys == .false.' errflg = 1 return endif diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 655308d3a..9ca6e8e10 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -25,8 +25,7 @@ module lsm_ruc !! \section arg_table_lsm_ruc_init Argument Table !! \htmlinclude lsm_ruc_init.html !! - subroutine lsm_ruc_init (lsm, lsm_ruc, & - me, master, isot, ivegsrc, nlunit, & + subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & flag_restart, flag_init, & im, lsoil_ruc, lsoil, kice, nlev, & ! in lsm_ruc, lsm, slmsk, stype, vtype, & ! in @@ -37,8 +36,6 @@ subroutine lsm_ruc_init (lsm, lsm_ruc, & implicit none ! --- in - integer, intent(in) :: lsm - integer, intent(in) :: lsm_ruc integer, intent(in) :: me, master, isot, ivegsrc, nlunit logical, intent(in) :: flag_restart logical, intent(in) :: flag_init diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index f085dd0bc..e504c0700 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -7,22 +7,6 @@ [ccpp-arg-table] name = lsm_ruc_init type = scheme -[lsm] - standard_name = flag_for_land_surface_scheme - long_name = flag for land surface model - units = flag - dimensions = () - type = integer - intent = in - optional = F -[lsm_ruc] - standard_name = flag_for_ruc_land_surface_scheme - long_name = flag for RUC land surface model - units = flag - dimensions = () - type = integer - intent = in - optional = F [me] standard_name = mpi_rank long_name = current MPI-rank From 59452cb93c6d5d2252a54f5f26fcf9f3a0f6d1c9 Mon Sep 17 00:00:00 2001 From: XiaSun-NOAA Date: Tue, 11 May 2021 22:59:04 +0000 Subject: [PATCH 51/74] Consistency check for cires_ugwp --- physics/cires_ugwp.F90 | 11 ++++++++++- physics/cires_ugwp.meta | 8 ++++++++ 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index 8f06b5401..38496eeb7 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -40,7 +40,7 @@ module cires_ugwp ! subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & fn_nml2, lonr, latr, levs, ak, bk, dtp, cdmbgwd, cgwf, & - pa_rf_in, tau_rf_in, con_p0, do_ugwp, errmsg, errflg) + pa_rf_in, tau_rf_in, con_p0, gwd_opt,do_ugwp, errmsg, errflg) !---- initialization of cires_ugwp implicit none @@ -58,6 +58,7 @@ subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & real(kind=kind_phys), intent (in) :: cdmbgwd(:), cgwf(:) ! "scaling" controls for "old" GFS-GW schemes real(kind=kind_phys), intent (in) :: pa_rf_in, tau_rf_in real(kind=kind_phys), intent (in) :: con_p0 + integer, intent(in) :: gwd_opt logical, intent (in) :: do_ugwp character(len=*), intent (in) :: fn_nml2 @@ -76,6 +77,14 @@ subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & errflg = 0 if (is_initialized) return + + ! Consistency checks + if (gwd_opt/=1) then + write(errmsg,'(*(a))') "Logic error: namelist choice of gravity wave & + & drag is different from cires_ugwp scheme" + errflg = 1 + return + end if if (do_ugwp .or. cdmbgwd(3) > 0.0) then call cires_ugwpv0_mod_init (me, master, nlunit, input_nml_file, logunit, & diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index e2afbf70f..cf9992624 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -155,6 +155,14 @@ kind = kind_phys intent = in optional = F +[gwd_opt] + standard_name = gwd_opt + long_name = flag to choose gwd scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [do_ugwp] standard_name = do_ugwp long_name = flag to activate CIRES UGWP From 1d8fa1b7bada95d5ba93ca24807c2a2bf101f295 Mon Sep 17 00:00:00 2001 From: XiaSun-NOAA Date: Wed, 12 May 2021 22:34:39 +0000 Subject: [PATCH 52/74] fix some err msg and if statements --- physics/GFS_rrtmg_setup.F90 | 2 +- physics/GFS_rrtmgp_setup.F90 | 2 +- physics/drag_suite.F90 | 2 +- physics/gscond.f | 3 ++- physics/gscond.meta | 8 ++++++++ physics/precpd.f | 3 ++- physics/precpd.meta | 8 ++++++++ physics/unified_ugwp.F90 | 2 +- 8 files changed, 24 insertions(+), 6 deletions(-) diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/GFS_rrtmg_setup.F90 index 84b2549f1..a933637ce 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -212,7 +212,7 @@ subroutine GFS_rrtmg_setup_init ( & if (is_initialized) return if (do_RRTMGP) then - write(errmsg,'(*(a))') "Logic error: do_RRTMGP should be set false" + write(errmsg,'(*(a))') "Logic error: do_RRTMGP must be set .false." errflg = 1 return end if diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index 2eb2e6933..d466e4e27 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -79,7 +79,7 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, ! Consistency checks if (.not. do_RRTMGP) then - write(errmsg,'(*(a))') "Logic error: do_RRTMGP should be set true" + write(errmsg,'(*(a))') "Logic error: do_RRTMGP must be set .true." errflg = 1 return end if diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 8b8b16523..1d83fec1c 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -19,7 +19,7 @@ subroutine drag_suite_init(gwd_opt, errmsg, errflg) errflg = 0 ! Consistency checks - if (gwd_opt/=3 .or. gwd_opt/=33) then + if (gwd_opt/=3 .and. gwd_opt/=33) then write(errmsg,'(*(a))') "Logic error: namelist choice of gravity wave & & drag is different from drag_suite scheme" errflg = 1 diff --git a/physics/gscond.f b/physics/gscond.f index bc76e576d..124c0c40b 100644 --- a/physics/gscond.f +++ b/physics/gscond.f @@ -37,7 +37,8 @@ subroutine zhaocarr_gscond_init (imp_physics, & if (is_initialized) return ! Consistency checks - if (imp_physics/=imp_physics_zhao_carr) then + if (imp_physics/=imp_physics_zhao_carr .and. & + & imp_physics/=imp_physics_zhao_carr_pdf) then write(errmsg,'(*(a))') "Logic error: namelist choice of & & microphysics is different from Zhao-Carr MP" errflg = 1 diff --git a/physics/gscond.meta b/physics/gscond.meta index 0140b0a70..006fe4472 100644 --- a/physics/gscond.meta +++ b/physics/gscond.meta @@ -23,6 +23,14 @@ type = integer intent = in optional = F +[imp_physics_zhao_carr_pdf] + standard_name = flag_for_zhao_carr_pdf_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme with PDF clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/precpd.f b/physics/precpd.f index c75b920cb..11f4a64dd 100644 --- a/physics/precpd.f +++ b/physics/precpd.f @@ -31,7 +31,8 @@ subroutine zhaocarr_precpd_init (imp_physics, & if (is_initialized) return ! Consistency checks - if (imp_physics/=imp_physics_zhao_carr) then + if (imp_physics/=imp_physics_zhao_carr .and. & + & imp_physics/=imp_physics_zhao_carr_pdf) then write(errmsg,'(*(a))') "Logic error: namelist choice of & & microphysics is different from Zhao-Carr MP" errflg = 1 diff --git a/physics/precpd.meta b/physics/precpd.meta index bf78254f2..4a8009113 100644 --- a/physics/precpd.meta +++ b/physics/precpd.meta @@ -23,6 +23,14 @@ type = integer intent = in optional = F +[imp_physics_zhao_carr_pdf] + standard_name = flag_for_zhao_carr_pdf_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme with PDF clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index c799f0384..7599874ce 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -106,7 +106,7 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & errflg = 0 ! Consistency checks - if (gwd_opt/=2 .or. gwd_opt/=22) then + if (gwd_opt/=2 .and. gwd_opt/=22) then write(errmsg,'(*(a))') "Logic error: namelist choice of gravity wave & & drag is different from unified_ugwp scheme" errflg = 1 From 50e46a1f6e685bd50198ffd5ec179efda7faac68 Mon Sep 17 00:00:00 2001 From: XiaSun-NOAA Date: Wed, 12 May 2021 22:39:33 +0000 Subject: [PATCH 53/74] minor msg fix --- physics/GFS_rrtmg_setup.F90 | 2 +- physics/GFS_rrtmgp_setup.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/GFS_rrtmg_setup.F90 index a933637ce..aa5f3f4ca 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -212,7 +212,7 @@ subroutine GFS_rrtmg_setup_init ( & if (is_initialized) return if (do_RRTMGP) then - write(errmsg,'(*(a))') "Logic error: do_RRTMGP must be set .false." + write(errmsg,'(*(a))') "Logic error: do_RRTMGP must be set to .false." errflg = 1 return end if diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index d466e4e27..ff82ba779 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -79,7 +79,7 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, ! Consistency checks if (.not. do_RRTMGP) then - write(errmsg,'(*(a))') "Logic error: do_RRTMGP must be set .true." + write(errmsg,'(*(a))') "Logic error: do_RRTMGP must be set to .true." errflg = 1 return end if From d224b13c9e7cab8cf21d4d9eb06b889a95f35aa5 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Thu, 13 May 2021 21:24:40 +0000 Subject: [PATCH 54/74] Added option for ice on lakes. --- physics/GFS_radiation_surface.F90 | 25 ++++++++++++++++++------- physics/GFS_radiation_surface.meta | 18 ++++++++++++++++++ 2 files changed, 36 insertions(+), 7 deletions(-) diff --git a/physics/GFS_radiation_surface.F90 b/physics/GFS_radiation_surface.F90 index 1801e6f57..cf4cdec6e 100644 --- a/physics/GFS_radiation_surface.F90 +++ b/physics/GFS_radiation_surface.F90 @@ -42,8 +42,8 @@ subroutine GFS_radiation_surface_init (me, sfcalb, ialb, iems, errmsg, errflg) iemsflg= iems ! surface emissivity control flag if ( me == 0 ) then - print *,' In GFS_radiation_surface_init, before calling sfc_init' - print *,' ialb=',ialb,' iems=',iems + print *,'In GFS_radiation_surface_init, before calling sfc_init' + print *,'ialb=',ialb,' iems=',iems end if ! Call surface initialization routine @@ -60,7 +60,8 @@ subroutine GFS_radiation_surface_run ( & vtype, xlat, xlon, slmsk, lndp_type, n_var_lndp, sfc_alb_pert, & lndp_var_list, lndp_prt_list, landfrac, snowd, sncovr, & sncovr_ice, fice, zorl, hprime, tsfg, tsfa, tisfc, coszen, & - min_seaice, alvsf, alnsf, alvwf, alnwf, facsf, facwf, & + min_seaice, min_lakeice, lakefrac, & + alvsf, alnsf, alvwf, alnwf, facsf, facwf, & semis_lnd, semis_ice, snoalb, & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & @@ -75,11 +76,12 @@ subroutine GFS_radiation_surface_run ( & integer, intent(in) :: im logical, intent(in) :: frac_grid, lslwr, lsswr integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc, lndp_type, n_var_lndp - real(kind=kind_phys), intent(in) :: min_seaice + real(kind=kind_phys), intent(in) :: min_seaice, min_lakeice real(kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, vtype, slmsk, & sfc_alb_pert, lndp_prt_list, & - landfrac, snowd, sncovr, & + landfrac, lakefrac, & + snowd, sncovr, & sncovr_ice, fice, zorl, & hprime, tsfg, tsfa, tisfc, & coszen, alvsf, alnsf, alvwf, & @@ -99,6 +101,7 @@ subroutine GFS_radiation_surface_run ( & ! Local variables integer :: i real(kind=kind_phys) :: lndp_alb + real(kind=kind_phys) :: cimin real(kind=kind_phys), dimension(im) :: fracl, fraci, fraco logical, dimension(im) :: icy @@ -109,6 +112,14 @@ subroutine GFS_radiation_surface_run ( & ! Intialize intent(out) variables sfcalb = 0.0 + do i=1,im + if (lakefrac(i) > f_zero) then + cimin = min_lakeice + else + cimin = min_seaice + endif + enddo + ! Return immediately if neither shortwave nor longwave radiation are called if (.not. lsswr .and. .not. lslwr) return @@ -123,7 +134,7 @@ subroutine GFS_radiation_surface_run ( & else fracl(i) = f_zero fraco(i) = f_one - if(fice(i) < min_seaice) then + if(fice(i) < cimin) then fraci(i) = f_zero icy(i) = .false. else @@ -137,7 +148,7 @@ subroutine GFS_radiation_surface_run ( & do i=1,im fracl(i) = landfrac(i) fraco(i) = max(f_zero, f_one - fracl(i)) - if(fice(i) < min_seaice) then + if(fice(i) < cimin) then fraci(i) = f_zero icy(i) = .false. else diff --git a/physics/GFS_radiation_surface.meta b/physics/GFS_radiation_surface.meta index 6c770575c..d1136c43a 100644 --- a/physics/GFS_radiation_surface.meta +++ b/physics/GFS_radiation_surface.meta @@ -305,6 +305,24 @@ kind = kind_phys intent = in optional = F +[min_lakeice] + standard_name = lake_ice_minimum + long_name = minimum lake ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lakefrac] + standard_name = lake_area_fraction + long_name = fraction of horizontal grid area occupied by lake + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [alvsf] standard_name = mean_vis_albedo_with_strong_cosz_dependency long_name = mean vis albedo with strong cosz dependency From e457e01208e2a5094bf46fe08c0e69bc316010be Mon Sep 17 00:00:00 2001 From: Xia Sun <58949533+XiaSun-Atmos@users.noreply.github.com> Date: Fri, 14 May 2021 10:27:28 -0600 Subject: [PATCH 55/74] Update ysuvdif.F90 --- physics/ysuvdif.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/ysuvdif.F90 b/physics/ysuvdif.F90 index 443137615..d59ceb386 100644 --- a/physics/ysuvdif.F90 +++ b/physics/ysuvdif.F90 @@ -13,7 +13,7 @@ module ysuvdif subroutine ysuvdif_init (do_ysu,errmsg,errflg) - integer, intent(in) :: do_ysu + logical, intent(in) :: do_ysu character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg From e0b1eb665e9a4e38e7ec5a3deb7daa4713d297f2 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 14 May 2021 10:45:15 -0600 Subject: [PATCH 56/74] Return earlier from physics/GFS_radiation_surface.F90 if sw/lw radiation are not called --- physics/GFS_radiation_surface.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/GFS_radiation_surface.F90 b/physics/GFS_radiation_surface.F90 index cf4cdec6e..cb574ce65 100644 --- a/physics/GFS_radiation_surface.F90 +++ b/physics/GFS_radiation_surface.F90 @@ -112,6 +112,9 @@ subroutine GFS_radiation_surface_run ( & ! Intialize intent(out) variables sfcalb = 0.0 + ! Return immediately if neither shortwave nor longwave radiation are called + if (.not. lsswr .and. .not. lslwr) return + do i=1,im if (lakefrac(i) > f_zero) then cimin = min_lakeice @@ -120,9 +123,6 @@ subroutine GFS_radiation_surface_run ( & endif enddo - ! Return immediately if neither shortwave nor longwave radiation are called - if (.not. lsswr .and. .not. lslwr) return - ! Set up land/ice/ocean fractions for emissivity and albedo calculations if (.not. frac_grid) then do i=1,im From 0918b5653f08ff68f0e63bff2291b54962f9ec79 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 14 May 2021 13:37:21 -0600 Subject: [PATCH 57/74] physics/GFS_radiation_surface.*: do not reset alb/emis to zero when lw/sw are not called --- physics/GFS_radiation_surface.F90 | 17 +++-------------- physics/GFS_radiation_surface.meta | 8 ++++---- 2 files changed, 7 insertions(+), 18 deletions(-) diff --git a/physics/GFS_radiation_surface.F90 b/physics/GFS_radiation_surface.F90 index cb574ce65..dd0c56d43 100644 --- a/physics/GFS_radiation_surface.F90 +++ b/physics/GFS_radiation_surface.F90 @@ -92,9 +92,9 @@ subroutine GFS_radiation_surface_run ( & albivis_lnd, albinir_lnd real(kind=kind_phys), dimension(:), intent(in) :: albdvis_ice, albdnir_ice, & albivis_ice, albinir_ice - real(kind=kind_phys), dimension(:), intent(out) :: semisbase, semis - real(kind=kind_phys), dimension(:,:), intent(out) :: sfcalb - real(kind=kind_phys), dimension(:), intent(out) :: sfc_alb_dif + real(kind=kind_phys), dimension(:), intent(inout) :: semisbase, semis + real(kind=kind_phys), dimension(:,:), intent(inout) :: sfcalb + real(kind=kind_phys), dimension(:), intent(inout) :: sfc_alb_dif character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -109,9 +109,6 @@ subroutine GFS_radiation_surface_run ( & errmsg = '' errflg = 0 - ! Intialize intent(out) variables - sfcalb = 0.0 - ! Return immediately if neither shortwave nor longwave radiation are called if (.not. lsswr .and. .not. lslwr) return @@ -168,10 +165,6 @@ subroutine GFS_radiation_surface_run ( & hprime, semis_lnd, semis_ice, im, & fracl, fraco, fraci, icy, & ! --- inputs semisbase, semis) ! --- outputs - ! DH* required? or a bad idea? wasn't there beforehand, neither for RRTMG nor RRTMGP - else - semis = 0.0 - ! *DH endif if (lsswr) then @@ -198,10 +191,6 @@ subroutine GFS_radiation_surface_run ( & !> -# Approximate mean surface albedo from vis- and nir- diffuse values. sfc_alb_dif(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) - ! DH* needed? RRTMGP was doing this, RRTMG not - else - sfc_alb_dif(:) = 0.0 - ! *DH endif end subroutine GFS_radiation_surface_run diff --git a/physics/GFS_radiation_surface.meta b/physics/GFS_radiation_surface.meta index d1136c43a..c38ffe2a3 100644 --- a/physics/GFS_radiation_surface.meta +++ b/physics/GFS_radiation_surface.meta @@ -483,7 +483,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [semis] standard_name = surface_longwave_emissivity @@ -492,7 +492,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [sfcalb] standard_name = surface_albedo_components @@ -501,7 +501,7 @@ dimensions = (horizontal_loop_extent,number_of_components_for_surface_albedo) type = real kind = kind_phys - intent = out + intent = inout optional = F [sfc_alb_dif] standard_name = surface_diffused_shortwave_albedo @@ -510,7 +510,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [errmsg] standard_name = ccpp_error_message From b80fe7090b143b5c538ae22a0293c4a65257fe01 Mon Sep 17 00:00:00 2001 From: XiaSun-NOAA Date: Fri, 14 May 2021 20:09:07 +0000 Subject: [PATCH 58/74] fix --- physics/gscond.f | 7 +++++-- physics/precpd.f | 4 +++- physics/sfc_drv_ruc.F90 | 2 +- 3 files changed, 9 insertions(+), 4 deletions(-) diff --git a/physics/gscond.f b/physics/gscond.f index 124c0c40b..1606bc93a 100644 --- a/physics/gscond.f +++ b/physics/gscond.f @@ -19,13 +19,16 @@ module zhaocarr_gscond !> \section arg_table_zhaocarr_gscond_init Argument Table !! subroutine zhaocarr_gscond_init (imp_physics, & - & imp_physics_zhao_carr, & + & imp_physics_zhao_carr, & + & imp_physics_zhao_carr_pdf, & & errmsg, errflg) implicit none ! Interface variables integer, intent(in ) :: imp_physics - integer, intent(in ) :: imp_physics_zhao_carr + integer, intent(in ) :: imp_physics_zhao_carr, & + & imp_physics_zhao_carr_pdf + ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg diff --git a/physics/precpd.f b/physics/precpd.f index 11f4a64dd..2279356b3 100644 --- a/physics/precpd.f +++ b/physics/precpd.f @@ -14,12 +14,14 @@ module zhaocarr_precpd subroutine zhaocarr_precpd_init (imp_physics, & & imp_physics_zhao_carr, & + & imp_physics_zhao_carr_pdf, & & errmsg, errflg) implicit none ! Interface variables integer, intent(in ) :: imp_physics - integer, intent(in ) :: imp_physics_zhao_carr + integer, intent(in ) :: imp_physics_zhao_carr, & + & imp_physics_zhao_carr_pdf ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 9ca6e8e10..f2f0369c2 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -82,7 +82,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & ! Consistency checks if (lsm/=lsm_ruc) then - write(errmsg,'(*(a))') 'Logic error: namelist choice of ', + write(errmsg,'(*(a))') 'Logic error: namelist choice of ', & & 'LSM is different from RUC' errflg = 1 return From a8500a8720f8b0edef969503390d0c5979e51959 Mon Sep 17 00:00:00 2001 From: XiaSun-NOAA Date: Fri, 14 May 2021 23:39:40 +0000 Subject: [PATCH 59/74] add end if in module_MYJSFC_wrapper --- physics/module_MYJSFC_wrapper.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/physics/module_MYJSFC_wrapper.F90 b/physics/module_MYJSFC_wrapper.F90 index c392e239e..3d2b2e017 100644 --- a/physics/module_MYJSFC_wrapper.F90 +++ b/physics/module_MYJSFC_wrapper.F90 @@ -24,6 +24,7 @@ subroutine myjsfc_wrapper_init (do_myjsfc, & write(errmsg,fmt='(*(a))') 'Logic error: do_myjsfc = .false.' errflg = 1 return + end if end subroutine myjsfc_wrapper_init subroutine myjsfc_wrapper_finalize () From 79739c7bed12038c2bbe233042fdf40bb8dfb26e Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 14 May 2021 20:04:22 -0600 Subject: [PATCH 60/74] physics/GFS_phys_time_vary.fv3.*: bug fix, do not initialize sfcalb/sfcemis data for restart runs; adjust formatting --- physics/GFS_phys_time_vary.fv3.F90 | 59 +++++++++++------------------ physics/GFS_phys_time_vary.fv3.meta | 8 ++++ 2 files changed, 31 insertions(+), 36 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 12e10d80c..b68900d09 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -79,13 +79,14 @@ subroutine GFS_phys_time_vary_init ( albdnir_ice, albivis_ice, albinir_ice, emiss_lnd, emiss_ice, taussxy, waxy, wtxy, & zwtxy, xlaixy, xsaixy, lfmassxy, stmassxy, rtmassxy, woodxy, stblcpxy, fastcpxy, & smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, & - slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, nthrds, errmsg, errflg) + slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, flag_restart, nthrds, & + errmsg, errflg) implicit none ! Interface variables integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny - logical, intent(in) :: h2o_phys, iaerclm + logical, intent(in) :: h2o_phys, iaerclm, flag_restart integer, intent(in) :: idate(:) real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:) @@ -392,43 +393,29 @@ subroutine GFS_phys_time_vary_init ( end if !--- For Noah MP or RUC LSMs: initialize four components of albedo for - !--- land and ice - if (lsm == lsm_noahmp .or. lsm == lsm_ruc) then - if (me == master ) write(0,'(a)') 'GFS_phys_time_vary_init: initialize albedo for land and ice' - albdvis_lnd(:) = missing_value - albdnir_lnd(:) = missing_value - albivis_lnd(:) = missing_value - albinir_lnd(:) = missing_value - emiss_lnd(:) = missing_value - + !--- land and ice - not for restart runs + lsm_init: if (.not.flag_restart) then + if (lsm == lsm_noahmp .or. lsm == lsm_ruc) then + if (me == master ) write(0,'(a)') 'GFS_phys_time_vary_init: initialize albedo for land and ice' do ix=1,im - albdvis_lnd(ix) = 0.2_kind_phys - albdnir_lnd(ix) = 0.2_kind_phys - albivis_lnd(ix) = 0.2_kind_phys - albinir_lnd(ix) = 0.2_kind_phys - emiss_lnd(ix) = 0.95_kind_phys + albdvis_lnd(ix) = 0.2_kind_phys + albdnir_lnd(ix) = 0.2_kind_phys + albivis_lnd(ix) = 0.2_kind_phys + albinir_lnd(ix) = 0.2_kind_phys + emiss_lnd(ix) = 0.95_kind_phys enddo - endif - - if (lsm == lsm_ruc) then - albdvis_ice(:) = missing_value - albdnir_ice(:) = missing_value - albivis_ice(:) = missing_value - albinir_ice(:) = missing_value - emiss_ice(:) = missing_value - + endif + if (lsm == lsm_ruc) then do ix=1,im - albdvis_ice(ix) = 0.6_kind_phys - albdnir_ice(ix) = 0.6_kind_phys - albivis_ice(ix) = 0.6_kind_phys - albinir_ice(ix) = 0.6_kind_phys - emiss_ice(ix) = 0.97_kind_phys + albdvis_ice(ix) = 0.6_kind_phys + albdnir_ice(ix) = 0.6_kind_phys + albivis_ice(ix) = 0.6_kind_phys + albinir_ice(ix) = 0.6_kind_phys + emiss_ice(ix) = 0.97_kind_phys enddo - endif - - if (lsm == lsm_noahmp) then - if (all(tvxy < zero)) then + endif + noahmp_init: if (lsm == lsm_noahmp) then allocate(dzsno (lsnow_lsm_lbound:lsnow_lsm_ubound)) allocate(dzsnso(lsnow_lsm_lbound:lsoil) ) dzsno(:) = missing_value @@ -686,8 +673,8 @@ subroutine GFS_phys_time_vary_init ( deallocate(dzsno) deallocate(dzsnso) - endif - endif !if Noah MP cold start ends + endif noahmp_init + endif lsm_init is_initialized = .true. diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index 458bd617f..5fe518eab 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -980,6 +980,14 @@ kind = kind_phys intent = in optional = F +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F [nthrds] standard_name = omp_threads long_name = number of OpenMP threads available for physics schemes From ec07fc0ab1dc97b847106c269bfe2b66cca583c5 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 17 May 2021 10:54:17 -0600 Subject: [PATCH 61/74] Updates and bugfixes in physics/GFS_debug.F90 --- physics/GFS_debug.F90 | 29 +++++++++++++++++++++++++++-- 1 file changed, 27 insertions(+), 2 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 416e773eb..dcf4ebab9 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -507,6 +507,26 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%snowfallac_land', Sfcprop%snowfallac_land) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%snowfallac_ice', Sfcprop%snowfallac_ice) end if + ! Revised surface albedo and emissivity calculation + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%emis_lnd', Sfcprop%emis_lnd) + ! NoahMP and RUC + if (Model%lsm == Model%lsm_ruc .or. Model%lsm == Model%lsm_noahmp) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albdvis_lnd', Sfcprop%albdvis_lnd) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albdnir_lnd', Sfcprop%albdnir_lnd) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albivis_lnd', Sfcprop%albivis_lnd) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albinir_lnd', Sfcprop%albinir_lnd) + end if + ! RUC only + if (Model%lsm == Model%lsm_ruc) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%emis_ice', Sfcprop%emis_ice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albdvis_ice', Sfcprop%albdvis_ice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albdnir_ice', Sfcprop%albdnir_ice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albivis_ice', Sfcprop%albivis_ice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albinir_ice', Sfcprop%albinir_ice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%sfalb_lnd', Sfcprop%sfalb_lnd) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%sfalb_ice', Sfcprop%sfalb_ice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%sfalb_lnd_bck', Sfcprop%sfalb_lnd_bck) + end if ! Radtend call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%sfcfsw%upfxc', Radtend%sfcfsw(:)%upfxc) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%sfcfsw%dnfxc', Radtend%sfcfsw(:)%dnfxc) @@ -835,6 +855,13 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nwfa2d', Coupling%nwfa2d) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nifa2d', Coupling%nifa2d) end if + if (Model%do_RRTMGP) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%fluxlwUP_jac', Coupling%fluxlwUP_jac) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%fluxlwUP_allsky', Coupling%fluxlwUP_allsky) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%fluxlwDOWN_allsky', Coupling%fluxlwDOWN_allsky) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%htrlw', Coupling%htrlw) + end if + ! ! Grid call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%xlon ', Grid%xlon ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%xlat ', Grid%xlat ) @@ -1347,8 +1374,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%precip_frac ', Interstitial%precip_frac ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%icseed_lw ', Interstitial%icseed_lw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%icseed_sw ', Interstitial%icseed_sw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxlwUP_allsky ', Interstitial%fluxlwUP_allsky ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxlwDOWN_allsky ', Interstitial%fluxlwDOWN_allsky ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxlwUP_clrsky ', Interstitial%fluxlwUP_clrsky ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxlwDOWN_clrsky ', Interstitial%fluxlwDOWN_clrsky ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxswUP_allsky ', Interstitial%fluxswUP_allsky ) From f1e2db9c2060c4b82ac954afb0383fe84dc1808a Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 17 May 2021 10:55:43 -0600 Subject: [PATCH 62/74] Bug fix in physics/sfc_drv_ruc.* to get b4b reproducible results in restart runs --- physics/sfc_drv_ruc.F90 | 10 +++++----- physics/sfc_drv_ruc.meta | 2 +- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 25612e48f..59006fb60 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -98,7 +98,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & ! --- out real (kind=kind_phys), dimension(:), intent(out) :: zs - real (kind=kind_phys), dimension(:), intent(out) :: sfalb_lnd_bck + real (kind=kind_phys), dimension(:), intent(inout) :: sfalb_lnd_bck real (kind=kind_phys), dimension(:,:), intent(out) :: tsice real (kind=kind_phys), dimension(:), intent(out) :: semisbase real (kind=kind_phys), dimension(:), intent(out) :: pores, resid @@ -179,15 +179,15 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & if (soiltyp(i) < 1) soiltyp(i) = 14 if (vegtype(i) < 1) vegtype(i) = 17 endif - !-- initialize background and actual emissivity + !-- initialize background emissivity semisbase(i) = lemitbl(vegtype(i)) ! no snow effect - sfalb_lnd_bck(i) = 0.25*(alnsf(i) + alnwf(i) + alvsf(i) + alvwf(i)) & - * min(1., facsf(i)+facwf(i)) if (.not.flag_restart) then !-- land semis_lnd(i) = semisbase(i) * (1.-sncovr_lnd(i)) & + 0.99 * sncovr_lnd(i) + sfalb_lnd_bck(i) = 0.25*(alnsf(i) + alnwf(i) + alvsf(i) + alvwf(i)) & + * min(1., facsf(i)+facwf(i)) alb_lnd = sfalb_lnd_bck(i) * (1. - sncovr_lnd(i)) & + snoalb(i) * sncovr_lnd(i) albdvis_lnd(i) = alb_lnd @@ -1610,7 +1610,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in !! Check if RUC soil data (tslb, ...) is provided or not !if (minval(tslb)==maxval(tslb)) then - ! For restart runs, can assume that RUC soul data is provided + ! For restart runs, can assume that RUC soil data is provided if (.not.restart) then flag_sst = 0 diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index e3f091a22..83143f42b 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -369,7 +369,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [semisbase] standard_name = baseline_surface_longwave_emissivity From 1a8a1bfd0756097665da3e9d8143ac886cf4acb5 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 18 May 2021 09:05:12 -0600 Subject: [PATCH 63/74] Remove option to revert to old iemis=1/ialb=1 calculation in physics/radiation_surface.f --- physics/radiation_surface.f | 160 ------------------------------------ 1 file changed, 160 deletions(-) diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 97e34224d..ab7d33e44 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -1,7 +1,3 @@ -! DH* -!# ! commented out ! define ORIG_ALB_EMS_OPTION_ONE -! *DH - !> \file radiation_surface.f !! This file contains routines that set up surface albedo for SW !! radiation and surface emissivity for LW radiation. @@ -452,7 +448,6 @@ subroutine setalb & do i = 1, IMAX -#ifndef ORIG_ALB_EMS_OPTION_ONE !-- water albedo asevd_wat = 0.06 asend_wat = 0.06 @@ -561,122 +556,6 @@ subroutine setalb & sfcalb(i,4) = min(0.99,max(0.01,alndvd))*fracl(i) & ! diffuse visible & + asevd_wat*fraco(i) + asevd_ice*fraci(i) -#else - -!> - Calculate snow cover input directly for land model, no -!! conversion needed. - - fsno0 = sncovr(i) ! snow fraction on land - - if (nint(slmsk(i))==0 .and. tsknf(i)>con_tice) fsno0 = f_zero - - if (nint(slmsk(i)) == 2) then - if(lsm == lsm_ruc) then - !-- use RUC LSM's snow-cover fraction for ice - fsno0 = sncovr_ice(i) ! snow fraction on ice - else - asnow = 0.02*snowf(i) - argh = min(0.50, max(.025, 0.01*zorlf(i))) - hrgh = min(f_one, max(0.20, 1.0577-1.1538e-3*hprif(i) ) ) - fsno0 = asnow / (argh + asnow) * hrgh - endif - endif - - fsno1 = f_one - fsno0 ! snow-free fraction (land or ice), 1-sea - flnd0 = min(f_one, facsf(i)+facwf(i)) ! 1-land, 0-sea/ice - fsea0 = max(f_zero, f_one-flnd0) ! 1-sea/ice, 0-land - fsno = fsno0 ! snow cover, >0 - land/ice - fsea = fsea0 * fsno1 ! 1-sea/ice, 0-land - flnd = flnd0 * fsno1 ! <=1-land,0-sea/ice - -!> - Calculate diffused sea surface albedo. - - if (tsknf(i) >= 271.5) then - asevd = 0.06 - asend = 0.06 - elseif (tsknf(i) < 271.1) then - asevd = 0.70 - asend = 0.65 - else - a1 = (tsknf(i) - 271.1)**2 - asevd = 0.7 - 4.0*a1 - asend = 0.65 - 3.6875*a1 - endif - -!> - Calculate diffused snow albedo, land area use input max snow -!! albedo. - - if (nint(slmsk(i)) == 2) then - ffw = f_one - fice(i) - if (ffw < f_one) then - dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) )) - b1 = 0.03 * dtgd - else - b1 = f_zero - endif - - b3 = 0.06 * ffw - asnvd = (0.70 + b1) * fice(i) + b3 - asnnd = (0.60 + b1) * fice(i) + b3 - asevd = 0.70 * fice(i) + b3 - asend = 0.60 * fice(i) + b3 - else - asnvd = snoalb(i) - asnnd = snoalb(i) - endif - -!> - Calculate direct snow albedo. - - if (nint(slmsk(i)) == 2) then - if (coszf(i) < 0.5) then - csnow = 0.5 * (3.0 / (f_one+4.0*coszf(i)) - f_one) - asnvb = min( 0.98, asnvd+(f_one-asnvd)*csnow ) - asnnb = min( 0.98, asnnd+(f_one-asnnd)*csnow ) - else - asnvb = asnvd - asnnb = asnnd - endif - else - asnvb = snoalb(i) - asnnb = snoalb(i) - endif - -!> - Calculate direct sea surface albedo, use fanglin's zenith angle -!! treatment. - - if (coszf(i) > 0.0001) then - -! rfcs = 1.89 - 3.34*coszf(i) + 4.13*coszf(i)*coszf(i) & -! & - 2.02*coszf(i)*coszf(i)*coszf(i) - rfcs = 1.775/(1.0+1.55*coszf(i)) - - if (tsknf(i) >= con_t0c) then - !- sea - asevb = max(asevd, 0.026/(coszf(i)**1.7+0.065) & - & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & - & * (coszf(i)-f_one)) - asenb = asevb - else - !- ice - asevb = asevd - asenb = asend - endif - else - !- no sun - rfcs = f_one - asevb = asevd - asenb = asend - endif - - !- zenith dependence is applied only to direct beam albedo - ab1bm = min(0.99, alnsf(i)*rfcs) - ab2bm = min(0.99, alvsf(i)*rfcs) - sfcalb(i,1) = ab1bm *flnd + asenb*fsea + asnnb*fsno - sfcalb(i,2) = alnwf(i)*flnd + asend*fsea + asnnd*fsno - sfcalb(i,3) = ab2bm *flnd + asevb*fsea + asnvb*fsno - sfcalb(i,4) = alvwf(i)*flnd + asevd*fsea + asnvd*fsno -#endif - enddo ! end_do_i_loop !> -# use land model output for land area: Noah MP, RUC (land and ice). @@ -901,9 +780,6 @@ subroutine setemis & real (kind=kind_phys) :: dltg, hdlt, tmp1, tmp2, & & asnow, argh, hrgh, fsno -#ifdef ORIG_ALB_EMS_OPTION_ONE - real (kind=kind_phys) :: fsno0, fsno1 -#endif real (kind=kind_phys) :: sfcemis_land, sfcemis_ice ! --- reference emiss value for diff surface emiss index @@ -928,7 +804,6 @@ subroutine setemis & lab_do_IMAX : do i = 1, IMAX -#ifndef ORIG_ALB_EMS_OPTION_ONE if (fracl(i) < epsln) then ! no land if ( abs(fraco(i)-f_one) < epsln ) then ! open water point sfcemis(i) = emsref(1) @@ -938,15 +813,7 @@ subroutine setemis & !-- fractional sea ice sfcemis(i) = fraco(i)*emsref(1) + fraci(i)*emsref(7) endif -#else - if ( nint(slmsk(i)) == 0 ) then ! sea point - - sfcemis(i) = emsref(1) - - else if ( nint(slmsk(i)) == 2 ) then ! sea-ice - sfcemis(i) = emsref(7) -#endif else ! land or fractional grid ! --- map grid in longitude direction @@ -980,7 +847,6 @@ subroutine setemis & idx = max( 2, idxems(i2,j2) ) if ( idx >= 7 ) idx = 2 -#ifndef ORIG_ALB_EMS_OPTION_ONE if (abs(fracl(i)-f_one) < epsln) then sfcemis(i) = emsref(idx) else @@ -988,15 +854,10 @@ subroutine setemis & & + fraci(i)*emsref(7) endif semisbase(i) = sfcemis(i) -#else - sfcemis(i) = emsref(idx) -#endif endif ! end if_slmsk_block !> - Check for snow covered area. - -#ifndef ORIG_ALB_EMS_OPTION_ONE if ( sncovr(i) > f_zero ) then ! input land/ice area snow cover fsno = sncovr(i) @@ -1014,27 +875,6 @@ subroutine setemis & endif endif ! end if_ialbflg -#else - if ( ialbflg==1 .and. nint(slmsk(i))==1 ) then ! input land area snow cover - - fsno0 = sncovr(i) - fsno1 = f_one - fsno0 - sfcemis(i) = sfcemis(i)*fsno1 + emsref(8)*fsno0 - - else ! compute snow cover from snow depth - if ( snowf(i) > f_zero ) then - asnow = 0.02*snowf(i) - argh = min(0.50, max(.025, 0.01*zorlf(i))) - hrgh = min(f_one, max(0.20, 1.0577-1.1538e-3*hprif(i) ) ) - fsno0 = asnow / (argh + asnow) * hrgh - if (nint(slmsk(i)) == 0 .and. tsknf(i) > 271.2) & - & fsno0=f_zero - fsno1 = f_one - fsno0 - sfcemis(i) = sfcemis(i)*fsno1 + emsref(8)*fsno0 - endif - - endif ! end if_ialbflg -#endif enddo lab_do_IMAX From c661a57318f4a59a32faa25308a53203b20eb778 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 18 May 2021 13:00:05 -0600 Subject: [PATCH 64/74] Bug fix in physics/GFS_phys_time_vary.fv3.meta: use correct horizontal dimension --- physics/GFS_phys_time_vary.fv3.meta | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index 5fe518eab..6289fb6a7 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -759,7 +759,7 @@ standard_name = surface_albedo_direct_visible_over_land long_name = direct surface albedo visible band over land units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -768,7 +768,7 @@ standard_name = surface_albedo_direct_NIR_over_land long_name = direct surface albedo NIR band over land units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -777,7 +777,7 @@ standard_name = surface_albedo_diffuse_visible_over_land long_name = diffuse surface albedo visible band over land units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -786,7 +786,7 @@ standard_name = surface_albedo_diffuse_NIR_over_land long_name = diffuse surface albedo NIR band over land units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -795,7 +795,7 @@ standard_name = surface_albedo_direct_visible_over_ice long_name = direct surface albedo visible band over ice units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -804,7 +804,7 @@ standard_name = surface_albedo_direct_NIR_over_ice long_name = direct surface albedo NIR band over ice units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -813,7 +813,7 @@ standard_name = surface_albedo_diffuse_visible_over_ice long_name = diffuse surface albedo visible band over ice units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -822,7 +822,7 @@ standard_name = surface_albedo_diffuse_NIR_over_ice long_name = diffuse surface albedo NIR band over ice units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -831,7 +831,7 @@ standard_name = surface_longwave_emissivity_over_land long_name = surface lw emissivity in fraction over land units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -840,7 +840,7 @@ standard_name = surface_longwave_emissivity_over_ice long_name = surface lw emissivity in fraction over ice units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout From 329364bd0bdf0f4a4d5ab71060889947c98f95d0 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 18 May 2021 13:06:44 -0600 Subject: [PATCH 65/74] copy GFS_phys_time_vary.fv3.F90/meta changes over to SCM versions --- physics/GFS_phys_time_vary.scm.F90 | 63 ++++++++++++++-------- physics/GFS_phys_time_vary.scm.meta | 83 +++++++++++++++++++++++------ 2 files changed, 109 insertions(+), 37 deletions(-) diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 9fa4e2de3..e1b5c3d9b 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -69,16 +69,18 @@ subroutine GFS_phys_time_vary_init ( isot, ivegsrc, nlunit, sncovr, sncovr_ice, lsm, lsm_noahmp, lsm_ruc, min_seaice, & fice, landfrac, vtype, weasd, lsoil, zs, dzs, lsnow_lsm_lbound, lsnow_lsm_ubound, & tvxy, tgxy, tahxy, canicexy, canliqxy, eahxy, cmxy, chxy, fwetxy, sneqvoxy, alboldxy,& - qsnowxy, wslakexy, albdvis, albdnir, albivis, albinir, emiss, taussxy, waxy, wtxy, & + qsnowxy, wslakexy, albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, albdvis_ice, & + albdnir_ice, albivis_ice, albinir_ice, emiss_lnd, emiss_ice, taussxy, waxy, wtxy, & zwtxy, xlaixy, xsaixy, lfmassxy, stmassxy, rtmassxy, woodxy, stblcpxy, fastcpxy, & smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, & - slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, nthrds, errmsg, errflg) + slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, flag_restart, nthrds, & + errmsg, errflg) implicit none ! Interface variables integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny - logical, intent(in) :: h2o_phys, iaerclm + logical, intent(in) :: h2o_phys, iaerclm, flag_restart integer, intent(in) :: idate(:) real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:) @@ -119,11 +121,16 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(inout) :: alboldxy(:) real(kind_phys), intent(inout) :: qsnowxy(:) real(kind_phys), intent(inout) :: wslakexy(:) - real(kind_phys), intent(inout) :: albdvis(:) - real(kind_phys), intent(inout) :: albdnir(:) - real(kind_phys), intent(inout) :: albivis(:) - real(kind_phys), intent(inout) :: albinir(:) - real(kind_phys), intent(inout) :: emiss(:) + real(kind_phys), intent(inout) :: albdvis_lnd(:) + real(kind_phys), intent(inout) :: albdnir_lnd(:) + real(kind_phys), intent(inout) :: albivis_lnd(:) + real(kind_phys), intent(inout) :: albinir_lnd(:) + real(kind_phys), intent(inout) :: albdvis_ice(:) + real(kind_phys), intent(inout) :: albdnir_ice(:) + real(kind_phys), intent(inout) :: albivis_ice(:) + real(kind_phys), intent(inout) :: albinir_ice(:) + real(kind_phys), intent(inout) :: emiss_lnd(:) + real(kind_phys), intent(inout) :: emiss_ice(:) real(kind_phys), intent(inout) :: taussxy(:) real(kind_phys), intent(inout) :: waxy(:) real(kind_phys), intent(inout) :: wtxy(:) @@ -339,8 +346,30 @@ subroutine GFS_phys_time_vary_init ( if (errflg/=0) return end if - if (lsm == lsm_noahmp) then - if (all(tvxy <= zero)) then + !--- For Noah MP or RUC LSMs: initialize four components of albedo for + !--- land and ice - not for restart runs + lsm_init: if (.not.flag_restart) then + if (lsm == lsm_noahmp .or. lsm == lsm_ruc) then + if (me == master ) write(0,'(a)') 'GFS_phys_time_vary_init: initialize albedo for land and ice' + do ix=1,im + albdvis_lnd(ix) = 0.2_kind_phys + albdnir_lnd(ix) = 0.2_kind_phys + albivis_lnd(ix) = 0.2_kind_phys + albinir_lnd(ix) = 0.2_kind_phys + emiss_lnd(ix) = 0.95_kind_phys + enddo + endif + if (lsm == lsm_ruc) then + do ix=1,im + albdvis_ice(ix) = 0.6_kind_phys + albdnir_ice(ix) = 0.6_kind_phys + albivis_ice(ix) = 0.6_kind_phys + albinir_ice(ix) = 0.6_kind_phys + emiss_ice(ix) = 0.97_kind_phys + enddo + endif + + noahmp_init: if (lsm == lsm_noahmp) then allocate(dzsno (lsnow_lsm_lbound:lsnow_lsm_ubound)) allocate(dzsnso(lsnow_lsm_lbound:lsoil) ) dzsno(:) = missing_value @@ -359,11 +388,6 @@ subroutine GFS_phys_time_vary_init ( alboldxy(:) = missing_value qsnowxy(:) = missing_value wslakexy(:) = missing_value - albdvis(:) = missing_value - albdnir(:) = missing_value - albivis(:) = missing_value - albinir(:) = missing_value - emiss(:) = missing_value taussxy(:) = missing_value waxy(:) = missing_value wtxy(:) = missing_value @@ -418,11 +442,6 @@ subroutine GFS_phys_time_vary_init ( ! already set to 0.0 wslakexy(ix) = zero taussxy(ix) = zero - albdvis(ix) = 0.2_kind_phys - albdnir(ix) = 0.2_kind_phys - albivis(ix) = 0.2_kind_phys - albinir(ix) = 0.2_kind_phys - emiss(ix) = 0.95_kind_phys waxy(ix) = 4900.0_kind_phys wtxy(ix) = waxy(ix) @@ -592,8 +611,8 @@ subroutine GFS_phys_time_vary_init ( deallocate(dzsno) deallocate(dzsnso) - endif - endif !if Noah MP cold start ends + endif noahmp_init + endif lsm_init is_initialized = .true. diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index 74408d533..23df2cfb2 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -755,45 +755,90 @@ kind = kind_phys intent = inout optional = F -[albdvis] - standard_name = surface_albedo_direct_visible - long_name = direct surface albedo visible band +[albdvis_lnd] + standard_name = surface_albedo_direct_visible_over_land + long_name = direct surface albedo visible band over land units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[albdnir] - standard_name = surface_albedo_direct_NIR - long_name = direct surface albedo NIR band +[albdnir_lnd] + standard_name = surface_albedo_direct_NIR_over_land + long_name = direct surface albedo NIR band over land units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[albivis] - standard_name = surface_albedo_diffuse_visible - long_name = diffuse surface albedo visible band +[albivis_lnd] + standard_name = surface_albedo_diffuse_visible_over_land + long_name = diffuse surface albedo visible band over land units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[albinir] - standard_name = surface_albedo_diffuse_NIR - long_name = diffuse surface albedo NIR band +[albinir_lnd] + standard_name = surface_albedo_diffuse_NIR_over_land + long_name = diffuse surface albedo NIR band over land units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[emiss] - standard_name = surface_emissivity_lsm - long_name = surface emissivity from lsm +[albdvis_ice] + standard_name = surface_albedo_direct_visible_over_ice + long_name = direct surface albedo visible band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albdnir_ice] + standard_name = surface_albedo_direct_NIR_over_ice + long_name = direct surface albedo NIR band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albivis_ice] + standard_name = surface_albedo_diffuse_visible_over_ice + long_name = diffuse surface albedo visible band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albinir_ice] + standard_name = surface_albedo_diffuse_NIR_over_ice + long_name = diffuse surface albedo NIR band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[emiss_lnd] + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[emiss_ice] + standard_name = surface_longwave_emissivity_over_ice + long_name = surface lw emissivity in fraction over ice units = frac dimensions = (horizontal_dimension) type = real @@ -935,6 +980,14 @@ kind = kind_phys intent = in optional = F +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F [nthrds] standard_name = omp_threads long_name = number of OpenMP threads available for physics schemes From 38f28a2fc23ebd3424b6b098d0157554c22aa798 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 18 May 2021 16:53:47 -0600 Subject: [PATCH 66/74] Update metadata for ztmax variables --- physics/GFS_surface_composites.meta | 18 +++++++++--------- physics/sfc_diff.meta | 18 +++++++++--------- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 0781787aa..95f2c6e4e 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -1920,27 +1920,27 @@ intent = in optional = F [ztmax_wat] - standard_name = ztmax_whatever_that_is_over_water - long_name = zxtmax whatever that is over water - units = ??? + standard_name = bounded_surface_roughness_length_for_heat_over_water + long_name = bounded surface roughness length for heat over water + units = m dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F [ztmax_lnd] - standard_name = ztmax_whatever_that_is_over_land - long_name = zxtmax whatever that is over land - units = ??? + standard_name = bounded_surface_roughness_length_for_heat_over_land + long_name = bounded surface roughness length for heat over land + units = m dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F [ztmax_ice] - standard_name = ztmax_whatever_that_is_over_ice - long_name = zxtmax whatever that is over ice - units = ??? + standard_name = bounded_surface_roughness_length_for_heat_over_ice + long_name = bounded surface roughness length for heat over ice + units = m dimensions = (horizontal_loop_extent) type = real kind = kind_phys diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 17a30f28c..7b639b6b0 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -619,27 +619,27 @@ intent = inout optional = F [ztmax_wat] - standard_name = ztmax_whatever_that_is_over_water - long_name = zxtmax whatever that is over water - units = ??? + standard_name = bounded_surface_roughness_length_for_heat_over_water + long_name = bounded surface roughness length for heat over water + units = m dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout optional = F [ztmax_lnd] - standard_name = ztmax_whatever_that_is_over_land - long_name = zxtmax whatever that is over land - units = ??? + standard_name = bounded_surface_roughness_length_for_heat_over_land + long_name = bounded surface roughness length for heat over land + units = m dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout optional = F [ztmax_ice] - standard_name = ztmax_whatever_that_is_over_ice - long_name = zxtmax whatever that is over ice - units = ??? + standard_name = bounded_surface_roughness_length_for_heat_over_ice + long_name = bounded surface roughness length for heat over ice + units = m dimensions = (horizontal_loop_extent) type = real kind = kind_phys From b179486fda73f21d45c85cad20c6a8e713d2e323 Mon Sep 17 00:00:00 2001 From: Xia Sun <58949533+XiaSun-Atmos@users.noreply.github.com> Date: Wed, 19 May 2021 08:21:28 -0600 Subject: [PATCH 67/74] Update cu_gf_driver.F90 --- physics/cu_gf_driver.F90 | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 758969fbd..c17aaec76 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -48,19 +48,14 @@ subroutine cu_gf_driver_init(imfshalcnv, imfshalcnv_gf, imfdeepcnv, & ! *DH temporary ! Consistency checks - if (imfshalcnv/=imfshalcnv_gf) then + if (.not. (imfshalcnv == imfshalcnv_gf .or. & + & imfdeepcnv == imfdeepcnv_gf)) then write(errmsg,'(*(a))') 'Logic error: namelist choice of', & - & ' shallow convection is different from Grell-Freitas scheme' + & ' convection is different from Grell-Freitas scheme' errflg = 1 return end if - if (imfdeepcnv/=imfdeepcnv_gf) then - write(errmsg,'(*(a))') 'Logic error: namelist choice of', & - & ' deep convection is different from Grell-Freitas scheme' - errflg = 1 - return - end if end subroutine cu_gf_driver_init subroutine cu_gf_driver_finalize() From c3375bb50de56a396da36bd004fcf204a0adb252 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 25 May 2021 13:41:30 +0000 Subject: [PATCH 68/74] Removed SNET. Net sloar radiation is computed from the incoming SW and albedo. --- physics/sfc_drv_ruc.F90 | 30 ++++++------------------------ physics/sfc_drv_ruc.meta | 9 --------- 2 files changed, 6 insertions(+), 33 deletions(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 59006fb60..e6f4644d5 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -277,7 +277,6 @@ end subroutine lsm_ruc_finalize ! sigmaf - real, areal fractional cover of green vegetation im ! ! dlwflx - real, total sky sfc downward lw flux ( w/m**2 ) im ! ! dswflx - real, total sky sfc downward sw flux ( w/m**2 ) im ! -! snet - real, total sky sfc netsw flx into ground(w/m**2) im ! ! delt - real, time interval (second) 1 ! ! tg3 - real, deep soil temperature (k) im ! ! cm - real, surface exchange coeff for momentum (m/s) im ! @@ -337,7 +336,7 @@ subroutine lsm_ruc_run & ! inputs & imp_physics, imp_physics_gfdl, imp_physics_thompson, & & do_mynnsfclay, lsoil_ruc, lsoil, rdlai, zs, & & t1, q1, qc, soiltyp, vegtype, sigmaf, laixy, & - & dlwflx, dswsfc, snet, tg3, coszen, land, icy, lake, & + & dlwflx, dswsfc, tg3, coszen, land, icy, lake, & & rainnc, rainc, ice, snow, graupel, & & prsl1, zf, wind, shdmin, shdmax, & & srflag, sfalb_lnd_bck, snoalb, & @@ -389,7 +388,7 @@ subroutine lsm_ruc_run & ! inputs integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson real (kind=kind_phys), dimension(:), intent(in) :: & - & t1, sigmaf, laixy, dlwflx, dswsfc, snet, tg3, & + & t1, sigmaf, laixy, dlwflx, dswsfc, tg3, & & coszen, prsl1, wind, shdmin, shdmax, & & sfalb_lnd_bck, snoalb, zf, qc, q1, & ! for land @@ -938,17 +937,8 @@ subroutine lsm_ruc_run & ! inputs snoalb1d_lnd(i,j) = snoalb(i) albbck_lnd(i,j) = albbcksol(i) !sfalb_lnd_bck(i) - ! alb_lnd takes into account snow on the ground - !if (kdt == 1) then - ! if (dswsfc(i) > 0.) then - ! alb_lnd(i,j) = max(0.01, 1. - snet(i)/dswsfc(i)) - ! else - ! alb_lnd(i,j) = albbck_lnd(i,j) * (1.-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) - ! endif - !else alb_lnd(i,j) = albbck_lnd(i,j) * (1.-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) ! sfalb_lnd(i) - !endif - solnet_lnd(i,j) = snet(i) !dswsfc(i)*(1.-alb_lnd(i,j)) !..net sw rad flx (dn-up) at sfc in w/m2 + solnet_lnd(i,j) = dswsfc(i)*(1.-alb_lnd(i,j)) !..net sw rad flx (dn-up) at sfc in w/m2 cmc(i,j) = canopy(i) ! [mm] soilt_lnd(i,j) = tsurf_lnd(i) ! clu_q2m_iter @@ -1239,21 +1229,13 @@ subroutine lsm_ruc_run & ! inputs !-- alb_ice* is computed in setalb called from rrtmg_sw_pre. snoalb1d_ice(i,j) = 0.75 !alb_ice_snow(i) !0.75 is RAP value for max snow alb on ice albbck_ice(i,j) = 0.55 !alb_ice_snowfree(i) !0.55 is RAP value for ice alb - if (kdt == 1) then - if (dswsfc(i) > 0.) then - alb_ice(i,j) = max(0.01, 1. - snet(i)/dswsfc(i)) - else - alb_ice(i,j) = albbck_ice(i,j) * (1.-sncovr_ice(i,j)) + snoalb1d_ice(i,j) * sncovr_ice(i,j) - endif - else - alb_ice(i,j) = sfalb_ice(i) - endif - solnet_ice(i,j) = snet(i) !dswsfc(i)*(1.-alb_ice(i,j)) + alb_ice(i,j) = sfalb_ice(i) + solnet_ice(i,j) = dswsfc(i)*(1.-alb_ice(i,j)) qvg_ice(i,j) = sfcqv_ice(i) qsfc_ice(i,j) = sfcqv_ice(i)/(1.+sfcqv_ice(i)) qsg_ice(i,j) = rslf(prsl1(i),tsurf_ice(i)) qcg_ice(i,j) = sfcqc_ice(i) - semis_bck(i,j) = 0.99 + semis_bck(i,j) = 0.99 if (kdt == 1) then sfcems_ice(i,j) = semisbase(i) * (1.-sncovr_ice(i,j)) + 0.99 * sncovr_ice(i,j) else diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 83143f42b..150ebe489 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -810,15 +810,6 @@ kind = kind_phys intent = in optional = F -[snet] - standard_name = surface_net_downwelling_shortwave_flux - long_name = surface net downwelling shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F [tg3] standard_name = deep_soil_temperature long_name = deep soil temperature From 0a8aa3a426ae4f565eaf12b56346b07a0fecf7aa Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 25 May 2021 10:44:27 -0600 Subject: [PATCH 69/74] Add timestep_init andd timestep_final versions of GFS_diagtoscreen and GFS_interstitialtoscreen --- physics/GFS_debug.F90 | 80 +++++++++++++++++++++++++++++++++--- physics/GFS_debug.meta | 92 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 167 insertions(+), 5 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index dcf4ebab9..00e7865ef 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -307,7 +307,7 @@ module GFS_diagtoscreen private - public GFS_diagtoscreen_init, GFS_diagtoscreen_run, GFS_diagtoscreen_finalize + public GFS_diagtoscreen_init, GFS_diagtoscreen_timestep_init, GFS_diagtoscreen_run, GFS_diagtoscreen_finalize contains @@ -344,6 +344,39 @@ subroutine GFS_diagtoscreen_init (Model, Data, Interstitial, errmsg, errflg) end subroutine GFS_diagtoscreen_init +!> \section arg_table_GFS_diagtoscreen_timestep_init Argument Table +!! \htmlinclude GFS_diagtoscreen_timestep_init.html +!! + subroutine GFS_diagtoscreen_timestep_init (Model, Data, Interstitial, errmsg, errflg) + + use GFS_typedefs, only: GFS_control_type, GFS_data_type, & + GFS_interstitial_type + + implicit none + + !--- interface variables + type(GFS_control_type), intent(in) :: Model + type(GFS_data_type), intent(in) :: Data(:) + type(GFS_interstitial_type), intent(in) :: Interstitial(:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + !--- local variables + integer :: i + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + do i=1,size(Data) + call GFS_diagtoscreen_run (Model, Data(i)%Statein, Data(i)%Stateout, Data(i)%Sfcprop, & + Data(i)%Coupling, Data(i)%Grid, Data(i)%Tbd, Data(i)%Cldprop, & + Data(i)%Radtend, Data(i)%Intdiag, Interstitial(1), & + size(Interstitial), i, errmsg, errflg) + end do + + end subroutine GFS_diagtoscreen_timestep_init + subroutine GFS_diagtoscreen_finalize () end subroutine GFS_diagtoscreen_finalize @@ -870,17 +903,17 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%coslat', Grid%coslat) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%area ', Grid%area ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%dx ', Grid%dx ) - if (Model%ntoz > 0) then + if (Model%kdt>0 .and. Model%ntoz>0) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%ddy_o3 ', Grid%ddy_o3 ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx1_o3', Grid%jindx1_o3) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx2_o3', Grid%jindx2_o3) endif - if (Model%h2o_phys) then + if (Model%kdt>0 .and. Model%h2o_phys) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%ddy_h ', Grid%ddy_h ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx1_h', Grid%jindx1_h) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx2_h', Grid%jindx2_h) endif - if (Model%do_ugwp_v1) then + if (Model%kdt>0 .and. Model%do_ugwp_v1) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%ddy_j1tau ', Grid%ddy_j1tau ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%ddy_j2tau ', Grid%ddy_j2tau ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx1_tau', Grid%jindx1_tau ) @@ -916,10 +949,13 @@ module GFS_interstitialtoscreen private - public GFS_interstitialtoscreen_init, GFS_interstitialtoscreen_run, GFS_interstitialtoscreen_finalize + public GFS_interstitialtoscreen_init, GFS_interstitialtoscreen_timestep_init, GFS_interstitialtoscreen_run, GFS_interstitialtoscreen_finalize contains +!> \section arg_table_GFS_interstitialtoscreen_init Argument Table +!! \htmlinclude GFS_interstitialtoscreen_init.html +!! subroutine GFS_interstitialtoscreen_init (Model, Data, Interstitial, errmsg, errflg) use GFS_typedefs, only: GFS_control_type, GFS_data_type, & @@ -951,6 +987,40 @@ subroutine GFS_interstitialtoscreen_init (Model, Data, Interstitial, errmsg, err end subroutine GFS_interstitialtoscreen_init +!> \section arg_table_GFS_interstitialtoscreen_timestep_init Argument Table +!! \htmlinclude GFS_interstitialtoscreen_timestep_init.html +!! + subroutine GFS_interstitialtoscreen_timestep_init (Model, Data, Interstitial, errmsg, errflg) + + use GFS_typedefs, only: GFS_control_type, GFS_data_type, & + GFS_interstitial_type + + implicit none + + !--- interface variables + type(GFS_control_type), intent(in) :: Model + type(GFS_data_type), intent(in) :: Data(:) + type(GFS_interstitial_type), intent(in) :: Interstitial(:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + !--- local variables + integer :: i + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + + do i=1,size(Interstitial) + call GFS_interstitialtoscreen_run (Model, Data(1)%Statein, Data(1)%Stateout, Data(1)%Sfcprop, & + Data(1)%Coupling, Data(1)%Grid, Data(1)%Tbd, Data(1)%Cldprop, & + Data(1)%Radtend, Data(1)%Intdiag, Interstitial(i), & + size(Interstitial), -999, errmsg, errflg) + end do + + end subroutine GFS_interstitialtoscreen_timestep_init + subroutine GFS_interstitialtoscreen_finalize () end subroutine GFS_interstitialtoscreen_finalize diff --git a/physics/GFS_debug.meta b/physics/GFS_debug.meta index f2a991426..a2d3db0bf 100644 --- a/physics/GFS_debug.meta +++ b/physics/GFS_debug.meta @@ -49,6 +49,52 @@ intent = out optional = F +######################################################################## +[ccpp-arg-table] + name = GFS_diagtoscreen_timestep_init + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type in FV3 + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Data] + standard_name = GFS_data_type_instance_all_blocks + long_name = instance of derived type GFS_data_type + units = DDT + dimensions = (ccpp_block_count) + type = GFS_data_type + intent = in + optional = F +[Interstitial] + standard_name = GFS_interstitial_type_instance_all_threads + long_name = instance of derived type GFS_interstitial_type + units = DDT + dimensions = (omp_threads) + type = GFS_interstitial_type + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = GFS_diagtoscreen_run @@ -227,6 +273,52 @@ intent = out optional = F +######################################################################## +[ccpp-arg-table] + name = GFS_interstitialtoscreen_timestep_init + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type in FV3 + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Data] + standard_name = GFS_data_type_instance_all_blocks + long_name = instance of derived type GFS_data_type + units = DDT + dimensions = (ccpp_block_count) + type = GFS_data_type + intent = in + optional = F +[Interstitial] + standard_name = GFS_interstitial_type_instance_all_threads + long_name = instance of derived type GFS_interstitial_type + units = DDT + dimensions = (omp_threads) + type = GFS_interstitial_type + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = GFS_interstitialtoscreen_run From 03506970339cb42b20aa74a7c8f9cb41f7ee496c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 26 May 2021 08:18:13 -0600 Subject: [PATCH 70/74] Bug fixes in several metadata files: use horizontal_dimension in _init, _timestep_init, _timestep_final, _final routines; use horizontal_loop_extent in _run routines --- physics/GFS_rrtmgp_pre.meta | 6 ++-- physics/GFS_rrtmgp_thompsonmp_pre.meta | 6 ++-- physics/module_MYNNSFC_wrapper.meta | 2 +- physics/rrtmgp_sw_gas_optics.meta | 2 +- physics/sfc_drv_ruc.meta | 46 +++++++++++++------------- 5 files changed, 31 insertions(+), 31 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 8096aef2a..919cb33fb 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -86,7 +86,7 @@ dimensions = () type = logical intent = in - optional = F + optional = F [i_o3] standard_name = index_for_ozone long_name = tracer index for ozone mixing ratio @@ -324,7 +324,7 @@ standard_name = saturation_vapor_pressure long_name = saturation vapor pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -333,7 +333,7 @@ standard_name = water_vapor_mixing_ratio long_name = water vaport mixing ratio units = kg/kg - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta index c17abde74..bb60df092 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.meta +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -139,7 +139,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -148,7 +148,7 @@ standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure at vertical layer for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -157,7 +157,7 @@ standard_name = virtual_temperature long_name = layer virtual temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 0bb56a07b..d082752c4 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -764,7 +764,7 @@ standard_name = water_vapor_mixing_ratio_at_surface_over_ice long_name = water vapor mixing ratio at surface over ice units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta index 32eeee4a9..f6a163ec1 100644 --- a/physics/rrtmgp_sw_gas_optics.meta +++ b/physics/rrtmgp_sw_gas_optics.meta @@ -8,7 +8,7 @@ name = rrtmgp_sw_gas_optics_init type = scheme [ncol] - standard_name = horizontal_loop_extent + standard_name = horizontal_dimension long_name = horizontal dimension units = count dimensions = () diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 150ebe489..7a7fc5075 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -82,8 +82,8 @@ intent = in optional = F [im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent + standard_name = horizontal_dimension + long_name = horizontal dimension units = count dimensions = () type = integer @@ -168,7 +168,7 @@ standard_name = water_vapor_specific_humidity_at_lowest_model_layer long_name = water vapor specific humidity at lowest model layer units = kg kg-1 - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in @@ -177,7 +177,7 @@ standard_name = air_pressure_at_lowest_model_layer long_name = mean pressure at lowest model layer units = Pa - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in @@ -195,7 +195,7 @@ standard_name = sea_ice_temperature long_name = sea ice surface skin temperature units = K - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in @@ -249,7 +249,7 @@ standard_name = sea_ice_concentration long_name = ice fraction over open water units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in @@ -267,7 +267,7 @@ standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction over land units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in @@ -276,7 +276,7 @@ standard_name = surface_snow_area_fraction_over_ice long_name = surface snow area fraction over ice units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in @@ -285,7 +285,7 @@ standard_name = upper_bound_on_max_albedo_over_deep_snow long_name = maximum snow albedo units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in @@ -348,7 +348,7 @@ standard_name = water_vapor_mixing_ratio_at_surface_over_land long_name = water vapor mixing ratio at surface over land units = kg kg-1 - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -357,7 +357,7 @@ standard_name = water_vapor_mixing_ratio_at_surface_over_ice long_name = water vapor mixing ratio at surface over ice units = kg kg-1 - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -366,7 +366,7 @@ standard_name =surface_snow_free_albedo_over_land long_name = surface snow-free albedo over ice units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -375,7 +375,7 @@ standard_name = baseline_surface_longwave_emissivity long_name = baseline surface lw emissivity in fraction units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = out @@ -384,7 +384,7 @@ standard_name = surface_longwave_emissivity_over_land long_name = surface lw emissivity in fraction over land units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -393,7 +393,7 @@ standard_name = surface_longwave_emissivity_over_ice long_name = surface lw emissivity in fraction over ice units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -402,7 +402,7 @@ standard_name = surface_albedo_direct_visible_over_land long_name = direct surface albedo visible band over land units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -411,7 +411,7 @@ standard_name = surface_albedo_direct_NIR_over_land long_name = direct surface albedo NIR band over land units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -420,7 +420,7 @@ standard_name = surface_albedo_diffuse_visible_over_land long_name = diffuse surface albedo visible band over land units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -429,7 +429,7 @@ standard_name = surface_albedo_diffuse_NIR_over_land long_name = diffuse surface albedo NIR band over land units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -438,7 +438,7 @@ standard_name = surface_albedo_direct_visible_over_ice long_name = direct surface albedo visible band over ice units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -447,7 +447,7 @@ standard_name = surface_albedo_direct_NIR_over_ice long_name = direct surface albedo NIR band over ice units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -456,7 +456,7 @@ standard_name = surface_albedo_diffuse_visible_over_ice long_name = diffuse surface albedo visible band over ice units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -465,7 +465,7 @@ standard_name = surface_albedo_diffuse_NIR_over_ice long_name = diffuse surface albedo NIR band over ice units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout From 09494e6132acba744085a96243c66a4a3c164701 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 1 Jun 2021 08:24:46 -0600 Subject: [PATCH 71/74] Several bug fixes to UGWP v1 and GSL drag suite related to updated tendencies code --- physics/drag_suite.F90 | 8 ++++++-- physics/ugwpv1_gsldrag.F90 | 17 +++++++++-------- physics/ugwpv1_gsldrag.meta | 1 - physics/unified_ugwp.F90 | 4 +++- 4 files changed, 18 insertions(+), 12 deletions(-) diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 7f9da6f4f..9b110d689 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -218,7 +218,7 @@ subroutine drag_suite_run( & & do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & & dtend, dtidx, index_of_process_orographic_gwd, & & index_of_temperature, index_of_x_wind, & - & index_of_y_wind, ldiag3d, errmsg, errflg ) + & index_of_y_wind, ldiag3d, errmsg, errflg) ! ******************************************************************** ! -----> I M P L E M E N T A T I O N V E R S I O N <---------- @@ -504,8 +504,12 @@ subroutine drag_suite_run( & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - var_temp2 = 0. + ! Initialize local variables + var_temp2 = 0. + udtend = -1 + vdtend = -1 + Tdtend = -1 if(ldiag3d) then udtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/ugwpv1_gsldrag.F90 index 518aefab4..104fc8e3f 100644 --- a/physics/ugwpv1_gsldrag.F90 +++ b/physics/ugwpv1_gsldrag.F90 @@ -429,8 +429,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! real(kind=kind_phys), intent(inout), dimension(:,:) :: dudt, dvdt, dtdt - ! dtend is only allocated if ldiag=.true. - real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), & index_of_x_wind, index_of_y_wind, index_of_temperature, & index_of_process_orographic_gwd, index_of_process_nonorographic_gwd @@ -548,16 +547,18 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & ol4ss,theta,sigma,gamma,elvmax, & - dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl, & - dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd, & - dusfcg, dvsfcg, & - du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & - du_osscol, dv_osscol, du_ofdcol, dv_ofdcol, & + dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl, & + dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd, & + dusfcg, dvsfcg, & + du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & + du_osscol, dv_osscol, du_ofdcol, dv_ofdcol, & slmsk,br1,hpbl, con_g,con_cp,con_rd,con_rv, & con_fv, con_pi, lonr, & cdmbgwd(1:2),me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & - errmsg,errflg) + dtend, dtidx, index_of_process_orographic_gwd, & + index_of_temperature, index_of_x_wind, & + index_of_y_wind, ldiag3d, errmsg, errflg) ! ! dusfcg = du_ogwcol + du_oblcol + du_osscol + du_ofdcol ! diff --git a/physics/ugwpv1_gsldrag.meta b/physics/ugwpv1_gsldrag.meta index c751b901c..5cfae9dd1 100644 --- a/physics/ugwpv1_gsldrag.meta +++ b/physics/ugwpv1_gsldrag.meta @@ -1156,7 +1156,6 @@ dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys - active = (flag_diagnostics_3D) intent = inout optional = F [dtidx] diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index 587885cc6..def7ba141 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -342,7 +342,9 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, con_fvirt,con_pi,lonr, & cdmbgwd(1:2),me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & - errmsg,errflg) + dtend, dtidx, index_of_process_orographic_gwd, & + index_of_temperature, index_of_x_wind, & + index_of_y_wind, ldiag3d, errmsg, errflg) ! ! put zeros due to xy GSL-drag style: dtaux2d_bl,dtauy2d_bl,dtaux2d_ss.......dusfc_ls,dvsfc_ls ! From df632d81c8f5c3f2e8199953bb86bebf59cad6c7 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 2 Jun 2021 13:01:02 -0600 Subject: [PATCH 72/74] Add missing variables to physics/GFS_debug.F90, comment out erroneous tendencies code --- physics/GFS_debug.F90 | 38 +++++++++++++++++++++++++------------- 1 file changed, 25 insertions(+), 13 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 0218affa0..567cbbd32 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -667,6 +667,16 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%v1 ', Diag%v1) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%chh ', Diag%chh) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%cmm ', Diag%cmm) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dlwsfci ', Diag%dlwsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%ulwsfci ', Diag%ulwsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dswsfci ', Diag%dswsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%nswsfci ', Diag%nswsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%uswsfci ', Diag%uswsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dusfci ', Diag%dusfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dvsfci ', Diag%dvsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dtsfci ', Diag%dtsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dqsfci ', Diag%dqsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%gfluxi ', Diag%gfluxi) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%epi ', Diag%epi) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%smcwlt2 ', Diag%smcwlt2) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%smcref2 ', Diag%smcref2) @@ -687,19 +697,21 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%shum_wts ', Diag%shum_wts) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%zmtnblck ', Diag%zmtnblck) if (Model%ldiag3d) then - do itracer=2,Model%ntracp100 - do iprocess=1,Model%nprocess - idtend = Model%dtidx(itracer,iprocess) - if(idtend>=1) then - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, & - 'dtend_'//Model%dtend_tracer_labels(itracer)//'_' & - //Model%dtend_cause_labels(iprocess), Diag%dtend(1,1,idtend)) - endif - enddo - enddo - !call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%upd_mf ', Diag%upd_mf) - !call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dwn_mf ', Diag%dwn_mf) - !call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%det_mf ', Diag%det_mf) + !do itracer=2,Model%ntracp100 + ! do iprocess=1,Model%nprocess + ! idtend = Model%dtidx(itracer,iprocess) + ! if(idtend>=1) then + ! call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, & + ! 'dtend_'//Model%dtend_tracer_labels(itracer)//'_' & + ! //Model%dtend_cause_labels(iprocess), Diag%dtend(1,1,idtend)) + ! endif + ! enddo + !enddo + if (Model%qdiag3d) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%upd_mf ', Diag%upd_mf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dwn_mf ', Diag%dwn_mf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%det_mf ', Diag%det_mf) + end if end if if(Model%lradar) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%refl_10cm ', Diag%refl_10cm) From 10ab813d658c288e2b872406a5f15d991d3cb6d6 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 2 Jun 2021 13:02:06 -0600 Subject: [PATCH 73/74] Fix b4b issue for restart runs with RUC LSM --- physics/GFS_surface_composites.F90 | 6 +++--- physics/GFS_surface_composites.meta | 8 ++++++++ 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index ee99e0f85..48a4b7808 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -27,7 +27,7 @@ end subroutine GFS_surface_composites_pre_finalize !> \section arg_table_GFS_surface_composites_pre_run Argument Table !! \htmlinclude GFS_surface_composites_pre_run.html !! - subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, lsm_ruc, frac_grid, & + subroutine GFS_surface_composites_pre_run (im, flag_init, flag_restart, lkm, lsm, lsm_noahmp, lsm_ruc, frac_grid, & flag_cice, cplflx, cplwav2atm, landfrac, lakefrac, lakedepth, oceanfrac, frland, & dry, icy, use_flake, ocean, wet, hice, cice, zorlo, zorll, zorli, & snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & @@ -43,7 +43,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, ! Interface variables integer, intent(in ) :: im, lkm integer, intent(in ) :: lsm, lsm_noahmp, lsm_ruc - logical, intent(in ) :: flag_init, frac_grid, cplflx, cplwav2atm + logical, intent(in ) :: flag_init, flag_restart, frac_grid, cplflx, cplwav2atm logical, dimension(:), intent(inout) :: flag_cice logical, dimension(:), intent(inout) :: dry, icy, use_flake, ocean, wet real(kind=kind_phys), dimension(:), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac @@ -231,7 +231,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, snowd_ice(i) = snowd(i) ep1d_ice(i) = zero gflx_ice(i) = zero - if (iemsflg == 2 .and. .not. flag_init .and. lsm == lsm_ruc) then + if (iemsflg == 2 .and. (.not.flag_init .or. flag_restart) .and. lsm == lsm_ruc) then !-- use emis_ice from RUC LSM with snow effect semis_ice(i) = emis_ice(i) else diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 95f2c6e4e..9caf9db04 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -23,6 +23,14 @@ type = logical intent = in optional = F +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F [lkm] standard_name = flag_for_lake_surface_scheme long_name = flag for lake surface model From ef5db3119c2f924dfe2c1da180b92f388b1a82f7 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 3 Jun 2021 10:19:07 -0600 Subject: [PATCH 74/74] More bug fixes related to tendencies in physics/unified_ugwp.F90 --- physics/unified_ugwp.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index def7ba141..da79ecde8 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -268,8 +268,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, real(kind=kind_phys), intent(out), dimension(:,:) :: dudt_mtb, dudt_tms real(kind=kind_phys), intent(out), dimension(:,:) :: dtaux2d_ls, dtauy2d_ls - ! The dtend array is are only allocated if ldiag=.true. - real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) + real(kind=kind_phys), intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), index_of_temperature, index_of_x_wind, & index_of_y_wind, index_of_process_nonorographic_gwd, & index_of_process_orographic_gwd @@ -340,7 +339,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & slmsk,br1,hpbl,con_g,con_cp,con_rd,con_rv, & con_fvirt,con_pi,lonr, & - cdmbgwd(1:2),me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & + cdmbgwd,me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & dtend, dtidx, index_of_process_orographic_gwd, & index_of_temperature, index_of_x_wind, &