libsim Versione 7.1.11
file_utilities.F90
1! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2! authors:
3! Davide Cesari <dcesari@arpa.emr.it>
4! Paolo Patruno <ppatruno@arpa.emr.it>
5
6! This program is free software; you can redistribute it and/or
7! modify it under the terms of the GNU General Public License as
8! published by the Free Software Foundation; either version 2 of
9! the License, or (at your option) any later version.
10
11! This program is distributed in the hope that it will be useful,
12! but WITHOUT ANY WARRANTY; without even the implied warranty of
13! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14! GNU General Public License for more details.
15
16! You should have received a copy of the GNU General Public License
17! along with this program. If not, see <http://www.gnu.org/licenses/>.
18#include "config.h"
19
26MODULE file_utilities
27USE kinds
33IMPLICIT NONE
34
35CHARACTER(len=128), PARAMETER :: package_name = package
36CHARACTER(len=128), PARAMETER :: prefix = prefix
37
38INTEGER, PARAMETER, PRIVATE :: nftype = 2
39CHARACTER(len=10), PARAMETER, PRIVATE :: &
40 preflist(2,nftype) = reshape((/ &
41 '/usr/local', '/usr ', &
42 '/usr/local', ' '/), &
43 (/2,nftype/))
44CHARACTER(len=6), PARAMETER, PRIVATE :: &
45 postfix(nftype) = (/ '/share', '/etc ' /)
46CHARACTER(len=6), PARAMETER, PRIVATE :: &
47 filetypename(nftype) = (/ 'DATA ', 'CONFIG' /)
48INTEGER, PARAMETER :: filetype_data = 1
49INTEGER, PARAMETER :: filetype_config = 2
50
51
55TYPE csv_record
56 PRIVATE
57 INTEGER :: cursor, action, nfield !, ntotal
58 INTEGER(KIND=int_b) :: csep, cquote
59 INTEGER(KIND=int_b), POINTER :: record(:)
60END TYPE csv_record
61
62INTEGER, PARAMETER, PRIVATE :: csv_basereclen=1024, &
63 csv_action_read=0, csv_action_write=1
64
67INTERFACE init
68 MODULE PROCEDURE csv_record_init
69END INTERFACE
70
74INTERFACE delete
75 MODULE PROCEDURE csv_record_delete
76END INTERFACE
77
91INTERFACE csv_record_getfield
92 MODULE PROCEDURE csv_record_getfield_char, csv_record_getfield_int, &
93 csv_record_getfield_real, csv_record_getfield_double
94END INTERFACE
95
101INTERFACE csv_record_addfield
102 MODULE PROCEDURE csv_record_addfield_char, csv_record_addfield_int, &
103 csv_record_addfield_real, csv_record_addfield_double, &
104 csv_record_addfield_csv_record
105END INTERFACE
106
113 MODULE PROCEDURE csv_record_addfield_char_miss, csv_record_addfield_int_miss, &
114 csv_record_addfield_real_miss, csv_record_addfield_double_miss
115END INTERFACE
116
117
118PRIVATE csv_record_init, csv_record_delete, csv_record_getfield_char, &
119 csv_record_getfield_int, csv_record_getfield_real, csv_record_getfield_double, &
120 csv_record_addfield_char, csv_record_addfield_int, csv_record_addfield_real, &
121 csv_record_addfield_double, csv_record_addfield_csv_record, &
122 csv_record_addfield_char_miss, csv_record_addfield_int_miss, &
123 csv_record_addfield_real_miss, csv_record_addfield_double_miss, &
124 checkrealloc, add_byte
125
126CONTAINS
127
140FUNCTION getunit() RESULT(unit)
141INTEGER :: unit
142
143LOGICAL :: op
144
145DO unit = 100, 32767
146 INQUIRE(unit, opened=op)
147 IF (.NOT. op) RETURN
148ENDDO
149
150CALL l4f_log(l4f_error, 'Too many open files')
151CALL raise_error()
152unit = -1
153
154END FUNCTION getunit
155
165FUNCTION get_package_filepath(filename, filetype) RESULT(path)
166CHARACTER(len=*), INTENT(in) :: filename
167INTEGER, INTENT(in) :: filetype
168character(len=len(filename)) :: lfilename
169
170INTEGER :: j
171CHARACTER(len=512) :: path
172LOGICAL :: exist,cwd,share
173
174!IF (package_name == ' ') THEN
175! CALL getarg(0, package_name)
176!ENDIF
177
178IF (filetype < 1 .OR. filetype > nftype) THEN
179 path = ''
180 CALL l4f_log(l4f_error, 'package file type '//t2c(filetype)// &
181 ' not valid')
182 CALL raise_error()
183 RETURN
184ENDIF
185
186share = filename(:6) == "share:"
187cwd = filename(:4) == "cwd:"
188
189lfilename=filename
190if (share) lfilename=filename(7:)
191if (cwd) lfilename=filename(5:)
192
193if ( .not. share .and. .not. cwd .and. filetype == filetype_data) then
194 share=.true.
195 cwd=.true.
196end if
197
198if (cwd) then
199 ! try with current dir
200 path = lfilename
201 CALL l4f_log(l4f_debug, 'inquire local file '//trim(path))
202 INQUIRE(file=path, exist=exist)
203 IF (exist) THEN
204 CALL l4f_log(l4f_info, 'local file '//trim(path)//' found')
205 RETURN
206 ENDIF
207end if
208
209if (share .or. filetype == filetype_config) then
210
211 ! try with environment variable
212 CALL getenv(trim(uppercase(package_name))//'_'//trim(filetypename(filetype)), path)
213 IF (path /= ' ') THEN
214
215 path(len_trim(path)+1:) = '/'//lfilename
216 CALL l4f_log(l4f_debug, 'inquire env package file '//trim(path))
217 INQUIRE(file=path, exist=exist)
218 IF (exist) THEN
219 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
220 RETURN
221 ENDIF
222 ENDIF
223
224 ! try with install prefix
225 path = trim(prefix)//trim(postfix(filetype)) &
226 //'/'//trim(package_name)//'/'//lfilename
227 CALL l4f_log(l4f_debug, 'inquire install package file '//trim(path))
228 INQUIRE(file=path, exist=exist)
229 IF (exist) THEN
230 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
231 RETURN
232 ENDIF
233
234 ! try with default install prefix
235 DO j = 1, SIZE(preflist,1)
236 IF (preflist(j,filetype) == ' ') EXIT
237 path = trim(preflist(j,filetype))//trim(postfix(filetype)) &
238 //'/'//trim(package_name)//'/'//lfilename
239 CALL l4f_log(l4f_debug, 'inquire package file '//trim(path))
240 INQUIRE(file=path, exist=exist)
241 IF (exist) THEN
242 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
243 RETURN
244 ENDIF
245 ENDDO
246
247end if
248
249CALL l4f_log(l4f_info, 'package file '//trim(lfilename)//' not found')
250path = cmiss
251
252END FUNCTION get_package_filepath
253
254
259FUNCTION open_package_file(filename, filetype) RESULT(unit)
260CHARACTER(len=*), INTENT(in) :: filename
261INTEGER, INTENT(in) :: filetype
262INTEGER :: unit, i
263
264CHARACTER(len=512) :: path
265
266unit = -1
267path=get_package_filepath(filename, filetype)
268IF (path == '') RETURN
269
270unit = getunit()
271IF (unit == -1) RETURN
272
273OPEN(unit, file=path, status='old', iostat = i)
274IF (i == 0) THEN
275 CALL l4f_log(l4f_info, 'package file '//trim(path)//' opened')
276 RETURN
277ENDIF
278
279CALL l4f_log(l4f_error, 'package file '//trim(filename)//' not found')
280CALL raise_error()
281unit = -1
282
283END FUNCTION open_package_file
284
299SUBROUTINE csv_record_init(this, record, csep, cquote, nfield)
300TYPE(csv_record),INTENT(INOUT) :: this
301CHARACTER(len=*),INTENT(IN), OPTIONAL :: record
302CHARACTER(len=1),INTENT(IN),OPTIONAL :: csep
303CHARACTER(len=1),INTENT(IN),OPTIONAL :: cquote
304INTEGER,INTENT(OUT),OPTIONAL :: nfield
305
306INTEGER :: l
307
308IF (PRESENT(csep)) THEN
309 this%csep = transfer(csep, this%csep)
310ELSE
311 this%csep = transfer(',', this%csep)
312ENDIF
313IF (PRESENT(cquote)) THEN
314 this%cquote = transfer(cquote, this%cquote)
315ELSE
316 this%cquote = transfer('"', this%cquote)
317ENDIF
318
319this%cursor = 0
320this%nfield = 0
321IF (PRESENT(record)) THEN
322 l = len_trim(record)
323 ALLOCATE(this%record(l))
324 this%record(:) = transfer(record, this%record, l) ! ice in pgf90 with TRIM(record)
325
326 IF (PRESENT(nfield)) THEN
327 nfield = 0
328 DO WHILE(.NOT.csv_record_end(this)) ! faccio un giro a vuoto sul record
329 nfield = nfield + 1
330 CALL csv_record_getfield(this)
331 ENDDO
332 this%cursor = 0 ! riazzero il cursore
333 ENDIF
334ELSE
335 ALLOCATE(this%record(csv_basereclen))
336ENDIF
337
338END SUBROUTINE csv_record_init
339
340
342SUBROUTINE csv_record_delete(this)
343TYPE(csv_record), INTENT(INOUT) :: this
344
345DEALLOCATE(this%record)
346
347END SUBROUTINE csv_record_delete
348
349
351SUBROUTINE csv_record_rewind(this)
352TYPE(csv_record),INTENT(INOUT) :: this
353
354this%cursor = 0
355this%nfield = 0
356
357END SUBROUTINE csv_record_rewind
358
363SUBROUTINE csv_record_addfield_char(this, field, force_quote)
364TYPE(csv_record),INTENT(INOUT) :: this
365CHARACTER(len=*),INTENT(IN) :: field
366LOGICAL, INTENT(in), OPTIONAL :: force_quote
367
368INTEGER :: i
369LOGICAL :: lquote
370
371lquote = optio_log(force_quote)
372IF (len(field) == 0) THEN ! Particular case to be handled separately
373 CALL checkrealloc(this, 1)
374 IF (this%nfield > 0) THEN
375 CALL add_byte(this, this%csep) ! add separator if necessary
376 ELSE
377 CALL add_byte(this, this%cquote) ! if first record is empty it should be quoted
378 CALL add_byte(this, this%cquote) ! in case it is the only one
379 ENDIF
380ELSE IF (index(field, transfer(this%csep,field(1:1))) == 0 &
381 .AND. index(field, transfer(this%cquote,field(1:1))) == 0 &
382 .AND. .NOT.is_space_c(field(1:1)) &
383 .AND. .NOT.is_space_c(field(len(field):len(field))) &
384 .AND. .NOT.lquote) THEN ! quote not required
385 CALL checkrealloc(this, len(field)+1)
386 IF (this%nfield > 0) CALL add_byte(this, this%csep) ! add separator if necessary
387 this%record(this%cursor+1:this%cursor+len(field)) = transfer(field, this%record)
388 this%cursor = this%cursor + len(field)
389ELSE ! quote required
390 CALL checkrealloc(this, 2*len(field)+3) ! worst case """""""""
391 IF (this%nfield > 0) CALL add_byte(this, this%csep) ! add separator if necessary
392 CALL add_byte(this, this%cquote) ! add quote
393 DO i = 1, len(field)
394 CALL add_char(field(i:i))
395 ENDDO
396 CALL add_byte(this, this%cquote) ! add quote
397ENDIF
398
399this%nfield = this%nfield + 1
400
401CONTAINS
402
403! add a character, doubling it if it's a quote
404SUBROUTINE add_char(char)
405CHARACTER(len=1) :: char
406
407this%cursor = this%cursor+1
408this%record(this%cursor) = transfer(char, this%record(1))
409IF (this%record(this%cursor) == this%cquote) THEN ! double the quote
410 this%cursor = this%cursor+1
411 this%record(this%cursor) = this%cquote
412ENDIF
413
414END SUBROUTINE add_char
415
416END SUBROUTINE csv_record_addfield_char
417
418
419! Reallocate record if necessary
420SUBROUTINE checkrealloc(this, enlarge)
421TYPE(csv_record),INTENT(INOUT) :: this
422INTEGER, INTENT(in) :: enlarge
423
424INTEGER(KIND=int_b), POINTER :: tmpptr(:)
425
426IF (this%cursor+enlarge+1 > SIZE(this%record)) THEN
427 ALLOCATE(tmpptr(SIZE(this%record)+max(csv_basereclen, enlarge)))
428 tmpptr(1:SIZE(this%record)) = this%record(:)
429 DEALLOCATE(this%record)
430 this%record => tmpptr
431ENDIF
432
433END SUBROUTINE checkrealloc
434
435
436! add a byte
437SUBROUTINE add_byte(this, char)
438TYPE(csv_record),INTENT(INOUT) :: this
439INTEGER(kind=int_b) :: char
440
441this%cursor = this%cursor+1
442this%record(this%cursor) = char
443
444END SUBROUTINE add_byte
445
446
450SUBROUTINE csv_record_addfield_char_miss(this, field, force_quote)
451TYPE(csv_record),INTENT(INOUT) :: this
452CHARACTER(len=*),INTENT(IN) :: field
453LOGICAL, INTENT(in), OPTIONAL :: force_quote
454
455CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
456
457END SUBROUTINE csv_record_addfield_char_miss
458
459
462SUBROUTINE csv_record_addfield_int(this, field, form, force_quote)
463TYPE(csv_record),INTENT(INOUT) :: this
464INTEGER,INTENT(IN) :: field
465CHARACTER(len=*),INTENT(in),OPTIONAL :: form
466LOGICAL, INTENT(in), OPTIONAL :: force_quote
467
468IF (PRESENT(form)) THEN
469 CALL csv_record_addfield(this, trim(to_char(field, form)), force_quote=force_quote)
470ELSE
471 CALL csv_record_addfield(this, t2c(field), force_quote=force_quote)
472ENDIF
473
474END SUBROUTINE csv_record_addfield_int
475
476
480SUBROUTINE csv_record_addfield_int_miss(this, field, force_quote)
481TYPE(csv_record),INTENT(INOUT) :: this
482INTEGER,INTENT(IN) :: field
483LOGICAL, INTENT(in), OPTIONAL :: force_quote
484
485CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
486
487END SUBROUTINE csv_record_addfield_int_miss
488
489
492SUBROUTINE csv_record_addfield_real(this, field, form, force_quote)
493TYPE(csv_record),INTENT(INOUT) :: this
494REAL,INTENT(IN) :: field
495CHARACTER(len=*),INTENT(in),OPTIONAL :: form
496LOGICAL, INTENT(in), OPTIONAL :: force_quote
497
498IF (PRESENT(form)) THEN
499 CALL csv_record_addfield(this, trim(to_char(field, form)), force_quote=force_quote)
500ELSE
501 CALL csv_record_addfield(this, t2c(field), force_quote=force_quote)
502ENDIF
503
504END SUBROUTINE csv_record_addfield_real
505
506
510SUBROUTINE csv_record_addfield_real_miss(this, field, force_quote)
511TYPE(csv_record),INTENT(INOUT) :: this
512REAL,INTENT(IN) :: field
513LOGICAL, INTENT(in), OPTIONAL :: force_quote
514
515CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
516
517END SUBROUTINE csv_record_addfield_real_miss
518
519
522SUBROUTINE csv_record_addfield_double(this, field, form, force_quote)
523TYPE(csv_record),INTENT(INOUT) :: this
524DOUBLE PRECISION,INTENT(IN) :: field
525CHARACTER(len=*),INTENT(in),OPTIONAL :: form
526LOGICAL, INTENT(in), OPTIONAL :: force_quote
527
528IF (PRESENT(form)) THEN
529 CALL csv_record_addfield(this, trim(to_char(field, form)), force_quote=force_quote)
530ELSE
531 CALL csv_record_addfield(this, t2c(field), force_quote=force_quote)
532ENDIF
533
534END SUBROUTINE csv_record_addfield_double
535
540SUBROUTINE csv_record_addfield_double_miss(this, field, force_quote)
541TYPE(csv_record),INTENT(INOUT) :: this
542DOUBLE PRECISION,INTENT(IN) :: field
543LOGICAL, INTENT(in), OPTIONAL :: force_quote
544
545CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
546
547END SUBROUTINE csv_record_addfield_double_miss
548
549
555SUBROUTINE csv_record_addfield_csv_record(this, record)
556TYPE(csv_record),INTENT(INOUT) :: this
557TYPE(csv_record),INTENT(IN) :: record
558
559IF (this%csep /= record%csep .OR. this%cquote /= record%cquote) RETURN ! error
560CALL checkrealloc(this, record%cursor)
561IF (this%nfield > 0) CALL add_byte(this, this%csep)
562
563this%record(this%cursor+1:this%cursor+record%cursor) = &
564 record%record(1:record%cursor)
565this%cursor = this%cursor + record%cursor
566this%nfield = this%nfield + record%nfield
567
568END SUBROUTINE csv_record_addfield_csv_record
569
570
573FUNCTION csv_record_getrecord(this, nfield)
574TYPE(csv_record),INTENT(IN) :: this
575INTEGER, INTENT(out), OPTIONAL :: nfield
576
577CHARACTER(len=this%cursor) :: csv_record_getrecord
578
579csv_record_getrecord = transfer(this%record(1:this%cursor), csv_record_getrecord)
580IF (present(nfield)) nfield = this%nfield
581
582END FUNCTION csv_record_getrecord
583
584
590SUBROUTINE csv_record_getfield_char(this, field, flen, ier)
591TYPE(csv_record),INTENT(INOUT) :: this
592CHARACTER(len=*),INTENT(OUT),OPTIONAL :: field
594INTEGER,INTENT(OUT),OPTIONAL :: flen
595INTEGER,INTENT(OUT),OPTIONAL :: ier
596
597LOGICAL :: inquote, inpre, inpost, firstquote
598INTEGER :: i, ocursor, ofcursor
599
600! check end of record
601IF (csv_record_end(this)) THEN
602 IF (PRESENT(field)) field = cmiss
603 IF (PRESENT(ier))THEN
604 ier = 2
605 ELSE
606 CALL l4f_log(l4f_error, &
607 'in csv_record_getfield, attempt to read past end of record')
608 CALL raise_error()
609 ENDIF
610 RETURN
611ENDIF
612! start decoding
613IF (PRESENT(field)) field = ''
614IF (PRESENT(ier)) ier = 0
615ocursor = 0
616ofcursor = 0
617inquote = .false.
618inpre = .true.
619inpost = .false.
620firstquote = .false.
621
622DO i = this%cursor+1, SIZE(this%record)
623 IF (inpre) THEN ! sono nel preludio, butto via gli spazi
624 IF (is_space_b(this%record(i))) THEN
625 cycle
626 ELSE
627 inpre = .false.
628 ENDIF
629 ENDIF
630
631 IF (.NOT.inquote) THEN ! fuori da " "
632 IF (this%record(i) == this%cquote) THEN ! ": inizia " "
633 inquote = .true.
634 cycle
635 ELSE IF (this%record(i) == this%csep) THEN ! ,: fine campo
636 EXIT
637 ELSE ! carattere normale, elimina "trailing blanks"
638 CALL add_char(this%record(i), .true., field)
639 cycle
640 ENDIF
641 ELSE ! dentro " "
642 IF (.NOT.firstquote) THEN ! il precedente non e` "
643 IF (this%record(i) == this%cquote) THEN ! ": fine " " oppure ""
644 firstquote = .true.
645 cycle
646 ELSE ! carattere normale
647 CALL add_char(this%record(i), .false., field)
648 cycle
649 ENDIF
650 ELSE ! il precedente e` "
651 firstquote = .false.
652 IF (this%record(i) == this%cquote) THEN ! ": sequenza ""
653 CALL add_char(this%cquote, .false., field)
654 cycle
655 ELSE ! carattere normale: e` terminata " "
656 inquote = .false.
657 IF (this%record(i) == this%csep) THEN ! , fine campo
658 EXIT
659 ELSE ! carattere normale, elimina "trailing blanks"
660 CALL add_char(this%record(i), .true., field)
661 cycle
662 ENDIF
663 ENDIF
664 ENDIF
665 ENDIF
666ENDDO
667
668this%cursor = min(i, SIZE(this%record) + 1)
669IF (PRESENT(flen)) flen = ofcursor ! restituisco la lunghezza
670IF (PRESENT(field)) THEN ! controllo overflow di field
671 IF (ofcursor > len(field)) THEN
672 IF (PRESENT(ier)) THEN
673 ier = 1
674 ELSE
675 CALL l4f_log(l4f_warn, &
676 'in csv_record_getfield, CHARACTER variable too short for field: '// &
677 t2c(len(field))//'/'//t2c(ocursor))
678 ENDIF
679 ENDIF
680ENDIF
681
682CONTAINS
683
684SUBROUTINE add_char(char, check_space, field)
685INTEGER(kind=int_b) :: char
686LOGICAL,INTENT(IN) :: check_space
687CHARACTER(len=*),INTENT(OUT),OPTIONAL :: field
688
689CHARACTER(len=1) :: dummy ! this prevents a memory leak in TRANSFER()???
690
691ocursor = ocursor + 1
692 IF (PRESENT(field)) THEN
693 IF (ocursor <= len(field)) THEN
694 field(ocursor:ocursor) = transfer(char, dummy)
695 ENDIF
696ENDIF
697IF (check_space) THEN
698 IF (.NOT.is_space_b(char)) ofcursor = ocursor
699ELSE
700 ofcursor = ocursor
701ENDIF
702
703END SUBROUTINE add_char
705END SUBROUTINE csv_record_getfield_char
706
707
713SUBROUTINE csv_record_getfield_int(this, field, ier)
714TYPE(csv_record),INTENT(INOUT) :: this
715INTEGER,INTENT(OUT) :: field
716INTEGER,INTENT(OUT),OPTIONAL :: ier
717
718CHARACTER(len=32) :: cfield
719INTEGER :: lier
720
721CALL csv_record_getfield(this, field=cfield, ier=ier)
722IF (c_e(cfield) .AND. len_trim(cfield) /= 0) THEN
723 READ(cfield, '(I32)', iostat=lier) field
724 IF (lier /= 0) THEN
725 field = imiss
726 IF (.NOT.PRESENT(ier)) THEN
727 CALL l4f_log(l4f_error, &
728 'in csv_record_getfield, invalid integer field: '//trim(cfield))
729 CALL raise_error()
730 ELSE
731 ier = 3 ! conversion error
732 ENDIF
733 ENDIF
734ELSE
735 field = imiss
736ENDIF
737
738END SUBROUTINE csv_record_getfield_int
739
740
746SUBROUTINE csv_record_getfield_real(this, field, ier)
747TYPE(csv_record),INTENT(INOUT) :: this
748REAL,INTENT(OUT) :: field
749INTEGER,INTENT(OUT),OPTIONAL :: ier
750
751CHARACTER(len=32) :: cfield
752INTEGER :: lier
753
754CALL csv_record_getfield(this, field=cfield, ier=ier)
755IF (c_e(cfield) .AND. len_trim(cfield) /= 0) THEN
756 READ(cfield, '(F32.0)', iostat=lier) field
757 IF (lier /= 0) THEN
758 field = rmiss
759 IF (.NOT.PRESENT(ier)) THEN
760 CALL l4f_log(l4f_error, &
761 'in csv_record_getfield, invalid real field: '//trim(cfield))
762 CALL raise_error()
763 ELSE
764 ier = 3 ! conversion error
765 ENDIF
766 ENDIF
767ELSE
768 field = rmiss
769ENDIF
770
771END SUBROUTINE csv_record_getfield_real
772
773
779SUBROUTINE csv_record_getfield_double(this, field, ier)
780TYPE(csv_record),INTENT(INOUT) :: this
781DOUBLE PRECISION,INTENT(OUT) :: field
782INTEGER,INTENT(OUT),OPTIONAL :: ier
783
784CHARACTER(len=32) :: cfield
785INTEGER :: lier
786
787CALL csv_record_getfield(this, field=cfield, ier=ier)
788IF (c_e(cfield) .AND. len_trim(cfield) /= 0) THEN
789 READ(cfield, '(F32.0)', iostat=lier) field
790 IF (lier /= 0) THEN
791 field = dmiss
792 IF (.NOT.PRESENT(ier)) THEN
793 CALL l4f_log(l4f_error, &
794 'in csv_record_getfield, invalid double precision field: '//trim(cfield))
795 CALL raise_error()
796 ELSE
797 ier = 3 ! conversion error
798 ENDIF
799 ENDIF
800ELSE
801 field = dmiss
802ENDIF
803
804END SUBROUTINE csv_record_getfield_double
805
806
809FUNCTION csv_record_end(this)
810TYPE(csv_record), INTENT(IN) :: this
811LOGICAL :: csv_record_end
812
813csv_record_end = this%cursor > SIZE(this%record)
814
815END FUNCTION csv_record_end
816
817
818FUNCTION is_space_c(char) RESULT(is_space)
819CHARACTER(len=1) :: char
820LOGICAL :: is_space
821
822is_space = (ichar(char) == 32 .OR. ichar(char) == 9) ! improve
823
824END FUNCTION is_space_c
825
826
827FUNCTION is_space_b(char) RESULT(is_space)
828INTEGER(kind=int_b) :: char
829LOGICAL :: is_space
830
831is_space = (char == 32 .OR. char == 9) ! improve
832
833END FUNCTION is_space_b
834
835
836END MODULE file_utilities
Set of functions that return a trimmed CHARACTER representation of the input variable.
Set of functions that return a CHARACTER representation of the input variable.
Methods for successively adding fields to a csv_record object.
Methods for successively adding fields to a csv_record object.
Methods for successively obtaining the fields of a csv_record object.
Destructor for the class csv_record.
Constructor for the class csv_record.
Index method.
Function to check whether a value is missing or not.
Utilities for CHARACTER variables.
Gestione degli errori.
Utilities for managing files.
Definition of constants to be used for declaring variables of a desired type.
Definition: kinds.F90:251
classe per la gestione del logging
Definitions of constants and functions for working with missing values.
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Class for interpreting the records of a csv file.

Generated with Doxygen.