[cig-commits] r22800 - in seismo/3D/SPECFEM3D/trunk: DATA src/specfem3D
lefebvre at geodynamics.org
lefebvre at geodynamics.org
Wed Sep 18 07:35:34 PDT 2013
Author: lefebvre
Date: 2013-09-18 07:35:34 -0700 (Wed, 18 Sep 2013)
New Revision: 22800
Modified:
seismo/3D/SPECFEM3D/trunk/DATA/Par_file
seismo/3D/SPECFEM3D/trunk/src/specfem3D/save_adjoint_kernels.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/save_kernels_adios.F90
Log:
interfaces added for dummy args routines in save_adjoint kernel.
Modified: seismo/3D/SPECFEM3D/trunk/DATA/Par_file
===================================================================
--- seismo/3D/SPECFEM3D/trunk/DATA/Par_file 2013-09-18 14:35:28 UTC (rev 22799)
+++ seismo/3D/SPECFEM3D/trunk/DATA/Par_file 2013-09-18 14:35:34 UTC (rev 22800)
@@ -5,7 +5,7 @@
SIMULATION_TYPE = 3
# 0 = earthquake simulation, 1/2/3 = three steps in noise simulation
NOISE_TOMOGRAPHY = 0
-SAVE_FORWARD = .false.
+SAVE_FORWARD = .true.
# UTM projection parameters
UTM_PROJECTION_ZONE = 11
@@ -15,7 +15,7 @@
NPROC = 4
# time step parameters
-NSTEP = 2000
+NSTEP = 200
DT = 0.03
# number of nodes for 2D and 3D shape functions for hexahedra
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/save_adjoint_kernels.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/save_adjoint_kernels.f90 2013-09-18 14:35:28 UTC (rev 22799)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/save_adjoint_kernels.f90 2013-09-18 14:35:34 UTC (rev 22800)
@@ -40,14 +40,47 @@
!> Save kernels.
subroutine save_adjoint_kernels()
- use specfem_par
- use specfem_par_acoustic
- use specfem_par_elastic
- use specfem_par_poroelastic
+ use constants, only: CUSTOM_REAL, SAVE_TRANSVERSE_KL, ANISOTROPIC_KL, &
+ APPROXIMATE_HESS_KL, NGLLX, NGLLY, NGLLZ
+ use specfem_par, only: LOCAL_PATH, myrank, sigma_kl, NSPEC_AB, &
+ ADIOS_FOR_KERNELS, NOISE_TOMOGRAPHY, NSPEC_ADJOINT
+ use specfem_par_acoustic, only: ACOUSTIC_SIMULATION
+ use specfem_par_elastic, only: ELASTIC_SIMULATION
+ use specfem_par_poroelastic, only: POROELASTIC_SIMULATION
implicit none
+ interface
+ subroutine save_kernels_elastic(adios_handle, alphav_kl, alphah_kl, &
+ betav_kl, betah_kl, eta_kl, &
+ rhop_kl, alpha_kl, beta_kl)
+
+ integer(kind=8) :: adios_handle
+ ! FIXME
+ ! Break the CUSTOM_REAL stuff.
+ ! put all this file in a module so interface is implicit
+ ! OR
+ ! redo what was done before SVN revision 22718
+ !
+ ! see other FIXME below (same than see one)
+ real(kind=4), dimension(:,:,:,:), allocatable :: &
+ alphav_kl,alphah_kl,betav_kl,betah_kl, &
+ eta_kl, rhop_kl, alpha_kl, beta_kl
+ end subroutine save_kernels_elastic
+ end interface
+
+ real(kind=CUSTOM_REAL), dimension(:,:,:,:),allocatable :: alphav_kl, &
+ alphah_kl, &
+ betav_kl, &
+ betah_kl, &
+ eta_kl
+
+ real(kind=CUSTOM_REAL), dimension(:,:,:,:),allocatable :: rhop_kl, &
+ alpha_kl, &
+ beta_kl
+
integer(kind=8) :: adios_handle
+ integer :: ier
! flag to save GLL weights
logical,parameter :: SAVE_WEIGHTS = .false.
@@ -63,7 +96,41 @@
! elastic domains
if( ELASTIC_SIMULATION ) then
- call save_kernels_elastic(adios_handle)
+ ! allocates temporary transversely isotropic kernels
+ if( ANISOTROPIC_KL ) then
+ if( SAVE_TRANSVERSE_KL ) then
+ allocate(alphav_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT), &
+ alphah_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT), &
+ betav_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT), &
+ betah_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT), &
+ eta_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT), &
+ stat=ier)
+ if( ier /=0 ) stop 'error allocating arrays alphav_kl,...'
+
+ ! derived kernels
+ ! vp kernel
+ allocate(alpha_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT),stat=ier)
+ if( ier /= 0 ) stop 'error allocating array alpha_kl'
+ ! vs kernel
+ allocate(beta_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT),stat=ier)
+ if( ier /= 0 ) stop 'error allocating array beta_kl'
+ endif
+ else
+ ! derived kernels
+ ! vp kernel
+ allocate(alpha_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT),stat=ier)
+ if( ier /= 0 ) stop 'error allocating array alpha_kl'
+ ! vs kernel
+ allocate(beta_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT),stat=ier)
+ if( ier /= 0 ) stop 'error allocating array beta_kl'
+ ! density prime kernel
+ allocate(rhop_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT),stat=ier)
+ if( ier /= 0 ) stop 'error allocating array rhop_kl'
+ endif
+
+ call save_kernels_elastic(adios_handle, alphav_kl, alphah_kl, &
+ betav_kl, betah_kl, eta_kl, &
+ rhop_kl, alpha_kl, beta_kl)
endif
if( POROELASTIC_SIMULATION ) then
@@ -90,6 +157,18 @@
call perform_write_adios_kernels(adios_handle)
endif
+ if (ELASTIC_SIMULATION) then
+ ! frees temporary arrays
+ if( ANISOTROPIC_KL ) then
+ if( SAVE_TRANSVERSE_KL ) then
+ deallocate(alphav_kl,alphah_kl,betav_kl,betah_kl,eta_kl)
+ deallocate(alpha_kl,beta_kl)
+ endif
+ else
+ deallocate(rhop_kl,alpha_kl,beta_kl)
+ endif
+ endif
+
end subroutine save_adjoint_kernels
!==============================================================================
@@ -194,14 +273,33 @@
!==============================================================================
!> Save elastic related kernels
-subroutine save_kernels_elastic(adios_handle)
+subroutine save_kernels_elastic(adios_handle, alphav_kl, alphah_kl, &
+ betav_kl, betah_kl, eta_kl, &
+ rhop_kl, alpha_kl, beta_kl)
use specfem_par
use specfem_par_elastic
implicit none
+ interface
+ subroutine save_kernels_elastic_adios(adios_handle, alphav_kl, alphah_kl, &
+ betav_kl, betah_kl, eta_kl, &
+ rhop_kl, alpha_kl, beta_kl)
+
+ integer(kind=8) :: adios_handle
+ ! FIXME
+ ! see other FIXME above.
+ real(kind=4), dimension(:,:,:,:), allocatable :: &
+ alphav_kl,alphah_kl,betav_kl,betah_kl, &
+ eta_kl, rhop_kl, alpha_kl, beta_kl
+ end subroutine save_kernels_elastic_adios
+ end interface
+
integer(kind=8) :: adios_handle
+ real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: &
+ alphav_kl,alphah_kl,betav_kl,betah_kl, &
+ eta_kl, rhop_kl, alpha_kl, beta_kl
! local parameters
integer:: ispec,i,j,k,iglob,ier
@@ -211,43 +309,8 @@
real(kind=CUSTOM_REAL) :: A,N,C,L,F,eta
real(kind=CUSTOM_REAL), dimension(21) :: cijkl_kl_local
real(kind=CUSTOM_REAL), dimension(5) :: an_kl
- real(kind=CUSTOM_REAL), dimension(:,:,:,:),allocatable :: alphav_kl,alphah_kl,betav_kl,betah_kl,eta_kl
- ! temporary isotropic kernels
- real(kind=CUSTOM_REAL), dimension(:,:,:,:),allocatable :: rhop_kl,alpha_kl,beta_kl
- ! allocates temporary transversely isotropic kernels
- if( ANISOTROPIC_KL ) then
- if( SAVE_TRANSVERSE_KL ) then
- allocate(alphav_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT), &
- alphah_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT), &
- betav_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT), &
- betah_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT), &
- eta_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT), &
- stat=ier)
- if( ier /=0 ) stop 'error allocating arrays alphav_kl,...'
-
- ! derived kernels
- ! vp kernel
- allocate(alpha_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT),stat=ier)
- if( ier /= 0 ) stop 'error allocating array alpha_kl'
- ! vs kernel
- allocate(beta_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT),stat=ier)
- if( ier /= 0 ) stop 'error allocating array beta_kl'
- endif
- else
- ! derived kernels
- ! vp kernel
- allocate(alpha_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT),stat=ier)
- if( ier /= 0 ) stop 'error allocating array alpha_kl'
- ! vs kernel
- allocate(beta_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT),stat=ier)
- if( ier /= 0 ) stop 'error allocating array beta_kl'
- ! density prime kernel
- allocate(rhop_kl(NGLLX,NGLLY,NGLLZ,NSPEC_ADJOINT),stat=ier)
- if( ier /= 0 ) stop 'error allocating array rhop_kl'
- endif
-
! finalizes calculation of rhop, beta, alpha kernels
do ispec = 1, NSPEC_AB
@@ -361,7 +424,9 @@
enddo
if (ADIOS_FOR_KERNELS) then
- call save_kernels_elastic_adios(adios_handle)
+ call save_kernels_elastic_adios(adios_handle, alphav_kl, alphah_kl, &
+ betav_kl, betah_kl, eta_kl, &
+ rhop_kl, alpha_kl, beta_kl)
else
if (ANISOTROPIC_KL) then
@@ -449,15 +514,6 @@
endif
endif
- ! frees temporary arrays
- if( ANISOTROPIC_KL ) then
- if( SAVE_TRANSVERSE_KL ) then
- deallocate(alphav_kl,alphah_kl,betav_kl,betah_kl,eta_kl)
- deallocate(alpha_kl,beta_kl)
- endif
- else
- deallocate(rhop_kl,alpha_kl,beta_kl)
- endif
end subroutine save_kernels_elastic
!==============================================================================
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/save_kernels_adios.F90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/save_kernels_adios.F90 2013-09-18 14:35:28 UTC (rev 22799)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/save_kernels_adios.F90 2013-09-18 14:35:34 UTC (rev 22800)
@@ -80,7 +80,7 @@
! Type inference for define_adios_global_array1D. Avoid additional args.
real(kind=CUSTOM_REAL), dimension(1,1,1,1) :: dummy_kernel
- output_name = "OUTPUT_FILES/kernels.bp"
+ output_name = LOCAL_PATH(1:len_trim(LOCAL_PATH))// "/kernels.bp"
group_name = "SPECFEM3D_KERNELS"
call MPI_Comm_dup (MPI_COMM_WORLD, comm, ierr)
@@ -217,7 +217,7 @@
! Open the handle to file containing all the ADIOS variables |
! previously defined |
!------------------------------------------------------------'
- call adios_open (handle, group_name, outputname, "w", comm, adios_err)
+ call adios_open (handle, group_name, output_name, "w", comm, adios_err)
call adios_group_size (handle, groupsize, adios_totalsize, adios_err)
call adios_write(handle, "nspec", NSPEC_AB, ier)
@@ -312,7 +312,7 @@
integer:: local_dim
! Transverse isotropic paramters
- real(kind=CUSTOM_REAL), dimension(:,:,:,:):: &
+ real(kind=CUSTOM_REAL), dimension(:,:,:,:), allocatable :: &
alphav_kl,alphah_kl,betav_kl,betah_kl, &
eta_kl, rhop_kl, alpha_kl, beta_kl
More information about the CIG-COMMITS
mailing list