Test which checks the omp_set_nest_lock and the omp_unset_nest_lock function. 2.0 omp_nest_lock omp flush INTEGER FUNCTION omp_nest_lock() IMPLICIT NONE !result is: ! 0 -- if the test fails ! 1 -- if the test succeeds INTEGER result INTEGER nr_threads_in_single INTEGER nr_iterations INTEGER i INCLUDE "omp_lib.h" INTEGER (KIND=OMP_NEST_LOCK_KIND) :: lock COMMON /orphvars/ lock 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 CALL omp_set_nest_lock(lock) !$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 END IF END FUNCTION