[cig-commits] r22602 - seismo/3D/SPECFEM3D_GLOBE/trunk/utils
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Sun Jul 14 05:00:02 PDT 2013
Author: dkomati1
Date: 2013-07-14 05:00:01 -0700 (Sun, 14 Jul 2013)
New Revision: 22602
Modified:
seismo/3D/SPECFEM3D_GLOBE/trunk/utils/test_shape_for_vectorization_if_not_first_index.f90
Log:
more complete version of test_shape_for_vectorization_if_not_first_index.f90
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/utils/test_shape_for_vectorization_if_not_first_index.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/utils/test_shape_for_vectorization_if_not_first_index.f90 2013-07-14 02:06:39 UTC (rev 22601)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/utils/test_shape_for_vectorization_if_not_first_index.f90 2013-07-14 12:00:01 UTC (rev 22602)
@@ -1,41 +1,64 @@
-program test
+program test_shape_vectorization
!! DK DK July 2013: test if we can use (ijk,1,1) instead of (i,j,k) when the group is not located at the first index
!! DK DK July 2013: (do NOT compile with range checking of course)
implicit none
-integer, parameter :: NX = 5
-integer, parameter :: NY = 6
-integer, parameter :: NZ = 7
-integer, parameter :: NL = 4
+integer, parameter :: NX = 8
+integer, parameter :: NY = 8
+integer, parameter :: NZ = 5
+integer, parameter :: NL = 7
+integer, parameter :: NM = 4
-integer, dimension(NL,NX,NY,NZ) :: a
+integer, dimension(NL,NX,NY,NZ,NM) :: a
-integer :: i,j,k,l,ijk
+integer :: i,j,k,l,m,ijk
+integer :: a_from_first_order,difference
-do l = 1,NL
+real :: r
+
+call random_seed()
+
+open(unit=10,file='first_result.dat',status='unknown')
+do m = 1,NM
do k = 1,NZ
do j = 1,NY
do i = 1,NX
- a(l,i,j,k) = l + i + j + k ! create test values
- print *,a(l,i,j,k)
+do l = 1,NL
+ call random_number(r)
+ a(l,i,j,k,m) = nint(r * 20000.) ! create test values
+ print *,a(l,i,j,k,m)
+ write(10,*) a(l,i,j,k,m)
enddo
enddo
enddo
enddo
+enddo
+close(10)
print *
!! DK DK in practice it gives the exact same order, thus the trick works fine
-print *,'now in different order'
+print *,'now in the vectorized order order'
print *
+open(unit=10,file='first_result.dat',status='old')
+do m = 1,NM
+do ijk = 1,NX*NY*NZ
do l = 1,NL
-do ijk = 1,NX*NY*NZ
- print *,a(l,ijk,1,1)
+ read(10,*) a_from_first_order
+ difference = abs(a(l,ijk,1,1,m) - a_from_first_order)
+ print *,a(l,ijk,1,1,m),difference
+ if(difference /= 0) stop 'error, difference between the two orders is not zero'
enddo
enddo
+enddo
+close(10)
-end
+print *
+print *,'the test is successful, the two orders are 100% identical'
+print *
+end program test_shape_vectorization
+
More information about the CIG-COMMITS
mailing list