From 756f2cf9be15b4f4d840299380b367ddd6ed03e5 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Fri, 26 Mar 2021 19:45:14 +0000 Subject: [PATCH 01/40] 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/40] 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/40] 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 21df4016f4d435ed531b773e80b462d57e1f4213 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 31 Mar 2021 20:11:05 -0600 Subject: [PATCH 04/40] Fix CODEOWNERS --- CODEOWNERS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CODEOWNERS b/CODEOWNERS index 0d5230f89..b6c597371 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -3,7 +3,7 @@ # These owners will be the default owners for everything in the repo. #* @defunkt -* @climbfuji @llpcarson @grantfirl @JulieSchramm +* @DomHeinzeller # Order is important. The last matching pattern has the most precedence. # So if a pull request only touches javascript files, only these owners From ed7db4dbdd50ba427e4fd0a090a74a500bf57fab Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Mon, 5 Apr 2021 21:03:59 +0000 Subject: [PATCH 05/40] 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 06/40] 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 07/40] 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 08/40] 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 09/40] 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 10/40] 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 11/40] 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 12/40] 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 13/40] 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 14/40] 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 15/40] 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 16/40] 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 17/40] 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 18/40] 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 19/40] 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 20/40] 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 21/40] 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 22/40] 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 23/40] 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 24/40] 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 25/40] 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 45849a9859fca65d803ea7502e307cd092127a0a Mon Sep 17 00:00:00 2001 From: Ben Green Date: Wed, 28 Apr 2021 16:31:05 +0000 Subject: [PATCH 26/40] 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/40] 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 d224b13c9e7cab8cf21d4d9eb06b889a95f35aa5 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Thu, 13 May 2021 21:24:40 +0000 Subject: [PATCH 28/40] 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 e0b1eb665e9a4e38e7ec5a3deb7daa4713d297f2 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 14 May 2021 10:45:15 -0600 Subject: [PATCH 29/40] 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 30/40] 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 79739c7bed12038c2bbe233042fdf40bb8dfb26e Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 14 May 2021 20:04:22 -0600 Subject: [PATCH 31/40] 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 32/40] 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 33/40] 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 34/40] 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 35/40] 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 36/40] 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 37/40] 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 c3375bb50de56a396da36bd004fcf204a0adb252 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 25 May 2021 13:41:30 +0000 Subject: [PATCH 38/40] 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 39/40] 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 40/40] 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