[cig-commits] r22072 - in seismo/3D/SPECFEM3D/trunk/src: generate_databases specfem3D
xie.zhinan at geodynamics.org
xie.zhinan at geodynamics.org
Wed May 15 02:40:30 PDT 2013
Author: xie.zhinan
Date: 2013-05-15 02:40:30 -0700 (Wed, 15 May 2013)
New Revision: 22072
Modified:
seismo/3D/SPECFEM3D/trunk/src/generate_databases/pml_set_local_dampingcoeff.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_calling_routine.f90
Log:
clean the code a little
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/pml_set_local_dampingcoeff.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/pml_set_local_dampingcoeff.f90 2013-05-15 04:53:50 UTC (rev 22071)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/pml_set_local_dampingcoeff.f90 2013-05-15 09:40:30 UTC (rev 22072)
@@ -161,49 +161,44 @@
do ispec_CPML=1,nspec_cpml
ispec = CPML_to_spec(ispec_CPML)
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- iglob = ibool(i,j,k,ispec)
- if( CPML_regions(ispec_CPML) == CPML_X_ONLY ) then
- if(xstore(iglob) - x_origin > 0._CUSTOM_REAL)then
- if(xstore(iglob) - x_origin <= CPML_x_right - x_origin )then
- CPML_x_right = xstore(iglob)
- endif
- else
- if(abs(xstore(iglob) - x_origin) <= abs(CPML_x_left-x_origin))then
- CPML_x_left = xstore(iglob)
- endif
+ do k=1,NGLLZ; do j=1,NGLLY; do i=1,NGLLX
+ iglob = ibool(i,j,k,ispec)
+ if(CPML_regions(ispec_CPML) == CPML_X_ONLY) then
+ if(xstore(iglob) - x_origin > 0._CUSTOM_REAL)then
+ if(xstore(iglob) - x_origin <= CPML_x_right - x_origin)then
+ CPML_x_right = xstore(iglob)
endif
- endif
-
- if( CPML_regions(ispec_CPML) == CPML_Y_ONLY ) then
- if(ystore(iglob) - y_origin > 0._CUSTOM_REAL)then
- if(ystore(iglob) - y_origin <= CPML_y_front - y_origin )then
- CPML_y_front = ystore(iglob)
- endif
- else
- if(abs(ystore(iglob) - y_origin) <= abs(CPML_y_back-y_origin))then
- CPML_y_back = ystore(iglob)
- endif
+ else
+ if(abs(xstore(iglob) - x_origin) <= abs(CPML_x_left-x_origin))then
+ CPML_x_left = xstore(iglob)
endif
- endif
+ endif
+ endif
- if( CPML_regions(ispec_CPML) == CPML_Z_ONLY ) then
- if(zstore(iglob) - z_origin > 0._CUSTOM_REAL)then
- if(zstore(iglob) - z_origin <= CPML_z_top - z_origin )then
- CPML_z_top = zstore(iglob)
- endif
- else
- if(abs(zstore(iglob) - z_origin) <= abs(CPML_z_bottom-z_origin))then
- CPML_z_bottom = zstore(iglob)
- endif
+ if(CPML_regions(ispec_CPML) == CPML_Y_ONLY ) then
+ if(ystore(iglob) - y_origin > 0._CUSTOM_REAL)then
+ if(ystore(iglob) - y_origin <= CPML_y_front - y_origin)then
+ CPML_y_front = ystore(iglob)
endif
- endif
+ else
+ if(abs(ystore(iglob) - y_origin) <= abs(CPML_y_back-y_origin))then
+ CPML_y_back = ystore(iglob)
+ endif
+ endif
+ endif
- enddo
- enddo
- enddo
+ if(CPML_regions(ispec_CPML) == CPML_Z_ONLY ) then
+ if(zstore(iglob) - z_origin > 0._CUSTOM_REAL)then
+ if(zstore(iglob) - z_origin <= CPML_z_top - z_origin)then
+ CPML_z_top = zstore(iglob)
+ endif
+ else
+ if(abs(zstore(iglob) - z_origin) <= abs(CPML_z_bottom-z_origin))then
+ CPML_z_bottom = zstore(iglob)
+ endif
+ endif
+ endif
+ enddo; enddo; enddo
enddo
CPML_width_x_right = x_max_all - CPML_x_right
@@ -238,22 +233,17 @@
vp_max = 0._CUSTOM_REAL
do ispec_CPML=1,nspec_cpml
ispec = CPML_to_spec(ispec_CPML)
- do k=1,NGLLZ
- do j=1,NGLLY
- do i=1,NGLLX
- vp_elastic = rho_vp(i,j,k,ispec)/rhostore(i,j,k,ispec)
- vp_acoustic = rho_vp(i,j,k,ispec)/rhostore(i,j,k,ispec)
+ do k=1,NGLLZ; do j=1,NGLLY; do i=1,NGLLX
+ vp_elastic = rho_vp(i,j,k,ispec)/rhostore(i,j,k,ispec)
+ vp_acoustic = rho_vp(i,j,k,ispec)/rhostore(i,j,k,ispec)
- if(vp_acoustic .ge. vp_max)then
- vp_max = vp_acoustic
- endif
- if(vp_elastic .ge. vp_max)then
- vp_max = vp_acoustic
- endif
-
- enddo
- enddo
- enddo
+ if(vp_acoustic .ge. vp_max)then
+ vp_max = vp_acoustic
+ endif
+ if(vp_elastic .ge. vp_max)then
+ vp_max = vp_acoustic
+ endif
+ enddo; enddo; enddo
enddo
call max_all_all_cr(vp_max,vp_max_all)
@@ -278,6 +268,7 @@
write(IMAIN,*) 'CPML_width_z: ',CPML_width_z
write(IMAIN,*)
endif
+
call sync_all()
! loops over all C-PML elements
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_calling_routine.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_calling_routine.f90 2013-05-15 04:53:50 UTC (rev 22071)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_acoustic_calling_routine.f90 2013-05-15 09:40:30 UTC (rev 22072)
@@ -372,33 +372,32 @@
! to be zero on outer boundary of PML help to improve the accuracy of absorbing low-frequency wave components
! in case of long-time simulation
- ! C-PML boundary
- if(PML_CONDITIONS)then
- do iface=1,num_abs_boundary_faces
- ispec = abs_boundary_ispec(iface)
- if (ispec_is_inner(ispec) .eqv. phase_is_inner) then
- if( ispec_is_acoustic(ispec) .and. is_CPML(ispec) ) then
- ! reference gll points on boundary face
- do igll = 1,NGLLSQUARE
+! C-PML boundary
+ if(PML_CONDITIONS)then
+ do iface=1,num_abs_boundary_faces
+ ispec = abs_boundary_ispec(iface)
+ if(ispec_is_inner(ispec) .eqv. phase_is_inner) then
+ if(ispec_is_acoustic(ispec) .and. is_CPML(ispec) ) then
+ ! reference gll points on boundary face
+ do igll = 1,NGLLSQUARE
+ ! gets local indices for GLL point
+ i = abs_boundary_ijk(1,igll,iface)
+ j = abs_boundary_ijk(2,igll,iface)
+ k = abs_boundary_ijk(3,igll,iface)
- ! gets local indices for GLL point
- i = abs_boundary_ijk(1,igll,iface)
- j = abs_boundary_ijk(2,igll,iface)
- k = abs_boundary_ijk(3,igll,iface)
+ iglob=ibool(i,j,k,ispec)
- iglob=ibool(i,j,k,ispec)
-
- potential_dot_dot_acoustic(iglob) = 0.0
- potential_dot_acoustic(iglob) = 0.0
- potential_acoustic(iglob) = 0.0
- if(ELASTIC_SIMULATION ) then
- potential_dot_dot_acoustic_interface(iglob) = 0.0
- endif
- enddo
- endif ! ispec_is_acoustic
+ potential_dot_dot_acoustic(iglob) = 0.0
+ potential_dot_acoustic(iglob) = 0.0
+ potential_acoustic(iglob) = 0.0
+ if(ELASTIC_SIMULATION ) then
+ potential_dot_dot_acoustic_interface(iglob) = 0.0
endif
- enddo
- endif
+ enddo
+ endif ! ispec_is_acoustic
+ endif
+ enddo
+ endif
! update velocity
! note: Newmark finite-difference time scheme with acoustic domains:
More information about the CIG-COMMITS
mailing list