From de9a3fe25995a6fca487f73646538eb4bca82409 Mon Sep 17 00:00:00 2001
From: Grzegorz Kowal <grzegorz@amuncode.org>
Date: Thu, 7 Mar 2019 11:34:22 -0300
Subject: [PATCH] USER_PROBLEM: Add status flag to allocations and
 deallocations.

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
---
 sources/user_problem.F90 | 78 ++++++++++++++++++++--------------------
 1 file changed, 40 insertions(+), 38 deletions(-)

diff --git a/sources/user_problem.F90 b/sources/user_problem.F90
index 39c1f98..08278cd 100644
--- a/sources/user_problem.F90
+++ b/sources/user_problem.F90
@@ -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