[cig-commits] r11792 - seismo/3D/SPECFEM3D_GLOBE/trunk
dmichea at geodynamics.org
dmichea at geodynamics.org
Thu Apr 10 02:36:18 PDT 2008
Author: dmichea
Date: 2008-04-10 02:36:18 -0700 (Thu, 10 Apr 2008)
New Revision: 11792
Modified:
seismo/3D/SPECFEM3D_GLOBE/trunk/create_regions_mesh.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/get_MPI_1D_buffers.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/get_MPI_cutplanes_eta.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/get_MPI_cutplanes_xi.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/get_jacobian_boundaries.f90
Log:
removed all sorting when Cuthill Mc Kee is not activated, this to avoid memory wasting.
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/create_regions_mesh.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/create_regions_mesh.f90 2008-04-10 00:01:46 UTC (rev 11791)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/create_regions_mesh.f90 2008-04-10 09:36:18 UTC (rev 11792)
@@ -335,7 +335,7 @@
character(len=150) LOCAL_PATH,errmsg
! use integer array to store values
- integer, dimension(NX_BATHY,NY_BATHY) :: ibathy_topo
+ integer ibathy_topo(NX_BATHY,NY_BATHY)
! arrays with the mesh in double precision
double precision xstore(NGLLX,NGLLY,NGLLZ,nspec)
@@ -1301,7 +1301,7 @@
endif
! define the doubling flag of this element
-! only two active central cubes, the four others are fictitious
+! only two active central cube, the 4 others are fictitious
! determine where we cut the central cube to share it between CHUNK_AB & CHUNK_AB_ANTIPODE
! in the case of mod(NPROC_XI,2)/=0, the cut is asymetric and the bigger part is for CHUNK_AB
@@ -1444,13 +1444,13 @@
! arrays locval(npointot) and ifseg(npointot) used to save memory
call get_MPI_cutplanes_xi(myrank,prname,nspec,iMPIcut_xi,ibool, &
xstore,ystore,zstore,ifseg,npointot, &
- NSPEC2D_ETA_FACE,iregion_code,NGLOB2DMAX_XY,nglob)
+ NSPEC2D_ETA_FACE,iregion_code,NGLOB2DMAX_XY)
call get_MPI_cutplanes_eta(myrank,prname,nspec,iMPIcut_eta,ibool, &
xstore,ystore,zstore,ifseg,npointot, &
- NSPEC2D_XI_FACE,iregion_code,NGLOB2DMAX_XY,nglob)
+ NSPEC2D_XI_FACE,iregion_code,NGLOB2DMAX_XY)
call get_MPI_1D_buffers(myrank,prname,nspec,iMPIcut_xi,iMPIcut_eta,ibool,idoubling, &
xstore,ystore,zstore,ifseg,npointot, &
- NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER,iregion_code,nglob)
+ NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER,iregion_code)
! Stacey
if(NCHUNKS /= 6) &
@@ -1488,132 +1488,133 @@
! ***************************************************
! Cuthill McKee permutation
! ***************************************************
-
- if (iregion_code /= IREGION_INNER_CORE .or. PERMUTE_INNER_CORE) then
- allocate(perm(nspec))
- if(iregion_code == IREGION_CRUST_MANTLE) then
- ! do not permute anisotropic elements
- perm(1:FIRST_ELT_NON_ANISO-1) = (/ (i,i=1,FIRST_ELT_NON_ANISO-1) /)
-
- ! no more connectivity between layers below and above the anisotropic layers => 2 permutations
- ! permute the bottom of the region : below the aniso layers
- allocate(perm_tmp(FIRST_ELT_ABOVE_ANISO-FIRST_ELT_NON_ANISO))
- call get_perm(ibool(:,:,:,FIRST_ELT_NON_ANISO:FIRST_ELT_ABOVE_ANISO-1),perm_tmp,LIMIT_MULTI_CUTHILL,&
-(FIRST_ELT_ABOVE_ANISO-FIRST_ELT_NON_ANISO),nglob,.true.,.false.)
- perm(FIRST_ELT_NON_ANISO:FIRST_ELT_ABOVE_ANISO-1) = perm_tmp(:)+(FIRST_ELT_NON_ANISO-1)
- deallocate(perm_tmp)
-
- ! permute the top of the region : above the aniso layers
- allocate(perm_tmp(nspec-FIRST_ELT_ABOVE_ANISO+1))
- call get_perm(ibool(:,:,:,FIRST_ELT_ABOVE_ANISO:nspec),perm_tmp,LIMIT_MULTI_CUTHILL,&
-(nspec-FIRST_ELT_ABOVE_ANISO+1),nglob,.true.,.false.)
- perm(FIRST_ELT_ABOVE_ANISO:nspec) = perm_tmp(:)+(FIRST_ELT_ABOVE_ANISO-1)
- deallocate(perm_tmp)
- else
- ! the 3 last parameters are : PERFORM_CUTHILL_MCKEE,INVERSE,FACE
- call get_perm(ibool,perm,LIMIT_MULTI_CUTHILL,nspec,nglob,.true.,.false.)
- endif
-
- ! permutation of xstore, ystore, zstore, rhostore, kappavstore, kappahstore,
- ! muvstore, muhstore, eta_anisostore, xixstore, xiystore, xizstore, etaxstore,
- ! etaystore, etazstore, gammaxstore, gammaystore, gammazstore, no more jacobianstore
-
- allocate(temp_array_dble(NGLLX,NGLLY,NGLLZ,nspec))
- if(ATTENUATION .and. ATTENUATION_3D) then
- call permute_elements_dble(Qmu_store,temp_array_dble,perm,nspec)
- allocate(temp_array_dble_5dim(N_SLS,NGLLX,NGLLY,NGLLZ,nspec))
- temp_array_dble_5dim(:,:,:,:,:) = tau_e_store(:,:,:,:,:)
+ if (PERFORM_CUTHILL_MCKEE) then
+ if (iregion_code /= IREGION_INNER_CORE .or. PERMUTE_INNER_CORE) then
+ allocate(perm(nspec))
+ if(iregion_code == IREGION_CRUST_MANTLE) then
+ ! do not permute anisotropic elements
+ perm(1:FIRST_ELT_NON_ANISO-1) = (/ (i,i=1,FIRST_ELT_NON_ANISO-1) /)
+
+ ! no more connectivity between layers below and above the anisotropic layers => 2 permutations
+ ! permute the bottom of the region : below the aniso layers
+ allocate(perm_tmp(FIRST_ELT_ABOVE_ANISO-FIRST_ELT_NON_ANISO))
+ call get_perm(ibool(:,:,:,FIRST_ELT_NON_ANISO:FIRST_ELT_ABOVE_ANISO-1),perm_tmp,LIMIT_MULTI_CUTHILL,&
+ (FIRST_ELT_ABOVE_ANISO-FIRST_ELT_NON_ANISO),nglob,.true.,.false.)
+ perm(FIRST_ELT_NON_ANISO:FIRST_ELT_ABOVE_ANISO-1) = perm_tmp(:)+(FIRST_ELT_NON_ANISO-1)
+ deallocate(perm_tmp)
+
+ ! permute the top of the region : above the aniso layers
+ allocate(perm_tmp(nspec-FIRST_ELT_ABOVE_ANISO+1))
+ call get_perm(ibool(:,:,:,FIRST_ELT_ABOVE_ANISO:nspec),perm_tmp,LIMIT_MULTI_CUTHILL,&
+ (nspec-FIRST_ELT_ABOVE_ANISO+1),nglob,.true.,.false.)
+ perm(FIRST_ELT_ABOVE_ANISO:nspec) = perm_tmp(:)+(FIRST_ELT_ABOVE_ANISO-1)
+ deallocate(perm_tmp)
+ else
+ ! the 3 last parameters are : PERFORM_CUTHILL_MCKEE,INVERSE,FACE
+ call get_perm(ibool,perm,LIMIT_MULTI_CUTHILL,nspec,nglob,.true.,.false.)
+ endif
+
+ ! permutation of xstore, ystore, zstore, rhostore, kappavstore, kappahstore,
+ ! muvstore, muhstore, eta_anisostore, xixstore, xiystore, xizstore, etaxstore,
+ ! etaystore, etazstore, gammaxstore, gammaystore, gammazstore, no more jacobianstore
+
+ allocate(temp_array_dble(NGLLX,NGLLY,NGLLZ,nspec))
+ if(ATTENUATION .and. ATTENUATION_3D) then
+ call permute_elements_dble(Qmu_store,temp_array_dble,perm,nspec)
+ allocate(temp_array_dble_5dim(N_SLS,NGLLX,NGLLY,NGLLZ,nspec))
+ temp_array_dble_5dim(:,:,:,:,:) = tau_e_store(:,:,:,:,:)
+ do i = 1,nspec
+ tau_e_store(:,:,:,:,perm(i)) = temp_array_dble_5dim(:,:,:,:,i)
+ enddo
+ deallocate(temp_array_dble_5dim)
+ endif
+ call permute_elements_dble(xstore,temp_array_dble,perm,nspec)
+ call permute_elements_dble(ystore,temp_array_dble,perm,nspec)
+ call permute_elements_dble(zstore,temp_array_dble,perm,nspec)
+ deallocate(temp_array_dble)
+
+
+ allocate(temp_array_real(NGLLX,NGLLY,NGLLZ,nspec))
+ if(NCHUNKS /= 6) then
+ call permute_elements_real(rho_vp,temp_array_real,perm,nspec)
+ call permute_elements_real(rho_vs,temp_array_real,perm,nspec)
+ endif
+ if((ANISOTROPIC_INNER_CORE .and. iregion_code == IREGION_INNER_CORE) .or. &
+ (ANISOTROPIC_3D_MANTLE .and. iregion_code == IREGION_CRUST_MANTLE)) then
+ call permute_elements_real(c11store,temp_array_real,perm,nspec)
+ call permute_elements_real(c12store,temp_array_real,perm,nspec)
+ call permute_elements_real(c13store,temp_array_real,perm,nspec)
+ call permute_elements_real(c14store,temp_array_real,perm,nspec)
+ call permute_elements_real(c15store,temp_array_real,perm,nspec)
+ call permute_elements_real(c16store,temp_array_real,perm,nspec)
+ call permute_elements_real(c22store,temp_array_real,perm,nspec)
+ call permute_elements_real(c23store,temp_array_real,perm,nspec)
+ call permute_elements_real(c24store,temp_array_real,perm,nspec)
+ call permute_elements_real(c25store,temp_array_real,perm,nspec)
+ call permute_elements_real(c26store,temp_array_real,perm,nspec)
+ call permute_elements_real(c33store,temp_array_real,perm,nspec)
+ call permute_elements_real(c34store,temp_array_real,perm,nspec)
+ call permute_elements_real(c35store,temp_array_real,perm,nspec)
+ call permute_elements_real(c36store,temp_array_real,perm,nspec)
+ call permute_elements_real(c44store,temp_array_real,perm,nspec)
+ call permute_elements_real(c45store,temp_array_real,perm,nspec)
+ call permute_elements_real(c46store,temp_array_real,perm,nspec)
+ call permute_elements_real(c55store,temp_array_real,perm,nspec)
+ call permute_elements_real(c56store,temp_array_real,perm,nspec)
+ call permute_elements_real(c66store,temp_array_real,perm,nspec)
+ endif
+ call permute_elements_real(rhostore,temp_array_real,perm,nspec)
+ call permute_elements_real(kappavstore,temp_array_real,perm,nspec)
+ call permute_elements_real(kappahstore,temp_array_real,perm,nspec)
+ call permute_elements_real(muvstore,temp_array_real,perm,nspec)
+ call permute_elements_real(muhstore,temp_array_real,perm,nspec)
+ call permute_elements_real(eta_anisostore,temp_array_real,perm,nspec)
+ call permute_elements_real(xixstore,temp_array_real,perm,nspec)
+ call permute_elements_real(xiystore,temp_array_real,perm,nspec)
+ call permute_elements_real(xizstore,temp_array_real,perm,nspec)
+ call permute_elements_real(etaxstore,temp_array_real,perm,nspec)
+ call permute_elements_real(etaystore,temp_array_real,perm,nspec)
+ call permute_elements_real(etazstore,temp_array_real,perm,nspec)
+ call permute_elements_real(gammaxstore,temp_array_real,perm,nspec)
+ call permute_elements_real(gammaystore,temp_array_real,perm,nspec)
+ call permute_elements_real(gammazstore,temp_array_real,perm,nspec)
+ deallocate(temp_array_real)
+
+ ! permutation of ibool
+ allocate(temp_array_int(NGLLX,NGLLY,NGLLZ,nspec))
+ call permute_elements_integer(ibool,temp_array_int,perm,nspec)
+ deallocate(temp_array_int)
+
+ ! permutation of iMPIcut_*
+ allocate(temp_array_2D_log(2,nspec))
+ temp_array_2D_log(:,:) = iMPIcut_xi(:,:)
do i = 1,nspec
- tau_e_store(:,:,:,:,perm(i)) = temp_array_dble_5dim(:,:,:,:,i)
+ iMPIcut_xi(:,perm(i)) = temp_array_2D_log(:,i)
enddo
- deallocate(temp_array_dble_5dim)
+ temp_array_2D_log(:,:) = iMPIcut_eta(:,:)
+ do i = 1,nspec
+ iMPIcut_eta(:,perm(i)) = temp_array_2D_log(:,i)
+ enddo
+ deallocate(temp_array_2D_log)
+
+ ! permutation of iboun
+ allocate(temp_array_2D_log(6,nspec))
+ temp_array_2D_log(:,:) = iboun(:,:)
+ do i = 1,nspec
+ iboun(:,perm(i)) = temp_array_2D_log(:,i)
+ enddo
+ deallocate(temp_array_2D_log)
+
+ ! permutation of idoubling
+ allocate(temp_array_1D_int(nspec))
+ temp_array_1D_int(:) = idoubling(:)
+ do i = 1,nspec
+ idoubling(perm(i)) = temp_array_1D_int(i)
+ enddo
+ deallocate(temp_array_1D_int)
+
+ deallocate(perm)
endif
- call permute_elements_dble(xstore,temp_array_dble,perm,nspec)
- call permute_elements_dble(ystore,temp_array_dble,perm,nspec)
- call permute_elements_dble(zstore,temp_array_dble,perm,nspec)
- deallocate(temp_array_dble)
-
-
- allocate(temp_array_real(NGLLX,NGLLY,NGLLZ,nspec))
- if(NCHUNKS /= 6) then
- call permute_elements_real(rho_vp,temp_array_real,perm,nspec)
- call permute_elements_real(rho_vs,temp_array_real,perm,nspec)
- endif
- if((ANISOTROPIC_INNER_CORE .and. iregion_code == IREGION_INNER_CORE) .or. &
- (ANISOTROPIC_3D_MANTLE .and. iregion_code == IREGION_CRUST_MANTLE)) then
- call permute_elements_real(c11store,temp_array_real,perm,nspec)
- call permute_elements_real(c12store,temp_array_real,perm,nspec)
- call permute_elements_real(c13store,temp_array_real,perm,nspec)
- call permute_elements_real(c14store,temp_array_real,perm,nspec)
- call permute_elements_real(c15store,temp_array_real,perm,nspec)
- call permute_elements_real(c16store,temp_array_real,perm,nspec)
- call permute_elements_real(c22store,temp_array_real,perm,nspec)
- call permute_elements_real(c23store,temp_array_real,perm,nspec)
- call permute_elements_real(c24store,temp_array_real,perm,nspec)
- call permute_elements_real(c25store,temp_array_real,perm,nspec)
- call permute_elements_real(c26store,temp_array_real,perm,nspec)
- call permute_elements_real(c33store,temp_array_real,perm,nspec)
- call permute_elements_real(c34store,temp_array_real,perm,nspec)
- call permute_elements_real(c35store,temp_array_real,perm,nspec)
- call permute_elements_real(c36store,temp_array_real,perm,nspec)
- call permute_elements_real(c44store,temp_array_real,perm,nspec)
- call permute_elements_real(c45store,temp_array_real,perm,nspec)
- call permute_elements_real(c46store,temp_array_real,perm,nspec)
- call permute_elements_real(c55store,temp_array_real,perm,nspec)
- call permute_elements_real(c56store,temp_array_real,perm,nspec)
- call permute_elements_real(c66store,temp_array_real,perm,nspec)
- endif
- call permute_elements_real(rhostore,temp_array_real,perm,nspec)
- call permute_elements_real(kappavstore,temp_array_real,perm,nspec)
- call permute_elements_real(kappahstore,temp_array_real,perm,nspec)
- call permute_elements_real(muvstore,temp_array_real,perm,nspec)
- call permute_elements_real(muhstore,temp_array_real,perm,nspec)
- call permute_elements_real(eta_anisostore,temp_array_real,perm,nspec)
- call permute_elements_real(xixstore,temp_array_real,perm,nspec)
- call permute_elements_real(xiystore,temp_array_real,perm,nspec)
- call permute_elements_real(xizstore,temp_array_real,perm,nspec)
- call permute_elements_real(etaxstore,temp_array_real,perm,nspec)
- call permute_elements_real(etaystore,temp_array_real,perm,nspec)
- call permute_elements_real(etazstore,temp_array_real,perm,nspec)
- call permute_elements_real(gammaxstore,temp_array_real,perm,nspec)
- call permute_elements_real(gammaystore,temp_array_real,perm,nspec)
- call permute_elements_real(gammazstore,temp_array_real,perm,nspec)
- deallocate(temp_array_real)
-
- ! permutation of ibool
- allocate(temp_array_int(NGLLX,NGLLY,NGLLZ,nspec))
- call permute_elements_integer(ibool,temp_array_int,perm,nspec)
- deallocate(temp_array_int)
-
- ! permutation of iMPIcut_*
- allocate(temp_array_2D_log(2,nspec))
- temp_array_2D_log(:,:) = iMPIcut_xi(:,:)
- do i = 1,nspec
- iMPIcut_xi(:,perm(i)) = temp_array_2D_log(:,i)
- enddo
- temp_array_2D_log(:,:) = iMPIcut_eta(:,:)
- do i = 1,nspec
- iMPIcut_eta(:,perm(i)) = temp_array_2D_log(:,i)
- enddo
- deallocate(temp_array_2D_log)
-
- ! permutation of iboun
- allocate(temp_array_2D_log(6,nspec))
- temp_array_2D_log(:,:) = iboun(:,:)
- do i = 1,nspec
- iboun(:,perm(i)) = temp_array_2D_log(:,i)
- enddo
- deallocate(temp_array_2D_log)
-
- ! permutation of idoubling
- allocate(temp_array_1D_int(nspec))
- temp_array_1D_int(:) = idoubling(:)
- do i = 1,nspec
- idoubling(perm(i)) = temp_array_1D_int(i)
- enddo
- deallocate(temp_array_1D_int)
-
- deallocate(perm)
endif
! ***************************************************
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/get_MPI_1D_buffers.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/get_MPI_1D_buffers.f90 2008-04-10 00:01:46 UTC (rev 11791)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/get_MPI_1D_buffers.f90 2008-04-10 09:36:18 UTC (rev 11792)
@@ -27,7 +27,7 @@
subroutine get_MPI_1D_buffers(myrank,prname,nspec,iMPIcut_xi,iMPIcut_eta,ibool, &
idoubling,xstore,ystore,zstore,mask_ibool,npointot, &
- NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER,iregion,nglob_ori)
+ NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER,iregion)
! routine to create the MPI 1D chunk buffers for edges
@@ -35,7 +35,7 @@
include "constants.h"
- integer nspec,myrank,nglob_ori,nglob,ipoin1D,iregion
+ integer nspec,myrank,nglob,ipoin1D,iregion
integer, dimension(MAX_NUM_REGIONS,NB_SQUARE_CORNERS) :: NSPEC1D_RADIAL_CORNER,NGLOB1D_RADIAL_CORNER
logical iMPIcut_xi(2,nspec)
@@ -71,17 +71,19 @@
! allocate arrays for message buffers with maximum size
! define maximum size for message buffers
- allocate(ibool_selected(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
- allocate(xstore_selected(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
- allocate(ystore_selected(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
- allocate(zstore_selected(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
- allocate(ind(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
- allocate(ninseg(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
- allocate(iglob(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
- allocate(locval(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
- allocate(ifseg(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
- allocate(iwork(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
- allocate(work(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
+ if (PERFORM_CUTHILL_MCKEE) then
+ allocate(ibool_selected(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
+ allocate(xstore_selected(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
+ allocate(ystore_selected(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
+ allocate(zstore_selected(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
+ allocate(ind(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
+ allocate(ninseg(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
+ allocate(iglob(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
+ allocate(locval(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
+ allocate(ifseg(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
+ allocate(iwork(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
+ allocate(work(maxval(NGLOB1D_RADIAL_CORNER(iregion,:))))
+ endif
! write the MPI buffers for the left and right edges of the slice
! and the position of the points to check that the buffers are fine
@@ -121,24 +123,29 @@
if(.not. mask_ibool(ibool(ix,iy,iz,ispec))) then
mask_ibool(ibool(ix,iy,iz,ispec)) = .true.
npoin1D = npoin1D + 1
- ibool_selected(npoin1D) = ibool(ix,iy,iz,ispec)
- xstore_selected(npoin1D) = xstore(ix,iy,iz,ispec)
- ystore_selected(npoin1D) = ystore(ix,iy,iz,ispec)
- zstore_selected(npoin1D) = zstore(ix,iy,iz,ispec)
+ if (PERFORM_CUTHILL_MCKEE) then
+ ibool_selected(npoin1D) = ibool(ix,iy,iz,ispec)
+ xstore_selected(npoin1D) = xstore(ix,iy,iz,ispec)
+ ystore_selected(npoin1D) = ystore(ix,iy,iz,ispec)
+ zstore_selected(npoin1D) = zstore(ix,iy,iz,ispec)
+ else
+ write(10,*) ibool(ispec), xstore(ispec), &
+ ystore(ispec),zstore(ispec)
+ endif
endif
enddo
endif
enddo
- nglob=nglob_ori
- call sort_array_coordinates(npoin1D,xstore_selected,ystore_selected,zstore_selected, &
- ibool_selected,iglob,locval,ifseg,nglob,ind,ninseg,iwork,work)
-
- do ipoin1D=1,npoin1D
- write(10,*) ibool_selected(ipoin1D), xstore_selected(ipoin1D), &
- ystore_selected(ipoin1D),zstore_selected(ipoin1D)
- enddo
-
+ if (PERFORM_CUTHILL_MCKEE) then
+ call sort_array_coordinates(npoin1D,xstore_selected,ystore_selected,zstore_selected, &
+ ibool_selected,iglob,locval,ifseg,nglob,ind,ninseg,iwork,work)
+
+ do ipoin1D=1,npoin1D
+ write(10,*) ibool_selected(ipoin1D), xstore_selected(ipoin1D), &
+ ystore_selected(ipoin1D),zstore_selected(ipoin1D)
+ enddo
+ endif
! put flag to indicate end of the list of points
write(10,*) '0 0 0. 0. 0.'
@@ -181,24 +188,30 @@
if(.not. mask_ibool(ibool(ix,iy,iz,ispec))) then
mask_ibool(ibool(ix,iy,iz,ispec)) = .true.
npoin1D = npoin1D + 1
- ibool_selected(npoin1D) = ibool(ix,iy,iz,ispec)
- xstore_selected(npoin1D) = xstore(ix,iy,iz,ispec)
- ystore_selected(npoin1D) = ystore(ix,iy,iz,ispec)
- zstore_selected(npoin1D) = zstore(ix,iy,iz,ispec)
+ if (PERFORM_CUTHILL_MCKEE) then
+ ibool_selected(npoin1D) = ibool(ix,iy,iz,ispec)
+ xstore_selected(npoin1D) = xstore(ix,iy,iz,ispec)
+ ystore_selected(npoin1D) = ystore(ix,iy,iz,ispec)
+ zstore_selected(npoin1D) = zstore(ix,iy,iz,ispec)
+ else
+ write(10,*) ibool(ispec), xstore(ispec), &
+ ystore(ispec),zstore(ispec)
+ endif
endif
enddo
endif
enddo
- nglob=nglob_ori
- call sort_array_coordinates(npoin1D,xstore_selected,ystore_selected,zstore_selected, &
- ibool_selected,iglob,locval,ifseg,nglob,ind,ninseg,iwork,work)
+ if (PERFORM_CUTHILL_MCKEE) then
+ call sort_array_coordinates(npoin1D,xstore_selected,ystore_selected,zstore_selected, &
+ ibool_selected,iglob,locval,ifseg,nglob,ind,ninseg,iwork,work)
+
+ do ipoin1D=1,npoin1D
+ write(10,*) ibool_selected(ipoin1D), xstore_selected(ipoin1D), &
+ ystore_selected(ipoin1D),zstore_selected(ipoin1D)
+ enddo
+ endif
- do ipoin1D=1,npoin1D
- write(10,*) ibool_selected(ipoin1D), xstore_selected(ipoin1D), &
- ystore_selected(ipoin1D),zstore_selected(ipoin1D)
- enddo
-
! put flag to indicate end of the list of points
write(10,*) '0 0 0. 0. 0.'
@@ -251,24 +264,30 @@
if(.not. mask_ibool(ibool(ix,iy,iz,ispec))) then
mask_ibool(ibool(ix,iy,iz,ispec)) = .true.
npoin1D = npoin1D + 1
- ibool_selected(npoin1D) = ibool(ix,iy,iz,ispec)
- xstore_selected(npoin1D) = xstore(ix,iy,iz,ispec)
- ystore_selected(npoin1D) = ystore(ix,iy,iz,ispec)
- zstore_selected(npoin1D) = zstore(ix,iy,iz,ispec)
+ if (PERFORM_CUTHILL_MCKEE) then
+ ibool_selected(npoin1D) = ibool(ix,iy,iz,ispec)
+ xstore_selected(npoin1D) = xstore(ix,iy,iz,ispec)
+ ystore_selected(npoin1D) = ystore(ix,iy,iz,ispec)
+ zstore_selected(npoin1D) = zstore(ix,iy,iz,ispec)
+ else
+ write(10,*) ibool(ispec), xstore(ispec), &
+ ystore(ispec),zstore(ispec)
+ endif
endif
enddo
endif
enddo
- nglob=nglob_ori
- call sort_array_coordinates(npoin1D,xstore_selected,ystore_selected,zstore_selected, &
- ibool_selected,iglob,locval,ifseg,nglob,ind,ninseg,iwork,work)
+ if (PERFORM_CUTHILL_MCKEE) then
+ call sort_array_coordinates(npoin1D,xstore_selected,ystore_selected,zstore_selected, &
+ ibool_selected,iglob,locval,ifseg,nglob,ind,ninseg,iwork,work)
+
+ do ipoin1D=1,npoin1D
+ write(10,*) ibool_selected(ipoin1D), xstore_selected(ipoin1D), &
+ ystore_selected(ipoin1D),zstore_selected(ipoin1D)
+ enddo
+ endif
- do ipoin1D=1,npoin1D
- write(10,*) ibool_selected(ipoin1D), xstore_selected(ipoin1D), &
- ystore_selected(ipoin1D),zstore_selected(ipoin1D)
- enddo
-
! put flag to indicate end of the list of points
write(10,*) '0 0 0. 0. 0.'
@@ -317,24 +336,30 @@
if(.not. mask_ibool(ibool(ix,iy,iz,ispec))) then
mask_ibool(ibool(ix,iy,iz,ispec)) = .true.
npoin1D = npoin1D + 1
- ibool_selected(npoin1D) = ibool(ix,iy,iz,ispec)
- xstore_selected(npoin1D) = xstore(ix,iy,iz,ispec)
- ystore_selected(npoin1D) = ystore(ix,iy,iz,ispec)
- zstore_selected(npoin1D) = zstore(ix,iy,iz,ispec)
+ if (PERFORM_CUTHILL_MCKEE) then
+ ibool_selected(npoin1D) = ibool(ix,iy,iz,ispec)
+ xstore_selected(npoin1D) = xstore(ix,iy,iz,ispec)
+ ystore_selected(npoin1D) = ystore(ix,iy,iz,ispec)
+ zstore_selected(npoin1D) = zstore(ix,iy,iz,ispec)
+ else
+ write(10,*) ibool(ispec), xstore(ispec), &
+ ystore(ispec),zstore(ispec)
+ endif
endif
enddo
endif
enddo
- nglob=nglob_ori
- call sort_array_coordinates(npoin1D,xstore_selected,ystore_selected,zstore_selected, &
- ibool_selected,iglob,locval,ifseg,nglob,ind,ninseg,iwork,work)
+ if (PERFORM_CUTHILL_MCKEE) then
+ call sort_array_coordinates(npoin1D,xstore_selected,ystore_selected,zstore_selected, &
+ ibool_selected,iglob,locval,ifseg,nglob,ind,ninseg,iwork,work)
+
+ do ipoin1D=1,npoin1D
+ write(10,*) ibool_selected(ipoin1D), xstore_selected(ipoin1D), &
+ ystore_selected(ipoin1D),zstore_selected(ipoin1D)
+ enddo
+ endif
- do ipoin1D=1,npoin1D
- write(10,*) ibool_selected(ipoin1D), xstore_selected(ipoin1D), &
- ystore_selected(ipoin1D),zstore_selected(ipoin1D)
- enddo
-
! put flag to indicate end of the list of points
write(10,*) '0 0 0. 0. 0.'
@@ -347,17 +372,19 @@
if(ispeccount /= NSPEC1D_RADIAL_CORNER(iregion,3) .or. npoin1D /= NGLOB1D_RADIAL_CORNER(iregion,3)) &
call exit_MPI(myrank,'error MPI 1D buffer detection in xi=right')
- deallocate(ibool_selected)
- deallocate(xstore_selected)
- deallocate(ystore_selected)
- deallocate(zstore_selected)
- deallocate(ind)
- deallocate(ninseg)
- deallocate(iglob)
- deallocate(locval)
- deallocate(ifseg)
- deallocate(iwork)
- deallocate(work)
+ if (PERFORM_CUTHILL_MCKEE) then
+ deallocate(ibool_selected)
+ deallocate(xstore_selected)
+ deallocate(ystore_selected)
+ deallocate(zstore_selected)
+ deallocate(ind)
+ deallocate(ninseg)
+ deallocate(iglob)
+ deallocate(locval)
+ deallocate(ifseg)
+ deallocate(iwork)
+ deallocate(work)
+ endif
end subroutine get_MPI_1D_buffers
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/get_MPI_cutplanes_eta.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/get_MPI_cutplanes_eta.f90 2008-04-10 00:01:46 UTC (rev 11791)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/get_MPI_cutplanes_eta.f90 2008-04-10 09:36:18 UTC (rev 11792)
@@ -27,7 +27,7 @@
subroutine get_MPI_cutplanes_eta(myrank,prname,nspec,iMPIcut_eta,ibool, &
xstore,ystore,zstore,mask_ibool,npointot, &
- NSPEC2D_XI_FACE,iregion,NGLOB2DMAX_XY,nglob_ori)
+ NSPEC2D_XI_FACE,iregion,NGLOB2DMAX_XY)
! this routine detects cut planes along eta
! In principle the left cut plane of the first slice
@@ -38,7 +38,7 @@
include "constants.h"
- integer nspec,myrank,nglob_ori,nglob,ipoin2D,NGLOB2DMAX_XY,iregion
+ integer nspec,myrank,nglob,ipoin2D,NGLOB2DMAX_XY,iregion
integer, dimension(MAX_NUM_REGIONS,NB_SQUARE_EDGES_ONEDIR) :: NSPEC2D_XI_FACE
@@ -74,17 +74,19 @@
! allocate arrays for message buffers with maximum size
! define maximum size for message buffers
- allocate(ibool_selected(NGLOB2DMAX_XY))
- allocate(xstore_selected(NGLOB2DMAX_XY))
- allocate(ystore_selected(NGLOB2DMAX_XY))
- allocate(zstore_selected(NGLOB2DMAX_XY))
- allocate(ind(NGLOB2DMAX_XY))
- allocate(ninseg(NGLOB2DMAX_XY))
- allocate(iglob(NGLOB2DMAX_XY))
- allocate(locval(NGLOB2DMAX_XY))
- allocate(ifseg(NGLOB2DMAX_XY))
- allocate(iwork(NGLOB2DMAX_XY))
- allocate(work(NGLOB2DMAX_XY))
+ if (PERFORM_CUTHILL_MCKEE) then
+ allocate(ibool_selected(NGLOB2DMAX_XY))
+ allocate(xstore_selected(NGLOB2DMAX_XY))
+ allocate(ystore_selected(NGLOB2DMAX_XY))
+ allocate(zstore_selected(NGLOB2DMAX_XY))
+ allocate(ind(NGLOB2DMAX_XY))
+ allocate(ninseg(NGLOB2DMAX_XY))
+ allocate(iglob(NGLOB2DMAX_XY))
+ allocate(locval(NGLOB2DMAX_XY))
+ allocate(ifseg(NGLOB2DMAX_XY))
+ allocate(iwork(NGLOB2DMAX_XY))
+ allocate(work(NGLOB2DMAX_XY))
+ endif
! theoretical number of surface elements in the buffers
! cut planes along eta=constant correspond to XI faces
@@ -120,25 +122,31 @@
if(.not. mask_ibool(ibool(ix,iy,iz,ispec))) then
mask_ibool(ibool(ix,iy,iz,ispec)) = .true.
npoin2D_eta = npoin2D_eta + 1
- ibool_selected(npoin2D_eta) = ibool(ix,iy,iz,ispec)
- xstore_selected(npoin2D_eta) = xstore(ix,iy,iz,ispec)
- ystore_selected(npoin2D_eta) = ystore(ix,iy,iz,ispec)
- zstore_selected(npoin2D_eta) = zstore(ix,iy,iz,ispec)
+ if (PERFORM_CUTHILL_MCKEE) then
+ ibool_selected(npoin2D_eta) = ibool(ix,iy,iz,ispec)
+ xstore_selected(npoin2D_eta) = xstore(ix,iy,iz,ispec)
+ ystore_selected(npoin2D_eta) = ystore(ix,iy,iz,ispec)
+ zstore_selected(npoin2D_eta) = zstore(ix,iy,iz,ispec)
+ else
+ write(10,*) ibool(ispec), xstore(ispec), &
+ ystore(ispec),zstore(ispec)
+ endif
endif
enddo
enddo
endif
enddo
- nglob=nglob_ori
- call sort_array_coordinates(npoin2D_eta,xstore_selected,ystore_selected,zstore_selected, &
- ibool_selected,iglob,locval,ifseg,nglob,ind,ninseg,iwork,work)
+ if (PERFORM_CUTHILL_MCKEE) then
+ call sort_array_coordinates(npoin2D_eta,xstore_selected,ystore_selected,zstore_selected, &
+ ibool_selected,iglob,locval,ifseg,nglob,ind,ninseg,iwork,work)
+
+ do ipoin2D=1,npoin2D_eta
+ write(10,*) ibool_selected(ipoin2D), xstore_selected(ipoin2D), &
+ ystore_selected(ipoin2D),zstore_selected(ipoin2D)
+ enddo
+ endif
- do ipoin2D=1,npoin2D_eta
- write(10,*) ibool_selected(ipoin2D), xstore_selected(ipoin2D), &
- ystore_selected(ipoin2D),zstore_selected(ipoin2D)
- enddo
-
! put flag to indicate end of the list of points
write(10,*) '0 0 0. 0. 0.'
@@ -178,25 +186,31 @@
if(.not. mask_ibool(ibool(ix,iy,iz,ispec))) then
mask_ibool(ibool(ix,iy,iz,ispec)) = .true.
npoin2D_eta = npoin2D_eta + 1
- ibool_selected(npoin2D_eta) = ibool(ix,iy,iz,ispec)
- xstore_selected(npoin2D_eta) = xstore(ix,iy,iz,ispec)
- ystore_selected(npoin2D_eta) = ystore(ix,iy,iz,ispec)
- zstore_selected(npoin2D_eta) = zstore(ix,iy,iz,ispec)
+ if (PERFORM_CUTHILL_MCKEE) then
+ ibool_selected(npoin2D_eta) = ibool(ix,iy,iz,ispec)
+ xstore_selected(npoin2D_eta) = xstore(ix,iy,iz,ispec)
+ ystore_selected(npoin2D_eta) = ystore(ix,iy,iz,ispec)
+ zstore_selected(npoin2D_eta) = zstore(ix,iy,iz,ispec)
+ else
+ write(10,*) ibool(ispec), xstore(ispec), &
+ ystore(ispec),zstore(ispec)
+ endif
endif
enddo
enddo
endif
enddo
- nglob=nglob_ori
- call sort_array_coordinates(npoin2D_eta,xstore_selected,ystore_selected,zstore_selected, &
- ibool_selected,iglob,locval,ifseg,nglob,ind,ninseg,iwork,work)
+ if (PERFORM_CUTHILL_MCKEE) then
+ call sort_array_coordinates(npoin2D_eta,xstore_selected,ystore_selected,zstore_selected, &
+ ibool_selected,iglob,locval,ifseg,nglob,ind,ninseg,iwork,work)
+
+ do ipoin2D=1,npoin2D_eta
+ write(10,*) ibool_selected(ipoin2D), xstore_selected(ipoin2D), &
+ ystore_selected(ipoin2D),zstore_selected(ipoin2D)
+ enddo
+ endif
- do ipoin2D=1,npoin2D_eta
- write(10,*) ibool_selected(ipoin2D), xstore_selected(ipoin2D), &
- ystore_selected(ipoin2D),zstore_selected(ipoin2D)
- enddo
-
! put flag to indicate end of the list of points
write(10,*) '0 0 0. 0. 0.'
@@ -208,17 +222,19 @@
! compare number of surface elements detected to analytical value
if(ispecc2 /= nspec2Dtheor) call exit_MPI(myrank,'error MPI cut-planes detection in eta=right')
- deallocate(ibool_selected)
- deallocate(xstore_selected)
- deallocate(ystore_selected)
- deallocate(zstore_selected)
- deallocate(ind)
- deallocate(ninseg)
- deallocate(iglob)
- deallocate(locval)
- deallocate(ifseg)
- deallocate(iwork)
- deallocate(work)
+ if (PERFORM_CUTHILL_MCKEE) then
+ deallocate(ibool_selected)
+ deallocate(xstore_selected)
+ deallocate(ystore_selected)
+ deallocate(zstore_selected)
+ deallocate(ind)
+ deallocate(ninseg)
+ deallocate(iglob)
+ deallocate(locval)
+ deallocate(ifseg)
+ deallocate(iwork)
+ deallocate(work)
+ endif
end subroutine get_MPI_cutplanes_eta
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/get_MPI_cutplanes_xi.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/get_MPI_cutplanes_xi.f90 2008-04-10 00:01:46 UTC (rev 11791)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/get_MPI_cutplanes_xi.f90 2008-04-10 09:36:18 UTC (rev 11792)
@@ -27,7 +27,7 @@
subroutine get_MPI_cutplanes_xi(myrank,prname,nspec,iMPIcut_xi,ibool, &
xstore,ystore,zstore,mask_ibool,npointot, &
- NSPEC2D_ETA_FACE,iregion,NGLOB2DMAX_XY,nglob_ori)
+ NSPEC2D_ETA_FACE,iregion,NGLOB2DMAX_XY)
! this routine detects cut planes along xi
! In principle the left cut plane of the first slice
@@ -38,7 +38,7 @@
include "constants.h"
- integer nspec,myrank,nglob_ori,nglob,ipoin2D,iregion
+ integer nspec,myrank,nglob,ipoin2D,iregion
integer, dimension(MAX_NUM_REGIONS,NB_SQUARE_EDGES_ONEDIR) :: NSPEC2D_ETA_FACE
logical iMPIcut_xi(2,nspec)
@@ -73,17 +73,19 @@
! allocate arrays for message buffers with maximum size
! define maximum size for message buffers
- allocate(ibool_selected(NGLOB2DMAX_XY))
- allocate(xstore_selected(NGLOB2DMAX_XY))
- allocate(ystore_selected(NGLOB2DMAX_XY))
- allocate(zstore_selected(NGLOB2DMAX_XY))
- allocate(ind(NGLOB2DMAX_XY))
- allocate(ninseg(NGLOB2DMAX_XY))
- allocate(iglob(NGLOB2DMAX_XY))
- allocate(locval(NGLOB2DMAX_XY))
- allocate(ifseg(NGLOB2DMAX_XY))
- allocate(iwork(NGLOB2DMAX_XY))
- allocate(work(NGLOB2DMAX_XY))
+ if (PERFORM_CUTHILL_MCKEE) then
+ allocate(ibool_selected(NGLOB2DMAX_XY))
+ allocate(xstore_selected(NGLOB2DMAX_XY))
+ allocate(ystore_selected(NGLOB2DMAX_XY))
+ allocate(zstore_selected(NGLOB2DMAX_XY))
+ allocate(ind(NGLOB2DMAX_XY))
+ allocate(ninseg(NGLOB2DMAX_XY))
+ allocate(iglob(NGLOB2DMAX_XY))
+ allocate(locval(NGLOB2DMAX_XY))
+ allocate(ifseg(NGLOB2DMAX_XY))
+ allocate(iwork(NGLOB2DMAX_XY))
+ allocate(work(NGLOB2DMAX_XY))
+ endif
! theoretical number of surface elements in the buffers
@@ -119,25 +121,31 @@
if(.not. mask_ibool(ibool(ix,iy,iz,ispec))) then
mask_ibool(ibool(ix,iy,iz,ispec)) = .true.
npoin2D_xi = npoin2D_xi + 1
- ibool_selected(npoin2D_xi) = ibool(ix,iy,iz,ispec)
- xstore_selected(npoin2D_xi) = xstore(ix,iy,iz,ispec)
- ystore_selected(npoin2D_xi) = ystore(ix,iy,iz,ispec)
- zstore_selected(npoin2D_xi) = zstore(ix,iy,iz,ispec)
+ if (PERFORM_CUTHILL_MCKEE) then
+ ibool_selected(npoin2D_xi) = ibool(ix,iy,iz,ispec)
+ xstore_selected(npoin2D_xi) = xstore(ix,iy,iz,ispec)
+ ystore_selected(npoin2D_xi) = ystore(ix,iy,iz,ispec)
+ zstore_selected(npoin2D_xi) = zstore(ix,iy,iz,ispec)
+ else
+ write(10,*) ibool(ispec), xstore(ispec), &
+ ystore(ispec),zstore(ispec)
+ endif
endif
enddo
enddo
endif
enddo
- nglob=nglob_ori
- call sort_array_coordinates(npoin2D_xi,xstore_selected,ystore_selected,zstore_selected, &
- ibool_selected,iglob,locval,ifseg,nglob,ind,ninseg,iwork,work)
+ if (PERFORM_CUTHILL_MCKEE) then
+ call sort_array_coordinates(npoin2D_xi,xstore_selected,ystore_selected,zstore_selected, &
+ ibool_selected,iglob,locval,ifseg,nglob,ind,ninseg,iwork,work)
+
+ do ipoin2D=1,npoin2D_xi
+ write(10,*) ibool_selected(ipoin2D), xstore_selected(ipoin2D), &
+ ystore_selected(ipoin2D),zstore_selected(ipoin2D)
+ enddo
+ endif
- do ipoin2D=1,npoin2D_xi
- write(10,*) ibool_selected(ipoin2D), xstore_selected(ipoin2D), &
- ystore_selected(ipoin2D),zstore_selected(ipoin2D)
- enddo
-
! put flag to indicate end of the list of points
write(10,*) '0 0 0. 0. 0.'
@@ -179,26 +187,32 @@
if(.not. mask_ibool(ibool(ix,iy,iz,ispec))) then
mask_ibool(ibool(ix,iy,iz,ispec)) = .true.
npoin2D_xi = npoin2D_xi + 1
- ibool_selected(npoin2D_xi) = ibool(ix,iy,iz,ispec)
- xstore_selected(npoin2D_xi) = xstore(ix,iy,iz,ispec)
- ystore_selected(npoin2D_xi) = ystore(ix,iy,iz,ispec)
- zstore_selected(npoin2D_xi) = zstore(ix,iy,iz,ispec)
+ if (PERFORM_CUTHILL_MCKEE) then
+ ibool_selected(npoin2D_xi) = ibool(ix,iy,iz,ispec)
+ xstore_selected(npoin2D_xi) = xstore(ix,iy,iz,ispec)
+ ystore_selected(npoin2D_xi) = ystore(ix,iy,iz,ispec)
+ zstore_selected(npoin2D_xi) = zstore(ix,iy,iz,ispec)
+ else
+ write(10,*) ibool(ispec), xstore(ispec), &
+ ystore(ispec),zstore(ispec)
+ endif
endif
enddo
enddo
endif
enddo
- nglob=nglob_ori
- call sort_array_coordinates(npoin2D_xi,xstore_selected,ystore_selected,zstore_selected, &
- ibool_selected,iglob,locval,ifseg,nglob,ind,ninseg,iwork,work)
+ if (PERFORM_CUTHILL_MCKEE) then
+ call sort_array_coordinates(npoin2D_xi,xstore_selected,ystore_selected,zstore_selected, &
+ ibool_selected,iglob,locval,ifseg,nglob,ind,ninseg,iwork,work)
+
+ do ipoin2D=1,npoin2D_xi
+ write(10,*) ibool_selected(ipoin2D), xstore_selected(ipoin2D), &
+ ystore_selected(ipoin2D),zstore_selected(ipoin2D)
+ enddo
+ endif
- do ipoin2D=1,npoin2D_xi
- write(10,*) ibool_selected(ipoin2D), xstore_selected(ipoin2D), &
- ystore_selected(ipoin2D),zstore_selected(ipoin2D)
- enddo
-
! put flag to indicate end of the list of points
write(10,*) '0 0 0. 0. 0.'
@@ -213,17 +227,19 @@
call exit_MPI(myrank,errmsg)
endif
- deallocate(ibool_selected)
- deallocate(xstore_selected)
- deallocate(ystore_selected)
- deallocate(zstore_selected)
- deallocate(ind)
- deallocate(ninseg)
- deallocate(iglob)
- deallocate(locval)
- deallocate(ifseg)
- deallocate(iwork)
- deallocate(work)
+ if (PERFORM_CUTHILL_MCKEE) then
+ deallocate(ibool_selected)
+ deallocate(xstore_selected)
+ deallocate(ystore_selected)
+ deallocate(zstore_selected)
+ deallocate(ind)
+ deallocate(ninseg)
+ deallocate(iglob)
+ deallocate(locval)
+ deallocate(ifseg)
+ deallocate(iwork)
+ deallocate(work)
+ endif
end subroutine get_MPI_cutplanes_xi
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/get_jacobian_boundaries.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/get_jacobian_boundaries.f90 2008-04-10 00:01:46 UTC (rev 11791)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/get_jacobian_boundaries.f90 2008-04-10 09:36:18 UTC (rev 11792)
@@ -143,37 +143,38 @@
call compute_jacobian_2D(myrank,ispecb1,xelm,yelm,zelm,dershape2D_x, &
jacobian2D_xmin,normal_xmin,NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX)
- allocate (xstore_selected(ispecb1))
- allocate (ystore_selected(ispecb1))
- allocate (zstore_selected(ispecb1))
- allocate(ind(ispecb1))
- allocate(ninseg(ispecb1))
- allocate(iglob(ispecb1))
- allocate(locval(ispecb1))
- allocate(ifseg(ispecb1))
- allocate(iwork(ispecb1))
- allocate(work(ispecb1))
-
- do ispec_tmp=1,ispecb1
- xstore_selected(ispec_tmp) = xstore(1,1,1,ibelm_xmin(ispec_tmp))
- ystore_selected(ispec_tmp) = ystore(1,1,1,ibelm_xmin(ispec_tmp))
- zstore_selected(ispec_tmp) = zstore(1,1,1,ibelm_xmin(ispec_tmp))
- enddo
-
- call sort_array_coordinates_gjb(ispecb1,xstore_selected,ystore_selected,zstore_selected, &
- ibelm_xmin,iglob,normal_xmin,jacobian2D_xmin,locval,ifseg,dummy_var,ind,ninseg,iwork,work,NGLLY,NGLLZ)
-
- deallocate (xstore_selected)
- deallocate (ystore_selected)
- deallocate (zstore_selected)
- deallocate(ind)
- deallocate(ninseg)
- deallocate(iglob)
- deallocate(locval)
- deallocate(ifseg)
- deallocate(iwork)
- deallocate(work)
-
+ if (PERFORM_CUTHILL_MCKEE) then
+ allocate (xstore_selected(ispecb1))
+ allocate (ystore_selected(ispecb1))
+ allocate (zstore_selected(ispecb1))
+ allocate(ind(ispecb1))
+ allocate(ninseg(ispecb1))
+ allocate(iglob(ispecb1))
+ allocate(locval(ispecb1))
+ allocate(ifseg(ispecb1))
+ allocate(iwork(ispecb1))
+ allocate(work(ispecb1))
+
+ do ispec_tmp=1,ispecb1
+ xstore_selected(ispec_tmp) = xstore(1,1,1,ibelm_xmin(ispec_tmp))
+ ystore_selected(ispec_tmp) = ystore(1,1,1,ibelm_xmin(ispec_tmp))
+ zstore_selected(ispec_tmp) = zstore(1,1,1,ibelm_xmin(ispec_tmp))
+ enddo
+
+ call sort_array_coordinates_gjb(ispecb1,xstore_selected,ystore_selected,zstore_selected, &
+ ibelm_xmin,iglob,normal_xmin,jacobian2D_xmin,locval,ifseg,dummy_var,ind,ninseg,iwork,work,NGLLY,NGLLZ)
+
+ deallocate (xstore_selected)
+ deallocate (ystore_selected)
+ deallocate (zstore_selected)
+ deallocate(ind)
+ deallocate(ninseg)
+ deallocate(iglob)
+ deallocate(locval)
+ deallocate(ifseg)
+ deallocate(iwork)
+ deallocate(work)
+ endif
endif
! on boundary: xmax
@@ -215,37 +216,38 @@
call compute_jacobian_2D(myrank,ispecb2,xelm,yelm,zelm,dershape2D_x, &
jacobian2D_xmax,normal_xmax,NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX)
- allocate (xstore_selected(ispecb2))
- allocate (ystore_selected(ispecb2))
- allocate (zstore_selected(ispecb2))
- allocate(ind(ispecb2))
- allocate(ninseg(ispecb2))
- allocate(iglob(ispecb2))
- allocate(locval(ispecb2))
- allocate(ifseg(ispecb2))
- allocate(iwork(ispecb2))
- allocate(work(ispecb2))
-
- do ispec_tmp=1,ispecb2
- xstore_selected(ispec_tmp) = xstore(1,1,1,ibelm_xmax(ispec_tmp))
- ystore_selected(ispec_tmp) = ystore(1,1,1,ibelm_xmax(ispec_tmp))
- zstore_selected(ispec_tmp) = zstore(1,1,1,ibelm_xmax(ispec_tmp))
- enddo
-
- call sort_array_coordinates_gjb(ispecb2,xstore_selected,ystore_selected,zstore_selected, &
- ibelm_xmax,iglob,normal_xmax,jacobian2D_xmax,locval,ifseg,dummy_var,ind,ninseg,iwork,work,NGLLY,NGLLZ)
-
- deallocate (xstore_selected)
- deallocate (ystore_selected)
- deallocate (zstore_selected)
- deallocate(ind)
- deallocate(ninseg)
- deallocate(iglob)
- deallocate(locval)
- deallocate(ifseg)
- deallocate(iwork)
- deallocate(work)
-
+ if (PERFORM_CUTHILL_MCKEE) then
+ allocate (xstore_selected(ispecb2))
+ allocate (ystore_selected(ispecb2))
+ allocate (zstore_selected(ispecb2))
+ allocate(ind(ispecb2))
+ allocate(ninseg(ispecb2))
+ allocate(iglob(ispecb2))
+ allocate(locval(ispecb2))
+ allocate(ifseg(ispecb2))
+ allocate(iwork(ispecb2))
+ allocate(work(ispecb2))
+
+ do ispec_tmp=1,ispecb2
+ xstore_selected(ispec_tmp) = xstore(1,1,1,ibelm_xmax(ispec_tmp))
+ ystore_selected(ispec_tmp) = ystore(1,1,1,ibelm_xmax(ispec_tmp))
+ zstore_selected(ispec_tmp) = zstore(1,1,1,ibelm_xmax(ispec_tmp))
+ enddo
+
+ call sort_array_coordinates_gjb(ispecb2,xstore_selected,ystore_selected,zstore_selected, &
+ ibelm_xmax,iglob,normal_xmax,jacobian2D_xmax,locval,ifseg,dummy_var,ind,ninseg,iwork,work,NGLLY,NGLLZ)
+
+ deallocate (xstore_selected)
+ deallocate (ystore_selected)
+ deallocate (zstore_selected)
+ deallocate(ind)
+ deallocate(ninseg)
+ deallocate(iglob)
+ deallocate(locval)
+ deallocate(ifseg)
+ deallocate(iwork)
+ deallocate(work)
+ endif
endif
! on boundary: ymin
@@ -287,37 +289,38 @@
call compute_jacobian_2D(myrank,ispecb3,xelm,yelm,zelm,dershape2D_y, &
jacobian2D_ymin,normal_ymin,NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX)
- allocate (xstore_selected(ispecb3))
- allocate (ystore_selected(ispecb3))
- allocate (zstore_selected(ispecb3))
- allocate(ind(ispecb3))
- allocate(ninseg(ispecb3))
- allocate(iglob(ispecb3))
- allocate(locval(ispecb3))
- allocate(ifseg(ispecb3))
- allocate(iwork(ispecb3))
- allocate(work(ispecb3))
-
- do ispec_tmp=1,ispecb3
- xstore_selected(ispec_tmp) = xstore(1,1,1,ibelm_ymin(ispec_tmp))
- ystore_selected(ispec_tmp) = ystore(1,1,1,ibelm_ymin(ispec_tmp))
- zstore_selected(ispec_tmp) = zstore(1,1,1,ibelm_ymin(ispec_tmp))
- enddo
-
- call sort_array_coordinates_gjb(ispecb3,xstore_selected,ystore_selected,zstore_selected, &
- ibelm_ymin,iglob,normal_ymin,jacobian2D_ymin,locval,ifseg,dummy_var,ind,ninseg,iwork,work,NGLLX,NGLLZ)
-
- deallocate (xstore_selected)
- deallocate (ystore_selected)
- deallocate (zstore_selected)
- deallocate(ind)
- deallocate(ninseg)
- deallocate(iglob)
- deallocate(locval)
- deallocate(ifseg)
- deallocate(iwork)
- deallocate(work)
-
+ if (PERFORM_CUTHILL_MCKEE) then
+ allocate (xstore_selected(ispecb3))
+ allocate (ystore_selected(ispecb3))
+ allocate (zstore_selected(ispecb3))
+ allocate(ind(ispecb3))
+ allocate(ninseg(ispecb3))
+ allocate(iglob(ispecb3))
+ allocate(locval(ispecb3))
+ allocate(ifseg(ispecb3))
+ allocate(iwork(ispecb3))
+ allocate(work(ispecb3))
+
+ do ispec_tmp=1,ispecb3
+ xstore_selected(ispec_tmp) = xstore(1,1,1,ibelm_ymin(ispec_tmp))
+ ystore_selected(ispec_tmp) = ystore(1,1,1,ibelm_ymin(ispec_tmp))
+ zstore_selected(ispec_tmp) = zstore(1,1,1,ibelm_ymin(ispec_tmp))
+ enddo
+
+ call sort_array_coordinates_gjb(ispecb3,xstore_selected,ystore_selected,zstore_selected, &
+ ibelm_ymin,iglob,normal_ymin,jacobian2D_ymin,locval,ifseg,dummy_var,ind,ninseg,iwork,work,NGLLX,NGLLZ)
+
+ deallocate (xstore_selected)
+ deallocate (ystore_selected)
+ deallocate (zstore_selected)
+ deallocate(ind)
+ deallocate(ninseg)
+ deallocate(iglob)
+ deallocate(locval)
+ deallocate(ifseg)
+ deallocate(iwork)
+ deallocate(work)
+ endif
endif
! on boundary: ymax
@@ -359,37 +362,38 @@
call compute_jacobian_2D(myrank,ispecb4,xelm,yelm,zelm,dershape2D_y, &
jacobian2D_ymax,normal_ymax,NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX)
- allocate (xstore_selected(ispecb4))
- allocate (ystore_selected(ispecb4))
- allocate (zstore_selected(ispecb4))
- allocate(ind(ispecb4))
- allocate(ninseg(ispecb4))
- allocate(iglob(ispecb4))
- allocate(locval(ispecb4))
- allocate(ifseg(ispecb4))
- allocate(iwork(ispecb4))
- allocate(work(ispecb4))
-
- do ispec_tmp=1,ispecb4
- xstore_selected(ispec_tmp) = xstore(1,1,1,ibelm_ymax(ispec_tmp))
- ystore_selected(ispec_tmp) = ystore(1,1,1,ibelm_ymax(ispec_tmp))
- zstore_selected(ispec_tmp) = zstore(1,1,1,ibelm_ymax(ispec_tmp))
- enddo
-
- call sort_array_coordinates_gjb(ispecb4,xstore_selected,ystore_selected,zstore_selected, &
- ibelm_ymax,iglob,normal_ymax,jacobian2D_ymax,locval,ifseg,dummy_var,ind,ninseg,iwork,work,NGLLX,NGLLZ)
-
- deallocate (xstore_selected)
- deallocate (ystore_selected)
- deallocate (zstore_selected)
- deallocate(ind)
- deallocate(ninseg)
- deallocate(iglob)
- deallocate(locval)
- deallocate(ifseg)
- deallocate(iwork)
- deallocate(work)
-
+ if (PERFORM_CUTHILL_MCKEE) then
+ allocate (xstore_selected(ispecb4))
+ allocate (ystore_selected(ispecb4))
+ allocate (zstore_selected(ispecb4))
+ allocate(ind(ispecb4))
+ allocate(ninseg(ispecb4))
+ allocate(iglob(ispecb4))
+ allocate(locval(ispecb4))
+ allocate(ifseg(ispecb4))
+ allocate(iwork(ispecb4))
+ allocate(work(ispecb4))
+
+ do ispec_tmp=1,ispecb4
+ xstore_selected(ispec_tmp) = xstore(1,1,1,ibelm_ymax(ispec_tmp))
+ ystore_selected(ispec_tmp) = ystore(1,1,1,ibelm_ymax(ispec_tmp))
+ zstore_selected(ispec_tmp) = zstore(1,1,1,ibelm_ymax(ispec_tmp))
+ enddo
+
+ call sort_array_coordinates_gjb(ispecb4,xstore_selected,ystore_selected,zstore_selected, &
+ ibelm_ymax,iglob,normal_ymax,jacobian2D_ymax,locval,ifseg,dummy_var,ind,ninseg,iwork,work,NGLLX,NGLLZ)
+
+ deallocate (xstore_selected)
+ deallocate (ystore_selected)
+ deallocate (zstore_selected)
+ deallocate(ind)
+ deallocate(ninseg)
+ deallocate(iglob)
+ deallocate(locval)
+ deallocate(ifseg)
+ deallocate(iwork)
+ deallocate(work)
+ endif
endif
! on boundary: bottom
@@ -430,37 +434,38 @@
call compute_jacobian_2D(myrank,ispecb5,xelm,yelm,zelm,dershape2D_bottom, &
jacobian2D_bottom,normal_bottom,NGLLX,NGLLY,NSPEC2D_BOTTOM)
- allocate (xstore_selected(ispecb5))
- allocate (ystore_selected(ispecb5))
- allocate (zstore_selected(ispecb5))
- allocate(ind(ispecb5))
- allocate(ninseg(ispecb5))
- allocate(iglob(ispecb5))
- allocate(locval(ispecb5))
- allocate(ifseg(ispecb5))
- allocate(iwork(ispecb5))
- allocate(work(ispecb5))
-
- do ispec_tmp=1,ispecb5
- xstore_selected(ispec_tmp) = xstore(1,1,1,ibelm_bottom(ispec_tmp))
- ystore_selected(ispec_tmp) = ystore(1,1,1,ibelm_bottom(ispec_tmp))
- zstore_selected(ispec_tmp) = zstore(1,1,1,ibelm_bottom(ispec_tmp))
- enddo
-
- call sort_array_coordinates_gjb(ispecb5,xstore_selected,ystore_selected,zstore_selected, &
- ibelm_bottom,iglob,normal_bottom,jacobian2D_bottom,locval,ifseg,dummy_var,ind,ninseg,iwork,work,NGLLX,NGLLY)
-
- deallocate (xstore_selected)
- deallocate (ystore_selected)
- deallocate (zstore_selected)
- deallocate(ind)
- deallocate(ninseg)
- deallocate(iglob)
- deallocate(locval)
- deallocate(ifseg)
- deallocate(iwork)
- deallocate(work)
-
+ if (PERFORM_CUTHILL_MCKEE) then
+ allocate (xstore_selected(ispecb5))
+ allocate (ystore_selected(ispecb5))
+ allocate (zstore_selected(ispecb5))
+ allocate(ind(ispecb5))
+ allocate(ninseg(ispecb5))
+ allocate(iglob(ispecb5))
+ allocate(locval(ispecb5))
+ allocate(ifseg(ispecb5))
+ allocate(iwork(ispecb5))
+ allocate(work(ispecb5))
+
+ do ispec_tmp=1,ispecb5
+ xstore_selected(ispec_tmp) = xstore(1,1,1,ibelm_bottom(ispec_tmp))
+ ystore_selected(ispec_tmp) = ystore(1,1,1,ibelm_bottom(ispec_tmp))
+ zstore_selected(ispec_tmp) = zstore(1,1,1,ibelm_bottom(ispec_tmp))
+ enddo
+
+ call sort_array_coordinates_gjb(ispecb5,xstore_selected,ystore_selected,zstore_selected, &
+ ibelm_bottom,iglob,normal_bottom,jacobian2D_bottom,locval,ifseg,dummy_var,ind,ninseg,iwork,work,NGLLX,NGLLY)
+
+ deallocate (xstore_selected)
+ deallocate (ystore_selected)
+ deallocate (zstore_selected)
+ deallocate(ind)
+ deallocate(ninseg)
+ deallocate(iglob)
+ deallocate(locval)
+ deallocate(ifseg)
+ deallocate(iwork)
+ deallocate(work)
+ endif
endif
! on boundary: top
@@ -501,36 +506,38 @@
call compute_jacobian_2D(myrank,ispecb6,xelm,yelm,zelm,dershape2D_top, &
jacobian2D_top,normal_top,NGLLX,NGLLY,NSPEC2D_TOP)
- allocate (xstore_selected(ispecb6))
- allocate (ystore_selected(ispecb6))
- allocate (zstore_selected(ispecb6))
- allocate(ind(ispecb6))
- allocate(ninseg(ispecb6))
- allocate(iglob(ispecb6))
- allocate(locval(ispecb6))
- allocate(ifseg(ispecb6))
- allocate(iwork(ispecb6))
- allocate(work(ispecb6))
-
- do ispec_tmp=1,ispecb6
- xstore_selected(ispec_tmp) = xstore(1,1,1,ibelm_top(ispec_tmp))
- ystore_selected(ispec_tmp) = ystore(1,1,1,ibelm_top(ispec_tmp))
- zstore_selected(ispec_tmp) = zstore(1,1,1,ibelm_top(ispec_tmp))
- enddo
-
- call sort_array_coordinates_gjb(ispecb6,xstore_selected,ystore_selected,zstore_selected, &
- ibelm_top,iglob,normal_top,jacobian2D_top,locval,ifseg,dummy_var,ind,ninseg,iwork,work,NGLLX,NGLLY)
-
- deallocate (xstore_selected)
- deallocate (ystore_selected)
- deallocate (zstore_selected)
- deallocate(ind)
- deallocate(ninseg)
- deallocate(iglob)
- deallocate(locval)
- deallocate(ifseg)
- deallocate(iwork)
- deallocate(work)
+ if (PERFORM_CUTHILL_MCKEE) then
+ allocate (xstore_selected(ispecb6))
+ allocate (ystore_selected(ispecb6))
+ allocate (zstore_selected(ispecb6))
+ allocate(ind(ispecb6))
+ allocate(ninseg(ispecb6))
+ allocate(iglob(ispecb6))
+ allocate(locval(ispecb6))
+ allocate(ifseg(ispecb6))
+ allocate(iwork(ispecb6))
+ allocate(work(ispecb6))
+
+ do ispec_tmp=1,ispecb6
+ xstore_selected(ispec_tmp) = xstore(1,1,1,ibelm_top(ispec_tmp))
+ ystore_selected(ispec_tmp) = ystore(1,1,1,ibelm_top(ispec_tmp))
+ zstore_selected(ispec_tmp) = zstore(1,1,1,ibelm_top(ispec_tmp))
+ enddo
+
+ call sort_array_coordinates_gjb(ispecb6,xstore_selected,ystore_selected,zstore_selected, &
+ ibelm_top,iglob,normal_top,jacobian2D_top,locval,ifseg,dummy_var,ind,ninseg,iwork,work,NGLLX,NGLLY)
+
+ deallocate (xstore_selected)
+ deallocate (ystore_selected)
+ deallocate (zstore_selected)
+ deallocate(ind)
+ deallocate(ninseg)
+ deallocate(iglob)
+ deallocate(locval)
+ deallocate(ifseg)
+ deallocate(iwork)
+ deallocate(work)
+ endif
endif
enddo
More information about the cig-commits
mailing list