[cig-commits] r8491 - seismo/2D/SPECFEM2D/trunk
walter at geodynamics.org
walter at geodynamics.org
Fri Dec 7 15:50:30 PST 2007
Author: walter
Date: 2007-12-07 15:50:30 -0800 (Fri, 07 Dec 2007)
New Revision: 8491
Added:
seismo/2D/SPECFEM2D/trunk/define_derivation_matrices.f90
Removed:
seismo/2D/SPECFEM2D/trunk/define_derivative_matrices.f90
Modified:
seismo/2D/SPECFEM2D/trunk/Makefile
seismo/2D/SPECFEM2D/trunk/specfem2D.f90
seismo/2D/SPECFEM2D/trunk/write_seismograms.f90
Log:
renamed define_derivative_matrices.f90 to define_derivation_matrices.f90.
fixed memory problem with automatic arrays buffer_binary_single and buffer_binary_double.
Modified: seismo/2D/SPECFEM2D/trunk/Makefile
===================================================================
--- seismo/2D/SPECFEM2D/trunk/Makefile 2006-06-20 23:24:32 UTC (rev 8490)
+++ seismo/2D/SPECFEM2D/trunk/Makefile 2007-12-07 23:50:30 UTC (rev 8491)
@@ -35,7 +35,7 @@
OBJS_MESHFEM2D = $O/meshfem2D.o $O/read_value_parameters.o
OBJS_SPECFEM2D = $O/checkgrid.o $O/datim.o $O/defarrays.o\
- $O/lagrange_poly.o $O/gmat01.o $O/gll_library.o $O/plotgll.o $O/define_derivative_matrices.o\
+ $O/lagrange_poly.o $O/gmat01.o $O/gll_library.o $O/plotgll.o $O/define_derivation_matrices.o\
$O/plotpost.o $O/locate_receivers.o $O/locate_source_force.o $O/compute_gradient_attenuation.o\
$O/specfem2D.o $O/write_seismograms.o $O/createnum_fast.o $O/createnum_slow.o\
$O/define_shape_functions.o $O/create_color_image.o $O/compute_gradient_fluid.o\
@@ -97,8 +97,8 @@
$O/gll_library.o: gll_library.f90 constants.h
${F90} $(FLAGS_CHECK) -c -o $O/gll_library.o gll_library.f90
-$O/define_derivative_matrices.o: define_derivative_matrices.f90 constants.h
- ${F90} $(FLAGS_CHECK) -c -o $O/define_derivative_matrices.o define_derivative_matrices.f90
+$O/define_derivation_matrices.o: define_derivation_matrices.f90 constants.h
+ ${F90} $(FLAGS_CHECK) -c -o $O/define_derivation_matrices.o define_derivation_matrices.f90
$O/plotgll.o: plotgll.f90 constants.h
${F90} $(FLAGS_CHECK) -c -o $O/plotgll.o plotgll.f90
Copied: seismo/2D/SPECFEM2D/trunk/define_derivation_matrices.f90 (from rev 8490, seismo/2D/SPECFEM2D/trunk/define_derivative_matrices.f90)
===================================================================
--- seismo/2D/SPECFEM2D/trunk/define_derivative_matrices.f90 2006-06-20 23:24:32 UTC (rev 8490)
+++ seismo/2D/SPECFEM2D/trunk/define_derivation_matrices.f90 2007-12-07 23:50:30 UTC (rev 8491)
@@ -0,0 +1,61 @@
+
+!========================================================================
+!
+! S P E C F E M 2 D Version 5.1
+! ------------------------------
+!
+! Dimitri Komatitsch
+! Universite de Pau et des Pays de l'Adour, France
+!
+! (c) January 2005
+!
+!========================================================================
+
+ subroutine define_derivation_matrices(xigll,zigll,wxgll,wzgll,hprime_xx,hprime_zz)
+
+ implicit none
+
+ include "constants.h"
+
+! Gauss-Lobatto-Legendre points of integration
+ double precision, dimension(NGLLX) :: xigll
+ double precision, dimension(NGLLZ) :: zigll
+
+! weights
+ double precision, dimension(NGLLX) :: wxgll
+ double precision, dimension(NGLLZ) :: wzgll
+
+! array with derivatives of Lagrange polynomials
+ double precision, dimension(NGLLX,NGLLX) :: hprime_xx
+ double precision, dimension(NGLLZ,NGLLZ) :: hprime_zz
+
+! function for calculating derivatives of Lagrange polynomials
+ double precision, external :: lagrange_deriv_GLL
+
+ integer i1,i2,k1,k2
+
+! set up coordinates of the Gauss-Lobatto-Legendre points
+ call zwgljd(xigll,wxgll,NGLLX,GAUSSALPHA,GAUSSBETA)
+ call zwgljd(zigll,wzgll,NGLLZ,GAUSSALPHA,GAUSSBETA)
+
+! if number of points is odd, the middle abscissa is exactly zero
+ if(mod(NGLLX,2) /= 0) xigll((NGLLX-1)/2+1) = ZERO
+ if(mod(NGLLZ,2) /= 0) zigll((NGLLZ-1)/2+1) = ZERO
+
+! calculate derivatives of the Lagrange polynomials
+! and precalculate some products in double precision
+! hprime(i,j) = h'_i(xigll_j) by definition of the derivative matrix
+ do i1=1,NGLLX
+ do i2=1,NGLLX
+ hprime_xx(i1,i2) = lagrange_deriv_GLL(i1-1,i2-1,xigll,NGLLX)
+ enddo
+ enddo
+
+ do k1=1,NGLLZ
+ do k2=1,NGLLZ
+ hprime_zz(k1,k2) = lagrange_deriv_GLL(k1-1,k2-1,zigll,NGLLZ)
+ enddo
+ enddo
+
+ end subroutine define_derivation_matrices
+
Deleted: seismo/2D/SPECFEM2D/trunk/define_derivative_matrices.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/define_derivative_matrices.f90 2006-06-20 23:24:32 UTC (rev 8490)
+++ seismo/2D/SPECFEM2D/trunk/define_derivative_matrices.f90 2007-12-07 23:50:30 UTC (rev 8491)
@@ -1,61 +0,0 @@
-
-!========================================================================
-!
-! S P E C F E M 2 D Version 5.1
-! ------------------------------
-!
-! Dimitri Komatitsch
-! Universite de Pau et des Pays de l'Adour, France
-!
-! (c) January 2005
-!
-!========================================================================
-
- subroutine define_derivative_matrices(xigll,zigll,wxgll,wzgll,hprime_xx,hprime_zz)
-
- implicit none
-
- include "constants.h"
-
-! Gauss-Lobatto-Legendre points of integration
- double precision, dimension(NGLLX) :: xigll
- double precision, dimension(NGLLZ) :: zigll
-
-! weights
- double precision, dimension(NGLLX) :: wxgll
- double precision, dimension(NGLLZ) :: wzgll
-
-! array with derivatives of Lagrange polynomials
- double precision, dimension(NGLLX,NGLLX) :: hprime_xx
- double precision, dimension(NGLLZ,NGLLZ) :: hprime_zz
-
-! function for calculating derivatives of Lagrange polynomials
- double precision, external :: lagrange_deriv_GLL
-
- integer i1,i2,k1,k2
-
-! set up coordinates of the Gauss-Lobatto-Legendre points
- call zwgljd(xigll,wxgll,NGLLX,GAUSSALPHA,GAUSSBETA)
- call zwgljd(zigll,wzgll,NGLLZ,GAUSSALPHA,GAUSSBETA)
-
-! if number of points is odd, the middle abscissa is exactly zero
- if(mod(NGLLX,2) /= 0) xigll((NGLLX-1)/2+1) = ZERO
- if(mod(NGLLZ,2) /= 0) zigll((NGLLZ-1)/2+1) = ZERO
-
-! calculate derivatives of the Lagrange polynomials
-! and precalculate some products in double precision
-! hprime(i,j) = h'_i(xigll_j) by definition of the derivative matrix
- do i1=1,NGLLX
- do i2=1,NGLLX
- hprime_xx(i1,i2) = lagrange_deriv_GLL(i1-1,i2-1,xigll,NGLLX)
- enddo
- enddo
-
- do k1=1,NGLLZ
- do k2=1,NGLLZ
- hprime_zz(k1,k2) = lagrange_deriv_GLL(k1-1,k2-1,zigll,NGLLZ)
- enddo
- enddo
-
- end subroutine define_derivative_matrices
-
Modified: seismo/2D/SPECFEM2D/trunk/specfem2D.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/specfem2D.f90 2006-06-20 23:24:32 UTC (rev 8490)
+++ seismo/2D/SPECFEM2D/trunk/specfem2D.f90 2007-12-07 23:50:30 UTC (rev 8491)
@@ -71,8 +71,13 @@
integer, dimension(:), allocatable :: ispec_selected_rec
double precision, dimension(:), allocatable :: xi_receiver,gamma_receiver,st_xval,st_zval
+! for seismograms
double precision, dimension(:,:), allocatable :: sisux,sisuz
+! to write seismograms in single precision SEP and double precision binary format
+ real(kind=4), dimension(:), allocatable :: buffer_binary_single
+ double precision, dimension(:), allocatable :: buffer_binary_double
+
logical anyabs
integer i,j,it,irec,ipoin,ip,id
@@ -398,7 +403,7 @@
write(IOUT,207) nspec,ngnod,NGLLX,NGLLZ,NGLLX*NGLLZ,pointsdisp,numat,nelemabs
! set up Gauss-Lobatto-Legendre derivation matrices
- call define_derivative_matrices(xigll,zigll,wxgll,wzgll,hprime_xx,hprime_zz)
+ call define_derivation_matrices(xigll,zigll,wxgll,wzgll,hprime_xx,hprime_zz)
!
!---- read the material properties
@@ -503,6 +508,10 @@
allocate(sisux(NSTEP,nrec))
allocate(sisuz(NSTEP,nrec))
+! to write seismograms in single precision SEP and double precision binary format
+ allocate(buffer_binary_single(NSTEP*nrec))
+ allocate(buffer_binary_double(NSTEP*nrec))
+
! receiver information
allocate(ispec_selected_rec(nrec))
allocate(st_xval(nrec))
@@ -1798,14 +1807,16 @@
endif
!---- save temporary seismograms
- call write_seismograms(sisux,sisuz,station_name,network_name,NSTEP,nrec,deltat,sismostype,st_xval,it,t0)
+ call write_seismograms(sisux,sisuz,station_name,network_name,NSTEP, &
+ nrec,deltat,sismostype,st_xval,it,t0,buffer_binary_single,buffer_binary_double)
endif
enddo ! end of the main time loop
!---- save final seismograms
- call write_seismograms(sisux,sisuz,station_name,network_name,NSTEP,nrec,deltat,sismostype,st_xval,it,t0)
+ call write_seismograms(sisux,sisuz,station_name,network_name,NSTEP, &
+ nrec,deltat,sismostype,st_xval,it,t0,buffer_binary_single,buffer_binary_double)
! print exit banner
call datim(stitle)
Modified: seismo/2D/SPECFEM2D/trunk/write_seismograms.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/write_seismograms.f90 2006-06-20 23:24:32 UTC (rev 8490)
+++ seismo/2D/SPECFEM2D/trunk/write_seismograms.f90 2007-12-07 23:50:30 UTC (rev 8491)
@@ -13,7 +13,8 @@
! write seismograms to text files
- subroutine write_seismograms(sisux,sisuz,station_name,network_name,NSTEP,nrec,deltat,sismostype,st_xval,it,t0)
+ subroutine write_seismograms(sisux,sisuz,station_name,network_name, &
+ NSTEP,nrec,deltat,sismostype,st_xval,it,t0,buffer_binary_single,buffer_binary_double)
implicit none
More information about the cig-commits
mailing list