[cig-commits] r8578 - seismo/2D/SPECFEM2D/trunk
walter at geodynamics.org
walter at geodynamics.org
Fri Dec 7 15:58:02 PST 2007
Author: walter
Date: 2007-12-07 15:58:01 -0800 (Fri, 07 Dec 2007)
New Revision: 8578
Modified:
seismo/2D/SPECFEM2D/trunk/TODO_list
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/specfem2D.F90
Log:
added overlapping of comunications with computation.
Modified: seismo/2D/SPECFEM2D/trunk/TODO_list
===================================================================
--- seismo/2D/SPECFEM2D/trunk/TODO_list 2007-09-12 01:47:41 UTC (rev 8577)
+++ seismo/2D/SPECFEM2D/trunk/TODO_list 2007-12-07 23:58:01 UTC (rev 8578)
@@ -11,4 +11,3 @@
- getting rid of constants_unstruct.h.
- checking use of real or double precision. Gain in elapsed time is ok, but now we have to look for memory consumption.
- checking output on stdout (for data that should be printed only once).
-- compute during the non-blocking persistent MPI calls.
\ No newline at end of file
Modified: seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90 2007-09-12 01:47:41 UTC (rev 8577)
+++ seismo/2D/SPECFEM2D/trunk/assemble_MPI.F90 2007-12-07 23:58:01 UTC (rev 8578)
@@ -6,7 +6,8 @@
ibool_interfaces_acoustic, ibool_interfaces_elastic, &
nibool_interfaces_acoustic, nibool_interfaces_elastic, &
inum_interfaces_acoustic, inum_interfaces_elastic, &
- ninterface_acoustic, ninterface_elastic &
+ ninterface_acoustic, ninterface_elastic, &
+ mask_ispec_inner_outer &
)
@@ -35,6 +36,8 @@
integer :: num_interface
integer :: ispec_interface
+
+ logical, dimension(nspec), intent(inout) :: mask_ispec_inner_outer
logical, dimension(npoin) :: mask_ibool_acoustic
logical, dimension(npoin) :: mask_ibool_elastic
@@ -102,7 +105,20 @@
end do
nibool_interfaces_acoustic(num_interface) = npoin_interface_acoustic
nibool_interfaces_elastic(num_interface) = npoin_interface_elastic
-
+
+ do ispec = 1, nspec
+ do iz = 1, NGLLZ
+ do ix = 1, NGLLX
+ if ( mask_ibool_acoustic(ibool(ix,iz,ispec)) &
+ .or. mask_ibool_elastic(ibool(ix,iz,ispec)) ) then
+ mask_ispec_inner_outer(ispec) = .true.
+ endif
+
+ enddo
+ enddo
+ enddo
+
+
end do
Modified: seismo/2D/SPECFEM2D/trunk/compute_forces_acoustic.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/compute_forces_acoustic.f90 2007-09-12 01:47:41 UTC (rev 8577)
+++ seismo/2D/SPECFEM2D/trunk/compute_forces_acoustic.f90 2007-12-07 23:58:01 UTC (rev 8578)
@@ -19,7 +19,9 @@
vpext,source_time_function,hprime_xx,hprimewgll_xx, &
hprime_zz,hprimewgll_zz,wxgll,wzgll, &
ibegin_bottom,iend_bottom,ibegin_top,iend_top, &
- jbegin_left,jend_left,jbegin_right,jend_right)
+ jbegin_left,jend_left,jbegin_right,jend_right, &
+ nspec_inner_outer, ispec_inner_outer_to_glob, num_phase_inner_outer &
+ )
! compute forces for the acoustic elements
@@ -54,11 +56,16 @@
real(kind=CUSTOM_REAL), dimension(NGLLX) :: wxgll
real(kind=CUSTOM_REAL), dimension(NGLLZ) :: wzgll
+! for overlapping MPI communications with computation
+ integer, intent(in) :: nspec_inner_outer
+ integer, dimension(nspec_inner_outer), intent(in) :: ispec_inner_outer_to_glob
+ logical, intent(in) :: num_phase_inner_outer
+
!---
!--- local variables
!---
- integer :: ispec,i,j,k,iglob,ispecabs,ibegin,iend,jbegin,jend
+ integer :: ispec,ispec_inner_outer,i,j,k,iglob,ispecabs,ibegin,iend,jbegin,jend
! spatial derivatives
real(kind=CUSTOM_REAL) :: dux_dxi,dux_dgamma,dux_dxl,dux_dzl
@@ -73,8 +80,10 @@
real(kind=CUSTOM_REAL) :: mul_relaxed,lambdal_relaxed,kappal,cpl
! loop over spectral elements
- do ispec = 1,nspec
+ do ispec_inner_outer = 1,nspec_inner_outer
+ ispec = ispec_inner_outer_to_glob(ispec_inner_outer)
+
!---
!--- acoustic spectral element
!---
@@ -136,6 +145,9 @@
enddo ! end of loop over all spectral elements
+! only for the first call to compute_forces_acoustic (during computation on outer elements)
+ if ( num_phase_inner_outer ) then
+
!
!--- absorbing boundaries
!
@@ -304,5 +316,7 @@
call exit_MPI('wrong source type')
endif
+ endif ! end of computation that needs to be done only once, during the first call to compute_forces_acoustic
+
end subroutine compute_forces_acoustic
Modified: seismo/2D/SPECFEM2D/trunk/compute_forces_elastic.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/compute_forces_elastic.f90 2007-09-12 01:47:41 UTC (rev 8577)
+++ seismo/2D/SPECFEM2D/trunk/compute_forces_elastic.f90 2007-12-07 23:58:01 UTC (rev 8578)
@@ -19,7 +19,9 @@
jacobian,vpext,vsext,rhoext,source_time_function,sourcearray,e1,e11, &
e13,dux_dxl_n,duz_dzl_n,duz_dxl_n,dux_dzl_n, &
dux_dxl_np1,duz_dzl_np1,duz_dxl_np1,dux_dzl_np1,hprime_xx,hprimewgll_xx, &
- hprime_zz,hprimewgll_zz,wxgll,wzgll,inv_tau_sigma_nu1,phi_nu1,inv_tau_sigma_nu2,phi_nu2,Mu_nu1,Mu_nu2)
+ hprime_zz,hprimewgll_zz,wxgll,wzgll,inv_tau_sigma_nu1,phi_nu1,inv_tau_sigma_nu2,phi_nu2,Mu_nu1,Mu_nu2, &
+ nspec_inner_outer, ispec_inner_outer_to_glob, num_phase_inner_outer &
+ )
! compute forces for the elastic elements
@@ -65,11 +67,16 @@
real(kind=CUSTOM_REAL), dimension(NGLLX) :: wxgll
real(kind=CUSTOM_REAL), dimension(NGLLZ) :: wzgll
+! for overlapping MPI communications with computation
+ integer, intent(in) :: nspec_inner_outer
+ integer, dimension(nspec_inner_outer), intent(in) :: ispec_inner_outer_to_glob
+ logical, intent(in) :: num_phase_inner_outer
+
!---
!--- local variables
!---
- integer :: ispec,i,j,k,iglob,ispecabs,ibegin,iend
+ integer :: ispec,ispec_inner_outer,i,j,k,iglob,ispecabs,ibegin,iend
! spatial derivatives
real(kind=CUSTOM_REAL) :: dux_dxi,dux_dgamma,duz_dxi,duz_dgamma
@@ -89,12 +96,18 @@
! for attenuation
real(kind=CUSTOM_REAL) :: Un,Unp1,tauinv,Sn,Snp1,theta_n,theta_np1,tauinvsquare,tauinvcube,tauinvUn
+! only for the first call to compute_forces_elastic (during computation on outer elements)
+ if ( num_phase_inner_outer ) then
! compute Grad(displ_elastic) at time step n for attenuation
if(TURN_ATTENUATION_ON) call compute_gradient_attenuation(displ_elastic,dux_dxl_n,duz_dxl_n, &
dux_dzl_n,duz_dzl_n,xix,xiz,gammax,gammaz,ibool,elastic,hprime_xx,hprime_zz,nspec,npoin)
+ endif
-! loop over spectral elements
- do ispec = 1,nspec
+! loop over spectral elements
+ do ispec_inner_outer = 1,nspec_inner_outer
+
+! get global numbering for inner or outer elements
+ ispec = ispec_inner_outer_to_glob(ispec_inner_outer)
!---
!--- elastic spectral element
@@ -239,6 +252,9 @@
enddo ! end of loop over all spectral elements
+! only for the first call to compute_forces_elastic (during computation on outer elements)
+ if ( num_phase_inner_outer ) then
+
!
!--- absorbing boundaries
!
@@ -484,6 +500,8 @@
endif ! if not using an initial field
+ else
+
! implement attenuation
if(TURN_ATTENUATION_ON) then
@@ -554,5 +572,7 @@
endif ! end of test on attenuation
+ endif ! end of test on attenuation
+
end subroutine compute_forces_elastic
Modified: seismo/2D/SPECFEM2D/trunk/specfem2D.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/specfem2D.F90 2007-09-12 01:47:41 UTC (rev 8577)
+++ seismo/2D/SPECFEM2D/trunk/specfem2D.F90 2007-12-07 23:58:01 UTC (rev 8578)
@@ -288,6 +288,11 @@
integer :: max_ibool_interfaces_size_ac, max_ibool_interfaces_size_el
#endif
+! for overlapping MPI communications with computation
+ integer :: nspec_outer, nspec_inner, num_ispec_outer, num_ispec_inner
+ integer, dimension(:), allocatable :: ispec_outer_to_glob, ispec_inner_to_glob
+ logical, dimension(:), allocatable :: mask_ispec_inner_outer
+
integer, dimension(:,:), allocatable :: acoustic_surface
integer, dimension(:,:), allocatable :: acoustic_edges
@@ -1037,7 +1042,10 @@
#ifdef USE_MPI
if ( nproc > 1 ) then
! preparing for MPI communications
- call prepare_assemble_MPI (nspec,ibool, &
+ allocate(mask_ispec_inner_outer(nspec))
+ mask_ispec_inner_outer(:) = .false.
+
+ call prepare_assemble_MPI (nspec,ibool, &
knods, ngnod, &
npoin, elastic, &
ninterface, max_interface_size, &
@@ -1045,9 +1053,30 @@
ibool_interfaces_acoustic, ibool_interfaces_elastic, &
nibool_interfaces_acoustic, nibool_interfaces_elastic, &
inum_interfaces_acoustic, inum_interfaces_elastic, &
- ninterface_acoustic, ninterface_elastic &
+ ninterface_acoustic, ninterface_elastic, &
+ mask_ispec_inner_outer &
)
+ nspec_outer = count(mask_ispec_inner_outer)
+ nspec_inner = nspec - nspec_outer
+
+ allocate(ispec_outer_to_glob(nspec_outer))
+ allocate(ispec_inner_to_glob(nspec_inner))
+
+! building of corresponding arrays between inner/outer elements and their global number
+ num_ispec_outer = 0
+ num_ispec_inner = 0
+ do ispec = 1, nspec
+ if ( mask_ispec_inner_outer(ispec) ) then
+ num_ispec_outer = num_ispec_outer + 1
+ ispec_outer_to_glob(num_ispec_outer) = ispec
+ else
+ num_ispec_inner = num_ispec_inner + 1
+ ispec_inner_to_glob(num_ispec_inner) = ispec
+
+ endif
+ enddo
+
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))
@@ -1089,8 +1118,26 @@
else
ninterface_acoustic = 0
ninterface_elastic = 0
- end if
+
+ nspec_outer = 0
+ nspec_inner = nspec
+
+ allocate(ispec_inner_to_glob(nspec_inner))
+ do ispec = 1, nspec
+ ispec_inner_to_glob(ispec) = ispec
+ enddo
+ end if ! end of test on wether there is more than one process ( nproc>1 )
+
+#else
+ nspec_outer = 0
+ nspec_inner = nspec
+
+ allocate(ispec_inner_to_glob(nspec_inner))
+ do ispec = 1, nspec
+ ispec_inner_to_glob(ispec) = ispec
+ enddo
+
#endif
@@ -1671,6 +1718,7 @@
! ************* compute forces for the acoustic elements
! *********************************************************
+! first call, computation on outer elements, absorbing conditions and source
call compute_forces_acoustic(npoin,nspec,nelemabs,numat, &
iglob_source,ispec_selected_source,is_proc_source,source_type,it,NSTEP,anyabs, &
assign_external_model,initialfield,ibool,kmato,numabs, &
@@ -1679,7 +1727,9 @@
vpext,source_time_function,hprime_xx,hprimewgll_xx, &
hprime_zz,hprimewgll_zz,wxgll,wzgll, &
ibegin_bottom,iend_bottom,ibegin_top,iend_top, &
- jbegin_left,jend_left,jbegin_right,jend_right)
+ jbegin_left,jend_left,jbegin_right,jend_right, &
+ nspec_outer, ispec_outer_to_glob, .true. &
+ )
endif ! end of test if any acoustic element
@@ -1749,10 +1799,10 @@
endif
-! assembling potential_dot_dot for acoustic elements
+! assembling potential_dot_dot for acoustic elements (send)
#ifdef USE_MPI
- if ( nproc > 1 .and. any_acoustic .and. ninterface_acoustic > 0) then
- call assemble_MPI_vector_ac_start(potential_dot_dot_acoustic,npoin, &
+ if ( nproc > 1 .and. any_acoustic .and. ninterface_acoustic > 0) then
+ call assemble_MPI_vector_ac_start(potential_dot_dot_acoustic,npoin, &
ninterface, ninterface_acoustic, &
inum_interfaces_acoustic, &
max_interface_size, max_ibool_interfaces_size_ac,&
@@ -1760,7 +1810,28 @@
tab_requests_send_recv_acoustic, &
buffer_send_faces_vector_ac &
)
- call assemble_MPI_vector_ac_wait(potential_dot_dot_acoustic,npoin, &
+ endif
+#endif
+
+! second call, computation on inner elements
+ if(any_acoustic) then
+ call compute_forces_acoustic(npoin,nspec,nelemabs,numat, &
+ iglob_source,ispec_selected_source,is_proc_source,source_type,it,NSTEP,anyabs, &
+ assign_external_model,initialfield,ibool,kmato,numabs, &
+ elastic,codeabs,potential_dot_dot_acoustic,potential_dot_acoustic, &
+ potential_acoustic,density,elastcoef,xix,xiz,gammax,gammaz,jacobian, &
+ vpext,source_time_function,hprime_xx,hprimewgll_xx, &
+ hprime_zz,hprimewgll_zz,wxgll,wzgll, &
+ ibegin_bottom,iend_bottom,ibegin_top,iend_top, &
+ jbegin_left,jend_left,jbegin_right,jend_right, &
+ nspec_inner, ispec_inner_to_glob, .false. &
+ )
+ endif
+
+! assembling potential_dot_dot for acoustic elements (receive)
+#ifdef USE_MPI
+ if ( nproc > 1 .and. any_acoustic .and. ninterface_acoustic > 0) then
+ call assemble_MPI_vector_ac_wait(potential_dot_dot_acoustic,npoin, &
ninterface, ninterface_acoustic, &
inum_interfaces_acoustic, &
max_interface_size, max_ibool_interfaces_size_ac,&
@@ -1768,7 +1839,7 @@
tab_requests_send_recv_acoustic, &
buffer_recv_faces_vector_ac &
)
- end if
+ endif
#endif
@@ -1791,6 +1862,7 @@
! ************* main solver for the elastic elements
! *********************************************************
+! first call, computation on outer elements, absorbing conditions and source
if(any_elastic) &
call compute_forces_elastic(npoin,nspec,nelemabs,numat,iglob_source, &
ispec_selected_source,is_proc_source,source_type,it,NSTEP,anyabs,assign_external_model, &
@@ -1800,7 +1872,9 @@
jacobian,vpext,vsext,rhoext,source_time_function,sourcearray, &
e1,e11,e13,dux_dxl_n,duz_dzl_n,duz_dxl_n,dux_dzl_n, &
dux_dxl_np1,duz_dzl_np1,duz_dxl_np1,dux_dzl_np1,hprime_xx,hprimewgll_xx, &
- hprime_zz,hprimewgll_zz,wxgll,wzgll,inv_tau_sigma_nu1,phi_nu1,inv_tau_sigma_nu2,phi_nu2,Mu_nu1,Mu_nu2)
+ hprime_zz,hprimewgll_zz,wxgll,wzgll,inv_tau_sigma_nu1,phi_nu1,inv_tau_sigma_nu2,phi_nu2,Mu_nu1,Mu_nu2, &
+ nspec_outer, ispec_outer_to_glob, .true. &
+ )
! *********************************************************
! ************* add coupling with the acoustic side
@@ -1873,7 +1947,7 @@
endif
-! assembling accel_elastic for elastic elements
+! assembling accel_elastic for elastic elements (send)
#ifdef USE_MPI
if ( nproc > 1 .and. any_elastic .and. ninterface_elastic > 0) then
call assemble_MPI_vector_el_start(accel_elastic,npoin, &
@@ -1884,6 +1958,26 @@
tab_requests_send_recv_elastic, &
buffer_send_faces_vector_el &
)
+ endif
+#endif
+
+! second call, computation on inner elements and update of
+ if(any_elastic) &
+ call compute_forces_elastic(npoin,nspec,nelemabs,numat,iglob_source, &
+ ispec_selected_source,is_proc_source,source_type,it,NSTEP,anyabs,assign_external_model, &
+ initialfield,TURN_ATTENUATION_ON,TURN_ANISOTROPY_ON,angleforce,deltatcube, &
+ deltatfourth,twelvedeltat,fourdeltatsquare,ibool,kmato,numabs,elastic,codeabs, &
+ accel_elastic,veloc_elastic,displ_elastic,density,elastcoef,xix,xiz,gammax,gammaz, &
+ jacobian,vpext,vsext,rhoext,source_time_function,sourcearray, &
+ e1,e11,e13,dux_dxl_n,duz_dzl_n,duz_dxl_n,dux_dzl_n, &
+ dux_dxl_np1,duz_dzl_np1,duz_dxl_np1,dux_dzl_np1,hprime_xx,hprimewgll_xx, &
+ hprime_zz,hprimewgll_zz,wxgll,wzgll,inv_tau_sigma_nu1,phi_nu1,inv_tau_sigma_nu2,phi_nu2,Mu_nu1,Mu_nu2, &
+ nspec_inner, ispec_inner_to_glob, .false. &
+ )
+
+! assembling accel_elastic for elastic elements (receive)
+#ifdef USE_MPI
+ if ( nproc > 1 .and. any_elastic .and. ninterface_elastic > 0) then
call assemble_MPI_vector_el_wait(accel_elastic,npoin, &
ninterface, ninterface_elastic, &
inum_interfaces_elastic, &
More information about the cig-commits
mailing list