[cig-commits] r21548 - seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D
lefebvre at geodynamics.org
lefebvre at geodynamics.org
Fri Mar 15 10:39:31 PDT 2013
Author: lefebvre
Date: 2013-03-15 10:39:31 -0700 (Fri, 15 Mar 2013)
New Revision: 21548
Modified:
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/write_specfem_adios_header.F90
Log:
Subroutine to write ADIOS header splitted and file doxygen-ated
modified: src/specfem3D/write_specfem_adios_header.F90
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/write_specfem_adios_header.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/write_specfem_adios_header.F90 2013-03-15 17:06:12 UTC (rev 21547)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/write_specfem_adios_header.F90 2013-03-15 17:39:31 UTC (rev 21548)
@@ -76,21 +76,17 @@
integer, dimension(NSOURCES) :: yr, mo, da, ho, mi
double precision, dimension(NSOURCES) :: sec, t_shift, hdur, lat, long, depth
double precision, dimension(NSOURCES) :: mrr, mtt, mpp, mrt, mrp, mtp
- integer :: datasource_length ! write for later reading of datasource
- character(len=5) :: datasource_tmp
+ integer :: event_name_length, datasource_length
character(len=16):: event_name
character(len=:), allocatable :: datasource ! F03 feature
! values from STATIONS ----------------------------------
integer :: NSTATIONS
integer :: station_name_length, network_name_length ! for later reading
- character(len=MAX_LENGTH_STATION_NAME) :: station_name_tmp
- character(len=MAX_LENGTH_NETWORK_NAME) :: network_name_tmp
character(len=:), allocatable :: station_name, network_name
double precision, allocatable, dimension(:) :: stlat, stlon, stele, stbur
character(len=150) :: OUTPUT_FILES,LOCAL_PATH,LOCAL_TMP_PATH,MODEL
- character(len=256) :: string, CMTSOLUTION, STATIONS
! Adios variables
integer :: adios_err
@@ -104,7 +100,7 @@
integer :: isource, irec, ier
- ! ensure that only the master open the adios handle inside MPI_COMM_SELF
+ ! only the master needs to read the values to be written
if(myrank == 0) then
call adios_declare_group (adios_group, "SPECFEM3D_GLOBE_HEADER", &
"", 0, adios_err)
@@ -138,208 +134,55 @@
call define_par_file_variables (adios_group, group_size_inc, model_length)
!--*** Values read from DATA/CMTSOLUTION ***--
- ! extract all unmodified values from CMTSOLUTION
- ! get_cmt() routine modify the read values
- ! TODO factorize what follows and get_cmt.f90 and probably one or two other
- ! routines
- call get_value_string(CMTSOLUTION, 'solver.CMTSOLUTION', 'DATA/CMTSOLUTION')
- open(unit=1,file=CMTSOLUTION,status='old',action='read')
- datasource_length = 4*NSOURCES ! a datasource is 4 character, by convention
- allocate(character(len=(datasource_length)) :: datasource, stat=ier)
- if (ier /=0) &
- call exit_MPI (myrank, &
- "error allocating datasource string for adios header")
- datasource = ""
- ! ADIOS only (1) byte for a string. This may cause data overwriting.
- ! => increase the generate by the string size -1
- adios_groupsize = adios_groupsize + 4*NSOURCES - 1
- do isource=1,NSOURCES
+ call read_raw_cmtsolution (yr, mo, da, ho, mi, sec, t_shift, hdur, lat, &
+ long, depth, mrr, mtt, mpp, mrt, mrp, mtp, event_name_length, &
+ event_name, datasource_length, datasource)
+ call define_cmtsolution_variables (adios_group, group_size_inc, NSOURCES, &
+ event_name_length, datasource_length)
- read(1,"(a256)") string
- ! skips empty lines
- do while( len_trim(string) == 0 )
- read(1,"(a256)") string
- enddo
- ! read header with event information
- read(string,"(a4,i5,i3,i3,i3,i3,f6.2)") datasource_tmp,yr(isource), &
- mo(isource),da(isource),ho(isource),mi(isource),sec(isource)
- datasource = datasource // datasource_tmp
- ! read event name
- read(1,"(a)") string
- read(string(12:len_trim(string)),*) event_name
- ! read time shift
- read(1,"(a)") string
- read(string(12:len_trim(string)),*) t_shift(isource)
- ! read half duration
- read(1,"(a)") string
- read(string(15:len_trim(string)),*) hdur(isource)
- ! read latitude
- read(1,"(a)") string
- read(string(10:len_trim(string)),*) lat(isource)
- ! read longitude
- read(1,"(a)") string
- read(string(11:len_trim(string)),*) long(isource)
- ! read depth
- read(1,"(a)") string
- read(string(7:len_trim(string)),*) depth(isource)
- ! read Mrr
- read(1,"(a)") string
- read(string(5:len_trim(string)),*) mrr(isource)
- ! read Mtt
- read(1,"(a)") string
- read(string(5:len_trim(string)),*) mtt(isource)
- ! read Mpp
- read(1,"(a)") string
- read(string(5:len_trim(string)),*) mpp(isource)
- ! read Mrt
- read(1,"(a)") string
- read(string(5:len_trim(string)),*) mrt(isource)
- ! read Mrp
- read(1,"(a)") string
- read(string(5:len_trim(string)),*) mrp(isource)
- ! read Mtp
- read(1,"(a)") string
- read(string(5:len_trim(string)),*) mtp(isource)
- enddo
- close(1)
-
- ! define adios variables for the CMTSOLUTION
- call define_cmtsolution_variables (adios_group, group_size_inc, NSOURCES, &
- datasource_length)
-
-
!--*** Values read from DATA/STATIONS
- ! Extract values from STATIONS File
- call get_value_string(STATIONS, 'solver.STATIONS', 'DATA/STATIONS')
- open(unit=1,file=STATIONS,iostat=ier,status='old',action='read')
- NSTATIONS = 0
- do while(ier == 0)
- read(1,"(a)",iostat=ier) string
- if(ier == 0) NSTATIONS = NSTATIONS + 1
- enddo
- allocate (character (len=(MAX_LENGTH_STATION_NAME*NSTATIONS)) :: station_name)
- allocate (character (len=(MAX_LENGTH_NETWORK_NAME*NSTATIONS)) :: network_name)
- allocate (stlat (NSTATIONS))
- allocate (stlon (NSTATIONS))
- allocate (stele (NSTATIONS))
- allocate (stbur (NSTATIONS))
- station_name = ""
- network_name = ""
- rewind(1)
- do irec = 1,NSTATIONS
- read(1,*,iostat=ier) station_name_tmp, network_name_tmp, &
- stlat(irec), stlon(irec), &
- stele(irec), stbur(irec)
- if( ier /= 0 ) then
- write(IMAIN,*) 'error reading in station ',irec
- call exit_MPI(myrank,'error reading in station in STATIONS file')
- endif
- station_name = station_name // trim(station_name_tmp) // " "
- network_name = network_name // trim(network_name_tmp) // " "
- enddo
- close(1)
- station_name = trim(station_name)
- network_name = trim(network_name)
- station_name_length = len(station_name)
- network_name_length = len(network_name)
-
- call define_stations_variables (adios_group, group_size_inc, NSTATIONS,&
+ call read_raw_stations (NSTATIONS, stlat, stlon, stele, stbur, &
+ station_name_length, station_name, network_name_length, network_name)
+ call define_stations_variables (adios_group, group_size_inc, NSTATIONS, &
station_name_length, network_name_length)
! open the file where the headers have to be written
- call adios_open (adios_handle, "SPECFEM3D_GLOBE_HEADER", filename, "w", &
+ call adios_open (adios_handle, "SPECFEM3D_GLOBE_HEADER", filename, "w", &
MPI_COMM_SELF, adios_err);
! The group size have been auto-incremented
adios_groupsize = group_size_inc
- call adios_group_size (adios_handle, adios_groupsize, adios_totalsize, adios_err)
+ call adios_group_size (adios_handle, adios_groupsize, &
+ adios_totalsize, adios_err)
! Write variables from 'Par_file'
- call adios_write (adios_handle, "ANGULAR_WIDTH_XI_IN_DEGREES", ANGULAR_WIDTH_XI_IN_DEGREES, adios_err)
- call adios_write (adios_handle, "ANGULAR_WIDTH_ETA_IN_DEGREES", ANGULAR_WIDTH_ETA_IN_DEGREES, adios_err)
- call adios_write (adios_handle, "CENTER_LONGITUDE_IN_DEGREES", CENTER_LONGITUDE_IN_DEGREES, adios_err)
- call adios_write (adios_handle, "CENTER_LATITUDE_IN_DEGREES", CENTER_LATITUDE_IN_DEGREES, adios_err)
- call adios_write (adios_handle, "GAMMA_ROTATION_AZIMUTH", GAMMA_ROTATION_AZIMUTH, adios_err)
- call adios_write (adios_handle, "HDUR_MOVIE", HDUR_MOVIE, adios_err)
- call adios_write (adios_handle, "MOVIE_TOP_KM", MOVIE_TOP_KM, adios_err)
- call adios_write (adios_handle, "MOVIE_BOTTOM_KM", MOVIE_BOTTOM_KM, adios_err)
- call adios_write (adios_handle, "MOVIE_EAST_DEG", MOVIE_EAST_DEG, adios_err)
- call adios_write (adios_handle, "MOVIE_WEST_DEG", MOVIE_WEST_DEG, adios_err)
- call adios_write (adios_handle, "MOVIE_NORTH_DEG", MOVIE_NORTH_DEG, adios_err)
- call adios_write (adios_handle, "MOVIE_SOUTH_DEG", MOVIE_SOUTH_DEG, adios_err)
- call adios_write (adios_handle, "RECORD_LENGTH_IN_MINUTES", RECORD_LENGTH_IN_MINUTES, adios_err)
- call adios_write (adios_handle, "NTSTEP_BETWEEN_OUTPUT_SEISMOS", NTSTEP_BETWEEN_OUTPUT_SEISMOS, adios_err)
- call adios_write (adios_handle, "NTSTEP_BETWEEN_READ_ADJSRC", NTSTEP_BETWEEN_READ_ADJSRC, adios_err)
- call adios_write (adios_handle, "NTSTEP_BETWEEN_FRAMES", NTSTEP_BETWEEN_FRAMES, adios_err)
- call adios_write (adios_handle, "NTSTEP_BETWEEN_OUTPUT_INFO", NTSTEP_BETWEEN_OUTPUT_INFO, adios_err)
- call adios_write (adios_handle, "NUMBER_OF_RUNS", NUMBER_OF_RUNS, adios_err)
- call adios_write (adios_handle, "NUMBER_OF_THIS_RUN", NUMBER_OF_THIS_RUN, adios_err)
- call adios_write (adios_handle, "NCHUNKS", NCHUNKS, adios_err)
- call adios_write (adios_handle, "SIMULATION_TYPE", SIMULATION_TYPE, adios_err)
- call adios_write (adios_handle, "MOVIE_VOLUME_TYPE", MOVIE_VOLUME_TYPE, adios_err)
- call adios_write (adios_handle, "MOVIE_START", MOVIE_START, adios_err)
- call adios_write (adios_handle, "MOVIE_STOP", MOVIE_STOP, adios_err)
- call adios_write (adios_handle, "NEX_XI", NEX_XI, adios_err)
- call adios_write (adios_handle, "NEX_ETA", NEX_ETA, adios_err)
- call adios_write (adios_handle, "NPROC_XI", NPROC_XI, adios_err)
- call adios_write (adios_handle, "NPROC_ETA", NPROC_ETA, adios_err)
- call adios_write (adios_handle, "NOISE_TOMOGRAPHY", NOISE_TOMOGRAPHY, adios_err)
- call adios_write (adios_handle, "ELLIPTICITY", ELLIPTICITY, adios_err)
- call adios_write (adios_handle, "GRAVITY", GRAVITY, adios_err)
- call adios_write (adios_handle, "ROTATION", ROTATION, adios_err)
- call adios_write (adios_handle, "TOPOGRAPHY", TOPOGRAPHY, adios_err)
- call adios_write (adios_handle, "OCEANS", OCEANS, adios_err)
- call adios_write (adios_handle, "MOVIE_SURFACE", MOVIE_SURFACE, adios_err)
- call adios_write (adios_handle, "MOVIE_VOLUME", MOVIE_VOLUME, adios_err)
- call adios_write (adios_handle, "MOVIE_COARSE", MOVIE_COARSE, adios_err)
- call adios_write (adios_handle, "RECEIVERS_CAN_BE_BURIED", RECEIVERS_CAN_BE_BURIED, adios_err)
- call adios_write (adios_handle, "PRINT_SOURCE_TIME_FUNCTION", PRINT_SOURCE_TIME_FUNCTION, adios_err)
- call adios_write (adios_handle, "SAVE_MESH_FILES", SAVE_MESH_FILES, adios_err)
- call adios_write (adios_handle, "ATTENUATION", ATTENUATION, adios_err)
- call adios_write (adios_handle, "ATTENUATION_NEW", ATTENUATION_NEW, adios_err)
- call adios_write (adios_handle, "ABSORBING_CONDITIONS", ABSORBING_CONDITIONS, adios_err)
- call adios_write (adios_handle, "SAVE_FORWARD", SAVE_FORWARD, adios_err)
- call adios_write (adios_handle, "OUTPUT_SEISMOS_ASCII_TEXT", OUTPUT_SEISMOS_ASCII_TEXT, adios_err)
- call adios_write (adios_handle, "OUTPUT_SEISMOS_SAC_ALPHANUM", OUTPUT_SEISMOS_SAC_ALPHANUM, adios_err)
- call adios_write (adios_handle, "OUTPUT_SEISMOS_SAC_BINARY", OUTPUT_SEISMOS_SAC_BINARY, adios_err)
- call adios_write (adios_handle, "ROTATE_SEISMOGRAMS_RT", ROTATE_SEISMOGRAMS_RT, adios_err)
- call adios_write (adios_handle, "WRITE_SEISMOGRAMS_BY_MASTER", WRITE_SEISMOGRAMS_BY_MASTER, adios_err)
- call adios_write (adios_handle, "SAVE_ALL_SEISMOS_IN_ONE_FILE", SAVE_ALL_SEISMOS_IN_ONE_FILE, adios_err)
- call adios_write (adios_handle, "USE_BINARY_FOR_LARGE_FILE", USE_BINARY_FOR_LARGE_FILE, adios_err)
- call adios_write (adios_handle, "model_length", model_length, adios_err)
- call adios_write (adios_handle, "MODEL", MODEL, adios_err)
+ call write_adios_par_file_variables (adios_handle, &
+ ANGULAR_WIDTH_XI_IN_DEGREES, ANGULAR_WIDTH_ETA_IN_DEGREES, &
+ CENTER_LONGITUDE_IN_DEGREES, CENTER_LATITUDE_IN_DEGREES, &
+ GAMMA_ROTATION_AZIMUTH, HDUR_MOVIE, MOVIE_TOP_KM, MOVIE_BOTTOM_KM, &
+ MOVIE_EAST_DEG, MOVIE_WEST_DEG, MOVIE_NORTH_DEG, MOVIE_SOUTH_DEG, &
+ RECORD_LENGTH_IN_MINUTES, NTSTEP_BETWEEN_OUTPUT_SEISMOS, &
+ NTSTEP_BETWEEN_READ_ADJSRC, NTSTEP_BETWEEN_FRAMES, &
+ NTSTEP_BETWEEN_OUTPUT_INFO, NUMBER_OF_RUNS, NUMBER_OF_THIS_RUN,NCHUNKS,&
+ SIMULATION_TYPE, MOVIE_VOLUME_TYPE, MOVIE_START, MOVIE_STOP, NEX_XI, &
+ NEX_ETA, NPROC_XI, NPROC_ETA, NOISE_TOMOGRAPHY, ELLIPTICITY, GRAVITY, &
+ ROTATION, TOPOGRAPHY, OCEANS, MOVIE_SURFACE, MOVIE_VOLUME,MOVIE_COARSE,&
+ RECEIVERS_CAN_BE_BURIED, PRINT_SOURCE_TIME_FUNCTION, SAVE_MESH_FILES, &
+ ATTENUATION, ATTENUATION_NEW, ABSORBING_CONDITIONS, SAVE_FORWARD, &
+ OUTPUT_SEISMOS_ASCII_TEXT, OUTPUT_SEISMOS_SAC_ALPHANUM, &
+ OUTPUT_SEISMOS_SAC_BINARY, ROTATE_SEISMOGRAMS_RT, &
+ WRITE_SEISMOGRAMS_BY_MASTER, SAVE_ALL_SEISMOS_IN_ONE_FILE, &
+ USE_BINARY_FOR_LARGE_FILE, model_length, MODEL)
- ! Write variables from 'CMTSOLUTION'
- call adios_write (adios_handle, "NSOURCES", NSOURCES, adios_err)
- call adios_write (adios_handle, "year", yr, adios_err)
- call adios_write (adios_handle, "month", mo, adios_err)
- call adios_write (adios_handle, "day", da, adios_err)
- call adios_write (adios_handle, "hour", ho, adios_err)
- call adios_write (adios_handle, "minute", mi, adios_err)
- call adios_write (adios_handle, "second", sec, adios_err)
- call adios_write (adios_handle, "time_shift", t_shift, adios_err)
- call adios_write (adios_handle, "half_duration", hdur, adios_err)
- call adios_write (adios_handle, "latitude", lat, adios_err)
- call adios_write (adios_handle, "longitude", long, adios_err)
- call adios_write (adios_handle, "depth", depth, adios_err)
- call adios_write (adios_handle, "mrr", mrr, adios_err)
- call adios_write (adios_handle, "mtt", mtt, adios_err)
- call adios_write (adios_handle, "mpp", mpp, adios_err)
- call adios_write (adios_handle, "mrt", mrt, adios_err)
- call adios_write (adios_handle, "mrp", mrp, adios_err)
- call adios_write (adios_handle, "mtp", mtp, adios_err)
- call adios_write (adios_handle, "datasource_length", datasource_length, adios_err)
- call adios_write (adios_handle, "datasource", datasource, adios_err)
+ ! Write variables from 'CMTSOLUTION'
+ call write_adios_cmtsolution_variables (adios_handle, &
+ NSOURCES, yr, mo, da, ho, mi, sec, t_shift, hdur, lat, long, depth, &
+ mrr, mtt, mpp, mrt, mrp, mtp, event_name_length, event_name, &
+ datasource_length, datasource)
! Write variables from 'STATIONS'
- call adios_write (adios_handle, "NSTATIONS", NSTATIONS, adios_err)
- call adios_write (adios_handle, "station_latitude", stlat, adios_err)
- call adios_write (adios_handle, "station_longitude", stlon, adios_err)
- call adios_write (adios_handle, "station_elevation", stele, adios_err)
- call adios_write (adios_handle, "station_burial", stbur, adios_err)
- call adios_write (adios_handle, "station_name_length", station_name_length, adios_err)
- call adios_write (adios_handle, "network_name_length", network_name_length, adios_err)
- call adios_write (adios_handle, "station_name", station_name, adios_err)
- call adios_write (adios_handle, "network_name", network_name, adios_err)
+ call write_adios_stations_variables (adios_handle, &
+ NSTATIONS, stlat, stlon, stele, stbur, station_name_length, &
+ station_name, network_name_length, network_name)
call adios_close (adios_handle, adios_err)
@@ -351,8 +194,14 @@
deallocate(stele)
deallocate(stbur)
endif
-end subroutine write_specfem_header_adios
+! Imbricated/contained subroutines. The initial thougth was to do a module with
+! public access to the write_specfem_header_adios routine and private access to
+! the other routines. The problem then is the files compilation order that
+! should be done very carefully. This require modifications of the Makefile
+! which is not currently designed to do that.
+contains
+
!> \brief Define ADIOS variable to store values from the Par_file
!! \param adios_group The ADIOS entity grouping variables for data transferts
!! \param group_size_inc The group size to increment wrt. the variable size
@@ -431,11 +280,11 @@
!! \param datasource_length The number of character of the datasource string.
!! Usefull for reading back the datasources.
subroutine define_cmtsolution_variables (adios_group, group_size_inc, NSOURCES,&
- datasource_length)
+ event_name_length, datasource_length)
implicit none
integer(kind=8), intent(in) :: adios_group
integer(kind=8), intent(inout) :: group_size_inc
- integer, intent(in) :: NSOURCES, datasource_length
+ integer, intent(in) :: NSOURCES, datasource_length, event_name_length
!-- Number of SOURCES inside the CMTSOLUTION file
call define_adios_integer_scalar (adios_group, "NSOURCES", "/CMTSOLUTION", group_size_inc)
@@ -459,6 +308,8 @@
call define_adios_integer_local_array1D (adios_group, "hour", "/CMTSOLUTION", NSOURCES, "NSOURCES", group_size_inc)
call define_adios_integer_local_array1D (adios_group, "minute", "/CMTSOLUTION", NSOURCES, "NSOURCES", group_size_inc)
!-- string
+ call define_adios_integer_scalar (adios_group, "event_name_length", "/CMTSOLUTION", group_size_inc)
+ call define_adios_string (adios_group, "event_name", "/CMTSOLUTION", event_name_length, group_size_inc)
call define_adios_integer_scalar (adios_group, "datasource_length", "/CMTSOLUTION", group_size_inc)
call define_adios_string (adios_group, "datasource", "/CMTSOLUTION", datasource_length, group_size_inc)
end subroutine define_cmtsolution_variables
@@ -491,3 +342,349 @@
call define_adios_string (adios_group, "station_name", "/STATIONS", station_name_length, group_size_inc)
call define_adios_string (adios_group, "network_name", "/STATIONS", network_name_length, group_size_inc)
end subroutine define_stations_variables
+
+!> \brief Read the 'CMTSOLUTION file' and do not modify nor transform variables
+!! \param yr Array to store the year of the events
+!! \param mo Array to store the month of the events
+!! \param da Array to store the day of the events
+!! \param ho Array to store the hour of the events
+!! \param mi Array to store the minute of the events
+!! \param sec Array to store the second of the events
+!! \param t_shift Array to store the time shift at the beginning of the events
+!! \param hdur Array to store the duration of the events
+!! \param lat Array to store the latitude of the events
+!! \param long Array to store the longitude of the events
+!! \param depth Arrays to store the depth of the events
+!! \param mrr Arrays to store the mrr component of the events
+!! \param mtt Arrays to store the mtt component of the events
+!! \param mpp Arrays to store the mpp component of the events
+!! \param mrt Arrays to store the mrt component of the events
+!! \param mrp Arrays to store the mrp component of the events
+!! \param mtp Arrays to store the mtp component of the events
+!! \param event_name_length Variable for keeping the size of the event_name
+!! string
+!! \param event_name Strings to store the event name
+!! \param datasource_length Variable for keeping the size of the datasource
+!! string
+!! \param datasource String in which the different datasource names are
+!! concatenated
+!> \note This subroutine and get_cmt.f90 are redundant. Might be factorized in
+!! the future. For now we do not want the value modification from get_cmt
+subroutine read_raw_cmtsolution (yr, mo, da, ho, mi, sec, t_shift, hdur, lat, &
+ long, depth, mrr, mtt, mpp, mrt, mrp, mtp, event_name_length, event_name, &
+ datasource_length, datasource)
+ implicit none
+ ! Parameters
+ integer, dimension(NSOURCES), intent(out) :: yr, mo, da, ho, mi
+ double precision, dimension(NSOURCES), intent(out) :: sec, t_shift, hdur, lat, long, depth
+ double precision, dimension(NSOURCES), intent(out) :: mrr, mtt, mpp, mrt, mrp, mtp
+ integer, intent(inout) :: event_name_length, datasource_length
+ character(len=16), intent(out) :: event_name
+ character(len=:), allocatable, intent(out) :: datasource ! F03 feature
+ ! Local variables
+ character(len=5) :: datasource_tmp
+ character(len=256) :: CMTSOLUTION, string
+ ! extract all unmodified values from CMTSOLUTION
+ ! get_cmt() routine modify the read values
+ ! TODO factorize what follows and get_cmt.f90 and probably one or two other
+ ! routines
+ call get_value_string(CMTSOLUTION, 'solver.CMTSOLUTION', 'DATA/CMTSOLUTION')
+ open(unit=1,file=CMTSOLUTION,status='old',action='read')
+ datasource_length = 4*NSOURCES ! a datasource is 4 character, by convention
+ allocate(character(len=(datasource_length)) :: datasource, stat=ier)
+ if (ier /=0) &
+ call exit_MPI (myrank, &
+ "error allocating datasource string for adios header")
+ datasource = ""
+ ! ADIOS only (1) byte for a string. This may cause data overwriting.
+ ! => increase the generate by the string size -1
+ adios_groupsize = adios_groupsize + 4*NSOURCES - 1
+ do isource=1,NSOURCES
+
+ read(1,"(a256)") string
+ ! skips empty lines
+ do while( len_trim(string) == 0 )
+ read(1,"(a256)") string
+ enddo
+ ! read header with event information
+ read(string,"(a4,i5,i3,i3,i3,i3,f6.2)") datasource_tmp,yr(isource), &
+ mo(isource),da(isource),ho(isource),mi(isource),sec(isource)
+ datasource = datasource // datasource_tmp
+ ! read event name
+ read(1,"(a)") string
+ read(string(12:len_trim(string)),*) event_name
+ ! read time shift
+ read(1,"(a)") string
+ read(string(12:len_trim(string)),*) t_shift(isource)
+ ! read half duration
+ read(1,"(a)") string
+ read(string(15:len_trim(string)),*) hdur(isource)
+ ! read latitude
+ read(1,"(a)") string
+ read(string(10:len_trim(string)),*) lat(isource)
+ ! read longitude
+ read(1,"(a)") string
+ read(string(11:len_trim(string)),*) long(isource)
+ ! read depth
+ read(1,"(a)") string
+ read(string(7:len_trim(string)),*) depth(isource)
+ ! read Mrr
+ read(1,"(a)") string
+ read(string(5:len_trim(string)),*) mrr(isource)
+ ! read Mtt
+ read(1,"(a)") string
+ read(string(5:len_trim(string)),*) mtt(isource)
+ ! read Mpp
+ read(1,"(a)") string
+ read(string(5:len_trim(string)),*) mpp(isource)
+ ! read Mrt
+ read(1,"(a)") string
+ read(string(5:len_trim(string)),*) mrt(isource)
+ ! read Mrp
+ read(1,"(a)") string
+ read(string(5:len_trim(string)),*) mrp(isource)
+ ! read Mtp
+ read(1,"(a)") string
+ read(string(5:len_trim(string)),*) mtp(isource)
+ enddo
+ close(1)
+ event_name_length = len_trim(event_name)
+end subroutine read_raw_cmtsolution
+
+!> \brief Reads information form the 'STATIONS' file without modifying anything
+!! \param NSTATIONS How many stations are used
+!! \param stlat Array to store the latitude of the stations
+!! \param stlon Array to store the longitude of the stations
+!! \param stele Array to store the elevation of the stations
+!! \param stbur Array to store the burial of the statisons
+!! \param station_name_length Variable to keep the length of the station_name
+!! string
+!! \param station_name String in which the different station names are
+!! concatenated
+!! \param network_name_length Variable to keep the length of the network_name
+!! string
+!! \param network_name String in which the different network names are
+!! concatenated
+subroutine read_raw_stations (NSTATIONS, stlat, stlon, stele, stbur, &
+ station_name_length, station_name, network_name_length, network_name)
+ implicit none
+ ! Parameters
+ integer :: NSTATIONS
+ integer, intent(inout) :: station_name_length, network_name_length ! for later reading
+ character(len=:), allocatable, intent(out) :: station_name, network_name
+ double precision, allocatable, dimension(:), intent(out) :: stlat, stlon, stele, stbur
+ ! Local variables
+ character(len=MAX_LENGTH_STATION_NAME) :: station_name_tmp
+ character(len=MAX_LENGTH_NETWORK_NAME) :: network_name_tmp
+ character(len=256) :: STATIONS, string
+
+ ! Extract values from STATIONS File
+ call get_value_string(STATIONS, 'solver.STATIONS', 'DATA/STATIONS')
+ open(unit=1,file=STATIONS,iostat=ier,status='old',action='read')
+ NSTATIONS = 0
+ do while(ier == 0)
+ read(1,"(a)",iostat=ier) string
+ if(ier == 0) NSTATIONS = NSTATIONS + 1
+ enddo
+ allocate (character (len=(MAX_LENGTH_STATION_NAME*NSTATIONS)) :: station_name)
+ allocate (character (len=(MAX_LENGTH_NETWORK_NAME*NSTATIONS)) :: network_name)
+ allocate (stlat (NSTATIONS))
+ allocate (stlon (NSTATIONS))
+ allocate (stele (NSTATIONS))
+ allocate (stbur (NSTATIONS))
+ station_name = ""
+ network_name = ""
+ rewind(1)
+ do irec = 1,NSTATIONS
+ read(1,*,iostat=ier) station_name_tmp, network_name_tmp, &
+ stlat(irec), stlon(irec), &
+ stele(irec), stbur(irec)
+ if( ier /= 0 ) then
+ write(IMAIN,*) 'error reading in station ',irec
+ call exit_MPI(myrank,'error reading in station in STATIONS file')
+ endif
+ station_name = station_name // trim(station_name_tmp) // " "
+ network_name = network_name // trim(network_name_tmp) // " "
+ enddo
+ close(1)
+ station_name = trim(station_name)
+ network_name = trim(network_name)
+ station_name_length = len(station_name)
+ network_name_length = len(network_name)
+end subroutine read_raw_stations
+
+!> \brief Wrapper to write the 'Par_file' variables into the adios header
+!! \param adios_handle The handle to the file where the variable should be
+!! written
+subroutine write_adios_par_file_variables (adios_handle, &
+ ANGULAR_WIDTH_XI_IN_DEGREES, ANGULAR_WIDTH_ETA_IN_DEGREES, &
+ CENTER_LONGITUDE_IN_DEGREES, CENTER_LATITUDE_IN_DEGREES, &
+ GAMMA_ROTATION_AZIMUTH, HDUR_MOVIE, MOVIE_TOP_KM, MOVIE_BOTTOM_KM, &
+ MOVIE_EAST_DEG, MOVIE_WEST_DEG, MOVIE_NORTH_DEG, MOVIE_SOUTH_DEG, &
+ RECORD_LENGTH_IN_MINUTES, NTSTEP_BETWEEN_OUTPUT_SEISMOS, &
+ NTSTEP_BETWEEN_READ_ADJSRC, NTSTEP_BETWEEN_FRAMES, &
+ NTSTEP_BETWEEN_OUTPUT_INFO, NUMBER_OF_RUNS, NUMBER_OF_THIS_RUN, NCHUNKS, &
+ SIMULATION_TYPE, MOVIE_VOLUME_TYPE, MOVIE_START, MOVIE_STOP, NEX_XI, &
+ NEX_ETA, NPROC_XI, NPROC_ETA, NOISE_TOMOGRAPHY, ELLIPTICITY, GRAVITY, &
+ ROTATION, TOPOGRAPHY, OCEANS, MOVIE_SURFACE, MOVIE_VOLUME, MOVIE_COARSE, &
+ RECEIVERS_CAN_BE_BURIED, PRINT_SOURCE_TIME_FUNCTION, SAVE_MESH_FILES, &
+ ATTENUATION, ATTENUATION_NEW, ABSORBING_CONDITIONS, SAVE_FORWARD, &
+ OUTPUT_SEISMOS_ASCII_TEXT, OUTPUT_SEISMOS_SAC_ALPHANUM, &
+ OUTPUT_SEISMOS_SAC_BINARY, ROTATE_SEISMOGRAMS_RT, &
+ WRITE_SEISMOGRAMS_BY_MASTER, SAVE_ALL_SEISMOS_IN_ONE_FILE, &
+ USE_BINARY_FOR_LARGE_FILE, model_length, MODEL)
+ implicit none
+ ! Parameters
+ integer(kind=8), intent(in) :: adios_handle
+ integer, intent(in) :: NTSTEP_BETWEEN_OUTPUT_SEISMOS, &
+ NTSTEP_BETWEEN_READ_ADJSRC, NTSTEP_BETWEEN_FRAMES, &
+ NTSTEP_BETWEEN_OUTPUT_INFO,NUMBER_OF_RUNS, NUMBER_OF_THIS_RUN,NCHUNKS, &
+ SIMULATION_TYPE, MOVIE_VOLUME_TYPE, MOVIE_START,MOVIE_STOP, NEX_XI, &
+ NEX_ETA,NPROC_XI,NPROC_ETA, NOISE_TOMOGRAPHY
+ double precision, intent(in) :: ANGULAR_WIDTH_XI_IN_DEGREES, &
+ ANGULAR_WIDTH_ETA_IN_DEGREES, CENTER_LONGITUDE_IN_DEGREES, &
+ CENTER_LATITUDE_IN_DEGREES, GAMMA_ROTATION_AZIMUTH, HDUR_MOVIE, &
+ MOVIE_TOP_KM,MOVIE_BOTTOM_KM, MOVIE_EAST_DEG,MOVIE_WEST_DEG, &
+ MOVIE_NORTH_DEG,MOVIE_SOUTH_DEG, RECORD_LENGTH_IN_MINUTES
+ logical, intent(in) :: ELLIPTICITY,GRAVITY,ROTATION,TOPOGRAPHY,OCEANS, &
+ MOVIE_SURFACE, MOVIE_VOLUME,MOVIE_COARSE, RECEIVERS_CAN_BE_BURIED, &
+ PRINT_SOURCE_TIME_FUNCTION, SAVE_MESH_FILES,ATTENUATION,ATTENUATION_NEW, &
+ ABSORBING_CONDITIONS,SAVE_FORWARD, OUTPUT_SEISMOS_ASCII_TEXT, &
+ OUTPUT_SEISMOS_SAC_ALPHANUM,OUTPUT_SEISMOS_SAC_BINARY, &
+ ROTATE_SEISMOGRAMS_RT,WRITE_SEISMOGRAMS_BY_MASTER, &
+ SAVE_ALL_SEISMOS_IN_ONE_FILE,USE_BINARY_FOR_LARGE_FILE
+ integer, intent(in) :: model_length
+ character(len=*), intent(in) :: MODEL
+ ! Local variables
+ integer :: adios_err
+
+ call adios_write (adios_handle, "ANGULAR_WIDTH_XI_IN_DEGREES", ANGULAR_WIDTH_XI_IN_DEGREES, adios_err)
+ call adios_write (adios_handle, "ANGULAR_WIDTH_ETA_IN_DEGREES", ANGULAR_WIDTH_ETA_IN_DEGREES, adios_err)
+ call adios_write (adios_handle, "CENTER_LONGITUDE_IN_DEGREES", CENTER_LONGITUDE_IN_DEGREES, adios_err)
+ call adios_write (adios_handle, "CENTER_LATITUDE_IN_DEGREES", CENTER_LATITUDE_IN_DEGREES, adios_err)
+ call adios_write (adios_handle, "GAMMA_ROTATION_AZIMUTH", GAMMA_ROTATION_AZIMUTH, adios_err)
+ call adios_write (adios_handle, "HDUR_MOVIE", HDUR_MOVIE, adios_err)
+ call adios_write (adios_handle, "MOVIE_TOP_KM", MOVIE_TOP_KM, adios_err)
+ call adios_write (adios_handle, "MOVIE_BOTTOM_KM", MOVIE_BOTTOM_KM, adios_err)
+ call adios_write (adios_handle, "MOVIE_EAST_DEG", MOVIE_EAST_DEG, adios_err)
+ call adios_write (adios_handle, "MOVIE_WEST_DEG", MOVIE_WEST_DEG, adios_err)
+ call adios_write (adios_handle, "MOVIE_NORTH_DEG", MOVIE_NORTH_DEG, adios_err)
+ call adios_write (adios_handle, "MOVIE_SOUTH_DEG", MOVIE_SOUTH_DEG, adios_err)
+ call adios_write (adios_handle, "RECORD_LENGTH_IN_MINUTES", RECORD_LENGTH_IN_MINUTES, adios_err)
+ call adios_write (adios_handle, "NTSTEP_BETWEEN_OUTPUT_SEISMOS", NTSTEP_BETWEEN_OUTPUT_SEISMOS, adios_err)
+ call adios_write (adios_handle, "NTSTEP_BETWEEN_READ_ADJSRC", NTSTEP_BETWEEN_READ_ADJSRC, adios_err)
+ call adios_write (adios_handle, "NTSTEP_BETWEEN_FRAMES", NTSTEP_BETWEEN_FRAMES, adios_err)
+ call adios_write (adios_handle, "NTSTEP_BETWEEN_OUTPUT_INFO", NTSTEP_BETWEEN_OUTPUT_INFO, adios_err)
+ call adios_write (adios_handle, "NUMBER_OF_RUNS", NUMBER_OF_RUNS, adios_err)
+ call adios_write (adios_handle, "NUMBER_OF_THIS_RUN", NUMBER_OF_THIS_RUN, adios_err)
+ call adios_write (adios_handle, "NCHUNKS", NCHUNKS, adios_err)
+ call adios_write (adios_handle, "SIMULATION_TYPE", SIMULATION_TYPE, adios_err)
+ call adios_write (adios_handle, "MOVIE_VOLUME_TYPE", MOVIE_VOLUME_TYPE, adios_err)
+ call adios_write (adios_handle, "MOVIE_START", MOVIE_START, adios_err)
+ call adios_write (adios_handle, "MOVIE_STOP", MOVIE_STOP, adios_err)
+ call adios_write (adios_handle, "NEX_XI", NEX_XI, adios_err)
+ call adios_write (adios_handle, "NEX_ETA", NEX_ETA, adios_err)
+ call adios_write (adios_handle, "NPROC_XI", NPROC_XI, adios_err)
+ call adios_write (adios_handle, "NPROC_ETA", NPROC_ETA, adios_err)
+ call adios_write (adios_handle, "NOISE_TOMOGRAPHY", NOISE_TOMOGRAPHY, adios_err)
+ call adios_write (adios_handle, "ELLIPTICITY", ELLIPTICITY, adios_err)
+ call adios_write (adios_handle, "GRAVITY", GRAVITY, adios_err)
+ call adios_write (adios_handle, "ROTATION", ROTATION, adios_err)
+ call adios_write (adios_handle, "TOPOGRAPHY", TOPOGRAPHY, adios_err)
+ call adios_write (adios_handle, "OCEANS", OCEANS, adios_err)
+ call adios_write (adios_handle, "MOVIE_SURFACE", MOVIE_SURFACE, adios_err)
+ call adios_write (adios_handle, "MOVIE_VOLUME", MOVIE_VOLUME, adios_err)
+ call adios_write (adios_handle, "MOVIE_COARSE", MOVIE_COARSE, adios_err)
+ call adios_write (adios_handle, "RECEIVERS_CAN_BE_BURIED", RECEIVERS_CAN_BE_BURIED, adios_err)
+ call adios_write (adios_handle, "PRINT_SOURCE_TIME_FUNCTION", PRINT_SOURCE_TIME_FUNCTION, adios_err)
+ call adios_write (adios_handle, "SAVE_MESH_FILES", SAVE_MESH_FILES, adios_err)
+ call adios_write (adios_handle, "ATTENUATION", ATTENUATION, adios_err)
+ call adios_write (adios_handle, "ATTENUATION_NEW", ATTENUATION_NEW, adios_err)
+ call adios_write (adios_handle, "ABSORBING_CONDITIONS", ABSORBING_CONDITIONS, adios_err)
+ call adios_write (adios_handle, "SAVE_FORWARD", SAVE_FORWARD, adios_err)
+ call adios_write (adios_handle, "OUTPUT_SEISMOS_ASCII_TEXT", OUTPUT_SEISMOS_ASCII_TEXT, adios_err)
+ call adios_write (adios_handle, "OUTPUT_SEISMOS_SAC_ALPHANUM", OUTPUT_SEISMOS_SAC_ALPHANUM, adios_err)
+ call adios_write (adios_handle, "OUTPUT_SEISMOS_SAC_BINARY", OUTPUT_SEISMOS_SAC_BINARY, adios_err)
+ call adios_write (adios_handle, "ROTATE_SEISMOGRAMS_RT", ROTATE_SEISMOGRAMS_RT, adios_err)
+ call adios_write (adios_handle, "WRITE_SEISMOGRAMS_BY_MASTER", WRITE_SEISMOGRAMS_BY_MASTER, adios_err)
+ call adios_write (adios_handle, "SAVE_ALL_SEISMOS_IN_ONE_FILE", SAVE_ALL_SEISMOS_IN_ONE_FILE, adios_err)
+ call adios_write (adios_handle, "USE_BINARY_FOR_LARGE_FILE", USE_BINARY_FOR_LARGE_FILE, adios_err)
+ call adios_write (adios_handle, "model_length", model_length, adios_err)
+ call adios_write (adios_handle, "MODEL", MODEL, adios_err)
+end subroutine write_adios_par_file_variables
+
+!> \brief Wrapper to write the 'CMTSOLUTION' variables into the adios header
+!! \param adios_handle The handle to the file where the variable should be
+!! written
+subroutine write_adios_cmtsolution_variables (adios_handle, &
+ NSOURCES, yr, mo, da, ho, mi, sec, t_shift, hdur, lat, long, depth, &
+ mrr, mtt, mpp, mrt, mrp, mtp, event_name_length, event_name, &
+ datasource_length, datasource)
+ implicit none
+ ! Parameters
+ integer(kind=8), intent(in) :: adios_handle
+ integer, intent(in) :: NSOURCES
+ integer, dimension(NSOURCES), intent(in) :: yr, mo, da, ho, mi
+ double precision, dimension(NSOURCES), intent(in) :: sec, t_shift, hdur, &
+ lat, long, depth
+ double precision, dimension(NSOURCES), intent(in) :: mrr, mtt, mpp, &
+ mrt, mrp, mtp
+ integer, intent(in) :: event_name_length, datasource_length
+ character(len=16), intent(in) :: event_name
+ character(len=:), allocatable, intent(in) :: datasource ! F03 feature
+ ! Local variables
+ integer :: adios_err
+
+ call adios_write (adios_handle, "NSOURCES", NSOURCES, adios_err)
+ call adios_write (adios_handle, "year", yr, adios_err)
+ call adios_write (adios_handle, "month", mo, adios_err)
+ call adios_write (adios_handle, "day", da, adios_err)
+ call adios_write (adios_handle, "hour", ho, adios_err)
+ call adios_write (adios_handle, "minute", mi, adios_err)
+ call adios_write (adios_handle, "second", sec, adios_err)
+ call adios_write (adios_handle, "time_shift", t_shift, adios_err)
+ call adios_write (adios_handle, "half_duration", hdur, adios_err)
+ call adios_write (adios_handle, "latitude", lat, adios_err)
+ call adios_write (adios_handle, "longitude", long, adios_err)
+ call adios_write (adios_handle, "depth", depth, adios_err)
+ call adios_write (adios_handle, "mrr", mrr, adios_err)
+ call adios_write (adios_handle, "mtt", mtt, adios_err)
+ call adios_write (adios_handle, "mpp", mpp, adios_err)
+ call adios_write (adios_handle, "mrt", mrt, adios_err)
+ call adios_write (adios_handle, "mrp", mrp, adios_err)
+ call adios_write (adios_handle, "mtp", mtp, adios_err)
+ call adios_write (adios_handle, "event_name_length", event_name_length, adios_err)
+ call adios_write (adios_handle, "event_name", event_name, adios_err)
+ call adios_write (adios_handle, "datasource_length", datasource_length, adios_err)
+ call adios_write (adios_handle, "datasource", datasource, adios_err)
+end subroutine write_adios_cmtsolution_variables
+
+!> \brief Wrapper to write the 'STATIONS' variables into the adios header
+!! \param adios_handle The handle to the file where the variable should be
+!! written
+subroutine write_adios_stations_variables (adios_handle, &
+ NSTATIONS, stlat, stlon, stele, stbur, station_name_length, station_name, &
+ network_name_length, network_name)
+ implicit none
+ ! Parameters
+ integer(kind=8), intent(in) :: adios_handle
+ integer, intent(in):: NSTATIONS
+ integer, intent(in):: station_name_length, network_name_length ! for later reading
+ character(len=:), allocatable, intent(in) :: station_name, network_name
+ double precision, allocatable, dimension(:), intent(in) :: stlat, stlon, &
+ stele, stbur
+ ! Local variables
+ integer :: adios_err
+
+ call adios_write (adios_handle, "NSTATIONS", NSTATIONS, adios_err)
+ call adios_write (adios_handle, "station_latitude", stlat, adios_err)
+ call adios_write (adios_handle, "station_longitude", stlon, adios_err)
+ call adios_write (adios_handle, "station_elevation", stele, adios_err)
+ call adios_write (adios_handle, "station_burial", stbur, adios_err)
+ call adios_write (adios_handle, "station_name_length", station_name_length, adios_err)
+ call adios_write (adios_handle, "network_name_length", network_name_length, adios_err)
+ call adios_write (adios_handle, "station_name", station_name, adios_err)
+ call adios_write (adios_handle, "network_name", network_name, adios_err)
+end subroutine write_adios_stations_variables
+
+end subroutine write_specfem_header_adios
More information about the CIG-COMMITS
mailing list