[cig-commits] [commit] devel: added test of size(array) > 0 before broadcasting them (arrays of size 0 are legal in Fortran for some reason, but can create problems in the call to our broadcast routines because we call them with array(1) as argument). Swapped two "use module" statements in src/specfem3D/fault_solver_*.f90 because the first used the second, which led to an internal compiler error with some versions of GNU gfortran. (705302c)
cig_noreply at geodynamics.org
cig_noreply at geodynamics.org
Wed Sep 24 08:46:32 PDT 2014
Repository : https://github.com/geodynamics/specfem3d
On branch : devel
Link : https://github.com/geodynamics/specfem3d/compare/e8f0b0d06ff8115b57ff7a6688a040b04e174252...705302c37445c942b0bc92a6fb33dacb0db40336
>---------------------------------------------------------------
commit 705302c37445c942b0bc92a6fb33dacb0db40336
Author: Dimitri Komatitsch <komatitsch at lma.cnrs-mrs.fr>
Date: Wed Sep 24 17:37:08 2014 +0200
added test of size(array) > 0 before broadcasting them (arrays of size 0 are legal in Fortran for some reason, but can create problems in the call to our broadcast routines because we call them with array(1) as argument). Swapped two "use module" statements in src/specfem3D/fault_solver_*.f90 because the first used the second, which led to an internal compiler error with some versions of GNU gfortran.
>---------------------------------------------------------------
705302c37445c942b0bc92a6fb33dacb0db40336
src/specfem3D/fault_solver_dynamic.f90 | 2 +-
src/specfem3D/fault_solver_kinematic.f90 | 2 +-
src/specfem3D/read_mesh_databases.F90 | 222 ++++++++++++++++---------------
3 files changed, 120 insertions(+), 106 deletions(-)
diff --git a/src/specfem3D/fault_solver_dynamic.f90 b/src/specfem3D/fault_solver_dynamic.f90
index 3d3fbc7..90b95eb 100644
--- a/src/specfem3D/fault_solver_dynamic.f90
+++ b/src/specfem3D/fault_solver_dynamic.f90
@@ -37,8 +37,8 @@
module fault_solver_dynamic
- use fault_solver_common
use constants
+ use fault_solver_common
implicit none
diff --git a/src/specfem3D/fault_solver_kinematic.f90 b/src/specfem3D/fault_solver_kinematic.f90
index b3a54f6..3c345cb 100644
--- a/src/specfem3D/fault_solver_kinematic.f90
+++ b/src/specfem3D/fault_solver_kinematic.f90
@@ -32,8 +32,8 @@
module fault_solver_kinematic
- use fault_solver_common
use constants
+ use fault_solver_common
implicit none
diff --git a/src/specfem3D/read_mesh_databases.F90 b/src/specfem3D/read_mesh_databases.F90
index 6788112..7aa3d96 100644
--- a/src/specfem3D/read_mesh_databases.F90
+++ b/src/specfem3D/read_mesh_databases.F90
@@ -87,9 +87,9 @@
call bcast_all_i_for_database(NSPEC_AB, 1)
call bcast_all_i_for_database(NGLOB_AB, 1)
call bcast_all_i_for_database(ibool(1,1,1,1), size(ibool))
- call bcast_all_cr_for_database(xstore(1), size(xstore))
- call bcast_all_cr_for_database(ystore(1), size(ystore))
- call bcast_all_cr_for_database(zstore(1), size(zstore))
+ if(size(xstore) > 0) call bcast_all_cr_for_database(xstore(1), size(xstore))
+ if(size(ystore) > 0) call bcast_all_cr_for_database(ystore(1), size(ystore))
+ if(size(zstore) > 0) call bcast_all_cr_for_database(zstore(1), size(zstore))
call bcast_all_cr_for_database(xix(1,1,1,1), size(xix))
call bcast_all_cr_for_database(xiy(1,1,1,1), size(xiy))
call bcast_all_cr_for_database(xiz(1,1,1,1), size(xiz))
@@ -102,9 +102,9 @@
call bcast_all_cr_for_database(jacobian(1,1,1,1), size(jacobian))
call bcast_all_cr_for_database(kappastore(1,1,1,1), size(kappastore))
call bcast_all_cr_for_database(mustore(1,1,1,1), size(mustore))
- call bcast_all_l_for_database(ispec_is_acoustic(1), size(ispec_is_acoustic))
- call bcast_all_l_for_database(ispec_is_elastic(1), size(ispec_is_elastic))
- call bcast_all_l_for_database(ispec_is_poroelastic(1), size(ispec_is_poroelastic))
+ if(size(ispec_is_acoustic) > 0) call bcast_all_l_for_database(ispec_is_acoustic(1), size(ispec_is_acoustic))
+ if(size(ispec_is_elastic) > 0) call bcast_all_l_for_database(ispec_is_elastic(1), size(ispec_is_elastic))
+ if(size(ispec_is_poroelastic) > 0) call bcast_all_l_for_database(ispec_is_poroelastic(1), size(ispec_is_poroelastic))
! acoustic
! number of acoustic elements in this partition
@@ -127,7 +127,7 @@
allocate(rmass_acoustic(NGLOB_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array rmass_acoustic'
if(I_should_read_the_database) read(27) rmass_acoustic
- call bcast_all_cr_for_database(rmass_acoustic(1), size(rmass_acoustic))
+ if(size(rmass_acoustic) > 0) call bcast_all_cr_for_database(rmass_acoustic(1), size(rmass_acoustic))
! initializes mass matrix contribution
allocate(rmassz_acoustic(NGLOB_AB),stat=ier)
@@ -246,7 +246,7 @@
allocate(rmass_ocean_load(NGLOB_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array rmass_ocean_load'
if(I_should_read_the_database) read(27) rmass_ocean_load
- call bcast_all_cr_for_database(rmass_ocean_load(1), size(rmass_ocean_load))
+ if(size(rmass_ocean_load) > 0) call bcast_all_cr_for_database(rmass_ocean_load(1), size(rmass_ocean_load))
else
! dummy allocation
allocate(rmass_ocean_load(1),stat=ier)
@@ -255,10 +255,10 @@
!pll material parameters for stacey conditions
if(I_should_read_the_database) read(27,iostat=ier) rho_vp
- call bcast_all_cr_for_database(rho_vp(1,1,1,1), size(rho_vp))
+ if(size(rho_vp) > 0) call bcast_all_cr_for_database(rho_vp(1,1,1,1), size(rho_vp))
if( ier /= 0 ) stop 'error reading in array rho_vp'
if(I_should_read_the_database) read(27,iostat=ier) rho_vs
- call bcast_all_cr_for_database(rho_vs(1,1,1,1), size(rho_vs))
+ if(size(rho_vs) > 0) call bcast_all_cr_for_database(rho_vs(1,1,1,1), size(rho_vs))
if( ier /= 0 ) stop 'error reading in array rho_vs'
else
@@ -333,17 +333,17 @@
read(27) rho_vpII
read(27) rho_vsI
endif
- call bcast_all_cr_for_database(rmass_solid_poroelastic(1), size(rmass_solid_poroelastic))
- call bcast_all_cr_for_database(rmass_fluid_poroelastic(1), size(rmass_fluid_poroelastic))
- call bcast_all_cr_for_database(rhoarraystore(1,1,1,1,1), size(rhoarraystore))
- call bcast_all_cr_for_database(kappaarraystore(1,1,1,1,1), size(kappaarraystore))
- call bcast_all_cr_for_database(etastore(1,1,1,1), size(etastore))
- call bcast_all_cr_for_database(tortstore(1,1,1,1), size(tortstore))
- call bcast_all_cr_for_database(permstore(1,1,1,1,1), size(permstore))
- call bcast_all_cr_for_database(phistore(1,1,1,1), size(phistore))
- call bcast_all_cr_for_database(rho_vpI(1,1,1,1), size(rho_vpI))
- call bcast_all_cr_for_database(rho_vpII(1,1,1,1), size(rho_vpII))
- call bcast_all_cr_for_database(rho_vsI(1,1,1,1), size(rho_vsI))
+ if(size(rmass_solid_poroelastic) > 0) call bcast_all_cr_for_database(rmass_solid_poroelastic(1), size(rmass_solid_poroelastic))
+ if(size(rmass_fluid_poroelastic) > 0) call bcast_all_cr_for_database(rmass_fluid_poroelastic(1), size(rmass_fluid_poroelastic))
+ if(size(rhoarraystore) > 0) call bcast_all_cr_for_database(rhoarraystore(1,1,1,1,1), size(rhoarraystore))
+ if(size(kappaarraystore) > 0) call bcast_all_cr_for_database(kappaarraystore(1,1,1,1,1), size(kappaarraystore))
+ if(size(etastore) > 0) call bcast_all_cr_for_database(etastore(1,1,1,1), size(etastore))
+ if(size(tortstore) > 0) call bcast_all_cr_for_database(tortstore(1,1,1,1), size(tortstore))
+ if(size(permstore) > 0) call bcast_all_cr_for_database(permstore(1,1,1,1,1), size(permstore))
+ if(size(phistore) > 0) call bcast_all_cr_for_database(phistore(1,1,1,1), size(phistore))
+ if(size(rho_vpI) > 0) call bcast_all_cr_for_database(rho_vpI(1,1,1,1), size(rho_vpI))
+ if(size(rho_vpII) > 0) call bcast_all_cr_for_database(rho_vpII(1,1,1,1), size(rho_vpII))
+ if(size(rho_vsI) > 0) call bcast_all_cr_for_database(rho_vsI(1,1,1,1), size(rho_vsI))
endif
! checks simulation types are valid
@@ -413,18 +413,18 @@
read(27) alpha_store_y
read(27) alpha_store_z
endif
- call bcast_all_i_for_database(CPML_regions(1), size(CPML_regions))
- call bcast_all_i_for_database(CPML_to_spec(1), size(CPML_to_spec))
- call bcast_all_l_for_database(is_CPML(1), size(is_CPML))
- call bcast_all_cr_for_database(d_store_x(1,1,1,1), size(d_store_x))
- call bcast_all_cr_for_database(d_store_y(1,1,1,1), size(d_store_y))
- call bcast_all_cr_for_database(d_store_z(1,1,1,1), size(d_store_z))
- call bcast_all_cr_for_database(k_store_x(1,1,1,1), size(k_store_x))
- call bcast_all_cr_for_database(k_store_y(1,1,1,1), size(k_store_y))
- call bcast_all_cr_for_database(k_store_z(1,1,1,1), size(k_store_z))
- call bcast_all_cr_for_database(alpha_store_x(1,1,1,1), size(alpha_store_x))
- call bcast_all_cr_for_database(alpha_store_y(1,1,1,1), size(alpha_store_y))
- call bcast_all_cr_for_database(alpha_store_z(1,1,1,1), size(alpha_store_z))
+ if(size(CPML_regions) > 0) call bcast_all_i_for_database(CPML_regions(1), size(CPML_regions))
+ if(size(CPML_to_spec) > 0) call bcast_all_i_for_database(CPML_to_spec(1), size(CPML_to_spec))
+ if(size(is_CPML) > 0) call bcast_all_l_for_database(is_CPML(1), size(is_CPML))
+ if(size(d_store_x) > 0) call bcast_all_cr_for_database(d_store_x(1,1,1,1), size(d_store_x))
+ if(size(d_store_y) > 0) call bcast_all_cr_for_database(d_store_y(1,1,1,1), size(d_store_y))
+ if(size(d_store_z) > 0) call bcast_all_cr_for_database(d_store_z(1,1,1,1), size(d_store_z))
+ if(size(k_store_x) > 0) call bcast_all_cr_for_database(k_store_x(1,1,1,1), size(k_store_x))
+ if(size(k_store_y) > 0) call bcast_all_cr_for_database(k_store_y(1,1,1,1), size(k_store_y))
+ if(size(k_store_z) > 0) call bcast_all_cr_for_database(k_store_z(1,1,1,1), size(k_store_z))
+ if(size(alpha_store_x) > 0) call bcast_all_cr_for_database(alpha_store_x(1,1,1,1), size(alpha_store_x))
+ if(size(alpha_store_y) > 0) call bcast_all_cr_for_database(alpha_store_y(1,1,1,1), size(alpha_store_y))
+ if(size(alpha_store_z) > 0) call bcast_all_cr_for_database(alpha_store_z(1,1,1,1), size(alpha_store_z))
if((SIMULATION_TYPE == 1 .and. SAVE_FORWARD) .or. SIMULATION_TYPE == 3) then
if(I_should_read_the_database) read(27) nglob_interface_PML_acoustic
@@ -435,13 +435,15 @@
allocate(points_interface_PML_acoustic(nglob_interface_PML_acoustic),stat=ier)
if(ier /= 0) stop 'error allocating array points_interface_PML_acoustic'
if(I_should_read_the_database) read(27) points_interface_PML_acoustic
- call bcast_all_i_for_database(points_interface_PML_acoustic(1), size(points_interface_PML_acoustic))
+ if(size(points_interface_PML_acoustic) > 0) &
+ call bcast_all_i_for_database(points_interface_PML_acoustic(1), size(points_interface_PML_acoustic))
endif
if(nglob_interface_PML_elastic > 0) then
allocate(points_interface_PML_elastic(nglob_interface_PML_elastic),stat=ier)
if(ier /= 0) stop 'error allocating array points_interface_PML_elastic'
if(I_should_read_the_database) read(27) points_interface_PML_elastic
- call bcast_all_i_for_database(points_interface_PML_elastic(1), size(points_interface_PML_elastic))
+ if(size(points_interface_PML_elastic) > 0) &
+ call bcast_all_i_for_database(points_interface_PML_elastic(1), size(points_interface_PML_elastic))
endif
endif
endif
@@ -487,10 +489,11 @@
read(27) abs_boundary_jacobian2Dw
read(27) abs_boundary_normal
endif
- call bcast_all_i_for_database(abs_boundary_ispec(1), size(abs_boundary_ispec))
- call bcast_all_i_for_database(abs_boundary_ijk(1,1,1), size(abs_boundary_ijk))
- call bcast_all_cr_for_database(abs_boundary_jacobian2Dw(1,1), size(abs_boundary_jacobian2Dw))
- call bcast_all_cr_for_database(abs_boundary_normal(1,1,1), size(abs_boundary_normal))
+ if(size(abs_boundary_ispec) > 0) call bcast_all_i_for_database(abs_boundary_ispec(1), size(abs_boundary_ispec))
+ if(size(abs_boundary_ijk) > 0) call bcast_all_i_for_database(abs_boundary_ijk(1,1,1), size(abs_boundary_ijk))
+ if(size(abs_boundary_jacobian2Dw) > 0) &
+ call bcast_all_cr_for_database(abs_boundary_jacobian2Dw(1,1), size(abs_boundary_jacobian2Dw))
+ if(size(abs_boundary_normal) > 0) call bcast_all_cr_for_database(abs_boundary_normal(1,1,1), size(abs_boundary_normal))
endif
else
if (num_abs_boundary_faces > 0) then
@@ -500,10 +503,11 @@
read(27) abs_boundary_jacobian2Dw
read(27) abs_boundary_normal
endif
- call bcast_all_i_for_database(abs_boundary_ispec(1), size(abs_boundary_ispec))
- call bcast_all_i_for_database(abs_boundary_ijk(1,1,1), size(abs_boundary_ijk))
- call bcast_all_cr_for_database(abs_boundary_jacobian2Dw(1,1), size(abs_boundary_jacobian2Dw))
- call bcast_all_cr_for_database(abs_boundary_normal(1,1,1), size(abs_boundary_normal))
+ if(size(abs_boundary_ispec) > 0) call bcast_all_i_for_database(abs_boundary_ispec(1), size(abs_boundary_ispec))
+ if(size(abs_boundary_ijk) > 0) call bcast_all_i_for_database(abs_boundary_ijk(1,1,1), size(abs_boundary_ijk))
+ if(size(abs_boundary_jacobian2Dw) > 0) &
+ call bcast_all_cr_for_database(abs_boundary_jacobian2Dw(1,1), size(abs_boundary_jacobian2Dw))
+ if(size(abs_boundary_normal) > 0) call bcast_all_cr_for_database(abs_boundary_normal(1,1,1), size(abs_boundary_normal))
if (STACEY_ABSORBING_CONDITIONS) then
! store mass matrix contributions
if (ELASTIC_SIMULATION) then
@@ -512,13 +516,13 @@
read(27) rmassy
read(27) rmassz
endif
- call bcast_all_cr_for_database(rmassx(1), size(rmassx))
- call bcast_all_cr_for_database(rmassy(1), size(rmassy))
- call bcast_all_cr_for_database(rmassz(1), size(rmassz))
+ if(size(rmassx) > 0) call bcast_all_cr_for_database(rmassx(1), size(rmassx))
+ if(size(rmassy) > 0) call bcast_all_cr_for_database(rmassy(1), size(rmassy))
+ if(size(rmassz) > 0) call bcast_all_cr_for_database(rmassz(1), size(rmassz))
endif
if (ACOUSTIC_SIMULATION) then
if(I_should_read_the_database) read(27) rmassz_acoustic
- call bcast_all_cr_for_database(rmassz_acoustic(1), size(rmassz_acoustic))
+ if(size(rmassz_acoustic) > 0) call bcast_all_cr_for_database(rmassz_acoustic(1), size(rmassz_acoustic))
endif
endif
endif
@@ -573,10 +577,11 @@
read(27) free_surface_jacobian2Dw
read(27) free_surface_normal
endif
- call bcast_all_i_for_database(free_surface_ispec(1), size(free_surface_ispec))
- call bcast_all_i_for_database(free_surface_ijk(1,1,1), size(free_surface_ijk))
- call bcast_all_cr_for_database(free_surface_jacobian2Dw(1,1), size(free_surface_jacobian2Dw))
- call bcast_all_cr_for_database(free_surface_normal(1,1,1), size(free_surface_normal))
+ if(size(free_surface_ispec) > 0) call bcast_all_i_for_database(free_surface_ispec(1), size(free_surface_ispec))
+ if(size(free_surface_ijk) > 0) call bcast_all_i_for_database(free_surface_ijk(1,1,1), size(free_surface_ijk))
+ if(size(free_surface_jacobian2Dw) > 0) &
+ call bcast_all_cr_for_database(free_surface_jacobian2Dw(1,1), size(free_surface_jacobian2Dw))
+ if(size(free_surface_normal) > 0) call bcast_all_cr_for_database(free_surface_normal(1,1,1), size(free_surface_normal))
endif
! acoustic-elastic coupling surface
@@ -594,10 +599,11 @@
read(27) coupling_ac_el_jacobian2Dw
read(27) coupling_ac_el_normal
endif
- call bcast_all_i_for_database(coupling_ac_el_ispec(1), size(coupling_ac_el_ispec))
- call bcast_all_i_for_database(coupling_ac_el_ijk(1,1,1), size(coupling_ac_el_ijk))
- call bcast_all_cr_for_database(coupling_ac_el_jacobian2Dw(1,1), size(coupling_ac_el_jacobian2Dw))
- call bcast_all_cr_for_database(coupling_ac_el_normal(1,1,1), size(coupling_ac_el_normal))
+ if(size(coupling_ac_el_ispec) > 0) call bcast_all_i_for_database(coupling_ac_el_ispec(1), size(coupling_ac_el_ispec))
+ if(size(coupling_ac_el_ijk) > 0) call bcast_all_i_for_database(coupling_ac_el_ijk(1,1,1), size(coupling_ac_el_ijk))
+ if(size(coupling_ac_el_jacobian2Dw) > 0) &
+ call bcast_all_cr_for_database(coupling_ac_el_jacobian2Dw(1,1), size(coupling_ac_el_jacobian2Dw))
+ if(size(coupling_ac_el_normal) > 0) call bcast_all_cr_for_database(coupling_ac_el_normal(1,1,1), size(coupling_ac_el_normal))
endif
! acoustic-poroelastic coupling surface
@@ -615,10 +621,11 @@
read(27) coupling_ac_po_jacobian2Dw
read(27) coupling_ac_po_normal
endif
- call bcast_all_i_for_database(coupling_ac_po_ispec(1), size(coupling_ac_po_ispec))
- call bcast_all_i_for_database(coupling_ac_po_ijk(1,1,1), size(coupling_ac_po_ijk))
- call bcast_all_cr_for_database(coupling_ac_po_jacobian2Dw(1,1), size(coupling_ac_po_jacobian2Dw))
- call bcast_all_cr_for_database(coupling_ac_po_normal(1,1,1), size(coupling_ac_po_normal))
+ if(size(coupling_ac_po_ispec) > 0) call bcast_all_i_for_database(coupling_ac_po_ispec(1), size(coupling_ac_po_ispec))
+ if(size(coupling_ac_po_ijk) > 0) call bcast_all_i_for_database(coupling_ac_po_ijk(1,1,1), size(coupling_ac_po_ijk))
+ if(size(coupling_ac_po_jacobian2Dw) > 0) &
+ call bcast_all_cr_for_database(coupling_ac_po_jacobian2Dw(1,1), size(coupling_ac_po_jacobian2Dw))
+ if(size(coupling_ac_po_normal) > 0) call bcast_all_cr_for_database(coupling_ac_po_normal(1,1,1), size(coupling_ac_po_normal))
endif
! elastic-poroelastic coupling surface
@@ -640,12 +647,13 @@
read(27) coupling_el_po_jacobian2Dw
read(27) coupling_el_po_normal
endif
- call bcast_all_i_for_database(coupling_el_po_ispec(1), size(coupling_el_po_ispec))
- call bcast_all_i_for_database(coupling_po_el_ispec(1), size(coupling_po_el_ispec))
- call bcast_all_i_for_database(coupling_el_po_ijk(1,1,1), size(coupling_el_po_ijk))
- call bcast_all_i_for_database(coupling_po_el_ijk(1,1,1), size(coupling_po_el_ijk))
- call bcast_all_cr_for_database(coupling_el_po_jacobian2Dw(1,1), size(coupling_el_po_jacobian2Dw))
- call bcast_all_cr_for_database(coupling_el_po_normal(1,1,1), size(coupling_el_po_normal))
+ if(size(coupling_el_po_ispec) > 0) call bcast_all_i_for_database(coupling_el_po_ispec(1), size(coupling_el_po_ispec))
+ if(size(coupling_po_el_ispec) > 0) call bcast_all_i_for_database(coupling_po_el_ispec(1), size(coupling_po_el_ispec))
+ if(size(coupling_el_po_ijk) > 0) call bcast_all_i_for_database(coupling_el_po_ijk(1,1,1), size(coupling_el_po_ijk))
+ if(size(coupling_po_el_ijk) > 0) call bcast_all_i_for_database(coupling_po_el_ijk(1,1,1), size(coupling_po_el_ijk))
+ if(size(coupling_el_po_jacobian2Dw) > 0) &
+ call bcast_all_cr_for_database(coupling_el_po_jacobian2Dw(1,1), size(coupling_el_po_jacobian2Dw))
+ if(size(coupling_el_po_normal) > 0) call bcast_all_cr_for_database(coupling_el_po_normal(1,1,1), size(coupling_el_po_normal))
endif
! MPI interfaces
@@ -664,9 +672,11 @@
read(27) nibool_interfaces_ext_mesh
read(27) ibool_interfaces_ext_mesh
endif
- call bcast_all_i_for_database(my_neighbours_ext_mesh(1), size(my_neighbours_ext_mesh))
- call bcast_all_i_for_database(nibool_interfaces_ext_mesh(1), size(nibool_interfaces_ext_mesh))
- call bcast_all_i_for_database(ibool_interfaces_ext_mesh(1,1), size(ibool_interfaces_ext_mesh))
+ if(size(my_neighbours_ext_mesh) > 0) call bcast_all_i_for_database(my_neighbours_ext_mesh(1), size(my_neighbours_ext_mesh))
+ if(size(nibool_interfaces_ext_mesh) > 0) &
+ call bcast_all_i_for_database(nibool_interfaces_ext_mesh(1), size(nibool_interfaces_ext_mesh))
+ if(size(ibool_interfaces_ext_mesh) > 0) &
+ call bcast_all_i_for_database(ibool_interfaces_ext_mesh(1,1), size(ibool_interfaces_ext_mesh))
else
max_nibool_interfaces_ext_mesh = 0
allocate(ibool_interfaces_ext_mesh(0,0),stat=ier)
@@ -696,34 +706,34 @@
read(27) c56store
read(27) c66store
endif
- call bcast_all_cr_for_database(c11store(1,1,1,1), size(c11store))
- call bcast_all_cr_for_database(c12store(1,1,1,1), size(c12store))
- call bcast_all_cr_for_database(c13store(1,1,1,1), size(c13store))
- call bcast_all_cr_for_database(c14store(1,1,1,1), size(c14store))
- call bcast_all_cr_for_database(c15store(1,1,1,1), size(c15store))
- call bcast_all_cr_for_database(c16store(1,1,1,1), size(c16store))
- call bcast_all_cr_for_database(c22store(1,1,1,1), size(c22store))
- call bcast_all_cr_for_database(c23store(1,1,1,1), size(c23store))
- call bcast_all_cr_for_database(c24store(1,1,1,1), size(c24store))
- call bcast_all_cr_for_database(c25store(1,1,1,1), size(c25store))
- call bcast_all_cr_for_database(c26store(1,1,1,1), size(c26store))
- call bcast_all_cr_for_database(c33store(1,1,1,1), size(c33store))
- call bcast_all_cr_for_database(c34store(1,1,1,1), size(c34store))
- call bcast_all_cr_for_database(c35store(1,1,1,1), size(c35store))
- call bcast_all_cr_for_database(c36store(1,1,1,1), size(c36store))
- call bcast_all_cr_for_database(c44store(1,1,1,1), size(c44store))
- call bcast_all_cr_for_database(c45store(1,1,1,1), size(c45store))
- call bcast_all_cr_for_database(c46store(1,1,1,1), size(c46store))
- call bcast_all_cr_for_database(c55store(1,1,1,1), size(c55store))
- call bcast_all_cr_for_database(c56store(1,1,1,1), size(c56store))
- call bcast_all_cr_for_database(c66store(1,1,1,1), size(c66store))
+ if(size(c11store) > 0) call bcast_all_cr_for_database(c11store(1,1,1,1), size(c11store))
+ if(size(c12store) > 0) call bcast_all_cr_for_database(c12store(1,1,1,1), size(c12store))
+ if(size(c13store) > 0) call bcast_all_cr_for_database(c13store(1,1,1,1), size(c13store))
+ if(size(c14store) > 0) call bcast_all_cr_for_database(c14store(1,1,1,1), size(c14store))
+ if(size(c15store) > 0) call bcast_all_cr_for_database(c15store(1,1,1,1), size(c15store))
+ if(size(c16store) > 0) call bcast_all_cr_for_database(c16store(1,1,1,1), size(c16store))
+ if(size(c22store) > 0) call bcast_all_cr_for_database(c22store(1,1,1,1), size(c22store))
+ if(size(c23store) > 0) call bcast_all_cr_for_database(c23store(1,1,1,1), size(c23store))
+ if(size(c24store) > 0) call bcast_all_cr_for_database(c24store(1,1,1,1), size(c24store))
+ if(size(c25store) > 0) call bcast_all_cr_for_database(c25store(1,1,1,1), size(c25store))
+ if(size(c26store) > 0) call bcast_all_cr_for_database(c26store(1,1,1,1), size(c26store))
+ if(size(c33store) > 0) call bcast_all_cr_for_database(c33store(1,1,1,1), size(c33store))
+ if(size(c34store) > 0) call bcast_all_cr_for_database(c34store(1,1,1,1), size(c34store))
+ if(size(c35store) > 0) call bcast_all_cr_for_database(c35store(1,1,1,1), size(c35store))
+ if(size(c36store) > 0) call bcast_all_cr_for_database(c36store(1,1,1,1), size(c36store))
+ if(size(c44store) > 0) call bcast_all_cr_for_database(c44store(1,1,1,1), size(c44store))
+ if(size(c45store) > 0) call bcast_all_cr_for_database(c45store(1,1,1,1), size(c45store))
+ if(size(c46store) > 0) call bcast_all_cr_for_database(c46store(1,1,1,1), size(c46store))
+ if(size(c55store) > 0) call bcast_all_cr_for_database(c55store(1,1,1,1), size(c55store))
+ if(size(c56store) > 0) call bcast_all_cr_for_database(c56store(1,1,1,1), size(c56store))
+ if(size(c66store) > 0) call bcast_all_cr_for_database(c66store(1,1,1,1), size(c66store))
endif
! inner / outer elements
allocate(ispec_is_inner(NSPEC_AB),stat=ier)
if( ier /= 0 ) stop 'error allocating array ispec_is_inner'
if(I_should_read_the_database) read(27) ispec_is_inner
- call bcast_all_l_for_database(ispec_is_inner(1), size(ispec_is_inner))
+ if(size(ispec_is_inner) > 0) call bcast_all_l_for_database(ispec_is_inner(1), size(ispec_is_inner))
if( ACOUSTIC_SIMULATION ) then
if(I_should_read_the_database) then
@@ -738,7 +748,8 @@
if( ier /= 0 ) stop 'error allocating array phase_ispec_inner_acoustic'
if(num_phase_ispec_acoustic > 0 ) then
if(I_should_read_the_database) read(27) phase_ispec_inner_acoustic
- call bcast_all_i_for_database(phase_ispec_inner_acoustic(1,1), size(phase_ispec_inner_acoustic))
+ if(size(phase_ispec_inner_acoustic) > 0) &
+ call bcast_all_i_for_database(phase_ispec_inner_acoustic(1,1), size(phase_ispec_inner_acoustic))
endif
endif
@@ -755,7 +766,8 @@
if( ier /= 0 ) stop 'error allocating array phase_ispec_inner_elastic'
if(num_phase_ispec_elastic > 0 ) then
if(I_should_read_the_database) read(27) phase_ispec_inner_elastic
- call bcast_all_i_for_database(phase_ispec_inner_elastic(1,1), size(phase_ispec_inner_elastic))
+ if(size(phase_ispec_inner_elastic) > 0) &
+ call bcast_all_i_for_database(phase_ispec_inner_elastic(1,1), size(phase_ispec_inner_elastic))
endif
endif
@@ -772,7 +784,8 @@
if( ier /= 0 ) stop 'error allocating array phase_ispec_inner_poroelastic'
if(num_phase_ispec_poroelastic > 0 ) then
if(I_should_read_the_database) read(27) phase_ispec_inner_poroelastic
- call bcast_all_i_for_database(phase_ispec_inner_poroelastic(1,1), size(phase_ispec_inner_poroelastic))
+ if(size(phase_ispec_inner_poroelastic) > 0) &
+ call bcast_all_i_for_database(phase_ispec_inner_poroelastic(1,1), size(phase_ispec_inner_poroelastic))
endif
endif
@@ -788,7 +801,8 @@
if( ier /= 0 ) stop 'error allocating num_elem_colors_acoustic array'
if(I_should_read_the_database) read(27) num_elem_colors_acoustic
- call bcast_all_i_for_database(num_elem_colors_acoustic(1), size(num_elem_colors_acoustic))
+ if(size(num_elem_colors_acoustic) > 0) &
+ call bcast_all_i_for_database(num_elem_colors_acoustic(1), size(num_elem_colors_acoustic))
endif
! elastic domain colors
if( ELASTIC_SIMULATION ) then
@@ -800,7 +814,7 @@
if( ier /= 0 ) stop 'error allocating num_elem_colors_elastic array'
if(I_should_read_the_database) read(27) num_elem_colors_elastic
- call bcast_all_i_for_database(num_elem_colors_elastic(1), size(num_elem_colors_elastic))
+ if(size(num_elem_colors_elastic) > 0) call bcast_all_i_for_database(num_elem_colors_elastic(1), size(num_elem_colors_elastic))
endif
else
! allocates dummy arrays
@@ -1125,10 +1139,10 @@
read(27) ijk_moho_top
read(27) ijk_moho_bot
endif
- call bcast_all_i_for_database(ibelm_moho_top(1), size(ibelm_moho_top))
- call bcast_all_i_for_database(ibelm_moho_bot(1), size(ibelm_moho_bot))
- call bcast_all_i_for_database(ijk_moho_top(1,1,1), size(ijk_moho_top))
- call bcast_all_i_for_database(ijk_moho_bot(1,1,1), size(ijk_moho_bot))
+ if(size(ibelm_moho_top) > 0) call bcast_all_i_for_database(ibelm_moho_top(1), size(ibelm_moho_top))
+ if(size(ibelm_moho_bot) > 0) call bcast_all_i_for_database(ibelm_moho_bot(1), size(ibelm_moho_bot))
+ if(size(ijk_moho_top) > 0) call bcast_all_i_for_database(ijk_moho_top(1,1,1), size(ijk_moho_top))
+ if(size(ijk_moho_bot) > 0) call bcast_all_i_for_database(ijk_moho_bot(1,1,1), size(ijk_moho_bot))
if(I_should_read_the_database) close(27)
@@ -1147,8 +1161,8 @@
read(27) normal_moho_top
read(27) normal_moho_bot
endif
- call bcast_all_cr_for_database(normal_moho_top(1,1,1), size(normal_moho_top))
- call bcast_all_cr_for_database(normal_moho_bot(1,1,1), size(normal_moho_bot))
+ if(size(normal_moho_top) > 0) call bcast_all_cr_for_database(normal_moho_top(1,1,1), size(normal_moho_top))
+ if(size(normal_moho_bot) > 0) call bcast_all_cr_for_database(normal_moho_bot(1,1,1), size(normal_moho_bot))
if(I_should_read_the_database) close(27)
! flags
@@ -1166,13 +1180,13 @@
read(27) is_moho_top
read(27) is_moho_bot
endif
- call bcast_all_l_for_database(is_moho_top(1), size(is_moho_top))
- call bcast_all_l_for_database(is_moho_bot(1), size(is_moho_bot))
+ if(size(is_moho_top) > 0) call bcast_all_l_for_database(is_moho_top(1), size(is_moho_top))
+ if(size(is_moho_bot) > 0) call bcast_all_l_for_database(is_moho_bot(1), size(is_moho_bot))
if(I_should_read_the_database) close(27)
endif
- ! moho kernel
+ ! Moho kernel
allocate( moho_kl(NGLLSQUARE,NSPEC2D_MOHO),stat=ier)
if( ier /= 0 ) stop 'error allocating array moho_kl'
moho_kl = 0._CUSTOM_REAL
More information about the CIG-COMMITS
mailing list