SCALE-RM
Functions/Subroutines
scale_atmos_dyn_common Module Reference

module Atmosphere / Dynamics common More...

Functions/Subroutines

subroutine, public atmos_dyn_wdamp_setup (wdamp_coef, wdamp_tau, wdamp_height, FZ)
 Setup. More...
 
subroutine, public atmos_dyn_fill_halo (var, fill_constval, lateral_halo, top_bottom_halo)
 
subroutine, public atmos_dyn_copy_boundary (DENS, MOMZ, MOMX, MOMY, RHOT, PROG, DENS0, MOMZ0, MOMX0, MOMY0, RHOT0, PROG0, BND_W, BND_E, BND_S, BND_N, TwoD)
 
subroutine, public atmos_dyn_copy_boundary_tracer (QTRC, QTRC0, BND_W, BND_E, BND_S, BND_N, TwoD)
 
subroutine, public atmos_dyn_divergence (DDIV, MOMZ, MOMX, MOMY, GSQRT, J13G, J23G, J33G, MAPF, TwoD, RCDZ, RCDX, RCDY, RFDZ, FDZ)
 
subroutine, public atmos_dyn_prep_pres_linearization (DPRES, RT2P, REF_rhot, RHOT, QTRC, REF_pres, AQ_R, AQ_CV, AQ_CP, AQ_MASS)
 

Detailed Description

module Atmosphere / Dynamics common

Description
common subroutines for Atmospheric dynamical process
Author
Team SCALE

Function/Subroutine Documentation

◆ atmos_dyn_wdamp_setup()

subroutine, public scale_atmos_dyn_common::atmos_dyn_wdamp_setup ( real(rp), dimension(ka), intent(inout)  wdamp_coef,
real(rp), intent(in)  wdamp_tau,
real(rp), intent(in)  wdamp_height,
real(rp), dimension(0:ka), intent(in)  FZ 
)

Setup.

Definition at line 69 of file scale_atmos_dyn_common.F90.

69  use scale_const, only: &
70  pi => const_pi, &
71  eps => const_eps
72  implicit none
73 
74  real(RP), intent(inout) :: wdamp_coef(KA)
75  real(RP), intent(in) :: wdamp_tau
76  real(RP), intent(in) :: wdamp_height
77  real(RP), intent(in) :: FZ(0:KA)
78 
79  real(RP) :: alpha, sw
80 
81  integer :: k
82  !---------------------------------------------------------------------------
83 
84  if ( wdamp_height < 0.0_rp ) then
85  wdamp_coef(:) = 0.0_rp
86  elseif( fz(ke)-wdamp_height < eps ) then
87  wdamp_coef(:) = 0.0_rp
88  else
89  alpha = 1.0_rp / wdamp_tau
90 
91  do k = ks, ke
92  sw = 0.5_rp + sign( 0.5_rp, fz(k)-wdamp_height )
93 
94  wdamp_coef(k) = alpha * sw &
95  * 0.5_rp * ( 1.0_rp - cos( pi * (fz(k)-wdamp_height) / (fz(ke)-wdamp_height)) )
96  enddo
97  wdamp_coef( 1:ks-1) = wdamp_coef(ks)
98  wdamp_coef(ke+1:ka ) = wdamp_coef(ke)
99 
100  log_newline
101  log_info("ATMOS_DYN_wdamp_setup",*) 'Setup Rayleigh damping coefficient'
102  log_info_cont('(1x,A)') '|=== Rayleigh Damping Coef ===|'
103  log_info_cont('(1x,A)') '| k zh[m] coef[/s] |'
104  do k = ka, ke+1, -1
105  log_info_cont('(1x,A,I5,F10.2,ES12.4,A)') '| ',k, fz(k), wdamp_coef(k),' |'
106  enddo
107  k = ke
108  log_info_cont('(1x,A,I5,F10.2,ES12.4,A)') '| ',k, fz(k), wdamp_coef(k),' | KE = TOA'
109  do k = ke-1, ks, -1
110  log_info_cont('(1x,A,I5,F10.2,ES12.4,A)') '| ',k, fz(k), wdamp_coef(k),' |'
111  enddo
112  k = ks-1
113  log_info_cont('(1x,A,I5,F10.2,ES12.4,A)') '| ',k, fz(k), wdamp_coef(k),' | KS-1 = surface'
114  do k = ks-2, 1, -1
115  log_info_cont('(1x,A,I5,F10.2,ES12.4,A)') '| ',k, fz(k), wdamp_coef(k),' |'
116  enddo
117  k = 0
118  log_info_cont('(1x,A,I5,F10.2,12x,A)') '| ',k, fz(k), ' |'
119  log_info_cont('(1x,A)') '|=============================|'
120  endif
121 
122  return

References scale_const::const_eps, scale_const::const_pi, scale_tracer::k, scale_atmos_grid_cartesc_index::ka, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn::atmos_dyn_setup().

Here is the caller graph for this function:

◆ atmos_dyn_fill_halo()

subroutine, public scale_atmos_dyn_common::atmos_dyn_fill_halo ( real(rp), dimension(ka,ia,ja), intent(inout)  var,
real(rp), intent(in)  fill_constval,
logical, intent(in)  lateral_halo,
logical, intent(in)  top_bottom_halo 
)

Definition at line 129 of file scale_atmos_dyn_common.F90.

129  implicit none
130 
131  real(RP), intent(inout) :: var(KA,IA,JA)
132  real(RP), intent(in) :: fill_constval
133  logical, intent(in) :: lateral_halo
134  logical, intent(in) :: top_bottom_halo
135 
136  integer :: i, j, k
137  !----------------------------
138 
139  if (lateral_halo) then
140 !OCL XFILL
141  do j = 1, ja
142  do i = 1, isb-1
143  do k = 1, ka
144  var(k,i,j) = fill_constval
145  enddo
146  enddo
147  do i = ieb+1, ia
148  do k = 1, ka
149  var(k,i,j) = fill_constval
150  enddo
151  enddo
152  enddo
153 !OCL XFILL
154  do j = 1, jsb-1
155  do i = 1, ia
156  do k = 1, ka
157  var(k,i,j) = fill_constval
158  enddo
159  enddo
160  enddo
161 !OCL XFILL
162  do j = jeb+1, ja
163  do i = 1, ia
164  do k = 1, ka
165  var(k,i,j) = fill_constval
166  enddo
167  enddo
168  enddo
169  end if
170 
171  if (top_bottom_halo) then
172  !OCL XFILL
173  do j = js, je
174  do i = is, ie
175  var( 1:ks-1,i,j) = fill_constval
176  var(ke+1:ka ,i,j) = fill_constval
177  enddo
178  enddo
179  end if
180 
181  return

References scale_atmos_grid_cartesc_index::ia, scale_atmos_grid_cartesc_index::ie, scale_atmos_grid_cartesc_index::ieb, scale_atmos_grid_cartesc_index::is, scale_atmos_grid_cartesc_index::isb, scale_atmos_grid_cartesc_index::ja, scale_atmos_grid_cartesc_index::je, scale_atmos_grid_cartesc_index::jeb, scale_atmos_grid_cartesc_index::js, scale_atmos_grid_cartesc_index::jsb, scale_tracer::k, scale_atmos_grid_cartesc_index::ka, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_tstep_large_fvm_heve::atmos_dyn_tstep_large_fvm_heve().

Here is the caller graph for this function:

◆ atmos_dyn_copy_boundary()

subroutine, public scale_atmos_dyn_common::atmos_dyn_copy_boundary ( real(rp), dimension (ka,ia,ja), intent(inout)  DENS,
real(rp), dimension (ka,ia,ja), intent(inout)  MOMZ,
real(rp), dimension (ka,ia,ja), intent(inout)  MOMX,
real(rp), dimension (ka,ia,ja), intent(inout)  MOMY,
real(rp), dimension (ka,ia,ja), intent(inout)  RHOT,
real(rp), dimension (ka,ia,ja,va), intent(inout)  PROG,
real(rp), dimension(ka,ia,ja), intent(in)  DENS0,
real(rp), dimension(ka,ia,ja), intent(in)  MOMZ0,
real(rp), dimension(ka,ia,ja), intent(in)  MOMX0,
real(rp), dimension(ka,ia,ja), intent(in)  MOMY0,
real(rp), dimension(ka,ia,ja), intent(in)  RHOT0,
real(rp), dimension(ka,ia,ja,va), intent(in)  PROG0,
logical, intent(in)  BND_W,
logical, intent(in)  BND_E,
logical, intent(in)  BND_S,
logical, intent(in)  BND_N,
logical, intent(in)  TwoD 
)

Definition at line 188 of file scale_atmos_dyn_common.F90.

188  implicit none
189  real(RP), intent(inout) :: DENS (KA,IA,JA)
190  real(RP), intent(inout) :: MOMZ (KA,IA,JA)
191  real(RP), intent(inout) :: MOMX (KA,IA,JA)
192  real(RP), intent(inout) :: MOMY (KA,IA,JA)
193  real(RP), intent(inout) :: RHOT (KA,IA,JA)
194  real(RP), intent(inout) :: PROG (KA,IA,JA,VA)
195  real(RP), intent(in) :: DENS0(KA,IA,JA)
196  real(RP), intent(in) :: MOMZ0(KA,IA,JA)
197  real(RP), intent(in) :: MOMX0(KA,IA,JA)
198  real(RP), intent(in) :: MOMY0(KA,IA,JA)
199  real(RP), intent(in) :: RHOT0(KA,IA,JA)
200  real(RP), intent(in) :: PROG0(KA,IA,JA,VA)
201  logical, intent(in) :: BND_W
202  logical, intent(in) :: BND_E
203  logical, intent(in) :: BND_S
204  logical, intent(in) :: BND_N
205  logical, intent(in) :: TwoD
206 
207  integer :: k, i, j, iv
208 
209  if ( bnd_w .and. (.not. twod) ) then
210  !$omp parallel do default(none) private(j,k) OMP_SCHEDULE_ collapse(2) &
211  !$omp private(i,iv) &
212  !$omp shared(JA,IS,KS,KE,DENS,DENS0,MOMZ,MOMZ0,MOMX,MOMX0,MOMY,MOMY0,RHOT,RHOT0,VA,PROG,PROG0)
213 !OCL XFILL
214  do j = 1, ja
215  do i = 1, is-1
216  do k = ks, ke
217  dens(k,i,j) = dens0(k,i,j)
218  momz(k,i,j) = momz0(k,i,j)
219  momx(k,i,j) = momx0(k,i,j)
220  momy(k,i,j) = momy0(k,i,j)
221  rhot(k,i,j) = rhot0(k,i,j)
222  do iv = 1, va
223  prog(k,i,j,iv) = prog0(k,i,j,iv)
224  end do
225  enddo
226  enddo
227  enddo
228  end if
229  if ( bnd_e .and. (.not. twod) ) then
230  !$omp parallel do default(none) private(j,k) OMP_SCHEDULE_ collapse(2) &
231  !$omp private(i,iv) &
232  !$omp shared(JA,IE,IA,KS,KE,DENS,DENS0,MOMZ,MOMZ0,MOMX,MOMX0,MOMY,MOMY0,RHOT,RHOT0,VA,PROG,PROG0)
233 !OCL XFILL
234  do j = 1, ja
235  do i = ie+1, ia
236  do k = ks, ke
237  dens(k,i,j) = dens0(k,i,j)
238  momz(k,i,j) = momz0(k,i,j)
239  momx(k,i,j) = momx0(k,i,j)
240  momy(k,i,j) = momy0(k,i,j)
241  rhot(k,i,j) = rhot0(k,i,j)
242  do iv = 1, va
243  prog(k,i,j,iv) = prog0(k,i,j,iv)
244  end do
245  enddo
246  enddo
247  enddo
248  !$omp parallel do private(j,k) OMP_SCHEDULE_ collapse(2)
249 !OCL XFILL
250  do j = 1, ja
251  do k = ks, ke
252  momx(k,ie,j) = momx0(k,ie,j)
253  enddo
254  enddo
255  end if
256  if ( bnd_s ) then
257  !$omp parallel do default(none) private(j,k) OMP_SCHEDULE_ collapse(2) &
258  !$omp private(i,iv) &
259  !$omp shared(JS,IA,KS,KE,DENS,DENS0,MOMZ,MOMZ0,MOMX,MOMX0,MOMY,MOMY0,RHOT,RHOT0,VA,PROG,PROG0)
260 !OCL XFILL
261  do j = 1, js-1
262  do i = 1, ia
263  do k = ks, ke
264  dens(k,i,j) = dens0(k,i,j)
265  momz(k,i,j) = momz0(k,i,j)
266  momx(k,i,j) = momx0(k,i,j)
267  momy(k,i,j) = momy0(k,i,j)
268  rhot(k,i,j) = rhot0(k,i,j)
269  do iv = 1, va
270  prog(k,i,j,iv) = prog0(k,i,j,iv)
271  end do
272  enddo
273  enddo
274  enddo
275  end if
276  if ( bnd_n ) then
277  !$omp parallel do default(none) private(j,k) OMP_SCHEDULE_ collapse(2) &
278  !$omp private(i,iv) &
279  !$omp shared(JA,JE,IA,KS,KE,DENS,DENS0,MOMZ,MOMZ0,MOMX,MOMX0,MOMY,MOMY0,RHOT,RHOT0,VA,PROG,PROG0)
280 !OCL XFILL
281  do j = je+1, ja
282  do i = 1, ia
283  do k = ks, ke
284  dens(k,i,j) = dens0(k,i,j)
285  momz(k,i,j) = momz0(k,i,j)
286  momx(k,i,j) = momx0(k,i,j)
287  momy(k,i,j) = momy0(k,i,j)
288  rhot(k,i,j) = rhot0(k,i,j)
289  do iv = 1, va
290  prog(k,i,j,iv) = prog0(k,i,j,iv)
291  end do
292  enddo
293  enddo
294  enddo
295  !$omp parallel do private(i,k) OMP_SCHEDULE_ collapse(2)
296 !OCL XFILL
297  do i = 1, ia
298  do k = ks, ke
299  momy(k,i,je) = momy0(k,i,je)
300  enddo
301  enddo
302  end if
303 
304  return

References scale_atmos_grid_cartesc_index::ia, scale_atmos_grid_cartesc_index::ie, scale_atmos_grid_cartesc_index::is, scale_atmos_grid_cartesc_index::ja, scale_atmos_grid_cartesc_index::je, scale_atmos_grid_cartesc_index::js, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, scale_atmos_grid_cartesc_index::ks, and scale_index::va.

Referenced by scale_atmos_dyn_tinteg_short_rk11s8o::atmos_dyn_tinteg_short_rk11s8o(), scale_atmos_dyn_tinteg_short_rk3::atmos_dyn_tinteg_short_rk3(), scale_atmos_dyn_tinteg_short_rk4::atmos_dyn_tinteg_short_rk4(), and scale_atmos_dyn_tinteg_short_rk7s6o::atmos_dyn_tinteg_short_rk7s6o().

Here is the caller graph for this function:

◆ atmos_dyn_copy_boundary_tracer()

subroutine, public scale_atmos_dyn_common::atmos_dyn_copy_boundary_tracer ( real(rp), dimension (ka,ia,ja), intent(inout)  QTRC,
real(rp), dimension(ka,ia,ja), intent(in)  QTRC0,
logical, intent(in)  BND_W,
logical, intent(in)  BND_E,
logical, intent(in)  BND_S,
logical, intent(in)  BND_N,
logical, intent(in)  TwoD 
)

Definition at line 311 of file scale_atmos_dyn_common.F90.

311  implicit none
312  real(RP), intent(inout) :: QTRC (KA,IA,JA)
313  real(RP), intent(in) :: QTRC0(KA,IA,JA)
314  logical, intent(in) :: BND_W
315  logical, intent(in) :: BND_E
316  logical, intent(in) :: BND_S
317  logical, intent(in) :: BND_N
318  logical, intent(in) :: TwoD
319 
320  integer :: k, i, j
321 
322  if ( bnd_w .and. (.not. twod) ) then
323  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
324  !$omp shared(JA,IS,KS,KE,QTRC,QTRC0)
325 !OCL XFILL
326  do j = 1, ja
327  do i = 1, is-1
328  do k = ks, ke
329  qtrc(k,i,j) = qtrc0(k,i,j)
330  enddo
331  enddo
332  enddo
333  end if
334  if ( bnd_e .and. (.not. twod) ) then
335  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
336  !$omp shared(JA,IE,IA,KS,KE,QTRC,QTRC0)
337 !OCL XFILL
338  do j = 1, ja
339  do i = ie+1, ia
340  do k = ks, ke
341  qtrc(k,i,j) = qtrc0(k,i,j)
342  enddo
343  enddo
344  enddo
345  end if
346  if ( bnd_s ) then
347  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
348  !$omp shared(JS,IA,KS,KE,QTRC,QTRC0)
349 !OCL XFILL
350  do j = 1, js-1
351  do i = 1, ia
352  do k = ks, ke
353  qtrc(k,i,j) = qtrc0(k,i,j)
354  enddo
355  enddo
356  enddo
357  end if
358  if ( bnd_n ) then
359  !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
360  !$omp shared(JA,JE,IA,KS,KE,QTRC,QTRC0)
361 !OCL XFILL
362  do j = je+1, ja
363  do i = 1, ia
364  do k = ks, ke
365  qtrc(k,i,j) = qtrc0(k,i,j)
366  enddo
367  enddo
368  enddo
369  end if
370 
371  return

References scale_atmos_grid_cartesc_index::ia, scale_atmos_grid_cartesc_index::ie, scale_atmos_grid_cartesc_index::is, scale_atmos_grid_cartesc_index::ja, scale_atmos_grid_cartesc_index::je, scale_atmos_grid_cartesc_index::js, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, and scale_atmos_grid_cartesc_index::ks.

Referenced by scale_atmos_dyn_tinteg_tracer_linrk::atmos_dyn_tinteg_tracer_linrk(), and scale_atmos_dyn_tinteg_tracer_rk3::atmos_dyn_tinteg_tracer_rk3().

Here is the caller graph for this function:

◆ atmos_dyn_divergence()

subroutine, public scale_atmos_dyn_common::atmos_dyn_divergence ( real(rp), dimension(ka,ia,ja), intent(out)  DDIV,
real(rp), dimension(ka,ia,ja), intent(in)  MOMZ,
real(rp), dimension(ka,ia,ja), intent(in)  MOMX,
real(rp), dimension(ka,ia,ja), intent(in)  MOMY,
real(rp), dimension(ka,ia,ja,7), intent(in)  GSQRT,
real(rp), dimension(ka,ia,ja,7), intent(in)  J13G,
real(rp), dimension(ka,ia,ja,7), intent(in)  J23G,
real(rp), intent(in)  J33G,
real(rp), dimension(ia,ja,2,7), intent(in)  MAPF,
logical, intent(in)  TwoD,
real(rp), dimension(ka), intent(in)  RCDZ,
real(rp), dimension(ia), intent(in)  RCDX,
real(rp), dimension(ja), intent(in)  RCDY,
real(rp), dimension(ka-1), intent(in)  RFDZ,
real(rp), dimension(ka-1), intent(in)  FDZ 
)

Definition at line 382 of file scale_atmos_dyn_common.F90.

382  implicit none
383  real(RP), intent(out) :: DDIV(KA,IA,JA)
384  real(RP), intent(in) :: MOMZ(KA,IA,JA)
385  real(RP), intent(in) :: MOMX(KA,IA,JA)
386  real(RP), intent(in) :: MOMY(KA,IA,JA)
387  real(RP), intent(in) :: GSQRT(KA,IA,JA,7)
388  real(RP), intent(in) :: J13G(KA,IA,JA,7)
389  real(RP), intent(in) :: J23G(KA,IA,JA,7)
390  real(RP), intent(in) :: J33G
391  real(RP), intent(in) :: MAPF(IA,JA,2,7)
392  logical, intent(in) :: TwoD
393  real(RP), intent(in) :: RCDZ(KA)
394  real(RP), intent(in) :: RCDX(IA)
395  real(RP), intent(in) :: RCDY(JA)
396  real(RP), intent(in) :: RFDZ(KA-1)
397  real(RP), intent(in) :: FDZ(KA-1)
398 
399  integer :: k, i, j
400 
401  call prof_rapstart("DYN_divercence", 2)
402 
403  ! 3D divergence
404 
405  if ( twod ) then
406  !$omp parallel do private(j,k) OMP_SCHEDULE_
407  do j = js, je+1
408  do k = ks-1, ke+1
409  ddiv(k,is,j) = j33g * ( momz(k,is,j) - momz(k-1,is,j) ) * rcdz(k) &
410  + ( ( momy(k+1,is,j) + momy(k+1,is,j-1) ) * j23g(k+1,is,j,i_xyw) &
411  - ( momy(k-1,is,j) + momy(k-1,is,j-1) ) * j23g(k-1,is,j,i_xyw) ) / ( fdz(k)+fdz(k-1) ) &
412  + mapf(is,j,2,i_xy) &
413  * ( momy(k,is,j ) * gsqrt(k,is,j ,i_xvz) / mapf(is,j ,1,i_xv) &
414  - momy(k,is,j-1) * gsqrt(k,is,j-1,i_xvz) / mapf(is,j-1,1,i_xv) ) * rcdy(j)
415  enddo
416  enddo
417 #ifdef DEBUG
418  k = iundef; i = iundef; j = iundef
419 #endif
420  !$omp parallel do private(j) OMP_SCHEDULE_
421  do j = js, je+1
422  ddiv(ks,is,j) = j33g * ( momz(ks,is,j) ) * rcdz(ks) &
423  + ( ( momy(ks+1,is,j) + momy(ks+1,is,j-1) ) * j23g(ks+1,is,j,i_xyw) &
424  - ( momy(ks ,is,j) + momy(ks ,is,j-1) ) * j23g(ks ,is,j,i_xyw) ) * rfdz(ks) &
425  + mapf(is,j,2,i_xy) &
426  * ( momy(ks,is,j ) * gsqrt(ks,is,j ,i_xvz) / mapf(is,j ,1,i_xv) &
427  - momy(ks,is,j-1) * gsqrt(ks,is,j-1,i_xvz) / mapf(is,j-1,1,i_xv) ) * rcdy(j)
428  ddiv(ke,is,j) = j33g * ( - momz(ke-1,is,j ) ) * rcdz(ke) &
429  + ( ( momy(ke ,is,j) + momy(ke ,is,j-1) ) * j23g(ke ,is,j,i_xyw) &
430  - ( momy(ke-1,is,j) + momy(ke-1,is,j-1) ) * j23g(ke-1,is,j,i_xyw) ) * rfdz(ke) &
431  + mapf(is,j,2,i_xy) &
432  * ( momy(ke,is,j ) * gsqrt(ke,is,j ,i_xvz) / mapf(is,j ,1,i_xv) &
433  - momy(ke,is,j-1) * gsqrt(ke,is,j-1,i_xvz) / mapf(is,j-1,1,i_xv) ) * rcdy(j)
434  enddo
435 #ifdef DEBUG
436  k = iundef; i = iundef; j = iundef
437 #endif
438  else
439  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
440  do j = js, je+1
441  do i = is, ie+1
442  do k = ks-1, ke+1
443  ddiv(k,i,j) = j33g * ( momz(k,i,j) - momz(k-1,i ,j ) ) * rcdz(k) &
444  + ( ( momx(k+1,i,j) + momx(k+1,i-1,j ) ) * j13g(k+1,i,j,i_xyw) &
445  - ( momx(k-1,i,j) + momx(k-1,i-1,j ) ) * j13g(k-1,i,j,i_xyw) &
446  + ( momy(k+1,i,j) + momy(k+1,i ,j-1) ) * j23g(k+1,i,j,i_xyw) &
447  - ( momy(k-1,i,j) + momy(k-1,i ,j-1) ) * j23g(k-1,i,j,i_xyw) ) / ( fdz(k)+fdz(k-1) ) &
448  + mapf(i,j,1,i_xy) * mapf(i,j,2,i_xy) &
449  * ( ( momx(k,i ,j ) * gsqrt(k,i ,j ,i_uyz) / mapf(i ,j ,2,i_uy) &
450  - momx(k,i-1,j ) * gsqrt(k,i-1,j ,i_uyz) / mapf(i-1,j ,2,i_uy) ) * rcdx(i) &
451  + ( momy(k,i ,j ) * gsqrt(k,i ,j ,i_xvz) / mapf(i ,j ,1,i_xv) &
452  - momy(k,i, j-1) * gsqrt(k,i ,j-1,i_xvz) / mapf(i ,j-1,1,i_xv) ) * rcdy(j) )
453  enddo
454  enddo
455  enddo
456 #ifdef DEBUG
457  k = iundef; i = iundef; j = iundef
458 #endif
459  !$omp parallel do private(i,j) OMP_SCHEDULE_ collapse(2)
460  do j = js, je+1
461  do i = is, ie+1
462  ddiv(ks,i,j) = j33g * ( momz(ks,i,j) ) * rcdz(ks) &
463  + ( ( momx(ks+1,i,j) + momx(ks+1,i-1,j ) ) * j13g(ks+1,i,j,i_xyw) &
464  - ( momx(ks-1,i,j) + momx(ks ,i-1,j ) ) * j13g(ks ,i,j,i_xyw) &
465  + ( momy(ks+1,i,j) + momy(ks+1,i ,j-1) ) * j23g(ks+1,i,j,i_xyw) &
466  - ( momy(ks ,i,j) + momy(ks ,i ,j-1) ) * j23g(ks ,i,j,i_xyw) ) * rfdz(ks) &
467  + mapf(i,j,1,i_xy) * mapf(i,j,2,i_xy) &
468  * ( ( momx(ks,i ,j ) * gsqrt(ks,i ,j ,i_uyz) / mapf(i ,j ,2,i_uy) &
469  - momx(ks,i-1,j ) * gsqrt(ks,i-1,j ,i_uyz) / mapf(i-1,j ,2,i_uy) ) * rcdx(i) &
470  + ( momy(ks,i ,j ) * gsqrt(ks,i ,j ,i_xvz) / mapf(i ,j ,1,i_xv) &
471  - momy(ks,i, j-1) * gsqrt(ks,i ,j-1,i_xvz) / mapf(i ,j-1,1,i_xv) ) * rcdy(j) )
472  ddiv(ke,i,j) = j33g * ( - momz(ke-1,i ,j ) ) * rcdz(ke) &
473  + ( ( momx(ke ,i,j) + momx(ke ,i-1,j ) ) * j13g(ke ,i,j,i_xyw) &
474  - ( momx(ke-1,i,j) + momx(ke-1,i-1,j ) ) * j13g(ke-1,i,j,i_xyw) &
475  + ( momy(ke ,i,j) + momy(ke ,i ,j-1) ) * j23g(ke ,i,j,i_xyw) &
476  - ( momy(ke-1,i,j) + momy(ke-1,i ,j-1) ) * j23g(ke-1,i,j,i_xyw) ) * rfdz(ke) &
477  + mapf(i,j,1,i_xy) * mapf(i,j,2,i_xy) &
478  * ( ( momx(ke,i ,j ) * gsqrt(ke,i ,j ,i_uyz) / mapf(i ,j ,2,i_uy) &
479  - momx(ke,i-1,j ) * gsqrt(ke,i-1,j ,i_uyz) / mapf(i-1,j ,2,i_uy) ) * rcdx(i) &
480  + ( momy(ke,i ,j ) * gsqrt(ke,i ,j ,i_xvz) / mapf(i ,j ,1,i_xv) &
481  - momy(ke,i, j-1) * gsqrt(ke,i ,j-1,i_xvz) / mapf(i ,j-1,1,i_xv) ) * rcdy(j) )
482  enddo
483  enddo
484 #ifdef DEBUG
485  k = iundef; i = iundef; j = iundef
486 #endif
487  end if
488  call prof_rapend ("DYN_divercence", 2)
489 
490  return

References scale_atmos_grid_cartesc_index::i_uy, scale_atmos_grid_cartesc_index::i_uyz, scale_atmos_grid_cartesc_index::i_xv, scale_atmos_grid_cartesc_index::i_xvz, scale_atmos_grid_cartesc_index::i_xy, scale_atmos_grid_cartesc_index::i_xyw, scale_atmos_grid_cartesc_index::ie, scale_atmos_grid_cartesc_index::is, scale_atmos_grid_cartesc_index::je, scale_atmos_grid_cartesc_index::js, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, scale_atmos_grid_cartesc_index::ks, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Referenced by scale_atmos_dyn_tstep_large_fvm_heve::atmos_dyn_tstep_large_fvm_heve().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_dyn_prep_pres_linearization()

subroutine, public scale_atmos_dyn_common::atmos_dyn_prep_pres_linearization ( real(rp), dimension(ka,ia,ja), intent(out)  DPRES,
real(rp), dimension(ka,ia,ja), intent(out)  RT2P,
real(rp), dimension(ka,ia,ja), intent(out)  REF_rhot,
real(rp), dimension(ka,ia,ja), intent(in)  RHOT,
real(rp), dimension(ka,ia,ja,qa), intent(in)  QTRC,
real(rp), dimension(ka,ia,ja), intent(in)  REF_pres,
real(rp), dimension(qa), intent(in)  AQ_R,
real(rp), dimension(qa), intent(in)  AQ_CV,
real(rp), dimension(qa), intent(in)  AQ_CP,
real(rp), dimension(qa), intent(in)  AQ_MASS 
)

Definition at line 510 of file scale_atmos_dyn_common.F90.

510 
511  use scale_const, only: &
512  p0 => const_pre00, &
513  rdry => const_rdry, &
514  cvdry => const_cvdry, &
515  cpdry => const_cpdry
516  implicit none
517 
518  real(RP), intent(out) :: DPRES(KA,IA,JA)
519  real(RP), intent(out) :: RT2P(KA,IA,JA)
520  real(RP), intent(out) :: REF_rhot(KA,IA,JA)
521  real(RP), intent(in) :: RHOT(KA,IA,JA)
522  real(RP), intent(in) :: QTRC(KA,IA,JA,QA)
523  real(RP), intent(in) :: REF_pres(KA,IA,JA)
524  real(RP), intent(in) :: AQ_R(QA)
525  real(RP), intent(in) :: AQ_CV(QA)
526  real(RP), intent(in) :: AQ_CP(QA)
527  real(RP), intent(in) :: AQ_MASS(QA)
528 
529  integer :: i, j, k
530  integer :: iq
531  real(RP) :: QDRY ! dry air
532  real(RP) :: Rtot ! total R
533  real(RP) :: CVtot ! total CV
534  real(RP) :: CPtot ! total CP
535  real(RP) :: PRES ! pressure
536 
537 #ifdef DRY
538  real(RP) :: CPovCV
539 #endif
540 
541  !--------------------------------------
542 
543 #ifdef DRY
544  cpovcv = cpdry / cvdry
545 #endif
546 
547 !OCL XFILL
548  !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
549  !$omp shared(JA,IA,KS,KE) &
550  !$omp shared(P0,Rdry,RHOT,AQ_R,AQ_CV,AQ_CP,QTRC,AQ_MASS,REF_rhot,REF_pres,CPdry,CVdry,QA,RT2P,DPRES) &
551 #ifdef DRY
552  !$omp shared(CPovCV) &
553 #endif
554  !$omp private(i,j,k,iq) &
555  !$omp private(PRES,Rtot,CVtot,CPtot,QDRY)
556  do j = 1, ja
557  do i = 1, ia
558  do k = ks, ke
559 #ifdef DRY
560  pres = p0 * ( rdry * rhot(k,i,j) / p0 )**cpovcv
561  rt2p(k,i,j) = cpovcv * pres / rhot(k,i,j)
562 #else
563  rtot = 0.0_rp
564  cvtot = 0.0_rp
565  cptot = 0.0_rp
566  qdry = 1.0_rp
567  do iq = 1, qa
568  rtot = rtot + aq_r(iq) * qtrc(k,i,j,iq)
569  cvtot = cvtot + aq_cv(iq) * qtrc(k,i,j,iq)
570  cptot = cptot + aq_cp(iq) * qtrc(k,i,j,iq)
571  qdry = qdry - qtrc(k,i,j,iq) * aq_mass(iq)
572  enddo
573  rtot = rtot + rdry * qdry
574  cvtot = cvtot + cvdry * qdry
575  cptot = cptot + cpdry * qdry
576  pres = p0 * ( rtot * rhot(k,i,j) / p0 )**( cptot / cvtot )
577  rt2p(k,i,j) = cptot / cvtot * pres / rhot(k,i,j)
578 #endif
579  dpres(k,i,j) = pres - ref_pres(k,i,j)
580  ref_rhot(k,i,j) = rhot(k,i,j)
581  end do
582  dpres(ks-1,i,j) = dpres(ks+1,i,j) + ( ref_pres(ks+1,i,j) - ref_pres(ks-1,i,j) )
583  dpres(ke+1,i,j) = dpres(ke-1,i,j) + ( ref_pres(ke-1,i,j) - ref_pres(ke+1,i,j) )
584  end do
585  end do
586 
587  return

References scale_const::const_cpdry, scale_const::const_cvdry, scale_const::const_pre00, scale_const::const_rdry, scale_atmos_grid_cartesc_index::ia, scale_atmos_grid_cartesc_index::ja, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, scale_atmos_grid_cartesc_index::ks, and scale_tracer::qa.

Referenced by scale_atmos_dyn_tstep_large_fvm_heve::atmos_dyn_tstep_large_fvm_heve().

Here is the caller graph for this function:
scale_const::const_eps
real(rp), public const_eps
small number
Definition: scale_const.F90:33
scale_const::const_pi
real(rp), public const_pi
pi
Definition: scale_const.F90:31
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_const::const_cvdry
real(rp), public const_cvdry
specific heat (dry air,constant volume) [J/kg/K]
Definition: scale_const.F90:57
scale_const::const_cpdry
real(rp), public const_cpdry
specific heat (dry air,constant pressure) [J/kg/K]
Definition: scale_const.F90:56
scale_const::const_rdry
real(rp), public const_rdry
specific gas constant (dry air) [J/kg/K]
Definition: scale_const.F90:55
scale_const::const_pre00
real(rp), public const_pre00
pressure reference [Pa]
Definition: scale_const.F90:88
scale_atmos_grid_cartesc_index::i_xyw
integer, public i_xyw
Definition: scale_atmos_grid_cartesC_index.F90:91