[cig-commits] r23000 - in seismo/3D/SPECFEM3D_GLOBE/trunk/src: shared specfem3D
lefebvre at geodynamics.org
lefebvre at geodynamics.org
Tue Mar 4 13:56:08 PST 2014
Author: lefebvre
Date: 2014-03-04 13:56:07 -0800 (Tue, 04 Mar 2014)
New Revision: 23000
Modified:
seismo/3D/SPECFEM3D_GLOBE/trunk/src/shared/rules.mk
seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/asdf_data.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/rules.mk
seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/write_output_ASDF.F90
seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/write_seismograms.f90
Log:
Cleaned ASDF routines from James.
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/src/shared/rules.mk
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/src/shared/rules.mk 2014-03-04 17:22:01 UTC (rev 22999)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/src/shared/rules.mk 2014-03-04 21:56:07 UTC (rev 23000)
@@ -71,6 +71,7 @@
$(EMPTY_MACRO)
shared_MODULES = \
+ $(FC_MODDIR)/asdf_var.$(FC_MODEXT) \
$(FC_MODDIR)/constants.$(FC_MODEXT) \
$(FC_MODDIR)/shared_input_parameters.$(FC_MODEXT) \
$(FC_MODDIR)/shared_compute_parameters.$(FC_MODEXT) \
@@ -82,12 +83,18 @@
$O/adios_helpers_writers.shared_adios_module.o \
$O/adios_helpers.shared_adios.o \
$O/adios_manager.shared_adios.o \
+ $O/asdf_helpers_definitions.shared_adios_module.o \
+ $O/asdf_helpers_writers.shared_adios_module.o \
+ $O/asdf_helpers.shared_adios.o \
$(EMPTY_MACRO)
adios_shared_MODULES = \
$(FC_MODDIR)/adios_helpers_definitions_mod.$(FC_MODEXT) \
$(FC_MODDIR)/adios_helpers_mod.$(FC_MODEXT) \
$(FC_MODDIR)/adios_helpers_writers_mod.$(FC_MODEXT) \
+ $(FC_MODDIR)/asdf_helpers_definitions_mod.$(FC_MODEXT) \
+ $(FC_MODDIR)/asdf_helpers_mod.$(FC_MODEXT) \
+ $(FC_MODDIR)/asdf_helpers_writer_mod.$(FC_MODEXT) \
$(EMPTY_MACRO)
adios_shared_STUBS = \
@@ -133,10 +140,10 @@
$O/%.shared_adios_module.o: $S/%.f90
${FCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
-$O/%.shared_adios.o: $S/%.f90 $O/adios_helpers_writers.shared_adios_module.o $O/adios_helpers_definitions.shared_adios_module.o $O/shared_par.shared_module.o
+$O/%.shared_adios.o: $S/%.f90 $O/adios_helpers_writers.shared_adios_module.o $O/adios_helpers_definitions.shared_adios_module.o $O/shared_par.shared_module.o $O/asdf_helpers_writers.shared_adios_module.o $O/asdf_helpers_definitions.shared_adios_module.o
${FCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
-$O/%.shared_adios.o: $S/%.F90 $O/adios_helpers_writers.shared_adios_module.o $O/adios_helpers_definitions.shared_adios_module.o $O/shared_par.shared_module.o
+$O/%.shared_adios.o: $S/%.F90 $O/adios_helpers_writers.shared_adios_module.o $O/adios_helpers_definitions.shared_adios_module.o $O/shared_par.shared_module.o $O/asdf_helpers_writers.shared_adios_module.o $O/asdf_helpers_definitions.shared_adios_module.o
${FCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/asdf_data.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/asdf_data.f90 2014-03-04 17:22:01 UTC (rev 22999)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/asdf_data.f90 2014-03-04 21:56:07 UTC (rev 23000)
@@ -1,3 +1,9 @@
+
+!> Module defining the data structure for asdf
+!! * Waveforms defined per event
+!! * Waveform attributes defined per seismogram per event
+!! \author JAS and Wenjie
+
module asdf_data
type asdf_record
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/rules.mk
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/rules.mk 2014-03-04 17:22:01 UTC (rev 22999)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/rules.mk 2014-03-04 21:56:07 UTC (rev 23000)
@@ -330,11 +330,11 @@
${FCCOMPILE_CHECK} ${FCFLAGS_f90} -c -qsmp=omp -o $@ $<
-$O/%.solverstatic_adios.o: $S/%.f90 ${OUTPUT}/values_from_mesher.h $O/shared_par.shared_module.o $O/specfem3D_par.solverstatic_module.o $O/adios_helpers.shared_adios.o
- ${FCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
+$O/%.solverstatic_adios.o: $S/%.f90 ${OUTPUT}/values_from_mesher.h $O/shared_par.shared_module.o $O/specfem3D_par.solverstatic_module.o $O/adios_helpers.shared_adios.o $O/asdf_helpers.shared_adios.o
+ ${MPIFCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
$O/%.solverstatic_adios.o: $S/%.F90 ${OUTPUT}/values_from_mesher.h $O/shared_par.shared_module.o $O/specfem3D_par.solverstatic_module.o $O/adios_helpers.shared_adios.o
- ${FCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
+ ${MPIFCCOMPILE_CHECK} ${FCFLAGS_f90} -c -o $@ $<
###
### no dependence on values from mesher here
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/write_output_ASDF.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/write_output_ASDF.F90 2014-03-04 17:22:01 UTC (rev 22999)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/write_output_ASDF.F90 2014-03-04 21:56:07 UTC (rev 23000)
@@ -1,186 +1,270 @@
-!--------------------------------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
!> \file write_output_ASDF.F90
-!! \brief Write subroutines for writing ASDF seismograms to file using the ADIOS library
+!! \brief Write subroutines for writing ASDF seismograms to file using
+!! the ADIOS library
!! \author JAS and Wenjie Lei
-!--------------------------------------------------------------------------------------------------------
+!------------------------------------------------------------------------------
#include "config.fh"
!> Initializes the data structure for asdf
-!! \param my_asdf The asdf data structure
+!! \param asdf_container The asdf data structure
!! \param total_seismos_local The number of records on the local processer
-subroutine init_asdf_data(my_asdf,total_seismos_local)
+subroutine init_asdf_data(asdf_container,total_seismos_local)
use asdf_data
use specfem_par, only : event_name_SAC,myrank
- type(asdf_event) :: my_asdf
- integer :: total_seismos_local
- my_asdf%nrecords = total_seismos_local
- my_asdf%event = trim(event_name_SAC)
- allocate (my_asdf%npoints(my_asdf%nrecords))
- allocate (my_asdf%gmt_year(my_asdf%nrecords))
- allocate (my_asdf%gmt_hour(my_asdf%nrecords))
- allocate (my_asdf%gmt_day(my_asdf%nrecords))
- allocate (my_asdf%gmt_min(my_asdf%nrecords))
- allocate (my_asdf%gmt_sec(my_asdf%nrecords))
- allocate (my_asdf%gmt_msec(my_asdf%nrecords))
- allocate (my_asdf%event_lat(my_asdf%nrecords))
- allocate (my_asdf%event_lo(my_asdf%nrecords))
- allocate (my_asdf%event_dpt(my_asdf%nrecords))
- allocate (my_asdf%receiver_lat(my_asdf%nrecords))
- allocate (my_asdf%receiver_lo(my_asdf%nrecords))
- allocate (my_asdf%receiver_el(my_asdf%nrecords))
- allocate (my_asdf%receiver_dpt(my_asdf%nrecords))
- allocate (my_asdf%begin_value(my_asdf%nrecords))
- allocate (my_asdf%end_value(my_asdf%nrecords))
- allocate (my_asdf%cmp_azimuth(my_asdf%nrecords))
- allocate (my_asdf%cmp_incident_ang(my_asdf%nrecords))
- allocate (my_asdf%sample_rate(my_asdf%nrecords))
- allocate (my_asdf%scale_factor(my_asdf%nrecords))
- allocate (my_asdf%ev_to_sta_AZ(my_asdf%nrecords))
- allocate (my_asdf%sta_to_ev_AZ(my_asdf%nrecords))
- allocate (my_asdf%great_circle_arc(my_asdf%nrecords))
- allocate (my_asdf%dist(my_asdf%nrecords))
- allocate (my_asdf%P_pick(my_asdf%nrecords))
- allocate (my_asdf%S_pick(my_asdf%nrecords))
- allocate (my_asdf%records(my_asdf%nrecords))
- allocate (my_asdf%receiver_name_array(my_asdf%nrecords))
- allocate (my_asdf%network_array(my_asdf%nrecords))
- allocate (my_asdf%component_array(my_asdf%nrecords))
- allocate (my_asdf%receiver_id_array(my_asdf%nrecords))
+ ! Parameters
+ type(asdf_event),intent(inout) :: asdf_container
+ integer,intent(in) :: total_seismos_local
+ ! Variables
+ integer :: ier
+
+ asdf_container%nrecords = total_seismos_local
+ asdf_container%event = trim(event_name_SAC)
+
+ allocate (asdf_container%npoints(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%gmt_year(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%gmt_hour(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%gmt_day(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%gmt_min(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%gmt_sec(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%gmt_msec(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%event_lat(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%event_lo(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%event_dpt(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%receiver_lat(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%receiver_lo(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%receiver_el(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%receiver_dpt(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%begin_value(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%end_value(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%cmp_azimuth(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%cmp_incident_ang(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%sample_rate(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%scale_factor(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%ev_to_sta_AZ(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%sta_to_ev_AZ(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%great_circle_arc(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%dist(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%P_pick(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%S_pick(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%records(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%receiver_name_array(asdf_container%nrecords), &
+ STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%network_array(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%component_array(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ allocate (asdf_container%receiver_id_array(asdf_container%nrecords), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+
end subroutine init_asdf_data
+
!> Stores the records into the asdf structure
-!! \param my_asdf The asdf data structure
+!! \param asdf_container The asdf data structure
!! \param seismogram_tmp The current seismogram to store
!! \param irec_local The local index of the receivers on the local processor
!! \param irec The global index of the receiver
!! \param chn The broadband channel simulated
!! \param iorientation The recorded seismogram's orientation direction
-subroutine store_asdf_data(my_asdf,seismogram_tmp,irec_local,irec,chn,iorientation)
+subroutine store_asdf_data(asdf_container, seismogram_tmp, irec_local, &
+ irec, chn, iorientation)
use asdf_data
use specfem_par,only: &
- station_name,network_name,stlat,stlon,stele,stbur, &
- DT,t0, &
- seismo_offset,seismo_current,it_end, &
- NTSTEP_BETWEEN_OUTPUT_SEISMOS, &
- yr=>yr_SAC,jda=>jda_SAC,ho=>ho_SAC,mi=>mi_SAC,sec=>sec_SAC, &
- tshift_cmt=>t_cmt_SAC,t_shift=>t_shift_SAC, &
- elat=>elat_SAC,elon=>elon_SAC,depth=>depth_SAC, &
+ station_name,network_name,stlat,stlon,stele,stbur, &
+ DT,t0, &
+ seismo_offset,seismo_current,it_end, &
+ NTSTEP_BETWEEN_OUTPUT_SEISMOS, &
+ yr=>yr_SAC,jda=>jda_SAC,ho=>ho_SAC,mi=>mi_SAC,sec=>sec_SAC, &
+ tshift_cmt=>t_cmt_SAC,t_shift=>t_shift_SAC, &
+ elat=>elat_SAC,elon=>elon_SAC,depth=>depth_SAC, &
event_name=>event_name_SAC,cmt_lat=>cmt_lat_SAC,cmt_lon=>cmt_lon_SAC,&
cmt_depth=>cmt_depth_SAC,cmt_hdur=>cmt_hdur_SAC
implicit none
include "constants.h"
- character(len=4) :: chn
- integer :: i, irec_local, irec
+
+ ! Parameters
+ character(len=4),intent(in) :: chn
+ integer,intent(in) :: irec_local, irec
+ real(kind=CUSTOM_REAL),dimension(5,NTSTEP_BETWEEN_OUTPUT_SEISMOS), &
+ intent(in) :: seismogram_tmp
+ integer,intent(in) :: iorientation
+ type(asdf_event),intent(inout) :: asdf_container
+ ! Variables
integer :: length_station_name, length_network_name
- double precision, allocatable :: trace(:)
- real(kind=CUSTOM_REAL),dimension(5,NTSTEP_BETWEEN_OUTPUT_SEISMOS) :: seismogram_tmp
- real :: B
- integer iorientation
- integer :: adios_err
- type(asdf_event) :: my_asdf
+ integer :: ier, i
i = (irec_local-1)*(3) + (iorientation)
- my_asdf%npoints(i) = seismo_current
- my_asdf%gmt_year(i) = yr
- my_asdf%gmt_day(i) = jda
- my_asdf%gmt_hour(i) = ho
- my_asdf%gmt_min(i) = mi
- my_asdf%gmt_sec(i) = sec
- my_asdf%gmt_msec(i) = 0
- my_asdf%event_lat(i) = cmt_lat
- my_asdf%event_lo(i) = cmt_lon
- my_asdf%event_dpt(i) = cmt_depth
- my_asdf%receiver_lat(i) = stlat(irec_local)
- my_asdf%receiver_lo(i) = stlon(irec_local)
- my_asdf%receiver_el(i) = stele(irec_local)
- my_asdf%receiver_dpt(i) = stbur(irec_local)
- my_asdf%begin_value(i) = seismo_offset*DT-t0+tshift_cmt
- my_asdf%end_value(i) = -12345
- my_asdf%cmp_azimuth(i) = 0.0
- my_asdf%cmp_incident_ang(i) = 0.0
- my_asdf%sample_rate(i) = DT
- my_asdf%scale_factor(i) = -12345
- my_asdf%ev_to_sta_AZ(i) = -12345
- my_asdf%sta_to_ev_AZ(i) = -12345
- my_asdf%great_circle_arc(i) = -12345
- my_asdf%dist(i) = -12345
- my_asdf%P_pick(i) = -12345
- my_asdf%S_pick(i) = -12345
+ asdf_container%npoints(i) = seismo_current
+ asdf_container%gmt_year(i) = yr
+ asdf_container%gmt_day(i) = jda
+ asdf_container%gmt_hour(i) = ho
+ asdf_container%gmt_min(i) = mi
+ asdf_container%gmt_sec(i) = sec
+ asdf_container%gmt_msec(i) = 0
+ asdf_container%event_lat(i) = cmt_lat
+ asdf_container%event_lo(i) = cmt_lon
+ asdf_container%event_dpt(i) = cmt_depth
+ asdf_container%receiver_lat(i) = stlat(irec_local)
+ asdf_container%receiver_lo(i) = stlon(irec_local)
+ asdf_container%receiver_el(i) = stele(irec_local)
+ asdf_container%receiver_dpt(i) = stbur(irec_local)
+ asdf_container%begin_value(i) = seismo_offset*DT-t0+tshift_cmt
+ asdf_container%end_value(i) = -12345
+ asdf_container%cmp_azimuth(i) = 0.0
+ asdf_container%cmp_incident_ang(i) = 0.0
+ asdf_container%sample_rate(i) = DT
+ asdf_container%scale_factor(i) = -12345
+ asdf_container%ev_to_sta_AZ(i) = -12345
+ asdf_container%sta_to_ev_AZ(i) = -12345
+ asdf_container%great_circle_arc(i) = -12345
+ asdf_container%dist(i) = -12345
+ asdf_container%P_pick(i) = -12345
+ asdf_container%S_pick(i) = -12345
length_station_name = len_trim(station_name(irec))
length_network_name = len_trim(network_name(irec))
- my_asdf%receiver_name_array(i) = station_name(irec)(1:length_station_name)
- my_asdf%network_array(i) = network_name(irec)(1:length_network_name)
- my_asdf%component_array(i) = chn
- my_asdf%receiver_id_array(i) = ""
- allocate (my_asdf%records(i)%record(seismo_current))
- my_asdf%records(i)%record(1:seismo_current) = seismogram_tmp(iorientation, 1:seismo_current)
+ asdf_container%receiver_name_array(i) &
+ = station_name(irec)(1:length_station_name)
+ asdf_container%network_array(i) = network_name(irec)(1:length_network_name)
+ asdf_container%component_array(i) = chn
+ asdf_container%receiver_id_array(i) = ""
+ allocate (asdf_container%records(i)%record(seismo_current), STAT=ier)
+ if (ier /= 0) print *, 'Allocate failed. status = ', ier
+ asdf_container%records(i)%record(1:seismo_current) = seismogram_tmp(iorientation, 1:seismo_current)
+
end subroutine store_asdf_data
+
!> Closes the asdf data structure by deallocating all arrays
-!! \param my_asdf The asdf data structure
+!! \param asdf_container The asdf data structure
!! \param total_seismos_local The number of seismograms on the local processor
-subroutine close_asdf_data(my_asdf, total_seismos_local)
+subroutine close_asdf_data(asdf_container, total_seismos_local)
use asdf_data
- type(asdf_event) :: my_asdf
- integer :: i, total_seismos_local
+ ! Parameters
+ type(asdf_event),intent(inout) :: asdf_container
+ integer,intent(in) :: total_seismos_local
+ !Variables
+ integer :: i, ierr
- deallocate (my_asdf%npoints)
- deallocate (my_asdf%gmt_year)
- deallocate (my_asdf%gmt_hour)
- deallocate (my_asdf%gmt_day)
- deallocate (my_asdf%gmt_min)
- deallocate (my_asdf%gmt_sec)
- deallocate (my_asdf%gmt_msec)
- deallocate (my_asdf%event_lat)
- deallocate (my_asdf%event_lo)
- deallocate (my_asdf%event_dpt)
- deallocate (my_asdf%receiver_lat)
- deallocate (my_asdf%receiver_lo)
- deallocate (my_asdf%receiver_el)
- deallocate (my_asdf%receiver_dpt)
- deallocate (my_asdf%begin_value)
- deallocate (my_asdf%end_value)
- deallocate (my_asdf%cmp_azimuth)
- deallocate (my_asdf%cmp_incident_ang)
- deallocate (my_asdf%sample_rate)
- deallocate (my_asdf%scale_factor)
- deallocate (my_asdf%ev_to_sta_AZ)
- deallocate (my_asdf%sta_to_ev_AZ)
- deallocate (my_asdf%great_circle_arc)
- deallocate (my_asdf%dist)
- deallocate (my_asdf%P_pick)
- deallocate (my_asdf%S_pick)
+ deallocate (asdf_container%npoints, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%gmt_year, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%gmt_hour, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%gmt_day, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%gmt_min, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%gmt_sec, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%gmt_msec, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%event_lat, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%event_lo, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%event_dpt, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%receiver_lat, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%receiver_lo, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%receiver_el, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%receiver_dpt, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%begin_value, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%end_value, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%cmp_azimuth, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%cmp_incident_ang, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%sample_rate, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%scale_factor, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%ev_to_sta_AZ, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%sta_to_ev_AZ, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%great_circle_arc, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%dist, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%P_pick, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%S_pick, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
do i = 1, total_seismos_local
- deallocate(my_asdf%records(i)%record)
+ deallocate(asdf_container%records(i)%record, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
enddo
- deallocate (my_asdf%receiver_name_array)
- deallocate (my_asdf%network_array)
- deallocate (my_asdf%component_array)
- deallocate (my_asdf%receiver_id_array)
+ deallocate (asdf_container%receiver_name_array, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%network_array, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%component_array, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate (asdf_container%receiver_id_array, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
end subroutine close_asdf_data
+
!> Writes the asdf data structure to the file
-!! \param my_asdf The asdf data structure
-subroutine write_asdf(my_asdf)
+!! \param asdf_container The asdf data structure
+subroutine write_asdf(asdf_container)
use asdf_data
use adios_write_mod
use specfem_par, only : event_name_SAC,myrank
implicit none
+ ! Parameters
+ type(asdf_event),intent(inout) :: asdf_container
+ ! Variables
integer :: adios_err, comm, ierr, sizeprocs
integer(kind=8) :: adios_group
character(len=200) :: ASDF_FN
- type(asdf_event) :: my_asdf
call world_duplicate(comm)
call world_size(sizeprocs)
@@ -190,83 +274,87 @@
call adios_select_method (adios_group, "MPI", "", "", adios_err)
ASDF_FN="OUTPUT_FILES/"//trim(event_name_SAC)//"_sem.bp"
- call write_asdf_data (ASDF_FN, my_asdf, adios_group, myrank, sizeprocs, comm, ierr)
+ call write_asdf_data (ASDF_FN, asdf_container, adios_group, myrank, &
+ sizeprocs, comm, ierr)
end subroutine write_asdf
+
!> Writes the asdf data structure to asdf_fn using parallel write
!! \param asdf_fn The file name for asdf
-!! \param my_asdf The asdf data structure
+!! \param asdf_container The asdf data structure
!! \param adios_group The adios group for the file
!! \param rank The rank of the processor
!! \param nproc The number of processors
!! \param comm The communication group of processors
!! \param ierr The error for adios subroutine calls
-subroutine write_asdf_data(asdf_fn, my_asdf, adios_group, rank, nproc, comm, ierr)
+subroutine write_asdf_data(asdf_fn, asdf_container, adios_group, rank, nproc, comm, ierr)
use asdf_data
use adios_write_mod
- character(len=*) :: asdf_fn
- type(asdf_event),intent(in) :: my_asdf
- integer :: rank, nproc, comm, ierr
-
+ ! Parameters
+ character(len=*),intent(inout) :: asdf_fn
+ type(asdf_event),intent(inout) :: asdf_container
+ integer,intent(inout) :: adios_group
+ integer,intent(in) :: rank, nproc, comm, ierr
+ ! Variables
integer :: adios_err
- integer(kind=8) :: adios_groupsize, adios_totalsize, varid
- integer(kind=8) :: adios_handle, adios_group
+ integer(kind=8) :: adios_groupsize, adios_totalsize
+ integer(kind=8) :: adios_handle
!calculate size
adios_groupsize = 0
- call define_asdf_data (adios_group, adios_groupsize, my_asdf,&
+ call define_asdf_data (adios_group, adios_groupsize, asdf_container,&
rank, nproc, comm, ierr)
call adios_open (adios_handle, "EVENTS", asdf_fn, "w", comm, adios_err)
- call adios_group_size (adios_handle, adios_groupsize, adios_totalsize, adios_err)
+ call adios_group_size (adios_handle, adios_groupsize, adios_totalsize, &
+ adios_err)
!call the write sub
- call write_asdf_data_sub (my_asdf, adios_handle, adios_group,&
- adios_groupsize, rank, nproc, comm, ierr)
+ call write_asdf_data_sub (asdf_container, adios_handle, rank, nproc, &
+ comm, ierr)
!adios close
call adios_close(adios_handle, adios_err)
end subroutine write_asdf_data
+
!> Defines the asdf structure using adios
!! \param adios_group The adios group
!! \param my_group_size The adios group size
-!! \param my_asdf The asdf data structure
+!! \param asdf_container The asdf data structure
!! \param rank The rank of the processor
!! \param nproc The number of processors
!! \param comm The communication group of processors
!! \param ierr The error for adios subroutine calls
-subroutine define_asdf_data (adios_group, my_group_size, my_asdf, &
- rank, nproc, comm, ierr)
+subroutine define_asdf_data (adios_group, my_group_size, asdf_container, &
+ rank, nproc, comm, ierr)
use adios_write_mod
use asdf_helpers_mod
use asdf_data
use specfem_par,only: nrec
+
implicit none
- integer(kind=8), intent(in) :: adios_group
- integer(kind=8) :: my_group_size
- type(asdf_event) :: my_asdf
+ ! Parameters
+ integer(kind=8), intent(inout) :: adios_group, my_group_size
+ type(asdf_event), intent(inout) :: asdf_container
integer, intent(in) :: rank, nproc, comm
- integer :: ierr
+ integer, intent(inout) :: ierr
- integer :: i, nerr, string_total_length
+ ! Variables
+ integer :: i, string_total_length
integer, parameter :: STRING_COMMON_LENGTH = 20
- integer :: adios_err, stat
+ integer :: adios_err
- integer(kind=8) :: varid
-
integer :: nrecords
- character(len=2) :: data_type
- character(len=32) :: header, record
- character(len=6) :: npts_string
+ character(len=32) :: record
character(len=10) :: i_string
- character(len=200) :: command, dummy, record_path
+ character(len=200) :: dummy
integer :: dum_int, int_array(10)
real :: dum_real, real_array(10)
@@ -275,31 +363,31 @@
integer :: nrecords_total, offset
!gather info. Here, we only need nrecords_total
- nrecords=my_asdf%nrecords
+ nrecords=asdf_container%nrecords
call gather_offset_info(nrecords,nrecords_total,offset,rank,nproc,comm,ierr)
call define_adios_local_string_1d_array (adios_group, my_group_size, &
- 13,"", "event", dummy)
+ 13,"", "event", dummy)
!nrecords info
call define_adios_scalar (adios_group, my_group_size, "", "nreceivers",&
- dum_int)
+ dum_int)
call define_adios_scalar (adios_group, my_group_size, "", "nrecords",&
- dum_int)
+ dum_int)
!frequency(period) info
call define_adios_scalar (adios_group, my_group_size, "", "min_period", &
- dum_real)
+ dum_real)
call define_adios_scalar (adios_group, my_group_size, "", "max_period", &
- dum_real)
+ dum_real)
!string info
- call define_adios_scalar (adios_group, my_group_size, "", "receiver_name_len", &
- dum_int)
- call define_adios_scalar (adios_group, my_group_size, "", "network_len", &
- dum_int)
- call define_adios_scalar (adios_group, my_group_size, "", "receiver_id_len", &
- dum_int)
- call define_adios_scalar (adios_group, my_group_size, "", "component_len", &
- dum_int)
+ call define_adios_scalar (adios_group, my_group_size, "", &
+ "receiver_name_len", dum_int)
+ call define_adios_scalar (adios_group, my_group_size, "", &
+ "network_len", dum_int)
+ call define_adios_scalar (adios_group, my_group_size, "", &
+ "receiver_id_len", dum_int)
+ call define_adios_scalar (adios_group, my_group_size, "", &
+ "component_len", dum_int)
call define_adios_global_integer_1d_array (adios_group, my_group_size,&
nrecords, "", "npoints", int_array)
@@ -368,12 +456,12 @@
!DISPLACEMENT
do i = 1, nrecords
write(i_string, '(I10)' ) i+offset
- record=trim(my_asdf%receiver_name_array(i))//"."//&
- trim(my_asdf%network_array(i))//"."//&
- trim(my_asdf%component_array(i))//"."//&
- trim(my_asdf%receiver_id_array(i))
+ record=trim(asdf_container%receiver_name_array(i))//"."// &
+ trim(asdf_container%network_array(i))//"."// &
+ trim(asdf_container%component_array(i))//"."// &
+ trim(asdf_container%receiver_id_array(i))
call define_adios_global_real_1d_array (adios_group, my_group_size,&
- my_asdf%npoints(i), "", trim(record), real_array)
+ asdf_container%npoints(i), "", trim(record), real_array)
enddo
!define attribute
@@ -385,68 +473,98 @@
adios_string, "Low pass filter in Hz (0 if none applied) ", "" , adios_err )
call adios_define_attribute ( adios_group , "max_period", "desc", &
adios_string, "High pass filter in Hz (0 if none applied) ", "" , adios_err )
- call adios_define_attribute ( adios_group , "event_lat", "desc", adios_string, &
- "Event CMT latitude (degrees, north positive) ", "", adios_err )
- call adios_define_attribute ( adios_group , "event_lo", "desc", adios_string, &
- "Event CMT longitude (degrees, east positive) ", "", adios_err )
- call adios_define_attribute ( adios_group , "event_dpt", "desc", adios_string, &
- "Event CMT depth (km) ", "" , adios_err )
- call adios_define_attribute ( adios_group , "event_dpt", "desc", adios_string, &
- "Event CMT depth (km) ", "" , adios_err )
- call adios_define_attribute ( adios_group , "component", "desc", adios_string, &
- "Record component ", "" , adios_err)
- call adios_define_attribute ( adios_group, "gmt_year", "desc", adios_string, &
- "GMT year corresponding to reference (zero) time in file. ", "" , adios_err)
- call adios_define_attribute ( adios_group, "gmt_day", "desc", adios_string, &
- "GMT julian day corresponding to reference (zero) time in file. ", "" , adios_err)
- call adios_define_attribute ( adios_group, "gmt_hour", "desc", adios_string, &
- "GMT hour corresponding to reference (zero) time in file. ", "" , adios_err)
- call adios_define_attribute ( adios_group, "gmt_min", "desc", adios_string, &
- "GMT minute corresponding to reference (zero) time in file. ", "" , adios_err)
- call adios_define_attribute ( adios_group, "gmt_sec", "desc", adios_string, &
- "GMT second corresponding to reference (zero) time in file. ", "" , adios_err)
- call adios_define_attribute ( adios_group, "gmt_msec", "desc", adios_string, &
- "GMT millisecond corresponding to reference (zero) time in file. ", "" , adios_err)
- call adios_define_attribute ( adios_group , "receiver_lat", "desc", adios_string, &
- "Receiver latitude (degrees, north positive) ", "" , adios_err )
- call adios_define_attribute ( adios_group , "receiver_lo", "desc", adios_string, &
- "Receiver longitude (degrees, east positive) ", "" , adios_err )
- call adios_define_attribute ( adios_group , "receiver_dpt", "desc", adios_string, &
- "Receiver depth below surface (meters) ", "" , adios_err )
- call adios_define_attribute ( adios_group , "receiver_el", "desc", adios_string, &
- "Receiver elevation (meters) ", "" , adios_err )
- call adios_define_attribute ( adios_group , "begin_value", "desc", adios_string, &
- "Beginning value of time array ", "" , adios_err )
- call adios_define_attribute ( adios_group , "end_value", "desc", adios_string, &
+ call adios_define_attribute (adios_group , "event_lat", "desc",adios_string, &
+ "Event CMT latitude (degrees, north positive) ",&
+ "", adios_err )
+ call adios_define_attribute (adios_group , "event_lo", "desc", adios_string, &
+ "Event CMT longitude (degrees, east positive) ",&
+ "", adios_err )
+ call adios_define_attribute (adios_group , "event_dpt", "desc", adios_string,&
+ "Event CMT depth (km) ", "" , adios_err )
+ call adios_define_attribute (adios_group , "event_dpt", "desc", adios_string,&
+ "Event CMT depth (km) ", "" , adios_err )
+ call adios_define_attribute (adios_group , "component", "desc", adios_string,&
+ "Record component ", "" , adios_err)
+ call adios_define_attribute (adios_group, "gmt_year", "desc", adios_string, &
+ "GMT year corresponding to reference (zero) time in file. ", &
+ "" , adios_err)
+ call adios_define_attribute (adios_group, "gmt_day", "desc", adios_string, &
+ "GMT julian day corresponding to reference (zero) time in file. ", &
+ "" , adios_err)
+ call adios_define_attribute (adios_group, "gmt_hour", "desc", adios_string, &
+ "GMT hour corresponding to reference (zero) time in file. ", &
+ "" , adios_err)
+ call adios_define_attribute (adios_group, "gmt_min", "desc", adios_string, &
+ "GMT minute corresponding to reference (zero) time in file. ", &
+ "" , adios_err)
+ call adios_define_attribute (adios_group, "gmt_sec", "desc", adios_string, &
+ "GMT second corresponding to reference (zero) time in file. ", &
+ "" , adios_err)
+ call adios_define_attribute (adios_group, "gmt_msec", "desc", adios_string, &
+ "GMT millisecond corresponding to reference (zero) time in file. ", &
+ "" , adios_err)
+ call adios_define_attribute (adios_group , "receiver_lat", "desc", &
+ adios_string, &
+ "Receiver latitude (degrees, north positive) ",&
+ "" , adios_err )
+ call adios_define_attribute (adios_group , "receiver_lo", "desc", &
+ adios_string, &
+ "Receiver longitude (degrees, east positive) ", &
+ "" , adios_err )
+ call adios_define_attribute (adios_group , "receiver_dpt", "desc", &
+ adios_string, &
+ "Receiver depth below surface (meters) ", "" , &
+ adios_err )
+ call adios_define_attribute (adios_group , "receiver_el", "desc", &
+ adios_string, &
+ "Receiver elevation (meters) ", "" , adios_err )
+ call adios_define_attribute (adios_group , "begin_value", "desc", &
+ adios_string, &
+ "Beginning value of time array ", "" , adios_err )
+ call adios_define_attribute (adios_group , "end_value", "desc", adios_string,&
"End value of time array ", "" , adios_err )
- call adios_define_attribute ( adios_group , "cmp_azimuth", "desc", adios_string, &
- "Component azimuth (degrees clockwise from north) ", "", adios_err )
- call adios_define_attribute ( adios_group , "cmp_incident_ang", "desc", adios_string,&
- "Component incident angle (degrees from vertical) ", "", adios_err )
- call adios_define_attribute ( adios_group , "sample_rate", "desc", adios_string, &
- "Sampling rate (s) ", "" , adios_err )
- call adios_define_attribute ( adios_group , "scale_factor", "desc", adios_string, &
- "Scale factor to convert the unit of synthetics from meters to nanometer ", &
- "" , adios_err )
- call adios_define_attribute ( adios_group , "ev_to_sta_AZ", "desc", adios_string, &
- "Event to station azimuth (degrees) ", "" , adios_err )
- call adios_define_attribute ( adios_group , "sta_to_ev_AZ", "desc", adios_string, &
- "Station to event azimuth (backazimuth, degrees) ", "", adios_err )
- call adios_define_attribute ( adios_group , "great_circle_dist", "desc", adios_string, &
- "Great circle distance between event and station (degrees) ", "", adios_err )
- call adios_define_attribute ( adios_group , "receiver_name", "desc", adios_string, &
- "Receiver name ", "" , adios_err )
- call adios_define_attribute( adios_group , "network", "desc", adios_string, &
- "Receiver network name ", "" , adios_err )
- call adios_define_attribute( adios_group , "receiver_id", "desc", adios_string, &
- "Receiver number ", "" , adios_err )
- call adios_define_attribute ( adios_group , "component", "desc", adios_string,&
- "Receiver component name ", "" , adios_err )
+ call adios_define_attribute (adios_group , "cmp_azimuth", "desc", &
+ adios_string, &
+ "Component azimuth (degrees clockwise from north) ", &
+ "", adios_err )
+ call adios_define_attribute (adios_group , "cmp_incident_ang", "desc", &
+ adios_string, &
+ "Component incident angle (degrees from vertical) ", &
+ "", adios_err )
+ call adios_define_attribute (adios_group , "sample_rate", "desc", &
+ adios_string, &
+ "Sampling rate (s) ", "" , adios_err )
+ call adios_define_attribute (adios_group , "scale_factor", "desc", &
+ adios_string, &
+ "Scale factor to convert the unit of synthetics from meters to nanometer ", &
+ "" , adios_err )
+ call adios_define_attribute (adios_group , "ev_to_sta_AZ", "desc", &
+ adios_string, &
+ "Event to station azimuth (degrees) ", "" , &
+ adios_err )
+ call adios_define_attribute (adios_group , "sta_to_ev_AZ", "desc", &
+ adios_string, &
+ "Station to event azimuth (backazimuth, degrees) ", &
+ "", adios_err )
+ call adios_define_attribute (adios_group , "great_circle_dist", "desc", &
+ adios_string, &
+ "Great circle distance between event and station (degrees) ", &
+ "", adios_err )
+ call adios_define_attribute (adios_group , "receiver_name", "desc", &
+ adios_string, &
+ "Receiver name ", "" , adios_err )
+ call adios_define_attribute(adios_group , "network", "desc", adios_string, &
+ "Receiver network name ", "" , adios_err )
+ call adios_define_attribute(adios_group , "receiver_id", "desc", &
+ adios_string, "Receiver number ", "", adios_err)
+ call adios_define_attribute (adios_group , "component", "desc", adios_string,&
+ "Receiver component name ", "" , adios_err )
end subroutine define_asdf_data
+
!> Writes the asdf data structure to the adios arrays
-!! \param my_asdf The asdf data structure
+!! \param asdf_container The asdf data structure
!! \param adios_handle The asdf file name
!! \param adios_group The adios group
!! \param adios_groupsize The adios group size
@@ -454,8 +572,8 @@
!! \param nproc The number of processors
!! \param comm The communication group of processors
!! \param ierr The error for adios subroutine calls
-subroutine write_asdf_data_sub (my_asdf, adios_handle, my_adios_group,&
- adios_groupsize, rank, nproc, comm, ierr)
+subroutine write_asdf_data_sub (asdf_container, adios_handle, rank, &
+ nproc, comm, ierr)
use adios_write_mod
use asdf_data
@@ -464,9 +582,9 @@
implicit none
integer :: adios_err, i
- integer(kind=8),intent(in) :: my_adios_group, adios_groupsize
integer(kind=8),intent(in) :: adios_handle
- integer,intent(in) :: rank, nproc, comm, ierr
+ integer,intent(in) :: rank, nproc, comm
+ integer,intent(inout) :: ierr
integer :: nrecords_total, offset, nreceivers
integer :: receiver_name_len, network_len, component_len, receiver_id_len
integer :: rn_len_total, nw_len_total, rid_len_total, comp_len_total
@@ -477,27 +595,32 @@
character(len=:), allocatable :: receiver_name_total, network_total, &
component_total, receiver_id_total
- type(asdf_event) :: my_asdf
+ type(asdf_event),intent(inout) :: asdf_container
!gather array offset info
- call gather_offset_info(my_asdf%nrecords,nrecords_total,offset,&
+ call gather_offset_info(asdf_container%nrecords,nrecords_total,offset,&
rank, nproc, comm, ierr)
!ensemble the string for receiver_name, network, componen and receiver_id
- allocate(character(len=6*my_asdf%nrecords) :: receiver_name)
- allocate(character(len=6*my_asdf%nrecords) :: network)
- allocate(character(len=6*my_asdf%nrecords) :: component)
- allocate(character(len=6*my_asdf%nrecords) :: receiver_id)
+ allocate(character(len=6*asdf_container%nrecords) :: receiver_name, STAT=ierr)
+ if (ierr /= 0) print *, 'Allocate failed. status = ', ierr
+ allocate(character(len=6*asdf_container%nrecords) :: network, STAT=ierr)
+ if (ierr /= 0) print *, 'Allocate failed. status = ', ierr
+ allocate(character(len=6*asdf_container%nrecords) :: component, STAT=ierr)
+ if (ierr /= 0) print *, 'Allocate failed. status = ', ierr
+ allocate(character(len=6*asdf_container%nrecords) :: receiver_id, STAT=ierr)
+ if (ierr /= 0) print *, 'Allocate failed. status = ', ierr
receiver_name=''
network=''
component=''
receiver_id=''
- do i=1, my_asdf%nrecords
- receiver_name=trim(receiver_name)//trim(my_asdf%receiver_name_array(i))//'.'
- network=trim(network)//trim(my_asdf%network_array(i))//'.'
- component=trim(component)//trim(my_asdf%component_array(i))//'.'
- receiver_id=trim(receiver_id)//trim(my_asdf%receiver_id_array(i))//'.'
+ do i=1, asdf_container%nrecords
+ receiver_name=trim(receiver_name) // &
+ trim(asdf_container%receiver_name_array(i)) // '.'
+ network=trim(network)//trim(asdf_container%network_array(i))//'.'
+ component=trim(component)//trim(asdf_container%component_array(i))//'.'
+ receiver_id=trim(receiver_id)//trim(asdf_container%receiver_id_array(i))//'.'
enddo
receiver_name_len = len_trim(receiver_name)
network_len = len_trim(network)
@@ -513,10 +636,14 @@
rank, nproc, comm, ierr)
call gather_string_total_length(component_len, comp_len_total,&
rank, nproc, comm, ierr)
- allocate(character(len=rn_len_total) :: receiver_name_total)
- allocate(character(len=nw_len_total) :: network_total)
- allocate(character(len=rid_len_total) :: receiver_id_total)
- allocate(character(len=comp_len_total) :: component_total)
+ allocate(character(len=rn_len_total) :: receiver_name_total, STAT=ierr)
+ if (ierr /= 0) print *, 'Allocate failed. status = ', ierr
+ allocate(character(len=nw_len_total) :: network_total, STAT=ierr)
+ if (ierr /= 0) print *, 'Allocate failed. status = ', ierr
+ allocate(character(len=rid_len_total) :: receiver_id_total, STAT=ierr)
+ if (ierr /= 0) print *, 'Allocate failed. status = ', ierr
+ allocate(character(len=comp_len_total) :: component_total, STAT=ierr)
+ if (ierr /= 0) print *, 'Allocate failed. status = ', ierr
!write all local strings into global string
call gather_string_offset_info(receiver_name_len, rn_len_total,rn_offset, &
@@ -534,27 +661,30 @@
!===========================
!write out the string info
if(rank.eq.0)then
- call adios_write(adios_handle, "receiver_name", trim(receiver_name_total),adios_err)
+ call adios_write(adios_handle, "receiver_name", trim(receiver_name_total), &
+ adios_err)
call adios_write(adios_handle, "network", trim(network_total), adios_err)
call adios_write(adios_handle, "component", trim(component_total), adios_err)
- call adios_write(adios_handle, "receiver_id", trim(receiver_id_total),adios_err)
+ call adios_write(adios_handle, "receiver_id", trim(receiver_id_total), &
+ adios_err)
endif
- deallocate(receiver_name_total)
- deallocate(network_total)
- deallocate(receiver_id_total)
- deallocate(component_total)
+ deallocate(receiver_name_total)
+ deallocate(network_total)
+ deallocate(receiver_id_total)
+ deallocate(component_total)
+
!===========================
! write seismic records
- do i = 1, my_asdf%nrecords
+ do i = 1, asdf_container%nrecords
write( loc_string, '(I10)' ) i+offset
- loc_string=trim(my_asdf%receiver_name_array(i))//"."//&
- trim(my_asdf%network_array(i))//"."//&
- trim(my_asdf%component_array(i))//"."//&
- trim(my_asdf%receiver_id_array(i))
- call write_adios_global_1d_array(adios_handle, rank, nproc, &
- my_asdf%npoints(i), my_asdf%npoints(i), 0, &
- loc_string, my_asdf%records(i)%record)
+ loc_string=trim(asdf_container%receiver_name_array(i))//"."// &
+ trim(asdf_container%network_array(i))//"."// &
+ trim(asdf_container%component_array(i))//"."// &
+ trim(asdf_container%receiver_id_array(i))
+ call write_adios_global_1d_array(adios_handle, rank, nproc, &
+ asdf_container%npoints(i), asdf_container%npoints(i), 0, &
+ loc_string, asdf_container%records(i)%record)
enddo
!===========================
@@ -568,70 +698,103 @@
call adios_write(adios_handle, "nreceivers", nreceivers, adios_err)
call adios_write(adios_handle, "min_period", 0, adios_err)
call adios_write(adios_handle, "max_period", 0, adios_err)
- call adios_write(adios_handle, "event", my_asdf%event, adios_err)
+ call adios_write(adios_handle, "event", asdf_container%event, adios_err)
endif
!===========================
!write out the array
- call write_adios_global_integer_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "npoints", my_asdf%npoints)
- call write_adios_global_integer_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "gmt_year", my_asdf%gmt_year)
- call write_adios_global_integer_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "gmt_day", my_asdf%gmt_day)
- call write_adios_global_integer_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "gmt_hour", my_asdf%gmt_hour)
- call write_adios_global_integer_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "gmt_min", my_asdf%gmt_min)
- call write_adios_global_integer_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "gmt_sec", my_asdf%gmt_sec)
- call write_adios_global_integer_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "gmt_msec", my_asdf%gmt_msec)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "event_lat", my_asdf%event_lat)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "event_lo", my_asdf%event_lo)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "event_dpt", my_asdf%event_dpt)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "receiver_lat", my_asdf%receiver_lat)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "receiver_lo", my_asdf%receiver_lo)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "receiver_el", my_asdf%receiver_el)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "receiver_dpt", my_asdf%receiver_dpt)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "begin_value", my_asdf%begin_value)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "end_value", my_asdf%end_value)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "cmp_azimuth", my_asdf%cmp_azimuth)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "cmp_incident_ang", my_asdf%cmp_incident_ang)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "sample_rate", my_asdf%sample_rate)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "scale_factor", my_asdf%scale_factor)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "ev_to_sta_AZ", my_asdf%ev_to_sta_AZ)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "sta_to_ev_AZ", my_asdf%sta_to_ev_AZ)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "great_circle_arc", my_asdf%great_circle_arc)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "dist", my_asdf%dist)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "P_pick", my_asdf%P_pick)
- call write_adios_global_real_1d_array(adios_handle, rank, nproc, my_asdf%nrecords,&
- nrecords_total, offset, "S_pick", my_asdf%S_pick)
+ call write_adios_global_integer_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "npoints", asdf_container%npoints)
+ call write_adios_global_integer_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "gmt_year", asdf_container%gmt_year)
+ call write_adios_global_integer_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "gmt_day", asdf_container%gmt_day)
+ call write_adios_global_integer_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "gmt_hour", asdf_container%gmt_hour)
+ call write_adios_global_integer_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "gmt_min", asdf_container%gmt_min)
+ call write_adios_global_integer_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "gmt_sec", asdf_container%gmt_sec)
+ call write_adios_global_integer_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "gmt_msec", asdf_container%gmt_msec)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "event_lat", asdf_container%event_lat)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "event_lo", asdf_container%event_lo)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "event_dpt", asdf_container%event_dpt)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "receiver_lat", asdf_container%receiver_lat)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "receiver_lo", asdf_container%receiver_lo)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "receiver_el", asdf_container%receiver_el)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "receiver_dpt", asdf_container%receiver_dpt)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "begin_value", asdf_container%begin_value)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "end_value", asdf_container%end_value)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "cmp_azimuth", asdf_container%cmp_azimuth)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "cmp_incident_ang", &
+ asdf_container%cmp_incident_ang)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "sample_rate", asdf_container%sample_rate)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "scale_factor", asdf_container%scale_factor)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "ev_to_sta_AZ", asdf_container%ev_to_sta_AZ)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "sta_to_ev_AZ", asdf_container%sta_to_ev_AZ)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "great_circle_arc", &
+ asdf_container%great_circle_arc)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "dist", asdf_container%dist)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "P_pick", asdf_container%P_pick)
+ call write_adios_global_real_1d_array(adios_handle, rank, nproc, &
+ asdf_container%nrecords, &
+ nrecords_total, offset, "S_pick", asdf_container%S_pick)
- deallocate(receiver_name)
- deallocate(network)
- deallocate(receiver_id)
- deallocate(component)
+ deallocate(receiver_name, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate(network, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate(receiver_id, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate(component, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
end subroutine write_asdf_data_sub
+
!> Gets offset values for arrays
!! \param local_dim The local dimension on the processor
!! \param global_dim The global dimension of the array
@@ -641,24 +804,27 @@
!! \param comm The communication group of processors
!! \param ierr The error for adios subroutine calls
subroutine gather_offset_info(local_dim, global_dim, offset,&
- rank, nproc, comm, ierr)
+ rank, nproc, comm, ierr)
use mpi
implicit none
- integer :: local_dim, global_dim, offset
- integer :: rank, nproc, comm, ierr
+ integer,intent(inout) :: local_dim, global_dim, offset
+ integer,intent(in) :: rank, nproc, comm
+ integer,intent(inout) :: ierr
integer, allocatable :: local_dim_all_proc(:)
integer, allocatable :: offset_all_proc(:)
integer :: i
- allocate(local_dim_all_proc(nproc))
- allocate(offset_all_proc(nproc))
+ allocate(local_dim_all_proc(nproc), STAT=ierr)
+ if (ierr /= 0) print *, 'Allocate failed. status = ', ierr
+ allocate(offset_all_proc(nproc), STAT=ierr)
+ if (ierr /= 0) print *, 'Allocate failed. status = ', ierr
call synchronize_all()
call MPI_Gather(local_dim, 1, MPI_INTEGER, local_dim_all_proc, 1, &
- MPI_INTEGER, 0, comm, ierr)
+ MPI_INTEGER, 0, comm, ierr)
if(rank.eq.0)then
offset_all_proc(1)=0
@@ -672,8 +838,10 @@
1, MPI_INTEGER, 0, comm, ierr)
call MPI_Bcast(global_dim, 1, MPI_INTEGER, 0, comm, ierr)
- deallocate(local_dim_all_proc)
- deallocate(offset_all_proc)
+ deallocate(local_dim_all_proc, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate(offset_all_proc, STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
end subroutine gather_offset_info
@@ -690,14 +858,15 @@
use mpi
implicit none
- integer :: local_dim, global_dim
- integer :: rank, nproc, comm, ierr
+ integer,intent(inout) :: local_dim, global_dim
+ integer,intent(in) :: rank, nproc, comm
+ integer,intent(inout) :: ierr
integer, allocatable :: local_dim_all_proc(:)
- integer :: i, tag, mpi_status(MPI_STATUS_SIZE)
if(rank.eq.0)then
- allocate(local_dim_all_proc(nproc))
+ allocate(local_dim_all_proc(nproc),STAT=ierr)
+ if (ierr /= 0) print *, 'Allocate failed. status = ', ierr
endif
call synchronize_all()
@@ -706,7 +875,8 @@
call synchronize_all()
if(rank.eq.0)then
global_dim=sum(local_dim_all_proc(1:nproc))
- deallocate(local_dim_all_proc)
+ deallocate(local_dim_all_proc,STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
endif
end subroutine gather_string_total_length
@@ -721,25 +891,27 @@
!! \param nproc The number of processors
!! \param comm The communication group of processors
!! \param ierr The error
-subroutine gather_string_offset_info(local_dim, global_dim, offset,&
- string_piece, string_total,&
+subroutine gather_string_offset_info(local_dim, global_dim, offset, &
+ string_piece, string_total, &
rank, nproc, comm, ierr)
-
use mpi
implicit none
- integer :: local_dim, global_dim, offset
- character(len=*) :: string_piece, string_total
+ integer,intent(inout) :: local_dim, global_dim, offset
+ character(len=*),intent(inout) :: string_piece, string_total
character(len=10000) :: buffer_string
- integer :: rank, nproc, comm, ierr
+ integer,intent(in) :: rank, nproc, comm
+ integer,intent(inout) :: ierr
integer, allocatable :: local_dim_all_proc(:)
integer, allocatable :: offset_all_proc(:)
- integer :: i, tag, mpi_status(MPI_STATUS_SIZE)
+ integer :: i, mpi_status(MPI_STATUS_SIZE)
if(rank.eq.0)then
- allocate(local_dim_all_proc(nproc))
- allocate(offset_all_proc(nproc))
+ allocate(local_dim_all_proc(nproc),STAT=ierr)
+ if (ierr /= 0) print *, 'Allocate failed. status = ', ierr
+ allocate(offset_all_proc(nproc),STAT=ierr)
+ if (ierr /= 0) print *, 'Allocate failed. status = ', ierr
endif
call synchronize_all()
@@ -752,62 +924,43 @@
do i=2, nproc
offset_all_proc(i)=sum(local_dim_all_proc(1:(i-1)))
enddo
- !print *, "offset_all_proc:", offset_all_proc(:)
string_total=''
buffer_string=''
string_total=trim(string_total)//trim(string_piece(1:local_dim))
endif
- !print *,"TAG1"
- !if(rank.eq.0) then
- ! print *,"global_dim",global_dim
- !endif
-
call synchronize_all()
if(rank.eq.0)then
offset_all_proc(1)=0
do i=2, nproc
offset_all_proc(i)=sum(local_dim_all_proc(1:(i-1)))
enddo
- !print *, "offset_all_proc:", offset_all_proc(:)
string_total=''
buffer_string=''
string_total=trim(string_total)//trim(string_piece(1:local_dim))
endif
- !print *,"TAG1"
- !if(rank.eq.0) then
- !print *,"global_dim",global_dim
- !endif
-
- !call synchronize_all()
if(rank.eq.0)then
do i=1,nproc-1
- !print *, "buffer_before:",trim(buffer_string)
- !print *, "local_dim_all_proc:",local_dim_all_proc(i+1)
call MPI_Recv(buffer_string, local_dim_all_proc(i+1),MPI_CHARACTER,&
- i, 1, comm, mpi_status,ierr)
- !print *,"buffer_string:", trim(buffer_string)
+ i, 1, comm, mpi_status,ierr)
string_total=trim(string_total)//buffer_string(1:local_dim_all_proc(i+1))
enddo
else
- !print *, "local_dim:", local_dim
- !print *,"string_piece:", trim(string_piece)
call MPI_Send(string_piece, local_dim, MPI_CHARACTER,&
0, 1, comm, ierr)
endif
- !print *,"TAG", rank
call synchronize_all()
call MPI_Scatter(offset_all_proc, 1, MPI_INTEGER, offset, &
1, MPI_INTEGER, 0, comm, ierr)
call MPI_Bcast(global_dim, 1, MPI_INTEGER, 0, comm, ierr)
- !print *,"rank, local dim, global_dim,offset:", rank, local_dim, &
- ! global_dim, offset
if (rank.eq.0) then
- deallocate(local_dim_all_proc)
- deallocate(offset_all_proc)
+ deallocate(local_dim_all_proc,STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
+ deallocate(offset_all_proc,STAT=ierr)
+ if (ierr /= 0) print *, 'Deallocate failed. status = ', ierr
endif
end subroutine gather_string_offset_info
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/write_seismograms.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/write_seismograms.f90 2014-03-04 17:22:01 UTC (rev 22999)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/write_seismograms.f90 2014-03-04 21:56:07 UTC (rev 23000)
@@ -140,16 +140,14 @@
real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: one_seismogram
integer :: iproc,sender,irec_local,iorientation,irec,ier,receiver
- integer :: nrec_local_received, sizeprocs, offset
- integer :: total_seismos,total_seismos_local,total_seismos_global
- integer,dimension(:),allocatable:: islice_num_rec_local,nrecords_all
+ integer :: nrec_local_received
+ integer :: total_seismos,total_seismos_local
+ integer,dimension(:),allocatable:: islice_num_rec_local
character(len=256) :: sisname
- character(len=4) :: chn
- character(len=2) :: bic
! timing
double precision, external :: wtime
! todo: only needed for asdf output but I am passing this around
- type(asdf_event) :: my_asdf
+ type(asdf_event) :: asdf_container
! allocates single station seismogram
allocate(one_seismogram(NDIM,NTSTEP_BETWEEN_OUTPUT_SEISMOS),stat=ier)
@@ -185,7 +183,7 @@
endif
endif
- ! todo: this initializes the asdf data structure by allocating arrays
+ ! initializes the asdf data structure by allocating arrays
if (OUTPUT_SEISMOS_ASDF) then
total_seismos_local = 0
do irec_local = 1, nrec_local
@@ -193,7 +191,7 @@
total_seismos_local=total_seismos_local+1
enddo
enddo
- call init_asdf_data(my_asdf,total_seismos_local)
+ call init_asdf_data(asdf_container, total_seismos_local)
endif
total_seismos_local = 0
@@ -208,22 +206,22 @@
one_seismogram = seismograms(:,irec_local,:)
! write this seismogram
- ! todo: my_asdf data structure is passed here which is a bit ugly
- call write_one_seismogram(one_seismogram,irec,irec_local,my_asdf)
+ ! asdf data structure is passed as an argument
+ call write_one_seismogram(one_seismogram,irec,irec_local,asdf_container)
enddo
- ! this is wheere the asdf data structure is written to the file and
- ! everything is deallocated
+ ! write asdf container to the file
if (OUTPUT_SEISMOS_ASDF) then
call synchronize_all()
- call write_asdf(my_asdf)
- call close_asdf_data(my_asdf, total_seismos_local)
+ call write_asdf(asdf_container)
+ ! deallocate the contanier
+ call close_asdf_data(asdf_container, total_seismos_local)
endif
! create one large file instead of one small file per station to avoid file system overload
if(OUTPUT_SEISMOS_ASCII_TEXT .and. SAVE_ALL_SEISMOS_IN_ONE_FILE) close(IOUT)
- if(total_seismos_local/= nrec_local) call exit_MPI(myrank,'incorrect total number of receivers saved')
+ !if(total_seismos_local/= nrec_local) call exit_MPI(myrank,'incorrect total number of receivers saved')
! user output
if(myrank == 0) then
@@ -315,7 +313,7 @@
total_seismos = total_seismos + 1
! write this seismogram
- call write_one_seismogram(one_seismogram,irec)
+ call write_one_seismogram(one_seismogram,irec,irec_local)
enddo
endif
@@ -366,7 +364,7 @@
!-------------------------------------------------------------------------------------------------
!
- subroutine write_one_seismogram(one_seismogram,irec,irec_local,my_asdf)
+ subroutine write_one_seismogram(one_seismogram,irec,irec_local,asdf_container)
use asdf_data
use constants_solver
@@ -391,7 +389,7 @@
integer :: iorientation,length_station_name,length_network_name
character(len=4) :: chn
- character(len=256) :: sisname,sisname2,sisname_big_file
+ character(len=256) :: sisname,sisname_big_file
character(len=2) :: bic
! variables used for calculation of backazimuth and
@@ -401,7 +399,7 @@
double precision :: phi
real(kind=CUSTOM_REAL) :: cphi,sphi
integer :: isample
- type(asdf_event) :: my_asdf
+ type(asdf_event) :: asdf_container
! initializes
seismogram_tmp(:,:) = 0.0_CUSTOM_REAL
@@ -509,7 +507,7 @@
! ASDF output format
if(OUTPUT_SEISMOS_ASDF) &
- call store_asdf_data(my_asdf,seismogram_tmp,irec_local,irec,chn,iorientation)
+ call store_asdf_data(asdf_container,seismogram_tmp,irec_local,irec,chn,iorientation)
enddo ! do iorientation
More information about the CIG-COMMITS
mailing list