[cig-commits] r21750 - seismo/3D/SPECFEM3D/trunk/src/decompose_mesh
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Sun Apr 7 16:31:35 PDT 2013
Author: dkomati1
Date: 2013-04-07 16:31:34 -0700 (Sun, 07 Apr 2013)
New Revision: 21750
Modified:
seismo/3D/SPECFEM3D/trunk/src/decompose_mesh/decompose_mesh.F90
Log:
now check that the PML element file exists if PML_CONDITIONS is set to true
Modified: seismo/3D/SPECFEM3D/trunk/src/decompose_mesh/decompose_mesh.F90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/decompose_mesh/decompose_mesh.F90 2013-04-07 23:29:52 UTC (rev 21749)
+++ seismo/3D/SPECFEM3D/trunk/src/decompose_mesh/decompose_mesh.F90 2013-04-07 23:31:34 UTC (rev 21750)
@@ -177,6 +177,7 @@
stop 'error file open'
endif
read(98,*) nnodes
+ if( nnodes < 1 ) stop 'error: nnodes < 1'
allocate(nodes_coords(3,nnodes),stat=ier)
if( ier /= 0 ) stop 'error allocating array nodes_coords'
do inode = 1, nnodes
@@ -205,6 +206,7 @@
! sets number of elements (integer 4-byte)
nspec = nspec_long
+ if( nspec < 1 ) stop 'error: nspec < 1'
allocate(elmnts(NGNOD,nspec),stat=ier)
if( ier /= 0 ) stop 'error allocating array elmnts'
do ispec = 1, nspec
@@ -512,11 +514,21 @@
! reads in absorbing boundary files
open(unit=98, file=localpath_name(1:len_trim(localpath_name))//'/absorbing_surface_file_xmin', &
status='old', form='formatted',iostat=ier)
+! if the file does not exist then define the number of Stacey elements as zero for this face;
+! beware that these files can also be used to set Dirichlet boundary conditions on the outer edges of CPML
+! absorbing layers for elastic elements, not only for Stacey; thus these files may exist and be non-empty
+! even when STACEY_ABSORBING_CONDITIONS is false
if( ier /= 0 ) then
nspec2D_xmin = 0
else
read(98,*) nspec2D_xmin
endif
+! 33333333333333333333333333333333333333333
+! an array of size 0 is a valid object in Fortran 90, i.e. the array is then considered as allocated
+! and can thus for instance be used as an argument in a call to a subroutine without giving any error
+! even when full range and pointer checking is used in the compiler options;
+! thus here the idea is that if some of the absorbing files do not exist because there are no absorbing
+! conditions for this mesh then the array is created nonetheless, but with a dummy size of 0
allocate(ibelm_xmin(nspec2D_xmin),stat=ier)
if( ier /= 0 ) stop 'error allocating array ibelm_xmin'
allocate(nodes_ibelm_xmin(NGNOD2D,nspec2D_xmin),stat=ier)
@@ -630,10 +642,21 @@
close(98)
print*, ' nspec2D_top = ', nspec2D_top
+! 33333333333333333333333333333333333333333
+! an array of size 0 is a valid object in Fortran 90, i.e. the array is then considered as allocated
+! and can thus for instance be used as an argument in a call to a subroutine without giving any error
+! even when full range and pointer checking is used in the compiler options;
+! thus here the idea is that if some of the absorbing files do not exist because there are no absorbing
+! conditions for this mesh then the array is created nonetheless, but with a dummy size of 0
+
! reads in absorbing_cpml boundary file
open(unit=98, file=localpath_name(1:len_trim(localpath_name))//'/absorbing_cpml_file', &
status='old', form='formatted',iostat=ier)
- if( ier /= 0 ) then
+! if the file does not exist but if there are PML_CONDITIONS then stop
+ if( ier /= 0 .and. PML_CONDITIONS) &
+ stop 'error: PML_CONDITIONS is set to true but file absorbing_cpml_file does not exist'
+! if the file does not exist or if there are PML_CONDITIONS then define the number of CPML elements as zero
+ if( ier /= 0 .or. .not. PML_CONDITIONS) then
nspec_cpml = 0
else
read(98,*) nspec_cpml, CPML_width
More information about the CIG-COMMITS
mailing list