blob: 33d4cd0c559b77d9ecb129be1dc964f30972fd37 [file] [log] [blame]
 Test which checks the omp parallel do ordered directive 2.0 omp parallel do ordered par schedule stat ! ********************************************************** ! Helper function is_larger ! ********************************************************** INTEGER FUNCTION i_islarger2(i) IMPLICIT NONE INTEGER i INTEGER last_i,islarger COMMON /com/ last_i INCLUDE "omp_testsuite.f" ! print *, "last_i",last_i, "i", i ! last_i is a global variable IF ( i .GT. last_i ) THEN islarger = 1 ELSE islarger = 0 END IF last_i = i i_islarger2 = islarger END FUNCTION INTEGER FUNCTION par_do_ordered() IMPLICIT NONE COMMON /com/ last_i INTEGER known_sum,i, last_i INTEGER is_larger,sum,i_islarger2 COMMON /orphvars/ is_larger,sum,i sum=0 is_larger=1 last_i=0 !\$omp parallel do schedule(static, 1) ordered DO i=1, 99 !\$omp ordered IF( i_islarger2(i) .EQ. 1 .AND. is_larger .EQ. 1 ) THEN is_larger = 1 ELSE is_larger = 0 END IF sum = sum + i !\$omp end ordered END DO !\$omp end parallel do known_sum = (99*100)/2 !Yi Wen; Sun compiler will fail sometimes ! print *, "sum", sum, "ks", known_sum, "la", is_larger IF ( known_sum .EQ. sum .AND. is_larger .EQ. 1 ) THEN = 1 ELSE = 0 END IF END FUNCTION