Test which checks that the omp_get_num_threads returns the correct number of threads. Therefor it counts up a variable in a parallelized section and compars this value with the result of the omp_get_num_threads function.
2.0
omp_get_num_threads
INTEGER FUNCTION omp_num_threads()
IMPLICIT NONE
INTEGER i, max_threads
INTEGER omp_get_num_threads
INTEGER failed,threads,nthreads,tmp
COMMON /orphvars/ failed,threads,nthreads
failed = 0
max_threads = 0
!$omp parallel
!$omp master
max_threads = OMP_GET_NUM_THREADS()
!$omp end master
!$omp end parallel
! print *, "max threads:",max_threads
!Yi Wen added omp_Set_dynamics here to make sure num_threads clause work
!Thanks to Dr. Yin Ma in Absoft. should be not be called before the test loop
!because it allows the dynamic adjustment of the number of threads at runtime
!instead of using the max_threads set.
!CALL OMP_SET_DYNAMIC(.TRUE.)
DO threads = 1, max_threads
nthreads = 0
!$omp parallel num_threads(threads) reduction(+:failed)
! print *, threads, omp_get_num_threads()
tmp = omp_get_num_threads()
IF ( threads .NE. tmp ) THEN
failed = failed + 1
WRITE (1,*) "Error: found ", tmp, " instead of ",
& threads, " threads"
END IF
!$omp atomic
nthreads = nthreads + 1
!$omp end parallel
! print *, threads, nthreads
IF ( nthreads .NE. threads ) THEN
IF ( nthreads .EQ. threads ) THEN
failed = failed + 1
END IF
END DO
IF(failed .NE. 0) THEN
= 0
ELSE
= 1
END IF
END FUNCTION