Skip to content
Snippets Groups Projects

Variant of copy for 2d dpsp

Merged Dylan Kierans requested to merge feature-copy2d-dpsp into master
All threads resolved!
1 file
+ 30
2
Compare changes
  • Side-by-side
  • Inline
@@ -414,6 +414,34 @@ CONTAINS
CALL ASSERT_EQUAL(assert_real_sp_5d_array(src, dest), .TRUE.)
END SUBROUTINE
SUBROUTINE Test_copy_2d_dpsp
REAL(dp) :: src(10, 8) = 1.0
REAL(sp) :: dest(10, 8)
CALL TAG_TEST("Test_copy_2d_dpsp_ones")
CALL copy(src, dest, .FALSE.)
CALL ASSERT_EQUAL(assert_real_spdp_2d_array(dest, src), .TRUE.)
CALL RANDOM_NUMBER(src)
CALL TAG_TEST("Test_copy_2d_dpsp_random")
CALL copy(src, dest, .FALSE.)
CALL ASSERT_EQUAL(assert_real_spdp_2d_array(dest, src), .TRUE.)
END SUBROUTINE
SUBROUTINE Test_copy_3d_dpsp
REAL(dp) :: src(10, 8, 6) = 1.0
REAL(sp) :: dest(10, 8, 6)
CALL TAG_TEST("Test_copy_3d_dpsp_ones")
CALL copy(src, dest, .FALSE.)
CALL ASSERT_EQUAL(assert_real_spdp_3d_array(dest, src), .TRUE.)
CALL RANDOM_NUMBER(src)
CALL TAG_TEST("Test_copy_3d_dpsp_random")
CALL copy(src, dest, .FALSE.)
CALL ASSERT_EQUAL(assert_real_spdp_3d_array(dest, src), .TRUE.)
END SUBROUTINE
SUBROUTINE Test_copy_2d_spdp
REAL(sp) :: src(10, 10) = 1.0
REAL(dp) :: dest(10, 10)
@@ -1845,7 +1873,7 @@ CONTAINS
assert_real_spdp_2d_array = .TRUE.
DO i = 1, SIZE(array1, 1)
DO j = 1, SIZE(array1, 2)
IF (array1(i, j) /= array2(i, j)) THEN
IF (array1(i, j) /= REAL(array2(i, j),KIND=sp)) THEN
assert_real_spdp_2d_array = .FALSE.
EXIT
END IF
@@ -1862,7 +1890,7 @@ CONTAINS
DO i = 1, SIZE(array1, 1)
DO j = 1, SIZE(array1, 2)
DO k = 1, SIZE(array1, 3)
IF (array1(i, j, k) /= array2(i, j, k)) THEN
IF (array1(i, j, k) /= REAL(array2(i, j, k),KIND=sp)) THEN
assert_real_spdp_3d_array = .FALSE.
EXIT
END IF
Loading