source: XMLF90/src/sax/m_converters.f90

Last change on this file was 6, checked in by ymipsl, 13 years ago

Import des sources XMLF90

File size: 5.1 KB
Line 
1module m_converters
2
3use m_debug
4
5private
6!
7! Takes a string and turns it into useful data structures,
8! such as numerical arrays.
9!
10! NOTE: The string must contain *homogeneous* data, i.e.: all real numbers,
11! all integers, etc.
12!
13public :: build_data_array
14
15interface build_data_array
16      module procedure build_data_array_real_sp,  &
17                       build_data_array_real_dp,  &
18                       build_data_array_integer
19end interface
20private :: build_data_array_real_sp
21private :: build_data_array_real_dp
22private :: build_data_array_integer
23
24private :: token_analysis, is_separator, is_CR_or_LF
25
26CONTAINS
27
28!---------------------------------------------------------------
29subroutine build_data_array_real_dp(str,x,n)
30integer, parameter  :: dp = selected_real_kind(14)
31!
32character(len=*), intent(in)                ::  str
33real(kind=dp), dimension(:), intent(inout)  ::    x
34integer, intent(inout)                      ::    n
35
36integer                            :: ntokens, status, last_pos
37character(len=len(str))  :: s
38
39s = str
40call token_analysis(s,ntokens,last_pos)
41if (debug) print *, "ntokens, last_pos ", ntokens, last_pos
42if (debug) print *, s
43if ((n + ntokens) > size(x)) STOP "data array full"
44read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens)
45if (status /= 0) STOP "real conversion error"
46n = n + ntokens
47
48end subroutine build_data_array_real_dp
49!---------------------------------------------------------------
50
51subroutine build_data_array_real_sp(str,x,n)
52integer, parameter  :: sp = selected_real_kind(6)
53!
54character(len=*), intent(in)                :: str
55real(kind=sp), dimension(:), intent(inout)  ::    x
56integer, intent(inout)                      ::    n
57
58integer                            :: ntokens, status, last_pos
59character(len=len(str))  :: s
60
61s = str
62call token_analysis(s,ntokens,last_pos)
63if (debug) print *, "ntokens, last_pos ", ntokens, last_pos
64if (debug) print *, s
65if ((n + ntokens) > size(x)) STOP "data array full"
66read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens)
67if (status /= 0) STOP "real conversion error"
68n = n + ntokens
69
70end subroutine build_data_array_real_sp
71
72!---------------------------------------------------------------
73subroutine build_data_array_integer(str,x,n)
74integer, parameter  :: sp = selected_real_kind(14)
75!
76character(len=*), intent(in)                :: str
77integer, dimension(:), intent(inout)        ::    x
78integer, intent(inout)                      ::    n
79
80integer                            :: ntokens, status, last_pos
81character(len=len(str))  :: s
82
83s = str
84call token_analysis(s,ntokens,last_pos)
85if (debug) print *, "ntokens, last_pos ", ntokens, last_pos
86if (debug) print *, s
87if ((n + ntokens) > size(x)) STOP "data array full"
88read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens)
89if (status /= 0) STOP "integer conversion error"
90n = n + ntokens
91
92end subroutine build_data_array_integer
93
94
95!==================================================================
96
97function is_separator(c) result(sep)
98character(len=1), intent(in)          :: c
99logical                               :: sep
100
101 sep = ((c == char(32)) .or. (c == char(10))             &
102         .or. (c == char(9)) .or. (c == char(13)))
103
104end function is_separator
105!----------------------------------------------------------------
106function is_CR_or_LF(c) result(res)
107character(len=1), intent(in)          :: c
108logical                               :: res
109
110 res = ((c == char(10)) .or. (c == char(13)))
111
112end function is_CR_or_LF
113
114!==================================================================
115
116subroutine token_analysis(str,ntokens,last_pos)
117!
118character(len=*), intent(inout)          :: str
119integer, intent(out)                     :: ntokens, last_pos
120!
121!
122! Checks the contents of a string and finds the number of tokens it contains
123! The standard separator is generalized whitespace (space, tab, CR, or LF)
124! It also returns the last useful position in the string (excluding
125! separator characters which are not blanks, and thus not caught by the
126! (len_)trim fortran intrinsic). This is necessary to perform list-directed
127! I/O in the string as an internal file.
128!
129! Also, replace on the fly CR and LF by blanks. This is necessary if
130! str spans more than one record. In that case, internal reads only
131! look at the first record.
132! -- ** Compiler limits on size of internal record??
133!
134integer           :: i, str_length
135logical           :: in_token
136character(len=1)  :: c
137
138in_token = .false.
139ntokens = 0
140last_pos = 0
141
142str_length = len_trim(str)
143!print *, "string length: ", str_length
144
145do i = 1, str_length
146      c = str(i:i)
147
148      if (in_token) then
149         if (is_separator(c)) then
150            in_token = .false.
151            if (is_CR_or_LF(c)) str(i:i) = " "
152         else
153            last_pos = i
154         endif
155
156      else   ! not in token
157         
158         if (is_separator(c)) then
159            if (is_CR_or_LF(c)) str(i:i) = " "
160            ! do nothing
161         else
162            in_token = .true.
163            last_pos = i
164            ntokens = ntokens + 1
165         endif
166      endif
167enddo
168!print *, "ntokens, last_pos: ", ntokens, last_pos
169
170end subroutine token_analysis
171
172
173end module m_converters
174
175
176
177
178
179
180
Note: See TracBrowser for help on using the repository browser.