libsim Versione 7.2.6

◆ csv_record_getfield_int()

subroutine, private csv_record_getfield_int ( type(csv_record), intent(inout) this,
integer, intent(out) field,
integer, intent(out), optional ier )
private

Returns next field from the record this as an INTEGER variable.

The field pointer is advanced to the next field. If all the fields have already been interpreted or the field cannot be interpreted as an integer, or if it is longer than 32 characters, it returns a missing value.

Parametri
[in,out]thisobject to be decoded
[out]fieldvalue of the field, = imiss if conversion fails
[out]iererror code, 0 = OK, 2 = end of record, 3 = cannot convert to integer

Definizione alla linea 901 del file file_utilities.F90.

902! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
903! authors:
904! Davide Cesari <dcesari@arpa.emr.it>
905! Paolo Patruno <ppatruno@arpa.emr.it>
906
907! This program is free software; you can redistribute it and/or
908! modify it under the terms of the GNU General Public License as
909! published by the Free Software Foundation; either version 2 of
910! the License, or (at your option) any later version.
911
912! This program is distributed in the hope that it will be useful,
913! but WITHOUT ANY WARRANTY; without even the implied warranty of
914! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
915! GNU General Public License for more details.
916
917! You should have received a copy of the GNU General Public License
918! along with this program. If not, see <http://www.gnu.org/licenses/>.
919#include "config.h"
920!> Utilities for managing files. This module is a collection of generic utilities
921!! for managing files. A group of utilities is dedicated to locating
922!! and opening configuration files in standard directories or in
923!! directories specified by environmental variables. The module also
924!! contains the class \a csv_record for creating and interpreting the
925!! records of a csv file.
926!! \ingroup base
927MODULE file_utilities
928USE kinds
932USE log4fortran
933USE err_handling
934IMPLICIT NONE
935
936CHARACTER(len=128), PARAMETER :: package_name = package
937CHARACTER(len=128), PARAMETER :: prefix = prefix
938
939INTEGER, PARAMETER, PRIVATE :: nftype = 2
940CHARACTER(len=10), PARAMETER, PRIVATE :: &
941 preflist(2,nftype) = reshape((/ &
942 '/usr/local', '/usr ', &
943 '/usr/local', ' '/), &
944 (/2,nftype/))
945CHARACTER(len=6), PARAMETER, PRIVATE :: &
946 postfix(nftype) = (/ '/share', '/etc ' /)
947CHARACTER(len=6), PARAMETER, PRIVATE :: &
948 filetypename(nftype) = (/ 'DATA ', 'CONFIG' /)
949INTEGER, PARAMETER :: filetype_data = 1 !< Data file requested
950INTEGER, PARAMETER :: filetype_config = 2 !< Configuration file requested
951
952
953!> Class for interpreting the records of a csv file.
954!! See http://en.wikipedia.org/wiki/Comma-separated_values for a
955!! detailed description of the csv format.
956TYPE csv_record
957 PRIVATE
958 INTEGER :: cursor, action, nfield !, ntotal
959 INTEGER(KIND=int_b) :: csep, cquote
960 INTEGER(KIND=int_b), POINTER :: record(:)
961END TYPE csv_record
962
963INTEGER, PARAMETER, PRIVATE :: csv_basereclen=1024, &
964 csv_action_read=0, csv_action_write=1
965
966!> Constructor for the class \a csv_record. It has to be called for every
967!! record (line) csv to be created or interpreted.
968INTERFACE init
969 MODULE PROCEDURE csv_record_init
970END INTERFACE
971
972!> Destructor for the class \a csv_record. It is important to call
973!! it before reusing the object for the following record, in order to
974!! avoid memory leaks.
975INTERFACE delete
976 MODULE PROCEDURE csv_record_delete
977END INTERFACE
978
979!> Methods for successively obtaining the fields of a \a csv_record object.
980!! The generic name \c csv_record_getfield with parameters of the
981!! desired type should be used instead of the specific names, the
982!! compiler will select the proper subroutine. If the optiona argument
983!! \a ier is not provided the subroutines will log warning and error
984!! messages and possibly stop the program in case of error, otherwise
985!! nothing is signalled and the returned error code has the following
986!! meaning:
987!!
988!! \li 0 success
989!! \li 1 field too long for being contained in the string provided (warning, a truncated value is returned anyway)
990!! \li 2 attempt to read past end of record (error, a missing value is returned)
991!! \li 3 conversion to the required type impossible (error, a missing value is returned)
992INTERFACE csv_record_getfield
993 MODULE PROCEDURE csv_record_getfield_char, csv_record_getfield_int, &
994 csv_record_getfield_real, csv_record_getfield_double
995END INTERFACE
996
997!> Methods for successively adding fields to a \a csv_record object.
998!! The generic name \c csv_record_addfield with parameters of the
999!! desired type should be used instead of the specific names, the
1000!! compiler will select the proper subroutine. Missing values are
1001!! literally inserted in the output without special treatment.
1002INTERFACE csv_record_addfield
1003 MODULE PROCEDURE csv_record_addfield_char, csv_record_addfield_int, &
1004 csv_record_addfield_real, csv_record_addfield_double, &
1005 csv_record_addfield_csv_record
1006END INTERFACE
1007
1008!> Methods for successively adding fields to a \a csv_record object.
1009!! The generic name \c csv_record_addfield with parameters of the
1010!! desired type should be used instead of the specific names, the
1011!! compiler will select the proper subroutine. Missing values are
1012!! inserted as empty fields.
1014 MODULE PROCEDURE csv_record_addfield_char_miss, csv_record_addfield_int_miss, &
1015 csv_record_addfield_real_miss, csv_record_addfield_double_miss
1016END INTERFACE
1017
1018
1019PRIVATE csv_record_init, csv_record_delete, csv_record_getfield_char, &
1020 csv_record_getfield_int, csv_record_getfield_real, csv_record_getfield_double, &
1021 csv_record_addfield_char, csv_record_addfield_int, csv_record_addfield_real, &
1022 csv_record_addfield_double, csv_record_addfield_csv_record, &
1023 csv_record_addfield_char_miss, csv_record_addfield_int_miss, &
1024 csv_record_addfield_real_miss, csv_record_addfield_double_miss, &
1025 checkrealloc, add_byte
1026
1027CONTAINS
1028
1029!> Returns the number of a Fortran input/output unit currently unused.
1030!! It returns -1 in case of error. Example of use:
1031!! \code
1032!! USE file_utilities
1033!! ...
1034!! INTEGER :: n
1035!! ...
1036!! n=getunit()
1037!! IF (n /= -1) THEN
1038!! OPEN(n, FILE='ostregheta.txt')
1039!! ...
1040!! \endcode
1041FUNCTION getunit() RESULT(unit)
1042INTEGER :: unit
1043
1044LOGICAL :: op
1045
1046DO unit = 100, 32767
1047 INQUIRE(unit, opened=op)
1048 IF (.NOT. op) RETURN
1049ENDDO
1050
1051CALL l4f_log(l4f_error, 'Too many open files')
1052CALL raise_error()
1053unit = -1
1054
1055END FUNCTION getunit
1056
1057!> Looks for a specific file for the libsim package.
1058!! It searches in different directories in the following order:
1059!! - current working directory
1060!! - directory specified by the environmental variabile \c LIBSIM_DATA for data files or \c LIBSIM_CONFIG for configuration files, if defined
1061!! - directory \c /usr/local/share/libsim for data files or \c /usr/local/etc/libsim for configuration files
1062!! - directory \c /usr/share/libsim for data files or \c /etc/libsim for configuration files.
1063!! filename prefixed by "cwd:" or "share:" force search in current working directory or other package paths respectively
1064!! default is everywhere for data files and package paths only for config files
1065!! It returns the full path to the existing file or an empty string if not found.
1066FUNCTION get_package_filepath(filename, filetype) RESULT(path)
1067CHARACTER(len=*), INTENT(in) :: filename !< name of the file to be searched, it must be a relative path name
1068INTEGER, INTENT(in) :: filetype !< type of file, the constants \a ::filetype_data or \a ::filetype_config have to be used
1069character(len=len(filename)) :: lfilename
1070
1071INTEGER :: j
1072CHARACTER(len=512) :: path
1073LOGICAL :: exist,cwd,share
1074
1075!IF (package_name == ' ') THEN
1076! CALL getarg(0, package_name)
1077!ENDIF
1078
1079IF (filetype < 1 .OR. filetype > nftype) THEN
1080 path = ''
1081 CALL l4f_log(l4f_error, 'package file type '//t2c(filetype)// &
1082 ' not valid')
1083 CALL raise_error()
1084 RETURN
1085ENDIF
1086
1087share = filename(:6) == "share:"
1088cwd = filename(:4) == "cwd:"
1089
1090lfilename=filename
1091if (share) lfilename=filename(7:)
1092if (cwd) lfilename=filename(5:)
1093
1094if ( .not. share .and. .not. cwd .and. filetype == filetype_data) then
1095 share=.true.
1096 cwd=.true.
1097end if
1098
1099if (cwd) then
1100 ! try with current dir
1101 path = lfilename
1102 CALL l4f_log(l4f_debug, 'inquire local file '//trim(path))
1103 INQUIRE(file=path, exist=exist)
1104 IF (exist) THEN
1105 CALL l4f_log(l4f_info, 'local file '//trim(path)//' found')
1106 RETURN
1107 ENDIF
1108end if
1109
1110if (share .or. filetype == filetype_config) then
1111
1112 ! try with environment variable
1113 CALL getenv(trim(uppercase(package_name))//'_'//trim(filetypename(filetype)), path)
1114 IF (path /= ' ') THEN
1115
1116 path(len_trim(path)+1:) = '/'//lfilename
1117 CALL l4f_log(l4f_debug, 'inquire env package file '//trim(path))
1118 INQUIRE(file=path, exist=exist)
1119 IF (exist) THEN
1120 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1121 RETURN
1122 ENDIF
1123 ENDIF
1124
1125 ! try with install prefix
1126 path = trim(prefix)//trim(postfix(filetype)) &
1127 //'/'//trim(package_name)//'/'//lfilename
1128 CALL l4f_log(l4f_debug, 'inquire install package file '//trim(path))
1129 INQUIRE(file=path, exist=exist)
1130 IF (exist) THEN
1131 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1132 RETURN
1133 ENDIF
1134
1135 ! try with default install prefix
1136 DO j = 1, SIZE(preflist,1)
1137 IF (preflist(j,filetype) == ' ') EXIT
1138 path = trim(preflist(j,filetype))//trim(postfix(filetype)) &
1139 //'/'//trim(package_name)//'/'//lfilename
1140 CALL l4f_log(l4f_debug, 'inquire package file '//trim(path))
1141 INQUIRE(file=path, exist=exist)
1142 IF (exist) THEN
1143 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1144 RETURN
1145 ENDIF
1146 ENDDO
1147
1148end if
1149
1150CALL l4f_log(l4f_info, 'package file '//trim(lfilename)//' not found')
1151path = cmiss
1152
1153END FUNCTION get_package_filepath
1154
1155
1156!> Opens a specific file for the libsim package.
1157!! It searches in different directories using get_package_filepath to locate the file.
1158!! It returns the unit number associated to the file found and successfully opened,
1159!! or -1 if the file does not exist or an error occurred while opening it.
1160FUNCTION open_package_file(filename, filetype) RESULT(unit)
1161CHARACTER(len=*), INTENT(in) :: filename !< name of the file to be opened, it must be a relative path name
1162INTEGER, INTENT(in) :: filetype !< type of file, the constants \a ::filetype_data or \a ::filetype_config have to be used
1163INTEGER :: unit, i
1164
1165CHARACTER(len=512) :: path
1166
1167unit = -1
1168path=get_package_filepath(filename, filetype)
1169IF (path == '') RETURN
1170
1171unit = getunit()
1172IF (unit == -1) RETURN
1173
1174OPEN(unit, file=path, status='old', iostat = i)
1175IF (i == 0) THEN
1176 CALL l4f_log(l4f_info, 'package file '//trim(path)//' opened')
1177 RETURN
1178ENDIF
1179
1180CALL l4f_log(l4f_error, 'package file '//trim(filename)//' not found')
1181CALL raise_error()
1182unit = -1
1183
1184END FUNCTION open_package_file
1185
1186
1187!> Initialise a \a csv_record object.
1188!! If the record is provided in input, the object is used for decoding a
1189!! record read from a file (\a csv_record_getfield methods),
1190!! if record is not provided, then the object will be used for
1191!! coding a csv record (\a csv_record_addfield methods), for the
1192!! successive write on file.
1193!! It is possible to specify nonstandard characters for delimiting
1194!! and grouping fields, default comma (,) and double quote (").
1195!! In case of decoding, it is possible to obtain in output the number of fields
1196!! in the record, but this will take extra computing time. As an alternative,
1197!! the ::csv_record_end method can be used when extracting each field.
1198!! Warning: the \a csv_record class does not handle csv records that extend
1199!! on different lines.
1200SUBROUTINE csv_record_init(this, record, csep, cquote, nfield)
1201TYPE(csv_record),INTENT(INOUT) :: this !< object to be initialised
1202CHARACTER(len=*),INTENT(IN), OPTIONAL :: record !< csv record to be interpreted, if not provided, it means we want to code a csv record for output
1203CHARACTER(len=1),INTENT(IN),OPTIONAL :: csep !< field separator character, default \c , (comma)
1204CHARACTER(len=1),INTENT(IN),OPTIONAL :: cquote !< field grouping character, default \c " (double quote); it is usually used when a field contains comma or blanks
1205INTEGER,INTENT(OUT),OPTIONAL :: nfield !< number of fields in the record
1206
1207INTEGER :: l
1208
1209IF (PRESENT(csep)) THEN
1210 this%csep = transfer(csep, this%csep)
1211ELSE
1212 this%csep = transfer(',', this%csep)
1213ENDIF
1214IF (PRESENT(cquote)) THEN
1215 this%cquote = transfer(cquote, this%cquote)
1216ELSE
1217 this%cquote = transfer('"', this%cquote)
1218ENDIF
1219
1220this%cursor = 0
1221this%nfield = 0
1222IF (PRESENT(record)) THEN
1223 l = len_trim(record)
1224 ALLOCATE(this%record(l))
1225 this%record(:) = transfer(record, this%record, l) ! ice in pgf90 with TRIM(record)
1226
1227 IF (PRESENT(nfield)) THEN
1228 nfield = 0
1229 DO WHILE(.NOT.csv_record_end(this)) ! faccio un giro a vuoto sul record
1230 nfield = nfield + 1
1231 CALL csv_record_getfield(this)
1232 ENDDO
1233 this%cursor = 0 ! riazzero il cursore
1234 ENDIF
1235ELSE
1236 ALLOCATE(this%record(csv_basereclen))
1237ENDIF
1238
1239END SUBROUTINE csv_record_init
1240
1241
1242!> Destroy the \a csv_record object, freeing allocated memory.
1243SUBROUTINE csv_record_delete(this)
1244TYPE(csv_record), INTENT(INOUT) :: this !< object to be destroyed
1245
1246DEALLOCATE(this%record)
1247
1248END SUBROUTINE csv_record_delete
1249
1250
1251!> Rewind the pointer in order to allow rescan or rewrite of the same record.
1252SUBROUTINE csv_record_rewind(this)
1253TYPE(csv_record),INTENT(INOUT) :: this !< object to be rewound
1254
1255this%cursor = 0
1256this%nfield = 0
1257
1258END SUBROUTINE csv_record_rewind
1259
1260
1261!> Add a field from a \c CHARACTER variable to the csv record \a this.
1262!! The field will be quoted if necessary.
1263!! \todo Improve the trailing blank quoting.
1264SUBROUTINE csv_record_addfield_char(this, field, force_quote)
1265TYPE(csv_record),INTENT(INOUT) :: this !< object where to add field
1266CHARACTER(len=*),INTENT(IN) :: field !< field to be added
1267LOGICAL, INTENT(in), OPTIONAL :: force_quote !< if provided and \c .TRUE. , the field will be quoted even if not necessary
1268
1269INTEGER :: i
1270LOGICAL :: lquote
1271
1272lquote = optio_log(force_quote)
1273IF (len(field) == 0) THEN ! Particular case to be handled separately
1274 CALL checkrealloc(this, 1)
1275 IF (this%nfield > 0) THEN
1276 CALL add_byte(this, this%csep) ! add separator if necessary
1277 ELSE
1278 CALL add_byte(this, this%cquote) ! if first record is empty it should be quoted
1279 CALL add_byte(this, this%cquote) ! in case it is the only one
1280 ENDIF
1281ELSE IF (index(field, transfer(this%csep,field(1:1))) == 0 &
1282 .AND. index(field, transfer(this%cquote,field(1:1))) == 0 &
1283 .AND. .NOT.is_space_c(field(1:1)) &
1284 .AND. .NOT.is_space_c(field(len(field):len(field))) &
1285 .AND. .NOT.lquote) THEN ! quote not required
1286 CALL checkrealloc(this, len(field)+1)
1287 IF (this%nfield > 0) CALL add_byte(this, this%csep) ! add separator if necessary
1288 this%record(this%cursor+1:this%cursor+len(field)) = transfer(field, this%record)
1289 this%cursor = this%cursor + len(field)
1290ELSE ! quote required
1291 CALL checkrealloc(this, 2*len(field)+3) ! worst case """""""""
1292 IF (this%nfield > 0) CALL add_byte(this, this%csep) ! add separator if necessary
1293 CALL add_byte(this, this%cquote) ! add quote
1294 DO i = 1, len(field)
1295 CALL add_char(field(i:i))
1296 ENDDO
1297 CALL add_byte(this, this%cquote) ! add quote
1298ENDIF
1299
1300this%nfield = this%nfield + 1
1301
1302CONTAINS
1303
1304! add a character, doubling it if it's a quote
1305SUBROUTINE add_char(char)
1306CHARACTER(len=1) :: char
1307
1308this%cursor = this%cursor+1
1309this%record(this%cursor) = transfer(char, this%record(1))
1310IF (this%record(this%cursor) == this%cquote) THEN ! double the quote
1311 this%cursor = this%cursor+1
1312 this%record(this%cursor) = this%cquote
1313ENDIF
1314
1315END SUBROUTINE add_char
1316
1317END SUBROUTINE csv_record_addfield_char
1318
1319
1320! Reallocate record if necessary
1321SUBROUTINE checkrealloc(this, enlarge)
1322TYPE(csv_record),INTENT(INOUT) :: this
1323INTEGER, INTENT(in) :: enlarge
1324
1325INTEGER(KIND=int_b), POINTER :: tmpptr(:)
1326
1327IF (this%cursor+enlarge+1 > SIZE(this%record)) THEN
1328 ALLOCATE(tmpptr(SIZE(this%record)+max(csv_basereclen, enlarge)))
1329 tmpptr(1:SIZE(this%record)) = this%record(:)
1330 DEALLOCATE(this%record)
1331 this%record => tmpptr
1332ENDIF
1333
1334END SUBROUTINE checkrealloc
1335
1336
1337! add a byte
1338SUBROUTINE add_byte(this, char)
1339TYPE(csv_record),INTENT(INOUT) :: this
1340INTEGER(kind=int_b) :: char
1341
1342this%cursor = this%cursor+1
1343this%record(this%cursor) = char
1344
1345END SUBROUTINE add_byte
1346
1347
1348!> Add a field from a \c CHARACTER variable to the csv record \a this.
1349!! The field will be quoted if necessary. A missing value is inserted
1350!! as an empty field.
1351SUBROUTINE csv_record_addfield_char_miss(this, field, force_quote)
1352TYPE(csv_record),INTENT(INOUT) :: this !< object where to add field
1353CHARACTER(len=*),INTENT(IN) :: field !< field to be added
1354LOGICAL, INTENT(in), OPTIONAL :: force_quote !< if provided and \c .TRUE. , the field will be quoted even if not necessary
1355
1356CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
1357
1358END SUBROUTINE csv_record_addfield_char_miss
1359
1360
1361!> Add a field from an \c INTEGER variable to the csv record \a this.
1362!! The field will be quoted if necessary.
1363SUBROUTINE csv_record_addfield_int(this, field, form, force_quote)
1364TYPE(csv_record),INTENT(INOUT) :: this !< object where to add field
1365INTEGER,INTENT(IN) :: field !< field to be added
1366CHARACTER(len=*),INTENT(in),OPTIONAL :: form !< optional format
1367LOGICAL, INTENT(in), OPTIONAL :: force_quote !< if provided and \c .TRUE. , the field will be quoted even if not necessary
1368
1369IF (PRESENT(form)) THEN
1370 CALL csv_record_addfield(this, trim(to_char(field, form)), force_quote=force_quote)
1371ELSE
1372 CALL csv_record_addfield(this, t2c(field), force_quote=force_quote)
1373ENDIF
1374
1375END SUBROUTINE csv_record_addfield_int
1376
1377
1378!> Add a field from an \c INTEGER variable to the csv record \a this.
1379!! The field will be quoted if necessary. A missing value is inserted
1380!! as an empty field.
1381SUBROUTINE csv_record_addfield_int_miss(this, field, force_quote)
1382TYPE(csv_record),INTENT(INOUT) :: this !< object where to add field
1383INTEGER,INTENT(IN) :: field !< field to be added
1384LOGICAL, INTENT(in), OPTIONAL :: force_quote !< if provided and \c .TRUE. , the field will be quoted even if not necessary
1385
1386CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
1387
1388END SUBROUTINE csv_record_addfield_int_miss
1389
1390
1391!> Add a field from a \c REAL variable to the csv record \a this.
1392!! The field will be quoted if necessary.
1393SUBROUTINE csv_record_addfield_real(this, field, form, force_quote)
1394TYPE(csv_record),INTENT(INOUT) :: this !< object where to add field
1395REAL,INTENT(IN) :: field !< field to be added
1396CHARACTER(len=*),INTENT(in),OPTIONAL :: form !< optional format
1397LOGICAL, INTENT(in), OPTIONAL :: force_quote !< if provided and \c .TRUE. , the field will be quoted even if not necessary
1398
1399IF (PRESENT(form)) THEN
1400 CALL csv_record_addfield(this, trim(to_char(field, form)), force_quote=force_quote)
1401ELSE
1402 CALL csv_record_addfield(this, t2c(field), force_quote=force_quote)
1403ENDIF
1404
1405END SUBROUTINE csv_record_addfield_real
1406
1407
1408!> Add a field from a \c REAL variable to the csv record \a this.
1409!! The field will be quoted if necessary. A missing value is inserted
1410!! as an empty field.
1411SUBROUTINE csv_record_addfield_real_miss(this, field, force_quote)
1412TYPE(csv_record),INTENT(INOUT) :: this !< object where to add field
1413REAL,INTENT(IN) :: field !< field to be added
1414LOGICAL, INTENT(in), OPTIONAL :: force_quote !< if provided and \c .TRUE. , the field will be quoted even if not necessary
1415
1416CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
1417
1418END SUBROUTINE csv_record_addfield_real_miss
1419
1420
1421!> Add a field from a \c DOUBLE PRECISION variable to the csv record \a this.
1422!! The field will be quoted if necessary.
1423SUBROUTINE csv_record_addfield_double(this, field, form, force_quote)
1424TYPE(csv_record),INTENT(INOUT) :: this !< object where to add field
1425DOUBLE PRECISION,INTENT(IN) :: field !< field to be added
1426CHARACTER(len=*),INTENT(in),OPTIONAL :: form !< optional format
1427LOGICAL, INTENT(in), OPTIONAL :: force_quote !< if provided and \c .TRUE. , the field will be quoted even if not necessary
1428
1429IF (PRESENT(form)) THEN
1430 CALL csv_record_addfield(this, trim(to_char(field, form)), force_quote=force_quote)
1431ELSE
1432 CALL csv_record_addfield(this, t2c(field), force_quote=force_quote)
1433ENDIF
1434
1435END SUBROUTINE csv_record_addfield_double
1436
1437
1438!> Add a field from a \c DOUBLE PRECISION variable to the csv record \a this.
1439!! The field will be quoted if necessary. A missing value is inserted
1440!! as an empty field.
1441SUBROUTINE csv_record_addfield_double_miss(this, field, force_quote)
1442TYPE(csv_record),INTENT(INOUT) :: this !< object where to add field
1443DOUBLE PRECISION,INTENT(IN) :: field !< field to be added
1444LOGICAL, INTENT(in), OPTIONAL :: force_quote !< if provided and \c .TRUE. , the field will be quoted even if not necessary
1445
1446CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
1447
1448END SUBROUTINE csv_record_addfield_double_miss
1449
1450
1451!> Add a full \a csv_record object to the csv record \a this.
1452!! The object to be added must have been generated through \a
1453!! csv_record_addfield calls (csv encoding mode). Both \a csv_record
1454!! objects \a this and \a record must use the same delimiter and
1455!! quoting characters, otherwise the operation will silently fail.
1456SUBROUTINE csv_record_addfield_csv_record(this, record)
1457TYPE(csv_record),INTENT(INOUT) :: this !< object where to add record
1458TYPE(csv_record),INTENT(IN) :: record !< record to be added
1459
1460IF (this%csep /= record%csep .OR. this%cquote /= record%cquote) RETURN ! error
1461CALL checkrealloc(this, record%cursor)
1462IF (this%nfield > 0) CALL add_byte(this, this%csep)
1463
1464this%record(this%cursor+1:this%cursor+record%cursor) = &
1465 record%record(1:record%cursor)
1466this%cursor = this%cursor + record%cursor
1467this%nfield = this%nfield + record%nfield
1468
1469END SUBROUTINE csv_record_addfield_csv_record
1470
1471
1472!> Return current csv-coded record as a \a CHARACTER variable, ready to be written
1473!! to a file. It is not necessary to trim the result for trailing blanks.
1474FUNCTION csv_record_getrecord(this, nfield)
1475TYPE(csv_record),INTENT(IN) :: this !< object to be coded, the object is not modified, so that other fields can still be added after the call to ::csv_record_getrecord
1476INTEGER, INTENT(out), OPTIONAL :: nfield !< number of fields contained in the record
1477
1478CHARACTER(len=this%cursor) :: csv_record_getrecord
1479
1480csv_record_getrecord = transfer(this%record(1:this%cursor), csv_record_getrecord)
1481IF (present(nfield)) nfield = this%nfield
1482
1483END FUNCTION csv_record_getrecord
1484
1485
1486!> Returns next field from the record \a this as a \c CHARACTER variable.
1487!! The field pointer is advanced to the next field.
1488!! If all the fields have already been interpreted it returns an empty string
1489!! anyway; in order to verify the end-of-record condition the \a ier parameter
1490!! must be used.
1491SUBROUTINE csv_record_getfield_char(this, field, flen, ier)
1492TYPE(csv_record),INTENT(INOUT) :: this !< object to be decoded
1493CHARACTER(len=*),INTENT(OUT),OPTIONAL :: field !< contents of the field, if not provided, the field pointer is increased only; if the variable is not long enough, a warning is printed and the part that fits is returned;
1494!< the variable is space-terminated anyway, so the \a flen parameter has to be used in order to evaluate possible significant trailing spaces
1495INTEGER,INTENT(OUT),OPTIONAL :: flen !< actual length of the field including trailing blanks, it is correctly computed also when \a field is not provided or too short
1496INTEGER,INTENT(OUT),OPTIONAL :: ier!< error code, 0 = OK, 1 = \a field too short, 2 = end of record
1497
1498LOGICAL :: inquote, inpre, inpost, firstquote
1499INTEGER :: i, ocursor, ofcursor
1500
1501! check end of record
1502IF (csv_record_end(this)) THEN
1503 IF (PRESENT(field)) field = cmiss
1504 IF (PRESENT(ier))THEN
1505 ier = 2
1506 ELSE
1507 CALL l4f_log(l4f_error, &
1508 'in csv_record_getfield, attempt to read past end of record')
1509 CALL raise_error()
1510 ENDIF
1511 RETURN
1512ENDIF
1513! start decoding
1514IF (PRESENT(field)) field = ''
1515IF (PRESENT(ier)) ier = 0
1516ocursor = 0
1517ofcursor = 0
1518inquote = .false.
1519inpre = .true.
1520inpost = .false.
1521firstquote = .false.
1522
1523DO i = this%cursor+1, SIZE(this%record)
1524 IF (inpre) THEN ! sono nel preludio, butto via gli spazi
1525 IF (is_space_b(this%record(i))) THEN
1526 cycle
1527 ELSE
1528 inpre = .false.
1529 ENDIF
1530 ENDIF
1531
1532 IF (.NOT.inquote) THEN ! fuori da " "
1533 IF (this%record(i) == this%cquote) THEN ! ": inizia " "
1534 inquote = .true.
1535 cycle
1536 ELSE IF (this%record(i) == this%csep) THEN ! ,: fine campo
1537 EXIT
1538 ELSE ! carattere normale, elimina "trailing blanks"
1539 CALL add_char(this%record(i), .true., field)
1540 cycle
1541 ENDIF
1542 ELSE ! dentro " "
1543 IF (.NOT.firstquote) THEN ! il precedente non e` "
1544 IF (this%record(i) == this%cquote) THEN ! ": fine " " oppure ""
1545 firstquote = .true.
1546 cycle
1547 ELSE ! carattere normale
1548 CALL add_char(this%record(i), .false., field)
1549 cycle
1550 ENDIF
1551 ELSE ! il precedente e` "
1552 firstquote = .false.
1553 IF (this%record(i) == this%cquote) THEN ! ": sequenza ""
1554 CALL add_char(this%cquote, .false., field)
1555 cycle
1556 ELSE ! carattere normale: e` terminata " "
1557 inquote = .false.
1558 IF (this%record(i) == this%csep) THEN ! , fine campo
1559 EXIT
1560 ELSE ! carattere normale, elimina "trailing blanks"
1561 CALL add_char(this%record(i), .true., field)
1562 cycle
1563 ENDIF
1564 ENDIF
1565 ENDIF
1566 ENDIF
1567ENDDO
1568
1569this%cursor = min(i, SIZE(this%record) + 1)
1570IF (PRESENT(flen)) flen = ofcursor ! restituisco la lunghezza
1571IF (PRESENT(field)) THEN ! controllo overflow di field
1572 IF (ofcursor > len(field)) THEN
1573 IF (PRESENT(ier)) THEN
1574 ier = 1
1575 ELSE
1576 CALL l4f_log(l4f_warn, &
1577 'in csv_record_getfield, CHARACTER variable too short for field: '// &
1578 t2c(len(field))//'/'//t2c(ocursor))
1579 ENDIF
1580 ENDIF
1581ENDIF
1582
1583CONTAINS
1584
1585SUBROUTINE add_char(char, check_space, field)
1586INTEGER(kind=int_b) :: char
1587LOGICAL,INTENT(IN) :: check_space
1588CHARACTER(len=*),INTENT(OUT),OPTIONAL :: field
1589
1590CHARACTER(len=1) :: dummy ! this prevents a memory leak in TRANSFER()???
1591
1592ocursor = ocursor + 1
1593 IF (PRESENT(field)) THEN
1594 IF (ocursor <= len(field)) THEN
1595 field(ocursor:ocursor) = transfer(char, dummy)
1596 ENDIF
1597ENDIF
1598IF (check_space) THEN
1599 IF (.NOT.is_space_b(char)) ofcursor = ocursor
1600ELSE
1601 ofcursor = ocursor
1602ENDIF
1603
1604END SUBROUTINE add_char
1605
1606END SUBROUTINE csv_record_getfield_char
1607
1608
1609!> Returns next field from the record \a this as an \c INTEGER variable.
1610!! The field pointer is advanced to the next field.
1611!! If all the fields have already been interpreted or the field cannot be
1612!! interpreted as an integer, or if it is longer than 32 characters,
1613!! it returns a missing value.
1614SUBROUTINE csv_record_getfield_int(this, field, ier)
1615TYPE(csv_record),INTENT(INOUT) :: this !< object to be decoded
1616INTEGER,INTENT(OUT) :: field !< value of the field, = \a imiss if conversion fails
1617INTEGER,INTENT(OUT),OPTIONAL :: ier !< error code, 0 = OK, 2 = end of record, 3 = cannot convert to integer
1618
1619CHARACTER(len=32) :: cfield
1620INTEGER :: lier
1621
1622CALL csv_record_getfield(this, field=cfield, ier=ier)
1623IF (c_e(cfield) .AND. len_trim(cfield) /= 0) THEN
1624 READ(cfield, '(I32)', iostat=lier) field
1625 IF (lier /= 0) THEN
1626 field = imiss
1627 IF (.NOT.PRESENT(ier)) THEN
1628 CALL l4f_log(l4f_error, &
1629 'in csv_record_getfield, invalid integer field: '//trim(cfield))
1630 CALL raise_error()
1631 ELSE
1632 ier = 3 ! conversion error
1633 ENDIF
1634 ENDIF
1635ELSE
1636 field = imiss
1637ENDIF
1638
1639END SUBROUTINE csv_record_getfield_int
1640
1641
1642!> Returns next field from the record \a this as a \c REAL variable.
1643!! The field pointer is advanced to the next field.
1644!! If all the fields have already been interpreted or the field cannot be
1645!! interpreted as a real, or if it is longer than 32 characters,
1646!! it returns a missing value.
1647SUBROUTINE csv_record_getfield_real(this, field, ier)
1648TYPE(csv_record),INTENT(INOUT) :: this !< object to be decoded
1649REAL,INTENT(OUT) :: field !< value of the field, = \a rmiss if conversion fails
1650INTEGER,INTENT(OUT),OPTIONAL :: ier !< error code, 0 = OK, 2 = end of record, 3 = cannot convert to real
1651
1652CHARACTER(len=32) :: cfield
1653INTEGER :: lier
1654
1655CALL csv_record_getfield(this, field=cfield, ier=ier)
1656IF (c_e(cfield) .AND. len_trim(cfield) /= 0) THEN
1657 READ(cfield, '(F32.0)', iostat=lier) field
1658 IF (lier /= 0) THEN
1659 field = rmiss
1660 IF (.NOT.PRESENT(ier)) THEN
1661 CALL l4f_log(l4f_error, &
1662 'in csv_record_getfield, invalid real field: '//trim(cfield))
1663 CALL raise_error()
1664 ELSE
1665 ier = 3 ! conversion error
1666 ENDIF
1667 ENDIF
1668ELSE
1669 field = rmiss
1670ENDIF
1671
1672END SUBROUTINE csv_record_getfield_real
1673
1674
1675!> Returns next field from the record \a this as a \c DOUBLE PRECISION variable.
1676!! The field pointer is advanced to the next field.
1677!! If all the fields have already been interpreted or the field cannot be
1678!! interpreted as double, or if it is longer than 32 characters,
1679!! it returns a missing value.
1680SUBROUTINE csv_record_getfield_double(this, field, ier)
1681TYPE(csv_record),INTENT(INOUT) :: this !< object to be decoded
1682DOUBLE PRECISION,INTENT(OUT) :: field !< value of the field, = \a dmiss if conversion fails
1683INTEGER,INTENT(OUT),OPTIONAL :: ier !< error code, 0 = OK, 2 = end of record, 3 = cannot convert to double
1684
1685CHARACTER(len=32) :: cfield
1686INTEGER :: lier
1687
1688CALL csv_record_getfield(this, field=cfield, ier=ier)
1689IF (c_e(cfield) .AND. len_trim(cfield) /= 0) THEN
1690 READ(cfield, '(F32.0)', iostat=lier) field
1691 IF (lier /= 0) THEN
1692 field = dmiss
1693 IF (.NOT.PRESENT(ier)) THEN
1694 CALL l4f_log(l4f_error, &
1695 'in csv_record_getfield, invalid double precision field: '//trim(cfield))
1696 CALL raise_error()
1697 ELSE
1698 ier = 3 ! conversion error
1699 ENDIF
1700 ENDIF
1701ELSE
1702 field = dmiss
1703ENDIF
1704
1705END SUBROUTINE csv_record_getfield_double
1706
1707
1708!> Tells whether end of record was reached (\c .TRUE.)
1709!! or there are still some fields left (\c .FALSE.).
1710FUNCTION csv_record_end(this)
1711TYPE(csv_record), INTENT(IN) :: this !< object to be checked for end of record
1712LOGICAL :: csv_record_end
1713
1714csv_record_end = this%cursor > SIZE(this%record)
1715
1716END FUNCTION csv_record_end
1717
1718
1719FUNCTION is_space_c(char) RESULT(is_space)
1720CHARACTER(len=1) :: char
1721LOGICAL :: is_space
1722
1723is_space = (ichar(char) == 32 .OR. ichar(char) == 9) ! improve
1724
1725END FUNCTION is_space_c
1726
1727
1728FUNCTION is_space_b(char) RESULT(is_space)
1729INTEGER(kind=int_b) :: char
1730LOGICAL :: is_space
1731
1732is_space = (char == 32 .OR. char == 9) ! improve
1733
1734END FUNCTION is_space_b
1735
1736
1737END 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:245
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.