diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index 6e0c61ff8..825929207 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -23,7 +23,6 @@ module module_physics_driver use edmf, only: edmf_run use GFS_PBL_generic_pre, only: GFS_PBL_generic_pre_run use GFS_PBL_generic_post, only: GFS_PBL_generic_post_run -! use sasas_deep, only: sasasdeep_run use GFS_DCNV_generic_pre, only: GFS_DCNV_generic_pre_run use GFS_DCNV_generic_post, only: GFS_DCNV_generic_post_run use GFS_SCNV_generic_pre, only: GFS_SCNV_generic_pre_run @@ -41,6 +40,15 @@ module module_physics_driver use GFS_MP_generic_post, only: GFS_MP_generic_post_run use GFS_MP_generic_pre, only: GFS_MP_generic_pre_run use GFS_zhao_carr_pre, only: GFS_zhao_carr_pre_run + + use lsm_noah + use lsm_noah_pre + use lsm_noah_post + use surface_exchange_coefficients + use surface_diagnose + use GFS_surface_loop_control_part1 + use GFS_surface_loop_control_part2 + implicit none @@ -698,9 +706,9 @@ subroutine GFS_physics_driver & endif ! --- ... transfer soil moisture and temperature from global to local variables - smsoil(:,:) = Sfcprop%smc(:,:) +! smsoil(:,:) = Sfcprop%smc(:,:) stsoil(:,:) = Sfcprop%stc(:,:) - slsoil(:,:) = Sfcprop%slc(:,:) !! clu: slc -> slsoil +! slsoil(:,:) = Sfcprop%slc(:,:) !! clu: slc -> slsoil ! dudt(:,:) = 0. ! dvdt(:,:) = 0. ! dtdt(:,:) = 0. @@ -881,20 +889,22 @@ subroutine GFS_physics_driver & tsurf(:) = Sfcprop%tsfc(:) flag_guess(:) = .false. flag_iter(:) = .true. - drain(:) = 0.0 +! drain(:) = 0.0 ep1d(:) = 0.0 - runof(:) = 0.0 +! runof(:) = 0.0 !hflx(:) = 0.0 !evap(:) = 0.0 - evbs(:) = 0.0 - evcw(:) = 0.0 - trans(:) = 0.0 - sbsno(:) = 0.0 - snowc(:) = 0.0 - snohf(:) = 0.0 +! evbs(:) = 0.0 +! evcw(:) = 0.0 +! trans(:) = 0.0 +! sbsno(:) = 0.0 +! snowc(:) = 0.0 +! snohf(:) = 0.0 Diag%zlvl(:) = Statein%phil(:,1) * onebg - Diag%smcwlt2(:) = 0.0 - Diag%smcref2(:) = 0.0 +! Diag%smcwlt2(:) = 0.0 +! Diag%smcref2(:) = 0.0 + call lsm_noah_pre_run(im,Model%lsoil,smsoil,slsoil,Sfcprop%smc(:,:),Sfcprop%slc(:,:), & + drain,runof,evbs,evcw,trans,sbsno,snowc,snohf,Diag%smcwlt2(:),Diag%smcref2(:)) ! --- ... lu: iter-loop over (sfc_diff,sfc_drv,sfc_ocean,sfc_sice) @@ -904,22 +914,24 @@ subroutine GFS_physics_driver & ! ! if (lprnt) write(0,*)' tsea=',tsea(ipr),' tsurf=',tsurf(ipr),iter - call sfc_diff (im,Statein%pgr, Statein%ugrs, Statein%vgrs, & - Statein%tgrs, Statein%qgrs, Diag%zlvl, & +! call sfc_diff (im,Statein%pgr, Statein%ugrs, Statein%vgrs, & + call sfc_ex_coef_run(im,Statein%pgr, Statein%ugrs(:,1), Statein%vgrs(:,1), & + Statein%tgrs(:,1), Statein%qgrs(:,1,1), Diag%zlvl, & Sfcprop%snowd, Sfcprop%tsfc, Sfcprop%zorl, cd, & - cdq, rb, Statein%prsl(1,1), work3, islmsk, stress, & + cdq, rb, Statein%prsl(:,1), work3, islmsk, stress, & Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%uustar, & - wind, Tbd%phy_f2d(1,Model%num_p2d), fm10, fh2, & + wind, Tbd%phy_f2d(:,Model%num_p2d), fm10, fh2, & sigmaf, vegtype, Sfcprop%shdmax, Model%ivegsrc, & tsurf, flag_iter, Model%redrag) ! --- ... lu: update flag_guess - do i = 1, im - if (iter == 1 .and. wind(i) < 2.0) then - flag_guess(i) = .true. - endif - enddo +! do i = 1, im +! if (iter == 1 .and. wind(i) < 2.0) then +! flag_guess(i) = .true. +! endif +! enddo + call GFS_surface_loop_control_part1_run(im,iter,wind,flag_guess) if (Model%nstf_name(1) > 0) then @@ -985,13 +997,14 @@ subroutine GFS_physics_driver & ! if (lprnt) write(0,*)' tsead=',tsea(ipr),' tsurf=',tsurf(ipr),iter ! &,' pgr=',pgr(ipr),' sfcemis=',sfcemis(ipr) - call sfc_drv & +! call sfc_drv & + call lsm_noah_run & ! --- inputs: - (im, Model%lsoil, Statein%pgr, Statein%ugrs, Statein%vgrs, & - Statein%tgrs, Statein%qgrs, soiltyp, vegtype, sigmaf, & + (im, Model%lsoil, Statein%pgr, Statein%ugrs(:,1), Statein%vgrs(:,1), & + Statein%tgrs(:,1), Statein%qgrs(:,1,1), soiltyp, vegtype, sigmaf, & Radtend%semis, gabsbdlw, adjsfcdsw, adjsfcnsw, dtf, & - Sfcprop%tg3, cd, cdq, Statein%prsl(1,1), work3, DIag%zlvl, & - islmsk, Tbd%phy_f2d(1,Model%num_p2d), slopetyp, & + Sfcprop%tg3, cd, cdq, Statein%prsl(:,1), work3, DIag%zlvl, & + islmsk, Tbd%phy_f2d(:,Model%num_p2d), slopetyp, & Sfcprop%shdmin, Sfcprop%shdmax, Sfcprop%snoalb, & Radtend%sfalb, flag_iter, flag_guess, Model%isot, & Model%ivegsrc, & @@ -1056,16 +1069,16 @@ subroutine GFS_physics_driver & ! --- ... lu: update flag_iter and flag_guess - do i = 1, im - flag_iter(i) = .false. - flag_guess(i) = .false. - - if (iter == 1 .and. wind(i) < 2.0) then - if ((islmsk(i) == 1) .or. ((islmsk(i) == 0) .and. & - (Model%nstf_name(1) > 0))) then - flag_iter(i) = .true. - endif - endif +! do i = 1, im +! flag_iter(i) = .false. +! flag_guess(i) = .false. +! +! if (iter == 1 .and. wind(i) < 2.0) then +! if ((islmsk(i) == 1) .or. ((islmsk(i) == 0) .and. & +! (Model%nstf_name(1) > 0))) then +! flag_iter(i) = .true. +! endif +! endif ! if(islmsk(i) == 1 .and. iter == 1) then ! if (wind(i) < 2.0) flag_iter(i) = .true. @@ -1073,7 +1086,9 @@ subroutine GFS_physics_driver & ! & .and. nstf_name(1) > 0) then ! if (wind(i) < 2.0) flag_iter(i) = .true. ! endif - enddo +! enddo + call GFS_surface_loop_control_part2_run(im,iter,wind,flag_guess,& + flag_iter,islmsk,Model%nstf_name(1)) enddo ! end iter_loop @@ -1090,9 +1105,10 @@ subroutine GFS_physics_driver & ! --- ... update near surface fields - call sfc_diag (im, Statein%pgr, Statein%ugrs, Statein%vgrs, & - Statein%tgrs, Statein%qgrs, Sfcprop%tsfc, qss, & - Sfcprop%f10m, Diag%u10m, Diag%v10m, & +! call sfc_diag (im, Statein%pgr, Statein%ugrs, Statein%vgrs, & + call sfc_diag_run(im, Statein%pgr, Statein%ugrs(:,1), Statein%vgrs(:,1), & + Statein%tgrs(:,1), Statein%qgrs(:,1,1), Sfcprop%tsfc, qss, & + Sfcprop%f10m, Diag%u10m, Diag%v10m, & Sfcprop%t2m, Sfcprop%q2m, work3, evap, & Sfcprop%ffmm, Sfcprop%ffhh, fm10, fh2) @@ -2678,11 +2694,16 @@ subroutine GFS_physics_driver & !!! this change allows gocart to use filtered wind fields !!! if (Model%lgocart) then - call sfc_diag (im, Statein%pgr, Stateout%gu0, Stateout%gv0, & - Stateout%gt0, Stateout%gq0, Sfcprop%tsfc, qss, & - Sfcprop%f10m, Diag%u10m, Diag%v10m, Sfcprop%t2m, & - Sfcprop%q2m, work3, evap, Sfcprop%ffmm, & - Sfcprop%ffhh, fm10, fh2) +! call sfc_diag (im, Statein%pgr, Stateout%gu0, Stateout%gv0, & +! Stateout%gt0, Stateout%gq0, Sfcprop%tsfc, qss, & +! Sfcprop%f10m, Diag%u10m, Diag%v10m, Sfcprop%t2m, & +! Sfcprop%q2m, work3, evap, Sfcprop%ffmm, & +! Sfcprop%ffhh, fm10, fh2) + call sfc_diag_run(im, Statein%pgr, Statein%ugrs(:,1), Statein%vgrs(:,1), & + Statein%tgrs(:,1), Statein%qgrs(:,1,1), Sfcprop%tsfc, qss, & + Sfcprop%f10m, Diag%u10m, Diag%v10m, & + Sfcprop%t2m, Sfcprop%q2m, work3, evap, & + Sfcprop%ffmm, Sfcprop%ffhh, fm10, fh2) if (Model%lssav) then Diag%tmpmax (:) = max(Diag%tmpmax (:),Sfcprop%t2m(:)) @@ -2694,11 +2715,13 @@ subroutine GFS_physics_driver & ! --- ... total runoff is composed of drainage into water table and ! runoff at the surface and is accumulated in unit of meters - if (Model%lssav) then - tem = dtf * 0.001 - Diag%runoff(:) = Diag%runoff(:) + (drain(:)+runof(:)) * tem - Diag%srunoff(:) = Diag%srunoff(:) + runof(:) * tem - endif +! if (Model%lssav) then +! tem = dtf * 0.001 +! Diag%runoff(:) = Diag%runoff(:) + (drain(:)+runof(:)) * tem +! Diag%srunoff(:) = Diag%srunoff(:) + runof(:) * tem +! endif + call lsm_noah_post_run(im,Model%lsoil,smsoil,slsoil,Sfcprop%smc(:,:),Sfcprop%slc(:,:), & + Model%lssav,dtf,drain,runof,Diag%runoff(:),Diag%srunoff(:)) ! --- ... xw: return updated ice thickness & concentration to global array do i = 1, im @@ -2714,9 +2737,9 @@ subroutine GFS_physics_driver & enddo ! --- ... return updated smsoil and stsoil to global arrays - Sfcprop%smc(:,:) = smsoil(:,:) +! Sfcprop%smc(:,:) = smsoil(:,:) Sfcprop%stc(:,:) = stsoil(:,:) - Sfcprop%slc(:,:) = slsoil(:,:) +! Sfcprop%slc(:,:) = slsoil(:,:) ! --- ... calculate column precipitable water "pwat" ! Diag%pwat(:) = 0.0 diff --git a/makefile b/makefile index c44cb823b..bfd1f4ed5 100644 --- a/makefile +++ b/makefile @@ -95,6 +95,7 @@ SRCS_f = \ ./physics/sascnv.f \ ./physics/sascnvn.f \ ./physics/set_soilveg.f \ + ./physics/GFS_surface_loop_control.f \ ./physics/sfc_cice.f \ ./physics/sfc_diag.f \ ./physics/sfc_diff.f \ diff --git a/physics/GFS_surface_loop_control.f b/physics/GFS_surface_loop_control.f new file mode 100644 index 000000000..f267799f9 --- /dev/null +++ b/physics/GFS_surface_loop_control.f @@ -0,0 +1,121 @@ +!> \file GFS_surface_loop_control.f +!! This file contains the GFS_surface_loop_control scheme. + +!> \defgroup GFS_surface_loop_control GFS_surface_loop_control scheme +!! @{ +!! \brief Brief description of the parameterization +!! \section diagram Calling Hierarchy Diagram +!! \section intraphysics Intraphysics Communication + + module GFS_surface_loop_control_part1 + contains + + subroutine GFS_surface_loop_control_part1_init + end subroutine GFS_surface_loop_control_part1_init + + subroutine GFS_surface_loop_control_part1_finalize + end subroutine GFS_surface_loop_control_part1_finalize + +!> \brief Brief description of the subroutine +!! +!! \section arg_table_GFS_surface_loop_control_part1_run Arguments +!!| local var name | longname | description | units | rank | type | kind | intent | optional | +!!|----------------|-------------------------------------------------------------|--------------------------------------------|------------|------|---------|-----------|--------|----------| +!!| im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | in | F | +!!| iter | iteration_number | number of iteration | index | 0 | real | kind_phys | 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 | +!! +!! \section general General Algorithm +!! \section detailed Detailed Algorithm +!! @{ + + subroutine GFS_surface_loop_control_part1_run & + & ( im,iter,wind,flag_guess + & ) + + use machine, only: kind_phys + +! --- interface variables + integer, intent(in) :: im, iter + real(kind=kind_phys), dimension(im), intent(in) :: & + & wind + logical, dimension(im), intent(inout) :: & + & flag_guess + + do i = 1, im + if (iter == 1 .and. wind(i) < 2.0) then + flag_guess(i) = .true. + endif + enddo + + end subroutine GFS_surface_loop_control_part1_run +!> @} + end module GFS_surface_loop_control_part1 +!> @} + +!> \defgroup GFS_surface_loop_control GFS_surface_loop_control scheme +!! @{ +!! \brief Brief description of the parameterization +!! \section diagram Calling Hierarchy Diagram +!! \section intraphysics Intraphysics Communication + + module GFS_surface_loop_control_part2 + contains + + subroutine GFS_surface_loop_control_part2_init + end subroutine GFS_surface_loop_control_part2_init + + subroutine GFS_surface_loop_control_part2_finalize + end subroutine GFS_surface_loop_control_part2_finalize + +!> \brief Brief description of the subroutine +!! +!! \section arg_table_GFS_surface_loop_control_part2_run Arguments +!!| local var name | longname | description | units | rank | type | kind | intent | optional | +!!|----------------|-------------------------------------------------------------|--------------------------------------------|------------|------|---------|-----------|--------|----------| +!!| im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | in | F | +!!| iter | iteration_number | number of iteration | index | 0 | real | kind_phys | 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 | | in | 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 | +!! +!! \section general General Algorithm +!! \section detailed Detailed Algorithm +!! @{ + + subroutine GFS_surface_loop_control_part2_run $ + $ (im,iter,wind,flag_guess,flag_iter,islmsk,nstf_name1 + $ ) + + use machine, only: kind_phys + +! --- interface variables + integer, intent(in) :: im, iter, nstf_name1 + integer, dimension(im), intent(in) :: islmsk +! integer, dimension(im) :: islmsk + real(kind=kind_phys), dimension(im), intent(in) :: & + & wind + logical, dimension(im), intent(inout) :: & + & flag_guess,flag_iter + + do i = 1, im + flag_iter(i) = .false. + 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 + flag_iter(i) = .true. + endif + endif + + enddo + + end subroutine GFS_surface_loop_control_part2_run +!> @} + + end module GFS_surface_loop_control_part2 +!> @} diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index 0ed0dfe13..7e9395ac1 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -1,16 +1,65 @@ - subroutine sfc_diag(im,ps,u1,v1,t1,q1, - & tskin,qsurf,f10m,u10m,v10m,t2m,q2m, - & prslki,evap,fm,fh,fm10,fh2) +!> \file sfc_diag.f +!! This file contains the land surface diagnose calculation scheme. + +!> \defgroup Sfc_diag Land Surface Diagnose Calculation +!! @{ +!! \brief Brief description of the parameterization +!! \section diagram Calling Hierarchy Diagram +!! \section intraphysics Intraphysics Communication + + module surface_diagnose + contains + + subroutine sfc_diag_init + end subroutine sfc_diag_init + + subroutine sfc_diag_finalize + end subroutine sfc_diag_finalize + +!> \brief Brief description of the subroutine +!! +!! \section arg_table_sfc_diag_run Arguments +!!| local var name | longname | description | units | rank | type | kind | intent | optional | +!!|----------------|-------------------------------------------------------------|-------------------------------------------------|------------|------|---------|-----------|--------|----------| +!!| im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 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 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 | specific_humidity_at_lowest_model_layer | 1st model layer 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 | +!!| qsurf | surface_specific_humidity | surface specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | +!!| f10m | ratio_of_wind_at_lowest_model_layer_and_wind_at_10m | ratio of fm10 and fm | ratio | 1 | real | kind_phys | out | F | +!!| u10m | x_wind_at_10m | x component of wind at 10 m | m s-1 | 1 | real | kind_phys | out | F | +!!| v10m | y_wind_at_10m | y component of wind at 10 m | m s-1 | 1 | real | kind_phys | out | F | +!!| t2m | temperature_at_2m | temperature at 2 m | K | 1 | real | kind_phys | out | F | +!!| q2m | specific_humidity_at_2m | specific humidity at 2 m | kg kg-1 | 1 | real | kind_phys | out | 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 | +!!| evap | kinematic_surface_upward_latent_heat_flux | surface upward evaporation flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | +!!| fm | Monin-Obukhov_similarity_function_for_momentum | Monin-Obukhov similarity parameter for momentum | none | 1 | real | kind_phys | in | F | +!!| fh | Monin-Obukhov_similarity_function_for_heat | Monin-Obukhov similarity parameter for heat | none | 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 | in | F | +!!| fh2 | Monin-Obukhov_similarity_function_for_heat_at_2m | Monin-Obukhov similarity parameter for heat | none | 1 | real | kind_phys | in | F | +!! +!! \section general General Algorithm +!! \section detailed Detailed Algorithm +!! @{ + subroutine sfc_diag_run & + & (im,ps,u1,v1,t1,q1, & + & tskin,qsurf,f10m,u10m,v10m,t2m,q2m, & + & prslki,evap,fm,fh,fm10,fh2 & + & ) +!! ! use machine , only : kind_phys use funcphys, only : fpvs - use physcons, grav => con_g, cp => con_cp, + use physcons, grav => con_g, cp => con_cp, & & eps => con_eps, epsm1 => con_epsm1 implicit none ! integer im - real, dimension(im) :: ps, u1, v1, t1, q1, tskin, qsurf, - & f10m, u10m, v10m, t2m, q2m, prslki, evap, + real, dimension(im) :: ps, u1, v1, t1, q1, tskin, qsurf, & + & f10m, u10m, v10m, t2m, q2m, prslki, evap, & & fm, fh, fm10, fh2 ! ! locals @@ -57,4 +106,8 @@ subroutine sfc_diag(im,ps,u1,v1,t1,q1, enddo return - end + end subroutine sfc_diag_run +!> @} + + end module surface_diagnose +!> @} diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 951997898..d1f5dde54 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -1,25 +1,87 @@ - subroutine sfc_diff(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, - & tsurf,flag_iter,redrag) -! +!> \file sfc_diff.f +!! This file contains the surface exchange coefficient calculation scheme. + +!> \defgroup Sfc_ex_cal Surface Exchange Coefficient Calculation +!! @{ +!! \brief Brief description of the scheme +!! \section diagram Calling Hierarchy Diagram +!! \section intraphysics Intraphysics Communication + + module surface_exchange_coefficients + contains + + subroutine sfc_ex_coef_init + end subroutine sfc_ex_coef_init + + subroutine sfc_ex_coef_finalize + end subroutine sfc_ex_coef_finalize + +! subroutine sfc_diff(im,ps,u1,v1,t1,q1,z1, +!> \brief Brief description of the subroutine +!! +!! \section arg_table_sfc_ex_coef_run Arguments +!!| local var name | longname | description | units | rank | type | kind | intent | optional | +!!|----------------|-------------------------------------------------------------|-------------------------------------------------|------------|------|---------|-----------|--------|----------| +!!| im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 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 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 | specific_humidity_at_lowest_model_layer | 1st model layer specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | +!!| z1 | height_above_mean_sea_level_at_lowest_model_layer | height above mean sea level 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 | out? | F | +!!| ch | surface_drag_coefficient_for_heat_and_moisture_in_air | surface exchange coeff heat & moisture | none | 1 | real | kind_phys | out? | F | +!!| rb | bulk_richardson_number_at_lowest_model_level | bulk Richardson number at the surface | none | 1 | real | kind_phys | out? | 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 | out? | F | +!!| fm | Monin-Obukhov_similarity_function_for_momentum | Monin-Obukhov similarity parameter for momentum | none | 1 | real | kind_phys | out? | F | +!!| fh | Monin-Obukhov_similarity_function_for_heat | Monin-Obukhov similarity parameter for heat | none | 1 | real | kind_phys | out? | F | +!!| ustar | surface_friction_velocity | surface friction velocity | m s-1 | 1 | real | kind_phys | out? | F | +!!| wind | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | out | 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 | out | F | +!!| fh2 | Monin-Obukhov_similarity_function_for_heat_at_2m | Monin-Obukhov similarity parameter for heat | none | 1 | real | kind_phys | out | F | +!!| sigmaf | vegetation_area_fraction | areal fractional cover of green vegetation | frac | 1 | real | kind_phys | in | F | +!!| vegtype | cell_vegetation_type | 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 | vegetation type data source umd or igbp | index | 0 | integer | | 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 | 1 | logical | | in | F | +!! +!! \section general General Algorithm +!! \section detailed Detailed Algorithm +!! @{ + 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, & + & tsurf,flag_iter,redrag & + & ) +!! + use machine , only : kind_phys - use funcphys, only : fpvs - use physcons, grav => con_g, cp => con_cp - &, rvrdm1 => con_fvirt, rd => con_rd + use funcphys, only : fpvs + use physcons, grav => con_g, cp => con_cp & + &, rvrdm1 => con_fvirt, rd => con_rd & &, eps => con_eps, epsm1 => con_epsm1 implicit none ! integer im, ivegsrc - real(kind=kind_phys), dimension(im) :: ps, u1, v1, t1, q1, z1 - &, tskin, z0rl, cm, ch, rb - &, prsl1, prslki, stress - &, fm, fh, ustar, wind, ddvel - &, fm10, fh2, sigmaf, shdmax + real(kind=kind_phys), dimension(im) :: ps, u1, v1, t1, q1, z1 & + &, tskin, z0rl, cm, ch, rb & + &, prsl1, prslki, stress & + &, fm, fh, ustar, wind, ddvel & + &, fm10, fh2, sigmaf, shdmax & &, tsurf, snwdph integer, dimension(im) :: vegtype, islimsk @@ -30,11 +92,11 @@ subroutine sfc_diff(im,ps,u1,v1,t1,q1,z1, ! 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, + 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), parameter :: @@ -66,11 +128,11 @@ subroutine sfc_diff(im,ps,u1,v1,t1,q1,z1, ! parameter (rnu=1.51e-5,arnu=0.11*rnu) ! ! 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, ! surface roughness length is converted to m from cm ! do i=1,im - if(flag_iter(i)) then + 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) @@ -111,7 +173,7 @@ subroutine sfc_diff(im,ps,u1,v1,t1,q1,z1, tem1 = 1.0 - shdmax(i) tem2 = tem1 * tem1 tem1 = 1.0 - tem2 - + if( ivegsrc == 1 ) then if (vegtype(i) == 10) then @@ -301,4 +363,8 @@ subroutine sfc_diff(im,ps,u1,v1,t1,q1,z1, enddo return - end + end subroutine sfc_ex_coef_run +!> @} + + end module surface_exchange_coefficients +!> @} diff --git a/physics/sfc_drv.f b/physics/sfc_drv.f index 2fe4db9d7..683399c4b 100644 --- a/physics/sfc_drv.f +++ b/physics/sfc_drv.f @@ -1,22 +1,174 @@ !> \file sfc_drv.f !! This file contains the NOAH land surface scheme. -!> \defgroup NOAH NOAH Land Surface +!> \defgroup NOAH NOAH Land Surface pre +!! @{ +!! \brief Brief description of the parameterization +!! \section diagram Calling Hierarchy Diagram +!! \section intraphysics Intraphysics Communication + + module lsm_noah_pre + contains + + subroutine lsm_noah_pre_init + end subroutine lsm_noah_pre_init + + subroutine lsm_noah_pre_finalize + end subroutine lsm_noah_pre_finalize + +!> \brief Brief description of the subroutine +!! +!! \section arg_table_lsm_noah_pre_run Arguments +!!| local var name | longname | description | units | rank | type | kind | intent | optional | +!!|----------------|-------------------------------------------------------------|--------------------------------------------|------------|------|---------|-----------|--------|----------| +!!| im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | in | F | +!!| km | soil_vertical_dimension | soil vertical layer dimension | index | 0 | integer | | in | F | +!!| smsoil | volume_fraction_of_soil_moisture | volumetric fraction of soil moisture | frac | 2 | real | kind_phys | inout | F | +!!| slsoil | volume_fraction_of_unfrozen_soil_moisture | volume fraction of unfrozen soil moisture | frac | 2 | real | kind_phys | inout | F | +!!| smsoilin | volume_fraction_of_soil_moisture_input | volumetric fraction of soil moisture input | frac | 2 | real | kind_phys | in | F | +!!| slsoilin | volume_fraction_of_unfrozen_soil_moisture_input | volume fraction of unfrozen soil moisture input | frac | 2 | real | kind_phys | in | F | +!!| drain | subsurface_runoff_flux | subsurface runoff flux | g m-2 s-1 | 1 | real | kind_phys | inout | F | +!!| runof | surface_runoff_flux | surface runoff flux | g 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 | +!!| trans | transpiration_flux | total plant transpiration rate | kg m-2 s-1 | 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 | +!!| snowc | surface_snow_area_fraction | surface snow area fraction | frac | 1 | real | kind_phys | inout | 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 | inout | F | +!!| smcwlt2 | volume_fraction_of_condensed_water_in_soil_at_wilting_point | soil water fraction at wilting point | frac | 1 | real | kind_phys | inout | F | +!!| smcref2 | threshold_volume_fraction_of_condensed_water_in_soil | soil moisture threshold | frac | 1 | real | kind_phys | inout | F | +!! +!! \section general General Algorithm +!! \section detailed Detailed Algorithm +!! @{ + subroutine lsm_noah_pre_run & + & (im,km,smsoil,slsoil,smsoilin,slsoilin,drain,runof,evbs,evcw, & + & trans,sbsno,snowc,snohf,smcwlt2,smcref2 & + & ) + + use machine, only: kind_phys + +! --- interface variables + integer, intent(in) :: im, km + + real(kind=kind_phys), dimension(im,km), intent(inout) :: & + & smsoil,slsoil + + real(kind=kind_phys), dimension(im,km), intent(in) :: & + & smsoilin,slsoilin + + real(kind=kind_phys), dimension(im), intent(inout) :: & + & drain,runof,evbs,evcw,trans,sbsno,snowc,snohf,smcwlt2,smcref2 + + smsoil(:,:) = smsoilin(:,:) + slsoil(:,:) = slsoilin(:,:) + + drain(:) = 0.0 + runof(:) = 0.0 + evbs(:) = 0.0 + evcw(:) = 0.0 + trans(:) = 0.0 + sbsno(:) = 0.0 + snowc(:) = 0.0 + snohf(:) = 0.0 + smcwlt2(:) = 0.0 + smcref2(:) = 0.0 + + end subroutine lsm_noah_pre_run + +!> @} + end module lsm_noah_pre + +!> @} + +!> \defgroup NOAH NOAH Land Surface post !! @{ !! \brief Brief description of the parameterization !! \section diagram Calling Hierarchy Diagram !! \section intraphysics Intraphysics Communication + module lsm_noah_post + contains + + subroutine lsm_noah_post_init + end subroutine lsm_noah_post_init + + subroutine lsm_noah_post_finalize + end subroutine lsm_noah_post_finalize + !> \brief Brief description of the subroutine !! -!! \section arg_table_Noah_run Arguments -!! | local var name | longname | description | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------------------|------------------------------------|---------|------|---------|-----------|--------|----------| -!! | im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | in | F | +!! \section arg_table_lsm_noah_post_run Arguments +!!| local var name | longname | description | units | rank | type | kind | intent | optional | +!!|----------------|-------------------------------------------------------------|--------------------------------------------|------------|------|---------|-----------|--------|----------| +!!| im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | in | F | +!!| km | soil_vertical_dimension | soil vertical layer dimension | index | 0 | integer | | in | F | +!!| smsoil | volume_fraction_of_soil_moisture | volumetric fraction of soil moisture | frac | 2 | real | kind_phys | inout | F | +!!| slsoil | volume_fraction_of_unfrozen_soil_moisture | volume fraction of unfrozen soil moisture | frac | 2 | real | kind_phys | inout | F | +!!| smsoilout | volume_fraction_of_soil_moisture_output | volumetric fraction of soil moisture output| frac | 2 | real | kind_phys | in | F | +!!| slsoilout | volume_fraction_of_unfrozen_soil_moisture_output | volume fraction of unfrozen soil moisture output| frac | 2 | real | kind_phys | in | F | +!!| flag_lssav | flag_diagnostics | flag for calculating diagnostic fields | flag | 0 | logical | | in | F | +!!| dtf | time_step_for_dynamics | dynamics time step | s | 0 | real | kind_phys | in | F | +!!| drain | subsurface_runoff_flux | subsurface runoff flux | g m-2 s-1 | 1 | real | kind_phys | inout | F | +!!| runof | surface_runoff_flux | surface runoff flux | g m-2 s-1 | 1 | real | kind_phys | inout | F | +!!| runoff | total_runoff | total runoff | kg m-2 | 1 | real | kind_phys | inout | F | +!!| srunoff | surface_runoff | surface runoff | kg m-2 | 1 | real | kind_phys | inout | F | !! !! \section general General Algorithm !! \section detailed Detailed Algorithm !! @{ + + subroutine lsm_noah_post_run & + & (im,km,smsoil,slsoil,smsoilout,slsoilout, & + & flag_lssav,dtf,drain,runof,runoff,srunoff & + & ) + use machine, only: kind_phys + +! --- interface variables + integer, intent(in) :: im,km + real(kind=kind_phys), dimension(im,km), intent(in) :: & + & smsoil,slsoil + + real(kind=kind_phys), dimension(im,km), intent(out) :: & + & smsoilout,slsoilout + + logical, intent(in) :: flag_lssav + real, intent (in) :: dtf + + real(kind=kind_phys), dimension(im), intent(in ) :: & + & drain, runof + + real(kind=kind_phys), dimension(im), intent(inout) :: & + & runoff, srunoff + + if(flag_lssav) then + runoff(:) = runoff(:) + (drain(:)+runof(:)) * dtf * 0.001 + srunoff(:) = srunoff(:) + runof(:) * dtf * 0.001 + end if + smsoilout(:,:) = smsoil(:,:) + slsoilout(:,:) = slsoil(:,:) + + end subroutine lsm_noah_post_run + +!> @} + end module lsm_noah_post +!> @} + +!> \defgroup NOAH NOAH Land Surface +!! @{ +!! \brief Brief description of the parameterization +!! \section diagram Calling Hierarchy Diagram +!! \section intraphysics Intraphysics Communication + + module lsm_noah + contains + + subroutine lsm_noah_init + end subroutine lsm_noah_init + + subroutine lsm_noah_finalize + end subroutine lsm_noah_finalize + ! ===================================================================== ! ! description: ! ! ! @@ -71,7 +223,7 @@ ! cm - real, surface exchange coeff for momentum (m/s) im ! ! ch - real, surface exchange coeff heat & moisture(m/s) im ! ! prsl1 - real, sfc layer 1 mean pressure (pa) im ! -! prslki - real, 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 ! ! ddvel - real, im ! @@ -123,7 +275,80 @@ ! ==================== end of description ===================== ! !----------------------------------- - subroutine sfc_drv & +! subroutine sfc_drv & +!> \brief Brief description of the subroutine +!! +!! \section arg_table_lsm_noah_run Arguments +!!| local var name | longname | description | units | rank | type | kind | intent | optional | +!!|----------------|-------------------------------------------------------------|--------------------------------------------|------------|------|---------|-----------|--------|----------| +!!| im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | in | F | +!!| km | soil_vertical_dimension | soil vertical layer dimension | index | 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 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 | specific_humidity_at_lowest_model_layer | 1st model layer specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | +!!| soiltyp | cell_soil_type | soil type at each grid cell | index | 1 | integer | | in | F | +!!| vegtype | cell_vegetation_type | vegetation type at each grid cell | index | 1 | integer | | in | F | +!!| sigmaf | vegetation_area_fraction | areal fractional cover of green vegetation | frac | 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 | total sky surface downward longwave flux | W m-2 | 1 | real | kind_phys | in | F | +!!| dswsfc | surface_downwelling_shortwave_flux | total sky surface downward shortwave flux | W m-2 | 1 | real | kind_phys | in | F | +!!| 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 | +!!| 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_mean_sea_level_at_lowest_model_layer | height above MSL 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 | +!!| 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 | class of sfc slope | index | 1 | integer | | in | F | +!!| shdmin | minimum_vegetation_area_fraction | min fractional coverage of green veg | frac | 1 | real | kind_phys | in | F | +!!| shdmax | maximum_vegetation_area_fraction | max fractnl cover of green veg (not used) | frac | 1 | real | kind_phys | in | F | +!!| snoalb | upper_bound_on_max_albedo_over_deep_snow | upper bound on max albedo over deep snow | frac | 1 | real | kind_phys | in | F | +!!| sfalb | surface_diffused_shortwave_albedo | mean surface diffused shortwave albedo | frac | 1 | real | kind_phys | in | F | +!!| flag_iter | flag_for_iteration | flag for iteration | flag | 1 | logical | | in | F | +!!| flag_guess | flag_for_guess_run | flag for guess run | flag | 1 | logical | | in | F | +!!| isot | soil_type | soil type (not used) | index | 0 | integer | | in | F | +!!| ivegsrc | vegetation_type | vegetation type data source umd or igbp | index | 0 | integer | | 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 | precipitation_amount_in_one_dynamics_time_step | total precipitation in each time step | kg m-2 | 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 | +!!| sncovr1 | surface_snow_area_fraction | surface snow area fraction | frac | 1 | real | kind_phys | out | F | +!!| qsurf | surface_specific_humidity | surface specific humidity | kg kg-1 | 1 | real | kind_phys | out | F | +!!| gflux | upward_heat_flux_in_soil | upward soil heat flux | W m-2 | 1 | real | kind_phys | out | F | +!!| drain | subsurface_runoff_flux | subsurface runoff flux | g m-2 s-1 | 1 | real | kind_phys | out | F | +!!| evap | kinematic_surface_upward_latent_heat_flux | surface upward evaporation flux | kg kg-1 m s-1 | 1 | real | kind_phys | out | F | +!!| hflx | kinematic_surface_upward_sensible_heat_flux | surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | out | F | +!!| ep | surface_upward_potential_latent_heat_flux | surface upward potential latent heat flux | W m-2 | 1 | real | kind_phys | out | F | +!!| runoff | surface_runoff_flux | surface runoff flux | g m-2 s-1 | 1 | real | kind_phys | out | 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 | out | 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 | out | F | +!!| 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 | +!!| snowc | surface_snow_area_fraction | surface snow area fraction | frac | 1 | real | kind_phys | out | F | +!!| stm | soil_moisture_content | soil moisture content | kg m-2 | 1 | real | kind_phys | out | 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 | out | F | +!!| smcwlt2 | volume_fraction_of_condensed_water_in_soil_at_wilting_point | soil water fraction at wilting point | frac | 1 | real | kind_phys | out | F | +!!| smcref2 | threshold_volume_fraction_of_condensed_water_in_soil | soil moisture threshold | frac | 1 | real | kind_phys | out | F | +!!| wet1 | normalized_soil_wetness | normalized soil wetness | frac | 1 | real | kind_phys | out | F | +!! +!! \section general General Algorithm +!! \section detailed Detailed Algorithm +!! @{ + subroutine lsm_noah_run & & ( im, km, ps, u1, v1, t1, q1, soiltyp, vegtype, sigmaf, & & sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & & prsl1, prslki, zf, islimsk, ddvel, slopetyp, & @@ -135,7 +360,9 @@ subroutine sfc_drv & & cmm, chh, evbs, evcw, sbsno, snowc, stm, snohf, & & smcwlt2, smcref2, wet1 & ! -- outputs from here and above & ) -! +!! + + use machine , only : kind_phys use funcphys, only : fpvs use physcons, only : grav => con_g, cp => con_cp, & @@ -559,7 +786,10 @@ subroutine sfc_drv & ! return !................................... - end subroutine sfc_drv +! end subroutine sfc_drv + end subroutine lsm_noah_run !----------------------------------- !> @} + + end module lsm_noah !> @}