[cig-commits] [commit] devel: refactored write_seismograms (4129040)
cig_noreply at geodynamics.org
cig_noreply at geodynamics.org
Wed Dec 10 12:05:31 PST 2014
Repository : https://github.com/geodynamics/specfem2d
On branch : devel
Link : https://github.com/geodynamics/specfem2d/compare/ee73d7f81d9311271516b8a722ca6f2f50ae8743...0509fc8b3f04a8436eaccda15f30b6cee82c654f
>---------------------------------------------------------------
commit 4129040095ab0451901d690fcdcd92551e77c5e8
Author: rmodrak <rmodrak at princeton.edu>
Date: Wed Dec 10 14:35:06 2014 -0500
refactored write_seismograms
>---------------------------------------------------------------
4129040095ab0451901d690fcdcd92551e77c5e8
src/specfem2D/write_output_SU.f90 | 6 ++---
src/specfem2D/write_seismograms.F90 | 45 ++++++++++++++++++++++---------------
2 files changed, 30 insertions(+), 21 deletions(-)
diff --git a/src/specfem2D/write_output_SU.f90 b/src/specfem2D/write_output_SU.f90
index 1ef476f..dbff9c3 100644
--- a/src/specfem2D/write_output_SU.f90
+++ b/src/specfem2D/write_output_SU.f90
@@ -10,7 +10,7 @@
! to write seismograms in single precision SEP and double precision binary
! format
- double precision, dimension(number_of_components,NSTEP_BETWEEN_OUTPUT_SEISMOS/subsamp_seismos) :: buffer_binary
+ double precision, dimension(number_of_components,NSTEP_BETWEEN_OUTPUT_SEISMOS/subsamp_seismos,nrec) :: buffer_binary
! scaling factor for Seismic Unix xsu dislay
double precision, parameter :: FACTORXSU = 1.d0
@@ -70,9 +70,9 @@
! the "60" in the following corresponds to 240 bytes header (note the reclength is 4 bytes)
do isample = 1, seismo_current
- write(12,rec=irec*60+(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(1,isample))
+ write(12,rec=irec*60+(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(1,isample,irec))
if ( seismotype /= 4 .and. seismotype /= 6 .and. p_sv) then
- write(14,rec=irec*60+(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(2,isample))
+ write(14,rec=irec*60+(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(2,isample,irec))
endif
enddo
diff --git a/src/specfem2D/write_seismograms.F90 b/src/specfem2D/write_seismograms.F90
index c589268..4c5946f 100644
--- a/src/specfem2D/write_seismograms.F90
+++ b/src/specfem2D/write_seismograms.F90
@@ -73,7 +73,7 @@
character(len=150) sisname
! to write seismograms in single precision SEP and double precision binary format
- double precision, dimension(:,:), allocatable :: buffer_binary
+ double precision, dimension(:,:,:), allocatable :: buffer_binary
! scaling factor for Seismic Unix xsu dislay
double precision, parameter :: FACTORXSU = 1.d0
@@ -122,7 +122,7 @@
number_of_components = NDIM
endif
- allocate(buffer_binary(number_of_components,NSTEP_BETWEEN_OUTPUT_SEISMOS/subsamp_seismos))
+ allocate(buffer_binary(number_of_components,NSTEP_BETWEEN_OUTPUT_SEISMOS/subsamp_seismos,nrec))
if (save_binary_seismograms .and. myrank == 0 .and. seismo_offset == 0) then
@@ -202,31 +202,40 @@
if ( which_proc_receiver(irec) == myrank ) then
irecloc = irecloc + 1
- buffer_binary(1,:) = sisux(:,irecloc)
+ buffer_binary(1,:,irec) = sisux(:,irecloc)
if ( number_of_components == 2 ) then
- buffer_binary(2,:) = sisuz(:,irecloc)
+ buffer_binary(2,:,irec) = sisuz(:,irecloc)
else if ( number_of_components == 3 ) then
- buffer_binary(2,:) = sisuz(:,irecloc)
- buffer_binary(3,:) = siscurl(:,irecloc)
+ buffer_binary(2,:,irec) = sisuz(:,irecloc)
+ buffer_binary(3,:,irec) = siscurl(:,irecloc)
endif
#ifdef USE_MPI
else
- call MPI_RECV(buffer_binary(1,1),NSTEP_BETWEEN_OUTPUT_SEISMOS/subsamp_seismos,MPI_DOUBLE_PRECISION,&
+ call MPI_RECV(buffer_binary(1,1,irec),NSTEP_BETWEEN_OUTPUT_SEISMOS/subsamp_seismos,MPI_DOUBLE_PRECISION,&
which_proc_receiver(irec),irec,MPI_COMM_WORLD,MPI_STATUS_IGNORE,ierror)
if ( number_of_components == 2 ) then
- call MPI_RECV(buffer_binary(2,1),NSTEP_BETWEEN_OUTPUT_SEISMOS/subsamp_seismos,MPI_DOUBLE_PRECISION,&
+ call MPI_RECV(buffer_binary(2,1,irec),NSTEP_BETWEEN_OUTPUT_SEISMOS/subsamp_seismos,MPI_DOUBLE_PRECISION,&
which_proc_receiver(irec),irec,MPI_COMM_WORLD,MPI_STATUS_IGNORE,ierror)
endif
if ( number_of_components == 3 ) then
- call MPI_RECV(buffer_binary(2,1),NSTEP_BETWEEN_OUTPUT_SEISMOS/subsamp_seismos,MPI_DOUBLE_PRECISION,&
+ call MPI_RECV(buffer_binary(2,1,irec),NSTEP_BETWEEN_OUTPUT_SEISMOS/subsamp_seismos,MPI_DOUBLE_PRECISION,&
which_proc_receiver(irec),irec,MPI_COMM_WORLD,MPI_STATUS_IGNORE,ierror)
- call MPI_RECV(buffer_binary(3,1),NSTEP_BETWEEN_OUTPUT_SEISMOS/subsamp_seismos,MPI_DOUBLE_PRECISION,&
+ call MPI_RECV(buffer_binary(3,1,irec),NSTEP_BETWEEN_OUTPUT_SEISMOS/subsamp_seismos,MPI_DOUBLE_PRECISION,&
which_proc_receiver(irec),irec,MPI_COMM_WORLD,MPI_STATUS_IGNORE,ierror)
endif
#endif
endif
+ end if
+
+ end do
+
+ irecloc = 0
+ do irec = 1,nrec
+
+ if ( myrank == 0 ) then
+
if(.not. SU_FORMAT) then
if(save_ASCII_seismograms) then
@@ -285,10 +294,10 @@
#ifndef PAUL_SAVE_ASCII_IN_BINARY
do isample = 1,seismo_current
write(11,*) sngl(dble(seismo_offset+isample-1)*deltat - t0),' ', &
- sngl(buffer_binary(iorientation,isample))
+ sngl(buffer_binary(iorientation,isample,irec))
enddo
#else
- write(11) sngl(buffer_binary(iorientation,:))
+ write(11) sngl(buffer_binary(iorientation,:,irec))
#endif
close(11)
@@ -300,20 +309,20 @@
if(save_binary_seismograms) then
do isample = 1, seismo_current
if(save_binary_seismograms_single) &
- write(12,rec=(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(1,isample))
+ write(12,rec=(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(1,isample,irec))
if(save_binary_seismograms_double) &
- write(13,rec=(irec-1)*NSTEP+seismo_offset+isample) buffer_binary(1,isample)
+ write(13,rec=(irec-1)*NSTEP+seismo_offset+isample) buffer_binary(1,isample,irec)
if ( seismotype /= 4 .and. seismotype /= 6 .and. p_sv) then
if(save_binary_seismograms_single) &
- write(14,rec=(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(2,isample))
+ write(14,rec=(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(2,isample,irec))
if(save_binary_seismograms_double) &
- write(15,rec=(irec-1)*NSTEP+seismo_offset+isample) buffer_binary(2,isample)
+ write(15,rec=(irec-1)*NSTEP+seismo_offset+isample) buffer_binary(2,isample,irec)
endif
if ( seismotype == 5 ) then
if(save_binary_seismograms_single) &
- write(16,rec=(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(3,isample))
+ write(16,rec=(irec-1)*NSTEP+seismo_offset+isample) sngl(buffer_binary(3,isample,irec))
if(save_binary_seismograms_double) &
- write(17,rec=(irec-1)*NSTEP+seismo_offset+isample) buffer_binary(3,isample)
+ write(17,rec=(irec-1)*NSTEP+seismo_offset+isample) buffer_binary(3,isample,irec)
endif
enddo
endif
More information about the CIG-COMMITS
mailing list