libsim Versione 7.2.4

◆ csv_record_getfield_real()

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

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
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
983INTEGER, PARAMETER :: filetype_config = 2
984
985
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
1001INTERFACE init
1002 MODULE PROCEDURE csv_record_init
1003END INTERFACE
1004
1008INTERFACE delete
1009 MODULE PROCEDURE csv_record_delete
1010END INTERFACE
1011
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
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
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
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
1099FUNCTION get_package_filepath(filename, filetype) RESULT(path)
1100CHARACTER(len=*), INTENT(in) :: filename
1101INTEGER, INTENT(in) :: filetype
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
1193FUNCTION open_package_file(filename, filetype) RESULT(unit)
1194CHARACTER(len=*), INTENT(in) :: filename
1195INTEGER, INTENT(in) :: filetype
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
1233SUBROUTINE csv_record_init(this, record, csep, cquote, nfield)
1234TYPE(csv_record),INTENT(INOUT) :: this
1235CHARACTER(len=*),INTENT(IN), OPTIONAL :: record
1236CHARACTER(len=1),INTENT(IN),OPTIONAL :: csep
1237CHARACTER(len=1),INTENT(IN),OPTIONAL :: cquote
1238INTEGER,INTENT(OUT),OPTIONAL :: nfield
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
1276SUBROUTINE csv_record_delete(this)
1277TYPE(csv_record), INTENT(INOUT) :: this
1278
1279DEALLOCATE(this%record)
1280
1281END SUBROUTINE csv_record_delete
1282
1283
1285SUBROUTINE csv_record_rewind(this)
1286TYPE(csv_record),INTENT(INOUT) :: this
1287
1288this%cursor = 0
1289this%nfield = 0
1290
1291END SUBROUTINE csv_record_rewind
1292
1293
1297SUBROUTINE csv_record_addfield_char(this, field, force_quote)
1298TYPE(csv_record),INTENT(INOUT) :: this
1299CHARACTER(len=*),INTENT(IN) :: field
1300LOGICAL, INTENT(in), OPTIONAL :: force_quote
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
1384SUBROUTINE csv_record_addfield_char_miss(this, field, force_quote)
1385TYPE(csv_record),INTENT(INOUT) :: this
1386CHARACTER(len=*),INTENT(IN) :: field
1387LOGICAL, INTENT(in), OPTIONAL :: force_quote
1388
1389CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
1390
1391END SUBROUTINE csv_record_addfield_char_miss
1392
1393
1396SUBROUTINE csv_record_addfield_int(this, field, form, force_quote)
1397TYPE(csv_record),INTENT(INOUT) :: this
1398INTEGER,INTENT(IN) :: field
1399CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1400LOGICAL, INTENT(in), OPTIONAL :: force_quote
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
1414SUBROUTINE csv_record_addfield_int_miss(this, field, force_quote)
1415TYPE(csv_record),INTENT(INOUT) :: this
1416INTEGER,INTENT(IN) :: field
1417LOGICAL, INTENT(in), OPTIONAL :: force_quote
1418
1419CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
1420
1421END SUBROUTINE csv_record_addfield_int_miss
1422
1423
1426SUBROUTINE csv_record_addfield_real(this, field, form, force_quote)
1427TYPE(csv_record),INTENT(INOUT) :: this
1428REAL,INTENT(IN) :: field
1429CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1430LOGICAL, INTENT(in), OPTIONAL :: force_quote
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
1444SUBROUTINE csv_record_addfield_real_miss(this, field, force_quote)
1445TYPE(csv_record),INTENT(INOUT) :: this
1446REAL,INTENT(IN) :: field
1447LOGICAL, INTENT(in), OPTIONAL :: force_quote
1448
1449CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
1450
1451END SUBROUTINE csv_record_addfield_real_miss
1452
1453
1456SUBROUTINE csv_record_addfield_double(this, field, form, force_quote)
1457TYPE(csv_record),INTENT(INOUT) :: this
1458DOUBLE PRECISION,INTENT(IN) :: field
1459CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1460LOGICAL, INTENT(in), OPTIONAL :: force_quote
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
1474SUBROUTINE csv_record_addfield_double_miss(this, field, force_quote)
1475TYPE(csv_record),INTENT(INOUT) :: this
1476DOUBLE PRECISION,INTENT(IN) :: field
1477LOGICAL, INTENT(in), OPTIONAL :: force_quote
1478
1479CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
1480
1481END SUBROUTINE csv_record_addfield_double_miss
1482
1483
1489SUBROUTINE csv_record_addfield_csv_record(this, record)
1490TYPE(csv_record),INTENT(INOUT) :: this
1491TYPE(csv_record),INTENT(IN) :: record
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
1507FUNCTION csv_record_getrecord(this, nfield)
1508TYPE(csv_record),INTENT(IN) :: this
1509INTEGER, INTENT(out), OPTIONAL :: nfield
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
1524SUBROUTINE csv_record_getfield_char(this, field, flen, ier)
1525TYPE(csv_record),INTENT(INOUT) :: this
1526CHARACTER(len=*),INTENT(OUT),OPTIONAL :: field
1528INTEGER,INTENT(OUT),OPTIONAL :: flen
1529INTEGER,INTENT(OUT),OPTIONAL :: ier
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
1647SUBROUTINE csv_record_getfield_int(this, field, ier)
1648TYPE(csv_record),INTENT(INOUT) :: this
1649INTEGER,INTENT(OUT) :: field
1650INTEGER,INTENT(OUT),OPTIONAL :: ier
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
1680SUBROUTINE csv_record_getfield_real(this, field, ier)
1681TYPE(csv_record),INTENT(INOUT) :: this
1682REAL,INTENT(OUT) :: field
1683INTEGER,INTENT(OUT),OPTIONAL :: ier
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
1713SUBROUTINE csv_record_getfield_double(this, field, ier)
1714TYPE(csv_record),INTENT(INOUT) :: this
1715DOUBLE PRECISION,INTENT(OUT) :: field
1716INTEGER,INTENT(OUT),OPTIONAL :: ier
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
1743FUNCTION csv_record_end(this)
1744TYPE(csv_record), INTENT(IN) :: this
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.