[cig-commits] r22702 - seismo/3D/SPECFEM3D/trunk/src/specfem3D
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Tue Aug 6 14:50:51 PDT 2013
Author: dkomati1
Date: 2013-08-06 14:50:51 -0700 (Tue, 06 Aug 2013)
New Revision: 22702
Modified:
seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_allocate_arrays.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90
Log:
improved routine to allocate PML arrays that are not yet allocated
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_allocate_arrays.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_allocate_arrays.f90 2013-08-06 21:02:17 UTC (rev 22701)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/pml_allocate_arrays.f90 2013-08-06 21:50:51 UTC (rev 22702)
@@ -389,77 +389,73 @@
subroutine pml_allocate_arrays_dummy()
+ ! dummy allocation with a size of 1 for all the PML arrays that have not yet been allocated
+ ! in order to be able to use these arrays as arguments in subroutine calls
+
use pml_par
implicit none
- ! local parameters
- integer :: ier
+ if(.not. allocated(spec_to_CPML)) allocate(spec_to_CPML(1))
+ if(.not. allocated(CPML_type)) allocate(CPML_type(1))
+ if(.not. allocated(PML_dux_dxl)) allocate(PML_dux_dxl(1,1,1))
+ if(.not. allocated(PML_dux_dyl)) allocate(PML_dux_dyl(1,1,1))
+ if(.not. allocated(PML_dux_dzl)) allocate(PML_dux_dzl(1,1,1))
+ if(.not. allocated(PML_duy_dxl)) allocate(PML_duy_dxl(1,1,1))
+ if(.not. allocated(PML_duy_dyl)) allocate(PML_duy_dyl(1,1,1))
+ if(.not. allocated(PML_duy_dzl)) allocate(PML_duy_dzl(1,1,1))
+ if(.not. allocated(PML_duz_dxl)) allocate(PML_duz_dxl(1,1,1))
+ if(.not. allocated(PML_duz_dyl)) allocate(PML_duz_dyl(1,1,1))
+ if(.not. allocated(PML_duz_dzl)) allocate(PML_duz_dzl(1,1,1))
+ if(.not. allocated(PML_dux_dxl_new)) allocate(PML_dux_dxl_new(1,1,1))
+ if(.not. allocated(PML_dux_dyl_new)) allocate(PML_dux_dyl_new(1,1,1))
+ if(.not. allocated(PML_dux_dzl_new)) allocate(PML_dux_dzl_new(1,1,1))
+ if(.not. allocated(PML_duy_dxl_new)) allocate(PML_duy_dxl_new(1,1,1))
+ if(.not. allocated(PML_duy_dyl_new)) allocate(PML_duy_dyl_new(1,1,1))
+ if(.not. allocated(PML_duy_dzl_new)) allocate(PML_duy_dzl_new(1,1,1))
+ if(.not. allocated(PML_duz_dxl_new)) allocate(PML_duz_dxl_new(1,1,1))
+ if(.not. allocated(PML_duz_dyl_new)) allocate(PML_duz_dyl_new(1,1,1))
+ if(.not. allocated(PML_duz_dzl_new)) allocate(PML_duz_dzl_new(1,1,1))
+ if(.not. allocated(rmemory_dux_dxl_x)) allocate(rmemory_dux_dxl_x(1,1,1,1,2))
+ if(.not. allocated(rmemory_dux_dyl_x)) allocate(rmemory_dux_dyl_x(1,1,1,1,2))
+ if(.not. allocated(rmemory_dux_dzl_x)) allocate(rmemory_dux_dzl_x(1,1,1,1,2))
+ if(.not. allocated(rmemory_duy_dxl_x)) allocate(rmemory_duy_dxl_x(1,1,1,1))
+ if(.not. allocated(rmemory_duy_dyl_x)) allocate(rmemory_duy_dyl_x(1,1,1,1))
+ if(.not. allocated(rmemory_duz_dxl_x)) allocate(rmemory_duz_dxl_x(1,1,1,1))
+ if(.not. allocated(rmemory_duz_dzl_x)) allocate(rmemory_duz_dzl_x(1,1,1,1))
+ if(.not. allocated(rmemory_dux_dxl_y)) allocate(rmemory_dux_dxl_y(1,1,1,1))
+ if(.not. allocated(rmemory_dux_dyl_y)) allocate(rmemory_dux_dyl_y(1,1,1,1))
+ if(.not. allocated(rmemory_duy_dxl_y)) allocate(rmemory_duy_dxl_y(1,1,1,1,2))
+ if(.not. allocated(rmemory_duy_dyl_y)) allocate(rmemory_duy_dyl_y(1,1,1,1,2))
+ if(.not. allocated(rmemory_duy_dzl_y)) allocate(rmemory_duy_dzl_y(1,1,1,1,2))
+ if(.not. allocated(rmemory_duz_dyl_y)) allocate(rmemory_duz_dyl_y(1,1,1,1))
+ if(.not. allocated(rmemory_duz_dzl_y)) allocate(rmemory_duz_dzl_y(1,1,1,1))
+ if(.not. allocated(rmemory_dux_dxl_z)) allocate(rmemory_dux_dxl_z(1,1,1,1))
+ if(.not. allocated(rmemory_dux_dzl_z)) allocate(rmemory_dux_dzl_z(1,1,1,1))
+ if(.not. allocated(rmemory_duy_dyl_z)) allocate(rmemory_duy_dyl_z(1,1,1,1))
+ if(.not. allocated(rmemory_duy_dzl_z)) allocate(rmemory_duy_dzl_z(1,1,1,1))
+ if(.not. allocated(rmemory_duz_dxl_z)) allocate(rmemory_duz_dxl_z(1,1,1,1,2))
+ if(.not. allocated(rmemory_duz_dyl_z)) allocate(rmemory_duz_dyl_z(1,1,1,1,2))
+ if(.not. allocated(rmemory_duz_dzl_z)) allocate(rmemory_duz_dzl_z(1,1,1,1,2))
+ if(.not. allocated(rmemory_displ_elastic)) allocate(rmemory_displ_elastic(1,1,1,1,1,3))
+ if(.not. allocated(accel_elastic_CPML)) allocate(accel_elastic_CPML(1,1,1,1))
+ if(.not. allocated(PML_dpotential_dxl)) allocate(PML_dpotential_dxl(1,1,1))
+ if(.not. allocated(PML_dpotential_dyl)) allocate(PML_dpotential_dyl(1,1,1))
+ if(.not. allocated(PML_dpotential_dzl)) allocate(PML_dpotential_dzl(1,1,1))
+ if(.not. allocated(PML_dpotential_dxl_new)) allocate(PML_dpotential_dxl_new(1,1,1))
+ if(.not. allocated(PML_dpotential_dyl_new)) allocate(PML_dpotential_dyl_new(1,1,1))
+ if(.not. allocated(PML_dpotential_dzl_new)) allocate(PML_dpotential_dzl_new(1,1,1))
+ if(.not. allocated(rmemory_dpotential_dxl)) allocate(rmemory_dpotential_dxl(1,1,1,1,2))
+ if(.not. allocated(rmemory_dpotential_dyl)) allocate(rmemory_dpotential_dyl(1,1,1,1,2))
+ if(.not. allocated(rmemory_dpotential_dzl)) allocate(rmemory_dpotential_dzl(1,1,1,1,2))
+ if(.not. allocated(rmemory_potential_acoustic)) allocate(rmemory_potential_acoustic(1,1,1,1,3))
+ if(.not. allocated(potential_dot_dot_acoustic_CPML)) allocate(potential_dot_dot_acoustic_CPML(1,1,1))
+ if(.not. allocated(rmemory_coupling_ac_el_displ)) allocate(rmemory_coupling_ac_el_displ(3,1,1,1,1,2))
+ if(.not. allocated(rmemory_coupling_el_ac_potential)) allocate(rmemory_coupling_el_ac_potential(1,1,1,1,2))
+ ! allocates wavefield
+ if(.not. allocated(b_PML_field)) allocate(b_PML_field(9,1))
+ ! allocates wavefield
+ if(.not. allocated(b_PML_potential)) allocate(b_PML_potential(3,1))
- allocate(spec_to_CPML(1),stat=ier)
- allocate(CPML_type(1),stat=ier)
- allocate(PML_dux_dxl(1,1,1),stat=ier)
- allocate(PML_dux_dyl(1,1,1),stat=ier)
- allocate(PML_dux_dzl(1,1,1),stat=ier)
- allocate(PML_duy_dxl(1,1,1),stat=ier)
- allocate(PML_duy_dyl(1,1,1),stat=ier)
- allocate(PML_duy_dzl(1,1,1),stat=ier)
- allocate(PML_duz_dxl(1,1,1),stat=ier)
- allocate(PML_duz_dyl(1,1,1),stat=ier)
- allocate(PML_duz_dzl(1,1,1),stat=ier)
- allocate(PML_dux_dxl_new(1,1,1),stat=ier)
- allocate(PML_dux_dyl_new(1,1,1),stat=ier)
- allocate(PML_dux_dzl_new(1,1,1),stat=ier)
- allocate(PML_duy_dxl_new(1,1,1),stat=ier)
- allocate(PML_duy_dyl_new(1,1,1),stat=ier)
- allocate(PML_duy_dzl_new(1,1,1),stat=ier)
- allocate(PML_duz_dxl_new(1,1,1),stat=ier)
- allocate(PML_duz_dyl_new(1,1,1),stat=ier)
- allocate(PML_duz_dzl_new(1,1,1),stat=ier)
- allocate(rmemory_dux_dxl_x(1,1,1,1,2),stat=ier)
- allocate(rmemory_dux_dyl_x(1,1,1,1,2),stat=ier)
- allocate(rmemory_dux_dzl_x(1,1,1,1,2),stat=ier)
- allocate(rmemory_duy_dxl_x(1,1,1,1),stat=ier)
- allocate(rmemory_duy_dyl_x(1,1,1,1),stat=ier)
- allocate(rmemory_duz_dxl_x(1,1,1,1),stat=ier)
- allocate(rmemory_duz_dzl_x(1,1,1,1),stat=ier)
- allocate(rmemory_dux_dxl_y(1,1,1,1),stat=ier)
- allocate(rmemory_dux_dyl_y(1,1,1,1),stat=ier)
- allocate(rmemory_duy_dxl_y(1,1,1,1,2),stat=ier)
- allocate(rmemory_duy_dyl_y(1,1,1,1,2),stat=ier)
- allocate(rmemory_duy_dzl_y(1,1,1,1,2),stat=ier)
- allocate(rmemory_duz_dyl_y(1,1,1,1),stat=ier)
- allocate(rmemory_duz_dzl_y(1,1,1,1),stat=ier)
- allocate(rmemory_dux_dxl_z(1,1,1,1),stat=ier)
- allocate(rmemory_dux_dzl_z(1,1,1,1),stat=ier)
- allocate(rmemory_duy_dyl_z(1,1,1,1),stat=ier)
- allocate(rmemory_duy_dzl_z(1,1,1,1),stat=ier)
- allocate(rmemory_duz_dxl_z(1,1,1,1,2),stat=ier)
- allocate(rmemory_duz_dyl_z(1,1,1,1,2),stat=ier)
- allocate(rmemory_duz_dzl_z(1,1,1,1,2),stat=ier)
- allocate(rmemory_displ_elastic(1,1,1,1,1,3),stat=ier)
- allocate(accel_elastic_CPML(1,1,1,1),stat=ier)
- allocate(PML_dpotential_dxl(1,1,1),stat=ier)
- allocate(PML_dpotential_dyl(1,1,1),stat=ier)
- allocate(PML_dpotential_dzl(1,1,1),stat=ier)
- allocate(PML_dpotential_dxl_new(1,1,1),stat=ier)
- allocate(PML_dpotential_dyl_new(1,1,1),stat=ier)
- allocate(PML_dpotential_dzl_new(1,1,1),stat=ier)
- allocate(rmemory_dpotential_dxl(1,1,1,1,2),stat=ier)
- allocate(rmemory_dpotential_dyl(1,1,1,1,2),stat=ier)
- allocate(rmemory_dpotential_dzl(1,1,1,1,2),stat=ier)
- allocate(rmemory_potential_acoustic(1,1,1,1,3),stat=ier)
- allocate(potential_dot_dot_acoustic_CPML(1,1,1),stat=ier)
- allocate(rmemory_coupling_ac_el_displ(3,1,1,1,1,2),stat=ier)
- allocate(rmemory_coupling_el_ac_potential(1,1,1,1,2),stat=ier)
- ! allocates wavefield
- allocate(b_PML_field(9,1),stat=ier)
- allocate(b_PML_field(9,1),stat=ier)
- allocate(b_PML_field(9,1),stat=ier)
- ! allocates wavefield
- allocate(b_PML_potential(3,1),stat=ier)
- allocate(b_PML_potential(3,1),stat=ier)
- allocate(b_PML_potential(3,1),stat=ier)
-
end subroutine pml_allocate_arrays_dummy
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90 2013-08-06 21:02:17 UTC (rev 22701)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90 2013-08-06 21:50:51 UTC (rev 22702)
@@ -80,10 +80,10 @@
else
call prepare_timerun_pml()
endif
- else
-! dummy allocation with a size of 1 in order to be able to use the array as argument in subroutine calls
- call pml_allocate_arrays_dummy()
endif
+ ! dummy allocation with a size of 1 for all the PML arrays that have not yet been allocated
+ ! in order to be able to use these arrays as arguments in subroutine calls
+ call pml_allocate_arrays_dummy()
! prepares ADJOINT simulations
call prepare_timerun_adjoint()
@@ -751,12 +751,10 @@
stop 'error: the C-PML code works for 8-node bricks only; should be made more general'
! allocates and initializes C-PML arrays
- if( NSPEC_CPML > 0 ) then
- call pml_allocate_arrays()
- else
- ! dummy allocation with a size of 1 in order to be able to use the array as argument in subroutine calls
- call pml_allocate_arrays_dummy()
- endif
+ if( NSPEC_CPML > 0 ) call pml_allocate_arrays()
+ ! dummy allocation with a size of 1 for all the PML arrays that have not yet been allocated
+ ! in order to be able to use these arrays as arguments in subroutine calls
+ call pml_allocate_arrays_dummy()
! defines C-PML spectral elements local indexing
ispec_CPML = 0
More information about the CIG-COMMITS
mailing list