[cig-commits] r21836 - seismo/3D/SPECFEM3D/trunk/src/specfem3D

xie.zhinan at geodynamics.org xie.zhinan at geodynamics.org
Fri Apr 12 04:53:32 PDT 2013


Author: xie.zhinan
Date: 2013-04-12 04:53:31 -0700 (Fri, 12 Apr 2013)
New Revision: 21836

Modified:
   seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90
   seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_noDev.f90
Log:
fix one bug in case that PML_INSTEAD_OF_FREE_SURFACE set to be .false. and
PML_CONDITIONS set to be .true. and free_or_absorbing_surface_file_zmax file is provided and remove some useless comments '!ZN'


Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90	2013-04-12 03:21:35 UTC (rev 21835)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90	2013-04-12 11:53:31 UTC (rev 21836)
@@ -69,13 +69,13 @@
                         hprimewgll_xx,hprimewgll_yy,hprimewgll_zz, &
                         wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
                         kappastore,mustore,jacobian,ibool, &
-                        ATTENUATION,deltat,PML_CONDITIONS, &
+                        ATTENUATION,deltat,PML_CONDITIONS,PML_INSTEAD_OF_FREE_SURFACE, &
                         nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
                         ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
                         one_minus_sum_beta,factor_common, &
-                        one_minus_sum_beta_kappa,factor_common_kappa, & !ZN
+                        one_minus_sum_beta_kappa,factor_common_kappa, & 
                         alphaval,betaval,gammaval,&
-                        NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_kappa, & !ZN
+                        NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_kappa, & 
                         R_trace,R_xx,R_yy,R_xy,R_xz,R_yz, &
                         epsilondev_trace,epsilondev_xx,epsilondev_yy,epsilondev_xy, &
                         epsilondev_xz,epsilondev_yz,epsilon_trace_over_3, &
@@ -101,13 +101,13 @@
                         hprimewgll_xx,hprimewgll_yy,hprimewgll_zz, &
                         wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
                         kappastore,mustore,jacobian,ibool, &
-                        ATTENUATION,deltat,PML_CONDITIONS, &
+                        ATTENUATION,deltat,PML_CONDITIONS,PML_INSTEAD_OF_FREE_SURFACE, &
                         nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
                         ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
                         one_minus_sum_beta,factor_common, &
-                        one_minus_sum_beta_kappa,factor_common_kappa, & !ZN
+                        one_minus_sum_beta_kappa,factor_common_kappa, & 
                         b_alphaval,b_betaval,b_gammaval, &
-                        NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_kappa, & !ZN
+                        NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_kappa, & 
                         b_R_trace,b_R_xx,b_R_yy,b_R_xy,b_R_xz,b_R_yz, &
                         b_epsilondev_trace,b_epsilondev_xx,b_epsilondev_yy,b_epsilondev_xy, &
                         b_epsilondev_xz,b_epsilondev_yz,b_epsilon_trace_over_3, &
@@ -440,13 +440,13 @@
 !          kappastore,mustore,jacobian,ibool, &
 !          ATTENUATION,deltat, &
 !          one_minus_sum_beta,factor_common, &
-!          one_minus_sum_beta_kappa,factor_common_kappa, & !ZN
+!          one_minus_sum_beta_kappa,factor_common_kappa, & 
 !          alphaval,betaval,gammaval, &
-!          NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_kappa, & !ZN
-! !ZN      R_xx,R_yy,R_xy,R_xz,R_yz, &
-!          R_trace,R_xx,R_yy,R_xy,R_xz,R_yz, &  !ZN
-! !ZN      epsilondev_xx,epsilondev_yy,epsilondev_xy, &
-!          epsilondev_trace,epsilondev_xx,epsilondev_yy,epsilondev_xy, &  !ZN
+!          NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_kappa, & 
+!          R_xx,R_yy,R_xy,R_xz,R_yz, &
+!          R_trace,R_xx,R_yy,R_xy,R_xz,R_yz, &  
+!          epsilondev_xx,epsilondev_yy,epsilondev_xy, &
+!          epsilondev_trace,epsilondev_xx,epsilondev_yy,epsilondev_xy, &  
 !          epsilondev_xz,epsilondev_yz,epsilon_trace_over_3, &
 !          ANISOTROPY,NSPEC_ANISO, &
 !          c11store,c12store,c13store,c14store,c15store,c16store,&

Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_noDev.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_noDev.f90	2013-04-12 03:21:35 UTC (rev 21835)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/compute_forces_viscoelastic_noDev.f90	2013-04-12 11:53:31 UTC (rev 21836)
@@ -31,15 +31,15 @@
                         hprimewgll_xx,hprimewgll_yy,hprimewgll_zz,&
                         wgllwgll_xy,wgllwgll_xz,wgllwgll_yz, &
                         kappastore,mustore,jacobian,ibool, &
-                        ATTENUATION,deltat,PML_CONDITIONS, &
+                        ATTENUATION,deltat,PML_CONDITIONS,PML_INSTEAD_OF_FREE_SURFACE, &
                         nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax,NSPEC2D_BOTTOM,NSPEC2D_TOP, &
                         ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
                         one_minus_sum_beta,factor_common, &
-                        one_minus_sum_beta_kappa,factor_common_kappa, &  !ZN
+                        one_minus_sum_beta_kappa,factor_common_kappa, & 
                         alphaval,betaval,gammaval, &
-                        NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_kappa, & !ZN
-                        R_trace,R_xx,R_yy,R_xy,R_xz,R_yz, & !ZN
-                        epsilondev_trace,epsilondev_xx,epsilondev_yy,epsilondev_xy,& !ZN
+                        NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_kappa, & 
+                        R_trace,R_xx,R_yy,R_xy,R_xz,R_yz, & 
+                        epsilondev_trace,epsilondev_xx,epsilondev_yy,epsilondev_xy,& 
                         epsilondev_xz,epsilondev_yz,epsilon_trace_over_3, &
                         ANISOTROPY,NSPEC_ANISO, &
                         c11store,c12store,c13store,c14store,c15store,c16store, &
@@ -91,15 +91,15 @@
   integer :: NSPEC_ATTENUATION_AB,NSPEC_ATTENUATION_AB_kappa
   real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB) :: one_minus_sum_beta
   real(kind=CUSTOM_REAL), dimension(N_SLS,NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB) :: factor_common
-  real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa) :: one_minus_sum_beta_kappa  !ZN
-  real(kind=CUSTOM_REAL), dimension(N_SLS,NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa) :: factor_common_kappa !ZN
+  real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa) :: one_minus_sum_beta_kappa  
+  real(kind=CUSTOM_REAL), dimension(N_SLS,NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa) :: factor_common_kappa 
   real(kind=CUSTOM_REAL), dimension(N_SLS) :: alphaval,betaval,gammaval
   real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB,N_SLS) :: &
        R_xx,R_yy,R_xy,R_xz,R_yz
-  real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa,N_SLS) :: R_trace !ZN
+  real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa,N_SLS) :: R_trace 
 
   real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_STRAIN_ONLY) :: &
-       epsilondev_xx,epsilondev_yy,epsilondev_xy,epsilondev_xz,epsilondev_yz !ZN
+       epsilondev_xx,epsilondev_yy,epsilondev_xy,epsilondev_xz,epsilondev_yz 
   real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ATTENUATION_AB_kappa) :: epsilondev_trace
   real(kind=CUSTOM_REAL),dimension(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT) :: epsilon_trace_over_3
 
@@ -127,7 +127,7 @@
   integer :: ispec2D_moho_top, ispec2D_moho_bot
 
 ! C-PML absorbing boundary conditions
-  logical :: PML_CONDITIONS
+  logical :: PML_CONDITIONS,PML_INSTEAD_OF_FREE_SURFACE
   integer :: nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax,NSPEC2D_BOTTOM,NSPEC2D_TOP
   integer, dimension(nspec2D_xmin) :: ibelm_xmin
   integer, dimension(nspec2D_xmax) :: ibelm_xmax
@@ -162,7 +162,7 @@
                         c33,c34,c35,c36,c44,c45,c46,c55,c56,c66
 
   ! local attenuation parameters
-  real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: epsilondev_trace_loc, epsilondev_xx_loc, & !ZN
+  real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ) :: epsilondev_trace_loc, epsilondev_xx_loc, & 
        epsilondev_yy_loc, epsilondev_xy_loc, epsilondev_xz_loc, epsilondev_yz_loc
   real(kind=CUSTOM_REAL) :: R_trace_val1,R_xx_val1,R_yy_val1
   real(kind=CUSTOM_REAL) :: R_trace_val2,R_xx_val2,R_yy_val2
@@ -533,7 +533,7 @@
               if(ATTENUATION) then
                 ! use unrelaxed parameters if attenuation
                 mul  = mul * one_minus_sum_beta(i,j,k,ispec)
-                if(FULL_ATTENUATION_SOLID) kappal  = kappal * one_minus_sum_beta_kappa(i,j,k,ispec)  !ZN
+                if(FULL_ATTENUATION_SOLID) kappal  = kappal * one_minus_sum_beta_kappa(i,j,k,ispec)  
               endif
 
   ! full anisotropic case, stress calculations
@@ -809,13 +809,13 @@
                 gammaval_loc = gammaval(i_sls)
 
                 if(FULL_ATTENUATION_SOLID) then
-                   ! term in trace  !ZN
-                   factor_loc = kappastore(i,j,k,ispec) * factor_common_kappa(i_sls,i,j,k,ispec)  !ZN
+                   ! term in trace  
+                   factor_loc = kappastore(i,j,k,ispec) * factor_common_kappa(i_sls,i,j,k,ispec)  
 
-                   Sn   = factor_loc * epsilondev_trace(i,j,k,ispec)  !ZN
-                   Snp1   = factor_loc * epsilondev_trace_loc(i,j,k)  !ZN
-                   R_trace(i,j,k,ispec,i_sls) = alphaval_loc * R_trace(i,j,k,ispec,i_sls) + &  !ZN
-                        betaval_loc * Sn + gammaval_loc * Snp1  !ZN
+                   Sn   = factor_loc * epsilondev_trace(i,j,k,ispec)  
+                   Snp1   = factor_loc * epsilondev_trace_loc(i,j,k)  
+                   R_trace(i,j,k,ispec,i_sls) = alphaval_loc * R_trace(i,j,k,ispec,i_sls) + &  
+                        betaval_loc * Sn + gammaval_loc * Snp1  
                 endif
 
                 ! term in xx yy zz xy xz yz
@@ -1013,31 +1013,33 @@
      enddo
 
      ! top (zmax)
-     do ispec2D=1,NSPEC2D_BOTTOM
-        ispec = ibelm_top(ispec2D)
+     if(PML_INSTEAD_OF_FREE_SURFACE)then
+       do ispec2D=1,NSPEC2D_BOTTOM
+          ispec = ibelm_top(ispec2D)
 
-        if(CPML_mask_ibool(ispec) .and. ispec_is_elastic(ispec)) then
-           k = NGLLZ
+          if(CPML_mask_ibool(ispec) .and. ispec_is_elastic(ispec)) then
+             k = NGLLZ
 
-           do j=1,NGLLY
-              do i=1,NGLLX
-                 iglob = ibool(i,j,k,ispec)
+             do j=1,NGLLY
+                do i=1,NGLLX
+                   iglob = ibool(i,j,k,ispec)
 
-                 accel(1,iglob) = 0._CUSTOM_REAL
-                 accel(2,iglob) = 0._CUSTOM_REAL
-                 accel(3,iglob) = 0._CUSTOM_REAL
+                   accel(1,iglob) = 0._CUSTOM_REAL
+                   accel(2,iglob) = 0._CUSTOM_REAL
+                   accel(3,iglob) = 0._CUSTOM_REAL
 
-                 veloc(1,iglob) = 0._CUSTOM_REAL
-                 veloc(2,iglob) = 0._CUSTOM_REAL
-                 veloc(3,iglob) = 0._CUSTOM_REAL
+                   veloc(1,iglob) = 0._CUSTOM_REAL
+                   veloc(2,iglob) = 0._CUSTOM_REAL
+                   veloc(3,iglob) = 0._CUSTOM_REAL
 
-                 displ(1,iglob) = 0._CUSTOM_REAL
-                 displ(2,iglob) = 0._CUSTOM_REAL
-                 displ(3,iglob) = 0._CUSTOM_REAL
-              enddo
-           enddo
-        endif
-     enddo
+                   displ(1,iglob) = 0._CUSTOM_REAL
+                   displ(2,iglob) = 0._CUSTOM_REAL
+                   displ(3,iglob) = 0._CUSTOM_REAL
+                enddo
+             enddo
+          endif
+       enddo
+     endif
 
   endif ! if( PML_CONDITIONS )
 



More information about the CIG-COMMITS mailing list