[cig-commits] r12932 - seismo/3D/SPECFEM3D/branches/update_temporary
nlegoff at geodynamics.org
nlegoff at geodynamics.org
Sun Sep 21 16:46:00 PDT 2008
Author: nlegoff
Date: 2008-09-21 16:46:00 -0700 (Sun, 21 Sep 2008)
New Revision: 12932
Modified:
seismo/3D/SPECFEM3D/branches/update_temporary/assemble_MPI_scalar.f90
seismo/3D/SPECFEM3D/branches/update_temporary/assemble_MPI_vector.f90
seismo/3D/SPECFEM3D/branches/update_temporary/constants.h.in
seismo/3D/SPECFEM3D/branches/update_temporary/parallel.f90
seismo/3D/SPECFEM3D/branches/update_temporary/specfem3D.f90
Log:
added communications for simulations with external meshes.
Modified: seismo/3D/SPECFEM3D/branches/update_temporary/assemble_MPI_scalar.f90
===================================================================
--- seismo/3D/SPECFEM3D/branches/update_temporary/assemble_MPI_scalar.f90 2008-09-21 21:08:25 UTC (rev 12931)
+++ seismo/3D/SPECFEM3D/branches/update_temporary/assemble_MPI_scalar.f90 2008-09-21 23:46:00 UTC (rev 12932)
@@ -196,3 +196,84 @@
end subroutine assemble_MPI_scalar
+!
+!----
+!
+
+ subroutine assemble_MPI_scalar_ext_mesh(NPROC,NGLOB_AB,array_val, &
+ buffer_send_scalar_ext_mesh,buffer_recv_scalar_ext_mesh, &
+ ninterfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
+ nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,my_neighbours_ext_mesh, &
+ request_send_scalar_ext_mesh,request_recv_scalar_ext_mesh &
+ )
+
+ implicit none
+
+ include "constants.h"
+
+! include values created by the mesher
+ include "OUTPUT_FILES/values_from_mesher.h"
+
+! array to assemble
+ real(kind=CUSTOM_REAL), dimension(NGLOB_AB) :: array_val
+
+ integer :: NPROC
+ integer :: NGLOB_AB
+
+ real(kind=CUSTOM_REAL), dimension(max_nibool_interfaces_ext_mesh,ninterfaces_ext_mesh) :: &
+ buffer_send_scalar_ext_mesh,buffer_recv_scalar_ext_mesh
+
+ integer :: ninterfaces_ext_mesh,max_nibool_interfaces_ext_mesh
+ integer, dimension(ninterfaces_ext_mesh) :: nibool_interfaces_ext_mesh,my_neighbours_ext_mesh
+ integer, dimension(max_nibool_interfaces_ext_mesh,ninterfaces_ext_mesh) :: ibool_interfaces_ext_mesh
+ integer, dimension(ninterfaces_ext_mesh) :: request_send_scalar_ext_mesh,request_recv_scalar_ext_mesh
+
+ integer ipoin,iinterface
+ integer sender,receiver
+
+! $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+
+! here we have to assemble all the contributions between partitions using MPI
+
+! assemble only if more than one partition
+ if(NPROC > 1) then
+
+! partition border copy into the buffer
+ do iinterface = 1, ninterfaces_ext_mesh
+ do ipoin = 1, nibool_interfaces_ext_mesh(iinterface)
+ buffer_send_scalar_ext_mesh(ipoin,iinterface) = array_val(ibool_interfaces_ext_mesh(ipoin,iinterface))
+ enddo
+ enddo
+
+! send messages
+ do iinterface = 1, ninterfaces_ext_mesh
+ call issend_cr(buffer_send_scalar_ext_mesh(1:nibool_interfaces_ext_mesh(iinterface),iinterface), &
+ nibool_interfaces_ext_mesh(iinterface), &
+ my_neighbours_ext_mesh(iinterface), &
+ itag, &
+ request_send_scalar_ext_mesh(iinterface) &
+ )
+ call irecv_cr(buffer_send_scalar_ext_mesh(1:nibool_interfaces_ext_mesh(iinterface),iinterface), &
+ nibool_interfaces_ext_mesh(iinterface), &
+ my_neighbours_ext_mesh(iinterface), &
+ itag, &
+ request_recv_scalar_ext_mesh(iinterface) &
+ )
+ enddo
+
+! wait for communications completion
+ do iinterface = 1, ninterfaces_ext_mesh
+ call wait_req(request_recv_scalar_ext_mesh(iinterface))
+ enddo
+
+! adding contributions of neighbours
+ do iinterface = 1, ninterfaces_ext_mesh
+ do ipoin = 1, nibool_interfaces_ext_mesh(iinterface)
+ array_val(ibool_interfaces_ext_mesh(ipoin,iinterface)) = &
+ array_val(ibool_interfaces_ext_mesh(ipoin,iinterface)) + buffer_send_scalar_ext_mesh(ipoin,iinterface)
+ enddo
+ enddo
+
+ endif
+
+ end subroutine assemble_MPI_scalar_ext_mesh
Modified: seismo/3D/SPECFEM3D/branches/update_temporary/assemble_MPI_vector.f90
===================================================================
--- seismo/3D/SPECFEM3D/branches/update_temporary/assemble_MPI_vector.f90 2008-09-21 21:08:25 UTC (rev 12931)
+++ seismo/3D/SPECFEM3D/branches/update_temporary/assemble_MPI_vector.f90 2008-09-21 23:46:00 UTC (rev 12932)
@@ -196,3 +196,89 @@
end subroutine assemble_MPI_vector
+!
+!----
+!
+
+ subroutine assemble_MPI_vector_ext_mesh(NPROC,NGLOB_AB,array_val, &
+ buffer_send_vector_ext_mesh,buffer_recv_vector_ext_mesh, &
+ ninterfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
+ nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,my_neighbours_ext_mesh, &
+ request_send_vector_ext_mesh,request_recv_vector_ext_mesh &
+ )
+
+ implicit none
+
+ include "constants.h"
+
+! include values created by the mesher
+ include "OUTPUT_FILES/values_from_mesher.h"
+
+! array to assemble
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_AB) :: array_val
+
+ integer :: NPROC
+ integer :: NGLOB_AB
+
+ real(kind=CUSTOM_REAL), dimension(NDIM,max_nibool_interfaces_ext_mesh,ninterfaces_ext_mesh) :: &
+ buffer_send_vector_ext_mesh,buffer_recv_vector_ext_mesh
+
+ integer :: ninterfaces_ext_mesh,max_nibool_interfaces_ext_mesh
+ integer, dimension(ninterfaces_ext_mesh) :: nibool_interfaces_ext_mesh,my_neighbours_ext_mesh
+ integer, dimension(max_nibool_interfaces_ext_mesh,ninterfaces_ext_mesh) :: ibool_interfaces_ext_mesh
+ integer, dimension(ninterfaces_ext_mesh) :: request_send_vector_ext_mesh,request_recv_vector_ext_mesh
+
+ integer ipoin,iinterface
+ integer sender,receiver
+
+! $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+
+! here we have to assemble all the contributions between partitions using MPI
+
+! assemble only if more than one partition
+ if(NPROC > 1) then
+
+! partition border copy into the buffer
+ do iinterface = 1, ninterfaces_ext_mesh
+ do ipoin = 1, nibool_interfaces_ext_mesh(iinterface)
+ buffer_send_vector_ext_mesh(:,ipoin,iinterface) = array_val(:,ibool_interfaces_ext_mesh(ipoin,iinterface))
+ enddo
+ enddo
+
+! send messages
+ do iinterface = 1, ninterfaces_ext_mesh
+ call issend_cr(buffer_send_vector_ext_mesh(:,1:nibool_interfaces_ext_mesh(iinterface),iinterface), &
+ NDIM*nibool_interfaces_ext_mesh(iinterface), &
+ my_neighbours_ext_mesh(iinterface), &
+ itag, &
+ request_send_vector_ext_mesh(iinterface) &
+ )
+ call irecv_cr(buffer_send_vector_ext_mesh(:,1:nibool_interfaces_ext_mesh(iinterface),iinterface), &
+ NDIM*nibool_interfaces_ext_mesh(iinterface), &
+ my_neighbours_ext_mesh(iinterface), &
+ itag, &
+ request_recv_vector_ext_mesh(iinterface) &
+ )
+ enddo
+
+! wait for communications completion (recv)
+ do iinterface = 1, ninterfaces_ext_mesh
+ call wait_req(request_recv_vector_ext_mesh(iinterface))
+ enddo
+
+! adding contributions of neighbours
+ do iinterface = 1, ninterfaces_ext_mesh
+ do ipoin = 1, nibool_interfaces_ext_mesh(iinterface)
+ array_val(:,ibool_interfaces_ext_mesh(ipoin,iinterface)) = &
+ array_val(:,ibool_interfaces_ext_mesh(ipoin,iinterface)) + buffer_send_vector_ext_mesh(:,ipoin,iinterface)
+ enddo
+ enddo
+
+! wait for communications completion (send)
+ do iinterface = 1, ninterfaces_ext_mesh
+ call wait_req(request_send_vector_ext_mesh(iinterface))
+ enddo
+
+ endif
+
+ end subroutine assemble_MPI_vector_ext_mesh
Modified: seismo/3D/SPECFEM3D/branches/update_temporary/constants.h.in
===================================================================
--- seismo/3D/SPECFEM3D/branches/update_temporary/constants.h.in 2008-09-21 21:08:25 UTC (rev 12931)
+++ seismo/3D/SPECFEM3D/branches/update_temporary/constants.h.in 2008-09-21 23:46:00 UTC (rev 12932)
@@ -117,7 +117,7 @@
!------------------------------------------------------
! nlegoff -- Variables that should be read/computed elsewhere.
-! Temporary declared here.
+! Temporarily declared here.
!------------------------------------------------------
! whether or not an external mesh is used (provided by CUBIT for example)
logical, parameter :: USE_EXTERNAL_MESH = .false.
Modified: seismo/3D/SPECFEM3D/branches/update_temporary/parallel.f90
===================================================================
--- seismo/3D/SPECFEM3D/branches/update_temporary/parallel.f90 2008-09-21 21:08:25 UTC (rev 12931)
+++ seismo/3D/SPECFEM3D/branches/update_temporary/parallel.f90 2008-09-21 23:46:00 UTC (rev 12932)
@@ -401,3 +401,78 @@
proc_null = MPI_PROC_NULL
end function proc_null
+
+!
+!----
+!
+
+ subroutine issend_cr(sendbuf, sendcount, dest, sendtag, req)
+
+ implicit none
+
+! standard include of the MPI library
+ include 'mpif.h'
+
+ include "constants.h"
+ include "precision.h"
+
+ integer sendcount, dest, sendtag, req
+ real(kind=CUSTOM_REAL), dimension(sendcount) :: sendbuf
+
+! MPI status of messages to be received
+ integer msg_status(MPI_STATUS_SIZE)
+
+ integer ier
+
+ call MPI_ISSEND(sendbuf(1),sendcount,CUSTOM_MPI_TYPE,dest,sendtag, &
+ MPI_COMM_WORLD,req,ier)
+
+ end subroutine issend_cr
+
+!
+!----
+!
+
+ subroutine irecv_cr(recvbuf, recvcount, dest, recvtag, req)
+
+ implicit none
+
+! standard include of the MPI library
+ include 'mpif.h'
+
+ include "constants.h"
+ include "precision.h"
+
+ integer recvcount, dest, recvtag, req
+ real(kind=CUSTOM_REAL), dimension(recvcount) :: recvbuf
+
+! MPI status of messages to be received
+ integer msg_status(MPI_STATUS_SIZE)
+
+ integer ier
+
+ call MPI_IRECV(recvbuf(1),recvcount,CUSTOM_MPI_TYPE,dest,recvtag, &
+ MPI_COMM_WORLD,req,ier)
+
+ end subroutine irecv_cr
+
+!
+!----
+!
+
+ subroutine wait_req(req)
+
+ implicit none
+
+! standard include of the MPI library
+ include 'mpif.h'
+
+ integer :: req
+
+ integer, dimension(MPI_STATUS_SIZE) :: req_mpi_status
+
+ integer :: ier
+
+ call mpi_wait(req,req_mpi_status,ier)
+
+ end subroutine wait_req
Modified: seismo/3D/SPECFEM3D/branches/update_temporary/specfem3D.f90
===================================================================
--- seismo/3D/SPECFEM3D/branches/update_temporary/specfem3D.f90 2008-09-21 21:08:25 UTC (rev 12931)
+++ seismo/3D/SPECFEM3D/branches/update_temporary/specfem3D.f90 2008-09-21 23:46:00 UTC (rev 12932)
@@ -449,6 +449,10 @@
real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: buffer_recv_vector_ext_mesh
real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: buffer_send_scalar_ext_mesh
real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: buffer_recv_scalar_ext_mesh
+ integer, dimension(:), allocatable :: request_send_scalar_ext_mesh
+ integer, dimension(:), allocatable :: request_recv_scalar_ext_mesh
+ integer, dimension(:), allocatable :: request_send_vector_ext_mesh
+ integer, dimension(:), allocatable :: request_recv_vector_ext_mesh
! ************** PROGRAM STARTS HERE **************
@@ -505,7 +509,7 @@
DT = DT_ext_mesh
NSTEP = NSTEP_ext_mesh
call create_name_database(prname,myrank,LOCAL_PATH)
- open(unit=27,file=prname(1:len_trim(prname))//'.bin',status='old',action='read',form='unformatted')
+ open(unit=27,file=prname(1:len_trim(prname))//'external_mesh.bin',status='old',action='read',form='unformatted')
read(27) NSPEC_AB
read(27) NGLOB_AB
close(27)
@@ -663,7 +667,10 @@
allocate(buffer_recv_vector_ext_mesh(NDIM,max_nibool_interfaces_ext_mesh,ninterfaces_ext_mesh))
allocate(buffer_send_scalar_ext_mesh(max_nibool_interfaces_ext_mesh,ninterfaces_ext_mesh))
allocate(buffer_recv_scalar_ext_mesh(max_nibool_interfaces_ext_mesh,ninterfaces_ext_mesh))
-
+ allocate(request_send_vector_ext_mesh(ninterfaces_ext_mesh))
+ allocate(request_recv_vector_ext_mesh(ninterfaces_ext_mesh))
+ allocate(request_send_scalar_ext_mesh(ninterfaces_ext_mesh))
+ allocate(request_recv_scalar_ext_mesh(ninterfaces_ext_mesh))
close(27)
else
@@ -722,6 +729,7 @@
if (ATTENUATION .and. ((SIMULATION_TYPE == 1 .and. SAVE_FORWARD) .or. SIMULATION_TYPE == 3)) &
call create_name_database(prname_Q,myrank,LOCAL_PATH_Q)
+ if (.not. USE_EXTERNAL_MESH) then
! boundary parameters
open(unit=27,file=prname(1:len_trim(prname))//'ibelm.bin',status='old',action='read',form='unformatted')
read(27) ibelm_xmin
@@ -873,8 +881,9 @@
endif
endif
+
+ endif ! end of (.not. USE_EXTERNAL_MESH)
-
! $$$$$$$$$$$$$$$$$$$$$$$$ SOURCES $$$$$$$$$$$$$$$$$
! read topography and bathymetry file
@@ -1208,10 +1217,19 @@
call sync_all()
! the mass matrix needs to be assembled with MPI here once and for all
+ if (USE_EXTERNAL_MESH) then
+ call assemble_MPI_scalar_ext_mesh(NPROC,NGLOB_AB,rmass, &
+ buffer_send_scalar_ext_mesh,buffer_recv_scalar_ext_mesh, &
+ ninterfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
+ nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,my_neighbours_ext_mesh, &
+ request_send_scalar_ext_mesh,request_recv_scalar_ext_mesh &
+ )
+ else
call assemble_MPI_scalar(rmass,iproc_xi,iproc_eta,addressing, &
iboolleft_xi,iboolright_xi,iboolleft_eta,iboolright_eta, &
buffer_send_faces_scalar,buffer_received_faces_scalar,npoin2D_xi,npoin2D_eta, &
NPROC_XI,NPROC_ETA,NPOIN2DMAX_XMIN_XMAX,NPOIN2DMAX_YMIN_YMAX,NPOIN2DMAX_XY)
+ endif
if(myrank == 0) write(IMAIN,*) 'end assembling MPI mass matrix'
@@ -2595,10 +2613,19 @@
! assemble all the contributions between slices using MPI
+ if (USE_EXTERNAL_MESH) then
+ call assemble_MPI_vector_ext_mesh(NPROC,NGLOB_AB,accel, &
+ buffer_send_vector_ext_mesh,buffer_recv_vector_ext_mesh, &
+ ninterfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
+ nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh,my_neighbours_ext_mesh, &
+ request_send_vector_ext_mesh,request_recv_vector_ext_mesh &
+ )
+ else
call assemble_MPI_vector(accel,iproc_xi,iproc_eta,addressing, &
iboolleft_xi,iboolright_xi,iboolleft_eta,iboolright_eta, &
buffer_send_faces_vector,buffer_received_faces_vector,npoin2D_xi,npoin2D_eta, &
NPROC_XI,NPROC_ETA,NPOIN2DMAX_XMIN_XMAX,NPOIN2DMAX_YMIN_YMAX,NPOIN2DMAX_XY)
+ endif
if (SIMULATION_TYPE == 3) call assemble_MPI_vector(b_accel,iproc_xi,iproc_eta,addressing, &
iboolleft_xi,iboolright_xi,iboolleft_eta,iboolright_eta, &
buffer_send_faces_vector,buffer_received_faces_vector,npoin2D_xi,npoin2D_eta, &
More information about the cig-commits
mailing list