diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index ef8f2de97..9731a6309 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -372,18 +372,43 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! --- ... coupling insertion - if (cplflx) then - do i=1,im - dusfc_cpl (i) = dusfc_cpl(i) + dusfc1(i)*dtf - dvsfc_cpl (i) = dvsfc_cpl(i) + dvsfc1(i)*dtf - dtsfc_cpl (i) = dtsfc_cpl(i) + dtsfc1(i)*dtf - dqsfc_cpl (i) = dqsfc_cpl(i) + dqsfc1(i)*dtf - dusfci_cpl(i) = dusfc1(i) - dvsfci_cpl(i) = dvsfc1(i) - dtsfci_cpl(i) = dtsfc1(i) - dqsfci_cpl(i) = dqsfc1(i) - enddo - endif +! ### GJF ### the following section needs to be made CCPP-compliant when cplflx = T +! if (cplflx) then +! do i=1,im +! if (ocean(i)) then ! Ocean only, NO LAKES +! if (flag_cice(i)) cice(i) = fice_cice(i) +! if (cice(i) == 1.) then ! use results from CICE +! Coupling%dusfci_cpl(i) = dusfc_cice(i) +! Coupling%dvsfci_cpl(i) = dvsfc_cice(i) +! Coupling%dtsfci_cpl(i) = dtsfc_cice(i) +! Coupling%dqsfci_cpl(i) = dqsfc_cice(i) +! elseif (dry(i) .or. icy(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point +! tem1 = max(Diag%q1(i), 1.e-8) +! rho = Statein%prsl(i,1) / (con_rd*Diag%t1(i)*(1.0+con_fvirt*tem1)) +! if (wind(i) > 0.) then +! Coupling%dusfci_cpl(i) = -rho * stress_ocean(i) * Statein%ugrs(i,1) / wind(i) ! U-momentum flux +! Coupling%dvsfci_cpl(i) = -rho * stress_ocean(i) * Statein%vgrs(i,1) / wind(i) ! V-momentum flux +! else +! Coupling%dusfci_cpl(i) = 0. +! Coupling%dvsfci_cpl(i) = 0. +! end if +! Coupling%dtsfci_cpl(i) = con_cp * rho * hflx_ocean(i) !sensible heat flux over open ocean +! Coupling%dqsfci_cpl(i) = con_hvap * rho * evap_ocean(i) ! latent heat flux over open ocean +! else ! use results from PBL scheme for 100% open ocean +! Coupling%dusfci_cpl(i) = dusfc1(i) +! Coupling%dvsfci_cpl(i) = dvsfc1(i) +! Coupling%dtsfci_cpl(i) = dtsfc1(i) +! Coupling%dqsfci_cpl(i) = dqsfc1(i) +! endif +! +! Coupling%dusfc_cpl (i) = Coupling%dusfc_cpl(i) + Coupling%dusfci_cpl(i) * dtf +! Coupling%dvsfc_cpl (i) = Coupling%dvsfc_cpl(i) + Coupling%dvsfci_cpl(i) * dtf +! Coupling%dtsfc_cpl (i) = Coupling%dtsfc_cpl(i) + Coupling%dtsfci_cpl(i) * dtf +! Coupling%dqsfc_cpl (i) = Coupling%dqsfc_cpl(i) + Coupling%dqsfci_cpl(i) * dtf +! ! +! endif ! Ocean only, NO LAKES +! enddo +! endif !-------------------------------------------------------lssav if loop ---------- if (lssav) then do i=1,im diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 649192f40..9ed719d76 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -134,11 +134,17 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, if (mpirank==impi .and. omprank==iomp) then ! Sfcprop call print_var(mpirank,omprank, blkno, 'Sfcprop%slmsk' , Sfcprop%slmsk) - call print_var(mpirank,omprank, blkno, 'Sfcprop%lakemsk' , Sfcprop%lakemsk) + call print_var(mpirank,omprank, blkno, 'Sfcprop%oceanfrac', Sfcprop%oceanfrac) + call print_var(mpirank,omprank, blkno, 'Sfcprop%landfrac' , Sfcprop%landfrac) + call print_var(mpirank,omprank, blkno, 'Sfcprop%lakefrac' , Sfcprop%lakefrac) call print_var(mpirank,omprank, blkno, 'Sfcprop%tsfc' , Sfcprop%tsfc) + call print_var(mpirank,omprank, blkno, 'Sfcprop%tsfco' , Sfcprop%tsfco) + call print_var(mpirank,omprank, blkno, 'Sfcprop%tsfcl' , Sfcprop%tsfcl) call print_var(mpirank,omprank, blkno, 'Sfcprop%tisfc' , Sfcprop%tisfc) call print_var(mpirank,omprank, blkno, 'Sfcprop%snowd' , Sfcprop%snowd) call print_var(mpirank,omprank, blkno, 'Sfcprop%zorl' , Sfcprop%zorl) + call print_var(mpirank,omprank, blkno, 'Sfcprop%zorlo' , Sfcprop%zorlo) + call print_var(mpirank,omprank, blkno, 'Sfcprop%zorll' , Sfcprop%zorll) call print_var(mpirank,omprank, blkno, 'Sfcprop%fice' , Sfcprop%fice) call print_var(mpirank,omprank, blkno, 'Sfcprop%hprim' , Sfcprop%hprim) call print_var(mpirank,omprank, blkno, 'Sfcprop%hprime' , Sfcprop%hprime) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 3d9c00ac9..eb1e2e2b4 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -108,7 +108,7 @@ end subroutine GFS_suite_interstitial_1_finalize !! | rhbtop | critical_relative_humidity_at_top_of_atmosphere | critical relative humidity at the top of atmosphere | frac | 0 | real | kind_phys | out | F | !! | frain | dynamics_to_physics_timestep_ratio | ratio of dynamics timestep to physics timestep | none | 0 | real | kind_phys | out | F | !! | islmsk | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | out | F | -!! | frland | land_area_fraction | land area fraction | frac | 1 | real | kind_phys | out | F | +!! | frland | land_area_fraction_for_microphysics | land area fraction used in microphysics schemes | frac | 1 | real | kind_phys | out | F | !! | work1 | grid_size_related_coefficient_used_in_scale-sensitive_schemes | grid size related coefficient used in scale-sensitive schemes | none | 1 | real | kind_phys | out | F | !! | work2 | grid_size_related_coefficient_used_in_scale-sensitive_schemes_complement | complement to work1 | none | 1 | real | kind_phys | out | F | !! | psurf | surface_air_pressure_diag | surface air pressure diagnostic | Pa | 1 | real | kind_phys | out | F | @@ -117,11 +117,14 @@ end subroutine GFS_suite_interstitial_1_finalize !! | dtdt | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | out | F | !! | dtdtc | tendency_of_air_temperature_due_to_radiative_heating_assuming_clear_sky | clear sky radiative (shortwave + longwave) heating rate at current time | K s-1 | 2 | real | kind_phys | out | F | !! | dqdt | tendency_of_tracers_due_to_model_physics | updated tendency of the tracers | kg kg-1 s-1 | 3 | real | kind_phys | out | F | +!! | tisfc | sea_ice_temperature | sea ice surface skin temperature | K | 1 | real | kind_phys | in | F | +!! | tice | sea_ice_temperature_interstitial | sea ice surface skin temperature use as interstitial | K | 1 | real | kind_phys | out | F | !! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | !! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! subroutine GFS_suite_interstitial_1_run (im, levs, ntrac, crtrh, dtf, dtp, slmsk, area, dxmin, dxinv, pgr, & - rhbbot, rhpbl, rhbtop, frain, islmsk, frland, work1, work2, psurf, dudt, dvdt, dtdt, dtdtc, dqdt, errmsg, errflg) + rhbbot, rhpbl, rhbtop, frain, islmsk, frland, work1, work2, psurf, dudt, dvdt, dtdt, dtdtc, dqdt, & + tisfc, tice, errmsg, errflg) use machine, only: kind_phys @@ -138,6 +141,8 @@ subroutine GFS_suite_interstitial_1_run (im, levs, ntrac, crtrh, dtf, dtp, slmsk real(kind=kind_phys), intent(out), dimension(im) :: frland, work1, work2, psurf real(kind=kind_phys), intent(out), dimension(im,levs) :: dudt, dvdt, dtdt, dtdtc real(kind=kind_phys), intent(out), dimension(im,levs,ntrac) :: dqdt + real(kind=kind_phys), intent(in), dimension(im) :: tisfc + real(kind=kind_phys), intent(out), dimension(im) :: tice character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -165,6 +170,9 @@ subroutine GFS_suite_interstitial_1_run (im, levs, ntrac, crtrh, dtf, dtp, slmsk work1(i) = max(0.0, min(1.0,work1(i))) work2(i) = 1.0 - work1(i) psurf(i) = pgr(i) + ! DH* 20190507 - assign sea ice temperature to interstitial variable + tice(i) = tisfc(i) + ! *DH end do do k=1,levs diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 new file mode 100644 index 000000000..1d912159a --- /dev/null +++ b/physics/GFS_surface_composites.F90 @@ -0,0 +1,477 @@ +!> \file GFS_surface_composites.F90 +!! Contains code related to generating composites for all GFS surface schemes. + +module GFS_surface_composites_pre + + use machine, only: kind_phys + + implicit none + + private + + public GFS_surface_composites_pre_init, GFS_surface_composites_pre_finalize, GFS_surface_composites_pre_run + +contains + + subroutine GFS_surface_composites_pre_init () + end subroutine GFS_surface_composites_pre_init + + subroutine GFS_surface_composites_pre_finalize() + end subroutine GFS_surface_composites_pre_finalize + +#if 0 +!> \section arg_table_GFS_surface_composites_pre_run Argument Table +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|-----------------------------------------------------------------------------------|----------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| +!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | +!! | cplflx | flag_for_flux_coupling | flag controlling cplflx collection (default off) | flag | 0 | logical | | in | F | +!! | landfrac | land_area_fraction | fraction of horizontal grid area occupied by land | frac | 1 | real | kind_phys | in | F | +!! | lakefrac | lake_area_fraction | fraction of horizontal grid area occupied by lake | frac | 1 | real | kind_phys | in | F | +!! | oceanfrac | sea_area_fraction | fraction of horizontal grid area occupied by ocean | frac | 1 | real | kind_phys | in | F | +!! | dry | flag_nonzero_land_surface_fraction | flag indicating presence of some land surface area fraction | flag | 1 | logical | | inout | F | +!! | icy | flag_nonzero_sea_ice_surface_fraction | flag indicating presence of some sea ice surface area fraction | flag | 1 | logical | | inout | F | +!! | lake | flag_nonzero_lake_surface_fraction | flag indicating presence of some lake surface area fraction | flag | 1 | logical | | inout | F | +!! | ocean | flag_nonzero_ocean_surface_fraction | flag indicating presence of some ocean surface area fraction | flag | 1 | logical | | inout | F | +!! | wet | flag_nonzero_wet_surface_fraction | flag indicating presence of some ocean or lake surface area fraction | flag | 1 | logical | | inout | F | +!! | fice | sea_ice_concentration | ice fraction over open water | frac | 1 | real | kind_phys | in | F | +!! | cimin | minimum_sea_ice_concentration | minimum sea ice concentration | frac | 0 | real | kind_phys | in | F | +!! | zorl | surface_roughness_length | surface roughness length | cm | 1 | real | kind_phys | in | F | +!! | zorlo | surface_roughness_length_over_ocean | surface roughness length over ocean | cm | 1 | real | kind_phys | inout | F | +!! | zorll | surface_roughness_length_over_land | surface roughness length over land | cm | 1 | real | kind_phys | inout | F | +!! | zorl_ocn | surface_roughness_length_over_ocean_interstitial | surface roughness length over ocean (temporary use as interstitial) | cm | 1 | real | kind_phys | inout | F | +!! | zorl_lnd | surface_roughness_length_over_land_interstitial | surface roughness length over land (temporary use as interstitial) | cm | 1 | real | kind_phys | inout | F | +!! | zorl_ice | surface_roughness_length_over_ice_interstitial | surface roughness length over ice (temporary use as interstitial) | cm | 1 | real | kind_phys | inout | F | +!! | snowd | surface_snow_thickness_water_equivalent | water equivalent snow depth | mm | 1 | real | kind_phys | in | F | +!! | snowd_ocn | surface_snow_thickness_water_equivalent_over_ocean | water equivalent snow depth over ocean | mm | 1 | real | kind_phys | inout | F | +!! | snowd_lnd | surface_snow_thickness_water_equivalent_over_land | water equivalent snow depth over land | mm | 1 | real | kind_phys | inout | F | +!! | snowd_ice | surface_snow_thickness_water_equivalent_over_ice | water equivalent snow depth over ice | mm | 1 | real | kind_phys | inout | F | +!! | tprcp | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep | total precipitation amount in each time step | m | 1 | real | kind_phys | in | F | +!! | tprcp_ocn | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ocean | total precipitation amount in each time step over ocean | m | 1 | real | kind_phys | inout | F | +!! | tprcp_lnd | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land | total precipitation amount in each time step over land | m | 1 | real | kind_phys | inout | F | +!! | tprcp_ice | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice | total precipitation amount in each time step over ice | m | 1 | real | kind_phys | inout | F | +!! | uustar | surface_friction_velocity | boundary layer parameter | m s-1 | 1 | real | kind_phys | in | F | +!! | uustar_lnd | surface_friction_velocity_over_land | surface friction velocity over land | m s-1 | 1 | real | kind_phys | inout | F | +!! | uustar_ice | surface_friction_velocity_over_ice | surface friction velocity over ice | m s-1 | 1 | real | kind_phys | inout | F | +!! | weasd | water_equivalent_accumulated_snow_depth | water equiv of acc snow depth over land and sea ice | mm | 1 | real | kind_phys | in | F | +!! | weasd_lnd | water_equivalent_accumulated_snow_depth_over_land | water equiv of acc snow depth over land | mm | 1 | real | kind_phys | inout | F | +!! | weasd_ice | water_equivalent_accumulated_snow_depth_over_ice | water equiv of acc snow depth over ice | mm | 1 | real | kind_phys | inout | F | +!! | ep1d_ice | surface_upward_potential_latent_heat_flux_over_ice | surface upward potential latent heat flux over ice | W m-2 | 1 | real | kind_phys | inout | F | +!! | tsfc | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | +!! | tsfco | sea_surface_temperature | sea surface temperature | K | 1 | real | kind_phys | inout | F | +!! | tsfcl | surface_skin_temperature_over_land | surface skin temperature over land | K | 1 | real | kind_phys | inout | F | +!! | tsfc_ocn | surface_skin_temperature_over_ocean_interstitial | surface skin temperature over ocean (temporary use as interstitial) | K | 1 | real | kind_phys | inout | F | +!! | tsfc_lnd | surface_skin_temperature_over_land_interstitial | surface skin temperature over land (temporary use as interstitial) | K | 1 | real | kind_phys | inout | F | +!! | tsfc_ice | surface_skin_temperature_over_ice_interstitial | surface skin temperature over ice (temporary use as interstitial) | K | 1 | real | kind_phys | inout | F | +!! | tisfc | sea_ice_temperature | sea ice surface skin temperature | K | 1 | real | kind_phys | inout | F | +!! | tsurf | surface_skin_temperature_after_iteration | surface skin temperature after iteration | K | 1 | real | kind_phys | inout | F | +!! | tsurf_ocn | surface_skin_temperature_after_iteration_over_ocean | surface skin temperature after iteration over ocean | K | 1 | real | kind_phys | inout | F | +!! | tsurf_lnd | surface_skin_temperature_after_iteration_over_land | surface skin temperature after iteration over land | K | 1 | real | kind_phys | inout | F | +!! | tsurf_ice | surface_skin_temperature_after_iteration_over_ice | surface skin temperature after iteration over ice | K | 1 | real | kind_phys | inout | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! +#endif + subroutine GFS_surface_composites_pre_run (im, cplflx, landfrac, lakefrac, oceanfrac, & + dry, icy, lake, ocean, wet, fice, cimin, zorl, zorlo, zorll, zorl_ocn, & + zorl_lnd, zorl_ice, snowd, snowd_ocn, snowd_lnd, snowd_ice, tprcp, tprcp_ocn, & + tprcp_lnd, tprcp_ice, uustar, uustar_lnd, uustar_ice, weasd, weasd_lnd, & + weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_ocn, tsfc_lnd, tsfc_ice, tisfc, & + tsurf, tsurf_ocn, tsurf_lnd, tsurf_ice, errmsg, errflg) + + use machine, only: kind_phys + + implicit none + + ! Interface variables + integer, intent(in) :: im + logical, intent(in) :: cplflx + logical, dimension(im), intent(inout) :: dry, icy, lake, ocean, wet + real(kind=kind_phys), intent(in) :: cimin + real(kind=kind_phys), dimension(im), intent(in) :: landfrac, lakefrac, oceanfrac, fice + real(kind=kind_phys), dimension(im), intent(in) :: zorl, snowd, tprcp, uustar, weasd, tsfc + + real(kind=kind_phys), dimension(im), intent(inout) :: zorlo, zorll, tsfco, tsfcl, tisfc, tsurf + real(kind=kind_phys), dimension(im), intent(inout) :: snowd_ocn, snowd_lnd, snowd_ice, tprcp_ocn, & + tprcp_lnd, tprcp_ice, zorl_ocn, zorl_lnd, zorl_ice, tsfc_ocn, tsfc_lnd, tsfc_ice, tsurf_ocn, & + tsurf_lnd, tsurf_ice, uustar_lnd, uustar_ice, weasd_lnd, weasd_ice, ep1d_ice + + ! CCPP error handling + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: i + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + do i = 1, im + if(oceanfrac(i)>0.) ocean(i) = .true. + if(landfrac(i) >0.) dry(i) = .true. + if(lakefrac(i) >0.) lake(i) = .true. + if(ocean(i) .or. lake(i)) wet(i) = .true. + if(fice(i) > cimin*max(oceanfrac(i),lakefrac(i))) icy(i) = .true. + enddo + + do i=1,im + if (.not. cplflx) then + zorll(i) = zorl(i) + zorlo(i) = zorl(i) + tsfcl(i) = tsfc(i) + tsfco(i) = tsfc(i) + tisfc(i) = tsfc(i) + end if + if(wet(i)) then + snowd_ocn(i) = snowd(i) + tprcp_ocn(i) = tprcp(i) + zorl_ocn(i) = zorlo(i) + tsfc_ocn(i) = tsfco(i) + tsurf_ocn(i)= tsfco(i) + endif + if (dry(i)) then + uustar_lnd(i) = uustar(i) + weasd_lnd(i) = weasd(i) + tprcp_lnd(i) = tprcp(i) + zorl_lnd(i) = zorll(i) + tsfc_lnd(i) = tsfcl(i) + tsurf_lnd(i) = tsfcl(i) + snowd_lnd(i) = snowd(i) + end if + if (icy(i)) then + uustar_ice(i) = uustar(i) + weasd_ice(i) = weasd(i) + tprcp_ice(i) = tprcp(i) + zorl_ice(i) = zorll(i) + tsfc_ice(i) = tisfc(i) + tsurf_ice(i)= tisfc(i) + snowd_ice(i) = snowd(i) + ep1d_ice(i) = 0. + end if + enddo + + end subroutine GFS_surface_composites_pre_run + +end module GFS_surface_composites_pre + + +module GFS_surface_composites_post + + use machine, only: kind_phys + + implicit none + + private + + public GFS_surface_composites_post_init, GFS_surface_composites_post_finalize, GFS_surface_composites_post_run + +contains + + subroutine GFS_surface_composites_post_init () + end subroutine GFS_surface_composites_post_init + + subroutine GFS_surface_composites_post_finalize() + end subroutine GFS_surface_composites_post_finalize + +#if 0 +!> \section arg_table_GFS_surface_composites_post_run Argument Table +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|---------------------------------------------------------------------------------------------------------------------|-------------------------------------------------------------------------------------|-------------|------|------------|-----------|--------|----------| +!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | +!! | cplflx | flag_for_flux_coupling | flag controlling cplflx collection (default off) | flag | 0 | logical | | in | F | +!! | flag_cice | flag_for_cice | flag for cice | flag | 1 | logical | | in | F | +!! | dry | flag_nonzero_land_surface_fraction | flag indicating presence of some land surface area fraction | flag | 1 | logical | | in | F | +!! | wet | flag_nonzero_wet_surface_fraction | flag indicating presence of some ocean or lake surface area fraction | flag | 1 | logical | | in | F | +!! | icy | flag_nonzero_sea_ice_surface_fraction | flag indicating presence of some sea ice surface area fraction | flag | 1 | logical | | in | F | +!! | lndfrac | land_area_fraction | fraction of horizontal grid area occupied by land | frac | 1 | real | kind_phys | in | F | +!! | lakfrac | lake_area_fraction | fraction of horizontal grid area occupied by lake | frac | 1 | real | kind_phys | in | F | +!! | ocnfrac | sea_area_fraction | fraction of horizontal grid area occupied by ocean | frac | 1 | real | kind_phys | in | F | +!! | cice | sea_ice_concentration | ice fraction over open water | frac | 1 | real | kind_phys | in | F | +!! | zorl | surface_roughness_length | surface roughness length | cm | 1 | real | kind_phys | inout | F | +!! | zorlo | surface_roughness_length_over_ocean | surface roughness length over ocean | cm | 1 | real | kind_phys | inout | F | +!! | zorll | surface_roughness_length_over_land | surface roughness length over land | cm | 1 | real | kind_phys | inout | F | +!! | zorl_ocn | surface_roughness_length_over_ocean_interstitial | surface roughness length over ocean (temporary use as interstitial) | cm | 1 | real | kind_phys | in | F | +!! | zorl_lnd | surface_roughness_length_over_land_interstitial | surface roughness length over land (temporary use as interstitial) | cm | 1 | real | kind_phys | in | F | +!! | zorl_ice | surface_roughness_length_over_ice_interstitial | surface roughness length over ice (temporary use as interstitial) | cm | 1 | real | kind_phys | in | F | +!! | cd | surface_drag_coefficient_for_momentum_in_air | surface exchange coeff for momentum | none | 1 | real | kind_phys | inout | F | +!! | cd_ocn | surface_drag_coefficient_for_momentum_in_air_over_ocean | surface exchange coeff for momentum over ocean | none | 1 | real | kind_phys | in | F | +!! | cd_lnd | surface_drag_coefficient_for_momentum_in_air_over_land | surface exchange coeff for momentum over land | none | 1 | real | kind_phys | in | F | +!! | cd_ice | surface_drag_coefficient_for_momentum_in_air_over_ice | surface exchange coeff for momentum over ice | none | 1 | real | kind_phys | in | F | +!! | cdq | surface_drag_coefficient_for_heat_and_moisture_in_air | surface exchange coeff heat & moisture | none | 1 | real | kind_phys | inout | F | +!! | cdq_ocn | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean | surface exchange coeff heat & moisture over ocean | none | 1 | real | kind_phys | in | F | +!! | cdq_lnd | surface_drag_coefficient_for_heat_and_moisture_in_air_over_land | surface exchange coeff heat & moisture over land | none | 1 | real | kind_phys | in | F | +!! | cdq_ice | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice | surface exchange coeff heat & moisture over ice | none | 1 | real | kind_phys | in | F | +!! | rb | bulk_richardson_number_at_lowest_model_level | bulk Richardson number at the surface | none | 1 | real | kind_phys | inout | F | +!! | rb_ocn | bulk_richardson_number_at_lowest_model_level_over_ocean | bulk Richardson number at the surface over ocean | none | 1 | real | kind_phys | in | F | +!! | rb_lnd | bulk_richardson_number_at_lowest_model_level_over_land | bulk Richardson number at the surface over land | none | 1 | real | kind_phys | in | F | +!! | rb_ice | bulk_richardson_number_at_lowest_model_level_over_ice | bulk Richardson number at the surface over ice | none | 1 | real | kind_phys | in | F | +!! | stress | surface_wind_stress | surface wind stress | m2 s-2 | 1 | real | kind_phys | inout | F | +!! | stress_ocn | surface_wind_stress_over_ocean | surface wind stress over ocean | m2 s-2 | 1 | real | kind_phys | in | F | +!! | stress_lnd | surface_wind_stress_over_land | surface wind stress over land | m2 s-2 | 1 | real | kind_phys | in | F | +!! | stress_ice | surface_wind_stress_over_ice | surface wind stress over ice | m2 s-2 | 1 | real | kind_phys | in | F | +!! | ffmm | Monin-Obukhov_similarity_function_for_momentum | Monin-Obukhov similarity function for momentum | none | 1 | real | kind_phys | inout | F | +!! | ffmm_ocn | Monin-Obukhov_similarity_function_for_momentum_over_ocean | Monin-Obukhov similarity function for momentum over ocean | none | 1 | real | kind_phys | in | F | +!! | ffmm_lnd | Monin-Obukhov_similarity_function_for_momentum_over_land | Monin-Obukhov similarity function for momentum over land | none | 1 | real | kind_phys | in | F | +!! | ffmm_ice | Monin-Obukhov_similarity_function_for_momentum_over_ice | Monin-Obukhov similarity function for momentum over ice | none | 1 | real | kind_phys | in | F | +!! | ffhh | Monin-Obukhov_similarity_function_for_heat | Monin-Obukhov similarity function for heat | none | 1 | real | kind_phys | inout | F | +!! | ffhh_ocn | Monin-Obukhov_similarity_function_for_heat_over_ocean | Monin-Obukhov similarity function for heat over ocean | none | 1 | real | kind_phys | in | F | +!! | ffhh_lnd | Monin-Obukhov_similarity_function_for_heat_over_land | Monin-Obukhov similarity function for heat over land | none | 1 | real | kind_phys | in | F | +!! | ffhh_ice | Monin-Obukhov_similarity_function_for_heat_over_ice | Monin-Obukhov similarity function for heat over ice | none | 1 | real | kind_phys | in | F | +!! | uustar | surface_friction_velocity | boundary layer parameter | m s-1 | 1 | real | kind_phys | inout | F | +!! | uustar_ocn | surface_friction_velocity_over_ocean | surface friction velocity over ocean | m s-1 | 1 | real | kind_phys | in | F | +!! | uustar_lnd | surface_friction_velocity_over_land | surface friction velocity over land | m s-1 | 1 | real | kind_phys | in | F | +!! | uustar_ice | surface_friction_velocity_over_ice | surface friction velocity over ice | m s-1 | 1 | real | kind_phys | in | F | +!! | fm10 | Monin-Obukhov_similarity_function_for_momentum_at_10m | Monin-Obukhov similarity parameter for momentum at 10m | none | 1 | real | kind_phys | inout | F | +!! | fm10_ocn | Monin-Obukhov_similarity_function_for_momentum_at_10m_over_ocean | Monin-Obukhov similarity parameter for momentum at 10m over ocean | none | 1 | real | kind_phys | in | F | +!! | fm10_lnd | Monin-Obukhov_similarity_function_for_momentum_at_10m_over_land | Monin-Obukhov similarity parameter for momentum at 10m over land | none | 1 | real | kind_phys | in | F | +!! | fm10_ice | Monin-Obukhov_similarity_function_for_momentum_at_10m_over_ice | Monin-Obukhov similarity parameter for momentum at 10m over ice | none | 1 | real | kind_phys | in | F | +!! | fh2 | Monin-Obukhov_similarity_function_for_heat_at_2m | Monin-Obukhov similarity parameter for heat at 2m | none | 1 | real | kind_phys | inout | F | +!! | fh2_ocn | Monin-Obukhov_similarity_function_for_heat_at_2m_over_ocean | Monin-Obukhov similarity parameter for heat at 2m over ocean | none | 1 | real | kind_phys | in | F | +!! | fh2_lnd | Monin-Obukhov_similarity_function_for_heat_at_2m_over_land | Monin-Obukhov similarity parameter for heat at 2m over land | none | 1 | real | kind_phys | in | F | +!! | fh2_ice | Monin-Obukhov_similarity_function_for_heat_at_2m_over_ice | Monin-Obukhov similarity parameter for heat at 2m over ice | none | 1 | real | kind_phys | in | F | +!! | tsurf | surface_skin_temperature_after_iteration | surface skin temperature after iteration | K | 1 | real | kind_phys | inout | F | +!! | tsurf_ocn | surface_skin_temperature_after_iteration_over_ocean | surface skin temperature after iteration over ocean | K | 1 | real | kind_phys | in | F | +!! | tsurf_lnd | surface_skin_temperature_after_iteration_over_land | surface skin temperature after iteration over land | K | 1 | real | kind_phys | in | F | +!! | tsurf_ice | surface_skin_temperature_after_iteration_over_ice | surface skin temperature after iteration over ice | K | 1 | real | kind_phys | in | F | +!! | cmm | surface_drag_wind_speed_for_momentum_in_air | momentum exchange coefficient | m s-1 | 1 | real | kind_phys | inout | F | +!! | cmm_ocn | surface_drag_wind_speed_for_momentum_in_air_over_ocean | momentum exchange coefficient over ocean | m s-1 | 1 | real | kind_phys | in | F | +!! | cmm_lnd | surface_drag_wind_speed_for_momentum_in_air_over_land | momentum exchange coefficient over land | m s-1 | 1 | real | kind_phys | in | F | +!! | cmm_ice | surface_drag_wind_speed_for_momentum_in_air_over_ice | momentum exchange coefficient over ice | m s-1 | 1 | real | kind_phys | in | F | +!! | chh | surface_drag_mass_flux_for_heat_and_moisture_in_air | thermal exchange coefficient | kg m-2 s-1 | 1 | real | kind_phys | inout | F | +!! | chh_ocn | surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ocean | thermal exchange coefficient over ocean | kg m-2 s-1 | 1 | real | kind_phys | in | F | +!! | chh_lnd | surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land | thermal exchange coefficient over land | kg m-2 s-1 | 1 | real | kind_phys | in | F | +!! | chh_ice | surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice | thermal exchange coefficient over ice | kg m-2 s-1 | 1 | real | kind_phys | in | F | +!! | gflx | upward_heat_flux_in_soil | soil heat flux | W m-2 | 1 | real | kind_phys | inout | F | +!! | gflx_ocn | upward_heat_flux_in_soil_over_ocean | soil heat flux over ocean | W m-2 | 1 | real | kind_phys | in | F | +!! | gflx_lnd | upward_heat_flux_in_soil_over_land | soil heat flux over land | W m-2 | 1 | real | kind_phys | in | F | +!! | gflx_ice | upward_heat_flux_in_soil_over_ice | soil heat flux over ice | W m-2 | 1 | real | kind_phys | in | F | +!! | ep1d | surface_upward_potential_latent_heat_flux | surface upward potential latent heat flux | W m-2 | 1 | real | kind_phys | inout | F | +!! | ep1d_ocn | surface_upward_potential_latent_heat_flux_over_ocean | surface upward potential latent heat flux over ocean | W m-2 | 1 | real | kind_phys | in | F | +!! | ep1d_lnd | surface_upward_potential_latent_heat_flux_over_land | surface upward potential latent heat flux over land | W m-2 | 1 | real | kind_phys | in | F | +!! | ep1d_ice | surface_upward_potential_latent_heat_flux_over_ice | surface upward potential latent heat flux over ice | W m-2 | 1 | real | kind_phys | in | F | +!! | weasd | water_equivalent_accumulated_snow_depth | water equiv of acc snow depth over land and sea ice | mm | 1 | real | kind_phys | inout | F | +!! | weasd_lnd | water_equivalent_accumulated_snow_depth_over_land | water equiv of acc snow depth over land | mm | 1 | real | kind_phys | in | F | +!! | weasd_ice | water_equivalent_accumulated_snow_depth_over_ice | water equiv of acc snow depth over ice | mm | 1 | real | kind_phys | in | F | +!! | snowd | surface_snow_thickness_water_equivalent | water equivalent snow depth | mm | 1 | real | kind_phys | inout | F | +!! | snowd_ocn | surface_snow_thickness_water_equivalent_over_ocean | water equivalent snow depth over ocean | mm | 1 | real | kind_phys | in | F | +!! | snowd_lnd | surface_snow_thickness_water_equivalent_over_land | water equivalent snow depth over land | mm | 1 | real | kind_phys | in | F | +!! | snowd_ice | surface_snow_thickness_water_equivalent_over_ice | water equivalent snow depth over ice | mm | 1 | real | kind_phys | in | F | +!! | tprcp | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep | total precipitation amount in each time step | m | 1 | real | kind_phys | inout | F | +!! | tprcp_ocn | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ocean | total precipitation amount in each time step over ocean | m | 1 | real | kind_phys | in | F | +!! | tprcp_lnd | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land | total precipitation amount in each time step over land | m | 1 | real | kind_phys | in | F | +!! | tprcp_ice | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice | total precipitation amount in each time step over ice | m | 1 | real | kind_phys | in | F | +!! | evap | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | inout | F | +!! | evap_ocn | kinematic_surface_upward_latent_heat_flux_over_ocean | kinematic surface upward latent heat flux over ocean | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | +!! | evap_lnd | kinematic_surface_upward_latent_heat_flux_over_land | kinematic surface upward latent heat flux over land | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | +!! | evap_ice | kinematic_surface_upward_latent_heat_flux_over_ice | kinematic surface upward latent heat flux over ice | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | +!! | hflx | kinematic_surface_upward_sensible_heat_flux | kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | inout | F | +!! | hflx_ocn | kinematic_surface_upward_sensible_heat_flux_over_ocean | kinematic surface upward sensible heat flux over ocean | K m s-1 | 1 | real | kind_phys | in | F | +!! | hflx_lnd | kinematic_surface_upward_sensible_heat_flux_over_land | kinematic surface upward sensible heat flux over land | K m s-1 | 1 | real | kind_phys | in | F | +!! | hflx_ice | kinematic_surface_upward_sensible_heat_flux_over_ice | kinematic surface upward sensible heat flux over ice | K m s-1 | 1 | real | kind_phys | in | F | +!! | qss | surface_specific_humidity | surface air saturation specific humidity | kg kg-1 | 1 | real | kind_phys | inout | F | +!! | qss_ocn | surface_specific_humidity_over_ocean | surface air saturation specific humidity over ocean | kg kg-1 | 1 | real | kind_phys | in | F | +!! | qss_lnd | surface_specific_humidity_over_land | surface air saturation specific humidity over land | kg kg-1 | 1 | real | kind_phys | in | F | +!! | qss_ice | surface_specific_humidity_over_ice | surface air saturation specific humidity over ice | kg kg-1 | 1 | real | kind_phys | in | F | +!! | tsfc | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | inout | F | +!! | tsfco | sea_surface_temperature | sea surface temperature | K | 1 | real | kind_phys | inout | F | +!! | tsfcl | surface_skin_temperature_over_land | surface skin temperature over land | K | 1 | real | kind_phys | inout | F | +!! | tsfc_ocn | surface_skin_temperature_over_ocean_interstitial | surface skin temperature over ocean (temporary use as interstitial) | K | 1 | real | kind_phys | in | F | +!! | tsfc_lnd | surface_skin_temperature_over_land_interstitial | surface skin temperature over land (temporary use as interstitial) | K | 1 | real | kind_phys | in | F | +!! | tsfc_ice | surface_skin_temperature_over_ice_interstitial | surface skin temperature over ice (temporary use as interstitial) | K | 1 | real | kind_phys | in | F | +!! | tisfc | sea_ice_temperature | sea ice surface skin temperature | K | 1 | real | kind_phys | inout | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! +#endif + subroutine GFS_surface_composites_post_run ( & + im, cplflx, flag_cice, dry, wet, icy, lndfrac, lakfrac, ocnfrac, cice, zorl, zorlo, zorll, zorl_ocn, zorl_lnd, zorl_ice, & + cd, cd_ocn, cd_lnd, cd_ice, cdq, cdq_ocn, cdq_lnd, cdq_ice, rb, rb_ocn, rb_lnd, rb_ice, stress, stress_ocn, stress_lnd, & + stress_ice, ffmm, ffmm_ocn, ffmm_lnd, ffmm_ice, ffhh, ffhh_ocn, ffhh_lnd, ffhh_ice, uustar, uustar_ocn, uustar_lnd, & + uustar_ice, fm10, fm10_ocn, fm10_lnd, fm10_ice, fh2, fh2_ocn, fh2_lnd, fh2_ice, tsurf, tsurf_ocn, tsurf_lnd, tsurf_ice, & + cmm, cmm_ocn, cmm_lnd, cmm_ice, chh, chh_ocn, chh_lnd, chh_ice, gflx, gflx_ocn, gflx_lnd, gflx_ice, ep1d, ep1d_ocn, & + ep1d_lnd, ep1d_ice, weasd, weasd_lnd, weasd_ice, snowd, snowd_ocn, snowd_lnd, snowd_ice, tprcp, tprcp_ocn, tprcp_lnd, & + tprcp_ice, evap, evap_ocn, evap_lnd, evap_ice, hflx, hflx_ocn, hflx_lnd, hflx_ice, qss, qss_ocn, qss_lnd, qss_ice, & + tsfc, tsfco, tsfcl, tsfc_ocn, tsfc_lnd, tsfc_ice, tisfc, errmsg, errflg) + + use machine, only: kind_phys + + implicit none + + integer, intent(in) :: im + logical, intent(in) :: cplflx + logical, dimension(im), intent(in) :: flag_cice, dry, wet, icy + + real(kind=kind_phys), dimension(im), intent(in) :: lndfrac, lakfrac, ocnfrac, cice, & + zorl_ocn, zorl_lnd, zorl_ice, cd_ocn, cd_lnd, cd_ice, cdq_ocn, cdq_lnd, cdq_ice, rb_ocn, rb_lnd, rb_ice, stress_ocn, & + stress_lnd, stress_ice, ffmm_ocn, ffmm_lnd, ffmm_ice, ffhh_ocn, ffhh_lnd, ffhh_ice, uustar_ocn, uustar_lnd, uustar_ice, & + fm10_ocn, fm10_lnd, fm10_ice, fh2_ocn, fh2_lnd, fh2_ice, tsurf_ocn, tsurf_lnd, tsurf_ice, cmm_ocn, cmm_lnd, cmm_ice, & + chh_ocn, chh_lnd, chh_ice, gflx_ocn, gflx_lnd, gflx_ice, ep1d_ocn, ep1d_lnd, ep1d_ice, weasd_lnd, weasd_ice, snowd_ocn, & + snowd_lnd, snowd_ice,tprcp_ocn, tprcp_lnd, tprcp_ice, evap_ocn, evap_lnd, evap_ice, hflx_ocn, hflx_lnd, hflx_ice, & + qss_ocn, qss_lnd, qss_ice, tsfc_ocn, tsfc_lnd, tsfc_ice + + real(kind=kind_phys), dimension(im), intent(inout) :: zorl, zorlo, zorll, cd, cdq, rb, stress, ffmm, ffhh, uustar, fm10, & + fh2, tsurf, cmm, chh, gflx, ep1d, weasd, snowd, tprcp, evap, hflx, qss, tsfc, tsfco, tsfcl, tisfc + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: i + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! --- generate ocean/land/ice composites + + ! DH* + !write(0,*) "DH DEBUG composites: i, cplflx, flag_cice, dry, wet, icy, ocnfrac, lndfrac, lakfrac, cice, tsfc_{lnd,ocn,ice}, tsfc, tsfcl, tsfco, tisfc" + ! *DH + + do i=1, im + + ! --- three-way composites (fields from sfc_diff) + zorl(i) = cmposit3(ocnfrac(i), lndfrac(i), & + lakfrac(i),cice(i), & + zorl_ocn(i), zorl_lnd(i), zorl_ice(i)) + cd(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + cd_ocn(i), cd_lnd(i), cd_ice(i)) + cdq(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + cdq_ocn(i), cdq_lnd(i), cdq_ice(i)) + rb(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + rb_ocn(i), rb_lnd(i), rb_ice(i)) + stress(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + stress_ocn(i),stress_lnd(i),stress_ice(i)) + ffmm(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + ffmm_ocn(i), ffmm_lnd(i), ffmm_ice(i)) + ffhh(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + ffhh_ocn(i), ffhh_lnd(i), ffhh_ice(i)) + uustar(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + uustar_ocn(i),uustar_lnd(i),uustar_ice(i)) + fm10(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + fm10_ocn(i), fm10_lnd(i), fm10_ice(i)) + fh2(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + fh2_ocn(i), fh2_lnd(i), fh2_ice(i)) + tsurf(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + tsurf_ocn(i), tsurf_lnd(i), tsurf_ice(i)) + cmm(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + cmm_ocn(i), cmm_lnd(i), cmm_ice(i)) + chh(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + chh_ocn(i), chh_lnd(i), chh_ice(i)) + gflx(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + gflx_ocn(i), gflx_lnd(i), gflx_ice(i)) + ep1d(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + ep1d_ocn(i), ep1d_lnd(i), ep1d_ice(i)) + weasd(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + weasd(i), weasd_lnd(i), weasd_ice(i)) + snowd(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + snowd_ocn(i), snowd_lnd(i), snowd_ice(i)) + tprcp(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + tprcp_ocn(i), tprcp_lnd(i), tprcp_ice(i)) + + if(cplflx .and. flag_cice(i)) then ! 3-way when sfc_cice is used + evap(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + evap_ocn(i), evap_lnd(i), evap_ice(i)) + hflx(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + hflx_ocn(i), hflx_lnd(i), hflx_ice(i)) + qss(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + qss_ocn(i), qss_lnd(i), qss_ice(i)) + tsfc(i) = cmposit3(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + tsfc_ocn(i), tsfc_lnd(i), tsfc_ice(i)) + else ! 2-way when sfc_sice used (fields already composited in sfc_sice) + evap(i) = cmposit2(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + evap_ocn(i), evap_lnd(i), evap_ice(i)) + hflx(i) = cmposit2(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + hflx_ocn(i), hflx_lnd(i), hflx_ice(i)) + qss(i) = cmposit2(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + qss_ocn(i), qss_lnd(i), qss_ice(i)) + tsfc(i) = cmposit2(ocnfrac(i),lndfrac(i), & + lakfrac(i),cice(i), & + tsfc_ocn(i), tsfc_lnd(i), tsfc_ice(i)) + if(icy(i)) then + cmm(i) = cmm_ice(i) + chh(i) = chh_ice(i) + gflx(i) = gflx_ice(i) + ep1d(i) = ep1d_ice(i) + weasd(i) = weasd_ice(i) + snowd(i) = snowd_ice(i) + end if + endif ! cplflx .and. flag_cice + + zorll(i) = zorl_lnd(i) + zorlo(i) = zorl_ocn(i) + + if (dry(i)) tsfcl(i) = tsfc_lnd(i) + if (wet(i)) then + tsfco(i) = tsfc_ocn(i) + tisfc(i) = tsfc_ice(i) + end if + + ! DH* + !write(0,'(i5,5(1x,l),11e16.7)') i, cplflx, flag_cice(i), dry(i), wet(i), icy(i), & + ! ocnfrac(i), lndfrac(i), lakfrac(i), & + ! cice(i), tsfc_lnd(i), tsfc_ocn(i), tsfc_ice(i), & + ! tsfc(i), tsfcl(i), tsfco(i), tisfc(i) + ! *DH + + end do + + ! --- compositing done + + end subroutine GFS_surface_composites_post_run + + + real function cmposit2(frac_ocean,frac_dry,frac_lake,frac_ice,oceanval,landval,iceval) +! --- 2-way compositing (use with ice/non-ice composited variables) + implicit none + real(kind=kind_phys),intent(IN) :: frac_ocean,frac_dry,frac_lake,frac_ice,oceanval,landval,iceval + real(kind=kind_phys) :: frac_wet + + frac_wet=max(frac_lake,frac_ocean) + if (frac_ice.eq.0.) then + cmposit2 = frac_dry*landval + frac_wet*oceanval + else + cmposit2 = frac_dry*landval + frac_wet*iceval + end if + return + end function cmposit2 + + + real function cmposit3(frac_ocean,frac_dry,frac_lake,frac_ice,oceanval,landval,iceval) +! --- 3-way compositing + implicit none + real(kind=kind_phys),intent(IN) :: frac_ocean,frac_dry,frac_lake,frac_ice,oceanval,landval,iceval + + if (frac_dry == 0.0 .and. iceval == oceanval) then + cmposit3 = oceanval + else + cmposit3 = frac_dry*landval + frac_ice*iceval + (1.-frac_dry-frac_ice)*oceanval + endif + + return + end function cmposit3 + +end module GFS_surface_composites_post diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index d20cb9a95..42fe8c646 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -3,6 +3,10 @@ module GFS_surface_generic_pre + private + + public GFS_surface_generic_pre_init, GFS_surface_generic_pre_finalize, GFS_surface_generic_pre_run + contains subroutine GFS_surface_generic_pre_init () @@ -217,8 +221,13 @@ end subroutine GFS_surface_generic_pre_run end module GFS_surface_generic_pre + module GFS_surface_generic_post + private + + public GFS_surface_generic_post_init, GFS_surface_generic_post_finalize, GFS_surface_generic_post_run + contains subroutine GFS_surface_generic_post_init () @@ -234,7 +243,7 @@ end subroutine GFS_surface_generic_post_finalize !! | cplflx | flag_for_flux_coupling | flag controlling cplflx collection (default off) | flag | 0 | logical | | in | F | !! | cplwav | flag_for_wave_coupling | flag controlling cplwav collection (default off) | flag | 0 | logical | | in | F | !! | lssav | flag_diagnostics | logical flag for storing diagnostics | flag | 0 | logical | | in | F | -!! | islmsk | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | +!! | lndfrac | land_area_fraction | fraction of horizontal grid area occupied by land | frac | 1 | real | kind_phys | in | F | !! | dtf | time_step_for_dynamics | dynamics timestep | s | 0 | real | kind_phys | in | F | !! | ep1d | surface_upward_potential_latent_heat_flux | surface upward potential latent heat flux | W m-2 | 1 | real | kind_phys | in | F | !! | gflx | upward_heat_flux_in_soil | upward soil heat flux | W m-2 | 1 | real | kind_phys | in | F | @@ -318,7 +327,7 @@ end subroutine GFS_surface_generic_post_finalize !! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! #endif - subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, islmsk, dtf, ep1d, gflx, tgrs_1, qgrs_1, ugrs_1, vgrs_1, & + subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, lndfrac, dtf, ep1d, gflx, tgrs_1, qgrs_1, ugrs_1, vgrs_1, & adjsfcdlw, adjsfcdsw, adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd, adjsfculw, adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & t2m, q2m, u10m, v10m, tsfc, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf, & epi, gfluxi, t1, q1, u1, v1, dlwsfci_cpl, dswsfci_cpl, dlwsfc_cpl, dswsfc_cpl, dnirbmi_cpl, dnirdfi_cpl, dvisbmi_cpl, & @@ -333,7 +342,7 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, islmsk, dtf, integer, intent(in) :: im logical, intent(in) :: cplflx, cplwav, lssav - integer, dimension(im), intent(in) :: islmsk + real(kind=kind_phys), dimension(im), intent(in) :: lndfrac real(kind=kind_phys), intent(in) :: dtf @@ -404,7 +413,7 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, islmsk, dtf, ! them to net SW heat fluxes do i=1,im - if (islmsk(i) /= 1) then ! not a land point + if(lndfrac(i) < 1.) then ! Not 100% land ! --- compute open water albedo xcosz_loc = max( 0.0, min( 1.0, xcosz(i) )) ocalnirdf_cpl = 0.06 diff --git a/physics/GFS_surface_loop_control.F90 b/physics/GFS_surface_loop_control.F90 index d1a2c1ede..49de8fdab 100644 --- a/physics/GFS_surface_loop_control.F90 +++ b/physics/GFS_surface_loop_control.F90 @@ -80,17 +80,19 @@ end subroutine GFS_surface_loop_control_part2_finalize !! #if 0 !! \section arg_table_GFS_surface_loop_control_part2_run Arguments -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|--------------------------------------------|------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | iter | ccpp_loop_counter | loop counter for subcycling loops in CCPP | index | 0 | integer | | in | F | -!! | wind | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | -!! | flag_guess | flag_for_guess_run | flag for guess run | flag | 1 | logical | | inout | F | -!! | flag_iter | flag_for_iteration | flag for iteration | flag | 1 | logical | | inout | F | -!! | islmsk | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | -!! | nstf_name1 | flag_for_nsstm_run | NSSTM flag: off/uncoupled/coupled=0/1/2 | flag | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|----------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| +!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | +!! | iter | ccpp_loop_counter | loop counter for subcycling loops in CCPP | index | 0 | integer | | in | F | +!! | wind | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | +!! | flag_guess | flag_for_guess_run | flag for guess run | flag | 1 | logical | | inout | F | +!! | flag_iter | flag_for_iteration | flag for iteration | flag | 1 | logical | | inout | F | +!! | dry | flag_nonzero_land_surface_fraction | flag indicating presence of some land surface area fraction | flag | 1 | logical | | in | F | +!! | wet | flag_nonzero_wet_surface_fraction | flag indicating presence of some ocean or lake surface area fraction | flag | 1 | logical | | in | F | +!! | icy | flag_nonzero_sea_ice_surface_fraction | flag indicating presence of some sea ice surface area fraction | flag | 1 | logical | | in | F | +!! | nstf_name1 | flag_for_nsstm_run | NSSTM flag: off/uncoupled/coupled=0/1/2 | flag | 0 | integer | | in | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! #endif !! \section general General Algorithm @@ -98,7 +100,7 @@ end subroutine GFS_surface_loop_control_part2_finalize !! @{ subroutine GFS_surface_loop_control_part2_run (im, iter, wind, & - flag_guess, flag_iter, islmsk, nstf_name1, errmsg, errflg) + flag_guess, flag_iter, dry, wet, icy, nstf_name1, errmsg, errflg) use machine, only: kind_phys @@ -110,7 +112,7 @@ subroutine GFS_surface_loop_control_part2_run (im, iter, wind, & real(kind=kind_phys), dimension(im), intent(in) :: wind logical, dimension(im), intent(inout) :: flag_guess logical, dimension(im), intent(inout) :: flag_iter - integer, dimension(im), intent(in) :: islmsk + logical, dimension(im), intent(in) :: dry, wet, icy integer, intent(in) :: nstf_name1 character(len=*), intent(out) :: errmsg @@ -128,7 +130,7 @@ subroutine GFS_surface_loop_control_part2_run (im, iter, wind, & flag_guess(i) = .false. if (iter == 1 .and. wind(i) < 2.0) then - if ( islmsk(i) == 1 .or. (islmsk(i) == 0 .and. nstf_name1 > 0) ) then + if (dry(i) .or. (wet(i) .and. .not.icy(i) .and. nstf_name1 > 0)) then flag_iter(i) = .true. endif endif diff --git a/physics/gfdl_cloud_microphys.F90 b/physics/gfdl_cloud_microphys.F90 index 5debde890..584f980ad 100644 --- a/physics/gfdl_cloud_microphys.F90 +++ b/physics/gfdl_cloud_microphys.F90 @@ -56,7 +56,7 @@ subroutine gfdl_cloud_microphys_init (me, master, nlunit, input_nml_file, loguni logical, intent( in) :: do_shoc character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -133,7 +133,7 @@ end subroutine gfdl_cloud_microphys_finalize !! | con_g | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | !! | con_fvirt | ratio_of_vapor_to_dry_air_gas_constants_minus_one | rv/rd - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | !! | con_rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | -!! | frland | land_area_fraction | land area fraction | frac | 1 | real | kind_phys | in | F | +!! | frland | land_area_fraction_for_microphysics | land area fraction used in microphysics schemes | frac | 1 | real | kind_phys | in | F | !! | garea | cell_area | area of grid cell | m2 | 1 | real | kind_phys | in | F | !! | gq0 | water_vapor_specific_humidity_updated_by_physics | water vapor specific humidity updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F | !! | gq0_ntcw | cloud_condensed_water_mixing_ratio_updated_by_physics | cloud condensed water mixing ratio updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F | @@ -168,7 +168,7 @@ end subroutine gfdl_cloud_microphys_finalize !! | rer | effective_radius_of_stratiform_cloud_rain_particle_in_um | effective radius of cloud rain particle in micrometers | um | 2 | real | kind_phys | inout | F | !! | res | effective_radius_of_stratiform_cloud_snow_particle_in_um | effective radius of cloud snow particle in micrometers | um | 2 | real | kind_phys | inout | F | !! | reg | effective_radius_of_stratiform_cloud_graupel_particle_in_um | eff. radius of cloud graupel particle in micrometer | um | 2 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | !! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! subroutine gfdl_cloud_microphys_run( & diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 6181d089d..10f35955e 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -157,7 +157,7 @@ end subroutine m_micro_finalize !! | swheat_i | tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep | total sky sw heating rate | K s-1 | 2 | real | kind_phys | in | F | !! | w_upi | vertical_velocity_for_updraft | vertical velocity for updraft | m s-1 | 2 | real | kind_phys | in | F | !! | cf_upi | convective_cloud_fraction_for_microphysics | convective cloud fraction for microphysics | frac | 2 | real | kind_phys | in | F | -!! | frland | land_area_fraction | land area fraction | frac | 1 | real | kind_phys | in | F | +!! | frland | land_area_fraction_for_microphysics | land area fraction used in microphysics schemes | frac | 1 | real | kind_phys | in | F | !! | zpbl | atmosphere_boundary_layer_thickness | pbl height | m | 1 | real | kind_phys | in | F | !! | cnv_mfd_i | detrained_mass_flux | detrained mass flux | kg m-2 s-1 | 2 | real | kind_phys | in | F | !! | cnv_dqldt_i | tendency_of_cloud_water_due_to_convective_microphysics | tendency of cloud water due to convective microphysics | kg m-2 s-1 | 2 | real | kind_phys | in | F | @@ -1103,7 +1103,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! & REV_CN_X(im,lm), RSU_CN_X(im,lm), DLPDF_X(im,lm), & ! & DIPDF_X(im,lm), ALPHT_X(im,lm), PFRZ(im,lm), & & ALPHT_X(im,lm), PFRZ(im,lm)) -! & ACLL_CN_X(im,lm), ACIL_CN_X(im,lm), DQRL_X(im,lm) +! & ACLL_CN_X(im,lm), ACIL_CN_X(im,lm), DQRL_X(im,lm) ! & ACLL_CN_X(im,lm), ACIL_CN_X(im,lm), DQRL_X(im,lm), & ! & DZET(im,lm)) ! & DZET(im,lm), qst3(im,lm)) diff --git a/physics/module_nst_water_prop.f90 b/physics/module_nst_water_prop.f90 index 5b322e6cf..e5e79deaf 100644 --- a/physics/module_nst_water_prop.f90 +++ b/physics/module_nst_water_prop.f90 @@ -12,7 +12,7 @@ module module_nst_water_prop private public :: rhocoef,density,sw_rad,sw_rad_aw,sw_rad_sum,sw_rad_upper,sw_rad_upper_aw,sw_rad_skin,grv,solar_time_from_julian,compjd, & sw_ps_9b,sw_ps_9b_aw,get_dtzm_point,get_dtzm_2d - + ! interface sw_ps_9b module procedure sw_ps_9b @@ -43,34 +43,34 @@ module module_nst_water_prop ! ------------------------------------------------------ !>\ingroup waterprop !> This subroutine computes thermal expansion coefficient (alpha) -!! and saline contraction coefficient (beta). +!! and saline contraction coefficient (beta). subroutine rhocoef(t, s, rhoref, alpha, beta) ! ------------------------------------------------------ - ! compute thermal expansion coefficient (alpha) - ! and saline contraction coefficient (beta) using - ! the international equation of state of sea water - ! (1980). ref: pond and pickard, introduction to - ! dynamical oceanography, pp310. + ! compute thermal expansion coefficient (alpha) + ! and saline contraction coefficient (beta) using + ! the international equation of state of sea water + ! (1980). ref: pond and pickard, introduction to + ! dynamical oceanography, pp310. ! note: compression effects are not included implicit none - real(kind=kind_phys), intent(in) :: t, s, rhoref - real(kind=kind_phys), intent(out) :: alpha, beta + real(kind=kind_phys), intent(in) :: t, s, rhoref + real(kind=kind_phys), intent(out) :: alpha, beta real(kind=kind_phys) :: tc tc = t - t0k - alpha = & - 6.793952e-2 & - - 2.0 * 9.095290e-3 * tc + 3.0 * 1.001685e-4 * tc**2 & - - 4.0 * 1.120083e-6 * tc**3 + 5.0 * 6.536332e-9 * tc**4 & - - 4.0899e-3 * s & - + 2.0 * 7.6438e-5 * tc * s - 3.0 * 8.2467e-7 * tc**2 * s & - + 4.0 * 5.3875e-9 * tc**3 * s & + alpha = & + 6.793952e-2 & + - 2.0 * 9.095290e-3 * tc + 3.0 * 1.001685e-4 * tc**2 & + - 4.0 * 1.120083e-6 * tc**3 + 5.0 * 6.536332e-9 * tc**4 & + - 4.0899e-3 * s & + + 2.0 * 7.6438e-5 * tc * s - 3.0 * 8.2467e-7 * tc**2 * s & + + 4.0 * 5.3875e-9 * tc**3 * s & + 1.0227e-4 * s**1.5 - 2.0 * 1.6546e-6 * tc * s**1.5 - ! note: rhoref - specify + ! note: rhoref - specify ! alpha = -alpha/rhoref @@ -96,13 +96,13 @@ subroutine density(t, s, rho) real(kind=kind_phys), intent(in) :: t !unit, k real(kind=kind_phys), intent(in) :: s !unit, 1/1000 ! output - real(kind=kind_phys), intent(out) :: rho !unit, kg/m^3 + real(kind=kind_phys), intent(out) :: rho !unit, kg/m^3 ! local real(kind=kind_phys) :: tc - ! compute density using the international equation - ! of state of sea water 1980, (pond and pickard, - ! introduction to dynamical oceanography, pp310). + ! compute density using the international equation + ! of state of sea water 1980, (pond and pickard, + ! introduction to dynamical oceanography, pp310). ! compression effects are not included rho = 0.0 @@ -125,11 +125,11 @@ end subroutine density !====================== ! !>\ingroup waterprop -!> This subroutine computes the fraction of the solar radiation absorbed +!> This subroutine computes the fraction of the solar radiation absorbed !! by the depth z following Paulson and Simpson (1981) \cite paulson_and_simpson_1981 . elemental subroutine sw_ps_9b(z,fxp) ! - ! fraction of the solar radiation absorbed by the ocean at the depth z + ! fraction of the solar radiation absorbed by the ocean at the depth z ! following paulson and simpson, 1981 ! ! input: @@ -162,7 +162,7 @@ end subroutine sw_ps_9b !>\ingroup waterprop elemental subroutine sw_ps_9b_aw(z,aw) ! - ! d(fw)/d(z) for 9-band + ! d(fw)/d(z) for 9-band ! ! input: ! z: depth (m) @@ -260,7 +260,7 @@ elemental subroutine sw_fairall_6exp_v1_aw(z,aw) end subroutine sw_fairall_6exp_v1_aw ! !>\ingroup waterprop -!! This subroutine computes fraction of the solar radiation absorbed by the ocean at the +!! This subroutine computes fraction of the solar radiation absorbed by the ocean at the !! depth z (Fairall et al.(1996) \cite fairall_et_al_1996 , p.1298) following Paulson and !! Simpson (1981) \cite paulson_and_simpson_1981 . !>\param[in] z depth (m) @@ -296,7 +296,7 @@ end subroutine sw_fairall_6exp_v1_sum ! !====================== !>\ingroup waterprop -!! Solar radiation absorbed by the ocean at the depth z (Fairall et al. (1996) +!! Solar radiation absorbed by the ocean at the depth z (Fairall et al. (1996) !! \cite fairall_et_al_1996, p.1298) !>\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) !>\param[in] z depth (m) @@ -304,8 +304,8 @@ end subroutine sw_fairall_6exp_v1_sum elemental subroutine sw_fairall_simple_v1(f_sol_0,z,df_sol_z) ! ! solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1298) - ! - ! input: + ! + ! input: ! f_sol_0: solar radiation at the ocean surface (w/m^2) ! z: depth (m) ! @@ -327,7 +327,7 @@ end subroutine sw_fairall_simple_v1 !====================== ! !>\ingroup waterprop -!! solar radiation absorbed by the ocean at the depth z (Zeng and Beljaars (2005) +!! solar radiation absorbed by the ocean at the depth z (Zeng and Beljaars (2005) !! \cite zeng_and_beljaars_2005 , p.5). !>\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) !>\param[in] z depth (m) @@ -335,8 +335,8 @@ end subroutine sw_fairall_simple_v1 elemental subroutine sw_wick_v1(f_sol_0,z,df_sol_z) ! ! solar radiation absorbed by the ocean at the depth z (zeng and beljaars, 2005, p.5) - ! - ! input: + ! + ! input: ! f_sol_0: solar radiation at the ocean surface (w/m^2) ! z: depth (m) ! @@ -359,7 +359,7 @@ end subroutine sw_wick_v1 ! !>\ingroup waterprop !! This subroutine computes solar radiation absorbed by the ocean at the depth z -!! (Fairall et al.(1996) \cite fairall_et_al_1996 , p.1301) following +!! (Fairall et al.(1996) \cite fairall_et_al_1996 , p.1301) following !! Soloviev and Vershinsky (1982) \cite soloviev_and_vershinsky_1982. !>\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) !>\param[in] z depth (m) @@ -368,8 +368,8 @@ elemental subroutine sw_soloviev_3exp_v1(f_sol_0,z,df_sol_z) ! ! solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1301) ! following soloviev, 1982 - ! - ! input: + ! + ! input: ! f_sol_0: solar radiation at the ocean surface (w/m^2) ! z: depth (m) ! @@ -399,8 +399,8 @@ elemental subroutine sw_soloviev_3exp_v2(f_sol_0,z,df_sol_z) ! ! solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1301) ! following soloviev, 1982 - ! - ! input: + ! + ! input: ! f_sol_0: solar radiation at the ocean surface (w/m^2) ! z: depth (m) ! @@ -414,7 +414,7 @@ elemental subroutine sw_soloviev_3exp_v2(f_sol_0,z,df_sol_z) if(z>0) then df_sol_z=f_sol_0*(1.0 & -(0.28*0.014*(1.-exp(-z/0.014)) & - +0.27*0.357*(1.-exp(-z/0.357)) & + +0.27*0.357*(1.-exp(-z/0.357)) & +.45*12.82*(1.-exp(-z/12.82)))/z & ) else @@ -489,7 +489,7 @@ function grv(lat) c3=0.0000001262 c4=0.0000000007 pi=3.141593 - + phi=lat*pi/180 x=sin(phi) grv=gamma*(1+(c1*x**2)+(c2*x**4)+(c3*x**6)+(c4*x**8)) @@ -544,7 +544,7 @@ subroutine compjd(jyr,jmnth,jday,jhr,jmn,jd,fjd) ! jmnth - month ! jday - day ! jhr - hour -! jmn - minutes +! jmn - minutes ! output argument list: ! jd - julian day. ! fjd - fraction of the julian day. @@ -572,7 +572,7 @@ subroutine compjd(jyr,jmnth,jday,jhr,jmn,jd,fjd) end subroutine compjd !>\ingroup waterprop -!>This subroutine computes dtm (the mean of \f$dT(z)\f$). +!>This subroutine computes dtm (the mean of \f$dT(z)\f$). subroutine get_dtzm_point(xt,xz,dt_cool,zc,z1,z2,dtm) ! ===================================================================== ! ! ! @@ -654,7 +654,7 @@ subroutine get_dtzm_point(xt,xz,dt_cool,zc,z1,z2,dtm) end subroutine get_dtzm_point !>\ingroup waterprop - subroutine get_dtzm_2d(xt,xz,dt_cool,zc,slmsk,z1,z2,nx,ny,dtm) + subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,icy,z1,z2,nx,ny,dtm) ! ===================================================================== ! ! ! ! description: get dtm = mean of dT(z) (z1 - z2) with NSST dT(z) ! @@ -662,7 +662,7 @@ subroutine get_dtzm_2d(xt,xz,dt_cool,zc,slmsk,z1,z2,nx,ny,dtm) ! ! ! usage: ! ! ! -! call get_dtzm_2d ! +! call get_dtzm_2d ! ! ! ! inputs: ! ! (xt,xz,dt_cool,zc,z1,z2, ! @@ -677,6 +677,8 @@ subroutine get_dtzm_2d(xt,xz,dt_cool,zc,slmsk,z1,z2,nx,ny,dtm) ! xz - real, dtl thickness 1 ! ! dt_cool - real, sub-layer cooling amount 1 ! ! zc - sub-layer cooling thickness 1 ! +! wet - logical, flag for wet point (ocean or lake) 1 ! +! icy - logical, flag for ice point (ocean or lake) 1 ! ! nx - integer, dimension in x-direction (zonal) 1 ! ! ny - integer, dimension in y-direction (meridional) 1 ! ! z1 - lower bound of depth of sea temperature 1 ! @@ -689,9 +691,10 @@ subroutine get_dtzm_2d(xt,xz,dt_cool,zc,slmsk,z1,z2,nx,ny,dtm) implicit none integer, intent(in) :: nx,ny - real (kind=kind_phys), dimension(nx,ny), intent(in) :: xt,xz,dt_cool,zc,slmsk + real (kind=kind_phys), dimension(nx,ny), intent(in) :: xt,xz,dt_cool,zc + logical, dimension(nx,ny), intent(in) :: wet,icy real (kind=kind_phys), intent(in) :: z1,z2 - real (kind=kind_phys), dimension(nx,ny), intent(out) :: dtm + real (kind=kind_phys), dimension(nx,ny), intent(out) :: dtm ! Local variables integer :: i,j real (kind=kind_phys), dimension(nx,ny) :: dtw,dtc @@ -704,9 +707,9 @@ subroutine get_dtzm_2d(xt,xz,dt_cool,zc,slmsk,z1,z2,nx,ny,dtm) ! ! initialize dtw & dtc as zeros ! - dtw(i,j) = 0.0 - dtc(i,j) = 0.0 - if ( slmsk(i,j) == 0.0 ) then + dtw(i,j) = 0.0 + dtc(i,j) = 0.0 + if ( wet(i,j) .and. .not.icy(i,j) ) then ! ! get the mean warming in the range of z=z1 to z=z2 ! @@ -740,16 +743,16 @@ subroutine get_dtzm_2d(xt,xz,dt_cool,zc,slmsk,z1,z2,nx,ny,dtm) endif endif endif - endif ! if ( slmsk(i,j) == 0 ) then + endif ! if ( wet(i,j) .and. .not.icy(i,j) ) then enddo - enddo + enddo ! ! get the mean T departure from Tf in the range of z=z1 to z=z2 !$omp parallel do private(j,i) do j = 1, ny do i= 1, nx - if ( slmsk(i,j) == 0.0 ) then + if ( wet(i,j) .and. .not.icy(i,j)) then dtm(i,j) = dtw(i,j) - dtc(i,j) endif enddo diff --git a/physics/physcons.F90 b/physics/physcons.F90 index 727192afc..8e9fcd056 100644 --- a/physics/physcons.F90 +++ b/physics/physcons.F90 @@ -112,7 +112,8 @@ module physcons real(kind=kind_phys),parameter:: con_amo2 =31.9999 !< molecular wght of o2 (\f$g/mol\f$) real(kind=kind_phys),parameter:: con_amch4 =16.043 !< molecular wght of ch4 (\f$g/mol\f$) real(kind=kind_phys),parameter:: con_amn2o =44.013 !< molecular wght of n2o (\f$g/mol\f$) - real(kind=kind_phys), parameter:: con_thgni =-38.15 !< temperature the H.G.Nuc. ice starts + real(kind=kind_phys),parameter:: con_thgni =-38.15 !< temperature the H.G.Nuc. ice starts + real(kind=kind_phys),parameter:: cimin =0.15 !< minimum ice concentration !> \name Miscellaneous physics related constants (For WSM6; Moorthi - Jul 2014) ! integer, parameter :: max_lon=16000, max_lat=8000, min_lon=192, min_lat=94 diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 3717a9eb2..42bcfcdc1 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -1,70 +1,114 @@ !> \file sfc_diff.f -!! This file contains the surface roughness length formulation based on -!! the surface sublayer scheme in -!! Zeng and Dickinson (1998) \cite zeng_and_dickinson_1998. +!! This file contains the surface roughness length formulation based on +!! the surface sublayer scheme in +!! Zeng and Dickinson (1998) \cite zeng_and_dickinson_1998. !> This module contains the CCPP-compliant GFS surface layer scheme. - module sfc_ex_coef + module sfc_diff + + use machine , only : kind_phys + + implicit none + + public :: sfc_diff_init, sfc_diff_run, sfc_diff_finalize + + private + + real (kind=kind_phys), parameter :: ca=.4 ! ca - von karman constant + contains - subroutine sfc_ex_coef_init - end subroutine sfc_ex_coef_init + subroutine sfc_diff_init + end subroutine sfc_diff_init - subroutine sfc_ex_coef_finalize - end subroutine sfc_ex_coef_finalize + subroutine sfc_diff_finalize + end subroutine sfc_diff_finalize !> \defgroup GFS_diff_main GFS sfc_diff Main !! @{ !> \brief This subroutine calculates surface roughness length. !! !! This subroutine includes the surface roughness length formulation -!! based on the surface sublayer scheme in +!! based on the surface sublayer scheme in !! Zeng and Dickinson (1998) \cite zeng_and_dickinson_1998. -!> \section arg_table_sfc_ex_coef_run Argument Table +!> \section arg_table_sfc_diff_run Argument Table !! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | !! |----------------|------------------------------------------------------------------------------|------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| !! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | +!! | rvrdm1 | ratio_of_vapor_to_dry_air_gas_constants_minus_one | (rv/rd) - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | +!! | eps | ratio_of_dry_air_to_water_vapor_gas_constants | rd/rv | none | 0 | real | kind_phys | in | F | +!! | epsm1 | ratio_of_dry_air_to_water_vapor_gas_constants_minus_one | (rd/rv) - 1 | none | 0 | real | kind_phys | in | F | +!! | grav | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | !! | ps | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | !! | u1 | x_wind_at_lowest_model_layer | x component of 1st model layer wind | m s-1 | 1 | real | kind_phys | in | F | !! | v1 | y_wind_at_lowest_model_layer | y component of 1st model layer wind | m s-1 | 1 | real | kind_phys | in | F | !! | t1 | air_temperature_at_lowest_model_layer | 1st model layer air temperature | K | 1 | real | kind_phys | in | F | !! | q1 | water_vapor_specific_humidity_at_lowest_model_layer | 1st model layer specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | !! | z1 | height_above_ground_at_lowest_model_layer | height above ground at 1st model layer | m | 1 | real | kind_phys | in | F | -!! | snwdph | surface_snow_thickness_water_equivalent | water equivalent surface snow thickness | mm | 1 | real | kind_phys | in | F | -!! | tskin | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | -!! | z0rl | surface_roughness_length | surface roughness length | cm | 1 | real | kind_phys | inout | F | -!! | cm | surface_drag_coefficient_for_momentum_in_air | surface exchange coeff for momentum | none | 1 | real | kind_phys | inout | F | -!! | ch | surface_drag_coefficient_for_heat_and_moisture_in_air | surface exchange coeff heat & moisture | none | 1 | real | kind_phys | inout | F | -!! | rb | bulk_richardson_number_at_lowest_model_level | bulk Richardson number at the surface | none | 1 | real | kind_phys | inout | F | !! | prsl1 | air_pressure_at_lowest_model_layer | Model layer 1 mean pressure | Pa | 1 | real | kind_phys | in | F | !! | prslki | ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer | Exner function ratio bt midlayer and interface at 1st layer | ratio | 1 | real | kind_phys | in | F | -!! | islimsk | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | -!! | stress | surface_wind_stress | surface wind stress | m2 s-2 | 1 | real | kind_phys | inout | F | -!! | fm | Monin-Obukhov_similarity_function_for_momentum | Monin-Obukhov similarity parameter for momentum | none | 1 | real | kind_phys | inout | F | -!! | fh | Monin-Obukhov_similarity_function_for_heat | Monin-Obukhov similarity parameter for heat | none | 1 | real | kind_phys | inout | F | -!! | ustar | surface_friction_velocity | surface friction velocity | m s-1 | 1 | real | kind_phys | inout | F | -!! | wind | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | inout | F | !! | ddvel | surface_wind_enhancement_due_to_convection | surface wind enhancement due to convection | m s-1 | 1 | real | kind_phys | in | F | -!! | fm10 | Monin-Obukhov_similarity_function_for_momentum_at_10m | Monin-Obukhov similarity parameter for momentum | none | 1 | real | kind_phys | inout | F | -!! | fh2 | Monin-Obukhov_similarity_function_for_heat_at_2m | Monin-Obukhov similarity parameter for heat | none | 1 | real | kind_phys | inout | F | !! | sigmaf | bounded_vegetation_area_fraction | areal fractional cover of green vegetation bounded on the bottom | frac | 1 | real | kind_phys | in | F | !! | vegtype | vegetation_type_classification | vegetation type at each grid cell | index | 1 | integer | | in | F | !! | shdmax | maximum_vegetation_area_fraction | max fractnl cover of green veg | frac | 1 | real | kind_phys | in | F | !! | ivegsrc | vegetation_type_dataset_choice | land use dataset choice | index | 0 | integer | | in | F | !! | z0pert | perturbation_of_momentum_roughness_length | perturbation of momentum roughness length | frac | 1 | real | kind_phys | in | F | !! | ztpert | perturbation_of_heat_to_momentum_roughness_length_ratio | perturbation of heat to momentum roughness length ratio | frac | 1 | real | kind_phys | in | F | -!! | tsurf | surface_skin_temperature_after_iteration | surface skin temperature after iteration | K | 1 | real | kind_phys | in | F | !! | flag_iter | flag_for_iteration | flag for iteration | flag | 1 | logical | | in | F | !! | redrag | flag_for_reduced_drag_coefficient_over_sea | flag for reduced drag coefficient over sea | flag | 0 | logical | | in | F | +!! | wet | flag_nonzero_wet_surface_fraction | flag indicating presence of some ocean or lake surface area fraction | flag | 1 | logical | | in | F | +!! | dry | flag_nonzero_land_surface_fraction | flag indicating presence of some land surface area fraction | flag | 1 | logical | | in | F | +!! | icy | flag_nonzero_sea_ice_surface_fraction | flag indicating presence of some sea ice surface area fraction | flag | 1 | logical | | in | F | +!! | fice | sea_ice_concentration | ice fraction over open water | frac | 1 | real | kind_phys | in | F | +!! | tskin_ocn | surface_skin_temperature_over_ocean_interstitial | surface skin temperature over ocean (temporary use as interstitial) | K | 1 | real | kind_phys | in | F | +!! | tskin_lnd | surface_skin_temperature_over_land_interstitial | surface skin temperature over land (temporary use as interstitial) | K | 1 | real | kind_phys | in | F | +!! | tskin_ice | surface_skin_temperature_over_ice_interstitial | surface skin temperature over ice (temporary use as interstitial) | K | 1 | real | kind_phys | in | F | +!! | tsurf_ocn | surface_skin_temperature_after_iteration_over_ocean | surface skin temperature after iteration over ocean | K | 1 | real | kind_phys | in | F | +!! | tsurf_lnd | surface_skin_temperature_after_iteration_over_land | surface skin temperature after iteration over land | K | 1 | real | kind_phys | in | F | +!! | tsurf_ice | surface_skin_temperature_after_iteration_over_ice | surface skin temperature after iteration over ice | K | 1 | real | kind_phys | in | F | +!! | snwdph_ocn | surface_snow_thickness_water_equivalent_over_ocean | water equivalent snow depth over ocean | mm | 1 | real | kind_phys | in | F | +!! | snwdph_lnd | surface_snow_thickness_water_equivalent_over_land | water equivalent snow depth over land | mm | 1 | real | kind_phys | in | F | +!! | snwdph_ice | surface_snow_thickness_water_equivalent_over_ice | water equivalent snow depth over ice | mm | 1 | real | kind_phys | in | F | +!! | z0rl_ocn | surface_roughness_length_over_ocean_interstitial | surface roughness length over ocean (temporary use as interstitial) | cm | 1 | real | kind_phys | inout | F | +!! | z0rl_lnd | surface_roughness_length_over_land_interstitial | surface roughness length over land (temporary use as interstitial) | cm | 1 | real | kind_phys | inout | F | +!! | z0rl_ice | surface_roughness_length_over_ice_interstitial | surface roughness length over ice (temporary use as interstitial) | cm | 1 | real | kind_phys | inout | F | +!! | ustar_ocn | surface_friction_velocity_over_ocean | surface friction velocity over ocean | m s-1 | 1 | real | kind_phys | inout | F | +!! | ustar_lnd | surface_friction_velocity_over_land | surface friction velocity over land | m s-1 | 1 | real | kind_phys | inout | F | +!! | ustar_ice | surface_friction_velocity_over_ice | surface friction velocity over ice | m s-1 | 1 | real | kind_phys | inout | F | +!! | cm_ocn | surface_drag_coefficient_for_momentum_in_air_over_ocean | surface exchange coeff for momentum over ocean | none | 1 | real | kind_phys | inout | F | +!! | cm_lnd | surface_drag_coefficient_for_momentum_in_air_over_land | surface exchange coeff for momentum over land | none | 1 | real | kind_phys | inout | F | +!! | cm_ice | surface_drag_coefficient_for_momentum_in_air_over_ice | surface exchange coeff for momentum over ice | none | 1 | real | kind_phys | inout | F | +!! | ch_ocn | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean | surface exchange coeff heat & moisture over ocean | none | 1 | real | kind_phys | inout | F | +!! | ch_lnd | surface_drag_coefficient_for_heat_and_moisture_in_air_over_land | surface exchange coeff heat & moisture over land | none | 1 | real | kind_phys | inout | F | +!! | ch_ice | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice | surface exchange coeff heat & moisture over ice | none | 1 | real | kind_phys | inout | F | +!! | rb_ocn | bulk_richardson_number_at_lowest_model_level_over_ocean | bulk Richardson number at the surface over ocean | none | 1 | real | kind_phys | inout | F | +!! | rb_lnd | bulk_richardson_number_at_lowest_model_level_over_land | bulk Richardson number at the surface over land | none | 1 | real | kind_phys | inout | F | +!! | rb_ice | bulk_richardson_number_at_lowest_model_level_over_ice | bulk Richardson number at the surface over ice | none | 1 | real | kind_phys | inout | F | +!! | stress_ocn | surface_wind_stress_over_ocean | surface wind stress over ocean | m2 s-2 | 1 | real | kind_phys | inout | F | +!! | stress_lnd | surface_wind_stress_over_land | surface wind stress over land | m2 s-2 | 1 | real | kind_phys | inout | F | +!! | stress_ice | surface_wind_stress_over_ice | surface wind stress over ice | m2 s-2 | 1 | real | kind_phys | inout | F | +!! | fm_ocn | Monin-Obukhov_similarity_function_for_momentum_over_ocean | Monin-Obukhov similarity function for momentum over ocean | none | 1 | real | kind_phys | inout | F | +!! | fm_lnd | Monin-Obukhov_similarity_function_for_momentum_over_land | Monin-Obukhov similarity function for momentum over land | none | 1 | real | kind_phys | inout | F | +!! | fm_ice | Monin-Obukhov_similarity_function_for_momentum_over_ice | Monin-Obukhov similarity function for momentum over ice | none | 1 | real | kind_phys | inout | F | +!! | fh_ocn | Monin-Obukhov_similarity_function_for_heat_over_ocean | Monin-Obukhov similarity function for heat over ocean | none | 1 | real | kind_phys | inout | F | +!! | fh_lnd | Monin-Obukhov_similarity_function_for_heat_over_land | Monin-Obukhov similarity function for heat over land | none | 1 | real | kind_phys | inout | F | +!! | fh_ice | Monin-Obukhov_similarity_function_for_heat_over_ice | Monin-Obukhov similarity function for heat over ice | none | 1 | real | kind_phys | inout | F | +!! | fm10_ocn | Monin-Obukhov_similarity_function_for_momentum_at_10m_over_ocean | Monin-Obukhov similarity parameter for momentum at 10m over ocean | none | 1 | real | kind_phys | inout | F | +!! | fm10_lnd | Monin-Obukhov_similarity_function_for_momentum_at_10m_over_land | Monin-Obukhov similarity parameter for momentum at 10m over land | none | 1 | real | kind_phys | inout | F | +!! | fm10_ice | Monin-Obukhov_similarity_function_for_momentum_at_10m_over_ice | Monin-Obukhov similarity parameter for momentum at 10m over ice | none | 1 | real | kind_phys | inout | F | +!! | fh2_ocn | Monin-Obukhov_similarity_function_for_heat_at_2m_over_ocean | Monin-Obukhov similarity parameter for heat at 2m over ocean | none | 1 | real | kind_phys | inout | F | +!! | fh2_lnd | Monin-Obukhov_similarity_function_for_heat_at_2m_over_land | Monin-Obukhov similarity parameter for heat at 2m over land | none | 1 | real | kind_phys | inout | F | +!! | fh2_ice | Monin-Obukhov_similarity_function_for_heat_at_2m_over_ice | Monin-Obukhov similarity parameter for heat at 2m over ice | none | 1 | real | kind_phys | inout | F | +!! | wind | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | inout | F | !! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | !! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! !> \section general_diff GFS Surface Layer Scheme General Algorithm !! @{ !! - Calculate the thermal roughness length formulation over the ocean (see eq. (25) and (26) -!! in Zeng et al. (1998) \cite zeng_et_al_1998). +!! in Zeng et al. (1998) \cite zeng_et_al_1998). !! - Calculate Zeng's momentum roughness length formulation over land and sea ice. -!! - Calculate the new vegetation-dependent formulation of thermal roughness length +!! - Calculate the new vegetation-dependent formulation of thermal roughness length !! (Zheng et al.(2009) \cite zheng_et_al_2009). !! Zheng et al. (2009) \cite zheng_et_al_2009 proposed a new formulation on !! \f$ln(Z_{0m}^,/Z_{0t})\f$ as follows: @@ -86,51 +130,64 @@ end subroutine sfc_ex_coef_finalize !!\f] !! - Calculate the exchange coefficients:\f$cm\f$, \f$ch\f$, and \f$stress\f$ as inputs of other \a sfc schemes. !! - subroutine sfc_ex_coef_run & - & (im,ps,u1,v1,t1,q1,z1, & - & snwdph,tskin,z0rl,cm,ch,rb, & - & prsl1,prslki,islimsk, & - & stress,fm,fh, & - & ustar,wind,ddvel,fm10,fh2, & - & sigmaf,vegtype,shdmax,ivegsrc, & - & z0pert,ztpert, & - & tsurf,flag_iter,redrag,errmsg,errflg & - & ) + subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, !intent(in) + & ps,u1,v1,t1,q1,z1, !intent(in) + & prsl1,prslki,ddvel, !intent(in) + & sigmaf,vegtype,shdmax,ivegsrc, !intent(in) + & z0pert,ztpert, ! mg, sfc-perts !intent(in) + & flag_iter,redrag, !intent(in) + & wet,dry,icy,fice, !intent(in) + & tskin_ocn, tskin_lnd, tskin_ice, !intent(in) + & tsurf_ocn, tsurf_lnd, tsurf_ice, !intent(in) + & snwdph_ocn,snwdph_lnd,snwdph_ice, !intent(in) ! - use machine , only : kind_phys - use funcphys, only : fpvs - use physcons, grav => con_g, cp => con_cp & - &, rvrdm1 => con_fvirt, rd => con_rd & - &, eps => con_eps, epsm1 => con_epsm1 + & z0rl_ocn, z0rl_lnd, z0rl_ice, !intent(inout) + & ustar_ocn, ustar_lnd, ustar_ice, !intent(inout) +! + & cm_ocn, cm_lnd, cm_ice, !intent(inout) + & ch_ocn, ch_lnd, ch_ice, !intent(inout) + & rb_ocn, rb_lnd, rb_ice, !intent(inout) + & stress_ocn,stress_lnd,stress_ice, !intent(inout) + & fm_ocn, fm_lnd, fm_ice, !intent(inout) + & fh_ocn, fh_lnd, fh_ice, !intent(inout) + & fm10_ocn, fm10_lnd, fm10_ice, !intent(inout) + & fh2_ocn, fh2_lnd, fh2_ice, !intent(inout) + & wind , !intent(inout) + & errmsg, errflg) !intent(out) ! + use funcphys, only : fpvs + implicit none ! integer, intent(in) :: im, ivegsrc - real(kind=kind_phys), dimension(im), intent(in) :: & - & ps, u1, v1, t1, q1, z1 - real(kind=kind_phys), dimension(im), intent(in) :: & - & snwdph, tskin, prsl1 & - &, prslki - real(kind=kind_phys), dimension(im), intent(inout) :: & - & z0rl - real(kind=kind_phys), dimension(im), intent(inout) :: & - & cm, ch, rb - - real(kind=kind_phys), dimension(im), intent(inout) :: & - & stress, fm, fh, ustar, wind - real(kind=kind_phys), dimension(im), intent(in) :: & - & ddvel - real(kind=kind_phys), dimension(im), intent(inout) :: & - & fm10, fh2 - real(kind=kind_phys), dimension(im), intent(in) :: & - & sigmaf, shdmax, tsurf - real(kind=kind_phys), dimension(im), intent(in) :: & - & z0pert,ztpert - integer, dimension(im), intent(in) :: vegtype, islimsk -! - logical, intent(in) :: flag_iter(im) + integer, dimension(im), intent(in) :: vegtype + 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 ! added by s.lu + + real(kind=kind_phys), intent(in) :: rvrdm1, eps, epsm1, grav + real(kind=kind_phys), dimension(im), intent(in) :: + & ps,u1,v1,t1,q1,z1,prsl1,prslki,ddvel, + & sigmaf,shdmax, + & z0pert,ztpert ! mg, sfc-perts + real(kind=kind_phys), dimension(im), intent(in) :: + & tskin_ocn, tskin_lnd, tskin_ice, + & tsurf_ocn, tsurf_lnd, tsurf_ice, + & snwdph_ocn,snwdph_lnd,snwdph_ice, + & fice + + real(kind=kind_phys), dimension(im), intent(inout) :: + & z0rl_ocn, z0rl_lnd, z0rl_ice, + & ustar_ocn, ustar_lnd, ustar_ice, + & cm_ocn, cm_lnd, cm_ice, + & ch_ocn, ch_lnd, ch_ice, + & rb_ocn, rb_lnd, rb_ice, + & stress_ocn,stress_lnd,stress_ice, + & fm_ocn, fm_lnd, fm_ice, + & fh_ocn, fh_lnd, fh_ice, + & fm10_ocn, fm10_lnd, fm10_ice, + & fh2_ocn, fh2_lnd, fh2_ice, + & wind character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -138,24 +195,18 @@ subroutine sfc_ex_coef_run & ! integer i ! - real(kind=kind_phys) aa, aa0, bb, bb0, dtv, adtv,qs1,& - & hl1, hl12, pm, ph, pm10, ph2, rat,& - & thv1, tvs, z1i, z0, z0max, ztmax, & - & fms, fhs, hl0, hl0inf, hlinf, & - & hl110, hlt, hltinf, olinf, & - & restar, czilc, tem1, tem2, ztmax1 + real(kind=kind_phys) :: qs1, rat, thv1, restar, + & czilc, tem1, tem2 + + real(kind=kind_phys) :: tvs_ocn, tvs_lnd, tvs_ice, + & z0_ocn, z0_lnd, z0_ice, + & z0max_ocn,z0max_lnd,z0max_ice, + & ztmax_ocn,ztmax_lnd,ztmax_ice ! real(kind=kind_phys), parameter :: - & charnock=.014, ca=.4 ! ca - von karman constant - &, z0s_max=.317e-2 ! a limiting value at high winds over sea - - &, alpha=5., a0=-3.975, a1=12.32, alpha4=4.0*alpha - &, b1=-7.755, b2=6.041, alpha2=alpha+alpha, beta=1.0 - &, a0p=-7.941, a1p=24.75, b1p=-8.705, b2p=7.899 + & charnock=.014, z0s_max=.317e-2 ! a limiting value at high winds over sea &, vis=1.4e-5, rnu=1.51e-5, visi=1.0/vis - &, log01=log(0.01), log05=log(0.05), log07=log(0.07) - &, ztmin1=-999.0 ! parameter (charnock=.014,ca=.4)!c ca is the von karman constant ! parameter (alpha=5.,a0=-3.975,a1=12.32,b1=-7.755,b2=6.041) @@ -172,43 +223,48 @@ subroutine sfc_ex_coef_run & ! ! mbek -- toga-coare flux algorithm ! parameter (rnu=1.51e-5,arnu=0.11*rnu) -! - ! Initialize CCPP error handling variables + +! Initialize CCPP error handling variables errmsg = '' errflg = 0 -! + ! initialize variables. all units are supposedly m.k.s. unless specified ! ps is in pascals, wind is wind speed, ! surface roughness length is converted to m from cm ! do i=1,im + + ztmax_ocn = 0.; ztmax_lnd = 0.; ztmax_ice = 0. if(flag_iter(i)) then wind(i) = max(sqrt(u1(i)*u1(i) + v1(i)*v1(i)) & + max(0.0, min(ddvel(i), 30.0)), 1.0) tem1 = 1.0 + rvrdm1 * max(q1(i),1.e-8) thv1 = t1(i) * prslki(i) * tem1 - tvs = 0.5 * (tsurf(i)+tskin(i)) * tem1 + tvs_ocn = 0.5 * (tsurf_ocn(i)+tskin_ocn(i)) * tem1 + tvs_lnd = 0.5 * (tsurf_lnd(i)+tskin_lnd(i)) * tem1 + tvs_ice = 0.5 * (tsurf_ice(i)+tskin_ice(i)) * tem1 qs1 = fpvs(t1(i)) qs1 = max(1.0e-8, eps * qs1 / (prsl1(i) + epsm1 * qs1)) - z0 = 0.01 * z0rl(i) - z0max = max(1.0e-6, min(z0,z1(i))) - z1i = 1.0 / z1(i) + z0_ocn = 0.01 * z0rl_ocn(i) + z0max_ocn = max(1.0e-6, min(z0_ocn,z1(i))) + z0_lnd = 0.01 * z0rl_lnd(i) + z0max_lnd = max(1.0e-6, min(z0_lnd,z1(i))) + z0_ice = 0.01 * z0rl_ice(i) + z0max_ice = max(1.0e-6, min(z0_ice,z1(i))) ! compute stability dependent exchange coefficients ! this portion of the code is presently suppressed ! - if(islimsk(i) == 0) then ! over ocean -! - Over the ocean, calculate friction velocity in eq.(A10) in \cite zeng_et_al_1998 . - ustar(i) = sqrt(grav * z0 / charnock) + if (wet(i) .and. fice(i) < 1.) then ! some open ocean + ustar_ocn(i) = sqrt(grav * z0_ocn / charnock) !** test xubin's new z0 ! ztmax = z0max -! - Over the ocean, calculate the roughness Reynolds number: - restar = max(ustar(i)*z0max*visi, 0.000001) + restar = max(ustar_ocn(i)*z0max_ocn*visi, 0.000001) ! restar = log(restar) ! restar = min(restar,5.) @@ -217,103 +273,197 @@ subroutine sfc_ex_coef_run & ! rat = rat / (1. + (bb2 + cc2*restar) * restar)) ! rat taken from zeng, zhao and dickinson 1997 -! - Over the ocean, calculate the roughness length of temperature -!! (see eq.(25) and (26) in Zeng et al.(1998) \cite zeng_et_al_1998). rat = min(7.0, 2.67 * sqrt(sqrt(restar)) - 2.57) - ztmax = z0max * exp(-rat) - - else ! over land and sea ice + ztmax_ocn = z0max_ocn * exp(-rat) + endif ! Open ocean + if (dry(i) .or. icy(i)) then ! over land or sea ice !** xubin's new z0 over land and sea ice tem1 = 1.0 - shdmax(i) tem2 = tem1 * tem1 tem1 = 1.0 - tem2 if( ivegsrc == 1 ) then -! - Calculate the roughness length of momentum over land and sea ice. + if (vegtype(i) == 10) then - z0max = exp( tem2*log01 + tem1*log07 ) + z0max_lnd = exp( tem2*log01 + tem1*log07 ) elseif (vegtype(i) == 6) then - z0max = exp( tem2*log01 + tem1*log05 ) + z0max_lnd = exp( tem2*log01 + tem1*log05 ) elseif (vegtype(i) == 7) then ! z0max = exp( tem2*log01 + tem1*log01 ) - z0max = 0.01 + z0max_lnd = 0.01 elseif (vegtype(i) == 16) then ! z0max = exp( tem2*log01 + tem1*log01 ) - z0max = 0.01 + z0max_lnd = 0.01 else - z0max = exp( tem2*log01 + tem1*log(z0max) ) + z0max_lnd = exp( tem2*log01 + tem1*log(z0max_lnd) ) endif elseif (ivegsrc == 2 ) then if (vegtype(i) == 7) then - z0max = exp( tem2*log01 + tem1*log07 ) + z0max_lnd = exp( tem2*log01 + tem1*log07 ) elseif (vegtype(i) == 8) then - z0max = exp( tem2*log01 + tem1*log05 ) + z0max_lnd = exp( tem2*log01 + tem1*log05 ) elseif (vegtype(i) == 9) then ! z0max = exp( tem2*log01 + tem1*log01 ) - z0max = 0.01 + z0max_lnd = 0.01 elseif (vegtype(i) == 11) then ! z0max = exp( tem2*log01 + tem1*log01 ) - z0max = 0.01 + z0max_lnd = 0.01 else - z0max = exp( tem2*log01 + tem1*log(z0max) ) + z0max_lnd = exp( tem2*log01 + tem1*log(z0max_lnd) ) endif - endif -! - Calculate the roughness length for heat (see eq.(1) of \cite zheng_et_al_2012 ) . + endif ! over land or sea ice + + z0max_ice = z0max_lnd + ! mg, sfc-perts: add surface perturbations to z0max over land -!! Following Gehne et al. (2018) \cite gehne_et_al_2018, a perturbation of the momentum -!! roughness length (z0pert) is added using a logrithmic scaling. The spatial pattern of -!! z0pert is drawn from a normal distribution with a standard deviation of 0.14 while is -!! bounded between -0.5 and 0.5. Similarly, a perturbation of the ratio between the roughness -!! length for heat to the momentum roughness length (ztpert) is added. The spatial pattern -!! of ztpert is drawn from a normal distribution with a standard deviation of 0.08. - - if ( islimsk(i) == 1 .and. z0pert(i) /= 0.0 ) then - z0max = z0max * (10.**z0pert(i)) + if (dry(i) .and. z0pert(i) /= 0.0 ) then + z0max_lnd = z0max_lnd * (10.**z0pert(i)) endif - z0max = max(z0max,1.0e-6) -! + z0max_lnd = max(z0max_lnd,1.0e-6) + z0max_ice = max(z0max_ice,1.0e-6) + ! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height dependance of czil czilc = 0.8 tem1 = 1.0 - sigmaf(i) - ztmax = z0max*exp( - tem1*tem1 - & * czilc*ca*sqrt(ustar(i)*(0.01/1.5e-05))) + ztmax_lnd = z0max_lnd*exp( - tem1*tem1 + & * czilc*ca*sqrt(ustar_lnd(i)*(0.01/1.5e-05))) + ztmax_ice = z0max_ice*exp( - tem1*tem1 + & * czilc*ca*sqrt(ustar_ice(i)*(0.01/1.5e-05))) + ! mg, sfc-perts: add surface perturbations to ztmax/z0max ratio over land - if ( islimsk(i) == 1 .and. ztpert(i) /= 0.0) then - ztmax = ztmax * (10.**ztpert(i)) + if (dry(i) .and. ztpert(i) /= 0.0) then + ztmax_lnd = ztmax_lnd * (10.**ztpert(i)) + endif + + + endif ! end of if(sfctype flags) then + + ztmax_ocn = max(ztmax_ocn,1.0e-6) + ztmax_lnd = max(ztmax_lnd,1.0e-6) + ztmax_ice = max(ztmax_ice,1.0e-6) + +! BWG begin "stability" block, 2019-03-23 + if (wet(i) .and. fice(i) < 1.) then ! Some open ocean + call stability +! --- inputs: + & (z1(i),snwdph_ocn(i),thv1,wind(i), + & z0max_ocn,ztmax_ocn,tvs_ocn,grav, +! --- outputs: + & rb_ocn(i),fm_ocn(i),fh_ocn(i),fm10_ocn(i),fh2_ocn(i), + & cm_ocn(i),ch_ocn(i),stress_ocn(i),ustar_ocn(i)) + endif ! Open ocean points + + if (dry(i)) then ! Some land + call stability +! --- inputs: + & (z1(i),snwdph_lnd(i),thv1,wind(i), + & z0max_lnd,ztmax_lnd,tvs_lnd,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)) + endif ! Dry points + + if (icy(i)) then ! Some ice + call stability +! --- inputs: + & (z1(i),snwdph_ice(i),thv1,wind(i), + & z0max_ice,ztmax_ice,tvs_ice,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)) + endif ! Icy points + +! BWG: Everything from here to end of subroutine was after +! the stuff now put into "stability" + +! +! update z0 over ocean +! + if (wet(i) .and. fice(i) < 1.) then + z0_ocn = (charnock / grav) * ustar_ocn(i) * ustar_ocn(i) + +! mbek -- toga-coare flux algorithm +! z0 = (charnock / grav) * ustar(i)*ustar(i) + arnu/ustar(i) +! new implementation of z0 +! cc = ustar(i) * z0 / rnu +! pp = cc / (1. + cc) +! ff = grav * arnu / (charnock * ustar(i) ** 3) +! z0 = arnu / (ustar(i) * ff ** pp) + + if (redrag) then + z0rl_ocn(i) = 100.0 * max(min(z0_ocn, z0s_max), 1.e-7) + else + z0rl_ocn(i) = 100.0 * max(min(z0_ocn,.1), 1.e-7) endif + endif ! end of if(open ocean) + endif ! end of if(flagiter) loop + enddo + + return + end subroutine sfc_diff_run +!> @} + +!---------------------------------------- + subroutine stability +!........................................ +! --- inputs: + & ( z1, snwdph, thv1, wind, z0max, ztmax, tvs, grav, & +! --- outputs: + & rb, fm, fh, fm10, fh2, cm, ch, stress, ustar) +!----- + +! --- inputs: + real(kind=kind_phys), intent(in) :: & + & z1, snwdph, thv1, wind, z0max, ztmax, tvs, grav + +! --- outputs: + real(kind=kind_phys), intent(out) :: & + & rb, fm, fh, fm10, fh2, cm, ch, stress, ustar + +! --- locals: + real(kind=kind_phys), parameter :: alpha=5., a0=-3.975 & + &, a1=12.32, alpha4=4.0*alpha + &, b1=-7.755, b2=6.041, alpha2=alpha+alpha, beta=1.0 + &, a0p=-7.941, a1p=24.75, b1p=-8.705, b2p=7.899 + &, ztmin1=-999.0 - endif ! end of if(islimsk(i) == 0) then + real(kind=kind_phys) aa, aa0, bb, bb0, dtv, adtv, + & hl1, hl12, pm, ph, pm10, ph2, + & z1i, + & fms, fhs, hl0, hl0inf, hlinf, + & hl110, hlt, hltinf, olinf, + & tem1, tem2, ztmax1 - ztmax = max(ztmax,1.0e-6) - tem1 = z0max/z1(i) + z1i = 1.0 / z1 + + tem1 = z0max/z1 if (abs(1.0-tem1) > 1.0e-6) then ztmax1 = - beta*log(tem1)/(alpha2*(1.-tem1)) else ztmax1 = 99.0 endif - if( z0max < 0.05 .and. snwdph(i) < 10.0 ) ztmax1 = 99.0 - + if( z0max < 0.05 .and. snwdph < 10.0 ) ztmax1 = 99.0 ! compute stability indices (rb and hlinf) dtv = thv1 - tvs adtv = max(abs(dtv),0.001) dtv = sign(1.,dtv) * adtv - rb(i) = max(-5000.0, (grav+grav) * dtv * z1(i) - & / ((thv1 + tvs) * wind(i) * wind(i))) + rb = max(-5000.0, (grav+grav) * dtv * z1 + & / ((thv1 + tvs) * wind * wind)) tem1 = 1.0 / z0max tem2 = 1.0 / ztmax - fm(i) = log((z0max+z1(i)) * tem1) - fh(i) = log((ztmax+z1(i)) * tem2) - fm10(i) = log((z0max+10.) * tem1) - fh2(i) = log((ztmax+2.) * tem2) - hlinf = rb(i) * fm(i) * fm(i) / fh(i) + fm = log((z0max+z1) * tem1) + fh = log((ztmax+z1) * tem2) + fm10 = log((z0max+10.) * tem1) + fh2 = log((ztmax+2.) * tem2) + hlinf = rb * fm * fm / fh hlinf = min(max(hlinf,ztmin1),ztmax1) ! ! stable case @@ -330,9 +480,9 @@ subroutine sfc_ex_coef_run & bb0 = sqrt(1. + alpha4 * hltinf) pm = aa0 - aa + log( (aa + 1.)/(aa0 + 1.) ) ph = bb0 - bb + log( (bb + 1.)/(bb0 + 1.) ) - fms = fm(i) - pm - fhs = fh(i) - ph - hl1 = fms * fms * rb(i) / fhs + fms = fm - pm + fhs = fh - ph + hl1 = fms * fms * rb / fhs hl1 = min(max(hl1, ztmin1), ztmax1) endif ! @@ -360,10 +510,10 @@ subroutine sfc_ex_coef_run & ! unstable case - check for unphysical obukhov length ! else ! dtv < 0 case - olinf = z1(i) / hlinf + olinf = z1 / hlinf tem1 = 50.0 * z0max if(abs(olinf) <= tem1) then - hlinf = -z1(i) / tem1 + hlinf = -z1 / tem1 hlinf = min(max(hlinf,ztmin1),ztmax1) endif ! @@ -400,44 +550,23 @@ subroutine sfc_ex_coef_run & ! ! finish the exchange coefficient computation to provide fm and fh ! -! - Finish the exchange coefficient computation to provide cm, ch, stress as input of other -! \a sfc schemes. - fm(i) = fm(i) - pm - fh(i) = fh(i) - ph - fm10(i) = fm10(i) - pm10 - fh2(i) = fh2(i) - ph2 - cm(i) = ca * ca / (fm(i) * fm(i)) - ch(i) = ca * ca / (fm(i) * fh(i)) - tem1 = 0.00001/z1(i) - cm(i) = max(cm(i), tem1) - ch(i) = max(ch(i), tem1) - stress(i) = cm(i) * wind(i) * wind(i) - ustar(i) = sqrt(stress(i)) -! -! update z0 over ocean -! - if(islimsk(i) == 0) then - z0 = (charnock / grav) * ustar(i) * ustar(i) - -! mbek -- toga-coare flux algorithm -! z0 = (charnock / grav) * ustar(i)*ustar(i) + arnu/ustar(i) -! new implementation of z0 -! cc = ustar(i) * z0 / rnu -! pp = cc / (1. + cc) -! ff = grav * arnu / (charnock * ustar(i) ** 3) -! z0 = arnu / (ustar(i) * ff ** pp) - - if (redrag) then - z0rl(i) = 100.0 * max(min(z0, z0s_max), 1.e-7) - else - z0rl(i) = 100.0 * max(min(z0,.1), 1.e-7) - endif - endif - endif ! end of if(flagiter) loop - enddo + fm = fm - pm + fh = fh - ph + fm10 = fm10 - pm10 + fh2 = fh2 - ph2 + cm = ca * ca / (fm * fm) + ch = ca * ca / (fm * fh) + tem1 = 0.00001/z1 + cm = max(cm, tem1) + ch = max(ch, tem1) + stress = cm * wind * wind + ustar = sqrt(stress) return - end subroutine sfc_ex_coef_run -!! @} -!! @} - end module sfc_ex_coef +!................................. + end subroutine stability +!--------------------------------- + +!--------------------------------- +!> @} + end module sfc_diff diff --git a/physics/sfc_drv.f b/physics/sfc_drv.f index 766ee5d01..ec862ac85 100644 --- a/physics/sfc_drv.f +++ b/physics/sfc_drv.f @@ -72,7 +72,7 @@ end subroutine lsm_noah_finalize ! --- inputs: ! ! ( im, km, ps, u1, v1, t1, q1, soiltyp, vegtype, sigmaf, ! ! sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch, ! -! prsl1, prslki, zf, islimsk, ddvel, slopetyp, ! +! prsl1, prslki, zf, land, ddvel, slopetyp, ! ! shdmin, shdmax, snoalb, sfalb, flag_iter, flag_guess, ! ! lheatstrg, isot, ivegsrc, ! ! --- in/outs: ! @@ -119,7 +119,7 @@ end subroutine lsm_noah_finalize ! prsl1 - real, sfc layer 1 mean pressure (pa) im ! ! prslki - real, dimensionless exner function at layer 1 im ! ! zf - real, height of bottom layer (m) im ! -! islimsk - integer, sea/land/ice mask (=0/1/2) im ! +! land - logical, = T if a point with any land im ! ! ddvel - real, im ! ! slopetyp - integer, class of sfc slope (integer index) im ! ! shdmin - real, min fractional coverage of green veg im ! @@ -145,8 +145,7 @@ end subroutine lsm_noah_finalize ! canopy - real, canopy moisture content (m) im ! ! trans - real, total plant transpiration (m/s) im ! ! tsurf - real, surface skin temperature (after iteration) im ! -! ! -! outputs: ! +! zorl - real, surface roughness im ! ! sncovr1 - real, snow cover over land (fractional) im ! ! qsurf - real, specific humidity at sfc im ! ! gflux - real, soil heat flux (w/m**2) im ! @@ -165,14 +164,13 @@ end subroutine lsm_noah_finalize ! snohf - real, snow/freezing-rain latent heat flux (w/m**2)im ! ! smcwlt2 - real, dry soil moisture threshold im ! ! smcref2 - real, soil moisture threshold im ! -! zorl - real, surface roughness im ! ! wet1 - real, normalized soil wetness im ! ! ! ! ==================== end of description ===================== ! !>\defgroup Noah_LSM GFS Noah LSM Model !> @{ -!! \brief This is Noah LSM driver module, with the functionality of +!! \brief This is Noah LSM driver module, with the functionality of !! preparing variables to run Noah LSM gfssflx(), calling Noah LSM and post-processing !! variables for return to the parent model suite including unit conversion, as well !! as diagnotics calculation. @@ -181,6 +179,13 @@ end subroutine lsm_noah_finalize !! |----------------|------------------------------------------------------------------------------|-----------------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| !! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | !! | km | soil_vertical_dimension | soil vertical layer dimension | count | 0 | integer | | in | F | +!! | grav | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | +!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | +!! | hvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | +!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | +!! | eps | ratio_of_dry_air_to_water_vapor_gas_constants | rd/rv | none | 0 | real | kind_phys | in | F | +!! | epsm1 | ratio_of_dry_air_to_water_vapor_gas_constants_minus_one | (rd/rv) - 1 | none | 0 | real | kind_phys | in | F | +!! | rvrdm1 | ratio_of_vapor_to_dry_air_gas_constants_minus_one | (rv/rd) - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | !! | ps | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | !! | u1 | x_wind_at_lowest_model_layer | x component of 1st model layer wind | m s-1 | 1 | real | kind_phys | in | F | !! | v1 | y_wind_at_lowest_model_layer | y component of 1st model layer wind | m s-1 | 1 | real | kind_phys | in | F | @@ -195,12 +200,12 @@ end subroutine lsm_noah_finalize !! | snet | surface_net_downwelling_shortwave_flux | total sky surface net shortwave flux | W m-2 | 1 | real | kind_phys | in | F | !! | delt | time_step_for_dynamics | dynamics time step | s | 0 | real | kind_phys | in | F | !! | tg3 | deep_soil_temperature | bottom soil temperature | K | 1 | real | kind_phys | in | F | -!! | cm | surface_drag_coefficient_for_momentum_in_air | surface exchange coeff for momentum | none | 1 | real | kind_phys | in | F | -!! | ch | surface_drag_coefficient_for_heat_and_moisture_in_air | surface exchange coeff heat & moisture | none | 1 | real | kind_phys | in | F | +!! | cm | surface_drag_coefficient_for_momentum_in_air_over_land | surface exchange coeff for momentum over land | none | 1 | real | kind_phys | in | F | +!! | ch | surface_drag_coefficient_for_heat_and_moisture_in_air_over_land | surface exchange coeff heat & moisture over land | none | 1 | real | kind_phys | in | F | !! | prsl1 | air_pressure_at_lowest_model_layer | Model layer 1 mean pressure | Pa | 1 | real | kind_phys | in | F | !! | prslki | ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer | Exner function ratio bt midlayer and interface at 1st layer | ratio | 1 | real | kind_phys | in | F | !! | zf | height_above_ground_at_lowest_model_layer | height above ground at 1st model layer | m | 1 | real | kind_phys | in | F | -!! | islimsk | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | +!! | land | flag_nonzero_land_surface_fraction | flag indicating presence of some land surface area fraction | flag | 1 | logical | | in | F | !! | ddvel | surface_wind_enhancement_due_to_convection | surface wind enhancement due to convection | m s-1 | 1 | real | kind_phys | in | F | !! | slopetyp | surface_slope_classification | surface slope type at each grid cell | index | 1 | integer | | in | F | !! | shdmin | minimum_vegetation_area_fraction | min fractional coverage of green veg | frac | 1 | real | kind_phys | in | F | @@ -216,28 +221,28 @@ end subroutine lsm_noah_finalize !! | xlaipert | perturbation_of_leaf_area_index | perturbation of leaf area index | frac | 1 | real | kind_phys | in | F | !! | vegfpert | perturbation_of_vegetation_fraction | perturbation of vegetation fraction | frac | 1 | real | kind_phys | in | F | !! | pertvegf | magnitude_of_perturbation_of_vegetation_fraction | magnitude of perturbation of vegetation fraction | frac | 1 | real | kind_phys | in | F | -!! | weasd | water_equivalent_accumulated_snow_depth | water equivalent accumulated snow depth | mm | 1 | real | kind_phys | inout | F | -!! | snwdph | surface_snow_thickness_water_equivalent | water equivalent snow depth over land | mm | 1 | real | kind_phys | inout | F | -!! | tskin | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | inout | F | -!! | tprcp | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep | nonnegative precipitation amount in one dynamics time step | m | 1 | real | kind_phys | inout | F | +!! | weasd | water_equivalent_accumulated_snow_depth_over_land | water equiv of acc snow depth over land | mm | 1 | real | kind_phys | inout | F | +!! | snwdph | surface_snow_thickness_water_equivalent_over_land | water equivalent snow depth over land | mm | 1 | real | kind_phys | inout | F | +!! | tskin | surface_skin_temperature_over_land_interstitial | surface skin temperature over land (temporary use as interstitial) | K | 1 | real | kind_phys | inout | F | +!! | tprcp | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land | total precipitation amount in each time step over land | m | 1 | real | kind_phys | inout | F | !! | srflag | flag_for_precipitation_type | flag for snow or rain precipitation | flag | 1 | real | kind_phys | inout | F | !! | smc | volume_fraction_of_soil_moisture | volumetric fraction of soil moisture | frac | 2 | real | kind_phys | inout | F | !! | stc | soil_temperature | soil temperature | K | 2 | real | kind_phys | inout | F | !! | slc | volume_fraction_of_unfrozen_soil_moisture | volume fraction of unfrozen soil moisture | frac | 2 | real | kind_phys | inout | F | !! | canopy | canopy_water_amount | canopy moisture content | kg m-2 | 1 | real | kind_phys | inout | F | !! | trans | transpiration_flux | total plant transpiration rate | kg m-2 s-1 | 1 | real | kind_phys | inout | F | -!! | tsurf | surface_skin_temperature_after_iteration | surface skin temperature after iteration | K | 1 | real | kind_phys | inout | F | -!! | zorl | surface_roughness_length | surface roughness length | cm | 1 | real | kind_phys | inout | F | +!! | tsurf | surface_skin_temperature_after_iteration_over_land | surface skin temperature after iteration over land | K | 1 | real | kind_phys | inout | F | +!! | zorl | surface_roughness_length_over_land_interstitial | surface roughness length over land (temporary use as interstitial) | cm | 1 | real | kind_phys | inout | F | !! | sncovr1 | surface_snow_area_fraction_over_land | surface snow area fraction | frac | 1 | real | kind_phys | inout | F | -!! | qsurf | surface_specific_humidity | surface specific humidity | kg kg-1 | 1 | real | kind_phys | inout | F | -!! | gflux | upward_heat_flux_in_soil | upward soil heat flux | W m-2 | 1 | real | kind_phys | inout | F | +!! | qsurf | surface_specific_humidity_over_land | surface air saturation specific humidity over land | kg kg-1 | 1 | real | kind_phys | inout | F | +!! | gflux | upward_heat_flux_in_soil_over_land | soil heat flux over land | W m-2 | 1 | real | kind_phys | inout | F | !! | drain | subsurface_runoff_flux | subsurface runoff flux | g m-2 s-1 | 1 | real | kind_phys | inout | F | -!! | evap | kinematic_surface_upward_latent_heat_flux | surface upward evaporation flux | kg kg-1 m s-1 | 1 | real | kind_phys | inout | F | -!! | hflx | kinematic_surface_upward_sensible_heat_flux | surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | inout | F | -!! | ep | surface_upward_potential_latent_heat_flux | surface upward potential latent heat flux | W m-2 | 1 | real | kind_phys | inout | F | +!! | evap | kinematic_surface_upward_latent_heat_flux_over_land | kinematic surface upward latent heat flux over land | kg kg-1 m s-1 | 1 | real | kind_phys | inout | F | +!! | hflx | kinematic_surface_upward_sensible_heat_flux_over_land | kinematic surface upward sensible heat flux over land | K m s-1 | 1 | real | kind_phys | inout | F | +!! | ep | surface_upward_potential_latent_heat_flux_over_land | surface upward potential latent heat flux over land | W m-2 | 1 | real | kind_phys | inout | F | !! | runoff | surface_runoff_flux | surface runoff flux | g m-2 s-1 | 1 | real | kind_phys | inout | F | -!! | cmm | surface_drag_wind_speed_for_momentum_in_air | surf mom exch coef time mean surf wind | m s-1 | 1 | real | kind_phys | inout | F | -!! | chh | surface_drag_mass_flux_for_heat_and_moisture_in_air | surf h&m exch coef time surf wind & density | kg m-2 s-1 | 1 | real | kind_phys | inout | F | +!! | cmm | surface_drag_wind_speed_for_momentum_in_air_over_land | momentum exchange coefficient over land | m s-1 | 1 | real | kind_phys | inout | F | +!! | chh | surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land | thermal exchange coefficient over land | kg m-2 s-1 | 1 | real | kind_phys | inout | F | !! | evbs | soil_upward_latent_heat_flux | soil upward latent heat flux | W m-2 | 1 | real | kind_phys | inout | F | !! | evcw | canopy_upward_latent_heat_flux | canopy upward latent heat flux | W m-2 | 1 | real | kind_phys | inout | F | !! | sbsno | snow_deposition_sublimation_upward_latent_heat_flux | latent heat flux from snow depo/subl | W m-2 | 1 | real | kind_phys | inout | F | @@ -254,9 +259,10 @@ end subroutine lsm_noah_finalize !! @{ subroutine lsm_noah_run & ! --- inputs: - & ( im, km, ps, u1, v1, t1, q1, soiltyp, vegtype, sigmaf, & + & ( im, km, grav, cp, hvap, rd, eps, epsm1, rvrdm1, ps, u1, & + & v1, t1, q1, soiltyp, vegtype, sigmaf, & & sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & - & prsl1, prslki, zf, islimsk, ddvel, slopetyp, & + & prsl1, prslki, zf, land, ddvel, slopetyp, & & shdmin, shdmax, snoalb, sfalb, flag_iter, flag_guess, & & lheatstrg, isot, ivegsrc, & & bexppert, xlaipert, vegfpert,pertvegf, & ! sfc perts, mgehne @@ -271,19 +277,12 @@ subroutine lsm_noah_run & ! use machine , only : kind_phys use funcphys, only : fpvs - use physcons, only : grav => con_g, cp => con_cp, & - & hvap => con_hvap, rd => con_rd, & - & eps => con_eps, epsm1 => con_epsm1, & - & rvrdm1 => con_fvirt use surface_perturbation, only : ppfbet implicit none ! --- constant parameters: - real(kind=kind_phys), parameter :: cpinv = 1.0/cp - real(kind=kind_phys), parameter :: hvapi = 1.0/hvap - real(kind=kind_phys), parameter :: elocp = hvap/cp real(kind=kind_phys), parameter :: rhoh2o = 1000.0 real(kind=kind_phys), parameter :: a2 = 17.2693882 real(kind=kind_phys), parameter :: a3 = 273.16 @@ -295,6 +294,8 @@ subroutine lsm_noah_run & ! --- input: integer, intent(in) :: im, km, isot, ivegsrc + real (kind=kind_phys), intent(in) :: grav, cp, hvap, rd, eps, & + & epsm1, rvrdm1 real (kind=kind_phys), dimension(5), intent(in) :: pertvegf integer, dimension(im), intent(in) :: soiltyp, vegtype, slopetyp @@ -305,10 +306,9 @@ subroutine lsm_noah_run & & snoalb, sfalb, zf, & & bexppert, xlaipert, vegfpert - integer, dimension(im), intent(in) :: islimsk real (kind=kind_phys), intent(in) :: delt - logical, dimension(im), intent(in) :: flag_iter, flag_guess + logical, dimension(im), intent(in) :: flag_iter, flag_guess, land logical, intent(in) :: lheatstrg @@ -348,31 +348,26 @@ subroutine lsm_noah_run & & smcdry, smcref, smcmax, sneqv, snoalb1d, snowh, & & snomlt, sncovr, soilw, soilm, ssoil, tsea, th2, tbot, & & xlai, zlvl, swdn, tem, z0, bexpp, xlaip, vegfp, & - & mv,sv,alphav,betav,vegftmp + & mv, sv, alphav, betav, vegftmp, cpinv, hvapi, elocp integer :: couple, ice, nsoil, nroot, slope, stype, vtype integer :: i, k, iflag - - logical :: flag(im) ! !===> ... begin here ! + cpinv = 1.0/cp + hvapi = 1.0/hvap + elocp = hvap/cp !> - Initialize CCPP error handling variables errmsg = '' errflg = 0 -!> - Set flag for land points. - - do i = 1, im - flag(i) = (islimsk(i) == 1) - enddo - !> - Save land-related prognostic fields for guess run. do i = 1, im - if (flag(i) .and. flag_guess(i)) then + if (land(i) .and. flag_guess(i)) then weasd_old(i) = weasd(i) snwdph_old(i) = snwdph(i) tskin_old(i) = tskin(i) @@ -385,13 +380,13 @@ subroutine lsm_noah_run & stc_old(i,k) = stc(i,k) slc_old(i,k) = slc(i,k) enddo - endif + endif ! land & flag_guess enddo ! --- ... initialization block do i = 1, im - if (flag_iter(i) .and. flag(i)) then + if (flag_iter(i) .and. land(i)) then ep(i) = 0.0 evap (i) = 0.0 hflx (i) = 0.0 @@ -405,13 +400,13 @@ subroutine lsm_noah_run & sbsno(i) = 0.0 snowc(i) = 0.0 snohf(i) = 0.0 - endif + endif ! flag_iter & land enddo !> - initialize variables wind, q, and rh at level 1. do i = 1, im - if (flag_iter(i) .and. flag(i)) then + if (flag_iter(i) .and. land(i)) then wind(i) = max(sqrt( u1(i)*u1(i) + v1(i)*v1(i) ) & & + max(0.0, min(ddvel(i), 30.0)), 1.0) @@ -422,19 +417,19 @@ subroutine lsm_noah_run & qs1(i) = fpvs( t1(i) ) !* qs1=sat. humidity at level 1 (kg/kg) qs1(i) = max(eps*qs1(i) / (prsl1(i)+epsm1*qs1(i)), 1.e-8) q0 (i) = min(qs1(i), q0(i)) - endif + endif ! flag_iter & land enddo do i = 1, im - if (flag_iter(i) .and. flag(i)) then + if (flag_iter(i) .and. land(i)) then do k = 1, km zsoil(i,k) = zsoil_noah(k) enddo - endif + endif ! flag_iter & land enddo do i = 1, im - if (flag_iter(i) .and. flag(i)) then + if (flag_iter(i) .and. land(i)) then !> - Prepare variables to run Noah LSM: !! - 1. configuration information (c): @@ -516,7 +511,7 @@ subroutine lsm_noah_run & !! fraction is added to account for the uncertainty. A percentile matching technique !! is applied to guarantee the perturbed vegetation fraction is bounded between 0 and !! 1. The standard deviation of the perturbations is 0.25 for vegetation fraction of -!! 0.5 and the perturbations go to zero as vegetation fraction approaches its upper +!! 0.5 and the perturbations go to zero as vegetation fraction approaches its upper !! or lower bound. vegfp = vegfpert(i) ! sfc-perts, mgehne ! sfc perts, mgehne @@ -688,32 +683,32 @@ subroutine lsm_noah_run & !!\n nroot - number of root layers, a function of veg type, determined !! in subroutine redprm. - endif ! end if_flag_iter_and_flag_block + endif ! end if flag_iter and flag enddo ! end do_i_loop !> - Compute specific humidity at surface (\a qsurf). do i = 1, im - if (flag_iter(i) .and. flag(i)) then + if (flag_iter(i) .and. land(i)) then rch(i) = rho(i) * cp * ch(i) * wind(i) qsurf(i) = q1(i) + evap(i) / (elocp * rch(i)) - endif + endif ! flag_iter & land enddo !> - Compute surface upward sensible heat flux (\a hflx) and evaporation !! flux (\a evap). do i = 1, im - if (flag_iter(i) .and. flag(i)) then + if (flag_iter(i) .and. land(i)) then tem = 1.0 / rho(i) hflx(i) = hflx(i) * tem * cpinv evap(i) = evap(i) * tem * hvapi - endif + endif ! flag_iter & land enddo !> - Restore land-related prognostic fields for guess run. do i = 1, im - if (flag(i)) then + if (land(i)) then if (flag_guess(i)) then weasd(i) = weasd_old(i) snwdph(i) = snwdph_old(i) @@ -727,10 +722,10 @@ subroutine lsm_noah_run & stc(i,k) = stc_old(i,k) slc(i,k) = slc_old(i,k) enddo - else + else ! flag_guess = F tskin(i) = tsurf(i) - endif - endif + endif ! flag_guess + endif ! land enddo ! return diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index 4af1ab2c1..418b19a3b 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -27,24 +27,36 @@ end subroutine sfc_nst_finalize !! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | !! |----------------|------------------------------------------------------------------------------|-------------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| !! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | +!! | hvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | +!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | +!! | hfus | latent_heat_of_fusion_of_water_at_0C | latent heat of fusion | J kg-1 | 0 | real | kind_phys | in | F | +!! | jcal | joules_per_calorie_constant | joules per calorie constant | J cal-1 | 0 | real | kind_phys | in | F | +!! | eps | ratio_of_dry_air_to_water_vapor_gas_constants | rd/rv | none | 0 | real | kind_phys | in | F | +!! | epsm1 | ratio_of_dry_air_to_water_vapor_gas_constants_minus_one | (rd/rv) - 1 | none | 0 | real | kind_phys | in | F | +!! | rvrdm1 | ratio_of_vapor_to_dry_air_gas_constants_minus_one | (rv/rd) - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | +!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | +!! | rhw0 | sea_water_reference_density | sea water reference density | kg m-3 | 0 | real | kind_phys | in | F | +!! | sbc | steffan_boltzmann_constant | Steffan-Boltzmann constant | W m-2 K-4 | 0 | real | kind_phys | in | F | +!! | pi | pi | ratio of a circle's circumference to its diameter | radians | 0 | real | kind_phys | in | F | !! | ps | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | !! | u1 | x_wind_at_lowest_model_layer | x component of surface layer wind | m s-1 | 1 | real | kind_phys | in | F | !! | v1 | y_wind_at_lowest_model_layer | y component of surface layer wind | m s-1 | 1 | real | kind_phys | in | F | !! | t1 | air_temperature_at_lowest_model_layer | surface layer mean temperature | K | 1 | real | kind_phys | in | F | !! | q1 | water_vapor_specific_humidity_at_lowest_model_layer | surface layer mean specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | !! | tref | sea_surface_reference_temperature | reference/foundation temperature | K | 1 | real | kind_phys | in | F | -!! | cm | surface_drag_coefficient_for_momentum_in_air | surface exchange coeff for momentum | none | 1 | real | kind_phys | in | F | -!! | ch | surface_drag_coefficient_for_heat_and_moisture_in_air | surface exchange coeff heat & moisture | none | 1 | real | kind_phys | in | F | +!! | cm | surface_drag_coefficient_for_momentum_in_air_over_ocean | surface exchange coeff for momentum over ocean | none | 1 | real | kind_phys | in | F | +!! | ch | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean | surface exchange coeff heat & moisture over ocean | none | 1 | real | kind_phys | in | F | !! | prsl1 | air_pressure_at_lowest_model_layer | surface layer mean pressure | Pa | 1 | real | kind_phys | in | F | !! | prslki | ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer | Exner function ratio bt midlayer and interface at 1st layer | ratio | 1 | real | kind_phys | in | F | -!! | islimsk | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | +!! | wet | flag_nonzero_wet_surface_fraction | flag indicating presence of some ocean or lake surface area fraction | flag | 1 | logical | | in | F | +!! | icy | flag_nonzero_sea_ice_surface_fraction | flag indicating presence of some sea ice surface area fraction | flag | 1 | logical | | in | F | !! | xlon | longitude | longitude | radians | 1 | real | kind_phys | in | F | !! | sinlat | sine_of_latitude | sine of latitude | none | 1 | real | kind_phys | in | F | -!! | stress | surface_wind_stress | wind stress | m2 s-2 | 1 | real | kind_phys | in | F | +!! | stress | surface_wind_stress_over_ocean | surface wind stress over ocean | m2 s-2 | 1 | real | kind_phys | in | F | !! | sfcemis | surface_longwave_emissivity | surface longwave emissivity | frac | 1 | real | kind_phys | in | F | !! | dlwflx | surface_downwelling_longwave_flux_absorbed_by_ground | total sky sfc downward lw flux absorbed by the ocean | W m-2 | 1 | real | kind_phys | in | F | !! | sfcnsw | surface_net_downwelling_shortwave_flux | total sky sfc net sw flx into ocean | W m-2 | 1 | real | kind_phys | in | F | -!! | rain | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep | nonnegative precipitation amount on dyn time step | m | 1 | real | kind_phys | in | F | +!! | rain | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ocean | total precipitation amount in each time step over ocean | m | 1 | real | kind_phys | in | F | !! | timestep | time_step_for_dynamics | timestep interval | s | 0 | real | kind_phys | in | F | !! | kdt | index_of_time_step | current time step index | index | 0 | integer | | in | F | !! | solhr | forecast_hour | fcst hour at the end of prev time step | h | 0 | real | kind_phys | in | F | @@ -58,7 +70,7 @@ end subroutine sfc_nst_finalize !! | lprnt | flag_print | flag for printing diagnostics to output | flag | 0 | logical | | in | F | !! | ipr | horizontal_index_of_printed_column | horizontal index of printed column | index | 0 | integer | | in | F | !! | tskin | surface_skin_temperature_for_nsst | ocean surface skin temperature | K | 1 | real | kind_phys | inout | F | -!! | tsurf | surface_skin_temperature_after_iteration | ocean surface skin temperature for guess run | K | 1 | real | kind_phys | inout | F | +!! | tsurf | surface_skin_temperature_after_iteration_over_ocean | surface skin temperature after iteration over ocean | K | 1 | real | kind_phys | inout | F | !! | xt | diurnal_thermocline_layer_heat_content | heat content in diurnal thermocline layer | K m | 1 | real | kind_phys | inout | F | !! | xs | sea_water_salinity | salinity content in diurnal thermocline layer | ppt m | 1 | real | kind_phys | inout | F | !! | xu | diurnal_thermocline_layer_x_current | u-current content in diurnal thermocline layer | m2 s-1 | 1 | real | kind_phys | inout | F | @@ -76,21 +88,22 @@ end subroutine sfc_nst_finalize !! | d_conv | free_convection_layer_thickness | thickness of free convection layer | m | 1 | real | kind_phys | inout | F | !! | ifd | index_of_dtlm_start | index to start dtlm run or not | index | 1 | real | kind_phys | inout | F | !! | qrain | sensible_heat_flux_due_to_rainfall | sensible heat flux due to rainfall | W | 1 | real | kind_phys | inout | F | -!! | qsurf | surface_specific_humidity | surface air saturation specific humidity | kg kg-1 | 1 | real | kind_phys | inout | F | -!! | gflux | upward_heat_flux_in_soil | soil heat flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | cmm | surface_drag_wind_speed_for_momentum_in_air | surf mom exch coef time mean surf wind | m s-1 | 1 | real | kind_phys | inout | F | -!! | chh | surface_drag_mass_flux_for_heat_and_moisture_in_air | surf h&m exch coef time surf wind & density | kg m-2 s-1 | 1 | real | kind_phys | inout | F | -!! | evap | kinematic_surface_upward_latent_heat_flux | kinematic from latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | inout | F | -!! | hflx | kinematic_surface_upward_sensible_heat_flux | kinematic sensible heat flux | K m s-1 | 1 | real | kind_phys | inout | F | -!! | ep | surface_upward_potential_latent_heat_flux | potential evaporation | W m-2 | 1 | real | kind_phys | inout | F | +!! | qsurf | surface_specific_humidity_over_ocean | surface air saturation specific humidity over ocean | kg kg-1 | 1 | real | kind_phys | inout | F | +!! | gflux | upward_heat_flux_in_soil_over_ocean | soil heat flux over ocean | W m-2 | 1 | real | kind_phys | inout | F | +!! | cmm | surface_drag_wind_speed_for_momentum_in_air_over_ocean | momentum exchange coefficient over ocean | m s-1 | 1 | real | kind_phys | inout | F | +!! | chh | surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ocean | thermal exchange coefficient over ocean | kg m-2 s-1 | 1 | real | kind_phys | inout | F | +!! | evap | kinematic_surface_upward_latent_heat_flux_over_ocean | kinematic surface upward latent heat flux over ocean | kg kg-1 m s-1 | 1 | real | kind_phys | inout | F | +!! | hflx | kinematic_surface_upward_sensible_heat_flux_over_ocean | kinematic surface upward sensible heat flux over ocean | K m s-1 | 1 | real | kind_phys | inout | F | +!! | ep | surface_upward_potential_latent_heat_flux_over_ocean | surface upward potential latent heat flux over ocean | W m-2 | 1 | real | kind_phys | inout | F | !! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | !! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! !! \section NSST_general_algorithm GFS Near-Surface Sea Temperature Scheme General Algorithm !> @{ subroutine sfc_nst_run & - & ( im, ps, u1, v1, t1, q1, tref, cm, ch, & - & prsl1, prslki, islimsk, xlon, sinlat, stress, & + & ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & + & pi, sbc, ps, u1, v1, t1, q1, tref, cm, ch, & + & prsl1, prslki, wet, icy, xlon, sinlat, stress, & & sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, & & ddvel, flag_iter, flag_guess, nstf_name1, nstf_name4, & & nstf_name5, lprnt, ipr, & ! inputs from here and above @@ -108,7 +121,7 @@ subroutine sfc_nst_run & ! call sfc_nst ! ! inputs: ! ! ( im, ps, u1, v1, t1, q1, tref, cm, ch, ! -! prsl1, prslki, islimsk, xlon, sinlat, stress, ! +! prsl1, prslki, iwet, iice, xlon, sinlat, stress, ! ! sfcemis, dlwflx, sfcnsw, rain, timestep, kdt,solhr,xcosz, ! ! ddvel, flag_iter, flag_guess, nstf_name1, nstf_name4, ! ! nstf_name5, lprnt, ipr, ! @@ -152,7 +165,8 @@ subroutine sfc_nst_run & ! ch - real, surface exchange coeff heat & moisture(m/s) im ! ! prsl1 - real, surface layer mean pressure (pa) im ! ! prslki - real, im ! -! islimsk - integer, sea/land/ice mask (=0/1/2) im ! +! wet - logical, =T if any ocn/lak water (F otherwise) im ! +! icy - logical, =T if "enough" ice (F otherwise) im ! ! xlon - real, longitude (radians) im ! ! sinlat - real, sin of latitude im ! ! stress - real, wind stress (n/m**2) im ! @@ -221,11 +235,6 @@ subroutine sfc_nst_run & ! ===================================================================== ! use machine , only : kind_phys use funcphys, only : fpvs - use physcons, hvap => con_hvap & - &, cp => con_cp, hfus => con_hfus, jcal => con_jcal & - &, eps => con_eps, epsm1 => con_epsm1 & - &, rvrdm1 => con_fvirt, rd => con_rd & - &, rhw0 => con_rhw0,sbc => con_sbc,pi => con_pi use date_def, only: idate use module_nst_water_prop, only: get_dtzm_point use module_nst_parameters, only : t0k,cp_w,omg_m,omg_sh, & @@ -242,7 +251,6 @@ subroutine sfc_nst_run & implicit none ! ! --- constant parameters: - real (kind=kind_phys), parameter :: cpinv=1.0/cp, hvapi=1.0/hvap real (kind=kind_phys), parameter :: f24 = 24.0 ! hours/day real (kind=kind_phys), parameter :: f1440 = 1440.0 ! minutes/day real (kind=kind_phys), parameter :: czmin = 0.0001 ! cos(89.994) @@ -251,14 +259,17 @@ subroutine sfc_nst_run & ! --- inputs: integer, intent(in) :: im, kdt, ipr, nstf_name1, nstf_name4, & & nstf_name5 + real (kind=kind_phys), intent(in) :: hvap, cp, hfus, jcal, eps, + & epsm1, rvrdm1, rd, rhw0, sbc, pi real (kind=kind_phys), dimension(im), intent(in) :: ps, u1, v1, & & t1, q1, tref, cm, ch, prsl1, prslki, xlon,xcosz, & & sinlat, stress, sfcemis, dlwflx, sfcnsw, rain, ddvel - integer, intent(in), dimension(im):: islimsk real (kind=kind_phys), intent(in) :: timestep real (kind=kind_phys), intent(in) :: solhr - logical, intent(in) :: flag_iter(im), flag_guess(im), lprnt + logical, dimension(im), intent(in) :: flag_iter, flag_guess, wet, & + & icy + logical, intent(in) :: lprnt ! --- input/outputs: ! control variables of dtl system (5+2) and sl (2) and coefficients for d(tz)/d(ts) calculation @@ -281,7 +292,7 @@ subroutine sfc_nst_run & real (kind=kind_phys), dimension(im) :: q0, qss, rch, & rho_a, theta1, tv1, wind, wndmag - real(kind=kind_phys) elocp,tem + real(kind=kind_phys) elocp,tem,cpinv,hvapi ! ! nstm related prognostic fields ! @@ -307,24 +318,26 @@ subroutine sfc_nst_run & integer :: iw3jdn !====================================================================================================== cc - parameter (elocp=hvap/cp) - ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + cpinv=1.0/cp + hvapi=1.0/hvap + elocp=hvap/cp + sss = 34.0 ! temporarily, when sea surface salinity data is not ready ! ! flag for open water and where the iteration is on ! do i = 1, im - flag(i) = islimsk(i) == 0 .and. flag_iter(i) + flag(i) = wet(i) .and. .not.icy(i) .and. flag_iter(i) enddo ! ! save nst-related prognostic fields for guess run ! do i=1, im - if((islimsk(i) == 0) .and. flag_guess(i)) then + if(wet(i) .and. .not.icy(i) .and. flag_guess(i)) then xt_old(i) = xt(i) xs_old(i) = xs(i) xu_old(i) = xu(i) @@ -434,7 +447,7 @@ subroutine sfc_nst_run & rf_ts = (1000.*rain(i)/rho_w)*alfac*cp_w*(1.0+rch(i)*hl_ts) q_ts = rnl_ts + hs_ts + hl_ts + omg_sh*rf_ts ! -!> - Call cool_skin(), which is the sub-layer cooling parameterization +!> - Call cool_skin(), which is the sub-layer cooling parameterization !! (Fairfall et al. (1996) \cite fairall_et_al_1996). ! & calculate c_0, c_d ! @@ -633,7 +646,7 @@ subroutine sfc_nst_run & ! restore nst-related prognostic fields for guess run do i=1, im - if((islimsk(i) == 0) ) then + if(wet(i) .and. .not.icy(i)) then if(flag_guess(i)) then ! when it is guess of xt(i) = xt_old(i) xs(i) = xs_old(i) @@ -656,7 +669,7 @@ subroutine sfc_nst_run & tskin(i) = tsurf(i) endif ! if ( nstf_name1 > 1 then endif ! if(flag_guess(i)) then - endif ! if((islimsk(i).eq. 0.) ) then + endif ! if(wet(i) .and. .not.icy(i)) then enddo ! if (lprnt .and. i == ipr) print *,' beg xz8=',xz(i) @@ -714,40 +727,67 @@ subroutine sfc_nst_pre_finalize end subroutine sfc_nst_pre_finalize !! \section arg_table_sfc_nst_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|----------------------------------------------- |-------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | islimsk | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | -!! | oro | orography | orography | m | 1 | real | kind_phys | in | F | -!! | oro_uf | orography_unfiltered | unfiltered orographyo | m | 1 | real | kind_phys | in | F | -!! | tsfc | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | -!! | tsurf | surface_skin_temperature_after_iteration | ocean surface skin temperature for guess run | K | 1 | real | kind_phys | inout | F | -!! | tskin | surface_skin_temperature_for_nsst | ocean surface skin temperature | K | 1 | real | kind_phys | out | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|-------------------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------|-----------|--------|----------| +!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | +!! | rlapse | air_temperature_lapse_rate_constant | environmental air temperature lapse rate constant | K m-1 | 0 | real | kind_phys | in | F | +!! | icy | flag_nonzero_sea_ice_surface_fraction | flag indicating presence of some sea ice surface area fraction | flag | 1 | logical | | in | F | +!! | wet | flag_nonzero_wet_surface_fraction | flag indicating presence of some ocean or lake surface area fraction | flag | 1 | logical | | in | F | +!! | zorl_ocn | surface_roughness_length_over_ocean_interstitial | surface roughness length over ocean (temporary use as interstitial) | cm | 1 | real | kind_phys | inout | F | +!! | zorl_ice | surface_roughness_length_over_ice_interstitial | surface roughness length over ice (temporary use as interstitial) | cm | 1 | real | kind_phys | in | F | +!! | cd_ocn | surface_drag_coefficient_for_momentum_in_air_over_ocean | surface exchange coeff for momentum over ocean | none | 1 | real | kind_phys | inout | F | +!! | cd_ice | surface_drag_coefficient_for_momentum_in_air_over_ice | surface exchange coeff for momentum over ice | none | 1 | real | kind_phys | in | F | +!! | cdq_ocn | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean | surface exchange coeff heat & moisture over ocean | none | 1 | real | kind_phys | inout | F | +!! | cdq_ice | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice | surface exchange coeff heat & moisture over ice | none | 1 | real | kind_phys | in | F | +!! | rb_ocn | bulk_richardson_number_at_lowest_model_level_over_ocean | bulk Richardson number at the surface over ocean | none | 1 | real | kind_phys | inout | F | +!! | rb_ice | bulk_richardson_number_at_lowest_model_level_over_ice | bulk Richardson number at the surface over ice | none | 1 | real | kind_phys | in | F | +!! | stress_ocn | surface_wind_stress_over_ocean | surface wind stress over ocean | m2 s-2 | 1 | real | kind_phys | inout | F | +!! | stress_ice | surface_wind_stress_over_ice | surface wind stress over ice | m2 s-2 | 1 | real | kind_phys | in | F | +!! | ffmm_ocn | Monin-Obukhov_similarity_function_for_momentum_over_ocean | Monin-Obukhov similarity function for momentum over ocean | none | 1 | real | kind_phys | inout | F | +!! | ffmm_ice | Monin-Obukhov_similarity_function_for_momentum_over_ice | Monin-Obukhov similarity function for momentum over ice | none | 1 | real | kind_phys | in | F | +!! | ffhh_ocn | Monin-Obukhov_similarity_function_for_heat_over_ocean | Monin-Obukhov similarity function for heat over ocean | none | 1 | real | kind_phys | inout | F | +!! | ffhh_ice | Monin-Obukhov_similarity_function_for_heat_over_ice | Monin-Obukhov similarity function for heat over ice | none | 1 | real | kind_phys | in | F | +!! | uustar_ocn | surface_friction_velocity_over_ocean | surface friction velocity over ocean | m s-1 | 1 | real | kind_phys | inout | F | +!! | uustar_ice | surface_friction_velocity_over_ice | surface friction velocity over ice | m s-1 | 1 | real | kind_phys | in | F | +!! | fm10_ocn | Monin-Obukhov_similarity_function_for_momentum_at_10m_over_ocean | Monin-Obukhov similarity parameter for momentum at 10m over ocean | none | 1 | real | kind_phys | inout | F | +!! | fm10_ice | Monin-Obukhov_similarity_function_for_momentum_at_10m_over_ice | Monin-Obukhov similarity parameter for momentum at 10m over ice | none | 1 | real | kind_phys | in | F | +!! | fh2_ocn | Monin-Obukhov_similarity_function_for_heat_at_2m_over_ocean | Monin-Obukhov similarity parameter for heat at 2m over ocean | none | 1 | real | kind_phys | inout | F | +!! | fh2_ice | Monin-Obukhov_similarity_function_for_heat_at_2m_over_ice | Monin-Obukhov similarity parameter for heat at 2m over ice | none | 1 | real | kind_phys | in | F | +!! | oro | orography | orography | m | 1 | real | kind_phys | in | F | +!! | oro_uf | orography_unfiltered | unfiltered orographyo | m | 1 | real | kind_phys | in | F | +!! | tsfc_ocn | surface_skin_temperature_over_ocean_interstitial | surface skin temperature over ocean (temporary use as interstitial) | K | 1 | real | kind_phys | in | F | +!! | tsurf_ocn | surface_skin_temperature_after_iteration_over_ocean | surface skin temperature after iteration over ocean | K | 1 | real | kind_phys | inout | F | +!! | tseal | surface_skin_temperature_for_nsst | ocean surface skin temperature | K | 1 | real | kind_phys | inout | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! !> \section NSST_general_pre_algorithm General Algorithm !! @{ - subroutine sfc_nst_pre_run & - & (im, islimsk, oro, oro_uf, tsfc, tsurf, tskin, errmsg, errflg) + subroutine sfc_nst_pre_run + & (im, rlapse, icy, wet, zorl_ocn, zorl_ice, cd_ocn, cd_ice, + & cdq_ocn, cdq_ice, rb_ocn, rb_ice, stress_ocn, stress_ice, + & ffmm_ocn, ffmm_ice, ffhh_ocn, ffhh_ice, uustar_ocn, + & uustar_ice, fm10_ocn, fm10_ice, fh2_ocn, fh2_ice, oro, + & oro_uf, tsfc_ocn, tsurf_ocn, tseal, errmsg, errflg) use machine , only : kind_phys - use physcons, only: rlapse implicit none ! --- inputs: integer, intent(in) :: im - integer, dimension(im), intent(in) :: islimsk - real (kind=kind_phys), dimension(im), intent(in) :: oro, oro_uf - real (kind=kind_phys), dimension(im), intent(in) :: tsfc + logical, dimension(im), intent(in) :: icy, wet + real (kind=kind_phys), intent(in) :: rlapse + real (kind=kind_phys), dimension(im), intent(in) :: zorl_ice, + & cd_ice, cdq_ice, rb_ice, stress_ice, ffmm_ice, ffhh_ice, + & uustar_ice, fm10_ice, fh2_ice, oro, oro_uf, tsfc_ocn ! --- input/outputs: - real (kind=kind_phys), dimension(im), intent(inout) :: tsurf + real (kind=kind_phys), dimension(im), intent(inout) :: tsurf_ocn, + & zorl_ocn, cd_ocn, cdq_ocn, rb_ocn, stress_ocn, ffmm_ocn, + & ffhh_ocn, uustar_ocn, fm10_ocn, fh2_ocn, tseal ! --- outputs: - real (kind=kind_phys), dimension(im), intent(out) :: tskin - character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -759,14 +799,26 @@ subroutine sfc_nst_pre_run & errmsg = '' errflg = 0 - ! Initialize intent(out) variables - tskin = 0.0 + do i=1,im + if(icy(i)) then + zorl_ocn(i) = zorl_ice(i) + cd_ocn(i) = cd_ice(i) + cdq_ocn(i) = cdq_ice(i) + rb_ocn(i) = rb_ice(i) + stress_ocn(i) = stress_ice(i) + ffmm_ocn(i) = ffmm_ice(i) + ffhh_ocn(i) = ffhh_ice(i) + uustar_ocn(i) = uustar_ice(i) + fm10_ocn(i) = fm10_ice(i) + fh2_ocn(i) = fh2_ice(i) + endif + enddo - do i = 1, im - if ( islimsk(i) == 0 ) then + do i=1,im + if (wet(i) .and. .not. icy(i)) then tem = (oro(i)-oro_uf(i)) * rlapse - tskin(i) = tsfc(i) + tem - tsurf(i) = tsurf(i) + tem + tseal(i) = tsfc_ocn(i) + tem + tsurf_ocn(i) = tsurf_ocn(i) + tem endif enddo @@ -799,59 +851,60 @@ end subroutine sfc_nst_post_finalize !> \brief Brief description of the subroutine !! !! \section arg_table_sfc_nst_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|----------------------------------------------- |---------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | islimsk | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | -!! | oro | orography | orography | m | 1 | real | kind_phys | in | F | -!! | oro_uf | orography_unfiltered | unfiltered orography | m | 1 | real | kind_phys | in | F | -!! | nstf_name1 | flag_for_nsstm_run | NSSTM flag: off/uncoupled/coupled=0/1/2 | flag | 0 | integer | | in | F | -!! | nstf_name4 | vertical_temperature_average_range_lower_bound | zsea1 | mm | 0 | integer | | in | F | -!! | nstf_name5 | vertical_temperature_average_range_upper_bound | zsea2 | mm | 0 | integer | | in | F | -!! | xt | diurnal_thermocline_layer_heat_content | heat content in diurnal thermocline layer | K m | 1 | real | kind_phys | in | F | -!! | xz | diurnal_thermocline_layer_thickness | diurnal thermocline layer thickness | m | 1 | real | kind_phys | in | F | -!! | dt_cool | sub-layer_cooling_amount | sub-layer cooling amount | K | 1 | real | kind_phys | in | F | -!! | z_c | sub-layer_cooling_thickness | sub-layer cooling thickness | m | 1 | real | kind_phys | in | F | -!! | rslimsk | sea_land_ice_mask_real | landmask: sea/land/ice=0/1/2 | flag | 1 | real | kind_phys | in | F | -!! | tref | sea_surface_reference_temperature | reference/foundation temperature | K | 1 | real | kind_phys | in | F | -!! | xlon | longitude | longitude | radians | 1 | real | kind_phys | in | F | -!! | tsurf | surface_skin_temperature_after_iteration | ocean surface skin temperature for guess run | K | 1 | real | kind_phys | inout | F | -!! | dtzm | mean_change_over_depth_in_sea_water_temperature | mean of dT(z) (zsea1 to zsea2) | K | 1 | real | kind_phys | out | F | -!! | tsfc | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|----------------------------------------------------------------------|---------|------|-----------|-----------|--------|----------| +!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | +!! | rlapse | air_temperature_lapse_rate_constant | environmental air temperature lapse rate constant | K m-1 | 0 | real | kind_phys | in | F | +!! | wet | flag_nonzero_wet_surface_fraction | flag indicating presence of some ocean or lake surface area fraction | flag | 1 | logical | | in | F | +!! | icy | flag_nonzero_sea_ice_surface_fraction | flag indicating presence of some sea ice surface area fraction | flag | 1 | logical | | in | F | +!! | oro | orography | orography | m | 1 | real | kind_phys | in | F | +!! | oro_uf | orography_unfiltered | unfiltered orography | m | 1 | real | kind_phys | in | F | +!! | nstf_name1 | flag_for_nsstm_run | NSSTM flag: off/uncoupled/coupled=0/1/2 | flag | 0 | integer | | in | F | +!! | nstf_name4 | vertical_temperature_average_range_lower_bound | zsea1 | mm | 0 | integer | | in | F | +!! | nstf_name5 | vertical_temperature_average_range_upper_bound | zsea2 | mm | 0 | integer | | in | F | +!! | xt | diurnal_thermocline_layer_heat_content | heat content in diurnal thermocline layer | K m | 1 | real | kind_phys | in | F | +!! | xz | diurnal_thermocline_layer_thickness | diurnal thermocline layer thickness | m | 1 | real | kind_phys | in | F | +!! | dt_cool | sub-layer_cooling_amount | sub-layer cooling amount | K | 1 | real | kind_phys | in | F | +!! | z_c | sub-layer_cooling_thickness | sub-layer cooling thickness | m | 1 | real | kind_phys | in | F | +!! | tref | sea_surface_reference_temperature | reference/foundation temperature | K | 1 | real | kind_phys | in | F | +!! | xlon | longitude | longitude | radians | 1 | real | kind_phys | in | F | +!! | tsurf_ocn | surface_skin_temperature_after_iteration_over_ocean | surface skin temperature after iteration over ocean | K | 1 | real | kind_phys | inout | F | +!! | tsfc_ocn | surface_skin_temperature_over_ocean_interstitial | surface skin temperature over ocean (temporary use as interstitial) | K | 1 | real | kind_phys | inout | F | +!! | dtzm | mean_change_over_depth_in_sea_water_temperature | mean of dT(z) (zsea1 to zsea2) | K | 1 | real | kind_phys | out | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! ! \section NSST_general_post_algorithm General Algorithm ! ! \section NSST_detailed_post_algorithm Detailed Algorithm ! @{ subroutine sfc_nst_post_run & - & ( im, islimsk, oro, oro_uf, nstf_name1, nstf_name4, & - & nstf_name5, xt, xz, dt_cool, z_c, rslimsk, tref, xlon, & - & tsurf, dtzm, tsfc, errmsg, errflg & + & ( im, rlapse, wet, icy, oro, oro_uf, nstf_name1, & + & nstf_name4, nstf_name5, xt, xz, dt_cool, z_c, tref, xlon, & + & tsurf_ocn, tsfc_ocn, dtzm, errmsg, errflg & & ) use machine , only : kind_phys - use physcons, only: rlapse use module_nst_water_prop, only: get_dtzm_2d implicit none ! --- inputs: integer, intent(in) :: im - integer, dimension(im), intent(in) :: islimsk + logical, dimension(im), intent(in) :: wet, icy + real (kind=kind_phys), intent(in) :: rlapse real (kind=kind_phys), dimension(im), intent(in) :: oro, oro_uf integer, intent(in) :: nstf_name1, nstf_name4, nstf_name5 real (kind=kind_phys), dimension(im), intent(in) :: xt, xz, & - & dt_cool, z_c, rslimsk, tref, xlon + & dt_cool, z_c, tref, xlon ! --- input/outputs: - real (kind=kind_phys), dimension(im), intent(inout) :: tsurf + real (kind=kind_phys), dimension(im), intent(inout) :: tsurf_ocn, & + & tsfc_ocn ! --- outputs: real (kind=kind_phys), dimension(size(xlon,1)), intent(out) :: & & dtzm - real (kind=kind_phys), dimension(im), intent(inout) :: tsfc character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -869,8 +922,8 @@ subroutine sfc_nst_post_run & ! & ' kdt=',kdt do i = 1, im - if ( islimsk(i) == 0 ) then - tsurf(i) = tsurf(i) - (oro(i)-oro_uf(i)) * rlapse + if (wet(i) .and. .not. icy(i)) then + tsurf_ocn(i) = tsurf_ocn(i) - (oro(i)-oro_uf(i)) * rlapse endif enddo @@ -881,11 +934,11 @@ subroutine sfc_nst_post_run & zsea1 = 0.001*real(nstf_name4) zsea2 = 0.001*real(nstf_name5) call get_dtzm_2d (xt, xz, dt_cool, & - & z_c, rslimsk, zsea1, zsea2, & + & z_c, wet, icy, zsea1, zsea2, & & im, 1, dtzm) do i = 1, im - if ( islimsk(i) == 0 ) then - tsfc(i) = max(271.2,tref(i) + dtzm(i)) - & + if ( wet(i) .and. .not. icy(i) ) then + tsfc_ocn(i) = max(271.2,tref(i) + dtzm(i)) - & & (oro(i)-oro_uf(i))*rlapse endif enddo diff --git a/physics/sfc_ocean.F b/physics/sfc_ocean.F index 3a7ed5470..a0a835555 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -17,38 +17,46 @@ end subroutine sfc_ocean_finalize #if 0 !! \section arg_table_sfc_ocean_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|------------------------------------------------------------------------------|-------------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | ps | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | u1 | x_wind_at_lowest_model_layer | x component of surface layer wind | m s-1 | 1 | real | kind_phys | in | F | -!! | v1 | y_wind_at_lowest_model_layer | y component of surface layer wind | m s-1 | 1 | real | kind_phys | in | F | -!! | t1 | air_temperature_at_lowest_model_layer | surface layer mean temperature | K | 1 | real | kind_phys | in | F | -!! | q1 | water_vapor_specific_humidity_at_lowest_model_layer | surface layer mean specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | -!! | tskin | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | -!! | cm | surface_drag_coefficient_for_momentum_in_air | surface exchange coeff for momentum | none | 1 | real | kind_phys | in | F | -!! | ch | surface_drag_coefficient_for_heat_and_moisture_in_air | surface exchange coeff heat & moisture | none | 1 | real | kind_phys | in | F | -!! | prsl1 | air_pressure_at_lowest_model_layer | surface layer mean pressure | Pa | 1 | real | kind_phys | in | F | -!! | prslki | ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer | Exner function ratio bt midlayer and interface at 1st layer | ratio | 1 | real | kind_phys | in | F | -!! | islimsk | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | -!! | ddvel | surface_wind_enhancement_due_to_convection | wind enhancement due to convection | m s-1 | 1 | real | kind_phys | in | F | -!! | flag_iter | flag_for_iteration | flag for iteration | flag | 1 | logical | | in | F | -!! | qsurf | surface_specific_humidity | surface air saturation specific humidity | kg kg-1 | 1 | real | kind_phys | inout | F | -!! | cmm | surface_drag_wind_speed_for_momentum_in_air | surf mom exch coef time mean surf wind | m s-1 | 1 | real | kind_phys | inout | F | -!! | chh | surface_drag_mass_flux_for_heat_and_moisture_in_air | surf h&m exch coef time surf wind & density | kg m-2 s-1 | 1 | real | kind_phys | inout | F | -!! | gflux | upward_heat_flux_in_soil | soil heat flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | evap | kinematic_surface_upward_latent_heat_flux | kinematic from latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | inout | F | -!! | hflx | kinematic_surface_upward_sensible_heat_flux | kinematic sensible heat flux | K m s-1 | 1 | real | kind_phys | inout | F | -!! | ep | surface_upward_potential_latent_heat_flux | potential evaporation | W m-2 | 1 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|------------------------------------------------------------------------------|----------------------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| +!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | +!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | +!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | +!! | eps | ratio_of_dry_air_to_water_vapor_gas_constants | rd/rv | none | 0 | real | kind_phys | in | F | +!! | epsm1 | ratio_of_dry_air_to_water_vapor_gas_constants_minus_one | (rd/rv) - 1 | none | 0 | real | kind_phys | in | F | +!! | hvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | +!! | rvrdm1 | ratio_of_vapor_to_dry_air_gas_constants_minus_one | (rv/rd) - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | +!! | ps | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | +!! | u1 | x_wind_at_lowest_model_layer | x component of surface layer wind | m s-1 | 1 | real | kind_phys | in | F | +!! | v1 | y_wind_at_lowest_model_layer | y component of surface layer wind | m s-1 | 1 | real | kind_phys | in | F | +!! | t1 | air_temperature_at_lowest_model_layer | surface layer mean temperature | K | 1 | real | kind_phys | in | F | +!! | q1 | water_vapor_specific_humidity_at_lowest_model_layer | surface layer mean specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | +!! | tskin | surface_skin_temperature_over_ocean_interstitial | surface skin temperature over ocean (temporary use as interstitial) | K | 1 | real | kind_phys | in | F | +!! | cm | surface_drag_coefficient_for_momentum_in_air_over_ocean | surface exchange coeff for momentum over ocean | none | 1 | real | kind_phys | in | F | +!! | ch | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean | surface exchange coeff heat & moisture over ocean | none | 1 | real | kind_phys | in | F | +!! | prsl1 | air_pressure_at_lowest_model_layer | surface layer mean pressure | Pa | 1 | real | kind_phys | in | F | +!! | prslki | ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer | Exner function ratio bt midlayer and interface at 1st layer | ratio | 1 | real | kind_phys | in | F | +!! | wet | flag_nonzero_wet_surface_fraction | flag indicating presence of some ocean or lake surface area fraction | flag | 1 | logical | | in | F | +!! | fice | sea_ice_concentration | ice fraction over open water | frac | 1 | real | kind_phys | in | F | +!! | ddvel | surface_wind_enhancement_due_to_convection | wind enhancement due to convection | m s-1 | 1 | real | kind_phys | in | F | +!! | flag_iter | flag_for_iteration | flag for iteration | flag | 1 | logical | | in | F | +!! | qsurf | surface_specific_humidity_over_ocean | surface air saturation specific humidity over ocean | kg kg-1 | 1 | real | kind_phys | inout | F | +!! | cmm | surface_drag_wind_speed_for_momentum_in_air_over_ocean | momentum exchange coefficient over ocean | m s-1 | 1 | real | kind_phys | inout | F | +!! | chh | surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ocean | thermal exchange coefficient over ocean | kg m-2 s-1 | 1 | real | kind_phys | inout | F | +!! | gflux | upward_heat_flux_in_soil_over_ocean | soil heat flux over ocean | W m-2 | 1 | real | kind_phys | inout | F | +!! | evap | kinematic_surface_upward_latent_heat_flux_over_ocean | kinematic surface upward latent heat flux over ocean | kg kg-1 m s-1 | 1 | real | kind_phys | inout | F | +!! | hflx | kinematic_surface_upward_sensible_heat_flux_over_ocean | kinematic surface upward sensible heat flux over ocean | K m s-1 | 1 | real | kind_phys | inout | F | +!! | ep | surface_upward_potential_latent_heat_flux_over_ocean | surface upward potential latent heat flux over ocean | W m-2 | 1 | real | kind_phys | inout | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! #endif subroutine sfc_ocean_run & !................................... ! --- inputs: - & ( im, ps, u1, v1, t1, q1, tskin, cm, ch, & - & prsl1, prslki, islimsk, ddvel, flag_iter, & + & ( im, cp, rd, eps, epsm1, hvap, rvrdm1, ps, u1, v1, t1, q1, & + & tskin, cm, ch, prsl1, prslki, wet, fice, ddvel, & + & flag_iter, & ! --- outputs: & qsurf, cmm, chh, gflux, evap, hflx, ep, & & errmsg, errflg & @@ -62,7 +70,7 @@ subroutine sfc_ocean_run & ! call sfc_ocean ! ! inputs: ! ! ( im, ps, u1, v1, t1, q1, tskin, cm, ch, ! -! prsl1, prslki, islimsk, ddvel, flag_iter, ! +! prsl1, prslki, wet, fice, ddvel, flag_iter, ! ! outputs: ! ! qsurf, cmm, chh, gflux, evap, hflx, ep ) ! ! ! @@ -93,7 +101,8 @@ subroutine sfc_ocean_run & ! ch - real, surface exchange coeff heat & moisture(m/s) im ! ! prsl1 - real, surface layer mean pressure im ! ! prslki - real, im ! -! islimsk - integer, sea/land/ice mask (=0/1/2) im ! +! wet - logical, =T if any ocean/lak, =F otherwise im ! +! fice - real, ice fraction im ! ! ddvel - real, wind enhancement due to convection (m/s) im ! ! flag_iter- logical, im ! ! ! @@ -110,26 +119,18 @@ subroutine sfc_ocean_run & ! use machine , only : kind_phys use funcphys, only : fpvs - ! DH* TODO - replace constants with arguments to subroutine - use physcons, only : cp => con_cp, rd => con_rd, eps => con_eps, & - & epsm1 => con_epsm1, hvap => con_hvap, & - & rvrdm1 => con_fvirt ! implicit none -! -! --- constant parameters: - real (kind=kind_phys), parameter :: cpinv = 1.0/cp & - &, hvapi = 1.0/hvap & - &, elocp = hvap/cp ! --- inputs: integer, intent(in) :: im + real (kind=kind_phys), intent(in) :: cp, rd, eps, epsm1, hvap, & + & rvrdm1 real (kind=kind_phys), dimension(im), intent(in) :: ps, u1, v1, & - & t1, q1, tskin, cm, ch, prsl1, prslki, ddvel - integer, dimension(im), intent(in):: islimsk + & t1, q1, tskin, cm, ch, prsl1, prslki, ddvel, fice - logical, intent(in) :: flag_iter(im) + logical, dimension(im), intent(in) :: flag_iter, wet ! --- outputs: real (kind=kind_phys), dimension(im), intent(inout) :: qsurf, & @@ -140,13 +141,17 @@ subroutine sfc_ocean_run & ! --- locals: - real (kind=kind_phys) :: q0, qss, rch, rho, wind, tem + real (kind=kind_phys) :: q0, qss, rch, rho, wind, tem, cpinv, & + & hvapi, elocp integer :: i logical :: flag(im) ! !===> ... begin here + cpinv = 1.0/cp + hvapi = 1.0/hvap + elocp = hvap/cp ! ! -- ... initialize CCPP error handling variables errmsg = '' @@ -154,10 +159,10 @@ subroutine sfc_ocean_run & ! ! --- ... flag for open water do i = 1, im - flag(i) = ( islimsk(i) == 0 .and. flag_iter(i) ) + flag(i) = (wet(i) .and. fice(i)<1. .and. flag_iter(i)) ! --- ... initialize variables. all units are supposedly m.k.s. unless specified -! ps is in pascals, wind is wind speed, +! ps is in pascals, wind is wind speed, ! rho is density, qss is sat. hum. at surface if ( flag(i) ) then @@ -199,4 +204,4 @@ subroutine sfc_ocean_run & !................................... end subroutine sfc_ocean_run !----------------------------------- - end module sfc_ocean \ No newline at end of file + end module sfc_ocean diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index c77160c50..cef6b3c83 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -1,7 +1,7 @@ !> \file sfc_sice.f !! This file contains the GFS three level thermodynamic sea ice model. -!> This module comtains the CCPP-compliant GFS sea ice post interstitial codes, which returns +!> This module comtains the CCPP-compliant GFS sea ice post interstitial codes, which returns !! updated ice thickness and concentration to global arrays !! where there is no ice, and set temperature to surface skin temperature. module sfc_sice_post @@ -19,28 +19,31 @@ subroutine sfc_sice_post_finalize end subroutine sfc_sice_post_finalize !! \section arg_table_sfc_sice_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------------------|---------------------------------------------|-------|------|-----------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | islmsk | sea_land_ice_mask | sea/land/ice mask (=0/1/2) | flag | 1 | integer | | in | F | -!! | tsfc | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | -!! | fice | sea_ice_concentration | sea-ice concentration [0,1] | frac | 1 | real | kind_phys | inout | F | -!! | hice | sea_ice_thickness | sea-ice thickness | m | 1 | real | kind_phys | inout | F | -!! | tisfc | sea_ice_temperature | sea-ice surface temperature | K | 1 | real | kind_phys | inout | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|-------------------------------------------------------|---------------------------------------------------|-------|------|-----------|-----------|--------|----------| +!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | +!! | cplflx | flag_for_flux_coupling | flag controlling cplflx collection (default off) | flag | 0 | logical | | in | F | +!! | islmsk | sea_land_ice_mask | sea/land/ice mask (=0/1/2) | flag | 1 | integer | | in | F | +!! | tice | sea_ice_temperature_interstitial | sea-ice surface temperature use as interstitial | K | 1 | real | kind_phys | in | F | +!! | tsfc | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | +!! | fice | sea_ice_concentration | sea-ice concentration [0,1] | frac | 1 | real | kind_phys | inout | F | +!! | hice | sea_ice_thickness | sea-ice thickness | m | 1 | real | kind_phys | inout | F | +!! | tisfc | sea_ice_temperature | sea-ice surface temperature | K | 1 | real | kind_phys | inout | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! - subroutine sfc_sice_post_run(im, islmsk, tsfc, fice, hice, tisfc, & - & errmsg, errflg) + subroutine sfc_sice_post_run(im, cplflx, islmsk, tice, tsfc, & + & fice, hice, tisfc, errmsg, errflg) use machine, only : kind_phys implicit none ! --- input - integer :: im - integer, dimension(im) :: islmsk - real(kind=kind_phys), dimension(im), intent(in) :: tsfc + integer, intent(in) :: im + logical, intent(in) :: cplflx + integer, dimension(im), intent(in) :: islmsk + real(kind=kind_phys), dimension(im), intent(in) :: tice, tsfc ! --- input/output real(kind=kind_phys), dimension(im), intent(inout) :: fice, hice, & @@ -58,13 +61,17 @@ subroutine sfc_sice_post_run(im, islmsk, tsfc, fice, hice, tisfc, & !--- return updated ice thickness & concentration to global arrays ! where there is no ice, set temperature to surface skin temperature. - do i = 1, im - if (islmsk(i) /= 2) then - hice(i) = 0.0 - fice(i) = 0.0 - tisfc(i) = tsfc(i) - endif - enddo + if(.not. cplflx) then + do i = 1, im + if (islmsk(i) == 2) then + tisfc(i) = tice(i) + else + hice(i) = 0.0 + fice(i) = 0.0 + tisfc(i) = tsfc(i) + endif + enddo + endif end subroutine sfc_sice_post_run @@ -78,7 +85,6 @@ module sfc_sice subroutine sfc_sice_init end subroutine sfc_sice_init ! - subroutine sfc_sice_finalize end subroutine sfc_sice_finalize @@ -91,6 +97,17 @@ end subroutine sfc_sice_finalize !! |----------------|------------------------------------------------------------------------------|-----------------------------------------------------------------|---------------|------|-----------|-----------|--------|----------| !! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | !! | km | soil_vertical_dimension | vertical loop extent for soil levels, start at 1 | count | 0 | integer | | in | F | +!! | sbc | steffan_boltzmann_constant | Steffan-Boltzmann constant | W m-2 K-4 | 0 | real | kind_phys | in | F | +!! | hvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | +!! | tgice | freezing_point_temperature_of_seawater | freezing point temperature of seawater | K | 0 | real | kind_phys | in | F | +!! | cp | specific_heat_of_dry_air_at_constant_pressure | specific heat of dry air at constant pressure | J kg-1 K-1 | 0 | real | kind_phys | in | F | +!! | eps | ratio_of_dry_air_to_water_vapor_gas_constants | rd/rv | none | 0 | real | kind_phys | in | F | +!! | epsm1 | ratio_of_dry_air_to_water_vapor_gas_constants_minus_one | (rd/rv) - 1 | none | 0 | real | kind_phys | in | F | +!! | rvrdm1 | ratio_of_vapor_to_dry_air_gas_constants_minus_one | (rv/rd) - 1 (rv = ideal gas constant for water vapor) | none | 0 | real | kind_phys | in | F | +!! | grav | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | +!! | t0c | temperature_at_zero_celsius | temperature at 0 degrees Celsius | K | 0 | real | kind_phys | in | F | +!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-1 | 0 | real | kind_phys | in | F | +!! | cimin | minimum_sea_ice_concentration | minimum sea ice concentration | frac | 0 | real | kind_phys | in | F | !! | ps | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | !! | u1 | x_wind_at_lowest_model_layer | u component of surface layer wind | m s-1 | 1 | real | kind_phys | in | F | !! | v1 | y_wind_at_lowest_model_layer | v component of surface layer wind | m s-1 | 1 | real | kind_phys | in | F | @@ -102,8 +119,8 @@ end subroutine sfc_sice_finalize !! | sfcnsw | surface_net_downwelling_shortwave_flux | total sky sfc netsw flx into ground | W m-2 | 1 | real | kind_phys | in | F | !! | sfcdsw | surface_downwelling_shortwave_flux | total sky sfc downward sw flux | W m-2 | 1 | real | kind_phys | in | F | !! | srflag | flag_for_precipitation_type | snow/rain flag for precipitation | flag | 1 | real | kind_phys | in | F | -!! | cm | surface_drag_coefficient_for_momentum_in_air | surface exchange coeff for momentum | none | 1 | real | kind_phys | in | F | -!! | ch | surface_drag_coefficient_for_heat_and_moisture_in_air | surface exchange coeff heat & moisture | none | 1 | real | kind_phys | in | F | +!! | cm | surface_drag_coefficient_for_momentum_in_air_over_ice | surface exchange coeff for momentum over ice | none | 1 | real | kind_phys | in | F | +!! | ch | surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice | surface exchange coeff heat & moisture over ice | none | 1 | real | kind_phys | in | F | !! | prsl1 | air_pressure_at_lowest_model_layer | surface layer mean pressure | Pa | 1 | real | kind_phys | in | F | !! | prslki | ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer | Exner function ratio bt midlayer and interface at 1st layer | ratio | 1 | real | kind_phys | in | F | !! | islimsk | sea_land_ice_mask | sea/land/ice mask (=0/1/2) | flag | 1 | integer | | in | F | @@ -115,20 +132,20 @@ end subroutine sfc_sice_finalize !! | ipr | horizontal_index_of_printed_column | horizontal index of printed column | index | 0 | integer | | in | F | !! | hice | sea_ice_thickness | sea-ice thickness | m | 1 | real | kind_phys | inout | F | !! | fice | sea_ice_concentration | sea-ice concentration [0,1] | frac | 1 | real | kind_phys | inout | F | -!! | tice | sea_ice_temperature | sea-ice surface temperature | K | 1 | real | kind_phys | inout | F | -!! | weasd | water_equivalent_accumulated_snow_depth | water equivalent accumulated snow depth | mm | 1 | real | kind_phys | inout | F | -!! | tskin | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | inout | F | -!! | tprcp | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep | nonnegative precipitation amount in one dynamics time step | m | 1 | real | kind_phys | inout | F | +!! | tice | sea_ice_temperature_interstitial | sea-ice surface temperature use as interstitial | K | 1 | real | kind_phys | inout | F | +!! | weasd | water_equivalent_accumulated_snow_depth_over_ice | water equiv of acc snow depth over ice | mm | 1 | real | kind_phys | inout | F | +!! | tskin | surface_skin_temperature_over_ice_interstitial | surface skin temperature over ice (temporary use as interstitial) | K | 1 | real | kind_phys | inout | F | +!! | tprcp | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice | total precipitation amount in each time step over ice | m | 1 | real | kind_phys | inout | F | !! | stc | soil_temperature | soil temp | K | 2 | real | kind_phys | inout | F | -!! | ep | surface_upward_potential_latent_heat_flux | potential evaporation | W m-2 | 1 | real | kind_phys | inout | F | -!! | snwdph | surface_snow_thickness_water_equivalent | water equivalent snow depth | mm | 1 | real | kind_phys | inout | F | -!! | qsurf | surface_specific_humidity | sfc air saturation specific humidity | kg kg-1 | 1 | real | kind_phys | inout | F | +!! | ep | surface_upward_potential_latent_heat_flux_over_ice | surface upward potential latent heat flux over ice | W m-2 | 1 | real | kind_phys | inout | F | +!! | snwdph | surface_snow_thickness_water_equivalent_over_ice | water equivalent snow depth over ice | mm | 1 | real | kind_phys | inout | F | +!! | qsurf | surface_specific_humidity_over_ice | surface air saturation specific humidity over ice | kg kg-1 | 1 | real | kind_phys | inout | F | !! | snowmt | surface_snow_melt | snow melt during timestep | m | 1 | real | kind_phys | inout | F | -!! | gflux | upward_heat_flux_in_soil | soil heat flux | W m-2 | 1 | real | kind_phys | inout | F | -!! | cmm | surface_drag_wind_speed_for_momentum_in_air | surf mom exch coef time mean surf wind | m s-1 | 1 | real | kind_phys | inout | F | -!! | chh | surface_drag_mass_flux_for_heat_and_moisture_in_air | surf h&m exch coef time surf wind & density | kg m-2 s-1 | 1 | real | kind_phys | inout | F | -!! | evap | kinematic_surface_upward_latent_heat_flux | evaporative latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | inout | F | -!! | hflx | kinematic_surface_upward_sensible_heat_flux | kinematic sensible heat flux | K m s-1 | 1 | real | kind_phys | inout | F | +!! | gflux | upward_heat_flux_in_soil_over_ice | soil heat flux over ice | W m-2 | 1 | real | kind_phys | inout | F | +!! | cmm | surface_drag_wind_speed_for_momentum_in_air_over_ice | momentum exchange coefficient over ice | m s-1 | 1 | real | kind_phys | inout | F | +!! | chh | surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice | thermal exchange coefficient over ice | kg m-2 s-1 | 1 | real | kind_phys | inout | F | +!! | evap | kinematic_surface_upward_latent_heat_flux_over_ice | kinematic surface upward latent heat flux over ice | kg kg-1 m s-1 | 1 | real | kind_phys | inout | F | +!! | hflx | kinematic_surface_upward_sensible_heat_flux_over_ice | kinematic surface upward sensible heat flux over ice | K m s-1 | 1 | real | kind_phys | inout | F | !! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | !! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! @@ -157,7 +174,8 @@ end subroutine sfc_sice_finalize !! @{ subroutine sfc_sice_run & ! --- inputs: - & ( im, km, ps, u1, v1, t1, q1, delt, & + & ( im, km, sbc, hvap, tgice, cp, eps, epsm1, rvrdm1, grav, & + & t0c, rd, cimin, ps, u1, v1, t1, q1, delt, & & sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, & & cm, ch, prsl1, prslki, islimsk, ddvel, & & flag_iter, mom4ice, lsm, lprnt, ipr, & @@ -250,21 +268,13 @@ subroutine sfc_sice_run & ! ! ! ===================================================================== ! ! - use machine , only : kind_phys + use machine, only: kind_phys use funcphys, only : fpvs - use physcons, only : sbc => con_sbc, hvap => con_hvap, & - & tgice => con_tice, cp => con_cp, & - & eps => con_eps, epsm1 => con_epsm1, & - & grav => con_g, rvrdm1 => con_fvirt, & - & t0c => con_t0c, rd => con_rd ! implicit none ! ! - Define constant parameters integer, parameter :: kmi = 2 !< 2-layer of ice - real(kind=kind_phys), parameter :: cpinv = 1.0/cp - real(kind=kind_phys), parameter :: hvapi = 1.0/hvap - real(kind=kind_phys), parameter :: elocp = hvap/cp real(kind=kind_phys), parameter :: himax = 8.0 !< maximum ice thickness allowed real(kind=kind_phys), parameter :: himin = 0.1 !< minimum ice thickness required real(kind=kind_phys), parameter :: hsmax = 2.0 !< maximum snow depth allowed @@ -276,6 +286,9 @@ subroutine sfc_sice_run & integer, intent(in) :: im, km, lsm, ipr logical, intent(in) :: lprnt + real (kind=kind_phys), intent(in) :: sbc, hvap, tgice, cp, eps, & + & epsm1, grav, rvrdm1, t0c, rd, cimin + real (kind=kind_phys), dimension(im), intent(in) :: ps, u1, v1, & & t1, q1, sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, cm, ch, & & prsl1, prslki, ddvel @@ -283,7 +296,8 @@ subroutine sfc_sice_run & integer, dimension(im), intent(in) :: islimsk real (kind=kind_phys), intent(in) :: delt - logical, intent(in) :: flag_iter(im), mom4ice + logical, dimension(im), intent(in) :: flag_iter + logical, intent(in) :: mom4ice ! --- input/outputs: real (kind=kind_phys), dimension(im), intent(inout) :: hice, & @@ -307,7 +321,7 @@ subroutine sfc_sice_run & real (kind=kind_phys) :: t12, t14, tem, stsice(im,kmi) &, hflxi, hflxw, q0, qs1, wind, qssi, qssw - real (kind=kind_phys), parameter :: cimin=0.15 !< minimum ice concentration + real (kind=kind_phys) :: cpinv, hvapi, elocp integer :: i, k @@ -315,6 +329,10 @@ subroutine sfc_sice_run & ! !===> ... begin here ! + cpinv = 1.0/cp + hvapi = 1.0/hvap + elocp = hvap/cp + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -341,7 +359,7 @@ subroutine sfc_sice_run & ! if (mom4ice) then do i = 1, im - if (flag(i)) then + if (flag(i)) then ! sea ice hi_save(i) = hice(i) hs_save(i) = weasd(i) * 0.001 endif @@ -471,9 +489,9 @@ subroutine sfc_sice_run & ! if (lprnt) write(0,*)' tice2=',tice(ipr) call ice3lay ! --- inputs: ! -! & ( im, kmi, fice, flag, hfi, hfd, sneti, focn, delt, ! + & ( im, kmi, fice, flag, hfi, hfd, sneti, focn, delt, ! ! --- outputs: ! -! & snowd, hice, stsice, tice, snof, snowmt, gflux ) ! + & snowd, hice, stsice, tice, snof, snowmt, gflux ) ! ! if (lprnt) write(0,*)' tice3=',tice(ipr) if (mom4ice) then @@ -552,7 +570,7 @@ subroutine sfc_sice_run & !----------------------------------- -!> This subroutine is the entity of three-layer sea ice vertical thermodynamics +!> This subroutine is the entity of three-layer sea ice vertical thermodynamics !! based on Winton(2000) \cite winton_2000 . !! @{ !!\ingroup gfs_sice_main @@ -577,12 +595,12 @@ subroutine sfc_sice_run & subroutine ice3lay !................................... ! --- inputs: -! & ( im, kmi, fice, flag, hfi, hfd, sneti, focn, delt, & + & ( im, kmi, fice, flag, hfi, hfd, sneti, focn, delt, & ! --- input/outputs: -! & snowd, hice, stsice, tice, snof, & + & snowd, hice, stsice, tice, snof, & ! --- outputs: -! & snowmt, gflux & -! & ) + & snowmt, gflux & + & ) !************************************************************************** ! * @@ -661,24 +679,24 @@ subroutine ice3lay real (kind=kind_phys), parameter :: ki4 = ki*4.0 ! --- inputs: -! integer, intent(in) :: im, kmi + integer, intent(in) :: im, kmi -! real (kind=kind_phys), dimension(im), intent(in) :: fice, hfi, & -! & hfd, sneti, focn + real (kind=kind_phys), dimension(im), intent(in) :: fice, hfi, & + & hfd, sneti, focn -! real (kind=kind_phys), intent(in) :: delt + real (kind=kind_phys), intent(in) :: delt -! logical, dimension(im), intent(in) :: flag + logical, dimension(im), intent(in) :: flag ! --- input/outputs: -! real (kind=kind_phys), dimension(im), intent(inout) :: snowd, & -! & hice, tice, snof + real (kind=kind_phys), dimension(im), intent(inout) :: snowd, & + & hice, tice, snof -! real (kind=kind_phys), dimension(im,kmi), intent(inout) :: stsice + real (kind=kind_phys), dimension(im,kmi), intent(inout) :: stsice ! --- outputs: -! real (kind=kind_phys), dimension(im), intent(out) :: snowmt, & -! & gflux + real (kind=kind_phys), dimension(im), intent(out) :: snowmt, & + & gflux ! --- locals: @@ -730,7 +748,7 @@ subroutine ice3lay !! beneath the snow-ice interface (see \a eq.(5) in Winton (2000) \cite winton_2000). k12 = ki4*ks / (ks*hice(i) + ki4*snowd(i)) -!> - Calculate the conductive coupling between the two ice temperature +!> - Calculate the conductive coupling between the two ice temperature !! points (see \a eq.(10) in Winton (2000) \cite winton_2000). k32 = (ki+ki) / hice(i)