[cig-commits] r21865 - in seismo/2D/SPECFEM2D/trunk: EXAMPLES/INDUSTRIAL_FORMAT EXAMPLES/noise_layered EXAMPLES/noise_uniform UTILS src/meshfem2D src/shared src/specfem2D
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Sat Apr 13 15:21:11 PDT 2013
Author: dkomati1
Date: 2013-04-13 15:21:10 -0700 (Sat, 13 Apr 2013)
New Revision: 21865
Modified:
seismo/2D/SPECFEM2D/trunk/EXAMPLES/INDUSTRIAL_FORMAT/interpolate.f90
seismo/2D/SPECFEM2D/trunk/EXAMPLES/noise_layered/adj_mask.f90
seismo/2D/SPECFEM2D/trunk/EXAMPLES/noise_uniform/adj_cc.f90
seismo/2D/SPECFEM2D/trunk/UTILS/decimate_mesh.f90
seismo/2D/SPECFEM2D/trunk/src/meshfem2D/meshfem2D.F90
seismo/2D/SPECFEM2D/trunk/src/meshfem2D/part_unstruct.F90
seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_materials.f90
seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_parameter_file.F90
seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_regions.f90
seismo/2D/SPECFEM2D/trunk/src/meshfem2D/save_databases.f90
seismo/2D/SPECFEM2D/trunk/src/shared/read_value_parameters.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/assemble_MPI.F90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/calendar.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/checkgrid.F90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_curl_one_element.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_energy.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_forces_acoustic.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_forces_poro_fluid.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_forces_poro_solid.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_forces_viscoelastic.F90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_pressure.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_vector_field.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/convert_time.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/get_MPI.F90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/gmat01.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/initialize_simulation.F90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/invert_mass_matrix.F90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/noise_tomography.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/paco_beyond_critical.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/paco_convolve_fft.f90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/pml_init.F90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/prepare_assemble_MPI.F90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/read_databases.F90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90
seismo/2D/SPECFEM2D/trunk/src/specfem2D/write_seismograms.F90
Log:
unified syntax for endif, enddo and else if;
alse removed useless white spaces
Modified: seismo/2D/SPECFEM2D/trunk/EXAMPLES/INDUSTRIAL_FORMAT/interpolate.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/EXAMPLES/INDUSTRIAL_FORMAT/interpolate.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/EXAMPLES/INDUSTRIAL_FORMAT/interpolate.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -3,7 +3,7 @@
implicit none
!include "constants.h"
character(len=512),parameter :: sep_directory='./EXAMPLES/INDUSTRIAL_FORMAT/SEG_2D_SALT/'
- character(len=512),parameter :: sep_header_file_vp='vp.H'
+ character(len=512),parameter :: sep_header_file_vp='vp.H'
character(len=512),parameter :: sep_header_file_vs='vs.H' ! not used
character(len=512),parameter :: sep_header_file_rho='rho.H' ! not used
integer :: NX,NY,NZ,esize
Modified: seismo/2D/SPECFEM2D/trunk/EXAMPLES/noise_layered/adj_mask.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/EXAMPLES/noise_layered/adj_mask.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/EXAMPLES/noise_layered/adj_mask.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -32,7 +32,7 @@
! time variables
integer :: it, nt, nthalf
-double precision :: dt, off
+double precision :: dt, off
! data variables
double precision, dimension(:), allocatable :: seismo_1, seismo_2, seismo_3, seismo_4, &
@@ -101,7 +101,7 @@
open(unit=1001,file=trim(filename),status='old',action='read')
do it = 1, nt
read(1001,*) t(it), seismo_1(it)
-end do
+enddo
close(1001)
@@ -113,30 +113,30 @@
if (differentiate == 1) seismo_2(it) = ( seismo_1(it+1) - seismo_1(it-1) ) / (2*dt)
if (differentiate == 2) seismo_2(it) = ( seismo_1(it+1) - 2 * seismo_1(it) + seismo_1(it-1) ) / dt**2
-end do
+enddo
!!!!!!!!!! FILTER !!!!!!!!!!!!!!!!!!!!
seismo_3 = seismo_2
if (use_filtering) then
-! THIS SECTION CALCULATES THE FILTER AND MUST BE CALLED BEFORE
-! FILTER IS CALLED
+! THIS SECTION CALCULATES THE FILTER AND MUST BE CALLED BEFORE
+! FILTER IS CALLED
DELT = 1.0d3 * dt
F1=freq_low
F2=freq_high
call BNDPAS(F1,F2,DELT,D,G,nt)
-! F1 = LOW FREQUENCY CUTOFF (6 DB DOWN)
-! F2 = HIGH FREQUENCY CUTOFF (6 DB DOWN)
-! DELT = SAMPLE INTERVAL IN MILLISECONDS
-! D = WILL CONTAIN 8 Z DOMAIN COEFICIENTS OF RECURSIVE FILTER
+! F1 = LOW FREQUENCY CUTOFF (6 DB DOWN)
+! F2 = HIGH FREQUENCY CUTOFF (6 DB DOWN)
+! DELT = SAMPLE INTERVAL IN MILLISECONDS
+! D = WILL CONTAIN 8 Z DOMAIN COEFICIENTS OF RECURSIVE FILTER
! G = WILL CONTAIN THE GAIN OF THE FILTER,
call FILTER(seismo_3,nt,D,G,2)
-! X = DATA VECTOR OF LENGTH N CONTAINING DATA TO BE FILTERED
-! D = FILTER COEFFICIENTS CALCULATED BY BNDPAS
-! G = FILTER GAIN
+! X = DATA VECTOR OF LENGTH N CONTAINING DATA TO BE FILTERED
+! D = FILTER COEFFICIENTS CALCULATED BY BNDPAS
+! G = FILTER GAIN
! IG = 1 one pass
! IG = 2 two passes
-end if
+endif
!!!!!!!!!! WINDOW !!!!!!!!!!!!!!!!!!!!
@@ -146,14 +146,14 @@
if (it_begin < 1) it_begin = 1
if (it_end > nt) it_end = nt
-elseif (use_positive_branch) then
+else if (use_positive_branch) then
write(*,*) 'Choosing positive branch'
it_begin = nthalf + floor(off/dt)
it_end = nt
if (it_begin < nthalf) it_begin = nthalf
if (it_end > nt) it_end = nt
-elseif (use_negative_branch) then
+else if (use_negative_branch) then
write(*,*) 'Choosing negative branch'
it_begin = 1
it_end = nthalf - floor(off/dt)
@@ -180,14 +180,14 @@
if (beta<alpha/2.) then
w(it) = 0.5*(1.+cos(2.*pi/alpha*(beta-alpha/2.)))
- elseif (beta>alpha/2. .and. beta<1.-alpha/2.) then
+ else if (beta>alpha/2. .and. beta<1.-alpha/2.) then
w(it) = 1.0
else
w(it) = 0.5*(1.+cos(2*pi/w_tukey*(beta-1.+alpha/2.)))
endif
-end do
+enddo
seismo_4 = w * seismo_3
@@ -205,7 +205,7 @@
do it = 1,nt
if (.not. time_reverse) write(1002,'(f16.12,1pe18.8)'), t(it), seismo_adj(it)
if (time_reverse) write(1002,'(f16.12,1pe18.8)'), t(it), seismo_adj(nt+1-it)
-end do
+enddo
close(1002)
write(*,*) 'Finished writing to file.'
@@ -279,162 +279,162 @@
!=====================================================================
-SUBROUTINE BNDPAS(F1,F2,DELT,D,G,N)
-! RECURSIVE BUTTERWORTH BAND PASS FILTER (KANASEWICH, TIME SERIES
-! ANALYSIS IN GEOPHYSICS, UNIVERSITY OF ALBERTA PRESS, 1975; SHANKS,
-! JOHN L, RECURSION FILTERS FOR DIGITAL PROCESSING, GEOPHYSICS, V32,
-! FILTER. THE FILTER WILL HAVE 8 POLES IN THE S PLANE AND IS
-! APPLIED IN FORWARD AND REVERSE DIRECTIONS SO AS TO HAVE ZERO
-! PHASE SHIFT. THE GAIN AT THE TWO FREQUENCIES SPECIFIED AS
-! CUTOFF FREQUENCIES WILL BE -6DB AND THE ROLLOFF WILL BE ABOUT
-! THE FILTER TO PREVENT ALIASING PROBLEMS.
- COMPLEX P(4),S(8),Z1,Z2
- real D(8),XC(3),XD(3),XE(3)
- double precision :: X(N)
- DATA ISW/0/,TWOPI/6.2831853/
-! THIS SECTION CALCULATES THE FILTER AND MUST BE CALLED BEFORE
-! FILTER IS CALLED
-
-! F1 = LOW FREQUENCY CUTOFF (6 DB DOWN)
-! F2 = HIGH FREQUENCY CUTOFF (6 DB DOWN)
-! DELT = SAMPLE INTERVAL IN MILLISECONDS
-! D = WILL CONTAIN 8 Z DOMAIN COEFICIENTS OF RECURSIVE FILTER
-! G = WILL CONTAIN THE GAIN OF THE FILTER,
+SUBROUTINE BNDPAS(F1,F2,DELT,D,G,N)
+! RECURSIVE BUTTERWORTH BAND PASS FILTER (KANASEWICH, TIME SERIES
+! ANALYSIS IN GEOPHYSICS, UNIVERSITY OF ALBERTA PRESS, 1975; SHANKS,
+! JOHN L, RECURSION FILTERS FOR DIGITAL PROCESSING, GEOPHYSICS, V32,
+! FILTER. THE FILTER WILL HAVE 8 POLES IN THE S PLANE AND IS
+! APPLIED IN FORWARD AND REVERSE DIRECTIONS SO AS TO HAVE ZERO
+! PHASE SHIFT. THE GAIN AT THE TWO FREQUENCIES SPECIFIED AS
+! CUTOFF FREQUENCIES WILL BE -6DB AND THE ROLLOFF WILL BE ABOUT
+! THE FILTER TO PREVENT ALIASING PROBLEMS.
+ COMPLEX P(4),S(8),Z1,Z2
+ real D(8),XC(3),XD(3),XE(3)
+ double precision :: X(N)
+ DATA ISW/0/,TWOPI/6.2831853/
+! THIS SECTION CALCULATES THE FILTER AND MUST BE CALLED BEFORE
+! FILTER IS CALLED
- DT=DELT/1000.0
- TDT=2.0/DT
- FDT=4.0/DT
- ISW=1
- P(1)=CMPLX(-.3826834,.9238795)
- P(2)=CMPLX(-.3826834,-.9238795)
- P(3)=CMPLX(-.9238795,.3826834)
- P(4)=CMPLX(-.9238795,-.3826834)
- W1=TWOPI*F1
- W2=TWOPI*F2
- W1=TDT*TAN(W1/TDT)
- W2=TDT*TAN(W2/TDT)
- HWID=(W2-W1)/2.0
- WW=W1*W2
- DO 19 I=1,4
- Z1=P(I)*HWID
- Z2=Z1*Z1-WW
- Z2=CSQRT(Z2)
- S(I)=Z1+Z2
- 19 S(I+4)=Z1-Z2
- G=.5/HWID
- G=G*G
- G=G*G
- DO 29 I=1,7,2
- B=-2.0*REAL(S(I))
- Z1=S(I)*S(I+1)
- C=REAL(Z1)
- A=TDT+B+C/TDT
- G=G*A
- D(I)=(C*DT-FDT)/A
- 29 D(I+1)=(A-2.0*B)/A
- G=G*G
- 5 FORMAT ('-FILTER GAIN IS ', 9E12.6)
- RETURN
+! F1 = LOW FREQUENCY CUTOFF (6 DB DOWN)
+! F2 = HIGH FREQUENCY CUTOFF (6 DB DOWN)
+! DELT = SAMPLE INTERVAL IN MILLISECONDS
+! D = WILL CONTAIN 8 Z DOMAIN COEFICIENTS OF RECURSIVE FILTER
+! G = WILL CONTAIN THE GAIN OF THE FILTER,
- ENTRY FILTER(X,N,D,G,IG)
-
-! X = DATA VECTOR OF LENGTH N CONTAINING DATA TO BE FILTERED
-! D = FILTER COEFFICIENTS CALCULATED BY BNDPAS
-! G = FILTER GAIN
+ DT=DELT/1000.0
+ TDT=2.0/DT
+ FDT=4.0/DT
+ ISW=1
+ P(1)=CMPLX(-.3826834,.9238795)
+ P(2)=CMPLX(-.3826834,-.9238795)
+ P(3)=CMPLX(-.9238795,.3826834)
+ P(4)=CMPLX(-.9238795,-.3826834)
+ W1=TWOPI*F1
+ W2=TWOPI*F2
+ W1=TDT*TAN(W1/TDT)
+ W2=TDT*TAN(W2/TDT)
+ HWID=(W2-W1)/2.0
+ WW=W1*W2
+ DO 19 I=1,4
+ Z1=P(I)*HWID
+ Z2=Z1*Z1-WW
+ Z2=CSQRT(Z2)
+ S(I)=Z1+Z2
+ 19 S(I+4)=Z1-Z2
+ G=.5/HWID
+ G=G*G
+ G=G*G
+ DO 29 I=1,7,2
+ B=-2.0*REAL(S(I))
+ Z1=S(I)*S(I+1)
+ C=REAL(Z1)
+ A=TDT+B+C/TDT
+ G=G*A
+ D(I)=(C*DT-FDT)/A
+ 29 D(I+1)=(A-2.0*B)/A
+ G=G*G
+ 5 FORMAT ('-FILTER GAIN IS ', 9E12.6)
+ RETURN
+
+ ENTRY FILTER(X,N,D,G,IG)
+
+! X = DATA VECTOR OF LENGTH N CONTAINING DATA TO BE FILTERED
+! D = FILTER COEFFICIENTS CALCULATED BY BNDPAS
+! G = FILTER GAIN
! IG = 1 one pass
! ig = 2 two passes
-
- IF (ISW.EQ.1) GO TO 31
- WRITE (6,6)
- 6 FORMAT ('1BNDPAS MUST BE CALLED BEFORE FILTER')
- return
-
-! APPLY FILTER IN FORWARD DIRECTION
-
- 31 XM2=X(1)
- XM1=X(2)
- XM=X(3)
- XC(1)=XM2
- XC(2)=XM1-D(1)*XC(1)
- XC(3)=XM-XM2-D(1)*XC(2)-D(2)*XC(1)
- XD(1)=XC(1)
- XD(2)=XC(2)-D(3)*XD(1)
- XD(3)=XC(3)-XC(1)-D(3)*XD(2)-D(4)*XD(1)
- XE(1)=XD(1)
- XE(2)=XD(2)-D(5)*XE(1)
- XE(3)=XD(3)-XD(1)-D(5)*XE(2)-D(6)*XE(1)
- X(1)=XE(1)
- X(2)=XE(2)-D(7)*X(1)
- X(3)=XE(3)-XE(1)-D(7)*X(2)-D(8)*X(1)
- DO 39 I=4,N
- XM2=XM1
- XM1=XM
- XM=X(I)
- K=I-((I-1)/3)*3
- GO TO (34,35,36),K
- 34 M=1
- M1=3
- M2=2
- GO TO 37
- 35 M=2
- M1=1
- M2=3
- GO TO 37
- 36 M=3
- M1=2
- M2=1
- 37 XC(M)=XM-XM2-D(1)*XC(M1)-D(2)*XC(M2)
- XD(M)=XC(M)-XC(M2)-D(3)*XD(M1)-D(4)*XD(M2)
- XE(M)=XD(M)-XD(M2)-D(5)*XE(M1)-D(6)*XE(M2)
- 39 X(I)=XE(M)-XE(M2)-D(7)*X(I-1)-D(8)*X(I-2)
-!
+
+ IF (ISW==1) GO TO 31
+ WRITE (6,6)
+ 6 FORMAT ('1BNDPAS MUST BE CALLED BEFORE FILTER')
+ return
+
+! APPLY FILTER IN FORWARD DIRECTION
+
+ 31 XM2=X(1)
+ XM1=X(2)
+ XM=X(3)
+ XC(1)=XM2
+ XC(2)=XM1-D(1)*XC(1)
+ XC(3)=XM-XM2-D(1)*XC(2)-D(2)*XC(1)
+ XD(1)=XC(1)
+ XD(2)=XC(2)-D(3)*XD(1)
+ XD(3)=XC(3)-XC(1)-D(3)*XD(2)-D(4)*XD(1)
+ XE(1)=XD(1)
+ XE(2)=XD(2)-D(5)*XE(1)
+ XE(3)=XD(3)-XD(1)-D(5)*XE(2)-D(6)*XE(1)
+ X(1)=XE(1)
+ X(2)=XE(2)-D(7)*X(1)
+ X(3)=XE(3)-XE(1)-D(7)*X(2)-D(8)*X(1)
+ DO 39 I=4,N
+ XM2=XM1
+ XM1=XM
+ XM=X(I)
+ K=I-((I-1)/3)*3
+ GO TO (34,35,36),K
+ 34 M=1
+ M1=3
+ M2=2
+ GO TO 37
+ 35 M=2
+ M1=1
+ M2=3
+ GO TO 37
+ 36 M=3
+ M1=2
+ M2=1
+ 37 XC(M)=XM-XM2-D(1)*XC(M1)-D(2)*XC(M2)
+ XD(M)=XC(M)-XC(M2)-D(3)*XD(M1)-D(4)*XD(M2)
+ XE(M)=XD(M)-XD(M2)-D(5)*XE(M1)-D(6)*XE(M2)
+ 39 X(I)=XE(M)-XE(M2)-D(7)*X(I-1)-D(8)*X(I-2)
!
- if(ig.eq.1) goto 3333
- XM2=X(N)
- XM1=X(N-1)
- XM=X(N-2)
- XC(1)=XM2
- XC(2)=XM1-D(1)*XC(1)
- XC(3)=XM-XM2-D(1)*XC(2)-D(2)*XC(1)
- XD(1)=XC(1)
- XD(2)=XC(2)-D(3)*XD(1)
- XD(3)=XC(3)-XC(1)-D(3)*XD(2)-D(4)*XD(1)
- XE(1)=XD(1)
- XE(2)=XD(2)-D(5)*XE(1)
- XE(3)=XD(3)-XD(1)-D(5)*XE(2)-D(6)*XE(1)
- X(N)=XE(1)
- X(N-1)=XE(2)-D(7)*X(1)
- X(N-2)=XE(3)-XE(1)-D(7)*X(2)-D(8)*X(1)
- DO 49 I=4,N
- XM2=XM1
- XM1=XM
- J=N-I+1
- XM=X(J)
- K=I-((I-1)/3)*3
- GO TO (44,45,46),K
- 44 M=1
- M1=3
- M2=2
- GO TO 47
- 45 M=2
- M1=1
- M2=3
- GO TO 47
- 46 M=3
- M1=2
- M2=1
- 47 XC(M)=XM-XM2-D(1)*XC(M1)-D(2)*XC(M2)
- XD(M)=XC(M)-XC(M2)-D(3)*XD(M1)-D(4)*XD(M2)
- XE(M)=XD(M)-XD(M2)-D(5)*XE(M1)-D(6)*XE(M2)
- 49 X(J)=XE(M)-XE(M2)-D(7)*X(J+1)-D(8)*X(J+2)
+!
+ if(ig==1) goto 3333
+ XM2=X(N)
+ XM1=X(N-1)
+ XM=X(N-2)
+ XC(1)=XM2
+ XC(2)=XM1-D(1)*XC(1)
+ XC(3)=XM-XM2-D(1)*XC(2)-D(2)*XC(1)
+ XD(1)=XC(1)
+ XD(2)=XC(2)-D(3)*XD(1)
+ XD(3)=XC(3)-XC(1)-D(3)*XD(2)-D(4)*XD(1)
+ XE(1)=XD(1)
+ XE(2)=XD(2)-D(5)*XE(1)
+ XE(3)=XD(3)-XD(1)-D(5)*XE(2)-D(6)*XE(1)
+ X(N)=XE(1)
+ X(N-1)=XE(2)-D(7)*X(1)
+ X(N-2)=XE(3)-XE(1)-D(7)*X(2)-D(8)*X(1)
+ DO 49 I=4,N
+ XM2=XM1
+ XM1=XM
+ J=N-I+1
+ XM=X(J)
+ K=I-((I-1)/3)*3
+ GO TO (44,45,46),K
+ 44 M=1
+ M1=3
+ M2=2
+ GO TO 47
+ 45 M=2
+ M1=1
+ M2=3
+ GO TO 47
+ 46 M=3
+ M1=2
+ M2=1
+ 47 XC(M)=XM-XM2-D(1)*XC(M1)-D(2)*XC(M2)
+ XD(M)=XC(M)-XC(M2)-D(3)*XD(M1)-D(4)*XD(M2)
+ XE(M)=XD(M)-XD(M2)-D(5)*XE(M1)-D(6)*XE(M2)
+ 49 X(J)=XE(M)-XE(M2)-D(7)*X(J+1)-D(8)*X(J+2)
3333 continue
- if (ig.eq.1) then
+ if (ig==1) then
gg=sqrt(g) ! if only pass once, modify gain
else
gg=g
endif
- DO 59 I=1,N
- 59 X(I)=X(I)/gg
- RETURN
-END
+ DO 59 I=1,N
+ 59 X(I)=X(I)/gg
+ RETURN
+END
Modified: seismo/2D/SPECFEM2D/trunk/EXAMPLES/noise_uniform/adj_cc.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/EXAMPLES/noise_uniform/adj_cc.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/EXAMPLES/noise_uniform/adj_cc.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -32,7 +32,7 @@
! time variables
integer :: it, nt, nthalf
-double precision :: dt
+double precision :: dt
! data variables
double precision, dimension(:), allocatable :: seismo_1, seismo_2, seismo_3, seismo_4, &
@@ -91,7 +91,7 @@
open(unit=1001,file=trim(file_in),status='old',action='read')
do it = 1, nt
read(1001,*) t(it), seismo_1(it)
-end do
+enddo
close(1001)
@@ -103,30 +103,30 @@
if (differentiate == 1) seismo_2(it) = ( seismo_1(it+1) - seismo_1(it-1) ) / (2*dt)
if (differentiate == 2) seismo_2(it) = ( seismo_1(it+1) - 2 * seismo_1(it) + seismo_1(it-1) ) / dt**2
-end do
+enddo
!!!!!!!!!! FILTER !!!!!!!!!!!!!!!!!!!!
seismo_3 = seismo_2
if (use_filtering) then
-! THIS SECTION CALCULATES THE FILTER AND MUST BE CALLED BEFORE
-! FILTER IS CALLED
+! THIS SECTION CALCULATES THE FILTER AND MUST BE CALLED BEFORE
+! FILTER IS CALLED
DELT = 1.0d3 * dt
F1=freq_low
F2=freq_high
call BNDPAS(F1,F2,DELT,D,G,nt)
-! F1 = LOW FREQUENCY CUTOFF (6 DB DOWN)
-! F2 = HIGH FREQUENCY CUTOFF (6 DB DOWN)
-! DELT = SAMPLE INTERVAL IN MILLISECONDS
-! D = WILL CONTAIN 8 Z DOMAIN COEFICIENTS OF RECURSIVE FILTER
+! F1 = LOW FREQUENCY CUTOFF (6 DB DOWN)
+! F2 = HIGH FREQUENCY CUTOFF (6 DB DOWN)
+! DELT = SAMPLE INTERVAL IN MILLISECONDS
+! D = WILL CONTAIN 8 Z DOMAIN COEFICIENTS OF RECURSIVE FILTER
! G = WILL CONTAIN THE GAIN OF THE FILTER,
call FILTER(seismo_3,nt,D,G,2)
-! X = DATA VECTOR OF LENGTH N CONTAINING DATA TO BE FILTERED
-! D = FILTER COEFFICIENTS CALCULATED BY BNDPAS
-! G = FILTER GAIN
+! X = DATA VECTOR OF LENGTH N CONTAINING DATA TO BE FILTERED
+! D = FILTER COEFFICIENTS CALCULATED BY BNDPAS
+! G = FILTER GAIN
! IG = 1 one pass
! IG = 2 two passes
-end if
+endif
!!!!!!!!!! WINDOW !!!!!!!!!!!!!!!!!!!!
@@ -136,14 +136,14 @@
if (it_begin < 1) it_begin = 1
if (it_end > nt) it_end = nt
-elseif (use_positive_branch) then
+else if (use_positive_branch) then
write(*,*) 'Choosing positive branch'
it_begin = nthalf+1
it_end = nt
if (it_begin < nthalf) it_begin = nthalf
if (it_end > nt) it_end = nt
-elseif (use_negative_branch) then
+else if (use_negative_branch) then
write(*,*) 'Choosing negative branch'
it_begin = 1
it_end = nthalf
@@ -170,14 +170,14 @@
if (beta<alpha/2.) then
w(it) = 0.5*(1.+cos(2.*pi/alpha*(beta-alpha/2.)))
- elseif (beta>alpha/2. .and. beta<1.-alpha/2.) then
+ else if (beta>alpha/2. .and. beta<1.-alpha/2.) then
w(it) = 1.0
else
w(it) = 0.5*(1.+cos(2*pi/w_tukey*(beta-1.+alpha/2.)))
endif
-end do
+enddo
seismo_4 = w * seismo_3
@@ -194,7 +194,7 @@
do it = 1,nt
if (.not. time_reverse) write(1002,'(f16.12,1pe18.8)'), t(it), seismo_adj(it)
if (time_reverse) write(1002,'(f16.12,1pe18.8)'), t(it), seismo_adj(nt+1-it)
-end do
+enddo
close(1002)
write(*,*) 'Finished writing to file.'
@@ -268,162 +268,162 @@
!=====================================================================
-SUBROUTINE BNDPAS(F1,F2,DELT,D,G,N)
-! RECURSIVE BUTTERWORTH BAND PASS FILTER (KANASEWICH, TIME SERIES
-! ANALYSIS IN GEOPHYSICS, UNIVERSITY OF ALBERTA PRESS, 1975; SHANKS,
-! JOHN L, RECURSION FILTERS FOR DIGITAL PROCESSING, GEOPHYSICS, V32,
-! FILTER. THE FILTER WILL HAVE 8 POLES IN THE S PLANE AND IS
-! APPLIED IN FORWARD AND REVERSE DIRECTIONS SO AS TO HAVE ZERO
-! PHASE SHIFT. THE GAIN AT THE TWO FREQUENCIES SPECIFIED AS
-! CUTOFF FREQUENCIES WILL BE -6DB AND THE ROLLOFF WILL BE ABOUT
-! THE FILTER TO PREVENT ALIASING PROBLEMS.
- COMPLEX P(4),S(8),Z1,Z2
- real D(8),XC(3),XD(3),XE(3)
- double precision :: X(N)
- DATA ISW/0/,TWOPI/6.2831853/
-! THIS SECTION CALCULATES THE FILTER AND MUST BE CALLED BEFORE
-! FILTER IS CALLED
-
-! F1 = LOW FREQUENCY CUTOFF (6 DB DOWN)
-! F2 = HIGH FREQUENCY CUTOFF (6 DB DOWN)
-! DELT = SAMPLE INTERVAL IN MILLISECONDS
-! D = WILL CONTAIN 8 Z DOMAIN COEFICIENTS OF RECURSIVE FILTER
-! G = WILL CONTAIN THE GAIN OF THE FILTER,
+SUBROUTINE BNDPAS(F1,F2,DELT,D,G,N)
+! RECURSIVE BUTTERWORTH BAND PASS FILTER (KANASEWICH, TIME SERIES
+! ANALYSIS IN GEOPHYSICS, UNIVERSITY OF ALBERTA PRESS, 1975; SHANKS,
+! JOHN L, RECURSION FILTERS FOR DIGITAL PROCESSING, GEOPHYSICS, V32,
+! FILTER. THE FILTER WILL HAVE 8 POLES IN THE S PLANE AND IS
+! APPLIED IN FORWARD AND REVERSE DIRECTIONS SO AS TO HAVE ZERO
+! PHASE SHIFT. THE GAIN AT THE TWO FREQUENCIES SPECIFIED AS
+! CUTOFF FREQUENCIES WILL BE -6DB AND THE ROLLOFF WILL BE ABOUT
+! THE FILTER TO PREVENT ALIASING PROBLEMS.
+ COMPLEX P(4),S(8),Z1,Z2
+ real D(8),XC(3),XD(3),XE(3)
+ double precision :: X(N)
+ DATA ISW/0/,TWOPI/6.2831853/
+! THIS SECTION CALCULATES THE FILTER AND MUST BE CALLED BEFORE
+! FILTER IS CALLED
- DT=DELT/1000.0
- TDT=2.0/DT
- FDT=4.0/DT
- ISW=1
- P(1)=CMPLX(-.3826834,.9238795)
- P(2)=CMPLX(-.3826834,-.9238795)
- P(3)=CMPLX(-.9238795,.3826834)
- P(4)=CMPLX(-.9238795,-.3826834)
- W1=TWOPI*F1
- W2=TWOPI*F2
- W1=TDT*TAN(W1/TDT)
- W2=TDT*TAN(W2/TDT)
- HWID=(W2-W1)/2.0
- WW=W1*W2
- DO 19 I=1,4
- Z1=P(I)*HWID
- Z2=Z1*Z1-WW
- Z2=CSQRT(Z2)
- S(I)=Z1+Z2
- 19 S(I+4)=Z1-Z2
- G=.5/HWID
- G=G*G
- G=G*G
- DO 29 I=1,7,2
- B=-2.0*REAL(S(I))
- Z1=S(I)*S(I+1)
- C=REAL(Z1)
- A=TDT+B+C/TDT
- G=G*A
- D(I)=(C*DT-FDT)/A
- 29 D(I+1)=(A-2.0*B)/A
- G=G*G
- 5 FORMAT ('-FILTER GAIN IS ', 9E12.6)
- RETURN
+! F1 = LOW FREQUENCY CUTOFF (6 DB DOWN)
+! F2 = HIGH FREQUENCY CUTOFF (6 DB DOWN)
+! DELT = SAMPLE INTERVAL IN MILLISECONDS
+! D = WILL CONTAIN 8 Z DOMAIN COEFICIENTS OF RECURSIVE FILTER
+! G = WILL CONTAIN THE GAIN OF THE FILTER,
- ENTRY FILTER(X,N,D,G,IG)
-
-! X = DATA VECTOR OF LENGTH N CONTAINING DATA TO BE FILTERED
-! D = FILTER COEFFICIENTS CALCULATED BY BNDPAS
-! G = FILTER GAIN
+ DT=DELT/1000.0
+ TDT=2.0/DT
+ FDT=4.0/DT
+ ISW=1
+ P(1)=CMPLX(-.3826834,.9238795)
+ P(2)=CMPLX(-.3826834,-.9238795)
+ P(3)=CMPLX(-.9238795,.3826834)
+ P(4)=CMPLX(-.9238795,-.3826834)
+ W1=TWOPI*F1
+ W2=TWOPI*F2
+ W1=TDT*TAN(W1/TDT)
+ W2=TDT*TAN(W2/TDT)
+ HWID=(W2-W1)/2.0
+ WW=W1*W2
+ DO 19 I=1,4
+ Z1=P(I)*HWID
+ Z2=Z1*Z1-WW
+ Z2=CSQRT(Z2)
+ S(I)=Z1+Z2
+ 19 S(I+4)=Z1-Z2
+ G=.5/HWID
+ G=G*G
+ G=G*G
+ DO 29 I=1,7,2
+ B=-2.0*REAL(S(I))
+ Z1=S(I)*S(I+1)
+ C=REAL(Z1)
+ A=TDT+B+C/TDT
+ G=G*A
+ D(I)=(C*DT-FDT)/A
+ 29 D(I+1)=(A-2.0*B)/A
+ G=G*G
+ 5 FORMAT ('-FILTER GAIN IS ', 9E12.6)
+ RETURN
+
+ ENTRY FILTER(X,N,D,G,IG)
+
+! X = DATA VECTOR OF LENGTH N CONTAINING DATA TO BE FILTERED
+! D = FILTER COEFFICIENTS CALCULATED BY BNDPAS
+! G = FILTER GAIN
! IG = 1 one pass
! ig = 2 two passes
-
- IF (ISW.EQ.1) GO TO 31
- WRITE (6,6)
- 6 FORMAT ('1BNDPAS MUST BE CALLED BEFORE FILTER')
- return
-
-! APPLY FILTER IN FORWARD DIRECTION
-
- 31 XM2=X(1)
- XM1=X(2)
- XM=X(3)
- XC(1)=XM2
- XC(2)=XM1-D(1)*XC(1)
- XC(3)=XM-XM2-D(1)*XC(2)-D(2)*XC(1)
- XD(1)=XC(1)
- XD(2)=XC(2)-D(3)*XD(1)
- XD(3)=XC(3)-XC(1)-D(3)*XD(2)-D(4)*XD(1)
- XE(1)=XD(1)
- XE(2)=XD(2)-D(5)*XE(1)
- XE(3)=XD(3)-XD(1)-D(5)*XE(2)-D(6)*XE(1)
- X(1)=XE(1)
- X(2)=XE(2)-D(7)*X(1)
- X(3)=XE(3)-XE(1)-D(7)*X(2)-D(8)*X(1)
- DO 39 I=4,N
- XM2=XM1
- XM1=XM
- XM=X(I)
- K=I-((I-1)/3)*3
- GO TO (34,35,36),K
- 34 M=1
- M1=3
- M2=2
- GO TO 37
- 35 M=2
- M1=1
- M2=3
- GO TO 37
- 36 M=3
- M1=2
- M2=1
- 37 XC(M)=XM-XM2-D(1)*XC(M1)-D(2)*XC(M2)
- XD(M)=XC(M)-XC(M2)-D(3)*XD(M1)-D(4)*XD(M2)
- XE(M)=XD(M)-XD(M2)-D(5)*XE(M1)-D(6)*XE(M2)
- 39 X(I)=XE(M)-XE(M2)-D(7)*X(I-1)-D(8)*X(I-2)
-!
+
+ IF (ISW==1) GO TO 31
+ WRITE (6,6)
+ 6 FORMAT ('1BNDPAS MUST BE CALLED BEFORE FILTER')
+ return
+
+! APPLY FILTER IN FORWARD DIRECTION
+
+ 31 XM2=X(1)
+ XM1=X(2)
+ XM=X(3)
+ XC(1)=XM2
+ XC(2)=XM1-D(1)*XC(1)
+ XC(3)=XM-XM2-D(1)*XC(2)-D(2)*XC(1)
+ XD(1)=XC(1)
+ XD(2)=XC(2)-D(3)*XD(1)
+ XD(3)=XC(3)-XC(1)-D(3)*XD(2)-D(4)*XD(1)
+ XE(1)=XD(1)
+ XE(2)=XD(2)-D(5)*XE(1)
+ XE(3)=XD(3)-XD(1)-D(5)*XE(2)-D(6)*XE(1)
+ X(1)=XE(1)
+ X(2)=XE(2)-D(7)*X(1)
+ X(3)=XE(3)-XE(1)-D(7)*X(2)-D(8)*X(1)
+ DO 39 I=4,N
+ XM2=XM1
+ XM1=XM
+ XM=X(I)
+ K=I-((I-1)/3)*3
+ GO TO (34,35,36),K
+ 34 M=1
+ M1=3
+ M2=2
+ GO TO 37
+ 35 M=2
+ M1=1
+ M2=3
+ GO TO 37
+ 36 M=3
+ M1=2
+ M2=1
+ 37 XC(M)=XM-XM2-D(1)*XC(M1)-D(2)*XC(M2)
+ XD(M)=XC(M)-XC(M2)-D(3)*XD(M1)-D(4)*XD(M2)
+ XE(M)=XD(M)-XD(M2)-D(5)*XE(M1)-D(6)*XE(M2)
+ 39 X(I)=XE(M)-XE(M2)-D(7)*X(I-1)-D(8)*X(I-2)
!
- if(ig.eq.1) goto 3333
- XM2=X(N)
- XM1=X(N-1)
- XM=X(N-2)
- XC(1)=XM2
- XC(2)=XM1-D(1)*XC(1)
- XC(3)=XM-XM2-D(1)*XC(2)-D(2)*XC(1)
- XD(1)=XC(1)
- XD(2)=XC(2)-D(3)*XD(1)
- XD(3)=XC(3)-XC(1)-D(3)*XD(2)-D(4)*XD(1)
- XE(1)=XD(1)
- XE(2)=XD(2)-D(5)*XE(1)
- XE(3)=XD(3)-XD(1)-D(5)*XE(2)-D(6)*XE(1)
- X(N)=XE(1)
- X(N-1)=XE(2)-D(7)*X(1)
- X(N-2)=XE(3)-XE(1)-D(7)*X(2)-D(8)*X(1)
- DO 49 I=4,N
- XM2=XM1
- XM1=XM
- J=N-I+1
- XM=X(J)
- K=I-((I-1)/3)*3
- GO TO (44,45,46),K
- 44 M=1
- M1=3
- M2=2
- GO TO 47
- 45 M=2
- M1=1
- M2=3
- GO TO 47
- 46 M=3
- M1=2
- M2=1
- 47 XC(M)=XM-XM2-D(1)*XC(M1)-D(2)*XC(M2)
- XD(M)=XC(M)-XC(M2)-D(3)*XD(M1)-D(4)*XD(M2)
- XE(M)=XD(M)-XD(M2)-D(5)*XE(M1)-D(6)*XE(M2)
- 49 X(J)=XE(M)-XE(M2)-D(7)*X(J+1)-D(8)*X(J+2)
+!
+ if(ig==1) goto 3333
+ XM2=X(N)
+ XM1=X(N-1)
+ XM=X(N-2)
+ XC(1)=XM2
+ XC(2)=XM1-D(1)*XC(1)
+ XC(3)=XM-XM2-D(1)*XC(2)-D(2)*XC(1)
+ XD(1)=XC(1)
+ XD(2)=XC(2)-D(3)*XD(1)
+ XD(3)=XC(3)-XC(1)-D(3)*XD(2)-D(4)*XD(1)
+ XE(1)=XD(1)
+ XE(2)=XD(2)-D(5)*XE(1)
+ XE(3)=XD(3)-XD(1)-D(5)*XE(2)-D(6)*XE(1)
+ X(N)=XE(1)
+ X(N-1)=XE(2)-D(7)*X(1)
+ X(N-2)=XE(3)-XE(1)-D(7)*X(2)-D(8)*X(1)
+ DO 49 I=4,N
+ XM2=XM1
+ XM1=XM
+ J=N-I+1
+ XM=X(J)
+ K=I-((I-1)/3)*3
+ GO TO (44,45,46),K
+ 44 M=1
+ M1=3
+ M2=2
+ GO TO 47
+ 45 M=2
+ M1=1
+ M2=3
+ GO TO 47
+ 46 M=3
+ M1=2
+ M2=1
+ 47 XC(M)=XM-XM2-D(1)*XC(M1)-D(2)*XC(M2)
+ XD(M)=XC(M)-XC(M2)-D(3)*XD(M1)-D(4)*XD(M2)
+ XE(M)=XD(M)-XD(M2)-D(5)*XE(M1)-D(6)*XE(M2)
+ 49 X(J)=XE(M)-XE(M2)-D(7)*X(J+1)-D(8)*X(J+2)
3333 continue
- if (ig.eq.1) then
+ if (ig==1) then
gg=sqrt(g) ! if only pass once, modify gain
else
gg=g
endif
- DO 59 I=1,N
- 59 X(I)=X(I)/gg
- RETURN
-END
+ DO 59 I=1,N
+ 59 X(I)=X(I)/gg
+ RETURN
+END
Modified: seismo/2D/SPECFEM2D/trunk/UTILS/decimate_mesh.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/UTILS/decimate_mesh.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/UTILS/decimate_mesh.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -51,14 +51,14 @@
allocate(elmnts(4,nspec))
do ispec = 1, nspec
read(98,*) elmnts(1,ispec), elmnts(2,ispec), elmnts(3,ispec), elmnts(4,ispec)
- end do
+ enddo
close(98)
open(unit=98, file='./mat', status='old', form='formatted')
allocate(mat(nspec))
do ispec = 1, nspec
read(98,*) mat(ispec)
- end do
+ enddo
close(98)
open(unit=98, file='./nodes_coords', status='old', form='formatted')
@@ -66,7 +66,7 @@
allocate(nodes_coords(2,nnodes))
do inode = 1, nnodes
read(98,*) nodes_coords(1,inode), nodes_coords(2,inode)
- end do
+ enddo
close(98)
! set up local geometric tolerances
@@ -106,7 +106,7 @@
write(98,*) nodes_coords(1,elmnts(1,ispec)), nodes_coords(2,elmnts(1,ispec))
write(98,*) ' '
write(98,*) ' '
- end do
+ enddo
close(98)
@@ -153,9 +153,9 @@
temporary_nodes(2,ix,iz) = temporary_nodes(2,ix,1) + &
(( temporary_nodes(2,ix,NSUB+1) - temporary_nodes(2,ix,1) ) / real(NSUB)) * (iz-1)
- end do
+ enddo
- end do
+ enddo
temporary_nodes_lookup(:,:) = 0
@@ -175,16 +175,16 @@
temporary_nodes_lookup(ix,iz) = elmnts_new(inode,ispec_neighbours_new)
- end if
+ endif
- end do
+ enddo
- end do
- end do
- end do
- end if
- end do
+ enddo
+ enddo
+ enddo
+ endif
+ enddo
do ix = 1, NSUB+1
do iz = 1, NSUB+1
@@ -193,9 +193,9 @@
temporary_nodes_lookup(ix,iz) = num_nodes_new
nodes_coords_new(1,num_nodes_new) = temporary_nodes(1,ix,iz)
nodes_coords_new(2,num_nodes_new) = temporary_nodes(2,ix,iz)
- end if
- end do
- end do
+ endif
+ enddo
+ enddo
do i = 1, NSUB
do j = 1, NSUB
@@ -206,24 +206,24 @@
mat_new((ispec-1)*NSUB*NSUB+(i-1)*NSUB+j) = mat(ispec)
- end do
- end do
+ enddo
+ enddo
- end do
+ enddo
open(unit=99, file='./mesh_new', status='unknown', form='formatted')
write(99,*) nspec*NSUB*NSUB
do ispec = 1, nspec*NSUB*NSUB
write(99,*) elmnts_new(1,ispec), elmnts_new(2,ispec), elmnts_new(3,ispec), elmnts_new(4,ispec)
- end do
+ enddo
close(99)
open(unit=99, file='./mat_new', status='unknown', form='formatted')
do ispec = 1, nspec*NSUB*NSUB
write(99,*) mat_new(ispec)
- end do
+ enddo
close(99)
@@ -231,7 +231,7 @@
write(99,*) num_nodes_new
do inode = 1, num_nodes_new
write(99,*) nodes_coords_new(1,inode), nodes_coords_new(2,inode)
- end do
+ enddo
close(99)
open(unit=99, file='./check_new', status='unknown', form='formatted')
@@ -243,7 +243,7 @@
write(99,*) nodes_coords_new(1,elmnts_new(1,ispec)), nodes_coords_new(2,elmnts_new(1,ispec))
write(99,*) ' '
write(99,*) ' '
- end do
+ enddo
close(99)
@@ -298,7 +298,7 @@
nodes_elmnts(elmnts(i)*nsize+nnodes_elmnts(elmnts(i))) = i/esize
nnodes_elmnts(elmnts(i)) = nnodes_elmnts(elmnts(i)) + 1
- end do
+ enddo
print *, 'nnodes_elmnts'
@@ -315,9 +315,9 @@
do m = 0, nnodes_elmnts(num_node)-1
if ( nodes_elmnts(m+num_node*nsize) == elem_target ) then
connectivity = connectivity + 1
- end if
- end do
- end do
+ endif
+ enddo
+ enddo
if ( connectivity >= ncommonnodes) then
@@ -328,19 +328,19 @@
if ( adjncy(nodes_elmnts(k+j*nsize)*max_neighbour+m) == nodes_elmnts(l+j*nsize) ) then
is_neighbour = .true.
- end if
- end if
- end do
+ endif
+ endif
+ enddo
if ( .not.is_neighbour ) then
adjncy(nodes_elmnts(k+j*nsize)*max_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
adjncy(nodes_elmnts(l+j*nsize)*max_neighbour+xadj(nodes_elmnts(l+j*nsize))) = nodes_elmnts(k+j*nsize)
xadj(nodes_elmnts(l+j*nsize)) = xadj(nodes_elmnts(l+j*nsize)) + 1
- end if
- end if
- end do
- end do
- end do
+ endif
+ endif
+ enddo
+ enddo
+ enddo
! making adjacency arrays compact (to be used for partitioning)
do i = 0, nelmnts-1
@@ -349,8 +349,8 @@
do j = 0, k-1
adjncy(nb_edges) = adjncy(i*max_neighbour+j)
nb_edges = nb_edges + 1
- end do
- end do
+ enddo
+ enddo
xadj(nelmnts) = nb_edges
Modified: seismo/2D/SPECFEM2D/trunk/src/meshfem2D/meshfem2D.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/meshfem2D/meshfem2D.F90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/meshfem2D/meshfem2D.F90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -375,9 +375,9 @@
integer, dimension(:), allocatable :: num_material
! to store the position of pml element in array region_pml_external_mesh
- ! this is only useful when using pml together with external mesh
- integer, dimension(:), allocatable :: region_pml_external_mesh
- integer :: nspec_cpml
+ ! this is only useful when using pml together with external mesh
+ integer, dimension(:), allocatable :: region_pml_external_mesh
+ integer :: nspec_cpml
! interface data
integer :: max_npoints_interface,number_of_interfaces,npoints_interface_bottom, &
@@ -446,8 +446,8 @@
allocate(num_material(nelmnts))
num_material(:) = 0
- allocate(region_pml_external_mesh(nelmnts))
- region_pml_external_mesh(:) = 0
+ allocate(region_pml_external_mesh(nelmnts))
+ region_pml_external_mesh(:) = 0
! assigns materials to mesh elements
if ( read_external_mesh ) then
Modified: seismo/2D/SPECFEM2D/trunk/src/meshfem2D/part_unstruct.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/meshfem2D/part_unstruct.F90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/meshfem2D/part_unstruct.F90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -1628,13 +1628,13 @@
! we use the default strategy for partitioning
! thus no need to define an explicit strategy
call scotchfstratinit (SCOTCHSTRAT(1), IERR)
- IF (IERR .NE. 0) THEN
+ IF (IERR /= 0) THEN
PRINT *, 'ERROR : MAIN : Cannot initialize strat'
STOP
ENDIF
CALL SCOTCHFGRAPHINIT (SCOTCHGRAPH (1), IERR)
- IF (IERR .NE. 0) THEN
+ IF (IERR /= 0) THEN
PRINT *, 'ERROR : MAIN : Cannot initialize graph'
STOP
ENDIF
@@ -1650,31 +1650,31 @@
xadj_g(0), xadj_g(0), &
nb_edges, &
adjncy_g(0), adjwgt (0), IERR)
- IF (IERR .NE. 0) THEN
+ IF (IERR /= 0) THEN
PRINT *, 'ERROR : MAIN : Cannot build graph'
STOP
ENDIF
CALL SCOTCHFGRAPHCHECK (SCOTCHGRAPH (1), IERR)
- IF (IERR .NE. 0) THEN
+ IF (IERR /= 0) THEN
PRINT *, 'ERROR : MAIN : Invalid check'
STOP
ENDIF
call scotchfgraphpart (SCOTCHGRAPH (1), nparts, SCOTCHSTRAT(1), part(0), IERR)
- IF (IERR .NE. 0) THEN
+ IF (IERR /= 0) THEN
PRINT *, 'ERROR : MAIN : Cannot part graph'
STOP
ENDIF
CALL SCOTCHFGRAPHEXIT (SCOTCHGRAPH (1), IERR)
- IF (IERR .NE. 0) THEN
+ IF (IERR /= 0) THEN
PRINT *, 'ERROR : MAIN : Cannot destroy graph'
STOP
ENDIF
call scotchfstratexit (SCOTCHSTRAT(1), IERR)
- IF (IERR .NE. 0) THEN
+ IF (IERR /= 0) THEN
PRINT *, 'ERROR : MAIN : Cannot destroy strat'
STOP
ENDIF
Modified: seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_materials.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_materials.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_materials.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -128,7 +128,7 @@
else
phi(i) = 1.d0 ! acoustic
endif
- elseif (icodemat(i) == ANISOTROPIC_MATERIAL) then
+ else if (icodemat(i) == ANISOTROPIC_MATERIAL) then
! anisotropic materials
@@ -190,7 +190,7 @@
else
print *,'Material is solid'
endif
- elseif(icodemat(i) == POROELASTIC_MATERIAL) then
+ else if(icodemat(i) == POROELASTIC_MATERIAL) then
print *,'Material #',i,' isotropic'
print *,'rho_s, kappa_s= ',rho_s(i),kappa_s(i)
print *,'rho_f, kappa_f, eta_f= ',rho_f(i),kappa_f(i),eta_f(i)
Modified: seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_parameter_file.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_parameter_file.F90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_parameter_file.F90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -102,8 +102,8 @@
integer :: NSTEP_BETWEEN_OUTPUT_INFO,NSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP_BETWEEN_OUTPUT_IMAGES,NSTEP_BETWEEN_OUTPUT_WAVE_DUMPS, &
subsamp_seismos,imagetype_JPEG,imagetype_wavefield_dumps,NELEM_PML_THICKNESS
- logical :: output_postscript_snapshot,output_color_image,PML_BOUNDARY_CONDITIONS,ROTATE_PML_ACTIVATE
- double precision :: ROTATE_PML_ANGLE
+ logical :: output_postscript_snapshot,output_color_image,PML_BOUNDARY_CONDITIONS,ROTATE_PML_ACTIVATE
+ double precision :: ROTATE_PML_ANGLE
integer :: imagetype_postscript
double precision :: cutsnaps
logical :: meshvect,modelvect,boundvect,interpol
@@ -466,10 +466,10 @@
call read_value_integer_p(NELEM_PML_THICKNESS, 'solver.NELEM_PML_THICKNESS')
if(err_occurred() /= 0) stop 'error reading parameter 33zb in Par_file'
- call read_value_logical_p(ROTATE_PML_ACTIVATE, 'solver.ROTATE_PML_ACTIVATE')
+ call read_value_logical_p(ROTATE_PML_ACTIVATE, 'solver.ROTATE_PML_ACTIVATE')
if(err_occurred() /= 0) stop 'error reading parameter 51a in Par_file'
- call read_value_double_precision_p(ROTATE_PML_ANGLE, 'solver.ROTATE_PML_ANGLE')
+ call read_value_double_precision_p(ROTATE_PML_ANGLE, 'solver.ROTATE_PML_ANGLE')
if(err_occurred() /= 0) stop 'error reading parameter 51a in Par_file'
! boolean defining whether to use any absorbing boundaries
Modified: seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_regions.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_regions.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/meshfem2D/read_regions.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -111,7 +111,7 @@
if(poisson_ratio <= -1.00001d0 .or. poisson_ratio >= 0.50001d0) stop 'incorrect value of Poisson''s ratio'
print *,'QKappa = ',QKappa(imaterial_number)
print *,'Qmu = ',Qmu(imaterial_number)
- elseif(icodemat(imaterial_number) == POROELASTIC_MATERIAL) then
+ else if(icodemat(imaterial_number) == POROELASTIC_MATERIAL) then
! poroelastic material
print *,'Material # ',imaterial_number,' isotropic'
Modified: seismo/2D/SPECFEM2D/trunk/src/meshfem2D/save_databases.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/meshfem2D/save_databases.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/meshfem2D/save_databases.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -97,7 +97,7 @@
call write_glob2loc_nodes_database(15, iproc, npgeo, 1)
-! DK DK add support for using pml in mpi mode with external mesh
+! DK DK add support for using pml in mpi mode with external mesh
! call write_partition_database(15, iproc, nspec, num_material, ngnod, 1)
call write_partition_database(15, iproc, nspec, num_material, region_pml_external_mesh, ngnod, 1)
@@ -119,11 +119,11 @@
write(15,*) 'PML_BOUNDARY_CONDITIONS'
write(15,*) PML_BOUNDARY_CONDITIONS
- write(15,*) 'ROTATE_PML_ACTIVATE'
- write(15,*) ROTATE_PML_ACTIVATE
+ write(15,*) 'ROTATE_PML_ACTIVATE'
+ write(15,*) ROTATE_PML_ACTIVATE
- write(15,*) 'ROTATE_PML_ANGLE'
- write(15,*) ROTATE_PML_ANGLE
+ write(15,*) 'ROTATE_PML_ANGLE'
+ write(15,*) ROTATE_PML_ANGLE
write(15,*) 'read_external_mesh'
write(15,*) read_external_mesh
@@ -276,7 +276,7 @@
do i=1,nb_materials
if (icodemat(i) == ISOTROPIC_MATERIAL) then
write(15,*) i,icodemat(i),rho_s(i),cp(i),cs(i),0,0,QKappa(i),Qmu(i),0,0,0,0,0,0
- elseif(icodemat(i) == POROELASTIC_MATERIAL) then
+ else if(icodemat(i) == POROELASTIC_MATERIAL) then
write(15,*) i,icodemat(i),rho_s(i),rho_f(i),phi(i),tortuosity(i), &
permxx(i),permxz(i),permzz(i),kappa_s(i),&
kappa_f(i),kappa_fr(i),eta_f(i),mu_fr(i),Qmu(i)
@@ -289,7 +289,7 @@
write(15,*) 'Arrays kmato and knods for each bloc:'
-! DK DK add support for using pml in mpi mode with external mesh
+! DK DK add support for using pml in mpi mode with external mesh
! call write_partition_database(15, iproc, nspec, num_material, ngnod, 2)
call write_partition_database(15, iproc, nspec, num_material, region_pml_external_mesh, ngnod, 2)
Modified: seismo/2D/SPECFEM2D/trunk/src/shared/read_value_parameters.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/shared/read_value_parameters.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/shared/read_value_parameters.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -232,7 +232,7 @@
common /param_err_common/ ierr
call param_read(string_read, len(string_read), name, len(name), ierr)
- if (ierr .ne. 0) return
+ if (ierr /= 0) return
read(string_read,*) value_to_read
end subroutine read_value_integer_p
@@ -250,7 +250,7 @@
common /param_err_common/ ierr
call param_read(string_read, len(string_read), name, len(name), ierr)
- if (ierr .ne. 0) return
+ if (ierr /= 0) return
read(string_read,*) value_to_read
end subroutine read_value_double_precision_p
@@ -268,7 +268,7 @@
common /param_err_common/ ierr
call param_read(string_read, len(string_read), name, len(name), ierr)
- if (ierr .ne. 0) return
+ if (ierr /= 0) return
read(string_read,*) value_to_read
end subroutine read_value_logical_p
@@ -286,7 +286,7 @@
common /param_err_common/ ierr
call param_read(string_read, len(string_read), name, len(name), ierr)
- if (ierr .ne. 0) return
+ if (ierr /= 0) return
value_to_read = string_read
end subroutine read_value_string_p
@@ -304,7 +304,7 @@
common /param_err_common/ ierr
call param_read_nextparam(string_read, len(string_read), name, len(name), ierr)
- if (ierr .ne. 0) return
+ if (ierr /= 0) return
read(string_read,*) value_to_read
end subroutine read_value_integer_next_p
@@ -322,7 +322,7 @@
common /param_err_common/ ierr
call param_read_nextparam(string_read, len(string_read), name, len(name), ierr)
- if (ierr .ne. 0) return
+ if (ierr /= 0) return
read(string_read,*) value_to_read
end subroutine read_value_double_prec_next_p
@@ -340,7 +340,7 @@
common /param_err_common/ ierr
call param_read_nextparam(string_read, len(string_read), name, len(name), ierr)
- if (ierr .ne. 0) return
+ if (ierr /= 0) return
read(string_read,*) value_to_read
end subroutine read_value_logical_next_p
@@ -364,12 +364,12 @@
common /param_err_common/ ierr
call param_read_nextline(string_read, len(string_read), ierr)
- if (ierr .ne. 0) stop 'error reading material parameter'
+ if (ierr /= 0) stop 'error reading material parameter'
print*,trim(string_read)
read(string_read,*,iostat=ierr) i,icodematread,val0read,val1read,val2read,val3read,val4read,val5read,&
val6read,val7read,val8read,val9read,val10read,val11read,val12read
- if( ierr .ne. 0) stop 'error reading material parameters line'
+ if( ierr /= 0) stop 'error reading material parameters line'
end subroutine read_material_parameters_p
@@ -386,12 +386,12 @@
common /param_err_common/ ierr
call param_read_nextline(string_read, len(string_read), ierr)
- if (ierr .ne. 0) stop 'error reading region coordinates'
+ if (ierr /= 0) stop 'error reading region coordinates'
!print*,string_read
read(string_read,*,iostat=ierr) value_to_read_1,value_to_read_2,value_to_read_3,value_to_read_4,value_to_read_5
- if( ierr .ne. 0) stop 'error reading region coordinates line'
+ if( ierr /= 0) stop 'error reading region coordinates line'
end subroutine read_region_coordinates_p
@@ -415,7 +415,7 @@
filename = 'DATA/Par_file'
call param_open(filename, len_trim(filename), ierr)
- if( ierr .ne. 0 ) stop 'error opening DATA/Par_file file'
+ if( ierr /= 0 ) stop 'error opening DATA/Par_file file'
end subroutine open_parameter_file
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/assemble_MPI.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/assemble_MPI.F90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/assemble_MPI.F90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -112,13 +112,13 @@
ipoin = ipoin + 1
buffer_send_faces_scalar(ipoin,num_interface) = &
array_val1(ibool_interfaces_acoustic(i,num_interface))
- end do
+ enddo
do i = 1, nibool_interfaces_elastic(num_interface)
ipoin = ipoin + 1
buffer_send_faces_scalar(ipoin,num_interface) = &
array_val2(ibool_interfaces_elastic(i,num_interface))
- end do
+ enddo
do i = 1, nibool_interfaces_elastic(num_interface)
ipoin = ipoin + 1
@@ -126,18 +126,18 @@
! in order to handle the C deltat / 2 contribution of the Stacey conditions to the mass matrix
buffer_send_faces_scalar(ipoin,num_interface) = &
array_val5(ibool_interfaces_elastic(i,num_interface))
- end do
+ enddo
do i = 1, nibool_interfaces_poroelastic(num_interface)
ipoin = ipoin + 1
buffer_send_faces_scalar(ipoin,num_interface) = &
array_val3(ibool_interfaces_poroelastic(i,num_interface))
- end do
+ enddo
do i = 1, nibool_interfaces_poroelastic(num_interface)
ipoin = ipoin + 1
buffer_send_faces_scalar(ipoin,num_interface) = &
array_val4(ibool_interfaces_poroelastic(i,num_interface))
- end do
+ enddo
! non-blocking send
call MPI_ISEND( buffer_send_faces_scalar(1,num_interface), &
@@ -149,7 +149,7 @@
my_neighbours(num_interface), 11, &
MPI_COMM_WORLD, msg_requests(num_interface), ier)
- end do
+ enddo
do num_interface = 1, ninterface
@@ -169,14 +169,14 @@
array_val1(ibool_interfaces_acoustic(i,num_interface)) = &
array_val1(ibool_interfaces_acoustic(i,num_interface)) &
+ buffer_recv_faces_scalar(ipoin,num_interface)
- end do
+ enddo
do i = 1, nibool_interfaces_elastic(num_interface)
ipoin = ipoin + 1
array_val2(ibool_interfaces_elastic(i,num_interface)) = &
array_val2(ibool_interfaces_elastic(i,num_interface)) &
+ buffer_recv_faces_scalar(ipoin,num_interface)
- end do
+ enddo
do i = 1, nibool_interfaces_elastic(num_interface)
ipoin = ipoin + 1
@@ -185,22 +185,22 @@
array_val5(ibool_interfaces_elastic(i,num_interface)) = &
array_val5(ibool_interfaces_elastic(i,num_interface)) &
+ buffer_recv_faces_scalar(ipoin,num_interface)
- end do
+ enddo
do i = 1, nibool_interfaces_poroelastic(num_interface)
ipoin = ipoin + 1
array_val3(ibool_interfaces_poroelastic(i,num_interface)) = &
array_val3(ibool_interfaces_poroelastic(i,num_interface)) &
+ buffer_recv_faces_scalar(ipoin,num_interface)
- end do
+ enddo
do i = 1, nibool_interfaces_poroelastic(num_interface)
ipoin = ipoin + 1
array_val4(ibool_interfaces_poroelastic(i,num_interface)) = &
array_val4(ibool_interfaces_poroelastic(i,num_interface)) &
+ buffer_recv_faces_scalar(ipoin,num_interface)
- end do
+ enddo
- end do
+ enddo
! synchronizes MPI processes
call MPI_BARRIER(mpi_comm_world,ier)
@@ -272,9 +272,9 @@
! copies array values to buffer
buffer_send_faces_vector_ac(ipoin,iinterface) = array_val1(iglob)
- end do
+ enddo
- end do
+ enddo
do iinterface = 1, ninterface_acoustic
@@ -289,7 +289,7 @@
if ( ier /= MPI_SUCCESS ) then
call exit_mpi('MPI_ISEND unsuccessful in assemble_MPI_vector_start')
- end if
+ endif
! starts a non-blocking receive
call MPI_IRECV ( buffer_recv_faces_vector_ac(1,iinterface), &
@@ -299,9 +299,9 @@
if ( ier /= MPI_SUCCESS ) then
call exit_mpi('MPI_IRECV unsuccessful in assemble_MPI_vector')
- end if
+ endif
- end do
+ enddo
! waits for MPI requests to complete (recv)
@@ -322,9 +322,9 @@
iglob = ibool_interfaces_acoustic(ipoin,num_interface)
! adds buffer contribution
array_val1(iglob) = array_val1(iglob) + buffer_recv_faces_vector_ac(ipoin,iinterface)
- end do
+ enddo
- end do
+ enddo
! waits for MPI requests to complete (send)
@@ -393,9 +393,9 @@
buffer_send_faces_vector_el(ipoin+1:ipoin+3,iinterface) = &
array_val2(:,ibool_interfaces_elastic(i,num_interface))
ipoin = ipoin + 3
- end do
+ enddo
- end do
+ enddo
do iinterface = 1, ninterface_elastic
@@ -408,7 +408,7 @@
if ( ier /= MPI_SUCCESS ) then
call exit_mpi('MPI_ISEND unsuccessful in assemble_MPI_vector_el')
- end if
+ endif
call MPI_IRECV ( buffer_recv_faces_vector_el(1,iinterface), &
3*nibool_interfaces_elastic(num_interface), CUSTOM_MPI_TYPE, &
@@ -417,9 +417,9 @@
if ( ier /= MPI_SUCCESS ) then
call exit_mpi('MPI_IRECV unsuccessful in assemble_MPI_vector_el')
- end if
+ endif
- end do
+ enddo
do iinterface = 1, ninterface_elastic*2
@@ -437,9 +437,9 @@
array_val2(:,ibool_interfaces_elastic(i,num_interface)) &
+ buffer_recv_faces_vector_el(ipoin+1:ipoin+3,iinterface)
ipoin = ipoin + 3
- end do
+ enddo
- end do
+ enddo
end subroutine assemble_MPI_vector_el
@@ -500,16 +500,16 @@
buffer_send_faces_vector_pos(ipoin+1:ipoin+2,iinterface) = &
array_val3(:,ibool_interfaces_poroelastic(i,num_interface))
ipoin = ipoin + 2
- end do
+ enddo
ipoin = 0
do i = 1, nibool_interfaces_poroelastic(num_interface)
buffer_send_faces_vector_pow(ipoin+1:ipoin+2,iinterface) = &
array_val4(:,ibool_interfaces_poroelastic(i,num_interface))
ipoin = ipoin + 2
- end do
+ enddo
- end do
+ enddo
do iinterface = 1, ninterface_poroelastic
@@ -522,7 +522,7 @@
if ( ier /= MPI_SUCCESS ) then
call exit_mpi('MPI_ISEND unsuccessful in assemble_MPI_vector_pos')
- end if
+ endif
call MPI_IRECV ( buffer_recv_faces_vector_pos(1,iinterface), &
NDIM*nibool_interfaces_poroelastic(num_interface), CUSTOM_MPI_TYPE, &
@@ -531,7 +531,7 @@
if ( ier /= MPI_SUCCESS ) then
call exit_mpi('MPI_IRECV unsuccessful in assemble_MPI_vector_pos')
- end if
+ endif
call MPI_ISEND( buffer_send_faces_vector_pow(1,iinterface), &
NDIM*nibool_interfaces_poroelastic(num_interface), CUSTOM_MPI_TYPE, &
@@ -540,7 +540,7 @@
if ( ier /= MPI_SUCCESS ) then
call exit_mpi('MPI_ISEND unsuccessful in assemble_MPI_vector_pow')
- end if
+ endif
call MPI_IRECV ( buffer_recv_faces_vector_pow(1,iinterface), &
NDIM*nibool_interfaces_poroelastic(num_interface), CUSTOM_MPI_TYPE, &
@@ -549,9 +549,9 @@
if ( ier /= MPI_SUCCESS ) then
call exit_mpi('MPI_IRECV unsuccessful in assemble_MPI_vector_pow')
- end if
+ endif
- end do
+ enddo
do iinterface = 1, ninterface_poroelastic*4
@@ -569,7 +569,7 @@
array_val3(:,ibool_interfaces_poroelastic(i,num_interface)) + &
buffer_recv_faces_vector_pos(ipoin+1:ipoin+2,iinterface)
ipoin = ipoin + 2
- end do
+ enddo
ipoin = 0
do i = 1, nibool_interfaces_poroelastic(num_interface)
@@ -577,9 +577,9 @@
array_val4(:,ibool_interfaces_poroelastic(i,num_interface)) + &
buffer_recv_faces_vector_pow(ipoin+1:ipoin+2,iinterface)
ipoin = ipoin + 2
- end do
+ enddo
- end do
+ enddo
end subroutine assemble_MPI_vector_po
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/calendar.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/calendar.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/calendar.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -476,7 +476,7 @@
if (abs(ioptn) <= 3) then
if (iyear > 0) then
jyear = iyear
- elseif (iyear == 0) then
+ else if (iyear == 0) then
write(*,*) 'For calndr(), you specified the nonexistent year 0'
stop
else
@@ -559,7 +559,7 @@
! OPTIONS -2 and +2:
! Given the day number of the year (idayct) and the year (iyear),
! compute the day of the month (iday) and the month (month).
- elseif (abs(ioptn) == 2) then
+ else if (abs(ioptn) == 2) then
!
if (idayct < 60+leap) then
month = (idayct-1)/31
@@ -578,7 +578,7 @@
! OPTIONS -3 and +3:
! Given a calendar date (iday,month,iyear), compute the Julian Day
! number (idayct) that starts at noon.
- elseif (abs(ioptn) == 3) then
+ else if (abs(ioptn) == 3) then
!
! Shift to a system where the year starts on 1 March, so January
! and February belong to the preceding year.
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/checkgrid.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/checkgrid.F90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/checkgrid.F90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -468,7 +468,7 @@
write(IOUT,*)
write(IOUT,*) '*** Max stability for P wave velocity = ',courant_stability_number_max
write(IOUT,*)
- end if
+ endif
create_wavelength_histogram = .false.
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_curl_one_element.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_curl_one_element.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_curl_one_element.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -118,7 +118,7 @@
enddo
enddo
- elseif(poroelastic(ispec)) then
+ else if(poroelastic(ispec)) then
do j = 1,NGLLZ
do i = 1,NGLLX
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_energy.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_energy.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_energy.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -213,7 +213,7 @@
!---
!--- poroelastic spectral element
!---
- elseif(poroelastic(ispec)) then
+ else if(poroelastic(ispec)) then
! get unrelaxed elastic parameters of current spectral element
!for now replaced by solid, fluid, and frame parameters of current spectral element
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_forces_acoustic.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_forces_acoustic.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_forces_acoustic.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -256,7 +256,7 @@
else
coef1 = deltat / 2.0_CUSTOM_REAL
coef2 = deltat / 2.0_CUSTOM_REAL
- end if
+ endif
rmemory_acoustic_dux_dx(i,j,ispec_PML) = coef0*rmemory_acoustic_dux_dx(i,j,ispec_PML) &
+ PML_dux_dxl_new(i,j,ispec_PML) * coef1 + PML_dux_dxl(i,j,ispec_PML) * coef2
endif
@@ -285,7 +285,7 @@
else
coef1 = deltat / 2.0_CUSTOM_REAL
coef2 = deltat / 2.0_CUSTOM_REAL
- end if
+ endif
rmemory_acoustic_dux_dz(i,j,ispec_PML) = coef0 * rmemory_acoustic_dux_dz(i,j,ispec_PML) &
+ PML_dux_dzl_new(i,j,ispec_PML) *coef1 + PML_dux_dzl(i,j,ispec_PML) * coef2
endif
@@ -300,7 +300,7 @@
dux_dzl = PML_dux_dzl(i,j,ispec_PML) + A5 * rmemory_acoustic_dux_dz(i,j,ispec_PML)
- elseif (region_CPML(ispec) == CPML_TOP_LEFT .or. region_CPML(ispec) == CPML_TOP_RIGHT .or. &
+ else if (region_CPML(ispec) == CPML_TOP_LEFT .or. region_CPML(ispec) == CPML_TOP_RIGHT .or. &
region_CPML(ispec) == CPML_BOTTOM_LEFT .or. region_CPML(ispec) == CPML_BOTTOM_RIGHT) then
!------------------------------------------------------------------------------
!---------------------------- CORNER ------------------------------------------
@@ -322,10 +322,10 @@
else
coef1 = deltat / 2.0_CUSTOM_REAL
coef2 = deltat / 2.0_CUSTOM_REAL
- end if
+ endif
rmemory_acoustic_dux_dx(i,j,ispec_PML) = coef0*rmemory_acoustic_dux_dx(i,j,ispec_PML) &
+ PML_dux_dxl_new(i,j,ispec_PML) * coef1 + PML_dux_dxl(i,j,ispec_PML) * coef2
- end if
+ endif
if(stage_time_scheme == 6) then
rmemory_acoustic_dux_dx_LDDRK(i,j,ispec_PML) = &
@@ -353,12 +353,12 @@
else
coef1 = deltat / 2.0_CUSTOM_REAL
coef2 = deltat / 2.0_CUSTOM_REAL
- end if
+ endif
rmemory_acoustic_dux_dz(i,j,ispec_PML) = coef0 * rmemory_acoustic_dux_dz(i,j,ispec_PML) &
+ PML_dux_dzl_new(i,j,ispec_PML) *coef1 + PML_dux_dzl(i,j,ispec_PML) * coef2
- end if
+ endif
if(stage_time_scheme == 6) then
rmemory_acoustic_dux_dz_LDDRK(i,j,ispec_PML) = &
@@ -370,7 +370,7 @@
dux_dzl = PML_dux_dzl(i,j,ispec_PML) + A5 * rmemory_acoustic_dux_dz(i,j,ispec_PML)
- elseif(region_CPML(ispec) == CPML_TOP .or. region_CPML(ispec) == CPML_BOTTOM) then
+ else if(region_CPML(ispec) == CPML_TOP .or. region_CPML(ispec) == CPML_BOTTOM) then
!------------------------------------------------------------------------------
!---------------------------- TOP & BOTTOM ------------------------------------
@@ -388,11 +388,11 @@
else
coef1 = deltat / 2.0_CUSTOM_REAL
coef2 = deltat / 2.0_CUSTOM_REAL
- end if
+ endif
rmemory_acoustic_dux_dx(i,j,ispec_PML) = coef0*rmemory_acoustic_dux_dx(i,j,ispec_PML) &
+ PML_dux_dxl_new(i,j,ispec_PML) * coef1 + PML_dux_dxl(i,j,ispec_PML) * coef2
- end if
+ endif
if(stage_time_scheme == 6) then
rmemory_acoustic_dux_dx_LDDRK(i,j,ispec_PML) = &
@@ -416,11 +416,11 @@
else
coef1 = deltat / 2.0_CUSTOM_REAL
coef2 = deltat / 2.0_CUSTOM_REAL
- end if
+ endif
rmemory_acoustic_dux_dz(i,j,ispec_PML) = coef0 * rmemory_acoustic_dux_dz(i,j,ispec_PML) &
+ PML_dux_dzl_new(i,j,ispec_PML) *coef1 + PML_dux_dzl(i,j,ispec_PML) * coef2
- end if
+ endif
if(stage_time_scheme == 6) then
rmemory_acoustic_dux_dz_LDDRK(i,j,ispec_PML) = &
@@ -497,7 +497,7 @@
else
coef1 = deltat / 2.0_CUSTOM_REAL
coef2 = deltat / 2.0_CUSTOM_REAL
- end if
+ endif
rmemory_potential_acoustic(1,i,j,ispec_PML)=coef0 * rmemory_potential_acoustic(1,i,j,ispec_PML) &
+ (potential_acoustic(iglob)+deltat*potential_dot_acoustic(iglob)) * coef1 &
@@ -505,7 +505,7 @@
rmemory_potential_acoustic(2,i,j,ispec_PML)=0.0
- elseif (region_CPML(ispec) == CPML_TOP_LEFT .or. region_CPML(ispec) == CPML_TOP_RIGHT .or. &
+ else if (region_CPML(ispec) == CPML_TOP_LEFT .or. region_CPML(ispec) == CPML_TOP_RIGHT .or. &
region_CPML(ispec) == CPML_BOTTOM_LEFT .or. region_CPML(ispec) == CPML_BOTTOM_RIGHT) then
!------------------------------------------------------------------------------
@@ -522,7 +522,7 @@
else
coef1 = deltat / 2.0_CUSTOM_REAL
coef2 = deltat / 2.0_CUSTOM_REAL
- end if
+ endif
rmemory_potential_acoustic(1,i,j,ispec_PML)=&
coef0 * rmemory_potential_acoustic(1,i,j,ispec_PML) &
@@ -539,14 +539,14 @@
else
coef1 = deltat / 2.0_CUSTOM_REAL
coef2 = deltat / 2.0_CUSTOM_REAL
- end if
+ endif
rmemory_potential_acoustic(2,i,j,ispec_PML)=&
coef0 * rmemory_potential_acoustic(2,i,j,ispec_PML) &
+ (potential_acoustic(iglob)+deltat*potential_dot_acoustic(iglob))*(it+0.5)*deltat * coef1 &
+ potential_acoustic(iglob) *(it-0.5)*deltat * coef2
- elseif(region_CPML(ispec) == CPML_TOP .or. region_CPML(ispec) == CPML_BOTTOM) then
+ else if(region_CPML(ispec) == CPML_TOP .or. region_CPML(ispec) == CPML_BOTTOM) then
!------------------------------------------------------------------------------
!-------------------------------- TOP & BOTTOM --------------------------------
@@ -562,7 +562,7 @@
else
coef1 = deltat / 2._CUSTOM_REAL
coef2 = deltat / 2._CUSTOM_REAL
- end if
+ endif
rmemory_potential_acoustic(1,i,j,ispec_PML)=0._CUSTOM_REAL
@@ -594,7 +594,7 @@
rmemory_potential_acoustic(1,i,j,ispec_PML) = rmemory_potential_acoustic(1,i,j,ispec_PML) + &
beta_LDDRK(i_stage) * rmemory_potential_acoust_LDDRK(1,i,j,ispec_PML)
rmemory_potential_acoustic(2,i,j,ispec_PML) =0._CUSTOM_REAL
- end if
+ endif
potential_dot_dot_acoustic_PML(i,j,ispec_PML)= wxgll(i)*wzgll(j)/ kappal*jacobian(i,j,ispec) * &
(A0 * potential_acoustic(iglob) + &
@@ -602,7 +602,7 @@
A3 * rmemory_potential_acoustic(1,i,j,ispec_PML) + &
A4 * rmemory_potential_acoustic(2,i,j,ispec_PML))
- elseif (region_CPML(ispec) == CPML_TOP_LEFT .or. region_CPML(ispec) == CPML_TOP_RIGHT .or. &
+ else if (region_CPML(ispec) == CPML_TOP_LEFT .or. region_CPML(ispec) == CPML_TOP_RIGHT .or. &
region_CPML(ispec) == CPML_BOTTOM_LEFT .or. region_CPML(ispec) == CPML_BOTTOM_RIGHT) then
!------------------------------------------------------------------------------
!-------------------------------- CORNER --------------------------------------
@@ -627,7 +627,7 @@
d_z_store(i,j,ispec_PML) * k_x_store(i,j,ispec_PML)) &
-2._CUSTOM_REAL * alpha_x_store(i,j,ispec_PML)*d_x_store(i,j,ispec_PML)*d_z_store(i,j,ispec_PML)
A4 = alpha_x_store(i,j,ispec_PML) ** 2*d_x_store(i,j,ispec_PML)*d_z_store(i,j,ispec_PML)
- end if
+ endif
if(stage_time_scheme == 6) then
@@ -652,7 +652,7 @@
rmemory_potential_acoustic(2,i,j,ispec_PML) = rmemory_potential_acoustic(2,i,j,ispec_PML) + &
beta_LDDRK(i_stage) * rmemory_potential_acoust_LDDRK(2,i,j,ispec_PML)
- end if
+ endif
potential_dot_dot_acoustic_PML(i,j,ispec_PML)= wxgll(i)*wzgll(j)/ kappal*jacobian(i,j,ispec) * &
@@ -661,7 +661,7 @@
A3 * rmemory_potential_acoustic(1,i,j,ispec_PML) + &
A4 * rmemory_potential_acoustic(2,i,j,ispec_PML))
- elseif(region_CPML(ispec) == CPML_TOP .or. region_CPML(ispec) == CPML_BOTTOM) then
+ else if(region_CPML(ispec) == CPML_TOP .or. region_CPML(ispec) == CPML_BOTTOM) then
!------------------------------------------------------------------------------
!-------------------------------- TOP & BOTTOM --------------------------------
!------------------------------------------------------------------------------
@@ -683,7 +683,7 @@
rmemory_potential_acoustic(2,i,j,ispec_PML) = rmemory_potential_acoustic(2,i,j,ispec_PML) + &
beta_LDDRK(i_stage) * rmemory_potential_acoust_LDDRK(2,i,j,ispec_PML)
- end if
+ endif
potential_dot_dot_acoustic_PML(i,j,ispec_PML)= wxgll(i)*wzgll(j)/ kappal*jacobian(i,j,ispec) * &
(A0 * potential_acoustic(iglob) + &
@@ -779,7 +779,7 @@
potential_dot_dot_acoustic(iglob) = &
potential_dot_dot_acoustic(iglob) &
- potential_dot_acoustic(iglob)*weight/cpl/rhol
- elseif(SIMULATION_TYPE == 3) then
+ else if(SIMULATION_TYPE == 3) then
if(IS_BACKWARD_FIELD) then
! adds (previously) stored contribution
potential_dot_dot_acoustic(iglob) = &
@@ -825,7 +825,7 @@
potential_dot_dot_acoustic(iglob) = &
potential_dot_dot_acoustic(iglob) &
- potential_dot_acoustic(iglob)*weight/cpl/rhol
- elseif(SIMULATION_TYPE == 3) then
+ else if(SIMULATION_TYPE == 3) then
if(IS_BACKWARD_FIELD) then
! adds (previously) stored contribution
potential_dot_dot_acoustic(iglob) = &
@@ -872,7 +872,7 @@
potential_dot_dot_acoustic(iglob) = &
potential_dot_dot_acoustic(iglob) &
- potential_dot_acoustic(iglob)*weight/cpl/rhol
- elseif(SIMULATION_TYPE == 3) then
+ else if(SIMULATION_TYPE == 3) then
if(IS_BACKWARD_FIELD) then
! adds (previously) stored contribution
potential_dot_dot_acoustic(iglob) = &
@@ -919,7 +919,7 @@
potential_dot_dot_acoustic(iglob) = &
potential_dot_dot_acoustic(iglob) &
- potential_dot_acoustic(iglob)*weight/cpl/rhol
- elseif(SIMULATION_TYPE == 3) then
+ else if(SIMULATION_TYPE == 3) then
if(IS_BACKWARD_FIELD) then
! adds (previously) stored contribution
potential_dot_dot_acoustic(iglob) = &
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_forces_poro_fluid.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_forces_poro_fluid.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_forces_poro_fluid.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -272,7 +272,7 @@
endif
e11(i,j,ispec,i_sls) = e11_initial_rk(i,j,ispec,i_sls) &
+ weight_rk * e11_force_RK(i,j,ispec,i_sls,i_stage)
- elseif(i_stage==4)then
+ else if(i_stage==4)then
e11(i,j,ispec,i_sls) = e11_initial_rk(i,j,ispec,i_sls) + 1._CUSTOM_REAL / 6._CUSTOM_REAL * &
(e11_force_RK(i,j,ispec,i_sls,1) + 2._CUSTOM_REAL * e11_force_RK(i,j,ispec,i_sls,2) + &
2._CUSTOM_REAL * e11_force_RK(i,j,ispec,i_sls,3) + e11_force_RK(i,j,ispec,i_sls,4))
@@ -311,7 +311,7 @@
endif
e13(i,j,ispec,i_sls) = e13_initial_rk(i,j,ispec,i_sls) &
+ weight_rk * e13_force_RK(i,j,ispec,i_sls,i_stage)
- elseif(i_stage==4)then
+ else if(i_stage==4)then
e13(i,j,ispec,i_sls) = e13_initial_rk(i,j,ispec,i_sls) + 1._CUSTOM_REAL / 6._CUSTOM_REAL * &
(e13_force_RK(i,j,ispec,i_sls,1) + 2._CUSTOM_REAL * e13_force_RK(i,j,ispec,i_sls,2) + &
2._CUSTOM_REAL * e13_force_RK(i,j,ispec,i_sls,3) + e13_force_RK(i,j,ispec,i_sls,4))
@@ -663,7 +663,7 @@
if(SIMULATION_TYPE == 1 .and. SAVE_FORWARD) then
b_viscodampx(iglob) = wxgll(i)*wzgll(j)*jacobian(i,j,ispec) * viscodampx
b_viscodampz(iglob) = wxgll(i)*wzgll(j)*jacobian(i,j,ispec) * viscodampz
- elseif(SIMULATION_TYPE == 3) then ! kernels calculation
+ else if(SIMULATION_TYPE == 3) then ! kernels calculation
b_accelw_poroelastic(1,iglob) = b_accelw_poroelastic(1,iglob) - b_viscodampx(iglob)
b_accelw_poroelastic(2,iglob) = b_accelw_poroelastic(2,iglob) - b_viscodampz(iglob)
endif
@@ -757,7 +757,7 @@
if(SIMULATION_TYPE == 1 .and. SAVE_FORWARD) then
b_absorb_poro_w_left(1,j,ib_left(ispecabs),it) = tx*weight
b_absorb_poro_w_left(2,j,ib_left(ispecabs),it) = tz*weight
- elseif(SIMULATION_TYPE == 3) then
+ else if(SIMULATION_TYPE == 3) then
b_accelw_poroelastic(1,iglob) = b_accelw_poroelastic(1,iglob) - &
b_absorb_poro_w_left(1,j,ib_left(ispecabs),NSTEP-it+1)
b_accelw_poroelastic(2,iglob) = b_accelw_poroelastic(2,iglob) - &
@@ -813,7 +813,7 @@
if(SIMULATION_TYPE == 1 .and. SAVE_FORWARD) then
b_absorb_poro_w_right(1,j,ib_right(ispecabs),it) = tx*weight
b_absorb_poro_w_right(2,j,ib_right(ispecabs),it) = tz*weight
- elseif(SIMULATION_TYPE == 3) then
+ else if(SIMULATION_TYPE == 3) then
b_accelw_poroelastic(1,iglob) = b_accelw_poroelastic(1,iglob) - &
b_absorb_poro_w_right(1,j,ib_right(ispecabs),NSTEP-it+1)
b_accelw_poroelastic(2,iglob) = b_accelw_poroelastic(2,iglob) - &
@@ -873,7 +873,7 @@
if(SIMULATION_TYPE == 1 .and. SAVE_FORWARD) then
b_absorb_poro_w_bottom(1,i,ib_bottom(ispecabs),it) = tx*weight
b_absorb_poro_w_bottom(2,i,ib_bottom(ispecabs),it) = tz*weight
- elseif(SIMULATION_TYPE == 3) then
+ else if(SIMULATION_TYPE == 3) then
b_accelw_poroelastic(1,iglob) = b_accelw_poroelastic(1,iglob) - &
b_absorb_poro_w_bottom(1,i,ib_bottom(ispecabs),NSTEP-it+1)
b_accelw_poroelastic(2,iglob) = b_accelw_poroelastic(2,iglob) - &
@@ -933,7 +933,7 @@
if(SIMULATION_TYPE == 1 .and. SAVE_FORWARD) then
b_absorb_poro_w_top(1,i,ib_top(ispecabs),it) = tx*weight
b_absorb_poro_w_top(2,i,ib_top(ispecabs),it) = tz*weight
- elseif(SIMULATION_TYPE == 3) then
+ else if(SIMULATION_TYPE == 3) then
b_accelw_poroelastic(1,iglob) = b_accelw_poroelastic(1,iglob) - &
b_absorb_poro_w_top(1,i,ib_top(ispecabs),NSTEP-it+1)
b_accelw_poroelastic(2,iglob) = b_accelw_poroelastic(2,iglob) - &
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_forces_poro_solid.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_forces_poro_solid.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_forces_poro_solid.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -274,7 +274,7 @@
endif
e11(i,j,ispec,i_sls) = e11_initial_rk(i,j,ispec,i_sls) &
+ weight_rk * e11_force_RK(i,j,ispec,i_sls,i_stage)
- elseif(i_stage==4)then
+ else if(i_stage==4)then
e11(i,j,ispec,i_sls) = e11_initial_rk(i,j,ispec,i_sls) + 1._CUSTOM_REAL / 6._CUSTOM_REAL * &
(e11_force_RK(i,j,ispec,i_sls,1) + 2._CUSTOM_REAL * e11_force_RK(i,j,ispec,i_sls,2) + &
2._CUSTOM_REAL * e11_force_RK(i,j,ispec,i_sls,3) + e11_force_RK(i,j,ispec,i_sls,4))
@@ -313,7 +313,7 @@
endif
e13(i,j,ispec,i_sls) = e13_initial_rk(i,j,ispec,i_sls) &
+ weight_rk * e13_force_RK(i,j,ispec,i_sls,i_stage)
- elseif(i_stage==4)then
+ else if(i_stage==4)then
e13(i,j,ispec,i_sls) = e13_initial_rk(i,j,ispec,i_sls) + 1._CUSTOM_REAL / 6._CUSTOM_REAL * &
(e13_force_RK(i,j,ispec,i_sls,1) + 2._CUSTOM_REAL * e13_force_RK(i,j,ispec,i_sls,2) + &
2._CUSTOM_REAL * e13_force_RK(i,j,ispec,i_sls,3) + e13_force_RK(i,j,ispec,i_sls,4))
@@ -778,7 +778,7 @@
if(SIMULATION_TYPE == 1 .and. SAVE_FORWARD) then
b_absorb_poro_s_left(1,j,ib_left(ispecabs),it) = tx*weight
b_absorb_poro_s_left(2,j,ib_left(ispecabs),it) = tz*weight
- elseif(SIMULATION_TYPE == 3) then
+ else if(SIMULATION_TYPE == 3) then
b_accels_poroelastic(1,iglob) = b_accels_poroelastic(1,iglob) - &
b_absorb_poro_s_left(1,j,ib_left(ispecabs),NSTEP-it+1)
b_accels_poroelastic(2,iglob) = b_accels_poroelastic(2,iglob) - &
@@ -834,7 +834,7 @@
if(SIMULATION_TYPE == 1 .and. SAVE_FORWARD) then
b_absorb_poro_s_right(1,j,ib_right(ispecabs),it) = tx*weight
b_absorb_poro_s_right(2,j,ib_right(ispecabs),it) = tz*weight
- elseif(SIMULATION_TYPE == 3) then
+ else if(SIMULATION_TYPE == 3) then
b_accels_poroelastic(1,iglob) = b_accels_poroelastic(1,iglob) - &
b_absorb_poro_s_right(1,j,ib_right(ispecabs),NSTEP-it+1)
b_accels_poroelastic(2,iglob) = b_accels_poroelastic(2,iglob) - &
@@ -894,7 +894,7 @@
if(SIMULATION_TYPE == 1 .and. SAVE_FORWARD) then
b_absorb_poro_s_bottom(1,i,ib_bottom(ispecabs),it) = tx*weight
b_absorb_poro_s_bottom(2,i,ib_bottom(ispecabs),it) = tz*weight
- elseif(SIMULATION_TYPE == 3) then
+ else if(SIMULATION_TYPE == 3) then
b_accels_poroelastic(1,iglob) = b_accels_poroelastic(1,iglob) - &
b_absorb_poro_s_bottom(1,i,ib_bottom(ispecabs),NSTEP-it+1)
b_accels_poroelastic(2,iglob) = b_accels_poroelastic(2,iglob) - &
@@ -954,7 +954,7 @@
if(SIMULATION_TYPE == 1 .and. SAVE_FORWARD) then
b_absorb_poro_s_top(1,i,ib_top(ispecabs),it) = tx*weight
b_absorb_poro_s_top(2,i,ib_top(ispecabs),it) = tz*weight
- elseif(SIMULATION_TYPE == 3) then
+ else if(SIMULATION_TYPE == 3) then
b_accels_poroelastic(1,iglob) = b_accels_poroelastic(1,iglob) - &
b_absorb_poro_s_top(1,i,ib_top(ispecabs),NSTEP-it+1)
b_accels_poroelastic(2,iglob) = b_accels_poroelastic(2,iglob) - &
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_forces_viscoelastic.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_forces_viscoelastic.F90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_forces_viscoelastic.F90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -308,7 +308,7 @@
e1(i,j,ispec,i_sls) = e1_initial_rk(i,j,ispec,i_sls) &
+ weight_rk * e1_force_RK(i,j,ispec,i_sls,i_stage)
- elseif(i_stage==4)then
+ else if(i_stage==4)then
e1(i,j,ispec,i_sls) = e1_initial_rk(i,j,ispec,i_sls) + 1._CUSTOM_REAL / 6._CUSTOM_REAL * &
(e1_force_RK(i,j,ispec,i_sls,1) + 2._CUSTOM_REAL * e1_force_RK(i,j,ispec,i_sls,2) + &
@@ -348,7 +348,7 @@
endif
e11(i,j,ispec,i_sls) = e11_initial_rk(i,j,ispec,i_sls) &
+ weight_rk * e11_force_RK(i,j,ispec,i_sls,i_stage)
- elseif(i_stage==4)then
+ else if(i_stage==4)then
e11(i,j,ispec,i_sls) = e11_initial_rk(i,j,ispec,i_sls) + 1._CUSTOM_REAL / 6._CUSTOM_REAL * &
(e11_force_RK(i,j,ispec,i_sls,1) + 2._CUSTOM_REAL * e11_force_RK(i,j,ispec,i_sls,2) + &
2._CUSTOM_REAL * e11_force_RK(i,j,ispec,i_sls,3) + e11_force_RK(i,j,ispec,i_sls,4))
@@ -386,7 +386,7 @@
endif
e13(i,j,ispec,i_sls) = e13_initial_rk(i,j,ispec,i_sls) &
+ weight_rk * e13_force_RK(i,j,ispec,i_sls,i_stage)
- elseif(i_stage==4)then
+ else if(i_stage==4)then
e13(i,j,ispec,i_sls) = e13_initial_rk(i,j,ispec,i_sls) + 1._CUSTOM_REAL / 6._CUSTOM_REAL * &
(e13_force_RK(i,j,ispec,i_sls,1) + 2._CUSTOM_REAL * e13_force_RK(i,j,ispec,i_sls,2) + &
2._CUSTOM_REAL * e13_force_RK(i,j,ispec,i_sls,3) + e13_force_RK(i,j,ispec,i_sls,4))
@@ -559,7 +559,7 @@
else
coef1 = deltat / 2._CUSTOM_REAL
coef2 = deltat / 2._CUSTOM_REAL
- end if
+ endif
if(ROTATE_PML_ACTIVATE)then
@@ -601,7 +601,7 @@
rmemory_duz_dx(i,j,ispec_PML) = rmemory_duz_dx(i,j,ispec_PML) + &
beta_LDDRK(i_stage) * rmemory_duz_dx_LDDRK(i,j,ispec_PML)
- end if
+ endif
if(ROTATE_PML_ACTIVATE)then
dux_dxl = PML_dux_dxl(i,j,ispec_PML) + A8 * rmemory_dux_dx(i,j,ispec_PML)
@@ -629,7 +629,7 @@
else
coef1 = deltat / 2._CUSTOM_REAL
coef2 = deltat / 2._CUSTOM_REAL
- end if
+ endif
if(ROTATE_PML_ACTIVATE)then
rmemory_dux_dx_prime(i,j,ispec_PML) = coef0 * rmemory_dux_dx_prime(i,j,ispec_PML) &
@@ -651,7 +651,7 @@
+ PML_duz_dzl_new(i,j,ispec_PML) *coef1 + PML_duz_dzl(i,j,ispec_PML) * coef2
endif
- end if
+ endif
if(stage_time_scheme == 6) then
rmemory_dux_dz_LDDRK(i,j,ispec_PML) = alpha_LDDRK(i_stage) * rmemory_dux_dz_LDDRK(i,j,ispec_PML) &
@@ -663,7 +663,7 @@
+ deltat * (-bb * rmemory_duz_dz(i,j,ispec_PML) + PML_duz_dzl(i,j,ispec_PML))
rmemory_duz_dz(i,j,ispec_PML) = rmemory_duz_dz(i,j,ispec_PML) + &
beta_LDDRK(i_stage) * rmemory_duz_dz_LDDRK(i,j,ispec_PML)
- end if
+ endif
if(ROTATE_PML_ACTIVATE)then
dux_dxl_prime = PML_dux_dxl(i,j,ispec_PML) + A5 * rmemory_dux_dx_prime(i,j,ispec_PML)
@@ -681,7 +681,7 @@
!------------------------------------------------------------------------------
!---------------------------- CORNER ------------------------------------------
!------------------------------------------------------------------------------
- elseif (region_CPML(ispec) == CPML_TOP_LEFT .or. region_CPML(ispec) == CPML_TOP_RIGHT .or. &
+ else if (region_CPML(ispec) == CPML_TOP_LEFT .or. region_CPML(ispec) == CPML_TOP_RIGHT .or. &
region_CPML(ispec) == CPML_BOTTOM_LEFT .or. region_CPML(ispec) == CPML_BOTTOM_RIGHT) then
!---------------------- A8--------------------------
@@ -701,7 +701,7 @@
else
coef1 = deltat / 2._CUSTOM_REAL
coef2 = deltat / 2._CUSTOM_REAL
- end if
+ endif
if(ROTATE_PML_ACTIVATE)then
rmemory_dux_dx(i,j,ispec_PML) = coef0 * rmemory_dux_dx(i,j,ispec_PML) &
@@ -723,7 +723,7 @@
+ PML_duz_dxl_new(i,j,ispec_PML) * coef1 + PML_duz_dxl(i,j,ispec_PML) * coef2
endif
- end if
+ endif
if(stage_time_scheme == 6) then
rmemory_dux_dx_LDDRK(i,j,ispec_PML) = alpha_LDDRK(i_stage) * rmemory_dux_dx_LDDRK(i,j,ispec_PML) &
@@ -735,7 +735,7 @@
+ deltat * (-bb * rmemory_duz_dx(i,j,ispec_PML) + PML_duz_dxl(i,j,ispec_PML))
rmemory_duz_dx(i,j,ispec_PML) = rmemory_duz_dx(i,j,ispec_PML) + &
beta_LDDRK(i_stage) * rmemory_duz_dx_LDDRK(i,j,ispec_PML)
- end if
+ endif
if(ROTATE_PML_ACTIVATE)then
dux_dxl = PML_dux_dxl(i,j,ispec_PML) + A8 * rmemory_dux_dx(i,j,ispec_PML)
@@ -766,7 +766,7 @@
else
coef1 = deltat / 2._CUSTOM_REAL
coef2 = deltat / 2._CUSTOM_REAL
- end if
+ endif
if(ROTATE_PML_ACTIVATE)then
rmemory_dux_dx_prime(i,j,ispec_PML) = coef0 * rmemory_dux_dx_prime(i,j,ispec_PML) &
@@ -789,7 +789,7 @@
+ PML_duz_dzl_new(i,j,ispec_PML) *coef1 + PML_duz_dzl(i,j,ispec_PML) * coef2
endif
- end if
+ endif
if(stage_time_scheme == 6) then
rmemory_dux_dz_LDDRK(i,j,ispec_PML) = alpha_LDDRK(i_stage) * rmemory_dux_dz_LDDRK(i,j,ispec_PML) &
@@ -801,7 +801,7 @@
+ deltat * (-bb * rmemory_duz_dz(i,j,ispec_PML) + PML_duz_dzl(i,j,ispec_PML))
rmemory_duz_dz(i,j,ispec_PML) = rmemory_duz_dz(i,j,ispec_PML) + &
beta_LDDRK(i_stage) * rmemory_duz_dz_LDDRK(i,j,ispec_PML)
- end if
+ endif
if(ROTATE_PML_ACTIVATE)then
dux_dxl_prime = PML_dux_dxl(i,j,ispec_PML) + A5 * rmemory_dux_dx_prime(i,j,ispec_PML)
@@ -815,7 +815,7 @@
- elseif(region_CPML(ispec) == CPML_TOP .or. region_CPML(ispec) == CPML_BOTTOM) then
+ else if(region_CPML(ispec) == CPML_TOP .or. region_CPML(ispec) == CPML_BOTTOM) then
!------------------------------------------------------------------------------
!---------------------------- TOP & BOTTOM ------------------------------------
!------------------------------------------------------------------------------
@@ -832,7 +832,7 @@
else
coef1 = deltat / 2._CUSTOM_REAL
coef2 = deltat / 2._CUSTOM_REAL
- end if
+ endif
if(ROTATE_PML_ACTIVATE)then
rmemory_dux_dx(i,j,ispec_PML) = coef0 * rmemory_dux_dx(i,j,ispec_PML) &
@@ -854,7 +854,7 @@
+ PML_duz_dxl_new(i,j,ispec_PML) * coef1 + PML_duz_dxl(i,j,ispec_PML) * coef2
endif
- end if
+ endif
if(stage_time_scheme == 6) then
rmemory_dux_dx_LDDRK(i,j,ispec_PML) = alpha_LDDRK(i_stage) * rmemory_dux_dx_LDDRK(i,j,ispec_PML) &
@@ -866,7 +866,7 @@
+ deltat * (-bb * rmemory_duz_dx(i,j,ispec_PML) + PML_duz_dxl(i,j,ispec_PML))
rmemory_duz_dx(i,j,ispec_PML) = rmemory_duz_dx(i,j,ispec_PML) + &
beta_LDDRK(i_stage) * rmemory_duz_dx_LDDRK(i,j,ispec_PML)
- end if
+ endif
if(ROTATE_PML_ACTIVATE)then
dux_dxl = PML_dux_dxl(i,j,ispec_PML) + A7 * rmemory_dux_dx(i,j,ispec_PML)
@@ -893,7 +893,7 @@
else
coef1 = deltat / 2._CUSTOM_REAL
coef2 = deltat / 2._CUSTOM_REAL
- end if
+ endif
if(ROTATE_PML_ACTIVATE)then
rmemory_dux_dx_prime(i,j,ispec_PML) = coef0 * rmemory_dux_dx_prime(i,j,ispec_PML) &
@@ -915,7 +915,7 @@
+ PML_duz_dzl_new(i,j,ispec_PML) *coef1 + PML_duz_dzl(i,j,ispec_PML) * coef2
endif
- end if
+ endif
if(stage_time_scheme == 6) then
rmemory_dux_dz_LDDRK(i,j,ispec_PML) = alpha_LDDRK(i_stage) * rmemory_dux_dz_LDDRK(i,j,ispec_PML) &
@@ -927,7 +927,7 @@
+ deltat * (-bb * rmemory_duz_dz(i,j,ispec_PML) + PML_duz_dzl(i,j,ispec_PML))
rmemory_duz_dz(i,j,ispec_PML) = rmemory_duz_dz(i,j,ispec_PML) + &
beta_LDDRK(i_stage) * rmemory_duz_dz_LDDRK(i,j,ispec_PML)
- end if
+ endif
if(ROTATE_PML_ACTIVATE)then
dux_dxl_prime = PML_dux_dxl(i,j,ispec_PML) + A6 * rmemory_dux_dx_prime(i,j,ispec_PML)
@@ -1088,7 +1088,7 @@
c33 = anisotropy(4,kmato(ispec))
c35 = anisotropy(5,kmato(ispec))
c55 = anisotropy(6,kmato(ispec))
- end if
+ endif
! implement anisotropy in 2D
sigma_xx = c11*dux_dxl + c15*(duz_dxl + dux_dzl) + c13*duz_dzl
@@ -1145,7 +1145,7 @@
else
coef1 = deltat / 2._CUSTOM_REAL
coef2 = deltat / 2._CUSTOM_REAL
- end if
+ endif
rmemory_displ_elastic(1,1,i,j,ispec_PML)=coef0 * rmemory_displ_elastic(1,1,i,j,ispec_PML) &
+ displ_elastic_new(1,iglob) * coef1 + displ_elastic(1,iglob) * coef2
@@ -1154,12 +1154,12 @@
rmemory_displ_elastic(1,3,i,j,ispec_PML)=coef0 * rmemory_displ_elastic(1,3,i,j,ispec_PML) &
+ displ_elastic_new(3,iglob) * coef1 + displ_elastic(3,iglob) * coef2
rmemory_displ_elastic(2,3,i,j,ispec_PML)=0.0
- end if
+ endif
!------------------------------------------------------------------------------
!-------------------------------- CORNER --------------------------------------
!------------------------------------------------------------------------------
- elseif (region_CPML(ispec) == CPML_TOP_LEFT .or. region_CPML(ispec) == CPML_TOP_RIGHT .or. &
+ else if (region_CPML(ispec) == CPML_TOP_LEFT .or. region_CPML(ispec) == CPML_TOP_RIGHT .or. &
region_CPML(ispec) == CPML_BOTTOM_LEFT .or. region_CPML(ispec) == CPML_BOTTOM_RIGHT) then
!------------------------------------------------------------
@@ -1174,7 +1174,7 @@
else
coef1 = deltat / 2._CUSTOM_REAL
coef2 = deltat / 2._CUSTOM_REAL
- end if
+ endif
rmemory_displ_elastic(1,1,i,j,ispec_PML)= &
coef0 * rmemory_displ_elastic(1,1,i,j,ispec_PML) &
@@ -1182,7 +1182,7 @@
rmemory_displ_elastic(1,3,i,j,ispec_PML)= &
coef0 * rmemory_displ_elastic(1,3,i,j,ispec_PML) &
+ displ_elastic_new(3,iglob) * coef1 + displ_elastic(3,iglob) * coef2
- end if
+ endif
!------------------------------------------------------------
bb = alpha_z_store(i,j,ispec_PML)
@@ -1196,7 +1196,7 @@
else
coef1 = deltat / 2._CUSTOM_REAL
coef2 = deltat / 2._CUSTOM_REAL
- end if
+ endif
rmemory_displ_elastic(2,1,i,j,ispec_PML)=coef0 * rmemory_displ_elastic(2,1,i,j,ispec_PML) &
+ displ_elastic_new(1,iglob)*(it+0.5)*deltat * coef1 &
@@ -1204,9 +1204,9 @@
rmemory_displ_elastic(2,3,i,j,ispec_PML)=coef0 * rmemory_displ_elastic(2,3,i,j,ispec_PML) &
+ displ_elastic_new(3,iglob)*(it+0.5)*deltat * coef1 &
+ displ_elastic(3,iglob)*(it-0.5)*deltat * coef2
- end if
+ endif
- elseif(region_CPML(ispec) == CPML_TOP .or. region_CPML(ispec) == CPML_BOTTOM) then
+ else if(region_CPML(ispec) == CPML_TOP .or. region_CPML(ispec) == CPML_BOTTOM) then
!------------------------------------------------------------------------------
!-------------------------------- TOP & BOTTOM --------------------------------
!------------------------------------------------------------------------------
@@ -1223,7 +1223,7 @@
else
coef1 = deltat / 2._CUSTOM_REAL
coef2 = deltat / 2._CUSTOM_REAL
- end if
+ endif
rmemory_displ_elastic(1,1,i,j,ispec_PML)=0._CUSTOM_REAL
rmemory_displ_elastic(2,1,i,j,ispec_PML)=coef0 * rmemory_displ_elastic(2,1,i,j,ispec_PML) &
@@ -1232,7 +1232,7 @@
rmemory_displ_elastic(1,3,i,j,ispec_PML)=0._CUSTOM_REAL
rmemory_displ_elastic(2,3,i,j,ispec_PML)=coef0 * rmemory_displ_elastic(2,3,i,j,ispec_PML) &
+ displ_elastic_new(3,iglob) * coef1 + displ_elastic(3,iglob) * coef2
- end if
+ endif
endif
@@ -1264,7 +1264,7 @@
beta_LDDRK(i_stage) * rmemory_displ_elastic_LDDRK(1,3,i,j,ispec_PML)
rmemory_displ_elastic(2,3,i,j,ispec_PML) =0._CUSTOM_REAL
- end if
+ endif
accel_elastic_PML(1,i,j,ispec_PML)= wxgll(i)*wzgll(j)*rhol*jacobian(i,j,ispec) * &
( &
@@ -1282,7 +1282,7 @@
)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!corner
- elseif (region_CPML(ispec) == CPML_TOP_LEFT .or. region_CPML(ispec) == CPML_TOP_RIGHT .or. &
+ else if (region_CPML(ispec) == CPML_TOP_LEFT .or. region_CPML(ispec) == CPML_TOP_RIGHT .or. &
region_CPML(ispec) == CPML_BOTTOM_LEFT .or. region_CPML(ispec) == CPML_BOTTOM_RIGHT) then
A0 = d_x_store(i,j,ispec_PML) * d_z_store(i,j,ispec_PML) &
@@ -1304,7 +1304,7 @@
d_z_store(i,j,ispec_PML) * k_x_store(i,j,ispec_PML)) &
-2._CUSTOM_REAL * alpha_x_store(i,j,ispec_PML)*d_x_store(i,j,ispec_PML)*d_z_store(i,j,ispec_PML)
A4 = alpha_x_store(i,j,ispec_PML) ** 2*d_x_store(i,j,ispec_PML)*d_z_store(i,j,ispec_PML)
- end if
+ endif
if(stage_time_scheme == 6) then
@@ -1334,7 +1334,7 @@
rmemory_displ_elastic(2,3,i,j,ispec_PML) = rmemory_displ_elastic(2,3,i,j,ispec_PML) + &
beta_LDDRK(i_stage) * rmemory_displ_elastic_LDDRK(2,3,i,j,ispec_PML)
- end if
+ endif
accel_elastic_PML(1,i,j,ispec_PML)= wxgll(i)*wzgll(j)*rhol*jacobian(i,j,ispec) * &
( &
@@ -1354,7 +1354,7 @@
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!corner
- elseif(region_CPML(ispec) == CPML_TOP .or. region_CPML(ispec) == CPML_BOTTOM) then
+ else if(region_CPML(ispec) == CPML_TOP .or. region_CPML(ispec) == CPML_BOTTOM) then
A0 = - alpha_z_store(i,j,ispec_PML) * d_z_store(i,j,ispec_PML)
A1 = d_z_store(i,j,ispec_PML)
@@ -1380,7 +1380,7 @@
rmemory_displ_elastic(2,3,i,j,ispec_PML) = rmemory_displ_elastic(2,3,i,j,ispec_PML) + &
beta_LDDRK(i_stage) * rmemory_displ_elastic_LDDRK(2,3,i,j,ispec_PML)
- end if
+ endif
accel_elastic_PML(1,i,j,ispec_PML)= wxgll(i)*wzgll(j)*rhol*jacobian(i,j,ispec) * &
( &
@@ -1491,7 +1491,7 @@
traction_x_t0=t0x_left(count_left)
traction_z_t0=t0z_left(count_left)
count_left=count_left+1
- end if
+ endif
else
veloc_horiz = 0
veloc_vert = 0
@@ -1609,7 +1609,7 @@
traction_x_t0=t0x_right(count_right)
traction_z_t0=t0z_right(count_right)
count_right=count_right+1
- end if
+ endif
else
veloc_horiz = 0
veloc_vert = 0
@@ -1734,7 +1734,7 @@
traction_x_t0=t0x_bot(count_bottom)
traction_z_t0=t0z_bot(count_bottom)
count_bottom=count_bottom+1
- end if
+ endif
else
veloc_horiz = 0
veloc_vert = 0
@@ -2073,7 +2073,7 @@
sourcearray(i_source,2,i,j)*source_time_function(i_source,it,i_stage)
enddo
enddo
- elseif(SIMULATION_TYPE == 3 .and. backward_simulation) then ! backward wavefield
+ else if(SIMULATION_TYPE == 3 .and. backward_simulation) then ! backward wavefield
do j=1,NGLLZ
do i=1,NGLLX
iglob = ibool(i,j,ispec_selected_source(i_source))
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_pressure.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_pressure.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_pressure.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -355,7 +355,7 @@
enddo
enddo
- elseif(poroelastic(ispec)) then
+ else if(poroelastic(ispec)) then
lambdal_unrelaxed_elastic = poroelastcoef(1,1,kmato(ispec))
mul_unrelaxed_elastic = poroelastcoef(2,1,kmato(ispec))
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_vector_field.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_vector_field.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/compute_vector_field.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -178,7 +178,7 @@
enddo
enddo
- elseif(poroelastic(ispec)) then
+ else if(poroelastic(ispec)) then
do j = 1,NGLLZ
do i = 1,NGLLX
iglob = ibool(i,j,ispec)
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/convert_time.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/convert_time.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/convert_time.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -58,10 +58,10 @@
if (mon == 2) then
if (is_leap_year(yr) .and. (day < 1 .or. day > 29)) then
stop 'Error in convtime: February day out of range (1-29)'
- elseif (.not. is_leap_year(yr) .and. (day < 1 .or. day > 28)) then
+ else if (.not. is_leap_year(yr) .and. (day < 1 .or. day > 28)) then
stop 'Error in convtime: February day out of range (1-28)'
endif
- elseif (mon == 4 .or. mon == 6 .or. mon == 9 .or. mon == 11) then
+ else if (mon == 4 .or. mon == 6 .or. mon == 9 .or. mon == 11) then
if (day < 1 .or. day > 30) stop 'Error in convtime: day out of range (1-30)'
else
if (day < 1 .or. day > 31) stop 'Error in convtime: day out of range (1-31)'
@@ -188,7 +188,7 @@
tmon=itime-leap_mon(imon)
if (tmon > 0) then
goto 30
- elseif (tmon < 0) then
+ else if (tmon < 0) then
imon=imon-1
itime=itime-month(imon)
else
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/get_MPI.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/get_MPI.F90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/get_MPI.F90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -134,9 +134,9 @@
num_interface = 0
if( idomain == 1 ) then
num_interface = ninterface_acoustic
- elseif( idomain == 2 ) then
+ else if( idomain == 2 ) then
num_interface = ninterface_elastic
- elseif( idomain == 3 ) then
+ else if( idomain == 3 ) then
num_interface = ninterface_poroelastic
endif
if( num_interface == 0 ) cycle
@@ -148,9 +148,9 @@
num_nibool = 0
if( idomain == 1 ) then
num_nibool = nibool_interfaces_acoustic(iinterface)
- elseif( idomain == 2 ) then
+ else if( idomain == 2 ) then
num_nibool = nibool_interfaces_elastic(iinterface)
- elseif( idomain == 3 ) then
+ else if( idomain == 3 ) then
num_nibool = nibool_interfaces_poroelastic(iinterface)
endif
! checks if anything to sort
@@ -170,9 +170,9 @@
! works with a copy of ibool array
if( idomain == 1 ) then
ibool_dummy(:) = ibool_interfaces_acoustic(1:num_nibool,iinterface)
- elseif( idomain == 2 ) then
+ else if( idomain == 2 ) then
ibool_dummy(:) = ibool_interfaces_elastic(1:num_nibool,iinterface)
- elseif( idomain == 3 ) then
+ else if( idomain == 3 ) then
ibool_dummy(:) = ibool_interfaces_poroelastic(1:num_nibool,iinterface)
endif
@@ -204,9 +204,9 @@
! stores new order of ibool array
if( idomain == 1 ) then
ibool_interfaces_acoustic(1:num_nibool,iinterface) = ibool_dummy(:)
- elseif( idomain == 2 ) then
+ else if( idomain == 2 ) then
ibool_interfaces_elastic(1:num_nibool,iinterface) = ibool_dummy(:)
- elseif( idomain == 3 ) then
+ else if( idomain == 3 ) then
ibool_interfaces_poroelastic(1:num_nibool,iinterface) = ibool_dummy(:)
endif
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/gmat01.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/gmat01.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/gmat01.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -238,7 +238,7 @@
else
porosity_array(n) = 1.d0
endif
- elseif (indic == 2) then
+ else if (indic == 2) then
density_array(1,n) = density(1)
! dummy poroelastcoef values, trick to avoid floating invalid
poroelastcoef(1,1,n) = lambda
@@ -252,7 +252,7 @@
aniso_array(5,n) = c35
aniso_array(6,n) = c55
porosity_array(n) = 0.d0
- elseif (indic == 3) then
+ else if (indic == 3) then
density_array(1,n) = density(1)
density_array(2,n) = density(2)
poroelastcoef(1,1,n) = lambda_s
@@ -290,9 +290,9 @@
else ! acoustic
write(IOUT,300) n,cp,density(1),kappa,QKappa,Qmu
endif
- elseif(indic == 2) then ! elastic (anisotropic)
+ else if(indic == 2) then ! elastic (anisotropic)
write(IOUT,400) n,density(1),c11,c13,c15,c33,c35,c55
- elseif(indic == 3) then
+ else if(indic == 3) then
! material is poroelastic (solid/fluid)
write(iout,500) n,sqrt(cpIsquare),sqrt(cpIIsquare),sqrt(cssquare)
write(iout,600) density(1),poisson_s,lambda_s,mu_s,kappa_s,young_s
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/initialize_simulation.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/initialize_simulation.F90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/initialize_simulation.F90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -155,14 +155,14 @@
poroelastic(ispec) = .false.
any_acoustic = .true.
count_nspec_acoustic = count_nspec_acoustic + 1
- elseif( porosity(kmato(ispec)) < TINYVAL) then
+ else if( porosity(kmato(ispec)) < TINYVAL) then
! elastic domain
elastic(ispec) = .true.
poroelastic(ispec) = .false.
any_elastic = .true.
if(any(anisotropy(:,kmato(ispec)) /= 0)) then
anisotropic(ispec) = .true.
- end if
+ endif
else
! poroelastic domain
elastic(ispec) = .false.
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/invert_mass_matrix.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/invert_mass_matrix.F90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/invert_mass_matrix.F90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -201,14 +201,14 @@
+ wxgll(i)*wzgll(j)*rhol*jacobian(i,j,ispec) * (K_x_store(i,j,ispec_PML)&
+ d_x_store(i,j,ispec_PML) * deltat / 2.d0)
rmass_inverse_elastic_three(iglob) = rmass_inverse_elastic_one(iglob)
- elseif (region_CPML(ispec) == CPML_TOP_LEFT .or. region_CPML(ispec) == CPML_TOP_RIGHT .or. &
+ else if (region_CPML(ispec) == CPML_TOP_LEFT .or. region_CPML(ispec) == CPML_TOP_RIGHT .or. &
region_CPML(ispec) == CPML_BOTTOM_LEFT .or. region_CPML(ispec) == CPML_BOTTOM_RIGHT) then
rmass_inverse_elastic_one(iglob) = rmass_inverse_elastic_one(iglob) &
+ wxgll(i)*wzgll(j)*rhol*jacobian(i,j,ispec) * (K_x_store(i,j,ispec_PML) * K_z_store(i,j,ispec_PML)&
+ (d_x_store(i,j,ispec_PML)*k_z_store(i,j,ispec_PML)+&
d_z_store(i,j,ispec_PML)*k_x_store(i,j,ispec_PML)) * deltat / 2.d0)
rmass_inverse_elastic_three(iglob) = rmass_inverse_elastic_one(iglob)
- elseif(region_CPML(ispec) == CPML_TOP .or. region_CPML(ispec) == CPML_BOTTOM) then
+ else if(region_CPML(ispec) == CPML_TOP .or. region_CPML(ispec) == CPML_BOTTOM) then
rmass_inverse_elastic_one(iglob) = rmass_inverse_elastic_one(iglob) &
+ wxgll(i)*wzgll(j)*rhol*jacobian(i,j,ispec) * (K_z_store(i,j,ispec_PML)&
+ d_z_store(i,j,ispec_PML)* deltat / 2.d0)
@@ -249,13 +249,13 @@
rmass_inverse_acoustic(iglob) = rmass_inverse_acoustic(iglob) &
+ wxgll(i)*wzgll(j)/ kappal*jacobian(i,j,ispec) * (K_x_store(i,j,ispec_PML)&
+ d_x_store(i,j,ispec_PML) * deltat / 2.d0)
- elseif (region_CPML(ispec) == CPML_TOP_LEFT .or. region_CPML(ispec) == CPML_TOP_RIGHT .or. &
+ else if (region_CPML(ispec) == CPML_TOP_LEFT .or. region_CPML(ispec) == CPML_TOP_RIGHT .or. &
region_CPML(ispec) == CPML_BOTTOM_LEFT .or. region_CPML(ispec) == CPML_BOTTOM_RIGHT) then
rmass_inverse_acoustic(iglob) = rmass_inverse_acoustic(iglob) &
+ wxgll(i)*wzgll(j)/ kappal*jacobian(i,j,ispec) * (K_x_store(i,j,ispec_PML) * K_z_store(i,j,ispec_PML)&
+ (d_x_store(i,j,ispec_PML)*k_z_store(i,j,ispec_PML)&
+d_z_store(i,j,ispec_PML)*k_x_store(i,j,ispec_PML)) * deltat / 2.d0)
- elseif(region_CPML(ispec) == CPML_TOP .or. region_CPML(ispec) == CPML_BOTTOM) then
+ else if(region_CPML(ispec) == CPML_TOP .or. region_CPML(ispec) == CPML_BOTTOM) then
rmass_inverse_acoustic(iglob) = rmass_inverse_acoustic(iglob) &
+ wxgll(i)*wzgll(j)/ kappal*jacobian(i,j,ispec) * (K_z_store(i,j,ispec_PML)&
+ d_z_store(i,j,ispec_PML)* deltat / 2.d0)
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/noise_tomography.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/noise_tomography.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/noise_tomography.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -234,7 +234,7 @@
close(55)
- elseif( time_function_type == 1) then
+ else if( time_function_type == 1) then
!Ricker (second derivative of a Gaussian) time function
do it = 1,NSTEP
t = it*deltat
@@ -243,7 +243,7 @@
enddo
- elseif( time_function_type == 2) then
+ else if( time_function_type == 2) then
!first derivative of a Gaussian time function
do it = 1,NSTEP
t = it*deltat
@@ -251,7 +251,7 @@
enddo
- elseif( time_function_type == 3) then
+ else if( time_function_type == 3) then
!Gaussian time function
do it = 1,NSTEP
t = it*deltat
@@ -259,7 +259,7 @@
enddo
- elseif( time_function_type == 4 ) then
+ else if( time_function_type == 4 ) then
!reproduce time function from Figure 2a of Tromp et al. 2010
do it = 1,NSTEP
t = it*deltat
@@ -430,7 +430,7 @@
recl=nglob*CUSTOM_REAL,action='write',iostat=ios)
if( ios /= 0) call exit_mpi('Error saving generating wavefield.')
- elseif (NOISE_TOMOGRAPHY == 2) then
+ else if (NOISE_TOMOGRAPHY == 2) then
open(unit=500,file='OUTPUT_FILES/NOISE_TOMOGRAPHY/phi',access='direct', &
recl=nglob*CUSTOM_REAL,action='write',iostat=ios)
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/paco_beyond_critical.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/paco_beyond_critical.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/paco_beyond_critical.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -80,13 +80,13 @@
delta_in_period=2.d0
do while(delta_in_period<1.5*abs(xmax-xmin)/cs_local)
delta_in_period=2.d0*delta_in_period
- end do
+ enddo
! test Deltat compatibility
DT=256.d0
do while(DT>deltat)
DT=DT/2.d0
- end do
+ enddo
if (abs(DT-deltat)>1.0d-13) then
print *, "you must take a deltat that is a power of two (power can be negative)"
print *, "for example you can take", DT
@@ -98,11 +98,11 @@
N=2
do while(N<2*NSTEP_global+1)
N=2.d0*N
- end do
+ enddo
do while(DT<(delta_in_period/N))
N=2.d0*N
- end do
+ enddo
print *,'N found to perform the frequency calculation:',N
print *,'number of discrete frequencies = ',N/2
@@ -141,7 +141,7 @@
allocate(local_pt(npt))
do inode=1,npt
local_pt(inode)=inode
- end do
+ enddo
NSTEP_local=1
else if(FLAG==1) then
print *,"calculation of every time step on the left absorbing boundary"
@@ -340,7 +340,7 @@
deallocate(Field_Tx)
deallocate(Field_Tz)
- end do
+ enddo
end subroutine paco_beyond_critical
@@ -420,13 +420,13 @@
FA=-UI*SQRT(-A)
else
FA=SQRT(A)+ZER
- end IF
+ endif
IF (CB<1.0d0) then
FB=-UI*SQRT(-B)
else
FB=CMPLX(SQRT(B),0.0d0)
- end IF
+ endif
END SUBROUTINE FAFB
@@ -463,7 +463,7 @@
A2=(-1.0d0+ZER)/AQB
B2=ZER
RETURN
- end IF
+ endif
CA=1.0d0/SIN(GP)
CB=CA/BEALF
@@ -497,7 +497,7 @@
A2=ZER
B2=(-1.0d0+ZER)/AKB
return
- end IF
+ endif
CB=1.0d0/SIN(GS)
CA=CB*BEALF
@@ -576,13 +576,13 @@
F1=F1**U3
else
F1=-(-F1)**U3
- end IF
+ endif
F2=-SQRT(FIND)-Q/2.0d0
IF (F2>0.0d0) then
F2=F2**U3
else
F2=-(-F2)**U3
- end IF
+ endif
FACT=F1+F2+8.0d0/3.0d0
CRB=SQRT(FACT)
else
@@ -592,12 +592,12 @@
F1=COS((PI-ACOS(F1))/3.0d0)
else
F1=COS(ACOS(F1)/3.0d0)
- end IF
+ endif
F2=-P/3.0d0
F2=SQRT(F2)
F12=-2.0d0*F1*F2+8.0d0/3.0d0
CRB=SQRT(F12)
- end IF
+ endif
END FUNCTION CRB
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/paco_convolve_fft.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/paco_convolve_fft.f90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/paco_convolve_fft.f90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -104,7 +104,7 @@
! coefficients to take time steps needed (t=i*deltat+1: one step on two starting at 1)
mult=2
delay=1
- end if
+ endif
do J=1,NSTEP
CY(mult*J+delay)=CY(mult*J+delay)/RAIZ/dt
@@ -201,14 +201,14 @@
CTEMP=CX(J)*SC
CX(J)=CX(I)*SC
CX(I)=CTEMP
- end IF
+ endif
M=LX/2
do while (M>=1 .and. M<J)
J=J-M
M=M/2
- end do
+ enddo
J=J+M
- end DO
+ enddo
L=1
do while(L<LX)
@@ -220,11 +220,11 @@
CTEMP=CW*CX(I+L)
CX(I+L)=CX(I)-CTEMP
CX(I)=CX(I)+CTEMP
- end DO
- end DO
+ enddo
+ enddo
L=ISTEP
- end do
+ enddo
END SUBROUTINE fourier_transform
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/pml_init.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/pml_init.F90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/pml_init.F90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -111,7 +111,7 @@
k=1
do while(k<=ncorner .and. icorner_iglob(k)/=iglob)
k=k+1
- end do
+ enddo
ncorner=ncorner+1
icorner_iglob(ncorner) = iglob
@@ -120,7 +120,7 @@
endif ! we are on the good absorbing boundary
enddo
- end if
+ endif
!find elements stuck to boundary elements to define the 4 elements PML thickness
!we take 4 elements for the PML thickness
@@ -134,12 +134,12 @@
do k=1,ncorner
if (iglob==icorner_iglob(k)) then
which_PML_elem(ibound,ispec) = .true.
- end if
- end do
- end do
- end do
- end if
- end do
+ endif
+ enddo
+ enddo
+ enddo
+ endif
+ enddo
! list every corner of each PML element detected
ncorner=0
@@ -154,16 +154,16 @@
k=1
do while(k<=ncorner .and. icorner_iglob(k)/=iglob)
k=k+1
- end do
+ enddo
ncorner=ncorner+1
icorner_iglob(ncorner) = iglob
- end do
- end do
+ enddo
+ enddo
nspec_PML=nspec_PML+1
- end if
- end do
+ endif
+ enddo
- end do !end nelem_thickness loop
+ enddo !end nelem_thickness loop
if(SIMULATION_TYPE == 3 .or. (SIMULATION_TYPE == 1 .and. SAVE_FORWARD))then
@@ -176,13 +176,13 @@
do k=1,ncorner
if (iglob==icorner_iglob(k)) then
PML_interior_interface(ibound,ispec) = .true.
- end if
- end do
- end do
- end do
- end if
- end do
- end do !end nelem_thickness loop
+ endif
+ enddo
+ enddo
+ enddo
+ endif
+ enddo
+ enddo !end nelem_thickness loop
endif !end of SIMULATION_TYPE == 3
@@ -197,34 +197,34 @@
.and. (.not. which_PML_elem(IRIGHT,ispec)) &
.and. (.not. which_PML_elem(ILEFT,ispec)))then
nglob_interface = nglob_interface + 5
- elseif(PML_interior_interface(ITOP,ispec) &
+ else if(PML_interior_interface(ITOP,ispec) &
.and. (.not. PML_interior_interface(IRIGHT,ispec)) &
.and. (.not. PML_interior_interface(ILEFT,ispec)) &
.and. (.not. which_PML_elem(IRIGHT,ispec)) &
.and. (.not. which_PML_elem(ILEFT,ispec)))then
nglob_interface = nglob_interface + 5
- elseif(PML_interior_interface(IRIGHT,ispec) &
+ else if(PML_interior_interface(IRIGHT,ispec) &
.and. (.not. PML_interior_interface(IBOTTOM,ispec)) &
.and. (.not. PML_interior_interface(ITOP,ispec)) &
.and. (.not. which_PML_elem(IBOTTOM,ispec)) &
.and. (.not. which_PML_elem(ITOP,ispec)))then
nglob_interface = nglob_interface + 5
- elseif(PML_interior_interface(ILEFT,ispec) &
+ else if(PML_interior_interface(ILEFT,ispec) &
.and. (.not. PML_interior_interface(IBOTTOM,ispec)) &
.and. (.not. PML_interior_interface(ITOP,ispec)) &
.and. (.not. which_PML_elem(IBOTTOM,ispec)) &
.and. (.not. which_PML_elem(ITOP,ispec)))then
nglob_interface = nglob_interface + 5
- elseif(PML_interior_interface(ILEFT,ispec) &
+ else if(PML_interior_interface(ILEFT,ispec) &
.and. PML_interior_interface(IBOTTOM,ispec))then
nglob_interface = nglob_interface + 10
- elseif(PML_interior_interface(IRIGHT,ispec) &
+ else if(PML_interior_interface(IRIGHT,ispec) &
.and. PML_interior_interface(IBOTTOM,ispec))then
nglob_interface = nglob_interface + 10
- elseif(PML_interior_interface(ILEFT,ispec) &
+ else if(PML_interior_interface(ILEFT,ispec) &
.and. PML_interior_interface(ITOP,ispec))then
nglob_interface = nglob_interface + 10
- elseif(PML_interior_interface(IRIGHT,ispec) &
+ else if(PML_interior_interface(IRIGHT,ispec) &
.and. PML_interior_interface(ITOP,ispec))then
nglob_interface = nglob_interface + 10
endif
@@ -302,7 +302,7 @@
if (is_PML(ispec)) then
nspec_PML=nspec_PML+1
spec_to_PML(ispec)=nspec_PML
- end if
+ endif
enddo
endif !end of detection of element inside PML layer for inner mesher
@@ -396,7 +396,7 @@
point_interface(nglob_interface + 4) = ibool(4,1,ispec)
point_interface(nglob_interface + 5) = ibool(5,1,ispec)
nglob_interface = nglob_interface + 5
- elseif(PML_interior_interface(ITOP,ispec) &
+ else if(PML_interior_interface(ITOP,ispec) &
.and. (.not. PML_interior_interface(IRIGHT,ispec)) &
.and. (.not. PML_interior_interface(ILEFT,ispec)) &
.and. (.not. which_PML_elem(IRIGHT,ispec)) &
@@ -407,7 +407,7 @@
point_interface(nglob_interface + 4) = ibool(4,NGLLZ,ispec)
point_interface(nglob_interface + 5) = ibool(5,NGLLZ,ispec)
nglob_interface = nglob_interface + 5
- elseif(PML_interior_interface(IRIGHT,ispec) &
+ else if(PML_interior_interface(IRIGHT,ispec) &
.and. (.not. PML_interior_interface(IBOTTOM,ispec)) &
.and. (.not. PML_interior_interface(ITOP,ispec)) &
.and. (.not. which_PML_elem(IBOTTOM,ispec)) &
@@ -418,7 +418,7 @@
point_interface(nglob_interface + 4) = ibool(NGLLX,4,ispec)
point_interface(nglob_interface + 5) = ibool(NGLLX,5,ispec)
nglob_interface = nglob_interface + 5
- elseif(PML_interior_interface(ILEFT,ispec) &
+ else if(PML_interior_interface(ILEFT,ispec) &
.and. (.not. PML_interior_interface(IBOTTOM,ispec)) &
.and. (.not. PML_interior_interface(ITOP,ispec)) &
.and. (.not. which_PML_elem(IBOTTOM,ispec)) &
@@ -429,7 +429,7 @@
point_interface(nglob_interface + 4) = ibool(1,4,ispec)
point_interface(nglob_interface + 5) = ibool(1,5,ispec)
nglob_interface = nglob_interface + 5
- elseif(PML_interior_interface(ILEFT,ispec) &
+ else if(PML_interior_interface(ILEFT,ispec) &
.and. PML_interior_interface(IBOTTOM,ispec))then
point_interface(nglob_interface + 1) = ibool(1,1,ispec)
point_interface(nglob_interface + 2) = ibool(1,2,ispec)
@@ -442,7 +442,7 @@
point_interface(nglob_interface + 9) = ibool(4,1,ispec)
point_interface(nglob_interface + 10)= ibool(5,1,ispec)
nglob_interface = nglob_interface + 10
- elseif(PML_interior_interface(IRIGHT,ispec) &
+ else if(PML_interior_interface(IRIGHT,ispec) &
.and. PML_interior_interface(IBOTTOM,ispec))then
point_interface(nglob_interface + 1) = ibool(NGLLX,1,ispec)
point_interface(nglob_interface + 2) = ibool(NGLLX,2,ispec)
@@ -455,7 +455,7 @@
point_interface(nglob_interface + 9) = ibool(4,1,ispec)
point_interface(nglob_interface + 10)= ibool(5,1,ispec)
nglob_interface = nglob_interface + 10
- elseif(PML_interior_interface(ILEFT,ispec) &
+ else if(PML_interior_interface(ILEFT,ispec) &
.and. PML_interior_interface(ITOP,ispec))then
point_interface(nglob_interface + 1) = ibool(1,1,ispec)
point_interface(nglob_interface + 2) = ibool(1,2,ispec)
@@ -468,7 +468,7 @@
point_interface(nglob_interface + 9) = ibool(4,NGLLZ,ispec)
point_interface(nglob_interface + 10)= ibool(5,NGLLZ,ispec)
nglob_interface = nglob_interface + 10
- elseif(PML_interior_interface(IRIGHT,ispec) &
+ else if(PML_interior_interface(IRIGHT,ispec) &
.and. PML_interior_interface(ITOP,ispec))then
point_interface(nglob_interface + 1) = ibool(NGLLX,1,ispec)
point_interface(nglob_interface + 2) = ibool(NGLLX,2,ispec)
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/prepare_assemble_MPI.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/prepare_assemble_MPI.F90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/prepare_assemble_MPI.F90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -132,7 +132,7 @@
! element control node ids
do k = 1, ngnod
n(k) = knods(k,ispec)
- end do
+ enddo
! common node ids
e1 = my_interfaces(3,ispec_interface,num_interface)
e2 = my_interfaces(4,ispec_interface,num_interface)
@@ -151,26 +151,26 @@
mask_ibool_elastic(iglob) = .true.
nglob_interface_elastic = nglob_interface_elastic + 1
ibool_interfaces_elastic(nglob_interface_elastic,num_interface) = iglob
- end if
+ endif
else if ( poroelastic(ispec) ) then
! poroelastic element
if(.not. mask_ibool_poroelastic(iglob)) then
mask_ibool_poroelastic(iglob) = .true.
nglob_interface_poroelastic = nglob_interface_poroelastic + 1
ibool_interfaces_poroelastic(nglob_interface_poroelastic,num_interface) = iglob
- end if
+ endif
else
! acoustic element
if(.not. mask_ibool_acoustic(iglob)) then
mask_ibool_acoustic(iglob) = .true.
nglob_interface_acoustic = nglob_interface_acoustic + 1
ibool_interfaces_acoustic(nglob_interface_acoustic,num_interface) = iglob
- end if
- end if
- end do
- end do
+ endif
+ endif
+ enddo
+ enddo
- end do
+ enddo
! stores counters for interface points
nibool_interfaces_acoustic(num_interface) = nglob_interface_acoustic
@@ -191,7 +191,7 @@
enddo
enddo
- end do
+ enddo
! sets number of interfaces for each material domain
ninterface_acoustic = 0
@@ -204,18 +204,18 @@
if ( nibool_interfaces_acoustic(num_interface) > 0 ) then
ninterface_acoustic = ninterface_acoustic + 1
inum_interfaces_acoustic(ninterface_acoustic) = num_interface
- end if
+ endif
! elastic
if ( nibool_interfaces_elastic(num_interface) > 0 ) then
ninterface_elastic = ninterface_elastic + 1
inum_interfaces_elastic(ninterface_elastic) = num_interface
- end if
+ endif
! poroelastic
if ( nibool_interfaces_poroelastic(num_interface) > 0 ) then
ninterface_poroelastic = ninterface_poroelastic + 1
inum_interfaces_poroelastic(ninterface_poroelastic) = num_interface
- end if
- end do
+ endif
+ enddo
end subroutine prepare_assemble_MPI
@@ -246,25 +246,25 @@
ixmax = 1
izmin = 1
izmax = 1
- end if
+ endif
if ( e1 == n(2) ) then
ixmin = NGLLX
ixmax = NGLLX
izmin = 1
izmax = 1
- end if
+ endif
if ( e1 == n(3) ) then
ixmin = NGLLX
ixmax = NGLLX
izmin = NGLLZ
izmax = NGLLZ
- end if
+ endif
if ( e1 == n(4) ) then
ixmin = 1
ixmax = 1
izmin = NGLLZ
izmax = NGLLZ
- end if
+ endif
sens = 1
else if( itype == 2 ) then
@@ -279,13 +279,13 @@
ixmax = NGLLX
izmax = 1
sens = 1
- end if
+ endif
if ( e2 == n(4) ) then
ixmax = 1
izmax = NGLLZ
sens = 1
- end if
- end if
+ endif
+ endif
if ( e1 == n(2) ) then
ixmin = NGLLX
izmin = 1
@@ -293,13 +293,13 @@
ixmax = NGLLX
izmax = NGLLZ
sens = 1
- end if
+ endif
if ( e2 == n(1) ) then
ixmax = 1
izmax = 1
sens = -1
- end if
- end if
+ endif
+ endif
if ( e1 == n(3) ) then
ixmin = NGLLX
izmin = NGLLZ
@@ -307,13 +307,13 @@
ixmax = 1
izmax = NGLLZ
sens = -1
- end if
+ endif
if ( e2 == n(2) ) then
ixmax = NGLLX
izmax = 1
sens = -1
- end if
- end if
+ endif
+ endif
if ( e1 == n(4) ) then
ixmin = 1
izmin = NGLLZ
@@ -321,19 +321,19 @@
ixmax = 1
izmax = 1
sens = -1
- end if
+ endif
if ( e2 == n(3) ) then
ixmax = NGLLX
izmax = NGLLZ
sens = 1
- end if
- end if
+ endif
+ endif
else
call exit_MPI('ERROR get_edge unknown type')
- end if
+ endif
end subroutine get_edge
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/read_databases.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/read_databases.F90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/read_databases.F90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -252,7 +252,7 @@
read(IIN,"(a80)") datlin
read(IIN,*) save_binary_seismograms_single,save_binary_seismograms_double
- read(IIN,"(a80)") datlin
+ read(IIN,"(a80)") datlin
read(IIN,*) save_ASCII_kernels
read(IIN,"(a80)") datlin
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -1176,9 +1176,9 @@
if(time_stepping_scheme == 1)then
stage_time_scheme=1
- elseif(time_stepping_scheme == 2)then
+ else if(time_stepping_scheme == 2)then
stage_time_scheme=Nstages
- elseif(time_stepping_scheme == 3)then
+ else if(time_stepping_scheme == 3)then
stage_time_scheme=4
endif
@@ -4655,10 +4655,10 @@
close(504)
endif
- elseif (NOISE_TOMOGRAPHY == 2) then
+ else if (NOISE_TOMOGRAPHY == 2) then
call create_mask_noise(nglob,coord,mask_noise)
- elseif (NOISE_TOMOGRAPHY == 3) then
+ else if (NOISE_TOMOGRAPHY == 3) then
if (output_wavefields_noise) then
call create_mask_noise(nglob,coord,mask_noise)
@@ -5098,7 +5098,7 @@
rx_viscous(i,j,ispec) = rx_viscous_initial_rk(i,j,ispec) + weight_rk * rx_viscous_force_RK(i,j,ispec,i_stage)
- elseif(i_stage==4)then
+ else if(i_stage==4)then
rx_viscous(i,j,ispec) = rx_viscous_initial_rk(i,j,ispec) + 1.0d0 / 6.0d0 * &
(rx_viscous_force_RK(i,j,ispec,i_stage) + 2.0d0 * rx_viscous_force_RK(i,j,ispec,i_stage) + &
@@ -5123,7 +5123,7 @@
rz_viscous(i,j,ispec) = rz_viscous_initial_rk(i,j,ispec) + weight_rk * rz_viscous_force_RK(i,j,ispec,i_stage)
- elseif(i_stage==4)then
+ else if(i_stage==4)then
rz_viscous(i,j,ispec) = rz_viscous_initial_rk(i,j,ispec) + 1.0d0 / 6.0d0 * &
(rz_viscous_force_RK(i,j,ispec,i_stage) + 2.0d0 * rz_viscous_force_RK(i,j,ispec,i_stage) + &
@@ -5382,21 +5382,21 @@
nx = - zxi / jacobian1D
nz = + xxi / jacobian1D
weight = jacobian1D * wxgll(i)
- elseif(iedge_acoustic == IBOTTOM)then
+ else if(iedge_acoustic == IBOTTOM)then
xxi = + gammaz(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
zxi = - gammax(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
jacobian1D = sqrt(xxi**2 + zxi**2)
nx = + zxi / jacobian1D
nz = - xxi / jacobian1D
weight = jacobian1D * wxgll(i)
- elseif(iedge_acoustic ==ILEFT)then
+ else if(iedge_acoustic ==ILEFT)then
xgamma = - xiz(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
zgamma = + xix(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
jacobian1D = sqrt(xgamma**2 + zgamma**2)
nx = - zgamma / jacobian1D
nz = + xgamma / jacobian1D
weight = jacobian1D * wzgll(j)
- elseif(iedge_acoustic ==IRIGHT)then
+ else if(iedge_acoustic ==IRIGHT)then
xgamma = - xiz(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
zgamma = + xix(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
jacobian1D = sqrt(xgamma**2 + zgamma**2)
@@ -5486,21 +5486,21 @@
nx = - zxi / jacobian1D
nz = + xxi / jacobian1D
weight = jacobian1D * wxgll(i)
- elseif(iedge_acoustic == IBOTTOM)then
+ else if(iedge_acoustic == IBOTTOM)then
xxi = + gammaz(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
zxi = - gammax(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
jacobian1D = sqrt(xxi**2 + zxi**2)
nx = + zxi / jacobian1D
nz = - xxi / jacobian1D
weight = jacobian1D * wxgll(i)
- elseif(iedge_acoustic ==ILEFT)then
+ else if(iedge_acoustic ==ILEFT)then
xgamma = - xiz(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
zgamma = + xix(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
jacobian1D = sqrt(xgamma**2 + zgamma**2)
nx = - zgamma / jacobian1D
nz = + xgamma / jacobian1D
weight = jacobian1D * wzgll(j)
- elseif(iedge_acoustic ==IRIGHT)then
+ else if(iedge_acoustic ==IRIGHT)then
xgamma = - xiz(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
zgamma = + xix(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
jacobian1D = sqrt(xgamma**2 + zgamma**2)
@@ -5703,7 +5703,7 @@
potential_dot_acoustic(:) = potential_dot_acoustic_init_rk(:) + weight_rk * potential_dot_dot_acoustic_rk(:,i_stage)
potential_acoustic(:) = potential_acoustic_init_rk(:) + weight_rk * potential_dot_acoustic_rk(:,i_stage)
- elseif(i_stage==4)then
+ else if(i_stage==4)then
!! DK DK this should be vectorized
potential_dot_acoustic(:) = potential_dot_acoustic_init_rk(:) + 1.0d0 / 6.0d0 * &
@@ -6021,21 +6021,21 @@
nx = - zxi / jacobian1D
nz = + xxi / jacobian1D
weight = jacobian1D * wxgll(i)
- elseif(iedge_acoustic == IBOTTOM)then
+ else if(iedge_acoustic == IBOTTOM)then
xxi = + gammaz(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
zxi = - gammax(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
jacobian1D = sqrt(xxi**2 + zxi**2)
nx = + zxi / jacobian1D
nz = - xxi / jacobian1D
weight = jacobian1D * wxgll(i)
- elseif(iedge_acoustic ==ILEFT)then
+ else if(iedge_acoustic ==ILEFT)then
xgamma = - xiz(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
zgamma = + xix(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
jacobian1D = sqrt(xgamma**2 + zgamma**2)
nx = - zgamma / jacobian1D
nz = + xgamma / jacobian1D
weight = jacobian1D * wzgll(j)
- elseif(iedge_acoustic ==IRIGHT)then
+ else if(iedge_acoustic ==IRIGHT)then
xgamma = - xiz(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
zgamma = + xix(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
jacobian1D = sqrt(xgamma**2 + zgamma**2)
@@ -6309,21 +6309,21 @@
nx = - zxi / jacobian1D
nz = + xxi / jacobian1D
weight = jacobian1D * wxgll(i)
- elseif(iedge_poroelastic == IBOTTOM)then
+ else if(iedge_poroelastic == IBOTTOM)then
xxi = + gammaz(i,j,ispec_poroelastic) * jacobian(i,j,ispec_poroelastic)
zxi = - gammax(i,j,ispec_poroelastic) * jacobian(i,j,ispec_poroelastic)
jacobian1D = sqrt(xxi**2 + zxi**2)
nx = + zxi / jacobian1D
nz = - xxi / jacobian1D
weight = jacobian1D * wxgll(i)
- elseif(iedge_poroelastic ==ILEFT)then
+ else if(iedge_poroelastic ==ILEFT)then
xgamma = - xiz(i,j,ispec_poroelastic) * jacobian(i,j,ispec_poroelastic)
zgamma = + xix(i,j,ispec_poroelastic) * jacobian(i,j,ispec_poroelastic)
jacobian1D = sqrt(xgamma**2 + zgamma**2)
nx = - zgamma / jacobian1D
nz = + xgamma / jacobian1D
weight = jacobian1D * wzgll(j)
- elseif(iedge_poroelastic ==IRIGHT)then
+ else if(iedge_poroelastic ==IRIGHT)then
xgamma = - xiz(i,j,ispec_poroelastic) * jacobian(i,j,ispec_poroelastic)
zgamma = + xix(i,j,ispec_poroelastic) * jacobian(i,j,ispec_poroelastic)
jacobian1D = sqrt(xgamma**2 + zgamma**2)
@@ -6429,12 +6429,12 @@
call add_point_source_noise(p_sv,it,NSTEP,nglob,ibool,ispec_noise, &
accel_elastic,angle_noise,source_array_noise)
- elseif (NOISE_TOMOGRAPHY == 2) then
+ else if (NOISE_TOMOGRAPHY == 2) then
call add_surface_movie_noise(p_sv,NOISE_TOMOGRAPHY,it,NSTEP,nspec,nglob,ibool,accel_elastic, &
surface_movie_x_noise,surface_movie_y_noise, &
surface_movie_z_noise,mask_noise,jacobian,wxgll,wzgll)
- elseif (NOISE_TOMOGRAPHY == 3) then
+ else if (NOISE_TOMOGRAPHY == 3) then
if (.not. save_everywhere) then
call add_surface_movie_noise(p_sv,NOISE_TOMOGRAPHY,it,NSTEP,nspec,nglob,ibool,b_accel_elastic, &
surface_movie_x_noise,surface_movie_y_noise, &
@@ -6558,7 +6558,7 @@
displ_elastic(2,:) = displ_elastic_initial_rk(2,:) + weight_rk * veloc_elastic_rk(2,:,i_stage)
displ_elastic(3,:) = displ_elastic_initial_rk(3,:) + weight_rk * veloc_elastic_rk(3,:,i_stage)
- elseif(i_stage==4)then
+ else if(i_stage==4)then
!! DK DK this should be vectorized
veloc_elastic(1,:) = veloc_elastic_initial_rk(1,:) + 1.0d0 / 6.0d0 * &
@@ -6780,21 +6780,21 @@
nx = - zxi / jacobian1D
nz = + xxi / jacobian1D
weight = jacobian1D * wxgll(i)
- elseif(iedge_acoustic == IBOTTOM)then
+ else if(iedge_acoustic == IBOTTOM)then
xxi = + gammaz(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
zxi = - gammax(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
jacobian1D = sqrt(xxi**2 + zxi**2)
nx = + zxi / jacobian1D
nz = - xxi / jacobian1D
weight = jacobian1D * wxgll(i)
- elseif(iedge_acoustic ==ILEFT)then
+ else if(iedge_acoustic ==ILEFT)then
xgamma = - xiz(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
zgamma = + xix(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
jacobian1D = sqrt(xgamma**2 + zgamma**2)
nx = - zgamma / jacobian1D
nz = + xgamma / jacobian1D
weight = jacobian1D * wzgll(j)
- elseif(iedge_acoustic ==IRIGHT)then
+ else if(iedge_acoustic ==IRIGHT)then
xgamma = - xiz(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
zgamma = + xix(i,j,ispec_acoustic) * jacobian(i,j,ispec_acoustic)
jacobian1D = sqrt(xgamma**2 + zgamma**2)
@@ -7090,21 +7090,21 @@
nx = - zxi / jacobian1D
nz = + xxi / jacobian1D
weight = jacobian1D * wxgll(i)
- elseif(iedge_poroelastic == IBOTTOM)then
+ else if(iedge_poroelastic == IBOTTOM)then
xxi = + gammaz(i,j,ispec_poroelastic) * jacobian(i,j,ispec_poroelastic)
zxi = - gammax(i,j,ispec_poroelastic) * jacobian(i,j,ispec_poroelastic)
jacobian1D = sqrt(xxi**2 + zxi**2)
nx = + zxi / jacobian1D
nz = - xxi / jacobian1D
weight = jacobian1D * wxgll(i)
- elseif(iedge_poroelastic ==ILEFT)then
+ else if(iedge_poroelastic ==ILEFT)then
xgamma = - xiz(i,j,ispec_poroelastic) * jacobian(i,j,ispec_poroelastic)
zgamma = + xix(i,j,ispec_poroelastic) * jacobian(i,j,ispec_poroelastic)
jacobian1D = sqrt(xgamma**2 + zgamma**2)
nx = - zgamma / jacobian1D
nz = + xgamma / jacobian1D
weight = jacobian1D * wzgll(j)
- elseif(iedge_poroelastic ==IRIGHT)then
+ else if(iedge_poroelastic ==IRIGHT)then
xgamma = - xiz(i,j,ispec_poroelastic) * jacobian(i,j,ispec_poroelastic)
zgamma = + xix(i,j,ispec_poroelastic) * jacobian(i,j,ispec_poroelastic)
jacobian1D = sqrt(xgamma**2 + zgamma**2)
@@ -7324,7 +7324,7 @@
displw_poroelastic(2,:) = displw_poroelastic_initial_rk(2,:) + weight_rk * velocw_poroelastic_rk(2,:,i_stage)
- elseif(i_stage==4)then
+ else if(i_stage==4)then
velocs_poroelastic(1,:) = velocs_poroelastic_initial_rk(1,:) + 1.0d0 / 6.0d0 * &
(accels_poroelastic_rk(1,:,1) + 2.0d0 * accels_poroelastic_rk(1,:,2) + &
@@ -7526,7 +7526,7 @@
! displ_elastic(3,iglob) = displ_elastic_initial_rk(3,iglob) - weight_rk * veloc_elastic_rk(3,iglob,i_stage)
-! elseif(i_stage==4)then
+! else if(i_stage==4)then
! veloc_elastic(1,iglob) = veloc_elastic_initial_rk(1,iglob) - 1.0d0 / 6.0d0 * &
! (accel_elastic_rk(1,iglob,1) + 2.0d0 * accel_elastic_rk(1,iglob,2) + &
@@ -7568,7 +7568,7 @@
! displs_poroelastic(2,iglob) = displs_poroelastic_initial_rk(2,iglob) - weight_rk * velocs_poroelastic_rk(2,iglob,i_stage)
-! elseif(i_stage==4)then
+! else if(i_stage==4)then
! velocs_poroelastic(1,iglob) = velocs_poroelastic_initial_rk(1,iglob) - 1.0d0 / 6.0d0 * &
! (accels_poroelastic_rk(1,iglob,1) + 2.0d0 * accels_poroelastic_rk(1,iglob,2) + &
@@ -7623,7 +7623,7 @@
! displ_elastic(3,iglob) = displ_elastic_initial_rk(3,iglob) + weight_rk * veloc_elastic_rk(3,iglob,i_stage)
- ! elseif(i_stage==4)then
+ ! else if(i_stage==4)then
! veloc_elastic(1,iglob) = veloc_elastic_initial_rk(1,iglob) + 1.0d0 / 6.0d0 * &
! (accel_elastic_rk(1,iglob,1) + 2.0d0 * accel_elastic_rk(1,iglob,2) + &
@@ -7662,7 +7662,7 @@
! displs_poroelastic(2,iglob) = displs_poroelastic_initial_rk(2,iglob) + weight_rk * velocs_poroelastic_rk(2,iglob,i_stage)
- ! elseif(i_stage==4)then
+ ! else if(i_stage==4)then
! velocs_poroelastic(1,iglob) = velocs_poroelastic_initial_rk(1,iglob) + 1.0d0 / 6.0d0 * &
! (accels_poroelastic_rk(1,iglob,1) + 2.0d0 * accels_poroelastic_rk(1,iglob,2) + &
@@ -7804,10 +7804,10 @@
if ( NOISE_TOMOGRAPHY == 1 ) then
call save_surface_movie_noise(NOISE_TOMOGRAPHY,p_sv,it,NSTEP,nglob,displ_elastic)
- elseif ( NOISE_TOMOGRAPHY == 2 .and. save_everywhere ) then
+ else if ( NOISE_TOMOGRAPHY == 2 .and. save_everywhere ) then
call save_surface_movie_noise(NOISE_TOMOGRAPHY,p_sv,it,NSTEP,nglob,displ_elastic)
- elseif ( NOISE_TOMOGRAPHY == 3 .and. save_everywhere ) then
+ else if ( NOISE_TOMOGRAPHY == 3 .and. save_everywhere ) then
if (it==1) &
open(unit=500,file='OUTPUT_FILES/NOISE_TOMOGRAPHY/phi',access='direct', &
recl=nglob*CUSTOM_REAL,action='write',iostat=ios)
@@ -7996,7 +7996,7 @@
if(poroelastic(ispec)) then
dxd = displs_poroelastic(1,iglob)
dzd = displs_poroelastic(2,iglob)
- elseif(elastic(ispec)) then
+ else if(elastic(ispec)) then
dxd = displ_elastic(1,iglob)
dyd = displ_elastic(2,iglob)
dzd = displ_elastic(3,iglob)
@@ -8007,7 +8007,7 @@
if(poroelastic(ispec)) then
dxd = velocs_poroelastic(1,iglob)
dzd = velocs_poroelastic(2,iglob)
- elseif(elastic(ispec)) then
+ else if(elastic(ispec)) then
dxd = veloc_elastic(1,iglob)
dyd = veloc_elastic(2,iglob)
dzd = veloc_elastic(3,iglob)
@@ -8018,7 +8018,7 @@
if(poroelastic(ispec)) then
dxd = accels_poroelastic(1,iglob)
dzd = accels_poroelastic(2,iglob)
- elseif(elastic(ispec)) then
+ else if(elastic(ispec)) then
dxd = accel_elastic(1,iglob)
dyd = accel_elastic(2,iglob)
dzd = accel_elastic(3,iglob)
@@ -8029,7 +8029,7 @@
if(poroelastic(ispec)) then
dxd = displs_poroelastic(1,iglob)
dzd = displs_poroelastic(2,iglob)
- elseif(elastic(ispec)) then
+ else if(elastic(ispec)) then
dxd = displ_elastic(1,iglob)
dzd = displ_elastic(2,iglob)
endif
Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/write_seismograms.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/write_seismograms.F90 2013-04-13 22:18:57 UTC (rev 21864)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/write_seismograms.F90 2013-04-13 22:21:10 UTC (rev 21865)
@@ -178,7 +178,7 @@
if(save_binary_seismograms_single) then
if(seismotype == 4 .or. seismotype == 6) then
open(unit=12,file='OUTPUT_FILES/pressure_file_single.bin',status='unknown',access='direct',recl=4)
- elseif(.not.p_sv) then
+ else if(.not.p_sv) then
open(unit=12,file='OUTPUT_FILES/Uy_file_single.bin',status='unknown',access='direct',recl=4)
else
open(unit=12,file='OUTPUT_FILES/Ux_file_single.bin',status='unknown',access='direct',recl=4)
@@ -188,7 +188,7 @@
if(save_binary_seismograms_double) then
if(seismotype == 4 .or. seismotype == 6) then
open(unit=13,file='OUTPUT_FILES/pressure_file_double.bin',status='unknown',access='direct',recl=8)
- elseif(.not.p_sv) then
+ else if(.not.p_sv) then
open(unit=13,file='OUTPUT_FILES/Uz_file_double.bin',status='unknown',access='direct',recl=8)
else
open(unit=13,file='OUTPUT_FILES/Ux_file_double.bin',status='unknown',access='direct',recl=8)
More information about the CIG-COMMITS
mailing list