[cig-commits] r20785 - seismo/2D/SPECFEM2D/trunk/src/specfem2D

xie.zhinan at geodynamics.org xie.zhinan at geodynamics.org
Thu Sep 27 02:26:17 PDT 2012


Author: xie.zhinan
Date: 2012-09-27 02:26:16 -0700 (Thu, 27 Sep 2012)
New Revision: 20785

Modified:
   seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90
Log:
add mpi support for acoustic simulation with LDDRK


Modified: seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90	2012-09-27 09:02:01 UTC (rev 20784)
+++ seismo/2D/SPECFEM2D/trunk/src/specfem2D/specfem2D.F90	2012-09-27 09:26:16 UTC (rev 20785)
@@ -510,6 +510,7 @@
   real(kind=CUSTOM_REAL), dimension(:), allocatable :: &
     potential_dot_dot_acoustic,potential_dot_acoustic,potential_acoustic
   real(kind=CUSTOM_REAL), dimension(:), allocatable :: potential_dot_acoustic_LDDRK, potential_acoustic_LDDRK
+  real(kind=CUSTOM_REAL), dimension(:), allocatable :: potential_dot_acoustic_temp
   real(kind=CUSTOM_REAL), dimension(:), allocatable :: potential_acoustic_init_rk, potential_dot_acoustic_init_rk
   real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: potential_dot_dot_acoustic_rk, potential_dot_acoustic_rk
   real(kind=CUSTOM_REAL), dimension(:), allocatable :: potential_acoustic_adj_coupling
@@ -2806,6 +2807,7 @@
     if(time_stepping_scheme == 2) then
     allocate(potential_acoustic_LDDRK(nglob_acoustic))
     allocate(potential_dot_acoustic_LDDRK(nglob_acoustic))
+    allocate(potential_dot_acoustic_temp(nglob_acoustic))
     endif
 
     if(time_stepping_scheme == 3) then
@@ -3443,6 +3445,7 @@
   if(time_stepping_scheme == 2 )then
   potential_acoustic_LDDRK = 0._CUSTOM_REAL
   potential_dot_acoustic_LDDRK = 0._CUSTOM_REAL
+  potential_dot_acoustic_temp = 0._CUSTOM_REAL
   endif
 
   if(time_stepping_scheme == 3 )then
@@ -5303,6 +5306,18 @@
                     tab_requests_send_recv_acoustic,buffer_send_faces_vector_ac, &
                     buffer_recv_faces_vector_ac, my_neighbours)
 
+     if(time_stepping_scheme == 2)then
+      if(i_stage==1 .and. it == 1)then
+       potential_dot_acoustic_temp = potential_dot_acoustic
+       call assemble_MPI_vector_ac(potential_dot_acoustic,nglob, &
+                    ninterface, ninterface_acoustic,inum_interfaces_acoustic, &
+                    max_interface_size, max_ibool_interfaces_size_ac,&
+                    ibool_interfaces_acoustic, nibool_interfaces_acoustic, &
+                    tab_requests_send_recv_acoustic,buffer_send_faces_vector_ac, &
+                    buffer_recv_faces_vector_ac, my_neighbours)
+      endif
+     endif
+
       if ( SIMULATION_TYPE == 2) then
         call assemble_MPI_vector_ac(b_potential_dot_dot_acoustic,nglob, &
                      ninterface, ninterface_acoustic,inum_interfaces_acoustic, &
@@ -5345,15 +5360,23 @@
         potential_acoustic_LDDRK = alpha_LDDRK(i_stage) * potential_acoustic_LDDRK &
                                        +deltat*potential_dot_acoustic
 
+        if(i_stage==1 .and. it == 1)then
+        potential_dot_acoustic_temp = potential_dot_acoustic_temp &
+                                      + beta_LDDRK(i_stage) * potential_dot_acoustic_LDDRK
+        potential_dot_acoustic = potential_dot_acoustic_temp
+        else
         potential_dot_acoustic = potential_dot_acoustic + beta_LDDRK(i_stage) * potential_dot_acoustic_LDDRK
+        endif
 
+!        potential_dot_acoustic = potential_dot_acoustic + beta_LDDRK(i_stage) * potential_dot_acoustic_LDDRK
+
         potential_acoustic = potential_acoustic + beta_LDDRK(i_stage) * potential_acoustic_LDDRK
 
       endif
 
       if(time_stepping_scheme == 3)then
 
-  potential_dot_dot_acoustic = potential_dot_dot_acoustic * rmass_inverse_acoustic
+        potential_dot_dot_acoustic = potential_dot_dot_acoustic * rmass_inverse_acoustic
 
         potential_dot_dot_acoustic_rk(:,i_stage) = deltat * potential_dot_dot_acoustic(:)
         potential_dot_acoustic_rk(:,i_stage) = deltat * potential_dot_acoustic(:)



More information about the CIG-COMMITS mailing list