FE-Project
Loading...
Searching...
No Matches
scale_timeint_rk.F90
Go to the documentation of this file.
1!-------------------------------------------------------------------------------
2! Warning: This file was generated from common/scale_timeint_rk.F90.erb.
3! Do not edit this file.
4!-------------------------------------------------------------------------------
5!-------------------------------------------------------------------------------
6!> Module common / Runge-Kutta scheme
7!!
8!! @par Description
9!! Driver module to provide various Runge-Kutta schemes.
10!!
11!! @author Yuta Kawai, Team SCALE
12!<
13#include "scaleFElib.h"
15 !-----------------------------------------------------------------------------
16 !
17 !++ Used modules
18 !
19 use scale_precision
20 use scale_io
21 use scale_prc
22 use scale_prof
23 use scale_prc
24
25 !-----------------------------------------------------------------------------
26 implicit none
27 private
28
29 !-----------------------------------------------------------------------------
30 !
31 !++ Public type, procedures
32 !
33
34 !> Derived type to provide RK scheme
35 type, public :: timeint_rk
36 real(RP), private :: dt !< Timestep
37
38 integer, private :: rk_scheme_id_ex !< ID of explicit RK scheme
39 integer, private :: rk_scheme_id_im !< ID of implicit RK scheme
40
41 integer, private, allocatable :: size_each_var(:) !< Dimension information for each variable
42 integer, public :: nstage !< Number of stage in RK scheme
43 integer, public :: tend_buf_size !< Buffer size to store tendencies
44
45 ! For Butcher representation (explicit part)
46 real(rp), public, allocatable :: coef_a_ex(:,:) !< Coefficients A in the Butcher table (explicit part)
47 real(rp), public, allocatable :: coef_b_ex(:) !< Coefficients b in the Butcher table (explicit part)
48 real(rp), public, allocatable :: coef_c_ex(:) !< Coefficients c in the Butcher table (explicit part)
49
50 ! For Shu-Osher representation (explicit part)
51 real(rp), public, allocatable :: coef_sig_ex(:,:)
52 real(rp), public, allocatable :: coef_gam_ex(:,:)
53
54 ! For Butcher representation (implicit part)
55 real(rp), public, allocatable :: coef_a_im(:,:) !< Coefficients A in the Butcher table (implicit part)
56 real(rp), public, allocatable :: coef_b_im(:) !< Coefficients b in the Butcher table (implicit part)
57 real(rp), public, allocatable :: coef_c_im(:) !< Coefficients c in the Butcher table (implicit part)
58
59 integer, allocatable :: tend_buf_indmap(:)
60 integer :: var_num
61 real(rp), public, allocatable :: var_buf1d_ex(:,:,:)
62 real(rp), public, allocatable :: tend_buf1d_ex(:,:,:)
63 real(rp), public, allocatable :: tend_buf1d_im(:,:,:)
64 real(rp), public, allocatable :: var0_1d(:,:)
65 real(rp), private, allocatable :: vartmp_1d(:,:)
66 real(rp), public, allocatable :: var_buf2d_ex(:,:,:,:)
67 real(rp), public, allocatable :: tend_buf2d_ex(:,:,:,:)
68 real(rp), public, allocatable :: tend_buf2d_im(:,:,:,:)
69 real(rp), public, allocatable :: var0_2d(:,:,:)
70 real(rp), private, allocatable :: vartmp_2d(:,:,:)
71 real(rp), public, allocatable :: var_buf3d_ex(:,:,:,:,:)
72 real(rp), public, allocatable :: tend_buf3d_ex(:,:,:,:,:)
73 real(rp), public, allocatable :: tend_buf3d_im(:,:,:,:,:)
74 real(rp), public, allocatable :: var0_3d(:,:,:,:)
75 real(rp), private, allocatable :: vartmp_3d(:,:,:,:)
76
77 logical, private :: low_storage_flag
78 logical, public :: imex_flag
79 integer, public :: ndim
80 contains
81 procedure, public :: init => timeint_rk_init
82 procedure, public :: final => timeint_rk_final
83 procedure, public :: get_implicit_diagfac => timeint_rk_get_implicit_diagfac
84 procedure, public :: get_deltime => timeint_rk_get_deltime
85 procedure, public :: advance1d => timeint_rk_advance1d
86 procedure, public :: advance1d_varlist => timeint_rk_advance1d_varlist
87 procedure, public :: advance_trcvar_1d => timeint_rk_advance_trcvar1d
88 procedure, public :: storevar0_1d => timeint_rk_store_var0_1d
89 procedure, public :: storeimplicit1d => timeint_rk_storeimpl1d
90 procedure, public :: advance2d => timeint_rk_advance2d
91 procedure, public :: advance2d_varlist => timeint_rk_advance2d_varlist
92 procedure, public :: advance_trcvar_2d => timeint_rk_advance_trcvar2d
93 procedure, public :: storevar0_2d => timeint_rk_store_var0_2d
94 procedure, public :: storeimplicit2d => timeint_rk_storeimpl2d
95 procedure, public :: advance3d => timeint_rk_advance3d
96 procedure, public :: advance3d_varlist => timeint_rk_advance3d_varlist
97 procedure, public :: advance_trcvar_3d => timeint_rk_advance_trcvar3d
98 procedure, public :: storevar0_3d => timeint_rk_store_var0_3d
99 procedure, public :: storeimplicit3d => timeint_rk_storeimpl3d
100 generic, public :: advance => advance1d, advance2d, advance3d
101 generic, public :: advance_varlist => advance1d_varlist, advance2d_varlist, advance3d_varlist
102 generic, public :: advance_trcvar => advance_trcvar_1d, advance_trcvar_2d, advance_trcvar_3d
103 generic, public :: storevar0 => storevar0_1d, storevar0_2d, storevar0_3d
104 generic, public :: storeimplicit => storeimplicit1d, storeimplicit2d, storeimplicit3d
105 end type timeint_rk
106
107 !> Derived type to store pointer to variable data when using varlist in RK advance procedures
108 type, public :: timeint_rk_var
109 real(rp), pointer :: var1d(:)
110 real(rp), pointer :: var2d(:,:)
111 real(rp), pointer :: var3d(:,:,:)
112 end type timeint_rk_var
113
114 !-----------------------------------------------------------------------------
115 !
116 !++ Public parameters & variables
117 !
118 !-----------------------------------------------------------------------------
119 !
120 !++ Private procedures
121 !
122 !-------------------
123
124contains
125
126!----------------
127
128!> Initialize a object to provide RK scheme
129!!
130!! @param rk_scheme_name Name of RK scheme
131!! @param dt Timestep
132!! @param ndim Number of spatial Dimension
133!! @param var_num Number of variables
134!! @param size_each_var Array to store size of each dimension
135 subroutine timeint_rk_init( this, &
136 rk_scheme_name, dt, var_num, ndim, size_each_var )
137
141 implicit none
142 class(timeint_rk), intent(inout) :: this
143 character(*), intent(in) :: rk_scheme_name
144 real(RP), intent(in) :: dt
145 integer, intent(in) :: var_num
146 integer, intent(in) :: ndim
147 integer, intent(in) :: size_each_var(ndim)
148 !----------------------------------------
149
150 !$acc enter data create(this)
151
152 this%dt = dt
153 this%ndim = ndim
154 this%var_num = var_num
155 allocate( this%size_each_var(ndim) )
156 this%size_each_var(:) = size_each_var(:)
157 !$acc enter data copyin( this%size_each_var )
158 !$acc enter data attach( this%size_each_var )
159
160 call timeint_rk_butcher_tab_get_info( rk_scheme_name, & ! (in)
161 this%nstage, this%tend_buf_size, & ! (out)
162 this%low_storage_flag, this%imex_flag ) ! (out)
163
164 allocate ( this%coef_a_ex(this%nstage,this%nstage), this%coef_b_ex(this%nstage), this%coef_c_ex(this%nstage) )
165 allocate ( this%coef_sig_ex(this%nstage+1,this%nstage), this%coef_gam_ex(this%nstage+1,this%nstage) )
166! if (this%imex_flag) then
167 allocate ( this%coef_a_im(this%nstage,this%nstage), this%coef_b_im(this%nstage), this%coef_c_im(this%nstage) )
168! end if
169
170 select case(this%ndim)
171 case(1)
172 allocate( this%tend_buf1D_ex(size_each_var(1), var_num, this%tend_buf_size) )
173 !$acc enter data create( this%tend_buf1D_ex )
174 if ( this%imex_flag ) then
175 allocate( this%tend_buf1D_im(size_each_var(1), var_num, this%tend_buf_size) )
176 else
177 allocate( this%tend_buf1D_im(1,1,1) ) ! dummy allocation to avoid error in the case of non-IMEX scheme
178 end if
179 !$acc enter data create( this%tend_buf1D_im )
180 allocate( this%var0_1D(size_each_var(1), var_num) )
181 allocate( this%varTmp_1D(size_each_var(1), var_num) )
182 !$acc enter data create( this%var0_1D, this%varTmp_1D )
183 case(2)
184 allocate( this%tend_buf2D_ex(size_each_var(1),size_each_var(2), var_num, this%tend_buf_size) )
185 !$acc enter data create( this%tend_buf2D_ex )
186 if ( this%imex_flag ) then
187 allocate( this%tend_buf2D_im(size_each_var(1),size_each_var(2), var_num, this%tend_buf_size) )
188 else
189 allocate( this%tend_buf2D_im(1,1,1,1) ) ! dummy allocation to avoid error in the case of non-IMEX scheme
190 end if
191 !$acc enter data create( this%tend_buf2D_im )
192 allocate( this%var0_2D(size_each_var(1),size_each_var(2), var_num) )
193 allocate( this%varTmp_2D(size_each_var(1),size_each_var(2), var_num) )
194 !$acc enter data create( this%var0_2D, this%varTmp_2D )
195 case(3)
196 allocate( this%tend_buf3D_ex(size_each_var(1),size_each_var(2),size_each_var(3), var_num, this%tend_buf_size) )
197 !$acc enter data create( this%tend_buf3D_ex )
198 if ( this%imex_flag ) then
199 allocate( this%tend_buf3D_im(size_each_var(1),size_each_var(2),size_each_var(3), var_num, this%tend_buf_size) )
200 else
201 allocate( this%tend_buf3D_im(1,1,1,1,1) ) ! dummy allocation to avoid error in the case of non-IMEX scheme
202 end if
203 !$acc enter data create( this%tend_buf3D_im )
204 allocate( this%var0_3D(size_each_var(1),size_each_var(2),size_each_var(3), var_num) )
205 allocate( this%varTmp_3D(size_each_var(1),size_each_var(2),size_each_var(3), var_num) )
206 !$acc enter data create( this%var0_3D, this%varTmp_3D )
207 end select
208 allocate( this%tend_buf_indmap(this%nstage) )
209
211 rk_scheme_name, this%nstage, this%imex_flag, & ! (in)
212 this%coef_a_ex, this%coef_b_ex, this%coef_c_ex, & ! (out)
213 this%coef_sig_ex, this%coef_gam_ex, & ! (out)
214 this%coef_a_im, this%coef_b_im, this%coef_c_im, & ! (out)
215 this%tend_buf_indmap ) ! (out)
216
217 !$acc enter data copyin( this%coef_a_ex, this%coef_b_ex, this%coef_c_ex, &
218 !$acc this%coef_sig_ex, this%coef_gam_ex, &
219 !$acc this%coef_a_im, this%coef_b_im, this%coef_c_im, &
220 !$acc this%tend_buf_indmap )
221
222 !$acc enter data attach( this%coef_a_ex, this%coef_b_ex, this%coef_c_ex, &
223 !$acc this%coef_sig_ex, this%coef_gam_ex, &
224 !$acc this%coef_a_im, this%coef_b_im, this%coef_c_im, &
225 !$acc this%tend_buf_indmap )
226
227 !$acc update device( this%dt, this%rk_scheme_id_ex, this%rk_scheme_id_im, this%nstage, this%tend_buf_size, this%var_num, this%low_storage_flag, this%imex_flag, this%ndim )
228 return
229 end subroutine timeint_rk_init
230
231!> Finalize a object to provide RK scheme
232!!
233 subroutine timeint_rk_final( this )
234 implicit none
235 class(timeint_rk), intent(inout) :: this
236 !----------------------------------------
237
238 !$acc exit data delete( this%coef_a_ex, this%coef_b_ex, this%coef_c_ex, &
239 !$acc this%coef_sig_ex, this%coef_gam_ex )
240 deallocate( this%coef_a_ex, this%coef_b_ex, this%coef_c_ex )
241 deallocate( this%coef_sig_ex, this%coef_gam_ex )
242
243! if (this%imex_flag) then
244 !$acc exit data delete( this%coef_a_im, this%coef_b_im, this%coef_c_im )
245 deallocate( this%coef_a_im, this%coef_b_im, this%coef_c_im )
246! end if
247
248 !$acc exit data delete( this%size_each_var, this%tend_buf_indmap )
249 deallocate( this%size_each_var, this%tend_buf_indmap )
250
251 select case(this%ndim)
252 case(1)
253 !$acc exit data delete( this%var0_1d, this%tend_buf1D_ex )
254 deallocate( this%var0_1d )
255 deallocate( this%tend_buf1D_ex )
256! if (this%imex_flag) then
257 !$acc exit data delete( this%tend_buf1D_im )
258 deallocate( this%tend_buf1D_im )
259! end if
260 !$acc exit data delete( this%varTmp_1d )
261 deallocate( this%varTmp_1d )
262 case(2)
263 !$acc exit data delete( this%var0_2d, this%tend_buf2D_ex )
264 deallocate( this%var0_2d )
265 deallocate( this%tend_buf2D_ex )
266! if (this%imex_flag) then
267 !$acc exit data delete( this%tend_buf2D_im )
268 deallocate( this%tend_buf2D_im )
269! end if
270 !$acc exit data delete( this%varTmp_2d )
271 deallocate( this%varTmp_2d )
272 case(3)
273 !$acc exit data delete( this%var0_3d, this%tend_buf3D_ex )
274 deallocate( this%var0_3d )
275 deallocate( this%tend_buf3D_ex )
276! if (this%imex_flag) then
277 !$acc exit data delete( this%tend_buf3D_im )
278 deallocate( this%tend_buf3D_im )
279! end if
280 !$acc exit data delete( this%varTmp_3d )
281 deallocate( this%varTmp_3d )
282 end select
283
284 !$acc exit data delete(this)
285 return
286 end subroutine timeint_rk_final
287
288!> Get timestep
289!!
290 elemental function timeint_rk_get_deltime( this ) result(dt)
291 implicit none
292 class(timeint_rk), intent(in) :: this
293 real(RP) :: dt
294 !-----------------------------------------------------
295
296 dt = this%dt
297
298 return
299 end function timeint_rk_get_deltime
300
301!> Get a diagonal component of coefficient matrix at a stage for implicit RK scheme
302!!
303!! @param nowstage Current stage
304 elemental function timeint_rk_get_implicit_diagfac( this, nowstage ) result(fac)
305 implicit none
306 class(timeint_rk), intent(in) :: this
307 integer, intent(in) :: nowstage
308 real(RP) :: fac
309 !-----------------------------------------------------
310
311 fac = this%coef_a_im(nowstage,nowstage) * this%dt
312
313 return
314 end function timeint_rk_get_implicit_diagfac
315 !----------------
316
317
318!> Advance a variable at the current stage with explicit RK part
319!!
320!! @param nowstage Current stage
321!! @param q Array to store variable data
322!! @param varID Index of the targeting variable
323!! @param is Index at which begins the loop for the corresponding direction
324!! @param ie Index at which finishes the loop for the corresponding direction
325 subroutine timeint_rk_advance1d( this, nowstage, q, varID, is, ie )
326 implicit none
327 class(timeint_rk), intent(inout) :: this
328 integer, intent(in) :: nowstage
329 real(RP), intent(inout) :: q(:)
330 integer, intent(in) :: varID
331 integer, intent(in) :: is, ie
332 !----------------------------------------
333
334 if (this%low_storage_flag) then
335 call prof_rapstart( 'rk_advance_low_storage1D', 3)
336 call rk_advance_low_storage1d( this, nowstage, q, varid, is, ie , this%size_each_var(1), this%var_num, &
337 this%var0_1D, this%varTmp_1d, this%tend_buf1D_ex )
338 call prof_rapend( 'rk_advance_low_storage1D', 3)
339 else
340 if ( this%imex_flag ) then
341 call rk_advance_general1d( this, nowstage, q, varid, is, ie , this%size_each_var(1), this%var_num, &
342 this%var0_1D, this%varTmp_1d, this%tend_buf1D_ex, this%tend_buf1D_im )
343 else
344 call rk_advance_general1d( this, nowstage, q, varid, is, ie , this%size_each_var(1), this%var_num, &
345 this%var0_1D, this%varTmp_1d, this%tend_buf1D_ex )
346 end if
347 end if
348
349 return
350 end subroutine timeint_rk_advance1d
351
352!> Advance variables at the current stage with explicit RK part
353!!
354!! @param nowstage Current stage
355!! @param var_list Array of timeint_rk_var object which saves pointer to variable data
356!! @param varIDs Indices of the targeting variables
357!! @param is Index at which begins the loop for the corresponding direction
358!! @param ie Index at which finishes the loop for the corresponding direction
359!OCL SERIAL
360 subroutine timeint_rk_advance1d_varlist( this, nowstage, var_list, varIDs, is, ie )
361 implicit none
362 class(timeint_rk), intent(inout) :: this
363 integer, intent(in) :: nowstage
364 integer, intent(in) :: varIDs(:)
365 type(timeint_rk_var), intent(inout) :: var_list(size(varIDs))
366 integer, intent(in) :: is, ie
367
368 integer :: i
369 integer :: n
370 !----------------------------------------
371
372 n = size(varids)
373
374 if (this%low_storage_flag) then
375 call prof_rapstart( 'rk_advance_varlist_low_storage1D', 3)
376 i = 1
377 do while(i <= n)
378 if ( i+1 <= n ) then
379 call rk_advance_low_storage1d_var2( this, nowstage, var_list(i)%var1D, var_list(i+1)%var1D, varids(i), varids(i+1), is, ie , this%size_each_var(1), this%var_num, &
380 this%var0_1D, this%varTmp_1d, this%tend_buf1D_ex )
381 i = i + 2
382 else
383 call rk_advance_low_storage1d( this, nowstage, var_list(n)%var1D, varids(n), is, ie , this%size_each_var(1), this%var_num, &
384 this%var0_1D, this%varTmp_1d, this%tend_buf1D_ex )
385 i = i + 1
386 end if
387 end do
388 !$acc wait(1)
389 call prof_rapend( 'rk_advance_varlist_low_storage1D', 3)
390 else
391 do i=1, n
392 call this%Advance1D( nowstage, var_list(i)%var1D, varids(i), is, ie )
393 end do
394 end if
395
396 return
397 end subroutine timeint_rk_advance1d_varlist
398
399!> Advance tracer variable data at the current stage with explicit RK part
400!!
401!! @param nowstage Current stage
402!! @param q Array to store tracer variable data
403!! @param varID Index of the targeting variable
404!! @param is Index at which begins the loop for the corresponding direction
405!! @param ie Index at which finishes the loop for the corresponding direction
406!! @param DDENS Array to store density perturbation data at the time level n+1
407!! @param DDENS0 Array to store density perturbation data at the time level n
408!! @param DENS_hyd Array to hydrostatic part of density
409 subroutine timeint_rk_advance_trcvar1d( this, nowstage, q, varID, is, ie , &
410 DDENS, DDENS0, DENS_hyd )
411 implicit none
412 class(timeint_rk), intent(inout) :: this
413 integer, intent(in) :: nowstage
414 real(RP), intent(inout) :: q(:)
415 integer, intent(in) :: varID
416 integer, intent(in) :: is, ie
417 real(RP), intent(in) :: DDENS (:)
418 real(RP), intent(in) :: DDENS0(:)
419 real(RP), intent(in) :: DENS_hyd(:)
420 !----------------------------------------
421
422 if ( this%imex_flag ) then
423 if ( prc_ismaster ) write(*,*) "timeint_rk_advence_trcvar: IMEX is not supported. Check!"
424 call prc_abort
425 end if
426
427 if (this%low_storage_flag) then
428 call rk_advance_trcvar_low_storage1d( this, nowstage, q, varid, is, ie , this%size_each_var(1), this%var_num, &
429 ddens, ddens0, dens_hyd, this%var0_1D, this%varTmp_1d, this%tend_buf1D_ex )
430 else
431 call rk_advance_trcvar_general1d( this, nowstage, q, varid, is, ie , this%size_each_var(1), this%var_num, &
432 ddens, ddens0, dens_hyd, this%var0_1D, this%varTmp_1d, this%tend_buf1D_ex )
433 end if
434
435 return
436 end subroutine timeint_rk_advance_trcvar1d
437
438!> Store variable data at the time level n for the case of IMEX RK scheme
439!!
440!! @param q Array to store variable data at the time level n
441!! @param varID Index of the targeting variable
442!! @param is Index at which begins the loop for the corresponding direction
443!! @param ie Index at which finishes the loop for the corresponding direction
444 subroutine timeint_rk_store_var0_1d( this, q, varID, is, ie )
445 implicit none
446 class(timeint_rk), intent(inout) :: this
447 real(RP), intent(inout) :: q(:)
448 integer, intent(in) :: varID
449 integer, intent(in) :: is, ie
450
451 integer :: i
452 !----------------------------------------
453
454 !$omp parallel private(i)
455 !$acc parallel present( q, this%var0_1D )
456 !$omp do
457 !$acc loop
458 do i=is, ie
459 this%var0_1D(i,varid) = q(i)
460 end do
461 !$acc end parallel
462 !$omp end parallel
463
464 return
465 end subroutine timeint_rk_store_var0_1d
466
467!> Store variable data after the implicit part of current stage in IMEX RK scheme
468!!
469!! @param nowstage Current stage
470!! @param q Array to store variable data after the implicit part of current stage
471!! @param varID Index of the targeting variable
472!! @param is Index at which begins the loop for the corresponding direction
473!! @param ie Index at which finishes the loop for the corresponding direction
474 subroutine timeint_rk_storeimpl1d( this, nowstage, q, varID, is, ie )
475 implicit none
476 class(timeint_rk), intent(inout) :: this
477 integer, intent(in) :: nowstage
478 real(RP), intent(inout) :: q(:)
479 integer, intent(in) :: varID
480 integer, intent(in) :: is, ie
481
482 !----------------------------------------
483
484 call rk_storeimpl_general1d( this, nowstage, q, varid, is, ie , this%size_each_var(1), this%var_num, &
485 this%var0_1D, this%varTmp_1d, this%tend_buf1D_im )
486
487 return
488 end subroutine timeint_rk_storeimpl1d
489
490!> Advance a variable at the current stage with explicit RK part
491!!
492!! @param nowstage Current stage
493!! @param q Array to store variable data
494!! @param varID Index of the targeting variable
495!! @param is Index at which begins the loop for the corresponding direction
496!! @param ie Index at which finishes the loop for the corresponding direction
497!! @param js Index at which begins the loop for the corresponding direction
498!! @param je Index at which finishes the loop for the corresponding direction
499 subroutine timeint_rk_advance2d( this, nowstage, q, varID, is, ie ,js, je )
500 implicit none
501 class(timeint_rk), intent(inout) :: this
502 integer, intent(in) :: nowstage
503 real(RP), intent(inout) :: q(:,:)
504 integer, intent(in) :: varID
505 integer, intent(in) :: is, ie ,js, je
506 !----------------------------------------
507
508 if (this%low_storage_flag) then
509 call prof_rapstart( 'rk_advance_low_storage2D', 3)
510 call rk_advance_low_storage2d( this, nowstage, q, varid, is, ie ,js, je , this%size_each_var(1),this%size_each_var(2), this%var_num, &
511 this%var0_2D, this%varTmp_2d, this%tend_buf2D_ex )
512 call prof_rapend( 'rk_advance_low_storage2D', 3)
513 else
514 if ( this%imex_flag ) then
515 call rk_advance_general2d( this, nowstage, q, varid, is, ie ,js, je , this%size_each_var(1),this%size_each_var(2), this%var_num, &
516 this%var0_2D, this%varTmp_2d, this%tend_buf2D_ex, this%tend_buf2D_im )
517 else
518 call rk_advance_general2d( this, nowstage, q, varid, is, ie ,js, je , this%size_each_var(1),this%size_each_var(2), this%var_num, &
519 this%var0_2D, this%varTmp_2d, this%tend_buf2D_ex )
520 end if
521 end if
522
523 return
524 end subroutine timeint_rk_advance2d
525
526!> Advance variables at the current stage with explicit RK part
527!!
528!! @param nowstage Current stage
529!! @param var_list Array of timeint_rk_var object which saves pointer to variable data
530!! @param varIDs Indices of the targeting variables
531!! @param is Index at which begins the loop for the corresponding direction
532!! @param ie Index at which finishes the loop for the corresponding direction
533!! @param js Index at which begins the loop for the corresponding direction
534!! @param je Index at which finishes the loop for the corresponding direction
535!OCL SERIAL
536 subroutine timeint_rk_advance2d_varlist( this, nowstage, var_list, varIDs, is, ie ,js, je )
537 implicit none
538 class(timeint_rk), intent(inout) :: this
539 integer, intent(in) :: nowstage
540 integer, intent(in) :: varIDs(:)
541 type(timeint_rk_var), intent(inout) :: var_list(size(varIDs))
542 integer, intent(in) :: is, ie ,js, je
543
544 integer :: i
545 integer :: n
546 !----------------------------------------
547
548 n = size(varids)
549
550 if (this%low_storage_flag) then
551 call prof_rapstart( 'rk_advance_varlist_low_storage2D', 3)
552 i = 1
553 do while(i <= n)
554 if ( i+1 <= n ) then
555 call rk_advance_low_storage2d_var2( this, nowstage, var_list(i)%var2D, var_list(i+1)%var2D, varids(i), varids(i+1), is, ie ,js, je , this%size_each_var(1),this%size_each_var(2), this%var_num, &
556 this%var0_2D, this%varTmp_2d, this%tend_buf2D_ex )
557 i = i + 2
558 else
559 call rk_advance_low_storage2d( this, nowstage, var_list(n)%var2D, varids(n), is, ie ,js, je , this%size_each_var(1),this%size_each_var(2), this%var_num, &
560 this%var0_2D, this%varTmp_2d, this%tend_buf2D_ex )
561 i = i + 1
562 end if
563 end do
564 !$acc wait(1)
565 call prof_rapend( 'rk_advance_varlist_low_storage2D', 3)
566 else
567 do i=1, n
568 call this%Advance2D( nowstage, var_list(i)%var2D, varids(i), is, ie ,js, je )
569 end do
570 end if
571
572 return
573 end subroutine timeint_rk_advance2d_varlist
574
575!> Advance tracer variable data at the current stage with explicit RK part
576!!
577!! @param nowstage Current stage
578!! @param q Array to store tracer variable data
579!! @param varID Index of the targeting variable
580!! @param is Index at which begins the loop for the corresponding direction
581!! @param ie Index at which finishes the loop for the corresponding direction
582!! @param js Index at which begins the loop for the corresponding direction
583!! @param je Index at which finishes the loop for the corresponding direction
584!! @param DDENS Array to store density perturbation data at the time level n+1
585!! @param DDENS0 Array to store density perturbation data at the time level n
586!! @param DENS_hyd Array to hydrostatic part of density
587 subroutine timeint_rk_advance_trcvar2d( this, nowstage, q, varID, is, ie ,js, je , &
588 DDENS, DDENS0, DENS_hyd )
589 implicit none
590 class(timeint_rk), intent(inout) :: this
591 integer, intent(in) :: nowstage
592 real(RP), intent(inout) :: q(:,:)
593 integer, intent(in) :: varID
594 integer, intent(in) :: is, ie ,js, je
595 real(RP), intent(in) :: DDENS (:,:)
596 real(RP), intent(in) :: DDENS0(:,:)
597 real(RP), intent(in) :: DENS_hyd(:,:)
598 !----------------------------------------
599
600 if ( this%imex_flag ) then
601 if ( prc_ismaster ) write(*,*) "timeint_rk_advence_trcvar: IMEX is not supported. Check!"
602 call prc_abort
603 end if
604
605 if (this%low_storage_flag) then
606 call rk_advance_trcvar_low_storage2d( this, nowstage, q, varid, is, ie ,js, je , this%size_each_var(1),this%size_each_var(2), this%var_num, &
607 ddens, ddens0, dens_hyd, this%var0_2D, this%varTmp_2d, this%tend_buf2D_ex )
608 else
609 call rk_advance_trcvar_general2d( this, nowstage, q, varid, is, ie ,js, je , this%size_each_var(1),this%size_each_var(2), this%var_num, &
610 ddens, ddens0, dens_hyd, this%var0_2D, this%varTmp_2d, this%tend_buf2D_ex )
611 end if
612
613 return
614 end subroutine timeint_rk_advance_trcvar2d
615
616!> Store variable data at the time level n for the case of IMEX RK scheme
617!!
618!! @param q Array to store variable data at the time level n
619!! @param varID Index of the targeting variable
620!! @param is Index at which begins the loop for the corresponding direction
621!! @param ie Index at which finishes the loop for the corresponding direction
622!! @param js Index at which begins the loop for the corresponding direction
623!! @param je Index at which finishes the loop for the corresponding direction
624 subroutine timeint_rk_store_var0_2d( this, q, varID, is, ie ,js, je )
625 implicit none
626 class(timeint_rk), intent(inout) :: this
627 real(RP), intent(inout) :: q(:,:)
628 integer, intent(in) :: varID
629 integer, intent(in) :: is, ie ,js, je
630
631 integer :: i,j
632 !----------------------------------------
633
634 !$omp parallel private(i,j)
635 !$acc parallel present( q, this%var0_2D )
636 !$omp do
637 !$acc loop collapse(2)
638 do j=js, je
639 do i=is, ie
640 this%var0_2D(i,j,varid) = q(i,j)
641 end do
642 end do
643 !$acc end parallel
644 !$omp end parallel
645
646 return
647 end subroutine timeint_rk_store_var0_2d
648
649!> Store variable data after the implicit part of current stage in IMEX RK scheme
650!!
651!! @param nowstage Current stage
652!! @param q Array to store variable data after the implicit part of current stage
653!! @param varID Index of the targeting variable
654!! @param is Index at which begins the loop for the corresponding direction
655!! @param ie Index at which finishes the loop for the corresponding direction
656!! @param js Index at which begins the loop for the corresponding direction
657!! @param je Index at which finishes the loop for the corresponding direction
658 subroutine timeint_rk_storeimpl2d( this, nowstage, q, varID, is, ie ,js, je )
659 implicit none
660 class(timeint_rk), intent(inout) :: this
661 integer, intent(in) :: nowstage
662 real(RP), intent(inout) :: q(:,:)
663 integer, intent(in) :: varID
664 integer, intent(in) :: is, ie ,js, je
665
666 !----------------------------------------
667
668 call rk_storeimpl_general2d( this, nowstage, q, varid, is, ie ,js, je , this%size_each_var(1),this%size_each_var(2), this%var_num, &
669 this%var0_2D, this%varTmp_2d, this%tend_buf2D_im )
670
671 return
672 end subroutine timeint_rk_storeimpl2d
673
674!> Advance a variable at the current stage with explicit RK part
675!!
676!! @param nowstage Current stage
677!! @param q Array to store variable data
678!! @param varID Index of the targeting variable
679!! @param is Index at which begins the loop for the corresponding direction
680!! @param ie Index at which finishes the loop for the corresponding direction
681!! @param js Index at which begins the loop for the corresponding direction
682!! @param je Index at which finishes the loop for the corresponding direction
683!! @param ks Index at which begins the loop for the corresponding direction
684!! @param ke Index at which finishes the loop for the corresponding direction
685 subroutine timeint_rk_advance3d( this, nowstage, q, varID, is, ie ,js, je ,ks, ke )
686 implicit none
687 class(timeint_rk), intent(inout) :: this
688 integer, intent(in) :: nowstage
689 real(RP), intent(inout) :: q(:,:,:)
690 integer, intent(in) :: varID
691 integer, intent(in) :: is, ie ,js, je ,ks, ke
692 !----------------------------------------
693
694 if (this%low_storage_flag) then
695 call prof_rapstart( 'rk_advance_low_storage3D', 3)
696 call rk_advance_low_storage3d( this, nowstage, q, varid, is, ie ,js, je ,ks, ke , this%size_each_var(1),this%size_each_var(2),this%size_each_var(3), this%var_num, &
697 this%var0_3D, this%varTmp_3d, this%tend_buf3D_ex )
698 call prof_rapend( 'rk_advance_low_storage3D', 3)
699 else
700 if ( this%imex_flag ) then
701 call rk_advance_general3d( this, nowstage, q, varid, is, ie ,js, je ,ks, ke , this%size_each_var(1),this%size_each_var(2),this%size_each_var(3), this%var_num, &
702 this%var0_3D, this%varTmp_3d, this%tend_buf3D_ex, this%tend_buf3D_im )
703 else
704 call rk_advance_general3d( this, nowstage, q, varid, is, ie ,js, je ,ks, ke , this%size_each_var(1),this%size_each_var(2),this%size_each_var(3), this%var_num, &
705 this%var0_3D, this%varTmp_3d, this%tend_buf3D_ex )
706 end if
707 end if
708
709 return
710 end subroutine timeint_rk_advance3d
711
712!> Advance variables at the current stage with explicit RK part
713!!
714!! @param nowstage Current stage
715!! @param var_list Array of timeint_rk_var object which saves pointer to variable data
716!! @param varIDs Indices of the targeting variables
717!! @param is Index at which begins the loop for the corresponding direction
718!! @param ie Index at which finishes the loop for the corresponding direction
719!! @param js Index at which begins the loop for the corresponding direction
720!! @param je Index at which finishes the loop for the corresponding direction
721!! @param ks Index at which begins the loop for the corresponding direction
722!! @param ke Index at which finishes the loop for the corresponding direction
723!OCL SERIAL
724 subroutine timeint_rk_advance3d_varlist( this, nowstage, var_list, varIDs, is, ie ,js, je ,ks, ke )
725 implicit none
726 class(timeint_rk), intent(inout) :: this
727 integer, intent(in) :: nowstage
728 integer, intent(in) :: varIDs(:)
729 type(timeint_rk_var), intent(inout) :: var_list(size(varIDs))
730 integer, intent(in) :: is, ie ,js, je ,ks, ke
731
732 integer :: i
733 integer :: n
734 !----------------------------------------
735
736 n = size(varids)
737
738 if (this%low_storage_flag) then
739 call prof_rapstart( 'rk_advance_varlist_low_storage3D', 3)
740 i = 1
741 do while(i <= n)
742 if ( i+1 <= n ) then
743 call rk_advance_low_storage3d_var2( this, nowstage, var_list(i)%var3D, var_list(i+1)%var3D, varids(i), varids(i+1), is, ie ,js, je ,ks, ke , this%size_each_var(1),this%size_each_var(2),this%size_each_var(3), this%var_num, &
744 this%var0_3D, this%varTmp_3d, this%tend_buf3D_ex )
745 i = i + 2
746 else
747 call rk_advance_low_storage3d( this, nowstage, var_list(n)%var3D, varids(n), is, ie ,js, je ,ks, ke , this%size_each_var(1),this%size_each_var(2),this%size_each_var(3), this%var_num, &
748 this%var0_3D, this%varTmp_3d, this%tend_buf3D_ex )
749 i = i + 1
750 end if
751 end do
752 !$acc wait(1)
753 call prof_rapend( 'rk_advance_varlist_low_storage3D', 3)
754 else
755 do i=1, n
756 call this%Advance3D( nowstage, var_list(i)%var3D, varids(i), is, ie ,js, je ,ks, ke )
757 end do
758 end if
759
760 return
761 end subroutine timeint_rk_advance3d_varlist
762
763!> Advance tracer variable data at the current stage with explicit RK part
764!!
765!! @param nowstage Current stage
766!! @param q Array to store tracer variable data
767!! @param varID Index of the targeting variable
768!! @param is Index at which begins the loop for the corresponding direction
769!! @param ie Index at which finishes the loop for the corresponding direction
770!! @param js Index at which begins the loop for the corresponding direction
771!! @param je Index at which finishes the loop for the corresponding direction
772!! @param ks Index at which begins the loop for the corresponding direction
773!! @param ke Index at which finishes the loop for the corresponding direction
774!! @param DDENS Array to store density perturbation data at the time level n+1
775!! @param DDENS0 Array to store density perturbation data at the time level n
776!! @param DENS_hyd Array to hydrostatic part of density
777 subroutine timeint_rk_advance_trcvar3d( this, nowstage, q, varID, is, ie ,js, je ,ks, ke , &
778 DDENS, DDENS0, DENS_hyd )
779 implicit none
780 class(timeint_rk), intent(inout) :: this
781 integer, intent(in) :: nowstage
782 real(RP), intent(inout) :: q(:,:,:)
783 integer, intent(in) :: varID
784 integer, intent(in) :: is, ie ,js, je ,ks, ke
785 real(RP), intent(in) :: DDENS (:,:,:)
786 real(RP), intent(in) :: DDENS0(:,:,:)
787 real(RP), intent(in) :: DENS_hyd(:,:,:)
788 !----------------------------------------
789
790 if ( this%imex_flag ) then
791 if ( prc_ismaster ) write(*,*) "timeint_rk_advence_trcvar: IMEX is not supported. Check!"
792 call prc_abort
793 end if
794
795 if (this%low_storage_flag) then
796 call rk_advance_trcvar_low_storage3d( this, nowstage, q, varid, is, ie ,js, je ,ks, ke , this%size_each_var(1),this%size_each_var(2),this%size_each_var(3), this%var_num, &
797 ddens, ddens0, dens_hyd, this%var0_3D, this%varTmp_3d, this%tend_buf3D_ex )
798 else
799 call rk_advance_trcvar_general3d( this, nowstage, q, varid, is, ie ,js, je ,ks, ke , this%size_each_var(1),this%size_each_var(2),this%size_each_var(3), this%var_num, &
800 ddens, ddens0, dens_hyd, this%var0_3D, this%varTmp_3d, this%tend_buf3D_ex )
801 end if
802
803 return
804 end subroutine timeint_rk_advance_trcvar3d
805
806!> Store variable data at the time level n for the case of IMEX RK scheme
807!!
808!! @param q Array to store variable data at the time level n
809!! @param varID Index of the targeting variable
810!! @param is Index at which begins the loop for the corresponding direction
811!! @param ie Index at which finishes the loop for the corresponding direction
812!! @param js Index at which begins the loop for the corresponding direction
813!! @param je Index at which finishes the loop for the corresponding direction
814!! @param ks Index at which begins the loop for the corresponding direction
815!! @param ke Index at which finishes the loop for the corresponding direction
816 subroutine timeint_rk_store_var0_3d( this, q, varID, is, ie ,js, je ,ks, ke )
817 implicit none
818 class(timeint_rk), intent(inout) :: this
819 real(RP), intent(inout) :: q(:,:,:)
820 integer, intent(in) :: varID
821 integer, intent(in) :: is, ie ,js, je ,ks, ke
822
823 integer :: i,j,k
824 !----------------------------------------
825
826 !$omp parallel private(i,j,k)
827 !$acc parallel present( q, this%var0_3D )
828 !$omp do collapse(2)
829 !$acc loop collapse(3)
830 do k=ks, ke
831 do j=js, je
832 do i=is, ie
833 this%var0_3D(i,j,k,varid) = q(i,j,k)
834 end do
835 end do
836 end do
837 !$acc end parallel
838 !$omp end parallel
839
840 return
841 end subroutine timeint_rk_store_var0_3d
842
843!> Store variable data after the implicit part of current stage in IMEX RK scheme
844!!
845!! @param nowstage Current stage
846!! @param q Array to store variable data after the implicit part of current stage
847!! @param varID Index of the targeting variable
848!! @param is Index at which begins the loop for the corresponding direction
849!! @param ie Index at which finishes the loop for the corresponding direction
850!! @param js Index at which begins the loop for the corresponding direction
851!! @param je Index at which finishes the loop for the corresponding direction
852!! @param ks Index at which begins the loop for the corresponding direction
853!! @param ke Index at which finishes the loop for the corresponding direction
854 subroutine timeint_rk_storeimpl3d( this, nowstage, q, varID, is, ie ,js, je ,ks, ke )
855 implicit none
856 class(timeint_rk), intent(inout) :: this
857 integer, intent(in) :: nowstage
858 real(RP), intent(inout) :: q(:,:,:)
859 integer, intent(in) :: varID
860 integer, intent(in) :: is, ie ,js, je ,ks, ke
861
862 !----------------------------------------
863
864 call rk_storeimpl_general3d( this, nowstage, q, varid, is, ie ,js, je ,ks, ke , this%size_each_var(1),this%size_each_var(2),this%size_each_var(3), this%var_num, &
865 this%var0_3D, this%varTmp_3d, this%tend_buf3D_im )
866
867 return
868 end subroutine timeint_rk_storeimpl3d
869
870!-------------------
871
872
873!> Advance variable data at the current stage with explicit RK part (low-storage case)
874!!
875!! @param nowstage Current stage
876!! @param q Array to store variable data
877!! @param varID Index of the targeting variable
878!! @param is Index at which begins the loop for the corresponding direction
879!! @param ie Index at which finishes the loop for the corresponding direction
880!OCL SERIAL
881 subroutine rk_advance_low_storage1d( this, nowstage, q, varID, is, ie , IA, var_num, &
882 var0_1D, varTmp_1d, tend_buf1D_ex )
883 use scale_const, only: &
884 eps => const_eps
885 implicit none
886 class(timeint_rk), intent(inout) :: this
887 integer, intent(in) :: nowstage
888 integer, intent(in) :: IA
889 real(RP), intent(inout) :: q(IA)
890 integer, intent(in) :: varID
891 integer, intent(in) :: is, ie
892 integer, intent(in) :: var_num
893 real(RP), intent(inout) :: var0_1d(IA,var_num)
894 real(RP), intent(inout) :: varTmp_1d(IA,var_num)
895 real(RP), intent(inout) :: tend_buf1D_ex(IA,var_num,this%tend_buf_size)
896
897 integer :: i
898 real(RP) :: sig_ss
899 real(RP) :: gam_ss
900 real(RP) :: one_Minus_sig_ss
901 real(RP) :: sig_Ns
902 real(RP) :: gam_Ns
903
904 !----------------------------------------
905
906 sig_ss = this%coef_sig_ex(nowstage+1,nowstage)
907 sig_ns = this%coef_sig_ex(this%nstage+1,nowstage)
908 one_minus_sig_ss = 1.0_rp - sig_ss
909 gam_ss = this%dt * this%coef_gam_ex(nowstage+1,nowstage)
910 gam_ns = this%dt * this%coef_gam_ex(this%nstage+1,nowstage)
911
912 if ( nowstage == this%nstage ) then
913 !$omp parallel private(i)
914 !$omp do
915 !$acc parallel present( q, varTmp_1d, tend_buf1D_ex ) async(1)
916 !$acc loop
917 do i=is, ie
918 q(i) = vartmp_1d(i,varid) &
919 + sig_ss * q(i) + gam_ss * tend_buf1d_ex(i,varid,1)
920 end do
921 !$acc end parallel
922 !$omp end parallel
923
924 return
925 end if
926
927 !$omp parallel private(i)
928 !$acc parallel present( q, var0_1D, varTmp_1D, tend_buf1D_ex ) async(1)
929 if (nowstage == 1) then
930 !$omp do
931 !$acc loop
932 do i=is, ie
933 var0_1d(i,varid) = q(i)
934 vartmp_1d(i,varid) = 0.0_rp
935 end do
936 end if
937
938 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps ) then
939 !$omp do
940 !$acc loop
941 do i=is, ie
942 vartmp_1d(i,varid) = vartmp_1d(i,varid) &
943 + sig_ns * q(i) + gam_ns * tend_buf1d_ex(i,varid,1)
944 end do
945 end if
946
947 !$omp do
948 !$acc loop
949 do i=is, ie
950 q(i) = one_minus_sig_ss * var0_1d(i,varid) &
951 + sig_ss * q(i) + gam_ss * tend_buf1d_ex(i,varid,1)
952 end do
953 !$acc end parallel
954 !$omp end parallel
955
956 return
957 end subroutine rk_advance_low_storage1d
958
959!> Advance variable data at the current stage with explicit RK part (low-storage case)
960!!
961!! @param nowstage Current stage
962!! @param q1 Array to store variable data
963!! @param q2 Array to store variable data
964!! @param varID1 Index of the targeting variable
965!! @param varID2 Index of the targeting variable
966!! @param is Index at which begins the loop for the corresponding direction
967!! @param ie Index at which finishes the loop for the corresponding direction
968!OCL SERIAL
969 subroutine rk_advance_low_storage1d_var2( this, nowstage, q1, q2, varID1, varID2, is, ie , IA, var_num, &
970 var0_1D, varTmp_1d, tend_buf1D_ex )
971 use scale_const, only: &
972 eps => const_eps
973 implicit none
974 class(timeint_rk), intent(inout) :: this
975 integer, intent(in) :: nowstage
976 integer, intent(in) :: IA
977 real(RP), intent(inout) :: q1(IA)
978 real(RP), intent(inout) :: q2(IA)
979 integer, intent(in) :: varID1
980 integer, intent(in) :: varID2
981 integer, intent(in) :: is, ie
982 integer, intent(in) :: var_num
983 real(RP), intent(inout) :: var0_1d(IA,var_num)
984 real(RP), intent(inout) :: varTmp_1d(IA,var_num)
985 real(RP), intent(inout) :: tend_buf1D_ex(IA,var_num,this%tend_buf_size)
986
987 integer :: i
988 real(RP) :: sig_ss
989 real(RP) :: gam_ss
990 real(RP) :: one_Minus_sig_ss
991 real(RP) :: sig_Ns
992 real(RP) :: gam_Ns
993
994 !----------------------------------------
995
996 sig_ss = this%coef_sig_ex(nowstage+1,nowstage)
997 sig_ns = this%coef_sig_ex(this%nstage+1,nowstage)
998 one_minus_sig_ss = 1.0_rp - sig_ss
999 gam_ss = this%dt * this%coef_gam_ex(nowstage+1,nowstage)
1000 gam_ns = this%dt * this%coef_gam_ex(this%nstage+1,nowstage)
1001
1002 if ( nowstage == this%nstage ) then
1003 !$omp parallel private(i)
1004 !$omp do
1005 !$acc parallel present( q1, q2, varTmp_1d, tend_buf1D_ex ) async(1)
1006 !$acc loop
1007 do i=is, ie
1008 q1(i) = vartmp_1d(i,varid1) &
1009 + sig_ss * q1(i) + gam_ss * tend_buf1d_ex(i,varid1,1)
1010 q2(i) = vartmp_1d(i,varid2) &
1011 + sig_ss * q2(i) + gam_ss * tend_buf1d_ex(i,varid2,1)
1012 end do
1013 !$acc end parallel
1014 !$omp end parallel
1015
1016 return
1017 end if
1018
1019 !$omp parallel private(i)
1020 !$acc parallel present( q1, q2, var0_1D, varTmp_1D, tend_buf1D_ex ) async(1)
1021 if (nowstage == 1) then
1022 !$omp do
1023 !$acc loop
1024 do i=is, ie
1025 var0_1d(i,varid1) = q1(i)
1026 var0_1d(i,varid2) = q2(i)
1027
1028 vartmp_1d(i,varid1) = 0.0_rp
1029 vartmp_1d(i,varid2) = 0.0_rp
1030 end do
1031 end if
1032
1033 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps ) then
1034 !$omp do
1035 !$acc loop
1036 do i=is, ie
1037 vartmp_1d(i,varid1) = vartmp_1d(i,varid1) &
1038 + sig_ns * q1(i) + gam_ns * tend_buf1d_ex(i,varid1,1)
1039 vartmp_1d(i,varid2) = vartmp_1d(i,varid2) &
1040 + sig_ns * q2(i) + gam_ns * tend_buf1d_ex(i,varid2,1)
1041 end do
1042 end if
1043
1044 !$omp do
1045 !$acc loop
1046 do i=is, ie
1047 q1(i) = one_minus_sig_ss * var0_1d(i,varid1) &
1048 + sig_ss * q1(i) + gam_ss * tend_buf1d_ex(i,varid1,1)
1049 q2(i) = one_minus_sig_ss * var0_1d(i,varid2) &
1050 + sig_ss * q2(i) + gam_ss * tend_buf1d_ex(i,varid2,1)
1051 end do
1052 !$acc end parallel
1053 !$omp end parallel
1054
1055 return
1056 end subroutine rk_advance_low_storage1d_var2
1057
1058!> Advance tracer variable data at the current stage with explicit RK part (low-storage case)
1059!!
1060!! @param nowstage Current stage
1061!! @param q Array to store tracer variable data
1062!! @param varID Index of the targeting variable
1063!! @param is Index at which begins the loop for the corresponding direction
1064!! @param ie Index at which finishes the loop for the corresponding direction
1065!! @param DDENS Array to store density perturbation data at the time level n+1
1066!! @param DDENS0 Array to store density perturbation data at the time level n
1067!! @param DENS_hyd Array to hydrostatic part of density
1068!OCL SERIAL
1069 subroutine rk_advance_trcvar_low_storage1d( this, nowstage, q, varID, is, ie , IA, var_num, &
1070 DDENS, DDENS0, DENS_hyd, &
1071 var0_1D, varTmp_1d, tend_buf1D_ex )
1072 use scale_const, only: &
1073 eps => const_eps
1074 implicit none
1075 class(timeint_rk), intent(inout) :: this
1076 integer, intent(in) :: nowstage
1077 integer, intent(in) :: IA
1078 real(RP), intent(inout) :: q(IA)
1079 integer, intent(in) :: varID
1080 integer, intent(in) :: is, ie
1081 integer, intent(in) :: var_num
1082 real(RP), intent(in) :: DDENS (IA)
1083 real(RP), intent(in) :: DDENS0(IA)
1084 real(RP), intent(in) :: DENS_hyd(IA)
1085 real(RP), intent(inout) :: var0_1d(IA,var_num)
1086 real(RP), intent(inout) :: varTmp_1d(IA,var_num)
1087 real(RP), intent(inout) :: tend_buf1D_ex(IA,var_num,this%tend_buf_size)
1088
1089 integer :: i
1090 real(RP) :: sig_ss
1091 real(RP) :: gam_ss
1092 real(RP) :: one_Minus_sig_ss
1093 real(RP) :: sig_Ns
1094 real(RP) :: gam_Ns
1095 real(RP) :: c_ssm1
1096 real(RP) :: c_ss
1097
1098 real(RP) :: dens_ssm1
1099 real(RP) :: dens_ss
1100
1101 !----------------------------------------
1102
1103 call prof_rapstart( 'rk_advance_trcvar_low_storage1D', 3)
1104
1105 sig_ss = this%coef_sig_ex(nowstage+1,nowstage)
1106 sig_ns = this%coef_sig_ex(this%nstage+1,nowstage)
1107 one_minus_sig_ss = 1.0_rp - sig_ss
1108 gam_ss = this%dt * this%coef_gam_ex(nowstage+1,nowstage)
1109 gam_ns = this%dt * this%coef_gam_ex(this%nstage+1,nowstage)
1110 c_ssm1 = this%coef_c_ex(nowstage)
1111
1112 if ( nowstage == this%nstage ) then
1113 !$omp parallel private(i)
1114 !$acc parallel present( q, varTmp_1d, tend_buf1D_ex, DDENS, DDENS0, DENS_hyd )
1115 !$omp do
1116 !$acc loop
1117 do i=is, ie
1118 dens_ssm1 = dens_hyd(i) + ddens0(i) + c_ssm1 * ( ddens(i) - ddens0(i) )
1119 q(i) = ( vartmp_1d(i,varid) &
1120 + sig_ss * q(i) * dens_ssm1 + gam_ss * tend_buf1d_ex(i,varid,1) ) &
1121 / ( dens_hyd(i) + ddens(i) )
1122 end do
1123 !$acc end parallel
1124 !$omp end parallel
1125 call prof_rapend( 'rk_advance_trcvar_low_storage1D', 3)
1126
1127 return
1128 end if
1129
1130 c_ss = this%coef_c_ex(nowstage+1)
1131
1132 !$omp parallel private(i,dens_ss,dens_ssm1)
1133 !$acc parallel present( q, varTmp_1d, tend_buf1D_ex, DDENS, DDENS0, DENS_hyd )
1134 if (nowstage == 1) then
1135 !$omp do
1136 !$acc loop
1137 do i=is, ie
1138 var0_1d(i,varid) = q(i) * ( dens_hyd(i) + ddens0(i) )
1139 vartmp_1d(i,varid) = 0.0_rp
1140 end do
1141 end if
1142
1143 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps ) then
1144 !$omp do
1145 !$acc loop
1146 do i=is, ie
1147 dens_ssm1 = dens_hyd(i) + ddens0(i) + c_ssm1 * ( ddens(i) - ddens0(i) )
1148 vartmp_1d(i,varid) = vartmp_1d(i,varid) &
1149 + sig_ns * q(i) * dens_ssm1 + gam_ns * tend_buf1d_ex(i,varid,1)
1150 end do
1151 end if
1152
1153 !$omp do
1154 !$acc loop
1155 do i=is, ie
1156 dens_ssm1 = dens_hyd(i) + ddens0(i) + c_ssm1 * ( ddens(i) - ddens0(i) )
1157 dens_ss = dens_hyd(i) + ddens0(i) + c_ss * ( ddens(i) - ddens0(i) )
1158
1159 q(i) = ( one_minus_sig_ss * var0_1d(i,varid) &
1160 + sig_ss * q(i) * dens_ssm1 + gam_ss * tend_buf1d_ex(i,varid,1) ) &
1161 / dens_ss
1162 end do
1163 !$acc end parallel
1164 !$omp end parallel
1165
1166 call prof_rapend( 'rk_advance_trcvar_low_storage1D', 3)
1167
1168 return
1169 end subroutine rk_advance_trcvar_low_storage1d
1170
1171
1172!> Advance variable data at the current stage with explicit RK part (low-storage case)
1173!!
1174!! @param nowstage Current stage
1175!! @param q Array to store variable data
1176!! @param varID Index of the targeting variable
1177!! @param is Index at which begins the loop for the corresponding direction
1178!! @param ie Index at which finishes the loop for the corresponding direction
1179!! @param js Index at which begins the loop for the corresponding direction
1180!! @param je Index at which finishes the loop for the corresponding direction
1181!OCL SERIAL
1182 subroutine rk_advance_low_storage2d( this, nowstage, q, varID, is, ie ,js, je , IA,JA, var_num, &
1183 var0_2D, varTmp_2d, tend_buf2D_ex )
1184 use scale_const, only: &
1185 eps => const_eps
1186 implicit none
1187 class(timeint_rk), intent(inout) :: this
1188 integer, intent(in) :: nowstage
1189 integer, intent(in) :: IA,JA
1190 real(RP), intent(inout) :: q(IA,JA)
1191 integer, intent(in) :: varID
1192 integer, intent(in) :: is, ie ,js, je
1193 integer, intent(in) :: var_num
1194 real(RP), intent(inout) :: var0_2d(IA,JA,var_num)
1195 real(RP), intent(inout) :: varTmp_2d(IA,JA,var_num)
1196 real(RP), intent(inout) :: tend_buf2D_ex(IA,JA,var_num,this%tend_buf_size)
1197
1198 integer :: i,j
1199 real(RP) :: sig_ss
1200 real(RP) :: gam_ss
1201 real(RP) :: one_Minus_sig_ss
1202 real(RP) :: sig_Ns
1203 real(RP) :: gam_Ns
1204
1205 !----------------------------------------
1206
1207 sig_ss = this%coef_sig_ex(nowstage+1,nowstage)
1208 sig_ns = this%coef_sig_ex(this%nstage+1,nowstage)
1209 one_minus_sig_ss = 1.0_rp - sig_ss
1210 gam_ss = this%dt * this%coef_gam_ex(nowstage+1,nowstage)
1211 gam_ns = this%dt * this%coef_gam_ex(this%nstage+1,nowstage)
1212
1213 if ( nowstage == this%nstage ) then
1214 !$omp parallel private(i,j)
1215 !$omp do
1216 !$acc parallel present( q, varTmp_2d, tend_buf2D_ex ) async(1)
1217 !$acc loop collapse(2)
1218 do j=js, je
1219 do i=is, ie
1220 q(i,j) = vartmp_2d(i,j,varid) &
1221 + sig_ss * q(i,j) + gam_ss * tend_buf2d_ex(i,j,varid,1)
1222 end do
1223 end do
1224 !$acc end parallel
1225 !$omp end parallel
1226
1227 return
1228 end if
1229
1230 !$omp parallel private(i,j)
1231 !$acc parallel present( q, var0_2D, varTmp_2D, tend_buf2D_ex ) async(1)
1232 if (nowstage == 1) then
1233 !$omp do
1234 !$acc loop collapse(2)
1235 do j=js, je
1236 do i=is, ie
1237 var0_2d(i,j,varid) = q(i,j)
1238 vartmp_2d(i,j,varid) = 0.0_rp
1239 end do
1240 end do
1241 end if
1242
1243 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps ) then
1244 !$omp do
1245 !$acc loop collapse(2)
1246 do j=js, je
1247 do i=is, ie
1248 vartmp_2d(i,j,varid) = vartmp_2d(i,j,varid) &
1249 + sig_ns * q(i,j) + gam_ns * tend_buf2d_ex(i,j,varid,1)
1250 end do
1251 end do
1252 end if
1253
1254 !$omp do
1255 !$acc loop collapse(2)
1256 do j=js, je
1257 do i=is, ie
1258 q(i,j) = one_minus_sig_ss * var0_2d(i,j,varid) &
1259 + sig_ss * q(i,j) + gam_ss * tend_buf2d_ex(i,j,varid,1)
1260 end do
1261 end do
1262 !$acc end parallel
1263 !$omp end parallel
1264
1265 return
1266 end subroutine rk_advance_low_storage2d
1267
1268!> Advance variable data at the current stage with explicit RK part (low-storage case)
1269!!
1270!! @param nowstage Current stage
1271!! @param q1 Array to store variable data
1272!! @param q2 Array to store variable data
1273!! @param varID1 Index of the targeting variable
1274!! @param varID2 Index of the targeting variable
1275!! @param is Index at which begins the loop for the corresponding direction
1276!! @param ie Index at which finishes the loop for the corresponding direction
1277!! @param js Index at which begins the loop for the corresponding direction
1278!! @param je Index at which finishes the loop for the corresponding direction
1279!OCL SERIAL
1280 subroutine rk_advance_low_storage2d_var2( this, nowstage, q1, q2, varID1, varID2, is, ie ,js, je , IA,JA, var_num, &
1281 var0_2D, varTmp_2d, tend_buf2D_ex )
1282 use scale_const, only: &
1283 eps => const_eps
1284 implicit none
1285 class(timeint_rk), intent(inout) :: this
1286 integer, intent(in) :: nowstage
1287 integer, intent(in) :: IA,JA
1288 real(RP), intent(inout) :: q1(IA,JA)
1289 real(RP), intent(inout) :: q2(IA,JA)
1290 integer, intent(in) :: varID1
1291 integer, intent(in) :: varID2
1292 integer, intent(in) :: is, ie ,js, je
1293 integer, intent(in) :: var_num
1294 real(RP), intent(inout) :: var0_2d(IA,JA,var_num)
1295 real(RP), intent(inout) :: varTmp_2d(IA,JA,var_num)
1296 real(RP), intent(inout) :: tend_buf2D_ex(IA,JA,var_num,this%tend_buf_size)
1297
1298 integer :: i,j
1299 real(RP) :: sig_ss
1300 real(RP) :: gam_ss
1301 real(RP) :: one_Minus_sig_ss
1302 real(RP) :: sig_Ns
1303 real(RP) :: gam_Ns
1304
1305 !----------------------------------------
1306
1307 sig_ss = this%coef_sig_ex(nowstage+1,nowstage)
1308 sig_ns = this%coef_sig_ex(this%nstage+1,nowstage)
1309 one_minus_sig_ss = 1.0_rp - sig_ss
1310 gam_ss = this%dt * this%coef_gam_ex(nowstage+1,nowstage)
1311 gam_ns = this%dt * this%coef_gam_ex(this%nstage+1,nowstage)
1312
1313 if ( nowstage == this%nstage ) then
1314 !$omp parallel private(i,j)
1315 !$omp do
1316 !$acc parallel present( q1, q2, varTmp_2d, tend_buf2D_ex ) async(1)
1317 !$acc loop collapse(2)
1318 do j=js, je
1319 do i=is, ie
1320 q1(i,j) = vartmp_2d(i,j,varid1) &
1321 + sig_ss * q1(i,j) + gam_ss * tend_buf2d_ex(i,j,varid1,1)
1322 q2(i,j) = vartmp_2d(i,j,varid2) &
1323 + sig_ss * q2(i,j) + gam_ss * tend_buf2d_ex(i,j,varid2,1)
1324 end do
1325 end do
1326 !$acc end parallel
1327 !$omp end parallel
1328
1329 return
1330 end if
1331
1332 !$omp parallel private(i,j)
1333 !$acc parallel present( q1, q2, var0_2D, varTmp_2D, tend_buf2D_ex ) async(1)
1334 if (nowstage == 1) then
1335 !$omp do
1336 !$acc loop collapse(2)
1337 do j=js, je
1338 do i=is, ie
1339 var0_2d(i,j,varid1) = q1(i,j)
1340 var0_2d(i,j,varid2) = q2(i,j)
1341
1342 vartmp_2d(i,j,varid1) = 0.0_rp
1343 vartmp_2d(i,j,varid2) = 0.0_rp
1344 end do
1345 end do
1346 end if
1347
1348 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps ) then
1349 !$omp do
1350 !$acc loop collapse(2)
1351 do j=js, je
1352 do i=is, ie
1353 vartmp_2d(i,j,varid1) = vartmp_2d(i,j,varid1) &
1354 + sig_ns * q1(i,j) + gam_ns * tend_buf2d_ex(i,j,varid1,1)
1355 vartmp_2d(i,j,varid2) = vartmp_2d(i,j,varid2) &
1356 + sig_ns * q2(i,j) + gam_ns * tend_buf2d_ex(i,j,varid2,1)
1357 end do
1358 end do
1359 end if
1360
1361 !$omp do
1362 !$acc loop collapse(2)
1363 do j=js, je
1364 do i=is, ie
1365 q1(i,j) = one_minus_sig_ss * var0_2d(i,j,varid1) &
1366 + sig_ss * q1(i,j) + gam_ss * tend_buf2d_ex(i,j,varid1,1)
1367 q2(i,j) = one_minus_sig_ss * var0_2d(i,j,varid2) &
1368 + sig_ss * q2(i,j) + gam_ss * tend_buf2d_ex(i,j,varid2,1)
1369 end do
1370 end do
1371 !$acc end parallel
1372 !$omp end parallel
1373
1374 return
1375 end subroutine rk_advance_low_storage2d_var2
1376
1377!> Advance tracer variable data at the current stage with explicit RK part (low-storage case)
1378!!
1379!! @param nowstage Current stage
1380!! @param q Array to store tracer variable data
1381!! @param varID Index of the targeting variable
1382!! @param is Index at which begins the loop for the corresponding direction
1383!! @param ie Index at which finishes the loop for the corresponding direction
1384!! @param js Index at which begins the loop for the corresponding direction
1385!! @param je Index at which finishes the loop for the corresponding direction
1386!! @param DDENS Array to store density perturbation data at the time level n+1
1387!! @param DDENS0 Array to store density perturbation data at the time level n
1388!! @param DENS_hyd Array to hydrostatic part of density
1389!OCL SERIAL
1390 subroutine rk_advance_trcvar_low_storage2d( this, nowstage, q, varID, is, ie ,js, je , IA,JA, var_num, &
1391 DDENS, DDENS0, DENS_hyd, &
1392 var0_2D, varTmp_2d, tend_buf2D_ex )
1393 use scale_const, only: &
1394 eps => const_eps
1395 implicit none
1396 class(timeint_rk), intent(inout) :: this
1397 integer, intent(in) :: nowstage
1398 integer, intent(in) :: IA,JA
1399 real(RP), intent(inout) :: q(IA,JA)
1400 integer, intent(in) :: varID
1401 integer, intent(in) :: is, ie ,js, je
1402 integer, intent(in) :: var_num
1403 real(RP), intent(in) :: DDENS (IA,JA)
1404 real(RP), intent(in) :: DDENS0(IA,JA)
1405 real(RP), intent(in) :: DENS_hyd(IA,JA)
1406 real(RP), intent(inout) :: var0_2d(IA,JA,var_num)
1407 real(RP), intent(inout) :: varTmp_2d(IA,JA,var_num)
1408 real(RP), intent(inout) :: tend_buf2D_ex(IA,JA,var_num,this%tend_buf_size)
1409
1410 integer :: i,j
1411 real(RP) :: sig_ss
1412 real(RP) :: gam_ss
1413 real(RP) :: one_Minus_sig_ss
1414 real(RP) :: sig_Ns
1415 real(RP) :: gam_Ns
1416 real(RP) :: c_ssm1
1417 real(RP) :: c_ss
1418
1419 real(RP) :: dens_ssm1
1420 real(RP) :: dens_ss
1421
1422 !----------------------------------------
1423
1424 call prof_rapstart( 'rk_advance_trcvar_low_storage2D', 3)
1425
1426 sig_ss = this%coef_sig_ex(nowstage+1,nowstage)
1427 sig_ns = this%coef_sig_ex(this%nstage+1,nowstage)
1428 one_minus_sig_ss = 1.0_rp - sig_ss
1429 gam_ss = this%dt * this%coef_gam_ex(nowstage+1,nowstage)
1430 gam_ns = this%dt * this%coef_gam_ex(this%nstage+1,nowstage)
1431 c_ssm1 = this%coef_c_ex(nowstage)
1432
1433 if ( nowstage == this%nstage ) then
1434 !$omp parallel private(i,j)
1435 !$acc parallel present( q, varTmp_2d, tend_buf2D_ex, DDENS, DDENS0, DENS_hyd )
1436 !$omp do
1437 !$acc loop collapse(2)
1438 do j=js, je
1439 do i=is, ie
1440 dens_ssm1 = dens_hyd(i,j) + ddens0(i,j) + c_ssm1 * ( ddens(i,j) - ddens0(i,j) )
1441 q(i,j) = ( vartmp_2d(i,j,varid) &
1442 + sig_ss * q(i,j) * dens_ssm1 + gam_ss * tend_buf2d_ex(i,j,varid,1) ) &
1443 / ( dens_hyd(i,j) + ddens(i,j) )
1444 end do
1445 end do
1446 !$acc end parallel
1447 !$omp end parallel
1448 call prof_rapend( 'rk_advance_trcvar_low_storage2D', 3)
1449
1450 return
1451 end if
1452
1453 c_ss = this%coef_c_ex(nowstage+1)
1454
1455 !$omp parallel private(i,j,dens_ss,dens_ssm1)
1456 !$acc parallel present( q, varTmp_2d, tend_buf2D_ex, DDENS, DDENS0, DENS_hyd )
1457 if (nowstage == 1) then
1458 !$omp do
1459 !$acc loop collapse(2)
1460 do j=js, je
1461 do i=is, ie
1462 var0_2d(i,j,varid) = q(i,j) * ( dens_hyd(i,j) + ddens0(i,j) )
1463 vartmp_2d(i,j,varid) = 0.0_rp
1464 end do
1465 end do
1466 end if
1467
1468 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps ) then
1469 !$omp do
1470 !$acc loop collapse(2)
1471 do j=js, je
1472 do i=is, ie
1473 dens_ssm1 = dens_hyd(i,j) + ddens0(i,j) + c_ssm1 * ( ddens(i,j) - ddens0(i,j) )
1474 vartmp_2d(i,j,varid) = vartmp_2d(i,j,varid) &
1475 + sig_ns * q(i,j) * dens_ssm1 + gam_ns * tend_buf2d_ex(i,j,varid,1)
1476 end do
1477 end do
1478 end if
1479
1480 !$omp do
1481 !$acc loop collapse(2)
1482 do j=js, je
1483 do i=is, ie
1484 dens_ssm1 = dens_hyd(i,j) + ddens0(i,j) + c_ssm1 * ( ddens(i,j) - ddens0(i,j) )
1485 dens_ss = dens_hyd(i,j) + ddens0(i,j) + c_ss * ( ddens(i,j) - ddens0(i,j) )
1486
1487 q(i,j) = ( one_minus_sig_ss * var0_2d(i,j,varid) &
1488 + sig_ss * q(i,j) * dens_ssm1 + gam_ss * tend_buf2d_ex(i,j,varid,1) ) &
1489 / dens_ss
1490 end do
1491 end do
1492 !$acc end parallel
1493 !$omp end parallel
1494
1495 call prof_rapend( 'rk_advance_trcvar_low_storage2D', 3)
1496
1497 return
1498 end subroutine rk_advance_trcvar_low_storage2d
1499
1500
1501!> Advance variable data at the current stage with explicit RK part (low-storage case)
1502!!
1503!! @param nowstage Current stage
1504!! @param q Array to store variable data
1505!! @param varID Index of the targeting variable
1506!! @param is Index at which begins the loop for the corresponding direction
1507!! @param ie Index at which finishes the loop for the corresponding direction
1508!! @param js Index at which begins the loop for the corresponding direction
1509!! @param je Index at which finishes the loop for the corresponding direction
1510!! @param ks Index at which begins the loop for the corresponding direction
1511!! @param ke Index at which finishes the loop for the corresponding direction
1512!OCL SERIAL
1513 subroutine rk_advance_low_storage3d( this, nowstage, q, varID, is, ie ,js, je ,ks, ke , IA,JA,KA, var_num, &
1514 var0_3D, varTmp_3d, tend_buf3D_ex )
1515 use scale_const, only: &
1516 eps => const_eps
1517 implicit none
1518 class(timeint_rk), intent(inout) :: this
1519 integer, intent(in) :: nowstage
1520 integer, intent(in) :: IA,JA,KA
1521 real(RP), intent(inout) :: q(IA,JA,KA)
1522 integer, intent(in) :: varID
1523 integer, intent(in) :: is, ie ,js, je ,ks, ke
1524 integer, intent(in) :: var_num
1525 real(RP), intent(inout) :: var0_3d(IA,JA,KA,var_num)
1526 real(RP), intent(inout) :: varTmp_3d(IA,JA,KA,var_num)
1527 real(RP), intent(inout) :: tend_buf3D_ex(IA,JA,KA,var_num,this%tend_buf_size)
1528
1529 integer :: i,j,k
1530 real(RP) :: sig_ss
1531 real(RP) :: gam_ss
1532 real(RP) :: one_Minus_sig_ss
1533 real(RP) :: sig_Ns
1534 real(RP) :: gam_Ns
1535
1536 !----------------------------------------
1537
1538 sig_ss = this%coef_sig_ex(nowstage+1,nowstage)
1539 sig_ns = this%coef_sig_ex(this%nstage+1,nowstage)
1540 one_minus_sig_ss = 1.0_rp - sig_ss
1541 gam_ss = this%dt * this%coef_gam_ex(nowstage+1,nowstage)
1542 gam_ns = this%dt * this%coef_gam_ex(this%nstage+1,nowstage)
1543
1544 if ( nowstage == this%nstage ) then
1545 !$omp parallel private(i,j,k)
1546 !$omp do collapse(2)
1547 !$acc parallel present( q, varTmp_3d, tend_buf3D_ex ) async(1)
1548 !$acc loop collapse(3)
1549 do k=ks, ke
1550 do j=js, je
1551 do i=is, ie
1552 q(i,j,k) = vartmp_3d(i,j,k,varid) &
1553 + sig_ss * q(i,j,k) + gam_ss * tend_buf3d_ex(i,j,k,varid,1)
1554 end do
1555 end do
1556 end do
1557 !$acc end parallel
1558 !$omp end parallel
1559
1560 return
1561 end if
1562
1563 !$omp parallel private(i,j,k)
1564 !$acc parallel present( q, var0_3D, varTmp_3D, tend_buf3D_ex ) async(1)
1565 if (nowstage == 1) then
1566 !$omp do collapse(2)
1567 !$acc loop collapse(3)
1568 do k=ks, ke
1569 do j=js, je
1570 do i=is, ie
1571 var0_3d(i,j,k,varid) = q(i,j,k)
1572 vartmp_3d(i,j,k,varid) = 0.0_rp
1573 end do
1574 end do
1575 end do
1576 end if
1577
1578 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps ) then
1579 !$omp do collapse(2)
1580 !$acc loop collapse(3)
1581 do k=ks, ke
1582 do j=js, je
1583 do i=is, ie
1584 vartmp_3d(i,j,k,varid) = vartmp_3d(i,j,k,varid) &
1585 + sig_ns * q(i,j,k) + gam_ns * tend_buf3d_ex(i,j,k,varid,1)
1586 end do
1587 end do
1588 end do
1589 end if
1590
1591 !$omp do collapse(2)
1592 !$acc loop collapse(3)
1593 do k=ks, ke
1594 do j=js, je
1595 do i=is, ie
1596 q(i,j,k) = one_minus_sig_ss * var0_3d(i,j,k,varid) &
1597 + sig_ss * q(i,j,k) + gam_ss * tend_buf3d_ex(i,j,k,varid,1)
1598 end do
1599 end do
1600 end do
1601 !$acc end parallel
1602 !$omp end parallel
1603
1604 return
1605 end subroutine rk_advance_low_storage3d
1606
1607!> Advance variable data at the current stage with explicit RK part (low-storage case)
1608!!
1609!! @param nowstage Current stage
1610!! @param q1 Array to store variable data
1611!! @param q2 Array to store variable data
1612!! @param varID1 Index of the targeting variable
1613!! @param varID2 Index of the targeting variable
1614!! @param is Index at which begins the loop for the corresponding direction
1615!! @param ie Index at which finishes the loop for the corresponding direction
1616!! @param js Index at which begins the loop for the corresponding direction
1617!! @param je Index at which finishes the loop for the corresponding direction
1618!! @param ks Index at which begins the loop for the corresponding direction
1619!! @param ke Index at which finishes the loop for the corresponding direction
1620!OCL SERIAL
1621 subroutine rk_advance_low_storage3d_var2( this, nowstage, q1, q2, varID1, varID2, is, ie ,js, je ,ks, ke , IA,JA,KA, var_num, &
1622 var0_3D, varTmp_3d, tend_buf3D_ex )
1623 use scale_const, only: &
1624 eps => const_eps
1625 implicit none
1626 class(timeint_rk), intent(inout) :: this
1627 integer, intent(in) :: nowstage
1628 integer, intent(in) :: IA,JA,KA
1629 real(RP), intent(inout) :: q1(IA,JA,KA)
1630 real(RP), intent(inout) :: q2(IA,JA,KA)
1631 integer, intent(in) :: varID1
1632 integer, intent(in) :: varID2
1633 integer, intent(in) :: is, ie ,js, je ,ks, ke
1634 integer, intent(in) :: var_num
1635 real(RP), intent(inout) :: var0_3d(IA,JA,KA,var_num)
1636 real(RP), intent(inout) :: varTmp_3d(IA,JA,KA,var_num)
1637 real(RP), intent(inout) :: tend_buf3D_ex(IA,JA,KA,var_num,this%tend_buf_size)
1638
1639 integer :: i,j,k
1640 real(RP) :: sig_ss
1641 real(RP) :: gam_ss
1642 real(RP) :: one_Minus_sig_ss
1643 real(RP) :: sig_Ns
1644 real(RP) :: gam_Ns
1645
1646 !----------------------------------------
1647
1648 sig_ss = this%coef_sig_ex(nowstage+1,nowstage)
1649 sig_ns = this%coef_sig_ex(this%nstage+1,nowstage)
1650 one_minus_sig_ss = 1.0_rp - sig_ss
1651 gam_ss = this%dt * this%coef_gam_ex(nowstage+1,nowstage)
1652 gam_ns = this%dt * this%coef_gam_ex(this%nstage+1,nowstage)
1653
1654 if ( nowstage == this%nstage ) then
1655 !$omp parallel private(i,j,k)
1656 !$omp do collapse(2)
1657 !$acc parallel present( q1, q2, varTmp_3d, tend_buf3D_ex ) async(1)
1658 !$acc loop collapse(3)
1659 do k=ks, ke
1660 do j=js, je
1661 do i=is, ie
1662 q1(i,j,k) = vartmp_3d(i,j,k,varid1) &
1663 + sig_ss * q1(i,j,k) + gam_ss * tend_buf3d_ex(i,j,k,varid1,1)
1664 q2(i,j,k) = vartmp_3d(i,j,k,varid2) &
1665 + sig_ss * q2(i,j,k) + gam_ss * tend_buf3d_ex(i,j,k,varid2,1)
1666 end do
1667 end do
1668 end do
1669 !$acc end parallel
1670 !$omp end parallel
1671
1672 return
1673 end if
1674
1675 !$omp parallel private(i,j,k)
1676 !$acc parallel present( q1, q2, var0_3D, varTmp_3D, tend_buf3D_ex ) async(1)
1677 if (nowstage == 1) then
1678 !$omp do collapse(2)
1679 !$acc loop collapse(3)
1680 do k=ks, ke
1681 do j=js, je
1682 do i=is, ie
1683 var0_3d(i,j,k,varid1) = q1(i,j,k)
1684 var0_3d(i,j,k,varid2) = q2(i,j,k)
1685
1686 vartmp_3d(i,j,k,varid1) = 0.0_rp
1687 vartmp_3d(i,j,k,varid2) = 0.0_rp
1688 end do
1689 end do
1690 end do
1691 end if
1692
1693 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps ) then
1694 !$omp do collapse(2)
1695 !$acc loop collapse(3)
1696 do k=ks, ke
1697 do j=js, je
1698 do i=is, ie
1699 vartmp_3d(i,j,k,varid1) = vartmp_3d(i,j,k,varid1) &
1700 + sig_ns * q1(i,j,k) + gam_ns * tend_buf3d_ex(i,j,k,varid1,1)
1701 vartmp_3d(i,j,k,varid2) = vartmp_3d(i,j,k,varid2) &
1702 + sig_ns * q2(i,j,k) + gam_ns * tend_buf3d_ex(i,j,k,varid2,1)
1703 end do
1704 end do
1705 end do
1706 end if
1707
1708 !$omp do collapse(2)
1709 !$acc loop collapse(3)
1710 do k=ks, ke
1711 do j=js, je
1712 do i=is, ie
1713 q1(i,j,k) = one_minus_sig_ss * var0_3d(i,j,k,varid1) &
1714 + sig_ss * q1(i,j,k) + gam_ss * tend_buf3d_ex(i,j,k,varid1,1)
1715 q2(i,j,k) = one_minus_sig_ss * var0_3d(i,j,k,varid2) &
1716 + sig_ss * q2(i,j,k) + gam_ss * tend_buf3d_ex(i,j,k,varid2,1)
1717 end do
1718 end do
1719 end do
1720 !$acc end parallel
1721 !$omp end parallel
1722
1723 return
1724 end subroutine rk_advance_low_storage3d_var2
1725
1726!> Advance tracer variable data at the current stage with explicit RK part (low-storage case)
1727!!
1728!! @param nowstage Current stage
1729!! @param q Array to store tracer variable data
1730!! @param varID Index of the targeting variable
1731!! @param is Index at which begins the loop for the corresponding direction
1732!! @param ie Index at which finishes the loop for the corresponding direction
1733!! @param js Index at which begins the loop for the corresponding direction
1734!! @param je Index at which finishes the loop for the corresponding direction
1735!! @param ks Index at which begins the loop for the corresponding direction
1736!! @param ke Index at which finishes the loop for the corresponding direction
1737!! @param DDENS Array to store density perturbation data at the time level n+1
1738!! @param DDENS0 Array to store density perturbation data at the time level n
1739!! @param DENS_hyd Array to hydrostatic part of density
1740!OCL SERIAL
1741 subroutine rk_advance_trcvar_low_storage3d( this, nowstage, q, varID, is, ie ,js, je ,ks, ke , IA,JA,KA, var_num, &
1742 DDENS, DDENS0, DENS_hyd, &
1743 var0_3D, varTmp_3d, tend_buf3D_ex )
1744 use scale_const, only: &
1745 eps => const_eps
1746 implicit none
1747 class(timeint_rk), intent(inout) :: this
1748 integer, intent(in) :: nowstage
1749 integer, intent(in) :: IA,JA,KA
1750 real(RP), intent(inout) :: q(IA,JA,KA)
1751 integer, intent(in) :: varID
1752 integer, intent(in) :: is, ie ,js, je ,ks, ke
1753 integer, intent(in) :: var_num
1754 real(RP), intent(in) :: DDENS (IA,JA,KA)
1755 real(RP), intent(in) :: DDENS0(IA,JA,KA)
1756 real(RP), intent(in) :: DENS_hyd(IA,JA,KA)
1757 real(RP), intent(inout) :: var0_3d(IA,JA,KA,var_num)
1758 real(RP), intent(inout) :: varTmp_3d(IA,JA,KA,var_num)
1759 real(RP), intent(inout) :: tend_buf3D_ex(IA,JA,KA,var_num,this%tend_buf_size)
1760
1761 integer :: i,j,k
1762 real(RP) :: sig_ss
1763 real(RP) :: gam_ss
1764 real(RP) :: one_Minus_sig_ss
1765 real(RP) :: sig_Ns
1766 real(RP) :: gam_Ns
1767 real(RP) :: c_ssm1
1768 real(RP) :: c_ss
1769
1770 real(RP) :: dens_ssm1
1771 real(RP) :: dens_ss
1772
1773 !----------------------------------------
1774
1775 call prof_rapstart( 'rk_advance_trcvar_low_storage3D', 3)
1776
1777 sig_ss = this%coef_sig_ex(nowstage+1,nowstage)
1778 sig_ns = this%coef_sig_ex(this%nstage+1,nowstage)
1779 one_minus_sig_ss = 1.0_rp - sig_ss
1780 gam_ss = this%dt * this%coef_gam_ex(nowstage+1,nowstage)
1781 gam_ns = this%dt * this%coef_gam_ex(this%nstage+1,nowstage)
1782 c_ssm1 = this%coef_c_ex(nowstage)
1783
1784 if ( nowstage == this%nstage ) then
1785 !$omp parallel private(i,j,k)
1786 !$acc parallel present( q, varTmp_3d, tend_buf3D_ex, DDENS, DDENS0, DENS_hyd )
1787 !$omp do collapse(2)
1788 !$acc loop collapse(3)
1789 do k=ks, ke
1790 do j=js, je
1791 do i=is, ie
1792 dens_ssm1 = dens_hyd(i,j,k) + ddens0(i,j,k) + c_ssm1 * ( ddens(i,j,k) - ddens0(i,j,k) )
1793 q(i,j,k) = ( vartmp_3d(i,j,k,varid) &
1794 + sig_ss * q(i,j,k) * dens_ssm1 + gam_ss * tend_buf3d_ex(i,j,k,varid,1) ) &
1795 / ( dens_hyd(i,j,k) + ddens(i,j,k) )
1796 end do
1797 end do
1798 end do
1799 !$acc end parallel
1800 !$omp end parallel
1801 call prof_rapend( 'rk_advance_trcvar_low_storage3D', 3)
1802
1803 return
1804 end if
1805
1806 c_ss = this%coef_c_ex(nowstage+1)
1807
1808 !$omp parallel private(i,j,k,dens_ss,dens_ssm1)
1809 !$acc parallel present( q, varTmp_3d, tend_buf3D_ex, DDENS, DDENS0, DENS_hyd )
1810 if (nowstage == 1) then
1811 !$omp do collapse(2)
1812 !$acc loop collapse(3)
1813 do k=ks, ke
1814 do j=js, je
1815 do i=is, ie
1816 var0_3d(i,j,k,varid) = q(i,j,k) * ( dens_hyd(i,j,k) + ddens0(i,j,k) )
1817 vartmp_3d(i,j,k,varid) = 0.0_rp
1818 end do
1819 end do
1820 end do
1821 end if
1822
1823 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps ) then
1824 !$omp do collapse(2)
1825 !$acc loop collapse(3)
1826 do k=ks, ke
1827 do j=js, je
1828 do i=is, ie
1829 dens_ssm1 = dens_hyd(i,j,k) + ddens0(i,j,k) + c_ssm1 * ( ddens(i,j,k) - ddens0(i,j,k) )
1830 vartmp_3d(i,j,k,varid) = vartmp_3d(i,j,k,varid) &
1831 + sig_ns * q(i,j,k) * dens_ssm1 + gam_ns * tend_buf3d_ex(i,j,k,varid,1)
1832 end do
1833 end do
1834 end do
1835 end if
1836
1837 !$omp do collapse(2)
1838 !$acc loop collapse(3)
1839 do k=ks, ke
1840 do j=js, je
1841 do i=is, ie
1842 dens_ssm1 = dens_hyd(i,j,k) + ddens0(i,j,k) + c_ssm1 * ( ddens(i,j,k) - ddens0(i,j,k) )
1843 dens_ss = dens_hyd(i,j,k) + ddens0(i,j,k) + c_ss * ( ddens(i,j,k) - ddens0(i,j,k) )
1844
1845 q(i,j,k) = ( one_minus_sig_ss * var0_3d(i,j,k,varid) &
1846 + sig_ss * q(i,j,k) * dens_ssm1 + gam_ss * tend_buf3d_ex(i,j,k,varid,1) ) &
1847 / dens_ss
1848 end do
1849 end do
1850 end do
1851 !$acc end parallel
1852 !$omp end parallel
1853
1854 call prof_rapend( 'rk_advance_trcvar_low_storage3D', 3)
1855
1856 return
1857 end subroutine rk_advance_trcvar_low_storage3d
1858
1859
1860
1861!> Advance variable data at the current stage with explicit RK part (general case)
1862!!
1863!! @param nowstage Current stage
1864!! @param q Array to store variable data
1865!! @param varID Index of the targeting variable
1866!! @param is Index at which begins the loop for the corresponding direction
1867!! @param ie Index at which finishes the loop for the corresponding direction
1868!OCL SERIAL
1869 subroutine rk_advance_general1d( this, nowstage, q, varID, is, ie , IA, var_num, &
1870 var0_1D, varTmp_1d, tend_buf1D_ex, tend_buf1D_im )
1871 implicit none
1872 class(timeint_rk), intent(inout) :: this
1873 integer, intent(in) :: nowstage
1874 integer, intent(in) :: IA
1875 real(RP), intent(inout) :: q(IA)
1876 integer, intent(in) :: varID
1877 integer, intent(in) :: is, ie
1878 integer, intent(in) :: var_num
1879 real(RP), intent(inout) :: var0_1d(IA,var_num)
1880 real(RP), intent(inout) :: varTmp_1d(IA,var_num)
1881 real(RP), intent(inout) :: tend_buf1D_ex(IA,var_num,this%tend_buf_size)
1882 real(RP), intent(inout), optional :: tend_buf1D_im(IA,var_num,this%tend_buf_size)
1883
1884 integer :: i
1885 integer :: s
1886 integer :: tintbuf_ind
1887
1888 real(RP) :: coef_a_ex_dt
1889 real(RP) :: coef_a_im_dt
1890 real(RP) :: coef_b_ex_dt
1891 real(RP) :: coef_b_im_dt
1892 !----------------------------------------
1893
1894 call prof_rapstart( 'rk_advance_general1D', 3)
1895
1896 tintbuf_ind = this%tend_buf_indmap(nowstage)
1897
1898 if ( nowstage == 1 .and. (.not. this%imex_flag) ) then
1899 !$omp parallel do
1900 !$acc parallel loop collapse(1) present( q, var0_1d, varTmp_1d )
1901 do i=is, ie
1902 var0_1d(i,varid) = q(i)
1903 vartmp_1d(i,varid) = q(i)
1904 end do
1905 end if
1906
1907 if ( nowstage == this%nstage ) then
1908 if ( this%imex_flag ) then
1909 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
1910 coef_b_im_dt = this%coef_b_im(nowstage) * this%dt
1911 !$omp parallel do
1912 !$acc parallel loop collapse(1) present( q, varTmp_1d, tend_buf1D_ex, tend_buf1D_im )
1913 do i=is, ie
1914 q(i) = vartmp_1d(i,varid) &
1915 + coef_b_ex_dt * tend_buf1d_ex(i,varid,tintbuf_ind) &
1916 + coef_b_im_dt * tend_buf1d_im(i,varid,tintbuf_ind)
1917 end do
1918 else
1919 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
1920
1921 !$omp parallel do
1922 !$acc parallel loop collapse(1) present( q, varTmp_1d, tend_buf1D_ex )
1923 do i=is, ie
1924 q(i) = vartmp_1d(i,varid) &
1925 + coef_b_ex_dt * tend_buf1d_ex(i,varid,tintbuf_ind)
1926 end do
1927 end if
1928 call prof_rapend( 'rk_advance_general1D', 3)
1929
1930 return
1931 end if
1932
1933 !$omp parallel private( s, coef_a_ex_dt, coef_a_im_dt, coef_b_ex_dt, coef_b_im_dt ) &
1934 !$omp private( i )
1935 !$acc parallel present( q, var0_1D, varTmp_1D, tend_buf1D_ex, tend_buf1D_im )
1936
1937 if ( this%imex_flag ) then
1938 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
1939 coef_b_im_dt = this%coef_b_im(nowstage) * this%dt
1940
1941 !$omp do
1942 !$acc loop
1943 do i=is, ie
1944 q(i) = var0_1d(i,varid)
1945 vartmp_1d(i,varid) = vartmp_1d(i,varid) &
1946 + coef_b_ex_dt * tend_buf1d_ex(i,varid,tintbuf_ind) &
1947 + coef_b_im_dt * tend_buf1d_im(i,varid,tintbuf_ind)
1948 end do
1949 else
1950 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
1951
1952 !$omp do
1953 !$acc loop
1954 do i=is, ie
1955 q(i) = var0_1d(i,varid)
1956 vartmp_1d(i,varid) = vartmp_1d(i,varid) &
1957 + coef_b_ex_dt * tend_buf1d_ex(i,varid,tintbuf_ind)
1958 end do
1959 end if
1960
1961 if ( this%tend_buf_size == 1 .and. (.not. this%imex_flag) ) then
1962 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,nowstage)
1963 !$omp do
1964 !$acc loop
1965 do i=is, ie
1966 q(i) = var0_1d(i,varid) &
1967 + coef_a_ex_dt * tend_buf1d_ex(i,varid,1)
1968 end do
1969 else if ( .not. this%imex_flag ) then
1970 do s=1, nowstage
1971 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,s)
1972 !$omp do
1973 !$acc loop
1974 do i=is, ie
1975 q(i) = q(i) &
1976 + coef_a_ex_dt * tend_buf1d_ex(i,varid,s)
1977 end do
1978 end do
1979 else ! IMEX
1980 do s=1, nowstage
1981 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,s)
1982 coef_a_im_dt = this%dt * this%coef_a_im(nowstage+1,s)
1983 !$omp do
1984 !$acc loop
1985 do i=is, ie
1986 q(i) = q(i) &
1987 + coef_a_ex_dt * tend_buf1d_ex(i,varid,s) &
1988 + coef_a_im_dt * tend_buf1d_im(i,varid,s)
1989 end do
1990 end do
1991 end if
1992 !$acc end parallel
1993 !$omp end parallel
1994 call prof_rapend( 'rk_advance_general1D', 3)
1995
1996 return
1997 end subroutine rk_advance_general1d
1998
1999!> Advance tracer variable data at the current stage with explicit RK part (general case)
2000!!
2001!! @param nowstage Current stage
2002!! @param q Array to store tracer variable data
2003!! @param varID Index of the targeting variable
2004!! @param is Index at which begins the loop for the corresponding direction
2005!! @param ie Index at which finishes the loop for the corresponding direction
2006!! @param DDENS Array to store density perturbation data at the time level n+1
2007!! @param DDENS0 Array to store density perturbation data at the time level n
2008!! @param DENS_hyd Array to hydrostatic part of density
2009!OCL SERIAL
2010 subroutine rk_advance_trcvar_general1d( this, nowstage, q, varID, is, ie , IA, var_num, &
2011 DDENS, DDENS0, DENS_hyd, &
2012 var0_1D, varTmp_1d, tend_buf1D_ex )
2013 implicit none
2014 class(timeint_rk), intent(inout) :: this
2015 integer, intent(in) :: nowstage
2016 integer, intent(in) :: IA
2017 real(RP), intent(inout) :: q(IA)
2018 integer, intent(in) :: varID
2019 integer, intent(in) :: is, ie
2020 integer, intent(in) :: var_num
2021 real(RP), intent(in) :: DDENS (IA)
2022 real(RP), intent(in) :: DDENS0(IA)
2023 real(RP), intent(in) :: DENS_hyd(IA)
2024 real(RP), intent(inout) :: var0_1d(IA,var_num)
2025 real(RP), intent(inout) :: varTmp_1d(IA,var_num)
2026 real(RP), intent(inout) :: tend_buf1D_ex(IA,var_num,this%tend_buf_size)
2027
2028 integer :: i
2029 integer :: s
2030 integer :: tintbuf_ind
2031
2032 real(RP) :: dens_
2033
2034 real(RP) :: coef_a_ex
2035 real(RP) :: coef_a_ex_dt
2036 real(RP) :: coef_b_ex_dt
2037 real(RP) :: c_ss
2038 !----------------------------------------
2039
2040 call prof_rapstart( 'rk_advance_trcvar_general1D', 3)
2041
2042 tintbuf_ind = this%tend_buf_indmap(nowstage)
2043
2044 if ( this%nstage == 1 ) then
2045 !$omp parallel do
2046 !$acc parallel loop present( q, varTmp_1d, DDENS0, DENS_hyd )
2047 do i=is, ie
2048 vartmp_1d(i,varid) = q(i) * ( dens_hyd(i) + ddens0(i) )
2049 end do
2050 end if
2051
2052 if ( nowstage == this%nstage ) then
2053 coef_b_ex_dt = this%dt * this%coef_b_ex(nowstage)
2054 !$omp parallel do
2055 !$acc parallel loop present( q, varTmp_1d, DDENS, DENS_hyd )
2056 do i=is, ie
2057 q(i) = ( vartmp_1d(i,varid) &
2058 + coef_b_ex_dt * tend_buf1d_ex(i,varid,tintbuf_ind) ) &
2059 / ( dens_hyd(i) + ddens(i) )
2060 end do
2061 call prof_rapend( 'rk_advance_trcvar_general1D', 3)
2062
2063 return
2064 end if
2065
2066 c_ss = this%coef_c_ex(nowstage+1)
2067
2068 !$omp parallel private( s, dens_, coef_a_ex, coef_a_ex_dt, coef_b_ex_dt ) &
2069 !$omp private( i )
2070 !$acc parallel present( q, var0_1D, varTmp_1D, tend_buf1D_ex, DDENS, DDENS0, DENS_hyd )
2071
2072 if ( nowstage == 1 .and. (.not. this%imex_flag) ) then
2073 !$omp do
2074 !$acc loop
2075 do i=is, ie
2076 var0_1d(i,varid) = q(i) * ( dens_hyd(i) + ddens0(i) )
2077 vartmp_1d(i,varid) = var0_1d(i,varid)
2078 end do
2079 end if
2080
2081 coef_b_ex_dt = this%dt * this%coef_b_ex(nowstage)
2082 !$omp do
2083 !$acc loop
2084 do i=is, ie
2085 q(i) = this%var0_1d(i,varid)
2086 vartmp_1d(i,varid) = vartmp_1d(i,varid) &
2087 + coef_b_ex_dt * tend_buf1d_ex(i,varid,tintbuf_ind)
2088 end do
2089
2090 if ( this%tend_buf_size == 1 .and. (.not. this%imex_flag) ) then
2091 coef_a_ex = this%coef_a_ex(nowstage+1,nowstage)
2092 coef_b_ex_dt = this%dt * this%coef_a_ex(nowstage+1,nowstage)
2093 !$omp do
2094 !$acc loop
2095 do i=is, ie
2096 dens_ = ( dens_hyd(i) + ddens0(i) ) &
2097 + coef_a_ex * ( ddens(i) - ddens0(i) )
2098 q(i) = ( var0_1d(i,varid) &
2099 + coef_b_ex_dt * tend_buf1d_ex(i,varid,1) ) &
2100 / dens_
2101 end do
2102 else if ( .not. this%imex_flag ) then
2103 do s=1, nowstage
2104 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,s)
2105 !$omp do
2106 !$acc loop
2107 do i=is, ie
2108 q(i) = q(i) &
2109 + coef_a_ex_dt * tend_buf1d_ex(i,varid,s)
2110 end do
2111 end do
2112 !$omp do
2113 !$acc loop
2114 do i=is, ie
2115 dens_ = dens_hyd(i) + ddens0(i) + c_ss * ( ddens(i) - ddens0(i) )
2116 q(i) = q(i) / dens_
2117 end do
2118 end if
2119 !$acc end parallel
2120 !$omp end parallel
2121 call prof_rapend( 'rk_advance_trcvar_generall1D', 3)
2122
2123 return
2124 end subroutine rk_advance_trcvar_general1d
2125
2126!> Store variable data after the implicit part of current stage in IMEX RK scheme (general case)
2127!!
2128!! @param nowstage Current stage
2129!! @param q Array to store variable data after the implicit part of current stage
2130!! @param varID Index of the targeting variable
2131!! @param is Index at which begins the loop for the corresponding direction
2132!! @param ie Index at which finishes the loop for the corresponding direction
2133!OCL SERIAL
2134 subroutine rk_storeimpl_general1d( this, nowstage, q, varID, is, ie , IA, var_num, &
2135 var0_1D, varTmp_1d, tend_buf1D_im )
2136 implicit none
2137 class(timeint_rk), intent(inout) :: this
2138 integer, intent(in) :: nowstage
2139 integer, intent(in) :: IA
2140 real(RP), intent(inout) :: q(IA)
2141 integer, intent(in) :: varID
2142 integer, intent(in) :: is, ie
2143 integer, intent(in) :: var_num
2144 real(RP), intent(inout) :: var0_1d(IA,var_num)
2145 real(RP), intent(inout) :: varTmp_1d(IA,var_num)
2146 real(RP), intent(inout) :: tend_buf1D_im(IA,var_num,this%tend_buf_size)
2147
2148 integer :: i
2149 integer :: tintbuf_ind
2150 real(RP) :: coef_a_im_dt
2151 !----------------------------------------
2152
2153 if (.not. this%imex_flag ) return
2154
2155 tintbuf_ind = this%tend_buf_indmap(nowstage)
2156 coef_a_im_dt = this%dt * this%coef_a_im(nowstage,nowstage)
2157
2158 !$omp parallel
2159 !$acc parallel present( q, var0_1D, varTmp_1D, tend_buf1D_im )
2160
2161 if ( nowstage == 1 ) then
2162 !$omp do
2163 !$acc loop
2164 do i=is, ie
2165 var0_1d(i,varid) = q(i)
2166 vartmp_1d(i,varid) = q(i)
2167 end do
2168 end if
2169
2170 !$omp do
2171 !$acc loop
2172 do i=is, ie
2173 q(i) = q(i) &
2174 + coef_a_im_dt * tend_buf1d_im(i,varid,tintbuf_ind)
2175 end do
2176 !$acc end parallel
2177 !$omp end parallel
2178
2179 return
2180 end subroutine rk_storeimpl_general1d
2181
2182
2183!> Advance variable data at the current stage with explicit RK part (general case)
2184!!
2185!! @param nowstage Current stage
2186!! @param q Array to store variable data
2187!! @param varID Index of the targeting variable
2188!! @param is Index at which begins the loop for the corresponding direction
2189!! @param ie Index at which finishes the loop for the corresponding direction
2190!! @param js Index at which begins the loop for the corresponding direction
2191!! @param je Index at which finishes the loop for the corresponding direction
2192!OCL SERIAL
2193 subroutine rk_advance_general2d( this, nowstage, q, varID, is, ie ,js, je , IA,JA, var_num, &
2194 var0_2D, varTmp_2d, tend_buf2D_ex, tend_buf2D_im )
2195 implicit none
2196 class(timeint_rk), intent(inout) :: this
2197 integer, intent(in) :: nowstage
2198 integer, intent(in) :: IA,JA
2199 real(RP), intent(inout) :: q(IA,JA)
2200 integer, intent(in) :: varID
2201 integer, intent(in) :: is, ie ,js, je
2202 integer, intent(in) :: var_num
2203 real(RP), intent(inout) :: var0_2d(IA,JA,var_num)
2204 real(RP), intent(inout) :: varTmp_2d(IA,JA,var_num)
2205 real(RP), intent(inout) :: tend_buf2D_ex(IA,JA,var_num,this%tend_buf_size)
2206 real(RP), intent(inout), optional :: tend_buf2D_im(IA,JA,var_num,this%tend_buf_size)
2207
2208 integer :: i,j
2209 integer :: s
2210 integer :: tintbuf_ind
2211
2212 real(RP) :: coef_a_ex_dt
2213 real(RP) :: coef_a_im_dt
2214 real(RP) :: coef_b_ex_dt
2215 real(RP) :: coef_b_im_dt
2216 !----------------------------------------
2217
2218 call prof_rapstart( 'rk_advance_general2D', 3)
2219
2220 tintbuf_ind = this%tend_buf_indmap(nowstage)
2221
2222 if ( nowstage == 1 .and. (.not. this%imex_flag) ) then
2223 !$omp parallel do
2224 !$acc parallel loop collapse(2) present( q, var0_2d, varTmp_2d )
2225 do j=js, je
2226 do i=is, ie
2227 var0_2d(i,j,varid) = q(i,j)
2228 vartmp_2d(i,j,varid) = q(i,j)
2229 end do
2230 end do
2231 end if
2232
2233 if ( nowstage == this%nstage ) then
2234 if ( this%imex_flag ) then
2235 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
2236 coef_b_im_dt = this%coef_b_im(nowstage) * this%dt
2237 !$omp parallel do
2238 !$acc parallel loop collapse(2) present( q, varTmp_2d, tend_buf2D_ex, tend_buf2D_im )
2239 do j=js, je
2240 do i=is, ie
2241 q(i,j) = vartmp_2d(i,j,varid) &
2242 + coef_b_ex_dt * tend_buf2d_ex(i,j,varid,tintbuf_ind) &
2243 + coef_b_im_dt * tend_buf2d_im(i,j,varid,tintbuf_ind)
2244 end do
2245 end do
2246 else
2247 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
2248
2249 !$omp parallel do
2250 !$acc parallel loop collapse(2) present( q, varTmp_2d, tend_buf2D_ex )
2251 do j=js, je
2252 do i=is, ie
2253 q(i,j) = vartmp_2d(i,j,varid) &
2254 + coef_b_ex_dt * tend_buf2d_ex(i,j,varid,tintbuf_ind)
2255 end do
2256 end do
2257 end if
2258 call prof_rapend( 'rk_advance_general2D', 3)
2259
2260 return
2261 end if
2262
2263 !$omp parallel private( s, coef_a_ex_dt, coef_a_im_dt, coef_b_ex_dt, coef_b_im_dt ) &
2264 !$omp private( i,j )
2265 !$acc parallel present( q, var0_2D, varTmp_2D, tend_buf2D_ex, tend_buf2D_im )
2266
2267 if ( this%imex_flag ) then
2268 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
2269 coef_b_im_dt = this%coef_b_im(nowstage) * this%dt
2270
2271 !$omp do
2272 !$acc loop collapse(2)
2273 do j=js, je
2274 do i=is, ie
2275 q(i,j) = var0_2d(i,j,varid)
2276 vartmp_2d(i,j,varid) = vartmp_2d(i,j,varid) &
2277 + coef_b_ex_dt * tend_buf2d_ex(i,j,varid,tintbuf_ind) &
2278 + coef_b_im_dt * tend_buf2d_im(i,j,varid,tintbuf_ind)
2279 end do
2280 end do
2281 else
2282 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
2283
2284 !$omp do
2285 !$acc loop collapse(2)
2286 do j=js, je
2287 do i=is, ie
2288 q(i,j) = var0_2d(i,j,varid)
2289 vartmp_2d(i,j,varid) = vartmp_2d(i,j,varid) &
2290 + coef_b_ex_dt * tend_buf2d_ex(i,j,varid,tintbuf_ind)
2291 end do
2292 end do
2293 end if
2294
2295 if ( this%tend_buf_size == 1 .and. (.not. this%imex_flag) ) then
2296 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,nowstage)
2297 !$omp do
2298 !$acc loop collapse(2)
2299 do j=js, je
2300 do i=is, ie
2301 q(i,j) = var0_2d(i,j,varid) &
2302 + coef_a_ex_dt * tend_buf2d_ex(i,j,varid,1)
2303 end do
2304 end do
2305 else if ( .not. this%imex_flag ) then
2306 do s=1, nowstage
2307 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,s)
2308 !$omp do
2309 !$acc loop collapse(2)
2310 do j=js, je
2311 do i=is, ie
2312 q(i,j) = q(i,j) &
2313 + coef_a_ex_dt * tend_buf2d_ex(i,j,varid,s)
2314 end do
2315 end do
2316 end do
2317 else ! IMEX
2318 do s=1, nowstage
2319 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,s)
2320 coef_a_im_dt = this%dt * this%coef_a_im(nowstage+1,s)
2321 !$omp do
2322 !$acc loop collapse(2)
2323 do j=js, je
2324 do i=is, ie
2325 q(i,j) = q(i,j) &
2326 + coef_a_ex_dt * tend_buf2d_ex(i,j,varid,s) &
2327 + coef_a_im_dt * tend_buf2d_im(i,j,varid,s)
2328 end do
2329 end do
2330 end do
2331 end if
2332 !$acc end parallel
2333 !$omp end parallel
2334 call prof_rapend( 'rk_advance_general2D', 3)
2335
2336 return
2337 end subroutine rk_advance_general2d
2338
2339!> Advance tracer variable data at the current stage with explicit RK part (general case)
2340!!
2341!! @param nowstage Current stage
2342!! @param q Array to store tracer variable data
2343!! @param varID Index of the targeting variable
2344!! @param is Index at which begins the loop for the corresponding direction
2345!! @param ie Index at which finishes the loop for the corresponding direction
2346!! @param js Index at which begins the loop for the corresponding direction
2347!! @param je Index at which finishes the loop for the corresponding direction
2348!! @param DDENS Array to store density perturbation data at the time level n+1
2349!! @param DDENS0 Array to store density perturbation data at the time level n
2350!! @param DENS_hyd Array to hydrostatic part of density
2351!OCL SERIAL
2352 subroutine rk_advance_trcvar_general2d( this, nowstage, q, varID, is, ie ,js, je , IA,JA, var_num, &
2353 DDENS, DDENS0, DENS_hyd, &
2354 var0_2D, varTmp_2d, tend_buf2D_ex )
2355 implicit none
2356 class(timeint_rk), intent(inout) :: this
2357 integer, intent(in) :: nowstage
2358 integer, intent(in) :: IA,JA
2359 real(RP), intent(inout) :: q(IA,JA)
2360 integer, intent(in) :: varID
2361 integer, intent(in) :: is, ie ,js, je
2362 integer, intent(in) :: var_num
2363 real(RP), intent(in) :: DDENS (IA,JA)
2364 real(RP), intent(in) :: DDENS0(IA,JA)
2365 real(RP), intent(in) :: DENS_hyd(IA,JA)
2366 real(RP), intent(inout) :: var0_2d(IA,JA,var_num)
2367 real(RP), intent(inout) :: varTmp_2d(IA,JA,var_num)
2368 real(RP), intent(inout) :: tend_buf2D_ex(IA,JA,var_num,this%tend_buf_size)
2369
2370 integer :: i,j
2371 integer :: s
2372 integer :: tintbuf_ind
2373
2374 real(RP) :: dens_
2375
2376 real(RP) :: coef_a_ex
2377 real(RP) :: coef_a_ex_dt
2378 real(RP) :: coef_b_ex_dt
2379 real(RP) :: c_ss
2380 !----------------------------------------
2381
2382 call prof_rapstart( 'rk_advance_trcvar_general2D', 3)
2383
2384 tintbuf_ind = this%tend_buf_indmap(nowstage)
2385
2386 if ( this%nstage == 1 ) then
2387 !$omp parallel do
2388 !$acc parallel loop collapse(2) present( q, varTmp_2d, DDENS0, DENS_hyd )
2389 do j=js, je
2390 do i=is, ie
2391 vartmp_2d(i,j,varid) = q(i,j) * ( dens_hyd(i,j) + ddens0(i,j) )
2392 end do
2393 end do
2394 end if
2395
2396 if ( nowstage == this%nstage ) then
2397 coef_b_ex_dt = this%dt * this%coef_b_ex(nowstage)
2398 !$omp parallel do
2399 !$acc parallel loop collapse(2) present( q, varTmp_2d, DDENS, DENS_hyd )
2400 do j=js, je
2401 do i=is, ie
2402 q(i,j) = ( vartmp_2d(i,j,varid) &
2403 + coef_b_ex_dt * tend_buf2d_ex(i,j,varid,tintbuf_ind) ) &
2404 / ( dens_hyd(i,j) + ddens(i,j) )
2405 end do
2406 end do
2407 call prof_rapend( 'rk_advance_trcvar_general2D', 3)
2408
2409 return
2410 end if
2411
2412 c_ss = this%coef_c_ex(nowstage+1)
2413
2414 !$omp parallel private( s, dens_, coef_a_ex, coef_a_ex_dt, coef_b_ex_dt ) &
2415 !$omp private( i,j )
2416 !$acc parallel present( q, var0_2D, varTmp_2D, tend_buf2D_ex, DDENS, DDENS0, DENS_hyd )
2417
2418 if ( nowstage == 1 .and. (.not. this%imex_flag) ) then
2419 !$omp do
2420 !$acc loop collapse(2)
2421 do j=js, je
2422 do i=is, ie
2423 var0_2d(i,j,varid) = q(i,j) * ( dens_hyd(i,j) + ddens0(i,j) )
2424 vartmp_2d(i,j,varid) = var0_2d(i,j,varid)
2425 end do
2426 end do
2427 end if
2428
2429 coef_b_ex_dt = this%dt * this%coef_b_ex(nowstage)
2430 !$omp do
2431 !$acc loop collapse(2)
2432 do j=js, je
2433 do i=is, ie
2434 q(i,j) = this%var0_2d(i,j,varid)
2435 vartmp_2d(i,j,varid) = vartmp_2d(i,j,varid) &
2436 + coef_b_ex_dt * tend_buf2d_ex(i,j,varid,tintbuf_ind)
2437 end do
2438 end do
2439
2440 if ( this%tend_buf_size == 1 .and. (.not. this%imex_flag) ) then
2441 coef_a_ex = this%coef_a_ex(nowstage+1,nowstage)
2442 coef_b_ex_dt = this%dt * this%coef_a_ex(nowstage+1,nowstage)
2443 !$omp do
2444 !$acc loop collapse(2)
2445 do j=js, je
2446 do i=is, ie
2447 dens_ = ( dens_hyd(i,j) + ddens0(i,j) ) &
2448 + coef_a_ex * ( ddens(i,j) - ddens0(i,j) )
2449 q(i,j) = ( var0_2d(i,j,varid) &
2450 + coef_b_ex_dt * tend_buf2d_ex(i,j,varid,1) ) &
2451 / dens_
2452 end do
2453 end do
2454 else if ( .not. this%imex_flag ) then
2455 do s=1, nowstage
2456 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,s)
2457 !$omp do
2458 !$acc loop collapse(2)
2459 do j=js, je
2460 do i=is, ie
2461 q(i,j) = q(i,j) &
2462 + coef_a_ex_dt * tend_buf2d_ex(i,j,varid,s)
2463 end do
2464 end do
2465 end do
2466 !$omp do
2467 !$acc loop collapse(2)
2468 do j=js, je
2469 do i=is, ie
2470 dens_ = dens_hyd(i,j) + ddens0(i,j) + c_ss * ( ddens(i,j) - ddens0(i,j) )
2471 q(i,j) = q(i,j) / dens_
2472 end do
2473 end do
2474 end if
2475 !$acc end parallel
2476 !$omp end parallel
2477 call prof_rapend( 'rk_advance_trcvar_generall2D', 3)
2478
2479 return
2480 end subroutine rk_advance_trcvar_general2d
2481
2482!> Store variable data after the implicit part of current stage in IMEX RK scheme (general case)
2483!!
2484!! @param nowstage Current stage
2485!! @param q Array to store variable data after the implicit part of current stage
2486!! @param varID Index of the targeting variable
2487!! @param is Index at which begins the loop for the corresponding direction
2488!! @param ie Index at which finishes the loop for the corresponding direction
2489!! @param js Index at which begins the loop for the corresponding direction
2490!! @param je Index at which finishes the loop for the corresponding direction
2491!OCL SERIAL
2492 subroutine rk_storeimpl_general2d( this, nowstage, q, varID, is, ie ,js, je , IA,JA, var_num, &
2493 var0_2D, varTmp_2d, tend_buf2D_im )
2494 implicit none
2495 class(timeint_rk), intent(inout) :: this
2496 integer, intent(in) :: nowstage
2497 integer, intent(in) :: IA,JA
2498 real(RP), intent(inout) :: q(IA,JA)
2499 integer, intent(in) :: varID
2500 integer, intent(in) :: is, ie ,js, je
2501 integer, intent(in) :: var_num
2502 real(RP), intent(inout) :: var0_2d(IA,JA,var_num)
2503 real(RP), intent(inout) :: varTmp_2d(IA,JA,var_num)
2504 real(RP), intent(inout) :: tend_buf2D_im(IA,JA,var_num,this%tend_buf_size)
2505
2506 integer :: i,j
2507 integer :: tintbuf_ind
2508 real(RP) :: coef_a_im_dt
2509 !----------------------------------------
2510
2511 if (.not. this%imex_flag ) return
2512
2513 tintbuf_ind = this%tend_buf_indmap(nowstage)
2514 coef_a_im_dt = this%dt * this%coef_a_im(nowstage,nowstage)
2515
2516 !$omp parallel
2517 !$acc parallel present( q, var0_2D, varTmp_2D, tend_buf2D_im )
2518
2519 if ( nowstage == 1 ) then
2520 !$omp do
2521 !$acc loop collapse(2)
2522 do j=js, je
2523 do i=is, ie
2524 var0_2d(i,j,varid) = q(i,j)
2525 vartmp_2d(i,j,varid) = q(i,j)
2526 end do
2527 end do
2528 end if
2529
2530 !$omp do
2531 !$acc loop collapse(2)
2532 do j=js, je
2533 do i=is, ie
2534 q(i,j) = q(i,j) &
2535 + coef_a_im_dt * tend_buf2d_im(i,j,varid,tintbuf_ind)
2536 end do
2537 end do
2538 !$acc end parallel
2539 !$omp end parallel
2540
2541 return
2542 end subroutine rk_storeimpl_general2d
2543
2544
2545!> Advance variable data at the current stage with explicit RK part (general case)
2546!!
2547!! @param nowstage Current stage
2548!! @param q Array to store variable data
2549!! @param varID Index of the targeting variable
2550!! @param is Index at which begins the loop for the corresponding direction
2551!! @param ie Index at which finishes the loop for the corresponding direction
2552!! @param js Index at which begins the loop for the corresponding direction
2553!! @param je Index at which finishes the loop for the corresponding direction
2554!! @param ks Index at which begins the loop for the corresponding direction
2555!! @param ke Index at which finishes the loop for the corresponding direction
2556!OCL SERIAL
2557 subroutine rk_advance_general3d( this, nowstage, q, varID, is, ie ,js, je ,ks, ke , IA,JA,KA, var_num, &
2558 var0_3D, varTmp_3d, tend_buf3D_ex, tend_buf3D_im )
2559 implicit none
2560 class(timeint_rk), intent(inout) :: this
2561 integer, intent(in) :: nowstage
2562 integer, intent(in) :: IA,JA,KA
2563 real(RP), intent(inout) :: q(IA,JA,KA)
2564 integer, intent(in) :: varID
2565 integer, intent(in) :: is, ie ,js, je ,ks, ke
2566 integer, intent(in) :: var_num
2567 real(RP), intent(inout) :: var0_3d(IA,JA,KA,var_num)
2568 real(RP), intent(inout) :: varTmp_3d(IA,JA,KA,var_num)
2569 real(RP), intent(inout) :: tend_buf3D_ex(IA,JA,KA,var_num,this%tend_buf_size)
2570 real(RP), intent(inout), optional :: tend_buf3D_im(IA,JA,KA,var_num,this%tend_buf_size)
2571
2572 integer :: i,j,k
2573 integer :: s
2574 integer :: tintbuf_ind
2575
2576 real(RP) :: coef_a_ex_dt
2577 real(RP) :: coef_a_im_dt
2578 real(RP) :: coef_b_ex_dt
2579 real(RP) :: coef_b_im_dt
2580 !----------------------------------------
2581
2582 call prof_rapstart( 'rk_advance_general3D', 3)
2583
2584 tintbuf_ind = this%tend_buf_indmap(nowstage)
2585
2586 if ( nowstage == 1 .and. (.not. this%imex_flag) ) then
2587 !$omp parallel do collapse(2)
2588 !$acc parallel loop collapse(3) present( q, var0_3d, varTmp_3d )
2589 do k=ks, ke
2590 do j=js, je
2591 do i=is, ie
2592 var0_3d(i,j,k,varid) = q(i,j,k)
2593 vartmp_3d(i,j,k,varid) = q(i,j,k)
2594 end do
2595 end do
2596 end do
2597 end if
2598
2599 if ( nowstage == this%nstage ) then
2600 if ( this%imex_flag ) then
2601 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
2602 coef_b_im_dt = this%coef_b_im(nowstage) * this%dt
2603 !$omp parallel do collapse(2)
2604 !$acc parallel loop collapse(3) present( q, varTmp_3d, tend_buf3D_ex, tend_buf3D_im )
2605 do k=ks, ke
2606 do j=js, je
2607 do i=is, ie
2608 q(i,j,k) = vartmp_3d(i,j,k,varid) &
2609 + coef_b_ex_dt * tend_buf3d_ex(i,j,k,varid,tintbuf_ind) &
2610 + coef_b_im_dt * tend_buf3d_im(i,j,k,varid,tintbuf_ind)
2611 end do
2612 end do
2613 end do
2614 else
2615 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
2616
2617 !$omp parallel do collapse(2)
2618 !$acc parallel loop collapse(3) present( q, varTmp_3d, tend_buf3D_ex )
2619 do k=ks, ke
2620 do j=js, je
2621 do i=is, ie
2622 q(i,j,k) = vartmp_3d(i,j,k,varid) &
2623 + coef_b_ex_dt * tend_buf3d_ex(i,j,k,varid,tintbuf_ind)
2624 end do
2625 end do
2626 end do
2627 end if
2628 call prof_rapend( 'rk_advance_general3D', 3)
2629
2630 return
2631 end if
2632
2633 !$omp parallel private( s, coef_a_ex_dt, coef_a_im_dt, coef_b_ex_dt, coef_b_im_dt ) &
2634 !$omp private( i,j,k )
2635 !$acc parallel present( q, var0_3D, varTmp_3D, tend_buf3D_ex, tend_buf3D_im )
2636
2637 if ( this%imex_flag ) then
2638 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
2639 coef_b_im_dt = this%coef_b_im(nowstage) * this%dt
2640
2641 !$omp do collapse(2)
2642 !$acc loop collapse(3)
2643 do k=ks, ke
2644 do j=js, je
2645 do i=is, ie
2646 q(i,j,k) = var0_3d(i,j,k,varid)
2647 vartmp_3d(i,j,k,varid) = vartmp_3d(i,j,k,varid) &
2648 + coef_b_ex_dt * tend_buf3d_ex(i,j,k,varid,tintbuf_ind) &
2649 + coef_b_im_dt * tend_buf3d_im(i,j,k,varid,tintbuf_ind)
2650 end do
2651 end do
2652 end do
2653 else
2654 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
2655
2656 !$omp do collapse(2)
2657 !$acc loop collapse(3)
2658 do k=ks, ke
2659 do j=js, je
2660 do i=is, ie
2661 q(i,j,k) = var0_3d(i,j,k,varid)
2662 vartmp_3d(i,j,k,varid) = vartmp_3d(i,j,k,varid) &
2663 + coef_b_ex_dt * tend_buf3d_ex(i,j,k,varid,tintbuf_ind)
2664 end do
2665 end do
2666 end do
2667 end if
2668
2669 if ( this%tend_buf_size == 1 .and. (.not. this%imex_flag) ) then
2670 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,nowstage)
2671 !$omp do collapse(2)
2672 !$acc loop collapse(3)
2673 do k=ks, ke
2674 do j=js, je
2675 do i=is, ie
2676 q(i,j,k) = var0_3d(i,j,k,varid) &
2677 + coef_a_ex_dt * tend_buf3d_ex(i,j,k,varid,1)
2678 end do
2679 end do
2680 end do
2681 else if ( .not. this%imex_flag ) then
2682 do s=1, nowstage
2683 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,s)
2684 !$omp do collapse(2)
2685 !$acc loop collapse(3)
2686 do k=ks, ke
2687 do j=js, je
2688 do i=is, ie
2689 q(i,j,k) = q(i,j,k) &
2690 + coef_a_ex_dt * tend_buf3d_ex(i,j,k,varid,s)
2691 end do
2692 end do
2693 end do
2694 end do
2695 else ! IMEX
2696 do s=1, nowstage
2697 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,s)
2698 coef_a_im_dt = this%dt * this%coef_a_im(nowstage+1,s)
2699 !$omp do collapse(2)
2700 !$acc loop collapse(3)
2701 do k=ks, ke
2702 do j=js, je
2703 do i=is, ie
2704 q(i,j,k) = q(i,j,k) &
2705 + coef_a_ex_dt * tend_buf3d_ex(i,j,k,varid,s) &
2706 + coef_a_im_dt * tend_buf3d_im(i,j,k,varid,s)
2707 end do
2708 end do
2709 end do
2710 end do
2711 end if
2712 !$acc end parallel
2713 !$omp end parallel
2714 call prof_rapend( 'rk_advance_general3D', 3)
2715
2716 return
2717 end subroutine rk_advance_general3d
2718
2719!> Advance tracer variable data at the current stage with explicit RK part (general case)
2720!!
2721!! @param nowstage Current stage
2722!! @param q Array to store tracer variable data
2723!! @param varID Index of the targeting variable
2724!! @param is Index at which begins the loop for the corresponding direction
2725!! @param ie Index at which finishes the loop for the corresponding direction
2726!! @param js Index at which begins the loop for the corresponding direction
2727!! @param je Index at which finishes the loop for the corresponding direction
2728!! @param ks Index at which begins the loop for the corresponding direction
2729!! @param ke Index at which finishes the loop for the corresponding direction
2730!! @param DDENS Array to store density perturbation data at the time level n+1
2731!! @param DDENS0 Array to store density perturbation data at the time level n
2732!! @param DENS_hyd Array to hydrostatic part of density
2733!OCL SERIAL
2734 subroutine rk_advance_trcvar_general3d( this, nowstage, q, varID, is, ie ,js, je ,ks, ke , IA,JA,KA, var_num, &
2735 DDENS, DDENS0, DENS_hyd, &
2736 var0_3D, varTmp_3d, tend_buf3D_ex )
2737 implicit none
2738 class(timeint_rk), intent(inout) :: this
2739 integer, intent(in) :: nowstage
2740 integer, intent(in) :: IA,JA,KA
2741 real(RP), intent(inout) :: q(IA,JA,KA)
2742 integer, intent(in) :: varID
2743 integer, intent(in) :: is, ie ,js, je ,ks, ke
2744 integer, intent(in) :: var_num
2745 real(RP), intent(in) :: DDENS (IA,JA,KA)
2746 real(RP), intent(in) :: DDENS0(IA,JA,KA)
2747 real(RP), intent(in) :: DENS_hyd(IA,JA,KA)
2748 real(RP), intent(inout) :: var0_3d(IA,JA,KA,var_num)
2749 real(RP), intent(inout) :: varTmp_3d(IA,JA,KA,var_num)
2750 real(RP), intent(inout) :: tend_buf3D_ex(IA,JA,KA,var_num,this%tend_buf_size)
2751
2752 integer :: i,j,k
2753 integer :: s
2754 integer :: tintbuf_ind
2755
2756 real(RP) :: dens_
2757
2758 real(RP) :: coef_a_ex
2759 real(RP) :: coef_a_ex_dt
2760 real(RP) :: coef_b_ex_dt
2761 real(RP) :: c_ss
2762 !----------------------------------------
2763
2764 call prof_rapstart( 'rk_advance_trcvar_general3D', 3)
2765
2766 tintbuf_ind = this%tend_buf_indmap(nowstage)
2767
2768 if ( this%nstage == 1 ) then
2769 !$omp parallel do collapse(2)
2770 !$acc parallel loop collapse(3) present( q, varTmp_3d, DDENS0, DENS_hyd )
2771 do k=ks, ke
2772 do j=js, je
2773 do i=is, ie
2774 vartmp_3d(i,j,k,varid) = q(i,j,k) * ( dens_hyd(i,j,k) + ddens0(i,j,k) )
2775 end do
2776 end do
2777 end do
2778 end if
2779
2780 if ( nowstage == this%nstage ) then
2781 coef_b_ex_dt = this%dt * this%coef_b_ex(nowstage)
2782 !$omp parallel do collapse(2)
2783 !$acc parallel loop collapse(3) present( q, varTmp_3d, DDENS, DENS_hyd )
2784 do k=ks, ke
2785 do j=js, je
2786 do i=is, ie
2787 q(i,j,k) = ( vartmp_3d(i,j,k,varid) &
2788 + coef_b_ex_dt * tend_buf3d_ex(i,j,k,varid,tintbuf_ind) ) &
2789 / ( dens_hyd(i,j,k) + ddens(i,j,k) )
2790 end do
2791 end do
2792 end do
2793 call prof_rapend( 'rk_advance_trcvar_general3D', 3)
2794
2795 return
2796 end if
2797
2798 c_ss = this%coef_c_ex(nowstage+1)
2799
2800 !$omp parallel private( s, dens_, coef_a_ex, coef_a_ex_dt, coef_b_ex_dt ) &
2801 !$omp private( i,j,k )
2802 !$acc parallel present( q, var0_3D, varTmp_3D, tend_buf3D_ex, DDENS, DDENS0, DENS_hyd )
2803
2804 if ( nowstage == 1 .and. (.not. this%imex_flag) ) then
2805 !$omp do collapse(2)
2806 !$acc loop collapse(3)
2807 do k=ks, ke
2808 do j=js, je
2809 do i=is, ie
2810 var0_3d(i,j,k,varid) = q(i,j,k) * ( dens_hyd(i,j,k) + ddens0(i,j,k) )
2811 vartmp_3d(i,j,k,varid) = var0_3d(i,j,k,varid)
2812 end do
2813 end do
2814 end do
2815 end if
2816
2817 coef_b_ex_dt = this%dt * this%coef_b_ex(nowstage)
2818 !$omp do collapse(2)
2819 !$acc loop collapse(3)
2820 do k=ks, ke
2821 do j=js, je
2822 do i=is, ie
2823 q(i,j,k) = this%var0_3d(i,j,k,varid)
2824 vartmp_3d(i,j,k,varid) = vartmp_3d(i,j,k,varid) &
2825 + coef_b_ex_dt * tend_buf3d_ex(i,j,k,varid,tintbuf_ind)
2826 end do
2827 end do
2828 end do
2829
2830 if ( this%tend_buf_size == 1 .and. (.not. this%imex_flag) ) then
2831 coef_a_ex = this%coef_a_ex(nowstage+1,nowstage)
2832 coef_b_ex_dt = this%dt * this%coef_a_ex(nowstage+1,nowstage)
2833 !$omp do collapse(2)
2834 !$acc loop collapse(3)
2835 do k=ks, ke
2836 do j=js, je
2837 do i=is, ie
2838 dens_ = ( dens_hyd(i,j,k) + ddens0(i,j,k) ) &
2839 + coef_a_ex * ( ddens(i,j,k) - ddens0(i,j,k) )
2840 q(i,j,k) = ( var0_3d(i,j,k,varid) &
2841 + coef_b_ex_dt * tend_buf3d_ex(i,j,k,varid,1) ) &
2842 / dens_
2843 end do
2844 end do
2845 end do
2846 else if ( .not. this%imex_flag ) then
2847 do s=1, nowstage
2848 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,s)
2849 !$omp do collapse(2)
2850 !$acc loop collapse(3)
2851 do k=ks, ke
2852 do j=js, je
2853 do i=is, ie
2854 q(i,j,k) = q(i,j,k) &
2855 + coef_a_ex_dt * tend_buf3d_ex(i,j,k,varid,s)
2856 end do
2857 end do
2858 end do
2859 end do
2860 !$omp do collapse(2)
2861 !$acc loop collapse(3)
2862 do k=ks, ke
2863 do j=js, je
2864 do i=is, ie
2865 dens_ = dens_hyd(i,j,k) + ddens0(i,j,k) + c_ss * ( ddens(i,j,k) - ddens0(i,j,k) )
2866 q(i,j,k) = q(i,j,k) / dens_
2867 end do
2868 end do
2869 end do
2870 end if
2871 !$acc end parallel
2872 !$omp end parallel
2873 call prof_rapend( 'rk_advance_trcvar_generall3D', 3)
2874
2875 return
2876 end subroutine rk_advance_trcvar_general3d
2877
2878!> Store variable data after the implicit part of current stage in IMEX RK scheme (general case)
2879!!
2880!! @param nowstage Current stage
2881!! @param q Array to store variable data after the implicit part of current stage
2882!! @param varID Index of the targeting variable
2883!! @param is Index at which begins the loop for the corresponding direction
2884!! @param ie Index at which finishes the loop for the corresponding direction
2885!! @param js Index at which begins the loop for the corresponding direction
2886!! @param je Index at which finishes the loop for the corresponding direction
2887!! @param ks Index at which begins the loop for the corresponding direction
2888!! @param ke Index at which finishes the loop for the corresponding direction
2889!OCL SERIAL
2890 subroutine rk_storeimpl_general3d( this, nowstage, q, varID, is, ie ,js, je ,ks, ke , IA,JA,KA, var_num, &
2891 var0_3D, varTmp_3d, tend_buf3D_im )
2892 implicit none
2893 class(timeint_rk), intent(inout) :: this
2894 integer, intent(in) :: nowstage
2895 integer, intent(in) :: IA,JA,KA
2896 real(RP), intent(inout) :: q(IA,JA,KA)
2897 integer, intent(in) :: varID
2898 integer, intent(in) :: is, ie ,js, je ,ks, ke
2899 integer, intent(in) :: var_num
2900 real(RP), intent(inout) :: var0_3d(IA,JA,KA,var_num)
2901 real(RP), intent(inout) :: varTmp_3d(IA,JA,KA,var_num)
2902 real(RP), intent(inout) :: tend_buf3D_im(IA,JA,KA,var_num,this%tend_buf_size)
2903
2904 integer :: i,j,k
2905 integer :: tintbuf_ind
2906 real(RP) :: coef_a_im_dt
2907 !----------------------------------------
2908
2909 if (.not. this%imex_flag ) return
2910
2911 tintbuf_ind = this%tend_buf_indmap(nowstage)
2912 coef_a_im_dt = this%dt * this%coef_a_im(nowstage,nowstage)
2913
2914 !$omp parallel
2915 !$acc parallel present( q, var0_3D, varTmp_3D, tend_buf3D_im )
2916
2917 if ( nowstage == 1 ) then
2918 !$omp do collapse(2)
2919 !$acc loop collapse(3)
2920 do k=ks, ke
2921 do j=js, je
2922 do i=is, ie
2923 var0_3d(i,j,k,varid) = q(i,j,k)
2924 vartmp_3d(i,j,k,varid) = q(i,j,k)
2925 end do
2926 end do
2927 end do
2928 end if
2929
2930 !$omp do collapse(2)
2931 !$acc loop collapse(3)
2932 do k=ks, ke
2933 do j=js, je
2934 do i=is, ie
2935 q(i,j,k) = q(i,j,k) &
2936 + coef_a_im_dt * tend_buf3d_im(i,j,k,varid,tintbuf_ind)
2937 end do
2938 end do
2939 end do
2940 !$acc end parallel
2941 !$omp end parallel
2942
2943 return
2944 end subroutine rk_storeimpl_general3d
2945
2946end module scale_timeint_rk
Module common / Runge-Kutta scheme.
subroutine, public timeint_rk_butcher_tab_get_info(rk_scheme_name, nstage, tend_buf_size, low_storage_flag, imex_flag)
subroutine, public timeint_rk_butcher_tab_get(rk_scheme_name, nstage, imex_flag, coef_a_ex, coef_b_ex, coef_c_ex, coef_sig_ex, coef_gam_ex, coef_a_im, coef_b_im, coef_c_im, tend_buf_indmap)
Module common / Runge-Kutta scheme.
subroutine timeint_rk_init(this, rk_scheme_name, dt, var_num, ndim, size_each_var)
Initialize a object to provide RK scheme.
Derived type to store pointer to variable data when using varlist in RK advance procedures.
Derived type to provide RK scheme.