Test which checks the omp_test_nest_lock function. 2.0 omp_test_nest_lock omp flush INTEGER FUNCTION omp_test_nest_lock() IMPLICIT NONE INTEGER result !result is: ! 0 -- if the test fails ! 1 -- if the test succeeds INTEGER nr_threads_in_single INTEGER nr_iterations INTEGER i include "omp_lib.h" INTEGER (KIND=OMP_NEST_LOCK_KIND) :: lock COMMON /orphvars/ lock ! INTEGER lck INCLUDE "omp_testsuite.f" nr_iterations=0 nr_threads_in_single=0 CALL OMP_INIT_NEST_LOCK(lock) result=0 !$omp parallel shared(lock,nr_threads_in_single,nr_iterations,result) !$omp do DO i=1,LOOPCOUNT DO WHILE(OMP_TEST_NEST_LOCK(lock) .EQ. 0) END DO !$omp flush nr_threads_in_single=nr_threads_in_single+1 !$omp flush nr_iterations=nr_iterations+1 nr_threads_in_single=nr_threads_in_single-1 result=result+nr_threads_in_single CALL OMP_UNSET_NEST_LOCK(lock) END DO !$omp end do !$omp end parallel CALL omp_destroy_nest_lock(lock) ! print *, result, nr_iterations IF(result.EQ.0 .AND. nr_iterations .EQ. LOOPCOUNT) THEN =1 ELSE =0 ENDIF END FUNCTION