[cig-commits] [commit] devel: fixed all the warnings given by the Portland and Cray compilers on a Cray at ORNL. In particular, renamed all the variables or functions that had the same name as Fortran intrinsics (although that is correct in Fortran, it can be confusing and it also confuses syntax highlighting, and the Portland compiler prints a warning for each of them) (24d334e)
cig_noreply at geodynamics.org
cig_noreply at geodynamics.org
Mon Apr 7 10:02:33 PDT 2014
Repository : ssh://shell.geodynamics.org/specfem2d
On branch : devel
Link : https://github.com/geodynamics/specfem2d/compare/fb480e7c8b36fe998ebefbb3c8e1c4cc995a287e...db407f7b459208d754fbfc3e3093a7b1243bdaf7
>---------------------------------------------------------------
commit 24d334e702e413f9c5ef9afe0462f074c0da4399
Author: Dimitri Komatitsch <komatitsch at lma.cnrs-mrs.fr>
Date: Mon Apr 7 18:59:28 2014 +0200
fixed all the warnings given by the Portland and Cray compilers on a Cray at ORNL.
In particular, renamed all the variables or functions that had the same name as Fortran intrinsics
(although that is correct in Fortran, it can be confusing and it also confuses syntax highlighting,
and the Portland compiler prints a warning for each of them)
>---------------------------------------------------------------
24d334e702e413f9c5ef9afe0462f074c0da4399
flags.guess | 6 +--
src/meshfem2D/Makefile.in | 6 ++-
src/shared/adj_seismogram.f90 | 8 ++--
src/shared/convolve_source_timefunction.f90 | 18 ++++----
src/shared/force_ftz.c | 4 ++
src/specfem2D/Makefile.in | 3 +-
src/specfem2D/check_stability.F90 | 10 ++--
src/specfem2D/compute_coupling_acoustic_el.f90 | 6 +--
src/specfem2D/compute_forces_viscoelastic.F90 | 15 +++---
src/specfem2D/convert_time.f90 | 63 ++++++++++++++++++++++----
src/specfem2D/createnum_fast.f90 | 20 ++++----
src/specfem2D/get_MPI.F90 | 12 ++---
src/specfem2D/netlib_specfun_erf.f90 | 28 ++++++------
src/specfem2D/pml_init.F90 | 8 ++--
src/specfem2D/prepare_source_time_function.f90 | 45 ++++++++----------
src/specfem2D/sort_array_coordinates.F90 | 10 ++--
src/specfem2D/specfem2D.F90 | 12 ++---
17 files changed, 159 insertions(+), 115 deletions(-)
diff --git a/flags.guess b/flags.guess
index 377b19a..572224a 100644
--- a/flags.guess
+++ b/flags.guess
@@ -18,8 +18,8 @@ case $FC in
# Cray Fortran
#
if test x"$FLAGS_CHECK" = x; then
- FLAGS_CHECK="-O3 -Onoaggress -Oipa0 -hfp2 -Ovector3 -Oscalar3 -Ocache2 -Ounroll2 -Ofusion2" # turn on optimization; -Oaggress -Oipa4 would make it even more aggressive
- # -eC -eD -ec -en -eI -ea -g -G0 # turn on full debugging and range checking
+ FLAGS_CHECK="-O3 -Onoaggress -Oipa0 -hfp2 -Ovector3 -Oscalar3 -Ocache2 -Ounroll2 -Ofusion2 -p ../../obj" # turn on optimization; -Oaggress -Oipa4 would make it even more aggressive
+ # -eC -eD -ec -en -eI -ea -g -G0 -M 1193 -M 1438 -p ../../obj # turn on full debugging and range checking
fi
;;
pgf95|*/pgf95|pgf90|*/pgf90)
@@ -27,7 +27,7 @@ case $FC in
# Portland PGI
#
if test x"$FLAGS_CHECK" = x; then
- FLAGS_CHECK="-fast -Mnobounds -Minline -Mneginfo -Mdclchk -Knoieee -Minform=warn -Mdaz -Mflushz -Mvect"
+ FLAGS_CHECK="-fast -Mnobounds -Minline -Mneginfo -Mdclchk -Knoieee -Minform=inform -Mdaz -Mflushz -Mvect -mcmodel=medium"
# -Mbounds
# -fastsse -tp amd64e -Msmart
fi
diff --git a/src/meshfem2D/Makefile.in b/src/meshfem2D/Makefile.in
index 875a5c0..d4e03e0 100644
--- a/src/meshfem2D/Makefile.in
+++ b/src/meshfem2D/Makefile.in
@@ -60,9 +60,11 @@ CFLAGS = @CFLAGS@ $(CPPFLAGS) -I../../setup
@COND_MPI_TRUE at F90 = $(MPIFC) $(FCFLAGS) @FC_DEFINE at USE_MPI @FC_DEFINE at USE_SCOTCH -I"@SCOTCH_INCLUDEDIR@" $(MPILIBS)
@COND_MPI_FALSE at F90 = $(FC) $(FCFLAGS)
+LIB =
+
## scotch libraries
- at COND_MPI_TRUE@LIB = -L"@SCOTCH_LIBDIR@" -lscotch -lscotcherr
- at COND_MPI_FALSE@LIB =
+ at COND_MPI_TRUE@LIB += -L"@SCOTCH_LIBDIR@" -lscotch -lscotcherr
+ at COND_MPI_FALSE@LIB +=
LINK = $(F90)
diff --git a/src/shared/adj_seismogram.f90 b/src/shared/adj_seismogram.f90
index 1ff2183..826474b 100644
--- a/src/shared/adj_seismogram.f90
+++ b/src/shared/adj_seismogram.f90
@@ -56,8 +56,8 @@ program adj_seismogram
double precision, parameter :: deltat = 0.06
double precision, parameter :: EPS = 1.d-40
- integer :: itime,icomp,istart,iend,nlen,irec,NDIM,NDIMr,adj_comp
- double precision :: time,tstart(nrec),tend(nrec)
+ integer :: itime,icomp,istart,iend,nlenval,irec,NDIM,NDIMr,adj_comp
+ double precision :: timeval,tstart(nrec),tend(nrec)
character(len=150), dimension(nrec) :: station_name
double precision, dimension(NSTEP) :: time_window
double precision :: seism(NSTEP,3),Nnorm,seism_win(NSTEP)
@@ -91,7 +91,7 @@ program adj_seismogram
open(unit = 10, file = trim(filename))
do itime = 1,NSTEP
- read(10,*) time , seism(itime,icomp)
+ read(10,*) timeval , seism(itime,icomp)
enddo
enddo
@@ -113,7 +113,7 @@ program adj_seismogram
print*,'istart =',istart, 'iend =', iend
print*,'tstart =',istart*deltat, 'tend =', iend*deltat
if(istart >= iend) stop 'check istart,iend'
- nlen = iend - istart +1
+ nlenval = iend - istart +1
do icomp = 1, NDIM
diff --git a/src/shared/convolve_source_timefunction.f90 b/src/shared/convolve_source_timefunction.f90
index f9ef73d..61d83ef 100644
--- a/src/shared/convolve_source_timefunction.f90
+++ b/src/shared/convolve_source_timefunction.f90
@@ -58,11 +58,11 @@
integer :: i,j,N_j,number_remove,nlines
- double precision :: alpha,dt,tau_j,source,exponent,t1,t2,displ1,displ2,gamma,height,half_duration_triangle
+ double precision :: alpha,dt,tau_j,source,exponentval,t1,t2,displ1,displ2,gamma,height,half_duration_triangle
logical :: triangle
- double precision, dimension(:), allocatable :: time,sem,sem_fil
+ double precision, dimension(:), allocatable :: timeval,sem,sem_fil
! read file with number of lines in input
open(unit=33,file='input_convolve_code.txt',status='old',action='read')
@@ -72,18 +72,18 @@
close(33)
! allocate arrays
- allocate(time(nlines),sem(nlines),sem_fil(nlines))
+ allocate(timeval(nlines),sem(nlines),sem_fil(nlines))
! read the input seismogram
do i = 1,nlines
- read(5,*) time(i),sem(i)
+ read(5,*) timeval(i),sem(i)
enddo
! define a Gaussian with the right exponent to mimic a triangle of equivalent half duration
alpha = SOURCE_DECAY_MIMIC_TRIANGLE/half_duration_triangle
! compute the time step
- dt = time(2) - time(1)
+ dt = timeval(2) - timeval(1)
! number of integers for which the source wavelet is different from zero
if(triangle) then
@@ -126,9 +126,9 @@
else
! convolve with a Gaussian
- exponent = alpha**2 * tau_j**2
- if(exponent < 50.d0) then
- source = alpha*exp(-exponent)/sqrt(PI)
+ exponentval = alpha**2 * tau_j**2
+ if(exponentval < 50.d0) then
+ source = alpha*exp(-exponentval)/sqrt(PI)
else
source = 0.d0
endif
@@ -145,7 +145,7 @@
! compute number of samples to remove from end of seismograms
number_remove = N_j + 1
do i=1,nlines - number_remove
- write(*,*) sngl(time(i)),' ',sngl(sem_fil(i))
+ write(*,*) sngl(timeval(i)),' ',sngl(sem_fil(i))
enddo
end program convolve_source_time_function
diff --git a/src/shared/force_ftz.c b/src/shared/force_ftz.c
index b2d6402..721d680 100644
--- a/src/shared/force_ftz.c
+++ b/src/shared/force_ftz.c
@@ -63,6 +63,10 @@
/* * The FTZ bit (bit 15) in the MXCSR register must be masked (value = 1). */
/* * The underflow exception (bit 11) needs to be masked (value = 1). */
+/* This routine is not strictly necessary for SPECFEM, thus if it does not compile on your system
+ (since it calls some low-level system routines) just suppress all the lines below (i.e. make it an empty file)
+ and comment out the call to force_ftz() in the main SPECFEM program */
+
#include "config.h"
#define FTZ_BIT 15
diff --git a/src/specfem2D/Makefile.in b/src/specfem2D/Makefile.in
index 70b679c..bd90ca8 100644
--- a/src/specfem2D/Makefile.in
+++ b/src/specfem2D/Makefile.in
@@ -65,6 +65,7 @@ CFLAGS = @CFLAGS@ $(CPPFLAGS) -I../../setup
@COND_MPI_TRUE at F90 = $(MPIFC) $(FCFLAGS) @FC_DEFINE at USE_MPI $(MPILIBS)
@COND_MPI_FALSE at F90 = $(FC) $(FCFLAGS)
+LIB =
LINK = $(F90)
@@ -171,7 +172,7 @@ OBJS_SPECFEM2D = \
$O/jddctmgr.o $O/jdhuff.o $O/jdinput.o $O/jdmainct.o $O/jdmarker.o $O/jdmaster.o \
$O/jdmerge.o $O/jdpostct.o $O/jdsample.o $O/jdtrans.o $O/jerror.o $O/jfdctflt.o \
$O/jfdctfst.o $O/jfdctint.o $O/jidctflt.o $O/jidctfst.o $O/jidctint.o $O/jquant1.o \
- $O/jquant2.o $O/jutils.o $O/jmemmgr.o $O/jmemnobs.o
+ $O/jquant2.o $O/jutils.o $O/jmemmgr.o $O/jmemnobs.o $(LIB)
default: $(DEFAULT)
diff --git a/src/specfem2D/check_stability.F90 b/src/specfem2D/check_stability.F90
index 1d73ac8..14feca3 100644
--- a/src/specfem2D/check_stability.F90
+++ b/src/specfem2D/check_stability.F90
@@ -43,7 +43,7 @@
!========================================================================
- subroutine check_stability(myrank,time,it,NSTEP,NOISE_TOMOGRAPHY, &
+ subroutine check_stability(myrank,timeval,it,NSTEP,NOISE_TOMOGRAPHY, &
nglob_acoustic,nglob_elastic,nglob_poroelastic, &
any_elastic_glob,any_elastic,displ_elastic, &
any_poroelastic_glob,any_poroelastic, &
@@ -61,7 +61,7 @@
integer :: myrank,it,NSTEP,NOISE_TOMOGRAPHY
- double precision :: time
+ double precision :: timeval
logical :: any_elastic_glob,any_elastic
integer :: nglob_elastic
@@ -102,10 +102,10 @@
! user output
if (myrank == 0) then
write(IOUT,*)
- if(time >= 1.d-3 .and. time < 1000.d0) then
- write(IOUT,"('Time step number ',i7,' t = ',f9.4,' s out of ',i7)") it,time,NSTEP
+ if(timeval >= 1.d-3 .and. timeval < 1000.d0) then
+ write(IOUT,"('Time step number ',i7,' t = ',f9.4,' s out of ',i7)") it,timeval,NSTEP
else
- write(IOUT,"('Time step number ',i7,' t = ',1pe13.6,' s out of ',i7)") it,time,NSTEP
+ write(IOUT,"('Time step number ',i7,' t = ',1pe13.6,' s out of ',i7)") it,timeval,NSTEP
endif
write(IOUT,*) 'We have done ',sngl(100.d0*dble(it-1)/dble(NSTEP-1)),'% of the total'
endif
diff --git a/src/specfem2D/compute_coupling_acoustic_el.f90 b/src/specfem2D/compute_coupling_acoustic_el.f90
index 0f53838..935443e 100644
--- a/src/specfem2D/compute_coupling_acoustic_el.f90
+++ b/src/specfem2D/compute_coupling_acoustic_el.f90
@@ -49,7 +49,7 @@
fluid_solid_elastic_ispec,fluid_solid_elastic_iedge,&
AXISYM,nglob,coord,is_on_the_axis,xiglj,wxglj, &
PML_BOUNDARY_CONDITIONS,nspec_PML,K_x_store,K_z_store,d_x_store,d_z_store,alpha_x_store,&
- alpha_z_store,is_PML,spec_to_PML,region_CPML,rmemory_fsb_displ_elastic,time,deltat)
+ alpha_z_store,is_PML,spec_to_PML,region_CPML,rmemory_fsb_displ_elastic,timeval,deltat)
implicit none
include 'constants.h'
@@ -90,7 +90,7 @@
ispec_PML,CPML_region_local,singularity_type_xz
real(kind=CUSTOM_REAL) :: displ_x,displ_z,displ_n,&
xxi,zxi,xgamma,zgamma,jacobian1D,nx,nz,weight
- double precision :: time,deltat
+ double precision :: timeval,deltat
double precision :: kappa_x,kappa_z,d_x,d_z,alpha_x,alpha_z,beta_x,beta_z, &
A8,A9,A10,bb_xz_1,bb_xz_2,coef0_xz_1,coef1_xz_1,coef2_xz_1,coef0_xz_2,coef1_xz_2,coef2_xz_2
@@ -127,7 +127,7 @@
alpha_z = alpha_z_store(i,j,ispec_PML)
beta_x = alpha_x + d_x / kappa_x
beta_z = alpha_z + d_z / kappa_z
- call lik_parameter_computation(time,deltat,kappa_x,beta_x,alpha_x,kappa_z,beta_z,alpha_z,&
+ call lik_parameter_computation(timeval,deltat,kappa_x,beta_x,alpha_x,kappa_z,beta_z,alpha_z,&
CPML_region_local,13,A8,A9,A10,singularity_type_xz,bb_xz_1,bb_xz_2,&
coef0_xz_1,coef1_xz_1,coef2_xz_1,coef0_xz_2,coef1_xz_2,coef2_xz_2)
rmemory_fsb_displ_elastic(1,1,i,j,inum) = coef0_xz_1 * rmemory_fsb_displ_elastic(1,1,i,j,inum) + &
diff --git a/src/specfem2D/compute_forces_viscoelastic.F90 b/src/specfem2D/compute_forces_viscoelastic.F90
index 1ea5e76..5a65311 100644
--- a/src/specfem2D/compute_forces_viscoelastic.F90
+++ b/src/specfem2D/compute_forces_viscoelastic.F90
@@ -208,9 +208,10 @@ subroutine compute_forces_viscoelastic(p_sv,nglob,nspec,myrank,nelemabs,numat, &
real(kind=CUSTOM_REAL) :: e1_sum,e11_sum,e13_sum
integer :: i_sls
+ ! nsub1 denotes discrete time step n-1
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,nspec) :: dux_dxl_n,duz_dzl_n,duz_dxl_n,dux_dzl_n, &
dux_dxl_nsub1,duz_dzl_nsub1,duz_dxl_nsub1,dux_dzl_nsub1
- !nsub1 denote discrete time step n-1
+
double precision :: coef0,coef1,coef2
! material properties of the elastic medium
@@ -1855,13 +1856,13 @@ end subroutine compute_forces_viscoelastic
!========================================================================
- subroutine lik_parameter_computation(time,deltat,kappa_x,beta_x,alpha_x,kappa_z,beta_z,alpha_z, &
+ subroutine lik_parameter_computation(timeval,deltat,kappa_x,beta_x,alpha_x,kappa_z,beta_z,alpha_z, &
CPML_region_local,index_ik,A_0,A_1,A_2,singularity_type_2,bb_1,bb_2, &
coef0_1,coef1_1,coef2_1,coef0_2,coef1_2,coef2_2)
implicit none
include "constants.h"
- double precision, intent(in) :: time
+ double precision, intent(in) :: timeval
double precision :: deltat
double precision, intent(in) :: kappa_x,beta_x,alpha_x,kappa_z,beta_z,alpha_z
integer, intent(in) :: CPML_region_local,index_ik
@@ -1910,7 +1911,7 @@ end subroutine compute_forces_viscoelastic
bar_A_1 = bar_A_0 * (-2._CUSTOM_REAL * alpha_0 + (alpha_z + beta_x))
bar_A_2 = bar_A_0 * (alpha_0 - alpha_z) * (alpha_0-beta_x)
- A_1 = bar_A_1 + time * bar_A_2
+ A_1 = bar_A_1 + timeval * bar_A_2
A_2 = -bar_A_2
singularity_type_2 = 1 ! 0 means no singularity, 1 means first order singularity
@@ -1957,14 +1958,14 @@ end subroutine compute_forces_viscoelastic
!========================================================================
- subroutine l_parameter_computation(time,deltat,kappa_x,beta_x,alpha_x,kappa_z,beta_z,alpha_z, &
+ subroutine l_parameter_computation(timeval,deltat,kappa_x,beta_x,alpha_x,kappa_z,beta_z,alpha_z, &
CPML_region_local,A_0,A_1,A_2,A_3,A_4,singularity_type,&
bb_1,coef0_1,coef1_1,coef2_1,bb_2,coef0_2,coef1_2,coef2_2)
implicit none
include "constants.h"
- double precision :: time
+ double precision :: timeval
double precision :: deltat
double precision, intent(in) :: kappa_x,beta_x,alpha_x,kappa_z,beta_z,alpha_z
integer, intent(in) :: CPML_region_local
@@ -2007,7 +2008,7 @@ end subroutine compute_forces_viscoelastic
+ 3._CUSTOM_REAL * alpha_0**2 * beta_xyz_1 - 2._CUSTOM_REAL * alpha_0 * beta_xyz_2)
bar_A_4 = bar_A_0 * alpha_0**2 * (beta_x - alpha_0) * (beta_z - alpha_0)
- A_3 = bar_A_3 + time * bar_A_4
+ A_3 = bar_A_3 + timeval * bar_A_4
A_4 = -bar_A_4
singularity_type = 1
diff --git a/src/specfem2D/convert_time.f90 b/src/specfem2D/convert_time.f90
index 03da30f..4e264ca 100644
--- a/src/specfem2D/convert_time.f90
+++ b/src/specfem2D/convert_time.f90
@@ -1,4 +1,47 @@
+!========================================================================
+!
+! S P E C F E M 2 D Version 7 . 0
+! --------------------------------
+!
+! Copyright CNRS, Inria and University of Pau, France,
+! and Princeton University / California Institute of Technology, USA.
+! Contributors: Dimitri Komatitsch, dimitri DOT komatitsch aT univ-pau DOT fr
+! Nicolas Le Goff, nicolas DOT legoff aT univ-pau DOT fr
+! Roland Martin, roland DOT martin aT univ-pau DOT fr
+! Christina Morency, cmorency aT princeton DOT edu
+!
+! This software is a computer program whose purpose is to solve
+! the two-dimensional viscoelastic anisotropic or poroelastic wave equation
+! using a spectral-element method (SEM).
+!
+! This software is governed by the CeCILL license under French law and
+! abiding by the rules of distribution of free software. You can use,
+! modify and/or redistribute the software under the terms of the CeCILL
+! license as circulated by CEA, CNRS and Inria at the following URL
+! "http://www.cecill.info".
+!
+! As a counterpart to the access to the source code and rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors have only limited
+! liability.
+!
+! In this respect, the user's attention is drawn to the risks associated
+! with loading, using, modifying and/or developing or reproducing the
+! software by the user in light of its specific status of free software,
+! that may mean that it is complicated to manipulate, and that also
+! therefore means that it is reserved for developers and experienced
+! professionals having in-depth computer knowledge. Users are therefore
+! encouraged to load and test the software's suitability as regards their
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and, more generally, to use and operate it in the
+! same conditions as regards security.
+!
+! The full text of the license is available in file "LICENSE".
+!
+!========================================================================
+
! open-source subroutines taken from the World Ocean Circulation Experiment (WOCE)
! web site at http://www.coaps.fsu.edu/woce/html/wcdtools.htm
@@ -9,7 +52,7 @@
! extended by Dimitri Komatitsch, University of Toulouse, France, April 2011,
! to go beyond the year 2020; I extended that to the year 3000 and thus had to write a loop to fill array "year()".
- subroutine convtime(timestamp,yr,mon,day,hr,min)
+ subroutine convtime(timestamp,yr,mon,day,hr,minvalue)
! Originally written by Shawn Smith (ssmith AT coaps.fsu.edu)
! Updated Spring 1999 for Y2K compliance by Anthony Arguez (anthony AT coaps.fsu.edu).
@@ -23,7 +66,7 @@
integer, intent(out) :: timestamp
- integer, intent(in) :: yr,mon,day,hr,min
+ integer, intent(in) :: yr,mon,day,hr,minvalue
integer :: year(1980:MAX_YEAR),month(12),leap_mon(12)
@@ -69,13 +112,13 @@
if (hr < 0 .or. hr > 23) stop 'Error in convtime: hour out of range (0-23)'
- if (min < 0 .or. min > 60) stop 'Error in convtime: minute out of range (0-60)'
+ if (minvalue < 0 .or. minvalue > 60) stop 'Error in convtime: minute out of range (0-60)'
! convert time (test if leap year)
if (is_leap_year(yr)) then
- timestamp = year(yr)+leap_mon(mon)+((day-1)*min_day)+(hr*min_hr)+min
+ timestamp = year(yr)+leap_mon(mon)+((day-1)*min_day)+(hr*min_hr)+minvalue
else
- timestamp = year(yr)+month(mon)+((day-1)*min_day)+(hr*min_hr)+min
+ timestamp = year(yr)+month(mon)+((day-1)*min_day)+(hr*min_hr)+minvalue
endif
end subroutine convtime
@@ -84,7 +127,7 @@
!----
!
- subroutine invtime(timestamp,yr,mon,day,hr,min)
+ subroutine invtime(timestamp,yr,mon,day,hr,minvalue)
! This subroutine will convert a minutes timestamp to a year/month
! date. Based on the function convtime by Shawn Smith (COAPS).
@@ -104,7 +147,7 @@
integer, intent(in) :: timestamp
- integer, intent(out) :: yr,mon,day,hr,min
+ integer, intent(out) :: yr,mon,day,hr,minvalue
integer :: year(1980:MAX_YEAR),month(13),leap_mon(13)
@@ -176,7 +219,7 @@
mon=imon
day=1
hr=0
- min=0
+ minvalue=0
return
endif
@@ -199,7 +242,7 @@
mon=imon
day=1
hr=0
- min=0
+ minvalue=0
return
endif
endif
@@ -237,7 +280,7 @@
hr=ihour
! the remainder at this point is the minutes, so return them directly
- min=itime
+ minvalue=itime
end subroutine invtime
diff --git a/src/specfem2D/createnum_fast.f90 b/src/specfem2D/createnum_fast.f90
index d643ef8..d93a09f 100644
--- a/src/specfem2D/createnum_fast.f90
+++ b/src/specfem2D/createnum_fast.f90
@@ -42,7 +42,7 @@
!
!========================================================================
- subroutine createnum_fast(knods,ibool,shape,coorg,nglob,npgeo,nspec,ngnod,myrank)
+ subroutine createnum_fast(knods,ibool,shapeval,coorg,nglob,npgeo,nspec,ngnod,myrank)
! same as subroutine "createnum_slow" but with a faster algorithm
@@ -52,13 +52,13 @@
integer nglob,npgeo,nspec,ngnod,myrank
integer knods(ngnod,nspec),ibool(NGLLX,NGLLZ,nspec)
- double precision shape(ngnod,NGLLX,NGLLX)
+ double precision shapeval(ngnod,NGLLX,NGLLX)
double precision coorg(NDIM,npgeo)
integer i,j
! additional arrays needed for this fast version
- integer, dimension(:), allocatable :: loc,ind,ninseg,iglob,iwork
+ integer, dimension(:), allocatable :: locval,ind,ninseg,iglob,iwork
logical, dimension(:), allocatable :: ifseg
double precision, dimension(:), allocatable :: xp,yp,work
@@ -80,7 +80,7 @@
nxyz = NGLLX*NGLLZ
ntot = nxyz*nspec
- allocate(loc(ntot))
+ allocate(locval(ntot))
allocate(ind(ntot))
allocate(ninseg(ntot))
allocate(iglob(ntot))
@@ -104,8 +104,8 @@
ycor = zero
do in = 1,ngnod
nnum = knods(in,ispec)
- xcor = xcor + shape(in,ix,iy)*coorg(1,nnum)
- ycor = ycor + shape(in,ix,iy)*coorg(2,nnum)
+ xcor = xcor + shapeval(in,ix,iy)*coorg(1,nnum)
+ ycor = ycor + shapeval(in,ix,iy)*coorg(2,nnum)
enddo
xp(ilocnum + ieoff) = xcor
@@ -122,7 +122,7 @@
do ispec = 1,nspec
ieoff = nxyz*(ispec -1)
do ix = 1,nxyz
- loc (ix+ieoff) = ix+ieoff
+ locval (ix+ieoff) = ix+ieoff
enddo
enddo
@@ -169,7 +169,7 @@
endif
call swap(xp(ioff),work,ind,ninseg(iseg))
call swap(yp(ioff),work,ind,ninseg(iseg))
- call iswap(loc(ioff),iwork,ind,ninseg(iseg))
+ call iswap(locval(ioff),iwork,ind,ninseg(iseg))
ioff=ioff+ninseg(iseg)
enddo
! Check for jumps in current coordinate
@@ -199,7 +199,7 @@
ig = 0
do i=1,ntot
if (ifseg(i)) ig=ig+1
- iglob(loc(i)) = ig
+ iglob(locval(i)) = ig
enddo
nglob = ig
@@ -218,7 +218,7 @@
enddo
enddo
- deallocate(loc)
+ deallocate(locval)
deallocate(ind)
deallocate(ninseg)
deallocate(iglob)
diff --git a/src/specfem2D/get_MPI.F90 b/src/specfem2D/get_MPI.F90
index 33848d6..0c65a19 100644
--- a/src/specfem2D/get_MPI.F90
+++ b/src/specfem2D/get_MPI.F90
@@ -101,7 +101,7 @@
integer :: iinterface,ilocnum
integer :: num_points1, num_points2
! assembly test
- integer :: i,j,ispec,iglob,count,inum,ier,idomain
+ integer :: i,j,ispec,iglob,countval,inum,ier,idomain
integer :: max_nibool_interfaces,num_nibool,num_interface
real(kind=CUSTOM_REAL), dimension(:),allocatable :: test_flag_cr
real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: buffer_send_faces_vector_ac
@@ -237,13 +237,14 @@
! checks interfaces in acoustic domains
inum = 0
- count = 0
+ countval = 0
+
if ( ninterface_acoustic > 0) then
! checks with assembly of test fields
allocate(test_flag_cr(nglob))
test_flag_cr(:) = 0._CUSTOM_REAL
- count = 0
+ countval = 0
do ispec = 1, nspec
! sets flags on global points
do j = 1, NGLLZ
@@ -252,7 +253,7 @@
iglob = ibool(i,j,ispec)
! counts number of unique global points to set
- if( nint(test_flag_cr(iglob)) == 0 ) count = count+1
+ if( nint(test_flag_cr(iglob)) == 0 ) countval = countval + 1
! sets identifier
test_flag_cr(iglob) = myrank + 1.0
@@ -306,8 +307,7 @@
endif
! note: this mpi reduction awaits information from all processes.
- call MPI_REDUCE(inum, num_points2, 1, MPI_INTEGER, &
- MPI_SUM, 0, MPI_COMM_WORLD, ier)
+ call MPI_REDUCE(inum, num_points2, 1, MPI_INTEGER, MPI_SUM, 0, MPI_COMM_WORLD, ier)
if( myrank == 0 ) then
write(IOUT,*) ' assembly acoustic MPI interface points:',num_points2
diff --git a/src/specfem2D/netlib_specfun_erf.f90 b/src/specfem2D/netlib_specfun_erf.f90
index bf2ae89..2ae1d21 100644
--- a/src/specfem2D/netlib_specfun_erf.f90
+++ b/src/specfem2D/netlib_specfun_erf.f90
@@ -1,5 +1,5 @@
- subroutine calerf(ARG,RESULT,JINT)
+ subroutine calerf(ARG,RESULT,jintval)
!------------------------------------------------------------------
!
@@ -24,12 +24,12 @@
! routine. The function subprograms invoke CALERF with the
! statement
!
-! call CALERF(ARG,RESULT,JINT)
+! call CALERF(ARG,RESULT,jintval)
!
! where the parameter usage is as follows
!
! Function Parameters for CALERF
-! call ARG Result JINT
+! call ARG Result jintval
!
! ERF(ARG) ANY REAL ARGUMENT ERF(ARG) 0
!
@@ -88,7 +88,7 @@
implicit none
- integer I,JINT
+ integer I,jintval
double precision A,ARG,B,C,D,DEL,FOUR,HALF,P,ONE,Q,RESULT,SIXTEEN,SQRPI, &
TWO,THRESHOLD,X,XBIG,XDEN,XHUGE,XINF,XMAX,XNEG,XNUM,XSMALL, &
Y,YSQ,ZERO
@@ -157,8 +157,8 @@
enddo
RESULT = X * (XNUM + A(4)) / (XDEN + B(4))
- if (JINT /= 0) RESULT = ONE - RESULT
- if (JINT == 2) RESULT = EXP(YSQ) * RESULT
+ if (jintval /= 0) RESULT = ONE - RESULT
+ if (jintval == 2) RESULT = EXP(YSQ) * RESULT
goto 800
!------------------------------------------------------------------
@@ -174,7 +174,7 @@
enddo
RESULT = (XNUM + C(8)) / (XDEN + D(8))
- if (JINT /= 2) then
+ if (jintval /= 2) then
YSQ = AINT(Y*SIXTEEN)/SIXTEEN
DEL = (Y-YSQ)*(Y+YSQ)
RESULT = EXP(-YSQ*YSQ) * EXP(-DEL) * RESULT
@@ -186,7 +186,7 @@
else
RESULT = ZERO
if (Y >= XBIG) then
- if (JINT /= 2 .OR. Y >= XMAX) goto 300
+ if (jintval /= 2 .OR. Y >= XMAX) goto 300
if (Y >= XHUGE) then
RESULT = SQRPI / Y
goto 300
@@ -203,7 +203,7 @@
RESULT = YSQ *(XNUM + P(5)) / (XDEN + Q(5))
RESULT = (SQRPI - RESULT) / Y
- if (JINT /= 2) then
+ if (jintval /= 2) then
YSQ = AINT(Y*SIXTEEN)/SIXTEEN
DEL = (Y-YSQ)*(Y+YSQ)
RESULT = EXP(-YSQ*YSQ) * EXP(-DEL) * RESULT
@@ -213,10 +213,10 @@
!------------------------------------------------------------------
! Fix up for negative argument, erf, etc.
!------------------------------------------------------------------
- 300 if (JINT == 0) then
+ 300 if (jintval == 0) then
RESULT = (HALF - RESULT) + HALF
if (X < ZERO) RESULT = -RESULT
- else if (JINT == 1) then
+ else if (jintval == 1) then
if (X < ZERO) RESULT = TWO - RESULT
else
if (X < ZERO) then
@@ -246,11 +246,11 @@
implicit none
- integer JINT
+ integer jintval
double precision X, RESULT
- JINT = 0
- call calerf(X,RESULT,JINT)
+ jintval = 0
+ call calerf(X,RESULT,jintval)
netlib_specfun_erf = RESULT
end function netlib_specfun_erf
diff --git a/src/specfem2D/pml_init.F90 b/src/specfem2D/pml_init.F90
index 4310dc4..c69e4fb 100644
--- a/src/specfem2D/pml_init.F90
+++ b/src/specfem2D/pml_init.F90
@@ -433,14 +433,14 @@ end subroutine pml_init
ibool,coord,is_PML,region_CPML,spec_to_PML,nspec_PML,&
K_x_store,K_z_store,d_x_store,d_z_store,alpha_x_store,alpha_z_store)
+#ifdef USE_MPI
+ use mpi
+#endif
+
implicit none
include "constants.h"
-#ifdef USE_MPI
- include "mpif.h"
-#endif
-
integer nspec,npoin,numat,nspec_PML
double precision :: f0_temp
diff --git a/src/specfem2D/prepare_source_time_function.f90 b/src/specfem2D/prepare_source_time_function.f90
index 8317a0e..1d810c1 100644
--- a/src/specfem2D/prepare_source_time_function.f90
+++ b/src/specfem2D/prepare_source_time_function.f90
@@ -68,7 +68,7 @@
real(kind=CUSTOM_REAL),dimension(NSOURCES,NSTEP,stage_time_scheme) :: source_time_function
! local parameters
- double precision :: stf_used, time, DecT, Tc, omegat, omega_coa
+ double precision :: stf_used, timeval, DecT, Tc, omegat, omega_coa
double precision, dimension(NSOURCES) :: hdur,hdur_gauss
double precision, external :: netlib_specfun_erf
integer :: it,i_source
@@ -103,18 +103,11 @@
do i_stage = 1,stage_time_scheme
! compute current time
- if(stage_time_scheme == 1)then
- time = (it-1)*deltat
- endif
+ if(stage_time_scheme == 1) timeval = (it-1)*deltat
- if(stage_time_scheme == 4)then
- time = (it-1)*deltat+c_RK(i_stage)*deltat
- endif
-
- if(stage_time_scheme == 6)then
- time = (it-1)*deltat+c_LDDRK(i_stage)*deltat
- endif
+ if(stage_time_scheme == 4) timeval = (it-1)*deltat+c_RK(i_stage)*deltat
+ if(stage_time_scheme == 6) timeval = (it-1)*deltat+c_LDDRK(i_stage)*deltat
stf_used = 0.d0
@@ -125,25 +118,25 @@
! Ricker (second derivative of a Gaussian) source time function
source_time_function(i_source,it,i_stage) = - factor(i_source) * &
- (ONE-TWO*aval(i_source)*(time-t0-tshift_src(i_source))**2) * &
- exp(-aval(i_source)*(time-t0-tshift_src(i_source))**2)
+ (ONE-TWO*aval(i_source)*(timeval-t0-tshift_src(i_source))**2) * &
+ exp(-aval(i_source)*(timeval-t0-tshift_src(i_source))**2)
! source_time_function(i_source,it) = - factor(i_source) * &
! TWO*aval(i_source)*sqrt(aval(i_source))*&
- ! (time-t0-tshift_src(i_source))/pi * exp(-aval(i_source)*(time-t0-tshift_src(i_source))**2)
+ ! (timeval-t0-tshift_src(i_source))/pi * exp(-aval(i_source)*(timeval-t0-tshift_src(i_source))**2)
else if( time_function_type(i_source) == 2 ) then
! first derivative of a Gaussian source time function
source_time_function(i_source,it,i_stage) = - factor(i_source) * &
- TWO*aval(i_source)*(time-t0-tshift_src(i_source)) * &
- exp(-aval(i_source)*(time-t0-tshift_src(i_source))**2)
+ TWO*aval(i_source)*(timeval-t0-tshift_src(i_source)) * &
+ exp(-aval(i_source)*(timeval-t0-tshift_src(i_source))**2)
else if(time_function_type(i_source) == 3 .or. time_function_type(i_source) == 4) then
! Gaussian or Dirac (we use a very thin Gaussian instead) source time function
source_time_function(i_source,it,i_stage) = factor(i_source) * &
- exp(-aval(i_source)*(time-t0-tshift_src(i_source))**2)
+ exp(-aval(i_source)*(timeval-t0-tshift_src(i_source))**2)
else if(time_function_type(i_source) == 5) then
@@ -151,7 +144,7 @@
hdur(i_source) = 1.d0 / f0(i_source)
hdur_gauss(i_source) = hdur(i_source) * 5.d0 / 3.d0
source_time_function(i_source,it,i_stage) = factor(i_source) * 0.5d0*(1.0d0 + &
- netlib_specfun_erf(SOURCE_DECAY_MIMIC_TRIANGLE*(time-t0-tshift_src(i_source))/hdur_gauss(i_source)))
+ netlib_specfun_erf(SOURCE_DECAY_MIMIC_TRIANGLE*(timeval-t0-tshift_src(i_source))/hdur_gauss(i_source)))
else if(time_function_type(i_source) == 6) then
@@ -159,11 +152,11 @@
Tc = 4.d0 / f0(i_source) + DecT
- if ( time > DecT .and. time < Tc ) then
+ if ( timeval > DecT .and. timeval < Tc ) then
! source time function from Computational Ocean Acoustics
omega_coa = TWO * PI * f0(i_source)
- omegat = omega_coa * ( time - DecT )
+ omegat = omega_coa * ( timeval - DecT )
source_time_function(i_source,it,i_stage) = factor(i_source) * HALF * &
sin( omegat ) * ( ONE - cos( QUARTER * omegat ) )
!source_time_function(i_source,it,i_stage) = - factor(i_source) * HALF / omega_coa / omega_coa * &
@@ -181,18 +174,18 @@
Tc = 4.d0 / f0(i_source) + DecT
omega_coa = TWO * PI * f0(i_source)
- if ( time > DecT .and. time < Tc ) then
+ if ( timeval > DecT .and. timeval < Tc ) then
! source time function from Computational Ocean Acoustics
- omegat = omega_coa * ( time - DecT )
+ omegat = omega_coa * ( timeval - DecT )
!source_time_function(i_source,it,i_stage) = factor(i_source) * HALF / omega_coa / omega_coa * &
! ( sin(omegat) - 8.d0 / 9.d0 * sin(3.d0/ 4.d0 * omegat) - &
- ! 8.d0 / 25.d0 * sin(5.d0 / 4.d0 * omegat) -1./15.*( time - DecT ) + 1./15.*4./f0(i_source))
+ ! 8.d0 / 25.d0 * sin(5.d0 / 4.d0 * omegat) -1./15.*( timeval - DecT ) + 1./15.*4./f0(i_source))
source_time_function(i_source,it,i_stage) = factor(i_source) * HALF / omega_coa / omega_coa * &
( - sin(omegat) + 8.d0 / 9.d0 * sin(3.d0 / 4.d0 * omegat) + &
8.d0 / 25.d0 * sin(5.d0 / 4.d0 * omegat) - 1.d0 / 15.d0 * omegat )
- else if ( time > DecT ) then
+ else if ( timeval > DecT ) then
source_time_function(i_source,it,i_stage) = - factor(i_source) * HALF / omega_coa / 15.d0 * (4.d0 / f0(i_source))
@@ -210,10 +203,10 @@
stf_used = stf_used + source_time_function(i_source,it,i_stage)
! output relative time in third column, in case user wants to check it as well
- ! if (myrank == 0 .and. i_source == 1) write(55,*) sngl(time-t0-tshift_src(1)),real(source_time_function(1,it),4),sngl(time)
+! if (myrank == 0 .and. i_source == 1) write(55,*) sngl(timeval-t0-tshift_src(1)),real(source_time_function(1,it),4),sngl(timeval)
if (myrank == 0 .and. i_source == 1 .and. i_stage == 1) then
! note: earliest start time of the simulation is: (it-1)*deltat - t0
- write(55,*) sngl(time-t0),sngl(stf_used),sngl(time)
+ write(55,*) sngl(timeval-t0),sngl(stf_used),sngl(timeval)
endif
enddo
diff --git a/src/specfem2D/sort_array_coordinates.F90 b/src/specfem2D/sort_array_coordinates.F90
index 27e3180..8b0c932 100644
--- a/src/specfem2D/sort_array_coordinates.F90
+++ b/src/specfem2D/sort_array_coordinates.F90
@@ -47,7 +47,7 @@
! subroutines to sort MPI buffers to assemble between chunks
- subroutine sort_array_coordinates(npointot,x,z,ibool,iglob,loc,ifseg, &
+ subroutine sort_array_coordinates(npointot,x,z,ibool,iglob,locval,ifseg, &
nglob,ind,ninseg,iwork,work)
! this routine MUST be in double precision to avoid sensitivity
@@ -64,7 +64,7 @@
integer,intent(inout) :: ibool(npointot)
- integer iglob(npointot),loc(npointot)
+ integer iglob(npointot),locval(npointot)
integer ind(npointot),ninseg(npointot)
logical ifseg(npointot)
double precision,intent(in) :: x(npointot),z(npointot)
@@ -79,7 +79,7 @@
! establish initial pointers
do ipoin=1,npointot
- loc(ipoin)=ipoin
+ locval(ipoin)=ipoin
enddo
ifseg(:)=.false.
@@ -100,7 +100,7 @@
call rank_buffers(z(ioff),ind,ninseg(iseg))
endif
- call swap_all_buffers(ibool(ioff),loc(ioff), &
+ call swap_all_buffers(ibool(ioff),locval(ioff), &
x(ioff),z(ioff),iwork,work,ind,ninseg(iseg))
ioff=ioff+ninseg(iseg)
@@ -133,7 +133,7 @@
ig=0
do i=1,npointot
if(ifseg(i)) ig=ig+1
- iglob(loc(i))=ig
+ iglob(locval(i))=ig
enddo
nglob=ig
diff --git a/src/specfem2D/specfem2D.F90 b/src/specfem2D/specfem2D.F90
index 49c9f9f..8737072 100644
--- a/src/specfem2D/specfem2D.F90
+++ b/src/specfem2D/specfem2D.F90
@@ -455,7 +455,7 @@
! coefficients of the explicit Newmark time scheme
integer NSTEP
- double precision :: deltatover2,deltatsquareover2,time
+ double precision :: deltatover2,deltatsquareover2,timeval
double precision :: deltat
! Gauss-Lobatto-Legendre points and weights
@@ -4934,7 +4934,7 @@ if(coupled_elastic_poro) then
do it = 1,NSTEP
! compute current time
- time = (it-1)*deltat
+ timeval = (it-1)*deltat
do i_stage=1, stage_time_scheme
@@ -5330,7 +5330,7 @@ if(coupled_elastic_poro) then
fluid_solid_elastic_ispec,fluid_solid_elastic_iedge,&
AXISYM,nglob,coord,is_on_the_axis,xiglj,wxglj, &
PML_BOUNDARY_CONDITIONS,nspec_PML,K_x_store,K_z_store,d_x_store,d_z_store,alpha_x_store,&
- alpha_z_store,is_PML,spec_to_PML,region_CPML,rmemory_fsb_displ_elastic,time,deltat)
+ alpha_z_store,is_PML,spec_to_PML,region_CPML,rmemory_fsb_displ_elastic,timeval,deltat)
endif
if(SIMULATION_TYPE == 3)then
@@ -5340,7 +5340,7 @@ if(coupled_elastic_poro) then
fluid_solid_elastic_ispec,fluid_solid_elastic_iedge,&
AXISYM,nglob,coord,is_on_the_axis,xiglj,wxglj, &
PML_BOUNDARY_CONDITIONS,nspec_PML,K_x_store,K_z_store,d_x_store,d_z_store,alpha_x_store,&
- alpha_z_store,is_PML,spec_to_PML,region_CPML,rmemory_fsb_displ_elastic,time,deltat)
+ alpha_z_store,is_PML,spec_to_PML,region_CPML,rmemory_fsb_displ_elastic,timeval,deltat)
call compute_coupling_acoustic_el(nspec,nglob_elastic,nglob_acoustic,num_fluid_solid_edges,ibool,wxgll,wzgll,xix,xiz,&
gammax,gammaz,jacobian,ivalue,jvalue,ivalue_inverse,jvalue_inverse,b_displ_elastic,b_displ_elastic_old,&
@@ -5348,7 +5348,7 @@ if(coupled_elastic_poro) then
fluid_solid_elastic_ispec,fluid_solid_elastic_iedge,&
AXISYM,nglob,coord,is_on_the_axis,xiglj,wxglj, &
PML_BOUNDARY_CONDITIONS,nspec_PML,K_x_store,K_z_store,d_x_store,d_z_store,alpha_x_store,&
- alpha_z_store,is_PML,spec_to_PML,region_CPML,rmemory_fsb_displ_elastic,time,deltat)
+ alpha_z_store,is_PML,spec_to_PML,region_CPML,rmemory_fsb_displ_elastic,timeval,deltat)
endif
endif
@@ -8535,7 +8535,7 @@ if(coupled_elastic_poro) then
!---- display time step and max of norm of displacement
if(mod(it,NSTEP_BETWEEN_OUTPUT_INFO) == 0 .or. it == 5 .or. it == NSTEP) then
- call check_stability(myrank,time,it,NSTEP,NOISE_TOMOGRAPHY, &
+ call check_stability(myrank,timeval,it,NSTEP,NOISE_TOMOGRAPHY, &
nglob_acoustic,nglob_elastic,nglob_poroelastic, &
any_elastic_glob,any_elastic,displ_elastic, &
any_poroelastic_glob,any_poroelastic, &
More information about the CIG-COMMITS
mailing list