SCALE-RM
scale_cpl_phy_sfc_fixed_temp.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 !-------------------------------------------------------------------------------
11 #include "scalelib.h"
12 module scale_cpl_phy_sfc_fixed_temp
13  !-----------------------------------------------------------------------------
14  !
15  !++ used modules
16  !
17  use scale_precision
18  use scale_io
19  use scale_prof
20  use scale_cpl_sfc_index
21  !-----------------------------------------------------------------------------
22  implicit none
23  private
24  !-----------------------------------------------------------------------------
25  !
26  !++ Public procedure
27  !
28  public :: cpl_phy_sfc_fixed_temp_setup
29  public :: cpl_phy_sfc_fixed_temp_finalize
30  public :: cpl_phy_sfc_fixed_temp
31 
32  !-----------------------------------------------------------------------------
33  !
34  !++ Public parameters & variables
35  !
36  !-----------------------------------------------------------------------------
37  !
38  !++ Private procedure
39  !
40  !-----------------------------------------------------------------------------
41  !
42  !++ Private parameters & variables
43  !
44  logical :: initialized = .false.
45 
46  !-----------------------------------------------------------------------------
47 contains
48  !-----------------------------------------------------------------------------
50  subroutine cpl_phy_sfc_fixed_temp_setup
51  implicit none
52  !---------------------------------------------------------------------------
53 
54  if ( initialized ) return
55 
56  log_newline
57  log_info("CPL_PHY_SFC_FIXED_TEMP_setup",*) 'Setup'
58 
59  initialized = .true.
60 
61  return
62  end subroutine cpl_phy_sfc_fixed_temp_setup
63 
64  !-----------------------------------------------------------------------------
66  subroutine cpl_phy_sfc_fixed_temp_finalize
67 
68  initialized = .false.
69 
70  return
71  end subroutine cpl_phy_sfc_fixed_temp_finalize
72 
73  !-----------------------------------------------------------------------------
74  subroutine cpl_phy_sfc_fixed_temp( &
75  IA, IS, IE, &
76  JA, JS, JE, &
77  TMPA, PRSA, &
78  WA, UA, VA, &
79  RHOA, QVA, LH, &
80  Z1, PBL, &
81  RHOS, PRSS, &
82  RFLXD, &
83  TMPS, WSTR, QVEF, &
84  ALBEDO, &
85  Rb, Z0M, Z0H, Z0E, &
86  calc_flag, dt, &
87  ZMFLX, XMFLX, YMFLX, &
88  SHFLX, LHFLX, QVFLX, &
89  GFLX, &
90  Ustar, Tstar, Qstar, &
91  Wstar, &
92  RLmo, &
93  U10, V10, T2, Q2 )
94  use scale_const, only: &
95  eps => const_eps, &
96  undef => const_undef, &
97  epsvap => const_epsvap, &
98  pre00 => const_pre00, &
99  rdry => const_rdry, &
100  cpdry => const_cpdry, &
101  rvap => const_rvap, &
102  stb => const_stb
103  use scale_atmos_saturation, only: &
104 ! qsat => ATMOS_SATURATION_pres2qsat_all
105  qsat => atmos_saturation_dens2qsat_all
106  use scale_bulkflux, only: &
107  bulkflux, &
108  bulkflux_diagnose_surface
109  implicit none
110 
111  integer, intent(in) :: ia, is, ie
112  integer, intent(in) :: ja, js, je
113  real(rp), intent(in) :: tmpa (ia,ja) ! temperature at the lowest atmospheric layer [K]
114  real(rp), intent(in) :: prsa (ia,ja) ! pressure at the lowest atmospheric layer [Pa]
115  real(rp), intent(in) :: wa (ia,ja) ! velocity w at the lowest atmospheric layer [m/s]
116  real(rp), intent(in) :: ua (ia,ja) ! velocity u at the lowest atmospheric layer [m/s]
117  real(rp), intent(in) :: va (ia,ja) ! velocity v at the lowest atmospheric layer [m/s]
118  real(rp), intent(in) :: rhoa (ia,ja) ! density at the lowest atmospheric layer [kg/m3]
119  real(rp), intent(in) :: qva (ia,ja) ! ratio of water vapor mass to total mass at the lowest atmospheric layer [kg/kg]
120  real(rp), intent(in) :: lh (ia,ja) ! latent heat at the lowest atmospheric layer [J/kg]
121  real(rp), intent(in) :: z1 (ia,ja) ! cell center height at the lowest atmospheric layer [m]
122  real(rp), intent(in) :: pbl (ia,ja) ! the top of atmospheric mixing layer [m]
123  real(rp), intent(in) :: rhos (ia,ja) ! density at the surface [kg/m3]
124  real(rp), intent(in) :: prss (ia,ja) ! pressure at the surface [Pa]
125  real(rp), intent(in) :: rflxd (ia,ja,n_rad_dir,n_rad_rgn) ! downward radiation flux at the surface (direct/diffuse,IR/near-IR/VIS) [J/m2/s]
126  real(rp), intent(in) :: tmps (ia,ja) ! surface temperature [K]
127  real(rp), intent(in) :: wstr (ia,ja) ! amount of the water storage [kg/m2]
128  real(rp), intent(in) :: qvef (ia,ja) ! efficiency of evaporation (0-1)
129  real(rp), intent(in) :: albedo (ia,ja,n_rad_dir,n_rad_rgn) ! surface albedo (direct/diffuse,IR/near-IR/VIS) (0-1)
130  real(rp), intent(in) :: rb (ia,ja) ! stomata resistance [1/s]
131  real(rp), intent(in) :: z0m (ia,ja) ! roughness length for momemtum [m]
132  real(rp), intent(in) :: z0h (ia,ja) ! roughness length for heat [m]
133  real(rp), intent(in) :: z0e (ia,ja) ! roughness length for vapor [m]
134  logical, intent(in) :: calc_flag(ia,ja) ! to decide calculate or not
135  real(dp), intent(in) :: dt ! delta time
136 
137  real(rp), intent(out) :: zmflx (ia,ja) ! z-momentum flux at the surface [kg/m/s2]
138  real(rp), intent(out) :: xmflx (ia,ja) ! x-momentum flux at the surface [kg/m/s2]
139  real(rp), intent(out) :: ymflx (ia,ja) ! y-momentum flux at the surface [kg/m/s2]
140  real(rp), intent(out) :: shflx (ia,ja) ! sensible heat flux at the surface [J/m2/s]
141  real(rp), intent(out) :: lhflx (ia,ja) ! latent heat flux at the surface [J/m2/s]
142  real(rp), intent(out) :: qvflx (ia,ja) ! water vapor flux at the surface [kg/m2/s]
143  real(rp), intent(out) :: gflx (ia,ja) ! subsurface heat flux at the surface [J/m2/s]
144  real(rp), intent(out) :: ustar (ia,ja) ! friction velocity [m/s]
145  real(rp), intent(out) :: tstar (ia,ja) ! temperature scale [K]
146  real(rp), intent(out) :: qstar (ia,ja) ! moisture scale [kg/kg]
147  real(rp), intent(out) :: wstar (ia,ja) ! convective velocity scale [m/s]
148  real(rp), intent(out) :: rlmo (ia,ja) ! inversed Obukhov length [1/m]
149  real(rp), intent(out) :: u10 (ia,ja) ! velocity u at 10m [m/s]
150  real(rp), intent(out) :: v10 (ia,ja) ! velocity v at 10m [m/s]
151  real(rp), intent(out) :: t2 (ia,ja) ! temperature at 2m [K]
152  real(rp), intent(out) :: q2 (ia,ja) ! water vapor at 2m [kg/kg]
153 
154  real(rp) :: emis ! surface longwave emission [J/m2/s]
155  real(rp) :: lwd ! surface downward longwave radiation flux [J/m2/s]
156  real(rp) :: lwu ! surface upward longwave radiation flux [J/m2/s]
157  real(rp) :: swd ! surface downward shortwave radiation flux [J/m2/s]
158  real(rp) :: swu ! surface upward shortwave radiation flux [J/m2/s]
159  real(rp) :: res ! residual
160 
161  real(rp) :: uabs ! absolute velocity [m/s]
162  real(rp) :: ra ! Aerodynamic resistance (=1/Ce) [1/s]
163 
164  real(rp) :: qvsat ! saturation water vapor mixing ratio at surface [kg/kg]
165  real(rp) :: qvs(ia,ja) ! water vapor mixing ratio at surface [kg/kg]
166  real(rp) :: rtot ! total gas constant
167  real(rp) :: qdry ! dry air mass ratio [kg/kg]
168 
169  real(rp) :: fracu10(ia,ja) ! calculation parameter for U10 [1]
170  real(rp) :: fract2 (ia,ja) ! calculation parameter for T2 [1]
171  real(rp) :: fracq2 (ia,ja) ! calculation parameter for Q2 [1]
172 
173  real(rp) :: mflux
174 
175  integer :: i, j
176  !---------------------------------------------------------------------------
177 
178  log_progress(*) 'coupler / physics / surface / FIXED-TEMP'
179 
180  !$acc data copyin(TMPA,PRSA,WA,UA,VA,RHOA,QVA,LH,Z1,PBL,RHOS,PRSS,RFLXD,TMPS,WSTR,QVEF,ALBEDO,Rb,Z0M,Z0H,Z0E,calc_flag) &
181  !$acc copyout(ZMFLX,XMFLX,YMFLX,SHFLX,LHFLX,QVFLX,GFLX,Ustar,Tstar,Qstar,Wstar,RLmo,U10,V10,T2,Q2) &
182  !$acc create(QVS,FracU10,FracT2,FracQ2)
183 
184  ! calculate surface flux
185  !$omp parallel do schedule(dynamic) collapse(2) &
186 #ifndef __GFORTRAN__
187  !$omp default(none) &
188  !$omp shared(IS,IE,JS,JE,EPS,UNDEF,Rdry,CPdry,bulkflux,dt, &
189  !$omp calc_flag,TMPA,QVA,QVS,LH,WA,UA,VA,Z1,PBL,PRSA,TMPS,WSTR,PRSS,RHOS,QVEF,Z0M,Z0H,Z0E,ALBEDO,RFLXD,Rb, &
190  !$omp FracU10,FracT2,FracQ2, &
191  !$omp SHFLX,LHFLX,QVFLX,GFLX,ZMFLX,XMFLX,YMFLX,Ustar,Tstar,Qstar,Wstar,RLmo,U10,V10,T2,Q2) &
192 #else
193  !$omp default(shared) &
194 #endif
195  !$omp private(qdry,Rtot,QVsat,Uabs,Ra,res,emis,LWD,LWU,SWD,SWU,MFLUX)
196  !$acc kernels
197  do j = js, je
198  !$acc loop private(qvsat,ra,Uabs)
199  do i = is, ie
200  if ( calc_flag(i,j) ) then
201 
202 ! qdry = 1.0_RP - QVA(i,j)
203 ! Rtot = qdry * Rdry + QVA(i,j) * Rvap
204 ! call qsat( TMPS(i,j), PRSS(i,j), qdry, QVsat )
205  call qsat( tmps(i,j), rhos(i,j), qvsat )
206 
207  qvs(i,j) = ( 1.0_rp-qvef(i,j) ) * qva(i,j) &
208  + ( qvef(i,j) ) * qvsat
209 
210  uabs = sqrt( wa(i,j)**2 + ua(i,j)**2 + va(i,j)**2 )
211 
212  call bulkflux( tmpa(i,j), tmps(i,j), & ! [IN]
213  prsa(i,j), prss(i,j), & ! [IN]
214  qva(i,j), qvs(i,j), & ! [IN]
215  uabs, z1(i,j), pbl(i,j), & ! [IN]
216  z0m(i,j), z0h(i,j), z0e(i,j), & ! [IN]
217  ustar(i,j), tstar(i,j), qstar(i,j), & ! [OUT]
218  wstar(i,j), rlmo(i,j), ra, & ! [OUT]
219  fracu10(i,j), fract2(i,j), fracq2(i,j) ) ! [OUT]
220 
221  if ( uabs < eps ) then
222  zmflx(i,j) = 0.0_rp
223  xmflx(i,j) = 0.0_rp
224  ymflx(i,j) = 0.0_rp
225  else
226  mflux = - rhos(i,j) * ustar(i,j)**2
227  zmflx(i,j) = mflux * wa(i,j) / uabs
228  xmflx(i,j) = mflux * ua(i,j) / uabs
229  ymflx(i,j) = mflux * va(i,j) / uabs
230  end if
231  shflx(i,j) = -rhos(i,j) * ustar(i,j) * tstar(i,j) * cpdry
232  qvflx(i,j) = -rhos(i,j) * ustar(i,j) * qstar(i,j) * ra / ( ra+rb(i,j) )
233  qvflx(i,j) = min( qvflx(i,j), wstr(i,j) / real(dt,rp) )
234  lhflx(i,j) = qvflx(i,j) * lh(i,j)
235 
236  emis = ( 1.0_rp-albedo(i,j,i_r_diffuse,i_r_ir) ) * stb * tmps(i,j)**4
237 
238  lwd = rflxd(i,j,i_r_diffuse,i_r_ir)
239  lwu = rflxd(i,j,i_r_diffuse,i_r_ir) * albedo(i,j,i_r_diffuse,i_r_ir) + emis
240  swd = rflxd(i,j,i_r_direct ,i_r_nir) &
241  + rflxd(i,j,i_r_diffuse,i_r_nir) &
242  + rflxd(i,j,i_r_direct ,i_r_vis) &
243  + rflxd(i,j,i_r_diffuse,i_r_vis)
244  swu = rflxd(i,j,i_r_direct ,i_r_nir) * albedo(i,j,i_r_direct ,i_r_nir) &
245  + rflxd(i,j,i_r_diffuse,i_r_nir) * albedo(i,j,i_r_diffuse,i_r_nir) &
246  + rflxd(i,j,i_r_direct ,i_r_vis) * albedo(i,j,i_r_direct ,i_r_vis) &
247  + rflxd(i,j,i_r_diffuse,i_r_vis) * albedo(i,j,i_r_diffuse,i_r_vis)
248 
249  ! calculation for residual
250  res = swd - swu + lwd - lwu - shflx(i,j) - qvflx(i,j) * lh(i,j)
251 
252  ! put residual in ground heat flux (positive for downward)
253  gflx(i,j) = res
254 
255  else ! not calculate surface flux
256  zmflx(i,j) = undef
257  xmflx(i,j) = undef
258  ymflx(i,j) = undef
259  shflx(i,j) = undef
260  lhflx(i,j) = undef
261  qvflx(i,j) = undef
262  gflx(i,j) = undef
263  ustar(i,j) = undef
264  tstar(i,j) = undef
265  qstar(i,j) = undef
266  wstar(i,j) = undef
267  rlmo(i,j) = undef
268  u10(i,j) = undef
269  v10(i,j) = undef
270  t2(i,j) = undef
271  q2(i,j) = undef
272  endif
273  enddo
274  enddo
275  !$acc end kernels
276 
277  call bulkflux_diagnose_surface( ia, is, ie, ja, js, je, &
278  ua(:,:), va(:,:), & ! (in)
279  tmpa(:,:), qva(:,:), & ! (in)
280  tmps(:,:), qvs(:,:), & ! (in)
281  z1(:,:), z0m(:,:), z0h(:,:), z0e(:,:), & ! (in)
282  u10(:,:), v10(:,:), t2(:,:), q2(:,:), & ! (out)
283  mask = calc_flag(:,:), & ! (in)
284  fracu10 = fracu10(:,:), & ! (in)
285  fract2 = fract2(:,:), & ! (in)
286  fracq2 = fracq2(:,:) ) ! (in)
287 
288  !$acc end data
289 
290  return
291  end subroutine cpl_phy_sfc_fixed_temp
292 
293 end module scale_cpl_phy_sfc_fixed_temp
scale_cpl_sfc_index::n_rad_dir
integer, parameter, public n_rad_dir
Definition: scale_cpl_sfc_index.F90:36
scale_cpl_sfc_index::i_r_direct
integer, parameter, public i_r_direct
Definition: scale_cpl_sfc_index.F90:37
scale_const::const_epsvap
real(rp), public const_epsvap
Rdry / Rvap.
Definition: scale_const.F90:75
scale_cpl_sfc_index::i_r_diffuse
integer, parameter, public i_r_diffuse
Definition: scale_cpl_sfc_index.F90:38
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_cpl_sfc_index::i_r_ir
integer, parameter, public i_r_ir
Definition: scale_cpl_sfc_index.F90:29
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_cpl_phy_sfc_fixed_temp::cpl_phy_sfc_fixed_temp_finalize
subroutine, public cpl_phy_sfc_fixed_temp_finalize
Finalize.
Definition: scale_cpl_phy_sfc_fixed_temp.F90:67
scale_cpl_phy_sfc_fixed_temp::cpl_phy_sfc_fixed_temp_setup
subroutine, public cpl_phy_sfc_fixed_temp_setup
Setup.
Definition: scale_cpl_phy_sfc_fixed_temp.F90:51
scale_precision::rp
integer, parameter, public rp
Definition: scale_precision.F90:41
scale_io
module STDIO
Definition: scale_io.F90:10
scale_cpl_sfc_index::i_r_nir
integer, parameter, public i_r_nir
Definition: scale_cpl_sfc_index.F90:30
scale_const
module CONSTANT
Definition: scale_const.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_precision::dp
integer, parameter, public dp
Definition: scale_precision.F90:32
scale_const::const_stb
real(rp), parameter, public const_stb
Stefan-Boltzman constant [W/m2/K4].
Definition: scale_const.F90:53
scale_cpl_sfc_index
module coupler / surface-atmospehre
Definition: scale_cpl_sfc_index.F90:11
scale_cpl_sfc_index::i_r_vis
integer, parameter, public i_r_vis
Definition: scale_cpl_sfc_index.F90:31
scale_cpl_phy_sfc_fixed_temp::cpl_phy_sfc_fixed_temp
subroutine, public cpl_phy_sfc_fixed_temp(IA, IS, IE, JA, JS, JE, TMPA, PRSA, WA, UA, VA, RHOA, QVA, LH, Z1, PBL, RHOS, PRSS, RFLXD, TMPS, WSTR, QVEF, ALBEDO, Rb, Z0M, Z0H, Z0E, calc_flag, dt, ZMFLX, XMFLX, YMFLX, SHFLX, LHFLX, QVFLX, GFLX, Ustar, Tstar, Qstar, Wstar, RLmo, U10, V10, T2, Q2)
Definition: scale_cpl_phy_sfc_fixed_temp.F90:94
scale_const::const_rdry
real(rp), public const_rdry
specific gas constant (dry air) [J/kg/K]
Definition: scale_const.F90:59
scale_cpl_sfc_index::n_rad_rgn
integer, parameter, public n_rad_rgn
Definition: scale_cpl_sfc_index.F90:28
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_cpl_phy_sfc_fixed_temp
module coupler / surface fixed temp model
Definition: scale_cpl_phy_sfc_fixed_temp.F90:12
scale_bulkflux::bulkflux
procedure(bc), pointer, public bulkflux
Definition: scale_bulkflux.F90:84
Generated by   doxygen 1.8.17