| <ompts:test> |
| <ompts:testdescription>Test which checks the guided option of the omp do schedule directive.</ompts:testdescription> |
| <ompts:ompversion>2.0</ompts:ompversion> |
| <ompts:directive>omp do schedule(guided)</ompts:directive> |
| <ompts:dependences>omp flush,omp do nowait,omp critical,omp single</ompts:dependences> |
| <ompts:testcode> |
| ! TODO: |
| ! C. Niethammer: |
| ! Find check to decide if the test was run as schedule(static) because |
| ! this also can pass the test if the work is divided into thread-counts |
| INTEGER FUNCTION <ompts:testcode:functionname>do_schedule_guided</ompts:testcode:functionname>() |
| IMPLICIT NONE |
| INTEGER omp_get_thread_num,omp_get_num_threads |
| CHARACTER*20 logfile |
| INTEGER threads |
| INTEGER tmp_count |
| INTEGER, allocatable :: tmp(:) |
| INTEGER ii, flag |
| INTEGER result |
| INTEGER expected |
| INTEGER openwork |
| DOUBLE PRECISION c |
| |
| <ompts:orphan:vars> |
| INTEGER i |
| INTEGER tid |
| INTEGER count |
| |
| INTEGER DELAY |
| INTEGER MAX_TIME |
| INTEGER CFSMAX_SIZE |
| |
| ! ... choose small iteration space for small sync. overhead |
| PARAMETER (DELAY = 1) |
| PARAMETER (MAX_TIME = 5) |
| PARAMETER (CFSMAX_SIZE = 150) |
| |
| INTEGER notout |
| INTEGER maxiter |
| INTEGER tids(0:CFSMAX_SIZE-1) |
| |
| COMMON /orphvars/ notout,maxiter,tids |
| </ompts:orphan:vars> |
| |
| result = 0 |
| notout = 1 |
| maxiter = 0 |
| count = 0 |
| tmp_count = 0 |
| openwork = CFSMAX_SIZE |
| <ompts:check> |
| |
| ! Determine the number of available threads |
| !$omp parallel |
| !$omp single |
| threads = omp_get_num_threads() |
| !$omp end single |
| !$omp end parallel |
| IF ( threads .LT. 2) THEN |
| PRINT *,"This test only works with at least two threads" |
| WRITE(1,*) "This test only works with at least two threads" |
| <testfunctionname></testfunctionname> = 0 |
| STOP |
| END IF |
| |
| ! ... Now the real parallel work: |
| ! ... Each thread will start immediately with the first chunk. |
| |
| !$omp parallel private(tid,count) shared(tids,maxiter) |
| tid = omp_get_thread_num() |
| <ompts:orphan> |
| !$omp do schedule(guided) |
| DO i = 0 , CFSMAX_SIZE-1 |
| count = 0 |
| !$omp flush(maxiter) |
| IF ( i .GT. maxiter ) THEN |
| !$omp critical |
| maxiter = i |
| !$omp end critical |
| END IF |
| |
| !.. if it is not our turn we wait |
| ! a) until another thread executed an iteration |
| ! with a higher iteration count |
| ! b) we are at the end of the loop (first thread finished |
| ! and set notout=0 OR |
| ! c) timeout arrived |
| |
| !$omp flush(maxiter,notout) |
| IF ( notout .GE. 1 .AND. count .LT. MAX_TIME |
| & .AND. maxiter .EQ. i ) THEN |
| DO WHILE ( notout .GE. 1 .AND. count .LT. MAX_TIME |
| & .AND. maxiter .EQ. i ) |
| CALL sleep(DELAY) |
| count = count + DELAY |
| END DO |
| END IF |
| tids(i) = tid |
| END DO |
| !$omp end do nowait |
| </ompts:orphan> |
| |
| notout = 0 |
| !$omp flush(notout) |
| |
| !$omp end parallel |
| |
| !*******************************************************! |
| ! evaluation of the values |
| !*******************************************************! |
| count = 0 |
| |
| DO i=0, CFSMAX_SIZE - 2 |
| IF ( tids(i) .NE. tids(i+1) ) THEN |
| count = count + 1 |
| END IF |
| END DO |
| |
| ALLOCATE( tmp(0:count) ) |
| tmp_count = 0 |
| tmp(0) = 1 |
| ! ... calculate the chunksize for each dispatch |
| |
| DO i=0, CFSMAX_SIZE - 2 |
| IF ( tids(i) .EQ. tids(i+1) ) THEN |
| tmp(tmp_count) = tmp(tmp_count) + 1 |
| ELSE |
| tmp_count = tmp_count + 1 |
| tmp(tmp_count) = 1 |
| END IF |
| END DO |
| |
| ! ... Check if chunk sizes are decreased until equals to |
| ! ... the specified one, ignore the last dispatch |
| ! ... for possible smaller remainder |
| |
| ! Determine the constant |
| expected = openwork / threads |
| c = real(tmp(0)) / real(expected) |
| WRITE(1,*) "Found constant to be ", c |
| |
| DO i = 0, count - 2 |
| WRITE(1,*) "open:", openwork, "size:", tmp(i) |
| IF (expected .GT. 1) THEN |
| expected = c * openwork / threads |
| END IF |
| |
| IF (abs(tmp(i) - expected) .GE. 2 ) THEN |
| result = 1 |
| WRITE(1,*) "Chunksize differed from expected ", |
| & "value: ",tmp(i), "instead ", expected |
| END IF |
| |
| IF (i .GT. 0 .AND. (tmp(i-1) - tmp(i)) .LT. 0) THEN |
| WRITE(1,*) "Chunksize did not decrease: ", tmp(i), |
| & "instead",tmp(i-1) |
| END IF |
| |
| openwork = openwork - tmp(i) |
| END DO |
| |
| IF ( result .EQ. 0 ) THEN |
| <testfunctionname></testfunctionname> = 1 |
| ELSE |
| <testfunctionname></testfunctionname> = 0 |
| END IF |
| END |
| </ompts:check> |
| <ompts:crosscheck> |
| <testfunctionname></testfunctionname> = 0 |
| END |
| </ompts:crosscheck> |
| </ompts:testcode> |
| </omtps:test> |