MESH: Use workspace in prolong_block().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
parent
024fd4b82f
commit
f28803350b
@ -187,8 +187,8 @@ module mesh
|
||||
allocate(work(nwork), stat=status)
|
||||
|
||||
if (status /= 0) then
|
||||
write(error_unit,"('[',a,']: ',a)") trim(loc) &
|
||||
, "Cannot allocate the common workspace!"
|
||||
write(error_unit,"('[',a,']: ',a)") trim(loc), &
|
||||
"Cannot allocate the common workspace!"
|
||||
end if
|
||||
|
||||
#ifdef PROFILE
|
||||
@ -1055,6 +1055,8 @@ module mesh
|
||||
type(block_meta), pointer :: pchild
|
||||
type(block_data), pointer :: pdata
|
||||
|
||||
logical, save :: first = .true.
|
||||
|
||||
integer :: n, p, nl, nu
|
||||
integer :: i, im, ip
|
||||
integer :: j, jm, jp
|
||||
@ -1073,7 +1075,7 @@ module mesh
|
||||
integer , dimension(NDIMS) :: l, u
|
||||
real(kind=8), dimension(NDIMS) :: du
|
||||
|
||||
real(kind=8), dimension(:,:,:), allocatable :: work
|
||||
real(kind=8), dimension(:,:,:), pointer, save :: tmp
|
||||
|
||||
character(len=*), parameter :: loc = 'MESH::prolong_block()'
|
||||
|
||||
@ -1085,12 +1087,40 @@ module mesh
|
||||
|
||||
status = 0
|
||||
|
||||
allocate(work(pm(1), pm(2), pm(3)), stat = status)
|
||||
if (status /= 0) then
|
||||
write(error_unit,"('[',a,']: ',a)") trim(loc), &
|
||||
"Prolongation array could not be allocated!"
|
||||
if (first) then
|
||||
if (work_in_use) then
|
||||
write(error_unit,"('[',a,']: ',a,3i4,a)") trim(loc), &
|
||||
"Workspace is already occupied!"
|
||||
status = 1
|
||||
go to 100
|
||||
else
|
||||
n = product(pm(:))
|
||||
|
||||
if (n > nwork) then
|
||||
write(error_unit,"('[',a,']: ',a,3i4,a)") trim(loc), &
|
||||
"Workspace has too be increased!"
|
||||
nwork = n
|
||||
deallocate(work)
|
||||
allocate(work(nwork), stat=status)
|
||||
if (status /= 0) then
|
||||
write(error_unit,"('[',a,']: ',a)") trim(loc), &
|
||||
"Cannot increase the workspace's size!"
|
||||
end if
|
||||
end if
|
||||
|
||||
tmp(1:pm(1),1:pm(2),1:pm(3)) => work(1:n)
|
||||
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.
|
||||
|
||||
#if NDIMS == 2
|
||||
k = 1
|
||||
#endif /* NDIMS == 2 */
|
||||
@ -1149,10 +1179,10 @@ module mesh
|
||||
#if NDIMS == 2
|
||||
du1 = du(1) + du(2)
|
||||
du2 = du(1) - du(2)
|
||||
work(l(1),l(2),k) = pdata%u(n,i,j,k) - du1
|
||||
work(u(1),l(2),k) = pdata%u(n,i,j,k) + du2
|
||||
work(l(1),u(2),k) = pdata%u(n,i,j,k) - du2
|
||||
work(u(1),u(2),k) = pdata%u(n,i,j,k) + du1
|
||||
tmp(l(1),l(2),k) = pdata%u(n,i,j,k) - du1
|
||||
tmp(u(1),l(2),k) = pdata%u(n,i,j,k) + du2
|
||||
tmp(l(1),u(2),k) = pdata%u(n,i,j,k) - du2
|
||||
tmp(u(1),u(2),k) = pdata%u(n,i,j,k) + du1
|
||||
#endif /* NDIMS == 2 */
|
||||
|
||||
#if NDIMS == 3
|
||||
@ -1160,14 +1190,14 @@ module mesh
|
||||
du2 = du(1) - du(2) - du(3)
|
||||
du3 = du(1) - du(2) + du(3)
|
||||
du4 = du(1) + du(2) - du(3)
|
||||
work(l(1),l(2),l(3)) = pdata%u(n,i,j,k) - du1
|
||||
work(u(1),l(2),l(3)) = pdata%u(n,i,j,k) + du2
|
||||
work(l(1),u(2),l(3)) = pdata%u(n,i,j,k) - du3
|
||||
work(u(1),u(2),l(3)) = pdata%u(n,i,j,k) + du4
|
||||
work(l(1),l(2),u(3)) = pdata%u(n,i,j,k) - du4
|
||||
work(u(1),l(2),u(3)) = pdata%u(n,i,j,k) + du3
|
||||
work(l(1),u(2),u(3)) = pdata%u(n,i,j,k) - du2
|
||||
work(u(1),u(2),u(3)) = pdata%u(n,i,j,k) + du1
|
||||
tmp(l(1),l(2),l(3)) = pdata%u(n,i,j,k) - du1
|
||||
tmp(u(1),l(2),l(3)) = pdata%u(n,i,j,k) + du2
|
||||
tmp(l(1),u(2),l(3)) = pdata%u(n,i,j,k) - du3
|
||||
tmp(u(1),u(2),l(3)) = pdata%u(n,i,j,k) + du4
|
||||
tmp(l(1),l(2),u(3)) = pdata%u(n,i,j,k) - du4
|
||||
tmp(u(1),l(2),u(3)) = pdata%u(n,i,j,k) + du3
|
||||
tmp(l(1),u(2),u(3)) = pdata%u(n,i,j,k) - du2
|
||||
tmp(u(1),u(2),u(3)) = pdata%u(n,i,j,k) + du1
|
||||
#endif /* NDIMS == 3 */
|
||||
end do
|
||||
end do
|
||||
@ -1183,23 +1213,18 @@ module mesh
|
||||
u(1:NDIMS) = l(1:NDIMS) + nn - 1
|
||||
|
||||
#if NDIMS == 2
|
||||
pchild%data%u(n,:,:,1) = work(l(1):u(1),l(2):u(2),k)
|
||||
pchild%data%u(n,:,:,1) = tmp(l(1):u(1),l(2):u(2),k)
|
||||
#endif /* NDIMS == 2 */
|
||||
#if NDIMS == 3
|
||||
pchild%data%u(n,:,:,:) = work(l(1):u(1),l(2):u(2),l(3):u(3))
|
||||
pchild%data%u(n,:,:,:) = tmp(l(1):u(1),l(2):u(2),l(3):u(3))
|
||||
#endif /* NDIMS == 3 */
|
||||
|
||||
end do ! nchildren
|
||||
end do ! n = 1, nv
|
||||
|
||||
if (allocated(work)) then
|
||||
deallocate(work, stat = status)
|
||||
if (status /= 0) then
|
||||
write(error_unit,"('[',a,']: ',a)") trim(loc), &
|
||||
"Prolongation array could not be deallocated!"
|
||||
end if
|
||||
end if
|
||||
work_in_use = .false.
|
||||
|
||||
100 continue
|
||||
#ifdef PROFILE
|
||||
call stop_timer(imp)
|
||||
#endif /* PROFILE */
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user