[cig-commits] r8556 - seismo/2D/SPECFEM2D/trunk
walter at geodynamics.org
walter at geodynamics.org
Fri Dec 7 15:56:11 PST 2007
Author: walter
Date: 2007-12-07 15:56:10 -0800 (Fri, 07 Dec 2007)
New Revision: 8556
Added:
seismo/2D/SPECFEM2D/trunk/precision_mpi.h
Modified:
seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90
seismo/2D/SPECFEM2D/trunk/compute_arrays_source.f90
seismo/2D/SPECFEM2D/trunk/compute_energy.f90
seismo/2D/SPECFEM2D/trunk/compute_forces_acoustic.f90
seismo/2D/SPECFEM2D/trunk/compute_forces_elastic.f90
seismo/2D/SPECFEM2D/trunk/compute_gradient_attenuation.f90
seismo/2D/SPECFEM2D/trunk/compute_pressure.f90
seismo/2D/SPECFEM2D/trunk/compute_vector_field.f90
seismo/2D/SPECFEM2D/trunk/constants.h
seismo/2D/SPECFEM2D/trunk/define_derivation_matrices.f90
seismo/2D/SPECFEM2D/trunk/enforce_acoustic_free_surface.f90
seismo/2D/SPECFEM2D/trunk/gll_library.f90
seismo/2D/SPECFEM2D/trunk/specfem2D.F90
Log:
adding support for single or double precision. Set CUSTOM_REAL and CUSTOM_MPI_TYPE in constans.h and precision_mpi.h to enable desired precision, and recompile (default is double precision). Using pgf90, single was 10-15% faster on our AMD Opteron cluster.
Modified: seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90 2007-07-04 23:38:11 UTC (rev 8555)
+++ seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90 2007-12-07 23:56:10 UTC (rev 8556)
@@ -241,14 +241,15 @@
include 'constants.h'
include 'mpif.h'
+ include 'precision_mpi.h'
integer, intent(in) :: ninterface, ninterface_acoustic
integer, dimension(ninterface), intent(in) :: inum_interfaces_acoustic
integer, intent(in) :: max_ibool_interfaces_size_ac
- double precision, dimension(max_ibool_interfaces_size_ac,ninterface_acoustic), intent(in) :: &
+ real(kind=CUSTOM_REAL), dimension(max_ibool_interfaces_size_ac,ninterface_acoustic), intent(in) :: &
buffer_send_faces_vector_ac
- double precision, dimension(max_ibool_interfaces_size_ac,ninterface_acoustic), intent(in) :: &
+ real(kind=CUSTOM_REAL), dimension(max_ibool_interfaces_size_ac,ninterface_acoustic), intent(in) :: &
buffer_recv_faces_vector_ac
integer, dimension(ninterface_acoustic*2), intent(inout) :: tab_requests_send_recv_acoustic
integer, dimension(ninterface), intent(in) :: nibool_interfaces_acoustic
@@ -264,11 +265,11 @@
num_interface = inum_interfaces_acoustic(inum_interface)
call MPI_Send_init ( buffer_send_faces_vector_ac(1,inum_interface), &
- nibool_interfaces_acoustic(num_interface), MPI_DOUBLE_PRECISION, &
+ nibool_interfaces_acoustic(num_interface), CUSTOM_MPI_TYPE, &
my_neighbours(num_interface), 12, MPI_COMM_WORLD, &
tab_requests_send_recv_acoustic(inum_interface), ier)
call MPI_Recv_init ( buffer_recv_faces_vector_ac(1,inum_interface), &
- nibool_interfaces_acoustic(num_interface), MPI_DOUBLE_PRECISION, &
+ nibool_interfaces_acoustic(num_interface), CUSTOM_MPI_TYPE, &
my_neighbours(num_interface), 12, MPI_COMM_WORLD, &
tab_requests_send_recv_acoustic(ninterface_acoustic+inum_interface), ier)
end do
@@ -293,14 +294,15 @@
include 'constants.h'
include 'mpif.h'
-
+ include 'precision_mpi.h'
+
integer, intent(in) :: ninterface, ninterface_elastic
integer, dimension(ninterface), intent(in) :: inum_interfaces_elastic
integer, intent(in) :: max_ibool_interfaces_size_el
- double precision, dimension(max_ibool_interfaces_size_el,ninterface_elastic), intent(in) :: &
+ real(kind=CUSTOM_REAL), dimension(max_ibool_interfaces_size_el,ninterface_elastic), intent(in) :: &
buffer_send_faces_vector_el
- double precision, dimension(max_ibool_interfaces_size_el,ninterface_elastic), intent(in) :: &
+ real(kind=CUSTOM_REAL), dimension(max_ibool_interfaces_size_el,ninterface_elastic), intent(in) :: &
buffer_recv_faces_vector_el
integer, dimension(ninterface_elastic*2), intent(inout) :: tab_requests_send_recv_elastic
integer, dimension(ninterface), intent(in) :: nibool_interfaces_elastic
@@ -316,11 +318,11 @@
num_interface = inum_interfaces_elastic(inum_interface)
call MPI_Send_init ( buffer_send_faces_vector_el(1,inum_interface), &
- NDIM*nibool_interfaces_elastic(num_interface), MPI_DOUBLE_PRECISION, &
+ NDIM*nibool_interfaces_elastic(num_interface), CUSTOM_MPI_TYPE, &
my_neighbours(num_interface), 13, MPI_COMM_WORLD, &
tab_requests_send_recv_elastic(inum_interface), ier)
call MPI_Recv_init ( buffer_recv_faces_vector_el(1,inum_interface), &
- NDIM*nibool_interfaces_elastic(num_interface), MPI_DOUBLE_PRECISION, &
+ NDIM*nibool_interfaces_elastic(num_interface), CUSTOM_MPI_TYPE, &
my_neighbours(num_interface), 13, MPI_COMM_WORLD, &
tab_requests_send_recv_elastic(ninterface_elastic+inum_interface), ier)
end do
@@ -341,7 +343,7 @@
! array to assemble
- double precision, dimension(npoin), intent(inout) :: array_val1, array_val2
+ real(kind=CUSTOM_REAL), dimension(npoin), intent(inout) :: array_val1, array_val2
integer, intent(in) :: myrank
integer, intent(in) :: npoin
@@ -434,7 +436,7 @@
! array to assemble
- double precision, dimension(npoin), intent(in) :: array_val1
+ real(kind=CUSTOM_REAL), dimension(npoin), intent(in) :: array_val1
integer, intent(in) :: npoin
@@ -445,7 +447,7 @@
integer, dimension(NGLLX*max_interface_size,ninterface), intent(in) :: ibool_interfaces_acoustic
integer, dimension(ninterface), intent(in) :: nibool_interfaces_acoustic
integer, dimension(ninterface_acoustic*2), intent(inout) :: tab_requests_send_recv_acoustic
- double precision, dimension(max_ibool_interfaces_size_ac,ninterface_acoustic), intent(inout) :: &
+ real(kind=CUSTOM_REAL), dimension(max_ibool_interfaces_size_ac,ninterface_acoustic), intent(inout) :: &
buffer_send_faces_vector_ac
integer :: ipoin, num_interface, inum_interface
@@ -497,7 +499,7 @@
! array to assemble
- double precision, dimension(NDIM,npoin), intent(in) :: array_val2
+ real(kind=CUSTOM_REAL), dimension(NDIM,npoin), intent(in) :: array_val2
integer, intent(in) :: npoin
@@ -508,7 +510,7 @@
integer, dimension(NGLLX*max_interface_size,ninterface), intent(in) :: ibool_interfaces_elastic
integer, dimension(ninterface), intent(in) :: nibool_interfaces_elastic
integer, dimension(ninterface_elastic*2), intent(inout) :: tab_requests_send_recv_elastic
- double precision, dimension(max_ibool_interfaces_size_el,ninterface_elastic), intent(inout) :: &
+ real(CUSTOM_REAL), dimension(max_ibool_interfaces_size_el,ninterface_elastic), intent(inout) :: &
buffer_send_faces_vector_el
@@ -563,7 +565,7 @@
! array to assemble
- double precision, dimension(npoin), intent(inout) :: array_val1
+ real(kind=CUSTOM_REAL), dimension(npoin), intent(inout) :: array_val1
integer, intent(in) :: npoin
@@ -574,7 +576,7 @@
integer, dimension(NGLLX*max_interface_size,ninterface), intent(in) :: ibool_interfaces_acoustic
integer, dimension(ninterface), intent(in) :: nibool_interfaces_acoustic
integer, dimension(ninterface_acoustic*2), intent(inout) :: tab_requests_send_recv_acoustic
- double precision, dimension(max_ibool_interfaces_size_ac,ninterface_acoustic), intent(inout) :: &
+ real(kind=CUSTOM_REAL), dimension(max_ibool_interfaces_size_ac,ninterface_acoustic), intent(inout) :: &
buffer_recv_faces_vector_ac
integer :: ipoin, num_interface, inum_interface
@@ -623,7 +625,7 @@
! array to assemble
- double precision, dimension(NDIM,npoin), intent(inout) :: array_val2
+ real(kind=CUSTOM_REAL), dimension(NDIM,npoin), intent(inout) :: array_val2
integer, intent(in) :: npoin
@@ -634,7 +636,7 @@
integer, dimension(NGLLX*max_interface_size,ninterface), intent(in) :: ibool_interfaces_elastic
integer, dimension(ninterface), intent(in) :: nibool_interfaces_elastic
integer, dimension(ninterface_elastic*2), intent(inout) :: tab_requests_send_recv_elastic
- double precision, dimension(max_ibool_interfaces_size_el,ninterface_elastic), intent(inout) :: &
+ real(kind=CUSTOM_REAL), dimension(max_ibool_interfaces_size_el,ninterface_elastic), intent(inout) :: &
buffer_recv_faces_vector_el
integer :: ipoin, num_interface, inum_interface
Modified: seismo/2D/SPECFEM2D/trunk/compute_arrays_source.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/compute_arrays_source.f90 2007-07-04 23:38:11 UTC (rev 8555)
+++ seismo/2D/SPECFEM2D/trunk/compute_arrays_source.f90 2007-12-07 23:56:10 UTC (rev 8556)
@@ -24,9 +24,9 @@
double precision xi_source,gamma_source
double precision Mxx,Mzz,Mxz
- double precision, dimension(NGLLX,NGLLZ,nspec) :: xix,xiz,gammax,gammaz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec) :: xix,xiz,gammax,gammaz
- double precision, dimension(NDIM,NGLLX,NGLLZ) :: sourcearray
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLZ) :: sourcearray
double precision xixd,xizd,gammaxd,gammazd
Modified: seismo/2D/SPECFEM2D/trunk/compute_energy.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/compute_energy.f90 2007-07-04 23:38:11 UTC (rev 8555)
+++ seismo/2D/SPECFEM2D/trunk/compute_energy.f90 2007-12-07 23:56:10 UTC (rev 8556)
@@ -25,10 +25,10 @@
include "constants.h"
! vector field in an element
- double precision, dimension(NDIM,NGLLX,NGLLX) :: vector_field_element
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLX) :: vector_field_element
! pressure in an element
- double precision, dimension(NGLLX,NGLLX) :: pressure_element
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: pressure_element
double precision, dimension(NGLLX,NGLLZ,nspec) :: e1_mech1,e11_mech1,e1_mech2,e11_mech2
@@ -181,8 +181,8 @@
lambdal_relaxed = elastcoef(1,kmato(ispec))
mul_relaxed = elastcoef(2,kmato(ispec))
rhol = density(kmato(ispec))
- kappal = lambdal_relaxed + TWO*mul_relaxed/3.d0
- cpl = sqrt((kappal + 4.d0*mul_relaxed/3.d0)/rhol)
+ kappal = lambdal_relaxed + TWO*mul_relaxed/3._CUSTOM_REAL
+ cpl = sqrt((kappal + 4._CUSTOM_REAL*mul_relaxed/3._CUSTOM_REAL)/rhol)
! double loop over GLL points
do j = 1,NGLLZ
Modified: seismo/2D/SPECFEM2D/trunk/compute_forces_acoustic.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/compute_forces_acoustic.f90 2007-07-04 23:38:11 UTC (rev 8555)
+++ seismo/2D/SPECFEM2D/trunk/compute_forces_acoustic.f90 2007-12-07 23:56:10 UTC (rev 8556)
@@ -39,20 +39,20 @@
logical, dimension(nspec) :: elastic
logical, dimension(4,nelemabs) :: codeabs
- double precision, dimension(npoin) :: potential_dot_dot_acoustic,potential_dot_acoustic,potential_acoustic
+ real(kind=CUSTOM_REAL), dimension(npoin) :: potential_dot_dot_acoustic,potential_dot_acoustic,potential_acoustic
double precision, dimension(numat) :: density
double precision, dimension(4,numat) :: elastcoef
- double precision, dimension(NGLLX,NGLLZ,nspec) :: xix,xiz,gammax,gammaz,jacobian
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec) :: xix,xiz,gammax,gammaz,jacobian
double precision, dimension(NGLLX,NGLLZ,nspec) :: vpext,vsext,rhoext
- double precision, dimension(NSTEP) :: source_time_function
+ real(kind=CUSTOM_REAL), dimension(NSTEP) :: source_time_function
! derivatives of Lagrange polynomials
- double precision, dimension(NGLLX,NGLLX) :: hprime_xx,hprimewgll_xx
- double precision, dimension(NGLLZ,NGLLZ) :: hprime_zz,hprimewgll_zz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: hprime_xx,hprimewgll_xx
+ real(kind=CUSTOM_REAL), dimension(NGLLZ,NGLLZ) :: hprime_zz,hprimewgll_zz
! Gauss-Lobatto-Legendre weights
- double precision, dimension(NGLLX) :: wxgll
- double precision, dimension(NGLLZ) :: wzgll
+ real(kind=CUSTOM_REAL), dimension(NGLLX) :: wxgll
+ real(kind=CUSTOM_REAL), dimension(NGLLZ) :: wzgll
!---
!--- local variables
@@ -61,16 +61,16 @@
integer :: ispec,i,j,k,iglob,ispecabs,ibegin,iend,jbegin,jend
! spatial derivatives
- double precision :: dux_dxi,dux_dgamma,dux_dxl,dux_dzl
- double precision :: nx,nz,rho_vp,rho_vs,weight,xxi,zxi,xgamma,zgamma,jacobian1D
+ real(kind=CUSTOM_REAL) :: dux_dxi,dux_dgamma,dux_dxl,dux_dzl
+ real(kind=CUSTOM_REAL) :: nx,nz,rho_vp,rho_vs,weight,xxi,zxi,xgamma,zgamma,jacobian1D
- double precision, dimension(NGLLX,NGLLZ) :: tempx1,tempx2
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ) :: tempx1,tempx2
! Jacobian matrix and determinant
- double precision :: xixl,xizl,gammaxl,gammazl,jacobianl
+ real(kind=CUSTOM_REAL) :: xixl,xizl,gammaxl,gammazl,jacobianl
! material properties of the elastic medium
- double precision :: mul_relaxed,lambdal_relaxed,kappal,cpl,csl,rhol
+ real(kind=CUSTOM_REAL) :: mul_relaxed,lambdal_relaxed,kappal,cpl,csl,rhol
! loop over spectral elements
do ispec = 1,nspec
@@ -149,8 +149,8 @@
lambdal_relaxed = elastcoef(1,kmato(ispec))
mul_relaxed = elastcoef(2,kmato(ispec))
rhol = density(kmato(ispec))
- kappal = lambdal_relaxed + TWO*mul_relaxed/3.d0
- cpl = sqrt((kappal + 4.d0*mul_relaxed/3.d0)/rhol)
+ kappal = lambdal_relaxed + TWO*mul_relaxed/3._CUSTOM_REAL
+ cpl = sqrt((kappal + 4._CUSTOM_REAL*mul_relaxed/3._CUSTOM_REAL)/rhol)
csl = sqrt(mul_relaxed/rhol)
Modified: seismo/2D/SPECFEM2D/trunk/compute_forces_elastic.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/compute_forces_elastic.f90 2007-07-04 23:38:11 UTC (rev 8555)
+++ seismo/2D/SPECFEM2D/trunk/compute_forces_elastic.f90 2007-12-07 23:56:10 UTC (rev 8556)
@@ -40,25 +40,25 @@
logical, dimension(nspec) :: elastic
logical, dimension(4,nelemabs) :: codeabs
- double precision, dimension(NDIM,npoin) :: accel_elastic,veloc_elastic,displ_elastic
+ real(kind=CUSTOM_REAL), dimension(NDIM,npoin) :: accel_elastic,veloc_elastic,displ_elastic
double precision, dimension(numat) :: density
double precision, dimension(4,numat) :: elastcoef
- double precision, dimension(NGLLX,NGLLZ,nspec) :: xix,xiz,gammax,gammaz,jacobian
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec) :: xix,xiz,gammax,gammaz,jacobian
double precision, dimension(NGLLX,NGLLZ,nspec) :: vpext,vsext,rhoext
- double precision, dimension(NSTEP) :: source_time_function
- double precision, dimension(NDIM,NGLLX,NGLLZ) :: sourcearray
+ real(kind=CUSTOM_REAL), dimension(NSTEP) :: source_time_function
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLZ) :: sourcearray
- double precision, dimension(NGLLX,NGLLZ,nspec) :: &
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec) :: &
e1_mech1,e11_mech1,e13_mech1,e1_mech2,e11_mech2,e13_mech2, &
dux_dxl_n,duz_dzl_n,duz_dxl_n,dux_dzl_n,dux_dxl_np1,duz_dzl_np1,duz_dxl_np1,dux_dzl_np1
! derivatives of Lagrange polynomials
- double precision, dimension(NGLLX,NGLLX) :: hprime_xx,hprimewgll_xx
- double precision, dimension(NGLLZ,NGLLZ) :: hprime_zz,hprimewgll_zz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: hprime_xx,hprimewgll_xx
+ real(kind=CUSTOM_REAL), dimension(NGLLZ,NGLLZ) :: hprime_zz,hprimewgll_zz
! Gauss-Lobatto-Legendre weights
- double precision, dimension(NGLLX) :: wxgll
- double precision, dimension(NGLLZ) :: wzgll
+ real(kind=CUSTOM_REAL), dimension(NGLLX) :: wxgll
+ real(kind=CUSTOM_REAL), dimension(NGLLZ) :: wzgll
!---
!--- local variables
@@ -67,22 +67,22 @@
integer :: ispec,i,j,k,iglob,ispecabs,ibegin,iend
! spatial derivatives
- double precision :: dux_dxi,dux_dgamma,duz_dxi,duz_dgamma
- double precision :: dux_dxl,duz_dxl,dux_dzl,duz_dzl
- double precision :: sigma_xx,sigma_xz,sigma_zz
- double precision :: nx,nz,vx,vz,vn,rho_vp,rho_vs,tx,tz,weight,xxi,zxi,xgamma,zgamma,jacobian1D
+ real(kind=CUSTOM_REAL) :: dux_dxi,dux_dgamma,duz_dxi,duz_dgamma
+ real(kind=CUSTOM_REAL) :: dux_dxl,duz_dxl,dux_dzl,duz_dzl
+ real(kind=CUSTOM_REAL) :: sigma_xx,sigma_xz,sigma_zz
+ real(kind=CUSTOM_REAL) :: nx,nz,vx,vz,vn,rho_vp,rho_vs,tx,tz,weight,xxi,zxi,xgamma,zgamma,jacobian1D
- double precision, dimension(NGLLX,NGLLZ) :: tempx1,tempx2,tempz1,tempz2
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ) :: tempx1,tempx2,tempz1,tempz2
! Jacobian matrix and determinant
- double precision :: xixl,xizl,gammaxl,gammazl,jacobianl
+ real(kind=CUSTOM_REAL) :: xixl,xizl,gammaxl,gammazl,jacobianl
! material properties of the elastic medium
- double precision :: mul_relaxed,lambdal_relaxed,lambdalplus2mul_relaxed,kappal,cpl,csl,rhol, &
+ real(kind=CUSTOM_REAL) :: mul_relaxed,lambdal_relaxed,lambdalplus2mul_relaxed,kappal,cpl,csl,rhol, &
lambdal_unrelaxed,mul_unrelaxed,lambdalplus2mul_unrelaxed
! for attenuation
- double precision :: Un,Unp1,tauinv,Sn,Snp1,theta_n,theta_np1,tauinvsquare,tauinvcube,tauinvUn
+ real(kind=CUSTOM_REAL) :: Un,Unp1,tauinv,Sn,Snp1,theta_n,theta_np1,tauinvsquare,tauinvcube,tauinvUn
! compute Grad(displ_elastic) at time step n for attenuation
if(TURN_ATTENUATION_ON) call compute_gradient_attenuation(displ_elastic,dux_dxl_n,duz_dxl_n, &
@@ -239,8 +239,8 @@
lambdal_relaxed = elastcoef(1,kmato(ispec))
mul_relaxed = elastcoef(2,kmato(ispec))
rhol = density(kmato(ispec))
- kappal = lambdal_relaxed + TWO*mul_relaxed/3.d0
- cpl = sqrt((kappal + 4.d0*mul_relaxed/3.d0)/rhol)
+ kappal = lambdal_relaxed + TWO*mul_relaxed/3._CUSTOM_REAL
+ cpl = sqrt((kappal + 4._CUSTOM_REAL*mul_relaxed/3._CUSTOM_REAL)/rhol)
csl = sqrt(mul_relaxed/rhol)
!--- left absorbing boundary
Modified: seismo/2D/SPECFEM2D/trunk/compute_gradient_attenuation.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/compute_gradient_attenuation.f90 2007-07-04 23:38:11 UTC (rev 8555)
+++ seismo/2D/SPECFEM2D/trunk/compute_gradient_attenuation.f90 2007-12-07 23:56:10 UTC (rev 8556)
@@ -26,22 +26,23 @@
logical, dimension(nspec) :: elastic
- double precision, dimension(NGLLX,NGLLZ,nspec) :: dux_dxl,duz_dxl,dux_dzl,duz_dzl,xix,xiz,gammax,gammaz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec) :: dux_dxl,duz_dxl,dux_dzl,duz_dzl
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec) :: xix,xiz,gammax,gammaz
- double precision, dimension(NDIM,npoin) :: displ_elastic
+ real(kind=CUSTOM_REAL), dimension(NDIM,npoin) :: displ_elastic
! array with derivatives of Lagrange polynomials
- double precision, dimension(NGLLX,NGLLX) :: hprime_xx
- double precision, dimension(NGLLZ,NGLLZ) :: hprime_zz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: hprime_xx
+ real(kind=CUSTOM_REAL), dimension(NGLLZ,NGLLZ) :: hprime_zz
! local variables
integer :: i,j,k,ispec
! spatial derivatives
- double precision :: dux_dxi,dux_dgamma,duz_dxi,duz_dgamma
+ real(kind=CUSTOM_REAL) :: dux_dxi,dux_dgamma,duz_dxi,duz_dgamma
! jacobian
- double precision :: xixl,xizl,gammaxl,gammazl
+ real(kind=CUSTOM_REAL) :: xixl,xizl,gammaxl,gammazl
! loop over spectral elements
do ispec = 1,nspec
Modified: seismo/2D/SPECFEM2D/trunk/compute_pressure.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/compute_pressure.f90 2007-07-04 23:38:11 UTC (rev 8555)
+++ seismo/2D/SPECFEM2D/trunk/compute_pressure.f90 2007-12-07 23:56:10 UTC (rev 8556)
@@ -31,25 +31,26 @@
double precision, dimension(4,numat) :: elastcoef
double precision, dimension(NGLLX,NGLLX,nspec) :: vpext,vsext,rhoext
- double precision, dimension(NGLLX,NGLLZ,nspec) :: xix,xiz,gammax,gammaz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec) :: xix,xiz,gammax,gammaz
logical, dimension(nspec) :: elastic
- double precision, dimension(npoin) :: potential_dot_dot_acoustic
- double precision, dimension(NDIM,npoin) :: displ_elastic,vector_field_display
+ real(kind=CUSTOM_REAL), dimension(npoin) :: potential_dot_dot_acoustic
+ real(kind=CUSTOM_REAL), dimension(NDIM,npoin) :: displ_elastic
+ double precision, dimension(NDIM,npoin) :: vector_field_display
! array with derivatives of Lagrange polynomials
- double precision, dimension(NGLLX,NGLLX) :: hprime_xx
- double precision, dimension(NGLLZ,NGLLZ) :: hprime_zz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: hprime_xx
+ real(kind=CUSTOM_REAL), dimension(NGLLZ,NGLLZ) :: hprime_zz
logical :: assign_external_model,TURN_ATTENUATION_ON,TURN_ANISOTROPY_ON
- double precision, dimension(NGLLX,NGLLZ,nspec) :: e1_mech1,e11_mech1,e1_mech2,e11_mech2
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec) :: e1_mech1,e11_mech1,e1_mech2,e11_mech2
! local variables
integer :: i,j,ispec,iglob
! pressure in this element
- double precision, dimension(NGLLX,NGLLX) :: pressure_element
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: pressure_element
! loop over spectral elements
do ispec = 1,nspec
@@ -96,38 +97,38 @@
double precision, dimension(4,numat) :: elastcoef
double precision, dimension(NGLLX,NGLLX,nspec) :: vpext,vsext,rhoext
- double precision, dimension(NGLLX,NGLLZ,nspec) :: xix,xiz,gammax,gammaz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec) :: xix,xiz,gammax,gammaz
! pressure in this element
- double precision, dimension(NGLLX,NGLLX) :: pressure_element
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: pressure_element
logical, dimension(nspec) :: elastic
- double precision, dimension(npoin) :: potential_dot_dot_acoustic
- double precision, dimension(NDIM,npoin) :: displ_elastic
+ real(kind=CUSTOM_REAL), dimension(npoin) :: potential_dot_dot_acoustic
+ real(kind=CUSTOM_REAL), dimension(NDIM,npoin) :: displ_elastic
! array with derivatives of Lagrange polynomials
- double precision, dimension(NGLLX,NGLLX) :: hprime_xx
- double precision, dimension(NGLLZ,NGLLZ) :: hprime_zz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: hprime_xx
+ real(kind=CUSTOM_REAL), dimension(NGLLZ,NGLLZ) :: hprime_zz
logical :: assign_external_model,TURN_ATTENUATION_ON,TURN_ANISOTROPY_ON
- double precision, dimension(NGLLX,NGLLZ,nspec) :: e1_mech1,e11_mech1,e1_mech2,e11_mech2
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec) :: e1_mech1,e11_mech1,e1_mech2,e11_mech2
! local variables
integer :: i,j,k,iglob
! jacobian
- double precision :: xixl,xizl,gammaxl,gammazl
+ real(kind=CUSTOM_REAL) :: xixl,xizl,gammaxl,gammazl
! spatial derivatives
- double precision :: dux_dxi,dux_dgamma,duz_dxi,duz_dgamma
- double precision :: dux_dxl,duz_dxl,dux_dzl,duz_dzl
- double precision :: sigma_xx,sigma_zz
+ real(kind=CUSTOM_REAL) :: dux_dxi,dux_dgamma,duz_dxi,duz_dgamma
+ real(kind=CUSTOM_REAL) :: dux_dxl,duz_dxl,dux_dzl,duz_dzl
+ real(kind=CUSTOM_REAL) :: sigma_xx,sigma_zz
! material properties of the elastic medium
integer :: material
- double precision :: mul_relaxed,lambdal_relaxed,lambdalplus2mul_relaxed,denst
- double precision :: mul_unrelaxed,lambdal_unrelaxed,lambdalplus2mul_unrelaxed,cpl,csl
+ real(kind=CUSTOM_REAL) :: mul_relaxed,lambdal_relaxed,lambdalplus2mul_relaxed,denst
+ real(kind=CUSTOM_REAL) :: mul_unrelaxed,lambdal_unrelaxed,lambdalplus2mul_unrelaxed,cpl,csl
! if elastic element
!
Modified: seismo/2D/SPECFEM2D/trunk/compute_vector_field.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/compute_vector_field.f90 2007-07-04 23:38:11 UTC (rev 8555)
+++ seismo/2D/SPECFEM2D/trunk/compute_vector_field.f90 2007-12-07 23:56:10 UTC (rev 8556)
@@ -25,21 +25,22 @@
integer, dimension(NGLLX,NGLLZ,nspec) :: ibool
- double precision, dimension(NGLLX,NGLLZ,nspec) :: xix,xiz,gammax,gammaz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec) :: xix,xiz,gammax,gammaz
logical, dimension(nspec) :: elastic
- double precision, dimension(npoin) :: potential_acoustic
- double precision, dimension(NDIM,npoin) :: veloc_elastic,vector_field_display
+ real(kind=CUSTOM_REAL), dimension(npoin) :: potential_acoustic
+ real(kind=CUSTOM_REAL), dimension(NDIM,npoin) :: veloc_elastic
+ double precision, dimension(NDIM,npoin) :: vector_field_display
! array with derivatives of Lagrange polynomials
- double precision, dimension(NGLLX,NGLLX) :: hprime_xx
- double precision, dimension(NGLLZ,NGLLZ) :: hprime_zz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: hprime_xx
+ real(kind=CUSTOM_REAL), dimension(NGLLZ,NGLLZ) :: hprime_zz
! local variables
integer i,j,ispec,iglob
! vector field in this element
- double precision, dimension(NDIM,NGLLX,NGLLX) :: vector_field_element
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLX) :: vector_field_element
! loop over spectral elements
do ispec = 1,nspec
@@ -77,28 +78,28 @@
integer, dimension(NGLLX,NGLLZ,nspec) :: ibool
- double precision, dimension(NGLLX,NGLLZ,nspec) :: xix,xiz,gammax,gammaz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec) :: xix,xiz,gammax,gammaz
! vector field in this element
- double precision, dimension(NDIM,NGLLX,NGLLX) :: vector_field_element
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLX) :: vector_field_element
logical, dimension(nspec) :: elastic
- double precision, dimension(npoin) :: potential_acoustic
- double precision, dimension(NDIM,npoin) :: veloc_elastic
+ real(kind=CUSTOM_REAL), dimension(npoin) :: potential_acoustic
+ real(kind=CUSTOM_REAL), dimension(NDIM,npoin) :: veloc_elastic
! array with derivatives of Lagrange polynomials
- double precision, dimension(NGLLX,NGLLX) :: hprime_xx
- double precision, dimension(NGLLZ,NGLLZ) :: hprime_zz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: hprime_xx
+ real(kind=CUSTOM_REAL), dimension(NGLLZ,NGLLZ) :: hprime_zz
! local variables
integer i,j,k,iglob
! space derivatives
- double precision tempx1l,tempx2l
- double precision hp1,hp2
+ real(kind=CUSTOM_REAL) tempx1l,tempx2l
+ real(kind=CUSTOM_REAL) hp1,hp2
! jacobian
- double precision xixl,xizl,gammaxl,gammazl
+ real(kind=CUSTOM_REAL) xixl,xizl,gammaxl,gammazl
! simple copy of existing vector if elastic element
if(elastic(ispec)) then
Modified: seismo/2D/SPECFEM2D/trunk/constants.h
===================================================================
--- seismo/2D/SPECFEM2D/trunk/constants.h 2007-07-04 23:38:11 UTC (rev 8555)
+++ seismo/2D/SPECFEM2D/trunk/constants.h 2007-12-07 23:56:10 UTC (rev 8556)
@@ -1,4 +1,14 @@
+ integer, parameter :: SIZE_REAL = 4
+ integer, parameter :: SIZE_DOUBLE = 8
+! set to SIZE_REAL to run in single precision
+! set to SIZE_DOUBLE to run in double precision (increases memory size by 2)
+!
+! DO NOT forget to change precision_mpi.h accordingly
+!
+ integer, parameter :: CUSTOM_REAL = SIZE_DOUBLE
+! integer, parameter :: CUSTOM_REAL = SIZE_REAL
+
! polynomial degree
integer, parameter :: NGLLX = 5
! the code does NOT work if NGLLZ /= NGLLX because it then cannot handle a non-structured mesh
@@ -6,6 +16,7 @@
! compute and output acoustic and elastic energy (slows down the code significantly)
logical, parameter :: OUTPUT_ENERGY = .false.
+
! output file for energy
integer, parameter :: IENERGY = 77
@@ -36,8 +47,8 @@
integer, parameter :: NEDGES = 4
! a few useful constants
- double precision, parameter :: ZERO = 0.d0,ONE = 1.d0
- double precision, parameter :: HALF = 0.5d0,TWO = 2.0d0,QUART = 0.25d0
+ real(kind=CUSTOM_REAL), parameter :: ZERO = 0.d0,ONE = 1.d0
+ real(kind=CUSTOM_REAL), parameter :: HALF = 0.5d0,TWO = 2.d0,QUART = 0.25d0
! pi
double precision, parameter :: PI = 3.141592653589793d0
@@ -46,7 +57,7 @@
double precision, parameter :: FOUR_THIRDS = 4.d0/3.d0
! 1/24
- double precision, parameter :: ONE_OVER_24 = 1.d0 / 24.d0
+ real(kind=CUSTOM_REAL), parameter :: ONE_OVER_24 = 1.d0 / 24.d0
! parameters to define the Gauss-Lobatto-Legendre points
double precision, parameter :: GAUSSALPHA = ZERO,GAUSSBETA = ZERO
@@ -113,26 +124,26 @@
double precision, parameter :: tau_epsilon_nu1_mech1 = 0.0325305d0
double precision, parameter :: tau_sigma_nu1_mech1 = 0.0311465d0
double precision, parameter :: tau_epsilon_nu2_mech1 = 0.0332577d0
- double precision, parameter :: tau_sigma_nu2_mech1 = 0.0304655d0
+ real(kind=CUSTOM_REAL), parameter :: tau_sigma_nu2_mech1 = 0.0304655d0
double precision, parameter :: tau_epsilon_nu1_mech2 = 0.0032530d0
- double precision, parameter :: tau_sigma_nu1_mech2 = 0.0031146d0
+ real(kind=CUSTOM_REAL), parameter :: tau_sigma_nu1_mech2 = 0.0031146d0
double precision, parameter :: tau_epsilon_nu2_mech2 = 0.0033257d0
- double precision, parameter :: tau_sigma_nu2_mech2 = 0.0030465d0
+ real(kind=CUSTOM_REAL), parameter :: tau_sigma_nu2_mech2 = 0.0030465d0
- double precision, parameter :: inv_tau_sigma_nu1_mech1 = ONE / tau_sigma_nu1_mech1
- double precision, parameter :: inv_tau_sigma_nu2_mech1 = ONE / tau_sigma_nu2_mech1
- double precision, parameter :: inv_tau_sigma_nu1_mech2 = ONE / tau_sigma_nu1_mech2
- double precision, parameter :: inv_tau_sigma_nu2_mech2 = ONE / tau_sigma_nu2_mech2
+ real(kind=CUSTOM_REAL), parameter :: inv_tau_sigma_nu1_mech1 = ONE / tau_sigma_nu1_mech1
+ real(kind=CUSTOM_REAL), parameter :: inv_tau_sigma_nu2_mech1 = ONE / tau_sigma_nu2_mech1
+ real(kind=CUSTOM_REAL), parameter :: inv_tau_sigma_nu1_mech2 = ONE / tau_sigma_nu1_mech2
+ real(kind=CUSTOM_REAL), parameter :: inv_tau_sigma_nu2_mech2 = ONE / tau_sigma_nu2_mech2
- double precision, parameter :: phi_nu1_mech1 = (ONE - tau_epsilon_nu1_mech1/tau_sigma_nu1_mech1) / tau_sigma_nu1_mech1
- double precision, parameter :: phi_nu2_mech1 = (ONE - tau_epsilon_nu2_mech1/tau_sigma_nu2_mech1) / tau_sigma_nu2_mech1
- double precision, parameter :: phi_nu1_mech2 = (ONE - tau_epsilon_nu1_mech2/tau_sigma_nu1_mech2) / tau_sigma_nu1_mech2
- double precision, parameter :: phi_nu2_mech2 = (ONE - tau_epsilon_nu2_mech2/tau_sigma_nu2_mech2) / tau_sigma_nu2_mech2
+ real(kind=CUSTOM_REAL), parameter :: phi_nu1_mech1 = (ONE - tau_epsilon_nu1_mech1/tau_sigma_nu1_mech1) / tau_sigma_nu1_mech1
+ real(kind=CUSTOM_REAL), parameter :: phi_nu2_mech1 = (ONE - tau_epsilon_nu2_mech1/tau_sigma_nu2_mech1) / tau_sigma_nu2_mech1
+ real(kind=CUSTOM_REAL), parameter :: phi_nu1_mech2 = (ONE - tau_epsilon_nu1_mech2/tau_sigma_nu1_mech2) / tau_sigma_nu1_mech2
+ real(kind=CUSTOM_REAL), parameter :: phi_nu2_mech2 = (ONE - tau_epsilon_nu2_mech2/tau_sigma_nu2_mech2) / tau_sigma_nu2_mech2
- double precision, parameter :: Mu_nu1 = ONE - (ONE - tau_epsilon_nu1_mech1/tau_sigma_nu1_mech1) &
+ real(kind=CUSTOM_REAL), parameter :: Mu_nu1 = ONE - (ONE - tau_epsilon_nu1_mech1/tau_sigma_nu1_mech1) &
- (ONE - tau_epsilon_nu1_mech2/tau_sigma_nu1_mech2)
- double precision, parameter :: Mu_nu2 = ONE - (ONE - tau_epsilon_nu2_mech1/tau_sigma_nu2_mech1) &
+ real(kind=CUSTOM_REAL), parameter :: Mu_nu2 = ONE - (ONE - tau_epsilon_nu2_mech1/tau_sigma_nu2_mech1) &
- (ONE - tau_epsilon_nu2_mech2/tau_sigma_nu2_mech2)
!-----------------------------------------------------------------------
Modified: seismo/2D/SPECFEM2D/trunk/define_derivation_matrices.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/define_derivation_matrices.f90 2007-07-04 23:38:11 UTC (rev 8555)
+++ seismo/2D/SPECFEM2D/trunk/define_derivation_matrices.f90 2007-12-07 23:56:10 UTC (rev 8556)
@@ -22,12 +22,12 @@
double precision, dimension(NGLLZ) :: zigll
! weights
- double precision, dimension(NGLLX) :: wxgll
- double precision, dimension(NGLLZ) :: wzgll
+ real(kind=CUSTOM_REAL), dimension(NGLLX) :: wxgll
+ real(kind=CUSTOM_REAL), dimension(NGLLZ) :: wzgll
! array with derivatives of Lagrange polynomials
- double precision, dimension(NGLLX,NGLLX) :: hprime_xx,hprimewgll_xx
- double precision, dimension(NGLLZ,NGLLZ) :: hprime_zz,hprimewgll_zz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: hprime_xx,hprimewgll_xx
+ real(kind=CUSTOM_REAL), dimension(NGLLZ,NGLLZ) :: hprime_zz,hprimewgll_zz
! function for calculating derivatives of Lagrange polynomials
double precision, external :: lagrange_deriv_GLL
Modified: seismo/2D/SPECFEM2D/trunk/enforce_acoustic_free_surface.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/enforce_acoustic_free_surface.f90 2007-07-04 23:38:11 UTC (rev 8555)
+++ seismo/2D/SPECFEM2D/trunk/enforce_acoustic_free_surface.f90 2007-12-07 23:56:10 UTC (rev 8556)
@@ -29,7 +29,7 @@
integer, dimension(NGLLX,NGLLZ,nspec) :: ibool
- double precision, dimension(npoin) :: potential_dot_dot_acoustic,potential_dot_acoustic,potential_acoustic
+ real(kind=CUSTOM_REAL), dimension(npoin) :: potential_dot_dot_acoustic,potential_dot_acoustic,potential_acoustic
!---
!--- local variables
Modified: seismo/2D/SPECFEM2D/trunk/gll_library.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/gll_library.f90 2007-07-04 23:38:11 UTC (rev 8555)
+++ seismo/2D/SPECFEM2D/trunk/gll_library.f90 2007-12-07 23:56:10 UTC (rev 8556)
@@ -408,11 +408,13 @@
!=======================================================================
implicit none
+ include 'constants.h'
- double precision, parameter :: zero=0.d0,one=1.d0,two=2.d0
+ !double precision, parameter :: zero=0.d0,one=1.d0,two=2.d0
integer np
- double precision z(np),w(np)
+ double precision z(np)
+ real(kind=CUSTOM_REAL) :: w(np)
double precision alpha,beta
integer n,np1,np2,i
@@ -478,12 +480,15 @@
!=======================================================================
implicit none
+ include 'constants.h'
- double precision, parameter :: zero=0.d0,one=1.d0,two=2.d0
+ !double precision, parameter :: zero=0.d0,one=1.d0,two=2.d0
+
integer np
double precision alpha,beta
- double precision z(np), w(np)
+ double precision z(np)
+ real(kind=CUSTOM_REAL) :: w(np)
integer n,nm1,i
double precision p,pd,pm1,pdm1,pm2,pdm2
Added: seismo/2D/SPECFEM2D/trunk/precision_mpi.h
===================================================================
--- seismo/2D/SPECFEM2D/trunk/precision_mpi.h 2007-07-04 23:38:11 UTC (rev 8555)
+++ seismo/2D/SPECFEM2D/trunk/precision_mpi.h 2007-12-07 23:56:10 UTC (rev 8556)
@@ -0,0 +1,8 @@
+! solver in single or double precision depending on the machine
+!
+! set to MPI_REAL to run in single precision
+! set to MPI_DOUBLE_PRECISION to run in double precision
+!
+! DO NOT forget to change constants.h accordingly
+!
+ integer, parameter :: CUSTOM_MPI_TYPE = MPI_DOUBLE_PRECISION
Modified: seismo/2D/SPECFEM2D/trunk/specfem2D.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/specfem2D.F90 2007-07-04 23:38:11 UTC (rev 8555)
+++ seismo/2D/SPECFEM2D/trunk/specfem2D.F90 2007-12-07 23:56:10 UTC (rev 8556)
@@ -99,7 +99,7 @@
integer :: source_type,time_function_type
double precision :: x_source,z_source,xi_source,gamma_source,Mxx,Mzz,Mxz,f0,t0,factor,angleforce,hdur,hdur_gauss
- double precision, dimension(NDIM,NGLLX,NGLLZ) :: sourcearray
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLZ) :: sourcearray
double precision, dimension(:,:), allocatable :: coorg
double precision, dimension(:), allocatable :: coorgread
@@ -112,10 +112,10 @@
double precision, dimension(:,:), allocatable :: sisux,sisuz
! vector field in an element
- double precision, dimension(NDIM,NGLLX,NGLLX) :: vector_field_element
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLX) :: vector_field_element
! pressure in an element
- double precision, dimension(NGLLX,NGLLX) :: pressure_element
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: pressure_element
integer :: i,j,k,l,it,irec,ipoin,ip,id,nbpoin,inump,n,ispec,npoin,npgeo,iglob
logical :: anyabs
@@ -126,12 +126,14 @@
double precision deltatover2,deltatsquareover2,time,deltat
! Gauss-Lobatto-Legendre points and weights
- double precision, dimension(NGLLX) :: xigll,wxgll
- double precision, dimension(NGLLZ) :: zigll,wzgll
+ double precision, dimension(NGLLX) :: xigll
+ real(kind=CUSTOM_REAL), dimension(NGLLX) :: wxgll
+ double precision, dimension(NGLLZ) :: zigll
+ real(kind=CUSTOM_REAL), dimension(NGLLX) :: wzgll
! derivatives of Lagrange polynomials
- double precision, dimension(NGLLX,NGLLX) :: hprime_xx,hprimewgll_xx
- double precision, dimension(NGLLZ,NGLLZ) :: hprime_zz,hprimewgll_zz
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLX) :: hprime_xx,hprimewgll_xx
+ real(kind=CUSTOM_REAL), dimension(NGLLZ,NGLLZ) :: hprime_zz,hprimewgll_zz
! Jacobian matrix and determinant
double precision :: xixl,xizl,gammaxl,gammazl,jacobianl
@@ -139,19 +141,21 @@
! material properties of the elastic medium
double precision :: mul_relaxed,lambdal_relaxed,cpsquare
- double precision, dimension(:,:), allocatable :: coord,accel_elastic,veloc_elastic,displ_elastic, &
- flagrange,xinterp,zinterp,Uxinterp,Uzinterp,elastcoef,vector_field_display
+ real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: accel_elastic,veloc_elastic,displ_elastic
+ double precision, dimension(:,:), allocatable :: coord, flagrange,xinterp,zinterp,Uxinterp,Uzinterp,elastcoef,vector_field_display
! for acoustic medium
- double precision, dimension(:), allocatable :: potential_dot_dot_acoustic,potential_dot_acoustic,potential_acoustic
- double precision, dimension(:), allocatable :: rmass_inverse_elastic,rmass_inverse_acoustic,density,displread,velocread,accelread
+ real(kind=CUSTOM_REAL), dimension(:), allocatable :: potential_dot_dot_acoustic,potential_dot_acoustic,potential_acoustic
+ real(kind=CUSTOM_REAL), dimension(:), allocatable :: rmass_inverse_elastic,rmass_inverse_acoustic
+ double precision, dimension(:), allocatable :: density,displread,velocread,accelread
double precision, dimension(:), allocatable :: vp_display
double precision, dimension(:,:,:), allocatable :: vpext,vsext,rhoext
double precision :: previous_vsext
- double precision, dimension(:,:,:), allocatable :: shape2D,shape2D_display,xix,xiz,gammax,gammaz,jacobian
+ double precision, dimension(:,:,:), allocatable :: shape2D,shape2D_display
+ real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: xix,xiz,gammax,gammaz,jacobian
double precision, dimension(:,:,:,:), allocatable :: dershape2D,dershape2D_display
@@ -162,7 +166,7 @@
integer ispec_selected_source,iglob_source,ix_source,iz_source,is_proc_source,nb_proc_source
double precision a,displnorm_all
- double precision, dimension(:), allocatable :: source_time_function
+ real(kind=CUSTOM_REAL), dimension(:), allocatable :: source_time_function
double precision, external :: erf
double precision :: vpmin,vpmax
@@ -179,7 +183,7 @@
! for absorbing and acoustic free surface conditions
integer :: ispec_acoustic_surface,inum,numabsread
logical :: codeabsread(4)
- double precision :: nx,nz,weight,xxi,zgamma
+ real(kind=CUSTOM_REAL) :: nx,nz,weight,xxi,zgamma
logical, dimension(:,:), allocatable :: codeabs
@@ -187,7 +191,7 @@
integer nspec_allocate
double precision :: deltatsquare,deltatcube,deltatfourth,twelvedeltat,fourdeltatsquare
- double precision, dimension(:,:,:), allocatable :: &
+ real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: &
e1_mech1,e11_mech1,e13_mech1,e1_mech2,e11_mech2,e13_mech2, &
dux_dxl_n,duz_dzl_n,duz_dxl_n,dux_dzl_n,dux_dxl_np1,duz_dzl_np1,duz_dxl_np1,dux_dzl_np1
@@ -200,7 +204,7 @@
integer :: num_fluid_solid_edges,ispec_acoustic,ispec_elastic, &
iedge_acoustic,iedge_elastic,ipoin1D,iglob2
logical :: any_acoustic,any_elastic,coupled_acoustic_elastic
- double precision :: displ_x,displ_z,displ_n,zxi,xgamma,jacobian1D,pressure
+ real(kind=CUSTOM_REAL) :: displ_x,displ_z,displ_n,zxi,xgamma,jacobian1D,pressure
! for color images
integer :: NX_IMAGE_color,NZ_IMAGE_color
@@ -268,11 +272,11 @@
integer, dimension(:), allocatable :: inum_interfaces_acoustic, inum_interfaces_elastic
#ifdef USE_MPI
- double precision, dimension(:,:), allocatable :: buffer_send_faces_vector_ac
- double precision, dimension(:,:), allocatable :: buffer_recv_faces_vector_ac
+ real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: buffer_send_faces_vector_ac
+ real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: buffer_recv_faces_vector_ac
integer, dimension(:), allocatable :: tab_requests_send_recv_acoustic
- double precision, dimension(:,:), allocatable :: buffer_send_faces_vector_el
- double precision, dimension(:,:), allocatable :: buffer_recv_faces_vector_el
+ real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: buffer_send_faces_vector_el
+ real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: buffer_recv_faces_vector_el
integer, dimension(:), allocatable :: tab_requests_send_recv_elastic
integer :: max_ibool_interfaces_size_ac, max_ibool_interfaces_size_el
#endif
@@ -1064,12 +1068,12 @@
! fill mass matrix with fictitious non-zero values to make sure it can be inverted globally
- if(any_elastic) where(rmass_inverse_elastic <= 0.d0) rmass_inverse_elastic = 1.d0
- if(any_acoustic) where(rmass_inverse_acoustic <= 0.d0) rmass_inverse_acoustic = 1.d0
+ if(any_elastic) where(rmass_inverse_elastic <= 0._CUSTOM_REAL) rmass_inverse_elastic = 1._CUSTOM_REAL
+ if(any_acoustic) where(rmass_inverse_acoustic <= 0._CUSTOM_REAL) rmass_inverse_acoustic = 1._CUSTOM_REAL
! compute the inverse of the mass matrix
- if(any_elastic) rmass_inverse_elastic(:) = 1 / rmass_inverse_elastic(:)
- if(any_acoustic) rmass_inverse_acoustic(:) = 1 / rmass_inverse_acoustic(:)
+ if(any_elastic) rmass_inverse_elastic(:) = 1._CUSTOM_REAL / rmass_inverse_elastic(:)
+ if(any_acoustic) rmass_inverse_acoustic(:) = 1._CUSTOM_REAL / rmass_inverse_acoustic(:)
! check the mesh, stability and number of points per wavelength
call checkgrid(vpext,vsext,rhoext,density,elastcoef,ibool,kmato,coord,npoin,vpmin,vpmax, &
@@ -1361,7 +1365,7 @@
! output absolute time in third column, in case user wants to check it as well
if ( myrank == 0 ) then
- write(55,*) sngl(time),sngl(source_time_function(it)),sngl(time-t0)
+ write(55,*) sngl(time),real(source_time_function(it),4),sngl(time-t0)
endif
enddo
More information about the cig-commits
mailing list