Branch data Line data Source code
1 : : !!****m* ABINIT/m_stream_string
2 : : !! NAME
3 : : !! m_stream_string
4 : : !!
5 : : !! FUNCTION
6 : : !! This module define a type representing a variable size
7 : : !! string. It can be used in a file-like way by writing to it or reading it.
8 : : !! Memory is automatically allocated on writing and freed on reading.
9 : : !!
10 : : !! COPYRIGHT
11 : : !! Copyright (C) 2009-2026 ABINIT group (TC, MG)
12 : : !! This file is distributed under the terms of the
13 : : !! GNU General Public License, see ~abinit/COPYING
14 : : !! or http://www.gnu.org/copyleft/gpl.txt .
15 : : !!
16 : : !! NOTES
17 : : !! Provide tools to manipulate variable size strings in an incremental FIFO way
18 : : !! Use `stream%push` to incrementally fill the string. The required memory space will be allocated
19 : : !! automatically when needed.
20 : : !! To avoid memory leaks you have to use stream_free on the stream to free the memory space unless
21 : : !! you already flushed it using stream%flush, stream%transfer, stream%to_string or stream%to_file.
22 : : !! Unlike the last four methods, stream_copy and stream_debug do not modify the source stream
23 : : !!
24 : : !! SOURCE
25 : :
26 : : #if defined HAVE_CONFIG_H
27 : : #include "config.h"
28 : : #endif
29 : :
30 : : #include "abi_common.h"
31 : :
32 : : module m_stream_string
33 : :
34 : : use defs_basis
35 : : use m_profiling_abi
36 : :
37 : : use m_fstrings, only : prep_char !, replace
38 : :
39 : : implicit none
40 : :
41 : : private
42 : :
43 : : integer,public,parameter :: chunk_size = 248
44 : :
45 : : type,private :: stream_chunk
46 : : type(stream_chunk), pointer :: next => null()
47 : : character(len=chunk_size) :: chunk = repeat(' ', chunk_size)
48 : : end type stream_chunk
49 : :
50 : : type,public :: stream_string
51 : : integer :: length = 0
52 : : type(stream_chunk), pointer :: head => null()
53 : : contains
54 : : procedure :: flush => stream_flush_unit
55 : : procedure :: flush_units => stream_flush_units
56 : : procedure :: free => stream_free
57 : : procedure :: copy => stream_copy
58 : : procedure :: push => stream_push
59 : : procedure :: pop_chunk => stream_pop_chunk
60 : : procedure :: to_string => stream_to_string
61 : : procedure :: to_file => stream_to_file
62 : : procedure :: transfer => stream_transfer
63 : : procedure :: debug => stream_debug
64 : :
65 : : end type stream_string
66 : :
67 : : contains
68 : : !!***
69 : :
70 : 24491 : subroutine stream_flush_unit(stream, unit, newline, firstchar)
71 : :
72 : : class(stream_string),intent(inout) :: stream
73 : : integer,intent(in) :: unit
74 : : logical,optional,intent(in) :: newline
75 : : character(len=*),optional,intent(in) :: firstchar
76 : :
77 : 24491 : character(len=stream%length) :: s
78 : 24491 : character(len=2 * stream%length) :: new_s
79 : : #ifdef FC_CRAY
80 : : integer :: i,l
81 : : integer, parameter :: c = 32767
82 : : #endif
83 : :
84 [ - + ]: 24491 : if (unit == dev_null) then
85 : 0 : call stream%free()
86 : 0 : return
87 : : end if
88 : :
89 : 24491 : call stream%to_string(s)
90 : :
91 [ + + ]: 24491 : if (present(firstchar)) then
92 : : !new_s = trim(firstchar) // trim(replace(trim(s), ch10, ch10//trim(firstchar)))
93 [ + - - + ]: 5 : new_s = prep_char(s, firstchar)
94 : 5 : write(unit, "(a)")trim(new_s)
95 : : else
96 : : #if defined FC_NVHPC || defined FC_LLVM
97 : : write(unit, "(a)") s
98 : : #else
99 : : #ifdef FC_CRAY
100 : : if(len_trim(s) <= c) then
101 : : write(unit, "(a)") trim(s)
102 : : else
103 : : l=len_trim(s)/c
104 : : do i=1,l
105 : : write(unit, "(a)") s((i-1)*c+1:i*c)
106 : : end do
107 : : write(unit, "(a)") s(l*c+1:len_trim(s))
108 : : end if
109 : : #else
110 : 24486 : write(unit, "(a)") trim(s)
111 : : #endif
112 : : #endif
113 : : end if
114 : :
115 [ + + ]: 24491 : if (present(newline)) then
116 [ + + ]: 24479 : if (newline) write(unit, "(a)")""
117 : : end if
118 : :
119 : 24491 : call stream%free()
120 : :
121 : : end subroutine stream_flush_unit
122 : :
123 : :
124 [ - + ]: 36873 : subroutine stream_flush_units(stream, units, newline)
125 : :
126 : : class(stream_string),intent(inout) :: stream
127 : : integer,intent(in) :: units(:)
128 : : logical,optional,intent(in) :: newline
129 : :
130 : : !Local variables-------------------------------
131 : : !scalars
132 : : integer :: ii, cnt
133 : 36873 : character(len=stream%length) :: s
134 : : !arrays
135 : 73746 : integer :: my_units(size(units))
136 : : !******************************************************************
137 : :
138 : : ! Remove duplicated units (if any)
139 : 36873 : my_units(1) = units(1); cnt = 1
140 [ + + ]: 36876 : do ii=2,size(units)
141 [ + + + - : 6 : if (any(units(ii) == my_units(1:cnt))) cycle
- + ]
142 : 3 : cnt = cnt + 1
143 : 36876 : my_units(cnt) = units(ii)
144 : : end do
145 : :
146 : 36873 : call stream%to_string(s)
147 : :
148 [ + + ]: 73749 : do ii=1,cnt
149 [ + - ]: 36876 : if (units(ii) == dev_null) cycle
150 : : #if defined FC_NVHPC || defined FC_LLVM
151 : : write(units(ii), "(a)")s
152 : : #else
153 : 36876 : write(units(ii), "(a)")trim(s)
154 : : #endif
155 [ + - ]: 73749 : if (present(newline)) then
156 [ + - ]: 36876 : if (newline) write(units(ii), "(a)")""
157 : : end if
158 : : end do
159 : :
160 : 36873 : call stream%free()
161 : :
162 : 36873 : end subroutine stream_flush_units
163 : :
164 : : !!****f* m_stream_string/stream_free
165 : : !! NAME
166 : : !! stream_free
167 : : !!
168 : : !! FUNCTION
169 : : !! free stream. Most of the time this is not needed since
170 : : !! routines to access the content free the stream
171 : : !!
172 : : !! SOURCE
173 : :
174 : 64038 : subroutine stream_free(stream)
175 : :
176 : : class(stream_string),intent(inout) :: stream
177 : : type(stream_chunk), pointer :: cursor, prev
178 : 64038 : cursor => stream%head
179 [ + + ]: 69045 : do while (associated(cursor))
180 : 5007 : prev => cursor
181 : 5007 : cursor => cursor%next
182 : 69045 : ABI_FREE_SCALAR(prev)
183 : : end do
184 : 64038 : stream%head => NULL()
185 : 64038 : stream%length = 0
186 : :
187 : 64038 : end subroutine stream_free
188 : : !!***
189 : :
190 : : !!****f* m_stream_string/stream_copy
191 : : !! NAME
192 : : !! stream_copy
193 : : !!
194 : : !! FUNCTION
195 : : !! copy src content to dest without altering src
196 : : !!
197 : : !! SOURCE
198 : :
199 : 0 : subroutine stream_copy(src, dest)
200 : : class(stream_string),intent(inout) :: src, dest
201 : : type(stream_chunk), pointer :: cursor
202 : 0 : cursor => src%head
203 [ # # ]: 0 : do while (associated(cursor))
204 : 0 : call dest%push(cursor%chunk)
205 : 0 : cursor => cursor%next
206 : : end do
207 : 0 : end subroutine stream_copy
208 : : !!***
209 : :
210 : : !!****f* m_stream_string/stream_push
211 : : !! NAME
212 : : !! stream_push
213 : : !!
214 : : !! FUNCTION
215 : : !! Write string to stream, allocating memory if needed
216 : : !!
217 : : !! SOURCE
218 : :
219 : 4459942 : subroutine stream_push(stream, string)
220 : : class(stream_string),intent(inout) :: stream
221 : : character(len=*),intent(in) :: string
222 : : integer :: offset, room_left, soffset
223 : : type(stream_chunk), pointer :: cursor
224 : :
225 : 4459942 : offset = stream%length
226 : :
227 : 4459942 : if (.not.associated(stream%head)) then
228 [ - + ]: 64038 : ABI_MALLOC_SCALAR(stream%head)
229 : : end if
230 : 4459942 : cursor => stream%head
231 : :
232 [ + + ]: 8299417 : do while(offset > chunk_size)
233 : 3839475 : cursor => cursor%next
234 : 3839475 : offset = offset - chunk_size
235 : : end do
236 : :
237 : 4459942 : room_left = chunk_size - offset
238 [ + + ]: 4459942 : if (room_left < len(string)) then
239 [ + + - + ]: 81754 : cursor%chunk(offset+1:chunk_size) = string(1:room_left)
240 : : soffset = room_left
241 [ + + ]: 163508 : do while (soffset < len(string))
242 [ - + ]: 81754 : ABI_MALLOC_SCALAR(cursor%next)
243 : : cursor%next%chunk(1:min(chunk_size, len(string)-soffset)) = &
244 [ - + ]: 81754 : string(soffset+1:min(soffset+chunk_size,len(string)))
245 : 81754 : cursor => cursor%next
246 : 163508 : soffset = soffset + chunk_size
247 : : end do
248 : : else
249 [ + - - + ]: 4378188 : cursor%chunk(offset+1:offset+len(string)) = string
250 : : end if
251 : 4459942 : stream%length = stream%length + len(string)
252 : :
253 [ + + ]: 4459942 : end subroutine stream_push
254 : : !!***
255 : :
256 : : !!****f* m_stream_string/stream_pop_chunk
257 : : !! NAME
258 : : !! stream_pop_chunk
259 : : !!
260 : : !! FUNCTION
261 : : !! Remove the last chunk of stream an put its content in string
262 : : !!
263 : : !! SOURCE
264 : :
265 : 140785 : subroutine stream_pop_chunk(stream, string)
266 : : class(stream_string),intent(inout) :: stream
267 : : character(len=chunk_size),intent(out) :: string
268 : : type(stream_chunk),pointer :: cursor
269 : :
270 : 140785 : string = stream%head%chunk
271 [ + + ]: 140785 : if (stream%length > chunk_size) then
272 : : ! copy the next pointer
273 : 79421 : cursor => stream%head%next
274 : : ! have next pointing to nothing
275 : : stream%head%next => NULL()
276 : : ! free head
277 : 79421 : ABI_FREE_SCALAR(stream%head)
278 : 79421 : stream%head => cursor
279 : 79421 : stream%length = stream%length - chunk_size
280 : : else
281 [ - + ]: 61364 : ABI_FREE_SCALAR(stream%head)
282 : 61364 : stream%length = 0
283 : : end if
284 : :
285 : 140785 : end subroutine stream_pop_chunk
286 : : !!***
287 : :
288 : : !!****f* m_stream_string/stream_to_string
289 : : !! NAME
290 : : !! stream_to_string
291 : : !!
292 : : !! FUNCTION
293 : : !! Copy the content of stream to string, freeing stream. String must be large enough
294 : : !!
295 : : !! SOURCE
296 : :
297 : 61364 : subroutine stream_to_string(stream, string)
298 : :
299 : : class(stream_string),intent(inout) :: stream
300 : : character(len=*),intent(out) :: string
301 : : character(len=chunk_size) :: stmp
302 : : integer :: offset, length
303 : 61364 : offset = 0
304 : :
305 [ + + + - : 27429244 : string = repeat(' ', len(string))
- + ]
306 [ + + ]: 202149 : do while (stream%length > 0)
307 : 140785 : length = stream%length
308 : 140785 : call stream%pop_chunk(stmp)
309 : 140785 : string(offset+1:offset+min(length, chunk_size)) = stmp(1:min(length, chunk_size))
310 : 140785 : offset = offset + chunk_size
311 : : end do
312 : :
313 [ - + ]: 61364 : end subroutine stream_to_string
314 : : !!***
315 : :
316 : : !!****f* m_stream_string/stream_to_file
317 : : !! NAME
318 : : !! stream_to_file
319 : : !!
320 : : !! FUNCTION
321 : : !! Write the content of stream to the file, freeing stream
322 : : !!
323 : : !! SOURCE
324 : :
325 : 0 : subroutine stream_to_file(stream, file_d)
326 : : class(stream_string),intent(inout) :: stream
327 : : integer,intent(in) :: file_d
328 : : character(len=chunk_size) :: stmp
329 : : integer :: offset, length
330 : 0 : offset = 0
331 : :
332 [ # # ]: 0 : do while (stream%length > 0)
333 : 0 : length = stream%length
334 : 0 : call stream%pop_chunk(stmp)
335 : 0 : write(file_d, '(A)', advance='no') stmp(1:min(length, chunk_size))
336 : 0 : offset = offset + chunk_size
337 : : end do
338 : :
339 : 0 : end subroutine stream_to_file
340 : : !!***
341 : :
342 : : !!****f* m_stream_string/stream_transfer
343 : : !! NAME
344 : : !! stream_transfer
345 : : !!
346 : : !! FUNCTION
347 : : !! Copy the content of src to dest, freeing src
348 : : !! If possible does not reallocate memory and just have
349 : : !! dest point to src content
350 : : !!
351 : : !! SOURCE
352 : :
353 : 0 : subroutine stream_transfer(src, dest)
354 : : class(stream_string),intent(inout) :: src, dest
355 : : character(len=chunk_size) :: chunk
356 : : integer :: length
357 [ # # ]: 0 : if(.not.associated(dest%head)) then
358 : : ! if possible just transfer the pointer
359 : 0 : dest%head => src%head
360 : 0 : dest%length = src%length
361 : 0 : src%head => NULL()
362 : : else
363 [ # # ]: 0 : do while (src%length > 0)
364 : 0 : length = src%length
365 : 0 : call src%pop_chunk(chunk)
366 [ # # ]: 0 : if(length > chunk_size) then
367 : 0 : call dest%push(chunk)
368 : : else
369 : 0 : call dest%push(chunk(1:length))
370 : : end if
371 : : end do
372 : : end if
373 : :
374 : 0 : end subroutine stream_transfer
375 : : !!***
376 : :
377 : : !!****f* m_stream_string/stream_debug
378 : : !! NAME
379 : : !! stream_debug
380 : : !!
381 : : !! FUNCTION
382 : : !! Show the content of the chunks on stdout
383 : : !!
384 : : !! SOURCE
385 : :
386 : 0 : subroutine stream_debug(src)
387 : : class(stream_string),intent(inout) :: src
388 : : type(stream_chunk), pointer :: cursor
389 : : integer :: c
390 : 0 : cursor => src%head
391 : 0 : c = 1
392 [ # # ]: 0 : do while (associated(cursor))
393 : 0 : write(std_out,*) "Chunk no", c
394 : 0 : write(std_out,'(A)') cursor%chunk
395 : 0 : cursor => cursor%next
396 : 0 : c = c + 1
397 : : end do
398 : 0 : end subroutine stream_debug
399 : : !!***
400 : :
401 : 0 : end module m_stream_string
402 : : !!***
|
