[cig-commits] r18195 - in seismo/3D/SPECFEM3D/trunk: . src/decompose_mesh_SCOTCH src/generate_databases src/shared src/specfem3D
danielpeter at geodynamics.org
danielpeter at geodynamics.org
Thu Apr 7 09:14:32 PDT 2011
Author: danielpeter
Date: 2011-04-07 09:14:32 -0700 (Thu, 07 Apr 2011)
New Revision: 18195
Modified:
seismo/3D/SPECFEM3D/trunk/config.h.in
seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/decompose_mesh_SCOTCH.f90
seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/part_decompose_mesh_SCOTCH.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_MPI.f90
seismo/3D/SPECFEM3D/trunk/src/shared/assemble_MPI_scalar.f90
seismo/3D/SPECFEM3D/trunk/src/shared/check_mesh_resolution.f90
seismo/3D/SPECFEM3D/trunk/src/shared/combine_vol_data.f90
seismo/3D/SPECFEM3D/trunk/src/shared/detect_surface.f90
seismo/3D/SPECFEM3D/trunk/src/shared/get_attenuation_model.f90
seismo/3D/SPECFEM3D/trunk/src/shared/prepare_assemble_MPI.f90
seismo/3D/SPECFEM3D/trunk/src/shared/smooth_vol_data.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_acoustic.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_elastic.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_elastic_Dev.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_stacey_elastic.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/detect_mesh_surfaces.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_receivers.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/noise_tomography.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_topography_bathymetry.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/setup_movie_meshes.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/setup_sources_receivers.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_movie_output.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_seismograms.f90
Log:
removes trailing white spaces in source code files
Modified: seismo/3D/SPECFEM3D/trunk/config.h.in
===================================================================
--- seismo/3D/SPECFEM3D/trunk/config.h.in 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/config.h.in 2011-04-07 16:14:32 UTC (rev 18195)
@@ -51,4 +51,4 @@
#undef YYTEXT_POINTER
/* Uncomment and define to select optimized file i/o for regional simulations */
-#define USE_MAP_FUNCTION
+#define USE_MAP_FUNCTION
Modified: seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/decompose_mesh_SCOTCH.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/decompose_mesh_SCOTCH.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/decompose_mesh_SCOTCH.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -128,7 +128,7 @@
! note: be aware that here we can have different node ordering for a cube element;
! the ordering from Cubit files might not be consistent for multiple volumes, or uneven, unstructured grids
!
- ! guess here it assumes that spectral elements ordering is like first
+ ! guess here it assumes that spectral elements ordering is like first
! at the bottom of the element, anticlock-wise, i.e.
! point 1 = (0,0,0), point 2 = (0,1,0), point 3 = (1,1,0), point 4 = (1,0,0)
! then top (positive z-direction) of element
@@ -274,7 +274,7 @@
! undefined materials: have to be listed in decreasing order of material_id (start with -1, -2, etc...)
! format:
! - for interfaces
- ! #material_domain_id #material_id(<0) #type_name (="interface")
+ ! #material_domain_id #material_id(<0) #type_name (="interface")
! #material_id_for_material_below #material_id_for_material_above
! example: 2 -1 interface 1 2
! - for tomography models
@@ -575,7 +575,7 @@
! local parameters
integer, dimension(:),allocatable :: num_material
integer :: ier
-
+
elmnts(:,:) = elmnts(:,:) - 1
! determines maximum neighbors based on 1 common node
@@ -609,7 +609,7 @@
! gets materials id associations
allocate(num_material(1:nspec),stat=ier)
- if( ier /= 0 ) stop 'error allocating array num_material'
+ if( ier /= 0 ) stop 'error allocating array num_material'
num_material(:) = mat(1,:)
! in case of acoustic/elastic simulation, weights elements accordingly
@@ -747,7 +747,7 @@
implicit none
!local parameters
-
+
allocate(my_interfaces(0:ninterfaces-1),stat=ier)
if( ier /= 0 ) stop 'error allocating array my_interfaces'
allocate(my_nb_interfaces(0:ninterfaces-1),stat=ier)
Modified: seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/part_decompose_mesh_SCOTCH.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/part_decompose_mesh_SCOTCH.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/decompose_mesh_SCOTCH/part_decompose_mesh_SCOTCH.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -97,7 +97,7 @@
adjncy(nodes_elmnts(k+j*nsize)*sup_neighbour &
+ xadj(nodes_elmnts(k+j*nsize))) = nodes_elmnts(l+j*nsize)
- xadj(nodes_elmnts(k+j*nsize)) = xadj(nodes_elmnts(k+j*nsize)) + 1
+ xadj(nodes_elmnts(k+j*nsize)) = xadj(nodes_elmnts(k+j*nsize)) + 1
if (xadj(nodes_elmnts(k+j*nsize))>sup_neighbour) &
stop 'ERROR : too much neighbours per element, modify the mesh.'
@@ -144,7 +144,7 @@
integer :: num_glob, num_part, nparts
integer, dimension(0:nparts-1) :: num_loc
integer :: ier
-
+
! allocates local numbering array
allocate(glob2loc_elmnts(0:nelmnts-1),stat=ier)
if( ier /= 0 ) stop 'error allocating array glob2loc_elmnts'
@@ -192,7 +192,7 @@
integer, dimension(0:nparts-1) :: parts_node
integer, dimension(0:nparts-1) :: num_parts
integer :: ier
-
+
allocate(glob2loc_nodes_nparts(0:nnodes),stat=ier)
if( ier /= 0 ) stop 'error allocating array glob2loc_nodes_nparts'
@@ -444,7 +444,7 @@
else
is_acoustic_el_adj = .false.
end if
- ! adds element if neighbor element has same material acoustic/not-acoustic
+ ! adds element if neighbor element has same material acoustic/not-acoustic
! and lies in next partition
if ( (part(adjncy(el_adj)) == num_part_bis) .and. &
(is_acoustic_el .eqv. is_acoustic_el_adj) ) then
@@ -606,7 +606,7 @@
!--------------------------------------------------
- ! Write elements on boundaries (and their four nodes on boundaries)
+ ! Write elements on boundaries (and their four nodes on boundaries)
! pertaining to iproc partition in the corresponding Database
!--------------------------------------------------
subroutine write_boundaries_database(IIN_database, iproc, nelmnts, nspec2D_xmin, nspec2D_xmax, &
@@ -1316,7 +1316,7 @@
integer :: i, iface, ier
integer :: el, el_adj
logical :: is_repartitioned
-
+
! sets acoustic/elastic flags for materials
is_acoustic(:) = .false.
is_elastic(:) = .false.
@@ -1445,11 +1445,11 @@
! temporary flag arrays
! element ids start from 0
allocate( is_moho(0:nelmnts-1),stat=ier)
- if( ier /= 0 ) stop 'error allocating array is_moho'
+ if( ier /= 0 ) stop 'error allocating array is_moho'
! node ids start from 0
allocate( node_is_moho(0:nnodes-1),stat=ier)
if( ier /= 0 ) stop 'error allocating array node_is_moho'
-
+
is_moho(:) = .false.
node_is_moho(:) = .false.
@@ -1493,7 +1493,7 @@
! gets neighbors by 4 common nodes (face)
! contains number of adjacent elements (neighbours)
allocate(xadj(0:nelmnts),stat=ier)
- if( ier /= 0 ) stop 'error allocating array xadj'
+ if( ier /= 0 ) stop 'error allocating array xadj'
! contains all element id indices of adjacent elements
allocate(adjncy(0:sup_neighbour*nelmnts-1),stat=ier)
if( ier /= 0 ) stop 'error allocating array adjncy'
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -776,8 +776,8 @@
subroutine create_regions_mesh_save_moho( myrank,nglob,nspec, &
nspec2D_moho_ext,ibelm_moho,nodes_ibelm_moho, &
nodes_coords_ext_mesh,nnodes_ext_mesh,ibool )
-
- use create_regions_mesh_ext_par
+
+ use create_regions_mesh_ext_par
implicit none
integer :: nspec2D_moho_ext
@@ -789,23 +789,23 @@
! data from the external mesh
integer :: nnodes_ext_mesh
double precision, dimension(NDIM,nnodes_ext_mesh) :: nodes_coords_ext_mesh
-
+
integer, dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
-! local parameters
+! local parameters
! Moho mesh
real(CUSTOM_REAL), dimension(:,:,:),allocatable :: normal_moho_top
real(CUSTOM_REAL), dimension(:,:,:),allocatable :: normal_moho_bot
integer,dimension(:,:,:),allocatable :: ijk_moho_top, ijk_moho_bot
integer,dimension(:),allocatable :: ibelm_moho_top, ibelm_moho_bot
integer :: NSPEC2D_MOHO
- logical, dimension(:),allocatable :: is_moho_top, is_moho_bot
-
- real(kind=CUSTOM_REAL),dimension(NGNOD2D) :: xcoord,ycoord,zcoord
+ logical, dimension(:),allocatable :: is_moho_top, is_moho_bot
+
+ real(kind=CUSTOM_REAL),dimension(NGNOD2D) :: xcoord,ycoord,zcoord
real(kind=CUSTOM_REAL) :: jacobian2Dw_face(NGLLX,NGLLY)
real(kind=CUSTOM_REAL) :: normal_face(NDIM,NGLLX,NGLLY)
real(kind=CUSTOM_REAL),dimension(NDIM):: normal
- integer :: ijk_face(3,NGLLX,NGLLY)
+ integer :: ijk_face(3,NGLLX,NGLLY)
real(kind=CUSTOM_REAL),dimension(:,:),allocatable :: iglob_normals
integer,dimension(:),allocatable:: iglob_is_surface
@@ -814,7 +814,7 @@
integer :: ispec2D,ispec,icorner,iface,i,j,k,igll,iglob,ier
integer :: iglob_midpoint,idirect,counter
integer :: imoho_top_all,imoho_bot_all,imoho_all
-
+
! corners indices of reference cube faces
integer,dimension(3,4),parameter :: iface1_corner_ijk = &
reshape( (/ 1,1,1, 1,NGLLY,1, 1,NGLLY,NGLLZ, 1,1,NGLLZ /),(/3,4/)) ! xmin
@@ -827,29 +827,29 @@
integer,dimension(3,4),parameter :: iface5_corner_ijk = &
reshape( (/ 1,1,1, 1,NGLLY,1, NGLLX,NGLLY,1, NGLLX,1,1 /),(/3,4/)) ! bottom
integer,dimension(3,4),parameter :: iface6_corner_ijk = &
- reshape( (/ 1,1,NGLLZ, NGLLX,1,NGLLZ, NGLLX,NGLLY,NGLLZ, 1,NGLLY,NGLLZ /),(/3,4/)) ! top
+ reshape( (/ 1,1,NGLLZ, NGLLX,1,NGLLZ, NGLLX,NGLLY,NGLLZ, 1,NGLLY,NGLLZ /),(/3,4/)) ! top
integer,dimension(3,4,6),parameter :: iface_all_corner_ijk = &
reshape( (/ iface1_corner_ijk,iface2_corner_ijk, &
iface3_corner_ijk,iface4_corner_ijk, &
iface5_corner_ijk,iface6_corner_ijk /),(/3,4,6/)) ! all faces
- ! midpoint indices for each face (xmin,xmax,ymin,ymax,zmin,zmax)
+ ! midpoint indices for each face (xmin,xmax,ymin,ymax,zmin,zmax)
integer,dimension(3,6),parameter :: iface_all_midpointijk = &
- reshape( (/ 1,2,2, NGLLX,2,2, 2,1,2, 2,NGLLY,2, 2,2,1, 2,2,NGLLZ /),(/3,6/)) ! top
-
+ reshape( (/ 1,2,2, NGLLX,2,2, 2,1,2, 2,NGLLY,2, 2,2,1, 2,2,NGLLZ /),(/3,6/)) ! top
+
! temporary arrays for passing information
allocate(iglob_is_surface(nglob), &
iglob_normals(NDIM,nglob),stat=ier)
if( ier /= 0 ) stop 'error allocating array iglob_is_surface'
-
+
iglob_is_surface = 0
iglob_normals = 0._CUSTOM_REAL
-
+
! loops over given moho surface elements
do ispec2D=1, nspec2D_moho_ext
! gets element id
ispec = ibelm_moho(ispec2D)
-
+
! looks for i,j,k indices of GLL points on boundary face
! determines element face by given CUBIT corners
! (note: uses point locations rather than point indices to find the element face,
@@ -859,7 +859,7 @@
ycoord(icorner) = nodes_coords_ext_mesh(2,nodes_ibelm_moho(icorner,ispec2D))
zcoord(icorner) = nodes_coords_ext_mesh(3,nodes_ibelm_moho(icorner,ispec2D))
enddo
-
+
! sets face id of reference element associated with this face
call get_element_face_id(ispec,xcoord,ycoord,zcoord, &
ibool,nspec,nglob, &
@@ -867,14 +867,14 @@
iface)
! ijk indices of GLL points for face id
- call get_element_face_gll_indices(iface,ijk_face,NGLLX,NGLLZ)
-
- ! weighted jacobian and normal
- call get_jacobian_boundary_face(myrank,nspec, &
+ call get_element_face_gll_indices(iface,ijk_face,NGLLX,NGLLZ)
+
+ ! weighted jacobian and normal
+ call get_jacobian_boundary_face(myrank,nspec, &
xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob,&
dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,&
- ispec,iface,jacobian2Dw_face,normal_face,NGLLX,NGLLZ)
+ wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,&
+ ispec,iface,jacobian2Dw_face,normal_face,NGLLX,NGLLZ)
! normal convention: points away from element
! switch normal direction if necessary
@@ -889,9 +889,9 @@
! stores information on global points on moho surface
igll = 0
- do j=1,NGLLY
+ do j=1,NGLLY
do i=1,NGLLX
- iglob = ibool(ijk_face(1,i,j),ijk_face(2,i,j),ijk_face(3,i,j),ispec)
+ iglob = ibool(ijk_face(1,i,j),ijk_face(2,i,j),ijk_face(3,i,j),ispec)
! sets flag
iglob_is_surface(iglob) = ispec2D
! sets normals
@@ -899,10 +899,10 @@
enddo
enddo
enddo
-
+
! stores moho elements
NSPEC2D_MOHO = nspec2D_moho_ext
-
+
allocate(ibelm_moho_bot(NSPEC2D_MOHO), &
ibelm_moho_top(NSPEC2D_MOHO), &
normal_moho_top(NDIM,NGLLSQUARE,NSPEC2D_MOHO), &
@@ -910,24 +910,24 @@
ijk_moho_bot(3,NGLLSQUARE,NSPEC2D_MOHO), &
ijk_moho_top(3,NGLLSQUARE,NSPEC2D_MOHO),stat=ier)
if( ier /= 0 ) stop 'error allocating ibelm_moho_bot'
-
+
ibelm_moho_bot = 0
ibelm_moho_top = 0
-
- ! element flags
+
+ ! element flags
allocate(is_moho_top(nspec), &
is_moho_bot(nspec),stat=ier)
if( ier /= 0 ) stop 'error allocating is_moho_top'
is_moho_top = .false.
- is_moho_bot = .false.
+ is_moho_bot = .false.
! finds spectral elements with moho surface
imoho_top = 0
imoho_bot = 0
do ispec=1,nspec
-
+
! loops over each face
- do iface = 1,6
+ do iface = 1,6
! checks if corners of face on surface
counter = 0
do icorner = 1,NGNOD2D
@@ -935,11 +935,11 @@
j = iface_all_corner_ijk(2,icorner,iface)
k = iface_all_corner_ijk(3,icorner,iface)
iglob = ibool(i,j,k,ispec)
-
- ! checks if point on surface
+
+ ! checks if point on surface
if( iglob_is_surface(iglob) > 0 ) then
counter = counter+1
-
+
! reference corner coordinates
xcoord(icorner) = xstore_dummy(iglob)
ycoord(icorner) = ystore_dummy(iglob)
@@ -947,19 +947,19 @@
endif
enddo
- ! stores moho informations
+ ! stores moho informations
if( counter == NGNOD2D ) then
! gets face GLL points i,j,k indices from element face
call get_element_face_gll_indices(iface,ijk_face,NGLLX,NGLLY)
- ! re-computes face infos
- ! weighted jacobian and normal
- call get_jacobian_boundary_face(myrank,nspec, &
+ ! re-computes face infos
+ ! weighted jacobian and normal
+ call get_jacobian_boundary_face(myrank,nspec, &
xstore_dummy,ystore_dummy,zstore_dummy,ibool,nglob,&
dershape2D_x,dershape2D_y,dershape2D_bottom,dershape2D_top, &
- wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,&
- ispec,iface,jacobian2Dw_face,normal_face,NGLLX,NGLLZ)
+ wgllwgll_xy,wgllwgll_xz,wgllwgll_yz,&
+ ispec,iface,jacobian2Dw_face,normal_face,NGLLX,NGLLZ)
! normal convention: points away from element
! switch normal direction if necessary
@@ -975,30 +975,30 @@
! takes normal stored temporary on a face midpoint
i = iface_all_midpointijk(1,iface)
j = iface_all_midpointijk(2,iface)
- k = iface_all_midpointijk(3,iface)
+ k = iface_all_midpointijk(3,iface)
iglob_midpoint = ibool(i,j,k,ispec)
normal(:) = iglob_normals(:,iglob_midpoint)
-
+
! determines whether normal points into element or not (top/bottom distinction)
call get_element_face_normal_idirect(ispec,iface,xcoord,ycoord,zcoord, &
ibool,nspec,nglob, &
xstore_dummy,ystore_dummy,zstore_dummy, &
- normal,idirect )
+ normal,idirect )
! takes moho surface element id given by id on midpoint
ispec2D = iglob_is_surface(iglob_midpoint)
! sets face infos for bottom (normal points away from element)
if( idirect == 1 ) then
-
+
! checks validity
if( is_moho_bot( ispec) .eqv. .true. ) then
print*,'error: moho surface geometry bottom'
print*,' does not allow for mulitple element faces in kernel computation'
call exit_mpi(myrank,'error moho bottom elements')
endif
-
- imoho_bot = imoho_bot + 1
+
+ imoho_bot = imoho_bot + 1
is_moho_bot(ispec) = .true.
ibelm_moho_bot(ispec2D) = ispec
@@ -1008,11 +1008,11 @@
do i=1,NGLLX
igll = igll+1
ijk_moho_bot(:,igll,ispec2D) = ijk_face(:,i,j)
- normal_moho_bot(:,igll,ispec2D) = normal_face(:,i,j)
+ normal_moho_bot(:,igll,ispec2D) = normal_face(:,i,j)
enddo
- enddo
-
- ! sets face infos for top element
+ enddo
+
+ ! sets face infos for top element
else if( idirect == 2 ) then
! checks validity
@@ -1022,35 +1022,35 @@
call exit_mpi(myrank,'error moho top elements')
endif
- imoho_top = imoho_top + 1
+ imoho_top = imoho_top + 1
is_moho_top(ispec) = .true.
ibelm_moho_top(ispec2D) = ispec
- ! gll points
+ ! gll points
igll = 0
do j=1,NGLLZ
do i=1,NGLLX
igll = igll+1
ijk_moho_top(:,igll,ispec) = ijk_face(:,i,j)
! note: top elements have normal pointing into element
- normal_moho_top(:,igll,ispec) = - normal_face(:,i,j)
+ normal_moho_top(:,igll,ispec) = - normal_face(:,i,j)
enddo
- enddo
+ enddo
endif
-
+
endif ! counter
-
+
enddo ! iface
-
+
! checks validity of top/bottom distinction
if( is_moho_top(ispec) .and. is_moho_bot(ispec) ) then
print*,'error: moho surface elements confusing'
print*,' element:',ispec,'has top and bottom surface'
call exit_mpi(myrank,'error moho surface element')
endif
-
+
enddo ! ispec2D
-
+
! note: surface e.g. could be at the free-surface and have no top elements etc...
! user output
call sum_all_i( imoho_top, imoho_top_all )
@@ -1081,5 +1081,5 @@
write(27) is_moho_top
write(27) is_moho_bot
close(27)
-
+
end subroutine create_regions_mesh_save_moho
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -491,7 +491,7 @@
use generate_databases_par
implicit none
-
+
if( OCEANS .and. TOPOGRAPHY ) then
! for Southern California
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_MPI.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_MPI.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/get_MPI.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -80,9 +80,9 @@
real(kind=CUSTOM_REAL), dimension(:),allocatable :: test_flag_cr
integer, dimension(:,:), allocatable :: ibool_interfaces_dummy
- ! gets global indices for points on MPI interfaces
+ ! gets global indices for points on MPI interfaces
! (defined by my_interfaces_ext_mesh) between different partitions
- ! and stores them in ibool_interfaces_ext_mesh & nibool_interfaces_ext_mesh
+ ! and stores them in ibool_interfaces_ext_mesh & nibool_interfaces_ext_mesh
! (number of total points)
call prepare_assemble_MPI( nelmnts_ext_mesh,elmnts_ext_mesh, &
ibool,nglob,ESIZE, &
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/assemble_MPI_scalar.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/assemble_MPI_scalar.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/assemble_MPI_scalar.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -96,7 +96,7 @@
itag, &
request_send_scalar_ext_mesh(iinterface) &
)
- ! receive request
+ ! receive request
call irecv_cr(buffer_recv_scalar_ext_mesh(1:nibool_interfaces_ext_mesh(iinterface),iinterface), &
nibool_interfaces_ext_mesh(iinterface), &
my_neighbours_ext_mesh(iinterface), &
@@ -193,7 +193,7 @@
itag, &
request_send_scalar_ext_mesh(iinterface) &
)
- ! receive request
+ ! receive request
call irecv_i(buffer_recv_scalar_ext_mesh(1:nibool_interfaces_ext_mesh(iinterface),iinterface), &
nibool_interfaces_ext_mesh(iinterface), &
my_neighbours_ext_mesh(iinterface), &
@@ -277,7 +277,7 @@
! send messages
do iinterface = 1, num_interfaces_ext_mesh
- ! non-blocking synchronous send request
+ ! non-blocking synchronous send request
call issend_cr(buffer_send_scalar_ext_mesh(1:nibool_interfaces_ext_mesh(iinterface),iinterface), &
nibool_interfaces_ext_mesh(iinterface), &
my_neighbours_ext_mesh(iinterface), &
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/check_mesh_resolution.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/check_mesh_resolution.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/check_mesh_resolution.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -62,7 +62,7 @@
! empirical choice for distorted elements to estimate time step and period resolved:
! courant number for time step estimate
- real(kind=CUSTOM_REAL),parameter :: COURANT_SUGGESTED = 0.3
+ real(kind=CUSTOM_REAL),parameter :: COURANT_SUGGESTED = 0.3
! number of points per minimum wavelength for minimum period estimate
real(kind=CUSTOM_REAL),parameter :: NPTS_PER_WAVELENGTH = 5
@@ -115,7 +115,7 @@
! computes minimum and maximum distance of neighbor GLL points in this grid cell
call get_GLL_minmaxdistance(distance_min,distance_max,ispec, &
NSPEC_AB,NGLOB_AB,ibool,xstore,ystore,zstore)
-
+
distance_min_glob = min( distance_min_glob, distance_min)
distance_max_glob = max( distance_max_glob, distance_max)
@@ -143,16 +143,16 @@
!
! rule of thumb (Komatitsch et al. 2005):
! "average number of points per minimum wavelength in an element should be around 5."
-
+
! average distance between GLL points within this element
avg_distance = elemsize_max / NGLLX ! since NGLLX = NGLLY = NGLLZ
-
+
! biggest possible minimum period such that number of points per minimum wavelength
! npts = ( min(vpmin,vsmin) * pmax ) / avg_distance is about ~ NPTS_PER_WAVELENGTH
!
! note: obviously, this estimation depends on the choice of points per wavelength
! which is empirical at the moment.
- ! also, keep in mind that the minimum period is just an estimation and
+ ! also, keep in mind that the minimum period is just an estimation and
! there is no such sharp cut-off period for valid synthetics.
! seismograms become just more and more inaccurate for periods shorter than this estimate.
pmax = avg_distance / min( vpmin,vsmin ) * NPTS_PER_WAVELENGTH
@@ -160,7 +160,7 @@
! old: based on GLL distance, i.e. on maximum ratio ( gridspacing / velocity )
- !pmax = distance_max / min( vpmin,vsmin ) * NELEM_PER_WAVELENGTH
+ !pmax = distance_max / min( vpmin,vsmin ) * NELEM_PER_WAVELENGTH
!pmax_glob = max(pmax_glob,pmax)
enddo
@@ -172,7 +172,7 @@
call max_all_cr(cmax,cmax_glob)
endif
- ! minimum period
+ ! minimum period
pmax = pmax_glob
call max_all_cr(pmax,pmax_glob)
@@ -232,7 +232,7 @@
endif
if( elemsize_max_glob >= HUGEVAL ) then
call exit_mpi(myrank,"error: element maximum size")
- endif
+ endif
!! DK DK May 2009: added this to print the minimum and maximum number of elements
!! DK DK May 2009: and points in the CUBIT + SCOTCH mesh
@@ -307,7 +307,7 @@
!
!-------------------------------------------------------------------------------------------------
-!
+!
subroutine get_vpvs_minmax(vpmin,vpmax,vsmin,vsmax,ispec,has_vs_zero, &
@@ -323,7 +323,7 @@
integer :: ispec
logical :: has_vs_zero
-
+
integer :: NSPEC_AB
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: &
kappastore,mustore,rho_vp,rho_vs
@@ -337,7 +337,7 @@
vpmax = -HUGEVAL
vsmin = HUGEVAL
vsmax = -HUGEVAL
-
+
! vp
where( rho_vp(:,:,:,ispec) > TINYVAL )
vp_elem(:,:,:) = (FOUR_THIRDS * mustore(:,:,:,ispec) &
@@ -351,7 +351,7 @@
vpmin = min(vpmin,val_min(1))
vpmax = max(vpmax,val_max(1))
-
+
! vs
where( rho_vs(:,:,:,ispec) > TINYVAL )
vs_elem(:,:,:) = mustore(:,:,:,ispec) / rho_vs(:,:,:,ispec)
@@ -371,10 +371,10 @@
vsmax = max(vsmax,val_max(1))
end subroutine get_vpvs_minmax
-
+
!
!-------------------------------------------------------------------------------------------------
-!
+!
subroutine get_GLL_minmaxdistance(distance_min,distance_max,ispec, &
@@ -434,13 +434,13 @@
enddo
enddo
enddo
-
+
end subroutine get_GLL_minmaxdistance
!
!-------------------------------------------------------------------------------------------------
-!
+!
subroutine get_elem_minmaxsize(elemsize_min,elemsize_max,ispec, &
@@ -463,7 +463,7 @@
! local parameters
real(kind=CUSTOM_REAL) :: dx,x0,y0,z0
integer :: i,j,k,icorner,jcorner,iglob_a,iglob_b
-
+
! corners indices of reference cube faces
! shapes of arrays below
integer,dimension(2),parameter :: corner_shape = (/3,NGNOD/)
@@ -494,7 +494,7 @@
! coordinates
iglob_b = ibool(i,j,k,ispec)
-
+
! distances between points
if( iglob_a /= iglob_b) then
dx = sqrt( ( x0 - xstore(iglob_b) )**2 &
@@ -503,7 +503,7 @@
if( dx < elemsize_min) elemsize_min = dx
if( dx > elemsize_max) elemsize_max = dx
endif
-
+
enddo
enddo
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/combine_vol_data.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/combine_vol_data.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/combine_vol_data.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -578,7 +578,7 @@
! writes out point locations and values
allocate(mask_ibool(NGLOB_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array mask_ibool'
-
+
mask_ibool(:) = .false.
numpoin = 0
do ispec=1,NSPEC_AB
@@ -634,7 +634,7 @@
allocate(mask_ibool(NGLOB_AB), &
num_ibool(NGLOB_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array mask_ibool'
-
+
mask_ibool(:) = .false.
num_ibool(:) = 0
numpoin = 0
@@ -753,7 +753,7 @@
allocate(mask_ibool(NGLOB_AB), &
num_ibool(NGLOB_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array mask_ibool'
-
+
mask_ibool(:) = .false.
num_ibool(:) = 0
numpoin = 0
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/detect_surface.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/detect_surface.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/detect_surface.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -110,7 +110,7 @@
! sets surface flags for element and global points
call ds_set_surface_flags(nspec,ispec_is_surface_external_mesh, &
nglob,iglob_is_surface_external_mesh, &
- i,j,k,ispec,ibool)
+ i,j,k,ispec,ibool)
endif
endif
@@ -159,7 +159,7 @@
nglob,iglob_is_surface_external_mesh, &
i,j,k,ispec,ibool)
- ! put this into separate subroutine to compile faster, otherwise compilers will try to unroll all do loops
+ ! put this into separate subroutine to compile faster, otherwise compilers will try to unroll all do loops
implicit none
@@ -169,11 +169,11 @@
integer :: nglob,nspec
integer, dimension(NGLLX,NGLLY,NGLLZ,nspec):: ibool
integer :: i,j,k,ispec
-
+
! surface flags
logical, dimension(nspec) :: ispec_is_surface_external_mesh
logical, dimension(nglob) :: iglob_is_surface_external_mesh
-
+
! local parameters
integer :: kk,jj,ii
@@ -202,7 +202,7 @@
enddo
enddo
endif
-
+
end subroutine ds_set_surface_flags
!
@@ -374,7 +374,7 @@
i,j,k,ispec,ibool, &
valence_external_mesh,count)
endif
-
+
endif
enddo
enddo
@@ -450,7 +450,7 @@
call ds_set_plane_flags(iface,ispec, &
nspec,ispec_is_surface_external_mesh, &
nglob,iglob_is_surface_external_mesh, &
- ibool,valence_external_mesh)
+ ibool,valence_external_mesh)
endif
endif
@@ -468,7 +468,7 @@
call ds_set_plane_flags(iface,ispec, &
nspec,ispec_is_surface_external_mesh, &
nglob,iglob_is_surface_external_mesh, &
- ibool,valence_external_mesh)
+ ibool,valence_external_mesh)
endif
endif
@@ -486,7 +486,7 @@
call ds_set_plane_flags(iface,ispec, &
nspec,ispec_is_surface_external_mesh, &
nglob,iglob_is_surface_external_mesh, &
- ibool,valence_external_mesh)
+ ibool,valence_external_mesh)
endif
endif
@@ -538,7 +538,7 @@
i,j,k,ispec,ibool, &
valence_external_mesh,count)
- ! put this into separate subroutine to compile faster, otherwise compilers will try to unroll all do loops
+ ! put this into separate subroutine to compile faster, otherwise compilers will try to unroll all do loops
implicit none
@@ -550,11 +550,11 @@
integer :: i,j,k,ispec,count
integer, dimension(nglob) :: valence_external_mesh
-
+
! surface flags
logical, dimension(nspec) :: ispec_is_surface_external_mesh
logical, dimension(nglob) :: iglob_is_surface_external_mesh
-
+
! local parameters
integer :: kk,jj,ii
logical :: has_face
@@ -599,7 +599,7 @@
enddo
endif
- ! sets flag for element to indicate that it has a face on surface
+ ! sets flag for element to indicate that it has a face on surface
if( has_face ) then
ispec_is_surface_external_mesh(ispec) = .true.
count = count+1
@@ -615,9 +615,9 @@
nspec,ispec_is_surface_external_mesh, &
nglob,iglob_is_surface_external_mesh, &
ibool,valence_external_mesh)
-
- ! put this into separate subroutine to compile faster, otherwise compilers will try to unroll all do loops
+ ! put this into separate subroutine to compile faster, otherwise compilers will try to unroll all do loops
+
implicit none
include "constants.h"
@@ -629,18 +629,18 @@
integer, dimension(NGLLX,NGLLY,NGLLZ,nspec):: ibool
integer, dimension(nglob) :: valence_external_mesh
-
+
! surface flags
logical, dimension(nspec) :: ispec_is_surface_external_mesh
logical, dimension(nglob) :: iglob_is_surface_external_mesh
-
+
! local parameters
integer :: jj,ii,i,j,k
integer,dimension(3,NGLLX,NGLLX) :: face_ijk
-
+
call get_element_face_gll_indices(iface,face_ijk,NGLLX,NGLLX)
-
+
do jj = 1, NGLLY
do ii = 1, NGLLX
i = face_ijk(1,ii,jj)
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/get_attenuation_model.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/get_attenuation_model.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/get_attenuation_model.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -745,13 +745,13 @@
integer, save :: first_time_called = 1
double precision, parameter :: ZERO_TOL = 1.e-5
integer ier
-
+
if(first_time_called == 1) then
first_time_called = 0
AM_S%Q_resolution = 10**ATTENUATION_COMP_RESOLUTION
AM_S%Q_max = ATTENUATION_COMP_MAXIMUM
Qtmp = AM_S%Q_resolution * AM_S%Q_max
-
+
allocate(AM_S%tau_eps_storage(N_SLS, Qtmp), &
AM_S%Qmu_storage(Qtmp),stat=ier)
if( ier /= 0 ) stop 'error allocating arrays for attenuation storage'
@@ -942,7 +942,7 @@
double precision, dimension(nf_in) :: f_in
double precision, dimension(nsls_in) :: tau_s_in
integer ier
-
+
allocate(AS_V%f(nf_in), &
AS_V%tau_s(nsls_in),stat=ier)
if( ier /= 0 ) stop 'error allocating arrays for attenuation simplex'
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/prepare_assemble_MPI.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/prepare_assemble_MPI.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/prepare_assemble_MPI.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -113,7 +113,7 @@
do ix = min(ixmin,ixmax), max(ixmin,ixmax)
! global index
iglob = ibool(ix,iy,iz,ispec)
-
+
! stores global index of point on interface
if(.not. mask_ibool_asteroid(iglob)) then
! masks point as being accounted for
@@ -144,7 +144,7 @@
subroutine get_edge ( ngnode, n, itype, e1, e2, e3, e4, &
ixmin, ixmax, iymin, iymax, izmin, izmax )
-! returns range of local (GLL) point indices i,j,k depending on given type
+! returns range of local (GLL) point indices i,j,k depending on given type
! for corner point (1), edge (2) or face (4)
implicit none
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/smooth_vol_data.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/smooth_vol_data.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/smooth_vol_data.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -368,7 +368,7 @@
cy0(NSPEC_AB), &
cz0(NSPEC_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array xl etc.'
-
+
do ispec = 1, nspec_AB
do k = 1, NGLLZ
do j = 1, NGLLY
@@ -422,7 +422,7 @@
allocate(tk(NGLLX,NGLLY,NGLLZ,NSPEC_AB), &
bk(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array tk and bk'
-
+
tk = 0.0_CUSTOM_REAL
bk = 0.0_CUSTOM_REAL
do it=1,num_interfaces_ext_mesh+1
@@ -479,7 +479,7 @@
cy(NSPEC_N), &
cz(NSPEC_N),stat=ier)
if( ier /= 0 ) stop 'error allocating array xx etc.'
-
+
do ispec = 1, nspec_N
do k = 1, NGLLZ
do j = 1, NGLLY
@@ -579,7 +579,7 @@
!if(myrank==0) print*, 'normalizes values ...'
allocate(dat_smooth(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array dat_smooth'
-
+
dat_smooth = 0.0_CUSTOM_REAL
do ispec = 1, nspec_AB
do k = 1, NGLLZ
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_acoustic.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_acoustic.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_acoustic.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -215,9 +215,9 @@
if (SIMULATION_TYPE == 2 .or. SIMULATION_TYPE == 3) then
! read in adjoint sources block by block (for memory consideration)
- ! e.g., in exploration experiments, both the number of receivers (nrec) and
+ ! e.g., in exploration experiments, both the number of receivers (nrec) and
! the number of time steps (NSTEP) are huge,
- ! which may cause problems since we have a large array:
+ ! which may cause problems since we have a large array:
! adj_sourcearrays(nadj_rec_local,NSTEP,NDIM,NGLLX,NGLLY,NGLLZ)
! figure out if we need to read in a chunk of the adjoint source at this timestep
@@ -226,7 +226,7 @@
! needs to read in a new chunk/block of the adjoint source
! note that for each partition, we divide it into two parts --- boundaries and interior --- indicated by 'phase_is_inner'
- ! we first do calculations for the boudaries, and then start communication
+ ! we first do calculations for the boudaries, and then start communication
! with other partitions while we calculate for the inner part
! this must be done carefully, otherwise the adjoint sources may be added twice
if (ibool_read_adj_arrays .and. (.not. phase_is_inner)) then
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_elastic.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_elastic.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_add_sources_elastic.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -198,9 +198,9 @@
if (SIMULATION_TYPE == 2 .or. SIMULATION_TYPE == 3) then
! read in adjoint sources block by block (for memory consideration)
- ! e.g., in exploration experiments, both the number of receivers (nrec) and
+ ! e.g., in exploration experiments, both the number of receivers (nrec) and
! the number of time steps (NSTEP) are huge,
- ! which may cause problems since we have a large array:
+ ! which may cause problems since we have a large array:
! adj_sourcearrays(nadj_rec_local,NSTEP,NDIM,NGLLX,NGLLY,NGLLZ)
! figure out if we need to read in a chunk of the adjoint source at this timestep
@@ -209,7 +209,7 @@
! needs to read in a new chunk/block of the adjoint source
! note that for each partition, we divide it into two parts --- boundaries and interior --- indicated by 'phase_is_inner'
- ! we first do calculations for the boudaries, and then start communication
+ ! we first do calculations for the boudaries, and then start communication
! with other partitions while calculate for the inner part
! this must be done carefully, otherwise the adjoint sources may be added twice
if (ibool_read_adj_arrays .and. (.not. phase_is_inner)) then
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_elastic_Dev.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_elastic_Dev.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_elastic_Dev.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -184,7 +184,7 @@
integer i,j,k
imodulo_N_SLS = mod(N_SLS,3)
-
+
! choses inner/outer elements
if( iphase == 1 ) then
num_elements = nspec_outer_elastic
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_stacey_elastic.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_stacey_elastic.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_stacey_elastic.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -157,10 +157,10 @@
if (SIMULATION_TYPE == 1 .and. SAVE_FORWARD .and. num_abs_boundary_faces > 0 ) then
! writes out absorbing boundary value
! uses fortran routine
- !write(IOABS,rec=it) b_reclen_field,b_absorb_field,b_reclen_field
+ !write(IOABS,rec=it) b_reclen_field,b_absorb_field,b_reclen_field
! uses c routine
- call write_abs(0,b_absorb_field,b_reclen_field,it)
+ call write_abs(0,b_absorb_field,b_reclen_field,it)
endif
-
+
end subroutine compute_stacey_elastic
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/detect_mesh_surfaces.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/detect_mesh_surfaces.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/detect_mesh_surfaces.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -34,7 +34,7 @@
use specfem_par_elastic
implicit none
integer :: ier
-
+
! for mesh surface
allocate(ispec_is_surface_external_mesh(NSPEC_AB), &
iglob_is_surface_external_mesh(NGLOB_AB),stat=ier)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_receivers.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_receivers.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_receivers.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -950,7 +950,7 @@
if( stutm_y >= LATITUDE_MIN .and. stutm_y <= LATITUDE_MAX .and. &
stutm_x >= LONGITUDE_MIN .and. stutm_x <= LONGITUDE_MAX) then
-
+
! w/out formating
! write(IOUT,*) trim(station_name),' ',trim(network_name),' ',sngl(stlat), &
! ' ',sngl(stlon), ' ',sngl(stele), ' ',sngl(stbur)
@@ -959,7 +959,7 @@
write(IOUT,'(a10,1x,a10,4e18.6)') &
trim(station_name),trim(network_name), &
sngl(stlat),sngl(stlon),sngl(stele),sngl(stbur)
-
+
endif
end if
enddo
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/noise_tomography.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/noise_tomography.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/noise_tomography.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -433,9 +433,9 @@
real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB_VAL) :: displ
! output parameters
! local parameters
- integer :: ispec2D,ispec,i,j,k,iglob
+ integer :: ispec2D,ispec,i,j,k,iglob
real(kind=CUSTOM_REAL),dimension(NDIM,NGLLX,NGLLY,nspec_top) :: noise_surface_movie
-
+
! get coordinates of surface mesh and surface displacement
do ispec2D = 1, nspec_top
ispec = ibelm_top(ispec2D)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -37,7 +37,7 @@
implicit none
character(len=256) :: plot_file
integer :: ier
-
+
! flag for any movie simulation
if( EXTERNAL_MESH_MOVIE_SURFACE .or. EXTERNAL_MESH_CREATE_SHAKEMAP .or. &
MOVIE_SURFACE .or. CREATE_SHAKEMAP .or. MOVIE_VOLUME .or. PNM_GIF_IMAGE ) then
@@ -532,7 +532,7 @@
if (SIMULATION_TYPE == 3) then
! opens existing files
- ! uses fortran routines for reading
+ ! uses fortran routines for reading
!open(unit=IOABS,file=trim(prname)//'absorb_field.bin',status='old',&
! action='read',form='unformatted',access='direct', &
! recl=b_reclen_field+2*4,iostat=ier )
@@ -541,7 +541,7 @@
call open_file_abs_r(0,trim(prname)//'absorb_field.bin', &
len_trim(trim(prname)//'absorb_field.bin'), &
b_reclen_field*NSTEP)
-
+
else
! opens new file
@@ -554,7 +554,7 @@
call open_file_abs_w(0,trim(prname)//'absorb_field.bin', &
len_trim(trim(prname)//'absorb_field.bin'), &
b_reclen_field*NSTEP)
-
+
endif
endif
@@ -572,12 +572,12 @@
!open(unit=IOABS_AC,file=trim(prname)//'absorb_potential.bin',status='old',&
! action='read',form='unformatted',access='direct', &
! recl=b_reclen_potential+2*4,iostat=ier )
- !if( ier /= 0 ) call exit_mpi(myrank,'error opening proc***_absorb_potential.bin file')
+ !if( ier /= 0 ) call exit_mpi(myrank,'error opening proc***_absorb_potential.bin file')
! uses c routines for faster reading
call open_file_abs_r(1,trim(prname)//'absorb_potential.bin', &
len_trim(trim(prname)//'absorb_potential.bin'), &
b_reclen_potential*NSTEP)
-
+
else
! opens new file
! uses fortran routines for writing
@@ -600,12 +600,12 @@
allocate(b_absorb_field(NDIM,NGLLSQUARE,b_num_abs_boundary_faces),stat=ier)
if( ier /= 0 ) stop 'error allocating array b_absorb_field'
endif
-
+
if( ACOUSTIC_SIMULATION ) then
allocate(b_absorb_potential(NGLLSQUARE,b_num_abs_boundary_faces),stat=ier)
if( ier /= 0 ) stop 'error allocating array b_absorb_potential'
endif
-
+
endif
endif
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -334,13 +334,13 @@
use specfem_par
use specfem_par_elastic
use specfem_par_acoustic
- implicit none
+ implicit none
! local parameters
integer :: i,j,k,ispec,iglob
integer :: iinterface,ier
character(len=256) :: filename
logical,dimension(:),allocatable :: iglob_is_inner
-
+
! allocates arrays
allocate(ispec_is_inner(NSPEC_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array ispec_is_inner'
@@ -356,7 +356,7 @@
iglob_is_inner(iglob) = .false.
enddo
enddo
-
+
! determines flags for inner elements (purely inside the partition)
do ispec = 1, NSPEC_AB
do k = 1, NGLLZ
@@ -378,7 +378,7 @@
xstore,ystore,zstore,ibool, &
ispec_is_inner,filename)
endif
-
+
! sets up elements for loops in acoustic simulations
if( ACOUSTIC_SIMULATION ) then
! counts inner and outer elements
@@ -450,7 +450,7 @@
!print *,'rank ',myrank,' elastic inner spec: ',nspec_inner_elastic
!print *,'rank ',myrank,' elastic outer spec: ',nspec_outer_elastic
endif
-
+
end subroutine rmd_setup_inner_outer_elemnts
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_topography_bathymetry.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_topography_bathymetry.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_topography_bathymetry.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -31,7 +31,7 @@
use specfem_par
implicit none
integer :: ier
-
+
! read topography and bathymetry file
if( OCEANS .and. TOPOGRAPHY ) then
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/setup_movie_meshes.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/setup_movie_meshes.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/setup_movie_meshes.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -42,7 +42,7 @@
allocate(nfaces_perproc_surface_ext_mesh(NPROC), &
faces_surface_offset_ext_mesh(NPROC),stat=ier)
if( ier /= 0 ) stop 'error allocating array for movie faces'
-
+
nfaces_org = nfaces_surface_ext_mesh
if (nfaces_surface_ext_mesh == 0) then
! dummy arrays
@@ -304,7 +304,7 @@
nfaces_surface_glob_em_points = nfaces_surface_glob_ext_mesh*NGLLX*NGLLY
else
! low-res movies only output at element corners
- nfaces_perproc_surface_ext_mesh(:) = nfaces_perproc_surface_ext_mesh(:)*NGNOD2D
+ nfaces_perproc_surface_ext_mesh(:) = nfaces_perproc_surface_ext_mesh(:)*NGNOD2D
nfaces_surface_ext_mesh_points = nfaces_surface_ext_mesh*NGNOD2D
nfaces_surface_glob_em_points = nfaces_surface_glob_ext_mesh*NGNOD2D
endif
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/setup_sources_receivers.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/setup_sources_receivers.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/setup_sources_receivers.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -862,14 +862,14 @@
close(IOVTK)
! creates additional receiver and source files
- ! extracts receiver locations
- filename = trim(OUTPUT_FILES)//'/sr.vtk'
+ ! extracts receiver locations
+ filename = trim(OUTPUT_FILES)//'/sr.vtk'
filename_new = trim(OUTPUT_FILES)//'/receiver.vtk'
write(system_command, &
"('awk ',a1,'{if(NR<5) print $0;if(NR==6)print ',a1,'POINTS',i6,' float',a1,';if(NR>5+',i6,')print $0}',a1,' < ',a,' > ',a)")&
"'",'"',nrec,'"',NSOURCES,"'",trim(filename),trim(filename_new)
call system(system_command)
-
+
! extracts source locations
filename_new = trim(OUTPUT_FILES)//'/source.vtk'
write(system_command, &
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_movie_output.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_movie_output.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_movie_output.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -196,7 +196,7 @@
! sets velocity vector with maximum norm of wavefield values
call wmo_get_max_vector(ispec,ispec2D,ipoin, &
displ_element,veloc_element,accel_element, &
- NGNOD2D)
+ NGNOD2D)
endif
enddo
endif
@@ -223,7 +223,7 @@
nfaces_surface_glob_em_points,NPROC)
call gatherv_all_cr(store_val_uz_external_mesh,nfaces_surface_ext_mesh_points,&
store_val_uz_all_external_mesh,nfaces_perproc_surface_ext_mesh,faces_surface_offset_ext_mesh,&
- nfaces_surface_glob_em_points,NPROC)
+ nfaces_surface_glob_em_points,NPROC)
else
! all other process just send
call gatherv_all_cr(store_val_x_external_mesh,nfaces_surface_ext_mesh_points,&
@@ -243,7 +243,7 @@
1,NPROC)
call gatherv_all_cr(store_val_uz_external_mesh,nfaces_surface_ext_mesh_points,&
dummy,nfaces_perproc_surface_ext_mesh,faces_surface_offset_ext_mesh,&
- 1,NPROC)
+ 1,NPROC)
endif
! creates shakemap file
@@ -271,19 +271,19 @@
narraydim)
! put into this separate routine to make compilation faster
-
- use specfem_par,only: NDIM,ibool
+
+ use specfem_par,only: NDIM,ibool
use specfem_par_movie
implicit none
-
+
integer :: ispec,ispec2D,ipoin,narraydim
real(kind=CUSTOM_REAL),dimension(NDIM,NGLLX,NGLLY,NGLLZ) :: &
displ_element,veloc_element,accel_element
-
- ! local parameters
+
+ ! local parameters
integer :: i,j,k,iglob
logical :: is_done
-
+
is_done = .false.
do k=1,NGLLZ
do j=1,NGLLY
@@ -314,7 +314,7 @@
enddo
enddo
enddo
-
+
end subroutine wmo_get_max_vector
!================================================================
@@ -389,7 +389,7 @@
! puts velocity values into storage array
call wmo_get_vel_vector(ispec,ispec2D,ipoin, &
veloc_element, &
- NGLLX*NGLLY)
+ NGLLX*NGLLY)
endif
enddo
else
@@ -408,7 +408,7 @@
! puts velocity values into storage array
call wmo_get_vel_vector(ispec,ispec2D,ipoin, &
veloc_element, &
- NGNOD2D)
+ NGNOD2D)
endif
enddo
endif
@@ -418,7 +418,7 @@
! collects locations only once
if (it == NTSTEP_BETWEEN_FRAMES ) then
! master collects all
- if( myrank == 0 ) then
+ if( myrank == 0 ) then
call gatherv_all_cr(store_val_x_external_mesh,nfaces_surface_ext_mesh_points,&
store_val_x_all_external_mesh,nfaces_perproc_surface_ext_mesh,faces_surface_offset_ext_mesh,&
nfaces_surface_glob_em_points,NPROC)
@@ -441,7 +441,7 @@
1,NPROC)
endif
endif
-
+
! updates/gathers velocity field (high-res or low-res)
if( myrank == 0 ) then
call gatherv_all_cr(store_val_ux_external_mesh,nfaces_surface_ext_mesh_points,&
@@ -463,7 +463,7 @@
1,NPROC)
call gatherv_all_cr(store_val_uz_external_mesh,nfaces_surface_ext_mesh_points,&
dummy,nfaces_perproc_surface_ext_mesh,faces_surface_offset_ext_mesh,&
- 1,NPROC)
+ 1,NPROC)
endif
! file output
@@ -491,19 +491,19 @@
narraydim)
! put into this separate routine to make compilation faster
-
- use specfem_par,only: NDIM,ibool
+
+ use specfem_par,only: NDIM,ibool
use specfem_par_movie
implicit none
-
+
integer :: ispec,ispec2D,ipoin,narraydim
real(kind=CUSTOM_REAL),dimension(NDIM,NGLLX,NGLLY,NGLLZ) :: &
veloc_element
-
- ! local parameters
+
+ ! local parameters
integer :: i,j,k,iglob
logical :: is_done
-
+
! velocity vector
is_done = .false.
do k=1,NGLLZ
@@ -519,7 +519,7 @@
enddo
enddo
enddo
-
+
end subroutine wmo_get_vel_vector
@@ -637,7 +637,7 @@
! acoustic pressure potential
if( ispec_is_acoustic(ispec) ) then
! stores values from element
- call wmo_get_val_elem(ispec,ipoin,val_element)
+ call wmo_get_val_elem(ispec,ipoin,val_element)
endif
enddo
@@ -675,7 +675,7 @@
! acoustic pressure potential
if( ispec_is_acoustic(ispec) ) then
! stores values from element
- call wmo_get_val_elem(ispec,ipoin,val_element)
+ call wmo_get_val_elem(ispec,ipoin,val_element)
endif
enddo ! iloc
@@ -707,7 +707,7 @@
1,NPROC)
endif
endif
-
+
! master collects wavefield
if( myrank == 0 ) then
call gatherv_all_cr(store_val_ux_external_mesh,nfaces_surface_ext_mesh_points,&
@@ -728,7 +728,7 @@
1,NPROC)
call gatherv_all_cr(store_val_uz_external_mesh,nfaces_surface_ext_mesh_points,&
dummy,nfaces_perproc_surface_ext_mesh,faces_surface_offset_ext_mesh,&
- 1,NPROC)
+ 1,NPROC)
endif
! file output: note that values are only stored on free surface
@@ -754,19 +754,19 @@
subroutine wmo_get_val_elem(ispec,ipoin,val_element)
! put into this separate routine to make compilation faster
-
- use specfem_par,only: NDIM,ibool
+
+ use specfem_par,only: NDIM,ibool
use specfem_par_movie
implicit none
-
+
integer :: ispec,ipoin
real(kind=CUSTOM_REAL),dimension(NDIM,NGLLX,NGLLY,NGLLZ) :: &
val_element
-
- ! local parameters
+
+ ! local parameters
integer :: i,j,k,iglob
logical :: is_done
-
+
! velocity vector
is_done = .false.
do k=1,NGLLZ
@@ -782,7 +782,7 @@
enddo
enddo
enddo
-
+
end subroutine wmo_get_val_elem
!=====================================================================
@@ -799,7 +799,7 @@
implicit none
real(kind=CUSTOM_REAL),dimension(:,:,:,:),allocatable:: &
displ_element,veloc_element,accel_element
- real(kind=CUSTOM_REAL),dimension(1):: dummy
+ real(kind=CUSTOM_REAL),dimension(1):: dummy
integer :: ipoin,ispec,iglob
integer :: imin,imax,jmin,jmax,kmin,kmax,iface,igll,iloc
integer :: i,j,k,ier
@@ -863,7 +863,7 @@
! acoustic domains
if( ispec_is_acoustic(ispec) ) then
! stores maximum values
- call wmo_get_max_vector_o(ispec,ipoin,displ_element,veloc_element,accel_element)
+ call wmo_get_max_vector_o(ispec,ipoin,displ_element,veloc_element,accel_element)
endif
enddo
@@ -901,7 +901,7 @@
! acoustic domains
if( ispec_is_acoustic(ispec) ) then
! stores maximum values
- call wmo_get_max_vector_o(ispec,ipoin,displ_element,veloc_element,accel_element)
+ call wmo_get_max_vector_o(ispec,ipoin,displ_element,veloc_element,accel_element)
endif
enddo
@@ -948,7 +948,7 @@
1,NPROC)
call gatherv_all_cr(store_val_uz_external_mesh,nfaces_surface_ext_mesh_points,&
dummy,nfaces_perproc_surface_ext_mesh,faces_surface_offset_ext_mesh,&
- 1,NPROC)
+ 1,NPROC)
endif
! creates shakemap file: note that values are only stored on free surface
@@ -976,19 +976,19 @@
subroutine wmo_get_max_vector_o(ispec,ipoin,displ_element,veloc_element,accel_element)
! put into this separate routine to make compilation faster
-
- use specfem_par,only: NDIM,ibool
+
+ use specfem_par,only: NDIM,ibool
use specfem_par_movie
implicit none
-
+
integer :: ispec,ipoin
real(kind=CUSTOM_REAL),dimension(NDIM,NGLLX,NGLLY,NGLLZ) :: &
displ_element,veloc_element,accel_element
-
- ! local parameters
+
+ ! local parameters
integer :: i,j,k,iglob
logical :: is_done
-
+
! velocity vector
is_done = .false.
do k=1,NGLLZ
@@ -1011,7 +1011,7 @@
enddo
enddo
enddo
-
+
end subroutine wmo_get_max_vector_o
!=====================================================================
@@ -1028,12 +1028,12 @@
real(kind=CUSTOM_REAL),dimension(:,:,:,:),allocatable:: veloc_element
! divergence and curl only in the global nodes
- real(kind=CUSTOM_REAL),dimension(:),allocatable:: div_glob,curl_glob
+ real(kind=CUSTOM_REAL),dimension(:),allocatable:: div_glob,curl_glob
integer,dimension(:),allocatable :: valency
integer :: ispec,ier
character(len=3) :: channel
character(len=1) :: compx,compy,compz
-
+
! gets component characters: X/Y/Z or E/N/Z
call write_channel_name(1,channel)
compx(1:1) = channel(3:3) ! either X or E
@@ -1052,7 +1052,7 @@
! allocate array for single elements
allocate( veloc_element(NDIM,NGLLX,NGLLY,NGLLZ),stat=ier)
if( ier /= 0 ) stop 'error allocating arrays for movie elements'
-
+
! uses div as temporary array to store velocity on all gll points
do ispec=1,NSPEC_AB
if( .not. ispec_is_acoustic(ispec) ) cycle
@@ -1069,7 +1069,7 @@
enddo
deallocate(veloc_element)
-
+
endif ! acoustic
! saves full snapshot data to local disk
@@ -1080,7 +1080,7 @@
curl_glob(NGLOB_AB), &
valency(NGLOB_AB), stat=ier)
if( ier /= 0 ) stop 'error allocating arrays for movie div and curl'
-
+
! calculates divergence and curl of velocity field
call wmo_movie_div_curl(NSPEC_AB,NGLOB_AB,veloc, &
div_glob,curl_glob,valency, &
@@ -1089,7 +1089,7 @@
ibool,ispec_is_elastic, &
hprime_xx,hprime_yy,hprime_zz, &
xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz)
-
+
! writes out div and curl on global points
write(outputname,"('/proc',i6.6,'_div_glob_it',i6.6,'.bin')") myrank,it
open(unit=27,file=trim(LOCAL_PATH)//trim(outputname),status='unknown',form='unformatted',iostat=ier)
@@ -1161,7 +1161,7 @@
!close(27)
endif
-
+
end subroutine wmo_movie_volume_output
!=====================================================================
@@ -1173,8 +1173,8 @@
ibool,ispec_is_elastic, &
hprime_xx,hprime_yy,hprime_zz, &
xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz)
-
-
+
+
! calculates div, curl and velocity
implicit none
@@ -1184,9 +1184,9 @@
! velocity field
real(kind=CUSTOM_REAL),dimension(NDIM,NGLOB_AB),intent(in) :: veloc
-
+
! divergence and curl only in the global nodes
- real(kind=CUSTOM_REAL),dimension(NGLOB_AB) :: div_glob,curl_glob
+ real(kind=CUSTOM_REAL),dimension(NGLOB_AB) :: div_glob,curl_glob
integer,dimension(NGLOB_AB) :: valency
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: div, curl_x, curl_y, curl_z
@@ -1194,17 +1194,17 @@
integer,dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB):: ibool
logical,dimension(NSPEC_AB) :: ispec_is_elastic
- ! array with derivatives of Lagrange polynomials
+ ! array with derivatives of Lagrange polynomials
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: hprime_xx
real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLY) :: hprime_yy
real(kind=CUSTOM_REAL), dimension(NGLLZ,NGLLZ) :: hprime_zz
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_AB) :: &
xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz
-
+
! local parameters
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: dvxdxl,dvxdyl,&
- dvxdzl,dvydxl,dvydyl,dvydzl,dvzdxl,dvzdyl,dvzdzl
+ dvxdzl,dvydxl,dvydyl,dvydzl,dvzdxl,dvzdyl,dvzdzl
real(kind=CUSTOM_REAL) xixl,xiyl,xizl,etaxl,etayl,etazl,gammaxl,gammayl,gammazl
real(kind=CUSTOM_REAL) hp1,hp2,hp3
real(kind=CUSTOM_REAL) tempx1l,tempx2l,tempx3l
@@ -1216,7 +1216,7 @@
div_glob(:) = 0.0_CUSTOM_REAL
curl_glob(:) = 0.0_CUSTOM_REAL
valency(:) = 0
-
+
! loops over elements
do ispec=1,NSPEC_AB
if( .not. ispec_is_elastic(ispec) ) cycle
@@ -1314,7 +1314,7 @@
div_glob(i) = div_glob(i)/valency(i)
curl_glob(i) = curl_glob(i)/valency(i)
endif
-
+
enddo
-
+
end subroutine wmo_movie_div_curl
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_seismograms.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_seismograms.f90 2011-04-07 12:56:31 UTC (rev 18194)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_seismograms.f90 2011-04-07 16:14:32 UTC (rev 18195)
@@ -87,7 +87,7 @@
xix,xiy,xiz,etax,etay,etaz,gammax,gammay,gammaz, &
ibool,rhostore)
- ! interpolates displ/veloc/pressure at receiver locations
+ ! interpolates displ/veloc/pressure at receiver locations
call compute_interpolated_dva_ac(displ_element,veloc_element,&
potential_dot_dot_acoustic,potential_dot_acoustic,&
potential_acoustic,NGLOB_AB, &
More information about the CIG-COMMITS
mailing list