Skip to content
Snippets Groups Projects
Commit 28087959 authored by Dylan Kierans's avatar Dylan Kierans
Browse files

Tests for copy 4d/5d

parent 7bf36f9d
No related branches found
No related tags found
1 merge request!113Variant of copy for 2d dpsp
Pipeline #98965 passed
This commit is part of merge request !113. Comments created here will be created in the context of that merge request.
......@@ -442,6 +442,34 @@ CONTAINS
CALL ASSERT_EQUAL(assert_real_spdp_3d_array(dest, src), .TRUE.)
END SUBROUTINE
SUBROUTINE Test_copy_4d_dpsp
REAL(dp) :: src(5, 5, 5, 5) = 1.0
REAL(sp) :: dest(5, 5, 5, 5)
CALL TAG_TEST("Test_copy_4d_dpsp_ones")
CALL copy(src, dest, .FALSE.)
CALL ASSERT_EQUAL(assert_real_spdp_4d_array(dest, src), .TRUE.)
CALL RANDOM_NUMBER(src)
CALL TAG_TEST("Test_copy_4d_dpsp_random")
CALL copy(src, dest, .FALSE.)
CALL ASSERT_EQUAL(assert_real_spdp_4d_array(dest, src), .TRUE.)
END SUBROUTINE
SUBROUTINE Test_copy_5d_dpsp
REAL(dp) :: src(5, 5, 5, 5, 5) = 1.0
REAL(sp) :: dest(5, 5, 5, 5, 5)
CALL TAG_TEST("Test_copy_5d_dpsp_ones")
CALL copy(src, dest, .FALSE.)
CALL ASSERT_EQUAL(assert_real_spdp_5d_array(dest, src), .TRUE.)
CALL RANDOM_NUMBER(src)
CALL TAG_TEST("Test_copy_5d_dpsp_random")
CALL copy(src, dest, .FALSE.)
CALL ASSERT_EQUAL(assert_real_spdp_5d_array(dest, src), .TRUE.)
END SUBROUTINE
SUBROUTINE Test_copy_2d_spdp
REAL(sp) :: src(10, 10) = 1.0
REAL(dp) :: dest(10, 10)
......@@ -1909,7 +1937,7 @@ CONTAINS
DO j = 1, SIZE(array1, 2)
DO k = 1, SIZE(array1, 3)
DO l = 1, SIZE(array1, 4)
IF (array1(i, j, k, l) /= array2(i, j, k, l)) THEN
IF (array1(i, j, k, l) /= REAL(array2(i, j, k, l), KIND=sp)) THEN
assert_real_spdp_4d_array = .FALSE.
EXIT
END IF
......@@ -1930,7 +1958,7 @@ CONTAINS
DO k = 1, SIZE(array1, 3)
DO l = 1, SIZE(array1, 4)
DO m = 1, SIZE(array1, 5)
IF (array1(i, j, k, l, m) /= array2(i, j, k, l, m)) THEN
IF (array1(i, j, k, l, m) /= REAL(array2(i, j, k, l, m), KIND=sp)) THEN
assert_real_spdp_5d_array = .FALSE.
EXIT
END IF
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment