idar-gexcon

Problem using OMP FIRSTPRIVATE in Fortran module with openf90

Discussion created by idar-gexcon on Oct 14, 2010
Latest reply on Dec 22, 2011 by santosh.zanjurne

The simple test example shown below illustrates a problem I found when using the openf90 compiler (version 4.2.4 from AMD-developer). Other Fortran compilers like Intel Fortran, Absoft Fortran and GNU Fortran works fine on this example. Using OMP THERADPRIVATE in a Fortran module does not work properly with openf90, the workaround is to use a named common block in the module and set OMP FIRSTPRIVATE on that.

openf90 -o mytest -openmp omp_test_threadprivate.f90

./mytest produces truncated output for Test1:

MAXIMUM 8 THREADS
Test1, NVALS=4
 1 0
Test2, NVALS=4
 1 0
 2 1
 3 2
 4 3

The output should rather be something like:

MAXIMUM 8 THREADS
Test1, NVALS=4
 1 0
 2 1
 4 3
 3 2
Test2, NVALS=4
 2 1
 3 2
 4 3
 1 0

--- example fortran code: omp_test_threadprivate.f90

MODULE MyData1
   IMPLICIT NONE
   INTEGER :: IVAL,NVALS
   SAVE IVAL
   !$OMP THREADPRIVATE(IVAL)
END MODULE MyData1

MODULE MyData2
   IMPLICIT NONE
   INTEGER :: IVAL,NVALS
   COMMON /MyData2_IVAL_CMN/ IVAL
   !$OMP THREADPRIVATE(/MyData2_IVAL_CMN/)
END MODULE MyData2

SUBROUTINE Test1
   USE MyData1
   IMPLICIT NONE
   INTEGER N, TID
   !$ INTEGER, EXTERNAL :: OMP_GET_THREAD_NUM
   NVALS = 4
   WRITE(*,'(A,I0.1)') 'Test1, NVALS=',NVALS
   TID = 0
   !$OMP PARALLEL DO PRIVATE(N,TID)
   DO N = 1,NVALS
      !$ TID = OMP_GET_THREAD_NUM()
      WRITE(*,'(2(1X,I0.1))') N,TID
   END DO
END SUBROUTINE Test1

SUBROUTINE Test2
   USE MyData2
   IMPLICIT NONE
   INTEGER N, TID
   !$ INTEGER, EXTERNAL :: OMP_GET_THREAD_NUM
   NVALS = 4
   WRITE(*,'(A,I0.1)') 'Test2, NVALS=',NVALS
   TID = 0
   !$OMP PARALLEL DO PRIVATE(N,TID)
   DO N = 1,NVALS
      !$ TID = OMP_GET_THREAD_NUM()
      WRITE(*,'(2(1X,I0.1))') N,TID
   END DO
END SUBROUTINE Test2

PROGRAM Test
   IMPLICIT NONE
   !$ INTEGER, EXTERNAL :: OMP_GET_THREAD_NUM,OMP_GET_NUM_THREADS
   !$ CALL OMP_SET_DYNAMIC(.FALSE.)
   !$OMP PARALLEL
   !$ IF (OMP_GET_THREAD_NUM() == 0) THEN
   !$    WRITE(*,'(A,I0.1,A)') 'MAXIMUM ',OMP_GET_NUM_THREADS(),' THREADS'
   !$ END IF
   !$OMP END PARALLEL
   CALL Test1
   CALL Test2
END PROGRAM Test

---

Outcomes