[cig-commits] r22866 - seismo/2D/SPECFEM2D/trunk/UTILS/Ra_Cleave_record_pressure_in_addition_to_displacement
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Thu Sep 26 15:44:41 PDT 2013
Author: dkomati1
Date: 2013-09-26 15:44:41 -0700 (Thu, 26 Sep 2013)
New Revision: 22866
Added:
seismo/2D/SPECFEM2D/trunk/UTILS/Ra_Cleave_record_pressure_in_addition_to_displacement/email_from_Ra_Cleave_about_multiple_receiver_types_in_SPECFEM2D_to_record_pressure_in_addition_to_displacement_2013.txt
seismo/2D/SPECFEM2D/trunk/UTILS/Ra_Cleave_record_pressure_in_addition_to_displacement/read_parameter_file_Ra_Cleave.F90
seismo/2D/SPECFEM2D/trunk/UTILS/Ra_Cleave_record_pressure_in_addition_to_displacement/save_databases_Ra_Cleave.f90
Log:
added three files in SPECFEM2D/UTILS/Ra_Cleave_record_pressure_in_addition_to_displacement
Added: seismo/2D/SPECFEM2D/trunk/UTILS/Ra_Cleave_record_pressure_in_addition_to_displacement/email_from_Ra_Cleave_about_multiple_receiver_types_in_SPECFEM2D_to_record_pressure_in_addition_to_displacement_2013.txt
===================================================================
--- seismo/2D/SPECFEM2D/trunk/UTILS/Ra_Cleave_record_pressure_in_addition_to_displacement/email_from_Ra_Cleave_about_multiple_receiver_types_in_SPECFEM2D_to_record_pressure_in_addition_to_displacement_2013.txt (rev 0)
+++ seismo/2D/SPECFEM2D/trunk/UTILS/Ra_Cleave_record_pressure_in_addition_to_displacement/email_from_Ra_Cleave_about_multiple_receiver_types_in_SPECFEM2D_to_record_pressure_in_addition_to_displacement_2013.txt 2013-09-26 22:44:41 UTC (rev 22866)
@@ -0,0 +1,51 @@
+
+Subject: Re: [CIG-SEISMO] Multiple receiver types - SpecFEM2D
+From: Ra Cleave / ra AT rippletech.co.nz
+Date: 03/14/2013 02:11 AM
+To: Dimitri Komatitsch
+
+Dimitri,
+
+Here are the routines I have modified. As I mentioned the code now optionally
+records pressure at each receiver. Most changes are preceded by a comment that
+starts with "!RC:". The par_file needs to have the following line:
+
+seismo_p = .true. # Whether pressure should also be recorded
+
+Files:
+SPECFEM2D-7.0.0-RC/src/specfem2D/write_seismograms.F90
+SPECFEM2D-7.0.0-RC/src/specfem2D/specfem2D.F90
+SPECFEM2D-7.0.0-RC/src/specfem2D/read_databases.f90
+
+SPECFEM2D-7.0.0-RC/src/meshfem2D/read_parameter_file.F90
+SPECFEM2D-7.0.0-RC/src/meshfem2D/save_databases.f90
+
+Best regards,
+Ra
+
+-- Ra Cleave RippleTech www.rippletech.co.nz On Fri, 08 Mar 2013 12:34:09 you wrote:
+> > Hello,
+> >
+> > That is a good idea. It is not available in the current version but you
+> > can implement it easily by copying and pasting all the sections that
+> > contain the word "seismogram" in the main program
+> > (src/specfem2D/specfem2D.F90) and using one set of arrays for velocity
+> > seismograms and another one for pressure.
+> >
+> > PS: if you implement that, please email me the new routine and I will
+> > add it to the official source code. It will be very useful.
+> >
+> > Thank you,
+> > Dimitri.
+> >
+> > On 03/08/2013 03:32 AM, Ra Cleave wrote:
+>> > > Hello,
+>> > >
+>> > > Is there any way to having different receiver types in one SpecFEM2D
+>> > > simulation? I am, in this case, interested in velocity and pressure
+>> > > receivers in the same simulation.
+>> > >
+>> > > Thanks in advance,
+>> > > Ra
+>> > >
+
Added: seismo/2D/SPECFEM2D/trunk/UTILS/Ra_Cleave_record_pressure_in_addition_to_displacement/read_parameter_file_Ra_Cleave.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/UTILS/Ra_Cleave_record_pressure_in_addition_to_displacement/read_parameter_file_Ra_Cleave.F90 (rev 0)
+++ seismo/2D/SPECFEM2D/trunk/UTILS/Ra_Cleave_record_pressure_in_addition_to_displacement/read_parameter_file_Ra_Cleave.F90 2013-09-26 22:44:41 UTC (rev 22866)
@@ -0,0 +1,609 @@
+
+!========================================================================
+!
+! S P E C F E M 2 D Version 7 . 0
+! --------------------------------
+!
+! Copyright CNRS, INRIA and University of Pau, France,
+! and Princeton University / California Institute of Technology, USA.
+! Contributors: Dimitri Komatitsch, dimitri DOT komatitsch aT univ-pau DOT fr
+! Nicolas Le Goff, nicolas DOT legoff aT univ-pau DOT fr
+! Roland Martin, roland DOT martin aT univ-pau DOT fr
+! Christina Morency, cmorency aT princeton DOT edu
+!
+! This software is a computer program whose purpose is to solve
+! the two-dimensional viscoelastic anisotropic or poroelastic wave equation
+! using a spectral-element method (SEM).
+!
+! This software is governed by the CeCILL license under French law and
+! abiding by the rules of distribution of free software. You can use,
+! modify and/or redistribute the software under the terms of the CeCILL
+! license as circulated by CEA, CNRS and INRIA at the following URL
+! "http://www.cecill.info".
+!
+! As a counterpart to the access to the source code and rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors have only limited
+! liability.
+!
+! In this respect, the user's attention is drawn to the risks associated
+! with loading, using, modifying and/or developing or reproducing the
+! software by the user in light of its specific status of free software,
+! that may mean that it is complicated to manipulate, and that also
+! therefore means that it is reserved for developers and experienced
+! professionals having in-depth computer knowledge. Users are therefore
+! encouraged to load and test the software's suitability as regards their
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and, more generally, to use and operate it in the
+! same conditions as regards security.
+!
+! The full text of the license is available in file "LICENSE".
+!
+!========================================================================
+
+module parameter_file
+
+ ! note: we use this module definition only to be able to allocate
+ ! arrays for receiverlines and materials in this subroutine rather than in the main
+ ! routine in meshfem2D.F90
+
+ ! note 2: the filename ending is .F90 to have pre-compilation with pragmas
+ ! (like #ifndef USE_MPI) working properly
+
+ implicit none
+ character(len=100) :: interfacesfile,title
+
+ integer :: SIMULATION_TYPE, NOISE_TOMOGRAPHY
+ logical :: SAVE_FORWARD,read_external_mesh
+
+ character(len=256) :: mesh_file, nodes_coords_file, materials_file, &
+ free_surface_file, absorbing_surface_file,&
+ CPML_element_file
+ character(len=256) :: tangential_detection_curve_file
+
+ ! variables used for partitioning
+ integer :: nproc,partitioning_method
+
+ double precision :: xmin,xmax
+ integer :: nx,ngnod
+
+ logical :: initialfield,add_Bielak_conditions,assign_external_model, &
+ READ_EXTERNAL_SEP_FILE,ATTENUATION_VISCOELASTIC_SOLID,ATTENUATION_PORO_FLUID_PART, &
+ save_ASCII_seismograms,save_binary_seismograms_single,save_binary_seismograms_double,DRAW_SOURCES_AND_RECEIVERS
+
+ double precision :: Q0,freq0
+
+ logical :: p_sv
+ logical :: any_abs,absbottom,absright,abstop,absleft
+ logical :: ADD_SPRING_TO_STACEY
+
+ integer :: nt
+ double precision :: deltat
+
+ integer :: NSOURCES
+ logical :: force_normal_to_surface
+
+ ! variables used for attenuation
+ integer :: N_SLS
+ double precision :: f0_attenuation
+
+ integer :: seismotype
+ logical :: seismo_p
+ logical :: generate_STATIONS
+
+ integer :: nreceiversets
+ double precision :: anglerec
+ logical :: rec_normal_to_surface
+
+ integer, dimension(:), pointer :: nrec
+ double precision, dimension(:), pointer :: xdeb,zdeb,xfin,zfin
+ logical, dimension(:), pointer :: enreg_surf_same_vertical
+
+ integer :: NSTEP_BETWEEN_OUTPUT_INFO,NSTEP_BETWEEN_OUTPUT_SEISMOS,NSTEP_BETWEEN_OUTPUT_IMAGES,NSTEP_BETWEEN_OUTPUT_WAVE_DUMPS, &
+ subsamp_seismos,imagetype_JPEG,imagetype_wavefield_dumps,NELEM_PML_THICKNESS
+ logical :: output_postscript_snapshot,output_color_image,PML_BOUNDARY_CONDITIONS
+ integer :: imagetype_postscript
+ double precision :: cutsnaps
+ logical :: meshvect,modelvect,boundvect,interpol
+ integer :: pointsdisp,subsamp_postscript
+ double precision :: sizemax_arrows
+ logical :: output_grid_Gnuplot,output_grid_ASCII,output_energy,output_wavefield_dumps,use_binary_for_wavefield_dumps
+ logical :: plot_lowerleft_corner_only
+
+ ! to store density and velocity model
+ integer :: nb_materials
+ integer, dimension(:),pointer :: icodemat
+ double precision, dimension(:),pointer :: rho_s,cp,cs, &
+ aniso3,aniso4,aniso5,aniso6,aniso7,aniso8,QKappa,Qmu
+ double precision, dimension(:),pointer :: rho_f,phi,tortuosity,permxx,permxz,&
+ permzz,kappa_s,kappa_f,kappa_fr,eta_f,mu_fr
+
+! factor to subsample color images output by the code (useful for very large models)
+ integer :: factor_subsample_image
+
+! use snapshot number in the file name of JPG color snapshots instead of the time step
+ logical :: USE_SNAPSHOT_NUMBER_IN_FILENAME
+
+! display acoustic layers as constant blue, because they likely correspond to water in the case of ocean acoustics
+! or in the case of offshore oil industry experiments.
+! (if off, display them as greyscale, as for elastic or poroelastic elements)
+ logical :: DRAW_WATER_IN_BLUE
+
+! US letter paper or European A4
+ logical :: US_LETTER
+
+! non linear display to enhance small amplitudes in color images
+ double precision :: POWER_DISPLAY_COLOR
+
+! perform inverse Cuthill-McKee (1969) permutation for mesh numbering
+ logical :: PERFORM_CUTHILL_MCKEE
+
+! output seismograms in Seismic Unix format (adjoint traces will be read in the same format)
+ logical :: SU_FORMAT
+
+! use this t0 as earliest starting time rather than the automatically calculated one
+! (must be positive and bigger than the automatically one to be effective;
+! simulation will start at t = - t0)
+ double precision :: USER_T0
+
+! value of time_stepping_scheme to decide which time scheme will be used
+! # 1 = Newmark (2nd order), 2 = LDDRK4-6 (4th-order 6-stage low storage Runge-Kutta)
+! 3 = classical 4th-order 4-stage Runge-Kutta
+ integer :: time_stepping_scheme
+
+!! DK DK for horizontal periodic conditions: detect common points between left and right edges
+ logical :: ADD_PERIODIC_CONDITIONS
+
+!! DK DK horizontal periodicity distance for periodic conditions
+ double precision :: PERIODIC_horiz_dist
+
+!! DK DK grid point detection tolerance for periodic conditions
+ double precision :: PERIODIC_DETECT_TOL
+
+contains
+
+ subroutine read_parameter_file()
+
+! reads in DATA/Par_file
+
+ implicit none
+ include "constants.h"
+
+ ! local parameters
+ integer :: ios,ireceiverlines
+ integer,external :: err_occurred
+
+ ! read file names and path for output
+ call read_value_string_p(title, 'solver.title')
+ if(err_occurred() /= 0) stop 'error reading parameter 1 in Par_file'
+
+ write(*,*) 'Title of the simulation'
+ write(*,*) title
+ print *
+
+ ! read type of simulation
+ call read_value_integer_p(SIMULATION_TYPE, 'solver.SIMULATION_TYPE')
+ if(err_occurred() /= 0) stop 'error reading parameter 2 in Par_file'
+
+ call read_value_integer_p(NOISE_TOMOGRAPHY, 'solver.NOISE_TOMOGRAPHY')
+ if(err_occurred() /= 0) stop 'error reading parameter NOISE_TOMOGRAPHY in Par_file'
+
+ call read_value_logical_p(SAVE_FORWARD, 'solver.SAVE_FORWARD')
+ if(err_occurred() /= 0) stop 'error reading parameter 3 in Par_file'
+
+ ! read info about partitioning
+ call read_value_integer_p(nproc, 'solver.nproc')
+ if(err_occurred() /= 0) stop 'error reading parameter 4 in Par_file'
+
+ call read_value_integer_p(partitioning_method, 'mesher.partitioning_method')
+ if(err_occurred() /= 0) stop 'error reading parameter 5a in Par_file'
+
+ call read_value_logical_p(PERFORM_CUTHILL_MCKEE, 'mesher.PERFORM_CUTHILL_MCKEE')
+ if(err_occurred() /= 0) stop 'error reading parameter 5b in Par_file'
+
+ call read_value_integer_p(ngnod, 'mesher.ngnod')
+ if(err_occurred() /= 0) stop 'error reading parameter 6 in Par_file'
+
+ call read_value_logical_p(initialfield, 'solver.initialfield')
+ if(err_occurred() /= 0) stop 'error reading parameter 7 in Par_file'
+
+ call read_value_logical_p(add_Bielak_conditions, 'solver.add_Bielak_conditions')
+ if(err_occurred() /= 0) stop 'error reading parameter 8 in Par_file'
+
+ call read_value_logical_p(assign_external_model, 'mesher.assign_external_model')
+ if(err_occurred() /= 0) stop 'error reading parameter 9 in Par_file'
+
+ call read_value_logical_p(READ_EXTERNAL_SEP_FILE, 'mesher.READ_EXTERNAL_SEP_FILE')
+ if(err_occurred() /= 0) stop 'error reading parameter 10 in Par_file'
+
+ call read_value_logical_p(ATTENUATION_VISCOELASTIC_SOLID, 'solver.ATTENUATION_VISCOELASTIC_SOLID')
+ if(err_occurred() /= 0) stop 'error reading parameter 11 in Par_file'
+
+ ! read viscous attenuation parameters (poroelastic media)
+ call read_value_logical_p(ATTENUATION_PORO_FLUID_PART, 'solver.ATTENUATION_PORO_FLUID_PART')
+ if(err_occurred() /= 0) stop 'error reading parameter 12a in Par_file'
+
+ call read_value_double_precision_p(Q0, 'solver.Q0')
+ if(err_occurred() /= 0) stop 'error reading parameter 13 in Par_file'
+
+ call read_value_double_precision_p(freq0, 'solver.freq0')
+ if(err_occurred() /= 0) stop 'error reading parameter 14 in Par_file'
+
+ ! determine if body or surface (membrane) waves calculation
+ call read_value_logical_p(p_sv, 'solver.p_sv')
+ if(err_occurred() /= 0) stop 'error reading parameter 15 in Par_file'
+
+ ! read time step parameters
+ call read_value_integer_p(nt, 'solver.nt')
+ if(err_occurred() /= 0) stop 'error reading parameter 16 in Par_file'
+
+ call read_value_double_precision_p(deltat, 'solver.deltat')
+ if(err_occurred() /= 0) stop 'error reading parameter 17a in Par_file'
+
+ call read_value_double_precision_p(USER_T0, 'solver.USER_T0')
+ if(err_occurred() /= 0) stop 'error reading parameter 17b in Par_file'
+
+ call read_value_integer_p(time_stepping_scheme, 'solver.time_stepping_scheme')
+ if(err_occurred() /= 0) stop 'error reading parameter 17c in Par_file'
+
+ ! read source infos
+ call read_value_integer_p(NSOURCES, 'solver.NSOURCES')
+ if(err_occurred() /= 0) stop 'error reading parameter 18 in Par_file'
+
+ call read_value_logical_p(force_normal_to_surface, 'solver.force_normal_to_surface')
+ if(err_occurred() /= 0) stop 'error reading parameter 19 in Par_file'
+
+ ! read constants for attenuation
+ call read_value_integer_p(N_SLS, 'solver.N_SLS')
+ if(err_occurred() /= 0) stop 'error reading parameter 20 in Par_file'
+ if(N_SLS < 1) stop 'must have N_SLS >= 1 even if attenuation if off because it is used to assign some arrays'
+
+ call read_value_double_precision_p(f0_attenuation, 'solver.f0_attenuation')
+ if(err_occurred() /= 0) stop 'error reading parameter 21 in Par_file'
+
+ ! read receiver line parameters
+ call read_value_integer_p(seismotype, 'solver.seismotype')
+ if(err_occurred() /= 0) stop 'error reading parameter 22 in Par_file'
+
+ !RC: Read whether pressure is also recorded at each receiver. Note that
+ !this will fail for "old" parameter files that don't have seismo_p.
+ call read_value_logical_p(seismo_p, 'solver.seismo_p')
+ if(err_occurred() /= 0) stop 'error reading parameter 22b in Par_file'
+
+ call read_value_integer_p(NSTEP_BETWEEN_OUTPUT_SEISMOS, 'solver.NSTEP_BETWEEN_OUTPUT_SEISMOS')
+ if(err_occurred() /= 0) stop 'error reading parameter 33b in Par_file'
+
+ call read_value_logical_p(save_ASCII_seismograms, 'solver.save_ASCII_seismograms')
+ if(err_occurred() /= 0) stop 'error reading parameter 12b in Par_file'
+
+ call read_value_logical_p(save_binary_seismograms_single, 'solver.save_binary_seismograms_single')
+ if(err_occurred() /= 0) stop 'error reading parameter 12c in Par_file'
+
+ call read_value_logical_p(save_binary_seismograms_double, 'solver.save_binary_seismograms_double')
+ if(err_occurred() /= 0) stop 'error reading parameter 12cc in Par_file'
+
+ call read_value_logical_p(SU_FORMAT, 'solver.SU_FORMAT')
+ if(err_occurred() /= 0) stop 'error reading parameter 26b in Par_file'
+
+ call read_value_integer_p(subsamp_seismos, 'solver.subsamp_seismos')
+ if(err_occurred() /= 0) stop 'error reading parameter 33e in Par_file'
+ if(subsamp_seismos < 1) stop 'error: subsamp_seismos must be >= 1'
+
+ call read_value_logical_p(generate_STATIONS, 'solver.generate_STATIONS')
+ if(err_occurred() /= 0) stop 'error reading parameter 23 in Par_file'
+
+ call read_value_integer_p(nreceiversets, 'solver.nreceiversets')
+ if(err_occurred() /= 0) stop 'error reading parameter 24 in Par_file'
+
+ call read_value_double_precision_p(anglerec, 'solver.anglerec')
+ if(err_occurred() /= 0) stop 'error reading parameter 25 in Par_file'
+
+ call read_value_logical_p(rec_normal_to_surface, 'solver.rec_normal_to_surface')
+ if(err_occurred() /= 0) stop 'error reading parameter 26a in Par_file'
+
+ if(nreceiversets < 1) stop 'number of receiver lines must be greater than 1'
+
+ ! allocate receiver line arrays
+ allocate(nrec(nreceiversets))
+ allocate(xdeb(nreceiversets))
+ allocate(zdeb(nreceiversets))
+ allocate(xfin(nreceiversets))
+ allocate(zfin(nreceiversets))
+ allocate(enreg_surf_same_vertical(nreceiversets),stat=ios)
+ if( ios /= 0 ) stop 'error allocating receiver lines'
+
+ ! loop on all the receiver lines
+ do ireceiverlines = 1,nreceiversets
+ call read_value_integer_next_p(nrec(ireceiverlines),'solver.nrec')
+ if(err_occurred() /= 0) stop 'error reading parameter 27 in Par_file'
+
+ call read_value_double_prec_next_p(xdeb(ireceiverlines),'solver.xdeb')
+ if(err_occurred() /= 0) stop 'error reading parameter 28 in Par_file'
+
+ call read_value_double_prec_next_p(zdeb(ireceiverlines),'solver.zdeb')
+ if(err_occurred() /= 0) stop 'error reading parameter 29 in Par_file'
+
+ call read_value_double_prec_next_p(xfin(ireceiverlines),'solver.xfin')
+ if(err_occurred() /= 0) stop 'error reading parameter 30 in Par_file'
+
+ call read_value_double_prec_next_p(zfin(ireceiverlines),'solver.zfin')
+ if(err_occurred() /= 0) stop 'error reading parameter 31 in Par_file'
+
+ call read_value_logical_next_p(enreg_surf_same_vertical(ireceiverlines),'solver.enreg_surf_same_vertical')
+ if(err_occurred() /= 0) stop 'error reading parameter 32 in Par_file'
+
+ if (read_external_mesh .and. enreg_surf_same_vertical(ireceiverlines)) then
+ stop 'Cannot use enreg_surf_same_vertical with external meshes!'
+ endif
+ enddo
+
+ ! read display parameters
+ call read_value_integer_p(NSTEP_BETWEEN_OUTPUT_INFO, 'solver.NSTEP_BETWEEN_OUTPUT_INFO')
+ if(err_occurred() /= 0) stop 'error reading parameter 33a in Par_file'
+
+ call read_value_integer_p(NSTEP_BETWEEN_OUTPUT_IMAGES, 'solver.NSTEP_BETWEEN_OUTPUT_IMAGES')
+ if(err_occurred() /= 0) stop 'error reading parameter 33c in Par_file'
+
+ call read_value_double_precision_p(cutsnaps, 'solver.cutsnaps')
+ if(err_occurred() /= 0) stop 'error reading parameter 37 in Par_file'
+
+ call read_value_logical_p(output_color_image, 'solver.output_color_image')
+ if(err_occurred() /= 0) stop 'error reading parameter 35 in Par_file'
+
+ call read_value_integer_p(imagetype_JPEG, 'solver.imagetype_JPEG')
+ if(err_occurred() /= 0) stop 'error reading parameter 33f in Par_file'
+
+ call read_value_integer_p(factor_subsample_image, 'solver.factor_subsample_image')
+ if(err_occurred() /= 0) stop 'error reading parameter 43b in Par_file'
+
+ call read_value_double_precision_p(POWER_DISPLAY_COLOR, 'solver.POWER_DISPLAY_COLOR')
+ if(err_occurred() /= 0) stop 'error reading parameter 43c in Par_file'
+
+ call read_value_logical_p(DRAW_SOURCES_AND_RECEIVERS, 'solver.DRAW_SOURCES_AND_RECEIVERS')
+ if(err_occurred() /= 0) stop 'error reading parameter 12d in Par_file'
+
+ call read_value_logical_p(DRAW_WATER_IN_BLUE, 'solver.DRAW_WATER_IN_BLUE')
+ if(err_occurred() /= 0) stop 'error reading parameter 43d in Par_file'
+
+ call read_value_logical_p(USE_SNAPSHOT_NUMBER_IN_FILENAME, 'solver.USE_SNAPSHOT_NUMBER_IN_FILENAME')
+ if(err_occurred() /= 0) stop 'error reading parameter 44c in Par_file'
+
+ call read_value_logical_p(output_postscript_snapshot, 'solver.output_postscript_snapshot')
+ if(err_occurred() /= 0) stop 'error reading parameter 34 in Par_file'
+
+ call read_value_integer_p(imagetype_postscript, 'solver.imagetype_postscript')
+ if(err_occurred() /= 0) stop 'error reading parameter 36 in Par_file'
+
+ call read_value_logical_p(meshvect, 'solver.meshvect')
+ if(err_occurred() /= 0) stop 'error reading parameter 38 in Par_file'
+
+ call read_value_logical_p(modelvect, 'solver.modelvect')
+ if(err_occurred() /= 0) stop 'error reading parameter 39 in Par_file'
+
+ call read_value_logical_p(boundvect, 'solver.boundvect')
+ if(err_occurred() /= 0) stop 'error reading parameter 40 in Par_file'
+
+ call read_value_logical_p(interpol, 'solver.interpol')
+ if(err_occurred() /= 0) stop 'error reading parameter 41 in Par_file'
+
+ call read_value_integer_p(pointsdisp, 'solver.pointsdisp')
+ if(err_occurred() /= 0) stop 'error reading parameter 42 in Par_file'
+
+ call read_value_integer_p(subsamp_postscript, 'solver.subsamp_postscript')
+ if(err_occurred() /= 0) stop 'error reading parameter 43a in Par_file'
+
+ call read_value_double_precision_p(sizemax_arrows, 'solver.sizemax_arrows')
+ if(err_occurred() /= 0) stop 'error reading parameter 44a in Par_file'
+
+ call read_value_logical_p(US_LETTER, 'solver.US_LETTER')
+ if(err_occurred() /= 0) stop 'error reading parameter 44b in Par_file'
+
+ call read_value_integer_p(NSTEP_BETWEEN_OUTPUT_WAVE_DUMPS, 'solver.NSTEP_BETWEEN_OUTPUT_WAVE_DUMPS')
+ if(err_occurred() /= 0) stop 'error reading parameter 33d in Par_file'
+
+ call read_value_logical_p(output_wavefield_dumps, 'solver.output_wavefield_dumps')
+ if(err_occurred() /= 0) stop 'error reading parameter 48 in Par_file'
+
+ call read_value_integer_p(imagetype_wavefield_dumps, 'solver.imagetype_wavefield_dumps')
+ if(err_occurred() /= 0) stop 'error reading parameter 33g in Par_file'
+
+ call read_value_logical_p(use_binary_for_wavefield_dumps, 'solver.use_binary_for_wavefield_dumps')
+ if(err_occurred() /= 0) stop 'error reading parameter 48 in Par_file'
+
+ call read_value_logical_p(output_grid_Gnuplot, 'solver.output_grid_Gnuplot')
+ if(err_occurred() /= 0) stop 'error reading parameter 45 in Par_file'
+
+ call read_value_logical_p(output_grid_ASCII, 'solver.output_grid_ASCII')
+ if(err_occurred() /= 0) stop 'error reading parameter 46 in Par_file'
+
+ call read_value_logical_p(output_energy, 'solver.output_energy')
+ if(err_occurred() /= 0) stop 'error reading parameter 47 in Par_file'
+
+ ! read the different material materials
+ call read_value_integer_p(nb_materials, 'mesher.nbmodels')
+ if(err_occurred() /= 0) stop 'error reading parameter 49 in Par_file'
+
+ if(nb_materials <= 0) stop 'Non-positive number of materials not allowed!'
+
+ allocate(icodemat(nb_materials))
+ allocate(cp(nb_materials))
+ allocate(cs(nb_materials))
+ allocate(aniso3(nb_materials))
+ allocate(aniso4(nb_materials))
+ allocate(aniso5(nb_materials))
+ allocate(aniso6(nb_materials))
+ allocate(aniso7(nb_materials))
+ allocate(aniso8(nb_materials))
+ allocate(QKappa(nb_materials))
+ allocate(Qmu(nb_materials))
+ allocate(rho_s(nb_materials))
+ allocate(rho_f(nb_materials))
+ allocate(phi(nb_materials))
+ allocate(tortuosity(nb_materials))
+ allocate(permxx(nb_materials))
+ allocate(permxz(nb_materials))
+ allocate(permzz(nb_materials))
+ allocate(kappa_s(nb_materials))
+ allocate(kappa_f(nb_materials))
+ allocate(kappa_fr(nb_materials))
+ allocate(eta_f(nb_materials))
+ allocate(mu_fr(nb_materials))
+
+ call read_materials(nb_materials,icodemat,cp,cs, &
+ aniso3,aniso4,aniso5,aniso6,aniso7,aniso8, &
+ QKappa,Qmu,rho_s,rho_f,phi,tortuosity, &
+ permxx,permxz,permzz,kappa_s,kappa_f,kappa_fr, &
+ eta_f,mu_fr)
+
+ ! boolean defining whether internal or external mesh
+ call read_value_logical_p(read_external_mesh, 'mesher.read_external_mesh')
+ if(err_occurred() /= 0) stop 'error reading parameter 50 in Par_file'
+
+ call read_value_logical_p(PML_BOUNDARY_CONDITIONS, 'solver.PML_BOUNDARY_CONDITIONS')
+ if(err_occurred() /= 0) stop 'error reading parameter 33za in Par_file'
+
+ call read_value_integer_p(NELEM_PML_THICKNESS, 'solver.NELEM_PML_THICKNESS')
+ if(err_occurred() /= 0) stop 'error reading parameter 33zb in Par_file'
+
+ ! boolean defining whether to use any absorbing boundaries
+ call read_value_logical_p(any_abs, 'solver.STACEY_ABSORBING_CONDITIONS')
+ if(err_occurred() /= 0) stop 'error reading parameter 51a in Par_file'
+
+ if(add_Bielak_conditions .and. .not. any_abs) &
+ stop 'need STACEY_ABSORBING_CONDITIONS set to .true. in order to use add_Bielak_conditions'
+
+ ! solve the conflict in value of PML_BOUNDARY_CONDITIONS and STACEY_ABSORBING_CONDITIONS
+ if(PML_BOUNDARY_CONDITIONS) any_abs = .true.
+
+ call read_value_logical_p(ADD_SPRING_TO_STACEY, 'solver.ADD_SPRING_TO_STACEY')
+ if(err_occurred() /= 0) stop 'error reading parameter 51a in Par_file'
+
+ if(add_Bielak_conditions .or. initialfield ) ADD_SPRING_TO_STACEY = .false.
+
+ call read_value_logical_p(ADD_PERIODIC_CONDITIONS, 'solver.ADD_PERIODIC_CONDITIONS')
+ if(err_occurred() /= 0) stop 'error reading parameter 51b in Par_file'
+
+ call read_value_double_precision_p(PERIODIC_horiz_dist, 'solver.PERIODIC_horiz_dist')
+ if(err_occurred() /= 0) stop 'error reading parameter 51c in Par_file'
+
+ call read_value_double_precision_p(PERIODIC_DETECT_TOL, 'solver.PERIODIC_DETECT_TOL')
+ if(err_occurred() /= 0) stop 'error reading parameter 51d in Par_file'
+
+ !-----------------
+ ! external mesh parameters
+
+ if( read_external_mesh ) then
+
+ ! read info about external mesh
+ call read_value_string_p(mesh_file, 'mesher.mesh_file')
+ if(err_occurred() /= 0) stop 'error reading parameter 52 in Par_file'
+
+ call read_value_string_p(nodes_coords_file, 'mesher.nodes_coords_file')
+ if(err_occurred() /= 0) stop 'error reading parameter 53 in Par_file'
+
+ call read_value_string_p(materials_file, 'mesher.materials_file')
+ if(err_occurred() /= 0) stop 'error reading parameter 54 in Par_file'
+
+ call read_value_string_p(free_surface_file, 'mesher.free_surface_file')
+ if(err_occurred() /= 0) stop 'error reading parameter 55 in Par_file'
+
+ call read_value_string_p(absorbing_surface_file, 'mesher.absorbing_surface_file')
+ if(err_occurred() /= 0) stop 'error reading parameter 56 in Par_file'
+
+ call read_value_string_p(CPML_element_file, 'mesher.CPML_element_file')
+ if(err_occurred() /= 0) stop 'error reading parameter 56 in Par_file'
+
+ call read_value_string_p(tangential_detection_curve_file, 'mesher.tangential_detection_curve_file')
+ if(err_occurred() /= 0) stop 'error reading parameter 57 in Par_file'
+
+ else
+
+ !-----------------
+ ! internal mesh parameters
+
+ ! interfaces file
+ call read_value_string_p(interfacesfile, 'mesher.interfacesfile')
+ if(err_occurred() /= 0) stop 'error reading parameter 58 in Par_file'
+
+ ! read grid parameters
+ call read_value_double_precision_p(xmin, 'mesher.xmin')
+ if(err_occurred() /= 0) stop 'error reading parameter 59 in Par_file'
+
+ call read_value_double_precision_p(xmax, 'mesher.xmax')
+ if(err_occurred() /= 0) stop 'error reading parameter 60 in Par_file'
+
+ call read_value_integer_p(nx, 'mesher.nx')
+ if(err_occurred() /= 0) stop 'error reading parameter 61 in Par_file'
+
+ ! read absorbing boundary parameters
+ call read_value_logical_p(absbottom, 'solver.absorbbottom')
+ if(err_occurred() /= 0) stop 'error reading parameter 62 in Par_file'
+
+ call read_value_logical_p(absright, 'solver.absorbright')
+ if(err_occurred() /= 0) stop 'error reading parameter 63 in Par_file'
+
+ call read_value_logical_p(abstop, 'solver.absorbtop')
+ if(err_occurred() /= 0) stop 'error reading parameter 64 in Par_file'
+
+ call read_value_logical_p(absleft, 'solver.absorbleft')
+ if(err_occurred() /= 0) stop 'error reading parameter 65 in Par_file'
+
+ ! note: if internal mesh, then regions will be read in by read_regions (from meshfem2D)
+
+ endif
+
+ ! checks input parameters
+ call check_parameters()
+
+ end subroutine read_parameter_file
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine check_parameters()
+
+ implicit none
+
+ ! checks partitioning
+ if ( nproc <= 0 ) then
+ print *, 'Number of processes (nproc) must be greater than or equal to one.'
+ stop
+ endif
+
+#ifndef USE_MPI
+ if ( nproc > 1 ) then
+ print *, 'Number of processes (nproc) must be equal to one when not using MPI.'
+ print *, 'Please recompile with -DUSE_MPI in order to enable use of MPI.'
+ stop
+ endif
+#endif
+
+ if(partitioning_method /= 1 .and. partitioning_method /= 3) then
+ print *, 'Invalid partitioning method number.'
+ print *, 'Partitioning method ',partitioning_method,' was requested, but is not available.'
+ print *, 'Support for the METIS graph partitioner has been discontinued, please use SCOTCH (option 3) instead.'
+ stop
+ endif
+
+ ! checks absorbing boundaries
+ if ( .not. any_abs ) then
+ absbottom = .false.
+ absright = .false.
+ abstop = .false.
+ absleft = .false.
+ endif
+
+ ! can use only one point to display lower-left corner only for interpolated snapshot
+ if(pointsdisp < 3) then
+ pointsdisp = 3
+ plot_lowerleft_corner_only = .true.
+ else
+ plot_lowerleft_corner_only = .false.
+ endif
+
+ end subroutine check_parameters
+
+end module parameter_file
+
Added: seismo/2D/SPECFEM2D/trunk/UTILS/Ra_Cleave_record_pressure_in_addition_to_displacement/save_databases_Ra_Cleave.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/UTILS/Ra_Cleave_record_pressure_in_addition_to_displacement/save_databases_Ra_Cleave.f90 (rev 0)
+++ seismo/2D/SPECFEM2D/trunk/UTILS/Ra_Cleave_record_pressure_in_addition_to_displacement/save_databases_Ra_Cleave.f90 2013-09-26 22:44:41 UTC (rev 22866)
@@ -0,0 +1,341 @@
+
+!========================================================================
+!
+! S P E C F E M 2 D Version 7 . 0
+! --------------------------------
+!
+! Copyright CNRS, INRIA and University of Pau, France,
+! and Princeton University / California Institute of Technology, USA.
+! Contributors: Dimitri Komatitsch, dimitri DOT komatitsch aT univ-pau DOT fr
+! Nicolas Le Goff, nicolas DOT legoff aT univ-pau DOT fr
+! Roland Martin, roland DOT martin aT univ-pau DOT fr
+! Christina Morency, cmorency aT princeton DOT edu
+!
+! This software is a computer program whose purpose is to solve
+! the two-dimensional viscoelastic anisotropic or poroelastic wave equation
+! using a spectral-element method (SEM).
+!
+! This software is governed by the CeCILL license under French law and
+! abiding by the rules of distribution of free software. You can use,
+! modify and/or redistribute the software under the terms of the CeCILL
+! license as circulated by CEA, CNRS and INRIA at the following URL
+! "http://www.cecill.info".
+!
+! As a counterpart to the access to the source code and rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty and the software's author, the holder of the
+! economic rights, and the successive licensors have only limited
+! liability.
+!
+! In this respect, the user's attention is drawn to the risks associated
+! with loading, using, modifying and/or developing or reproducing the
+! software by the user in light of its specific status of free software,
+! that may mean that it is complicated to manipulate, and that also
+! therefore means that it is reserved for developers and experienced
+! professionals having in-depth computer knowledge. Users are therefore
+! encouraged to load and test the software's suitability as regards their
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and, more generally, to use and operate it in the
+! same conditions as regards security.
+!
+! The full text of the license is available in file "LICENSE".
+!
+!========================================================================
+
+
+ subroutine save_databases(nspec,num_material,region_pml_external_mesh, &
+ my_interfaces,my_nb_interfaces, &
+ nnodes_tangential_curve,nodes_tangential_curve )
+
+
+! generates the databases for the solver
+
+ use part_unstruct
+ use parameter_file
+ use source_file
+ implicit none
+ include "constants.h"
+
+ integer :: nspec
+ integer, dimension(nelmnts) :: num_material
+ integer, dimension(nelmnts) :: region_pml_external_mesh
+
+ integer, dimension(0:ninterfaces-1) :: my_interfaces
+ integer, dimension(0:ninterfaces-1) :: my_nb_interfaces
+
+ integer :: nnodes_tangential_curve
+ double precision, dimension(2,nnodes_tangential_curve) :: nodes_tangential_curve
+
+ ! local parameters
+ integer :: iproc,i_source,i,ios
+ integer :: npgeo
+ integer :: my_ninterface
+ integer :: nedges_coupled_loc
+ integer :: nedges_acporo_coupled_loc
+ integer :: nedges_elporo_coupled_loc
+
+ character(len=256) :: prname
+
+
+ do iproc = 0, nproc-1
+
+ ! opens Database file
+ write(prname, "('./OUTPUT_FILES/Database',i5.5)") iproc
+ open(unit=15,file=trim(prname),status='unknown',iostat=ios)
+ if( ios /= 0 ) stop 'error saving databases; check that directory OUTPUT_FILES exists'
+
+ write(15,*) '#'
+ write(15,*) '# Database for SPECFEM2D'
+ write(15,*) '# Dimitri Komatitsch, (c) University of Pau, France'
+ write(15,*) '#'
+
+ write(15,*) 'Title of the simulation'
+ write(15,"(a100)") title
+
+ write(15,*) 'Type of simulation'
+ write(15,*) SIMULATION_TYPE, NOISE_TOMOGRAPHY, SAVE_FORWARD
+
+ call write_glob2loc_nodes_database(15, iproc, npgeo, 1)
+
+! DK DK add support for using pml in mpi mode with external mesh
+! call write_partition_database(15, iproc, nspec, num_material, ngnod, 1)
+ call write_partition_database(15, iproc, nspec, num_material, region_pml_external_mesh, ngnod, 1)
+
+ write(15,*) 'npgeo nproc'
+ write(15,*) npgeo,nproc
+
+ write(15,*) 'output_grid_Gnuplot interpol'
+ write(15,*) output_grid_Gnuplot,interpol
+
+ write(15,*) 'NSTEP_BETWEEN_OUTPUT_INFO'
+ write(15,*) NSTEP_BETWEEN_OUTPUT_INFO
+
+ write(15,*) 'NSTEP_BETWEEN_OUTPUT_SEISMOS'
+ write(15,*) NSTEP_BETWEEN_OUTPUT_SEISMOS
+
+ write(15,*) 'NSTEP_BETWEEN_OUTPUT_IMAGES'
+ write(15,*) NSTEP_BETWEEN_OUTPUT_IMAGES
+
+ write(15,*) 'PML_BOUNDARY_CONDITIONS'
+ write(15,*) PML_BOUNDARY_CONDITIONS
+
+ write(15,*) 'read_external_mesh'
+ write(15,*) read_external_mesh
+
+ write(15,*) 'NELEM_PML_THICKNESS'
+ write(15,*) NELEM_PML_THICKNESS
+
+ write(15,*) 'NSTEP_BETWEEN_OUTPUT_WAVE_DUMPS'
+ write(15,*) NSTEP_BETWEEN_OUTPUT_WAVE_DUMPS
+
+ write(15,*) 'subsamp_seismos imagetype_JPEG imagetype_wavefield_dumps'
+ write(15,*) subsamp_seismos,imagetype_JPEG,imagetype_wavefield_dumps
+
+ write(15,*) 'output_postscript_snapshot output_color_image colors numbers'
+ write(15,*) output_postscript_snapshot,output_color_image,' 1 0'
+
+ write(15,*) 'meshvect modelvect boundvect cutsnaps subsamp_postscript sizemax_arrows'
+ write(15,*) meshvect,modelvect,boundvect,cutsnaps,subsamp_postscript,sizemax_arrows
+
+ write(15,*) 'anglerec'
+ write(15,*) anglerec
+
+ write(15,*) 'initialfield add_Bielak_conditions'
+ write(15,*) initialfield,add_Bielak_conditions
+
+ write(15,*) 'seismotype seismo_p imagetype_postscript'
+ write(15,*) seismotype,seismo_p,imagetype_postscript
+
+ write(15,*) 'assign_external_model READ_EXTERNAL_SEP_FILE'
+ write(15,*) assign_external_model,READ_EXTERNAL_SEP_FILE
+
+ write(15,*) 'output_grid_ASCII output_energy output_wavefield_dumps'
+ write(15,*) output_grid_ASCII,output_energy,output_wavefield_dumps
+
+ write(15,*) 'use_binary_for_wavefield_dumps'
+ write(15,*) use_binary_for_wavefield_dumps
+
+ write(15,*) 'ATTENUATION_VISCOELASTIC_SOLID ATTENUATION_PORO_FLUID_PART'
+ write(15,*) ATTENUATION_VISCOELASTIC_SOLID,ATTENUATION_PORO_FLUID_PART
+
+ write(15,*) 'save_ASCII_seismograms'
+ write(15,*) save_ASCII_seismograms
+
+ write(15,*) 'save_binary_seismograms_single save_binary_seismograms_double'
+ write(15,*) save_binary_seismograms_single,save_binary_seismograms_double
+
+ write(15,*) 'DRAW_SOURCES_AND_RECEIVERS'
+ write(15,*) DRAW_SOURCES_AND_RECEIVERS
+
+ write(15,*) 'Q0 freq0'
+ write(15,*) Q0,freq0
+
+ write(15,*) 'p_sv'
+ write(15,*) p_sv
+
+ write(15,*) 'factor_subsample_image'
+ write(15,*) factor_subsample_image
+
+ write(15,*) 'USE_SNAPSHOT_NUMBER_IN_FILENAME'
+ write(15,*) USE_SNAPSHOT_NUMBER_IN_FILENAME
+
+ write(15,*) 'DRAW_WATER_IN_BLUE'
+ write(15,*) DRAW_WATER_IN_BLUE
+
+ write(15,*) 'US_LETTER'
+ write(15,*) US_LETTER
+
+ write(15,*) 'POWER_DISPLAY_COLOR'
+ write(15,*) POWER_DISPLAY_COLOR
+
+ write(15,*) 'PERFORM_CUTHILL_MCKEE'
+ write(15,*) PERFORM_CUTHILL_MCKEE
+
+ write(15,*) 'SU_FORMAT'
+ write(15,*) SU_FORMAT
+
+ write(15,*) 'USER_T0'
+ write(15,*) USER_T0
+
+ write(15,*) 'time_stepping_scheme'
+ write(15,*) time_stepping_scheme
+
+ write(15,*) 'ADD_SPRING_TO_STACEY'
+ write(15,*) ADD_SPRING_TO_STACEY
+
+ write(15,*) 'ADD_PERIODIC_CONDITIONS'
+ write(15,*) ADD_PERIODIC_CONDITIONS
+
+ write(15,*) 'PERIODIC_horiz_dist'
+ write(15,*) PERIODIC_horiz_dist
+
+ write(15,*) 'PERIODIC_DETECT_TOL'
+ write(15,*) PERIODIC_DETECT_TOL
+
+ write(15,*) 'nt deltat'
+ write(15,*) nt,deltat
+ write(15,*) 'NSOURCES'
+ write(15,*) NSOURCES
+
+ do i_source=1,NSOURCES
+ write(15,*) 'source', i_source
+ write(15,*) source_type(i_source),time_function_type(i_source), &
+ xs(i_source),zs(i_source),f0(i_source),tshift_src(i_source), &
+ factor(i_source),anglesource(i_source), &
+ Mxx(i_source),Mzz(i_source),Mxz(i_source)
+ enddo
+
+ write(15,*) 'attenuation'
+ write(15,*) N_SLS, f0_attenuation
+
+ write(15,*) 'Coordinates of macrobloc mesh (coorg):'
+
+ call write_glob2loc_nodes_database(15, iproc, npgeo, 2)
+
+ write(15,*) 'numat ngnod nspec pointsdisp plot_lowerleft_corner_only'
+ write(15,*) nb_materials,ngnod,nspec,pointsdisp,plot_lowerleft_corner_only
+
+ if (any_abs) then
+ call write_abs_merge_database(15, iproc, 1)
+ else
+ nelemabs_loc = 0
+ endif
+
+ call write_surface_database(15, nelem_acoustic_surface, acoustic_surface, nelem_acoustic_surface_loc, &
+ iproc, 1)
+
+ call write_fluidsolid_edges_database(15,nedges_coupled, nedges_coupled_loc, &
+ edges_coupled, iproc, 1)
+ call write_fluidsolid_edges_database(15, nedges_acporo_coupled, nedges_acporo_coupled_loc, &
+ edges_acporo_coupled, iproc, 1)
+ call write_fluidsolid_edges_database(15, nedges_elporo_coupled, nedges_elporo_coupled_loc, &
+ edges_elporo_coupled, iproc, 1)
+
+ if (.not. ( force_normal_to_surface .or. rec_normal_to_surface ) ) then
+ nnodes_tangential_curve = 0
+ endif
+
+ write(15,*) 'nelemabs nelem_acoustic_surface num_fluid_solid_edges num_fluid_poro_edges'
+ write(15,*) 'num_solid_poro_edges nnodes_tangential_curve'
+ write(15,*) nelemabs_loc,nelem_acoustic_surface_loc, &
+ nedges_coupled_loc,nedges_acporo_coupled_loc,&
+ nedges_elporo_coupled_loc,nnodes_tangential_curve
+
+ write(15,*) 'Material sets (num 1 rho vp vs 0 0 QKappa Qmu 0 0 0 0 0 0) or '
+ write(15,*) '(num 2 rho c11 c13 c33 c44 QKappa Qmu 0 0 0 0 0 0) or '
+ write(15,*) '(num 3 rhos rhof phi c k_xx k_xz k_zz Ks Kf Kfr etaf mufr Qmu)'
+ do i=1,nb_materials
+ if (icodemat(i) == ISOTROPIC_MATERIAL) then
+ write(15,*) i,icodemat(i),rho_s(i),cp(i),cs(i),0,0,QKappa(i),Qmu(i),0,0,0,0,0,0
+ elseif(icodemat(i) == POROELASTIC_MATERIAL) then
+ write(15,*) i,icodemat(i),rho_s(i),rho_f(i),phi(i),tortuosity(i), &
+ permxx(i),permxz(i),permzz(i),kappa_s(i),&
+ kappa_f(i),kappa_fr(i),eta_f(i),mu_fr(i),Qmu(i)
+ else
+ write(15,*) i,icodemat(i),rho_s(i),cp(i),cs(i), &
+ aniso3(i),aniso4(i),aniso5(i),aniso6(i),&
+ aniso7(i),aniso8(i),QKappa(i),Qmu(i),0,0
+ endif
+ enddo
+
+ write(15,*) 'Arrays kmato and knods for each bloc:'
+
+! DK DK add support for using pml in mpi mode with external mesh
+! call write_partition_database(15, iproc, nspec, num_material, ngnod, 2)
+ call write_partition_database(15, iproc, nspec, num_material, region_pml_external_mesh, ngnod, 2)
+
+ if ( nproc /= 1 ) then
+ call write_interfaces_database(15, nproc, iproc, &
+ my_ninterface, my_interfaces, my_nb_interfaces, 1)
+
+ write(15,*) 'Interfaces:'
+ write(15,*) my_ninterface, maxval(my_nb_interfaces)
+
+ call write_interfaces_database(15, nproc, iproc, &
+ my_ninterface, my_interfaces, my_nb_interfaces, 2)
+
+ else
+ write(15,*) 'Interfaces:'
+ write(15,*) 0, 0
+ endif
+
+
+ write(15,*) 'List of absorbing elements (edge1 edge2 edge3 edge4 type):'
+ if ( any_abs ) then
+ call write_abs_merge_database(15, iproc, 2)
+ endif
+
+ write(15,*) 'List of acoustic free-surface elements:'
+ call write_surface_database(15, nelem_acoustic_surface, acoustic_surface, nelem_acoustic_surface_loc, &
+ iproc, 2)
+
+
+ write(15,*) 'List of acoustic elastic coupled edges:'
+ call write_fluidsolid_edges_database(15, nedges_coupled, nedges_coupled_loc, &
+ edges_coupled, iproc, 2)
+
+ write(15,*) 'List of acoustic poroelastic coupled edges:'
+ call write_fluidsolid_edges_database(15, nedges_acporo_coupled, nedges_acporo_coupled_loc, &
+ edges_acporo_coupled, iproc, 2)
+
+ write(15,*) 'List of poroelastic elastic coupled edges:'
+ call write_fluidsolid_edges_database(15, nedges_elporo_coupled, nedges_elporo_coupled_loc, &
+ edges_elporo_coupled, iproc, 2)
+
+ write(15,*) 'List of tangential detection curve nodes:'
+ !write(15,*) nnodes_tangential_curve
+ write(15,*) force_normal_to_surface,rec_normal_to_surface
+
+ if (force_normal_to_surface .or. rec_normal_to_surface) then
+ do i = 1, nnodes_tangential_curve
+ write(15,*) nodes_tangential_curve(1,i),nodes_tangential_curve(2,i)
+ enddo
+ endif
+
+ ! closes Database file
+ close(15)
+
+ enddo
+
+ end subroutine save_databases
+
More information about the CIG-COMMITS
mailing list