Merge branch 'master' into reconnection

This commit is contained in:
Grzegorz Kowal 2022-01-08 11:42:17 -03:00
commit 3a9ca89a6b
13 changed files with 323 additions and 174 deletions

View File

@ -1262,13 +1262,11 @@ module blocks
type(block_data), pointer :: pdata
logical, save :: first = .true.
!$omp threadprivate(first)
integer :: p, q, np
integer :: i, ip, ir
integer :: j, jp, jr
integer :: k, kp = 1
#if NDIMS == 3
integer :: kr
#endif /* NDIMS == 3 */
integer :: k, kp, kr
real(kind=8) :: xln, yln, zln, xmn, xmx, ymn, ymx, zmn, zmx
integer, dimension(0:79,nchildren), save :: order
@ -1280,6 +1278,11 @@ module blocks
!
status = 0
#if NDIMS == 2
kp = 1
kr = 1
#endif /* NDIMS == 2 */
! prepare some arrays
!
if (first) then

View File

@ -523,12 +523,12 @@ module boundaries
#if NDIMS == 2
integer :: m
#endif /* NDIMS == 2 */
integer :: i , il , iu
integer :: j , jl , ju
integer :: k = 1, kl = 1, ku = 1
integer :: i, il, iu
integer :: j, jl, ju
integer :: k, kl, ku
integer :: s
#ifdef MPI
integer :: sproc = 0, rproc = 0
integer :: sproc, rproc
integer :: scount, rcount
integer :: l, p
@ -551,11 +551,22 @@ module boundaries
if (minlev == maxlev) return
#ifdef MPI
sproc = 0
rproc = 0
scount = 0
rcount = 0
! prepare the block exchange structures
!
call prepare_exchange_array()
#endif /* MPI */
#if NDIMS == 2
k = 1
kl = 1
ku = 1
#endif /* NDIMS == 2 */
! update the fluxes between blocks on the same process
!
! associate pleaf with the first block on the leaf list
@ -1407,7 +1418,7 @@ module boundaries
type(block_meta), pointer :: pmeta
type(block_leaf), pointer :: pleaf
integer :: i, j, k = 1, n
integer :: i, j, k, n
#if NDIMS == 2
integer :: m
#endif /* NDIMS == 2 */
@ -1416,11 +1427,16 @@ module boundaries
#if NDIMS == 3
real(kind=8), dimension(nn) :: z
#else /* NDIMS == 3 */
real(kind=8), dimension( 1) :: z = 0.0d+00
real(kind=8), dimension( 1) :: z
#endif /* NDIMS == 3 */
!-------------------------------------------------------------------------------
!
#if NDIMS == 2
k = 1
z = 0.0d+00
#endif /* NDIMS == 2 */
pleaf => list_leaf
do while(associated(pleaf))
pmeta => pleaf%meta
@ -1574,14 +1590,14 @@ module boundaries
! local variables
!
integer :: i , j , k = 1
integer :: i , j , k
integer :: il, jl, kl
integer :: iu, ju, ku
integer :: is, js, ks
integer :: it, jt, kt
#ifdef MPI
integer :: sproc = 0, rproc = 0
integer :: ecount = 0
integer :: sproc, rproc
integer :: ecount
integer :: l, p
! local arrays
@ -1592,6 +1608,10 @@ module boundaries
!-------------------------------------------------------------------------------
!
#ifdef MPI
sproc = 0
rproc = 0
ecount = 0
! prepare the block exchange structures
!
call prepare_exchange_array()
@ -1918,11 +1938,11 @@ module boundaries
! local variables
!
integer :: i , j , k = 1
integer :: i , j , k
integer :: il, jl, kl
integer :: iu, ju, ku
#ifdef MPI
integer :: sproc = 0, rproc = 0
integer :: sproc, rproc
integer :: scount, rcount
integer :: l, p
@ -1934,6 +1954,11 @@ module boundaries
!-------------------------------------------------------------------------------
!
#ifdef MPI
sproc = 0
rproc = 0
scount = 0
rcount = 0
! prepare the block exchange structures
!
call prepare_exchange_array()
@ -2257,13 +2282,13 @@ module boundaries
! local variables
!
integer :: i , j , k = 1
integer :: i , j , k
integer :: ic, jc, kc
integer :: ih, jh, kh
integer :: il = 1, jl = 1, kl = 1
integer :: iu = 1, ju = 1, ku = 1
integer :: il, jl, kl
integer :: iu, ju, ku
#ifdef MPI
integer :: sproc = 0, rproc = 0
integer :: sproc, rproc
integer :: scount, rcount
integer :: l, p
@ -2274,6 +2299,13 @@ module boundaries
!
!-------------------------------------------------------------------------------
!
il = 1
iu = 1
jl = 1
ju = 1
kl = 1
ku = 1
! calculate the sizes
!
ih = ni + ng
@ -2281,6 +2313,11 @@ module boundaries
kh = ni + ng
#ifdef MPI
sproc = 0
rproc = 0
scount = 0
rcount = 0
! prepare the block exchange structures
!
call prepare_exchange_array()
@ -2672,13 +2709,13 @@ module boundaries
!
integer :: i, il, iu, is, it
integer :: j, jl, ju, js, jt
integer :: k = 1
integer :: k
#if NDIMS == 3
integer :: kl, ku, ks, kt
#endif /* NDIMS == 3 */
#ifdef MPI
integer :: sproc = 0, rproc = 0
integer :: ecount = 0
integer :: sproc, rproc
integer :: ecount
integer :: l, p
! local arrays
@ -2688,9 +2725,15 @@ module boundaries
!
!-------------------------------------------------------------------------------
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#ifdef MPI
! prepare the block exchange structures
!
sproc = 0
rproc = 0
ecount = 0
call prepare_exchange_array()
#endif /* MPI */
@ -3096,12 +3139,12 @@ module boundaries
!
integer :: i, il, iu
integer :: j, jl, ju
integer :: k = 1
integer :: k
#if NDIMS == 3
integer :: kl, ku
#endif /* NDIMS == 3 */
#ifdef MPI
integer :: sproc = 0, rproc = 0
integer :: sproc, rproc
integer :: scount, rcount
integer :: l, p
@ -3112,7 +3155,14 @@ module boundaries
!
!-------------------------------------------------------------------------------
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#ifdef MPI
sproc = 0
rproc = 0
! prepare the block exchange structures
!
call prepare_exchange_array()
@ -3511,14 +3561,14 @@ module boundaries
! local variables
!
integer :: i, ic, ih, il = 1, iu = 1
integer :: j, jc, jh, jl = 1, ju = 1
integer :: k = 1, kc = 1
integer :: i, ic, ih, il, iu
integer :: j, jc, jh, jl, ju
integer :: k, kc
#if NDIMS == 3
integer :: kh, kl = 1, ku = 1
integer :: kh, kl, ku
#endif /* NDIMS == 3 */
#ifdef MPI
integer :: sproc = 0, rproc = 0
integer :: sproc, rproc
integer :: scount, rcount
integer :: l, p
@ -3529,6 +3579,17 @@ module boundaries
!
!-------------------------------------------------------------------------------
!
il = 1
iu = 1
jl = 1
ju = 1
k = 1
kc = 1
#if NDIMS == 3
kl = 1
ku = 1
#endif /* NDIMS == 3 */
! calculate the sizes
!
ih = ni + ng
@ -3538,6 +3599,11 @@ module boundaries
#endif /* NDIMS == 3 */
#ifdef MPI
sproc = 0
rproc = 0
scount = 0
rcount = 0
! prepare the block exchange structures
!
call prepare_exchange_array()
@ -4007,13 +4073,13 @@ module boundaries
!
integer :: i, il, iu, is, it
integer :: j, jl, ju, js, jt
integer :: k = 1
integer :: k
#if NDIMS == 3
integer :: kl, ku, ks, kt
#endif /* NDIMS == 3 */
#ifdef MPI
integer :: sproc = 0, rproc = 0
integer :: ecount = 0
integer :: sproc, rproc
integer :: ecount
integer :: l, p
! local arrays
@ -4023,7 +4089,15 @@ module boundaries
!
!-------------------------------------------------------------------------------
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#ifdef MPI
sproc = 0
rproc = 0
ecount = 0
! prepare the block exchange structures
!
call prepare_exchange_array()
@ -4385,12 +4459,12 @@ module boundaries
!
integer :: i, il, iu
integer :: j, jl, ju
integer :: k = 1
integer :: k
#if NDIMS == 3
integer :: kl, ku
#endif /* NDIMS == 3 */
#ifdef MPI
integer :: sproc = 0, rproc = 0
integer :: sproc, rproc
integer :: scount, rcount
integer :: l, p
@ -4401,7 +4475,16 @@ module boundaries
!
!-------------------------------------------------------------------------------
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#ifdef MPI
sproc = 0
rproc = 0
scount = 0
rcount = 0
! prepare the block exchange structures
!
call prepare_exchange_array()
@ -4744,12 +4827,12 @@ module boundaries
!
integer :: i, il, iu
integer :: j, jl, ju
integer :: k = 1
integer :: k
#if NDIMS == 3
integer :: kl, ku
#endif /* NDIMS == 3 */
#ifdef MPI
integer :: sproc = 0, rproc = 0
integer :: sproc, rproc
integer :: scount, rcount
integer :: l, p
@ -4760,7 +4843,16 @@ module boundaries
!
!-------------------------------------------------------------------------------
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#ifdef MPI
sproc = 0
rproc = 0
scount = 0
rcount = 0
! prepare the block exchange structures
!
call prepare_exchange_array()

View File

@ -1380,12 +1380,15 @@ module equations
real(kind=8), dimension(:,:,:,:), intent(inout) :: qq
integer , intent(out) :: status
integer :: i, j, k = 1
integer :: i, j, k
!-------------------------------------------------------------------------------
!
status = 0
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = nb, ne
#endif /* NDIMS == 3 */
@ -1472,11 +1475,11 @@ module equations
character(len=255) :: msg, sfmt
character(len=16) :: sit, sid, snc
integer :: n, p, nc, np
integer :: i = 1, il = 1, iu = 1
integer :: j = 1, jl = 1, ju = 1
integer :: k = 1
integer :: i, il, iu
integer :: j, jl, ju
integer :: k
#if NDIMS == 3
integer :: kl = 1, ku = 1
integer :: kl, ku
#endif /* NDIMS == 3 */
#if NDIMS == 3
@ -1492,6 +1495,19 @@ module equations
!-------------------------------------------------------------------------------
!
np = 0
i = 1
il = 1
iu = 1
j = 1
jl = 1
ju = 1
k = 1
#if NDIMS == 3
kl = 1
ku = 1
#endif /* NDIMS == 3 */
! search for negative density or pressure
!
physical(:,:,:) = qq(idn,:,:,:) > 0.0d+00
@ -1839,33 +1855,24 @@ module equations
!
function maxspeed_hd_iso(qq) result(maxspeed)
! include external procedures and variables
!
use coordinates, only : nb, ne
! local variables are not implicit by default
!
implicit none
! input arguments
!
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
! return value
!
real(kind=8) :: maxspeed
! local variables
!
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: vv, v
!
!-------------------------------------------------------------------------------
!
maxspeed = 0.0d+00
! iterate over all positions
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = nb, ne
#endif /* NDIMS == 3 */
@ -1918,7 +1925,7 @@ module equations
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
real(kind=8) , intent(out) :: vm, cm
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: vl, vu
!-------------------------------------------------------------------------------
@ -1926,6 +1933,9 @@ module equations
vm = 0.0d+00
cm = 0.0d+00
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = nb, ne
#endif /* NDIMS == 3 */
@ -2261,33 +2271,24 @@ module equations
!
function maxspeed_hd_adi(qq) result(maxspeed)
! include external procedures and variables
!
use coordinates, only : nb, ne
! local variables are not implicit by default
!
implicit none
! input arguments
!
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
! return value
!
real(kind=8) :: maxspeed
! local variables
!
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: vv, v, c
!
!-------------------------------------------------------------------------------
!
maxspeed = 0.0d+00
! iterate over all positions
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = nb, ne
#endif /* NDIMS == 3 */
@ -2344,7 +2345,7 @@ module equations
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
real(kind=8) , intent(out) :: vm, cm
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: vl, vu, cc
!-------------------------------------------------------------------------------
@ -2352,6 +2353,9 @@ module equations
vm = 0.0d+00
cm = 0.0d+00
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = nb, ne
#endif /* NDIMS == 3 */
@ -2741,33 +2745,24 @@ module equations
!
function maxspeed_mhd_iso(qq) result(maxspeed)
! include external procedures and variables
!
use coordinates, only : nb, ne
! local variables are not implicit by default
!
implicit none
! input arguments
!
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
! return value
!
real(kind=8) :: maxspeed
! local variables
!
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: vv, bb, v, c
!
!-------------------------------------------------------------------------------
!
maxspeed = 0.0d+00
! iterate over all positions
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = nb, ne
#endif /* NDIMS == 3 */
@ -2825,7 +2820,7 @@ module equations
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
real(kind=8) , intent(out) :: vm, cm
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: vl, vu, cc, xx
real(kind=8), dimension(3) :: bb
@ -2835,6 +2830,9 @@ module equations
vm = 0.0d+00
cm = 0.0d+00
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = nb, ne
#endif /* NDIMS == 3 */
@ -3354,33 +3352,24 @@ module equations
!
function maxspeed_mhd_adi(qq) result(maxspeed)
! include external procedures and variables
!
use coordinates, only : nb, ne
! local variables are not implicit by default
!
implicit none
! input arguments
!
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
! return value
!
real(kind=8) :: maxspeed
! local variables
!
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: vv, bb, v, c
!
!-------------------------------------------------------------------------------
!
maxspeed = 0.0d+00
! iterate over all positions
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = nb, ne
#endif /* NDIMS == 3 */
@ -3438,7 +3427,7 @@ module equations
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
real(kind=8) , intent(out) :: vm, cm
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: vl, vu, aa, cc, xx
real(kind=8), dimension(3) :: bb
@ -3448,6 +3437,9 @@ module equations
vm = 0.0d+00
cm = 0.0d+00
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = nb, ne
#endif /* NDIMS == 3 */
@ -4035,33 +4027,24 @@ module equations
!
function maxspeed_srhd_adi(qq) result(maxspeed)
! include external procedures and variables
!
use coordinates, only : nb, ne
! local variables are not implicit by default
!
implicit none
! input arguments
!
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
! return value
!
real(kind=8) :: maxspeed
! local variables
!
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: vv, v, cc, ww, c2, ss, fc
!
!-------------------------------------------------------------------------------
!
maxspeed = 0.0d+00
! iterate over all positions
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = nb, ne
#endif /* NDIMS == 3 */
@ -4122,7 +4105,7 @@ module equations
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
real(kind=8) , intent(out) :: vm, cm
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: vl, vu, vv, ww, aa, cc, ss, fc
!-------------------------------------------------------------------------------
@ -4130,6 +4113,9 @@ module equations
vm = 0.0d+00
cm = 0.0d+00
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = nb, ne
#endif /* NDIMS == 3 */
@ -5385,7 +5371,7 @@ module equations
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
real(kind=8) , intent(out) :: vm, cm
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: vl, vu
!-------------------------------------------------------------------------------
@ -5393,6 +5379,9 @@ module equations
vm = 0.0d+00
cm = 1.0d+00
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = nb, ne
#endif /* NDIMS == 3 */

View File

@ -3807,7 +3807,7 @@ module evolution
logical, save :: first = .true.
integer :: i , j , k = 1, p
integer :: i, j, k, p
integer :: im1, ip1
integer :: jm1, jp1
#if NDIMS == 3
@ -3818,7 +3818,7 @@ module evolution
real(kind=8), dimension(NDIMS) :: dh, dhi
integer :: nt = 0
integer, save :: nt = 0
!$ integer :: omp_get_thread_num
real(kind=8), dimension(:,:,:,:,:) , pointer, save :: f
@ -3886,6 +3886,9 @@ module evolution
! calculate the variable update from the directional fluxes
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = nbl, neu
km1 = k - 1
@ -4254,46 +4257,32 @@ module evolution
!
subroutine check_variables()
! include external procedures
!
use coordinates , only : nn => bcells
use equations , only : nv, pvars, cvars
use ieee_arithmetic, only : ieee_is_nan
! include external variables
!
use blocks , only : block_meta, list_meta
use blocks , only : block_data, list_data
! local variables are not implicit by default
!
implicit none
! local variables
!
integer :: i, j, k = 1, p
integer :: i, j, k, p
! local pointers
!
type(block_meta), pointer :: pmeta
type(block_data), pointer :: pdata
!
!-------------------------------------------------------------------------------
!
! associate the pointer with the first block on the data block list
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
pdata => list_data
! iterate over all data blocks
!
do while (associated(pdata))
! associate pmeta with the corresponding meta block
!
pmeta => pdata%meta
! check if there are NaNs in primitive variables
!
#if NDIMS == 3
do k = 1, nn
#endif /* NDIMS == 3 */
@ -4313,10 +4302,7 @@ module evolution
end do ! k = 1, nn
#endif /* NDIMS == 3 */
! assign pointer to the next block
!
pdata => pdata%next
end do
!-------------------------------------------------------------------------------

View File

@ -1173,7 +1173,7 @@ module forcing
type(block_data), pointer , intent(inout) :: pdata
real(kind=8), dimension(3), intent(in) :: xp, ap
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: x2, y2, r2
#if NDIMS == 3
real(kind=8) :: z2
@ -1215,6 +1215,10 @@ module forcing
z(:) = 0.0d+00
#endif /* NDIMS == 3 */
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
! iterate over the block coordinates
!
if (ien > 0) then
@ -1382,7 +1386,7 @@ module forcing
logical, save :: first = .true.
integer :: i, j, k = 1, l, n, status
integer :: i, j, k, l, n, status
real(kind=8) :: cs, sn
#if NDIMS == 3
real(kind=8) :: tt
@ -1398,7 +1402,7 @@ module forcing
real(kind=8), dimension(:,:,:,:), pointer, save :: acc
real(kind=8), dimension(:,:,:) , pointer, save :: den
integer :: nt = 0
integer, save :: nt = 0
!$ integer :: omp_get_thread_num
!$omp threadprivate(first, nt, acc, den)
@ -1428,6 +1432,10 @@ module forcing
first = .false.
end if
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
x(:) = - pi2 * (pdata%meta%xmin + ax(pdata%meta%level,:))
y(:) = - pi2 * (pdata%meta%ymin + ay(pdata%meta%level,:))
#if NDIMS == 3
@ -1623,7 +1631,7 @@ module forcing
type(block_data), pointer, intent(inout) :: pdata
integer :: i, j, k = 1, l
integer :: i, j, k, l
real(kind=8) :: cs, sn, dvol
#if NDIMS == 3
real(kind=8) :: tt
@ -1638,6 +1646,10 @@ module forcing
!-------------------------------------------------------------------------------
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
! prepare block coordinates
!
x(:) = pi2 * (pdata%meta%xmin + ax(pdata%meta%level,:))

View File

@ -852,7 +852,7 @@ module interpolations
real(kind=8), dimension(:,:,:) , intent(in) :: q
real(kind=8), dimension(:,:,:,:,:), intent(out) :: qi
integer :: i , j , k = 1
integer :: i , j , k
integer :: im1, jm1, ip1, jp1
#if NDIMS == 3
integer :: km1, kp1
@ -866,6 +866,10 @@ module interpolations
!-------------------------------------------------------------------------------
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
! copy ghost zones
!
do j = 1, NDIMS
@ -982,10 +986,14 @@ module interpolations
real(kind=8), dimension(:,:,:) , intent(in) :: q
real(kind=8), dimension(:,:,:,:,:), intent(out) :: qi
integer :: i, j, k = 1
integer :: i, j, k
!-------------------------------------------------------------------------------
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
! copy ghost zones
!
do j = 1, NDIMS
@ -1085,7 +1093,7 @@ module interpolations
logical :: flag
integer :: i, il, iu, im1, ip1
integer :: j, jl, ju, jm1, jp1
integer :: k = 1
integer :: k
#if NDIMS == 3
integer :: kl, ku, km1, kp1
#endif /* NDIMS == 3 */
@ -1099,6 +1107,10 @@ module interpolations
!-------------------------------------------------------------------------------
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
! copy ghost zones
!
do j = 1, NDIMS
@ -1268,7 +1280,7 @@ module interpolations
integer :: i, im1, ip1
integer :: j, jm1, jp1
integer :: k = 1
integer :: k
#if NDIMS == 3
integer :: km1, kp1
#endif /* NDIMS == 3 */
@ -1287,6 +1299,10 @@ module interpolations
!-------------------------------------------------------------------------------
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = 1, nn
km1 = max( 1, k - 1)

View File

@ -1860,7 +1860,7 @@ module mesh
real(kind=8), dimension(:,:,:), pointer, save :: tmp
integer :: nt = 0
integer, save :: nt = 0
!$ integer :: omp_get_thread_num
!$omp threadprivate(first, nt, tmp)

View File

@ -185,7 +185,7 @@ module problems
type(block_data), pointer, intent(inout) :: pdata
integer :: p, i, j, k = 1
integer :: p, i, j, k
real(kind=8) :: xl, xr
real(kind=8) :: dx, dxh
@ -230,6 +230,9 @@ module problems
! iterate over all positions in the YZ plane
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = 1, nn
#endif /* NDIMS == 3 */
@ -314,7 +317,7 @@ module problems
! local variables
!
integer :: i, j, k = 1
integer :: i, j, k
#if NDIMS == 3
integer :: ic, jc, kc
#endif /* NDIMS == 3 */
@ -478,6 +481,9 @@ module problems
! iterate over all positions in the YZ plane
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = 1, nn
@ -775,7 +781,7 @@ module problems
! local variables
!
integer :: i, j, k = 1
integer :: i, j, k
#if NDIMS == 3
integer :: ic, jc, kc
#endif /* NDIMS == 3 */
@ -939,6 +945,9 @@ module problems
! iterate over all positions in the YZ plane
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = 1, nn
@ -1209,7 +1218,7 @@ module problems
! local variables
!
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: rl, ru, dx, dy, dxh, dyh, ds, dl, dr
#if NDIMS == 3
real(kind=8) :: dz, dzh
@ -1312,6 +1321,9 @@ module problems
! iterate over all positions
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = 1, nn
#endif /* NDIMS == 3 */
@ -1429,7 +1441,7 @@ module problems
! local variables
!
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: yl, yu, dy, dyh
real(kind=8) :: sn, cs
@ -1497,6 +1509,9 @@ module problems
! iterate over all positions in the YZ plane
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = 1, nn
#endif /* NDIMS == 3 */
@ -1632,7 +1647,7 @@ module problems
! local variables
!
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: sn, cs
! local arrays
@ -1707,6 +1722,9 @@ module problems
! iterate over all positions in the YZ plane
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = 1, nn
#endif /* NDIMS == 3 */
@ -1822,7 +1840,7 @@ module problems
logical, save :: first = .true.
integer :: j, k = 1
integer :: j, k
real(kind=8), dimension(nv,nn) :: q, u
real(kind=8), dimension(nn) :: x, y
@ -1862,6 +1880,9 @@ module problems
q(ibz,:) = bgui
q(ibp,:) = 0.0d+00
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = 1, nn
#endif /* NDIMS == 3 */
@ -1938,7 +1959,7 @@ module problems
! local variables
!
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: t
! local arrays
@ -2000,6 +2021,9 @@ module problems
! iterate over all positions in the YZ planes
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = 1, nn
#endif /* NDIMS == 3 */
@ -2098,7 +2122,7 @@ module problems
! local variables
!
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: dx, dy, t
! local arrays
@ -2191,6 +2215,9 @@ module problems
! iterate over all positions in the YZ planes
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = 1, nn
#endif /* NDIMS == 3 */
@ -2267,7 +2294,7 @@ module problems
logical, save :: first = .true.
integer :: j, k = 1
integer :: j, k
real(kind=8), dimension(nv,nn) :: q, u
@ -2305,6 +2332,9 @@ module problems
call prim2cons(q(:,:), u(:,:))
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = 1, nn
#endif /* NDIMS == 3 */

View File

@ -399,7 +399,7 @@ module refinement
integer :: i, im1, ip1
integer :: j, jm1, jp1
integer :: k = 1
integer :: k
#if NDIMS == 3
integer :: km1, kp1
#endif /* NDIMS == 3 */
@ -414,6 +414,10 @@ module refinement
!
error = 0.0e+00
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
if (iqt > 0) then
#if NDIMS == 3
@ -501,7 +505,7 @@ module refinement
logical, save :: first = .true.
integer :: i, j, k = 1, status
integer :: i, j, k, status
real(kind=8) :: vort
real(kind=8), dimension(3), save :: dh
@ -547,6 +551,9 @@ module refinement
call curl(dh(:), pdata%q(ivx:ivz,:,:,:), w(:,:,:,:))
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = nbl, neu
#endif /* NDIMS == 3 */
@ -604,7 +611,7 @@ module refinement
logical, save :: first = .true.
integer :: i, j, k = 1, status
integer :: i, j, k, status
real(kind=8) :: jabs
real(kind=8), dimension(3), save :: dh
@ -653,6 +660,9 @@ module refinement
call curl(dh(:), pdata%q(ibx:ibz,:,:,:), w(:,:,:,:))
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = nbl, neu
#endif /* NDIMS == 3 */

View File

@ -629,7 +629,7 @@ module schemes
real(kind=8), dimension(:,:,:,:,:,:), intent(inout) :: s
real(kind=8), dimension(:,:,:,:,:) , intent(out) :: f
integer :: n, i, j, k = 1, l, p
integer :: n, i, j, k, l, p
real(kind=8) :: vm
real(kind=8), dimension(nf,nn,2) :: qi
@ -637,6 +637,10 @@ module schemes
!-------------------------------------------------------------------------------
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
! in the relativistic case, apply the reconstruction on variables
! using the four-velocities if requested
!
@ -3778,7 +3782,7 @@ module schemes
real(kind=8), dimension(9,9), save :: rm
!$omp threadprivate(first, adi_m1, adi_m1x, rm)
integer :: i, p
integer :: i
real(kind=8) :: dna, pra, vxa, vya, vza, bxa, bya, bza, bpa
real(kind=8) :: dnl, prl, pta, vva, br, bl, bp
real(kind=8) :: btl, bta, eka, ema, ub2, uba

View File

@ -274,10 +274,11 @@ module shapes
real(kind=8), save :: angle = 4.50d+01
logical , save :: first = .true.
!$omp threadprivate(first)
real(kind=8), save :: r2
real(kind=8), save :: dn_ovr, pr_ovr, bx_ovr, by_ovr
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: xl, yl, xu, yu, rl, ru
real(kind=8) :: dx, dy, dxh, dyh, daxy
#if NDIMS == 3
@ -296,8 +297,10 @@ module shapes
!-------------------------------------------------------------------------------
!
! prepare problem constants during the first subroutine call
!
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
if (first) then
! get problem parameters

View File

@ -292,14 +292,14 @@ module sources
logical, save :: first = .true.
integer :: status
integer :: i, j, k = 1
integer :: i, j, k
real(kind=8) :: fc, gc
real(kind=8) :: gx, gy, gz
real(kind=8) :: dvxdx, dvxdy, dvxdz, divv
real(kind=8) :: dvydx, dvydy, dvydz
real(kind=8) :: dvzdx, dvzdy, dvzdz
integer :: nt = 0
integer, save :: nt = 0
!$ integer :: omp_get_thread_num
real(kind=8), dimension(3) :: ga, dh
@ -339,6 +339,10 @@ module sources
first = .false.
end if
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
! proceed only if the gravitational term is enabled
!
if (gravity_enabled) then

View File

@ -461,7 +461,7 @@ module statistics
integer(kind=4), dimension(nprocs) :: cdist
#endif /* MPI */
integer :: nt = 0
integer, save :: nt = 0
!$ integer :: omp_get_thread_num
!$omp threadprivate(first, nt)