[cig-commits] [commit] master: tidy up (4fe8497)
cig_noreply at geodynamics.org
cig_noreply at geodynamics.org
Fri Oct 17 05:30:30 PDT 2014
Repository : https://github.com/geodynamics/axisem
On branch : master
Link : https://github.com/geodynamics/axisem/compare/607f803cf074063627513d235f9ed0837fc1dd44...b6457db24acdde4a4e1c08935ae1b22adf87f5bf
>---------------------------------------------------------------
commit 4fe849764e183152371b70079fb34e58397d244d
Author: martinvandriel <vandriel at erdw.ethz.ch>
Date: Fri Oct 17 12:22:41 2014 +0200
tidy up
>---------------------------------------------------------------
4fe849764e183152371b70079fb34e58397d244d
SOLVER/seismograms.f90 | 52 ----------------------
SOLVER/source.f90 | 2 +
SOLVER/splib.f90 | 58 ++++++++++++------------
SOLVER/stiffness.f90 | 111 ++++++++++++++++++++++------------------------
SOLVER/unrolled_loops.f90 | 37 +++++++---------
SOLVER/utlity.f90 | 54 +++++++++++-----------
SOLVER/wavefields_io.f90 | 2 +
7 files changed, 130 insertions(+), 186 deletions(-)
diff --git a/SOLVER/seismograms.f90 b/SOLVER/seismograms.f90
index 5974b8b..8855dc7 100644
--- a/SOLVER/seismograms.f90
+++ b/SOLVER/seismograms.f90
@@ -102,12 +102,6 @@ subroutine prepare_seismograms
dabs(z-router) < smallval*router) then
ielepi = iel
if (verbose > 1) then
- !write(6,*)'Proc ', mynum, ' found: '
- !write(6,*)'Epicenter element:',ielepi
- !write(6,*)'Epicenter radius [km], colat [deg]:', &
- ! r/1000.,theta/pi*180.
- !write(6,*)''
- !call flush(6)
write(69,*)'Proc ', mynum, ' found: '
write(69,*)'Epicenter element:',ielepi
write(69,*)'Epicenter radius [km], colat [deg]:', &
@@ -125,12 +119,6 @@ subroutine prepare_seismograms
if ( dabs(theta-pi) < min_distance_nondim*pi) then
ielantipode=iel
if (verbose > 1) then
- !write(6,*)'Proc ', mynum, ' found: '
- !write(6,*)'Antipodal element:',ielantipode
- !write(6,*)'Antipode radius [km], colat [deg]:',&
- ! r/1000.,theta/pi*180.
- !write(6,*)''
- ! call flush(6)
write(69,*)'Proc ', mynum, ' found: '
write(69,*)'Antipodal element:',ielantipode
write(69,*)'Antipode radius [km], colat [deg]:',&
@@ -148,13 +136,6 @@ subroutine prepare_seismograms
if ( dabs(z) < smallval_sngl) then
ielequ=iel
if (verbose > 1) then
- !write(6,*)'Proc ', mynum, ' found: '
- !write(6,*)'Equatorial element:',ielequ
- !write(6,*)'Equatorial radius [km], colat [deg]:',&
- ! r/1000.,theta/pi*180.
- !write(6,*)''
- !call flush(6)
-
write(69,*)'Proc ', mynum, ' found: '
write(69,*)'Equatorial element:',ielequ
write(69,*)'Equatorial radius [km], colat [deg]:',&
@@ -736,16 +717,6 @@ subroutine open_hyp_epi_equ_anti
if (maxind>0) then
- ! @TODO: this might be problematic if two processors have the source - then
- ! both open the same file. IMHO these files are pretty useless
- ! anyway, so not fixing it for now
- !if (have_src) then
- ! open(10001,file=datapath(1:lfdata)//'/seishypocenter1.dat')
- ! if (src_type(1)/='monopole') &
- ! open(10002,file=datapath(1:lfdata)//'/seishypocenter2.dat')
- ! open(10003,file=datapath(1:lfdata)//'/seishypocenter3.dat')
- !endif
-
if (have_epi) then
open(900,file=datapath(1:lfdata)//'/seisepicenter1.dat')
if (src_type(1)/='monopole') &
@@ -785,29 +756,6 @@ subroutine compute_hyp_epi_equ_anti(t,disp)
real(kind=realkind), intent(in) :: disp(0:,0:,:,:)
if (maxind>0) then
- !if (mynum==0) then
- ! if (ipol_src /= 0 ) then
- ! write(6,*)'PROBLEM in hypocenter location!'
- ! write(6,*)'ipol is not equal to zero, hence off the axis!',ipol_src
- ! stop
- ! endif
- !endif
-
- ! hypocenter
- !if (have_src) then
- ! if (src_type(1)=='dipole') then
- ! write(10001,*)t,disp(ipol_src,jpol_src,iel_src,1)+&
- ! disp(ipol_src,jpol_src,iel_src,2) ! s
- ! write(10002,*)t,disp(ipol_src,jpol_src,iel_src,1)-&
- ! disp(ipol_src,jpol_src,iel_src,2) ! phi
- ! else
- ! write(10001,*)t,disp(ipol_src,jpol_src,iel_src,1) ! s
- ! if (src_type(1)=='quadpole') &
- ! write(10002,*)t,disp(ipol_src,jpol_src,iel_src,2) ! phi
- ! endif
- ! write(10003,*)t,disp(ipol_src,jpol_src,iel_src,3) ! z
- !endif
-
! epicenter
if (have_epi) then
if (src_type(1)=='dipole') then
diff --git a/SOLVER/source.f90 b/SOLVER/source.f90
index 8f6bbe3..d863a7f 100644
--- a/SOLVER/source.f90
+++ b/SOLVER/source.f90
@@ -19,6 +19,7 @@
! along with AxiSEM. If not, see <http://www.gnu.org/licenses/>.
!
+!=========================================================================================
module source
use global_parameters
@@ -1177,3 +1178,4 @@ end subroutine define_moment_tensor
!-----------------------------------------------------------------------------------------
end module source
+!=========================================================================================
diff --git a/SOLVER/splib.f90 b/SOLVER/splib.f90
index 21af7b9..6774450 100644
--- a/SOLVER/splib.f90
+++ b/SOLVER/splib.f90
@@ -19,6 +19,7 @@
! along with AxiSEM. If not, see <http://www.gnu.org/licenses/>.
!
+!=========================================================================================
!> Core of the spectral method.
module splib
@@ -32,7 +33,7 @@ module splib
contains
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> This routine reorders array vin(n) in increasing order and
!! outputs array vout(n).
pure subroutine order(vin,vout,n)
@@ -60,9 +61,9 @@ pure subroutine order(vin,vout,n)
end do
end subroutine order
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> Applies more robust formula to return
!! value of the derivative of the i-th Lagrangian interpolant
!! defined over the weighted GLL points computed at these
@@ -126,9 +127,9 @@ subroutine lag_interp_deriv_wgl(dl,xi,i,N)
end if
end subroutine lag_interp_deriv_wgl
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> Compute the value of the derivative of the j-th Lagrange polynomial
!! of order N defined by the N+1 GLL points xi evaluated at these very
!! same N+1 GLL points.
@@ -155,9 +156,9 @@ pure subroutine hn_jprime(xi,j,N,dhj)
call delegl(N, xi, VN, QN, dhj)
end subroutine hn_jprime
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> computes the nodes relative to the legendre gauss-lobatto formula
pure subroutine zelegl(n,et,vn)
@@ -204,9 +205,9 @@ pure subroutine zelegl(n,et,vn)
end do
end subroutine zelegl
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> computes the nodes relative to the legendre gauss-lobatto formula
pure subroutine zelegl2(n,et)
@@ -246,9 +247,9 @@ pure subroutine zelegl2(n,et)
return
end subroutine zelegl2
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> Computes the nodes relative to the modified legendre gauss-lobatto
!! FORMULA along the s-axis
!! Relies on computing the eigenvalues of tridiagonal matrix.
@@ -296,9 +297,9 @@ pure subroutine zemngl2(n,et)
ET(1:n-1) = e(1:n-1)
end subroutine zemngl2
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> This routines returns the eigenvalues of the tridiagonal matrix
!! which diagonal and subdiagonal coefficients are contained in d(1:n) and
!! e(2:n) respectively. e(1) is free. The eigenvalues are returned in array d
@@ -356,9 +357,9 @@ pure subroutine tqli(d,e,n)
end do
end subroutine tqli
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> L2 norm of a and b
pure real(kind=dp) function pythag(a,b)
@@ -382,9 +383,9 @@ pure real(kind=dp) function pythag(a,b)
endif
end function pythag
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> computes the derivative of a polynomial at the legendre gauss-lobatto
!! nodes from the values of the polynomial attained at the same points
pure subroutine delegl(n,et,vn,qn,dqn)
@@ -419,9 +420,9 @@ pure subroutine delegl(n,et,vn,qn,dqn)
dqn(n) = dqn(n) + c * qn(n)
end subroutine delegl
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> computes the value of the legendre polynomial of degree n
!! and its first and second derivatives at a given point
pure subroutine valepo(n,x,y,dy,d2y)
@@ -463,9 +464,9 @@ pure subroutine valepo(n,x,y,dy,d2y)
enddo
end subroutine valepo
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> This routine computes the N+1 weights associated with the
!! Gauss-Lobatto-Legendre quadrature formula of order N.
pure subroutine get_welegl(N,xi,wt)
@@ -488,9 +489,9 @@ pure subroutine get_welegl(N,xi,wt)
end do
end subroutine get_welegl
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> This routine computes the N+1 weights associated with the
!! Gauss-Lobatto-Legendre quadrature formula of order N that one
!! to apply for elements having a non-zero intersection with the
@@ -532,9 +533,9 @@ pure subroutine get_welegl_axial(N,xi,wt,iflag)
end if
end subroutine get_welegl_axial
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> Computes the value of the "cylindrical" polynomial
!! m_n = (l_n + l_{n+1})/(1+x) of degree n
!! and its first and second derivatives at a given point
@@ -586,9 +587,9 @@ pure subroutine vamnpo(n,x,y,dy,d2y)
end do
end subroutine vamnpo
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> This routine computes the Lagrange interpolated value y at point x
!! associated to the function defined by the n values ya at n distinct points
!! xa. dy is the estimate of the error made on the interpolation.
@@ -640,6 +641,7 @@ pure subroutine polint(xa,ya,n,x,y,dy)
end do
end subroutine polint
-!----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
end module splib
+!=========================================================================================
diff --git a/SOLVER/stiffness.f90 b/SOLVER/stiffness.f90
index 6acee3e..2650e7e 100644
--- a/SOLVER/stiffness.f90
+++ b/SOLVER/stiffness.f90
@@ -19,9 +19,8 @@
! along with AxiSEM. If not, see <http://www.gnu.org/licenses/>.
!
-!====================
+!=========================================================================================
module stiffness
-!====================
use global_parameters, only: realkind
use data_matr
@@ -48,7 +47,7 @@ module stiffness
contains
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure function outerprod(a,b)
! outer product (dyadic) from numerical recipes
@@ -57,9 +56,9 @@ pure function outerprod(a,b)
outerprod = spread(a, dim=2, ncopies=size(b)) * spread(b, dim=1, ncopies=size(a))
end function outerprod
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure function outerprod_4(a,b)
! outer product (dyadic) from numerical recipes
@@ -68,9 +67,9 @@ pure function outerprod_4(a,b)
outerprod_4 = spread(a, dim=2, ncopies=5) * spread(b, dim=1, ncopies=5)
end function outerprod_4
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> Wrapper routine to avoid if statements in the timeloop
pure subroutine glob_stiffness_mono(glob_stiffness,u)
use data_mesh, only: npol, nel_solid
@@ -85,9 +84,9 @@ pure subroutine glob_stiffness_mono(glob_stiffness,u)
endif
end subroutine glob_stiffness_mono
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_stiffness_mono_4(glob_stiffness,u)
use data_mesh, only: nel_solid
@@ -186,9 +185,9 @@ pure subroutine glob_stiffness_mono_4(glob_stiffness,u)
end do
end subroutine glob_stiffness_mono_4
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_stiffness_mono_generic(glob_stiffness,u)
use data_mesh, only: npol, nel_solid
@@ -310,9 +309,9 @@ pure subroutine glob_stiffness_mono_generic(glob_stiffness,u)
enddo
end subroutine glob_stiffness_mono_generic
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_anel_stiffness_mono(glob_stiffness, R, R_cg, cg)
use data_mesh, only: npol
@@ -332,9 +331,9 @@ pure subroutine glob_anel_stiffness_mono(glob_stiffness, R, R_cg, cg)
endif
end subroutine glob_anel_stiffness_mono
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_anel_stiffness_mono_generic(glob_stiffness, R)
use attenuation, only: n_sls_attenuation
@@ -434,9 +433,9 @@ pure subroutine glob_anel_stiffness_mono_generic(glob_stiffness, R)
enddo
end subroutine glob_anel_stiffness_mono_generic
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_anel_stiffness_mono_4(glob_stiffness, R)
use attenuation, only: n_sls_attenuation
@@ -536,9 +535,9 @@ pure subroutine glob_anel_stiffness_mono_4(glob_stiffness, R)
enddo
end subroutine glob_anel_stiffness_mono_4
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_anel_stiffness_mono_cg4(glob_stiffness, R)
use attenuation, only: n_sls_attenuation
@@ -618,9 +617,9 @@ pure subroutine glob_anel_stiffness_mono_cg4(glob_stiffness, R)
enddo
end subroutine glob_anel_stiffness_mono_cg4
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> Wrapper routine to avoid if statements in the timeloop
pure subroutine glob_stiffness_di(glob_stiffness,u)
use data_mesh, only: npol, nel_solid
@@ -635,9 +634,9 @@ pure subroutine glob_stiffness_di(glob_stiffness,u)
endif
end subroutine glob_stiffness_di
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_stiffness_di_4(glob_stiffness,u)
use data_mesh, only: nel_solid
@@ -835,10 +834,9 @@ pure subroutine glob_stiffness_di_4(glob_stiffness,u)
enddo
end subroutine glob_stiffness_di_4
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_stiffness_di_generic(glob_stiffness,u)
use data_mesh, only: npol, nel_solid
@@ -1035,9 +1033,9 @@ pure subroutine glob_stiffness_di_generic(glob_stiffness,u)
enddo
end subroutine glob_stiffness_di_generic
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_anel_stiffness_di(glob_stiffness, R, R_cg, cg)
use data_mesh, only: npol
@@ -1057,9 +1055,9 @@ pure subroutine glob_anel_stiffness_di(glob_stiffness, R, R_cg, cg)
endif
end subroutine glob_anel_stiffness_di
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_anel_stiffness_di_generic(glob_stiffness, R)
use attenuation, only: n_sls_attenuation
@@ -1180,9 +1178,9 @@ pure subroutine glob_anel_stiffness_di_generic(glob_stiffness, R)
enddo
end subroutine glob_anel_stiffness_di_generic
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_anel_stiffness_di_4(glob_stiffness, R)
use attenuation, only: n_sls_attenuation
@@ -1303,9 +1301,9 @@ pure subroutine glob_anel_stiffness_di_4(glob_stiffness, R)
enddo
end subroutine glob_anel_stiffness_di_4
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_anel_stiffness_di_cg4(glob_stiffness, R)
use attenuation, only: n_sls_attenuation
@@ -1405,9 +1403,9 @@ pure subroutine glob_anel_stiffness_di_cg4(glob_stiffness, R)
enddo
end subroutine glob_anel_stiffness_di_cg4
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> Wrapper routine to avoid if statements in the timeloop
pure subroutine glob_stiffness_quad(glob_stiffness,u)
use data_mesh, only: npol, nel_solid
@@ -1422,9 +1420,9 @@ pure subroutine glob_stiffness_quad(glob_stiffness,u)
endif
end subroutine glob_stiffness_quad
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_stiffness_quad_generic(glob_stiffness,u)
use data_mesh, only: npol, nel_solid
@@ -1600,9 +1598,9 @@ pure subroutine glob_stiffness_quad_generic(glob_stiffness,u)
enddo
end subroutine glob_stiffness_quad_generic
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_stiffness_quad_4(glob_stiffness,u)
use data_mesh, only: nel_solid
@@ -1779,9 +1777,9 @@ pure subroutine glob_stiffness_quad_4(glob_stiffness,u)
enddo
end subroutine glob_stiffness_quad_4
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_anel_stiffness_quad(glob_stiffness, R, R_cg, cg)
use data_mesh, only: npol
@@ -1801,9 +1799,9 @@ pure subroutine glob_anel_stiffness_quad(glob_stiffness, R, R_cg, cg)
endif
end subroutine glob_anel_stiffness_quad
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_anel_stiffness_quad_generic(glob_stiffness, R)
use attenuation, only: n_sls_attenuation
@@ -1918,9 +1916,9 @@ pure subroutine glob_anel_stiffness_quad_generic(glob_stiffness, R)
enddo
end subroutine glob_anel_stiffness_quad_generic
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_anel_stiffness_quad_4(glob_stiffness, R)
use attenuation, only: n_sls_attenuation
@@ -2035,9 +2033,9 @@ pure subroutine glob_anel_stiffness_quad_4(glob_stiffness, R)
enddo
end subroutine glob_anel_stiffness_quad_4
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_anel_stiffness_quad_cg4(glob_stiffness, R)
use attenuation, only: n_sls_attenuation
@@ -2141,9 +2139,9 @@ pure subroutine glob_anel_stiffness_quad_cg4(glob_stiffness, R)
enddo
end subroutine glob_anel_stiffness_quad_cg4
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> Wrapper routine to avoid if statements in the timeloop
pure subroutine glob_fluid_stiffness(glob_stiffness_fl, chi)
use data_mesh, only: npol, nel_fluid
@@ -2158,9 +2156,9 @@ pure subroutine glob_fluid_stiffness(glob_stiffness_fl, chi)
endif
end subroutine glob_fluid_stiffness
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_fluid_stiffness_generic(glob_stiffness_fl, chi)
use data_mesh, only: npol, nel_fluid
@@ -2238,9 +2236,9 @@ pure subroutine glob_fluid_stiffness_generic(glob_stiffness_fl, chi)
enddo
end subroutine glob_fluid_stiffness_generic
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine glob_fluid_stiffness_4(glob_stiffness_fl, chi)
use data_mesh, only: nel_fluid
@@ -2320,8 +2318,7 @@ pure subroutine glob_fluid_stiffness_4(glob_stiffness_fl, chi)
enddo
end subroutine glob_fluid_stiffness_4
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!====================
end module stiffness
-!====================
+!=========================================================================================
diff --git a/SOLVER/unrolled_loops.f90 b/SOLVER/unrolled_loops.f90
index c682a0d..65816e5 100644
--- a/SOLVER/unrolled_loops.f90
+++ b/SOLVER/unrolled_loops.f90
@@ -19,11 +19,10 @@
! along with AxiSEM. If not, see <http://www.gnu.org/licenses/>.
!
-!========================
+!=========================================================================================
!> Routines for general matrix-matrix and matrix-vector multiplication. Called a
!! bazillion times, presumably fast.
module unrolled_loops
-!========================
use global_parameters, only: realkind
@@ -32,9 +31,7 @@ module unrolled_loops
contains
-!=============================================================================
-
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> Multiplies matrizes a and b to have c.
!! Size is fixed to npol x npol
pure subroutine mxm(a,b,c)
@@ -53,9 +50,9 @@ pure subroutine mxm(a,b,c)
end do
end subroutine mxm
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> Multiplies vector a leftwise to matrix b to have vector c.
!! Size is fixed to npol x npol
pure subroutine vxm(a,b,c)
@@ -73,9 +70,9 @@ pure subroutine vxm(a,b,c)
end do
end subroutine vxm
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine mxm_cg4_sparse_a(a,b,c)
! mxm for sparse a as found for coarse grained memory variables cg4
@@ -97,9 +94,9 @@ pure subroutine mxm_cg4_sparse_a(a,b,c)
end do
end subroutine mxm_cg4_sparse_a
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine mxm_cg4_sparse_b(a,b,c)
! mxm for sparse b as found for coarse grained memory variables cg4
@@ -121,9 +118,9 @@ pure subroutine mxm_cg4_sparse_b(a,b,c)
end do
end subroutine mxm_cg4_sparse_b
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine mxm_cg4_sparse_c(a,b,c)
@@ -159,9 +156,9 @@ pure subroutine mxm_cg4_sparse_c(a,b,c)
+ a(3,4) * b(4,3)
end subroutine mxm_cg4_sparse_c
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> Multiplies matrizes a and b to have c.
!! Size is fixed to 4x4
pure subroutine mxm_4(a,b,c)
@@ -189,9 +186,9 @@ pure subroutine mxm_4(a,b,c)
end do
end subroutine mxm_4
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
!> Multiplies vector a leftwise to matrix b to have vector c.
!! Size is fixed to npol x npol
pure subroutine vxm_4(a,b,c)
@@ -208,9 +205,7 @@ pure subroutine vxm_4(a,b,c)
end do
end subroutine vxm_4
-!=============================================================================
-
+!-----------------------------------------------------------------------------------------
-!========================
end module unrolled_loops
-!========================
+!=========================================================================================
diff --git a/SOLVER/utlity.f90 b/SOLVER/utlity.f90
index a5cc236..0510065 100644
--- a/SOLVER/utlity.f90
+++ b/SOLVER/utlity.f90
@@ -19,9 +19,8 @@
! along with AxiSEM. If not, see <http://www.gnu.org/licenses/>.
!
-!================
+!=========================================================================================
module utlity
-!================
use global_parameters
implicit none
@@ -35,7 +34,7 @@ module utlity
contains
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure logical function dblreldiff_small(x1,x2)
real(kind=dp), intent(in) :: x1,x2
@@ -51,9 +50,9 @@ pure logical function dblreldiff_small(x1,x2)
endif
end function dblreldiff_small
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure logical function reldiff_small(x1,x2)
real(kind=realkind), intent(in) :: x1,x2
@@ -73,9 +72,9 @@ pure logical function reldiff_small(x1,x2)
endif
end function reldiff_small
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure real(kind=realkind) function reldiff(x1,x2)
real(kind=realkind), intent(in) :: x1,x2
@@ -89,9 +88,9 @@ pure real(kind=realkind) function reldiff(x1,x2)
endif
end function reldiff
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure real(kind=dp) function dblereldiff(x1,x2)
real(kind=dp), intent(in) :: x1,x2
@@ -105,9 +104,9 @@ pure real(kind=dp) function dblereldiff(x1,x2)
endif
end function dblereldiff
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure real(kind=realkind) function absreldiff(x1,x2)
real(kind=realkind), intent(in) :: x1,x2
@@ -121,9 +120,9 @@ pure real(kind=realkind) function absreldiff(x1,x2)
endif
end function absreldiff
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure real(kind=dp) function dbleabsreldiff(x1,x2)
real(kind=dp), intent(in) :: x1,x2
@@ -137,9 +136,9 @@ pure real(kind=dp) function dbleabsreldiff(x1,x2)
endif
end function dbleabsreldiff
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure subroutine compute_coordinates(s,z,r,theta,ielem,ipol,jpol)
!< Given the elemental grid point index, outputs s,z,r,theta coordinate [m,rad].
!! These coordinates are by default ALWAYS global (no solid or fluid domains).
@@ -181,9 +180,9 @@ pure subroutine compute_coordinates(s,z,r,theta,ielem,ipol,jpol)
if (theta == zero .and. z < 0) theta = pi
end subroutine compute_coordinates
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure real(kind=dp) function scoord(ipol,jpol,ielem)
!< Given the elemental grid point index, outputs the s coordinate [m].
!! These coordinates are by default ALWAYS global (no solid or fluid domains).
@@ -214,9 +213,9 @@ pure real(kind=dp) function scoord(ipol,jpol,ielem)
if (abs(scoord) < min_distance_dim) scoord=zero
end function scoord
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure real(kind=dp) function zcoord(ipol,jpol,ielem)
!< Given the elemental grid point index, outputs the z coordinate [m].
!! These coordinates are by default ALWAYS global (no solid or fluid domains).
@@ -247,9 +246,9 @@ pure real(kind=dp) function zcoord(ipol,jpol,ielem)
if (abs(zcoord) < min_distance_dim) zcoord=zero
end function zcoord
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure real(kind=dp) function rcoord(ipol,jpol,ielem)
!< Given the elemental grid point index, outputs the radius coordinate [m].
!! These coordinates are by default ALWAYS global (no solid or fluid domains).
@@ -283,9 +282,9 @@ pure real(kind=dp) function rcoord(ipol,jpol,ielem)
if (abs(rcoord) < min_distance_dim) rcoord=zero
end function rcoord
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
pure real(kind=dp) function thetacoord(ipol,jpol,ielem)
!< Given the elemental grid point index, outputs the theta coordinate [rad].
!! These coordinates are by default ALWAYS global (no solid or fluid domains).
@@ -319,9 +318,9 @@ pure real(kind=dp) function thetacoord(ipol,jpol,ielem)
if (thetacoord == zero .and. z < 0) thetacoord = pi
end function thetacoord
-!=============================================================================
+!-----------------------------------------------------------------------------------------
-!=============================================================================
+!-----------------------------------------------------------------------------------------
function to_lower(strIn) result(strOut)
!< Converts string to lowercase, adapted from http://www.star.le.ac.uk/~cgp/fortran.html
implicit none
@@ -340,8 +339,7 @@ function to_lower(strIn) result(strOut)
end do
end function to_lower
-!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------------------
-!====================
end module utlity
-!====================
+!=========================================================================================
diff --git a/SOLVER/wavefields_io.f90 b/SOLVER/wavefields_io.f90
index 97902f5..203616c 100644
--- a/SOLVER/wavefields_io.f90
+++ b/SOLVER/wavefields_io.f90
@@ -19,6 +19,7 @@
! along with AxiSEM. If not, see <http://www.gnu.org/licenses/>.
!
+!=========================================================================================
!> Contains all routines that dump entire wavefields during the time loop.
!! Optimization of I/O therefore happens here and nowhere else.
!! The corresponding meshes are dumped in meshes_io.
@@ -1137,3 +1138,4 @@ end subroutine eradicate_src_elem_values
!-----------------------------------------------------------------------------------------
end module wavefields_io
+!=========================================================================================
More information about the CIG-COMMITS
mailing list