[cig-commits] r11819 - seismo/3D/SPECFEM3D_GLOBE/trunk

[dmichea at geodynamics.org]

Author: dmichea
Date: 2008-04-16 08:39:49 -0700 (Wed, 16 Apr 2008)
New Revision: 11819

Modified:
   seismo/3D/SPECFEM3D_GLOBE/trunk/get_jacobian_boundaries.f90
   seismo/3D/SPECFEM3D_GLOBE/trunk/sort_array_coordinates.f90
Log:
fixed a minor bug in get_jacobian_boundaries.f90
removed dead code from sort_array_coordinates.f90



Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/get_jacobian_boundaries.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/get_jacobian_boundaries.f90	2008-04-15 22:53:53 UTC (rev 11818)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/get_jacobian_boundaries.f90	2008-04-16 15:39:49 UTC (rev 11819)
@@ -515,7 +515,7 @@
 
 ! permutation of ibelm
   allocate(ibelm_tmp(ispecb))
-  ibelm_tmp = ibelm
+  ibelm_tmp(1:ispecb) = ibelm(1:ispecb)
   do i = 1,ispecb
     ibelm(perm(i)) = ibelm_tmp(i)
   enddo
@@ -523,7 +523,7 @@
 
 ! permutation of normal
   allocate(normal_tmp(NDIM,NGLL1,NGLL2,ispecb))
-  normal_tmp = normal
+  normal_tmp(:,:,:,1:ispecb) = normal(:,:,:,1:ispecb)
   do i = 1,ispecb
     normal(:,:,:,perm(i)) = normal_tmp(:,:,:,i)
   enddo
@@ -531,7 +531,7 @@
 
 ! permutation of jacobian2D
   allocate(jacobian2D_tmp(NGLL1,NGLL2,ispecb))
-  jacobian2D_tmp = jacobian2D
+  jacobian2D_tmp(:,:,1:ispecb) = jacobian2D(:,:,1:ispecb)
   do i = 1,ispecb
     jacobian2D(:,:,perm(i)) = jacobian2D_tmp(:,:,i)
   enddo

Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/sort_array_coordinates.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/sort_array_coordinates.f90	2008-04-15 22:53:53 UTC (rev 11818)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/sort_array_coordinates.f90	2008-04-16 15:39:49 UTC (rev 11819)
@@ -232,164 +232,4 @@
 
   end subroutine swap_all_buffers
 
-  subroutine sort_array_coordinates_gjb(npointot,x,y,z,ibool,iglob,normal,jacobian_2D,loc,ifseg,nglob,ind,ninseg,iwork,work,dim1,dim2)
 
-! this routine MUST be in double precision to avoid sensitivity
-! to roundoff errors in the coordinates of the points
-
-  implicit none
-
-  include "constants.h"
-
-  integer npointot,nglob,dim1,dim2
-
-  real(kind=CUSTOM_REAL) jacobian_2D(dim1,dim2,npointot), normal(NDIM,dim1,dim2,npointot)
-  integer ibool(npointot),iglob(npointot),loc(npointot)
-  integer ind(npointot),ninseg(npointot)
-  logical ifseg(npointot)
-  double precision x(npointot),y(npointot),z(npointot)
-  integer iwork(npointot)
-  double precision work(npointot)
-
-  integer ipoin,i,j
-  integer nseg,ioff,iseg,ig
-  double precision xtol
-
-! establish initial pointers
-  do ipoin=1,npointot
-    loc(ipoin)=ipoin
-  enddo
-
-! define a tolerance, normalized radius is 1., so let's use a small value
-  xtol = SMALLVALTOL
-
-  ifseg(:)=.false.
-
-  nseg=1
-  ifseg(1)=.true.
-  ninseg(1)=npointot
-
-  do j=1,NDIM
-
-! sort within each segment
-  ioff=1
-  do iseg=1,nseg
-    if(j == 1) then
-
-      call rank_buffers(x(ioff),ind,ninseg(iseg))
-
-    else if(j == 2) then
-
-      call rank_buffers(y(ioff),ind,ninseg(iseg))
-
-    else
-
-      call rank_buffers(z(ioff),ind,ninseg(iseg))
-
-    endif
-
-    call swap_all_buffers_gjb(ibool(ioff),loc(ioff), &
-            x(ioff),y(ioff),z(ioff),normal(:,:,:,ioff),jacobian_2D(:,:,ioff),iwork,work,ind,ninseg(iseg),dim1,dim2)
-
-    ioff=ioff+ninseg(iseg)
-  enddo
-
-! check for jumps in current coordinate
-  if(j == 1) then
-    do i=2,npointot
-      if(dabs(x(i)-x(i-1)) > xtol) ifseg(i)=.true.
-    enddo
-  else if(j == 2) then
-    do i=2,npointot
-      if(dabs(y(i)-y(i-1)) > xtol) ifseg(i)=.true.
-    enddo
-  else
-    do i=2,npointot
-      if(dabs(z(i)-z(i-1)) > xtol) ifseg(i)=.true.
-    enddo
-  endif
-
-! count up number of different segments
-  nseg=0
-  do i=1,npointot
-    if(ifseg(i)) then
-      nseg=nseg+1
-      ninseg(nseg)=1
-    else
-      ninseg(nseg)=ninseg(nseg)+1
-    endif
-  enddo
-  enddo
-
-! assign global node numbers (now sorted lexicographically)
-  ig=0
-  do i=1,npointot
-    if(ifseg(i)) ig=ig+1
-    iglob(loc(i))=ig
-  enddo
-
-  nglob=ig
-
-  end subroutine sort_array_coordinates_gjb
-
-  subroutine swap_all_buffers_gjb(IA,IB,A,B,C,NORM,JAC,IW,W,ind,n,dim1,dim2)
-!
-! swap arrays IA, IB, A, B and C according to addressing in array IND
-!
-  implicit none
-  include "constants.h"
-
-  integer n,dim1,dim2
-
-  integer IND(n)
-  integer IA(n),IB(n),IW(n)
-  double precision A(n),B(n),C(n),W(n)
-  real(kind=CUSTOM_REAL) NORM(NDIM,dim1,dim2,n), JAC(dim1,dim2,n), WN(NDIM,dim1,dim2,n), WJ(dim1,dim2,n)
-
-  integer i
-
-  do i=1,n
-    W(i)=A(i)
-    IW(i)=IA(i)
-  enddo
-
-  do i=1,n
-    A(i)=W(ind(i))
-    IA(i)=IW(ind(i))
-  enddo
-
-  do i=1,n
-    W(i)=B(i)
-    IW(i)=IB(i)
-  enddo
-
-  do i=1,n
-    B(i)=W(ind(i))
-    IB(i)=IW(ind(i))
-  enddo
-
-  do i=1,n
-    W(i)=C(i)
-  enddo
-
-  do i=1,n
-    C(i)=W(ind(i))
-  enddo
-
-  do i=1,n
-    WN(:,:,:,i)=NORM(:,:,:,i)
-  enddo
-  do i=1,n
-    NORM(:,:,:,i)=WN(:,:,:,ind(i))
-  enddo
-
-  do i=1,n
-    WJ(:,:,i)=JAC(:,:,i)
-  enddo
-  do i=1,n
-    JAC(:,:,i)=WJ(:,:,ind(i))
-  enddo
-
-  end subroutine swap_all_buffers_gjb
-
-