From f6ff97f5c51aa8f98a9bd09b610ecc41ac63067a Mon Sep 17 00:00:00 2001
From: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
Date: Fri, 23 May 2014 22:03:23 +0200
Subject: [PATCH] Added has_openmp for variables

---
 src/irp_stack.py         | 82 ++++++++++++++++++++++++++++------------
 src/preprocessed_text.py |  4 +-
 src/variable.py          | 14 +++++++
 3 files changed, 73 insertions(+), 27 deletions(-)

diff --git a/src/irp_stack.py b/src/irp_stack.py
index 1c347c3..3506ea6 100644
--- a/src/irp_stack.py
+++ b/src/irp_stack.py
@@ -45,24 +45,34 @@ module irp_stack_mod
   double precision,allocatable  :: irp_cpu(:,:)
   integer,allocatable           :: stack_index(:)
   logical                       :: alloc = .False.
+  integer                       :: nthread
   character*(128)               :: white = ''
 end module
 
 subroutine irp_enter(irp_where)
  use irp_stack_mod
  integer       :: ithread
- integer       :: nthread
  character*(*) :: irp_where
-$OMP_DECL
-!$OMP CRITICAL
- ithread = $OMP_GET_THREAD_NUM
- nthread = $OMP_GET_NUM_THREADS
+!$ integer, external :: omp_get_thread_num
+!$ integer, external :: omp_get_num_threads
+ ithread = 0
+!$ ithread = omp_get_thread_num()
 $1
-!$OMP END CRITICAL
+if (ithread /= 0) then
+   print *, 'Error: Provider is called by thread', ithread
+   call irp_trace
+   stop 1
+endif
 """
   if command_line.do_memory:
       txt+="""
  if (.not.alloc) then
+ nthread = 1
+ !$OMP PARALLEL
+ !$OMP SINGLE
+ !$ nthread = omp_get_num_threads()
+ !$OMP END SINGLE
+ !$OMP END PARALLEL
   print *, 'Allocating irp_stack(',STACKMAX,',',nthread,')'
   print *, 'Allocating irp_cpu(',STACKMAX,',',nthread,')'
   print *, 'Allocating stack_index(',nthread,')'
@@ -71,36 +81,55 @@ $1
 $2
 end subroutine
 
+subroutine irp_enter_f(irp_where)
+ use irp_stack_mod
+ integer       :: ithread
+ character*(*) :: irp_where
+!$ integer, external :: omp_get_thread_num
+!$ integer, external :: omp_get_num_threads
+ ithread = 0
+!$ ithread = omp_get_thread_num()
+$1
+"""
+  if command_line.do_memory:
+      txt+="""
+ if (.not.alloc) then
+ !$OMP PARALLEL
+ !$OMP SINGLE
+ !$ nthread = omp_get_num_threads()
+  print *, 'Allocating irp_stack(',STACKMAX,',',nthread,')'
+  print *, 'Allocating irp_cpu(',STACKMAX,',',nthread,')'
+  print *, 'Allocating stack_index(',nthread,')'
+ !$OMP END SINGLE
+ !$OMP END PARALLEL
+ endif"""
+  txt +="""
+$2
+end subroutine
+
 subroutine irp_leave (irp_where)
  use irp_stack_mod
   character*(*) :: irp_where
   integer       :: ithread
   double precision :: cpu
-$OMP_DECL
-!$OMP CRITICAL
-  ithread = $OMP_GET_THREAD_NUM
+!$ integer, external :: omp_get_thread_num
+ ithread = 0
+!$ ithread = omp_get_thread_num()
 $3
 $4
-!$OMP END CRITICAL
 end subroutine
 """
 
-  # $OMP_DECL
-  if do_openmp:
-    txt = txt.replace("$OMP_DECL","""
-  integer :: omp_get_num_threads
-  integer :: omp_get_thread_num
-""")
-    txt = txt.replace("$OMP_GET_NUM_THREADS","omp_get_num_threads()")
-    txt = txt.replace("$OMP_GET_THREAD_NUM","omp_get_thread_num()")
-  else:
-    txt = txt.replace("$OMP_DECL","")
-    txt = txt.replace("$OMP_GET_NUM_THREADS","1")
-    txt = txt.replace("$OMP_GET_THREAD_NUM","0")
-
   # $1
   if do_assert or do_debug:
     txt = txt.replace("$1","""
+ if (.not.alloc) then
+ !$OMP PARALLEL
+ !$OMP SINGLE
+ !$ nthread = omp_get_num_threads()
+ !$OMP END SINGLE
+ !$OMP END PARALLEL
+ !$OMP CRITICAL
  if (.not.alloc) then
    allocate(irp_stack(STACKMAX,nthread+1))
    allocate(irp_cpu(STACKMAX,nthread+1))
@@ -108,6 +137,8 @@ end subroutine
    stack_index = 0
    alloc = .True.
  endif
+ !$OMP END CRITICAL
+ endif
  stack_index(ithread+1) = stack_index(ithread+1)+1
  irp_stack(stack_index(ithread+1),ithread+1) = irp_where""")
     if command_line.do_memory:
@@ -143,13 +174,14 @@ end subroutine
   else:
     txt = txt.replace("$4","")
 
-  if do_debug or do_assert:
-    txt += """
+  txt += """
 subroutine irp_trace
  use irp_stack_mod
  integer :: ithread
  integer :: i
+!$ integer, external :: omp_get_thread_num
  ithread = 0
+!$ ithread = omp_get_thread_num()
  if (.not.alloc) return
  print *, 'Stack trace: ', ithread
  print *, '-------------------------'
diff --git a/src/preprocessed_text.py b/src/preprocessed_text.py
index 9ee8e33..63d0c72 100644
--- a/src/preprocessed_text.py
+++ b/src/preprocessed_text.py
@@ -602,7 +602,7 @@ def irp_simple_statements(text):
       Declaration(i,"  character*(%d) :: irp_here = '%s'"%(length,subname), f) ]
     if command_line.do_assert or command_line.do_debug:
       result += [
-        Simple_line(i,"  call irp_enter(irp_here)", f),
+        Simple_line(i,"  call irp_enter_f(irp_here)", f),
       ]
     return result
 
@@ -616,7 +616,7 @@ def irp_simple_statements(text):
       Declaration(i,"  character*(%d) :: irp_here = '%s'"%(length,subname), f) ]
     if command_line.do_assert or command_line.do_debug:
       result += [
-        Simple_line(i,"  call irp_enter(irp_here)", f),
+        Simple_line(i,"  call irp_enter_f(irp_here)", f),
       ]
     return result
 
diff --git a/src/variable.py b/src/variable.py
index c8f452d..82904d7 100644
--- a/src/variable.py
+++ b/src/variable.py
@@ -55,6 +55,20 @@ class Variable(object):
     return self._is_touched
   is_touched = property(is_touched)
 
+  ############################################################
+  def has_openmp(self):
+    if '_has_openmp' not in self.__dict__:
+      buffer = None
+      text = self.text
+      result = False
+      for line in text:
+        if type(line) == Openmp:
+          result = True
+          break
+      self._has_openmp = result
+    return self._has_openmp
+  has_openmp = property(has_openmp)
+
   ############################################################
   def is_written(self):
     if '_is_written' not in self.__dict__: