SCALE-RM
scale_roughness.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
11 !-------------------------------------------------------------------------------
12 #include "inc_openmp.h"
13 module scale_roughness
14  !-----------------------------------------------------------------------------
15  !
16  !++ used modules
17  !
18  use scale_precision
19  use scale_stdio
20  use scale_prof
21  use scale_grid_index
22  !-----------------------------------------------------------------------------
23  implicit none
24  private
25  !-----------------------------------------------------------------------------
26  !
27  !++ Public procedure
28  !
29  public :: roughness_setup
30 
31  abstract interface
32  subroutine rl( &
33  Z0M_t, &
34  Z0H_t, &
35  Z0E_t, &
36  Z0M, &
37  Z0H, &
38  Z0E, &
39  UA, &
40  VA, &
41  Z1, &
42  dt )
43  use scale_precision
44  use scale_grid_index
45  implicit none
46 
47  real(RP), intent(out) :: z0m_t(ia,ja) ! tendency of roughness length for momentum [m]
48  real(RP), intent(out) :: z0h_t(ia,ja) ! tendency of roughness length for heat [m]
49  real(RP), intent(out) :: z0e_t(ia,ja) ! tendency of roughness length for vapor [m]
50 
51  real(RP), intent(in) :: z0m(ia,ja) ! roughness length for momentum [m]
52  real(RP), intent(in) :: z0h(ia,ja) ! roughness length for heat [m]
53  real(RP), intent(in) :: z0e(ia,ja) ! roughness length for vapor [m]
54  real(RP), intent(in) :: ua (ia,ja) ! velocity u at the lowest atmospheric layer [m/s]
55  real(RP), intent(in) :: va (ia,ja) ! velocity v at the lowest atmospheric layer [m/s]
56  real(RP), intent(in) :: z1 (ia,ja) ! cell center height at the lowest atmospheric layer [m]
57  real(DP), intent(in) :: dt ! delta time
58  end subroutine rl
59  end interface
60 
61  procedure(rl), pointer :: roughness => null()
62  public :: roughness
63 
64  !-----------------------------------------------------------------------------
65  !
66  !++ Public parameters & variables
67  !
68  !-----------------------------------------------------------------------------
69  !
70  !++ Private procedure
71  !
72  private :: roughness_const_setup
73  private :: roughness_const
74  private :: roughness_miller92_setup
75  private :: roughness_moon07_setup
76  private :: roughness_miller92
77  private :: roughness_moon07
78 
79  !-----------------------------------------------------------------------------
80  !
81  !++ Private parameters & variables
82  !
83  character(len=H_SHORT), private :: roughness_type = 'MOON07' ! surface roughness length scheme
84 
85  real(RP), private :: roughness_visck = 1.5e-5_rp ! kinematic viscosity
86  real(RP), private :: roughness_ustar_min = 1.0e-3_rp ! minimum fiction velocity
87  real(RP), private :: roughness_z0m_min = 1.0e-5_rp ! minimum roughness length for momentum [m]
88  real(RP), private :: roughness_z0h_min = 1.0e-5_rp ! minimum roughness length for heat [m]
89  real(RP), private :: roughness_z0e_min = 1.0e-5_rp ! minimum roughness length for moisture [m]
90 
91  real(RP), private :: roughness_miller92_cm0 = 1.0e-3_rp ! bulk coef. for U*
92  real(RP), private :: roughness_miller92_z0mi = 0.0e-0_rp ! base roughness length for momentum
93  real(RP), private :: roughness_miller92_z0mr = 1.8e-2_rp ! rough factor for momentum
94  real(RP), private :: roughness_miller92_z0ms = 1.1e-1_rp ! smooth factor for momentum
95  real(RP), private :: roughness_miller92_z0hi = 1.4e-5_rp ! base roughness length for heat
96  real(RP), private :: roughness_miller92_z0hr = 0.0e-0_rp ! rough factor for heat
97  real(RP), private :: roughness_miller92_z0hs = 4.0e-1_rp ! smooth factor for heat
98  real(RP), private :: roughness_miller92_z0ei = 1.3e-4_rp ! base roughness length for moisture
99  real(RP), private :: roughness_miller92_z0er = 0.0e-0_rp ! rough factor for moisture
100  real(RP), private :: roughness_miller92_z0es = 6.2e-1_rp ! smooth factor for moisture
101 
102  integer, private :: roughness_moon07_itelim = 10 ! maximum iteration number
103 
104  !-----------------------------------------------------------------------------
105 contains
106  !-----------------------------------------------------------------------------
107  subroutine roughness_setup
108  use scale_process, only: &
109  prc_mpistop
110  implicit none
111 
112  namelist / param_roughness / &
113  roughness_type, &
114  roughness_visck, &
115  roughness_ustar_min, &
116  roughness_z0m_min, &
117  roughness_z0h_min, &
118  roughness_z0e_min
119 
120  integer :: ierr
121  !---------------------------------------------------------------------------
122 
123  if( io_l ) write(io_fid_log,*)
124  if( io_l ) write(io_fid_log,*) '++++++ Module[ROUGHNESS] / Categ[COUPLER] / Origin[SCALElib]'
125 
126  !--- read namelist
127  rewind(io_fid_conf)
128  read(io_fid_conf,nml=param_roughness,iostat=ierr)
129  if( ierr < 0 ) then !--- missing
130  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
131  elseif( ierr > 0 ) then !--- fatal error
132  write(*,*) 'xxx Not appropriate names in namelist PARAM_ROUGHNESS. Check!'
133  call prc_mpistop
134  endif
135  if( io_lnml ) write(io_fid_log,nml=param_roughness)
136 
137  select case( roughness_type )
138  case ('MILLER92')
139  roughness => roughness_miller92
140  call roughness_miller92_setup
141  case ('MOON07')
142  roughness => roughness_moon07
143  call roughness_moon07_setup
144  case ('CONST')
145  roughness => roughness_const
146  call roughness_const_setup
147  case default
148  write(*,*) 'xxx invalid sea roughness length scheme (', trim(roughness_type), '). CHECK!'
149  call prc_mpistop
150  end select
151 
152  return
153  end subroutine roughness_setup
154 
155  !-----------------------------------------------------------------------------
156  subroutine roughness_miller92_setup
157  use scale_process, only: &
158  prc_mpistop
159  implicit none
160 
161  namelist / param_roughness_miller92 / &
162  roughness_miller92_cm0, &
163  roughness_miller92_z0mi, &
164  roughness_miller92_z0mr, &
165  roughness_miller92_z0ms, &
166  roughness_miller92_z0hi, &
167  roughness_miller92_z0hr, &
168  roughness_miller92_z0hs, &
169  roughness_miller92_z0ei, &
170  roughness_miller92_z0er, &
171  roughness_miller92_z0es
172 
173  integer :: ierr
174  !---------------------------------------------------------------------------
175 
176  if( io_l ) write(io_fid_log,*) '*** Scheme for ocean roughness length : Miller (1992)'
177 
178  !--- read namelist
179  rewind(io_fid_conf)
180  read(io_fid_conf,nml=param_roughness_miller92,iostat=ierr)
181  if( ierr < 0 ) then !--- missing
182  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
183  elseif( ierr > 0 ) then !--- fatal error
184  write(*,*) 'xxx Not appropriate names in namelist PARAM_ROUGHNESS_MILLER92. Check!'
185  call prc_mpistop
186  endif
187  if( io_lnml ) write(io_fid_log,nml=param_roughness_miller92)
188 
189  return
190  end subroutine roughness_miller92_setup
191 
192  !-----------------------------------------------------------------------------
193  subroutine roughness_moon07_setup
194  use scale_process, only: &
195  prc_mpistop
196  implicit none
197 
198  namelist / param_roughness_moon07 / &
199  roughness_moon07_itelim
200 
201  integer :: ierr
202  !---------------------------------------------------------------------------
203 
204  if( io_l ) write(io_fid_log,*) '*** Scheme for ocean roughness length : Moon et al. (2007)'
205 
206  !--- read namelist
207  rewind(io_fid_conf)
208  read(io_fid_conf,nml=param_roughness_moon07,iostat=ierr)
209  if( ierr < 0 ) then !--- missing
210  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
211  elseif( ierr > 0 ) then !--- fatal error
212  write(*,*) 'xxx Not appropriate names in namelist PARAM_ROUGHNESS_MOON07. Check!'
213  call prc_mpistop
214  endif
215  if( io_lnml ) write(io_fid_log,nml=param_roughness_moon07)
216 
217  return
218  end subroutine roughness_moon07_setup
219 
220  !-----------------------------------------------------------------------------
221  subroutine roughness_const_setup
222  implicit none
223  !---------------------------------------------------------------------------
224 
225  if( io_l ) write(io_fid_log,*) '*** Scheme for ocean roughness length : constant'
226 
227  return
228  end subroutine roughness_const_setup
229 
230  !-----------------------------------------------------------------------------
231  subroutine roughness_miller92( &
232  Z0M_t, & ! [OUT]
233  Z0H_t, & ! [OUT]
234  Z0E_t, & ! [OUT]
235  Z0M, & ! [IN]
236  Z0H, & ! [IN]
237  Z0E, & ! [IN]
238  UA, & ! [IN]
239  VA, & ! [IN]
240  Z1, & ! [IN]
241  dt ) ! [IN]
242  use scale_const, only: &
243  grav => const_grav
244  implicit none
245 
246  ! arguments
247  real(RP), intent(out) :: Z0M_t(ia,ja) ! tendency of roughness length for momentum [m]
248  real(RP), intent(out) :: Z0H_t(ia,ja) ! tendency of roughness length for heat [m]
249  real(RP), intent(out) :: Z0E_t(ia,ja) ! tendency of roughness length for vapor [m]
250 
251  real(RP), intent(in) :: Z0M(ia,ja) ! roughness length for momentum [m]
252  real(RP), intent(in) :: Z0H(ia,ja) ! roughness length for heat [m]
253  real(RP), intent(in) :: Z0E(ia,ja) ! roughness length for vapor [m]
254  real(RP), intent(in) :: UA (ia,ja) ! velocity u at the lowest atomspheric layer [m/s]
255  real(RP), intent(in) :: VA (ia,ja) ! velocity v at the lowest atomspheric layer [m/s]
256  real(RP), intent(in) :: Z1 (ia,ja) ! cell center height at the lowest atmospheric layer [m]
257  real(DP), intent(in) :: dt ! delta time
258 
259  ! works
260  real(RP) :: Z0M1(ia,ja)
261  real(RP) :: Z0H1(ia,ja)
262  real(RP) :: Z0E1(ia,ja)
263 
264  real(RP) :: Uabs, Ustar
265 
266  integer :: i, j
267  !---------------------------------------------------------------------------
268 
269  do j = js, je
270  do i = is, ie
271 
272  uabs = sqrt( ua(i,j)**2 + va(i,j)**2 )
273  ustar = max( sqrt( roughness_miller92_cm0 ) * uabs, roughness_ustar_min )
274 
275  z0m1(i,j) = max( roughness_miller92_z0mi &
276  + roughness_miller92_z0mr / grav * ustar * ustar &
277  + roughness_miller92_z0ms * roughness_visck / ustar, &
278  roughness_z0m_min )
279  z0h1(i,j) = max( roughness_miller92_z0hi &
280  + roughness_miller92_z0hr / grav * ustar * ustar &
281  + roughness_miller92_z0hs * roughness_visck / ustar, &
282  roughness_z0h_min )
283  z0e1(i,j) = max( roughness_miller92_z0ei &
284  + roughness_miller92_z0er / grav * ustar * ustar &
285  + roughness_miller92_z0es * roughness_visck / ustar, &
286  roughness_z0e_min )
287 
288  ! calculate tendency
289  z0m_t(i,j) = ( z0m1(i,j) - z0m(i,j) ) / dt
290  z0h_t(i,j) = ( z0h1(i,j) - z0h(i,j) ) / dt
291  z0e_t(i,j) = ( z0e1(i,j) - z0e(i,j) ) / dt
292 
293  enddo
294  enddo
295 
296  return
297  end subroutine roughness_miller92
298 
299  !-----------------------------------------------------------------------------
303  subroutine roughness_moon07( &
304  Z0M_t, & ! [OUT]
305  Z0H_t, & ! [OUT]
306  Z0E_t, & ! [OUT]
307  Z0M, & ! [IN]
308  Z0H, & ! [IN]
309  Z0E, & ! [IN]
310  UA, & ! [IN]
311  VA, & ! [IN]
312  Z1, & ! [IN]
313  dt ) ! [IN]
314  use scale_const, only: &
315  grav => const_grav, &
316  karman => const_karman
317  implicit none
318 
319  ! arguments
320  real(RP), intent(out) :: Z0M_t(ia,ja) ! tendency of roughness length for momentum [m]
321  real(RP), intent(out) :: Z0H_t(ia,ja) ! tendency of roughness length for heat [m]
322  real(RP), intent(out) :: Z0E_t(ia,ja) ! tendency of roughness length for vapor [m]
323 
324  real(RP), intent(in) :: Z0M(ia,ja) ! roughness length for momentum [m]
325  real(RP), intent(in) :: Z0H(ia,ja) ! roughness length for heat [m]
326  real(RP), intent(in) :: Z0E(ia,ja) ! roughness length for vapor [m]
327  real(RP), intent(in) :: UA (ia,ja) ! velocity u at the lowest atomspheric layer [m/s]
328  real(RP), intent(in) :: VA (ia,ja) ! velocity v at the lowest atomspheric layer [m/s]
329  real(RP), intent(in) :: Z1 (ia,ja) ! cell center height at the lowest atmospheric layer [m]
330  real(DP), intent(in) :: dt ! delta time
331 
332  ! works
333  real(RP) :: Z0M1(ia,ja)
334  real(RP) :: Z0H1(ia,ja)
335  real(RP) :: Z0E1(ia,ja)
336 
337  real(RP) :: Ustar(ia,ja)
338  real(RP) :: Uabs (ia,ja)
339  real(RP) :: U10M
340 
341  integer :: ite
342  integer :: i, j
343  !---------------------------------------------------------------------------
344 
345  do j = js, je
346  do i = is, ie
347  z0m1(i,j) = max( z0m(i,j), roughness_z0m_min )
348  uabs(i,j) = sqrt( ua(i,j)**2 + va(i,j)**2 )
349  enddo
350  enddo
351 
352  do ite = 1, roughness_moon07_itelim
353  do j = js, je
354  do i = is, ie
355  ustar(i,j) = max( karman * uabs(i,j) / log( z1(i,j)/z0m1(i,j) ), roughness_ustar_min )
356  u10m = ustar(i,j) / karman * log( 10.0_rp/z0m1(i,j) )
357 
358  if ( u10m <= 12.5_rp ) then
359  z0m1(i,j) = max( 0.0185_rp * ustar(i,j)**2 / grav, roughness_z0m_min )
360  else
361  z0m1(i,j) = 1.0e-3_rp * ( 0.085_rp * ( -0.56_rp*ustar(i,j)**2 &
362  + 20.255_rp*ustar(i,j) &
363  + 2.458_rp ) - 0.58_rp )
364  endif
365  enddo
366  enddo
367  enddo
368 
369  ! Fairall et al. TOGA V3.0
370  ! Fairall et al. (2003) JCLI, vol. 16, 571-591. Eq. (28)
371  do j = js, je
372  do i = is, ie
373  z0h1(i,j) = min( 5.5e-5_rp / ( z0m1(i,j) * ustar(i,j) / roughness_visck )**0.6_rp, 1.1e-4_rp )
374  z0e1(i,j) = z0h1(i,j)
375  enddo
376  enddo
377 
378  do j = js, je
379  do i = is, ie
380  ! limiter
381  z0m1(i,j) = max( z0m1(i,j), roughness_z0m_min )
382  z0h1(i,j) = max( z0h1(i,j), roughness_z0h_min )
383  z0e1(i,j) = max( z0e1(i,j), roughness_z0e_min )
384 
385  ! calculate tendency
386  z0m_t(i,j) = ( z0m1(i,j) - z0m(i,j) ) / dt
387  z0h_t(i,j) = ( z0h1(i,j) - z0h(i,j) ) / dt
388  z0e_t(i,j) = ( z0e1(i,j) - z0e(i,j) ) / dt
389  enddo
390  enddo
391 
392  return
393  end subroutine roughness_moon07
394 
395  !-----------------------------------------------------------------------------
396  subroutine roughness_const( &
397  Z0M_t, & ! [OUT]
398  Z0H_t, & ! [OUT]
399  Z0E_t, & ! [OUT]
400  Z0M, & ! [IN]
401  Z0H, & ! [IN]
402  Z0E, & ! [IN]
403  UA, & ! [IN]
404  VA, & ! [IN]
405  Z1, & ! [IN]
406  dt ) ! [IN]
407  implicit none
408 
409  ! arguments
410  real(RP), intent(out) :: Z0M_t(ia,ja) ! tendency of roughness length for momentum [m]
411  real(RP), intent(out) :: Z0H_t(ia,ja) ! tendency of roughness length for heat [m]
412  real(RP), intent(out) :: Z0E_t(ia,ja) ! tendency of roughness length for vapor [m]
413 
414  real(RP), intent(in) :: Z0M(ia,ja) ! roughness length for momentum [m]
415  real(RP), intent(in) :: Z0H(ia,ja) ! roughness length for heat [m]
416  real(RP), intent(in) :: Z0E(ia,ja) ! roughness length for vapor [m]
417  real(RP), intent(in) :: UA (ia,ja) ! velocity u at the lowest atomspheric layer [m/s]
418  real(RP), intent(in) :: VA (ia,ja) ! velocity v at the lowest atomspheric layer [m/s]
419  real(RP), intent(in) :: Z1 (ia,ja) ! cell center height at the lowest atmospheric layer [m]
420  real(DP), intent(in) :: dt ! delta time
421 
422  z0m_t(:,:) = 0.0_rp
423  z0h_t(:,:) = 0.0_rp
424  z0e_t(:,:) = 0.0_rp
425 
426  return
427  end subroutine roughness_const
428 
429 end module scale_roughness
scale_grid_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_grid_index.F90:60
scale_grid_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_grid_index.F90:63
scale_process::prc_mpistop
subroutine, public prc_mpistop
Abort MPI.
Definition: scale_process.F90:234
scale_index::va
integer, public va
Definition: scale_index.F90:38
scale_stdio::io_l
logical, public io_l
output log or not? (this process)
Definition: scale_stdio.F90:59
scale_roughness::roughness_setup
subroutine, public roughness_setup
Definition: scale_roughness.F90:108
scale_stdio
module STDIO
Definition: scale_stdio.F90:12
scale_const::const_karman
real(rp), parameter, public const_karman
von Karman constant
Definition: scale_const.F90:52
scale_grid_index
module grid index
Definition: scale_grid_index.F90:14
scale_grid_index::ia
integer, public ia
of x whole cells (local, with HALO)
Definition: scale_grid_index.F90:55
scale_const::const_grav
real(rp), public const_grav
standard acceleration of gravity [m/s2]
Definition: scale_const.F90:48
scale_grid_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_grid_index.F90:62
scale_roughness::roughness
procedure(rl), pointer, public roughness
Definition: scale_roughness.F90:61
scale_process
module PROCESS
Definition: scale_process.F90:14
dc_log::log
subroutine, public log(type, message)
Definition: dc_log.f90:133
scale_const
module CONSTANT
Definition: scale_const.F90:14
scale_prof
module profiler
Definition: scale_prof.F90:10
scale_grid_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_grid_index.F90:61
scale_stdio::io_lnml
logical, public io_lnml
output log or not? (for namelist, this process)
Definition: scale_stdio.F90:60
scale_precision
module PRECISION
Definition: scale_precision.F90:13
scale_roughness
module Surface roughness length
Definition: scale_roughness.F90:13
scale_stdio::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_stdio.F90:55
scale_stdio::io_fid_log
integer, public io_fid_log
Log file ID.
Definition: scale_stdio.F90:56
scale_grid_index::ja
integer, public ja
of y whole cells (local, with HALO)
Definition: scale_grid_index.F90:56
Generated by   doxygen 1.8.13