[cig-commits] r8529 - in seismo/2D/SPECFEM2D/trunk: .
UTILS/sun_grid_engine_UPPA
walter at geodynamics.org
walter at geodynamics.org
Fri Dec 7 15:53:52 PST 2007
Author: walter
Date: 2007-12-07 15:53:51 -0800 (Fri, 07 Dec 2007)
New Revision: 8529
Modified:
seismo/2D/SPECFEM2D/trunk/UTILS/sun_grid_engine_UPPA/qsub_UPPA_parallel.sh
seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90
seismo/2D/SPECFEM2D/trunk/checkgrid.F90
seismo/2D/SPECFEM2D/trunk/compute_forces_acoustic.f90
seismo/2D/SPECFEM2D/trunk/compute_forces_elastic.f90
seismo/2D/SPECFEM2D/trunk/createnum_fast.f90
seismo/2D/SPECFEM2D/trunk/createnum_slow.f90
seismo/2D/SPECFEM2D/trunk/define_shape_functions.f90
seismo/2D/SPECFEM2D/trunk/gll_library.f90
seismo/2D/SPECFEM2D/trunk/gmat01.f90
seismo/2D/SPECFEM2D/trunk/locate_receivers.F90
seismo/2D/SPECFEM2D/trunk/locate_source_force.F90
seismo/2D/SPECFEM2D/trunk/locate_source_moment_tensor.F90
seismo/2D/SPECFEM2D/trunk/numerical_recipes.f90
seismo/2D/SPECFEM2D/trunk/plotpost.f90
seismo/2D/SPECFEM2D/trunk/recompute_jacobian.f90
seismo/2D/SPECFEM2D/trunk/specfem2D.F90
seismo/2D/SPECFEM2D/trunk/write_seismograms.F90
Log:
added call to exit_MPI instead of stop in order to terminate parallel jobs properly with sun grid engine when they need to be interrupted.
Modified: seismo/2D/SPECFEM2D/trunk/UTILS/sun_grid_engine_UPPA/qsub_UPPA_parallel.sh
===================================================================
--- seismo/2D/SPECFEM2D/trunk/UTILS/sun_grid_engine_UPPA/qsub_UPPA_parallel.sh 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/UTILS/sun_grid_engine_UPPA/qsub_UPPA_parallel.sh 2007-12-07 23:53:51 UTC (rev 8529)
@@ -44,11 +44,11 @@
if [ $j -lt 10 ]
then
- scp ./OUTPUT_FILES/Database0000$j $host.univ-pau.fr:/scratch/$2/$3$4/OUTPUT_FILES/
+ scp ../OUTPUT_FILES$3$4/Database0000$j $host.univ-pau.fr:/scratch/$2/$3$4/OUTPUT_FILES/
else
if [ $j -lt 100 ]
then
- scp ./OUTPUT_FILES/Database000$j $host.univ-pau.fr:/scratch/$2$3$4/OUTPUT_FILES/
+ scp ../OUTPUT_FILES$3$4/Database000$j $host.univ-pau.fr:/scratch/$2$3$4/OUTPUT_FILES/
fi
fi
@@ -69,7 +69,8 @@
cd $JOB_NAME$JOB_ID
-scp iplmas014.univ-pau.fr:$CURRENT_DIR/OUTPUT_FILES/Database* ./OUTPUT_FILES/
+mkdir ../OUTPUT_FILES$JOB_NAME$JOB_ID
+scp iplmas014.univ-pau.fr:$CURRENT_DIR/OUTPUT_FILES/Database* ../OUTPUT_FILES$JOB_NAME$JOB_ID/
scp iplmas014.univ-pau.fr:$CURRENT_DIR/DATA/STATIONS ./DATA/
scp iplmas014.univ-pau.fr:$CURRENT_DIR/xspecfem2D ./
scp iplmas014.univ-pau.fr:$CURRENT_DIR/clean_scratch_UPPA.sh ./
@@ -79,6 +80,7 @@
cd $CURRENT_DIR
rm -r $JOB_NAME$JOB_ID/
+rm -r OUTPUT_FILES$JOB_NAME$JOB_ID/
rm ./OUTPUT_FILES/Database*
Modified: seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90 2007-12-07 23:53:51 UTC (rev 8529)
@@ -512,7 +512,7 @@
do inum_interface = 1, ninterface_acoustic*2
call MPI_START(tab_requests_send_recv_acoustic(inum_interface), ier)
if ( ier /= MPI_SUCCESS ) then
- call exit_mpi(myrank,'MPI_start unsuccessful in assemble_MPI_vector_start')
+ call exit_mpi('MPI_start unsuccessful in assemble_MPI_vector_start')
end if
end do
@@ -581,7 +581,7 @@
do inum_interface = 1, ninterface_elastic*2
call MPI_START(tab_requests_send_recv_elastic(inum_interface), ier)
if ( ier /= MPI_SUCCESS ) then
- call exit_mpi(myrank,'MPI_start unsuccessful in assemble_MPI_vector_start')
+ call exit_mpi('MPI_start unsuccessful in assemble_MPI_vector_start')
end if
end do
@@ -633,7 +633,7 @@
call MPI_Waitall ( ninterface_acoustic*2, tab_requests_send_recv_acoustic(1), tab_statuses_acoustic(1,1), ier )
if ( ier /= MPI_SUCCESS ) then
- call exit_mpi(myrank,'MPI_WAITALL unsuccessful in assemble_MPI_vector_wait')
+ call exit_mpi('MPI_WAITALL unsuccessful in assemble_MPI_vector_wait')
end if
do inum_interface = 1, ninterface_acoustic
@@ -695,7 +695,7 @@
call MPI_Waitall ( ninterface_elastic*2, tab_requests_send_recv_elastic(1), tab_statuses_elastic(1,1), ier )
if ( ier /= MPI_SUCCESS ) then
- call exit_mpi(myrank,'MPI_WAITALL unsuccessful in assemble_MPI_vector_wait')
+ call exit_mpi('MPI_WAITALL unsuccessful in assemble_MPI_vector_wait')
end if
do inum_interface = 1, ninterface_elastic
@@ -714,16 +714,19 @@
end subroutine assemble_MPI_vector_elastic_wait
+#endif
-subroutine exit_MPI(myrank,error_msg)
+subroutine exit_MPI(error_msg)
+
implicit none
+#ifdef USE_MPI
! standard include of the MPI library
include 'mpif.h'
+#endif
-
! identifier for error message file
integer, parameter :: IERROR = 30
@@ -733,28 +736,25 @@
integer ier
character(len=80) outputname
+
! write error message to screen
write(*,*) error_msg(1:len(error_msg))
- write(*,*) 'Error detected, aborting MPI... proc ',myrank
+ write(*,*) 'Error detected, aborting MPI... proc '
- ! write error message to file
- write(outputname,"('error_message',i6.6,'.txt')") myrank
- open(unit=IERROR,file=outputname,status='unknown')
- write(IERROR,*) error_msg(1:len(error_msg))
- write(IERROR,*) 'Error detected, aborting MPI... proc ',myrank
- close(IERROR)
-
-
! stop all the MPI processes, and exit
! on some machines, MPI_FINALIZE needs to be called before MPI_ABORT
+#ifdef USE_MPI
+ call MPI_ABORT(MPI_COMM_WORLD,30,ier)
call MPI_FINALIZE(ier)
- call MPI_ABORT(ier)
+
+#endif
stop 'error, program ended in exit_MPI'
+
end subroutine exit_MPI
-#endif
+
Modified: seismo/2D/SPECFEM2D/trunk/checkgrid.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/checkgrid.F90 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/checkgrid.F90 2007-12-07 23:53:51 UTC (rev 8529)
@@ -105,7 +105,9 @@
! convert to real percentage
percent_GLL(:) = percent_GLL(:) / 100.d0
- if(NGLLX > NGLLX_MAX_STABILITY) stop 'cannot estimate the stability condition for that degree'
+ if(NGLLX > NGLLX_MAX_STABILITY) then
+ call exit_MPI('cannot estimate the stability condition for that degree')
+ end if
!---- compute parameters for the spectral elements
@@ -265,7 +267,7 @@
write(IOUT,*) ' Fundamental period = ',1.d0/f0
write(IOUT,*) ' Fundamental frequency = ',f0
if(t0 <= 1.d0/f0) then
- stop 'Onset time too small'
+ call exit_MPI('Onset time too small')
else
write(IOUT,*) ' --> onset time ok'
endif
Modified: seismo/2D/SPECFEM2D/trunk/compute_forces_acoustic.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/compute_forces_acoustic.f90 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/compute_forces_acoustic.f90 2007-12-07 23:53:51 UTC (rev 8529)
@@ -345,12 +345,13 @@
! moment tensor
else if(source_type == 2) then
- if(.not. elastic(ispec_selected_source)) stop 'cannot have moment tensor source in acoustic element'
-
+ if(.not. elastic(ispec_selected_source)) then
+ call exit_MPI('cannot have moment tensor source in acoustic element')
+ end if
endif
end if
else
- stop 'wrong source type'
+ call exit_MPI('wrong source type')
endif
end subroutine compute_forces_acoustic
Modified: seismo/2D/SPECFEM2D/trunk/compute_forces_elastic.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/compute_forces_elastic.f90 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/compute_forces_elastic.f90 2007-12-07 23:53:51 UTC (rev 8529)
@@ -470,7 +470,7 @@
end if
else
- stop 'wrong source type'
+ call exit_MPI('wrong source type')
endif
! implement attenuation
Modified: seismo/2D/SPECFEM2D/trunk/createnum_fast.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/createnum_fast.f90 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/createnum_fast.f90 2007-12-07 23:53:51 UTC (rev 8529)
@@ -37,6 +37,7 @@
double precision xmaxval,xminval,ymaxval,yminval,xtol,xtypdist
double precision xcor,ycor
+
!---- create global mesh numbering
write(IOUT,*)
write(IOUT,*)
@@ -195,7 +196,9 @@
deallocate(iwork)
! verification de la coherence de la numerotation generee
- if(minval(ibool) /= 1 .or. maxval(ibool) /= npoin) stop 'Error while generating global numbering'
+ if(minval(ibool) /= 1 .or. maxval(ibool) /= npoin) then
+ call exit_MPI('Error while generating global numbering')
+ end if
write(IOUT,*)
write(IOUT,*) 'Total number of points of the global mesh: ',npoin
Modified: seismo/2D/SPECFEM2D/trunk/createnum_slow.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/createnum_slow.f90 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/createnum_slow.f90 2007-12-07 23:53:51 UTC (rev 8529)
@@ -30,6 +30,7 @@
integer, dimension(NEDGES) :: ngnod_begin,ngnod_end
+
!---- create global mesh numbering
write(IOUT,*)
write(IOUT,*) 'Generating global mesh numbering (slow version)...'
@@ -122,7 +123,7 @@
i2 = 1
j2 = NGLLZ
else
- stop 'bad corner'
+ call exit_MPI('bad corner')
endif
! affecter le meme numero
@@ -178,7 +179,7 @@
if((knods(ngnod_begin(nedgeother),num2) == knods(ngnod_begin(nedgeloc),numelem)) &
.and. &
(knods(ngnod_end(nedgeother),num2) == knods(ngnod_end(nedgeloc),numelem))) then
- stop 'Improper topology of the input mesh detected'
+ call exit_MPI('Improper topology of the input mesh detected')
!--- sinon voir si cette arete a deja ete generee
@@ -212,7 +213,7 @@
jloc = kloc
ipos = NGLLZ - jloc + 1
else
- stop 'bad nedgeloc'
+ call exit_MPI('bad nedgeloc')
endif
! calculer l'abscisse le long de l'arete d'arrivee
@@ -234,14 +235,18 @@
i2 = 1
j2 = NGLLZ - ipos2 + 1
else
- stop 'bad nedgeother'
+ call exit_MPI('bad nedgeother')
endif
! verifier que le point de depart n'existe pas deja
- if(ibool(iloc,jloc,numelem) /= 0) stop 'point genere deux fois'
+ if(ibool(iloc,jloc,numelem) /= 0) then
+ call exit_MPI('point genere deux fois')
+ end if
! verifier que le point d'arrivee existe bien deja
- if(ibool(i2,j2,num2) == 0) stop 'point inconnu dans le maillage'
+ if(ibool(i2,j2,num2) == 0) then
+ call exit_MPI('point inconnu dans le maillage')
+ end if
! affecter le meme numero
ibool(iloc,jloc,numelem) = ibool(i2,j2,num2)
@@ -275,7 +280,9 @@
enddo
! verification de la coherence de la numerotation generee
- if(minval(ibool) /= 1 .or. maxval(ibool) /= npoin) stop 'Error while generating global numbering'
+ if(minval(ibool) /= 1 .or. maxval(ibool) /= npoin) then
+ call exit_MPI('Error while generating global numbering')
+ end if
write(IOUT,*) 'Total number of points of the global mesh: ',npoin
write(IOUT,*) 'distributed as follows:'
Modified: seismo/2D/SPECFEM2D/trunk/define_shape_functions.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/define_shape_functions.f90 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/define_shape_functions.f90 2007-12-07 23:53:51 UTC (rev 8529)
@@ -125,15 +125,15 @@
dershape2D(2,9) = -ONE * t2 * (ONE - ss)
else
- stop 'Error: wrong number of control nodes'
+ call exit_MPI('Error: wrong number of control nodes')
endif
!--- check the shape functions and their derivatives
! sum of shape functions should be one
! sum of derivaticves of shape functions should be zero
- if(abs(sum(shape2D)-ONE) > TINYVAL) stop 'error shape functions'
- if(abs(sum(dershape2D(1,:))) > TINYVAL) stop 'error deriv xi shape functions'
- if(abs(sum(dershape2D(2,:))) > TINYVAL) stop 'error deriv gamma shape functions'
+ if(abs(sum(shape2D)-ONE) > TINYVAL) call exit_MPI('error shape functions')
+ if(abs(sum(dershape2D(1,:))) > TINYVAL) call exit_MPI('error deriv xi shape functions')
+ if(abs(sum(dershape2D(2,:))) > TINYVAL) call exit_MPI('error deriv gamma shape functions')
end subroutine define_shape_functions
Modified: seismo/2D/SPECFEM2D/trunk/gll_library.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/gll_library.f90 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/gll_library.f90 2007-12-07 23:53:51 UTC (rev 8529)
@@ -431,9 +431,9 @@
p = zero
pdm1 = zero
- if (np <= 0) stop 'minimum number of Gauss points is 1'
+ if (np <= 0) call exit_MPI('minimum number of Gauss points is 1')
- if ((alpha <= -one) .or. (beta <= -one)) stop 'alpha and beta must be greater than -1'
+ if ((alpha <= -one) .or. (beta <= -one)) call exit_MPI('alpha and beta must be greater than -1')
if (np == 1) then
z(1) = (beta-alpha)/(apb+two)
@@ -500,12 +500,12 @@
nm1 = n-1
pd = zero
- if (np <= 1) stop 'minimum number of Gauss-Lobatto points is 2'
+ if (np <= 1) call exit_MPI('minimum number of Gauss-Lobatto points is 2')
! with spectral elements, use at least 3 points
- if (np <= 2) stop 'minimum number of Gauss-Lobatto points for the SEM is 3'
+ if (np <= 2) call exit_MPI('minimum number of Gauss-Lobatto points for the SEM is 3')
- if ((alpha <= -one) .or. (beta <= -one)) stop 'alpha and beta must be greater than -1'
+ if ((alpha <= -one) .or. (beta <= -one)) call exit_MPI('alpha and beta must be greater than -1')
if (nm1 > 0) then
alpg = alpha+one
Modified: seismo/2D/SPECFEM2D/trunk/gmat01.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/gmat01.f90 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/gmat01.f90 2007-12-07 23:53:51 UTC (rev 8529)
@@ -43,7 +43,7 @@
read(iin ,*) n,indic,density,val1,val2,val3,val4
- if(n<1 .or. n>numat) stop 'Wrong material set number'
+ if(n<1 .or. n>numat) call exit_MPI('Wrong material set number')
!---- isotropic material, P and S velocities given
if(indic == 1) then
@@ -68,7 +68,7 @@
poisson = half*(3.d0*kappa-two_mu)/(3.d0*kappa+mu)
! Poisson's ratio must be between -1 and +1/2
- if (poisson < -1.d0 .or. poisson > 0.5d0) stop 'Poisson''s ratio out of range'
+ if (poisson < -1.d0 .or. poisson > 0.5d0) call exit_MPI('Poisson''s ratio out of range')
!---- anisotropic material, c11, c13, c33 and c44 given in Pascal
else if (indic == 2) then
@@ -78,7 +78,7 @@
c44 = val4
else
- stop 'wrong model flag read'
+ call exit_MPI('wrong model flag read')
endif
Modified: seismo/2D/SPECFEM2D/trunk/locate_receivers.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/locate_receivers.F90 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/locate_receivers.F90 2007-12-07 23:53:51 UTC (rev 8529)
@@ -86,7 +86,7 @@
open(unit=1,file='DATA/STATIONS',status='old',action='read')
read(1,*) nrec_dummy
- if(nrec_dummy /= nrec) stop 'problem with number of receivers'
+ if(nrec_dummy /= nrec) call exit_MPI('problem with number of receivers')
! allocate memory for arrays using number of stations
allocate(final_distance(nrec))
@@ -100,7 +100,7 @@
read(1,*) station_name(irec),network_name(irec),st_xval(irec),st_zval(irec),stele,stbur
! check that station is not buried, burial is not implemented in current code
- if(abs(stbur) > TINYVAL) stop 'stations with non-zero burial not implemented yet'
+ if(abs(stbur) > TINYVAL) call exit_MPI('stations with non-zero burial not implemented yet')
! compute distance between source and receiver
distance_receiver(irec) = sqrt((st_zval(irec)-z_source)**2 + (st_xval(irec)-x_source)**2)
@@ -234,7 +234,7 @@
write(IOUT,*)
write(IOUT,*) 'Station # ',irec,' ',station_name(irec),network_name(irec)
- if(gather_final_distance(irec,which_proc_receiver(irec)+1) == HUGEVAL) stop 'error locating receiver'
+ if(gather_final_distance(irec,which_proc_receiver(irec)+1) == HUGEVAL) call exit_MPI('error locating receiver')
write(IOUT,*) ' original x: ',sngl(st_xval(irec))
write(IOUT,*) ' original z: ',sngl(st_zval(irec))
Modified: seismo/2D/SPECFEM2D/trunk/locate_source_force.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/locate_source_force.F90 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/locate_source_force.F90 2007-12-07 23:53:51 UTC (rev 8529)
@@ -119,7 +119,7 @@
#endif
if ( nb_proc_source < 1 ) then
- stop "error locating force source"
+ call exit_MPI('error locating force source')
end if
if ( is_proc_source == 1 ) then
Modified: seismo/2D/SPECFEM2D/trunk/locate_source_moment_tensor.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/locate_source_moment_tensor.F90 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/locate_source_moment_tensor.F90 2007-12-07 23:53:51 UTC (rev 8529)
@@ -189,7 +189,7 @@
write(IOUT,*)
write(IOUT,*) 'Moment-tensor source:'
- if(final_distance == HUGEVAL) stop 'error locating moment-tensor source'
+ if(final_distance == HUGEVAL) call exit_MPI('error locating moment-tensor source')
write(IOUT,*) ' original x: ',sngl(x_source)
write(IOUT,*) ' original z: ',sngl(z_source)
Modified: seismo/2D/SPECFEM2D/trunk/numerical_recipes.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/numerical_recipes.f90 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/numerical_recipes.f90 2007-12-07 23:53:51 UTC (rev 8529)
@@ -35,7 +35,7 @@
! this routine uses routines gcf and gser
double precision gammcf,gamser,gln
- if(x<0.d0 .or. a <= 0.d0) stop 'bad arguments in gammp'
+ if(x<0.d0 .or. a <= 0.d0) call exit_MPI('bad arguments in gammp')
if(x<a+1.d0)then
call gser(gamser,a,x,gln)
@@ -86,7 +86,7 @@
endif
enddo
- stop 'a too large, ITMAX too small in gcf'
+ call exit_MPI('a too large, ITMAX too small in gcf')
end subroutine gcf
@@ -111,7 +111,7 @@
gln=gammln(a)
if(x <= 0.d0)then
- if(x<0.d0) stop 'x < 0 in gser'
+ if(x<0.d0) call exit_MPI('x < 0 in gser')
gamser=0.d0
return
endif
@@ -130,7 +130,7 @@
endif
enddo
- stop 'a too large, ITMAX too small in gser'
+ call exit_MPI('a too large, ITMAX too small in gser')
end subroutine gser
Modified: seismo/2D/SPECFEM2D/trunk/plotpost.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/plotpost.f90 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/plotpost.f90 2007-12-07 23:53:51 UTC (rev 8529)
@@ -1424,7 +1424,7 @@
else if(imagetype == 3) then
write(24,*) '(Acceleration vector field) show'
else
- stop 'Bad field code in PostScript display'
+ call exit_MPI('Bad field code in PostScript display')
endif
write(24,*) 'grestore'
write(24,*) '25.35 CM 18.9 CM MV'
@@ -1720,7 +1720,7 @@
ideb = 2
ifin = 3
else
- stop 'Wrong absorbing boundary code'
+ call exit_MPI('Wrong absorbing boundary code')
endif
x1 = (coorg(1,knods(ideb,ispec))-xmin)*ratio_page + orig_x
@@ -1780,7 +1780,7 @@
ideb = 2
ifin = 3
else
- stop 'Wrong fluid-solid coupling edge code'
+ call exit_MPI('Wrong fluid-solid coupling edge code')
endif
x1 = (coorg(1,knods(ideb,ispec))-xmin)*ratio_page + orig_x
Modified: seismo/2D/SPECFEM2D/trunk/recompute_jacobian.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/recompute_jacobian.f90 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/recompute_jacobian.f90 2007-12-07 23:53:51 UTC (rev 8529)
@@ -67,7 +67,7 @@
jacobian = xxi*zgamma - xgamma*zxi
- if(jacobian <= ZERO) stop '2D Jacobian undefined'
+ if(jacobian <= ZERO) call exit_MPI('2D Jacobian undefined')
! invert the relation
xix = zgamma / jacobian
Modified: seismo/2D/SPECFEM2D/trunk/specfem2D.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/specfem2D.F90 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/specfem2D.F90 2007-12-07 23:53:51 UTC (rev 8529)
@@ -361,8 +361,8 @@
read(IIN,"(a80)") datlin
read(IIN,*) seismotype,imagetype
- if(seismotype < 1 .or. seismotype > 4) stop 'Wrong type for seismogram output'
- if(imagetype < 1 .or. imagetype > 4) stop 'Wrong type for snapshots'
+ if(seismotype < 1 .or. seismotype > 4) call exit_MPI('Wrong type for seismogram output')
+ if(imagetype < 1 .or. imagetype > 4) call exit_MPI('Wrong type for snapshots')
read(IIN,"(a80)") datlin
read(IIN,*) assign_external_model,outputgrid,TURN_ANISOTROPY_ON,TURN_ATTENUATION_ON
@@ -394,7 +394,7 @@
else if(source_type == 2) then
write(IOUT,222) x_source,z_source,f0,t0,factor,Mxx,Mzz,Mxz
else
- stop 'Unknown source type number !'
+ call exit_MPI('Unknown source type number !')
endif
endif
@@ -414,7 +414,7 @@
allocate(coorgread(NDIM))
do ip = 1,npgeo
read(IIN,*) ipoin,(coorgread(id),id =1,NDIM)
- if(ipoin<1 .or. ipoin>npgeo) stop 'Wrong control point number'
+ if(ipoin<1 .or. ipoin>npgeo) call exit_MPI('Wrong control point number')
coorg(:,ipoin) = coorgread
enddo
deallocate(coorgread)
@@ -588,7 +588,7 @@
do inum = 1,nelemabs
read(IIN,*) numabsread,codeabsread(1),codeabsread(2),codeabsread(3),codeabsread(4), ibegin_bottom(inum), iend_bottom(inum), &
jbegin_right(inum), jend_right(inum), ibegin_top(inum), iend_top(inum), jbegin_left(inum), jend_left(inum)
- if(numabsread < 1 .or. numabsread > nspec) stop 'Wrong absorbing element number'
+ if(numabsread < 1 .or. numabsread > nspec) call exit_MPI('Wrong absorbing element number')
numabs(inum) = numabsread
codeabs(IBOTTOM,inum) = codeabsread(1)
codeabs(IRIGHT,inum) = codeabsread(2)
@@ -617,8 +617,8 @@
acoustic_edges, acoustic_surface)
print *, 'POYU'
!!$ read(IIN,*) numacoustread,iedgeacoustread
-!!$ if(numacoustread < 1 .or. numacoustread > nspec) stop 'Wrong acoustic free surface element number'
-!!$ if(iedgeacoustread < 1 .or. iedgeacoustread > NEDGES) stop 'Wrong acoustic free surface edge number'
+!!$ if(numacoustread < 1 .or. numacoustread > nspec) call eixt_MPI('Wrong acoustic free surface element number')
+!!$ if(iedgeacoustread < 1 .or. iedgeacoustread > NEDGES) call exit_MPI('Wrong acoustic free surface edge number')
!!$ ispecnum_acoustic_surface(inum) = numacoustread
!!$ iedgenum_acoustic_surface(inum) = iedgeacoustread
!!$ enddo
@@ -699,7 +699,7 @@
write(IOUT,*) 'Total number of receivers = ',nrec
write(IOUT,*)
- if(nrec < 1) stop 'need at least one receiver'
+ if(nrec < 1) call exit_MPI('need at least one receiver')
@@ -793,7 +793,7 @@
write(IOUT,*) 'Assigning external velocity and density model...'
write(IOUT,*)
if(TURN_ANISOTROPY_ON .or. TURN_ATTENUATION_ON) &
- stop 'cannot have anisotropy nor attenuation if external model in current version'
+ call exit_MPI('cannot have anisotropy nor attenuation if external model in current version')
any_acoustic = .false.
any_elastic = .false.
do ispec = 1,nspec
@@ -802,12 +802,12 @@
do i = 1,NGLLX
iglob = ibool(i,j,ispec)
call define_external_model(coord(1,iglob),coord(2,iglob),kmato(ispec), &
- rhoext(i,j,ispec),vpext(i,j,ispec),vsext(i,j,ispec))
+ rhoext(i,j,ispec),vpext(i,j,ispec),vsext(i,j,ispec),myrank)
! stop if the same element is assigned both acoustic and elastic points in external model
if(.not. (i == 1 .and. j == 1) .and. &
((vsext(i,j,ispec) >= TINYVAL .and. previous_vsext < TINYVAL) .or. &
(vsext(i,j,ispec) < TINYVAL .and. previous_vsext >= TINYVAL))) &
- stop 'external velocity model cannot be both fluid and solid inside the same spectral element'
+ call exit_MPI('external velocity model cannot be both fluid and solid inside the same spectral element')
if(vsext(i,j,ispec) < TINYVAL) then
elastic(ispec) = .false.
any_acoustic = .true.
@@ -826,12 +826,13 @@
!
! for acoustic
- if(TURN_ANISOTROPY_ON .and. .not. any_elastic) stop 'cannot have anisotropy if acoustic simulation only'
+ if(TURN_ANISOTROPY_ON .and. .not. any_elastic) call exit_MPI('cannot have anisotropy if acoustic simulation only')
- if(TURN_ATTENUATION_ON .and. .not. any_elastic) stop 'currently cannot have attenuation if acoustic simulation only'
+ if(TURN_ATTENUATION_ON .and. .not. any_elastic) call exit_MPI('currently cannot have attenuation if acoustic simulation only')
! for attenuation
- if(TURN_ANISOTROPY_ON .and. TURN_ATTENUATION_ON) stop 'cannot have anisotropy and attenuation both turned on in current version'
+ if(TURN_ANISOTROPY_ON .and. TURN_ATTENUATION_ON) call exit_MPI('cannot have anisotropy and attenuation both &
+ & turned on in current version')
!
!---- define coefficients of the Newmark time scheme
@@ -854,7 +855,8 @@
do i = acoustic_surface(2,ispec_acoustic_surface), acoustic_surface(3,ispec_acoustic_surface)
iglob = ibool(i,j,ispec)
if ( iglob_source == iglob ) then
- stop 'an acoustic source cannot be located exactly on the free surface because pressure is zero there'
+ call exit_MPI('an acoustic source cannot be located exactly on the free surface &
+ & because pressure is zero there')
end if
end do
end do
@@ -872,7 +874,7 @@
Mxx,Mzz,Mxz,xix,xiz,gammax,gammaz,xigll,zigll,nspec)
else
- stop 'incorrect source type'
+ call exit_MPI('incorrect source type')
endif
@@ -912,7 +914,8 @@
(izmin==NGLLZ .and. izmax==NGLLZ .and. ixmin==NGLLX .and. ixmax==NGLLX .and. &
gamma_receiver(irec) > 0.99d0 .and. xi_receiver(irec) > 0.99d0) ) then
if(seismotype == 4) then
- stop 'an acoustic pressure receiver cannot be located exactly on the free surface because pressure is zero there'
+ call exit_MPI('an acoustic pressure receiver cannot be located exactly on the free &
+ & surface because pressure is zero there')
else
print *, '**********************************************************************'
print *, '*** Warning: acoustic receiver located exactly on the free surface ***'
@@ -1155,7 +1158,7 @@
end do
end do
if ( dist_min_pixel >= HUGEVAL ) then
- stop 'Error in detecting pixel for color image'
+ call exit_MPI('Error in detecting pixel for color image')
end if
nb_pixel_loc = nb_pixel_loc + 1
@@ -1332,17 +1335,17 @@
write(IOUT,*)
write(IOUT,*) 'Reading initial fields from external file...'
write(IOUT,*)
- if(any_acoustic) stop 'initial field currently implemented for purely elastic simulation only'
+ if(any_acoustic) call exit_MPI('initial field currently implemented for purely elastic simulation only')
open(unit=55,file='OUTPUT_FILES/wavefields.txt',status='unknown')
read(55,*) nbpoin
- if(nbpoin /= npoin) stop 'Wrong number of points in input file'
+ if(nbpoin /= npoin) call exit_MPI('Wrong number of points in input file')
allocate(displread(NDIM))
allocate(velocread(NDIM))
allocate(accelread(NDIM))
do n = 1,npoin
read(55,*) inump, (displread(i), i=1,NDIM), &
(velocread(i), i=1,NDIM), (accelread(i), i=1,NDIM)
- if(inump<1 .or. inump>npoin) stop 'Wrong point number'
+ if(inump<1 .or. inump>npoin) call exit_MPI('Wrong point number')
displ_elastic(:,inump) = displread
veloc_elastic(:,inump) = velocread
accel_elastic(:,inump) = accelread
@@ -1398,7 +1401,7 @@
source_time_function(it) = factor * 0.5d0*(1.0d0+erf(SOURCE_DECAY_RATE*(time-t0)/hdur_gauss))
else
- stop 'unknown source time function'
+ call exit_MPI('unknown source time function')
endif
! output absolute time in third column, in case user wants to check it as well
@@ -1426,11 +1429,11 @@
!!$ ispec = ispecnum_acoustic_surface(ispec_acoustic_surface)
!!$ iedge = iedgenum_acoustic_surface(ispec_acoustic_surface)
!!$ if(elastic(ispec)) then
-!!$ stop 'elastic element detected in acoustic free surface'
+!!$ call exit_MPI('elastic element detected in acoustic free surface')
!!$ else
!!$ do inum = 1,nelemabs
!!$ if(numabs(inum) == ispec .and. codeabs(iedge,inum)) &
-!!$ stop 'acoustic free surface cannot be both absorbing and free'
+!!$ call exit_MPI('acoustic free surface cannot be both absorbing and free')
!!$ enddo
!!$ endif
!!$ enddo
@@ -1526,7 +1529,7 @@
enddo
- !if(num_fluid_solid_edges /= num_fluid_solid_edges_alloc) stop 'error in creation of arrays for fluid/solid matching'
+ !if(num_fluid_solid_edges /= num_fluid_solid_edges_alloc) call exit_MPI('error in creation of arrays for fluid/solid matching')
! make sure fluid/solid matching has been perfectly detected: check that the grid points
! have the same physical coordinates
@@ -1559,7 +1562,7 @@
! if distance between the two points is not negligible, there is an error, since it should be zero
if(sqrt((coord(1,iglob) - coord(1,iglob2))**2 + (coord(2,iglob) - coord(2,iglob2))**2) > TINYVAL) &
- stop 'error in fluid/solid coupling buffer'
+ call exit_MPI( 'error in fluid/solid coupling buffer')
enddo
@@ -1938,7 +1941,7 @@
!!$ call MPI_BARRIER(MPI_COMM_WORLD, ier)
!!$#endif
!!$
-!!$ stop
+!!$ call exit_MPI('plop')
if(any_elastic) then
accel_elastic(1,:) = accel_elastic(1,:) * rmass_inverse_elastic
@@ -1961,14 +1964,14 @@
displnorm_all = maxval(sqrt(displ_elastic(1,:)**2 + displ_elastic(2,:)**2))
write(IOUT,*) 'Max norm of vector field in solid = ',displnorm_all
! check stability of the code in solid, exit if unstable
- if(displnorm_all > STABILITY_THRESHOLD) stop 'code became unstable and blew up in solid'
+ if(displnorm_all > STABILITY_THRESHOLD) call exit_MPI('code became unstable and blew up in solid')
endif
if(any_acoustic) then
displnorm_all = maxval(abs(potential_acoustic(:)))
write(IOUT,*) 'Max absolute value of scalar field in fluid = ',displnorm_all
! check stability of the code in fluid, exit if unstable
- if(displnorm_all > STABILITY_THRESHOLD) stop 'code became unstable and blew up in fluid'
+ if(displnorm_all > STABILITY_THRESHOLD) call exit_MPI('code became unstable and blew up in fluid')
endif
write(IOUT,*)
@@ -2126,7 +2129,7 @@
write(IOUT,*) 'cannot draw scalar pressure field as a vector plot, skipping...'
else
- stop 'wrong type for snapshots'
+ call exit_MPI('wrong type for snapshots')
endif
if(imagetype /= 4) write(IOUT,*) 'PostScript file written'
@@ -2171,7 +2174,7 @@
e1_mech2,e11_mech2,TURN_ATTENUATION_ON,TURN_ANISOTROPY_ON)
else
- stop 'wrong type for snapshots'
+ call exit_MPI('wrong type for snapshots')
endif
image_color_data(:,:) = 0.d0
Modified: seismo/2D/SPECFEM2D/trunk/write_seismograms.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/write_seismograms.F90 2007-06-26 00:44:52 UTC (rev 8528)
+++ seismo/2D/SPECFEM2D/trunk/write_seismograms.F90 2007-12-07 23:53:51 UTC (rev 8529)
@@ -69,7 +69,7 @@
else if(seismotype == 4) then
component = 'p'
else
- stop 'wrong component to save for seismograms'
+ call exit_MPI('wrong component to save for seismograms')
endif
@@ -160,7 +160,7 @@
else if(iorientation == 2) then
chn = 'BHZ'
else
- stop 'incorrect channel value'
+ call exit_MPI('incorrect channel value')
endif
! in case of pressure, use different abbreviation
@@ -172,10 +172,13 @@
length_network_name = len_trim(network_name(irec))
! check that length conforms to standard
- if(length_station_name < 1 .or. length_station_name > MAX_LENGTH_STATION_NAME) stop 'wrong length of station name'
+ if(length_station_name < 1 .or. length_station_name > MAX_LENGTH_STATION_NAME) then
+ call exit_MPI('wrong length of station name')
+ end if
+ if(length_network_name < 1 .or. length_network_name > MAX_LENGTH_NETWORK_NAME) then
+ call exit_MPI('wrong length of network name')
+ end if
- if(length_network_name < 1 .or. length_network_name > MAX_LENGTH_NETWORK_NAME) stop 'wrong length of network name'
-
write(sisname,"('OUTPUT_FILES/',a,'.',a,'.',a3,'.sem',a1)") station_name(irec)(1:length_station_name),&
network_name(irec)(1:length_network_name),chn,component
More information about the cig-commits
mailing list