[cig-commits] r8545 - seismo/2D/SPECFEM2D/trunk
walter at geodynamics.org
walter at geodynamics.org
Fri Dec 7 15:55:15 PST 2007
Author: walter
Date: 2007-12-07 15:55:14 -0800 (Fri, 07 Dec 2007)
New Revision: 8545
Modified:
seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90
seismo/2D/SPECFEM2D/trunk/enforce_acoustic_free_surface.f90
seismo/2D/SPECFEM2D/trunk/locate_receivers.F90
seismo/2D/SPECFEM2D/trunk/locate_source_force.F90
seismo/2D/SPECFEM2D/trunk/locate_source_moment_tensor.F90
seismo/2D/SPECFEM2D/trunk/part_unstruct.F90
seismo/2D/SPECFEM2D/trunk/plotpost.F90
seismo/2D/SPECFEM2D/trunk/specfem2D.F90
seismo/2D/SPECFEM2D/trunk/write_seismograms.F90
Log:
corrected some warnings with ifort.
Modified: seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90 2007-07-03 11:43:25 UTC (rev 8544)
+++ seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90 2007-12-07 23:55:14 UTC (rev 8545)
@@ -1,8 +1,8 @@
-subroutine prepare_assemble_MPI (myrank,nspec,ibool, &
+subroutine prepare_assemble_MPI (nspec,ibool, &
knods, ngnod, &
npoin, elastic, &
ninterface, max_interface_size, &
- my_neighbours, my_nelmnts_neighbours, my_interfaces, &
+ my_nelmnts_neighbours, my_interfaces, &
ibool_interfaces_acoustic, ibool_interfaces_elastic, &
nibool_interfaces_acoustic, nibool_interfaces_elastic, &
inum_interfaces_acoustic, inum_interfaces_elastic, &
@@ -14,14 +14,13 @@
include 'constants.h'
- integer, intent(in) :: nspec, myrank, npoin, ngnod
+ integer, intent(in) :: nspec, npoin, ngnod
logical, dimension(nspec), intent(in) :: elastic
integer, dimension(ngnod,nspec), intent(in) :: knods
integer, dimension(NGLLX,NGLLZ,nspec), intent(in) :: ibool
integer :: ninterface
integer :: max_interface_size
- integer, dimension(ninterface) :: my_neighbours
integer, dimension(ninterface) :: my_nelmnts_neighbours
integer, dimension(4,max_interface_size,ninterface) :: my_interfaces
integer, dimension(NGLLX*max_interface_size,ninterface) :: &
@@ -37,7 +36,6 @@
integer :: num_interface
integer :: ispec_interface
- logical, dimension(nspec) :: ispec_is_inner
logical, dimension(npoin) :: mask_ibool_acoustic
logical, dimension(npoin) :: mask_ibool_elastic
@@ -53,8 +51,7 @@
integer :: npoin_interface_elastic
integer :: ix,iz
- integer :: ier
-
+
integer :: sens
@@ -229,7 +226,7 @@
#ifdef USE_MPI
-subroutine create_MPI_requests_SEND_RECV_acoustic(myrank, &
+subroutine create_MPI_requests_SEND_RECV_acoustic( &
ninterface, ninterface_acoustic, &
nibool_interfaces_acoustic, &
my_neighbours, &
@@ -246,7 +243,6 @@
include 'mpif.h'
- integer, intent(in) :: myrank
integer, intent(in) :: ninterface, ninterface_acoustic
integer, dimension(ninterface), intent(in) :: inum_interfaces_acoustic
integer, intent(in) :: max_ibool_interfaces_size_acoustic
@@ -282,7 +278,7 @@
-subroutine create_MPI_requests_SEND_RECV_elastic(myrank, &
+subroutine create_MPI_requests_SEND_RECV_elastic( &
ninterface, ninterface_elastic, &
nibool_interfaces_elastic, &
my_neighbours, &
@@ -299,7 +295,6 @@
include 'mpif.h'
- integer, intent(in) :: myrank
integer, intent(in) :: ninterface, ninterface_elastic
integer, dimension(ninterface), intent(in) :: inum_interfaces_elastic
integer, intent(in) :: max_ibool_interfaces_size_elastic
@@ -423,14 +418,13 @@
-subroutine assemble_MPI_vector_acoustic_start(myrank,array_val1,npoin, &
+subroutine assemble_MPI_vector_acoustic_start(array_val1,npoin, &
ninterface, ninterface_acoustic, &
inum_interfaces_acoustic, &
max_interface_size, max_ibool_interfaces_size_acoustic,&
ibool_interfaces_acoustic, nibool_interfaces_acoustic, &
tab_requests_send_recv_acoustic, &
- buffer_send_faces_vector_acoustic, &
- buffer_recv_faces_vector_acoustic &
+ buffer_send_faces_vector_acoustic &
)
implicit none
@@ -443,7 +437,6 @@
double precision, dimension(npoin), intent(in) :: array_val1
- integer, intent(in) :: myrank
integer, intent(in) :: npoin
integer, intent(in) :: ninterface, ninterface_acoustic
integer, dimension(ninterface), intent(in) :: inum_interfaces_acoustic
@@ -453,12 +446,11 @@
integer, dimension(ninterface), intent(in) :: nibool_interfaces_acoustic
integer, dimension(ninterface_acoustic*2), intent(inout) :: tab_requests_send_recv_acoustic
double precision, dimension(max_ibool_interfaces_size_acoustic,ninterface_acoustic), intent(inout) :: &
- buffer_send_faces_vector_acoustic, buffer_recv_faces_vector_acoustic
+ buffer_send_faces_vector_acoustic
integer :: ipoin, num_interface, inum_interface
integer :: ier
- integer, dimension(MPI_STATUS_SIZE,ninterface_acoustic*2) :: tab_statuses_acoustic
-
+
integer :: i
@@ -489,14 +481,13 @@
-subroutine assemble_MPI_vector_elastic_start(myrank,array_val2,npoin, &
+subroutine assemble_MPI_vector_elastic_start(array_val2,npoin, &
ninterface, ninterface_elastic, &
inum_interfaces_elastic, &
max_interface_size, max_ibool_interfaces_size_elastic,&
ibool_interfaces_elastic, nibool_interfaces_elastic, &
tab_requests_send_recv_elastic, &
- buffer_send_faces_vector_elastic, &
- buffer_recv_faces_vector_elastic &
+ buffer_send_faces_vector_elastic &
)
implicit none
@@ -509,7 +500,6 @@
double precision, dimension(NDIM,npoin), intent(in) :: array_val2
- integer, intent(in) :: myrank
integer, intent(in) :: npoin
integer, intent(in) :: ninterface, ninterface_elastic
integer, dimension(ninterface), intent(in) :: inum_interfaces_elastic
@@ -519,13 +509,12 @@
integer, dimension(ninterface), intent(in) :: nibool_interfaces_elastic
integer, dimension(ninterface_elastic*2), intent(inout) :: tab_requests_send_recv_elastic
double precision, dimension(max_ibool_interfaces_size_elastic,ninterface_elastic), intent(inout) :: &
- buffer_send_faces_vector_elastic, buffer_recv_faces_vector_elastic
+ buffer_send_faces_vector_elastic
integer :: ipoin, num_interface, inum_interface
integer :: ier
- integer, dimension(MPI_STATUS_SIZE,ninterface_elastic) :: tab_statuses_elastic
integer :: i
@@ -558,13 +547,12 @@
-subroutine assemble_MPI_vector_acoustic_wait(myrank,array_val1,npoin, &
+subroutine assemble_MPI_vector_acoustic_wait(array_val1,npoin, &
ninterface, ninterface_acoustic, &
inum_interfaces_acoustic, &
max_interface_size, max_ibool_interfaces_size_acoustic,&
ibool_interfaces_acoustic, nibool_interfaces_acoustic, &
tab_requests_send_recv_acoustic, &
- buffer_send_faces_vector_acoustic, &
buffer_recv_faces_vector_acoustic &
)
@@ -578,7 +566,6 @@
double precision, dimension(npoin), intent(inout) :: array_val1
- integer, intent(in) :: myrank
integer, intent(in) :: npoin
integer, intent(in) :: ninterface, ninterface_acoustic
integer, dimension(ninterface), intent(in) :: inum_interfaces_acoustic
@@ -588,7 +575,7 @@
integer, dimension(ninterface), intent(in) :: nibool_interfaces_acoustic
integer, dimension(ninterface_acoustic*2), intent(inout) :: tab_requests_send_recv_acoustic
double precision, dimension(max_ibool_interfaces_size_acoustic,ninterface_acoustic), intent(inout) :: &
- buffer_send_faces_vector_acoustic, buffer_recv_faces_vector_acoustic
+ buffer_recv_faces_vector_acoustic
integer :: ipoin, num_interface, inum_interface
integer :: ier
@@ -620,13 +607,12 @@
-subroutine assemble_MPI_vector_elastic_wait(myrank,array_val2,npoin, &
+subroutine assemble_MPI_vector_elastic_wait(array_val2,npoin, &
ninterface, ninterface_elastic, &
inum_interfaces_elastic, &
max_interface_size, max_ibool_interfaces_size_elastic,&
ibool_interfaces_elastic, nibool_interfaces_elastic, &
tab_requests_send_recv_elastic, &
- buffer_send_faces_vector_elastic, &
buffer_recv_faces_vector_elastic &
)
@@ -640,7 +626,6 @@
double precision, dimension(NDIM,npoin), intent(inout) :: array_val2
- integer, intent(in) :: myrank
integer, intent(in) :: npoin
integer, intent(in) :: ninterface, ninterface_elastic
integer, dimension(ninterface), intent(in) :: inum_interfaces_elastic
@@ -650,7 +635,7 @@
integer, dimension(ninterface), intent(in) :: nibool_interfaces_elastic
integer, dimension(ninterface_elastic*2), intent(inout) :: tab_requests_send_recv_elastic
double precision, dimension(max_ibool_interfaces_size_elastic,ninterface_elastic), intent(inout) :: &
- buffer_send_faces_vector_elastic, buffer_recv_faces_vector_elastic
+ buffer_recv_faces_vector_elastic
integer :: ipoin, num_interface, inum_interface
integer :: ier
@@ -696,12 +681,11 @@
! identifier for error message file
integer, parameter :: IERROR = 30
- integer myrank
character(len=*) error_msg
integer ier
- character(len=80) outputname
+ ier = 0
! write error message to screen
write(*,*) error_msg(1:len(error_msg))
Modified: seismo/2D/SPECFEM2D/trunk/enforce_acoustic_free_surface.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/enforce_acoustic_free_surface.f90 2007-07-03 11:43:25 UTC (rev 8544)
+++ seismo/2D/SPECFEM2D/trunk/enforce_acoustic_free_surface.f90 2007-12-07 23:55:14 UTC (rev 8545)
@@ -35,7 +35,7 @@
!--- local variables
!---
- integer :: ispec_acoustic_surface,ispec,iedge,i,j,iglob
+ integer :: ispec_acoustic_surface,ispec,i,j,iglob
do ispec_acoustic_surface = 1, nelem_acoustic_surface
Modified: seismo/2D/SPECFEM2D/trunk/locate_receivers.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/locate_receivers.F90 2007-07-03 11:43:25 UTC (rev 8544)
+++ seismo/2D/SPECFEM2D/trunk/locate_receivers.F90 2007-12-07 23:55:14 UTC (rev 8545)
@@ -50,11 +50,11 @@
double precision x,z,xix,xiz,gammax,gammaz,jacobian
! use dynamic allocation
- double precision distmin, dist_glob
+ double precision distmin
double precision, dimension(:), allocatable :: final_distance
! receiver information
- integer :: nrecloc, is_proc_receiver, nb_proc_receiver
+ integer :: nrecloc
integer, dimension(nrec) :: ispec_selected_rec, recloc
double precision, dimension(nrec) :: xi_receiver,gamma_receiver
@@ -72,6 +72,8 @@
integer :: ierror
+ ierror = 0
+
! **************
write(IOUT,*)
Modified: seismo/2D/SPECFEM2D/trunk/locate_source_force.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/locate_source_force.F90 2007-07-03 11:43:25 UTC (rev 8544)
+++ seismo/2D/SPECFEM2D/trunk/locate_source_force.F90 2007-12-07 23:55:14 UTC (rev 8545)
@@ -39,7 +39,7 @@
integer :: ierror
-
+ ierror = 0
is_proc_source = 0
distminmax = -HUGEVAL
Modified: seismo/2D/SPECFEM2D/trunk/locate_source_moment_tensor.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/locate_source_moment_tensor.F90 2007-07-03 11:43:25 UTC (rev 8544)
+++ seismo/2D/SPECFEM2D/trunk/locate_source_moment_tensor.F90 2007-12-07 23:55:14 UTC (rev 8545)
@@ -52,17 +52,22 @@
integer, intent(in) :: nproc, myrank
double precision xi_source,gamma_source
+#ifdef USE_MPI
integer, dimension(1:nproc) :: allgather_is_proc_source
integer, dimension(1) :: locate_is_proc_source
integer :: ierror
+#endif
+
+
! **************
-
+ if ( myrank == 0 .or. nproc == 1 ) then
write(IOUT,*)
write(IOUT,*) '*******************************'
write(IOUT,*) ' locating moment-tensor source'
write(IOUT,*) '*******************************'
write(IOUT,*)
+ end if
! set distance to huge initial value
distmin=HUGEVAL
Modified: seismo/2D/SPECFEM2D/trunk/part_unstruct.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/part_unstruct.F90 2007-07-03 11:43:25 UTC (rev 8544)
+++ seismo/2D/SPECFEM2D/trunk/part_unstruct.F90 2007-12-07 23:55:14 UTC (rev 8545)
@@ -1206,11 +1206,10 @@
character(len=256), intent(in) :: scotch_strategy
integer :: IERR
- integer :: wgtflag
- integer, dimension(0:4) :: options
- integer :: num_start
-
+ edgecut = vwgt(0)
+ edgecut = 0
+
call scotchfstratinit (SCOTCHSTRAT(1), IERR)
IF (IERR .NE. 0) THEN
PRINT *, 'ERROR : MAIN : Cannot initialize strat'
Modified: seismo/2D/SPECFEM2D/trunk/plotpost.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/plotpost.F90 2007-07-03 11:43:25 UTC (rev 8544)
+++ seismo/2D/SPECFEM2D/trunk/plotpost.F90 2007-12-07 23:55:14 UTC (rev 8545)
@@ -94,8 +94,11 @@
integer :: nelem_acoustic_surface
integer, dimension(4,nelem_acoustic_surface) :: acoustic_edges
+#ifdef USE_MPI
double precision :: xmin_glob, xmax_glob, zmin_glob, zmax_glob
double precision :: dispmax_glob
+#endif
+
double precision, dimension(:,:), allocatable :: coorg_send
double precision, dimension(:,:), allocatable :: coorg_recv
integer, dimension(:), allocatable :: color_send
@@ -114,8 +117,21 @@
#endif
integer :: myrank, nproc
+#ifndef USE_MPI
+ allocate(coorg_recv(1,1))
+ allocate(color_recv(1))
+ allocate(RGB_recv(1,1))
+ nspec_recv = 0
+ nb_coorg_per_elem = 0
+ nb_color_per_elem = 0
+ ier = 0
+ num_spec = 0
+ iproc = nproc
+ deallocate(coorg_recv)
+ deallocate(color_recv)
+ deallocate(RGB_recv)
+#endif
-
! A4 or US letter paper
if(US_LETTER) then
usoffset = 1.75d0
Modified: seismo/2D/SPECFEM2D/trunk/specfem2D.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/specfem2D.F90 2007-07-03 11:43:25 UTC (rev 8544)
+++ seismo/2D/SPECFEM2D/trunk/specfem2D.F90 2007-12-07 23:55:14 UTC (rev 8545)
@@ -115,7 +115,7 @@
! pressure in an element
double precision, dimension(NGLLX,NGLLX) :: pressure_element
- integer :: i,j,k,l,it,irec,ipoin,ip,id,nbpoin,inump,n,ispec,iedge,npoin,npgeo,iglob
+ integer :: i,j,k,l,it,irec,ipoin,ip,id,nbpoin,inump,n,ispec,npoin,npgeo,iglob
logical :: anyabs
double precision :: dxd,dzd,valux,valuz,hlagrange,rhol,cosrot,sinrot,xi,gamma,x,z
@@ -153,7 +153,7 @@
integer, dimension(:,:,:), allocatable :: ibool
integer, dimension(:,:), allocatable :: knods
- integer, dimension(:), allocatable :: kmato,numabs,ispecnum_acoustic_surface,iedgenum_acoustic_surface, &
+ integer, dimension(:), allocatable :: kmato,numabs, &
ibegin_bottom,iend_bottom,ibegin_top,iend_top,jbegin_left,jend_left,jbegin_right,jend_right
integer ispec_selected_source,iglob_source,ix_source,iz_source,is_proc_source,nb_proc_source
@@ -173,7 +173,7 @@
double precision :: cutsnaps,sizemax_arrows,anglerec,xirec,gammarec
! for absorbing and acoustic free surface conditions
- integer :: ispec_acoustic_surface,inum,numabsread,numacoustread,iedgeacoustread
+ integer :: ispec_acoustic_surface,inum,numabsread
logical :: codeabsread(4)
double precision :: nx,nz,weight,xxi,zgamma
@@ -193,13 +193,13 @@
integer, dimension(NGLLX,NEDGES) :: ivalue,jvalue,ivalue_inverse,jvalue_inverse
integer, dimension(:), allocatable :: fluid_solid_acoustic_ispec,fluid_solid_acoustic_iedge, &
fluid_solid_elastic_ispec,fluid_solid_elastic_iedge
- integer :: num_fluid_solid_edges,num_fluid_solid_edges_alloc,ispec_acoustic,ispec_elastic, &
+ integer :: num_fluid_solid_edges,ispec_acoustic,ispec_elastic, &
iedge_acoustic,iedge_elastic,ipoin1D,iglob2
logical :: any_acoustic,any_elastic,coupled_acoustic_elastic
double precision :: displ_x,displ_z,displ_n,zxi,xgamma,jacobian1D,pressure
! for color images
- integer :: NX_IMAGE_color,NZ_IMAGE_color,iplus1,jplus1,iminus1,jminus1,count_passes
+ integer :: NX_IMAGE_color,NZ_IMAGE_color
integer :: npgeo_glob
double precision :: xmin_color_image,xmax_color_image, &
zmin_color_image,zmax_color_image,size_pixel_horizontal,size_pixel_vertical
@@ -263,13 +263,15 @@
integer :: ninterface_acoustic, ninterface_elastic
integer, dimension(:), allocatable :: inum_interfaces_acoustic, inum_interfaces_elastic
- double precision, dimension(:,:), allocatable :: buffer_send_faces_vector_acoustic
- double precision, dimension(:,:), allocatable :: buffer_recv_faces_vector_acoustic
+#ifdef USE_MPI
+ double precision, dimension(:,:), allocatable :: buffer_send_faces_vector_ac
+ double precision, dimension(:,:), allocatable :: buffer_recv_faces_vector_ac
integer, dimension(:), allocatable :: tab_requests_send_recv_acoustic
- double precision, dimension(:,:), allocatable :: buffer_send_faces_vector_elastic
- double precision, dimension(:,:), allocatable :: buffer_recv_faces_vector_elastic
+ double precision, dimension(:,:), allocatable :: buffer_send_faces_vector_el
+ double precision, dimension(:,:), allocatable :: buffer_recv_faces_vector_el
integer, dimension(:), allocatable :: tab_requests_send_recv_elastic
- integer :: max_ibool_interfaces_size_acoustic, max_ibool_interfaces_size_elastic
+ integer :: max_ibool_interfaces_size_ac, max_ibool_interfaces_size_el
+#endif
integer, dimension(:,:), allocatable :: acoustic_surface
integer, dimension(:,:), allocatable :: acoustic_edges
@@ -283,7 +285,6 @@
integer :: nrecloc, irecloc
integer, dimension(:), allocatable :: recloc, which_proc_receiver
- character(len=256) :: filename
!***********************************************************************
!
@@ -299,6 +300,10 @@
#else
nproc = 1
myrank = 0
+ ier = 0
+ ninterface_acoustic = 0
+ ninterface_elastic = 0
+ iproc = 0
#endif
@@ -836,8 +841,7 @@
do i = acoustic_surface(2,ispec_acoustic_surface), acoustic_surface(3,ispec_acoustic_surface)
iglob = ibool(i,j,ispec)
if ( iglob_source == iglob ) then
- call exit_MPI('an acoustic source cannot be located exactly on the free surface &
- & because pressure is zero there')
+ call exit_MPI('an acoustic source cannot be located exactly on the free surface because pressure is zero there')
end if
end do
end do
@@ -895,8 +899,7 @@
(izmin==NGLLZ .and. izmax==NGLLZ .and. ixmin==NGLLX .and. ixmax==NGLLX .and. &
gamma_receiver(irec) > 0.99d0 .and. xi_receiver(irec) > 0.99d0) ) then
if(seismotype == 4) then
- call exit_MPI('an acoustic pressure receiver cannot be located exactly on the free &
- & surface because pressure is zero there')
+call exit_MPI('an acoustic pressure receiver cannot be located exactly on the free surface because pressure is zero there')
else
print *, '**********************************************************************'
print *, '*** Warning: acoustic receiver located exactly on the free surface ***'
@@ -977,53 +980,53 @@
#ifdef USE_MPI
if ( nproc > 1 ) then
! preparing for MPI communications
- call prepare_assemble_MPI (myrank,nspec,ibool, &
+ call prepare_assemble_MPI (nspec,ibool, &
knods, ngnod, &
npoin, elastic, &
ninterface, max_interface_size, &
- my_neighbours, my_nelmnts_neighbours, my_interfaces, &
+ my_nelmnts_neighbours, my_interfaces, &
ibool_interfaces_acoustic, ibool_interfaces_elastic, &
nibool_interfaces_acoustic, nibool_interfaces_elastic, &
inum_interfaces_acoustic, inum_interfaces_elastic, &
ninterface_acoustic, ninterface_elastic &
)
- max_ibool_interfaces_size_acoustic = maxval(nibool_interfaces_acoustic(:))
- max_ibool_interfaces_size_elastic = NDIM*maxval(nibool_interfaces_elastic(:))
+ max_ibool_interfaces_size_ac = maxval(nibool_interfaces_acoustic(:))
+ max_ibool_interfaces_size_el = NDIM*maxval(nibool_interfaces_elastic(:))
allocate(tab_requests_send_recv_acoustic(ninterface_acoustic*2))
- allocate(buffer_send_faces_vector_acoustic(max_ibool_interfaces_size_acoustic,ninterface_acoustic))
- allocate(buffer_recv_faces_vector_acoustic(max_ibool_interfaces_size_acoustic,ninterface_acoustic))
+ allocate(buffer_send_faces_vector_ac(max_ibool_interfaces_size_ac,ninterface_acoustic))
+ allocate(buffer_recv_faces_vector_ac(max_ibool_interfaces_size_ac,ninterface_acoustic))
allocate(tab_requests_send_recv_elastic(ninterface_elastic*2))
- allocate(buffer_send_faces_vector_elastic(max_ibool_interfaces_size_elastic,ninterface_elastic))
- allocate(buffer_recv_faces_vector_elastic(max_ibool_interfaces_size_elastic,ninterface_elastic))
+ allocate(buffer_send_faces_vector_el(max_ibool_interfaces_size_el,ninterface_elastic))
+ allocate(buffer_recv_faces_vector_el(max_ibool_interfaces_size_el,ninterface_elastic))
! creating mpi non-blocking persistent communications for acoustic elements
- call create_MPI_requests_SEND_RECV_acoustic(myrank, &
+ call create_MPI_requests_SEND_RECV_acoustic( &
ninterface, ninterface_acoustic, &
nibool_interfaces_acoustic, &
my_neighbours, &
- max_ibool_interfaces_size_acoustic, &
- buffer_send_faces_vector_acoustic, &
- buffer_recv_faces_vector_acoustic, &
+ max_ibool_interfaces_size_ac, &
+ buffer_send_faces_vector_ac, &
+ buffer_recv_faces_vector_ac, &
tab_requests_send_recv_acoustic, &
inum_interfaces_acoustic &
)
! creating mpi non-blocking persistent communications for elastic elements
- call create_MPI_requests_SEND_RECV_elastic(myrank, &
+ call create_MPI_requests_SEND_RECV_elastic( &
ninterface, ninterface_elastic, &
nibool_interfaces_elastic, &
my_neighbours, &
- max_ibool_interfaces_size_elastic, &
- buffer_send_faces_vector_elastic, &
- buffer_recv_faces_vector_elastic, &
+ max_ibool_interfaces_size_el, &
+ buffer_send_faces_vector_el, &
+ buffer_recv_faces_vector_el, &
tab_requests_send_recv_elastic, &
inum_interfaces_elastic &
)
! assembling the mass matrix
call assemble_MPI_scalar(myrank,rmass_inverse_acoustic, rmass_inverse_elastic,npoin, &
- ninterface, max_interface_size, max_ibool_interfaces_size_acoustic, max_ibool_interfaces_size_elastic, &
+ 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)
end if
@@ -1166,7 +1169,8 @@
end do
end do
-! creating and filling array num_pixel_loc with the positions of each colored pixel owned by the local process (useful for parallel jobs)
+! creating and filling array num_pixel_loc with the positions of each colored
+! pixel owned by the local process (useful for parallel jobs)
allocate(num_pixel_loc(nb_pixel_loc))
nb_pixel_loc = 0
@@ -1216,6 +1220,15 @@
end if
end if
+#else
+ allocate(nb_pixel_per_proc(1))
+ deallocate(nb_pixel_per_proc)
+ allocate(num_pixel_recv(1,1))
+ deallocate(num_pixel_recv)
+ allocate(data_pixel_recv(1))
+ deallocate(data_pixel_recv)
+ allocate(data_pixel_send(1))
+ deallocate(data_pixel_send)
#endif
write(IOUT,*) 'done locating all the pixels of color images'
@@ -1424,8 +1437,6 @@
enddo
- !if(num_fluid_solid_edges /= num_fluid_solid_edges_alloc) call exit_MPI('error in creation of arrays for fluid/solid matching')
-
! make sure fluid/solid matching has been perfectly detected: check that the grid points
! have the same physical coordinates
! loop on all the coupling edges
@@ -1659,23 +1670,21 @@
! assembling potential_dot_dot for acoustic elements
#ifdef USE_MPI
if ( nproc > 1 .and. any_acoustic .and. ninterface_acoustic > 0) then
- call assemble_MPI_vector_acoustic_start(myrank,potential_dot_dot_acoustic,npoin, &
+ call assemble_MPI_vector_acoustic_start(potential_dot_dot_acoustic,npoin, &
ninterface, ninterface_acoustic, &
inum_interfaces_acoustic, &
- max_interface_size, max_ibool_interfaces_size_acoustic,&
+ max_interface_size, max_ibool_interfaces_size_ac,&
ibool_interfaces_acoustic, nibool_interfaces_acoustic, &
tab_requests_send_recv_acoustic, &
- buffer_send_faces_vector_acoustic, &
- buffer_recv_faces_vector_acoustic &
+ buffer_send_faces_vector_ac &
)
- call assemble_MPI_vector_acoustic_wait(myrank,potential_dot_dot_acoustic,npoin, &
+ call assemble_MPI_vector_acoustic_wait(potential_dot_dot_acoustic,npoin, &
ninterface, ninterface_acoustic, &
inum_interfaces_acoustic, &
- max_interface_size, max_ibool_interfaces_size_acoustic,&
+ max_interface_size, max_ibool_interfaces_size_ac,&
ibool_interfaces_acoustic, nibool_interfaces_acoustic, &
tab_requests_send_recv_acoustic, &
- buffer_send_faces_vector_acoustic, &
- buffer_recv_faces_vector_acoustic &
+ buffer_recv_faces_vector_ac &
)
end if
#endif
@@ -1785,23 +1794,21 @@
! assembling accel_elastic for elastic elements
#ifdef USE_MPI
if ( nproc > 1 .and. any_elastic .and. ninterface_elastic > 0) then
- call assemble_MPI_vector_elastic_start(myrank,accel_elastic,npoin, &
+ call assemble_MPI_vector_elastic_start(accel_elastic,npoin, &
ninterface, ninterface_elastic, &
inum_interfaces_elastic, &
- max_interface_size, max_ibool_interfaces_size_elastic,&
+ max_interface_size, max_ibool_interfaces_size_el,&
ibool_interfaces_elastic, nibool_interfaces_elastic, &
tab_requests_send_recv_elastic, &
- buffer_send_faces_vector_elastic, &
- buffer_recv_faces_vector_elastic &
+ buffer_send_faces_vector_el &
)
- call assemble_MPI_vector_elastic_wait(myrank,accel_elastic,npoin, &
+ call assemble_MPI_vector_elastic_wait(accel_elastic,npoin, &
ninterface, ninterface_elastic, &
inum_interfaces_elastic, &
- max_interface_size, max_ibool_interfaces_size_elastic,&
+ max_interface_size, max_ibool_interfaces_size_el,&
ibool_interfaces_elastic, nibool_interfaces_elastic, &
tab_requests_send_recv_elastic, &
- buffer_send_faces_vector_elastic, &
- buffer_recv_faces_vector_elastic &
+ buffer_recv_faces_vector_el &
)
end if
#endif
Modified: seismo/2D/SPECFEM2D/trunk/write_seismograms.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/write_seismograms.F90 2007-07-03 11:43:25 UTC (rev 8544)
+++ seismo/2D/SPECFEM2D/trunk/write_seismograms.F90 2007-12-07 23:55:14 UTC (rev 8545)
@@ -36,7 +36,7 @@
character(len=MAX_LENGTH_STATION_NAME), dimension(nrec) :: station_name
character(len=MAX_LENGTH_NETWORK_NAME), dimension(nrec) :: network_name
- integer irec,irecord,length_station_name,length_network_name,iorientation,isample,number_of_components
+ integer irec,length_station_name,length_network_name,iorientation,isample,number_of_components
character(len=4) chn
character(len=1) component
@@ -50,8 +50,9 @@
integer :: irecloc
+
+#ifdef USE_MPI
integer :: ierror
-#ifdef USE_MPI
integer, dimension(MPI_STATUS_SIZE) :: status
#endif
More information about the cig-commits
mailing list