[cig-commits] [commit] devel: fixed some typos found by Alexis Bottero (df613b7)
cig_noreply at geodynamics.org
cig_noreply at geodynamics.org
Wed Feb 19 08:35:40 PST 2014
Repository : ssh://geoshell/specfem2d
On branch : devel
Link : https://github.com/geodynamics/specfem2d/compare/bb0020bb55b89d2744838117bdbf3a606823fcc2...7c3de41c554ef886df9132045f834811c2b00f0e
>---------------------------------------------------------------
commit df613b7839c6fdf205f502261173ce67d51fdc49
Author: Dimitri Komatitsch <komatitsch at lma.cnrs-mrs.fr>
Date: Wed Feb 19 17:32:02 2014 +0100
fixed some typos found by Alexis Bottero
>---------------------------------------------------------------
df613b7839c6fdf205f502261173ce67d51fdc49
src/meshfem2D/part_unstruct.F90 | 2 +-
src/specfem2D/compute_coupling_acoustic_el.f90 | 1 +
src/specfem2D/compute_forces_acoustic.f90 | 41 +++++++++++------------
src/specfem2D/compute_forces_viscoelastic.F90 | 35 ++++++++++----------
src/specfem2D/compute_vector_field.f90 | 4 +--
src/specfem2D/construct_acoustic_surface.f90 | 32 +++++++++---------
src/specfem2D/invert_mass_matrix.F90 | 4 +--
src/specfem2D/read_databases.F90 | 8 ++---
src/specfem2D/recompute_jacobian.f90 | 2 +-
src/specfem2D/specfem2D.F90 | 45 +++++++++++++++-----------
10 files changed, 90 insertions(+), 84 deletions(-)
diff --git a/src/meshfem2D/part_unstruct.F90 b/src/meshfem2D/part_unstruct.F90
index 986e993..a77e73f 100644
--- a/src/meshfem2D/part_unstruct.F90
+++ b/src/meshfem2D/part_unstruct.F90
@@ -373,7 +373,7 @@ contains
! 'abs_surface' contains 1/ element number, 2/ number of nodes that form the absorbing edge
! (which currently must always be equal to two, see comment below),
! 3/ first node on the abs surface, 4/ second node on the abs surface
- ! 5/ 1=IBOTTOME, 2=IRIGHT, 3=ITOP, 4=ILEFT
+ ! 5/ 1=IBOTTOM, 2=IRIGHT, 3=ITOP, 4=ILEFT
!-----------------------------------------------
subroutine read_abs_surface(filename, remove_min_to_start_at_zero)
diff --git a/src/specfem2D/compute_coupling_acoustic_el.f90 b/src/specfem2D/compute_coupling_acoustic_el.f90
index 5a3e429..edfe976 100644
--- a/src/specfem2D/compute_coupling_acoustic_el.f90
+++ b/src/specfem2D/compute_coupling_acoustic_el.f90
@@ -84,6 +84,7 @@
! loop on all the coupling edges
+
do inum = 1,num_fluid_solid_edges
! get the edge of the acoustic element
diff --git a/src/specfem2D/compute_forces_acoustic.f90 b/src/specfem2D/compute_forces_acoustic.f90
index ee9f2ff..aad4e08 100644
--- a/src/specfem2D/compute_forces_acoustic.f90
+++ b/src/specfem2D/compute_forces_acoustic.f90
@@ -110,6 +110,26 @@
real(kind=CUSTOM_REAL), dimension(NGLLX,nspec_top,NSTEP) :: b_absorb_acoustic_top
real(kind=CUSTOM_REAL), dimension(NGLLX,nspec_bottom,NSTEP) :: b_absorb_acoustic_bottom
+! CPML coefficients and memory variables
+ integer :: nspec_PML,ispec_PML
+ integer, dimension(nspec) :: region_CPML
+ logical, dimension(nspec) :: is_PML
+ integer, dimension(nspec) :: spec_to_PML
+
+ real(kind=CUSTOM_REAL), dimension(2,NGLLX,NGLLZ,nspec_PML) :: rmemory_potential_acoustic
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec_PML,2) :: &
+ rmemory_acoustic_dux_dx,rmemory_acoustic_dux_dz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec_PML) :: &
+ K_x_store,K_z_store,d_x_store,d_z_store,alpha_x_store,alpha_z_store
+
+ logical :: PML_BOUNDARY_CONDITIONS,STACEY_BOUNDARY_CONDITIONS
+
+! coefficients and memory variables when using CPML with LDDRK
+ integer :: stage_time_scheme,i_stage
+ real(kind=CUSTOM_REAL), dimension(Nstages) :: alpha_LDDRK,beta_LDDRK,c_LDDRK
+ real(kind=CUSTOM_REAL), dimension(2,NGLLX,NGLLZ,nspec_PML) :: rmemory_potential_acoustic_LDDRK
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec_PML,2) :: rmemory_acoustic_dux_dx_LDDRK,rmemory_acoustic_dux_dz_LDDRK
+
!---
!--- local variables
!---
@@ -119,6 +139,7 @@
! spatial derivatives
real(kind=CUSTOM_REAL) :: dux_dxi,dux_dgamma,dux_dxl,dux_dzl
real(kind=CUSTOM_REAL) :: weight,xxi,zxi,xgamma,zgamma,jacobian1D
+
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ) :: tempx1,tempx2
! Jacobian matrix and determinant
@@ -129,18 +150,6 @@
integer :: ifirstelem,ilastelem
-!CPML coefficients and memory variables
- integer :: nspec_PML,ispec_PML
- integer, dimension(nspec) :: region_CPML
- logical, dimension(nspec) :: is_PML
- integer, dimension(nspec) :: spec_to_PML
-
- real(kind=CUSTOM_REAL), dimension(2,NGLLX,NGLLZ,nspec_PML) :: rmemory_potential_acoustic
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec_PML,2) :: &
- rmemory_acoustic_dux_dx,rmemory_acoustic_dux_dz
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec_PML) :: &
- K_x_store,K_z_store,d_x_store,d_z_store,alpha_x_store,alpha_z_store
-
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ) :: potential_dot_dot_acoustic_PML
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ) :: PML_dux_dxl,PML_dux_dzl,PML_dux_dxl_old,PML_dux_dzl_old
real(kind=CUSTOM_REAL) :: kappa_x,kappa_z,d_x,d_z,alpha_x,alpha_z,beta_x,beta_z,time_n,time_nsub1,&
@@ -150,14 +159,6 @@
integer :: CPML_region_local,singularity_type_zx,singularity_type_xz,singularity_type
double precision :: deltat
- logical :: PML_BOUNDARY_CONDITIONS,STACEY_BOUNDARY_CONDITIONS
-
-!coefficients and memory variables when using CPML with LDDRK
- integer :: stage_time_scheme,i_stage
- real(kind=CUSTOM_REAL), dimension(Nstages) :: alpha_LDDRK,beta_LDDRK,c_LDDRK
- real(kind=CUSTOM_REAL), dimension(2,NGLLX,NGLLZ,nspec_PML) :: rmemory_potential_acoustic_LDDRK
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec_PML,2) :: rmemory_acoustic_dux_dx_LDDRK,rmemory_acoustic_dux_dz_LDDRK
-
ifirstelem = 1
ilastelem = nspec
if(stage_time_scheme == 1) then
diff --git a/src/specfem2D/compute_forces_viscoelastic.F90 b/src/specfem2D/compute_forces_viscoelastic.F90
index caa0bad..ad56a3d 100644
--- a/src/specfem2D/compute_forces_viscoelastic.F90
+++ b/src/specfem2D/compute_forces_viscoelastic.F90
@@ -917,25 +917,26 @@ subroutine compute_forces_viscoelastic(p_sv,nglob,nspec,myrank,nelemabs,numat, &
!
! second double-loop over GLL to compute all the terms
!
- do j = 1,NGLLZ; do i = 1,NGLLX
- iglob = ibool(i,j,ispec)
- ! along x direction and z direction
- ! and assemble the contributions
- ! we can merge the two loops because NGLLX == NGLLZ
- do k = 1,NGLLX
- accel_elastic(1,iglob) = accel_elastic(1,iglob) - (tempx1(k,j)*hprimewgll_xx(k,i) + tempx2(i,k)*hprimewgll_zz(k,j))
- accel_elastic(2,iglob) = accel_elastic(2,iglob) - (tempy1(k,j)*hprimewgll_xx(k,i) + tempy2(i,k)*hprimewgll_zz(k,j))
- accel_elastic(3,iglob) = accel_elastic(3,iglob) - (tempz1(k,j)*hprimewgll_xx(k,i) + tempz2(i,k)*hprimewgll_zz(k,j))
- enddo
-
- !!! PML_BOUNDARY_CONDITIONS
- if(is_PML(ispec) .and. PML_BOUNDARY_CONDITIONS)then
- accel_elastic(1,iglob) = accel_elastic(1,iglob) - accel_elastic_PML(1,i,j)
- accel_elastic(3,iglob) = accel_elastic(3,iglob) - accel_elastic_PML(3,i,j)
- endif
+ do j = 1,NGLLZ
+ do i = 1,NGLLX
+ iglob = ibool(i,j,ispec)
+ ! along x direction and z direction
+ ! and assemble the contributions
+ ! we can merge the two loops because NGLLX == NGLLZ
+ do k = 1,NGLLX
+ accel_elastic(1,iglob) = accel_elastic(1,iglob) - (tempx1(k,j)*hprimewgll_xx(k,i) + tempx2(i,k)*hprimewgll_zz(k,j))
+ accel_elastic(2,iglob) = accel_elastic(2,iglob) - (tempy1(k,j)*hprimewgll_xx(k,i) + tempy2(i,k)*hprimewgll_zz(k,j))
+ accel_elastic(3,iglob) = accel_elastic(3,iglob) - (tempz1(k,j)*hprimewgll_xx(k,i) + tempz2(i,k)*hprimewgll_zz(k,j))
+ enddo
- enddo; enddo ! second loop over the GLL points
+ !!! PML_BOUNDARY_CONDITIONS
+ if(is_PML(ispec) .and. PML_BOUNDARY_CONDITIONS)then
+ accel_elastic(1,iglob) = accel_elastic(1,iglob) - accel_elastic_PML(1,i,j)
+ accel_elastic(3,iglob) = accel_elastic(3,iglob) - accel_elastic_PML(3,i,j)
+ endif
+ enddo
+ enddo ! second loop over the GLL points
endif ! end of test if elastic element
enddo ! end of loop over all spectral elements
diff --git a/src/specfem2D/compute_vector_field.f90 b/src/specfem2D/compute_vector_field.f90
index 1ceacb7..dc35ea3 100644
--- a/src/specfem2D/compute_vector_field.f90
+++ b/src/specfem2D/compute_vector_field.f90
@@ -222,9 +222,9 @@
if(assign_external_model) rhol = rhoext(i,j,ispec)
! derivatives of potential
- vector_field_element(1,i,j) = (tempx1l*xixl + tempx2l*gammaxl) / rhol
+ vector_field_element(1,i,j) = (tempx1l*xixl + tempx2l*gammaxl) / rhol !u_x
vector_field_element(2,i,j) = 0._CUSTOM_REAL
- vector_field_element(3,i,j) = (tempx1l*xizl + tempx2l*gammazl) / rhol
+ vector_field_element(3,i,j) = (tempx1l*xizl + tempx2l*gammazl) / rhol !u_z
enddo
enddo
diff --git a/src/specfem2D/construct_acoustic_surface.f90 b/src/specfem2D/construct_acoustic_surface.f90
index 9759529..eec7bff 100644
--- a/src/specfem2D/construct_acoustic_surface.f90
+++ b/src/specfem2D/construct_acoustic_surface.f90
@@ -48,39 +48,39 @@
! We chose to have ixmin <= ixmax and izmin <= izmax, so as to be able to have DO loops on it with
! an increment of +1.
!
-subroutine construct_acoustic_surface ( nspec, ngnod, knods, nsurface, surface, tab_surface )
+subroutine construct_acoustic_surface ( nspec, ngnod, knods, nelem_acoustic_surface, acoustic_edges, acoustic_surface )
implicit none
integer, intent(in) :: nspec
integer, intent(in) :: ngnod
integer, dimension(ngnod,nspec), intent(in) :: knods
- integer, intent(in) :: nsurface
- integer, dimension(4,nsurface), intent(in) :: surface
- integer, dimension(5,nsurface), intent(out) :: tab_surface
+ integer, intent(in) :: nelem_acoustic_surface
+ integer, dimension(4,nelem_acoustic_surface), intent(in) :: acoustic_edges
+ integer, dimension(5,nelem_acoustic_surface), intent(out) :: acoustic_surface
integer :: i, k
integer :: ixmin, ixmax
integer :: izmin, izmax
integer, dimension(ngnod) :: n
integer :: e1, e2
- integer :: type
+ integer :: type_acoust
- do i = 1, nsurface
- tab_surface(1,i) = surface(1,i)
- type = surface(2,i)
- e1 = surface(3,i)
- e2 = surface(4,i)
+ do i = 1, nelem_acoustic_surface
+ acoustic_surface(1,i) = acoustic_edges(1,i) ! Here we do a copy
+ type_acoust = acoustic_edges(2,i)
+ e1 = acoustic_edges(3,i)
+ e2 = acoustic_edges(4,i)
do k = 1, ngnod
- n(k) = knods(k,tab_surface(1,i))
+ n(k) = knods(k,acoustic_surface(1,i))
enddo
- call get_acoustic_edge ( ngnod, n, type, e1, e2, ixmin, ixmax, izmin, izmax )
+ call get_acoustic_edge ( ngnod, n, type_acoust, e1, e2, ixmin, ixmax, izmin, izmax )
- tab_surface(2,i) = ixmin
- tab_surface(3,i) = ixmax
- tab_surface(4,i) = izmin
- tab_surface(5,i) = izmax
+ acoustic_surface(2,i) = ixmin
+ acoustic_surface(3,i) = ixmax
+ acoustic_surface(4,i) = izmin
+ acoustic_surface(5,i) = izmax
enddo
diff --git a/src/specfem2D/invert_mass_matrix.F90 b/src/specfem2D/invert_mass_matrix.F90
index 1f4840b..f5edbc5 100644
--- a/src/specfem2D/invert_mass_matrix.F90
+++ b/src/specfem2D/invert_mass_matrix.F90
@@ -218,7 +218,7 @@
rmass_inverse_elastic_three(iglob) = rmass_inverse_elastic_one(iglob)
endif
endif
- else
+ else ! no PLM
rmass_inverse_elastic_one(iglob) = rmass_inverse_elastic_one(iglob) &
+ wxgll(i)*wzgll(j)*rhol*jacobian(i,j,ispec)
@@ -264,7 +264,7 @@
+ wxgll(i)*wzgll(j)/ kappal*jacobian(i,j,ispec) * (K_z_store(i,j,ispec_PML))
endif
endif
- else
+ else ! no PLM
rmass_inverse_acoustic(iglob) = rmass_inverse_acoustic(iglob) &
+ wxgll(i)*wzgll(j)*jacobian(i,j,ispec) / kappal
endif
diff --git a/src/specfem2D/read_databases.F90 b/src/specfem2D/read_databases.F90
index af2335a..dac7834 100644
--- a/src/specfem2D/read_databases.F90
+++ b/src/specfem2D/read_databases.F90
@@ -935,12 +935,11 @@
!-------------------------------------------------------------------------------------------------
!
- subroutine read_databases_final(nnodes_tangential_curve,nodes_tangential_curve, &
+ subroutine read_tangential_detection_curve(nnodes_tangential_curve,nodes_tangential_curve, &
force_normal_to_surface,rec_normal_to_surface, &
any_tangential_curve)
! reads tangential detection curve
-! and closes Database file
implicit none
include "constants.h"
@@ -971,9 +970,6 @@
rec_normal_to_surface = .false.
endif
- ! closes input Database file
- close(IIN)
-
- end subroutine read_databases_final
+ end subroutine read_tangential_detection_curve
diff --git a/src/specfem2D/recompute_jacobian.f90 b/src/specfem2D/recompute_jacobian.f90
index fb0ba89..ffc3358 100644
--- a/src/specfem2D/recompute_jacobian.f90
+++ b/src/specfem2D/recompute_jacobian.f90
@@ -73,7 +73,7 @@
! recompute jacobian for any (xi,gamma) point, not necessarily a GLL point
-! create the 2D shape functions and the Jacobian
+! create the 2D shape functions and then the Jacobian
call define_shape_functions(shape2D,dershape2D,xi,gamma,ngnod)
! compute coordinates and jacobian matrix
diff --git a/src/specfem2D/specfem2D.F90 b/src/specfem2D/specfem2D.F90
index 09df965..8ff69bb 100644
--- a/src/specfem2D/specfem2D.F90
+++ b/src/specfem2D/specfem2D.F90
@@ -1653,13 +1653,20 @@
endif
allocate(nodes_tangential_curve(2,nnodes_tangential_curve))
allocate(dist_tangential_detection_curve(nnodes_tangential_curve))
- call read_databases_final(nnodes_tangential_curve,nodes_tangential_curve, &
+ call read_tangential_detection_curve(nnodes_tangential_curve,nodes_tangential_curve, &
force_normal_to_surface,rec_normal_to_surface, &
any_tangential_curve)
! resets nnode_tangential_curve
if( any_tangential_curve .eqv. .false. ) nnodes_tangential_curve = 0
!
+!---- end of reading
+!
+
+! closes input Database file
+ close(IIN)
+
+!
!---- compute shape functions and their derivatives for SEM grid
!
@@ -1982,32 +1989,32 @@
!
!---- set the coordinates of the points of the global grid
!
- found_a_negative_jacobian = .false.
- do ispec = 1,nspec
- do j = 1,NGLLZ
- do i = 1,NGLLX
+ found_a_negative_jacobian = .false.
+ do ispec = 1,nspec
+ do j = 1,NGLLZ
+ do i = 1,NGLLX
- xi = xigll(i)
- gamma = zigll(j)
+ xi = xigll(i)
+ gamma = zigll(j)
- call recompute_jacobian(xi,gamma,x,z,xixl,xizl,gammaxl,gammazl, &
- jacobianl,coorg,knods,ispec,ngnod,nspec,npgeo, &
- .false.)
+ call recompute_jacobian(xi,gamma,x,z,xixl,xizl,gammaxl,gammazl, &
+ jacobianl,coorg,knods,ispec,ngnod,nspec,npgeo, &
+ .false.)
- if(jacobianl <= ZERO) found_a_negative_jacobian = .true.
+ if(jacobianl <= ZERO) found_a_negative_jacobian = .true.
- coord(1,ibool(i,j,ispec)) = x
- coord(2,ibool(i,j,ispec)) = z
+ coord(1,ibool(i,j,ispec)) = x
+ coord(2,ibool(i,j,ispec)) = z
- xix(i,j,ispec) = xixl
- xiz(i,j,ispec) = xizl
- gammax(i,j,ispec) = gammaxl
- gammaz(i,j,ispec) = gammazl
- jacobian(i,j,ispec) = jacobianl
+ xix(i,j,ispec) = xixl
+ xiz(i,j,ispec) = xizl
+ gammax(i,j,ispec) = gammaxl
+ gammaz(i,j,ispec) = gammazl
+ jacobian(i,j,ispec) = jacobianl
+ enddo
enddo
enddo
- enddo
! create an OpenDX file containing all the negative elements displayed in red, if any
! this allows users to locate problems in a mesh based on the OpenDX file created at the second iteration
More information about the CIG-COMMITS
mailing list