[cig-commits] r8606 - seismo/2D/SPECFEM2D/trunk
walter at geodynamics.org
walter at geodynamics.org
Fri Dec 7 16:00:36 PST 2007
Author: walter
Date: 2007-12-07 16:00:36 -0800 (Fri, 07 Dec 2007)
New Revision: 8606
Modified:
seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90
seismo/2D/SPECFEM2D/trunk/compute_forces_acoustic.f90
seismo/2D/SPECFEM2D/trunk/compute_forces_elastic.f90
seismo/2D/SPECFEM2D/trunk/enforce_acoustic_free_surface.f90
seismo/2D/SPECFEM2D/trunk/plotpost.F90
seismo/2D/SPECFEM2D/trunk/specfem2D.F90
seismo/2D/SPECFEM2D/trunk/write_seismograms.F90
Log:
fixed a few bugs (mainly errors detected by ifort, with unused unallocated arrays when some options are enabled or disabled).
Modified: seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90 2007-12-01 13:02:28 UTC (rev 8605)
+++ seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90 2007-12-08 00:00:36 UTC (rev 8606)
@@ -377,7 +377,7 @@
!-----------------------------------------------
! Assembling the mass matrix.
!-----------------------------------------------
-subroutine assemble_MPI_scalar(myrank,array_val1, array_val2,npoin, &
+subroutine assemble_MPI_scalar(array_val1, array_val2,npoin, &
ninterface, max_interface_size, max_ibool_interfaces_size_ac, max_ibool_interfaces_size_el, &
ibool_interfaces_acoustic,ibool_interfaces_elastic, nibool_interfaces_acoustic,nibool_interfaces_elastic, my_neighbours)
@@ -389,7 +389,6 @@
! array to assemble
real(kind=CUSTOM_REAL), dimension(npoin), intent(inout) :: array_val1, array_val2
- integer, intent(in) :: myrank
integer, intent(in) :: npoin
integer, intent(in) :: ninterface
integer, intent(in) :: max_interface_size
Modified: seismo/2D/SPECFEM2D/trunk/compute_forces_acoustic.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/compute_forces_acoustic.f90 2007-12-01 13:02:28 UTC (rev 8605)
+++ seismo/2D/SPECFEM2D/trunk/compute_forces_acoustic.f90 2007-12-08 00:00:36 UTC (rev 8606)
@@ -58,7 +58,7 @@
! for overlapping MPI communications with computation
integer, intent(in) :: nspec_inner_outer
- integer, dimension(nspec_inner_outer), intent(in) :: ispec_inner_outer_to_glob
+ integer, dimension(max(1,nspec_inner_outer)), intent(in) :: ispec_inner_outer_to_glob
logical, intent(in) :: num_phase_inner_outer
!---
Modified: seismo/2D/SPECFEM2D/trunk/compute_forces_elastic.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/compute_forces_elastic.f90 2007-12-01 13:02:28 UTC (rev 8605)
+++ seismo/2D/SPECFEM2D/trunk/compute_forces_elastic.f90 2007-12-08 00:00:36 UTC (rev 8606)
@@ -70,7 +70,7 @@
! for overlapping MPI communications with computation
integer, intent(in) :: nspec_inner_outer
- integer, dimension(nspec_inner_outer), intent(in) :: ispec_inner_outer_to_glob
+ integer, dimension(max(1,nspec_inner_outer)), intent(in) :: ispec_inner_outer_to_glob
logical, intent(in) :: num_phase_inner_outer
!---
Modified: seismo/2D/SPECFEM2D/trunk/enforce_acoustic_free_surface.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/enforce_acoustic_free_surface.f90 2007-12-01 13:02:28 UTC (rev 8605)
+++ seismo/2D/SPECFEM2D/trunk/enforce_acoustic_free_surface.f90 2007-12-08 00:00:36 UTC (rev 8606)
@@ -25,7 +25,7 @@
integer :: nelem_acoustic_surface,npoin,nspec
- integer, dimension(5,nelem_acoustic_surface) :: acoustic_surface
+ integer, dimension(5,max(1,nelem_acoustic_surface)) :: acoustic_surface
integer, dimension(NGLLX,NGLLZ,nspec) :: ibool
Modified: seismo/2D/SPECFEM2D/trunk/plotpost.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/plotpost.F90 2007-12-01 13:02:28 UTC (rev 8605)
+++ seismo/2D/SPECFEM2D/trunk/plotpost.F90 2007-12-08 00:00:36 UTC (rev 8606)
@@ -92,7 +92,7 @@
! for free surface output
integer :: nelem_acoustic_surface
- integer, dimension(4,nelem_acoustic_surface) :: acoustic_edges
+ integer, dimension(4,max(1,nelem_acoustic_surface)) :: acoustic_edges
#ifdef USE_MPI
double precision :: xmin_glob, xmax_glob, zmin_glob, zmax_glob
Modified: seismo/2D/SPECFEM2D/trunk/specfem2D.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/specfem2D.F90 2007-12-01 13:02:28 UTC (rev 8605)
+++ seismo/2D/SPECFEM2D/trunk/specfem2D.F90 2007-12-08 00:00:36 UTC (rev 8606)
@@ -663,6 +663,9 @@
acoustic_edges, acoustic_surface)
write(IOUT,*)
write(IOUT,*) 'Number of free surface elements: ',nelem_acoustic_surface
+ else
+ allocate(acoustic_edges(4,1))
+ allocate(acoustic_surface(5,1))
endif
!
@@ -1138,7 +1141,7 @@
)
! assembling the mass matrix
- call assemble_MPI_scalar(myrank,rmass_inverse_acoustic, rmass_inverse_elastic,npoin, &
+ call assemble_MPI_scalar(rmass_inverse_acoustic, rmass_inverse_elastic,npoin, &
ninterface, max_interface_size, max_ibool_interfaces_size_ac, max_ibool_interfaces_size_el, &
ibool_interfaces_acoustic,ibool_interfaces_elastic, nibool_interfaces_acoustic,nibool_interfaces_elastic, my_neighbours)
@@ -1168,6 +1171,7 @@
nspec_outer = 0
nspec_inner = nspec
+ allocate(ispec_outer_to_glob(1))
allocate(ispec_inner_to_glob(nspec_inner))
do ispec = 1, nspec
ispec_inner_to_glob(ispec) = ispec
@@ -1715,6 +1719,7 @@
time_start = 86400.d0*time_values(3) + 3600.d0*time_values(5) + &
60.d0*time_values(6) + time_values(7) + time_values(8) / 1000.d0
+ if(output_color_image) then
! to display the P-velocity model in background on color images
allocate(vp_display(npoin))
do ispec = 1,nspec
@@ -1775,6 +1780,7 @@
endif
#endif
+ endif
! initialize variables for writing seismograms
seismo_offset = 0
@@ -1807,9 +1813,11 @@
potential_dot_dot_acoustic = ZERO
! free surface for an acoustic medium
+ if ( nelem_acoustic_surface > 0 ) then
call enforce_acoustic_free_surface(potential_dot_dot_acoustic,potential_dot_acoustic, &
potential_acoustic,acoustic_surface, &
ibool,nelem_acoustic_surface,npoin,nspec)
+ endif
! *********************************************************
! ************* compute forces for the acoustic elements
@@ -1950,9 +1958,11 @@
potential_dot_acoustic = potential_dot_acoustic + deltatover2*potential_dot_dot_acoustic
! free surface for an acoustic medium
+ if ( nelem_acoustic_surface > 0 ) then
call enforce_acoustic_free_surface(potential_dot_dot_acoustic,potential_dot_acoustic, &
potential_acoustic,acoustic_surface, &
ibool,nelem_acoustic_surface,npoin,nspec)
+ endif
endif
! *********************************************************
@@ -2440,7 +2450,7 @@
!---- save temporary or final seismograms
call write_seismograms(sisux,sisuz,station_name,network_name,NSTEP, &
- nrecloc,which_proc_receiver,nrec,myrank,deltat,seismotype,st_xval,it,t0, &
+ nrecloc,which_proc_receiver,nrec,myrank,deltat,seismotype,st_xval,t0, &
NTSTEP_BETWEEN_OUTPUT_SEISMO,seismo_offset,seismo_current &
)
seismo_offset = seismo_offset + seismo_current
@@ -2497,6 +2507,13 @@
if(IOUT /= ISTANDARD_OUTPUT) close(IOUT)
!
+!---- end MPI
+!
+#ifdef USE_MPI
+ call MPI_FINALIZE(ier)
+#endif
+
+!
!---- formats
!
Modified: seismo/2D/SPECFEM2D/trunk/write_seismograms.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/write_seismograms.F90 2007-12-01 13:02:28 UTC (rev 8605)
+++ seismo/2D/SPECFEM2D/trunk/write_seismograms.F90 2007-12-08 00:00:36 UTC (rev 8606)
@@ -14,7 +14,7 @@
! write seismograms to text files
subroutine write_seismograms(sisux,sisuz,station_name,network_name, &
- NSTEP,nrecloc,which_proc_receiver,nrec,myrank,deltat,seismotype,st_xval,it,t0, &
+ NSTEP,nrecloc,which_proc_receiver,nrec,myrank,deltat,seismotype,st_xval,t0, &
NTSTEP_BETWEEN_OUTPUT_SEISMO,seismo_offset,seismo_current &
)
@@ -25,7 +25,7 @@
include "mpif.h"
#endif
- integer :: nrec,NSTEP,it,seismotype
+ integer :: nrec,NSTEP,seismotype
integer :: NTSTEP_BETWEEN_OUTPUT_SEISMO,seismo_offset,seismo_current
double precision :: t0,deltat
More information about the cig-commits
mailing list