[cig-commits] [commit] devel: Remove code-duplicating comments. (5ae80c7)
cig_noreply at geodynamics.org
cig_noreply at geodynamics.org
Thu May 1 00:50:20 PDT 2014
Repository : ssh://geoshell/specfem3d
On branch : devel
Link : https://github.com/geodynamics/specfem3d/compare/cb32c88d6155d7974561a6f72fc17aea596e2c4d...50aa953c1db3f565d76415f5305410a529996b75
>---------------------------------------------------------------
commit 5ae80c7fb55de5dcd419f32bc58b8d5d9193d109
Author: Elliott Sales de Andrade <esalesde at physics.utoronto.ca>
Date: Sat Jan 11 03:31:51 2014 -0500
Remove code-duplicating comments.
These comments duplicate some other code somewhere else. That's just
confusing, plus they're starting to get out of date now.
>---------------------------------------------------------------
5ae80c7fb55de5dcd419f32bc58b8d5d9193d109
src/meshfem3D/save_databases.f90 | 4 --
src/specfem3D/compute_arrays_source.f90 | 83 --------------------------------
src/specfem3D/fault_solver_common.f90 | 6 ---
src/specfem3D/fault_solver_dynamic.f90 | 43 -----------------
src/specfem3D/fault_solver_kinematic.f90 | 24 ---------
src/specfem3D/read_mesh_databases.F90 | 24 ---------
6 files changed, 184 deletions(-)
diff --git a/src/meshfem3D/save_databases.f90 b/src/meshfem3D/save_databases.f90
index 07989bb..9128baf 100644
--- a/src/meshfem3D/save_databases.f90
+++ b/src/meshfem3D/save_databases.f90
@@ -100,7 +100,6 @@
! Materials properties
write(IIN_database) NMATERIALS, 0
do idoubl = 1,NMATERIALS
- !write(IIN_database,*) material_properties(idoubl,:)
matpropl(:) = 0.d0
matpropl(1:6) = material_properties(idoubl,1:6)
! pad dummy zeros to fill up 16 entries (poroelastic medium not allowed)
@@ -110,9 +109,6 @@
write(IIN_database) nspec
do ispec=1,nspec
- !write(IIN_database,'(11i14)') ispec,true_material_num(ispec),1,ibool(1,1,1,ispec),ibool(2,1,1,ispec),&
- ! ibool(2,2,1,ispec),ibool(1,2,1,ispec),ibool(1,1,2,ispec),&
- ! ibool(2,1,2,ispec),ibool(2,2,2,ispec),ibool(1,2,2,ispec)
write(IIN_database) ispec,true_material_num(ispec),1,ibool(1,1,1,ispec),ibool(2,1,1,ispec),&
ibool(2,2,1,ispec),ibool(1,2,1,ispec),ibool(1,1,2,ispec),&
ibool(2,1,2,ispec),ibool(2,2,2,ispec),ibool(1,2,2,ispec)
diff --git a/src/specfem3D/compute_arrays_source.f90 b/src/specfem3D/compute_arrays_source.f90
index bc7ceb6..c190f8c 100644
--- a/src/specfem3D/compute_arrays_source.f90
+++ b/src/specfem3D/compute_arrays_source.f90
@@ -243,86 +243,3 @@ end subroutine compute_arrays_adjoint_source
end subroutine compute_arrays_source_acoustic
-
-! testing read in adjoint sources block by block
-
-!!!the original version
-!!!
-!!!subroutine compute_arrays_adjoint_source(myrank, adj_source_file, &
-!!! xi_receiver,eta_receiver,gamma_receiver, adj_sourcearray, &
-!!! xigll,yigll,zigll,NSTEP)
-!!!
-!!!
-!!! implicit none
-!!!
-!!! include 'constants.h'
-!!!
-!!!! input
-!!! integer myrank, NSTEP
-!!!
-!!! double precision xi_receiver, eta_receiver, gamma_receiver
-!!!
-!!! character(len=*) adj_source_file
-!!!
-!!!! output
-!!! real(kind=CUSTOM_REAL),dimension(NSTEP,NDIM,NGLLX,NGLLY,NGLLZ) :: adj_sourcearray
-!!!
-!!!! Gauss-Lobatto-Legendre points of integration and weights
-!!! double precision, dimension(NGLLX) :: xigll
-!!! double precision, dimension(NGLLY) :: yigll
-!!! double precision, dimension(NGLLZ) :: zigll
-!!!
-!!! double precision :: hxir(NGLLX), hpxir(NGLLX), hetar(NGLLY), hpetar(NGLLY), &
-!!! hgammar(NGLLZ), hpgammar(NGLLZ)
-!!!
-!!! real(kind=CUSTOM_REAL) :: adj_src(NSTEP,NDIM)
-!!!
-!!! integer icomp, itime, i, j, k, ios
-!!! double precision :: junk
-!!! ! note: should have same order as orientation in write_seismograms_to_file()
-!!! character(len=3),dimension(NDIM) :: comp = (/ "BHE", "BHN", "BHZ" /)
-!!! character(len=256) :: filename
-!!!
-!!! !adj_sourcearray(:,:,:,:,:) = 0.
-!!! adj_src = 0._CUSTOM_REAL
-!!!
-!!! ! loops over components
-!!! do icomp = 1, NDIM
-!!!
-!!! filename = 'SEM/'//trim(adj_source_file) // '.'// comp(icomp) // '.adj'
-!!! open(unit=IIN,file=trim(filename),status='old',action='read',iostat = ios)
-!!! if (ios /= 0) cycle ! cycles to next file
-!!! !if (ios /= 0) call exit_MPI(myrank, ' file '//trim(filename)//'does not exist')
-!!!
-!!! ! reads in adjoint source trace
-!!! do itime = 1, NSTEP
-!!!
-!!! ! things become a bit tricky because of the Newmark time scheme at
-!!! ! the very beginning of the time loop. however, when we read in the backward/reconstructed
-!!! ! wavefields at the end of the first time loop, we can use the adjoint source index from 1 to NSTEP
-!!! ! (and then access it in reverse NSTEP-it+1 down to 1, for it=1,..NSTEP; see compute_add_sources*.f90).
-!!! read(IIN,*,iostat=ios) junk, adj_src(itime,icomp)
-!!! if( ios /= 0 ) &
-!!! call exit_MPI(myrank, &
-!!! 'file '//trim(filename)//' has wrong length, please check with your simulation duration')
-!!! enddo
-!!! close(IIN)
-!!!
-!!! enddo
-!!!
-!!! ! lagrange interpolators for receiver location
-!!! call lagrange_any(xi_receiver,NGLLX,xigll,hxir,hpxir)
-!!! call lagrange_any(eta_receiver,NGLLY,yigll,hetar,hpetar)
-!!! call lagrange_any(gamma_receiver,NGLLZ,zigll,hgammar,hpgammar)
-!!!
-!!! ! interpolates adjoint source onto GLL points within this element
-!!! do k = 1, NGLLZ
-!!! do j = 1, NGLLY
-!!! do i = 1, NGLLX
-!!! adj_sourcearray(:,:,i,j,k) = hxir(i) * hetar(j) * hgammar(k) * adj_src(:,:)
-!!! enddo
-!!! enddo
-!!! enddo
-!!!
-!!!end subroutine compute_arrays_adjoint_source
-
diff --git a/src/specfem3D/fault_solver_common.f90 b/src/specfem3D/fault_solver_common.f90
index 3b01cb4..df41a60 100644
--- a/src/specfem3D/fault_solver_common.f90
+++ b/src/specfem3D/fault_solver_common.f90
@@ -36,8 +36,6 @@ module fault_solver_common
implicit none
-!!!!! DK DK private
-
type fault_type
integer :: nspec=0, nglob=0
real(kind=CUSTOM_REAL), dimension(:,:), pointer :: T=>null(),V=>null(),D=>null(),coord=>null()
@@ -59,7 +57,6 @@ module fault_solver_common
end type dataXZ_type
type swf_type
-!! DK DK private
integer :: kind
logical :: healing = .false.
real(kind=CUSTOM_REAL), dimension(:), pointer :: Dc=>null(), mus=>null(), mud=>null(), &
@@ -67,7 +64,6 @@ module fault_solver_common
end type swf_type
type rsf_type
-!! DK DK private
integer :: StateLaw = 1 ! 1=ageing law, 2=slip law
real(kind=CUSTOM_REAL), dimension(:), pointer :: V0=>null(), f0=>null(), L=>null(), &
V_init=>null(), &
@@ -87,7 +83,6 @@ module fault_solver_common
end type dataT_type
type, extends (fault_type) :: bc_dynandkinflt_type
-!!!!!!!! DK DK private
real(kind=CUSTOM_REAL), dimension(:,:), pointer :: T0=>null()
real(kind=CUSTOM_REAL), dimension(:), pointer :: MU=>null(), Fload=>null()
integer, dimension(:), pointer :: npoin_perproc=>null(), poin_offset=>null()
@@ -498,7 +493,6 @@ end subroutine init_dataT
!---------------------------------------------------------------
subroutine store_dataT(dataT,d,v,t,itime)
- !use specfem_par, only : myrank
!! DK DK use type() instead of class() for compatibility with some current compilers
type(dataT_type), intent(inout) :: dataT
real(kind=CUSTOM_REAL), dimension(:,:), intent(in) :: d,v,t
diff --git a/src/specfem3D/fault_solver_dynamic.f90 b/src/specfem3D/fault_solver_dynamic.f90
index bf2073a..d684ffe 100644
--- a/src/specfem3D/fault_solver_dynamic.f90
+++ b/src/specfem3D/fault_solver_dynamic.f90
@@ -44,49 +44,6 @@ module fault_solver_dynamic
private
-!! DK DK moved this to fault_common in order to use it there
-
-! ! outputs(dyn) /inputs (kind) at selected times for all fault nodes:
-! ! strength, state, slip, slip velocity, fault stresses, rupture time, process zone time
-! ! rupture time = first time when slip velocity = threshold V_RUPT (defined below)
-! ! process zone time = first time when slip = Dc
-! type dataXZ_type
-! real(kind=CUSTOM_REAL), dimension(:), pointer :: stg=>null(), sta=>null(), d1=>null(), d2=>null(), v1=>null(), v2=>null(), &
-! t1=>null(), t2=>null(), t3=>null(), tRUP=>null(), tPZ=>null()
-! real(kind=CUSTOM_REAL), dimension(:), pointer :: xcoord=>null(), ycoord=>null(), zcoord=>null()
-! integer :: npoin=0
-! end type dataXZ_type
-
-! type swf_type
-! private
-! integer :: kind
-! logical :: healing = .false.
-! real(kind=CUSTOM_REAL), dimension(:), pointer :: Dc=>null(), mus=>null(), mud=>null(), &
-! theta=>null(), T=>null(), C=>null()
-! end type swf_type
-
-! type rsf_type
-! private
-! integer :: StateLaw = 1 ! 1=ageing law, 2=slip law
-! real(kind=CUSTOM_REAL), dimension(:), pointer :: V0=>null(), f0=>null(), L=>null(), &
-! V_init=>null(), &
-! a=>null(), b=>null(), theta=>null(), &
-! T=>null(), C=>null(), &
-! fw=>null(), Vw=>null()
-! end type rsf_type
-
-! type, extends (fault_type) :: bc_dynandkinflt_type
-! private
-! real(kind=CUSTOM_REAL), dimension(:,:), pointer :: T0=>null()
-! real(kind=CUSTOM_REAL), dimension(:), pointer :: MU=>null(), Fload=>null()
-! integer, dimension(:), pointer :: npoin_perproc=>null(), poin_offset=>null()
-! type(dataT_type) :: dataT
-! type(dataXZ_type) :: dataXZ,dataXZ_all
-! type(swf_type), pointer :: swf => null()
-! type(rsf_type), pointer :: rsf => null()
-! logical :: allow_opening = .false. ! default : do not allow opening
-! end type bc_dynandkinflt_type
-
type(bc_dynandkinflt_type), allocatable, save :: faults(:)
!slip velocity threshold for healing
diff --git a/src/specfem3D/fault_solver_kinematic.f90 b/src/specfem3D/fault_solver_kinematic.f90
index 2e220b6..226f269 100644
--- a/src/specfem3D/fault_solver_kinematic.f90
+++ b/src/specfem3D/fault_solver_kinematic.f90
@@ -39,28 +39,6 @@ module fault_solver_kinematic
private
-!! DK DK used the "dynamic" version that I moved to "fault_common" instead
-!! DK DK works fine because it has all the elements needed below, plus some others that are then simply unused
-! type dataXZ_type
-! integer :: npoin=0
-! real(kind=CUSTOM_REAL), dimension(:), pointer :: d1=>null(), d2=>null(), &
-! v1=>null(), v2=>null(), &
-! t1=>null(), t2=>null(), t3=>null(), &
-! xcoord=>null(), ycoord=>null(), zcoord=>null()
-! end type dataXZ_type
-
-!! DK DK not needed any more, merged into a new "bc_dynandkinflt_type" to avoid having to use the "class" keyword,
-!! DK DK which is currently not supported by many Fortran compilers (and it is crucial for us to keep full portability)
-! type, extends (fault_type) :: bc_kinflt_type
-! private
-! type(dataT_type) :: dataT
-! type(dataXZ_type) :: dataXZ
-! real(kind=CUSTOM_REAL) :: kin_dt
-! integer :: kin_it
-! real(kind=CUSTOM_REAL), dimension(:,:), pointer :: v_kin_t1,v_kin_t2
-! end type bc_kinflt_type
-
-!! DK DK now use bc_dynandkinflt_type here instead
type(bc_dynandkinflt_type), allocatable, save :: faults(:)
!Number of time steps defined by the user : NTOUT
@@ -158,7 +136,6 @@ end subroutine BC_KINFLT_init
subroutine init_one_fault(bc,IIN_BIN,IIN_PAR,dt,NT,iflt)
-!! DK DK now use bc_dynandkinflt_type here instead
type(bc_dynandkinflt_type), intent(inout) :: bc
integer, intent(in) :: IIN_BIN,IIN_PAR,NT,iflt
real(kind=CUSTOM_REAL), intent(in) :: dt
@@ -227,7 +204,6 @@ subroutine BC_KINFLT_set_single(bc,MxA,V,D,iflt)
use specfem_par, only:it,NSTEP
real(kind=CUSTOM_REAL), intent(inout) :: MxA(:,:)
-!! DK DK now use bc_dynandkinflt_type here instead
type(bc_dynandkinflt_type), intent(inout) :: bc
real(kind=CUSTOM_REAL), intent(in) :: V(:,:),D(:,:)
integer,intent(in) :: iflt
diff --git a/src/specfem3D/read_mesh_databases.F90 b/src/specfem3D/read_mesh_databases.F90
index 8580f90..e7f7159 100644
--- a/src/specfem3D/read_mesh_databases.F90
+++ b/src/specfem3D/read_mesh_databases.F90
@@ -229,30 +229,6 @@
read(27,iostat=ier) rho_vs
if( ier /= 0 ) stop 'error reading in array rho_vs'
-!! DK DK rhostore is now allocated and read in all cases (see above)
-! ! checks if rhostore is available for gravity
-! if( GRAVITY ) then
-!
-! if( .not. ACOUSTIC_SIMULATION ) then
-! ! rho array needed for gravity
-! allocate(rhostore(NGLLX,NGLLY,NGLLZ,NSPEC_AB),stat=ier)
-! if( ier /= 0 ) stop 'error allocating array rhostore'
-!
-! ! extract rho information from mu = rho * vs * vs and rho_vs = rho * vs
-! rhostore = 0.0_CUSTOM_REAL
-! where( mustore > TINYVAL )
-! rhostore = (rho_vs*rho_vs) / mustore
-! endwhere
-!
-! ! note: the construct below leads to a segmentation fault (ifort v11.1). not sure why...
-! ! (where statement - standard fortran 95)
-! !where( mustore > TINYVAL )
-! ! rhostore = (rho_vs*rho_vs) / mustore
-! !elsewhere
-! ! rhostore = 0.0_CUSTOM_REAL
-! !endwhere
-! endif
-! endif
else
! no elastic attenuation & anisotropy
ATTENUATION = .false.
More information about the CIG-COMMITS
mailing list