13#include "scaleFElib.h"
36 real(RP),
private :: dt
38 integer,
private :: rk_scheme_id_ex
39 integer,
private :: rk_scheme_id_im
41 integer,
private,
allocatable :: size_each_var(:)
42 integer,
public :: nstage
43 integer,
public :: tend_buf_size
46 real(rp),
public,
allocatable :: coef_a_ex(:,:)
47 real(rp),
public,
allocatable :: coef_b_ex(:)
48 real(rp),
public,
allocatable :: coef_c_ex(:)
51 real(rp),
public,
allocatable :: coef_sig_ex(:,:)
52 real(rp),
public,
allocatable :: coef_gam_ex(:,:)
55 real(rp),
public,
allocatable :: coef_a_im(:,:)
56 real(rp),
public,
allocatable :: coef_b_im(:)
57 real(rp),
public,
allocatable :: coef_c_im(:)
59 integer,
allocatable :: tend_buf_indmap(:)
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(:,:,:,:)
77 logical,
private :: low_storage_flag
78 logical,
public :: imex_flag
79 integer,
public :: ndim
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
109 real(rp),
pointer :: var1d(:)
110 real(rp),
pointer :: var2d(:,:)
111 real(rp),
pointer :: var3d(:,:,:)
136 rk_scheme_name, dt, var_num, ndim, size_each_var )
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)
154 this%var_num = var_num
155 allocate( this%size_each_var(ndim) )
156 this%size_each_var(:) = size_each_var(:)
161 this%nstage, this%tend_buf_size, &
162 this%low_storage_flag, this%imex_flag )
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) )
167 allocate ( this%coef_a_im(this%nstage,this%nstage), this%coef_b_im(this%nstage), this%coef_c_im(this%nstage) )
170 select case(this%ndim)
172 allocate( this%tend_buf1D_ex(size_each_var(1), var_num, this%tend_buf_size) )
174 if ( this%imex_flag )
then
175 allocate( this%tend_buf1D_im(size_each_var(1), var_num, this%tend_buf_size) )
177 allocate( this%tend_buf1D_im(1,1,1) )
180 allocate( this%var0_1D(size_each_var(1), var_num) )
181 allocate( this%varTmp_1D(size_each_var(1), var_num) )
184 allocate( this%tend_buf2D_ex(size_each_var(1),size_each_var(2), var_num, this%tend_buf_size) )
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) )
189 allocate( this%tend_buf2D_im(1,1,1,1) )
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) )
196 allocate( this%tend_buf3D_ex(size_each_var(1),size_each_var(2),size_each_var(3), var_num, this%tend_buf_size) )
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) )
201 allocate( this%tend_buf3D_im(1,1,1,1,1) )
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) )
208 allocate( this%tend_buf_indmap(this%nstage) )
211 rk_scheme_name, this%nstage, this%imex_flag, &
212 this%coef_a_ex, this%coef_b_ex, this%coef_c_ex, &
213 this%coef_sig_ex, this%coef_gam_ex, &
214 this%coef_a_im, this%coef_b_im, this%coef_c_im, &
215 this%tend_buf_indmap )
233 subroutine timeint_rk_final( this )
240 deallocate( this%coef_a_ex, this%coef_b_ex, this%coef_c_ex )
241 deallocate( this%coef_sig_ex, this%coef_gam_ex )
245 deallocate( this%coef_a_im, this%coef_b_im, this%coef_c_im )
249 deallocate( this%size_each_var, this%tend_buf_indmap )
251 select case(this%ndim)
254 deallocate( this%var0_1d )
255 deallocate( this%tend_buf1D_ex )
258 deallocate( this%tend_buf1D_im )
261 deallocate( this%varTmp_1d )
264 deallocate( this%var0_2d )
265 deallocate( this%tend_buf2D_ex )
268 deallocate( this%tend_buf2D_im )
271 deallocate( this%varTmp_2d )
274 deallocate( this%var0_3d )
275 deallocate( this%tend_buf3D_ex )
278 deallocate( this%tend_buf3D_im )
281 deallocate( this%varTmp_3d )
286 end subroutine timeint_rk_final
290 elemental function timeint_rk_get_deltime( this )
result(dt)
299 end function timeint_rk_get_deltime
304 elemental function timeint_rk_get_implicit_diagfac( this, nowstage )
result(fac)
307 integer,
intent(in) :: nowstage
311 fac = this%coef_a_im(nowstage,nowstage) * this%dt
314 end function timeint_rk_get_implicit_diagfac
325 subroutine timeint_rk_advance1d( this, nowstage, q, varID, is, ie )
328 integer,
intent(in) :: nowstage
329 real(RP),
intent(inout) :: q(:)
330 integer,
intent(in) :: varID
331 integer,
intent(in) :: is, ie
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)
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 )
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 )
350 end subroutine timeint_rk_advance1d
360 subroutine timeint_rk_advance1d_varlist( this, nowstage, var_list, varIDs, is, ie )
363 integer,
intent(in) :: nowstage
364 integer,
intent(in) :: varIDs(:)
366 integer,
intent(in) :: is, ie
374 if (this%low_storage_flag)
then
375 call prof_rapstart(
'rk_advance_varlist_low_storage1D', 3)
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 )
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 )
389 call prof_rapend(
'rk_advance_varlist_low_storage1D', 3)
392 call this%Advance1D( nowstage, var_list(i)%var1D, varids(i), is, ie )
397 end subroutine timeint_rk_advance1d_varlist
409 subroutine timeint_rk_advance_trcvar1d( this, nowstage, q, varID, is, ie , &
410 DDENS, DDENS0, DENS_hyd )
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(:)
422 if ( this%imex_flag )
then
423 if ( prc_ismaster )
write(*,*)
"timeint_rk_advence_trcvar: IMEX is not supported. Check!"
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 )
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 )
436 end subroutine timeint_rk_advance_trcvar1d
444 subroutine timeint_rk_store_var0_1d( this, q, varID, is, ie )
447 real(RP),
intent(inout) :: q(:)
448 integer,
intent(in) :: varID
449 integer,
intent(in) :: is, ie
459 this%var0_1D(i,varid) = q(i)
465 end subroutine timeint_rk_store_var0_1d
474 subroutine timeint_rk_storeimpl1d( this, nowstage, q, varID, is, ie )
477 integer,
intent(in) :: nowstage
478 real(RP),
intent(inout) :: q(:)
479 integer,
intent(in) :: varID
480 integer,
intent(in) :: is, ie
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 )
488 end subroutine timeint_rk_storeimpl1d
499 subroutine timeint_rk_advance2d( this, nowstage, q, varID, is, ie ,js, je )
502 integer,
intent(in) :: nowstage
503 real(RP),
intent(inout) :: q(:,:)
504 integer,
intent(in) :: varID
505 integer,
intent(in) :: is, ie ,js, je
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)
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 )
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 )
524 end subroutine timeint_rk_advance2d
536 subroutine timeint_rk_advance2d_varlist( this, nowstage, var_list, varIDs, is, ie ,js, je )
539 integer,
intent(in) :: nowstage
540 integer,
intent(in) :: varIDs(:)
542 integer,
intent(in) :: is, ie ,js, je
550 if (this%low_storage_flag)
then
551 call prof_rapstart(
'rk_advance_varlist_low_storage2D', 3)
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 )
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 )
565 call prof_rapend(
'rk_advance_varlist_low_storage2D', 3)
568 call this%Advance2D( nowstage, var_list(i)%var2D, varids(i), is, ie ,js, je )
573 end subroutine timeint_rk_advance2d_varlist
587 subroutine timeint_rk_advance_trcvar2d( this, nowstage, q, varID, is, ie ,js, je , &
588 DDENS, DDENS0, DENS_hyd )
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(:,:)
600 if ( this%imex_flag )
then
601 if ( prc_ismaster )
write(*,*)
"timeint_rk_advence_trcvar: IMEX is not supported. Check!"
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 )
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 )
614 end subroutine timeint_rk_advance_trcvar2d
624 subroutine timeint_rk_store_var0_2d( this, q, varID, is, ie ,js, je )
627 real(RP),
intent(inout) :: q(:,:)
628 integer,
intent(in) :: varID
629 integer,
intent(in) :: is, ie ,js, je
640 this%var0_2D(i,j,varid) = q(i,j)
647 end subroutine timeint_rk_store_var0_2d
658 subroutine timeint_rk_storeimpl2d( this, nowstage, q, varID, is, ie ,js, je )
661 integer,
intent(in) :: nowstage
662 real(RP),
intent(inout) :: q(:,:)
663 integer,
intent(in) :: varID
664 integer,
intent(in) :: is, ie ,js, je
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 )
672 end subroutine timeint_rk_storeimpl2d
685 subroutine timeint_rk_advance3d( this, nowstage, q, varID, is, ie ,js, je ,ks, ke )
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
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)
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 )
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 )
710 end subroutine timeint_rk_advance3d
724 subroutine timeint_rk_advance3d_varlist( this, nowstage, var_list, varIDs, is, ie ,js, je ,ks, ke )
727 integer,
intent(in) :: nowstage
728 integer,
intent(in) :: varIDs(:)
730 integer,
intent(in) :: is, ie ,js, je ,ks, ke
738 if (this%low_storage_flag)
then
739 call prof_rapstart(
'rk_advance_varlist_low_storage3D', 3)
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 )
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 )
753 call prof_rapend(
'rk_advance_varlist_low_storage3D', 3)
756 call this%Advance3D( nowstage, var_list(i)%var3D, varids(i), is, ie ,js, je ,ks, ke )
761 end subroutine timeint_rk_advance3d_varlist
777 subroutine timeint_rk_advance_trcvar3d( this, nowstage, q, varID, is, ie ,js, je ,ks, ke , &
778 DDENS, DDENS0, DENS_hyd )
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(:,:,:)
790 if ( this%imex_flag )
then
791 if ( prc_ismaster )
write(*,*)
"timeint_rk_advence_trcvar: IMEX is not supported. Check!"
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 )
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 )
804 end subroutine timeint_rk_advance_trcvar3d
816 subroutine timeint_rk_store_var0_3d( this, q, varID, is, ie ,js, je ,ks, ke )
819 real(RP),
intent(inout) :: q(:,:,:)
820 integer,
intent(in) :: varID
821 integer,
intent(in) :: is, ie ,js, je ,ks, ke
833 this%var0_3D(i,j,k,varid) = q(i,j,k)
841 end subroutine timeint_rk_store_var0_3d
854 subroutine timeint_rk_storeimpl3d( this, nowstage, q, varID, is, ie ,js, je ,ks, ke )
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
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 )
868 end subroutine timeint_rk_storeimpl3d
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: &
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)
900 real(RP) :: one_Minus_sig_ss
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)
912 if ( nowstage == this%nstage )
then
918 q(i) = vartmp_1d(i,varid) &
919 + sig_ss * q(i) + gam_ss * tend_buf1d_ex(i,varid,1)
929 if (nowstage == 1)
then
933 var0_1d(i,varid) = q(i)
934 vartmp_1d(i,varid) = 0.0_rp
938 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps )
then
942 vartmp_1d(i,varid) = vartmp_1d(i,varid) &
943 + sig_ns * q(i) + gam_ns * tend_buf1d_ex(i,varid,1)
950 q(i) = one_minus_sig_ss * var0_1d(i,varid) &
951 + sig_ss * q(i) + gam_ss * tend_buf1d_ex(i,varid,1)
957 end subroutine rk_advance_low_storage1d
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: &
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)
990 real(RP) :: one_Minus_sig_ss
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)
1002 if ( nowstage == this%nstage )
then
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)
1021 if (nowstage == 1)
then
1025 var0_1d(i,varid1) = q1(i)
1026 var0_1d(i,varid2) = q2(i)
1028 vartmp_1d(i,varid1) = 0.0_rp
1029 vartmp_1d(i,varid2) = 0.0_rp
1033 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps )
then
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)
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)
1056 end subroutine rk_advance_low_storage1d_var2
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: &
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)
1092 real(RP) :: one_Minus_sig_ss
1098 real(RP) :: dens_ssm1
1103 call prof_rapstart(
'rk_advance_trcvar_low_storage1D', 3)
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)
1112 if ( nowstage == this%nstage )
then
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) )
1125 call prof_rapend(
'rk_advance_trcvar_low_storage1D', 3)
1130 c_ss = this%coef_c_ex(nowstage+1)
1134 if (nowstage == 1)
then
1138 var0_1d(i,varid) = q(i) * ( dens_hyd(i) + ddens0(i) )
1139 vartmp_1d(i,varid) = 0.0_rp
1143 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps )
then
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)
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) )
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) ) &
1166 call prof_rapend(
'rk_advance_trcvar_low_storage1D', 3)
1169 end subroutine rk_advance_trcvar_low_storage1d
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: &
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)
1201 real(RP) :: one_Minus_sig_ss
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)
1213 if ( nowstage == this%nstage )
then
1220 q(i,j) = vartmp_2d(i,j,varid) &
1221 + sig_ss * q(i,j) + gam_ss * tend_buf2d_ex(i,j,varid,1)
1232 if (nowstage == 1)
then
1237 var0_2d(i,j,varid) = q(i,j)
1238 vartmp_2d(i,j,varid) = 0.0_rp
1243 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps )
then
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)
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)
1266 end subroutine rk_advance_low_storage2d
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: &
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)
1301 real(RP) :: one_Minus_sig_ss
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)
1313 if ( nowstage == this%nstage )
then
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)
1334 if (nowstage == 1)
then
1339 var0_2d(i,j,varid1) = q1(i,j)
1340 var0_2d(i,j,varid2) = q2(i,j)
1342 vartmp_2d(i,j,varid1) = 0.0_rp
1343 vartmp_2d(i,j,varid2) = 0.0_rp
1348 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps )
then
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)
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)
1375 end subroutine rk_advance_low_storage2d_var2
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: &
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)
1413 real(RP) :: one_Minus_sig_ss
1419 real(RP) :: dens_ssm1
1424 call prof_rapstart(
'rk_advance_trcvar_low_storage2D', 3)
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)
1433 if ( nowstage == this%nstage )
then
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) )
1448 call prof_rapend(
'rk_advance_trcvar_low_storage2D', 3)
1453 c_ss = this%coef_c_ex(nowstage+1)
1457 if (nowstage == 1)
then
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
1468 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps )
then
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)
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) )
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) ) &
1495 call prof_rapend(
'rk_advance_trcvar_low_storage2D', 3)
1498 end subroutine rk_advance_trcvar_low_storage2d
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: &
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)
1532 real(RP) :: one_Minus_sig_ss
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)
1544 if ( nowstage == this%nstage )
then
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)
1565 if (nowstage == 1)
then
1571 var0_3d(i,j,k,varid) = q(i,j,k)
1572 vartmp_3d(i,j,k,varid) = 0.0_rp
1578 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps )
then
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)
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)
1605 end subroutine rk_advance_low_storage3d
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: &
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)
1642 real(RP) :: one_Minus_sig_ss
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)
1654 if ( nowstage == this%nstage )
then
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)
1677 if (nowstage == 1)
then
1683 var0_3d(i,j,k,varid1) = q1(i,j,k)
1684 var0_3d(i,j,k,varid2) = q2(i,j,k)
1686 vartmp_3d(i,j,k,varid1) = 0.0_rp
1687 vartmp_3d(i,j,k,varid2) = 0.0_rp
1693 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps )
then
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)
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)
1724 end subroutine rk_advance_low_storage3d_var2
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: &
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)
1764 real(RP) :: one_Minus_sig_ss
1770 real(RP) :: dens_ssm1
1775 call prof_rapstart(
'rk_advance_trcvar_low_storage3D', 3)
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)
1784 if ( nowstage == this%nstage )
then
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) )
1801 call prof_rapend(
'rk_advance_trcvar_low_storage3D', 3)
1806 c_ss = this%coef_c_ex(nowstage+1)
1810 if (nowstage == 1)
then
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
1823 if ( abs(sig_ns) > eps .or. abs(gam_ns) > eps )
then
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)
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) )
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) ) &
1854 call prof_rapend(
'rk_advance_trcvar_low_storage3D', 3)
1857 end subroutine rk_advance_trcvar_low_storage3d
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 )
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)
1886 integer :: tintbuf_ind
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
1894 call prof_rapstart(
'rk_advance_general1D', 3)
1896 tintbuf_ind = this%tend_buf_indmap(nowstage)
1898 if ( nowstage == 1 .and. (.not. this%imex_flag) )
then
1902 var0_1d(i,varid) = q(i)
1903 vartmp_1d(i,varid) = q(i)
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
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)
1919 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
1924 q(i) = vartmp_1d(i,varid) &
1925 + coef_b_ex_dt * tend_buf1d_ex(i,varid,tintbuf_ind)
1928 call prof_rapend(
'rk_advance_general1D', 3)
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
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)
1950 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
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)
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)
1966 q(i) = var0_1d(i,varid) &
1967 + coef_a_ex_dt * tend_buf1d_ex(i,varid,1)
1969 else if ( .not. this%imex_flag )
then
1971 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,s)
1976 + coef_a_ex_dt * tend_buf1d_ex(i,varid,s)
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)
1987 + coef_a_ex_dt * tend_buf1d_ex(i,varid,s) &
1988 + coef_a_im_dt * tend_buf1d_im(i,varid,s)
1994 call prof_rapend(
'rk_advance_general1D', 3)
1997 end subroutine rk_advance_general1d
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 )
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)
2030 integer :: tintbuf_ind
2034 real(RP) :: coef_a_ex
2035 real(RP) :: coef_a_ex_dt
2036 real(RP) :: coef_b_ex_dt
2040 call prof_rapstart(
'rk_advance_trcvar_general1D', 3)
2042 tintbuf_ind = this%tend_buf_indmap(nowstage)
2044 if ( this%nstage == 1 )
then
2048 vartmp_1d(i,varid) = q(i) * ( dens_hyd(i) + ddens0(i) )
2052 if ( nowstage == this%nstage )
then
2053 coef_b_ex_dt = this%dt * this%coef_b_ex(nowstage)
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) )
2061 call prof_rapend(
'rk_advance_trcvar_general1D', 3)
2066 c_ss = this%coef_c_ex(nowstage+1)
2072 if ( nowstage == 1 .and. (.not. this%imex_flag) )
then
2076 var0_1d(i,varid) = q(i) * ( dens_hyd(i) + ddens0(i) )
2077 vartmp_1d(i,varid) = var0_1d(i,varid)
2081 coef_b_ex_dt = this%dt * this%coef_b_ex(nowstage)
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)
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)
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) ) &
2102 else if ( .not. this%imex_flag )
then
2104 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,s)
2109 + coef_a_ex_dt * tend_buf1d_ex(i,varid,s)
2115 dens_ = dens_hyd(i) + ddens0(i) + c_ss * ( ddens(i) - ddens0(i) )
2121 call prof_rapend(
'rk_advance_trcvar_generall1D', 3)
2124 end subroutine rk_advance_trcvar_general1d
2134 subroutine rk_storeimpl_general1d( this, nowstage, q, varID, is, ie , IA, var_num, &
2135 var0_1D, varTmp_1d, tend_buf1D_im )
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)
2149 integer :: tintbuf_ind
2150 real(RP) :: coef_a_im_dt
2153 if (.not. this%imex_flag )
return
2155 tintbuf_ind = this%tend_buf_indmap(nowstage)
2156 coef_a_im_dt = this%dt * this%coef_a_im(nowstage,nowstage)
2161 if ( nowstage == 1 )
then
2165 var0_1d(i,varid) = q(i)
2166 vartmp_1d(i,varid) = q(i)
2174 + coef_a_im_dt * tend_buf1d_im(i,varid,tintbuf_ind)
2180 end subroutine rk_storeimpl_general1d
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 )
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)
2210 integer :: tintbuf_ind
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
2218 call prof_rapstart(
'rk_advance_general2D', 3)
2220 tintbuf_ind = this%tend_buf_indmap(nowstage)
2222 if ( nowstage == 1 .and. (.not. this%imex_flag) )
then
2227 var0_2d(i,j,varid) = q(i,j)
2228 vartmp_2d(i,j,varid) = q(i,j)
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
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)
2247 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
2253 q(i,j) = vartmp_2d(i,j,varid) &
2254 + coef_b_ex_dt * tend_buf2d_ex(i,j,varid,tintbuf_ind)
2258 call prof_rapend(
'rk_advance_general2D', 3)
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
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)
2282 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
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)
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)
2301 q(i,j) = var0_2d(i,j,varid) &
2302 + coef_a_ex_dt * tend_buf2d_ex(i,j,varid,1)
2305 else if ( .not. this%imex_flag )
then
2307 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,s)
2313 + coef_a_ex_dt * tend_buf2d_ex(i,j,varid,s)
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)
2326 + coef_a_ex_dt * tend_buf2d_ex(i,j,varid,s) &
2327 + coef_a_im_dt * tend_buf2d_im(i,j,varid,s)
2334 call prof_rapend(
'rk_advance_general2D', 3)
2337 end subroutine rk_advance_general2d
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 )
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)
2372 integer :: tintbuf_ind
2376 real(RP) :: coef_a_ex
2377 real(RP) :: coef_a_ex_dt
2378 real(RP) :: coef_b_ex_dt
2382 call prof_rapstart(
'rk_advance_trcvar_general2D', 3)
2384 tintbuf_ind = this%tend_buf_indmap(nowstage)
2386 if ( this%nstage == 1 )
then
2391 vartmp_2d(i,j,varid) = q(i,j) * ( dens_hyd(i,j) + ddens0(i,j) )
2396 if ( nowstage == this%nstage )
then
2397 coef_b_ex_dt = this%dt * this%coef_b_ex(nowstage)
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) )
2407 call prof_rapend(
'rk_advance_trcvar_general2D', 3)
2412 c_ss = this%coef_c_ex(nowstage+1)
2418 if ( nowstage == 1 .and. (.not. this%imex_flag) )
then
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)
2429 coef_b_ex_dt = this%dt * this%coef_b_ex(nowstage)
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)
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)
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) ) &
2454 else if ( .not. this%imex_flag )
then
2456 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,s)
2462 + coef_a_ex_dt * tend_buf2d_ex(i,j,varid,s)
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_
2477 call prof_rapend(
'rk_advance_trcvar_generall2D', 3)
2480 end subroutine rk_advance_trcvar_general2d
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 )
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)
2507 integer :: tintbuf_ind
2508 real(RP) :: coef_a_im_dt
2511 if (.not. this%imex_flag )
return
2513 tintbuf_ind = this%tend_buf_indmap(nowstage)
2514 coef_a_im_dt = this%dt * this%coef_a_im(nowstage,nowstage)
2519 if ( nowstage == 1 )
then
2524 var0_2d(i,j,varid) = q(i,j)
2525 vartmp_2d(i,j,varid) = q(i,j)
2535 + coef_a_im_dt * tend_buf2d_im(i,j,varid,tintbuf_ind)
2542 end subroutine rk_storeimpl_general2d
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 )
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)
2574 integer :: tintbuf_ind
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
2582 call prof_rapstart(
'rk_advance_general3D', 3)
2584 tintbuf_ind = this%tend_buf_indmap(nowstage)
2586 if ( nowstage == 1 .and. (.not. this%imex_flag) )
then
2592 var0_3d(i,j,k,varid) = q(i,j,k)
2593 vartmp_3d(i,j,k,varid) = q(i,j,k)
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
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)
2615 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
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)
2628 call prof_rapend(
'rk_advance_general3D', 3)
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
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)
2654 coef_b_ex_dt = this%coef_b_ex(nowstage) * this%dt
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)
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)
2676 q(i,j,k) = var0_3d(i,j,k,varid) &
2677 + coef_a_ex_dt * tend_buf3d_ex(i,j,k,varid,1)
2681 else if ( .not. this%imex_flag )
then
2683 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,s)
2689 q(i,j,k) = q(i,j,k) &
2690 + coef_a_ex_dt * tend_buf3d_ex(i,j,k,varid,s)
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)
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)
2714 call prof_rapend(
'rk_advance_general3D', 3)
2717 end subroutine rk_advance_general3d
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 )
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)
2754 integer :: tintbuf_ind
2758 real(RP) :: coef_a_ex
2759 real(RP) :: coef_a_ex_dt
2760 real(RP) :: coef_b_ex_dt
2764 call prof_rapstart(
'rk_advance_trcvar_general3D', 3)
2766 tintbuf_ind = this%tend_buf_indmap(nowstage)
2768 if ( this%nstage == 1 )
then
2774 vartmp_3d(i,j,k,varid) = q(i,j,k) * ( dens_hyd(i,j,k) + ddens0(i,j,k) )
2780 if ( nowstage == this%nstage )
then
2781 coef_b_ex_dt = this%dt * this%coef_b_ex(nowstage)
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) )
2793 call prof_rapend(
'rk_advance_trcvar_general3D', 3)
2798 c_ss = this%coef_c_ex(nowstage+1)
2804 if ( nowstage == 1 .and. (.not. this%imex_flag) )
then
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)
2817 coef_b_ex_dt = this%dt * this%coef_b_ex(nowstage)
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)
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)
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) ) &
2846 else if ( .not. this%imex_flag )
then
2848 coef_a_ex_dt = this%dt * this%coef_a_ex(nowstage+1,s)
2854 q(i,j,k) = q(i,j,k) &
2855 + coef_a_ex_dt * tend_buf3d_ex(i,j,k,varid,s)
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_
2873 call prof_rapend(
'rk_advance_trcvar_generall3D', 3)
2876 end subroutine rk_advance_trcvar_general3d
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 )
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)
2905 integer :: tintbuf_ind
2906 real(RP) :: coef_a_im_dt
2909 if (.not. this%imex_flag )
return
2911 tintbuf_ind = this%tend_buf_indmap(nowstage)
2912 coef_a_im_dt = this%dt * this%coef_a_im(nowstage,nowstage)
2917 if ( nowstage == 1 )
then
2923 var0_3d(i,j,k,varid) = q(i,j,k)
2924 vartmp_3d(i,j,k,varid) = q(i,j,k)
2935 q(i,j,k) = q(i,j,k) &
2936 + coef_a_im_dt * tend_buf3d_im(i,j,k,varid,tintbuf_ind)
2944 end subroutine rk_storeimpl_general3d
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.