From 307769dba0b97fbaf5d6be4bf310f8c4b345070d Mon Sep 17 00:00:00 2001 From: "Linlin.Pan" Date: Thu, 15 Aug 2019 09:05:57 +0000 Subject: [PATCH 01/10] adding coupling option in ccpp --- physics/GFS_PBL_generic.F90 | 116 ++++++++++------ physics/GFS_surface_generic.F90 | 63 ++++++++- physics/sfc_cice.f | 226 ++++++++++++++++++++++++++++++++ physics/sfc_sice.f | 52 ++++++-- 4 files changed, 410 insertions(+), 47 deletions(-) create mode 100644 physics/sfc_cice.f diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 5063038d4..2b230d952 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -291,6 +291,29 @@ end subroutine GFS_PBL_generic_post_finalize !! | dv3dt_OGWD | cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag | cumulative change in y wind due to orographic gravity wave drag | m s-1 | 2 | real | kind_phys | inout | F | !! | dq3dt | cumulative_change_in_water_vapor_specific_humidity_due_to_PBL | cumulative change in water vapor specific humidity due to PBL | kg kg-1 | 2 | real | kind_phys | inout | F | !! | dq3dt_ozone | cumulative_change_in_ozone_mixing_ratio_due_to_PBL | cumulative change in ozone mixing ratio due to PBL | kg kg-1 | 2 | real | kind_phys | inout | F | +!! | rd | gas_constant_dry_air | ideal gas constant for dry air | J kg-1 K-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 | +!! | 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 | +!! | hvap | latent_heat_of_vaporization_of_water_at_0C | latent heat of evaporation/sublimation | J kg-1 | 0 | real | kind_phys | in | F | +!! | t1 | air_temperature_at_lowest_model_layer_for_diag | layer 1 temperature for diag | K | 1 | real | kind_phys | in | F | +!! | q1 | water_vapor_specific_humidity_at_lowest_model_layer_for_diag | layer 1 specific humidity for diag | kg kg-1 | 1 | real | kind_phys | in | F | +!! | prsl | air_pressure | mean layer pressure | Pa | 2 | 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 | in | F | +!! | ushfsfci | instantaneous_upward_sensible_heat_flux | instantaneous upward sensible heat flux | W m-2 | 1 | real | kind_phys | out | F | +!! | oceanfrac | sea_area_fraction | fraction of horizontal grid area occupied by ocean | frac | 1 | real | kind_phys | in | F | +!! | fice | sea_ice_concentration | ice fraction over open water | frac | 1 | real | kind_phys | in | F | +!! | dusfc_cice | surface_x_momentum_flux_for_coupling_cice | sfc x momentum flux for cice | Pa | 1 | real | kind_phys | in | F | +!! | dvsfc_cice | surface_y_momentum_flux_for_coupling_cice | sfc y momentum flux for cice | Pa | 1 | real | kind_phys | in | F | +!! | dtsfc_cice | surface_upward_sensible_heat_flux_for_coupling_cice | sfc sensible heat flux for cice | W m-2 | 1 | real | kind_phys | in | F | +!! | dqsfc_cice | surface_upward_latent_heat_flux_for_coupling_cice | sfc latent heat flux for cice | W m-2 | 1 | real | kind_phys | 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 | +!! | wind | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 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 | in | 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 | +!! | 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 | +!! | ugrs1 | x_wind_at_lowest_model_layer | zonal wind at lowest model layer | m s-1 | 1 | real | kind_phys | in | F | +!! | vgrs1 | y_wind_at_lowest_model_layer | meridional wind at lowest model layer | m s-1 | 1 | real | kind_phys | 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 | !! @@ -303,7 +326,8 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqdt, dusfc_cpl, dvsfc_cpl, dtsfc_cpl, & dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, & dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, & - dq3dt_ozone, errmsg, errflg) + dq3dt_ozone, rd, cp,fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, fice, dusfc_cice, dvsfc_cice, dtsfc_cice, & + dqsfc_cice, dry, icy, wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1, errmsg, errflg) use machine, only: kind_phys @@ -317,6 +341,11 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu real(kind=kind_phys), intent(in) :: dtf + real(kind=kind_phys), intent(in) :: rd, cp, fvirt, hvap + real(kind=kind_phys), dimension(:), intent(in) :: t1, q1, hflx, oceanfrac, fice + real(kind=kind_phys), dimension(:,:), intent(in) :: prsl + real(kind=kind_phys), dimension(:), intent(in) :: dusfc_cice, dvsfc_cice, dtsfc_cice, dqsfc_cice, & + wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1 real(kind=kind_phys), dimension(im, levs, nvdiff), intent(in) :: dvdftra real(kind=kind_phys), dimension(im), intent(in) :: dusfc1, dvsfc1, dtsfc1, dqsfc1, xmu real(kind=kind_phys), dimension(im, levs), intent(in) :: dudt, dvdt, dtdt, htrsw, htrlw @@ -331,11 +360,14 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, real(kind=kind_phys), dimension(:), intent(inout) :: dusfc_cpl, dvsfc_cpl, dtsfc_cpl, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, & dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag + logical, dimension(:),intent(in) :: dry, icy + + real(kind=kind_phys), dimension(:), intent(out) :: ushfsfci character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg integer :: i, k - real(kind=kind_phys) :: tem + real(kind=kind_phys) :: tem, tem1, rho ! Initialize CCPP error handling variables errmsg = '' @@ -453,47 +485,57 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, endif endif ! nvdiff == ntrac + write(*,*)rd,cp,hvap,fvirt +!! new adding + if (cplchm) then + do i = 1, im + tem1 = max(q1(i), 1.e-8) + tem = prsl(i,1) / (rd*t1(i)*(1.0+fvirt*tem1)) + ushfsfci(i) = -cp * tem * hflx(i) ! upward sensible heat flux + enddo +!! Coupling%dkt (:,:) = dkt (:,:) + endif ! --- ... coupling insertion ! ### GJF ### the following section needs to be made CCPP-compliant when cplflx = T -! if (Model%cplflx) then -! do i=1,im -! if (Sfcprop%oceanfrac(i) > 0.0) then ! Ocean only, NO LAKES -! if (fice(i) == 1.0) 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.0) then -! tem = - rho * stress_ocn(i) / wind(i) -! Coupling%dusfci_cpl(i) = tem * Statein%ugrs(i,1) ! U-momentum flux -! Coupling%dvsfci_cpl(i) = tem * Statein%vgrs(i,1) ! V-momentum flux -! else -! Coupling%dusfci_cpl(i) = 0.0 -! Coupling%dvsfci_cpl(i) = 0.0 -! endif -! Coupling%dtsfci_cpl(i) = con_cp * rho * hflx_ocn(i) ! sensible heat flux over open ocean -! Coupling%dqsfci_cpl(i) = con_hvap * rho * evap_ocn(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 + if (cplflx) then + do i=1,im + if (oceanfrac(i) > 0.0) then ! Ocean only, NO LAKES + if (fice(i) == 1.0) then ! use results from CICE + dusfci_cpl(i) = dusfc_cice(i) + dvsfci_cpl(i) = dvsfc_cice(i) + dtsfci_cpl(i) = dtsfc_cice(i) + 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(q1(i), 1.e-8) + rho = prsl(i,1) / (rd*t1(i)*(1.0+fvirt*tem1)) + if (wind(i) > 0.0) then + tem = - rho * stress_ocn(i) / wind(i) + dusfci_cpl(i) = tem * ugrs1(i) ! U-momentum flux + dvsfci_cpl(i) = tem * vgrs1(i) ! V-momentum flux + else + dusfci_cpl(i) = 0.0 + dvsfci_cpl(i) = 0.0 + endif + dtsfci_cpl(i) = cp * rho * hflx_ocn(i) ! sensible heat flux over open ocean + dqsfci_cpl(i) = hvap * rho * evap_ocn(i) ! latent heat flux over open ocean + else ! use results from PBL scheme for 100% open ocean + dusfci_cpl(i) = dusfc1(i) + dvsfci_cpl(i) = dvsfc1(i) + dtsfci_cpl(i) = dtsfc1(i) + 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 + dusfc_cpl (i) = dusfc_cpl(i) + dusfci_cpl(i) * dtf + dvsfc_cpl (i) = dvsfc_cpl(i) + dvsfci_cpl(i) * dtf + dtsfc_cpl (i) = dtsfc_cpl(i) + dtsfci_cpl(i) * dtf + dqsfc_cpl (i) = dqsfc_cpl(i) + dqsfci_cpl(i) * dtf !! -! endif ! Ocean only, NO LAKES -! enddo -! endif -!-------------------------------------------------------lssav if loop ---------- + endif ! Ocean only, NO LAKES + enddo + endif + if (lssav) then do i=1,im dusfc_diag (i) = dusfc_diag(i) + dusfc1(i)*dtf diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 5504eb7cd..e40ac44b4 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -32,7 +32,7 @@ end subroutine GFS_surface_generic_pre_finalize !! | prslk_1 | dimensionless_exner_function_at_lowest_model_layer | dimensionless Exner function at lowest model layer | none | 1 | real | kind_phys | in | F | !! | semis | surface_longwave_emissivity | surface lw emissivity in fraction | frac | 1 | real | kind_phys | in | F | !! | adjsfcdlw | surface_downwelling_longwave_flux | surface downwelling longwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | -!! | tsfc | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | in | F | +!! | tsfc | surface_skin_temperature | surface skin temperature | K | 1 | real | kind_phys | inout | F | !! | phil | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | !! | con_g | gravitational_acceleration | gravitational acceleration | m s-2 | 0 | real | kind_phys | in | F | !! | sigmaf | bounded_vegetation_area_fraction | areal fractional cover of green vegetation bounded on the bottom | frac | 1 | real | kind_phys | inout | F | @@ -62,6 +62,24 @@ end subroutine GFS_surface_generic_pre_finalize !! | bexp1d | perturbation_of_soil_type_b_parameter | perturbation of soil type "b" parameter | frac | 1 | real | kind_phys | out | F | !! | xlai1d | perturbation_of_leaf_area_index | perturbation of leaf area index | frac | 1 | real | kind_phys | out | F | !! | vegf1d | perturbation_of_vegetation_fraction | perturbation of vegetation fraction | frac | 1 | real | kind_phys | out | 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 | | inout | F | +!! | islmsk_cice | sea_land_ice_mask_cice | sea/land/ice mask cice (=0/1/2) | flag | 1 | integer | | in | F | +!! | slimskin_cpl | sea_land_ice_mask_in | sea/land/ice mask input (=0/1/2) | flag | 1 | real | kind_phys | in | F | +!! | dusfcin_cpl | surface_x_momentum_flux_for_coupling_in | sfc x momentum flux for coupling in | Pa | 1 | real | kind_phys | in | F | +!! | dvsfcin_cpl | surface_y_momentum_flux_for_coupling_in | sfc y momentum flux for coupling in | Pa | 1 | real | kind_phys | in | F | +!! | dtsfcin_cpl | surface_upward_sensible_heat_flux_for_coupling_in | sfc sensible heat flux input | W m-2 | 1 | real | kind_phys | in | F | +!! | dqsfcin_cpl | surface_upward_latent_heat_flux_for_coupling_in | sfc latent heat flux input for coupling in | W m-2 | 1 | real | kind_phys | in | F | +!! | ulwsfcin_cpl | surface_upwelling_longwave_flux_for_coupling_in | surface upwelling LW flux for coupling in | W m-2 | 1 | real | kind_phys | in | F | +!! | ulwsfc_cice | surface_upwelling_longwave_flux_for_cice | surface upwelling longwave flux for cice | W m-2 | 1 | real | kind_phys | out | F | +!! | dusfc_cice | surface_x_momentum_flux_for_coupling_cice | sfc x momentum flux for cice | Pa | 1 | real | kind_phys | out | F | +!! | dvsfc_cice | surface_y_momentum_flux_for_coupling_cice | sfc y momentum flux for cice | Pa | 1 | real | kind_phys | out | F | +!! | dtsfc_cice | surface_upward_sensible_heat_flux_for_coupling_cice | sfc sensible heat flux for cice | W m-2 | 1 | real | kind_phys | out | F | +!! | dqsfc_cice | surface_upward_latent_heat_flux_for_coupling_cice | sfc latent heat flux for cice | W m-2 | 1 | real | kind_phys | out | F | +!! | tisfc | sea_ice_temperature | sea-ice surface temperature | K | 1 | real | kind_phys | in | F | +!! | tsfco | sea_surface_temperature | sea surface temperature | K | 1 | real | kind_phys | in | F | +!! | fice | sea_ice_concentration | sea-ice concentration [0,1] | frac | 1 | real | kind_phys | in | F | +!! | hice | sea_ice_thickness | sea-ice thickness | m | 1 | real | kind_phys | 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 | !! @@ -71,6 +89,9 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, slopetyp, work3, gabsbdlw, tsurf, zlvl, do_sppt, dtdtr, & drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, do_sfcperts, nsfcpert, sfc_wts, & pertz0, pertzt, pertshc, pertlai, pertvegf, z01d, zt1d, bexp1d, xlai1d, vegf1d, & + cplflx, flag_cice, islmsk_cice,slimskin_cpl, dusfcin_cpl, dvsfcin_cpl, & + dtsfcin_cpl, dqsfcin_cpl, ulwsfcin_cpl, ulwsfc_cice, dusfc_cice, dvsfc_cice, & + dtsfc_cice, dqsfc_cice, tisfc, tsfco, fice, hice, & errmsg, errflg) use machine, only: kind_phys @@ -85,7 +106,8 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, real(kind=kind_phys), intent(in) :: con_g real(kind=kind_phys), dimension(im), intent(in) :: vfrac, stype, vtype, slope, prsik_1, prslk_1, & - semis, adjsfcdlw, tsfc + semis, adjsfcdlw + real(kind=kind_phys), dimension(im), intent(inout) :: tsfc real(kind=kind_phys), dimension(im,levs), intent(in) :: phil real(kind=kind_phys), dimension(im), intent(inout) :: sigmaf, work3, gabsbdlw, tsurf, zlvl @@ -111,6 +133,19 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, real(kind=kind_phys), dimension(im), intent(out) :: xlai1d real(kind=kind_phys), dimension(im), intent(out) :: vegf1d + logical, intent(in) :: cplflx + real(kind=kind_phys), dimension(im), intent(in) :: slimskin_cpl + logical, dimension(im), intent(inout) :: flag_cice + integer, dimension(im), intent(out) :: islmsk_cice + real(kind=kind_phys), dimension(im), intent(in) ::ulwsfcin_cpl, & + dusfcin_cpl, dvsfcin_cpl, dtsfcin_cpl, dqsfcin_cpl, & + tisfc, tsfco, fice, hice + real(kind=kind_phys), dimension(im), intent(out) ::ulwsfc_cice, & + dusfc_cice, dvsfc_cice, dtsfc_cice, dqsfc_cice + real(kind=kind_phys), dimension(im) :: tisfc_cice, tsea_cice, & + fice_cice,hice_cice + + ! CCPP error handling character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -216,6 +251,30 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, tsurf(i) = tsfc(i) zlvl(i) = phil(i,1) * onebg end do + if (cplflx) then + do i=1,im + islmsk_cice(i) = int(slimskin_cpl(i)+0.5) + if(islmsk_cice(i) == 4)then + flag_cice(i) = .true. + else + flag_cice(i) = .false. + endif + ulwsfc_cice(i) = ulwsfcin_cpl(i) + dusfc_cice(i) = dusfcin_cpl(i) + dvsfc_cice(i) = dvsfcin_cpl(i) + dtsfc_cice(i) = dtsfcin_cpl(i) + dqsfc_cice(i) = dqsfcin_cpl(i) + tisfc_cice(i) = tisfc(i) + tsea_cice(i) = tsfco(i) + fice_cice(i) = fice(i) + hice_cice(i) = hice(i) + if(flag_cice(i)) tsfc(i) = fice_cice(i)*tisfc_cice(i) + (1. - fice_cice(i))*tsea_cice(i) + enddo + else + ! Avoid uninitialized variables - set to default values + flag_cice = .false. + endif + end subroutine GFS_surface_generic_pre_run diff --git a/physics/sfc_cice.f b/physics/sfc_cice.f new file mode 100644 index 000000000..d7b84f800 --- /dev/null +++ b/physics/sfc_cice.f @@ -0,0 +1,226 @@ +!> \file sfc_cice.f +!! This file contains the sfc_sice for coupling to CICE + +!> 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_cice_pre + + contains +!! \section arg_table_sfc_cice_post_init Argument Table +!! + subroutine sfc_cice_pre_init + end subroutine sfc_cice_pre_init + + subroutine sfc_cice_pre_finalize + end subroutine sfc_cice_pre_finalize + + end module sfc_cice_pre +!! + module sfc_cice_post + + contains +!! \section arg_table_sfc_cice_post_init Argument Table +!! + subroutine sfc_cice_post_init + end subroutine sfc_cice_post_init + +!! \section arg_table_sfc_cice_post_finalize Argument Table +!! + subroutine sfc_cice_post_finalize + end subroutine sfc_cice_post_finalize + + subroutine sfc_cice_post_run + end subroutine sfc_cice_post_run + + end module sfc_cice_post + +!> This module contains the CCPP-compliant GFS sea ice scheme. + module sfc_cice + + contains + + subroutine sfc_cice_init + end subroutine sfc_cice_init +! + subroutine sfc_cice_finalize + end subroutine sfc_cice_finalize + + +!> \defgroup sfc_sice for coupling to CICE +!! @{ +!! \section diagram Calling Hierarchy Diagram +!! \section intraphysics Intraphysics Communication +!! +!> \brief Brief description of the subroutine +!! +!! \section arg_table_cice_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 | +!! | cplflx | flag_for_flux_coupling | flag controlling cplflx collection (default off) | flag | 0 | logical | | in | F +!! | cplchm | flag_for_chemistry_coupling | flag controlling cplchm collection (default off) | flag | 0 | logical | | 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 | +!! | 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 | +!! | 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 | +!! | 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 | +!! | 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 | +!! | 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 | +!! | dqsfc | dqsfcin | aoi_fld%dqsfcin(item,lan) | | 1 | real | kind_phys | none | F | +!! | dtsfc | dtsfcin | aoi_fld%dtsfcin(item,lan) | | 1 | real | kind_phys | none | F | +!! | qsurf | surface_specific_humidity_over_ice | surface air saturation specific humidity over ice | kg kg-1 | 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 | +!! + +!! +!! \section general General Algorithm +!! \section detailed Detailed Algorithm +!! @{ + + +!! use physcons, only : hvap => con_hvap, cp => con_cp, & +!! & rvrdm1 => con_fvirt, rd => con_rd + contains +! +!----------------------------------- + subroutine sfc_cice_run & + & ( im, cplflx, cplchm, hvap, cp, rvrdm1, rd, & ! --- inputs: + & u1, v1, t1, q1, cm, ch, prsl1, prslki, & + & islimsk, ddvel, flag_iter, dqsfc, dtsfc, & + & qsurf, cmm, chh, evap, hflx, & ! --- outputs: + & errmsg, errflg + & ) + +! ===================================================================== ! +! description: ! +! Sep 2015 -- Xingren Wu created from sfc_sice for coupling to CICE ! +! ! +! usage: ! +! ! +! call sfc_cice ! +! inputs: ! +! ( im, u1, v1, t1, q1, cm, ch, prsl1, prslki, ! +! islimsk, ddvel, flag_iter, dqsfc, dtsfc, ! +! outputs: ! +! qsurf, cmm, chh, evap, hflx) ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: +! im, - integer, horiz dimension +! u1, v1 - real, u/v component of surface layer wind +! t1 - real, surface layer mean temperature ( k ) +! q1 - real, surface layer mean specific humidity +! cm - real, surface exchange coeff for momentum (m/s) +! ch - real, surface exchange coeff heat & moisture(m/s) +! prsl1 - real, surface layer mean pressure +! prslki - real, ? +! islimsk - integer, sea/land/ice mask +! ddvel - real, ? +! flag_iter- logical +! dqsfc - real, latent heat flux +! dtsfc - real, sensible heat flux +! outputs: +! qsurf - real, specific humidity at sfc +! cmm - real, ? +! chh - real, ? +! evap - real, evaperation from latent heat +! hflx - real, sensible heat +! ==================== end of description ===================== ! +! +! + use machine , only : kind_phys + implicit none + + + real (kind=kind_phys), intent(in) :: hvap, cp, rvrdm1, rd + +!- 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 + +! --- inputs: + integer, intent(in) :: im + logical, intent(in) :: cplflx + logical, intent(in) :: cplchm + + real (kind=kind_phys), dimension(im), intent(in) :: u1, v1, & + & t1, q1, cm, ch, prsl1, prslki, ddvel, dqsfc, dtsfc + + integer, dimension(im), intent(in) :: islimsk + + logical, intent(in) :: flag_iter(im) + +! --- outputs: + real (kind=kind_phys), dimension(im), intent(out) :: qsurf, & + & cmm, chh, evap, hflx +! + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! --- locals: + real (kind=kind_phys), dimension(im) :: q0, rch, rho, tv1, wind + + real (kind=kind_phys) :: tem + + integer :: i + + logical :: flag(im) + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 +! + if((.not. cplflx).and.(.not.cplchm))then + return + endif + + do i = 1, im + flag(i) = (islimsk(i) == 4) .and. flag_iter(i) + enddo +! + do i = 1, im + if (flag(i)) then + + wind(i) = sqrt(u1(i)*u1(i) + v1(i)*v1(i)) & + & + max(0.0, min(ddvel(i), 30.0)) + wind(i) = max(wind(i), 1.0) + + q0(i) = max(q1(i), 1.0e-8) + tv1(i) = t1(i) * (1.0 + rvrdm1*q0(i)) + rho(i) = prsl1(i) / (rd*tv1(i)) + + cmm(i) = cm(i) * wind(i) + chh(i) = rho(i) * ch(i) * wind(i) + rch(i) = chh(i) * cp + + qsurf(i) = q1(i) + dqsfc(i) / (elocp*rch(i)) + tem = 1.0 / rho(i) + hflx(i) = dtsfc(i) * tem * cpinv + evap(i) = dqsfc(i) * tem * hvapi + endif + enddo + + return +!----------------------------------- + end subroutine sfc_cice_run +!----------------------------------- + +!> @} + end module sfc_cice diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index fbc14587a..96c641ac3 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -19,7 +19,7 @@ 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 | +!! | sbc | stefan_boltzmann_constant | Stefan-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 | @@ -45,7 +45,7 @@ end subroutine sfc_sice_finalize !! | 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 | +!! | islimsk | sea_land_ice_mask | sea/land/ice mask (=0/1/2) | flag | 1 | integer | | inout | 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 | !! | lprnt | flag_print | switch for printing sample column to stdout | flag | 0 | logical | | in | F | @@ -66,6 +66,11 @@ end subroutine sfc_sice_finalize !! | 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 | +!! | cplflx | flag_for_flux_coupling | flag controlling cplflx collection (default off) | flag | 0 | logical | | in | F | +!! | cplchm | flag_for_chemistry_coupling | flag controlling cplchm collection (default off) | flag | 0 | logical | | in | F | +!! | flag_cice | flag_for_cice | flag for cice | flag | 1 | logical | | in | F | +!! | islmsk_cice | sea_land_ice_mask_cice | sea/land/ice mask cice (=0/1/2) | flag | 1 | integer | | in | F | +!! | slmsk | sea_land_ice_mask_real | landmask: sea/land/ice=0/1/2 | flag | 1 | real | kind_phys | 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 | !! @@ -98,7 +103,8 @@ subroutine sfc_sice_run & & cm, ch, prsl1, prslki, islimsk, ddvel, & & flag_iter, lprnt, ipr, & & hice, fice, tice, weasd, tskin, tprcp, stc, ep, & ! --- input/outputs: - & snwdph, qsurf, snowmt, gflux, cmm, chh, evap, hflx, & ! --- outputs: + & snwdph, qsurf, snowmt, gflux, cmm, chh, evap, hflx, & ! + & cplflx, cplchm, flag_cice, islmsk_cice, slmsk, & & errmsg, errflg & ) @@ -200,6 +206,8 @@ subroutine sfc_sice_run & ! --- inputs: integer, intent(in) :: im, km, ipr logical, intent(in) :: lprnt + logical, intent(in) :: cplflx + logical, intent(in) :: cplchm real (kind=kind_phys), intent(in) :: sbc, hvap, tgice, cp, eps, & & epsm1, grav, rvrdm1, t0c, rd, cimin @@ -208,10 +216,12 @@ subroutine sfc_sice_run & & t1, q1, sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, cm, ch, & & prsl1, prslki, ddvel - integer, dimension(im), intent(in) :: islimsk + integer, dimension(im), intent(inout) :: islimsk + integer, dimension(im), intent(in) :: islmsk_cice real (kind=kind_phys), intent(in) :: delt + real (kind=kind_phys), dimension(im), intent(in) :: slmsk - logical, dimension(im), intent(in) :: flag_iter + logical, dimension(im), intent(in) :: flag_iter, flag_cice ! --- input/outputs: real (kind=kind_phys), dimension(im), intent(inout) :: hice, & @@ -238,6 +248,7 @@ subroutine sfc_sice_run & real (kind=kind_phys) :: cpinv, hvapi, elocp integer :: i, k + integer, dimension(im) :: islmsk_LOCAL logical :: flag(im) ! @@ -250,17 +261,42 @@ subroutine sfc_sice_run & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + + do i = 1, im + islmsk_LOCAL(i) = islimsk(i) + enddo + + if (cplflx) then + do i=1,im + if (flag_cice(i)) then + islmsk_LOCAL (i) = islmsk_cice(i) + endif + enddo + endif + + do i = 1, im + islimsk(i)=islmsk_LOCAL(i) + enddo + + if (cplflx .or. cplchm) then + do i = 1, im + if (flag_cice(i)) then + islimsk(i) = int(slmsk(i)+0.5) + endif + enddo + endif + ! !> - Set flag for sea-ice. do i = 1, im - flag(i) = (islimsk(i) == 2) .and. flag_iter(i) - if (flag_iter(i) .and. islimsk(i) < 2) then + flag(i) = (islmsk_LOCAL(i) == 2) .and. flag_iter(i) + if (flag_iter(i) .and. islmsk_LOCAL(i) < 2) then hice(i) = zero fice(i) = zero endif enddo -! + do i = 1, im if (flag(i)) then if (srflag(i) > zero) then From f76289ea50facf218cc913b5ac04906f2cc6b1ab Mon Sep 17 00:00:00 2001 From: "Linlin.Pan" Date: Mon, 19 Aug 2019 22:06:45 +0000 Subject: [PATCH 02/10] adding coupling option to CCPP --- physics/GFS_PBL_generic.F90 | 13 +++++++++---- physics/GFS_suite_interstitial.F90 | 2 +- physics/GFS_surface_generic.F90 | 26 ++++++++++++++++---------- physics/sfc_sice.f | 4 ++++ 4 files changed, 30 insertions(+), 15 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 2b230d952..93ce62deb 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -302,10 +302,10 @@ end subroutine GFS_PBL_generic_post_finalize !! | ushfsfci | instantaneous_upward_sensible_heat_flux | instantaneous upward sensible heat flux | W m-2 | 1 | real | kind_phys | out | F | !! | oceanfrac | sea_area_fraction | fraction of horizontal grid area occupied by ocean | frac | 1 | real | kind_phys | in | F | !! | fice | sea_ice_concentration | ice fraction over open water | frac | 1 | real | kind_phys | in | F | -!! | dusfc_cice | surface_x_momentum_flux_for_coupling_cice | sfc x momentum flux for cice | Pa | 1 | real | kind_phys | in | F | -!! | dvsfc_cice | surface_y_momentum_flux_for_coupling_cice | sfc y momentum flux for cice | Pa | 1 | real | kind_phys | in | F | -!! | dtsfc_cice | surface_upward_sensible_heat_flux_for_coupling_cice | sfc sensible heat flux for cice | W m-2 | 1 | real | kind_phys | in | F | -!! | dqsfc_cice | surface_upward_latent_heat_flux_for_coupling_cice | sfc latent heat flux for cice | W m-2 | 1 | real | kind_phys | in | F | +!! | dusfc_cice | surface_x_momentum_flux_for_coupling_interstitial | sfc x momentum flux for coupling interstitial | Pa | 1 | real | kind_phys | in | F | +!! | dvsfc_cice | surface_y_momentum_flux_for_coupling_interstitial | sfc y momentum flux for coupling interstitial | Pa | 1 | real | kind_phys | in | F | +!! | dtsfc_cice | surface_upward_sensible_heat_flux_for_coupling_interstitial | sfc sensible heat flux for coupling interstitial | W m-2 | 1 | real | kind_phys | in | F | +!! | dqsfc_cice | surface_upward_latent_heat_flux_for_coupling_interstitial | sfc latent heat flux for coupling interstitial | W m-2 | 1 | real | kind_phys | 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 | !! | wind | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | @@ -496,6 +496,11 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, !! Coupling%dkt (:,:) = dkt (:,:) endif + if(cplflx)then + write(*,*)'Fatal error: CCPP is not ready for cplflx=true!!' + stop + endif + ! --- ... coupling insertion ! ### GJF ### the following section needs to be made CCPP-compliant when cplflx = T diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index ab294958f..0ba7f8c82 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -204,7 +204,7 @@ end subroutine GFS_suite_interstitial_2_finalize !! | adjsfcdsw | surface_downwelling_shortwave_flux | surface downwelling shortwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | !! | adjsfcdlw | surface_downwelling_longwave_flux | surface downwelling longwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | !! | pgr | surface_air_pressure | surface pressure | Pa | 1 | real | kind_phys | in | F | -!! | ulwsfc_cice | surface_upwelling_longwave_flux_for_cice | surface upwelling longwave flux for cice | W m-2 | 1 | real | kind_phys | in | F | +!! | ulwsfc_cice | surface_upwelling_longwave_flux_for_coupling | surface upwelling longwave flux for coupling | W m-2 | 1 | real | kind_phys | in | F | !! | lwhd | tendency_of_air_temperature_due_to_longwave_heating_for_idea | idea sky lw heating rates | K s-1 | 3 | real | kind_phys | in | F | !! | htrsw | 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 | !! | htrlw | tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep | total sky lw heating rate | K s-1 | 2 | real | kind_phys | in | F | diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index e40ac44b4..522da3631 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -66,16 +66,16 @@ end subroutine GFS_surface_generic_pre_finalize !! | flag_cice | flag_for_cice | flag for cice | flag | 1 | logical | | inout | F | !! | islmsk_cice | sea_land_ice_mask_cice | sea/land/ice mask cice (=0/1/2) | flag | 1 | integer | | in | F | !! | slimskin_cpl | sea_land_ice_mask_in | sea/land/ice mask input (=0/1/2) | flag | 1 | real | kind_phys | in | F | -!! | dusfcin_cpl | surface_x_momentum_flux_for_coupling_in | sfc x momentum flux for coupling in | Pa | 1 | real | kind_phys | in | F | -!! | dvsfcin_cpl | surface_y_momentum_flux_for_coupling_in | sfc y momentum flux for coupling in | Pa | 1 | real | kind_phys | in | F | -!! | dtsfcin_cpl | surface_upward_sensible_heat_flux_for_coupling_in | sfc sensible heat flux input | W m-2 | 1 | real | kind_phys | in | F | -!! | dqsfcin_cpl | surface_upward_latent_heat_flux_for_coupling_in | sfc latent heat flux input for coupling in | W m-2 | 1 | real | kind_phys | in | F | -!! | ulwsfcin_cpl | surface_upwelling_longwave_flux_for_coupling_in | surface upwelling LW flux for coupling in | W m-2 | 1 | real | kind_phys | in | F | -!! | ulwsfc_cice | surface_upwelling_longwave_flux_for_cice | surface upwelling longwave flux for cice | W m-2 | 1 | real | kind_phys | out | F | -!! | dusfc_cice | surface_x_momentum_flux_for_coupling_cice | sfc x momentum flux for cice | Pa | 1 | real | kind_phys | out | F | -!! | dvsfc_cice | surface_y_momentum_flux_for_coupling_cice | sfc y momentum flux for cice | Pa | 1 | real | kind_phys | out | F | -!! | dtsfc_cice | surface_upward_sensible_heat_flux_for_coupling_cice | sfc sensible heat flux for cice | W m-2 | 1 | real | kind_phys | out | F | -!! | dqsfc_cice | surface_upward_latent_heat_flux_for_coupling_cice | sfc latent heat flux for cice | W m-2 | 1 | real | kind_phys | out | F | +!! | dusfcin_cpl | surface_x_momentum_flux_for_coupling | sfc x momentum flux for coupling | Pa | 1 | real | kind_phys | in | F | +!! | dvsfcin_cpl | surface_y_momentum_flux_for_coupling | sfc y momentum flux for coupling | Pa | 1 | real | kind_phys | in | F | +!! | dtsfcin_cpl | surface_upward_sensible_heat_flux_for_coupling | sfc sensible heat flux input | W m-2 | 1 | real | kind_phys | in | F | +!! | dqsfcin_cpl | surface_upward_latent_heat_flux_for_coupling | sfc latent heat flux input for coupling | W m-2 | 1 | real | kind_phys | in | F | +!! | ulwsfcin_cpl | surface_upwelling_longwave_flux_for_coupling | surface upwelling LW flux for coupling | W m-2 | 1 | real | kind_phys | in | F | +!! | ulwsfc_cice | surface_upwelling_longwave_flux_for_coupling_interstitial | surface upwelling longwave flux for coupling interstitial | W m-2 | 1 | real | kind_phys | out | F | +!! | dusfc_cice | surface_x_momentum_flux_for_coupling_interstitial | sfc x momentum flux for coupling interstitial | Pa | 1 | real | kind_phys | out | F | +!! | dvsfc_cice | surface_y_momentum_flux_for_coupling_interstitial | sfc y momentum flux for coupling interstitial | Pa | 1 | real | kind_phys | out | F | +!! | dtsfc_cice | surface_upward_sensible_heat_flux_for_coupling_interstitial | sfc sensible heat flux for coupling interstitial | W m-2 | 1 | real | kind_phys | out | F | +!! | dqsfc_cice | surface_upward_latent_heat_flux_for_coupling_interstitial | sfc latent heat flux for coupling interstitial | W m-2 | 1 | real | kind_phys | out | F | !! | tisfc | sea_ice_temperature | sea-ice surface temperature | K | 1 | real | kind_phys | in | F | !! | tsfco | sea_surface_temperature | sea surface temperature | K | 1 | real | kind_phys | in | F | !! | fice | sea_ice_concentration | sea-ice concentration [0,1] | frac | 1 | real | kind_phys | in | F | @@ -251,6 +251,12 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, tsurf(i) = tsfc(i) zlvl(i) = phil(i,1) * onebg end do + + if(cplflx)then + write(*,*)'Fatal error: CCPP is not ready for cplflx=true!!' + stop + endif + if (cplflx) then do i=1,im islmsk_cice(i) = int(slimskin_cpl(i)+0.5) diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index 96c641ac3..900a23f3c 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -265,6 +265,10 @@ subroutine sfc_sice_run & do i = 1, im islmsk_LOCAL(i) = islimsk(i) enddo + if(cplflx)then + write(*,*)'Fatal error: CCPP is not ready for cplflx=true!!' + stop + endif if (cplflx) then do i=1,im From 2f013964b032fc0ba66efc6ca39b9308fcfc0f95 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 20 Aug 2019 13:48:17 -0600 Subject: [PATCH 03/10] change units of runoff fluxes to kg m-2 s-1 in the metadata (and in the code for RUC LSM); change units of soil moisture content and runoff variables to kg m-2 (CCPP metadata had been in error and they only were in kg m-2 after a conversion in GFS_diagnostics.F90); should be merged with removal of conversion factor in GFS_diagnostics.F90 in FV3 repo --- physics/GFS_surface_generic.F90 | 13 ++++++------- physics/sfc_drv.f | 10 +++++----- physics/sfc_drv_ruc.F90 | 18 +++++++++--------- 3 files changed, 20 insertions(+), 21 deletions(-) diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 5504eb7cd..62214438c 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -272,7 +272,7 @@ end subroutine GFS_surface_generic_post_finalize !! | xcosz | instantaneous_cosine_of_zenith_angle | cosine of zenith angle at current time | none | 1 | real | kind_phys | in | F | !! | evbs | soil_upward_latent_heat_flux | soil upward latent heat flux | W m-2 | 1 | real | kind_phys | in | F | !! | evcw | canopy_upward_latent_heat_flux | canopy upward latent heat flux | W m-2 | 1 | real | kind_phys | in | F | -!! | trans | transpiration_flux | total plant transpiration rate | kg m-2 s-1 | 1 | real | kind_phys | in | F | +!! | trans | transpiration_flux | total plant transpiration rate | W m-2 | 1 | real | kind_phys | in | F | !! | sbsno | snow_deposition_sublimation_upward_latent_heat_flux | latent heat flux from snow depo/subl | W m-2 | 1 | real | kind_phys | in | F | !! | snowc | surface_snow_area_fraction | surface snow area fraction | frac | 1 | real | kind_phys | in | F | !! | snohf | snow_freezing_rain_upward_latent_heat_flux | latent heat flux due to snow and frz rain | W m-2 | 1 | real | kind_phys | in | F | @@ -322,8 +322,8 @@ end subroutine GFS_surface_generic_post_finalize !! | ep | cumulative_surface_upward_potential_latent_heat_flux_multiplied_by_timestep | cumulative surface upward potential latent heat flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | !! | runoff | total_runoff | total water runoff | kg m-2 | 1 | real | kind_phys | inout | F | !! | srunoff | surface_runoff | surface water runoff (from lsm) | kg m-2 | 1 | real | kind_phys | inout | F | -!! | runof | surface_runoff_flux | surface runoff flux | g m-2 s-1 | 1 | real | kind_phys | in | F | -!! | drain | subsurface_runoff_flux | subsurface runoff flux | g m-2 s-1 | 1 | real | kind_phys | in | F | +!! | runof | surface_runoff_flux | surface runoff flux | kg m-2 s-1 | 1 | real | kind_phys | in | F | +!! | drain | subsurface_runoff_flux | subsurface runoff flux | kg m-2 s-1 | 1 | real | kind_phys | 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 | !! @@ -365,7 +365,7 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt real(kind=kind_phys), parameter :: albdf = 0.06d0 integer :: i - real(kind=kind_phys) :: tem, xcosz_loc, ocalnirdf_cpl, ocalnirbm_cpl, ocalvisdf_cpl, ocalvisbm_cpl + real(kind=kind_phys) :: xcosz_loc, ocalnirdf_cpl, ocalnirbm_cpl, ocalvisdf_cpl, ocalvisbm_cpl ! Initialize CCPP error handling variables errmsg = '' @@ -459,10 +459,9 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt ! --- ... total runoff is composed of drainage into water table and ! runoff at the surface and is accumulated in unit of meters if (lssav) then - tem = dtf * 0.001 do i=1,im - runoff(i) = runoff(i) + (drain(i)+runof(i)) * tem - srunoff(i) = srunoff(i) + runof(i) * tem + runoff(i) = runoff(i) + (drain(i)+runof(i)) * dtf + srunoff(i) = srunoff(i) + runof(i) * dtf enddo endif diff --git a/physics/sfc_drv.f b/physics/sfc_drv.f index ffe47ee17..d521be250 100644 --- a/physics/sfc_drv.f +++ b/physics/sfc_drv.f @@ -231,17 +231,17 @@ end subroutine lsm_noah_finalize !! | 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 | +!! | trans | transpiration_flux | total plant transpiration rate | W m-2 | 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_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 | +!! | drain | subsurface_runoff_flux | subsurface runoff flux | kg m-2 s-1 | 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 | +!! | runoff | surface_runoff_flux | surface runoff flux | 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 | @@ -614,7 +614,7 @@ subroutine lsm_noah_run & trans(i) = ett sbsno(i) = esnow snowc(i) = sncovr - stm(i) = soilm + stm(i) = soilm * 1000.0 ! unit conversion (from m to kg m-2) snohf(i) = flx1 + flx2 + flx3 smcwlt2(i) = smcwlt @@ -630,7 +630,7 @@ subroutine lsm_noah_run & enddo wet1(i) = smsoil(1) / smcmax !Sarah Lu added 09/09/2010 (for GOCART) -! --- ... unit conversion (from m s-1 to mm s-1) +! --- ... unit conversion (from m s-1 to mm s-1 and kg m-2 s-1) runoff(i) = runoff1 * 1000.0 drain (i) = runoff2 * 1000.0 diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 8316aba4d..ddf03e248 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -236,9 +236,9 @@ end subroutine lsm_ruc_finalize !! | evbs | soil_upward_latent_heat_flux | soil upward latent heat flux | W m-2 | 1 | real | kind_phys | out | F | !! | evcw | canopy_upward_latent_heat_flux | canopy upward latent heat flux | W m-2 | 1 | real | kind_phys | out | F | !! | sbsno | snow_deposition_sublimation_upward_latent_heat_flux | latent heat flux from snow depo/subl | W m-2 | 1 | real | kind_phys | out | F | -!! | trans | transpiration_flux | total plant transpiration rate | kg m-2 s-1 | 1 | real | kind_phys | out | F | -!! | runof | surface_runoff_flux | surface runoff flux | g m-2 s-1 | 1 | real | kind_phys | out | F | -!! | drain | subsurface_runoff_flux | subsurface runoff flux | g m-2 s-1 | 1 | real | kind_phys | out | F | +!! | trans | transpiration_flux | total plant transpiration rate | W m-2 | 1 | real | kind_phys | out | F | +!! | runof | surface_runoff_flux | surface runoff flux | kg m-2 s-1 | 1 | real | kind_phys | out | F | +!! | drain | subsurface_runoff_flux | subsurface runoff flux | kg m-2 s-1 | 1 | real | kind_phys | out | F | !! | runoff | total_runoff | total water runoff | kg m-2 | 1 | real | kind_phys | inout | F | !! | srunoff | surface_runoff | surface water runoff (from lsm) | kg m-2 | 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 | out | F | @@ -1032,12 +1032,12 @@ subroutine lsm_ruc_run & ! inputs sfcdew(i) = dew(i,j) qsurf(i) = qsfc(i,j) sncovr1(i) = sncovr(i,j) - stm(i) = soilm(i,j) + stm(i) = soilm(i,j) * 1000.0 ! unit conversion (from m to kg m-2) tsurf(i) = soilt(i,j) tice(i) = tsurf(i) - ! --- ... units [m/s] = [g m-2 s-1] - runof (i) = runoff1(i,j) - drain (i) = runoff2(i,j) + + runof (i) = runoff1(i,j) * 1000.0 ! unit conversion (from m s-1 to mm s-1 and kg m-2 s-1) + drain (i) = runoff2(i,j) * 1000.0 ! unit conversion (from m s-1 to mm s-1 and kg m-2 s-1) wetness(i) = wet(i,j) @@ -1048,8 +1048,8 @@ subroutine lsm_ruc_run & ! inputs rhosnf(i) = rhosnfr(i,j) ! --- ... accumulated total runoff and surface runoff - runoff(i) = runoff(i) + (drain(i)+runof(i)) * delt * 0.001 ! kg m-2 - srunoff(i) = srunoff(i) + runof(i) * delt * 0.001 ! kg m-2 + runoff(i) = runoff(i) + (drain(i)+runof(i)) * delt ! kg m-2 + srunoff(i) = srunoff(i) + runof(i) * delt ! kg m-2 ! --- ... accumulated frozen precipitation (accumulation in lsmruc) snowfallac(i) = snfallac(i,j) ! kg m-2 From a82db03d3072050ba232c5853fd815b7eca45b59 Mon Sep 17 00:00:00 2001 From: "Linlin.Pan" Date: Thu, 22 Aug 2019 19:02:26 +0000 Subject: [PATCH 04/10] adding coupling option in ccpp modified according to Dom's comments passed regression test. --- physics/GFS_PBL_generic.F90 | 3 +-- physics/sfc_cice.f | 38 ++++--------------------------------- physics/sfc_sice.f | 22 +++++++++------------ 3 files changed, 14 insertions(+), 49 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 93ce62deb..3c755705e 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -485,8 +485,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, endif endif ! nvdiff == ntrac - write(*,*)rd,cp,hvap,fvirt -!! new adding + if (cplchm) then do i = 1, im tem1 = max(q1(i), 1.e-8) diff --git a/physics/sfc_cice.f b/physics/sfc_cice.f index d7b84f800..d5a18c94c 100644 --- a/physics/sfc_cice.f +++ b/physics/sfc_cice.f @@ -1,40 +1,10 @@ !> \file sfc_cice.f !! This file contains the sfc_sice for coupling to CICE -!> 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_cice_pre - - contains -!! \section arg_table_sfc_cice_post_init Argument Table -!! - subroutine sfc_cice_pre_init - end subroutine sfc_cice_pre_init - - subroutine sfc_cice_pre_finalize - end subroutine sfc_cice_pre_finalize - - end module sfc_cice_pre -!! - module sfc_cice_post - - contains -!! \section arg_table_sfc_cice_post_init Argument Table -!! - subroutine sfc_cice_post_init - end subroutine sfc_cice_post_init - -!! \section arg_table_sfc_cice_post_finalize Argument Table -!! - subroutine sfc_cice_post_finalize - end subroutine sfc_cice_post_finalize - - subroutine sfc_cice_post_run - end subroutine sfc_cice_post_run - - end module sfc_cice_post +!> This module contains 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. !> This module contains the CCPP-compliant GFS sea ice scheme. module sfc_cice diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index 900a23f3c..8e4881990 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -248,7 +248,7 @@ subroutine sfc_sice_run & real (kind=kind_phys) :: cpinv, hvapi, elocp integer :: i, k - integer, dimension(im) :: islmsk_LOCAL + integer, dimension(im) :: islmsk_local logical :: flag(im) ! @@ -262,24 +262,20 @@ subroutine sfc_sice_run & errmsg = '' errflg = 0 - do i = 1, im - islmsk_LOCAL(i) = islimsk(i) - enddo if(cplflx)then write(*,*)'Fatal error: CCPP is not ready for cplflx=true!!' stop endif - if (cplflx) then - do i=1,im - if (flag_cice(i)) then - islmsk_LOCAL (i) = islmsk_cice(i) + do i = 1, im + islmsk_local(i) = islimsk(i) + if (flag_cice(i).and.cplflx) then + islmsk_local (i) = islmsk_cice(i) endif - enddo - endif + enddo do i = 1, im - islimsk(i)=islmsk_LOCAL(i) + islimsk(i)=islmsk_local(i) enddo if (cplflx .or. cplchm) then @@ -294,8 +290,8 @@ subroutine sfc_sice_run & !> - Set flag for sea-ice. do i = 1, im - flag(i) = (islmsk_LOCAL(i) == 2) .and. flag_iter(i) - if (flag_iter(i) .and. islmsk_LOCAL(i) < 2) then + flag(i) = (islmsk_local(i) == 2) .and. flag_iter(i) + if (flag_iter(i) .and. islmsk_local(i) < 2) then hice(i) = zero fice(i) = zero endif From 9b56b9007c4262b2087eb659eb62c168da061386 Mon Sep 17 00:00:00 2001 From: "Linlin.Pan" Date: Tue, 27 Aug 2019 16:33:34 +0000 Subject: [PATCH 05/10] adding coupling option to CCPP modified sfc_cice.f --- physics/sfc_cice.f | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/physics/sfc_cice.f b/physics/sfc_cice.f index d5a18c94c..eb66b28ce 100644 --- a/physics/sfc_cice.f +++ b/physics/sfc_cice.f @@ -65,7 +65,6 @@ end subroutine sfc_cice_finalize !! use physcons, only : hvap => con_hvap, cp => con_cp, & !! & rvrdm1 => con_fvirt, rd => con_rd - contains ! !----------------------------------- subroutine sfc_cice_run & @@ -120,11 +119,6 @@ subroutine sfc_cice_run & real (kind=kind_phys), intent(in) :: hvap, cp, rvrdm1, rd -!- 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 - ! --- inputs: integer, intent(in) :: im logical, intent(in) :: cplflx @@ -149,6 +143,8 @@ subroutine sfc_cice_run & real (kind=kind_phys) :: tem + real(kind=kind_phys) :: cpinv, hvapi, elocp + integer :: i logical :: flag(im) @@ -156,6 +152,10 @@ subroutine sfc_cice_run & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + + cpinv = 1.0/cp + hvapi = 1.0/hvap + elocp = hvap/cp ! if((.not. cplflx).and.(.not.cplchm))then return From a72e150284a1ce4c21ada0e3a11f0fb8c60a8911 Mon Sep 17 00:00:00 2001 From: climbfuji Date: Wed, 28 Aug 2019 11:18:32 -0600 Subject: [PATCH 06/10] physics/GFS_PBL_generic.F90: formatting changes, updates of comments --- physics/GFS_PBL_generic.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 3c755705e..357917ab7 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -361,8 +361,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag logical, dimension(:),intent(in) :: dry, icy - - real(kind=kind_phys), dimension(:), intent(out) :: ushfsfci + real(kind=kind_phys), dimension(:), intent(out) :: ushfsfci character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -502,7 +501,6 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! --- ... coupling insertion -! ### GJF ### the following section needs to be made CCPP-compliant when cplflx = T if (cplflx) then do i=1,im if (oceanfrac(i) > 0.0) then ! Ocean only, NO LAKES @@ -540,6 +538,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, enddo endif +!-------------------------------------------------------lssav if loop ---------- if (lssav) then do i=1,im dusfc_diag (i) = dusfc_diag(i) + dusfc1(i)*dtf From da8bea5b895dc2c026be183b38959f82846765d2 Mon Sep 17 00:00:00 2001 From: climbfuji Date: Wed, 28 Aug 2019 11:19:19 -0600 Subject: [PATCH 07/10] physics/sfc_cice.f, physics/sfc_sice.f: bugfixes for coupling code to correct logic for cice land-sea-ice mask --- physics/sfc_cice.f | 32 +++++++++++++------------------- physics/sfc_sice.f | 37 +++++++++++++------------------------ 2 files changed, 26 insertions(+), 43 deletions(-) diff --git a/physics/sfc_cice.f b/physics/sfc_cice.f index eb66b28ce..e969d677f 100644 --- a/physics/sfc_cice.f +++ b/physics/sfc_cice.f @@ -26,11 +26,11 @@ end subroutine sfc_cice_finalize !> \brief Brief description of the subroutine !! !! \section arg_table_cice_run Arguments -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | !! +!! | 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 -!! | cplchm | flag_for_chemistry_coupling | flag controlling cplchm collection (default off) | flag | 0 | logical | | in | F | +!! | cplflx | flag_for_flux_coupling | flag controlling cplflx collection (default off) | flag | 0 | logical | | in | F | +!! | cplchm | flag_for_chemistry_coupling | flag controlling cplchm collection (default off) | flag | 0 | logical | | 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 | !! | 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 | @@ -40,10 +40,10 @@ end subroutine sfc_cice_finalize !! | 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 | !! | 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 +!! | 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 | +!! | flag_cice | flag_for_cice | flag for cice | flag | 1 | logical | | 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 | !! | dqsfc | dqsfcin | aoi_fld%dqsfcin(item,lan) | | 1 | real | kind_phys | none | F | @@ -70,7 +70,7 @@ end subroutine sfc_cice_finalize subroutine sfc_cice_run & & ( im, cplflx, cplchm, hvap, cp, rvrdm1, rd, & ! --- inputs: & u1, v1, t1, q1, cm, ch, prsl1, prslki, & - & islimsk, ddvel, flag_iter, dqsfc, dtsfc, & + & flag_cice, ddvel, flag_iter, dqsfc, dtsfc, & & qsurf, cmm, chh, evap, hflx, & ! --- outputs: & errmsg, errflg & ) @@ -127,7 +127,7 @@ subroutine sfc_cice_run & real (kind=kind_phys), dimension(im), intent(in) :: u1, v1, & & t1, q1, cm, ch, prsl1, prslki, ddvel, dqsfc, dtsfc - integer, dimension(im), intent(in) :: islimsk + logical, dimension(im), intent(in) :: flag_cice logical, intent(in) :: flag_iter(im) @@ -146,27 +146,21 @@ subroutine sfc_cice_run & real(kind=kind_phys) :: cpinv, hvapi, elocp integer :: i - - logical :: flag(im) ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - +! + if ((.not. cplflx) .and. (.not.cplchm)) then + return + endif +! cpinv = 1.0/cp hvapi = 1.0/hvap elocp = hvap/cp -! - if((.not. cplflx).and.(.not.cplchm))then - return - endif - - do i = 1, im - flag(i) = (islimsk(i) == 4) .and. flag_iter(i) - enddo ! do i = 1, im - if (flag(i)) then + if (flag_cice(i) .and. flag_iter(i)) then wind(i) = sqrt(u1(i)*u1(i) + v1(i)*v1(i)) & & + max(0.0, min(ddvel(i), 30.0)) diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index 8e4881990..7b817d813 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -45,7 +45,7 @@ end subroutine sfc_sice_finalize !! | 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 | | inout | F | +!! | islimsk | sea_land_ice_mask | sea/land/ice mask (=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 | !! | lprnt | flag_print | switch for printing sample column to stdout | flag | 0 | logical | | in | F | @@ -70,7 +70,6 @@ end subroutine sfc_sice_finalize !! | cplchm | flag_for_chemistry_coupling | flag controlling cplchm collection (default off) | flag | 0 | logical | | in | F | !! | flag_cice | flag_for_cice | flag for cice | flag | 1 | logical | | in | F | !! | islmsk_cice | sea_land_ice_mask_cice | sea/land/ice mask cice (=0/1/2) | flag | 1 | integer | | in | F | -!! | slmsk | sea_land_ice_mask_real | landmask: sea/land/ice=0/1/2 | flag | 1 | real | kind_phys | 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 | !! @@ -104,7 +103,7 @@ subroutine sfc_sice_run & & flag_iter, lprnt, ipr, & & hice, fice, tice, weasd, tskin, tprcp, stc, ep, & ! --- input/outputs: & snwdph, qsurf, snowmt, gflux, cmm, chh, evap, hflx, & ! - & cplflx, cplchm, flag_cice, islmsk_cice, slmsk, & + & cplflx, cplchm, flag_cice, islmsk_cice, & & errmsg, errflg & ) @@ -216,10 +215,9 @@ subroutine sfc_sice_run & & t1, q1, sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, cm, ch, & & prsl1, prslki, ddvel - integer, dimension(im), intent(inout) :: islimsk + integer, dimension(im), intent(in) :: islimsk integer, dimension(im), intent(in) :: islmsk_cice real (kind=kind_phys), intent(in) :: delt - real (kind=kind_phys), dimension(im), intent(in) :: slmsk logical, dimension(im), intent(in) :: flag_iter, flag_cice @@ -263,28 +261,19 @@ subroutine sfc_sice_run & errflg = 0 if(cplflx)then - write(*,*)'Fatal error: CCPP is not ready for cplflx=true!!' + write(*,*)'Fatal error: CCPP not been tested with cplflx=true!' stop endif - do i = 1, im - islmsk_local(i) = islimsk(i) - if (flag_cice(i).and.cplflx) then - islmsk_local (i) = islmsk_cice(i) - endif - enddo - - do i = 1, im - islimsk(i)=islmsk_local(i) - enddo - - if (cplflx .or. cplchm) then - do i = 1, im - if (flag_cice(i)) then - islimsk(i) = int(slmsk(i)+0.5) - endif - enddo - endif + if (cplflx) then + where (flag_cice) + islmsk_local = islmsk_cice + elsewhere + islmsk_local = islimsk + endwhere + else + islmsk_local = islimsk + end if ! !> - Set flag for sea-ice. From 5a21626935e777875067f5922f22e4e084753565 Mon Sep 17 00:00:00 2001 From: climbfuji Date: Wed, 28 Aug 2019 17:17:38 -0600 Subject: [PATCH 08/10] physics/GFS_PBL_generic.F90: bugfix, add missing assignment of interstitial dkt to coupling dkt --- physics/GFS_PBL_generic.F90 | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 357917ab7..cecc477a4 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -314,6 +314,8 @@ end subroutine GFS_PBL_generic_post_finalize !! | 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 | !! | ugrs1 | x_wind_at_lowest_model_layer | zonal wind at lowest model layer | m s-1 | 1 | real | kind_phys | in | F | !! | vgrs1 | y_wind_at_lowest_model_layer | meridional wind at lowest model layer | m s-1 | 1 | real | kind_phys | in | F | +!! | dkt_cpl | instantaneous_atmosphere_heat_diffusivity | instantaneous atmospheric heat diffusivity | m2 s-1 | 2 | real | kind_phys | inout | F | +!! | dkt | atmosphere_heat_diffusivity | diffusivity for heat | m2 s-1 | 2 | real | kind_phys | 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 | !! @@ -327,7 +329,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, & dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, & dq3dt_ozone, rd, cp,fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, fice, dusfc_cice, dvsfc_cice, dtsfc_cice, & - dqsfc_cice, dry, icy, wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1, errmsg, errflg) + dqsfc_cice, dry, icy, wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1, dkt_cpl, dkt, errmsg, errflg) use machine, only: kind_phys @@ -362,6 +364,10 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, logical, dimension(:),intent(in) :: dry, icy real(kind=kind_phys), dimension(:), intent(out) :: ushfsfci + + real(kind=kind_phys), dimension(:,:), intent(inout) :: dkt_cpl + real(kind=kind_phys), dimension(:,:), intent(in) :: dkt + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -491,7 +497,8 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, tem = prsl(i,1) / (rd*t1(i)*(1.0+fvirt*tem1)) ushfsfci(i) = -cp * tem * hflx(i) ! upward sensible heat flux enddo -!! Coupling%dkt (:,:) = dkt (:,:) + ! dkt_cpl has dimensions (1:im,1:levs), but dkt has (1:im,1:levs-1) + dkt_cpl(1:im,1:levs-1) = dkt(1:im,1:levs-1) endif if(cplflx)then From 3f885901b6e59a0f56b89cececbda32beb384550 Mon Sep 17 00:00:00 2001 From: climbfuji Date: Wed, 28 Aug 2019 17:17:59 -0600 Subject: [PATCH 09/10] physics/GFS_surface_generic.F90: bugfix, remove coupling code that is no longer in GFS_physics_driver.F90, remove redundant assignment of default values for flag_cice --- physics/GFS_surface_generic.F90 | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 7b7fa7e9d..8acf186c1 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -142,9 +142,6 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, tisfc, tsfco, fice, hice real(kind=kind_phys), dimension(im), intent(out) ::ulwsfc_cice, & dusfc_cice, dvsfc_cice, dtsfc_cice, dqsfc_cice - real(kind=kind_phys), dimension(im) :: tisfc_cice, tsea_cice, & - fice_cice,hice_cice - ! CCPP error handling character(len=*), intent(out) :: errmsg @@ -262,23 +259,13 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, islmsk_cice(i) = int(slimskin_cpl(i)+0.5) if(islmsk_cice(i) == 4)then flag_cice(i) = .true. - else - flag_cice(i) = .false. endif ulwsfc_cice(i) = ulwsfcin_cpl(i) dusfc_cice(i) = dusfcin_cpl(i) dvsfc_cice(i) = dvsfcin_cpl(i) dtsfc_cice(i) = dtsfcin_cpl(i) dqsfc_cice(i) = dqsfcin_cpl(i) - tisfc_cice(i) = tisfc(i) - tsea_cice(i) = tsfco(i) - fice_cice(i) = fice(i) - hice_cice(i) = hice(i) - if(flag_cice(i)) tsfc(i) = fice_cice(i)*tisfc_cice(i) + (1. - fice_cice(i))*tsea_cice(i) enddo - else - ! Avoid uninitialized variables - set to default values - flag_cice = .false. endif From 65ec1e3e4e55fffa7fd95af560a6ac4883899a8b Mon Sep 17 00:00:00 2001 From: climbfuji Date: Wed, 28 Aug 2019 17:28:43 -0600 Subject: [PATCH 10/10] physics/GFS_PBL_generic.F90: rename instantaneous_upward_sensible_heat_flux to instantaneous_surface_upward_sensible_heat_flux_for_chemistry_coupling --- physics/GFS_PBL_generic.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index cecc477a4..b67e07d76 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -299,7 +299,7 @@ end subroutine GFS_PBL_generic_post_finalize !! | q1 | water_vapor_specific_humidity_at_lowest_model_layer_for_diag | layer 1 specific humidity for diag | kg kg-1 | 1 | real | kind_phys | in | F | !! | prsl | air_pressure | mean layer pressure | Pa | 2 | 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 | in | F | -!! | ushfsfci | instantaneous_upward_sensible_heat_flux | instantaneous upward sensible heat flux | W m-2 | 1 | real | kind_phys | out | F | +!! | ushfsfci | instantaneous_surface_upward_sensible_heat_flux_for_chemistry_coupling | instantaneous upward sensible heat flux for chemistry coupling | W m-2 | 1 | real | kind_phys | out | F | !! | oceanfrac | sea_area_fraction | fraction of horizontal grid area occupied by ocean | frac | 1 | real | kind_phys | in | F | !! | fice | sea_ice_concentration | ice fraction over open water | frac | 1 | real | kind_phys | in | F | !! | dusfc_cice | surface_x_momentum_flux_for_coupling_interstitial | sfc x momentum flux for coupling interstitial | Pa | 1 | real | kind_phys | in | F |