libsim Versione 7.2.6

◆ csv_record_getfield_real()

subroutine csv_record_getfield_real ( type(csv_record), intent(inout) this,
real, intent(out) field,
integer, intent(out), optional ier )

Returns next field from the record this as a REAL 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 a real, 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, = rmiss if conversion fails
[out]iererror code, 0 = OK, 2 = end of record, 3 = cannot convert to real

Definizione alla linea 934 del file file_utilities.F90.

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