[cig-commits] [commit] master: tidy up, removing unused stuff (ab234d1)
cig_noreply at geodynamics.org
cig_noreply at geodynamics.org
Fri Oct 17 05:30:25 PDT 2014
Repository : https://github.com/geodynamics/axisem
On branch : master
Link : https://github.com/geodynamics/axisem/compare/607f803cf074063627513d235f9ed0837fc1dd44...b6457db24acdde4a4e1c08935ae1b22adf87f5bf
>---------------------------------------------------------------
commit ab234d1cdbebbaec8590aba20a9c2923c05a2267
Author: martinvandriel <vandriel at erdw.ethz.ch>
Date: Fri Oct 17 11:55:54 2014 +0200
tidy up, removing unused stuff
>---------------------------------------------------------------
ab234d1cdbebbaec8590aba20a9c2923c05a2267
SOLVER/analytic_semi_mapping.f90 | 7 +-
SOLVER/analytic_spheroid_mapping.f90 | 10 +--
SOLVER/apply_masks.f90 | 1 +
SOLVER/get_mesh.f90 | 14 ++-
SOLVER/get_model.F90 | 166 +++++------------------------------
5 files changed, 35 insertions(+), 163 deletions(-)
diff --git a/SOLVER/analytic_semi_mapping.f90 b/SOLVER/analytic_semi_mapping.f90
index 4aab05c..fdaf8a7 100644
--- a/SOLVER/analytic_semi_mapping.f90
+++ b/SOLVER/analytic_semi_mapping.f90
@@ -19,9 +19,8 @@
! along with AxiSEM. If not, see <http://www.gnu.org/licenses/>.
!
-!==================================
+!=========================================================================================
module analytic_semi_mapping
-!==================================
!
! 10/01/2002: This module contains the
! machinery necessary to describe analytically
@@ -417,7 +416,5 @@ pure subroutine compute_theta(theta,s,z,a,b)
end subroutine compute_theta
!-----------------------------------------------------------------------------------------
-
-!=======================================
end module analytic_semi_mapping
-!=======================================
+!=========================================================================================
diff --git a/SOLVER/analytic_spheroid_mapping.f90 b/SOLVER/analytic_spheroid_mapping.f90
index be556bc..5a7687b 100644
--- a/SOLVER/analytic_spheroid_mapping.f90
+++ b/SOLVER/analytic_spheroid_mapping.f90
@@ -19,10 +19,9 @@
! along with AxiSEM. If not, see <http://www.gnu.org/licenses/>.
!
-!==================================
+!=========================================================================================
module analytic_spheroid_mapping
-!==================================
-!
+
!< 08/02/2002: This module contains the
!! machinery necessary to describe analytically
!! the transformation of the reference element
@@ -241,6 +240,5 @@ pure subroutine compute_theta(theta, s, z, a, b)
end subroutine compute_theta
!-----------------------------------------------------------------------------------------
-!=======================================
- end module analytic_spheroid_mapping
-!=======================================
+end module analytic_spheroid_mapping
+!=========================================================================================
diff --git a/SOLVER/apply_masks.f90 b/SOLVER/apply_masks.f90
index a1029ab..e95953d 100644
--- a/SOLVER/apply_masks.f90
+++ b/SOLVER/apply_masks.f90
@@ -98,6 +98,7 @@ pure subroutine apply_axis_mask_threecomp(u, nel, ax_array, nax_array)
end do
end subroutine apply_axis_mask_threecomp
+!-----------------------------------------------------------------------------------------
end module apply_masks
!=========================================================================================
diff --git a/SOLVER/get_mesh.f90 b/SOLVER/get_mesh.f90
index fb25352..cbe4d10 100644
--- a/SOLVER/get_mesh.f90
+++ b/SOLVER/get_mesh.f90
@@ -19,9 +19,8 @@
! along with AxiSEM. If not, see <http://www.gnu.org/licenses/>.
!
-!=================
+!=========================================================================================
module get_mesh
-!=================
! This module reads in mesh properties from the mesher (databases meshdb.dat),
! and allocates related memory.
@@ -44,7 +43,7 @@ module get_mesh
contains
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
subroutine read_db
! Read in the database generated by the mesher. File names are
! meshdb.dat0000, meshdb.dat0001, etc. for nproc-1 processor jobs.
@@ -408,9 +407,9 @@ subroutine read_db
if (lpr) write(6,*)
end subroutine read_db
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
elemental subroutine compute_coordinates_mesh(s,z,ielem,inode)
! Output s,z are the physical coordinates defined at
! serendipity nodes inode (between 1 and 8 usually)
@@ -424,8 +423,7 @@ elemental subroutine compute_coordinates_mesh(s,z,ielem,inode)
z = crd_nodes(lnods(ielem,inode),2)
end subroutine compute_coordinates_mesh
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!=====================
end module get_mesh
-!=====================
+!=========================================================================================
diff --git a/SOLVER/get_model.F90 b/SOLVER/get_model.F90
index ba3870d..0ee903e 100644
--- a/SOLVER/get_model.F90
+++ b/SOLVER/get_model.F90
@@ -19,9 +19,8 @@
! along with AxiSEM. If not, see <http://www.gnu.org/licenses/>.
!
-!========================
+!=========================================================================================
module get_model
-!========================
use global_parameters
use data_mesh
@@ -37,7 +36,7 @@ module get_model
private
contains
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> First define array ieldom that specifically appoints a respective domain
!! between discontinuities for each element (to avoid issues very close to
!! discontinuities).
@@ -77,13 +76,13 @@ module get_model
!! and coarsening layers.
!! On-the-fly verification of respective radial averages:
!! xmgrace timestep_rad.dat or xmgrace period_rad.dat
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
subroutine read_model(rho, lambda, mu, xi_ani, phi_ani, eta_ani, &
fa_ani_theta, fa_ani_phi, Q_mu_1d, Q_kappa_1d)
- use commun, ONLY : barrier
+ use commun, only : barrier
use lateral_heterogeneities
- use data_source, ONLY : rot_src
+ use data_source, only : rot_src
use data_mesh, only: npol, nelem, nel_solid, ielsolid
use nc_routines, only: nc_dump_elastic_parameters
@@ -333,129 +332,9 @@ subroutine read_model(rho, lambda, mu, xi_ani, phi_ani, eta_ani, &
call compute_coordinates(s, z, vsmaxr, theta, vsmaxloc(3),&
vsmaxloc(1), vsmaxloc(2))
end subroutine read_model
-!=============================================================================
-
-!-----------------------------------------------------------------------------
-!> file-based, step-wise model in terms of domains separated by disconts.
-!! format:
-!! ndisc
-!! r vp vs rho
-!subroutine arbitr_sub_solar_arr(s,z,v_p,v_s,rho,bkgrdmodel2)
-!
-! use data_mesh
-! real(kind=dp) , intent(in) :: s(0:npol,0:npol,1:nelem),z(0:npol,0:npol,1:nelem)
-! character(len=100), intent(in) :: bkgrdmodel2
-! real(kind=dp) , dimension(:,:,:), intent(out) :: rho(0:npol,0:npol,1:nelem)
-! real(kind=dp) , dimension(:,:,:), intent(out) :: v_s(0:npol,0:npol,1:nelem)
-! real(kind=dp) , dimension(:,:,:), intent(out) :: v_p(0:npol,0:npol,1:nelem)
-! real(kind=dp) , allocatable, dimension(:) :: disconttmp,rhotmp,vstmp,vptmp
-! integer :: ndisctmp,i,ind(2),ipol,jpol,iel
-! logical :: bkgrdmodelfile_exists
-! real(kind=dp) :: w(2),wsum,r0
-!
-! ! Does the file bkgrdmodel".bm" exist?
-! !@TODO: Change to new name convention scheme. Should start in the MESHER.
-! inquire(file=bkgrdmodel2(1:index(bkgrdmodel2,' ')-1)//'.bm', &
-! exist=bkgrdmodelfile_exists)
-! if (bkgrdmodelfile_exists) then
-! open(unit=77,file=bkgrdmodel2(1:index(bkgrdmodel2,' ')-1)//'.bm')
-! read(77,*)ndisctmp
-! allocate(disconttmp(1:ndisctmp))
-! allocate(vptmp(1:ndisctmp),vstmp(1:ndisctmp),rhotmp(1:ndisctmp))
-! do i=1, ndisctmp
-! read(77,*)disconttmp(i),rhotmp(i),vptmp(i),vstmp(i)
-! enddo
-! close(77)
-! do iel=1,nelem
-! do jpol=0,npol
-! do ipol=0,npol
-! r0 = dsqrt(s(ipol,jpol,iel)**2 +z(ipol,jpol,iel)**2 )
-! call interp_vel(r0,disconttmp(1:ndisctmp),ndisctmp,ind,w,wsum)
-! rho(ipol,jpol,iel)=sum(w*rhotmp(ind))*wsum
-! v_p(ipol,jpol,iel)=(w(1)*vptmp(ind(1))+w(2)*vptmp(ind(2)))*wsum
-! v_s(ipol,jpol,iel)=sum(w*vstmp(ind))*wsum
-! enddo
-! enddo
-! enddo
-! deallocate(disconttmp,vstmp,vptmp,rhotmp)
-! else
-! write(6,*)'Background model file', &
-! trim(bkgrdmodel2)//'.bm','does not exist!!!'
-! stop
-! endif
-!
-!end subroutine arbitr_sub_solar_arr
-!!=============================================================================
-!
-!!-----------------------------------------------------------------------------
-!!> Calculate interpolation parameters w to interpolate velocity at radius r0
-!!! from a model defined at positions r(1:n)
-!subroutine interp_vel(r0,r,n,ind,w,wsum)
-!
-! integer, intent(in) :: n !< number of supporting points
-! real(kind=dp) , intent(in) :: r(1:n) !< supporting points in depth
-! real(kind=dp) , intent(in) :: r0 !< Target depth
-! integer, intent(out) :: ind(2) !< Indizes of supporting points
-! !! between which r0 is found
-! real(kind=dp) , intent(out) :: w(2),wsum !< Weighting factors
-! integer :: i,p
-! real(kind=dp) :: dr1,dr2
-!
-! p = 1
-!
-! i = minloc(dabs(r-r0),1)
-!
-! if (r0>0.d0) then
-! if ((r(i)-r0)/r0> 1.d-8) then ! closest discont. at larger radius
-! ind(1)=i
-! ind(2)=i+1
-! dr1=r(ind(1))-r0
-! dr2=r0-r(ind(2))
-! elseif ((r0-r(i))/r0> 1.d-8) then ! closest discont. at smaller radius
-! if (r0>maxval(r)) then ! for round-off errors where mesh is above surface
-! ind(1)=i
-! ind(2)=i
-! dr1=1.d0
-! dr2=1.d0
-! else
-! ind(1)=i-1
-! ind(2)=i
-! dr1=r(ind(1))-r0
-! dr2=r0-r(ind(2))
-! endif
-! elseif (dabs((r(i)-r0)/r0)< 1.d-8) then ! closest discont identical
-! ind(1)=i
-! ind(2)=i
-! dr1=1.d0
-! dr2=1.d0
-! else
-! write(6,*)'problem with round-off errors in interpolating......'
-! write(6,*)'r0,r(i),i',r0,r(i),abs((r(i)-r0)/r0),i
-! stop
-! endif
-! else !r0=0
-! if (r(i)==0.d0) then ! center of the sun
-! ind(1)=i
-! ind(2)=i
-! dr1=1.d0
-! dr2=1.d0
-! else
-! ind(1)=i
-! ind(2)=i+1
-! dr1=r(ind(1))-r0
-! dr2=r0-r(ind(2))
-! endif
-! endif
-!
-! ! inverse distance weighting
-! w(1) = (dr1)**(-p)
-! w(2) = (dr2)**(-p)
-! wsum = 1.d0 / sum(w)
-!
-!end subroutine interp_vel
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
subroutine check_mesh_discontinuities(ieldom,domcount)
use data_mesh, only: ndisc, npol, nelem
@@ -532,9 +411,9 @@ subroutine check_mesh_discontinuities(ieldom,domcount)
enddo
end subroutine check_mesh_discontinuities
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
subroutine check_elastic_discontinuities(ieldom,domcount,lambda,mu,rho)
use data_mesh, only : ndisc, nelem
@@ -765,16 +644,16 @@ subroutine check_elastic_discontinuities(ieldom,domcount,lambda,mu,rho)
13 format(a7,1pe12.4,i7,3(1pe13.3))
end subroutine check_elastic_discontinuities
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> Do sanity checks on background model:
!! - no invalid (negative) values on lambda, mu, rho
!! - no lateral heterogeneities, unless it is a lathet model
!! - no insane variations of model parameters within one cell.
subroutine check_background_model(lambda,mu,rho)
- use data_mesh, ONLY : eltype, coarsing
+ use data_mesh, only : eltype, coarsing
use data_mesh, only : npol, nelem
real(kind=dp) , intent(in) :: rho(0:npol,0:npol,nelem)
@@ -962,18 +841,18 @@ subroutine check_background_model(lambda,mu,rho)
deallocate(maxdiffrho, maxdifflam, maxdiffmu)
end subroutine check_background_model
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> Resolution test: Insert radial sine function with wavenumbers according to
!! actual wavelengths, compute numerical and analytical integrals for various
!! setups by changing the wavenumber by source period and seismic velocities.
subroutine test_mesh_model_resolution(lambda,mu,rho)
- use def_grid, ONLY : massmatrix,massmatrix_dble
- use data_time, ONLY : period
- use data_mesh, ONLY : eltype, coarsing, north, axis
- use commun, ONLY : psum_dble,broadcast_int,broadcast_dble
+ use def_grid, only : massmatrix,massmatrix_dble
+ use data_time, only : period
+ use data_mesh, only : eltype, coarsing, north, axis
+ use commun, only : psum_dble,broadcast_int,broadcast_dble
real(kind=dp) , intent(in) :: rho(0:npol,0:npol,nelem)
@@ -1224,9 +1103,9 @@ subroutine test_mesh_model_resolution(lambda,mu,rho)
deallocate(mass)
end subroutine test_mesh_model_resolution
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> Write scalar values into a binary VTK files
subroutine write_VTK_bin_scal(x,y,z,u1,elems,filename)
implicit none
@@ -1501,8 +1380,7 @@ subroutine plot_model_vtk(rho, lambda, mu, xi_ani, phi_ani, eta_ani, &
endif
end subroutine plot_model_vtk
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!========================
end module get_model
-!========================
+!=========================================================================================
More information about the CIG-COMMITS
mailing list