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

USER_PROBLEM: Add status flag to allocations and deallocations.

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2019-03-07 11:34:22 -03:00
parent 99d5cc5069
commit de9a3fe259
1 changed files with 40 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
sources/user_problem.F90
View File

@ -201,49 +201,51 @@ module user_problem
! allocate phase and wave vector components
!
allocate(kx(nper), ky(nper), kz(nper))
allocate(ux(nper), uy(nper), uz(nper))
allocate(ph(nper))
allocate(kx(nper), ky(nper), kz(nper), ux(nper), uy(nper), uz(nper), &
ph(nper), stat = status)
if (status == 0) then
! choose random wave vector directions
!
fc = 1.0d+00 / sqrt(1.0d+00 * nper)
do n = 1, nper
thh = pi2 * randomu()
#if NDIMS == 3
thv = pi * randomn()
ux(n) = cos(thh) * cos(thv)
uy(n) = sin(thh) * cos(thv)
uz(n) = sin(thv)
kx(n) = pi2 * kper * ux(n)
ky(n) = pi2 * kper * uy(n)
kz(n) = pi2 * kper * uz(n)
tt = 0.0d+00
do while(tt == 0.0d+00)
fc = 1.0d+00 / sqrt(1.0d+00 * nper)
do n = 1, nper
thh = pi2 * randomu()
#if NDIMS == 3
thv = pi * randomn()
tx = cos(thh) * cos(thv)
ty = sin(thh) * cos(thv)
tz = sin(thv)
ux(n) = ty * kz(n) - tz * ky(n)
uy(n) = tz * kx(n) - tx * kz(n)
uz(n) = tx * ky(n) - ty * kx(n)
tt = sqrt(ux(n)**2 + uy(n)**2 + uz(n)**2)
end do
ux(n) = fc * ux(n) / tt
uy(n) = fc * uy(n) / tt
uz(n) = fc * uz(n) / tt
ux(n) = cos(thh) * cos(thv)
uy(n) = sin(thh) * cos(thv)
uz(n) = sin(thv)
kx(n) = pi2 * kper * ux(n)
ky(n) = pi2 * kper * uy(n)
kz(n) = pi2 * kper * uz(n)
tt = 0.0d+00
do while(tt == 0.0d+00)
thh = pi2 * randomu()
thv = pi * randomn()
tx = cos(thh) * cos(thv)
ty = sin(thh) * cos(thv)
tz = sin(thv)
ux(n) = ty * kz(n) - tz * ky(n)
uy(n) = tz * kx(n) - tx * kz(n)
uz(n) = tx * ky(n) - ty * kx(n)
tt = sqrt(ux(n)**2 + uy(n)**2 + uz(n)**2)
end do
ux(n) = fc * ux(n) / tt
uy(n) = fc * uy(n) / tt
uz(n) = fc * uz(n) / tt
#else /* NDIMS == 3 */
kx(n) = pi2 * kper * cos(thh)
ky(n) = pi2 * kper * sin(thh)
kz(n) = 0.0d+00
ux(n) = fc * sin(thh)
uy(n) = fc * cos(thh)
uz(n) = 0.0d+00
kx(n) = pi2 * kper * cos(thh)
ky(n) = pi2 * kper * sin(thh)
kz(n) = 0.0d+00
ux(n) = fc * sin(thh)
uy(n) = fc * cos(thh)
uz(n) = 0.0d+00
#endif /* NDIMS == 3 */
ph(n) = pi2 * randomu()
end do
ph(n) = pi2 * randomu()
end do
end if ! status
end if
! print information about the user problem setup
@ -324,9 +326,9 @@ module user_problem
! deallocate wave vector components, random directions, and random phase
!
if (allocated(kx)) deallocate(kx, ky, kz)
if (allocated(ux)) deallocate(ux, uy, uz)
if (allocated(ph)) deallocate(ph)
if (allocated(kx)) deallocate(kx, ky, kz, stat = status)
if (allocated(ux)) deallocate(ux, uy, uz, stat = status)
if (allocated(ph)) deallocate(ph, stat = status)
#ifdef PROFILE
! stop accounting time for module initialization/finalization