From 45f46a8264fd9e0510357dede0b273d5f0fe6f2d Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Wed, 26 Feb 2025 14:29:06 -0800 Subject: [PATCH 01/37] factoring out devtest from many F90 tests and putting it in a common header file --- Tests/acc_copyin.F90 | 20 +-- Tests/acc_copyout.F90 | 20 +-- Tests/acc_delete_async.F90 | 11 +- Tests/acc_delete_async_with_len.F90 | 10 +- Tests/acc_is_present.F90 | 11 +- Tests/acc_is_present_with_len.F90 | 11 +- Tests/acc_update_device.F90 | 11 +- Tests/acc_update_device_async.F90 | 10 +- Tests/acc_update_device_async_with_len.F90 | 10 +- Tests/acc_update_device_with_len.F90 | 18 +-- Tests/acc_update_self_async.F90 | 18 +-- Tests/acc_update_self_async_with_len.F90 | 18 +-- Tests/common.Fh | 126 +++++++++++++++++++ Tests/data_copyout_reference_counts.F90 | 25 +--- Tests/declare_function_scope_copy.F90 | 34 +---- Tests/declare_function_scope_copyin.F90 | 27 +--- Tests/declare_function_scope_copyout.F90 | 25 +--- Tests/enter_data_if.F90 | 43 +------ Tests/exit_data.F90 | 16 +-- Tests/exit_data_copyout_reference_counts.F90 | 25 +--- Tests/exit_data_finalize.F90 | 16 +-- Tests/kernels_copy.F90 | 27 +--- Tests/kernels_copyin.F90 | 27 +--- Tests/kernels_copyout.F90 | 18 +-- Tests/kernels_create.F90 | 25 +--- Tests/kernels_default_copy.F90 | 18 +-- Tests/parallel_default_copy.F90 | 18 +-- Tests/serial_default_copy.F90 | 18 +-- Tests/serial_if.F90 | 25 +--- 29 files changed, 217 insertions(+), 464 deletions(-) create mode 100644 Tests/common.Fh diff --git a/Tests/acc_copyin.F90 b/Tests/acc_copyin.F90 index 0b507c8..d22844f 100644 --- a/Tests/acc_copyin.F90 +++ b/Tests/acc_copyin.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:runtime,data,executable-data,construct-independent,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -102,15 +104,8 @@ LOGICAL FUNCTION test3() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c, a_copy, b_copy !Data INTEGER :: errors = 0 - LOGICAL,DIMENSION(1):: devtest - - devtest(1) = .TRUE. - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = .FALSE. - !$acc end parallel - IF (devtest(1) .eqv. .TRUE.) THEN + IF (devtest() .eqv. .TRUE.) THEN SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED @@ -316,15 +311,8 @@ LOGICAL FUNCTION test7() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c, a_copy, b_copy !Data INTEGER :: errors = 0 - LOGICAL,DIMENSION(1):: devtest - - devtest(1) = .TRUE. - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = .FALSE. - !$acc end parallel - IF (devtest(1) .eqv. .TRUE.) THEN + IF (devtest() .eqv. .TRUE.) THEN !Initialization SEEDDIM(1) = 1 # ifdef SEED diff --git a/Tests/acc_copyout.F90 b/Tests/acc_copyout.F90 index 5bc6d85..dd47911 100644 --- a/Tests/acc_copyout.F90 +++ b/Tests/acc_copyout.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:runtime,data,executable-data,construct-independent,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -100,15 +102,8 @@ LOGICAL FUNCTION test3() INTEGER :: x REAL(8),DIMENSION(LOOPCOUNT):: a, b, c INTEGER :: errors = 0 - LOGICAL,DIMENSION(1):: devtest - - devtest(1) = .TRUE. - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = .FALSE. - !$acc end parallel - IF (devtest(1) .eqv. .TRUE.) THEN + IF (devtest() .eqv. .TRUE.) THEN SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED @@ -199,15 +194,8 @@ LOGICAL FUNCTION test5() INTEGER :: x REAL(8),DIMENSION(LOOPCOUNT):: a, b, c INTEGER :: errors = 0 - LOGICAL,DIMENSION(1):: devtest - devtest(1) = .TRUE. - - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = .FALSE. - !$acc end parallel - IF (devtest(1) .eqv. .TRUE.) THEN + IF (devtest() .eqv. .TRUE.) THEN SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED diff --git a/Tests/acc_delete_async.F90 b/Tests/acc_delete_async.F90 index 4969112..c4f145e 100644 --- a/Tests/acc_delete_async.F90 +++ b/Tests/acc_delete_async.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:runtime,data,executable-data,async,construct-independent,V:2.5-2.7 LOGICAL FUNCTION test1() @@ -67,16 +69,9 @@ LOGICAL FUNCTION test2() INCLUDE "acc_testsuite.Fh" INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c!Data - INTEGER,DIMENSION(1) :: devtest INTEGER :: errors = 0 - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - - IF (devtest(1) == 1) THEN + IF (devtest() .eqv. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 0 diff --git a/Tests/acc_delete_async_with_len.F90 b/Tests/acc_delete_async_with_len.F90 index d7ec22e..d5d9c51 100644 --- a/Tests/acc_delete_async_with_len.F90 +++ b/Tests/acc_delete_async_with_len.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:runtime,data,executable-data,async,construct-independent,V:2.5-2.7 LOGICAL FUNCTION test1() @@ -68,15 +70,9 @@ LOGICAL FUNCTION test2() INCLUDE "acc_testsuite.Fh" INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data - INTEGER,DIMENSION(1):: devtest INTEGER :: errors = 0 - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - IF (devtest(1) == 1) THEN + IF (devtest() .eqv. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 0 diff --git a/Tests/acc_is_present.F90 b/Tests/acc_is_present.F90 index d3609e1..0ac5270 100644 --- a/Tests/acc_is_present.F90 +++ b/Tests/acc_is_present.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:runtime,devonly,construct-independent,present,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -6,16 +8,9 @@ LOGICAL FUNCTION test1() INCLUDE "acc_testsuite.Fh" INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a !Data - INTEGER,DIMENSION(1):: devtest INTEGER :: errors errors = 0 - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - !$acc enter data create(a(1:LOOPCOUNT)) IF (acc_is_present(a(1:LOOPCOUNT)) .eqv. .FALSE.) THEN errors = errors + 1 @@ -23,7 +18,7 @@ LOGICAL FUNCTION test1() END IF !$acc exit data delete(a(1:LOOPCOUNT)) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN IF (acc_is_present(a(1:LOOPCOUNT)) .eqv. .TRUE.) THEN errors = errors + 1 PRINT*, 2 diff --git a/Tests/acc_is_present_with_len.F90 b/Tests/acc_is_present_with_len.F90 index c090ddb..b768cad 100644 --- a/Tests/acc_is_present_with_len.F90 +++ b/Tests/acc_is_present_with_len.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:runtime,devonly,construct-independent,present,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -6,22 +8,15 @@ LOGICAL FUNCTION test1() INCLUDE "acc_testsuite.Fh" INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a !Data - INTEGER,DIMENSION(1):: devtest INTEGER :: errors = 0 - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - !$acc enter data create(a(1:LOOPCOUNT)) IF (acc_is_present(a(1), LOOPCOUNT*8) .eqv. .FALSE.) THEN errors = errors + 1 END IF !$acc exit data delete(a(1:LOOPCOUNT)) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN IF (acc_is_present(a(1), LOOPCOUNT*8) .eqv. .TRUE.) THEN errors = errors + 1 END IF diff --git a/Tests/acc_update_device.F90 b/Tests/acc_update_device.F90 index 1b67898..0b73fb0 100644 --- a/Tests/acc_update_device.F90 +++ b/Tests/acc_update_device.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:runtime,data,executable-data,construct-independent,update,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -50,16 +52,9 @@ LOGICAL FUNCTION test2() INCLUDE "acc_testsuite.Fh" INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data - INTEGER,DIMENSION(1):: devtest INTEGER :: errors = 0 - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 0 diff --git a/Tests/acc_update_device_async.F90 b/Tests/acc_update_device_async.F90 index 7b34d42..40f4d4a 100644 --- a/Tests/acc_update_device_async.F90 +++ b/Tests/acc_update_device_async.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:runtime,data,executable-data,async,construct-independent,update,V:2.5-2.7 LOGICAL FUNCTION test1() @@ -65,15 +67,9 @@ LOGICAL FUNCTION test2() INCLUDE "acc_testsuite.Fh" INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data - INTEGER,DIMENSION(1):: devtest INTEGER :: errors = 0 - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 0 diff --git a/Tests/acc_update_device_async_with_len.F90 b/Tests/acc_update_device_async_with_len.F90 index 677046e..828adf3 100644 --- a/Tests/acc_update_device_async_with_len.F90 +++ b/Tests/acc_update_device_async_with_len.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:runtime,data,executable-data,async,construct-independent,update,V:2.5-2.7 LOGICAL FUNCTION test1() @@ -66,16 +68,10 @@ LOGICAL FUNCTION test2() INCLUDE "acc_testsuite.Fh" INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data - INTEGER,DIMENSION(1):: devtest INTEGER :: errors errors = 0 - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 0 diff --git a/Tests/acc_update_device_with_len.F90 b/Tests/acc_update_device_with_len.F90 index fb92329..aefc306 100644 --- a/Tests/acc_update_device_with_len.F90 +++ b/Tests/acc_update_device_with_len.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:runtime,data,executable-data,devonly,construct-independent,update,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -6,16 +8,9 @@ LOGICAL FUNCTION test1() INCLUDE "acc_testsuite.Fh" INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data - INTEGER,DIMENSION(1):: devtest REAL(8) :: RAND INTEGER :: errors = 0 - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel - devtest(1) = 0 - !$acc end parallel - !Initilization SEEDDIM(1) = 1 # ifdef SEED @@ -59,16 +54,9 @@ LOGICAL FUNCTION test2() INCLUDE "acc_testsuite.Fh" INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data - INTEGER,DIMENSION(1):: devtest REAL(8) :: RAND INTEGER :: errors = 0 - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel - devtest(1) = 0 - !$acc end parallel - !Initilization SEEDDIM(1) = 1 # ifdef SEED @@ -76,7 +64,7 @@ LOGICAL FUNCTION test2() # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 0 diff --git a/Tests/acc_update_self_async.F90 b/Tests/acc_update_self_async.F90 index 89e64f0..d1edd5e 100644 --- a/Tests/acc_update_self_async.F90 +++ b/Tests/acc_update_self_async.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:runtime,data,executable-data,devonly,async,construct-independent,update,V:2.5-2.7 LOGICAL FUNCTION test1() @@ -6,16 +8,9 @@ LOGICAL FUNCTION test1() INCLUDE "acc_testsuite.Fh" INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c, d !Data - INTEGER,DIMENSION(1):: devtest REAL(8) :: RAND INTEGER :: errors = 0 - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel - devtest(1) = 0 - !$acc end parallel - !Initilization SEEDDIM(1) = 1 # ifdef SEED @@ -70,16 +65,9 @@ LOGICAL FUNCTION test2() INCLUDE "acc_testsuite.Fh" INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c, d !Data - INTEGER,DIMENSION(1):: devtest REAL(8) :: RAND INTEGER :: errors = 0 - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel - devtest(1) = 0 - !$acc end parallel - !Initilization SEEDDIM(1) = 1 # ifdef SEED @@ -87,7 +75,7 @@ LOGICAL FUNCTION test2() # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 0 diff --git a/Tests/acc_update_self_async_with_len.F90 b/Tests/acc_update_self_async_with_len.F90 index ffb6ccd..57c0711 100644 --- a/Tests/acc_update_self_async_with_len.F90 +++ b/Tests/acc_update_self_async_with_len.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:runtime,data,executable-data,devonly,async,construct-independent,update,V:2.5-2.7 LOGICAL FUNCTION test1() @@ -6,16 +8,9 @@ LOGICAL FUNCTION test1() INCLUDE "acc_testsuite.Fh" INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c, d !Data - INTEGER,DIMENSION(1):: devtest REAL(8) :: RAND INTEGER :: errors = 0 - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - !Initilization SEEDDIM(1) = 1 # ifdef SEED @@ -69,16 +64,9 @@ LOGICAL FUNCTION test2() INCLUDE "acc_testsuite.Fh" INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c, d !Data - INTEGER,DIMENSION(1):: devtest REAL(8) :: RAND INTEGER :: errors = 0 - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - !Initilization SEEDDIM(1) = 1 # ifdef SEED @@ -86,7 +74,7 @@ LOGICAL FUNCTION test2() # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 0 diff --git a/Tests/common.Fh b/Tests/common.Fh new file mode 100644 index 0000000..73b10b5 --- /dev/null +++ b/Tests/common.Fh @@ -0,0 +1,126 @@ +#ifndef COMMON_H +#define COMMON_H +LOGICAL FUNCTION devtest() + IMPLICIT NONE + LOGICAL,DIMENSION(1) :: test + devtest = .FALSE. + test(1) = .TRUE. + !$acc parallel copyin(test(1:1)) + test(1) = .FALSE. + !$acc end parallel + IF (test(1)) THEN + devtest = .TRUE. + ENDIF +END FUNCTION devtest + +#ifdef ATOMIC_CLAUSE +! Verify the resultant sequence of atomic operation +#ifndef ATOMIC_LIST +FUNCTION VERIFY_ATOMIC_SEQUENCE(a, b, length, init, final, op) RESULT(POSSIBLE) +#else +FUNCTION VERIFY_ATOMIC_SEQUENCE(a, a2, b, length, init, final, op) RESULT(POSSIBLE) +#endif + IMPLICIT NONE + REAL, PARAMETER :: PRECISION = 1.e-2 + ATOMIC_TYPE, DIMENSION(length), INTENT(IN) :: a, b +#ifdef ATOMIC_LIST + ATOMIC_TYPE, DIMENSION(length), INTENT(IN) :: a2 +#endif + INTEGER, INTENT(IN) :: length, op + ATOMIC_TYPE, INTENT(IN) :: init, final + LOGICAL, DIMENSION(length) :: done + INTEGER :: i, j + LOGICAL :: POSSIBLE + ATOMIC_TYPE :: current, tmp + + POSSIBLE = .FALSE. + done = .FALSE. + current = init + + outer: do i = 1, length + do j = 1, length +#ifdef ATOMIC_ASSIGN_FIRST +#ifdef ATOMIC_REAL + if (.NOT. done(j) .AND. abs(b(j) - current) .lt. PRECISION) then +#elif defined(ATOMIC_INTEGER) || defined(ATOMIC_LOGICAL) + if (.NOT. done(j) .AND. b(j) .eq. current) then +#endif + done(j) = .TRUE. +#endif +#ifndef ATOMIC_LIST + tmp = ATOMIC_OP(a(j), current) +#else + tmp = ATOMIC_OP(a(j), a2(j), current) +#endif +#ifdef ATOMIC_ASSIGN_FIRST + current = tmp + cycle outer + end if +#else +#ifdef ATOMIC_REAL + if (.NOT. done(j) .AND. abs(b(j) - tmp) .lt. PRECISION) then +#elif defined(ATOMIC_INTEGER) || defined(ATOMIC_LOGICAL) + if (.NOT. done(j) .AND. b(j) .eq. tmp) then +#endif + current = tmp + done(j) = .TRUE. + cycle outer + endif +#endif + end do + return + end do outer + +#ifdef ATOMIC_REAL + if (abs(current - final) .lt. PRECISION) then +#elif defined(ATOMIC_INTEGER) || defined(ATOMIC_LOGICAL) + if (current .eq. final) then +#endif + POSSIBLE = .TRUE. + end if +END FUNCTION + +#if defined(ATOMIC_REAL) || defined(ATOMIC_INTEGER) +RECURSIVE FUNCTION IS_POSSIBLE(a, length, current, final, op) RESULT(POSSIBLE) + IMPLICIT NONE + REAL, PARAMETER :: PRECISION = 1.e-2 + ATOMIC_TYPE, DIMENSION(length), INTENT(IN) :: a + INTEGER, INTENT(IN) :: length, op + ATOMIC_TYPE, INTENT(IN) :: current, final + ATOMIC_TYPE, ALLOCATABLE :: rest(:) + ATOMIC_TYPE :: tmp + LOGICAL :: POSSIBLE + INTEGER :: i, j + + POSSIBLE = .FALSE. + + IF (length .le. 0) THEN + IF (abs(current - final) .lt. PRECISION) THEN + POSSIBLE = .TRUE. + END IF + RETURN + ENDIF + + ALLOCATE(rest(length - 1)) + + DO i = 1, length + DO j = 1, i - 1 + rest(j) = a(j) + END DO + DO j = i + 1, length + rest(j - 1) = a(j) + END DO +#ifndef ATOMIC_LIST + tmp = ATOMIC_OP(a(i), current) +#endif + IF (IS_POSSIBLE(rest, length - 1, tmp, final, op)) THEN + POSSIBLE = .TRUE. + EXIT + END IF + END DO + + DEALLOCATE(rest) +END FUNCTION IS_POSSIBLE +#endif +#endif +#endif diff --git a/Tests/data_copyout_reference_counts.F90 b/Tests/data_copyout_reference_counts.F90 index 9749d99..5fde61c 100644 --- a/Tests/data_copyout_reference_counts.F90 +++ b/Tests/data_copyout_reference_counts.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:data,data_region,devonly,construct-independent,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -6,13 +8,6 @@ LOGICAL FUNCTION test1() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1)::devtest - - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel !Initilization SEEDDIM(1) = 1 @@ -21,7 +16,7 @@ LOGICAL FUNCTION test1() # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 0 @@ -59,13 +54,6 @@ LOGICAL FUNCTION test2() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1)::devtest - - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel !Initilization SEEDDIM(1) = 1 @@ -118,13 +106,6 @@ LOGICAL FUNCTION test3() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1)::devtest - - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel !Initilization SEEDDIM(1) = 1 diff --git a/Tests/declare_function_scope_copy.F90 b/Tests/declare_function_scope_copy.F90 index 2389618..33d1182 100644 --- a/Tests/declare_function_scope_copy.F90 +++ b/Tests/declare_function_scope_copy.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + SUBROUTINE copyin_copyout_test(a, b, c, LOOPCOUNT) REAL(8),DIMENSION(LOOPCOUNT),INTENT(IN) :: a, b REAL(8),DIMENSION(LOOPCOUNT),INTENT(INOUT) :: c @@ -21,15 +23,8 @@ LOGICAL FUNCTION test1() INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT, LOOPCOUNT) :: a, b, c - INTEGER,DIMENSION(1) :: devtest INTEGER :: x, y - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED @@ -68,15 +63,8 @@ LOGICAL FUNCTION test2() INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT, LOOPCOUNT) :: a, b, c - INTEGER,DIMENSION(1) :: devtest INTEGER :: x, y - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED @@ -119,22 +107,15 @@ LOGICAL FUNCTION test3() INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT, LOOPCOUNT) :: a, b, c - INTEGER,DIMENSION(1) :: devtest INTEGER :: x, y - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 3 @@ -174,22 +155,15 @@ LOGICAL FUNCTION test4() INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT, LOOPCOUNT) :: a, b, c - INTEGER,DIMENSION(1) :: devtest INTEGER :: x, y - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 4 diff --git a/Tests/declare_function_scope_copyin.F90 b/Tests/declare_function_scope_copyin.F90 index 12a7242..f61aa6f 100644 --- a/Tests/declare_function_scope_copyin.F90 +++ b/Tests/declare_function_scope_copyin.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + FUNCTION function_test(a, b, c, LOOPCOUNT) REAL(8),DIMENSION(LOOPCOUNT),INTENT(IN) :: a, b REAL(8),DIMENSION(LOOPCOUNT),INTENT(INOUT) :: c @@ -39,15 +41,8 @@ LOGICAL FUNCTION test1() INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT, LOOPCOUNT) :: a, b, c, a_host, b_host - INTEGER,DIMENSION(1) :: devtest INTEGER :: x, y - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED @@ -89,22 +84,15 @@ LOGICAL FUNCTION test2() INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT, LOOPCOUNT) :: a, b, c, a_host, b_host - INTEGER,DIMENSION(1) :: devtest INTEGER :: x, y - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 0 @@ -151,22 +139,15 @@ LOGICAL FUNCTION test3() INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT, LOOPCOUNT) :: a, b, c, a_host, b_host - INTEGER,DIMENSION(1) :: devtest INTEGER :: x, y - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 1 diff --git a/Tests/declare_function_scope_copyout.F90 b/Tests/declare_function_scope_copyout.F90 index facc34f..d28546d 100644 --- a/Tests/declare_function_scope_copyout.F90 +++ b/Tests/declare_function_scope_copyout.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + FUNCTION copyout_test(a, b, c, LOOPCOUNT) REAL(8),DIMENSION(LOOPCOUNT),INTENT(IN) :: a, b REAL(8),DIMENSION(LOOPCOUNT),INTENT(INOUT) :: c @@ -22,15 +24,8 @@ LOGICAL FUNCTION test1() INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT, LOOPCOUNT) :: a, b, c - INTEGER,DIMENSION(1) :: devtest INTEGER :: x, y - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED @@ -71,15 +66,8 @@ LOGICAL FUNCTION test2() INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT, LOOPCOUNT) :: a, b, c - INTEGER,DIMENSION(1) :: devtest INTEGER :: x, y - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED @@ -122,22 +110,15 @@ LOGICAL FUNCTION test3() INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT, LOOPCOUNT) :: a, b, c - INTEGER,DIMENSION(1) :: devtest INTEGER :: x, y - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 3 diff --git a/Tests/enter_data_if.F90 b/Tests/enter_data_if.F90 index f6a2c63..32115f2 100644 --- a/Tests/enter_data_if.F90 +++ b/Tests/enter_data_if.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:data,executable-data,devonly,construct-independent,if,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -6,15 +8,8 @@ LOGICAL FUNCTION test1() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, a_copy, b, b_copy, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest LOGICAL :: dev = .TRUE. LOGICAL :: cpu = .FALSE. - devtest(1) = 1 - - !$acc enter data copyin(devtest(1:1)) - !$acc parallel - devtest(1) = 0 - !$acc end parallel !Initilization SEEDDIM(1) = 1 @@ -58,15 +53,8 @@ LOGICAL FUNCTION test2() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, a_copy, b, b_copy, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest LOGICAL :: dev = .TRUE. LOGICAL :: cpu = .FALSE. - devtest(1) = 1 - - !$acc enter data copyin(devtest(1:1)) - !$acc parallel - devtest(1) = 0 - !$acc end parallel !Initilization SEEDDIM(1) = 1 @@ -111,15 +99,8 @@ LOGICAL FUNCTION test3() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, a_copy, b, b_copy, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest LOGICAL :: dev = .TRUE. LOGICAL :: cpu = .FALSE. - devtest(1) = 1 - - !$acc enter data copyin(devtest(1:1)) - !$acc parallel - devtest(1) = 0 - !$acc end parallel !Initilization SEEDDIM(1) = 1 @@ -128,7 +109,7 @@ LOGICAL FUNCTION test3() # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) a_copy = a CALL RANDOM_NUMBER(b) @@ -172,15 +153,8 @@ LOGICAL FUNCTION test4() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, a_copy, b, b_copy, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest LOGICAL :: dev = .TRUE. LOGICAL :: cpu = .FALSE. - devtest(1) = 1 - - !$acc enter data copyin(devtest(1:1)) - !$acc parallel - devtest(1) = 0 - !$acc end parallel !Initilization SEEDDIM(1) = 1 @@ -189,7 +163,7 @@ LOGICAL FUNCTION test4() # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 0 @@ -232,15 +206,8 @@ LOGICAL FUNCTION test5() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, a_copy, b, b_copy, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest LOGICAL :: dev = .TRUE. LOGICAL :: cpu = .FALSE. - devtest(1) = 1 - - !$acc enter data copyin(devtest(1:1)) - !$acc parallel - devtest(1) = 0 - !$acc end parallel !Initilization SEEDDIM(1) = 1 @@ -249,7 +216,7 @@ LOGICAL FUNCTION test5() # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 0 diff --git a/Tests/exit_data.F90 b/Tests/exit_data.F90 index 34845a9..ef6cf14 100644 --- a/Tests/exit_data.F90 +++ b/Tests/exit_data.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:data,executable-data,devonly,construct-independent,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -6,12 +8,6 @@ LOGICAL FUNCTION test1() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, a_copy !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel - devtest(1) = 0 - !$acc end parallel !Initilization SEEDDIM(1) = 1 @@ -23,7 +19,7 @@ LOGICAL FUNCTION test1() CALL RANDOM_NUMBER(a) a_copy = a - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN !$acc enter data copyin(a(1:LOOPCOUNT)) !$acc parallel present(a(1:LOOPCOUNT)) !$acc loop @@ -55,12 +51,6 @@ LOGICAL FUNCTION test2() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, a_copy !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel - devtest(1) = 0 - !$acc end parallel !Initilization SEEDDIM(1) = 1 diff --git a/Tests/exit_data_copyout_reference_counts.F90 b/Tests/exit_data_copyout_reference_counts.F90 index a45f339..0b9bbe6 100644 --- a/Tests/exit_data_copyout_reference_counts.F90 +++ b/Tests/exit_data_copyout_reference_counts.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:data,executable-data,devonly,construct-independent,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -6,13 +8,6 @@ LOGICAL FUNCTION test1() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest - - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel !Initilization SEEDDIM(1) = 1 @@ -25,7 +20,7 @@ LOGICAL FUNCTION test1() CALL RANDOM_NUMBER(b) c = 0 - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN !$acc enter data copyin(a(1:LOOPCOUNT), b(1:LOOPCOUNT), c(1:LOOPCOUNT)) !$acc data copyin(c(1:LOOPCOUNT)) !$acc parallel @@ -60,13 +55,6 @@ LOGICAL FUNCTION test2() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest - - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel !Initilization SEEDDIM(1) = 1 @@ -111,13 +99,6 @@ LOGICAL FUNCTION test3() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest - - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel !Initilization SEEDDIM(1) = 1 diff --git a/Tests/exit_data_finalize.F90 b/Tests/exit_data_finalize.F90 index fa8e08e..9ae9981 100644 --- a/Tests/exit_data_finalize.F90 +++ b/Tests/exit_data_finalize.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:data,executable-data,devonly,construct-independent,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -6,13 +8,6 @@ LOGICAL FUNCTION test1() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1) :: devtest - - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel !Initilization SEEDDIM(1) = 1 @@ -63,13 +58,6 @@ LOGICAL FUNCTION test2() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1) :: devtest - - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel !Initilization SEEDDIM(1) = 1 diff --git a/Tests/kernels_copy.F90 b/Tests/kernels_copy.F90 index 2da7440..4f7212f 100644 --- a/Tests/kernels_copy.F90 +++ b/Tests/kernels_copy.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:devonly,kernels,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -6,13 +8,6 @@ LOGICAL FUNCTION test1() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest - devtest(1) = 1 - - !$acc enter data copyin(devtest(1:1)) - !$acc kernels present(devtest) - devtest(1) = 0 - !$acc end kernels !Initilization SEEDDIM(1) = 1 @@ -55,13 +50,6 @@ LOGICAL FUNCTION test2() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest - devtest(1) = 1 - - !$acc enter data copyin(devtest(1:1)) - !$acc kernels present(devtest) - devtest(1) = 0 - !$acc end kernels !Initilization SEEDDIM(1) = 1 @@ -70,7 +58,7 @@ LOGICAL FUNCTION test2() # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 1 @@ -108,13 +96,6 @@ LOGICAL FUNCTION test3() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest - devtest(1) = 1 - - !$acc enter data copyin(devtest(1:1)) - !$acc kernels present(devtest) - devtest(1) = 0 - !$acc end kernels !Initilization SEEDDIM(1) = 1 @@ -123,7 +104,7 @@ LOGICAL FUNCTION test3() # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 1 diff --git a/Tests/kernels_copyin.F90 b/Tests/kernels_copyin.F90 index cf4478f..e2776e9 100644 --- a/Tests/kernels_copyin.F90 +++ b/Tests/kernels_copyin.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:devonly,kernels,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -6,13 +8,6 @@ LOGICAL FUNCTION test1() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest - devtest(1) = 1 - - !$acc enter data copyin(devtest(1:1)) - !$acc kernels - devtest(1) = 0 - !$acc end kernels !Initilization SEEDDIM(1) = 1 @@ -54,13 +49,6 @@ LOGICAL FUNCTION test2() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest - devtest(1) = 1 - - !$acc enter data copyin(devtest(1:1)) - !$acc kernels - devtest(1) = 0 - !$acc end kernels !Initilization SEEDDIM(1) = 1 @@ -69,7 +57,7 @@ LOGICAL FUNCTION test2() # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) b = 0 !$acc data copy(a(1:LOOPCOUNT), b(1:LOOPCOUNT)) @@ -110,13 +98,6 @@ LOGICAL FUNCTION test3() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest - devtest(1) = 1 - - !$acc enter data copyin(devtest(1:1)) - !$acc kernels - devtest(1) = 0 - !$acc end kernels !Initilization SEEDDIM(1) = 1 @@ -125,7 +106,7 @@ LOGICAL FUNCTION test3() # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) b = 0 diff --git a/Tests/kernels_copyout.F90 b/Tests/kernels_copyout.F90 index 50b8057..92002f2 100644 --- a/Tests/kernels_copyout.F90 +++ b/Tests/kernels_copyout.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:devonly,kernels,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -6,13 +8,6 @@ LOGICAL FUNCTION test1() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest - devtest(1) = 1 - - !$acc enter data copyin(devtest(1:1)) - !$acc kernels present(devtest(1:1)) - devtest(1) = 0 - !$acc end kernels !Initilization SEEDDIM(1) = 1 @@ -54,13 +49,6 @@ LOGICAL FUNCTION test2() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest - devtest(1) = 1 - - !$acc enter data copyin(devtest(1:1)) - !$acc kernels present(devtest(1:1)) - devtest(1) = 0 - !$acc end kernels !Initilization SEEDDIM(1) = 1 @@ -69,7 +57,7 @@ LOGICAL FUNCTION test2() # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) b = 0 diff --git a/Tests/kernels_create.F90 b/Tests/kernels_create.F90 index 846c9ed..4f9f8a5 100644 --- a/Tests/kernels_create.F90 +++ b/Tests/kernels_create.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:devonly,kernels,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -6,13 +8,6 @@ LOGICAL FUNCTION test1() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest - devtest(1) = 1 - - !$acc enter data copyin(devtest(1:1)) - !$acc kernels present(devtest(1:1)) - devtest(1) = 0 - !$acc end kernels !Initilization SEEDDIM(1) = 1 @@ -21,7 +16,7 @@ LOGICAL FUNCTION test1() # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) b = 0 c = 0 @@ -55,13 +50,6 @@ LOGICAL FUNCTION test2() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest - devtest(1) = 1 - - !$acc enter data copyin(devtest(1:1)) - !$acc kernels present(devtest(1:1)) - devtest(1) = 0 - !$acc end kernels !Initilization SEEDDIM(1) = 1 @@ -101,13 +89,6 @@ LOGICAL FUNCTION test3() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - INTEGER,DIMENSION(1):: devtest - devtest(1) = 1 - - !$acc enter data copyin(devtest(1:1)) - !$acc kernels present(devtest(1:1)) - devtest(1) = 0 - !$acc end kernels !Initilization SEEDDIM(1) = 1 diff --git a/Tests/kernels_default_copy.F90 b/Tests/kernels_default_copy.F90 index 34852f1..2f35c46 100644 --- a/Tests/kernels_default_copy.F90 +++ b/Tests/kernels_default_copy.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:devonly,kernels,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -6,13 +8,6 @@ LOGICAL FUNCTION test1() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - LOGICAL,DIMENSION(1):: devtest - devtest(1) = .TRUE. - - !$acc enter data copyin(devtest(1:1)) - !$acc kernels - devtest(1) = .FALSE. - !$acc end kernels !Initilization SEEDDIM(1) = 1 @@ -54,13 +49,6 @@ LOGICAL FUNCTION test2() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - LOGICAL,DIMENSION(1):: devtest - devtest(1) = .TRUE. - - !$acc enter data copyin(devtest(1:1)) - !$acc kernels - devtest(1) = .FALSE. - !$acc end kernels !Initilization SEEDDIM(1) = 1 @@ -69,7 +57,7 @@ LOGICAL FUNCTION test2() # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1)) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 1 diff --git a/Tests/parallel_default_copy.F90 b/Tests/parallel_default_copy.F90 index 6128f04..c4ebb2f 100644 --- a/Tests/parallel_default_copy.F90 +++ b/Tests/parallel_default_copy.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:devonly,parallel,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -6,13 +8,6 @@ LOGICAL FUNCTION test1() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - LOGICAL,DIMENSION(1):: devtest - devtest(1) = .TRUE. - - !$acc enter data copyin(devtest(1:1)) - !$acc parallel - devtest(1) = .FALSE. - !$acc end parallel !Initilization SEEDDIM(1) = 1 @@ -54,13 +49,6 @@ LOGICAL FUNCTION test2() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b, c !Data INTEGER :: errors = 0 - LOGICAL,DIMENSION(1):: devtest - devtest(1) = .TRUE. - - !$acc enter data copyin(devtest(1:1)) - !$acc parallel - devtest(1) = .FALSE. - !$acc end parallel !Initilization SEEDDIM(1) = 1 @@ -69,7 +57,7 @@ LOGICAL FUNCTION test2() # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1)) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 1 diff --git a/Tests/serial_default_copy.F90 b/Tests/serial_default_copy.F90 index 429a870..56d08d6 100644 --- a/Tests/serial_default_copy.F90 +++ b/Tests/serial_default_copy.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:devonly,V:2.6-2.7 LOGICAL FUNCTION test1() @@ -5,16 +7,9 @@ LOGICAL FUNCTION test1() INCLUDE "acc_testsuite.Fh" INTEGER:: errors REAL(8),DIMENSION(LOOPCOUNT):: a, b, c - INTEGER,DIMENSION(1):: devtest INTEGER:: x errors = 0 - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED @@ -54,23 +49,16 @@ LOGICAL FUNCTION test2() INCLUDE "acc_testsuite.Fh" INTEGER:: errors REAL(8),DIMENSION(LOOPCOUNT):: a, b, c - INTEGER,DIMENSION(1):: devtest INTEGER:: x errors = 0 - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 1 diff --git a/Tests/serial_if.F90 b/Tests/serial_if.F90 index 0a46c3b..9e157c4 100644 --- a/Tests/serial_if.F90 +++ b/Tests/serial_if.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:devonly,serial,if,V:2.6-2.7 LOGICAL FUNCTION test1() @@ -5,19 +7,12 @@ LOGICAL FUNCTION test1() INCLUDE "acc_testsuite.Fh" INTEGER:: errors REAL(8),DIMENSION(LOOPCOUNT):: a, b, c - LOGICAL,DIMENSION(1):: devtest LOGICAL:: host, device INTEGER:: x host = .FALSE. device = .TRUE. errors = 0 - devtest(1) = .TRUE. - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = .FALSE. - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED @@ -55,26 +50,19 @@ LOGICAL FUNCTION test2() INCLUDE "acc_testsuite.Fh" INTEGER:: errors REAL(8),DIMENSION(LOOPCOUNT):: a, b, c - LOGICAL,DIMENSION(1):: devtest LOGICAL:: host, device INTEGER:: x host = .FALSE. device = .TRUE. errors = 0 - devtest(1) = .TRUE. - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = .FALSE. - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1)) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = a + b @@ -109,19 +97,12 @@ LOGICAL FUNCTION test3() INCLUDE "acc_testsuite.Fh" INTEGER:: errors REAL(8),DIMENSION(LOOPCOUNT):: a, b, c - LOGICAL,DIMENSION(1):: devtest LOGICAL:: host, device INTEGER:: x host = .FALSE. device = .TRUE. errors = 0 - devtest(1) = .TRUE. - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = .FALSE. - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED From 07b5cdf15425f7cb6f507df2ba290d13b2313dcb Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Wed, 26 Feb 2025 14:31:48 -0800 Subject: [PATCH 02/37] major refactor of F90 atomic tests to all follow a common pattern and reduce code duplication --- Tests/acc_testsuite.Fh | 3 + Tests/atomic_capture_assign_expr_and_x.F90 | 138 +--------- .../atomic_capture_assign_expr_divided_x.F90 | 169 +----------- Tests/atomic_capture_assign_expr_eqv_x.F90 | 142 +--------- Tests/atomic_capture_assign_expr_minus_x.F90 | 161 +---------- Tests/atomic_capture_assign_expr_neqv_x.F90 | 140 +--------- Tests/atomic_capture_assign_expr_or_x.F90 | 142 +--------- Tests/atomic_capture_assign_expr_plus_x.F90 | 131 +-------- Tests/atomic_capture_assign_expr_times_x.F90 | 131 +-------- Tests/atomic_capture_assign_iand_expr_x.F90 | 142 +--------- Tests/atomic_capture_assign_iand_x_expr.F90 | 149 +--------- Tests/atomic_capture_assign_ior_expr_x.F90 | 140 +--------- Tests/atomic_capture_assign_ior_x_expr.F90 | 140 +--------- Tests/atomic_capture_assign_ixor_expr_x.F90 | 140 +--------- Tests/atomic_capture_assign_ixor_x_expr.F90 | 140 +--------- .../atomic_capture_assign_max_expr_list_x.F90 | 136 +-------- Tests/atomic_capture_assign_max_expr_x.F90 | 130 +-------- Tests/atomic_capture_assign_max_x_expr.F90 | 130 +-------- .../atomic_capture_assign_max_x_expr_list.F90 | 134 +-------- .../atomic_capture_assign_min_expr_list_x.F90 | 134 +-------- Tests/atomic_capture_assign_min_expr_x.F90 | 130 +-------- Tests/atomic_capture_assign_min_x_expr.F90 | 130 +-------- .../atomic_capture_assign_min_x_expr_list.F90 | 134 +-------- Tests/atomic_capture_assign_x_and_expr.F90 | 139 +--------- .../atomic_capture_assign_x_divided_expr.F90 | 169 +----------- Tests/atomic_capture_assign_x_eqv_expr.F90 | 142 +--------- Tests/atomic_capture_assign_x_minus_expr.F90 | 161 +---------- Tests/atomic_capture_assign_x_neqv_expr.F90 | 140 +--------- Tests/atomic_capture_assign_x_or_expr.F90 | 142 +--------- Tests/atomic_capture_assign_x_plus_expr.F90 | 131 +-------- Tests/atomic_capture_assign_x_times_expr.F90 | 131 +-------- Tests/atomic_capture_expr_and_x_assign.F90 | 132 +-------- .../atomic_capture_expr_divided_x_assign.F90 | 169 +----------- Tests/atomic_capture_expr_eqv_x_assign.F90 | 142 +--------- Tests/atomic_capture_expr_minus_x_assign.F90 | 161 +---------- Tests/atomic_capture_expr_neqv_x_assign.F90 | 140 +--------- Tests/atomic_capture_expr_or_x_assign.F90 | 142 +--------- Tests/atomic_capture_expr_plus_x_assign.F90 | 131 +-------- Tests/atomic_capture_expr_times_x_assign.F90 | 131 +-------- Tests/atomic_capture_iand_expr_x_assign.F90 | 149 +--------- Tests/atomic_capture_iand_x_expr_assign.F90 | 149 +--------- Tests/atomic_capture_ior_expr_x_assign.F90 | 140 +--------- Tests/atomic_capture_ior_x_expr_assign.F90 | 140 +--------- Tests/atomic_capture_ixor_expr_x_assign.F90 | 140 +--------- Tests/atomic_capture_ixor_x_expr_assign.F90 | 140 +--------- .../atomic_capture_max_expr_list_x_assign.F90 | 134 +-------- Tests/atomic_capture_max_expr_x_assign.F90 | 130 +-------- Tests/atomic_capture_max_x_expr_assign.F90 | 130 +-------- .../atomic_capture_max_x_expr_list_assign.F90 | 134 +-------- .../atomic_capture_min_expr_list_x_assign.F90 | 134 +-------- Tests/atomic_capture_min_expr_x_assign.F90 | 130 +-------- Tests/atomic_capture_min_x_expr_assign.F90 | 130 +-------- .../atomic_capture_min_x_expr_list_assign.F90 | 134 +-------- Tests/atomic_capture_x_and_expr_assign.F90 | 139 +--------- .../atomic_capture_x_divided_expr_assign.F90 | 169 +----------- Tests/atomic_capture_x_eqv_expr_assign.F90 | 142 +--------- Tests/atomic_capture_x_minus_expr_assign.F90 | 161 +---------- Tests/atomic_capture_x_neqv_expr_assign.F90 | 140 +--------- Tests/atomic_capture_x_or_expr_assign.F90 | 142 +--------- Tests/atomic_capture_x_plus_expr_assign.F90 | 131 +-------- Tests/atomic_capture_x_times_expr_assign.F90 | 131 +-------- Tests/atomic_expr_divided_x.F90 | 111 +------- Tests/atomic_expr_divided_x_end.F90 | 111 +------- Tests/atomic_expr_minus_x.F90 | 110 +------- Tests/atomic_expr_minus_x_end.F90 | 110 +------- Tests/atomic_template.Fh | 258 ++++++++++++++++++ Tests/atomic_update_expr_divided_x.F90 | 111 +------- Tests/atomic_update_expr_divided_x_end.F90 | 111 +------- Tests/atomic_update_expr_minus_x.F90 | 110 +------- Tests/atomic_update_expr_minus_x_end.F90 | 110 +------- 70 files changed, 733 insertions(+), 8847 deletions(-) create mode 100644 Tests/atomic_template.Fh diff --git a/Tests/acc_testsuite.Fh b/Tests/acc_testsuite.Fh index 9888325..cc0beb7 100644 --- a/Tests/acc_testsuite.Fh +++ b/Tests/acc_testsuite.Fh @@ -7,3 +7,6 @@ integer, parameter :: NUM_TEST_CALLS = 1 integer, parameter :: n = 1 integer, dimension(33) :: SEEDDIM = 0 real, parameter :: PRECISION = 1.e-2 +logical, external :: devtest +logical, external :: VERIFY_ATOMIC_SEQUENCE +logical, external :: IS_POSSIBLE diff --git a/Tests/atomic_capture_assign_expr_and_x.F90 b/Tests/atomic_capture_assign_expr_and_x.F90 index 340c1f1..f023028 100644 --- a/Tests/atomic_capture_assign_expr_and_x.F90 +++ b/Tests/atomic_capture_assign_expr_and_x.F90 @@ -1,134 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - LOGICAL,DIMENSION(length), INTENT(IN) :: a - LOGICAL,DIMENSION(length), INTENT(IN) :: b - LOGICAL, INTENT(IN) :: init - LOGICAL,DIMENSION(length - 1) :: passed_a - LOGICAL,DIMENSION(length - 1) :: passed_b - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - IF (b(x) .eqv. init) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, a(x) .AND. init)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_LOGICAL +#define ATOMIC_OPTYPE EXPR_AND_X +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT .TRUE. +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: randoms - LOGICAL,DIMENSION(LOOPCOUNT, 10):: a, b !Data - LOGICAL,DIMENSION(10):: passed_a, passed_b - LOGICAL IS_POSSIBLE - LOGICAL,DIMENSION(LOOPCOUNT):: totals, totals_comparison - INTEGER :: errors = 0 - LOGICAL :: init - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - DO x = 1, LOOPCOUNT - DO y = 1, 10 - IF (randoms(x, y) < .933) THEN - a(x, y) = .TRUE. - ELSE - a(x, y) = .FALSE. - END IF - END DO - END DO - - totals = .FALSE. - totals_comparison = .FALSE. - - !$acc data copyin(a(1:LOOPCOUNT,1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = a(x, y) .AND. totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) .AND. a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NEQV. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = .FALSE. - IF (.FALSE. .eqv. IS_POSSIBLE(a(x, 1:10), b(x, 1:10), 10, .FALSE.)) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_expr_divided_x.F90 b/Tests/atomic_capture_assign_expr_divided_x.F90 index ed55093..75eb962 100644 --- a/Tests/atomic_capture_assign_expr_divided_x.F90 +++ b/Tests/atomic_capture_assign_expr_divided_x.F90 @@ -1,165 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE_2(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - real(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - REAL(8):: mindif - IF (length .lt. 10) THEN - WRITE(*, *) length - END IF - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - init) .lt. (100 - length) * PRECISION) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = a(x) / init - IF (IS_POSSIBLE_2(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE_2 - - RECURSIVE FUNCTION IS_POSSIBLE(subset, destination, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8),DIMENSION(length), INTENT(IN) :: subset - REAL(8), INTENT(IN) :: destination - REAL(8), INTENT(IN) :: init - REAL(8),ALLOCATABLE :: passed(:) - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .gt. 0) THEN - ALLOCATE(passed(length - 1)) - ELSE - IF (abs(init - destination) .lt. (10 - length) * PRECISION) THEN - POSSIBLE = .TRUE. - ELSE - POSSIBLE = .FALSE. - END IF - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - DO y = 1, x - 1 - passed(y) = subset(y) - END DO - DO y = x + 1, length - passed(y - 1) = subset(y) - END DO - holder = subset(x) / init - IF (IS_POSSIBLE(passed, destination, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE EXPR_DIVIDED_X +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a !Data - REAL(8),DIMENSION(LOOPCOUNT, 10):: b - REAL(8),DIMENSION(LOOPCOUNT):: totals - REAL(8),DIMENSION(10):: passed - REAL(8),DIMENSION(10):: passed_b - REAL(8) :: holder - INTEGER :: errors = 0 - LOGICAL IS_POSSIBLE - LOGICAL IS_POSSIBLE_2 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 1 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = a(x, y) / totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed(y) = a(x, y) - END DO - holder = 1 - IF (IS_POSSIBLE(passed, totals(x), 10, holder) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - holder = 1 - IF (IS_POSSIBLE_2(passed, passed_b, 10, holder) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_expr_eqv_x.F90 b/Tests/atomic_capture_assign_expr_eqv_x.F90 index abf1f3e..9477450 100644 --- a/Tests/atomic_capture_assign_expr_eqv_x.F90 +++ b/Tests/atomic_capture_assign_expr_eqv_x.F90 @@ -1,138 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - LOGICAL, INTENT(IN) :: init - LOGICAL,DIMENSION(length), INTENT(IN) :: a - LOGICAL,DIMENSION(length), INTENT(IN) :: b - LOGICAL,DIMENSION(length - 1) :: passed_a - LOGICAL,DIMENSION(length - 1) :: passed_b - LOGICAL :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eqv. init) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = a(x) .eqv. init - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_LOGICAL +#define ATOMIC_OPTYPE EXPR_EQV_X +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT .FALSE. +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: randoms - LOGICAL,DIMENSION(LOOPCOUNT, 10):: a, b !Data - LOGICAL,DIMENSION(LOOPCOUNT):: totals, totals_comparison - LOGICAL,DIMENSION(10):: passed_a, passed_b - LOGICAL:: init - INTEGER :: errors = 0 - LOGICAL IS_POSSIBLE - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - DO x = 1, LOOPCOUNT - DO y = 1, 10 - IF (randoms(x, y) > .5) THEN - a(x, y) = .TRUE. - ELSE - a(x, y) = .FALSE. - END IF - END DO - END DO - - totals = .FALSE. - totals_comparison = .FALSE. - - !$acc data copyin(a(1:LOOPCOUNT,1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = a(x, y) .EQV. totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) .EQV. a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = .FALSE. - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .EQV. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NEQV. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_expr_minus_x.F90 b/Tests/atomic_capture_assign_expr_minus_x.F90 index 72a594f..e2575e7 100644 --- a/Tests/atomic_capture_assign_expr_minus_x.F90 +++ b/Tests/atomic_capture_assign_expr_minus_x.F90 @@ -1,157 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE_2(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - init) .GT. ((10 - length) * PRECISION)) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = a(x) - init - IF (IS_POSSIBLE_2(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE_2 - - RECURSIVE FUNCTION IS_POSSIBLE(subset, destination, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8),DIMENSION(length), INTENT(IN) :: subset - REAL(8), INTENT(IN) :: destination - REAL(8), INTENT(IN) :: init - REAL(8),ALLOCATABLE :: passed(:) - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .gt. 0) THEN - ALLOCATE(passed(length - 1)) - ELSE - IF (abs(init - destination) .gt. PRECISION) THEN - POSSIBLE = .TRUE. - ELSE - POSSIBLE = .FALSE. - END IF - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - DO y = 1, x - 1 - passed(y) = subset(y) - END DO - DO y = x + 1, length - passed(y - 1) = subset(y) - END DO - IF (IS_POSSIBLE(passed, destination, length - 1, subset(x) - init)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE EXPR_MINUS_X +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - LOGICAL IS_POSSIBLE - LOGICAL IS_POSSIBLE_2 - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = a(x, y) - totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - END DO - IF (IS_POSSIBLE(passed_a, totals(x), 10, 0) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE_2(passed_a, passed_b, 10, init) .EQV. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_expr_neqv_x.F90 b/Tests/atomic_capture_assign_expr_neqv_x.F90 index f1561cd..767741d 100644 --- a/Tests/atomic_capture_assign_expr_neqv_x.F90 +++ b/Tests/atomic_capture_assign_expr_neqv_x.F90 @@ -1,136 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - LOGICAL, INTENT(IN) :: init - LOGICAL,DIMENSION(length), INTENT(IN) :: a - LOGICAL,DIMENSION(length), INTENT(IN) :: b - LOGICAL,DIMENSION(length - 1) :: passed_a - LOGICAL,DIMENSION(length - 1) :: passed_b - LOGICAL :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eqv. init) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = a(x) .neqv. init - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_LOGICAL +#define ATOMIC_OPTYPE EXPR_NEQV_X +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT .FALSE. +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: randoms - LOGICAL,DIMENSION(LOOPCOUNT, 10):: a, b !Data - LOGICAL,DIMENSION(10):: passed_a, passed_b - LOGICAL,DIMENSION(LOOPCOUNT):: totals, totals_comparison - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - DO x = 1, LOOPCOUNT - DO y = 1, 10 - IF (randoms(x, y) > .5) THEN - a(x, y) = .TRUE. - ELSE - a(x, y) = .FALSE. - END IF - END DO - END DO - - totals = .FALSE. - totals_comparison = .FALSE. - - !$acc data copyin(a(1:LOOPCOUNT,1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = a(x, y) .NEQV. totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) .NEQV. a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NEQV. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - IF (IS_POSSIBLE(passed_a, passed_b, 10, .FALSE.) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_expr_or_x.F90 b/Tests/atomic_capture_assign_expr_or_x.F90 index d3d0370..8f621cf 100644 --- a/Tests/atomic_capture_assign_expr_or_x.F90 +++ b/Tests/atomic_capture_assign_expr_or_x.F90 @@ -1,138 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - LOGICAL, INTENT(IN) :: init - LOGICAL,DIMENSION(length), INTENT(IN) :: a - LOGICAL,DIMENSION(length), INTENT(IN) :: b - LOGICAL,DIMENSION(length - 1) :: passed_a - LOGICAL,DIMENSION(length - 1) :: passed_b - LOGICAL :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eqv. init) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = a(x) .or. init - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_LOGICAL +#define ATOMIC_OPTYPE EXPR_OR_X +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT .FALSE. +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: randoms - LOGICAL,DIMENSION(LOOPCOUNT, 10):: a, b !Data - LOGICAL,DIMENSION(LOOPCOUNT):: totals, totals_comparison - LOGICAL,DIMENSION(10):: passed_a, passed_b - LOGICAL IS_POSSIBLE - LOGICAL:: init - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - DO x = 1, LOOPCOUNT - DO y = 1, 10 - IF (randoms(x, y) > .933) THEN - a(x, y) = .TRUE. - ELSE - a(x, y) = .FALSE. - END IF - END DO - END DO - - totals = .FALSE. - totals_comparison = .FALSE. - - !$acc data copyin(a(1:LOOPCOUNT,1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = a(x, y) .OR. totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) .OR. a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NEQV. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = .FALSE. - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_expr_plus_x.F90 b/Tests/atomic_capture_assign_expr_plus_x.F90 index b4c87b3..a62a45e 100644 --- a/Tests/atomic_capture_assign_expr_plus_x.F90 +++ b/Tests/atomic_capture_assign_expr_plus_x.F90 @@ -1,127 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - init) .GT. ((10 - length) * PRECISION)) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = a(x) + init - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE EXPR_PLUS_X +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = a(x, y) + totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) + a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_expr_times_x.F90 b/Tests/atomic_capture_assign_expr_times_x.F90 index 8a9a915..4202f51 100644 --- a/Tests/atomic_capture_assign_expr_times_x.F90 +++ b/Tests/atomic_capture_assign_expr_times_x.F90 @@ -1,127 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - init) .GT. ((10 - length) * PRECISION)) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = a(x) * init - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE EXPR_TIMES_X +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 1 - totals_comparison = 1 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = a(x, y) * totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) * a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 1 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .TRUE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_iand_expr_x.F90 b/Tests/atomic_capture_assign_iand_expr_x.F90 index 8b92fba..88a1dd4 100644 --- a/Tests/atomic_capture_assign_iand_expr_x.F90 +++ b/Tests/atomic_capture_assign_iand_expr_x.F90 @@ -1,138 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - INTEGER, INTENT(IN) :: init - INTEGER,DIMENSION(length), INTENT(IN) :: a - INTEGER,DIMENSION(length), INTENT(IN) :: b - INTEGER,DIMENSION(length - 1) :: passed_a - INTEGER,DIMENSION(length - 1) :: passed_b - INTEGER :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eq. init) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = iand(a(x), init) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_INTEGER +#define ATOMIC_OPTYPE IAND_EXPR_X +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT -1 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y, z !Iterators - INTEGER,DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT, 10, 8):: randoms - INTEGER,DIMENSION(LOOPCOUNT):: totals, totals_comparison - INTEGER,DIMENSION(10):: passed_a, passed_b - INTEGER:: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - CALL RANDOM_NUMBER(randoms) - a = 0 - DO x = 1, LOOPCOUNT - DO y = 1, 10 - DO z = 1, 8 - IF (randoms(x, y, z) .lt. .933) THEN - a(x, y) = a(x, y) + ISHFT(1, z - 1) - END IF - END DO - END DO - END DO - totals = 0 - totals_comparison = 0 - DO x = 1, LOOPCOUNT - DO y = 0, 7 - totals(x) = totals(x) + ISHFT(1, y) - totals_comparison(x) = totals_comparison(x) + ISHFT(1, y) - END DO - END DO - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = iand(a(x, y), totals(x)) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = iand(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - DO y = 0, 7 - init = init + ISHFT(1, y) - END DO - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_iand_x_expr.F90 b/Tests/atomic_capture_assign_iand_x_expr.F90 index e3303b9..9737f28 100644 --- a/Tests/atomic_capture_assign_iand_x_expr.F90 +++ b/Tests/atomic_capture_assign_iand_x_expr.F90 @@ -1,145 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - INTEGER, INTENT(IN) :: init - INTEGER,DIMENSION(length), INTENT(IN) :: a - INTEGER,DIMENSION(length), INTENT(IN) :: b - INTEGER,DIMENSION(length - 1) :: passed_a - INTEGER,DIMENSION(length - 1) :: passed_b - INTEGER :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eq. init) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = iand(a(x), init) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_INTEGER +#define ATOMIC_OPTYPE IAND_X_EXPR +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT -1 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y, z !Iterators - INTEGER,DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT, 10, 8):: randoms - INTEGER,DIMENSION(LOOPCOUNT):: totals, totals_comparison - INTEGER,DIMENSION(10):: passed_a, passed_b - INTEGER:: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - a = 0 - DO x = 1, LOOPCOUNT - DO y = 1, 10 - DO z = 1, 8 - IF (randoms(x, y, z) .lt. .933) THEN - a(x, y) = a(x, y) + ISHFT(1, z - 1) - END IF - END DO - END DO - END DO - totals = 0 - totals_comparison = 0 - DO x = 1, LOOPCOUNT - DO y = 0, 7 - totals(x) = totals(x) + ISHFT(1, y) - totals_comparison(x) = totals_comparison(x) + ISHFT(1, y) - END DO - END DO - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = iand(totals(x), a(x, y)) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = iand(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - DO y = 0, 7 - init = init + ISHFT(1, y) - END DO - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_ior_expr_x.F90 b/Tests/atomic_capture_assign_ior_expr_x.F90 index 58bbfa5..a2aeb30 100644 --- a/Tests/atomic_capture_assign_ior_expr_x.F90 +++ b/Tests/atomic_capture_assign_ior_expr_x.F90 @@ -1,136 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - INTEGER, INTENT(IN) :: init - INTEGER,DIMENSION(length), INTENT(IN) :: a - INTEGER,DIMENSION(length), INTENT(IN) :: b - INTEGER,DIMENSION(length - 1) :: passed_a - INTEGER,DIMENSION(length - 1) :: passed_b - INTEGER :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eq. init) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = ior(a(x), init) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_INTEGER +#define ATOMIC_OPTYPE IOR_EXPR_X +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 0 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y, z !Iterators - INTEGER,DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT, 10, 8):: randoms - INTEGER,DIMENSION(LOOPCOUNT):: totals, totals_comparison - INTEGER,DIMENSION(10):: passed_a, passed_b - INTEGER:: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - a = 0 - DO x = 1, LOOPCOUNT - DO y = 1, 10 - DO z = 1, 8 - IF (randoms(x, y, z) .gt. .933) THEN - a(x, y) = a(x, y) + ISHFT(1, z - 1) - END IF - END DO - END DO - END DO - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = ior(a(x, y), totals(x)) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = ior(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_ior_x_expr.F90 b/Tests/atomic_capture_assign_ior_x_expr.F90 index b083abc..3e7aebc 100644 --- a/Tests/atomic_capture_assign_ior_x_expr.F90 +++ b/Tests/atomic_capture_assign_ior_x_expr.F90 @@ -1,136 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - INTEGER, INTENT(IN) :: init - INTEGER,DIMENSION(length), INTENT(IN) :: a - INTEGER,DIMENSION(length), INTENT(IN) :: b - INTEGER,DIMENSION(length - 1) :: passed_a - INTEGER,DIMENSION(length - 1) :: passed_b - INTEGER :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eq. init) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = ior(a(x), init) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_INTEGER +#define ATOMIC_OPTYPE IOR_X_EXPR +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 0 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y, z !Iterators - INTEGER,DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT, 10, 8):: randoms - INTEGER,DIMENSION(LOOPCOUNT):: totals, totals_comparison - INTEGER,DIMENSION(10):: passed_a, passed_b - INTEGER:: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - a = 0 - DO x = 1, LOOPCOUNT - DO y = 1, 10 - DO z = 1, 8 - IF (randoms(x, y, z) .gt. .933) THEN - a(x, y) = a(x, y) + ISHFT(1, z - 1) - END IF - END DO - END DO - END DO - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = ior(totals(x), a(x, y)) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = ior(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_ixor_expr_x.F90 b/Tests/atomic_capture_assign_ixor_expr_x.F90 index 58b5a3a..131fa38 100644 --- a/Tests/atomic_capture_assign_ixor_expr_x.F90 +++ b/Tests/atomic_capture_assign_ixor_expr_x.F90 @@ -1,136 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - INTEGER, INTENT(IN) :: init - INTEGER,DIMENSION(length), INTENT(IN) :: a - INTEGER,DIMENSION(length), INTENT(IN) :: b - INTEGER,DIMENSION(length - 1) :: passed_a - INTEGER,DIMENSION(length - 1) :: passed_b - INTEGER :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eq. init) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = ieor(a(x), init) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_INTEGER +#define ATOMIC_OPTYPE IXOR_EXPR_X +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 0 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y, z !Iterators - INTEGER,DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT, 10, 8):: randoms - INTEGER,DIMENSION(LOOPCOUNT):: totals, totals_comparison - INTEGER,DIMENSION(10):: passed_a, passed_b - INTEGER:: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - a = 0 - DO x = 1, LOOPCOUNT - DO y = 1, 10 - DO z = 1, 8 - IF (randoms(x, y, z) .gt. .5) THEN - a(x, y) = a(x, y) + ISHFT(1, z - 1) - END IF - END DO - END DO - END DO - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = ieor(a(x, y), totals(x)) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = ieor(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_ixor_x_expr.F90 b/Tests/atomic_capture_assign_ixor_x_expr.F90 index 01c3d29..c9e0d2b 100644 --- a/Tests/atomic_capture_assign_ixor_x_expr.F90 +++ b/Tests/atomic_capture_assign_ixor_x_expr.F90 @@ -1,136 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - INTEGER, INTENT(IN) :: init - INTEGER,DIMENSION(length), INTENT(IN) :: a - INTEGER,DIMENSION(length), INTENT(IN) :: b - INTEGER,DIMENSION(length - 1) :: passed_a - INTEGER,DIMENSION(length - 1) :: passed_b - INTEGER :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eq. init) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = ieor(a(x), init) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_INTEGER +#define ATOMIC_OPTYPE IXOR_X_EXPR +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 0 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 -LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y, z !Iterators - INTEGER,DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT, 10, 8):: randoms - INTEGER,DIMENSION(LOOPCOUNT):: totals, totals_comparison - INTEGER,DIMENSION(10):: passed_a, passed_b - INTEGER:: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - a = 0 - DO x = 1, LOOPCOUNT - DO y = 1, 10 - DO z = 1, 8 - IF (randoms(x, y, z) .gt. .5) THEN - a(x, y) = a(x, y) + ISHFT(1, z - 1) - END IF - END DO - END DO - END DO - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = ieor(totals(x), a(x, y)) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = ieor(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_max_expr_list_x.F90 b/Tests/atomic_capture_assign_max_expr_list_x.F90 index ad8bf11..0bb5e13 100644 --- a/Tests/atomic_capture_assign_max_expr_list_x.F90 +++ b/Tests/atomic_capture_assign_max_expr_list_x.F90 @@ -1,132 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, c, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length), INTENT(IN) :: c - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8),DIMENSION(length - 1) :: passed_c - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(c(x) - init) .lt. ((10 - length) * PRECISION)) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = max(a(x), b(x), init) - IF (IS_POSSIBLE(passed_a, passed_b, passed_c, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE MAX_EXPR_LIST_X +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b, c !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b, passed_c - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - CALL RANDOM_NUMBER(a) - CALL RANDOM_NUMBER(b) - - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10), b(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(c(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - c(x, y) = totals(x) - totals(x) = max(a(x, y), b(x, y), totals(x)) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = max(totals_comparison(x), a(x, y), b(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - passed_c(y) = c(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, passed_c, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" - !Conditionally define test functions -#ifndef T1 - LOGICAL :: test1 -#endif - failcode = 0 - failed = .FALSE. - -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_max_expr_x.F90 b/Tests/atomic_capture_assign_max_expr_x.F90 index dc1d2a8..8127bdb 100644 --- a/Tests/atomic_capture_assign_max_expr_x.F90 +++ b/Tests/atomic_capture_assign_max_expr_x.F90 @@ -1,126 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - init) .lt. (10 - length) * PRECISION) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = max(a(x), init) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE MAX_EXPR_X +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = max(a(x, y), totals(x)) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = max(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_max_x_expr.F90 b/Tests/atomic_capture_assign_max_x_expr.F90 index 929dbc8..e858bff 100644 --- a/Tests/atomic_capture_assign_max_x_expr.F90 +++ b/Tests/atomic_capture_assign_max_x_expr.F90 @@ -1,126 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - init) .lt. (10 - length) * PRECISION) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = max(a(x), init) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE MAX_X_EXPR +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = max(totals(x), a(x, y)) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = max(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_max_x_expr_list.F90 b/Tests/atomic_capture_assign_max_x_expr_list.F90 index 97436ea..ee71059 100644 --- a/Tests/atomic_capture_assign_max_x_expr_list.F90 +++ b/Tests/atomic_capture_assign_max_x_expr_list.F90 @@ -1,130 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, c, length, init) RESULT(POSSIBLE) -INTEGER, INTENT(IN) :: length -REAL(8), INTENT(IN) :: init -REAL(8),DIMENSION(length), INTENT(IN) :: a -REAL(8),DIMENSION(length), INTENT(IN) :: b -REAL(8),DIMENSION(length), INTENT(IN) :: c -REAL(8),DIMENSION(length - 1) :: passed_a -REAL(8),DIMENSION(length - 1) :: passed_b -REAL(8),DIMENSION(length - 1) :: passed_c -REAL(8) :: holder -LOGICAL :: POSSIBLE -INTEGER :: x, y - -IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN -END IF -POSSIBLE = .FALSE. - -DO x = 1, length - IF (abs(c(x) - init) .lt. ((10 - length) * PRECISION)) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = max(a(x), b(x), init) - IF (IS_POSSIBLE(passed_a, passed_b, passed_c, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF -END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE MAX_X_EXPR_LIST +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() -IMPLICIT NONE -INCLUDE "acc_testsuite.Fh" -INTEGER :: x, y !Iterators -REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b, c !Data -REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison -REAL(8),DIMENSION(10):: passed_a, passed_b, passed_c -REAL(8):: init -LOGICAL IS_POSSIBLE -INTEGER :: errors = 0 - -!Initilization -SEEDDIM(1) = 1 -#ifdef SEED -SEEDDIM(1) = SEED +#include "atomic_template.Fh" #endif -CALL RANDOM_SEED(PUT=SEEDDIM) - -CALL RANDOM_NUMBER(a) -CALL RANDOM_NUMBER(b) - -totals = 0 -totals_comparison = 0 - -!$acc data copyin(a(1:LOOPCOUNT, 1:10), b(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(c(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - c(x, y) = totals(x) - totals(x) = max(totals(x), a(x, y), b(x, y)) - !$acc end atomic - END DO - END DO - !$acc end parallel -!$acc end data -DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = max(totals_comparison(x), a(x, y), b(x, y)) - END DO -END DO -DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF -END DO - -DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - passed_c(y) = c(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, passed_c, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF -END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END -#endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_min_expr_list_x.F90 b/Tests/atomic_capture_assign_min_expr_list_x.F90 index f31a148..1be2510 100644 --- a/Tests/atomic_capture_assign_min_expr_list_x.F90 +++ b/Tests/atomic_capture_assign_min_expr_list_x.F90 @@ -1,130 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, c, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length), INTENT(IN) :: c - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8),DIMENSION(length - 1) :: passed_c - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(c(x) - init) .gt. (10 - length) * PRECISION) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = min(a(x), b(x), init) - IF (IS_POSSIBLE(passed_a, passed_b, passed_c, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE MIN_EXPR_LIST_X +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b, c !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b, passed_c - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - CALL RANDOM_NUMBER(b) - - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10), b(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(c(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - c(x, y) = totals(x) - totals(x) = min(a(x, y), b(x, y), totals(x)) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = min(totals_comparison(x), a(x, y), b(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - passed_c(y) = c(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, passed_c, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_min_expr_x.F90 b/Tests/atomic_capture_assign_min_expr_x.F90 index a892a69..4b6abd6 100644 --- a/Tests/atomic_capture_assign_min_expr_x.F90 +++ b/Tests/atomic_capture_assign_min_expr_x.F90 @@ -1,126 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - init) .gt. (10 - length) * PRECISION) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = min(a(x), init) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE MIN_EXPR_X +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = min(a(x, y), totals(x)) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = min(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_min_x_expr.F90 b/Tests/atomic_capture_assign_min_x_expr.F90 index 327f173..6fb5a95 100644 --- a/Tests/atomic_capture_assign_min_x_expr.F90 +++ b/Tests/atomic_capture_assign_min_x_expr.F90 @@ -1,126 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - init) .gt. (10 - length) * PRECISION) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = min(a(x), init) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_MIN +#define ATOMIC_OPTYPE MIN_X_EXPR +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = min(totals(x), a(x, y)) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = min(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_min_x_expr_list.F90 b/Tests/atomic_capture_assign_min_x_expr_list.F90 index a48695e..b6312e2 100644 --- a/Tests/atomic_capture_assign_min_x_expr_list.F90 +++ b/Tests/atomic_capture_assign_min_x_expr_list.F90 @@ -1,130 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, c, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length), INTENT(IN) :: c - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8),DIMENSION(length - 1) :: passed_c - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(c(x) - init) .lt. (10 - length) * PRECISION) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = min(a(x), b(x), init) - IF (IS_POSSIBLE(passed_a, passed_b, passed_c, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE MIN_X_EXPR_LIST +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b, c !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b, passed_c - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - CALL RANDOM_NUMBER(b) - - totals = 1 - totals_comparison = 1 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10), b(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(c(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - c(x, y) = totals(x) - totals(x) = min(totals(x), a(x, y), b(x, y)) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = min(totals_comparison(x), a(x, y), b(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - passed_c(y) = c(x, y) - END DO - init = 1 - IF (IS_POSSIBLE(passed_a, passed_b, passed_c, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_x_and_expr.F90 b/Tests/atomic_capture_assign_x_and_expr.F90 index f5909a6..81b9688 100644 --- a/Tests/atomic_capture_assign_x_and_expr.F90 +++ b/Tests/atomic_capture_assign_x_and_expr.F90 @@ -1,135 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - LOGICAL,DIMENSION(length), INTENT(IN) :: a - LOGICAL,DIMENSION(length), INTENT(IN) :: b - LOGICAL, INTENT(IN) :: init - LOGICAL,DIMENSION(length - 1) :: passed_a - LOGICAL,DIMENSION(length - 1) :: passed_b - LOGICAL :: POSSIBLE, holder - INTEGER :: x, y - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - IF (b(x) .eqv. init) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = a(x) .AND. init - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, a(x) .AND. init)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_LOGICAL +#define ATOMIC_OPTYPE X_AND_EXPR +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT .TRUE. +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 -LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: randoms - LOGICAL,DIMENSION(LOOPCOUNT, 10):: a, b !Data - LOGICAL,DIMENSION(10):: passed_a, passed_b - LOGICAL IS_POSSIBLE - LOGICAL,DIMENSION(LOOPCOUNT):: totals, totals_comparison - INTEGER :: errors = 0 - LOGICAL :: init - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - DO x = 1, LOOPCOUNT - DO y = 1, 10 - IF (randoms(x, y) < .933) THEN - a(x, y) = .TRUE. - ELSE - a(x, y) = .FALSE. - END IF - END DO - END DO - - totals = .FALSE. - totals_comparison = .FALSE. - - !$acc data copyin(a(1:LOOPCOUNT,1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = totals(x) .AND. a(x, y) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) .AND. a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NEQV. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = .FALSE. - IF (.FALSE. .eqv. IS_POSSIBLE(a(x, 1:10), b(x, 1:10), 10, .FALSE.)) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_x_divided_expr.F90 b/Tests/atomic_capture_assign_x_divided_expr.F90 index 71e5f5e..1cda43a 100644 --- a/Tests/atomic_capture_assign_x_divided_expr.F90 +++ b/Tests/atomic_capture_assign_x_divided_expr.F90 @@ -1,165 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE_2(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - real(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - REAL(8):: mindif - IF (length .lt. 10) THEN - WRITE(*, *) length - END IF - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - init) .lt. (100 - length) * PRECISION) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = init / a(x) - IF (IS_POSSIBLE_2(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE_2 - -RECURSIVE FUNCTION IS_POSSIBLE(subset, destination, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8),DIMENSION(length), INTENT(IN) :: subset - REAL(8), INTENT(IN) :: destination - REAL(8), INTENT(IN) :: init - REAL(8),ALLOCATABLE :: passed(:) - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .gt. 0) THEN - ALLOCATE(passed(length - 1)) - ELSE - IF (abs(init - destination) .lt. (10 - length) * PRECISION) THEN - POSSIBLE = .TRUE. - ELSE - POSSIBLE = .FALSE. - END IF - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - DO y = 1, x - 1 - passed(y) = subset(y) - END DO - DO y = x + 1, length - passed(y - 1) = subset(y) - END DO - holder = init / subset(x) - IF (IS_POSSIBLE(passed, destination, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE X_DIVIDED_EXPR +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a !Data - REAL(8),DIMENSION(LOOPCOUNT, 10):: b - REAL(8),DIMENSION(LOOPCOUNT):: totals - REAL(8),DIMENSION(10):: passed - REAL(8),DIMENSION(10):: passed_b - REAL(8) :: holder - INTEGER :: errors = 0 - LOGICAL IS_POSSIBLE - LOGICAL IS_POSSIBLE_2 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 1 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = totals(x) / a(x, y) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed(y) = a(x, y) - END DO - holder = 1 - IF (IS_POSSIBLE(passed, totals(x), 10, holder) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - holder = 1 - IF (IS_POSSIBLE_2(passed, passed_b, 10, holder) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_x_eqv_expr.F90 b/Tests/atomic_capture_assign_x_eqv_expr.F90 index 3e65b96..be0ac30 100644 --- a/Tests/atomic_capture_assign_x_eqv_expr.F90 +++ b/Tests/atomic_capture_assign_x_eqv_expr.F90 @@ -1,138 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - LOGICAL, INTENT(IN) :: init - LOGICAL,DIMENSION(length), INTENT(IN) :: a - LOGICAL,DIMENSION(length), INTENT(IN) :: b - LOGICAL,DIMENSION(length - 1) :: passed_a - LOGICAL,DIMENSION(length - 1) :: passed_b - LOGICAL :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eqv. init) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = a(x) .eqv. init - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_LOGICAL +#define ATOMIC_OPTYPE X_EQV_EXPR +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT .FALSE. +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: randoms - LOGICAL,DIMENSION(LOOPCOUNT, 10):: a, b !Data - LOGICAL,DIMENSION(LOOPCOUNT):: totals, totals_comparison - LOGICAL,DIMENSION(10):: passed_a, passed_b - LOGICAL:: init - INTEGER :: errors = 0 - LOGICAL IS_POSSIBLE - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - DO x = 1, LOOPCOUNT - DO y = 1, 10 - IF (randoms(x, y) > .5) THEN - a(x, y) = .TRUE. - ELSE - a(x, y) = .FALSE. - END IF - END DO - END DO - - totals = .FALSE. - totals_comparison = .FALSE. - - !$acc data copyin(a(1:LOOPCOUNT,1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = totals(x) .EQV. a(x, y) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) .EQV. a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = .FALSE. - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .EQV. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NEQV. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_x_minus_expr.F90 b/Tests/atomic_capture_assign_x_minus_expr.F90 index 629dd6f..dac4f36 100644 --- a/Tests/atomic_capture_assign_x_minus_expr.F90 +++ b/Tests/atomic_capture_assign_x_minus_expr.F90 @@ -1,157 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE_2(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - init) .GT. ((10 - length) * PRECISION)) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = init - a(x) - IF (IS_POSSIBLE_2(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE_2 - -RECURSIVE FUNCTION IS_POSSIBLE(subset, destination, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8),DIMENSION(length), INTENT(IN) :: subset - REAL(8), INTENT(IN) :: destination - REAL(8), INTENT(IN) :: init - REAL(8),ALLOCATABLE :: passed(:) - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .gt. 0) THEN - ALLOCATE(passed(length - 1)) - ELSE - IF (abs(init - destination) .gt. PRECISION) THEN - POSSIBLE = .TRUE. - ELSE - POSSIBLE = .FALSE. - END IF - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - DO y = 1, x - 1 - passed(y) = subset(y) - END DO - DO y = x + 1, length - passed(y - 1) = subset(y) - END DO - IF (IS_POSSIBLE(passed, destination, length - 1, init - subset(x))) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE X_MINUS_EXPR +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - LOGICAL IS_POSSIBLE - LOGICAL IS_POSSIBLE_2 - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = totals(x) - a(x, y) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - END DO - IF (IS_POSSIBLE(passed_a, totals(x), 10, 0) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE_2(passed_a, passed_b, 10, init) .EQV. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_x_neqv_expr.F90 b/Tests/atomic_capture_assign_x_neqv_expr.F90 index 21a4e20..15f35de 100644 --- a/Tests/atomic_capture_assign_x_neqv_expr.F90 +++ b/Tests/atomic_capture_assign_x_neqv_expr.F90 @@ -1,136 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - LOGICAL, INTENT(IN) :: init - LOGICAL,DIMENSION(length), INTENT(IN) :: a - LOGICAL,DIMENSION(length), INTENT(IN) :: b - LOGICAL,DIMENSION(length - 1) :: passed_a - LOGICAL,DIMENSION(length - 1) :: passed_b - LOGICAL :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eqv. init) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = a(x) .neqv. init - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_LOGICAL +#define ATOMIC_OPTYPE X_NEQV_EXPR +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT .FALSE. +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: randoms - LOGICAL,DIMENSION(LOOPCOUNT, 10):: a, b !Data - LOGICAL,DIMENSION(10):: passed_a, passed_b - LOGICAL,DIMENSION(LOOPCOUNT):: totals, totals_comparison - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - DO x = 1, LOOPCOUNT - DO y = 1, 10 - IF (randoms(x, y) > .5) THEN - a(x, y) = .TRUE. - ELSE - a(x, y) = .FALSE. - END IF - END DO - END DO - - totals = .FALSE. - totals_comparison = .FALSE. - - !$acc data copyin(a(1:LOOPCOUNT,1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = totals(x) .NEQV. a(x, y) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) .NEQV. a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NEQV. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - IF (IS_POSSIBLE(passed_a, passed_b, 10, .FALSE.) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_x_or_expr.F90 b/Tests/atomic_capture_assign_x_or_expr.F90 index 23e8bc4..4c6635f 100644 --- a/Tests/atomic_capture_assign_x_or_expr.F90 +++ b/Tests/atomic_capture_assign_x_or_expr.F90 @@ -1,138 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - LOGICAL, INTENT(IN) :: init - LOGICAL,DIMENSION(length), INTENT(IN) :: a - LOGICAL,DIMENSION(length), INTENT(IN) :: b - LOGICAL,DIMENSION(length - 1) :: passed_a - LOGICAL,DIMENSION(length - 1) :: passed_b - LOGICAL :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eqv. init) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = a(x) .or. init - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_LOGICAL +#define ATOMIC_OPTYPE X_OR_EXPR +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT .FALSE. +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: randoms - LOGICAL,DIMENSION(LOOPCOUNT, 10):: a, b !Data - LOGICAL,DIMENSION(LOOPCOUNT):: totals, totals_comparison - LOGICAL,DIMENSION(10):: passed_a, passed_b - LOGICAL IS_POSSIBLE - LOGICAL:: init - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - DO x = 1, LOOPCOUNT - DO y = 1, 10 - IF (randoms(x, y) > .933) THEN - a(x, y) = .TRUE. - ELSE - a(x, y) = .FALSE. - END IF - END DO - END DO - - totals = .FALSE. - totals_comparison = .FALSE. - - !$acc data copyin(a(1:LOOPCOUNT,1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = totals(x) .OR. a(x, y) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) .OR. a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NEQV. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = .FALSE. - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_x_plus_expr.F90 b/Tests/atomic_capture_assign_x_plus_expr.F90 index b540248..38944d1 100644 --- a/Tests/atomic_capture_assign_x_plus_expr.F90 +++ b/Tests/atomic_capture_assign_x_plus_expr.F90 @@ -1,127 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - init) .GT. ((10 - length) * PRECISION)) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = a(x) + init - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE X_PLUS_EXPR +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = totals(x) + a(x, y) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) + a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_assign_x_times_expr.F90 b/Tests/atomic_capture_assign_x_times_expr.F90 index 13a7bef..c07c0d3 100644 --- a/Tests/atomic_capture_assign_x_times_expr.F90 +++ b/Tests/atomic_capture_assign_x_times_expr.F90 @@ -1,127 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - init) .GT. ((10 - length) * PRECISION)) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = a(x) * init - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE X_TIMES_EXPR +#define ATOMIC_ASSIGN_FIRST +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 1 - totals_comparison = 1 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - b(x, y) = totals(x) - totals(x) = totals(x) * a(x, y) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) * a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 1 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .TRUE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_expr_and_x_assign.F90 b/Tests/atomic_capture_expr_and_x_assign.F90 index 8eb9d7a..7cb6de6 100644 --- a/Tests/atomic_capture_expr_and_x_assign.F90 +++ b/Tests/atomic_capture_expr_and_x_assign.F90 @@ -1,128 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - LOGICAL,DIMENSION(length), INTENT(IN) :: a - LOGICAL,DIMENSION(length), INTENT(IN) :: b - LOGICAL, INTENT(IN) :: init - LOGICAL,DIMENSION(length - 1) :: passed_a - LOGICAL,DIMENSION(length - 1) :: passed_b - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - IF (b(x) .eqv. (init .AND. a(x))) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, b(x))) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_LOGICAL +#define ATOMIC_OPTYPE EXPR_AND_X +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT .FALSE. +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: randoms - LOGICAL,DIMENSION(LOOPCOUNT, 10):: a !Data - LOGICAL,DIMENSION(LOOPCOUNT, 10):: b - LOGICAL IS_POSSIBLE - LOGICAL,DIMENSION(LOOPCOUNT):: totals, totals_comparison - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - DO x = 1, LOOPCOUNT - DO y = 1, 10 - IF (randoms(x, y) < .933) THEN - a(x, y) = .TRUE. - ELSE - a(x, y) = .FALSE. - END IF - END DO - END DO - - totals = .FALSE. - totals_comparison = .FALSE. - - !$acc data copyin(a(1:LOOPCOUNT,1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = a(x, y) .AND. totals(x) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) .AND. a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NEQV. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - IF (.FALSE. .eqv. IS_POSSIBLE(a(x, 1:10), b(x, 1:10), 10, .FALSE.)) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_expr_divided_x_assign.F90 b/Tests/atomic_capture_expr_divided_x_assign.F90 index d1d5166..91977ec 100644 --- a/Tests/atomic_capture_expr_divided_x_assign.F90 +++ b/Tests/atomic_capture_expr_divided_x_assign.F90 @@ -1,165 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE_2(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - real(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - REAL(8):: mindif - IF (length .lt. 10) THEN - WRITE(*, *) length - END IF - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - (a(x) / init)) .lt. (100 - length) * PRECISION) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE_2(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE_2 - - RECURSIVE FUNCTION IS_POSSIBLE(subset, destination, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8),DIMENSION(length), INTENT(IN) :: subset - REAL(8), INTENT(IN) :: destination - REAL(8), INTENT(IN) :: init - REAL(8),ALLOCATABLE :: passed(:) - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .gt. 0) THEN - ALLOCATE(passed(length - 1)) - ELSE - IF (abs(init - destination) .lt. (10 - length) * PRECISION) THEN - POSSIBLE = .TRUE. - ELSE - POSSIBLE = .FALSE. - END IF - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - DO y = 1, x - 1 - passed(y) = subset(y) - END DO - DO y = x + 1, length - passed(y - 1) = subset(y) - END DO - holder = subset(x) / init - IF (IS_POSSIBLE(passed, destination, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE EXPR_DIVIDED_X +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a !Data - REAL(8),DIMENSION(LOOPCOUNT, 10):: b - REAL(8),DIMENSION(LOOPCOUNT):: totals - REAL(8),DIMENSION(10):: passed - REAL(8),DIMENSION(10):: passed_b - REAL(8) :: holder - INTEGER :: errors = 0 - LOGICAL IS_POSSIBLE - LOGICAL IS_POSSIBLE_2 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 1 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = a(x, y) / totals(x) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed(y) = a(x, y) - END DO - holder = 1 - IF (IS_POSSIBLE(passed, totals(x), 10, holder) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - holder = 1 - IF (IS_POSSIBLE_2(passed, passed_b, 10, holder) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_expr_eqv_x_assign.F90 b/Tests/atomic_capture_expr_eqv_x_assign.F90 index a547899..d5cf393 100644 --- a/Tests/atomic_capture_expr_eqv_x_assign.F90 +++ b/Tests/atomic_capture_expr_eqv_x_assign.F90 @@ -1,138 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - LOGICAL, INTENT(IN) :: init - LOGICAL,DIMENSION(length), INTENT(IN) :: a - LOGICAL,DIMENSION(length), INTENT(IN) :: b - LOGICAL,DIMENSION(length - 1) :: passed_a - LOGICAL,DIMENSION(length - 1) :: passed_b - LOGICAL :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eqv. (init .eqv. a(x))) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_LOGICAL +#define ATOMIC_OPTYPE EXPR_EQV_X +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT .FALSE. +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: randoms - LOGICAL,DIMENSION(LOOPCOUNT, 10):: a, b !Data - LOGICAL,DIMENSION(LOOPCOUNT):: totals, totals_comparison - LOGICAL,DIMENSION(10):: passed_a, passed_b - LOGICAL:: init - INTEGER :: errors = 0 - LOGICAL IS_POSSIBLE - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - DO x = 1, LOOPCOUNT - DO y = 1, 10 - IF (randoms(x, y) > .5) THEN - a(x, y) = .TRUE. - ELSE - a(x, y) = .FALSE. - END IF - END DO - END DO - - totals = .FALSE. - totals_comparison = .FALSE. - - !$acc data copyin(a(1:LOOPCOUNT,1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = a(x, y) .EQV. totals(x) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) .EQV. a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = .FALSE. - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .EQV. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NEQV. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_expr_minus_x_assign.F90 b/Tests/atomic_capture_expr_minus_x_assign.F90 index 088f19d..a35a87d 100644 --- a/Tests/atomic_capture_expr_minus_x_assign.F90 +++ b/Tests/atomic_capture_expr_minus_x_assign.F90 @@ -1,157 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE_2(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - (a(x) - init)) .GT. ((10 - length) * PRECISION)) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE_2(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE_2 - - RECURSIVE FUNCTION IS_POSSIBLE(subset, destination, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8),DIMENSION(length), INTENT(IN) :: subset - REAL(8), INTENT(IN) :: destination - REAL(8), INTENT(IN) :: init - REAL(8),ALLOCATABLE :: passed(:) - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .gt. 0) THEN - ALLOCATE(passed(length - 1)) - ELSE - IF (abs(init - destination) .gt. PRECISION) THEN - POSSIBLE = .TRUE. - ELSE - POSSIBLE = .FALSE. - END IF - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - DO y = 1, x - 1 - passed(y) = subset(y) - END DO - DO y = x + 1, length - passed(y - 1) = subset(y) - END DO - IF (IS_POSSIBLE(passed, destination, length - 1, subset(x) - init)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE EXPR_MINUS_X +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - LOGICAL IS_POSSIBLE - LOGICAL IS_POSSIBLE_2 - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = a(x, y) - totals(x) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - END DO - IF (IS_POSSIBLE(passed_a, totals(x), 10, 0) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE_2(passed_a, passed_b, 10, init) .EQV. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_expr_neqv_x_assign.F90 b/Tests/atomic_capture_expr_neqv_x_assign.F90 index 612f1e2..6598a65 100644 --- a/Tests/atomic_capture_expr_neqv_x_assign.F90 +++ b/Tests/atomic_capture_expr_neqv_x_assign.F90 @@ -1,136 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - LOGICAL, INTENT(IN) :: init - LOGICAL,DIMENSION(length), INTENT(IN) :: a - LOGICAL,DIMENSION(length), INTENT(IN) :: b - LOGICAL,DIMENSION(length - 1) :: passed_a - LOGICAL,DIMENSION(length - 1) :: passed_b - LOGICAL :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eqv. (init .neqv. a(x))) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_LOGICAL +#define ATOMIC_OPTYPE EXPR_NEQV_X +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT .FALSE. +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: randoms - LOGICAL,DIMENSION(LOOPCOUNT, 10):: a, b !Data - LOGICAL,DIMENSION(10):: passed_a, passed_b - LOGICAL,DIMENSION(LOOPCOUNT):: totals, totals_comparison - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - DO x = 1, LOOPCOUNT - DO y = 1, 10 - IF (randoms(x, y) > .5) THEN - a(x, y) = .TRUE. - ELSE - a(x, y) = .FALSE. - END IF - END DO - END DO - - totals = .FALSE. - totals_comparison = .FALSE. - - !$acc data copyin(a(1:LOOPCOUNT,1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = a(x, y) .NEQV. totals(x) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) .NEQV. a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NEQV. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - IF (IS_POSSIBLE(passed_a, passed_b, 10, .FALSE.) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_expr_or_x_assign.F90 b/Tests/atomic_capture_expr_or_x_assign.F90 index a1a3038..c7e1cf5 100644 --- a/Tests/atomic_capture_expr_or_x_assign.F90 +++ b/Tests/atomic_capture_expr_or_x_assign.F90 @@ -1,138 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - LOGICAL, INTENT(IN) :: init - LOGICAL,DIMENSION(length), INTENT(IN) :: a - LOGICAL,DIMENSION(length), INTENT(IN) :: b - LOGICAL,DIMENSION(length - 1) :: passed_a - LOGICAL,DIMENSION(length - 1) :: passed_b - LOGICAL :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eqv. (init .or. a(x))) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_LOGICAL +#define ATOMIC_OPTYPE EXPR_OR_X +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT .FALSE. +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: randoms - LOGICAL,DIMENSION(LOOPCOUNT, 10):: a, b !Data - LOGICAL,DIMENSION(LOOPCOUNT):: totals, totals_comparison - LOGICAL,DIMENSION(10):: passed_a, passed_b - LOGICAL IS_POSSIBLE - LOGICAL:: init - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - DO x = 1, LOOPCOUNT - DO y = 1, 10 - IF (randoms(x, y) > .933) THEN - a(x, y) = .TRUE. - ELSE - a(x, y) = .FALSE. - END IF - END DO - END DO - - totals = .FALSE. - totals_comparison = .FALSE. - - !$acc data copyin(a(1:LOOPCOUNT,1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = a(x, y) .OR. totals(x) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) .OR. a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NEQV. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = .FALSE. - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_expr_plus_x_assign.F90 b/Tests/atomic_capture_expr_plus_x_assign.F90 index d3377c2..e85a990 100644 --- a/Tests/atomic_capture_expr_plus_x_assign.F90 +++ b/Tests/atomic_capture_expr_plus_x_assign.F90 @@ -1,127 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - (init + a(x))) .GT. ((10 - length) * PRECISION)) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE EXPR_PLUS_X +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = a(x, y) + totals(x) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) + a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_expr_times_x_assign.F90 b/Tests/atomic_capture_expr_times_x_assign.F90 index 9d220e6..53afed3 100644 --- a/Tests/atomic_capture_expr_times_x_assign.F90 +++ b/Tests/atomic_capture_expr_times_x_assign.F90 @@ -1,127 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - (init * a(x))) .GT. ((10 - length) * PRECISION)) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE EXPR_TIMES_X +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 1 - totals_comparison = 1 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = a(x, y) * totals(x) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) * a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 1 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .TRUE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_iand_expr_x_assign.F90 b/Tests/atomic_capture_iand_expr_x_assign.F90 index e75076a..56ac3d2 100644 --- a/Tests/atomic_capture_iand_expr_x_assign.F90 +++ b/Tests/atomic_capture_iand_expr_x_assign.F90 @@ -1,145 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - INTEGER, INTENT(IN) :: init - INTEGER,DIMENSION(length), INTENT(IN) :: a - INTEGER,DIMENSION(length), INTENT(IN) :: b - INTEGER,DIMENSION(length - 1) :: passed_a - INTEGER,DIMENSION(length - 1) :: passed_b - INTEGER :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eq. iand(init, a(x))) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_INTEGER +#define ATOMIC_OPTYPE IAND_EXPR_X +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT -1 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y, z !Iterators - INTEGER,DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT, 10, 8):: randoms - INTEGER,DIMENSION(LOOPCOUNT):: totals, totals_comparison - INTEGER,DIMENSION(10):: passed_a, passed_b - INTEGER:: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - a = 0 - DO x = 1, LOOPCOUNT - DO y = 1, 10 - DO z = 1, 8 - IF (randoms(x, y, z) .lt. .933) THEN - a(x, y) = a(x, y) + ISHFT(1, z - 1) - END IF - END DO - END DO - END DO - totals = 0 - totals_comparison = 0 - DO x = 1, LOOPCOUNT - DO y = 0, 7 - totals(x) = totals(x) + ISHFT(1, y) - totals_comparison(x) = totals_comparison(x) + ISHFT(1, y) - END DO - END DO - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = iand(a(x, y), totals(x)) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = iand(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - DO y = 0, 7 - init = init + ISHFT(1, y) - END DO - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_iand_x_expr_assign.F90 b/Tests/atomic_capture_iand_x_expr_assign.F90 index 4bce4c8..94e03a8 100644 --- a/Tests/atomic_capture_iand_x_expr_assign.F90 +++ b/Tests/atomic_capture_iand_x_expr_assign.F90 @@ -1,145 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - INTEGER, INTENT(IN) :: init - INTEGER,DIMENSION(length), INTENT(IN) :: a - INTEGER,DIMENSION(length), INTENT(IN) :: b - INTEGER,DIMENSION(length - 1) :: passed_a - INTEGER,DIMENSION(length - 1) :: passed_b - INTEGER :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eq. iand(init, a(x))) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_INTEGER +#define ATOMIC_OPTYPE IAND_X_EXPR +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT -1 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y, z !Iterators - INTEGER,DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT, 10, 8):: randoms - INTEGER,DIMENSION(LOOPCOUNT):: totals, totals_comparison - INTEGER,DIMENSION(10):: passed_a, passed_b - INTEGER:: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - a = 0 - DO x = 1, LOOPCOUNT - DO y = 1, 10 - DO z = 1, 8 - IF (randoms(x, y, z) .lt. .933) THEN - a(x, y) = a(x, y) + ISHFT(1, z - 1) - END IF - END DO - END DO - END DO - totals = 0 - totals_comparison = 0 - DO x = 1, LOOPCOUNT - DO y = 0, 7 - totals(x) = totals(x) + ISHFT(1, y) - totals_comparison(x) = totals_comparison(x) + ISHFT(1, y) - END DO - END DO - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = iand(totals(x), a(x, y)) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = iand(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - DO y = 0, 7 - init = init + ISHFT(1, y) - END DO - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_ior_expr_x_assign.F90 b/Tests/atomic_capture_ior_expr_x_assign.F90 index 378f5b8..b75b136 100644 --- a/Tests/atomic_capture_ior_expr_x_assign.F90 +++ b/Tests/atomic_capture_ior_expr_x_assign.F90 @@ -1,136 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - INTEGER, INTENT(IN) :: init - INTEGER,DIMENSION(length), INTENT(IN) :: a - INTEGER,DIMENSION(length), INTENT(IN) :: b - INTEGER,DIMENSION(length - 1) :: passed_a - INTEGER,DIMENSION(length - 1) :: passed_b - INTEGER :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eq. ior(init, a(x))) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_INTEGER +#define ATOMIC_OPTYPE IOR_EXPR_X +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 0 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y, z !Iterators - INTEGER,DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT, 10, 8):: randoms - INTEGER,DIMENSION(LOOPCOUNT):: totals, totals_comparison - INTEGER,DIMENSION(10):: passed_a, passed_b - INTEGER:: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - a = 0 - DO x = 1, LOOPCOUNT - DO y = 1, 10 - DO z = 1, 8 - IF (randoms(x, y, z) .gt. .933) THEN - a(x, y) = a(x, y) + ISHFT(1, z - 1) - END IF - END DO - END DO - END DO - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = ior(a(x, y), totals(x)) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = ior(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_ior_x_expr_assign.F90 b/Tests/atomic_capture_ior_x_expr_assign.F90 index 74a137b..11238a5 100644 --- a/Tests/atomic_capture_ior_x_expr_assign.F90 +++ b/Tests/atomic_capture_ior_x_expr_assign.F90 @@ -1,136 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - INTEGER, INTENT(IN) :: init - INTEGER,DIMENSION(length), INTENT(IN) :: a - INTEGER,DIMENSION(length), INTENT(IN) :: b - INTEGER,DIMENSION(length - 1) :: passed_a - INTEGER,DIMENSION(length - 1) :: passed_b - INTEGER :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eq. ior(init, a(x))) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_INTEGER +#define ATOMIC_OPTYPE IOR_X_EXPR +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 0 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y, z !Iterators - INTEGER,DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT, 10, 8):: randoms - INTEGER,DIMENSION(LOOPCOUNT):: totals, totals_comparison - INTEGER,DIMENSION(10):: passed_a, passed_b - INTEGER:: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - a = 0 - DO x = 1, LOOPCOUNT - DO y = 1, 10 - DO z = 1, 8 - IF (randoms(x, y, z) .gt. .933) THEN - a(x, y) = a(x, y) + ISHFT(1, z - 1) - END IF - END DO - END DO - END DO - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = ior(totals(x), a(x, y)) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = ior(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_ixor_expr_x_assign.F90 b/Tests/atomic_capture_ixor_expr_x_assign.F90 index a004152..bf2b91f 100644 --- a/Tests/atomic_capture_ixor_expr_x_assign.F90 +++ b/Tests/atomic_capture_ixor_expr_x_assign.F90 @@ -1,136 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - INTEGER, INTENT(IN) :: init - INTEGER,DIMENSION(length), INTENT(IN) :: a - INTEGER,DIMENSION(length), INTENT(IN) :: b - INTEGER,DIMENSION(length - 1) :: passed_a - INTEGER,DIMENSION(length - 1) :: passed_b - INTEGER :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eq. ieor(init, a(x))) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_INTEGER +#define ATOMIC_OPTYPE IXOR_EXPR_X +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 0 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y, z !Iterators - INTEGER,DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT, 10, 8):: randoms - INTEGER,DIMENSION(LOOPCOUNT):: totals, totals_comparison - INTEGER,DIMENSION(10):: passed_a, passed_b - INTEGER:: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - a = 0 - DO x = 1, LOOPCOUNT - DO y = 1, 10 - DO z = 1, 8 - IF (randoms(x, y, z) .gt. .5) THEN - a(x, y) = a(x, y) + ISHFT(1, z - 1) - END IF - END DO - END DO - END DO - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = ieor(a(x, y), totals(x)) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = ieor(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_ixor_x_expr_assign.F90 b/Tests/atomic_capture_ixor_x_expr_assign.F90 index 4499776..fa1433a 100644 --- a/Tests/atomic_capture_ixor_x_expr_assign.F90 +++ b/Tests/atomic_capture_ixor_x_expr_assign.F90 @@ -1,136 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - INTEGER, INTENT(IN) :: init - INTEGER,DIMENSION(length), INTENT(IN) :: a - INTEGER,DIMENSION(length), INTENT(IN) :: b - INTEGER,DIMENSION(length - 1) :: passed_a - INTEGER,DIMENSION(length - 1) :: passed_b - INTEGER :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eq. ieor(init, a(x))) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_INTEGER +#define ATOMIC_OPTYPE IXOR_X_EXPR +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 0 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y, z !Iterators - INTEGER,DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT, 10, 8):: randoms - INTEGER,DIMENSION(LOOPCOUNT):: totals, totals_comparison - INTEGER,DIMENSION(10):: passed_a, passed_b - INTEGER:: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - a = 0 - DO x = 1, LOOPCOUNT - DO y = 1, 10 - DO z = 1, 8 - IF (randoms(x, y, z) .gt. .5) THEN - a(x, y) = a(x, y) + ISHFT(1, z - 1) - END IF - END DO - END DO - END DO - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = ieor(totals(x), a(x, y)) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = ieor(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_max_expr_list_x_assign.F90 b/Tests/atomic_capture_max_expr_list_x_assign.F90 index 5d1167c..5eb0ce9 100644 --- a/Tests/atomic_capture_max_expr_list_x_assign.F90 +++ b/Tests/atomic_capture_max_expr_list_x_assign.F90 @@ -1,130 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, c, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length), INTENT(IN) :: c - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8),DIMENSION(length - 1) :: passed_c - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(c(x) - max(init, a(x), b(x))) .lt. ((10 - length) * PRECISION)) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = c(x) - IF (IS_POSSIBLE(passed_a, passed_b, passed_c, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE MAX_EXPR_LIST_X +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b, c !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b, passed_c - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - CALL RANDOM_NUMBER(b) - - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10), b(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(c(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = max(a(x, y), b(x, y), totals(x)) - c(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = max(totals_comparison(x), a(x, y), b(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - passed_c(y) = c(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, passed_c, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_max_expr_x_assign.F90 b/Tests/atomic_capture_max_expr_x_assign.F90 index 697c6dd..53ceddc 100644 --- a/Tests/atomic_capture_max_expr_x_assign.F90 +++ b/Tests/atomic_capture_max_expr_x_assign.F90 @@ -1,126 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - max(init, a(x))) .lt. (10 - length) * PRECISION) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE MAX_EXPR_X +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = max(a(x, y), totals(x)) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = max(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_max_x_expr_assign.F90 b/Tests/atomic_capture_max_x_expr_assign.F90 index 97b5c47..bd0c3b0 100644 --- a/Tests/atomic_capture_max_x_expr_assign.F90 +++ b/Tests/atomic_capture_max_x_expr_assign.F90 @@ -1,126 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - max(init, a(x))) .lt. (10 - length) * PRECISION) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE MAX_X_EXPR +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = max(totals(x), a(x, y)) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = max(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_max_x_expr_list_assign.F90 b/Tests/atomic_capture_max_x_expr_list_assign.F90 index d9627bf..db94e24 100644 --- a/Tests/atomic_capture_max_x_expr_list_assign.F90 +++ b/Tests/atomic_capture_max_x_expr_list_assign.F90 @@ -1,130 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, c, length, init) RESULT(POSSIBLE) -INTEGER, INTENT(IN) :: length -REAL(8), INTENT(IN) :: init -REAL(8),DIMENSION(length), INTENT(IN) :: a -REAL(8),DIMENSION(length), INTENT(IN) :: b -REAL(8),DIMENSION(length), INTENT(IN) :: c -REAL(8),DIMENSION(length - 1) :: passed_a -REAL(8),DIMENSION(length - 1) :: passed_b -REAL(8),DIMENSION(length - 1) :: passed_c -REAL(8) :: holder -LOGICAL :: POSSIBLE -INTEGER :: x, y - -IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN -END IF -POSSIBLE = .FALSE. - -DO x = 1, length - IF (abs(c(x) - max(init, a(x), b(x))) .lt. ((10 - length) * PRECISION)) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = c(x) - IF (IS_POSSIBLE(passed_a, passed_b, passed_c, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF -END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE MAX_X_EXPR_LIST +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() -IMPLICIT NONE -INCLUDE "acc_testsuite.Fh" -INTEGER :: x, y !Iterators -REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b, c !Data -REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison -REAL(8),DIMENSION(10):: passed_a, passed_b, passed_c -REAL(8):: init -LOGICAL IS_POSSIBLE -INTEGER :: errors = 0 - -!Initilization -SEEDDIM(1) = 1 -#ifdef SEED -SEEDDIM(1) = SEED +#include "atomic_template.Fh" #endif -CALL RANDOM_SEED(PUT=SEEDDIM) - -CALL RANDOM_NUMBER(a) -CALL RANDOM_NUMBER(b) - -totals = 0 -totals_comparison = 0 - -!$acc data copyin(a(1:LOOPCOUNT, 1:10), b(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(c(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = max(totals(x), a(x, y), b(x, y)) - c(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel -!$acc end data -DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = max(totals_comparison(x), a(x, y), b(x, y)) - END DO -END DO -DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF -END DO - -DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - passed_c(y) = c(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, passed_c, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF -END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END -#endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_min_expr_list_x_assign.F90 b/Tests/atomic_capture_min_expr_list_x_assign.F90 index 560a5ce..85eab13 100644 --- a/Tests/atomic_capture_min_expr_list_x_assign.F90 +++ b/Tests/atomic_capture_min_expr_list_x_assign.F90 @@ -1,130 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, c, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length), INTENT(IN) :: c - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8),DIMENSION(length - 1) :: passed_c - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(c(x) - min(init, a(x), b(x))) .gt. (10 - length) * PRECISION) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = c(x) - IF (IS_POSSIBLE(passed_a, passed_b, passed_c, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE MIN_EXPR_LIST_X +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b, c !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b, passed_c - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - CALL RANDOM_NUMBER(b) - - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10), b(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(c(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = min(a(x, y), b(x, y), totals(x)) - c(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = min(totals_comparison(x), a(x, y), b(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - passed_c(y) = c(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, passed_c, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_min_expr_x_assign.F90 b/Tests/atomic_capture_min_expr_x_assign.F90 index 4c85486..b2eccaf 100644 --- a/Tests/atomic_capture_min_expr_x_assign.F90 +++ b/Tests/atomic_capture_min_expr_x_assign.F90 @@ -1,126 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - min(init, a(x))) .gt. (10 - length) * PRECISION) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE MIN_EXPR_X +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = min(a(x, y), totals(x)) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = min(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_min_x_expr_assign.F90 b/Tests/atomic_capture_min_x_expr_assign.F90 index cdc361d..c21087f 100644 --- a/Tests/atomic_capture_min_x_expr_assign.F90 +++ b/Tests/atomic_capture_min_x_expr_assign.F90 @@ -1,126 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - min(init, a(x))) .gt. (10 - length) * PRECISION) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_MIN +#define ATOMIC_OPTYPE MIN_X_EXPR +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = min(totals(x), a(x, y)) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = min(totals_comparison(x), a(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_min_x_expr_list_assign.F90 b/Tests/atomic_capture_min_x_expr_list_assign.F90 index 50b37d2..057c599 100644 --- a/Tests/atomic_capture_min_x_expr_list_assign.F90 +++ b/Tests/atomic_capture_min_x_expr_list_assign.F90 @@ -1,130 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(a, b, c, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length), INTENT(IN) :: c - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8),DIMENSION(length - 1) :: passed_c - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(c(x) - min(init, a(x), b(x))) .lt. (10 - length) * PRECISION) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = c(x) - IF (IS_POSSIBLE(passed_a, passed_b, passed_c, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE MIN_X_EXPR_LIST +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b, c !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b, passed_c - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - CALL RANDOM_NUMBER(b) - - totals = 1 - totals_comparison = 1 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10), b(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(c(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = min(totals(x), a(x, y), b(x, y)) - c(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = min(totals_comparison(x), a(x, y), b(x, y)) - END DO - END DO - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - passed_c(y) = c(x, y) - END DO - init = 1 - IF (IS_POSSIBLE(passed_a, passed_b, passed_c, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_x_and_expr_assign.F90 b/Tests/atomic_capture_x_and_expr_assign.F90 index 03fd2b4..770bedd 100644 --- a/Tests/atomic_capture_x_and_expr_assign.F90 +++ b/Tests/atomic_capture_x_and_expr_assign.F90 @@ -1,135 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - LOGICAL,DIMENSION(length), INTENT(IN) :: a - LOGICAL,DIMENSION(length), INTENT(IN) :: b - LOGICAL, INTENT(IN) :: init - LOGICAL,DIMENSION(length - 1) :: passed_a - LOGICAL,DIMENSION(length - 1) :: passed_b - LOGICAL :: POSSIBLE, holder - INTEGER :: x, y - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - IF (b(x) .eqv. (a(x) .AND. init)) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_LOGICAL +#define ATOMIC_OPTYPE X_AND_EXPR +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT .TRUE. +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: randoms - LOGICAL,DIMENSION(LOOPCOUNT, 10):: a, b !Data - LOGICAL,DIMENSION(10):: passed_a, passed_b - LOGICAL IS_POSSIBLE - LOGICAL,DIMENSION(LOOPCOUNT):: totals, totals_comparison - INTEGER :: errors = 0 - LOGICAL :: init - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - DO x = 1, LOOPCOUNT - DO y = 1, 10 - IF (randoms(x, y) < .933) THEN - a(x, y) = .TRUE. - ELSE - a(x, y) = .FALSE. - END IF - END DO - END DO - - totals = .FALSE. - totals_comparison = .FALSE. - - !$acc data copyin(a(1:LOOPCOUNT,1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = totals(x) .AND. a(x, y) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) .AND. a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NEQV. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = .FALSE. - IF (.FALSE. .eqv. IS_POSSIBLE(a(x, 1:10), b(x, 1:10), 10, .FALSE.)) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_x_divided_expr_assign.F90 b/Tests/atomic_capture_x_divided_expr_assign.F90 index ce46645..51e5a8e 100644 --- a/Tests/atomic_capture_x_divided_expr_assign.F90 +++ b/Tests/atomic_capture_x_divided_expr_assign.F90 @@ -1,165 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE_2(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - real(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - REAL(8):: mindif - IF (length .lt. 10) THEN - WRITE(*, *) length - END IF - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - (init / a(x))) .lt. (100 - length) * PRECISION) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE_2(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE_2 - -RECURSIVE FUNCTION IS_POSSIBLE(subset, destination, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8),DIMENSION(length), INTENT(IN) :: subset - REAL(8), INTENT(IN) :: destination - REAL(8), INTENT(IN) :: init - REAL(8),ALLOCATABLE :: passed(:) - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .gt. 0) THEN - ALLOCATE(passed(length - 1)) - ELSE - IF (abs(init - destination) .lt. (10 - length) * PRECISION) THEN - POSSIBLE = .TRUE. - ELSE - POSSIBLE = .FALSE. - END IF - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - DO y = 1, x - 1 - passed(y) = subset(y) - END DO - DO y = x + 1, length - passed(y - 1) = subset(y) - END DO - holder = init / subset(x) - IF (IS_POSSIBLE(passed, destination, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE X_DIVIDED_EXPR +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a !Data - REAL(8),DIMENSION(LOOPCOUNT, 10):: b - REAL(8),DIMENSION(LOOPCOUNT):: totals - REAL(8),DIMENSION(10):: passed - REAL(8),DIMENSION(10):: passed_b - REAL(8) :: holder - INTEGER :: errors = 0 - LOGICAL IS_POSSIBLE - LOGICAL IS_POSSIBLE_2 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 1 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = totals(x) / a(x, y) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed(y) = a(x, y) - END DO - holder = 1 - IF (IS_POSSIBLE(passed, totals(x), 10, holder) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - holder = 1 - IF (IS_POSSIBLE_2(passed, passed_b, 10, holder) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_x_eqv_expr_assign.F90 b/Tests/atomic_capture_x_eqv_expr_assign.F90 index ccd0c5a..3035212 100644 --- a/Tests/atomic_capture_x_eqv_expr_assign.F90 +++ b/Tests/atomic_capture_x_eqv_expr_assign.F90 @@ -1,138 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - LOGICAL, INTENT(IN) :: init - LOGICAL,DIMENSION(length), INTENT(IN) :: a - LOGICAL,DIMENSION(length), INTENT(IN) :: b - LOGICAL,DIMENSION(length - 1) :: passed_a - LOGICAL,DIMENSION(length - 1) :: passed_b - LOGICAL :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eqv. (init .eqv. a(x))) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_LOGICAL +#define ATOMIC_OPTYPE X_EQV_EXPR +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT .FALSE. +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: randoms - LOGICAL,DIMENSION(LOOPCOUNT, 10):: a, b !Data - LOGICAL,DIMENSION(LOOPCOUNT):: totals, totals_comparison - LOGICAL,DIMENSION(10):: passed_a, passed_b - LOGICAL:: init - INTEGER :: errors = 0 - LOGICAL IS_POSSIBLE - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - DO x = 1, LOOPCOUNT - DO y = 1, 10 - IF (randoms(x, y) > .5) THEN - a(x, y) = .TRUE. - ELSE - a(x, y) = .FALSE. - END IF - END DO - END DO - - totals = .FALSE. - totals_comparison = .FALSE. - - !$acc data copyin(a(1:LOOPCOUNT,1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = totals(x) .EQV. a(x, y) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) .EQV. a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = .FALSE. - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .EQV. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NEQV. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_x_minus_expr_assign.F90 b/Tests/atomic_capture_x_minus_expr_assign.F90 index ac4c1d1..c75c7f1 100644 --- a/Tests/atomic_capture_x_minus_expr_assign.F90 +++ b/Tests/atomic_capture_x_minus_expr_assign.F90 @@ -1,157 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE_2(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - (init - a(x))) .GT. ((10 - length) * PRECISION)) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE_2(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE_2 - -RECURSIVE FUNCTION IS_POSSIBLE(subset, destination, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8),DIMENSION(length), INTENT(IN) :: subset - REAL(8), INTENT(IN) :: destination - REAL(8), INTENT(IN) :: init - REAL(8),ALLOCATABLE :: passed(:) - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .gt. 0) THEN - ALLOCATE(passed(length - 1)) - ELSE - IF (abs(init - destination) .gt. PRECISION) THEN - POSSIBLE = .TRUE. - ELSE - POSSIBLE = .FALSE. - END IF - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - DO y = 1, x - 1 - passed(y) = subset(y) - END DO - DO y = x + 1, length - passed(y - 1) = subset(y) - END DO - IF (IS_POSSIBLE(passed, destination, length - 1, init - subset(x))) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE X_MINUS_EXPR +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - LOGICAL IS_POSSIBLE - LOGICAL IS_POSSIBLE_2 - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT, 1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = totals(x) - a(x, y) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - END DO - IF (IS_POSSIBLE(passed_a, totals(x), 10, 0) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE_2(passed_a, passed_b, 10, init) .EQV. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_x_neqv_expr_assign.F90 b/Tests/atomic_capture_x_neqv_expr_assign.F90 index ed7c9b9..db97bab 100644 --- a/Tests/atomic_capture_x_neqv_expr_assign.F90 +++ b/Tests/atomic_capture_x_neqv_expr_assign.F90 @@ -1,136 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - LOGICAL, INTENT(IN) :: init - LOGICAL,DIMENSION(length), INTENT(IN) :: a - LOGICAL,DIMENSION(length), INTENT(IN) :: b - LOGICAL,DIMENSION(length - 1) :: passed_a - LOGICAL,DIMENSION(length - 1) :: passed_b - LOGICAL :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eqv. (init .neqv. a(x))) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_LOGICAL +#define ATOMIC_OPTYPE X_NEQV_EXPR +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT .FALSE. +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: randoms - LOGICAL,DIMENSION(LOOPCOUNT, 10):: a, b !Data - LOGICAL,DIMENSION(10):: passed_a, passed_b - LOGICAL,DIMENSION(LOOPCOUNT):: totals, totals_comparison - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - DO x = 1, LOOPCOUNT - DO y = 1, 10 - IF (randoms(x, y) > .5) THEN - a(x, y) = .TRUE. - ELSE - a(x, y) = .FALSE. - END IF - END DO - END DO - - totals = .FALSE. - totals_comparison = .FALSE. - - !$acc data copyin(a(1:LOOPCOUNT,1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = totals(x) .NEQV. a(x, y) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) .NEQV. a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NEQV. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - IF (IS_POSSIBLE(passed_a, passed_b, 10, .FALSE.) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_x_or_expr_assign.F90 b/Tests/atomic_capture_x_or_expr_assign.F90 index b239829..c47b1eb 100644 --- a/Tests/atomic_capture_x_or_expr_assign.F90 +++ b/Tests/atomic_capture_x_or_expr_assign.F90 @@ -1,138 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - LOGICAL, INTENT(IN) :: init - LOGICAL,DIMENSION(length), INTENT(IN) :: a - LOGICAL,DIMENSION(length), INTENT(IN) :: b - LOGICAL,DIMENSION(length - 1) :: passed_a - LOGICAL,DIMENSION(length - 1) :: passed_b - LOGICAL :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (b(x) .eqv. (init .or. a(x))) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_LOGICAL +#define ATOMIC_OPTYPE X_OR_EXPR +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT .FALSE. +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: randoms - LOGICAL,DIMENSION(LOOPCOUNT, 10):: a, b !Data - LOGICAL,DIMENSION(LOOPCOUNT):: totals, totals_comparison - LOGICAL,DIMENSION(10):: passed_a, passed_b - LOGICAL IS_POSSIBLE - LOGICAL:: init - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(randoms) - DO x = 1, LOOPCOUNT - DO y = 1, 10 - IF (randoms(x, y) > .933) THEN - a(x, y) = .TRUE. - ELSE - a(x, y) = .FALSE. - END IF - END DO - END DO - - totals = .FALSE. - totals_comparison = .FALSE. - - !$acc data copyin(a(1:LOOPCOUNT,1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = totals(x) .OR. a(x, y) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) .OR. a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NEQV. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = .FALSE. - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_x_plus_expr_assign.F90 b/Tests/atomic_capture_x_plus_expr_assign.F90 index 2f1b50f..77f4056 100644 --- a/Tests/atomic_capture_x_plus_expr_assign.F90 +++ b/Tests/atomic_capture_x_plus_expr_assign.F90 @@ -1,127 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - (init + a(x))) .GT. ((10 - length) * PRECISION)) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE X_PLUS_EXPR +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - totals_comparison = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = totals(x) + a(x, y) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) + a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 0 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_capture_x_times_expr_assign.F90 b/Tests/atomic_capture_x_times_expr_assign.F90 index 39a5e7b..53b9031 100644 --- a/Tests/atomic_capture_x_times_expr_assign.F90 +++ b/Tests/atomic_capture_x_times_expr_assign.F90 @@ -1,127 +1,10 @@ -RECURSIVE FUNCTION IS_POSSIBLE(a, b, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8), INTENT(IN) :: init - REAL(8),DIMENSION(length), INTENT(IN) :: a - REAL(8),DIMENSION(length), INTENT(IN) :: b - REAL(8),DIMENSION(length - 1) :: passed_a - REAL(8),DIMENSION(length - 1) :: passed_b - REAL(8) :: holder - LOGICAL :: POSSIBLE - INTEGER :: x, y - - IF (length .eq. 0) THEN - POSSIBLE = .TRUE. - RETURN - END IF - POSSIBLE = .FALSE. - - DO x = 1, length - IF (abs(b(x) - (init * a(x))) .GT. ((10 - length) * PRECISION)) THEN - DO y = 1, x - 1 - passed_a(y) = a(y) - passed_b(y) = b(y) - END DO - DO y = x + 1, length - passed_a(y - 1) = a(y) - passed_b(y - 1) = b(y) - END DO - holder = b(x) - IF (IS_POSSIBLE(passed_a, passed_b, length - 1, holder)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END IF - END DO -END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE capture +#define ATOMIC_REAL +#define ATOMIC_OPTYPE X_TIMES_EXPR +#define ATOMIC_ASSIGN_LATER +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a, b !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals, totals_comparison - REAL(8),DIMENSION(10):: passed_a, passed_b - REAL(8):: init - LOGICAL IS_POSSIBLE - INTEGER :: errors = 0 - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 1 - totals_comparison = 1 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT,1:10)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic capture - totals(x) = totals(x) * a(x, y) - b(x, y) = totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - DO x = 1, LOOPCOUNT - DO y = 1, 10 - totals_comparison(x) = totals_comparison(x) * a(x, y) - END DO - END DO - - DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN - errors = errors + 1 - WRITE(*, *) totals_comparison(x) - END IF - END DO - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed_a(y) = a(x, y) - passed_b(y) = b(x, y) - END DO - init = 1 - IF (IS_POSSIBLE(passed_a, passed_b, 10, init) .eqv. .TRUE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_expr_divided_x.F90 b/Tests/atomic_expr_divided_x.F90 index eea61ed..8a82bca 100644 --- a/Tests/atomic_expr_divided_x.F90 +++ b/Tests/atomic_expr_divided_x.F90 @@ -1,107 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(subset, destination, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8),DIMENSION(length), INTENT(IN) :: subset - REAL(8), INTENT(IN) :: destination - REAL(8), INTENT(IN) :: init - REAL(8),ALLOCATABLE :: passed(:) - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .gt. 0) THEN - ALLOCATE(passed(length - 1)) - ELSE - IF (abs(init - destination) .gt. PRECISION) THEN - POSSIBLE = .TRUE. - ELSE - POSSIBLE = .FALSE. - END IF - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - DO y = 1, x - 1 - passed(y) = subset(y) - END DO - DO y = x + 1, length - passed(y - 1) = subset(y) - END DO - IF (IS_POSSIBLE(passed, destination, length - 1, subset(x) / init)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE +#define ATOMIC_END +#define ATOMIC_REAL +#define ATOMIC_OPTYPE EXPR_DIVIDED_X +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 5 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals - REAL(8),DIMENSION(10):: passed - INTEGER :: errors = 0 - LOGICAL IS_POSSIBLE - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 1 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic - totals(x) = a(x, y) / totals(x) - END DO - END DO - !$acc end parallel - !$acc end data - - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed(y) = a(x, y) - END DO - IF (IS_POSSIBLE(passed, totals(x), 10, 1) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_expr_divided_x_end.F90 b/Tests/atomic_expr_divided_x_end.F90 index 68f682e..9c47c39 100644 --- a/Tests/atomic_expr_divided_x_end.F90 +++ b/Tests/atomic_expr_divided_x_end.F90 @@ -1,108 +1,9 @@ - RECURSIVE FUNCTION IS_POSSIBLE(subset, destination, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8),DIMENSION(length), INTENT(IN) :: subset - REAL(8), INTENT(IN) :: destination - REAL(8), INTENT(IN) :: init - REAL(8),ALLOCATABLE :: passed(:) - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .gt. 0) THEN - ALLOCATE(passed(length - 1)) - ELSE - IF (abs(init - destination) .gt. PRECISION) THEN - POSSIBLE = .TRUE. - ELSE - POSSIBLE = .FALSE. - END IF - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - DO y = 1, x - 1 - passed(y) = subset(y) - END DO - DO y = x + 1, length - passed(y - 1) = subset(y) - END DO - IF (IS_POSSIBLE(passed, destination, length - 1, subset(x) / init)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE +#define ATOMIC_REAL +#define ATOMIC_OPTYPE EXPR_DIVIDED_X +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 5 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals - REAL(8),DIMENSION(10):: passed - INTEGER :: errors = 0 - LOGICAL IS_POSSIBLE - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 1 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic - totals(x) = a(x, y) / totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed(y) = a(x, y) - END DO - IF (IS_POSSIBLE(passed, totals(x), 10, 1) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_expr_minus_x.F90 b/Tests/atomic_expr_minus_x.F90 index 4d92065..77e59dd 100644 --- a/Tests/atomic_expr_minus_x.F90 +++ b/Tests/atomic_expr_minus_x.F90 @@ -1,106 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(subset, destination, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8),DIMENSION(length), INTENT(IN) :: subset - REAL(8), INTENT(IN) :: destination - REAL(8), INTENT(IN) :: init - REAL(8),ALLOCATABLE :: passed(:) - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .gt. 0) THEN - ALLOCATE(passed(length - 1)) - ELSE - IF (abs(init - destination) .gt. PRECISION) THEN - POSSIBLE = .TRUE. - ELSE - POSSIBLE = .FALSE. - END IF - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - DO y = 1, x - 1 - passed(y) = subset(y) - END DO - DO y = x + 1, length - passed(y - 1) = subset(y) - END DO - IF (IS_POSSIBLE(passed, destination, length - 1, subset(x) - init)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE +#define ATOMIC_END +#define ATOMIC_REAL +#define ATOMIC_OPTYPE EXPR_MINUS_X +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 5 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - LOGICAL IS_POSSIBLE - REAL(8),DIMENSION(LOOPCOUNT, 10):: a !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals - INTEGER :: errors = 0 - REAL(8),DIMENSION(10):: passed - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic - totals(x) = a(x, y) - totals(x) - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed(y) = a(x, y) - END DO - IF (IS_POSSIBLE(passed, totals(x), 10, 0) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_expr_minus_x_end.F90 b/Tests/atomic_expr_minus_x_end.F90 index ee0d35d..5d8d049 100644 --- a/Tests/atomic_expr_minus_x_end.F90 +++ b/Tests/atomic_expr_minus_x_end.F90 @@ -1,107 +1,9 @@ - RECURSIVE FUNCTION IS_POSSIBLE(subset, destination, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8),DIMENSION(length), INTENT(IN) :: subset - REAL(8), INTENT(IN) :: destination - REAL(8), INTENT(IN) :: init - REAL(8),ALLOCATABLE :: passed(:) - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .gt. 0) THEN - ALLOCATE(passed(length - 1)) - ELSE - IF (abs(init - destination) .gt. PRECISION) THEN - POSSIBLE = .TRUE. - ELSE - POSSIBLE = .FALSE. - END IF - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - DO y = 1, x - 1 - passed(y) = subset(y) - END DO - DO y = x + 1, length - passed(y - 1) = subset(y) - END DO - IF (IS_POSSIBLE(passed, destination, length - 1, subset(x) - init)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE +#define ATOMIC_REAL +#define ATOMIC_OPTYPE EXPR_MINUS_X +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 5 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - LOGICAL IS_POSSIBLE - REAL(8),DIMENSION(LOOPCOUNT, 10):: a !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals - INTEGER :: errors = 0 - REAL(8),DIMENSION(10):: passed - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic - totals(x) = a(x, y) - totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed(y) = a(x, y) - END DO - IF (IS_POSSIBLE(passed, totals(x), 10, 0) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_template.Fh b/Tests/atomic_template.Fh new file mode 100644 index 0000000..d347ac2 --- /dev/null +++ b/Tests/atomic_template.Fh @@ -0,0 +1,258 @@ +#if !defined(ATOMIC_REAL) && !defined(ATOMIC_INTEGER) && !defined(ATOMIC_LOGICAL) +#define ATOMIC_REAL +#endif + +#ifndef ATOMIC_END +#define ATOMIC_END !$acc end atomic +#endif + +#ifdef ATOMIC_REAL +#define ATOMIC_TYPE REAL(8) +#elif defined(ATOMIC_INTEGER) +#define ATOMIC_TYPE INTEGER +#elif defined(ATOMIC_LOGICAL) +#define ATOMIC_TYPE LOGICAL +#endif + +#if defined(ATOMIC_REAL) || defined(ATOMIC_INTEGER) +#define EXPR_PLUS_X 1 +#define EXPR_MINUS_X 2 +#define EXPR_TIMES_X 3 +#define EXPR_DIVIDED_X 4 +#define X_PLUS_EXPR 5 +#define X_MINUS_EXPR 6 +#define X_TIMES_EXPR 7 +#define X_DIVIDED_EXPR 8 +#define MAX_EXPR_X 9 +#define MAX_X_EXPR 10 +#define MIN_EXPR_X 11 +#define MIN_X_EXPR 12 +#ifdef ATOMIC_INTEGER +#define IAND_EXPR_X 100 +#define IOR_EXPR_X 101 +#define IXOR_EXPR_X 102 +#define IAND_X_EXPR 103 +#define IOR_X_EXPR 104 +#define IXOR_X_EXPR 105 +#endif +#define MAX_EXPR_LIST_X 1001 +#define MIN_EXPR_LIST_X 1002 +#define MAX_X_EXPR_LIST 1003 +#define MIN_X_EXPR_LIST 1004 + +#if ATOMIC_OPTYPE == EXPR_PLUS_X +#define ATOMIC_OP(a, b) (a + b) +#elif ATOMIC_OPTYPE == EXPR_MINUS_X +#define ATOMIC_OP(a, b) (a - b) +#elif ATOMIC_OPTYPE == EXPR_TIMES_X +#define ATOMIC_OP(a, b) (a * b) +#elif ATOMIC_OPTYPE == EXPR_DIVIDED_X +#define ATOMIC_OP(a, b) (a / b) +#elif ATOMIC_OPTYPE == X_PLUS_EXPR +#define ATOMIC_OP(a, b) (b + a) +#elif ATOMIC_OPTYPE == X_MINUS_EXPR +#define ATOMIC_OP(a, b) (b - a) +#elif ATOMIC_OPTYPE == X_TIMES_EXPR +#define ATOMIC_OP(a, b) (b * a) +#elif ATOMIC_OPTYPE == X_DIVIDED_EXPR +#define ATOMIC_OP(a, b) (b / a) +#elif ATOMIC_OPTYPE == MAX_EXPR_X +#define ATOMIC_OP(a, b) max(a, b) +#elif ATOMIC_OPTYPE == MIN_EXPR_X +#define ATOMIC_OP(a, b) min(a, b) +#elif ATOMIC_OPTYPE == MAX_X_EXPR +#define ATOMIC_OP(a, b) max(b, a) +#elif ATOMIC_OPTYPE == MIN_X_EXPR +#define ATOMIC_OP(a, b) min(b, a) +#elif ATOMIC_OPTYPE == IAND_EXPR_X +#define ATOMIC_OP(a, b) iand(a, b) +#elif ATOMIC_OPTYPE == IOR_EXPR_X +#define ATOMIC_OP(a, b) ior(a, b) +#elif ATOMIC_OPTYPE == IXOR_EXPR_X +#define ATOMIC_OP(a, b) ieor(a, b) +#elif ATOMIC_OPTYPE == IAND_X_EXPR +#define ATOMIC_OP(a, b) iand(b, a) +#elif ATOMIC_OPTYPE == IOR_X_EXPR +#define ATOMIC_OP(a, b) ior(b, a) +#elif ATOMIC_OPTYPE == IXOR_X_EXPR +#define ATOMIC_OP(a, b) ieor(b, a) +#elif ATOMIC_OPTYPE == MAX_EXPR_LIST_X +#define ATOMIC_LIST +#define ATOMIC_OP(a, a2, b) max(a, a2, b) +#elif ATOMIC_OPTYPE == MIN_EXPR_LIST_X +#define ATOMIC_LIST +#define ATOMIC_OP(a, a2, b) min(a, a2, b) +#elif ATOMIC_OPTYPE == MAX_X_EXPR_LIST +#define ATOMIC_LIST +#define ATOMIC_OP(a, a2, b) max(b, a, a2) +#elif ATOMIC_OPTYPE == MIN_X_EXPR_LIST +#define ATOMIC_LIST +#define ATOMIC_OP(a, a2, b) min(b, a, a2) +#endif + +#elif defined(ATOMIC_LOGICAL) +#define EXPR_AND_X 2001 +#define EXPR_EQV_X 2002 +#define EXPR_NEQV_X 2003 +#define EXPR_OR_X 2004 +#define X_AND_EXPR 2005 +#define X_EQV_EXPR 2006 +#define X_NEQV_EXPR 2007 +#define X_OR_EXPR 2008 + +#if ATOMIC_OPTYPE == EXPR_AND_X +#define ATOMIC_OP(a, b) (a .AND. b) +#elif ATOMIC_OPTYPE == EXPR_EQV_X +#define ATOMIC_OP(a, b) (a .EQV. b) +#elif ATOMIC_OPTYPE == EXPR_NEQV_X +#define ATOMIC_OP(a, b) (a .AND. b) +#elif ATOMIC_OPTYPE == EXPR_OR_X +#define ATOMIC_OP(a, b) (a .OR. b) +#elif ATOMIC_OPTYPE == X_AND_EXPR +#define ATOMIC_OP(a, b) (b .AND. a) +#elif ATOMIC_OPTYPE == X_EQV_EXPR +#define ATOMIC_OP(a, b) (b .EQV. a) +#elif ATOMIC_OPTYPE == X_NEQV_EXPR +#define ATOMIC_OP(a, b) (b .NEQV. a) +#elif ATOMIC_OPTYPE == X_OR_EXPR +#define ATOMIC_OP(a, b) (b .OR. a) +#endif +#endif + +#include "common.Fh" +LOGICAL FUNCTION test1() + IMPLICIT NONE + INCLUDE "acc_testsuite.Fh" + ATOMIC_TYPE, DIMENSION(LOOPCOUNT, ATOMIC_SIZE) :: a +#ifdef ATOMIC_LIST + ATOMIC_TYPE, DIMENSION(LOOPCOUNT, ATOMIC_SIZE) :: a2 +#endif +#if defined(ATOMIC_ASSIGN_FIRST) || defined(ATOMIC_ASSIGN_LATER) + ATOMIC_TYPE, DIMENSION(LOOPCOUNT, ATOMIC_SIZE) :: b +#endif +#ifdef ATOMIC_INTEGER + REAL(8), DIMENSION(LOOPCOUNT, ATOMIC_SIZE, 8) :: random +#else + REAL(8), DIMENSION(LOOPCOUNT, ATOMIC_SIZE) :: random +#endif + ATOMIC_TYPE, DIMENSION(LOOPCOUNT) :: totals + INTEGER :: i, j, k + INTEGER :: errors = 0 + + !Initilization + SEEDDIM(1) = 1 +#ifdef SEED + SEEDDIM(1) = SEED +#endif + CALL RANDOM_SEED(PUT=SEEDDIM) + + CALL RANDOM_NUMBER(random) +#ifdef ATOMIC_REAL + a = random +#ifdef ATOMIC_LIST + CALL RANDOM_NUMBER(a2) +#endif +#elif defined(ATOMIC_INTEGER) + a = 0 + DO i = 1, LOOPCOUNT + DO j = 1, ATOMIC_SIZE + DO k = 1, 8 + IF (random(i, j, k) .gt. .933) THEN + a(i, j) = a(i, j) + ISHFT(1, k - 1) + END IF + END DO + END DO + END DO +#elif defined(ATOMIC_LOGICAL) + DO i = 1, LOOPCOUNT + DO j = 1, ATOMIC_SIZE + IF (random(i, j) < .933) THEN + a(i, j) = .TRUE. + ELSE + a(i, j) = .FALSE. + END IF + END DO + END DO +#endif + + totals = ATOMIC_INIT + + !$acc data copyin(a(1:LOOPCOUNT, 1:ATOMIC_SIZE)) copy(totals(1:LOOPCOUNT)) +#ifdef ATOMIC_LIST + !$acc data copyin(a2(1:LOOPCOUNT, 1:ATOMIC_SIZE)) +#endif +#if defined(ATOMIC_ASSIGN_FIRST) || defined(ATOMIC_ASSIGN_LATER) + !$acc data copyout(b(1:LOOPCOUNT, 1:ATOMIC_SIZE)) +#endif + !$acc parallel + !$acc loop + DO i = 1, LOOPCOUNT + DO j = 1, ATOMIC_SIZE + !$acc atomic ATOMIC_CLAUSE +#ifdef ATOMIC_ASSIGN_FIRST + b(i, j) = totals(i) +#endif +#ifdef ATOMIC_LIST + totals(i) = ATOMIC_OP(a(i, j), a2(i, j), totals(i)) +#else + totals(i) = ATOMIC_OP(a(i, j), totals(i)) +#endif +#ifdef ATOMIC_ASSIGN_LATER + b(i, j) = totals(i) +#endif + ATOMIC_END + END DO + END DO + !$acc end parallel +#ifdef ATOMIC_LIST + !$acc end data +#endif +#if defined(ATOMIC_ASSIGN_FIRST) || defined(ATOMIC_ASSIGN_LATER) + !$acc end data +#endif + !$acc end data + + DO i = 1, LOOPCOUNT +#if defined(ATOMIC_ASSIGN_FIRST) || defined(ATOMIC_ASSIGN_LATER) +#ifdef ATOMIC_LIST + IF (.NOT. VERIFY_ATOMIC_SEQUENCE(a(i, :), a2(i, :), b(i, :), & + & ATOMIC_SIZE, ATOMIC_INIT, totals(i), ATOMIC_OPTYPE)) THEN +#else + IF (.NOT. VERIFY_ATOMIC_SEQUENCE(a(i, :), b(i, :), & + & ATOMIC_SIZE, ATOMIC_INIT, totals(i), ATOMIC_OPTYPE)) THEN +#endif +#else + IF (.NOT. IS_POSSIBLE(a(i, :), ATOMIC_SIZE, ATOMIC_INIT, totals(i), ATOMIC_OPTYPE)) THEN +#endif + errors = errors + 1 + END IF + END DO + + IF (errors .eq. 0) THEN + test1 = .FALSE. + ELSE + test1 = .TRUE. + END IF +END FUNCTION test1 + +PROGRAM main + IMPLICIT NONE + INTEGER :: failcode, testrun + LOGICAL :: failed + INCLUDE "acc_testsuite.Fh" +#ifndef T1 + LOGICAL :: test1 +#endif + failed = .FALSE. + failcode = 0 +#ifndef T1 + DO testrun = 1, NUM_TEST_CALLS + failed = failed .or. test1() + END DO + IF (failed) THEN + failcode = failcode + 2 ** 0 + failed = .FALSE. + END IF +#endif + CALL EXIT (failcode) +END PROGRAM main diff --git a/Tests/atomic_update_expr_divided_x.F90 b/Tests/atomic_update_expr_divided_x.F90 index d0870fa..309c84e 100644 --- a/Tests/atomic_update_expr_divided_x.F90 +++ b/Tests/atomic_update_expr_divided_x.F90 @@ -1,107 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(subset, destination, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8),DIMENSION(length), INTENT(IN) :: subset - REAL(8), INTENT(IN) :: destination - REAL(8), INTENT(IN) :: init - REAL(8),ALLOCATABLE :: passed(:) - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .gt. 0) THEN - ALLOCATE(passed(length - 1)) - ELSE - IF (abs(init - destination) .gt. PRECISION) THEN - POSSIBLE = .TRUE. - ELSE - POSSIBLE = .FALSE. - END IF - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - DO y = 1, x - 1 - passed(y) = subset(y) - END DO - DO y = x + 1, length - passed(y - 1) = subset(y) - END DO - IF (IS_POSSIBLE(passed, destination, length - 1, subset(x) / init)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE update +#define ATOMIC_END +#define ATOMIC_REAL +#define ATOMIC_OPTYPE EXPR_DIVIDED_X +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 5 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals - REAL(8),DIMENSION(10):: passed - INTEGER :: errors = 0 - LOGICAL IS_POSSIBLE - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 1 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic update - totals(x) = a(x, y) / totals(x) - END DO - END DO - !$acc end parallel - !$acc end data - - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed(y) = a(x, y) - END DO - IF (IS_POSSIBLE(passed, totals(x), 10, 1) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_update_expr_divided_x_end.F90 b/Tests/atomic_update_expr_divided_x_end.F90 index 677aa1d..dce25e7 100644 --- a/Tests/atomic_update_expr_divided_x_end.F90 +++ b/Tests/atomic_update_expr_divided_x_end.F90 @@ -1,108 +1,9 @@ - RECURSIVE FUNCTION IS_POSSIBLE(subset, destination, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8),DIMENSION(length), INTENT(IN) :: subset - REAL(8), INTENT(IN) :: destination - REAL(8), INTENT(IN) :: init - REAL(8),ALLOCATABLE :: passed(:) - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .gt. 0) THEN - ALLOCATE(passed(length - 1)) - ELSE - IF (abs(init - destination) .gt. PRECISION) THEN - POSSIBLE = .TRUE. - ELSE - POSSIBLE = .FALSE. - END IF - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - DO y = 1, x - 1 - passed(y) = subset(y) - END DO - DO y = x + 1, length - passed(y - 1) = subset(y) - END DO - IF (IS_POSSIBLE(passed, destination, length - 1, subset(x) / init)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE update +#define ATOMIC_REAL +#define ATOMIC_OPTYPE EXPR_DIVIDED_X +#define ATOMIC_INIT 1.0_8 +#define ATOMIC_SIZE 5 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - REAL(8),DIMENSION(LOOPCOUNT, 10):: a !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals - REAL(8),DIMENSION(10):: passed - INTEGER :: errors = 0 - LOGICAL IS_POSSIBLE - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 1 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic update - totals(x) = a(x, y) / totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed(y) = a(x, y) - END DO - IF (IS_POSSIBLE(passed, totals(x), 10, 1) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_update_expr_minus_x.F90 b/Tests/atomic_update_expr_minus_x.F90 index 55afa2d..e9386d0 100644 --- a/Tests/atomic_update_expr_minus_x.F90 +++ b/Tests/atomic_update_expr_minus_x.F90 @@ -1,106 +1,10 @@ - RECURSIVE FUNCTION IS_POSSIBLE(subset, destination, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8),DIMENSION(length), INTENT(IN) :: subset - REAL(8), INTENT(IN) :: destination - REAL(8), INTENT(IN) :: init - REAL(8),ALLOCATABLE :: passed(:) - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .gt. 0) THEN - ALLOCATE(passed(length - 1)) - ELSE - IF (abs(init - destination) .gt. PRECISION) THEN - POSSIBLE = .TRUE. - ELSE - POSSIBLE = .FALSE. - END IF - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - DO y = 1, x - 1 - passed(y) = subset(y) - END DO - DO y = x + 1, length - passed(y - 1) = subset(y) - END DO - IF (IS_POSSIBLE(passed, destination, length - 1, subset(x) - init)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE update +#define ATOMIC_END +#define ATOMIC_REAL +#define ATOMIC_OPTYPE EXPR_MINUS_X +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 5 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - LOGICAL IS_POSSIBLE - REAL(8),DIMENSION(LOOPCOUNT, 10):: a !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals - INTEGER :: errors = 0 - REAL(8),DIMENSION(10):: passed - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic update - totals(x) = a(x, y) - totals(x) - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed(y) = a(x, y) - END DO - IF (IS_POSSIBLE(passed, totals(x), 10, 0) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM diff --git a/Tests/atomic_update_expr_minus_x_end.F90 b/Tests/atomic_update_expr_minus_x_end.F90 index 829bfd1..daabcd0 100644 --- a/Tests/atomic_update_expr_minus_x_end.F90 +++ b/Tests/atomic_update_expr_minus_x_end.F90 @@ -1,107 +1,9 @@ - RECURSIVE FUNCTION IS_POSSIBLE(subset, destination, length, init) RESULT(POSSIBLE) - INTEGER, INTENT(IN) :: length - REAL(8),DIMENSION(length), INTENT(IN) :: subset - REAL(8), INTENT(IN) :: destination - REAL(8), INTENT(IN) :: init - REAL(8),ALLOCATABLE :: passed(:) - LOGICAL :: POSSIBLE - INTEGER :: x, y - IF (length .gt. 0) THEN - ALLOCATE(passed(length - 1)) - ELSE - IF (abs(init - destination) .gt. PRECISION) THEN - POSSIBLE = .TRUE. - ELSE - POSSIBLE = .FALSE. - END IF - RETURN - END IF - POSSIBLE = .FALSE. - DO x = 1, length - DO y = 1, x - 1 - passed(y) = subset(y) - END DO - DO y = x + 1, length - passed(y - 1) = subset(y) - END DO - IF (IS_POSSIBLE(passed, destination, length - 1, subset(x) - init)) THEN - POSSIBLE = .TRUE. - RETURN - END IF - END DO - END FUNCTION IS_POSSIBLE - +#define ATOMIC_CLAUSE update +#define ATOMIC_REAL +#define ATOMIC_OPTYPE EXPR_MINUS_X +#define ATOMIC_INIT 0.0_8 +#define ATOMIC_SIZE 5 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 - LOGICAL FUNCTION test1() - IMPLICIT NONE - INCLUDE "acc_testsuite.Fh" - INTEGER :: x, y !Iterators - LOGICAL IS_POSSIBLE - REAL(8),DIMENSION(LOOPCOUNT, 10):: a !Data - REAL(8),DIMENSION(LOOPCOUNT):: totals - INTEGER :: errors = 0 - REAL(8),DIMENSION(10):: passed - - !Initilization - SEEDDIM(1) = 1 -# ifdef SEED - SEEDDIM(1) = SEED -# endif - CALL RANDOM_SEED(PUT=SEEDDIM) - - CALL RANDOM_NUMBER(a) - - totals = 0 - - !$acc data copyin(a(1:LOOPCOUNT, 1:10)) copy(totals(1:LOOPCOUNT)) - !$acc parallel - !$acc loop - DO x = 1, LOOPCOUNT - DO y = 1, 10 - !$acc atomic update - totals(x) = a(x, y) - totals(x) - !$acc end atomic - END DO - END DO - !$acc end parallel - !$acc end data - - DO x = 1, LOOPCOUNT - DO y = 1, 10 - passed(y) = a(x, y) - END DO - IF (IS_POSSIBLE(passed, totals(x), 10, 0) .eqv. .FALSE.) THEN - errors = errors + 1 - END IF - END DO - - IF (errors .eq. 0) THEN - test1 = .FALSE. - ELSE - test1 = .TRUE. - END IF - END +#include "atomic_template.Fh" #endif - - PROGRAM main - IMPLICIT NONE - INTEGER :: failcode, testrun - LOGICAL :: failed - INCLUDE "acc_testsuite.Fh" -#ifndef T1 - LOGICAL :: test1 -#endif - failed = .FALSE. - failcode = 0 -#ifndef T1 - DO testrun = 1, NUM_TEST_CALLS - failed = failed .or. test1() - END DO - IF (failed) THEN - failcode = failcode + 2 ** 0 - failed = .FALSE. - END IF -#endif - CALL EXIT (failcode) - END PROGRAM From b829b73dcca43b51ea46d64c29b73c813ab85e6f Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Wed, 26 Feb 2025 14:48:13 -0800 Subject: [PATCH 03/37] updating the precision on some C/C++ tests to be less strict, also fixing some math --- Tests/acc_testsuite.h | 1 + Tests/atomic_structured_expr_multiply_x_assign.c | 2 +- Tests/atomic_structured_expr_multiply_x_assign.cpp | 2 +- Tests/atomic_structured_multiply_equals_assign.c | 2 +- Tests/atomic_structured_multiply_equals_assign.cpp | 2 +- Tests/atomic_structured_x_multiply_expr_assign.c | 2 +- Tests/atomic_structured_x_multiply_expr_assign.cpp | 2 +- ...lel_loop_reduction_add_general_type_check_pt2.c | 14 +++++++------- ...l_loop_reduction_add_general_type_check_pt2.cpp | 14 +++++++------- 9 files changed, 21 insertions(+), 20 deletions(-) diff --git a/Tests/acc_testsuite.h b/Tests/acc_testsuite.h index 9fa7372..216133c 100644 --- a/Tests/acc_testsuite.h +++ b/Tests/acc_testsuite.h @@ -27,6 +27,7 @@ #define ARRAYSIZE 100 long long n = ARRAYSIZE; #define PRECISION 1e-8 +#define PRECISION2 1e-4 typedef double real_t; #ifdef __cplusplus diff --git a/Tests/atomic_structured_expr_multiply_x_assign.c b/Tests/atomic_structured_expr_multiply_x_assign.c index 552fbc9..7f843c0 100644 --- a/Tests/atomic_structured_expr_multiply_x_assign.c +++ b/Tests/atomic_structured_expr_multiply_x_assign.c @@ -6,7 +6,7 @@ bool is_possible(real_t* a, real_t* b, int length, real_t prev){ real_t *passed_a = (real_t *)malloc((length - 1) * sizeof(real_t)); real_t *passed_b = (real_t *)malloc((length - 1) * sizeof(real_t)); for (int x = 0; x < length; ++x){ - if (fabs(b[x] - (a[x] * prev)) < PRECISION){ + if (fabs(b[x] - (a[x] * prev)) < PRECISION2){ for (int y = 0; y < x; ++y){ passed_a[y] = a[y]; passed_b[y] = b[y]; diff --git a/Tests/atomic_structured_expr_multiply_x_assign.cpp b/Tests/atomic_structured_expr_multiply_x_assign.cpp index 038d148..596e40f 100644 --- a/Tests/atomic_structured_expr_multiply_x_assign.cpp +++ b/Tests/atomic_structured_expr_multiply_x_assign.cpp @@ -6,7 +6,7 @@ bool is_possible(real_t* a, real_t* b, int length, real_t prev){ real_t *passed_a = new real_t[(length - 1)]; real_t *passed_b = new real_t[(length - 1)]; for (int x = 0; x < length; ++x){ - if (fabs(b[x] - (a[x] * prev)) < PRECISION){ + if (fabs(b[x] - (a[x] * prev)) < PRECISION2){ for (int y = 0; y < x; ++y){ passed_a[y] = a[y]; passed_b[y] = b[y]; diff --git a/Tests/atomic_structured_multiply_equals_assign.c b/Tests/atomic_structured_multiply_equals_assign.c index a77128a..d62a432 100644 --- a/Tests/atomic_structured_multiply_equals_assign.c +++ b/Tests/atomic_structured_multiply_equals_assign.c @@ -6,7 +6,7 @@ bool is_possible(real_t* a, real_t* b, int length, real_t prev){ real_t *passed_a = (real_t *)malloc((length - 1) * sizeof(real_t)); real_t *passed_b = (real_t *)malloc((length - 1) * sizeof(real_t)); for (int x = 0; x < length; ++x){ - if (fabs(b[x] - (a[x] * prev)) < PRECISION){ + if (fabs(b[x] - (a[x] * prev)) < PRECISION2){ for (int y = 0; y < x; ++y){ passed_a[y] = a[y]; passed_b[y] = b[y]; diff --git a/Tests/atomic_structured_multiply_equals_assign.cpp b/Tests/atomic_structured_multiply_equals_assign.cpp index 6bf4619..f2858ac 100644 --- a/Tests/atomic_structured_multiply_equals_assign.cpp +++ b/Tests/atomic_structured_multiply_equals_assign.cpp @@ -6,7 +6,7 @@ bool is_possible(real_t* a, real_t* b, int length, real_t prev){ real_t *passed_a = new real_t[(length - 1)]; real_t *passed_b = new real_t[(length - 1)]; for (int x = 0; x < length; ++x){ - if (fabs(b[x] - (a[x] * prev)) < PRECISION){ + if (fabs(b[x] - (a[x] * prev)) < PRECISION2){ for (int y = 0; y < x; ++y){ passed_a[y] = a[y]; passed_b[y] = b[y]; diff --git a/Tests/atomic_structured_x_multiply_expr_assign.c b/Tests/atomic_structured_x_multiply_expr_assign.c index 3ed11db..c0e2d5c 100644 --- a/Tests/atomic_structured_x_multiply_expr_assign.c +++ b/Tests/atomic_structured_x_multiply_expr_assign.c @@ -6,7 +6,7 @@ bool is_possible(real_t* a, real_t* b, int length, real_t prev){ real_t *passed_a = (real_t *)malloc((length - 1) * sizeof(real_t)); real_t *passed_b = (real_t *)malloc((length - 1) * sizeof(real_t)); for (int x = 0; x < length; ++x){ - if (fabs(b[x] - (a[x] * prev)) < PRECISION){ + if (fabs(b[x] - (a[x] * prev)) < PRECISION2){ for (int y = 0; y < x; ++y){ passed_a[y] = a[y]; passed_b[y] = b[y]; diff --git a/Tests/atomic_structured_x_multiply_expr_assign.cpp b/Tests/atomic_structured_x_multiply_expr_assign.cpp index 1a412a2..51358a0 100644 --- a/Tests/atomic_structured_x_multiply_expr_assign.cpp +++ b/Tests/atomic_structured_x_multiply_expr_assign.cpp @@ -6,7 +6,7 @@ bool is_possible(real_t* a, real_t* b, int length, real_t prev){ real_t *passed_a = new real_t[(length - 1)]; real_t *passed_b = new real_t[(length - 1)]; for (int x = 0; x < length; ++x){ - if (fabs(b[x] - (a[x] * prev)) < PRECISION){ + if (fabs(b[x] - (a[x] * prev)) < PRECISION2){ for (int y = 0; y < x; ++y){ passed_a[y] = a[y]; passed_b[y] = b[y]; diff --git a/Tests/parallel_loop_reduction_add_general_type_check_pt2.c b/Tests/parallel_loop_reduction_add_general_type_check_pt2.c index 0d7a3e4..6b3ebd3 100644 --- a/Tests/parallel_loop_reduction_add_general_type_check_pt2.c +++ b/Tests/parallel_loop_reduction_add_general_type_check_pt2.c @@ -151,8 +151,8 @@ int test5(){ float host_total = 10; for (int x = 0; x < n; ++x){ - a[x] = rand() / (real_t)(RAND_MAX / 10); - b[x] = rand() / (real_t)(RAND_MAX / 10); + a[x] = rand() / (real_t)RAND_MAX / 10; + b[x] = rand() / (real_t)RAND_MAX / 10; } #pragma acc data copyin(a[0:n], b[0:n]) @@ -167,7 +167,7 @@ int test5(){ host_total += a[x] + b[x]; } - if (fabsf(total - host_total) > PRECISION) { + if (fabsf(total - host_total) > PRECISION2) { err += 1; } @@ -256,8 +256,8 @@ int test8(){ float _Complex host_total = 10 + 10 * I; for (int x = 0; x < n; ++x){ - a[x] = rand() / (real_t)(RAND_MAX / 10) + rand() / (real_t)(RAND_MAX / 10) * I; - b[x] = rand() / (real_t)(RAND_MAX / 10) + rand() / (real_t)(RAND_MAX / 10) * I; + a[x] = rand() / (real_t)RAND_MAX + rand() / (real_t)RAND_MAX * I; + b[x] = rand() / (real_t)RAND_MAX + rand() / (real_t)RAND_MAX * I; } #pragma acc data copyin(a[0:n], b[0:n]) @@ -272,10 +272,10 @@ int test8(){ host_total += a[x] + b[x]; } - if (fabsf(crealf(total) - crealf(host_total)) > PRECISION) { + if (fabsf(crealf(total) - crealf(host_total)) > PRECISION2) { err += 1; } - if (fabsf(cimagf(total) - cimagf(host_total)) > PRECISION) { + if (fabsf(cimagf(total) - cimagf(host_total)) > PRECISION2) { err += 1; } diff --git a/Tests/parallel_loop_reduction_add_general_type_check_pt2.cpp b/Tests/parallel_loop_reduction_add_general_type_check_pt2.cpp index 6964ebc..d105734 100644 --- a/Tests/parallel_loop_reduction_add_general_type_check_pt2.cpp +++ b/Tests/parallel_loop_reduction_add_general_type_check_pt2.cpp @@ -151,8 +151,8 @@ int test5(){ float host_total = 10; for (int x = 0; x < n; ++x){ - a[x] = rand() / (real_t)(RAND_MAX / 10); - b[x] = rand() / (real_t)(RAND_MAX / 10); + a[x] = rand() / (real_t)RAND_MAX / 10; + b[x] = rand() / (real_t)RAND_MAX / 10; } #pragma acc data copyin(a[0:n], b[0:n]) @@ -167,7 +167,7 @@ int test5(){ host_total += a[x] + b[x]; } - if (fabsf(total - host_total) > PRECISION) { + if (fabsf(total - host_total) > PRECISION2) { err += 1; } @@ -256,8 +256,8 @@ int test8(){ float _Complex host_total = 10 + 10 * I; for (int x = 0; x < n; ++x){ - a[x] = rand() / (real_t)(RAND_MAX / 10) + rand() / (real_t)(RAND_MAX / 10) * I; - b[x] = rand() / (real_t)(RAND_MAX / 10) + rand() / (real_t)(RAND_MAX / 10) * I; + a[x] = rand() / (real_t)RAND_MAX + rand() / (real_t)RAND_MAX * I; + b[x] = rand() / (real_t)RAND_MAX + rand() / (real_t)RAND_MAX * I; } #pragma acc data copyin(a[0:n], b[0:n]) @@ -272,10 +272,10 @@ int test8(){ host_total += a[x] + b[x]; } - if (fabsf(crealf(total) - crealf(host_total)) > PRECISION) { + if (fabsf(crealf(total) - crealf(host_total)) > PRECISION2) { err += 1; } - if (fabsf(cimagf(total) - cimagf(host_total)) > PRECISION) { + if (fabsf(cimagf(total) - cimagf(host_total)) > PRECISION2) { err += 1; } From 4abfc7382ca5bbd4991ba886cd470e1fe8d33935 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Wed, 26 Feb 2025 14:51:30 -0800 Subject: [PATCH 04/37] fixing acc_malloc.* to be less strict; acc_property_free_memory is not fine grained enough for a very strict test --- Tests/acc_malloc.F90 | 2 +- Tests/acc_malloc.c | 2 +- Tests/acc_malloc.cpp | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Tests/acc_malloc.F90 b/Tests/acc_malloc.F90 index e95bda5..6439cb3 100644 --- a/Tests/acc_malloc.F90 +++ b/Tests/acc_malloc.F90 @@ -19,7 +19,7 @@ LOGICAL FUNCTION test1() final_memory = acc_get_property(acc_get_device_num(acc_get_device_type()), acc_get_device_type(), acc_property_free_memory) DO x = 1, LOOPCOUNT - IF (final_memory + N * sizeof(a(1)) .gt. initial_memory) THEN + IF (final_memory .gt. initial_memory) THEN errors = errors + 1 END IF END DO diff --git a/Tests/acc_malloc.c b/Tests/acc_malloc.c index fcb3fff..3b0ce1a 100644 --- a/Tests/acc_malloc.c +++ b/Tests/acc_malloc.c @@ -10,7 +10,7 @@ int test1(){ return err; } size_t final_memory = acc_get_property(acc_get_device_num(acc_get_device_type()), acc_get_device_type(), acc_property_free_memory); - if (final_memory + n * sizeof(int) > initial_memory){ + if (final_memory > initial_memory){ err += 1; } diff --git a/Tests/acc_malloc.cpp b/Tests/acc_malloc.cpp index fcb3fff..3b0ce1a 100644 --- a/Tests/acc_malloc.cpp +++ b/Tests/acc_malloc.cpp @@ -10,7 +10,7 @@ int test1(){ return err; } size_t final_memory = acc_get_property(acc_get_device_num(acc_get_device_type()), acc_get_device_type(), acc_property_free_memory); - if (final_memory + n * sizeof(int) > initial_memory){ + if (final_memory > initial_memory){ err += 1; } From 182ddb68b36fcdb8a6eb552bb59be209b1d52556 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Wed, 26 Feb 2025 14:53:13 -0800 Subject: [PATCH 05/37] fixing acc_copyin_with_len.F90 to use new devtest, plus a bit of math --- Tests/acc_copyin_with_len.F90 | 24 ++++++------------------ 1 file changed, 6 insertions(+), 18 deletions(-) diff --git a/Tests/acc_copyin_with_len.F90 b/Tests/acc_copyin_with_len.F90 index 631fef9..cff1611 100644 --- a/Tests/acc_copyin_with_len.F90 +++ b/Tests/acc_copyin_with_len.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:runtime,data,executable-data,construct-independent,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -103,15 +105,8 @@ LOGICAL FUNCTION test3() REAL(8),DIMENSION(LOOPCOUNT):: a, b, c, a_copy, b_copy !Data REAL(8) :: RAND INTEGER :: errors = 0 - INTEGER,DIMENSION(1) :: devtest - - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED @@ -296,7 +291,7 @@ LOGICAL FUNCTION test6() !$acc exit data delete(a(1:LOOPCOUNT), b(1:LOOPCOUNT)) DO x = 1, LOOPCOUNT - IF (abs(c(x) + (a(x) + b(x))) .gt. PRECISION) THEN + IF (abs(c(x) - (a(x) + b(x))) .gt. PRECISION) THEN errors = errors + 1 END IF END DO @@ -319,15 +314,8 @@ LOGICAL FUNCTION test7() REAL(8),DIMENSION(LOOPCOUNT):: a, b, c, a_copy, b_copy !Data REAL(8) :: RAND INTEGER :: errors = 0 - LOGICAL,DIMENSION(1):: devtest - devtest(1) = .TRUE. - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = .FALSE. - !$acc end parallel - - IF (devtest(1) .eqv. .TRUE.) THEN + IF (devtest() .eqv. .TRUE.) THEN SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED @@ -361,7 +349,7 @@ LOGICAL FUNCTION test7() !$acc exit data delete(a(1:LOOPCOUNT), b(1:LOOPCOUNT)) DO x = 1, LOOPCOUNT - IF (abs(c(x) - (a(x) + b(x))) .gt. PRECISION) THEN + IF (abs(c(x) - (a_copy(x) + b_copy(x))) .gt. PRECISION) THEN errors = errors + 1 END IF END DO From f9119a0a7db2f93e17a685681615459fb1463ce8 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Wed, 26 Feb 2025 14:55:31 -0800 Subject: [PATCH 06/37] fixing some set_device_type tests to use the interface correctly; also a missing declaration --- Tests/set_device_type.c | 8 ++------ Tests/set_device_type.cpp | 8 ++------ Tests/set_device_type_num.F90 | 1 + 3 files changed, 5 insertions(+), 12 deletions(-) diff --git a/Tests/set_device_type.c b/Tests/set_device_type.c index d5f5af9..bf6b851 100644 --- a/Tests/set_device_type.c +++ b/Tests/set_device_type.c @@ -4,10 +4,8 @@ int test1(){ int err = 0; - int device_type = acc_get_device_type(); - #pragma acc set device_type(host) - if (acc_get_device_type() != device_type){ + if (acc_get_device_type() != acc_device_host){ err += 1; } @@ -19,10 +17,8 @@ int test1(){ int test2(){ int err = 0; - int device_type = acc_get_device_type(); - #pragma acc set device_type(multicore) - if (acc_get_device_type() != device_type){ + if (acc_get_device_type() != acc_device_host){ err += 1; } diff --git a/Tests/set_device_type.cpp b/Tests/set_device_type.cpp index d5f5af9..bf6b851 100644 --- a/Tests/set_device_type.cpp +++ b/Tests/set_device_type.cpp @@ -4,10 +4,8 @@ int test1(){ int err = 0; - int device_type = acc_get_device_type(); - #pragma acc set device_type(host) - if (acc_get_device_type() != device_type){ + if (acc_get_device_type() != acc_device_host){ err += 1; } @@ -19,10 +17,8 @@ int test1(){ int test2(){ int err = 0; - int device_type = acc_get_device_type(); - #pragma acc set device_type(multicore) - if (acc_get_device_type() != device_type){ + if (acc_get_device_type() != acc_device_host){ err += 1; } diff --git a/Tests/set_device_type_num.F90 b/Tests/set_device_type_num.F90 index d0dcf1b..f622ac0 100644 --- a/Tests/set_device_type_num.F90 +++ b/Tests/set_device_type_num.F90 @@ -4,6 +4,7 @@ LOGICAL FUNCTION test1() USE OPENACC IMPLICIT NONE INCLUDE "acc_testsuite.Fh" + INTEGER :: device_num INTEGER :: device_type INTEGER :: errors = 0 From d22fd42279f91ec38b10dd47b6caedcf985e55c3 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Wed, 26 Feb 2025 14:57:21 -0800 Subject: [PATCH 07/37] serial_private.c/.cpp were missing a present clause --- Tests/serial_private.c | 2 +- Tests/serial_private.cpp | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Tests/serial_private.c b/Tests/serial_private.c index 44df47b..3f64540 100644 --- a/Tests/serial_private.c +++ b/Tests/serial_private.c @@ -21,7 +21,7 @@ int test1(){ } #pragma acc enter data copyin(a[0:10*n], b[0:10*n], d[0:10]) - #pragma acc serial private(c[0:n]) + #pragma acc serial private(c[0:n]) present(a, b, d) { #pragma acc loop gang for (int x = 0; x < 10; ++x){ diff --git a/Tests/serial_private.cpp b/Tests/serial_private.cpp index aca52e3..707f260 100644 --- a/Tests/serial_private.cpp +++ b/Tests/serial_private.cpp @@ -21,7 +21,7 @@ int test1(){ } #pragma acc enter data copyin(a[0:10*n], b[0:10*n], d[0:10]) - #pragma acc serial private(c[0:n]) + #pragma acc serial private(c[0:n]) present(a, b, d) { #pragma acc loop gang for (int x = 0; x < 10; ++x){ From 146afc73a8aa788a757759727c84afb6dcd0735d Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Wed, 26 Feb 2025 14:57:55 -0800 Subject: [PATCH 08/37] fixing typo in serial_private.F90 --- Tests/serial_private.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Tests/serial_private.F90 b/Tests/serial_private.F90 index 4200183..b9d13f9 100644 --- a/Tests/serial_private.F90 +++ b/Tests/serial_private.F90 @@ -44,7 +44,7 @@ LOGICAL FUNCTION test1() DO x = 1, LOOPCOUNT temp = temp + (a(x, y) + b(x, y)) END DO - IF (abs(d(x) - temp) .gt. (2 * PRECISION * LOOPCOUNT)) THEN + IF (abs(d(y) - temp) .gt. (2 * PRECISION * LOOPCOUNT)) THEN errors = errors + 1 END IF END DO From 2cd87b3438febbaa27dc4265a2bbb0067485749d Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 08:04:44 -0800 Subject: [PATCH 09/37] adding missing variable initialization --- Tests/serial_loop_gang_blocking.F90 | 2 +- Tests/serial_loop_reduction_bitor_general.F90 | 2 +- Tests/serial_loop_reduction_max_general.F90 | 2 +- Tests/serial_loop_vector_blocking.F90 | 2 +- Tests/serial_loop_worker_blocking.F90 | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/Tests/serial_loop_gang_blocking.F90 b/Tests/serial_loop_gang_blocking.F90 index 1bf7d4f..fbd9f19 100644 --- a/Tests/serial_loop_gang_blocking.F90 +++ b/Tests/serial_loop_gang_blocking.F90 @@ -4,7 +4,7 @@ LOGICAL FUNCTION test1() IMPLICIT NONE INCLUDE "acc_testsuite.Fh" REAL(8),DIMENSION(LOOPCOUNT):: a, b, c - INTEGER:: multiplier + INTEGER:: multiplier = 1 INTEGER:: x INTEGER:: errors diff --git a/Tests/serial_loop_reduction_bitor_general.F90 b/Tests/serial_loop_reduction_bitor_general.F90 index 45688e6..7e2e556 100644 --- a/Tests/serial_loop_reduction_bitor_general.F90 +++ b/Tests/serial_loop_reduction_bitor_general.F90 @@ -3,7 +3,7 @@ LOGICAL FUNCTION test1() IMPLICIT NONE INCLUDE "acc_testsuite.Fh" - INTEGER:: errors, temp, x, y, b, host_b + INTEGER:: errors, temp, x, y, b = 0, host_b = 0 INTEGER,DIMENSION(LOOPCOUNT):: a REAL(8):: false_margin REAL(8),DIMENSION(LOOPCOUNT, 16):: randoms diff --git a/Tests/serial_loop_reduction_max_general.F90 b/Tests/serial_loop_reduction_max_general.F90 index f09c197..b28fe83 100644 --- a/Tests/serial_loop_reduction_max_general.F90 +++ b/Tests/serial_loop_reduction_max_general.F90 @@ -4,7 +4,7 @@ LOGICAL FUNCTION test1() IMPLICIT NONE INCLUDE "acc_testsuite.Fh" REAL(8),DIMENSION(LOOPCOUNT):: a, b - REAL(8):: maxval, host_max + REAL(8):: maxval = 0.0, host_max = 0.0 INTEGER:: errors, x SEEDDIM(1) = 1 diff --git a/Tests/serial_loop_vector_blocking.F90 b/Tests/serial_loop_vector_blocking.F90 index 6a7cf3b..3815fb4 100644 --- a/Tests/serial_loop_vector_blocking.F90 +++ b/Tests/serial_loop_vector_blocking.F90 @@ -5,7 +5,7 @@ LOGICAL FUNCTION test1() INCLUDE "acc_testsuite.Fh" INTEGER:: errors REAL(8),DIMENSION(LOOPCOUNT):: a, b, c - INTEGER:: multiplier, x + INTEGER:: multiplier = 1, x errors = 0 SEEDDIM(1) = 1 diff --git a/Tests/serial_loop_worker_blocking.F90 b/Tests/serial_loop_worker_blocking.F90 index b133536..6c38383 100644 --- a/Tests/serial_loop_worker_blocking.F90 +++ b/Tests/serial_loop_worker_blocking.F90 @@ -4,7 +4,7 @@ LOGICAL FUNCTION test1() IMPLICIT NONE INCLUDE "acc_testsuite.Fh" REAL(8),DIMENSION(LOOPCOUNT):: a, b, c - INTEGER:: multiplier + INTEGER:: multiplier = 1 INTEGER:: x INTEGER:: errors From 0e3757b398307d93f6154033d99f4ca1a9fa1ed6 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 08:11:41 -0800 Subject: [PATCH 10/37] error count update line missing equals; err + 1 --> err += 1 --- Tests/kernels_loop_vector_blocking.c | 2 +- Tests/kernels_loop_vector_blocking.cpp | 2 +- Tests/kernels_loop_worker_blocking.c | 2 +- Tests/kernels_loop_worker_blocking.cpp | 2 +- Tests/parallel_loop_vector_blocking.c | 2 +- Tests/parallel_loop_vector_blocking.cpp | 2 +- Tests/parallel_loop_worker_blocking.c | 2 +- Tests/parallel_loop_worker_blocking.cpp | 2 +- Tests/serial_loop_gang_blocking.c | 2 +- Tests/serial_loop_gang_blocking.cpp | 2 +- 10 files changed, 10 insertions(+), 10 deletions(-) diff --git a/Tests/kernels_loop_vector_blocking.c b/Tests/kernels_loop_vector_blocking.c index ad55d75..1fd92cb 100644 --- a/Tests/kernels_loop_vector_blocking.c +++ b/Tests/kernels_loop_vector_blocking.c @@ -33,7 +33,7 @@ int test1(){ for (int x = 0; x < n; ++x){ if (fabs(c[x] - 3 * (a[x] + b[x])) > PRECISION){ - err + 1; + err += 1; break; } } diff --git a/Tests/kernels_loop_vector_blocking.cpp b/Tests/kernels_loop_vector_blocking.cpp index 378123e..8e71798 100644 --- a/Tests/kernels_loop_vector_blocking.cpp +++ b/Tests/kernels_loop_vector_blocking.cpp @@ -33,7 +33,7 @@ int test1(){ for (int x = 0; x < n; ++x){ if (fabs(c[x] - 3 * (a[x] + b[x])) > PRECISION){ - err + 1; + err += 1; break; } } diff --git a/Tests/kernels_loop_worker_blocking.c b/Tests/kernels_loop_worker_blocking.c index 5b2a4b1..70c5cf3 100644 --- a/Tests/kernels_loop_worker_blocking.c +++ b/Tests/kernels_loop_worker_blocking.c @@ -33,7 +33,7 @@ int test1(){ for (int x = 0; x < n; ++x){ if (fabs(c[x] - 3 * (a[x] + b[x])) > PRECISION){ - err + 1; + err += 1; break; } } diff --git a/Tests/kernels_loop_worker_blocking.cpp b/Tests/kernels_loop_worker_blocking.cpp index f444d50..4bfd469 100644 --- a/Tests/kernels_loop_worker_blocking.cpp +++ b/Tests/kernels_loop_worker_blocking.cpp @@ -33,7 +33,7 @@ int test1(){ for (int x = 0; x < n; ++x){ if (fabs(c[x] - 3 * (a[x] + b[x])) > PRECISION){ - err + 1; + err += 1; break; } } diff --git a/Tests/parallel_loop_vector_blocking.c b/Tests/parallel_loop_vector_blocking.c index be1cee8..4bea656 100644 --- a/Tests/parallel_loop_vector_blocking.c +++ b/Tests/parallel_loop_vector_blocking.c @@ -33,7 +33,7 @@ int test1(){ for (int x = 0; x < n; ++x){ if (fabs(c[x] - 3 * (a[x] + b[x])) > PRECISION){ - err + 1; + err += 1; break; } } diff --git a/Tests/parallel_loop_vector_blocking.cpp b/Tests/parallel_loop_vector_blocking.cpp index 02e0f98..5068d3f 100644 --- a/Tests/parallel_loop_vector_blocking.cpp +++ b/Tests/parallel_loop_vector_blocking.cpp @@ -33,7 +33,7 @@ int test1(){ for (int x = 0; x < n; ++x){ if (fabs(c[x] - 3 * (a[x] + b[x])) > PRECISION){ - err + 1; + err += 1; break; } } diff --git a/Tests/parallel_loop_worker_blocking.c b/Tests/parallel_loop_worker_blocking.c index 4dfc50d..50dae03 100644 --- a/Tests/parallel_loop_worker_blocking.c +++ b/Tests/parallel_loop_worker_blocking.c @@ -33,7 +33,7 @@ int test1(){ for (int x = 0; x < n; ++x){ if (fabs(c[x] - 3 * (a[x] + b[x])) > PRECISION){ - err + 1; + err += 1; break; } } diff --git a/Tests/parallel_loop_worker_blocking.cpp b/Tests/parallel_loop_worker_blocking.cpp index 3dd00cc..c055e84 100644 --- a/Tests/parallel_loop_worker_blocking.cpp +++ b/Tests/parallel_loop_worker_blocking.cpp @@ -33,7 +33,7 @@ int test1(){ for (int x = 0; x < n; ++x){ if (fabs(c[x] - 3 * (a[x] + b[x])) > PRECISION){ - err + 1; + err += 1; break; } } diff --git a/Tests/serial_loop_gang_blocking.c b/Tests/serial_loop_gang_blocking.c index 5a1d63e..bcced96 100644 --- a/Tests/serial_loop_gang_blocking.c +++ b/Tests/serial_loop_gang_blocking.c @@ -33,7 +33,7 @@ int test1(){ for (int x = 0; x < n; ++x){ if (fabs(c[x] - 3 * (a[x] + b[x])) > PRECISION){ - err + 1; + err += 1; break; } } diff --git a/Tests/serial_loop_gang_blocking.cpp b/Tests/serial_loop_gang_blocking.cpp index 0acfdd4..e3c4a6e 100644 --- a/Tests/serial_loop_gang_blocking.cpp +++ b/Tests/serial_loop_gang_blocking.cpp @@ -33,7 +33,7 @@ int test1(){ for (int x = 0; x < n; ++x){ if (fabs(c[x] - 3 * (a[x] + b[x])) > PRECISION){ - err + 1; + err += 1; break; } } From 2a6caa165cbe5b9902ec3ebc18fc2ef3e84965af Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 08:13:09 -0800 Subject: [PATCH 11/37] fixing some math for serial/parallel_implicit_data_attributes --- Tests/parallel_implicit_data_attributes.c | 4 ++-- Tests/parallel_implicit_data_attributes.cpp | 4 ++-- Tests/serial_implicit_data_attributes.c | 4 ++-- Tests/serial_implicit_data_attributes.cpp | 4 ++-- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/Tests/parallel_implicit_data_attributes.c b/Tests/parallel_implicit_data_attributes.c index 145324a..a4a4e88 100644 --- a/Tests/parallel_implicit_data_attributes.c +++ b/Tests/parallel_implicit_data_attributes.c @@ -13,7 +13,7 @@ int test1(){ test += 1; } - if(fabs( test - host) > PRECISION){ + if(fabs( test - host - n) > PRECISION){ err++; } @@ -33,7 +33,7 @@ int test2(){ a += 1.0; } - if( fabs( a - host) > PRECISION){ + if( fabs( a - host - n) > PRECISION){ err++; } return err; diff --git a/Tests/parallel_implicit_data_attributes.cpp b/Tests/parallel_implicit_data_attributes.cpp index 188e5b0..f011460 100644 --- a/Tests/parallel_implicit_data_attributes.cpp +++ b/Tests/parallel_implicit_data_attributes.cpp @@ -13,7 +13,7 @@ int test1(){ test += 1; } - if(fabs( test - host) > PRECISION){ + if(fabs( test - host - n) > PRECISION){ err++; } @@ -33,7 +33,7 @@ int test2(){ a += 1.0; } - if( fabs( a - host) > PRECISION){ + if( fabs( a - host - n) > PRECISION){ err++; } return err; diff --git a/Tests/serial_implicit_data_attributes.c b/Tests/serial_implicit_data_attributes.c index 7db74ca..559c528 100644 --- a/Tests/serial_implicit_data_attributes.c +++ b/Tests/serial_implicit_data_attributes.c @@ -53,10 +53,10 @@ int test3(){ int device = host; #pragma acc serial reduction(+:device) for( int x = 0; x < n; ++x){ - device += device; + device += 1; } - if( fabs(host - device) > PRECISION ){ + if( fabs(device - host - n) > PRECISION ){ err = 1; } return err; diff --git a/Tests/serial_implicit_data_attributes.cpp b/Tests/serial_implicit_data_attributes.cpp index 4e384e3..de572bc 100644 --- a/Tests/serial_implicit_data_attributes.cpp +++ b/Tests/serial_implicit_data_attributes.cpp @@ -44,10 +44,10 @@ int test3(){ int device = host; #pragma acc serial reduction(+:device) for( int x = 0; x < n; ++x){ - device += device; + device += 1; } - if( fabs(host - device) > PRECISION ){ + if( fabs(device - host - n) > PRECISION ){ err = 1; } return err; From b0cf8ea2916b262d198a33594c12ea8563bf8f22 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 08:19:25 -0800 Subject: [PATCH 12/37] changing routine gang to routine seq; cannot call gang routine without loop --- Tests/routine_gang.c | 2 +- Tests/routine_gang.cpp | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Tests/routine_gang.c b/Tests/routine_gang.c index 183bee2..764f45c 100644 --- a/Tests/routine_gang.c +++ b/Tests/routine_gang.c @@ -42,7 +42,7 @@ real_t called_function_seq(real_t ** a, int x, long long n){ return returned; } -#pragma acc routine gang +#pragma acc routine seq real_t called_function_gang(real_t ** a, int x, long long n){ real_t returned = 0; real_t* itemized_return = (real_t *)malloc(((int) (n/10)) * sizeof(real_t)); //Lol diff --git a/Tests/routine_gang.cpp b/Tests/routine_gang.cpp index 24dc284..6bbd87d 100644 --- a/Tests/routine_gang.cpp +++ b/Tests/routine_gang.cpp @@ -42,7 +42,7 @@ real_t called_function_seq(real_t ** a, int x, long long n){ return returned; } -#pragma acc routine gang +#pragma acc routine seq real_t called_function_gang(real_t ** a, int x, long long n){ real_t returned = 0; real_t* itemized_return = new real_t[((int) (n/10))]; //Lol From e5fdda1748a16292c3702c37c67d9b2fc6df6a40 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 08:20:46 -0800 Subject: [PATCH 13/37] adding missing reduction variable initialization --- Tests/parallel_reduction.c | 2 +- Tests/parallel_reduction.cpp | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Tests/parallel_reduction.c b/Tests/parallel_reduction.c index 506fbc3..0d5570d 100644 --- a/Tests/parallel_reduction.c +++ b/Tests/parallel_reduction.c @@ -5,7 +5,7 @@ int test1(){ int err = 0; srand(SEED); real_t * a = (real_t *)malloc(n * sizeof(real_t)); - real_t reduction; + real_t reduction = 0.0; for (int x = 0; x < n; ++x){ a[x] = rand() / (real_t)(RAND_MAX / 10); diff --git a/Tests/parallel_reduction.cpp b/Tests/parallel_reduction.cpp index 80cbfb4..4fef7fa 100644 --- a/Tests/parallel_reduction.cpp +++ b/Tests/parallel_reduction.cpp @@ -5,7 +5,7 @@ int test1(){ int err = 0; srand(SEED); real_t * a = new real_t[n]; - real_t reduction; + real_t reduction = 0.0; for (int x = 0; x < n; ++x){ a[x] = rand() / (real_t)(RAND_MAX / 10); From 2b90cc184894e6745a571870dd5e0f4b8cfb5c08 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 08:22:21 -0800 Subject: [PATCH 14/37] fixing some typos --- Tests/parallel_create_zero.c | 4 ++-- Tests/parallel_create_zero.cpp | 4 ++-- Tests/parallel_if.cpp | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/Tests/parallel_create_zero.c b/Tests/parallel_create_zero.c index 33c88e7..5ab5717 100644 --- a/Tests/parallel_create_zero.c +++ b/Tests/parallel_create_zero.c @@ -12,7 +12,7 @@ int Test1(){ b[x] = 0.0; } - #pragma acc data copyin(a[0:n]) copyout(b[0:n] + #pragma acc data copyin(a[0:n]) copyout(b[0:n]) { #pragma acc parallel create(zero: b[0:n]) { @@ -47,4 +47,4 @@ int main(){ } #endif return failcode; -} \ No newline at end of file +} diff --git a/Tests/parallel_create_zero.cpp b/Tests/parallel_create_zero.cpp index 8464874..b43cce2 100644 --- a/Tests/parallel_create_zero.cpp +++ b/Tests/parallel_create_zero.cpp @@ -12,7 +12,7 @@ int Test1(){ b[x] = 0.0; } - #pragma acc data copyin(a[0:n]) copyout(b[0:n] + #pragma acc data copyin(a[0:n]) copyout(b[0:n]) { #pragma acc parallel create(zero: b[0:n]) { @@ -47,4 +47,4 @@ int main(){ } #endif return failcode; -} \ No newline at end of file +} diff --git a/Tests/parallel_if.cpp b/Tests/parallel_if.cpp index 7682b16..e952b7c 100644 --- a/Tests/parallel_if.cpp +++ b/Tests/parallel_if.cpp @@ -52,7 +52,7 @@ int test2(){ dev_test[0] = 0; } - if (devtest[0] != 0){ + if (dev_test[0] != 0){ for (int x = 0; x < n; ++x){ a[x] = rand() / (real_t)(RAND_MAX / 10); b[x] = rand() / (real_t)(RAND_MAX / 10); From 21f9c80ea53f38ec9b6bb54cd9e4925565ebf0f2 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 08:24:51 -0800 Subject: [PATCH 15/37] acc routine (fmin) is unnecessary --- Tests/kernels_loop_reduction_min_general.cpp | 1 - Tests/serial_loop_reduction_min_general.cpp | 1 - 2 files changed, 2 deletions(-) diff --git a/Tests/kernels_loop_reduction_min_general.cpp b/Tests/kernels_loop_reduction_min_general.cpp index 8b1e492..154245a 100644 --- a/Tests/kernels_loop_reduction_min_general.cpp +++ b/Tests/kernels_loop_reduction_min_general.cpp @@ -1,5 +1,4 @@ #include "acc_testsuite.h" -#pragma acc routine (fmin) seq #ifndef T1 //T1:kernels,loop,reduction,combined-constructs,V:1.0-2.7 diff --git a/Tests/serial_loop_reduction_min_general.cpp b/Tests/serial_loop_reduction_min_general.cpp index 89c6f9c..8bd1f54 100644 --- a/Tests/serial_loop_reduction_min_general.cpp +++ b/Tests/serial_loop_reduction_min_general.cpp @@ -1,5 +1,4 @@ #include "acc_testsuite.h" -#pragma acc routine (fmin) seq #ifndef T1 //T1:serial,loop,reduction,combined-constructs,V:2.6-2.7 From 4ad176a224e1e1bf9d70f1b40966ba9e67a0d1a5 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 08:27:26 -0800 Subject: [PATCH 16/37] fixing a bug in the test checks for kernels_if.*; also updating F90 test for refactored devtest --- Tests/kernels_if.F90 | 38 +++++--------------------------------- Tests/kernels_if.c | 7 +++---- Tests/kernels_if.cpp | 7 +++---- 3 files changed, 11 insertions(+), 41 deletions(-) diff --git a/Tests/kernels_if.F90 b/Tests/kernels_if.F90 index d12f816..b580700 100644 --- a/Tests/kernels_if.F90 +++ b/Tests/kernels_if.F90 @@ -1,3 +1,5 @@ +#include "common.Fh" + #ifndef T1 !T1:devonly,kernels,if,V:2.0-2.7 LOGICAL FUNCTION test1() @@ -6,14 +8,7 @@ LOGICAL FUNCTION test1() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b !Data INTEGER :: errors = 0 - LOGICAL,DIMENSION(1):: devtest LOGICAL:: data_on_device = .FALSE. - devtest(1) = .TRUE. - - !$acc enter data copyin(devtest(1:1)) - !$acc kernels present(devtest(1:1)) - devtest(1) = .FALSE. - !$acc end kernels !Initilization SEEDDIM(1) = 1 @@ -53,14 +48,7 @@ LOGICAL FUNCTION test2() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b !Data INTEGER :: errors = 0 - LOGICAL,DIMENSION(1):: devtest LOGICAL:: data_on_device = .FALSE. - devtest(1) = .TRUE. - - !$acc enter data copyin(devtest(1:1)) - !$acc kernels present(devtest(1:1)) - devtest(1) = .FALSE. - !$acc end kernels !Initilization SEEDDIM(1) = 1 @@ -103,14 +91,7 @@ LOGICAL FUNCTION test3() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b !Data INTEGER :: errors = 0 - LOGICAL,DIMENSION(1):: devtest LOGICAL:: data_on_device = .FALSE. - devtest(1) = .TRUE. - - !$acc enter data copyin(devtest(1:1)) - !$acc kernels present(devtest(1:1)) - devtest(1) = .FALSE. - !$acc end kernels !Initilization SEEDDIM(1) = 1 @@ -119,10 +100,11 @@ LOGICAL FUNCTION test3() # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eqv. .TRUE.) THEN + IF (devtest() .eqv. .TRUE.) THEN CALL RANDOM_NUMBER(a) b = 0 + data_on_device = .TRUE. !$acc enter data copyin(a(1:LOOPCOUNT)) create(b(1:LOOPCOUNT)) DO x = 1, LOOPCOUNT a(x) = -1 @@ -136,9 +118,6 @@ LOGICAL FUNCTION test3() !$acc end kernels DO x = 1, LOOPCOUNT - IF (abs(a(x) + 1) .gt. PRECISION) THEN - errors = errors + 1 - END IF IF (abs(b(x)) .gt. PRECISION) THEN errors = errors + 1 END IF @@ -169,14 +148,7 @@ LOGICAL FUNCTION test4() INTEGER :: x !Iterators REAL(8),DIMENSION(LOOPCOUNT):: a, b !Data INTEGER :: errors = 0 - LOGICAL,DIMENSION(1):: devtest LOGICAL:: data_on_device = .FALSE. - devtest(1) = .TRUE. - - !$acc enter data copyin(devtest(1:1)) - !$acc kernels present(devtest(1:1)) - devtest(1) = .FALSE. - !$acc end kernels !Initilization SEEDDIM(1) = 1 @@ -185,7 +157,7 @@ LOGICAL FUNCTION test4() # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) b = 0 diff --git a/Tests/kernels_if.c b/Tests/kernels_if.c index ad4decd..e74d14d 100644 --- a/Tests/kernels_if.c +++ b/Tests/kernels_if.c @@ -80,6 +80,8 @@ int test3(){ devtest[0] = 1; #pragma acc enter data copyin(devtest[0:1]) + data_on_device = 1; + #pragma acc parallel present(devtest[0:1]) { devtest[0] = 0; @@ -105,10 +107,7 @@ int test3(){ } } for (int x = 0; x < n; ++x){ - if (fabs(a[x] + 1) > PRECISION){ - err += 1; - } - if (fabs(b[x] + 1) > PRECISION){ + if (fabs(b[x]) > PRECISION){ err += 1; } } diff --git a/Tests/kernels_if.cpp b/Tests/kernels_if.cpp index 8efdc4c..b4eb7ae 100644 --- a/Tests/kernels_if.cpp +++ b/Tests/kernels_if.cpp @@ -80,6 +80,8 @@ int test3(){ devtest[0] = 1; #pragma acc enter data copyin(devtest[0:1]) + data_on_device = 1; + #pragma acc parallel present(devtest[0:1]) { devtest[0] = 0; @@ -105,10 +107,7 @@ int test3(){ } } for (int x = 0; x < n; ++x){ - if (fabs(a[x] + 1) > PRECISION){ - err += 1; - } - if (fabs(b[x] + 1) > PRECISION){ + if (fabs(b[x]) > PRECISION){ err += 1; } } From 95fe15deea2f2b97d7b5cafc275478d1e9d87b09 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 08:42:10 -0800 Subject: [PATCH 17/37] adding missing allocations to C/C++ declare_function_scope_* tests --- Tests/declare_function_scope_copy.c | 9 +++++++++ Tests/declare_function_scope_copy.cpp | 9 +++++++++ Tests/declare_function_scope_copyin.c | 8 ++++++++ Tests/declare_function_scope_copyin.cpp | 8 ++++++++ Tests/declare_function_scope_copyout.c | 9 +++++++++ Tests/declare_function_scope_copyout.cpp | 9 +++++++++ Tests/declare_function_scope_create.c | 8 ++++++++ Tests/declare_function_scope_create.cpp | 8 ++++++++ Tests/declare_function_scope_deviceptr.c | 4 ++++ Tests/declare_function_scope_deviceptr.cpp | 4 ++++ Tests/declare_function_scope_present.c | 4 ++++ Tests/declare_function_scope_present.cpp | 4 ++++ 12 files changed, 84 insertions(+) diff --git a/Tests/declare_function_scope_copy.c b/Tests/declare_function_scope_copy.c index 9ccb5ca..857baa8 100644 --- a/Tests/declare_function_scope_copy.c +++ b/Tests/declare_function_scope_copy.c @@ -58,6 +58,9 @@ int test2(){ real_t ** c = (real_t **)malloc(n * sizeof(real_t)); for (int x = 0; x < n; ++x){ + a[x] = (real_t *)malloc(n * sizeof(real_t)); + b[x] = (real_t *)malloc(n * sizeof(real_t)); + c[x] = (real_t *)malloc(n * sizeof(real_t)); for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); @@ -106,6 +109,9 @@ int test3(){ if (devtest[0] == 1){ for (int x = 0; x < n; ++x){ + a[x] = (real_t *)malloc(n * sizeof(real_t)); + b[x] = (real_t *)malloc(n * sizeof(real_t)); + c[x] = (real_t *)malloc(n * sizeof(real_t)); for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); @@ -157,6 +163,9 @@ int test4(){ if (devtest[1] == 1){ for (int x = 0; x < n; ++x){ + a[x] = (real_t *)malloc(n * sizeof(real_t)); + b[x] = (real_t *)malloc(n * sizeof(real_t)); + c[x] = (real_t *)malloc(n * sizeof(real_t)); for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); diff --git a/Tests/declare_function_scope_copy.cpp b/Tests/declare_function_scope_copy.cpp index 1aecfe6..f80a73a 100644 --- a/Tests/declare_function_scope_copy.cpp +++ b/Tests/declare_function_scope_copy.cpp @@ -58,6 +58,9 @@ int test2(){ real_t ** c = (real_t **)malloc(n * sizeof(real_t)); for (int x = 0; x < n; ++x){ + a[x] = new real_t[n]; + b[x] = new real_t[n]; + c[x] = new real_t[n]; for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); @@ -106,6 +109,9 @@ int test3(){ if (devtest[0] == 1){ for (int x = 0; x < n; ++x){ + a[x] = new real_t[n]; + b[x] = new real_t[n]; + c[x] = new real_t[n]; for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); @@ -157,6 +163,9 @@ int test4(){ if (devtest[1] == 1){ for (int x = 0; x < n; ++x){ + a[x] = new real_t[n]; + b[x] = new real_t[n]; + c[x] = new real_t[n]; for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); diff --git a/Tests/declare_function_scope_copyin.c b/Tests/declare_function_scope_copyin.c index ca776a2..17f914f 100644 --- a/Tests/declare_function_scope_copyin.c +++ b/Tests/declare_function_scope_copyin.c @@ -83,6 +83,9 @@ int test2(){ if (devtest[0] == 1){ for (int x = 0; x < n; ++x){ + a[x] = (real_t *)malloc(n * sizeof(real_t)); + b[x] = (real_t *)malloc(n * sizeof(real_t)); + c[x] = (real_t *)malloc(n * sizeof(real_t)); a_host[x] = (real_t *)malloc(n * sizeof(real_t)); b_host[x] = (real_t *)malloc(n * sizeof(real_t)); for (int y = 0; y < n; ++y){ @@ -141,6 +144,11 @@ int test3(){ if (devtest[0] == 1){ for (int x = 0; x < n; ++x){ + a[x] = (real_t *)malloc(n * sizeof(real_t)); + b[x] = (real_t *)malloc(n * sizeof(real_t)); + c[x] = (real_t *)malloc(n * sizeof(real_t)); + a_host[x] = (real_t *)malloc(n * sizeof(real_t)); + b_host[x] = (real_t *)malloc(n * sizeof(real_t)); for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); a_host[x][y] = a[x][y]; diff --git a/Tests/declare_function_scope_copyin.cpp b/Tests/declare_function_scope_copyin.cpp index 766a34c..7de26e6 100644 --- a/Tests/declare_function_scope_copyin.cpp +++ b/Tests/declare_function_scope_copyin.cpp @@ -83,6 +83,9 @@ int test2(){ if (devtest[0] == 1){ for (int x = 0; x < n; ++x){ + a[x] = new real_t[n]; + b[x] = new real_t[n]; + c[x] = new real_t[n]; a_host[x] = new real_t[n]; b_host[x] = new real_t[n]; for (int y = 0; y < n; ++y){ @@ -141,6 +144,11 @@ int test3(){ if (devtest[0] == 1){ for (int x = 0; x < n; ++x){ + a[x] = new real_t[n]; + b[x] = new real_t[n]; + c[x] = new real_t[n]; + a_host[x] = new real_t[n]; + b_host[x] = new real_t[n]; for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); a_host[x][y] = a[x][y]; diff --git a/Tests/declare_function_scope_copyout.c b/Tests/declare_function_scope_copyout.c index 3209735..90ea5f4 100644 --- a/Tests/declare_function_scope_copyout.c +++ b/Tests/declare_function_scope_copyout.c @@ -58,6 +58,9 @@ int test2(){ real_t ** c = (real_t **)malloc(n * sizeof(real_t)); for (int x = 0; x < n; ++x){ + a[x] = (real_t *)malloc(n * sizeof(real_t)); + b[x] = (real_t *)malloc(n * sizeof(real_t)); + c[x] = (real_t *)malloc(n * sizeof(real_t)); for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); @@ -106,6 +109,9 @@ int test3(){ if (devtest[0] == 1){ for (int x = 0; x < n; ++x){ + a[x] = (real_t *)malloc(n * sizeof(real_t)); + b[x] = (real_t *)malloc(n * sizeof(real_t)); + c[x] = (real_t *)malloc(n * sizeof(real_t)); for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); @@ -157,6 +163,9 @@ int test4(){ if (devtest[0] == 1){ for (int x = 0; x < n; ++x){ + a[x] = (real_t *)malloc(n * sizeof(real_t)); + b[x] = (real_t *)malloc(n * sizeof(real_t)); + c[x] = (real_t *)malloc(n * sizeof(real_t)); for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); diff --git a/Tests/declare_function_scope_copyout.cpp b/Tests/declare_function_scope_copyout.cpp index 8788c9a..6f665eb 100644 --- a/Tests/declare_function_scope_copyout.cpp +++ b/Tests/declare_function_scope_copyout.cpp @@ -58,6 +58,9 @@ int test2(){ real_t ** c = (real_t **)malloc(n * sizeof(real_t)); for (int x = 0; x < n; ++x){ + a[x] = new real_t[n]; + b[x] = new real_t[n]; + c[x] = new real_t[n]; for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); @@ -106,6 +109,9 @@ int test3(){ if (devtest[0] == 1){ for (int x = 0; x < n; ++x){ + a[x] = new real_t[n]; + b[x] = new real_t[n]; + c[x] = new real_t[n]; for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); @@ -157,6 +163,9 @@ int test4(){ if (devtest[0] == 1){ for (int x = 0; x < n; ++x){ + a[x] = new real_t[n]; + b[x] = new real_t[n]; + c[x] = new real_t[n]; for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); diff --git a/Tests/declare_function_scope_create.c b/Tests/declare_function_scope_create.c index 967835b..acd14fb 100644 --- a/Tests/declare_function_scope_create.c +++ b/Tests/declare_function_scope_create.c @@ -81,6 +81,10 @@ int test2(){ real_t ** d = (real_t **)malloc(n * sizeof(real_t)); for (int x = 0; x < n; ++x){ + a[x] = (real_t *)malloc(n * sizeof(real_t)); + b[x] = (real_t *)malloc(n * sizeof(real_t)); + c[x] = (real_t *)malloc(n * sizeof(real_t)); + d[x] = (real_t *)malloc(n * sizeof(real_t)); for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); @@ -131,6 +135,10 @@ int test3(){ if (devtest[0] == 1){ for (int x = 0; x < n; ++x){ + a[x] = (real_t *)malloc(n * sizeof(real_t)); + b[x] = (real_t *)malloc(n * sizeof(real_t)); + c[x] = (real_t *)malloc(n * sizeof(real_t)); + d[x] = (real_t *)malloc(n * sizeof(real_t)); for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); diff --git a/Tests/declare_function_scope_create.cpp b/Tests/declare_function_scope_create.cpp index c58ee73..a6dc77f 100644 --- a/Tests/declare_function_scope_create.cpp +++ b/Tests/declare_function_scope_create.cpp @@ -81,6 +81,10 @@ int test2(){ real_t ** d = (real_t **)malloc(n * sizeof(real_t)); for (int x = 0; x < n; ++x){ + a[x] = new real_t[n]; + b[x] = new real_t[n]; + c[x] = new real_t[n]; + d[x] = new real_t[n]; for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); @@ -131,6 +135,10 @@ int test3(){ if (devtest[0] == 1){ for (int x = 0; x < n; ++x){ + a[x] = new real_t[n]; + b[x] = new real_t[n]; + c[x] = new real_t[n]; + d[x] = new real_t[n]; for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); diff --git a/Tests/declare_function_scope_deviceptr.c b/Tests/declare_function_scope_deviceptr.c index 6f5e0bc..a9f1f82 100644 --- a/Tests/declare_function_scope_deviceptr.c +++ b/Tests/declare_function_scope_deviceptr.c @@ -83,6 +83,10 @@ int test2(){ if (devtest[0] == 1){ for (int x = 0; x < n; ++x){ + a[x] = (real_t *)malloc(n * sizeof(real_t)); + b[x] = (real_t *)malloc(n * sizeof(real_t)); + c[x] = (real_t *)malloc(n * sizeof(real_t)); + d[x] = (real_t *)malloc(n * sizeof(real_t)); for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); diff --git a/Tests/declare_function_scope_deviceptr.cpp b/Tests/declare_function_scope_deviceptr.cpp index 7ef419d..9bf977c 100644 --- a/Tests/declare_function_scope_deviceptr.cpp +++ b/Tests/declare_function_scope_deviceptr.cpp @@ -83,6 +83,10 @@ int test2(){ if (devtest[0] == 1){ for (int x = 0; x < n; ++x){ + a[x] = new real_t[n]; + b[x] = new real_t[n]; + c[x] = new real_t[n]; + d[x] = new real_t[n]; for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); diff --git a/Tests/declare_function_scope_present.c b/Tests/declare_function_scope_present.c index ad2cb33..3864f2b 100644 --- a/Tests/declare_function_scope_present.c +++ b/Tests/declare_function_scope_present.c @@ -82,6 +82,10 @@ int test2(){ if (devtest[0] == 1){ for (int x = 0; x < n; ++x){ + a[x] = (real_t *)malloc(n * sizeof(real_t)); + b[x] = (real_t *)malloc(n * sizeof(real_t)); + c[x] = (real_t *)malloc(n * sizeof(real_t)); + d[x] = (real_t *)malloc(n * sizeof(real_t)); for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); diff --git a/Tests/declare_function_scope_present.cpp b/Tests/declare_function_scope_present.cpp index 0212cd4..dbff29f 100644 --- a/Tests/declare_function_scope_present.cpp +++ b/Tests/declare_function_scope_present.cpp @@ -82,6 +82,10 @@ int test2(){ if (devtest[0] == 1){ for (int x = 0; x < n; ++x){ + a[x] = new real_t[n]; + b[x] = new real_t[n]; + c[x] = new real_t[n]; + d[x] = new real_t[n]; for (int y = 0; y < n; ++y){ a[x][y] = rand() / (real_t)(RAND_MAX / 10); b[x][y] = rand() / (real_t)(RAND_MAX / 10); From d9491cfc3a91e47e31ec69394ac0c50cb5334a03 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 08:45:34 -0800 Subject: [PATCH 18/37] removing some duplicate declarations and macros in acc_testsuite_declare.h and fixing associated tests --- Tests/acc_testsuite_declare.h | 37 ++--------------------------------- Tests/declare_copyin.c | 2 +- Tests/declare_copyin.cpp | 2 +- Tests/declare_create.c | 3 ++- Tests/declare_create.cpp | 1 + 5 files changed, 7 insertions(+), 38 deletions(-) diff --git a/Tests/acc_testsuite_declare.h b/Tests/acc_testsuite_declare.h index 497c757..121049a 100644 --- a/Tests/acc_testsuite_declare.h +++ b/Tests/acc_testsuite_declare.h @@ -25,15 +25,13 @@ /* General */ /**********************************************************/ -#define ARRAYSIZE 250 -long long n = ARRAYSIZE; #define PRECISION 1e-8 typedef double real_t; #ifdef DECLARE_TEST int fixed_size_array[10] = {0, 1, 4, 9, 16, 25, 36, 49, 64, 81}; real_t* datapointer; -int scalar_extern = 10; //For global scalar tests +int scalar = 10; //For global scalar tests #endif #ifdef DECLARE_COPYIN @@ -90,44 +88,13 @@ void extern_multiplyData_deviceptr(int mult, long long n){ } #endif -#ifdef __cplusplus -template -class data_container{ - public: - acctype* data; - size_t length; - inline acctype& operator[](int i){ - return this->data[i]; - } - acctype* get_data(){ - return this->data; - } - data_container(int size){ - this->length = size; - this->data = (acctype *)malloc(size * sizeof(acctype)); - } - ~data_container(){ - free(data); - } -}; -#else -typedef enum { false, true } bool; -#endif - -#define ARRAYSIZE_NEW 1024 #define ARRAYSIZE_SMALL 10 #define REPETITIONS 1 -#define LOOPCOUNT 1000 /* following times are in seconds */ #define SLEEPTIME 0.01 #define SLEEPTIME_LONG 0.5 -typedef struct { - double real; - double imag; -} dcomplex; - #endif @@ -143,4 +110,4 @@ typedef struct { // int testrun; // int failed; // return failcode; -// } \ No newline at end of file +// } diff --git a/Tests/declare_copyin.c b/Tests/declare_copyin.c index 163c224..820dd16 100644 --- a/Tests/declare_copyin.c +++ b/Tests/declare_copyin.c @@ -1,8 +1,8 @@ #define DECLARE_TEST #define DECLARE_COPYIN int mult_copyin = 2; -#include "acc_testsuite_declare.h" #include "acc_testsuite.h" +#include "acc_testsuite_declare.h" #pragma acc declare copyin(fixed_size_array) #pragma acc declare copyin(scalar) diff --git a/Tests/declare_copyin.cpp b/Tests/declare_copyin.cpp index 3613683..7787f0f 100644 --- a/Tests/declare_copyin.cpp +++ b/Tests/declare_copyin.cpp @@ -1,8 +1,8 @@ #define DECLARE_TEST #define DECLARE_COPYIN int mult_copyin = 2; -#include "acc_testsuite_declare.h" #include "acc_testsuite.h" +#include "acc_testsuite_declare.h" #pragma acc declare copyin(fixed_size_array) #pragma acc declare copyin(scalar) diff --git a/Tests/declare_create.c b/Tests/declare_create.c index 738361e..e9516a1 100644 --- a/Tests/declare_create.c +++ b/Tests/declare_create.c @@ -1,4 +1,5 @@ #define DECLARE_CREATE 1 +#include "acc_testsuite.h" #include "acc_testsuite_declare.h" real_t scalar = 2; real_t* a; @@ -308,4 +309,4 @@ int main(){ #endif free(a); return failcode; -} \ No newline at end of file +} diff --git a/Tests/declare_create.cpp b/Tests/declare_create.cpp index 2928c22..7eee107 100644 --- a/Tests/declare_create.cpp +++ b/Tests/declare_create.cpp @@ -1,4 +1,5 @@ #define DECLARE_CREATE 1 +#include "acc_testsuite.h" #include "acc_testsuite_declare.h" real_t scalar = 2; real_t* a; From 68b6cd22cad822fceeeaf101f31628567bd7673a Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 08:48:46 -0800 Subject: [PATCH 19/37] major edits to declare_copyin/create.F90 so that a separate module file isn't needed, and some misc fixes --- Tests/declare_copyin.F90 | 42 ++++++++++++++++++++++--------- Tests/declare_create.F90 | 54 ++++++++++++++++++++++++++++------------ 2 files changed, 68 insertions(+), 28 deletions(-) diff --git a/Tests/declare_copyin.F90 b/Tests/declare_copyin.F90 index 0c842d7..c2cd7f5 100644 --- a/Tests/declare_copyin.F90 +++ b/Tests/declare_copyin.F90 @@ -1,12 +1,31 @@ +MODULE DECLARE_COPYIN_MOD + INTEGER,DIMENSION(10):: fixed_size_array + !$acc declare copyin(fixed_size_array) + + public :: externMultiplyData +contains +SUBROUTINE externMultiplyData(a, n) !$acc routine vector -FUNCTION multiplyData(a) - REAL(8),DIMENSION(LOOPCOUNT), INTENT(INOUT) :: a + INTEGER :: n + REAL(8),DIMENSION(n), INTENT(INOUT) :: a INTEGER :: x !$acc loop vector - DO x = 1, LOOPCOUNT + DO x = 1, n + a(x) = a(x) * 2 + END DO +END SUBROUTINE externMultiplyData +END MODULE DECLARE_COPYIN_MOD + +SUBROUTINE multiplyData(a, n) + !$acc routine vector + INTEGER, INTENT(IN) :: n + REAL(8),DIMENSION(n), INTENT(INOUT) :: a + INTEGER :: x + !$acc loop vector + DO x = 1, n a(x) = a(x) * 2 END DO -END FUNCTION multiplyData +END SUBROUTINE multiplyData #ifndef T1 !T1:construct-independent,declare,V:2.0-2.7 @@ -60,6 +79,9 @@ LOGICAL FUNCTION test2() INCLUDE "acc_testsuite.Fh" INTEGER :: errors = 0 INTEGER :: mult = 2 + INTEGER :: scalar = 10 + !$acc declare copyin(scalar) + INTEGER :: x REAL(8),DIMENSION(LOOPCOUNT) :: a, b SEEDDIM(1) = 1 @@ -102,6 +124,7 @@ LOGICAL FUNCTION test3() INCLUDE "acc_testsuite.Fh" INTEGER :: errors = 0 INTEGER :: mult = 2 + INTEGER :: x REAL(8),DIMENSION(LOOPCOUNT) :: a, b SEEDDIM(1) = 1 @@ -115,10 +138,7 @@ LOGICAL FUNCTION test3() !$acc data copy(a(1:LOOPCOUNT)) !$acc parallel - !$acc loop - DO x = 1, 1 - CALL externMultiplyData(a, LOOPCOUNT) - END DO + call externMultiplyData(a, LOOPCOUNT) !$acc end parallel !$acc end data @@ -144,6 +164,7 @@ LOGICAL FUNCTION test4() INCLUDE "acc_testsuite.Fh" INTEGER :: errors = 0 INTEGER :: mult = 2 + INTEGER :: x REAL(8),DIMENSION(LOOPCOUNT) :: a, b SEEDDIM(1) = 1 @@ -157,10 +178,7 @@ LOGICAL FUNCTION test4() !$acc data copy(a(1:LOOPCOUNT)) !$acc parallel - !$acc loop - DO x = 1, 1 - CALL multiplyData(a) - END DO + CALL multiplyData(a, LOOPCOUNT) !$acc end parallel !$acc end data diff --git a/Tests/declare_create.F90 b/Tests/declare_create.F90 index 9d59014..31fe9e0 100644 --- a/Tests/declare_create.F90 +++ b/Tests/declare_create.F90 @@ -1,24 +1,49 @@ -!$acc declare create(fixed_size_array) -!$acc declare create(scalar) -!$acc declare create(LOOPCOUNT) +MODULE DECLARE_COPYIN_MOD + INTEGER,DIMENSION(10):: fixed_size_array + !$acc declare create(fixed_size_array) -FUNCTION multiplyData(a) - REAL(8),DIMENSION(LOOPCOUNT), INTENT(INOUT) :: a + INTEGER :: scalar = 2 + !$acc declare create (scalar) + + + + public :: externMultiplyData +contains +SUBROUTINE externMultiplyData(a, n) +!$acc routine vector + INTEGER :: n + REAL(8),DIMENSION(n), INTENT(INOUT) :: a + INTEGER :: x !$acc loop vector - DO x = 1, LOOPCOUNT + DO x = 1, n a(x) = a(x) * 2 END DO -END FUNCTION multiplyData +END SUBROUTINE externMultiplyData +END MODULE DECLARE_COPYIN_MOD + +SUBROUTINE multiplyData(a, n) + !$acc routine vector + INTEGER, INTENT(IN) :: n + REAL(8),DIMENSION(n), INTENT(INOUT) :: a + INTEGER :: x + !$acc loop vector + DO x = 1, n + a(x) = a(x) * 2 + END DO +END SUBROUTINE multiplyData + #ifndef T1 !T1:construct-independent,declare,update,V:2.0-2.7 LOGICAL FUNCTION test1() USE OPENACC + USE DECLARE_COPYIN_MOD IMPLICIT NONE INCLUDE "acc_testsuite.Fh" INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT) :: a, b + INTEGER :: x SEEDDIM(1) = 1 # ifdef SEED @@ -28,7 +53,6 @@ LOGICAL FUNCTION test1() CALL RANDOM_NUMBER(a) b = 0 - !$acc update device(n) !$acc data copyin(a(1:LOOPCOUNT)) copyout(b(1:LOOPCOUNT)) present(fixed_size_array) !$acc parallel !$acc loop @@ -61,11 +85,13 @@ LOGICAL FUNCTION test1() !T2:construct-independent,declare,update,V:2.0-2.7 LOGICAL FUNCTION test2() USE OPENACC + USE DECLARE_COPYIN_MOD IMPLICIT NONE INCLUDE "acc_testsuite.Fh" INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT) :: a, b + INTEGER :: x SEEDDIM(1) = 1 # ifdef SEED @@ -103,11 +129,13 @@ LOGICAL FUNCTION test2() !T3:construct-independent,declare,V:2.0-2.7 LOGICAL FUNCTION test3() USE OPENACC + USE DECLARE_COPYIN_MOD IMPLICIT NONE INCLUDE "acc_testsuite.Fh" INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT) :: a, b + INTEGER :: x SEEDDIM(1) = 1 # ifdef SEED @@ -117,13 +145,9 @@ LOGICAL FUNCTION test3() CALL RANDOM_NUMBER(a) b = a - !$acc update !$acc data copy(a(1:LOOPCOUNT)) !$acc parallel - !$acc loop - DO x = 1, 1 CALL externMultiplyData(a, LOOPCOUNT) - END DO !$acc end parallel !$acc end data @@ -149,6 +173,7 @@ LOGICAL FUNCTION test4() INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT) :: a, b + INTEGER :: x SEEDDIM(1) = 1 # ifdef SEED @@ -161,10 +186,7 @@ LOGICAL FUNCTION test4() !$acc data copy(a(1:LOOPCOUNT)) !$acc parallel - !$acc loop - DO x = 1, 1 - CALL multiplyData(a) - END DO + CALL multiplyData(a, LOOPCOUNT) !$acc end parallel !$acc end data From 2cf67f45710fa1de0c5190d999029e9cedba6fd9 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 08:51:54 -0800 Subject: [PATCH 20/37] adding array slice syntax and swapping indices around because Fortran is column-major; also updating devtest usage --- Tests/declare_function_scope_create.F90 | 45 +++++++----------------- Tests/declare_function_scope_present.F90 | 34 ++++++------------ 2 files changed, 24 insertions(+), 55 deletions(-) diff --git a/Tests/declare_function_scope_create.F90 b/Tests/declare_function_scope_create.F90 index 9b3b159..12c04ac 100644 --- a/Tests/declare_function_scope_create.F90 +++ b/Tests/declare_function_scope_create.F90 @@ -1,4 +1,6 @@ -FUNCTION create_test(a, b, c, d, LOOPCOUNT) +#include "common.Fh" + +SUBROUTINE create_test(a, b, c, d, LOOPCOUNT) REAL(8),DIMENSION(LOOPCOUNT),INTENT(IN) :: a, b REAL(8),DIMENSION(LOOPCOUNT),INTENT(INOUT) :: c, d INTEGER,INTENT(IN) :: LOOPCOUNT @@ -15,9 +17,9 @@ FUNCTION create_test(a, b, c, d, LOOPCOUNT) d(x) = c(x) * a(x) END DO !$acc end parallel -END FUNCTION function_test +END SUBROUTINE create_test -FUNCTION create_as_present(a, b, c, d, LOOPCOUNT) +SUBROUTINE create_as_present(a, b, c, d, LOOPCOUNT) REAL(8),DIMENSION(LOOPCOUNT),INTENT(IN) :: a, b REAL(8),DIMENSION(LOOPCOUNT),INTENT(INOUT) :: c, d INTEGER,INTENT(IN) :: LOOPCOUNT @@ -34,7 +36,7 @@ FUNCTION create_as_present(a, b, c, d, LOOPCOUNT) d(x) = c(x) * a(x) END DO !$acc end parallel -END FUNCTION function_test_dev_only +END SUBROUTINE create_as_present #ifndef T1 !T1:devonly,construct-independent,declare,V:2.0-2.7 @@ -45,15 +47,8 @@ LOGICAL FUNCTION test1() INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT, LOOPCOUNT) :: a, b, c, d - INTEGER,DIMENSION(1) :: devtest INTEGER :: x, y - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED @@ -67,7 +62,7 @@ LOGICAL FUNCTION test1() !$acc data copyin(a(1:LOOPCOUNT, 1:LOOPCOUNT), b(1:LOOPCOUNT, 1:LOOPCOUNT)) copyout(d(1:LOOPCOUNT, 1:LOOPCOUNT)) DO x = 1, LOOPCOUNT - CALL create_test(a(x), b(x), c(x), d(x), LOOPCOUNT) + CALL create_test(a(:,x), b(:,x), c(:,x), d(:,x), LOOPCOUNT) END DO !$acc end data @@ -95,15 +90,8 @@ LOGICAL FUNCTION test2() INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT, LOOPCOUNT) :: a, b, c, d - INTEGER,DIMENSION(1) :: devtest INTEGER :: x, y - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED @@ -117,7 +105,7 @@ LOGICAL FUNCTION test2() !$acc data copyin(a(1:LOOPCOUNT, 1:LOOPCOUNT), b(1:LOOPCOUNT, 1:LOOPCOUNT)) copy(c(1:LOOPCOUNT, 1:LOOPCOUNT)) copyout(d(1:LOOPCOUNT, 1:LOOPCOUNT)) DO x = 1, LOOPCOUNT - CALL create_as_present(a(x), b(x), c(x), d(x), LOOPCOUNT) + CALL create_as_present(a(:,x), b(:,x), c(:,x), d(:,x), LOOPCOUNT) END DO !$acc end data @@ -148,36 +136,29 @@ LOGICAL FUNCTION test3() INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT, LOOPCOUNT) :: a, b, c, d - INTEGER,DIMENSION(1) :: devtest INTEGER :: x, y - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 3 !$acc data copyin(a(1:LOOPCOUNT, 1:LOOPCOUNT), b(1:LOOPCOUNT, 1:LOOPCOUNT)) DO x = 1, LOOPCOUNT - !$acc data copyin(c(x:x, 1:LOOPCOUNT)) copyout(d(x:x, 1:LOOPCOUNT)) - CALL create_as_present(a(x), b(x), c(x), d(x), LOOPCOUNT) + !$acc data copyin(c(1:LOOPCOUNT, x:x)) copyout(d(1:LOOPCOUNT, x:x)) + CALL create_as_present(a(:,x), b(:,x), c(:,x), d(:,x), LOOPCOUNT) !$acc end data DO y = 1, LOOPCOUNT - IF (abs(c(x, y) - 3) .gt. PRECISION) THEN + IF (abs(c(y, x) - 3) .gt. PRECISION) THEN errors = errors + 1 END IF - IF (abs(d(x, y) - (a(x, y) * (3 + a(x, y) + b(x, y)))) .gt. PRECISION * 2) THEN + IF (abs(d(y, x) - (a(y, x) * (3 + a(y, x) + b(y, x)))) .gt. PRECISION * 2) THEN errors = errors + 1 END IF END DO diff --git a/Tests/declare_function_scope_present.F90 b/Tests/declare_function_scope_present.F90 index ff00243..a5e69a7 100644 --- a/Tests/declare_function_scope_present.F90 +++ b/Tests/declare_function_scope_present.F90 @@ -1,4 +1,6 @@ -FUNCTION present(a, b, c, d, LOOPCOUNT) +#include "common.Fh" + +FUNCTION present_test(a, b, c, d, LOOPCOUNT) REAL(8),DIMENSION(LOOPCOUNT),INTENT(IN) :: a, b REAL(8),DIMENSION(LOOPCOUNT),INTENT(INOUT) :: c, d INTEGER,INTENT(IN) :: LOOPCOUNT @@ -15,7 +17,7 @@ FUNCTION present(a, b, c, d, LOOPCOUNT) d(x) = c(x) * a(x) END DO !$acc end parallel -END FUNCTION function_test +END FUNCTION present_test #ifndef T1 !T1:devonly,construct-independent,declare,V:2.0-2.7 @@ -26,15 +28,8 @@ LOGICAL FUNCTION test1() INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT, LOOPCOUNT) :: a, b, c, d - INTEGER,DIMENSION(1) :: devtest INTEGER :: x, y - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED @@ -48,8 +43,8 @@ LOGICAL FUNCTION test1() !$acc data copyin(a(1:LOOPCOUNT, 1:LOOPCOUNT), b(1:LOOPCOUNT, 1:LOOPCOUNT)) copyout(d(1:LOOPCOUNT, 1:LOOPCOUNT)) DO x = 1, LOOPCOUNT - !$acc data copy(c(x:x, 1:LOOPCOUNT)) - CALL present(a(x), b(x), c(x), d(x), LOOPCOUNT) + !$acc data copy(c(1:LOOPCOUNT, x:x)) + CALL present_test(a(:,x), b(:,x), c(:,x), d(:,x), LOOPCOUNT) !$acc end data END DO !$acc end data @@ -81,36 +76,29 @@ LOGICAL FUNCTION test2() INTEGER :: errors = 0 INTEGER :: mult = 2 REAL(8),DIMENSION(LOOPCOUNT, LOOPCOUNT) :: a, b, c, d - INTEGER,DIMENSION(1) :: devtest INTEGER :: x, y - devtest(1) = 1 - !$acc enter data copyin(devtest(1:1)) - !$acc parallel present(devtest(1:1)) - devtest(1) = 0 - !$acc end parallel - SEEDDIM(1) = 1 # ifdef SEED SEEDDIM(1) = SEED # endif CALL RANDOM_SEED(PUT=SEEDDIM) - IF (devtest(1) .eq. 1) THEN + IF (devtest() .eq. .TRUE.) THEN CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) c = 3 !$acc data copyin(a(1:LOOPCOUNT, 1:LOOPCOUNT), b(1:LOOPCOUNT, 1:LOOPCOUNT)) DO x = 1, LOOPCOUNT - !$acc data copyin(c(x:x, 1:LOOPCOUNT)) copyout(d(x:x, 1:LOOPCOUNT)) - CALL present(a(x), b(x), c(x), d(x), LOOPCOUNT) + !$acc data copyin(c(1:LOOPCOUNT, x:x)) copyout(d(1:LOOPCOUNT, x:x)) + CALL present_test(a(:,x), b(:,x), c(:,x), d(:,x), LOOPCOUNT) !$acc end data DO y = 1, LOOPCOUNT - IF (abs(c(x, y) - 3) .gt. PRECISION) THEN + IF (abs(c(y, x) - 3) .gt. PRECISION) THEN errors = errors + 1 END IF - IF (abs(d(x, y) - (a(x, y) * (3 + a(x, y) + b(x, y)))) .gt. PRECISION * 2) THEN + IF (abs(d(y, x) - (a(y, x) * (3 + a(y, x) + b(y, x)))) .gt. PRECISION * 2) THEN errors = errors + 1 END IF END DO From 15911e1bd7447aa47957b274e58c539604844d0c Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 08:52:48 -0800 Subject: [PATCH 21/37] fixing loop indicies --- Tests/acc_get_device_num.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Tests/acc_get_device_num.F90 b/Tests/acc_get_device_num.F90 index f26b9f3..1740120 100644 --- a/Tests/acc_get_device_num.F90 +++ b/Tests/acc_get_device_num.F90 @@ -9,7 +9,7 @@ LOGICAL FUNCTION test1() errors = 0 IF (acc_get_device_type() .ne. acc_device_none) THEN - DO x = 1, acc_get_num_devices(acc_get_device_type()) + DO x = 0, acc_get_num_devices(acc_get_device_type())-1 CALL acc_set_device_num(x, acc_get_device_type()) IF (acc_get_device_num(acc_get_device_type()) .ne. x) THEN errors = errors + 1 From 1445751665f37be460b092be4e020b70901e8c18 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 08:53:27 -0800 Subject: [PATCH 22/37] fixing a loop index --- Tests/kernels_loop_reduction_bitor_general.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Tests/kernels_loop_reduction_bitor_general.cpp b/Tests/kernels_loop_reduction_bitor_general.cpp index c31f28d..5cf5faf 100644 --- a/Tests/kernels_loop_reduction_bitor_general.cpp +++ b/Tests/kernels_loop_reduction_bitor_general.cpp @@ -31,7 +31,7 @@ int test1(){ } - for (int x = 1; x < n; ++x){ + for (int x = 0; x < n; ++x){ host_b = host_b | a[x]; } if (b != host_b){ From a0c54f8d0213c8b10fd057e424d27c92eb94547e Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 08:54:29 -0800 Subject: [PATCH 23/37] fixing one more set of loop indicies --- Tests/acc_wait_any.c | 2 +- Tests/acc_wait_any.cpp | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Tests/acc_wait_any.c b/Tests/acc_wait_any.c index cf75f1c..28c8ffc 100644 --- a/Tests/acc_wait_any.c +++ b/Tests/acc_wait_any.c @@ -22,7 +22,7 @@ int test1() { #pragma acc data copyin(list[0:3][0:n]) { int queues[10]; - for (int i = 0; i < 2; i++) + for (int i = 0; i < 3; i++) { // Do some unbalanced operation on several queues #pragma acc enter data copyin(list[i]) async(i) diff --git a/Tests/acc_wait_any.cpp b/Tests/acc_wait_any.cpp index 9f12a43..d00c68a 100644 --- a/Tests/acc_wait_any.cpp +++ b/Tests/acc_wait_any.cpp @@ -22,7 +22,7 @@ int test1() { #pragma acc data copyin(list[0:3][0:n]) { int queues[10]; - for (int i = 0; i < 2; i++) + for (int i = 0; i < 3; i++) { // Do some unbalanced operation on several queues #pragma acc enter data copyin(list[i]) async(i) From bb3cd0a5943757ab054cc97fc9f59f24a9053d86 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 08:55:47 -0800 Subject: [PATCH 24/37] fixing a typo and adding a declare create for a global --- Tests/gang_dimensions.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Tests/gang_dimensions.c b/Tests/gang_dimensions.c index ca1b9bb..7f48a21 100644 --- a/Tests/gang_dimensions.c +++ b/Tests/gang_dimensions.c @@ -1,4 +1,5 @@ #include "acc_testsuite.h" +#pragma acc declare create(n) #ifndef T1 //T1:parallel,gang,dim,V:3.3 int test1(){ @@ -149,7 +150,7 @@ void inner_3D(real_t arr1, int n) } } -#pragma acc_routine gang(dim:1) +#pragma acc routine gang(dim:1) void middle(real_t arr1[n], int n) { #pragma acc loop gang(dim:1) From d125b88d5670aafd84fcebe2f2959d18a77e49aa Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 08:56:46 -0800 Subject: [PATCH 25/37] adding vector_length clause to force single thread gangs --- Tests/kernels_num_gangs.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Tests/kernels_num_gangs.F90 b/Tests/kernels_num_gangs.F90 index 4605fe5..8ac6ba6 100644 --- a/Tests/kernels_num_gangs.F90 +++ b/Tests/kernels_num_gangs.F90 @@ -9,13 +9,13 @@ LOGICAL FUNCTION test1() results = 0 - !$acc kernels num_gangs(8) + !$acc kernels num_gangs(8) vector_length(1) !$acc loop gang reduction(+:results) DO x = 1, LOOPCOUNT results = 1 END DO !$acc end kernels - + IF (results .ne. 8) THEN errors = errors + 1 END IF From bd37ed4a1af066dc649e6653bdcd09b43f0be0f7 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 09:48:18 -0800 Subject: [PATCH 26/37] missing pragma in acc_copyin_async.c --- Tests/acc_copyin_async.c | 1 + 1 file changed, 1 insertion(+) diff --git a/Tests/acc_copyin_async.c b/Tests/acc_copyin_async.c index f8f84e9..af2dfd4 100644 --- a/Tests/acc_copyin_async.c +++ b/Tests/acc_copyin_async.c @@ -170,6 +170,7 @@ int test4(){ } } acc_copyin_async(c, n * sizeof(real_t), 1); + #pragma acc exit data delete(c[0:n]) async(1) #pragma acc parallel present(c[0:n]) async(1) { #pragma acc loop From c0bf6cfd39d0bb29ba5693970357934f90090c00 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 10:52:16 -0800 Subject: [PATCH 27/37] shifting some pragmas around so acc_copyout_async* tests align --- Tests/acc_copyout_async.F90 | 6 +++--- Tests/acc_copyout_async_with_len.F90 | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/Tests/acc_copyout_async.F90 b/Tests/acc_copyout_async.F90 index bc9dd42..1735690 100644 --- a/Tests/acc_copyout_async.F90 +++ b/Tests/acc_copyout_async.F90 @@ -24,14 +24,14 @@ LOGICAL FUNCTION test1() !$acc enter data create(c(1:LOOPCOUNT), f(1:LOOPCOUNT)) - !$acc data copyin(a(1:LOOPCOUNT), b(1:LOOPCOUNT), d(1:LOOPCOUNT), e(1:LOOPCOUNT)) present(c(1:LOOPCOUNT), f(1:LOOPCOUNT)) - !$acc parallel async(1) + !$acc data copyin(a(1:LOOPCOUNT), b(1:LOOPCOUNT), d(1:LOOPCOUNT), e(1:LOOPCOUNT)) + !$acc parallel async(1) present(c(1:LOOPCOUNT)) !$acc loop DO x = 1, LOOPCOUNT c(x) = a(x) + b(x) END DO !$acc end parallel - !$acc parallel async(2) + !$acc parallel async(2) present(f(1:LOOPCOUNT)) !$acc loop DO x = 1, LOOPCOUNT f(x) = d(x) + e(x) diff --git a/Tests/acc_copyout_async_with_len.F90 b/Tests/acc_copyout_async_with_len.F90 index 55e0d6d..2fb4f37 100644 --- a/Tests/acc_copyout_async_with_len.F90 +++ b/Tests/acc_copyout_async_with_len.F90 @@ -24,14 +24,14 @@ LOGICAL FUNCTION test1() !$acc enter data create(c(1:LOOPCOUNT), f(1:LOOPCOUNT)) - !$acc data copyin(a(1:LOOPCOUNT), b(1:LOOPCOUNT), d(1:LOOPCOUNT), e(1:LOOPCOUNT)) present(c(1:LOOPCOUNT), f(1:LOOPCOUNT)) - !$acc parallel async(1) + !$acc data copyin(a(1:LOOPCOUNT), b(1:LOOPCOUNT), d(1:LOOPCOUNT), e(1:LOOPCOUNT)) + !$acc parallel async(1) present(c(1:LOOPCOUNT)) !$acc loop DO x = 1, LOOPCOUNT c(x) = a(x) + b(x) END DO !$acc end parallel - !$acc parallel async(2) + !$acc parallel async(2) present(f(1:LOOPCOUNT)) !$acc loop DO x = 1, LOOPCOUNT f(x) = d(x) + e(x) From ed23f08ea205824a451de0c8608b4f9d313ffe9b Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 28 Feb 2025 11:01:21 -0800 Subject: [PATCH 28/37] removing duplicate acc creates and adding a missing copyout --- Tests/acc_copyout_finalize_async.F90 | 1 - Tests/acc_copyout_finalize_async.c | 5 +---- Tests/acc_copyout_finalize_async.cpp | 5 +---- 3 files changed, 2 insertions(+), 9 deletions(-) diff --git a/Tests/acc_copyout_finalize_async.F90 b/Tests/acc_copyout_finalize_async.F90 index bc2d4ad..cafbb0e 100644 --- a/Tests/acc_copyout_finalize_async.F90 +++ b/Tests/acc_copyout_finalize_async.F90 @@ -22,7 +22,6 @@ LOGICAL FUNCTION test1() CALL RANDOM_NUMBER(e) f = 0 - !$acc enter data create(c(1:LOOPCOUNT), f(1:LOOPCOUNT)) !$acc enter data create(c(1:LOOPCOUNT), f(1:LOOPCOUNT)) !$acc data copyin(a(1:LOOPCOUNT), b(1:LOOPCOUNT), d(1:LOOPCOUNT), e(1:LOOPCOUNT)) present(c(1:LOOPCOUNT), f(1:LOOPCOUNT)) diff --git a/Tests/acc_copyout_finalize_async.c b/Tests/acc_copyout_finalize_async.c index b48a39f..e7f96c3 100644 --- a/Tests/acc_copyout_finalize_async.c +++ b/Tests/acc_copyout_finalize_async.c @@ -20,7 +20,6 @@ int test1(){ f[x] = 0; } - #pragma acc enter data create(c[0:n], f[0:n]) #pragma acc enter data create(c[0:n], f[0:n]) #pragma acc data copyin(a[0:n], b[0:n], d[0:n], e[0:n]) present(c[0:n], f[0:n]) @@ -73,7 +72,6 @@ int test2(){ c[x] = 0; } - #pragma acc enter data create(c[0:n]) #pragma acc enter data create(c[0:n]) #pragma acc data copyin(a[0:n], b[0:n]) @@ -117,7 +115,6 @@ int test3(){ c[x] = 0; } - #pragma acc enter data create(c[0:n]) #pragma acc enter data create(c[0:n]) #pragma acc data copyin(a[0:n], b[0:n]) { @@ -157,7 +154,6 @@ int test4(){ c[x] = 0; } - #pragma acc enter data create(c[0:n]) #pragma acc enter data create(c[0:n]) #pragma acc data copyin(a[0:n], b[0:n]) { @@ -177,6 +173,7 @@ int test4(){ c[x] += a[x] + b[x]; } } + acc_copyout_finalize_async(c, n * sizeof(real_t), 1); } for (int x = 0; x < n; ++x) { diff --git a/Tests/acc_copyout_finalize_async.cpp b/Tests/acc_copyout_finalize_async.cpp index f3dec43..f5ec802 100644 --- a/Tests/acc_copyout_finalize_async.cpp +++ b/Tests/acc_copyout_finalize_async.cpp @@ -20,7 +20,6 @@ int test1(){ f[x] = 0; } - #pragma acc enter data create(c[0:n], f[0:n]) #pragma acc enter data create(c[0:n], f[0:n]) #pragma acc data copyin(a[0:n], b[0:n], d[0:n], e[0:n]) present(c[0:n], f[0:n]) @@ -73,7 +72,6 @@ int test2(){ c[x] = 0; } - #pragma acc enter data create(c[0:n]) #pragma acc enter data create(c[0:n]) #pragma acc data copyin(a[0:n], b[0:n]) @@ -117,7 +115,6 @@ int test3(){ c[x] = 0; } - #pragma acc enter data create(c[0:n]) #pragma acc enter data create(c[0:n]) #pragma acc data copyin(a[0:n], b[0:n]) { @@ -157,7 +154,6 @@ int test4(){ c[x] = 0; } - #pragma acc enter data create(c[0:n]) #pragma acc enter data create(c[0:n]) #pragma acc data copyin(a[0:n], b[0:n]) { @@ -177,6 +173,7 @@ int test4(){ c[x] += a[x] + b[x]; } } + acc_copyout_finalize_async(c, n * sizeof(real_t), 1); } for (int x = 0; x < n; ++x) { From cde47fffbe3f459f23cd200e3514bec71e757922 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Mon, 3 Mar 2025 09:11:04 -0800 Subject: [PATCH 29/37] fixing array bounds in firstprivate for serial_firstprivate.c/.cpp --- Tests/serial_firstprivate.c | 4 ++-- Tests/serial_firstprivate.cpp | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/Tests/serial_firstprivate.c b/Tests/serial_firstprivate.c index ecfd5cb..2331701 100644 --- a/Tests/serial_firstprivate.c +++ b/Tests/serial_firstprivate.c @@ -21,7 +21,7 @@ int test1(){ } #pragma acc data copyin(a[0:10*n], b[0:10*n]) copy(d[0:10*n]) { - #pragma acc serial firstprivate(c[0:n]) + #pragma acc serial firstprivate(c[0:10]) { #pragma acc loop gang for (int x = 0; x < n; ++x){ @@ -67,7 +67,7 @@ int test2(){ #pragma acc data copyin(a[0:10*n], b[0:10*n]) copy(d[0:10*n]) { - #pragma acc serial firstprivate(c[0:n]) + #pragma acc serial firstprivate(c[0:10]) { #pragma acc loop gang independent for (int x = 0; x < n; ++x){ diff --git a/Tests/serial_firstprivate.cpp b/Tests/serial_firstprivate.cpp index 6fa8f34..5906e79 100644 --- a/Tests/serial_firstprivate.cpp +++ b/Tests/serial_firstprivate.cpp @@ -21,7 +21,7 @@ int test1(){ } #pragma acc data copyin(a[0:10*n], b[0:10*n]) copy(d[0:10*n]) { - #pragma acc serial firstprivate(c[0:n]) + #pragma acc serial firstprivate(c[0:10]) { #pragma acc loop gang for (int x = 0; x < n; ++x){ @@ -67,7 +67,7 @@ int test2(){ #pragma acc data copyin(a[0:10*n], b[0:10*n]) copy(d[0:10*n]) { - #pragma acc serial firstprivate(c[0:n]) + #pragma acc serial firstprivate(c[0:10]) { #pragma acc loop gang independent for (int x = 0; x < n; ++x){ From d922263c3f9cf5eceda20880ea4dc82e8900a525 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Mon, 3 Mar 2025 10:14:34 -0800 Subject: [PATCH 30/37] Revert "removing duplicate acc creates and adding a missing copyout" This reverts commit ed23f08ea205824a451de0c8608b4f9d313ffe9b. --- Tests/acc_copyout_finalize_async.F90 | 1 + Tests/acc_copyout_finalize_async.c | 5 ++++- Tests/acc_copyout_finalize_async.cpp | 5 ++++- 3 files changed, 9 insertions(+), 2 deletions(-) diff --git a/Tests/acc_copyout_finalize_async.F90 b/Tests/acc_copyout_finalize_async.F90 index cafbb0e..bc2d4ad 100644 --- a/Tests/acc_copyout_finalize_async.F90 +++ b/Tests/acc_copyout_finalize_async.F90 @@ -22,6 +22,7 @@ LOGICAL FUNCTION test1() CALL RANDOM_NUMBER(e) f = 0 + !$acc enter data create(c(1:LOOPCOUNT), f(1:LOOPCOUNT)) !$acc enter data create(c(1:LOOPCOUNT), f(1:LOOPCOUNT)) !$acc data copyin(a(1:LOOPCOUNT), b(1:LOOPCOUNT), d(1:LOOPCOUNT), e(1:LOOPCOUNT)) present(c(1:LOOPCOUNT), f(1:LOOPCOUNT)) diff --git a/Tests/acc_copyout_finalize_async.c b/Tests/acc_copyout_finalize_async.c index e7f96c3..b48a39f 100644 --- a/Tests/acc_copyout_finalize_async.c +++ b/Tests/acc_copyout_finalize_async.c @@ -20,6 +20,7 @@ int test1(){ f[x] = 0; } + #pragma acc enter data create(c[0:n], f[0:n]) #pragma acc enter data create(c[0:n], f[0:n]) #pragma acc data copyin(a[0:n], b[0:n], d[0:n], e[0:n]) present(c[0:n], f[0:n]) @@ -72,6 +73,7 @@ int test2(){ c[x] = 0; } + #pragma acc enter data create(c[0:n]) #pragma acc enter data create(c[0:n]) #pragma acc data copyin(a[0:n], b[0:n]) @@ -115,6 +117,7 @@ int test3(){ c[x] = 0; } + #pragma acc enter data create(c[0:n]) #pragma acc enter data create(c[0:n]) #pragma acc data copyin(a[0:n], b[0:n]) { @@ -154,6 +157,7 @@ int test4(){ c[x] = 0; } + #pragma acc enter data create(c[0:n]) #pragma acc enter data create(c[0:n]) #pragma acc data copyin(a[0:n], b[0:n]) { @@ -173,7 +177,6 @@ int test4(){ c[x] += a[x] + b[x]; } } - acc_copyout_finalize_async(c, n * sizeof(real_t), 1); } for (int x = 0; x < n; ++x) { diff --git a/Tests/acc_copyout_finalize_async.cpp b/Tests/acc_copyout_finalize_async.cpp index f5ec802..f3dec43 100644 --- a/Tests/acc_copyout_finalize_async.cpp +++ b/Tests/acc_copyout_finalize_async.cpp @@ -20,6 +20,7 @@ int test1(){ f[x] = 0; } + #pragma acc enter data create(c[0:n], f[0:n]) #pragma acc enter data create(c[0:n], f[0:n]) #pragma acc data copyin(a[0:n], b[0:n], d[0:n], e[0:n]) present(c[0:n], f[0:n]) @@ -72,6 +73,7 @@ int test2(){ c[x] = 0; } + #pragma acc enter data create(c[0:n]) #pragma acc enter data create(c[0:n]) #pragma acc data copyin(a[0:n], b[0:n]) @@ -115,6 +117,7 @@ int test3(){ c[x] = 0; } + #pragma acc enter data create(c[0:n]) #pragma acc enter data create(c[0:n]) #pragma acc data copyin(a[0:n], b[0:n]) { @@ -154,6 +157,7 @@ int test4(){ c[x] = 0; } + #pragma acc enter data create(c[0:n]) #pragma acc enter data create(c[0:n]) #pragma acc data copyin(a[0:n], b[0:n]) { @@ -173,7 +177,6 @@ int test4(){ c[x] += a[x] + b[x]; } } - acc_copyout_finalize_async(c, n * sizeof(real_t), 1); } for (int x = 0; x < n; ++x) { From 09c7058d383fca117726b3634a770f7362696e9a Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Mon, 3 Mar 2025 10:23:23 -0800 Subject: [PATCH 31/37] adding missing copyouts and fixing a copyout missing the finalize --- Tests/acc_copyout_finalize_async.c | 3 ++- Tests/acc_copyout_finalize_async.cpp | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/Tests/acc_copyout_finalize_async.c b/Tests/acc_copyout_finalize_async.c index b48a39f..80860c7 100644 --- a/Tests/acc_copyout_finalize_async.c +++ b/Tests/acc_copyout_finalize_async.c @@ -128,7 +128,7 @@ int test3(){ c[x] = a[x] + b[x]; } } - acc_copyout_async(c, n * sizeof(real_t), def_async_var + 1); + acc_copyout_finalize_async(c, n * sizeof(real_t), def_async_var + 1); #pragma acc wait } @@ -177,6 +177,7 @@ int test4(){ c[x] += a[x] + b[x]; } } + acc_copyout_finalize_async(c, n * sizeof(real_t), 1); } for (int x = 0; x < n; ++x) { diff --git a/Tests/acc_copyout_finalize_async.cpp b/Tests/acc_copyout_finalize_async.cpp index f3dec43..4b5d80f 100644 --- a/Tests/acc_copyout_finalize_async.cpp +++ b/Tests/acc_copyout_finalize_async.cpp @@ -128,7 +128,7 @@ int test3(){ c[x] = a[x] + b[x]; } } - acc_copyout_async(c, n * sizeof(real_t), def_async_var + 1); + acc_copyout_finalize_async(c, n * sizeof(real_t), def_async_var + 1); #pragma acc wait } @@ -177,6 +177,7 @@ int test4(){ c[x] += a[x] + b[x]; } } + acc_copyout_finalize_async(c, n * sizeof(real_t), 1); } for (int x = 0; x < n; ++x) { From 7fd9b83a57bbd755ca5336e1c3b9c7d130874f1f Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Mon, 3 Mar 2025 13:55:17 -0800 Subject: [PATCH 32/37] fixing typo, = -> == --- Tests/parallel_loop_reduction_max_general.c | 2 +- Tests/parallel_loop_reduction_max_general.cpp | 2 +- Tests/serial_loop_reduction_max_general.c | 2 +- Tests/serial_loop_reduction_max_general.cpp | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/Tests/parallel_loop_reduction_max_general.c b/Tests/parallel_loop_reduction_max_general.c index c105418..e7eb121 100644 --- a/Tests/parallel_loop_reduction_max_general.c +++ b/Tests/parallel_loop_reduction_max_general.c @@ -29,7 +29,7 @@ int test1(){ found = 1; } } - if (found = 0){ + if (found == 0){ err = 1; } diff --git a/Tests/parallel_loop_reduction_max_general.cpp b/Tests/parallel_loop_reduction_max_general.cpp index 0f05be2..d790746 100644 --- a/Tests/parallel_loop_reduction_max_general.cpp +++ b/Tests/parallel_loop_reduction_max_general.cpp @@ -29,7 +29,7 @@ int test1(){ found = 1; } } - if (found = 0){ + if (found == 0){ err = 1; } diff --git a/Tests/serial_loop_reduction_max_general.c b/Tests/serial_loop_reduction_max_general.c index 9e34345..6e6f1c7 100644 --- a/Tests/serial_loop_reduction_max_general.c +++ b/Tests/serial_loop_reduction_max_general.c @@ -29,7 +29,7 @@ int test1(){ found = 1; } } - if (found = 0){ + if (found == 0){ err = 1; } diff --git a/Tests/serial_loop_reduction_max_general.cpp b/Tests/serial_loop_reduction_max_general.cpp index cdd7ad0..ba5fc89 100644 --- a/Tests/serial_loop_reduction_max_general.cpp +++ b/Tests/serial_loop_reduction_max_general.cpp @@ -29,7 +29,7 @@ int test1(){ found = 1; } } - if (found = 0){ + if (found == 0){ err = 1; } From 34ca28728c346789f1422e1f84bc9899808f3a15 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Thu, 6 Mar 2025 13:51:26 -0800 Subject: [PATCH 33/37] correct fix for acc_wait_any this time --- Tests/acc_wait_any.c | 9 ++++----- Tests/acc_wait_any.cpp | 8 +++++--- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/Tests/acc_wait_any.c b/Tests/acc_wait_any.c index 28c8ffc..35ce2a2 100644 --- a/Tests/acc_wait_any.c +++ b/Tests/acc_wait_any.c @@ -19,10 +19,8 @@ int test1() { real_t *list[3] = {a, b, c}; - #pragma acc data copyin(list[0:3][0:n]) - { int queues[10]; - for (int i = 0; i < 3; i++) + for (int i = 0; i < 2; i++) { // Do some unbalanced operation on several queues #pragma acc enter data copyin(list[i]) async(i) @@ -37,7 +35,7 @@ int test1() { } int next; // Look for queue that is ready to process - while ((next = acc_wait_any(3, queues)) >= 0) + while ((next = acc_wait_any(2, queues)) >= 0) { // Remove this queue from consideration next time around queues[next] = acc_async_sync; @@ -50,8 +48,9 @@ int test1() { list[next][i] = list[next][i] * 2; } } + + #pragma acc exit data copyout(list[next][0:n]) async(next) } - } for (int x = 0; x < n; ++x){ if (fabs(c[x] - (a[x] + b[x])) > PRECISION){ diff --git a/Tests/acc_wait_any.cpp b/Tests/acc_wait_any.cpp index d00c68a..70c37a1 100644 --- a/Tests/acc_wait_any.cpp +++ b/Tests/acc_wait_any.cpp @@ -19,10 +19,10 @@ int test1() { real_t *list[3] = {a, b, c}; - #pragma acc data copyin(list[0:3][0:n]) + // #pragma acc data copyin(list[0:3][0:n]) { int queues[10]; - for (int i = 0; i < 3; i++) + for (int i = 0; i < 2; i++) { // Do some unbalanced operation on several queues #pragma acc enter data copyin(list[i]) async(i) @@ -37,7 +37,7 @@ int test1() { } int next; // Look for queue that is ready to process - while ((next = acc_wait_any(3, queues)) >= 0) + while ((next = acc_wait_any(2, queues)) >= 0) { // Remove this queue from consideration next time around queues[next] = acc_async_sync; @@ -50,6 +50,8 @@ int test1() { list[next][i] = list[next][i] * 2; } } + + #pragma acc exit data copyout(list[next]) async(next) } } From 24bffa6e8d0adc63bc2352d6aa9b1e38737e10b8 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Thu, 6 Mar 2025 14:54:02 -0800 Subject: [PATCH 34/37] fixing typo in parallel_create_zero --- Tests/parallel_create_zero.c | 2 +- Tests/parallel_create_zero.cpp | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Tests/parallel_create_zero.c b/Tests/parallel_create_zero.c index 5ab5717..6f42fb0 100644 --- a/Tests/parallel_create_zero.c +++ b/Tests/parallel_create_zero.c @@ -1,7 +1,7 @@ #include "acc_testsuite.h" #ifndef T1 //#T1:parallel,data,data_region,V:3.0-3.2 -int Test1(){ +int test1(){ int err=0; srand(SEED); real_t * a = (real_t *)malloc(n * sizeof(real_t)); diff --git a/Tests/parallel_create_zero.cpp b/Tests/parallel_create_zero.cpp index b43cce2..3052aab 100644 --- a/Tests/parallel_create_zero.cpp +++ b/Tests/parallel_create_zero.cpp @@ -1,7 +1,7 @@ #include "acc_testsuite.h" #ifndef T1 //#T1:parallel,data,data_region,V:3.0-3.2 -int Test1(){ +int test1(){ int err=0; srand(SEED); real_t * a = new real_t[n]; From 40d9cb1d5026a8d7bbce6045a4aceff95bb47b41 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 14 Mar 2025 09:09:04 -0700 Subject: [PATCH 35/37] modifying acc_wait_any slightly to make more use of async --- Tests/acc_wait_any.c | 4 +++- Tests/acc_wait_any.cpp | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/Tests/acc_wait_any.c b/Tests/acc_wait_any.c index 35ce2a2..b97d11b 100644 --- a/Tests/acc_wait_any.c +++ b/Tests/acc_wait_any.c @@ -41,7 +41,7 @@ int test1() { queues[next] = acc_async_sync; // Process work dependent on above - #pragma acc kernels + #pragma acc kernels async(next) { for(int i = 0; i < n; i++) { @@ -52,6 +52,8 @@ int test1() { #pragma acc exit data copyout(list[next][0:n]) async(next) } + #pragma acc wait + for (int x = 0; x < n; ++x){ if (fabs(c[x] - (a[x] + b[x])) > PRECISION){ err = 1; diff --git a/Tests/acc_wait_any.cpp b/Tests/acc_wait_any.cpp index 70c37a1..1ee5bb8 100644 --- a/Tests/acc_wait_any.cpp +++ b/Tests/acc_wait_any.cpp @@ -43,7 +43,7 @@ int test1() { queues[next] = acc_async_sync; // Process work dependent on above - #pragma acc kernels + #pragma acc kernels async(next) { for(int i = 0; i < n; i++) { @@ -55,6 +55,8 @@ int test1() { } } + #pragma acc wait + for (int x = 0; x < n; ++x){ if (fabs(c[x] - (a[x] + b[x])) > PRECISION){ err = 1; From 7cb389bfd67cb93b3b07a9fc87b9685ad6f9d129 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Fri, 14 Mar 2025 09:11:21 -0700 Subject: [PATCH 36/37] fixing misc typos, including a loop index and a couple #ifndefs --- Tests/atomic_capture_expr_and_x_assign.F90 | 2 +- Tests/kernels_loop_reduction_bitor_general.c | 2 +- Tests/parallel_loop_reduction_add_loop_type_check_pt1.c | 5 +++-- Tests/parallel_loop_reduction_add_loop_type_check_pt1.cpp | 5 +++-- 4 files changed, 8 insertions(+), 6 deletions(-) diff --git a/Tests/atomic_capture_expr_and_x_assign.F90 b/Tests/atomic_capture_expr_and_x_assign.F90 index 7cb6de6..1c8737a 100644 --- a/Tests/atomic_capture_expr_and_x_assign.F90 +++ b/Tests/atomic_capture_expr_and_x_assign.F90 @@ -2,7 +2,7 @@ #define ATOMIC_LOGICAL #define ATOMIC_OPTYPE EXPR_AND_X #define ATOMIC_ASSIGN_LATER -#define ATOMIC_INIT .FALSE. +#define ATOMIC_INIT .TRUE. #define ATOMIC_SIZE 10 #ifndef T1 !T1:construct-independent,atomic,V:2.0-2.7 diff --git a/Tests/kernels_loop_reduction_bitor_general.c b/Tests/kernels_loop_reduction_bitor_general.c index c31f28d..5cf5faf 100644 --- a/Tests/kernels_loop_reduction_bitor_general.c +++ b/Tests/kernels_loop_reduction_bitor_general.c @@ -31,7 +31,7 @@ int test1(){ } - for (int x = 1; x < n; ++x){ + for (int x = 0; x < n; ++x){ host_b = host_b | a[x]; } if (b != host_b){ diff --git a/Tests/parallel_loop_reduction_add_loop_type_check_pt1.c b/Tests/parallel_loop_reduction_add_loop_type_check_pt1.c index ddeae23..4b93389 100644 --- a/Tests/parallel_loop_reduction_add_loop_type_check_pt1.c +++ b/Tests/parallel_loop_reduction_add_loop_type_check_pt1.c @@ -1,5 +1,6 @@ #include "acc_testsuite.h" -#ifndef T1:private,reduction,combined-constructs,loop,V:1.0-2.7 +#ifndef T1 +//T1:private,reduction,combined-constructs,loop,V:1.0-2.7 int test1(){ int err = 0; srand(SEED); @@ -70,4 +71,4 @@ int main(){ } #endif return failcode; -} \ No newline at end of file +} diff --git a/Tests/parallel_loop_reduction_add_loop_type_check_pt1.cpp b/Tests/parallel_loop_reduction_add_loop_type_check_pt1.cpp index 2e79928..67010b5 100644 --- a/Tests/parallel_loop_reduction_add_loop_type_check_pt1.cpp +++ b/Tests/parallel_loop_reduction_add_loop_type_check_pt1.cpp @@ -1,5 +1,6 @@ #include "acc_testsuite.h" -#ifndef T1:private,reduction,combined-constructs,loop,V:1.0-2.7 +#ifndef T1 +//T1:private,reduction,combined-constructs,loop,V:1.0-2.7 int test1(){ int err = 0; srand(SEED); @@ -70,4 +71,4 @@ int main(){ } #endif return failcode; -} \ No newline at end of file +} From ab83024d7d43a12e02c2cc85cec1f9a2dbd865b5 Mon Sep 17 00:00:00 2001 From: Alister Johnson Date: Mon, 7 Jul 2025 10:13:29 -0700 Subject: [PATCH 37/37] Fixing logical atomic tests to use .EQV./.NEQV. instead of .EQ./.NE. --- Tests/atomic_expr_neqv_x.F90 | 2 +- Tests/atomic_expr_neqv_x_end.F90 | 2 +- Tests/atomic_template.Fh | 16 ++++++++-------- Tests/common.Fh | 12 +++++++++--- 4 files changed, 19 insertions(+), 13 deletions(-) diff --git a/Tests/atomic_expr_neqv_x.F90 b/Tests/atomic_expr_neqv_x.F90 index 92688e8..1ecaacf 100644 --- a/Tests/atomic_expr_neqv_x.F90 +++ b/Tests/atomic_expr_neqv_x.F90 @@ -49,7 +49,7 @@ LOGICAL FUNCTION test1() END DO DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN + IF (totals_comparison(x) .NEQV. totals(x)) THEN errors = errors + 1 WRITE(*, *) totals_comparison(x) END IF diff --git a/Tests/atomic_expr_neqv_x_end.F90 b/Tests/atomic_expr_neqv_x_end.F90 index 7b481f8..e61fa51 100644 --- a/Tests/atomic_expr_neqv_x_end.F90 +++ b/Tests/atomic_expr_neqv_x_end.F90 @@ -50,7 +50,7 @@ LOGICAL FUNCTION test1() END DO DO x = 1, LOOPCOUNT - IF (totals_comparison(x) .NE. totals(x)) THEN + IF (totals_comparison(x) .NEQV. totals(x)) THEN errors = errors + 1 WRITE(*, *) totals_comparison(x) END IF diff --git a/Tests/atomic_template.Fh b/Tests/atomic_template.Fh index d347ac2..511e438 100644 --- a/Tests/atomic_template.Fh +++ b/Tests/atomic_template.Fh @@ -101,21 +101,21 @@ #define X_OR_EXPR 2008 #if ATOMIC_OPTYPE == EXPR_AND_X -#define ATOMIC_OP(a, b) (a .AND. b) +#define ATOMIC_OP(a, b) a .AND. b #elif ATOMIC_OPTYPE == EXPR_EQV_X -#define ATOMIC_OP(a, b) (a .EQV. b) +#define ATOMIC_OP(a, b) a .EQV. b #elif ATOMIC_OPTYPE == EXPR_NEQV_X -#define ATOMIC_OP(a, b) (a .AND. b) +#define ATOMIC_OP(a, b) a .NEQV. b #elif ATOMIC_OPTYPE == EXPR_OR_X -#define ATOMIC_OP(a, b) (a .OR. b) +#define ATOMIC_OP(a, b) a .OR. b #elif ATOMIC_OPTYPE == X_AND_EXPR -#define ATOMIC_OP(a, b) (b .AND. a) +#define ATOMIC_OP(a, b) b .AND. a #elif ATOMIC_OPTYPE == X_EQV_EXPR -#define ATOMIC_OP(a, b) (b .EQV. a) +#define ATOMIC_OP(a, b) b .EQV. a #elif ATOMIC_OPTYPE == X_NEQV_EXPR -#define ATOMIC_OP(a, b) (b .NEQV. a) +#define ATOMIC_OP(a, b) b .NEQV. a #elif ATOMIC_OPTYPE == X_OR_EXPR -#define ATOMIC_OP(a, b) (b .OR. a) +#define ATOMIC_OP(a, b) b .OR. a #endif #endif diff --git a/Tests/common.Fh b/Tests/common.Fh index 73b10b5..edf3d16 100644 --- a/Tests/common.Fh +++ b/Tests/common.Fh @@ -42,8 +42,10 @@ FUNCTION VERIFY_ATOMIC_SEQUENCE(a, a2, b, length, init, final, op) RESULT(POSSIB #ifdef ATOMIC_ASSIGN_FIRST #ifdef ATOMIC_REAL if (.NOT. done(j) .AND. abs(b(j) - current) .lt. PRECISION) then -#elif defined(ATOMIC_INTEGER) || defined(ATOMIC_LOGICAL) +#elif defined(ATOMIC_INTEGER) if (.NOT. done(j) .AND. b(j) .eq. current) then +#elif defined(ATOMIC_LOGICAL) + if (.NOT. done(j) .AND. (b(j) .eqv. current)) then #endif done(j) = .TRUE. #endif @@ -59,8 +61,10 @@ FUNCTION VERIFY_ATOMIC_SEQUENCE(a, a2, b, length, init, final, op) RESULT(POSSIB #else #ifdef ATOMIC_REAL if (.NOT. done(j) .AND. abs(b(j) - tmp) .lt. PRECISION) then -#elif defined(ATOMIC_INTEGER) || defined(ATOMIC_LOGICAL) +#elif defined(ATOMIC_INTEGER) if (.NOT. done(j) .AND. b(j) .eq. tmp) then +#elif defined(ATOMIC_LOGICAL) + if (.NOT. done(j) .AND. (b(j) .eqv. tmp)) then #endif current = tmp done(j) = .TRUE. @@ -73,8 +77,10 @@ FUNCTION VERIFY_ATOMIC_SEQUENCE(a, a2, b, length, init, final, op) RESULT(POSSIB #ifdef ATOMIC_REAL if (abs(current - final) .lt. PRECISION) then -#elif defined(ATOMIC_INTEGER) || defined(ATOMIC_LOGICAL) +#elif defined(ATOMIC_INTEGER) if (current .eq. final) then +#elif defined(ATOMIC_LOGICAL) + if (current .eqv. final) then #endif POSSIBLE = .TRUE. end if