gkowal/amun-code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

USER_PROBLEM: Use workspace in update_user_shapes().

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2021-11-12 23:41:19 -03:00
parent e412d4cfa2
commit d03ae4e4c3
1 changed files with 61 additions and 14 deletions

75
sources/user_problem.F90

@ -1095,31 +1095,34 @@ module user_problem
!
subroutine update_user_shapes(pdata, time, dt)
use blocks , only : block_data
use constants , only : pi
use coordinates, only : nn => bcells
use coordinates, only : ymax, ay, adx, ady, adz
use equations , only : nv
use equations , only : idn, ivx, ivy, ivz, ipr, ibx, iby, ibz, ibp
use equations , only : prim2cons
use operators , only : laplace
use blocks , only : block_data
use constants , only : pi
use coordinates , only : nn => bcells
use coordinates , only : ymax, ay, adx, ady, adz
use equations , only : nv
use equations , only : idn, ivx, ivy, ivz, ipr, ibx, iby, ibz, ibp
use equations , only : prim2cons
use iso_fortran_env, only : error_unit
use operators , only : laplace
use workspace , only : work, nwork, work_in_use
implicit none
type(block_data), pointer, intent(inout) :: pdata
real(kind=8) , intent(in) :: time, dt
integer :: j, k = 1
logical, save :: first = .true.
integer :: j, k = 1, status
real(kind=8) :: fl, fr, fd, fa, fb
real(kind=8), dimension(3) :: dh = 1.0d+00
real(kind=8), dimension(nn) :: yc, fc
real(kind=8), dimension(nv,nn) :: q, u
#if NDIMS == 3
real(kind=8), dimension(nn,nn,nn) :: q2
#else /* NDIMS == 3 */
real(kind=8), dimension(nn,nn, 1) :: q2
#endif /* NDIMS == 3 */
real(kind=8), dimension(:,:,:), pointer, save :: q2
character(len=*), parameter :: loc = 'USER_PROBLEM:update_user_shapes()'
!-------------------------------------------------------------------------------
!
@ -1127,6 +1130,46 @@ module user_problem
call start_timer(ims)
#endif /* PROFILE */
if (first) then
status = 0
if (work_in_use) then
write(error_unit,"('[',a,']: ',a,3i4,a)") trim(loc), &
"Workspace is already occupied!"
go to 100
else
j = nn**NDIMS
if (j > nwork) then
write(error_unit,"('[',a,']: ',a,3i4,a)") trim(loc), &
"Workspace has too be increased!"
nwork = j
deallocate(work)
allocate(work(nwork), stat=status)
if (status /= 0) then
write(error_unit,"('[',a,']: ',a)") trim(loc), &
"Cannot increase the workspace's size!"
go to 100
end if
end if
#if NDIMS == 3
q2(1:nn,1:nn,1:nn) => work(1:j)
#else /* NDIMS == 3 */
q2(1:nn,1:nn,1: 1) => work(1:j)
#endif /* NDIMS == 3 */
end if
first = .false.
end if
if (work_in_use) then
write(error_unit,"('[',a,']: ',a,3i4,a)") trim(loc), &
"Workspace is already occupied! Corruptions can occur!"
end if
work_in_use = .true.
yc(:) = pdata%meta%ymin + ay(pdata%meta%level,:)
if (yc(1) < -yabs .or. yc(nn) > yabs) then
@ -1178,6 +1221,10 @@ module user_problem
end do
end if
work_in_use = .false.
100 continue
#ifdef PROFILE
call stop_timer(ims)
#endif /* PROFILE */