SCALE-RM
scale_land_phy_snow_diagnos.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
9 !-------------------------------------------------------------------------------
10 #include "scalelib.h"
11 module scale_land_phy_snow_diagnos
12  !-----------------------------------------------------------------------------
13  !
14  !++ used modules
15  !
16  use scale_precision
17  use scale_io
18  use scale_prof
19  !-----------------------------------------------------------------------------
20  implicit none
21  private
22  !-----------------------------------------------------------------------------
23  !
24  !++ Public procedure
25  !
26  public :: land_phy_snow_diags
27 
28  !-----------------------------------------------------------------------------
29  !
30  !++ Public parameters & variables
31  !
32  !-----------------------------------------------------------------------------
33  !
34  !++ Private procedure
35  !
36  !-----------------------------------------------------------------------------
37  !
38  !++ Private parameters & variables
39  !
40  !-----------------------------------------------------------------------------
41 contains
42  !-----------------------------------------------------------------------------
43  subroutine land_phy_snow_diags( &
44  LIA, LIS, LIE, LJA, LJS, LJE, &
45  SNOW_frac, &
46  TMPA, PRSA, &
47  WA, UA, VA, &
48  RHOA, QVA, &
49  Z1, PBL, &
50  RHOS, PRSS, LST1, &
51  QVEF, &
52  Z0M, Z0H, Z0E, &
53  ZMFLX, XMFLX, YMFLX, &
54  Ustar, Tstar, Qstar, &
55  Wstar, &
56  RLmo, &
57  U10, V10, &
58  T2, Q2 )
59  use scale_const, only: &
60  eps => const_eps, &
61  undef => const_undef, &
62  pre00 => const_pre00, &
63  rdry => const_rdry, &
64  cpdry => const_cpdry, &
65  rvap => const_rvap, &
66  stb => const_stb
67  use scale_atmos_saturation, only: &
68  qsat => atmos_saturation_dens2qsat_all
69 ! qsat => ATMOS_SATURATION_pres2qsat_all
70  use scale_bulkflux, only: &
71  bulkflux, &
72  bulkflux_diagnose_surface
73  implicit none
74  integer, intent(in) :: lia, lis, lie
75  integer, intent(in) :: lja, ljs, lje
76 
77  real(rp), intent(in) :: snow_frac(lia,lja) ! snow fraction
78  real(rp), intent(in) :: tmpa(lia,lja) ! temperature at the lowest atmospheric layer [K]
79  real(rp), intent(in) :: prsa(lia,lja) ! pressure at the lowest atmospheric layer [Pa]
80  real(rp), intent(in) :: wa (lia,lja) ! velocity w at the lowest atmospheric layer [m/s]
81  real(rp), intent(in) :: ua (lia,lja) ! velocity u at the lowest atmospheric layer [m/s]
82  real(rp), intent(in) :: va (lia,lja) ! velocity v at the lowest atmospheric layer [m/s]
83  real(rp), intent(in) :: rhoa(lia,lja) ! density at the lowest atmospheric layer [kg/m3]
84  real(rp), intent(in) :: qva (lia,lja) ! ratio of water vapor mass to total mass at the lowest atmospheric layer [kg/kg]
85  real(rp), intent(in) :: z1 (lia,lja) ! cell center height at the lowest atmospheric layer [m]
86  real(rp), intent(in) :: pbl (lia,lja) ! the top of atmospheric mixing layer [m]
87  real(rp), intent(in) :: rhos(lia,lja) ! density at the surface [kg/m3]
88  real(rp), intent(in) :: prss(lia,lja) ! pressure at the surface [Pa]
89 
90  real(rp), intent(in) :: lst1 (lia,lja) ! land surface temperature [K]
91  real(rp), intent(in) :: qvef (lia,lja) ! efficiency of evaporation (0-1)
92 
93  real(rp), intent(in) :: z0m (lia,lja) ! roughness length for momemtum [m]
94  real(rp), intent(in) :: z0h (lia,lja) ! roughness length for heat [m]
95  real(rp), intent(in) :: z0e (lia,lja) ! roughness length for vapor [m]
96 
97  real(rp), intent(out) :: zmflx(lia,lja) ! z-momentum flux at the surface [kg/m/s2]
98  real(rp), intent(out) :: xmflx(lia,lja) ! x-momentum flux at the surface [kg/m/s2]
99  real(rp), intent(out) :: ymflx(lia,lja) ! y-momentum flux at the surface [kg/m/s2]
100  real(rp), intent(out) :: ustar(lia,lja) ! friction velocity [m/s]
101  real(rp), intent(out) :: tstar(lia,lja) ! temperature scale [K]
102  real(rp), intent(out) :: qstar(lia,lja) ! moisture scale [kg/kg]
103  real(rp), intent(out) :: wstar(lia,lja) ! convective velocity scale [m/s]
104  real(rp), intent(out) :: rlmo (lia,lja) ! inversed Obukhov length [1/m]
105  real(rp), intent(out) :: u10 (lia,lja) ! velocity u at 10m [m/s]
106  real(rp), intent(out) :: v10 (lia,lja) ! velocity v at 10m [m/s]
107  real(rp), intent(out) :: t2 (lia,lja) ! temperature at 2m [K]
108  real(rp), intent(out) :: q2 (lia,lja) ! water vapor at 2m [kg/kg]
109 
110 
111  ! works
112  real(rp) :: uabs ! modified absolute velocity [m/s]
113  real(rp) :: ra ! Aerodynamic resistance (=1/Ce) [1/s]
114 
115  real(rp) :: qvsat ! saturation water vapor mixing ratio at surface [kg/kg]
116  real(rp) :: qvs(lia,lja) ! water vapor mixing ratio at surface [kg/kg]
117 ! real(RP) :: Rtot ! total gas constant
118 ! real(RP) :: qdry ! dry air mass ratio [kg/kg]
119 
120  real(rp) :: fracu10(lia,lja) ! calculation parameter for U10 [-]
121  real(rp) :: fract2 (lia,lja) ! calculation parameter for T2 [-]
122  real(rp) :: fracq2 (lia,lja) ! calculation parameter for Q2 [-]
123 
124  real(rp) :: mflux
125 
126  logical :: calc_flag(lia,lja)
127 
128  integer :: i, j
129  !---------------------------------------------------------------------------
130 
131  log_info("LAND_PHY_SNOW_DIAGS",*) 'Snow surface diagnostic'
132 
133  ! calculate surface flux
134  !$omp parallel do &
135  !$omp private(QVsat,Uabs,MFLUX)
136  do j = ljs, lje
137  do i = lis, lie
138 
139  if( snow_frac(i,j) > 0.0_rp ) then
140 
141  calc_flag(i,j) = .true.
142 
143 ! qdry = 1.0_RP - QVA(i,j)
144 ! Rtot = qdry * Rdry + QVA(i,j) * Rvap
145 
146 ! call qsat( LST1(i,j), PRSS(i,j), qdry, & ! [IN]
147 ! QVsat ) ! [OUT]
148  call qsat( lst1(i,j), rhos(i,j), & ! [IN]
149  qvsat ) ! [OUT]
150 
151  qvs(i,j) = ( 1.0_rp - qvef(i,j) ) * qva(i,j) + qvef(i,j) * qvsat
152 
153  uabs = sqrt( wa(i,j)**2 + ua(i,j)**2 + va(i,j)**2 )
154 
155  call bulkflux( tmpa(i,j), lst1(i,j), & ! [IN]
156  prsa(i,j), prss(i,j), & ! [IN]
157  qva(i,j), qvs(i,j), & ! [IN]
158  uabs, z1(i,j), pbl(i,j), & ! [IN]
159  z0m(i,j), z0h(i,j), z0e(i,j), & ! [IN]
160  ustar(i,j), tstar(i,j), qstar(i,j), & ! [OUT]
161  wstar(i,j), rlmo(i,j), ra, & ! [OUT]
162  fracu10(i,j), fract2(i,j), fracq2(i,j) ) ! [OUT]
163 
164  if ( uabs < eps ) then
165  zmflx(i,j) = 0.0_rp
166  xmflx(i,j) = 0.0_rp
167  ymflx(i,j) = 0.0_rp
168  else
169  mflux = - rhos(i,j) * ustar(i,j)**2
170  zmflx(i,j) = mflux * wa(i,j) / uabs
171  xmflx(i,j) = mflux * ua(i,j) / uabs
172  ymflx(i,j) = mflux * va(i,j) / uabs
173  end if
174 
175  else
176 
177  ! not calculate surface flux
178 
179  calc_flag(i,j) = .false.
180 
181  zmflx(i,j) = undef
182  xmflx(i,j) = undef
183  ymflx(i,j) = undef
184  ustar(i,j) = undef
185  tstar(i,j) = undef
186  qstar(i,j) = undef
187  wstar(i,j) = undef
188  rlmo(i,j) = undef
189  u10(i,j) = undef
190  v10(i,j) = undef
191  t2(i,j) = undef
192  q2(i,j) = undef
193 
194  end if
195 
196  end do
197  end do
198 
199  call bulkflux_diagnose_surface( lia, lis, lie, lja, ljs, lje, &
200  ua(:,:), va(:,:), & ! (in)
201  tmpa(:,:), qva(:,:), & ! (in)
202  lst1(:,:), qvs(:,:), & ! (in)
203  z1(:,:), z0m(:,:), z0h(:,:), z0e(:,:), & ! (in)
204  u10(:,:), v10(:,:), t2(:,:), q2(:,:), & ! (out)
205  mask = calc_flag(:,:), & ! (in)
206  fracu10 = fracu10(:,:), & ! (in)
207  fract2 = fract2(:,:), & ! (in)
208  fracq2 = fracq2(:,:) ) ! (in)
209 
210  return
211  end subroutine land_phy_snow_diags
212 
213 end module scale_land_phy_snow_diagnos
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_const::const_rvap
real(rp), parameter, public const_rvap
specific gas constant (water vapor) [J/kg/K]
Definition: scale_const.F90:68
scale_const::const_eps
real(rp), public const_eps
small number
Definition: scale_const.F90:35
scale_bulkflux
module Surface bulk flux
Definition: scale_bulkflux.F90:12
scale_precision::rp
integer, parameter, public rp
Definition: scale_precision.F90:41
scale_io
module STDIO
Definition: scale_io.F90:10
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_land_phy_snow_diagnos
module land / physics / snow / diagnostics
Definition: scale_land_phy_snow_diagnos.F90:11
scale_const::const_cpdry
real(rp), public const_cpdry
specific heat (dry air,constant pressure) [J/kg/K]
Definition: scale_const.F90:60
scale_prof
module profiler
Definition: scale_prof.F90:11
scale_land_phy_snow_diagnos::land_phy_snow_diags
subroutine, public land_phy_snow_diags(LIA, LIS, LIE, LJA, LJS, LJE, SNOW_frac, TMPA, PRSA, WA, UA, VA, RHOA, QVA, Z1, PBL, RHOS, PRSS, LST1, QVEF, Z0M, Z0H, Z0E, ZMFLX, XMFLX, YMFLX, Ustar, Tstar, Qstar, Wstar, RLmo, U10, V10, T2, Q2)
Definition: scale_land_phy_snow_diagnos.F90:59
scale_const::const_stb
real(rp), parameter, public const_stb
Stefan-Boltzman constant [W/m2/K4].
Definition: scale_const.F90:53
scale_const::const_rdry
real(rp), public const_rdry
specific gas constant (dry air) [J/kg/K]
Definition: scale_const.F90:59
scale_const::const_undef
real(rp), public const_undef
Definition: scale_const.F90:43
scale_atmos_saturation
module atmosphere / saturation
Definition: scale_atmos_saturation.F90:12
scale_const::const_pre00
real(rp), public const_pre00
pressure reference [Pa]
Definition: scale_const.F90:97
scale_bulkflux::bulkflux
procedure(bc), pointer, public bulkflux
Definition: scale_bulkflux.F90:84
Generated by   doxygen 1.8.17