[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