[cig-commits] [commit] devel: fix reading attenuation arrays with multiple runs (8d8a07d)

cig_noreply at geodynamics.org cig_noreply at geodynamics.org
Fri Jan 30 11:06:47 PST 2015


Repository : https://github.com/geodynamics/specfem3d

On branch  : devel
Link       : https://github.com/geodynamics/specfem3d/compare/0f3b542a91577fd3452edc0a5d46c4d8e62bc914...63ec61dee06d2d562f41593a891f451c692fdf79

>---------------------------------------------------------------

commit 8d8a07d30dbe60b126094dc732696d815207ae4e
Author: emanuele casarotti <casarotti at tiscali.it>
Date:   Fri Jan 30 15:16:47 2015 +0100

    fix reading attenuation arrays with multiple runs


>---------------------------------------------------------------

8d8a07d30dbe60b126094dc732696d815207ae4e
 src/specfem3D/prepare_timerun.F90 | 51 +++++++++++++++++++++++++--------------
 1 file changed, 33 insertions(+), 18 deletions(-)

diff --git a/src/specfem3D/prepare_timerun.F90 b/src/specfem3D/prepare_timerun.F90
index 32a2a80..41b3f1c 100644
--- a/src/specfem3D/prepare_timerun.F90
+++ b/src/specfem3D/prepare_timerun.F90
@@ -492,30 +492,45 @@
     scale_factor_kappa(:,:,:,:) = 1._CUSTOM_REAL
 
     ! reads in attenuation arrays
-    open(unit=27, file=prname(1:len_trim(prname))//'attenuation.bin', &
-          status='old',action='read',form='unformatted',iostat=ier)
-    if (ier /= 0) then
-      print*,'error: could not open ',prname(1:len_trim(prname))//'attenuation.bin'
-      call exit_mpi(myrank,'error opening attenuation.bin file')
+    call create_name_database(prname,myrank,LOCAL_PATH)
+    if (I_should_read_the_database) then
+        open(unit=27, file=prname(1:len_trim(prname))//'attenuation.bin', status='old',action='read',form='unformatted',iostat=ier)
+        if (ier /= 0) then
+            print*,'error: could not open ',prname(1:len_trim(prname))//'attenuation.bin'
+            call exit_mpi(myrank,'error opening attenuation.bin file')
+        endif
     endif
-    read(27) ispec
-    if (ispec /= NSPEC_ATTENUATION_AB) then
-      close(27)
-      print*,'error: attenuation file array ',ispec,'should be ',NSPEC_ATTENUATION_AB
-      call exit_mpi(myrank,'error attenuation array dimensions, please recompile and rerun generate_databases')
+    
+    if (I_should_read_the_database) then
+        read(27) ispec
+        if (ispec /= NSPEC_ATTENUATION_AB) then
+            close(27)
+            print*,'error: attenuation file array ',ispec,'should be ',NSPEC_ATTENUATION_AB
+            call exit_mpi(myrank,'error attenuation array dimensions, please recompile and rerun generate_databases')
+        endif
+        read(27) one_minus_sum_beta
+        read(27) factor_common
+        read(27) scale_factor
+
+        if (FULL_ATTENUATION_SOLID) then
+            read(27) one_minus_sum_beta_kappa
+            read(27) factor_common_kappa
+            read(27) scale_factor_kappa
+        endif
+
+        close(27)
     endif
-    read(27) one_minus_sum_beta
-    read(27) factor_common
-    read(27) scale_factor
     
+    call bcast_all_i_for_database(ispec, 1)
+    if (size(one_minus_sum_beta) > 0) call bcast_all_cr_for_database(one_minus_sum_beta(1,1,1,1), size(one_minus_sum_beta))
+    if (size(factor_common) > 0) call bcast_all_cr_for_database(factor_common(1,1,1,1,1), size(factor_common))
+    if (size(scale_factor) > 0) call bcast_all_cr_for_database(scale_factor(1,1,1,1), size(scale_factor))
     if (FULL_ATTENUATION_SOLID) then
-      read(27) one_minus_sum_beta_kappa
-      read(27) factor_common_kappa
-      read(27) scale_factor_kappa
+        call bcast_all_cr_for_database(one_minus_sum_beta_kappa(1,1,1,1), size(one_minus_sum_beta_kappa))
+        call bcast_all_cr_for_database(factor_common_kappa(1,1,1,1,1), size(factor_common_kappa))
+        call bcast_all_cr_for_database(scale_factor_kappa(1,1,1,1), size(scale_factor_kappa))
     endif
 
-    close(27)
-
 
     ! gets stress relaxation times tau_sigma, i.e.
     ! precalculates tau_sigma depending on period band (constant for all Q_mu), and



More information about the CIG-COMMITS mailing list