All Classes Files Functions Variables Pages
module_write_listing.f90
Go to the documentation of this file.
1 !=====================================================================================================================================
2 ! EFISPEC3D !
3 ! (Elements FInis SPECtraux 3D) !
4 ! !
5 ! http://efispec.free.fr !
6 ! !
7 ! !
8 ! This file is part of EFISPEC3D !
9 ! Please refer to http://efispec.free.fr if you use it or part of it !
10 ! !
11 ! !
12 !1 ---> French License: CeCILL V2 !
13 ! !
14 ! Copyright BRGM 2009 contributeurs : Florent DE MARTIN !
15 ! David MICHEA !
16 ! Philippe THIERRY !
17 ! !
18 ! Contact: f.demartin at brgm.fr !
19 ! !
20 ! Ce logiciel est un programme informatique servant a resoudre l'equation du !
21 ! mouvement en trois dimensions via une methode des elements finis spectraux. !
22 ! !
23 ! Ce logiciel est regi par la licence CeCILL soumise au droit francais et !
24 ! respectant les principes de diffusion des logiciels libres. Vous pouvez !
25 ! utiliser, modifier et/ou redistribuer ce programme sous les conditions de la !
26 ! licence CeCILL telle que diffusee par le CEA, le CNRS et l'INRIA sur le site !
27 ! "http://www.cecill.info". !
28 ! !
29 ! En contrepartie de l'accessibilite au code source et des droits de copie, de !
30 ! modification et de redistribution accordes par cette licence, il n'est offert !
31 ! aux utilisateurs qu'une garantie limitee. Pour les memes raisons, seule une !
32 ! responsabilite restreinte pese sur l'auteur du programme, le titulaire des !
33 ! droits patrimoniaux et les concedants successifs. !
34 ! !
35 ! A cet egard l'attention de l'utilisateur est attiree sur les risques associes !
36 ! au chargement, a l'utilisation, a la modification et/ou au developpement et a !
37 ! la reproduction du logiciel par l'utilisateur etant donne sa specificite de !
38 ! logiciel libre, qui peut le rendre complexe a manipuler et qui le reserve donc !
39 ! a des developpeurs et des professionnels avertis possedant des connaissances !
40 ! informatiques approfondies. Les utilisateurs sont donc invites a charger et !
41 ! tester l'adequation du logiciel a leurs besoins dans des conditions permettant !
42 ! d'assurer la securite de leurs systemes et ou de leurs donnees et, plus !
43 ! generalement, a l'utiliser et l'exploiter dans les memes conditions de !
44 ! securite. !
45 ! !
46 ! Le fait que vous puissiez acceder a cet en-tete signifie que vous avez pris !
47 ! connaissance de la licence CeCILL et que vous en avez accepte les termes. !
48 ! !
49 ! !
50 !2 ---> International license: GNU GPL V3 !
51 ! !
52 ! EFISPEC3D is a computer program that solves the three-dimensional equations of !
53 ! motion using a finite spectral-element method. !
54 ! !
55 ! Copyright (C) 2009 Florent DE MARTIN !
56 ! !
57 ! Contact: f.demartin at brgm.fr !
58 ! !
59 ! This program is free software: you can redistribute it and/or modify it under !
60 ! the terms of the GNU General Public License as published by the Free Software !
61 ! Foundation, either version 3 of the License, or (at your option) any later !
62 ! version. !
63 ! !
64 ! This program is distributed in the hope that it will be useful, but WITHOUT ANY !
65 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A !
66 ! PARTICULAR PURPOSE. See the GNU General Public License for more details. !
67 ! !
68 ! You should have received a copy of the GNU General Public License along with !
69 ! this program. If not, see http://www.gnu.org/licenses/. !
70 ! !
71 ! !
72 !3 ---> Third party libraries !
73 ! !
74 ! EFISPEC3D uses the following of third party libraries: !
75 ! !
76 ! --> METIS 5.1.0 !
77 ! see http://glaros.dtc.umn.edu/gkhome/metis/metis/overview !
78 ! !
79 ! --> Lib_VTK_IO !
80 ! see S. Zaghi's website: https://github.com/szaghi/Lib_VTK_IO !
81 ! !
82 ! --> INTERP_LINEAR !
83 ! see J. Burkardt website: http://people.sc.fsu.edu/~jburkardt/ !
84 ! !
85 ! --> SAC !
86 ! http://ds.iris.edu/files/sac-manual/ !
87 ! !
88 ! --> EXODUS II !
89 ! http://sourceforge.net/projects/exodusii/ !
90 ! !
91 ! --> NETCDF !
92 ! http://www.unidata.ucar.edu/software/netcdf/ !
93 ! !
94 ! --> HDF5 !
95 ! http://www.hdfgroup.org/HDF5/ !
96 ! !
97 ! Some of these libraries are located in directory lib and pre-compiled !
98 ! with intel compiler for x86_64 platform. !
99 ! !
100 ! !
101 !4 ---> Related Articles !
102 ! !
103 ! De Martin, F., Matsushima, M., Kawase, H. (BSSA, 2013) !
104 ! Impact of geometric effects on near-surface Green's functions !
105 ! doi:10.1785/0120130039 !
106 ! !
107 ! Aochi, H., Ducellier, A., Dupros, F., Delatre, M., Ulrich, T., De Martin, F., !
108 ! Yoshimi, M., (Pure Appl. Geophys. 2013) !
109 ! Finite Difference Simulations of Seismic Wave Propagation for the 2007 Mw 6.6 !
110 ! Niigata-ken Chuetsu-Oki Earthquake: Validity of Models and Reliable !
111 ! Input Ground Motion in the Near-Field !
112 ! doi:10.1007/s00024-011-0429-5 !
113 ! !
114 ! De Martin, F. (BSSA, 2011) !
115 ! Verification of a Spectral-Element Method Code for the Southern California !
116 ! Earthquake Center LOH.3 Viscoelastic Case !
117 ! doi:10.1785/0120100305 !
118 ! !
119 !=====================================================================================================================================
120 
123 
126 module mod_write_listing
127 
128  implicit none
129 
130  private
131 
132  public :: write_header
133  public :: write_temporal_domain_info
134  private :: write_receiver_saving_info
135  private :: write_snapshot_saving_info
136  public :: write_cfl_condition_ok
137  public :: write_cfl_condition_ko
138 
139  contains
140 
141 !
142 !
144 !***********************************************************************************************************************************************************************************
145  subroutine write_header()
146 !***********************************************************************************************************************************************************************************
147 
148  use mpi
149 
150  use mod_global_variables
151 
152  implicit none
153 
154 
155  integer :: ios
156  integer :: icpu
157 
158  character(len=255) :: info
159  character(len=MPI_MAX_PROCESSOR_NAME) :: cpu_name(ig_ncpu)
160 
161 !
162 !---->cpu0 gather all the name of the other cpu
163  cpu_name(:) = " "
164  call mpi_gather(cg_cpu_name,mpi_max_processor_name,mpi_character,cpu_name,mpi_max_processor_name,mpi_character,0,mpi_comm_world,ios)
165  if (ios /= 0) then
166  write(info,'(a)') "error while gathering cpus' name"
167  call error_stop(info)
168  endif
169 
170  if (ig_myrank == 0) then
171 
172  open(unit=ig_lst_unit,file=trim(cg_prefix)//".lst") !IG_LST_UNIT = 10
173  write(ig_lst_unit,'(a)') "**************************************************************************************************"
174  write(ig_lst_unit,'(a)') "*** ***"
175  write(ig_lst_unit,'(a)') "*** EFISPEC3D ***"
176  write(ig_lst_unit,'(a)') "*** (Elements FInis SPECtraux 3D) ***"
177  write(ig_lst_unit,'(a)') "*** ***"
178  write(ig_lst_unit,'(a)') "*** version 1.0 ***"
179  write(ig_lst_unit,'(a)') "*** ***"
180  write(ig_lst_unit,'(a)') "*** http://efispec.free.fr ***"
181  write(ig_lst_unit,'(a)') "*** ***"
182  write(ig_lst_unit,'(a)') "*** Developpers ***"
183  write(ig_lst_unit,'(a)') "*** --> Florent DE MARTIN ***"
184  write(ig_lst_unit,'(a)') "*** --> David MICHEA ***"
185  write(ig_lst_unit,'(a)') "*** --> Philippe THIERRY ***"
186  write(ig_lst_unit,'(a)') "*** ***"
187  write(ig_lst_unit,'(a)') "*** Copyright 2009 BRGM (French Geological Survey) ***"
188  write(ig_lst_unit,'(a)') "*** ***"
189  write(ig_lst_unit,'(a)') "**************************************************************************************************"
190 
191 !
192 !------->cpu name used for computation
193  write(ig_lst_unit,'("",/,a)') "name of the cpus used for computation"
194  do icpu = 1,ig_ncpu
195  write(ig_lst_unit,'(2a)') " --> ",trim(adjustl(cpu_name(icpu)))
196  enddo
197 
198 !
199 !------->epsilon of the machine
200  write(ig_lst_unit,'("",/,a)') "epsilon machine"
201  write(ig_lst_unit,'(a,es15.7)') " -->",epsilon_machine
202 
203 !
204 !------->smallest positive (non zero) number in the model of the type real
205  write(ig_lst_unit,'("",/,a)') "smallest positive (non zero) number of the type real"
206  write(ig_lst_unit,'(a,es15.7)') " -->",tiny_real
207 
208 !
209 !------->communication type
210  if (lg_async_mpi_comm) then
211  write(ig_lst_unit,'("",/,a)') "communication between cpus"
212  write(ig_lst_unit,'(a)') " --> asynchrone"
213  else
214  write(ig_lst_unit,'("",/,a)') "communication between cpus"
215  write(ig_lst_unit,'(a)') " --> synchrone"
216  endif
217 
218 !
219 !------->spectral element's polynomial order
220  write(ig_lst_unit,'("",/,a,I0 )') "spectral elements use Lagrange polynomial of order ",ig_lagrange_order
221  write(ig_lst_unit,'( a,I0,a)') " --> ",ig_ngll**3," GLL nodes per hexa"
222 
223 !
224 !---------->simulation rheology
225  if (.not.lg_visco) then
226  write(ig_lst_unit,'(" ",/,a)') "rheology of simulation"
227  write(ig_lst_unit,'(a)') " --> elastic"
228  else
229  write(ig_lst_unit,'(" ",/,a)') "rheology of simulation"
230  write(ig_lst_unit,'( a,I0,a)') " --> viscoelastic using ",ig_nrelax," memory variables"
231  endif
232 
233  endif
234 
235  return
236 !***********************************************************************************************************************************************************************************
237  end subroutine write_header
238 !***********************************************************************************************************************************************************************************
239 
240 
241 !
242 !
244 !***********************************************************************************************************************************************************************************
245  subroutine write_temporal_domain_info()
246 !***********************************************************************************************************************************************************************************
247 
248  use mod_global_variables, only :&
249  cg_prefix&
250  ,ig_myrank&
251  ,tiny_real&
252  ,ig_lst_unit&
253  ,rg_dt&
254  ,rg_simu_total_time&
255  ,ig_ndt
256 
257  implicit none
258 
259  if (ig_myrank == 0) then
260 
261  if (rg_dt > tiny_real) then
262 
263  write(ig_lst_unit,'("",/,a)') "time domain information found in the file "//trim(cg_prefix)//".cfg"
264  write(ig_lst_unit,'(a,f10.6)') "--> duration of simulation = ",rg_simu_total_time
265  write(ig_lst_unit,'(a,i10)') "--> number of time step = ",ig_ndt
266  write(ig_lst_unit,'(a,es15.6)')"--> size of time step =" ,rg_dt
267  write(ig_lst_unit,'(a)') "--> the stability of the simulation will be checked with the Courant-Friedrichs-Lewy condition (see below)."
268 
269  call write_receiver_saving_info()
270 
271  call write_snapshot_saving_info()
272 
273  else
274 
275  write(ig_lst_unit,'("",/,a)') "size of time step not found in the file "//trim(cg_prefix)//".cfg or inferior to TINY_REAL"
276  write(ig_lst_unit,'(a)') "--> the optimal size will be set by EFISPEC3D with respect to the Courant-Friedrichs-Lewy condition"
277 
278  endif
279 
280  endif
281 
282  return
283 !***********************************************************************************************************************************************************************************
284  end subroutine write_temporal_domain_info
285 !***********************************************************************************************************************************************************************************
286 
287 !
288 !
290 !***********************************************************************************************************************************************************************************
291  subroutine write_receiver_saving_info()
292 !***********************************************************************************************************************************************************************************
293 
294  use mod_global_variables, only :&
295  ig_lst_unit&
296  ,ig_myrank&
297  ,ig_ndt&
298  ,ig_receiver_saving_incr
299 
300  implicit none
301 
302  if (ig_myrank == 0) then
303 
304  write(ig_lst_unit,'(a)') " "
305 
306  if (ig_receiver_saving_incr < ig_ndt) then
307 
308  write(ig_lst_unit,'(a,i0,a)' ) "receivers' time history saved every ",ig_receiver_saving_incr," time steps"
309 
310  else
311 
312  write(ig_lst_unit,'(a)' ) "receivers' time history are not saved"
313 
314  endif
315 
316  endif
317 
318  return
319 !***********************************************************************************************************************************************************************************
320  end subroutine write_receiver_saving_info
321 !***********************************************************************************************************************************************************************************
322 
323 
324 !
325 !
327 !***********************************************************************************************************************************************************************************
328  subroutine write_snapshot_saving_info()
329 !***********************************************************************************************************************************************************************************
330 
331  use mod_global_variables, only :&
332  ig_lst_unit&
333  ,ig_myrank&
334  ,ig_ndt&
335  ,ig_snapshot_saving_incr&
336  ,lg_snapshot_displacement&
337  ,lg_snapshot_velocity&
338  ,lg_snapshot_acceleration&
339  ,ig_snapshot_volume_saving_incr&
340  ,lg_snapshot_volume_displacement&
341  ,lg_snapshot_volume_velocity&
342  ,lg_snapshot_volume_acceleration
343 
344  implicit none
345 
346  if (ig_myrank == 0) then
347 
348  write(ig_lst_unit,'(a)') " "
349 
350  if (ig_snapshot_saving_incr < ig_ndt) then
351  write(ig_lst_unit,'(a,i0,a)' ) "surface snapshot saved every ",ig_snapshot_saving_incr," time steps"
352  else
353  write(ig_lst_unit,'(a)' ) "surface snapshot are not saved"
354  endif
355  if (lg_snapshot_displacement) then
356  write(ig_lst_unit,'(a)') " --> displacement snapshot are saved"
357  else
358  write(ig_lst_unit,'(a)') " --> displacement snapshot are not saved"
359  endif
360  if (lg_snapshot_velocity) then
361  write(ig_lst_unit,'(a)') " --> velocity snapshot are saved"
362  else
363  write(ig_lst_unit,'(a)') " --> velocity snapshot are not saved"
364  endif
365  if (lg_snapshot_acceleration) then
366  write(ig_lst_unit,'(a)') " --> acceleration snapshot are saved"
367  else
368  write(ig_lst_unit,'(a)') " --> acceleration snapshot are not saved"
369  endif
370 
371  write(ig_lst_unit,'(a)') " "
372 
373  if (ig_snapshot_volume_saving_incr < ig_ndt) then
374  write(ig_lst_unit,'(a,i0,a)' ) "volume snapshot saved every ",ig_snapshot_volume_saving_incr," time steps"
375  else
376  write(ig_lst_unit,'(a)' ) "volume snapshot are not saved"
377  endif
378  if (lg_snapshot_volume_displacement) then
379  write(ig_lst_unit,'(a)') " --> displacement snapshot are saved"
380  else
381  write(ig_lst_unit,'(a)') " --> displacement snapshot are not saved"
382  endif
383  if (lg_snapshot_volume_velocity) then
384  write(ig_lst_unit,'(a)') " --> velocity snapshot are saved"
385  else
386  write(ig_lst_unit,'(a)') " --> velocity snapshot are not saved"
387  endif
388  if (lg_snapshot_volume_acceleration) then
389  write(ig_lst_unit,'(a)') " --> acceleration snapshot are saved"
390  else
391  write(ig_lst_unit,'(a)') " --> acceleration snapshot are not saved"
392  endif
393 
394  endif
395 
396  return
397 !***********************************************************************************************************************************************************************************
398  end subroutine write_snapshot_saving_info
399 !***********************************************************************************************************************************************************************************
400 
401 
402 !
403 !
405 !***********************************************************************************************************************************************************************************
406  subroutine write_cfl_condition_ok(dt)
407 !***********************************************************************************************************************************************************************************
408 
409  use mod_global_variables, only :&
410  ig_lst_unit&
411  ,ig_myrank
412 
413  implicit none
414 
415  real, intent(in) :: dt
416 
417  if (ig_myrank == 0) then
418 
419  write(ig_lst_unit,'("",/,a,es15.6,a)') "Courant–Friedrichs–Lewy (CFL) condition has been checked. Simulation's time step size equal to ",dt," honors the CFL condition."
420 
421  endif
422 
423  return
424 !***********************************************************************************************************************************************************************************
425  end subroutine write_cfl_condition_ok
426 !***********************************************************************************************************************************************************************************
427 
428 
429 !
430 !
432 !***********************************************************************************************************************************************************************************
433  subroutine write_cfl_condition_ko(dt)
434 !***********************************************************************************************************************************************************************************
435 
436  use mod_global_variables, only :&
437  ig_lst_unit&
438  ,ig_myrank&
439  ,rg_simu_total_time&
440  ,ig_ndt&
441  ,rg_dt
442 
443  implicit none
444 
445  real, intent(in) :: dt
446 
447  if (ig_myrank == 0) then
448 
449  write(ig_lst_unit,'("",/,a,es15.6,a)') "Courant–Friedrichs–Lewy (CFL) condition has been checked. Simulation's time step size has been modified to ",dt
450  write(ig_lst_unit,'(a,f10.6)') "--> duration of simulation = ",rg_simu_total_time
451  write(ig_lst_unit,'(a,i10)') "--> number of time step = ",ig_ndt
452  write(ig_lst_unit,'(a,es15.6)') "--> size of time step =" ,rg_dt
453 
454  call write_receiver_saving_info()
455 
456  call write_snapshot_saving_info()
457 
458  endif
459 
460  return
461 !***********************************************************************************************************************************************************************************
462  end subroutine write_cfl_condition_ko
463 !***********************************************************************************************************************************************************************************
464 
465 end module mod_write_listing
mod_write_listing::write_cfl_condition_ok
subroutine, public write_cfl_condition_ok(dt)
subroutine that writes valid CFL condition in the listing file (*.lst).
Definition: module_write_listing.f90:406
mod_write_listing::write_header
subroutine, public write_header()
subroutine that writes the header of the listing file (*.lst).
Definition: module_write_listing.f90:145
mod_global_variables
This module defines all global variables of EFISPEC3D. Scalar variables are initialized directly in t...
Definition: module_global_variables.f90:128
mod_write_listing::write_temporal_domain_info
subroutine, public write_temporal_domain_info()
subroutine that writes temporal information about the simulation in the listing file (*...
Definition: module_write_listing.f90:245
mod_write_listing::write_cfl_condition_ko
subroutine, public write_cfl_condition_ko(dt)
subroutine that writes invalid CFL condition in the listing file (*.lst).
Definition: module_write_listing.f90:433
mod_write_listing
This module contains subroutines to write information in the listing file *.lst.
Definition: module_write_listing.f90:126
mod_write_listing::write_receiver_saving_info
subroutine, private write_receiver_saving_info()
subroutine that writes receivers information in the listing file (*.lst).
Definition: module_write_listing.f90:291
mod_write_listing::write_snapshot_saving_info
subroutine, private write_snapshot_saving_info()
subroutine that writes snapshots information in the listing file (*.lst).
Definition: module_write_listing.f90:328