Fortran SFF API to data I/O streams in C++
fapid_sff_getwid2values.f
Go to the documentation of this file.
1 c this is <fapid_sff_getwid2values.f>
2 c ----------------------------------------------------------------------------
3 c
4 c Copyright (c) 2011 by Thomas Forbriger (BFO Schiltach)
5 c
6 c functions to extract values from WID2 line
7 c
8 c ----
9 c This program is free software; you can redistribute it and/or modify
10 c it under the terms of the GNU General Public License as published by
11 c the Free Software Foundation; either version 2 of the License, or
12 c (at your option) any later version.
13 c
14 c This program is distributed in the hope that it will be useful,
15 c but WITHOUT ANY WARRANTY; without even the implied warranty of
16 c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 c GNU General Public License for more details.
18 c
19 c You should have received a copy of the GNU General Public License
20 c along with this program; if not, write to the Free Software
21 c Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
22 c ----
23 c
24 c These functions are just copied from stuff.f
25 c
26 c REVISIONS and CHANGES
27 c 17/01/2011 V1.0 Thomas Forbriger
28 c 01/04/2011 V1.1 decode WID2 line
29 c
30 c ============================================================================
31 c
32 c Utilities to extract info from wid2line
33 cD
34 c---------------------------------------------------------------------------
35  subroutine sff_getdate(wid2line,date)
36 c
37 c extract date (yyyy/mm/dd)
38 c
39  character wid2line*132, date*(*)
40 cE
41  character wid2decoded*132
42 c
43  call sff_helper_decode_wid2(wid2line, wid2decoded)
44  date = wid2decoded(6:15)
45  return
46  end
47 cD
48 c---------------------------------------------------------------------------
49  subroutine sff_gettime(wid2line, time)
50 c
51 c extract time (hh:mm:ss.sss)
52 c
53  character wid2line*132, time*(*)
54 cE
55  character wid2decoded*132
56 c
57  call sff_helper_decode_wid2(wid2line, wid2decoded)
58  time = wid2decoded(17:28)
59  return
60  end
61 cD
62 c---------------------------------------------------------------------------
63  subroutine sff_getstation(wid2line, sta)
64 c
65 c extract station name (a5)
66 c
67  character wid2line*132, sta*(*)
68 cE
69  character wid2decoded*132
70 c
71  call sff_helper_decode_wid2(wid2line, wid2decoded)
72  sta = wid2decoded(30:34)
73  return
74  end
75 cD
76 c---------------------------------------------------------------------------
77  subroutine sff_getchannel(wid2line, channel)
78 c
79 c extract channel name (a3)
80 c
81  character wid2line*132, channel*(*)
82 cE
83  character wid2decoded*132
84 c
85  call sff_helper_decode_wid2(wid2line, wid2decoded)
86  channel = wid2decoded(36:38)
87  return
88  end
89 cD
90 c---------------------------------------------------------------------------
91  integer function sff_getn(wid2line)
92 c
93 c extract number of samples
94 c
95  character wid2line*132
96 cE
97  integer n
98  character wid2decoded*132
99 c
100  call sff_helper_decode_wid2(wid2line, wid2decoded)
101 c
102  read(wid2decoded(49:56),'(i8)') n
103  sff_getn = n
104  return
105  end
106 cD
107 c---------------------------------------------------------------------------
108  real function sff_getdt(wid2line)
109 c
110 c extract sampling interval
111 c
112  character wid2line*132
113 cE
114  real dt
115  character wid2decoded*132
116 c
117  call sff_helper_decode_wid2(wid2line, wid2decoded)
118 c
119  read(wid2decoded(58:68),'(f11.6)') dt
120  sff_getdt = 1./dt
121  return
122  end
123 c
124 c ----- END OF fapid_sff_getwid2values.f -----