libsim Versione 7.1.11

◆ csv_record_getfield_double()

subroutine, private csv_record_getfield_double ( type(csv_record), intent(inout)  this,
double precision, intent(out)  field,
integer, intent(out), optional  ier 
)
private

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

Definizione alla linea 973 del file file_utilities.F90.

974! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
975! authors:
976! Davide Cesari <dcesari@arpa.emr.it>
977! Paolo Patruno <ppatruno@arpa.emr.it>
978
979! This program is free software; you can redistribute it and/or
980! modify it under the terms of the GNU General Public License as
981! published by the Free Software Foundation; either version 2 of
982! the License, or (at your option) any later version.
983
984! This program is distributed in the hope that it will be useful,
985! but WITHOUT ANY WARRANTY; without even the implied warranty of
986! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
987! GNU General Public License for more details.
988
989! You should have received a copy of the GNU General Public License
990! along with this program. If not, see <http://www.gnu.org/licenses/>.
991#include "config.h"
992
999MODULE file_utilities
1000USE kinds
1004USE log4fortran
1005USE err_handling
1006IMPLICIT NONE
1007
1008CHARACTER(len=128), PARAMETER :: package_name = package
1009CHARACTER(len=128), PARAMETER :: prefix = prefix
1010
1011INTEGER, PARAMETER, PRIVATE :: nftype = 2
1012CHARACTER(len=10), PARAMETER, PRIVATE :: &
1013 preflist(2,nftype) = reshape((/ &
1014 '/usr/local', '/usr ', &
1015 '/usr/local', ' '/), &
1016 (/2,nftype/))
1017CHARACTER(len=6), PARAMETER, PRIVATE :: &
1018 postfix(nftype) = (/ '/share', '/etc ' /)
1019CHARACTER(len=6), PARAMETER, PRIVATE :: &
1020 filetypename(nftype) = (/ 'DATA ', 'CONFIG' /)
1021INTEGER, PARAMETER :: filetype_data = 1
1022INTEGER, PARAMETER :: filetype_config = 2
1023
1024
1028TYPE csv_record
1029 PRIVATE
1030 INTEGER :: cursor, action, nfield !, ntotal
1031 INTEGER(KIND=int_b) :: csep, cquote
1032 INTEGER(KIND=int_b), POINTER :: record(:)
1033END TYPE csv_record
1034
1035INTEGER, PARAMETER, PRIVATE :: csv_basereclen=1024, &
1036 csv_action_read=0, csv_action_write=1
1037
1040INTERFACE init
1041 MODULE PROCEDURE csv_record_init
1042END INTERFACE
1043
1047INTERFACE delete
1048 MODULE PROCEDURE csv_record_delete
1049END INTERFACE
1050
1064INTERFACE csv_record_getfield
1065 MODULE PROCEDURE csv_record_getfield_char, csv_record_getfield_int, &
1066 csv_record_getfield_real, csv_record_getfield_double
1067END INTERFACE
1068
1074INTERFACE csv_record_addfield
1075 MODULE PROCEDURE csv_record_addfield_char, csv_record_addfield_int, &
1076 csv_record_addfield_real, csv_record_addfield_double, &
1077 csv_record_addfield_csv_record
1078END INTERFACE
1079
1086 MODULE PROCEDURE csv_record_addfield_char_miss, csv_record_addfield_int_miss, &
1087 csv_record_addfield_real_miss, csv_record_addfield_double_miss
1088END INTERFACE
1089
1090
1091PRIVATE csv_record_init, csv_record_delete, csv_record_getfield_char, &
1092 csv_record_getfield_int, csv_record_getfield_real, csv_record_getfield_double, &
1093 csv_record_addfield_char, csv_record_addfield_int, csv_record_addfield_real, &
1094 csv_record_addfield_double, csv_record_addfield_csv_record, &
1095 csv_record_addfield_char_miss, csv_record_addfield_int_miss, &
1096 csv_record_addfield_real_miss, csv_record_addfield_double_miss, &
1097 checkrealloc, add_byte
1098
1099CONTAINS
1100
1113FUNCTION getunit() RESULT(unit)
1114INTEGER :: unit
1115
1116LOGICAL :: op
1117
1118DO unit = 100, 32767
1119 INQUIRE(unit, opened=op)
1120 IF (.NOT. op) RETURN
1121ENDDO
1122
1123CALL l4f_log(l4f_error, 'Too many open files')
1124CALL raise_error()
1125unit = -1
1126
1127END FUNCTION getunit
1128
1138FUNCTION get_package_filepath(filename, filetype) RESULT(path)
1139CHARACTER(len=*), INTENT(in) :: filename
1140INTEGER, INTENT(in) :: filetype
1141character(len=len(filename)) :: lfilename
1142
1143INTEGER :: j
1144CHARACTER(len=512) :: path
1145LOGICAL :: exist,cwd,share
1146
1147!IF (package_name == ' ') THEN
1148! CALL getarg(0, package_name)
1149!ENDIF
1150
1151IF (filetype < 1 .OR. filetype > nftype) THEN
1152 path = ''
1153 CALL l4f_log(l4f_error, 'package file type '//t2c(filetype)// &
1154 ' not valid')
1155 CALL raise_error()
1156 RETURN
1157ENDIF
1158
1159share = filename(:6) == "share:"
1160cwd = filename(:4) == "cwd:"
1161
1162lfilename=filename
1163if (share) lfilename=filename(7:)
1164if (cwd) lfilename=filename(5:)
1165
1166if ( .not. share .and. .not. cwd .and. filetype == filetype_data) then
1167 share=.true.
1168 cwd=.true.
1169end if
1170
1171if (cwd) then
1172 ! try with current dir
1173 path = lfilename
1174 CALL l4f_log(l4f_debug, 'inquire local file '//trim(path))
1175 INQUIRE(file=path, exist=exist)
1176 IF (exist) THEN
1177 CALL l4f_log(l4f_info, 'local file '//trim(path)//' found')
1178 RETURN
1179 ENDIF
1180end if
1181
1182if (share .or. filetype == filetype_config) then
1183
1184 ! try with environment variable
1185 CALL getenv(trim(uppercase(package_name))//'_'//trim(filetypename(filetype)), path)
1186 IF (path /= ' ') THEN
1187
1188 path(len_trim(path)+1:) = '/'//lfilename
1189 CALL l4f_log(l4f_debug, 'inquire env package file '//trim(path))
1190 INQUIRE(file=path, exist=exist)
1191 IF (exist) THEN
1192 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1193 RETURN
1194 ENDIF
1195 ENDIF
1196
1197 ! try with install prefix
1198 path = trim(prefix)//trim(postfix(filetype)) &
1199 //'/'//trim(package_name)//'/'//lfilename
1200 CALL l4f_log(l4f_debug, 'inquire install package file '//trim(path))
1201 INQUIRE(file=path, exist=exist)
1202 IF (exist) THEN
1203 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1204 RETURN
1205 ENDIF
1206
1207 ! try with default install prefix
1208 DO j = 1, SIZE(preflist,1)
1209 IF (preflist(j,filetype) == ' ') EXIT
1210 path = trim(preflist(j,filetype))//trim(postfix(filetype)) &
1211 //'/'//trim(package_name)//'/'//lfilename
1212 CALL l4f_log(l4f_debug, 'inquire package file '//trim(path))
1213 INQUIRE(file=path, exist=exist)
1214 IF (exist) THEN
1215 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1216 RETURN
1217 ENDIF
1218 ENDDO
1219
1220end if
1221
1222CALL l4f_log(l4f_info, 'package file '//trim(lfilename)//' not found')
1223path = cmiss
1224
1225END FUNCTION get_package_filepath
1226
1227
1232FUNCTION open_package_file(filename, filetype) RESULT(unit)
1233CHARACTER(len=*), INTENT(in) :: filename
1234INTEGER, INTENT(in) :: filetype
1235INTEGER :: unit, i
1236
1237CHARACTER(len=512) :: path
1238
1239unit = -1
1240path=get_package_filepath(filename, filetype)
1241IF (path == '') RETURN
1242
1243unit = getunit()
1244IF (unit == -1) RETURN
1245
1246OPEN(unit, file=path, status='old', iostat = i)
1247IF (i == 0) THEN
1248 CALL l4f_log(l4f_info, 'package file '//trim(path)//' opened')
1249 RETURN
1250ENDIF
1251
1252CALL l4f_log(l4f_error, 'package file '//trim(filename)//' not found')
1253CALL raise_error()
1254unit = -1
1255
1256END FUNCTION open_package_file
1257
1258
1272SUBROUTINE csv_record_init(this, record, csep, cquote, nfield)
1273TYPE(csv_record),INTENT(INOUT) :: this
1274CHARACTER(len=*),INTENT(IN), OPTIONAL :: record
1275CHARACTER(len=1),INTENT(IN),OPTIONAL :: csep
1276CHARACTER(len=1),INTENT(IN),OPTIONAL :: cquote
1277INTEGER,INTENT(OUT),OPTIONAL :: nfield
1278
1279INTEGER :: l
1280
1281IF (PRESENT(csep)) THEN
1282 this%csep = transfer(csep, this%csep)
1283ELSE
1284 this%csep = transfer(',', this%csep)
1285ENDIF
1286IF (PRESENT(cquote)) THEN
1287 this%cquote = transfer(cquote, this%cquote)
1288ELSE
1289 this%cquote = transfer('"', this%cquote)
1290ENDIF
1291
1292this%cursor = 0
1293this%nfield = 0
1294IF (PRESENT(record)) THEN
1295 l = len_trim(record)
1296 ALLOCATE(this%record(l))
1297 this%record(:) = transfer(record, this%record, l) ! ice in pgf90 with TRIM(record)
1298
1299 IF (PRESENT(nfield)) THEN
1300 nfield = 0
1301 DO WHILE(.NOT.csv_record_end(this)) ! faccio un giro a vuoto sul record
1302 nfield = nfield + 1
1303 CALL csv_record_getfield(this)
1304 ENDDO
1305 this%cursor = 0 ! riazzero il cursore
1306 ENDIF
1307ELSE
1308 ALLOCATE(this%record(csv_basereclen))
1309ENDIF
1310
1311END SUBROUTINE csv_record_init
1312
1313
1315SUBROUTINE csv_record_delete(this)
1316TYPE(csv_record), INTENT(INOUT) :: this
1317
1318DEALLOCATE(this%record)
1319
1320END SUBROUTINE csv_record_delete
1321
1322
1324SUBROUTINE csv_record_rewind(this)
1325TYPE(csv_record),INTENT(INOUT) :: this
1326
1327this%cursor = 0
1328this%nfield = 0
1329
1330END SUBROUTINE csv_record_rewind
1331
1332
1336SUBROUTINE csv_record_addfield_char(this, field, force_quote)
1337TYPE(csv_record),INTENT(INOUT) :: this
1338CHARACTER(len=*),INTENT(IN) :: field
1339LOGICAL, INTENT(in), OPTIONAL :: force_quote
1340
1341INTEGER :: i
1342LOGICAL :: lquote
1343
1344lquote = optio_log(force_quote)
1345IF (len(field) == 0) THEN ! Particular case to be handled separately
1346 CALL checkrealloc(this, 1)
1347 IF (this%nfield > 0) THEN
1348 CALL add_byte(this, this%csep) ! add separator if necessary
1349 ELSE
1350 CALL add_byte(this, this%cquote) ! if first record is empty it should be quoted
1351 CALL add_byte(this, this%cquote) ! in case it is the only one
1352 ENDIF
1353ELSE IF (index(field, transfer(this%csep,field(1:1))) == 0 &
1354 .AND. index(field, transfer(this%cquote,field(1:1))) == 0 &
1355 .AND. .NOT.is_space_c(field(1:1)) &
1356 .AND. .NOT.is_space_c(field(len(field):len(field))) &
1357 .AND. .NOT.lquote) THEN ! quote not required
1358 CALL checkrealloc(this, len(field)+1)
1359 IF (this%nfield > 0) CALL add_byte(this, this%csep) ! add separator if necessary
1360 this%record(this%cursor+1:this%cursor+len(field)) = transfer(field, this%record)
1361 this%cursor = this%cursor + len(field)
1362ELSE ! quote required
1363 CALL checkrealloc(this, 2*len(field)+3) ! worst case """""""""
1364 IF (this%nfield > 0) CALL add_byte(this, this%csep) ! add separator if necessary
1365 CALL add_byte(this, this%cquote) ! add quote
1366 DO i = 1, len(field)
1367 CALL add_char(field(i:i))
1368 ENDDO
1369 CALL add_byte(this, this%cquote) ! add quote
1370ENDIF
1371
1372this%nfield = this%nfield + 1
1373
1374CONTAINS
1375
1376! add a character, doubling it if it's a quote
1377SUBROUTINE add_char(char)
1378CHARACTER(len=1) :: char
1379
1380this%cursor = this%cursor+1
1381this%record(this%cursor) = transfer(char, this%record(1))
1382IF (this%record(this%cursor) == this%cquote) THEN ! double the quote
1383 this%cursor = this%cursor+1
1384 this%record(this%cursor) = this%cquote
1385ENDIF
1386
1387END SUBROUTINE add_char
1388
1389END SUBROUTINE csv_record_addfield_char
1390
1391
1392! Reallocate record if necessary
1393SUBROUTINE checkrealloc(this, enlarge)
1394TYPE(csv_record),INTENT(INOUT) :: this
1395INTEGER, INTENT(in) :: enlarge
1396
1397INTEGER(KIND=int_b), POINTER :: tmpptr(:)
1398
1399IF (this%cursor+enlarge+1 > SIZE(this%record)) THEN
1400 ALLOCATE(tmpptr(SIZE(this%record)+max(csv_basereclen, enlarge)))
1401 tmpptr(1:SIZE(this%record)) = this%record(:)
1402 DEALLOCATE(this%record)
1403 this%record => tmpptr
1404ENDIF
1405
1406END SUBROUTINE checkrealloc
1407
1408
1409! add a byte
1410SUBROUTINE add_byte(this, char)
1411TYPE(csv_record),INTENT(INOUT) :: this
1412INTEGER(kind=int_b) :: char
1413
1414this%cursor = this%cursor+1
1415this%record(this%cursor) = char
1416
1417END SUBROUTINE add_byte
1418
1419
1423SUBROUTINE csv_record_addfield_char_miss(this, field, force_quote)
1424TYPE(csv_record),INTENT(INOUT) :: this
1425CHARACTER(len=*),INTENT(IN) :: field
1426LOGICAL, INTENT(in), OPTIONAL :: force_quote
1427
1428CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
1429
1430END SUBROUTINE csv_record_addfield_char_miss
1431
1432
1435SUBROUTINE csv_record_addfield_int(this, field, form, force_quote)
1436TYPE(csv_record),INTENT(INOUT) :: this
1437INTEGER,INTENT(IN) :: field
1438CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1439LOGICAL, INTENT(in), OPTIONAL :: force_quote
1440
1441IF (PRESENT(form)) THEN
1442 CALL csv_record_addfield(this, trim(to_char(field, form)), force_quote=force_quote)
1443ELSE
1444 CALL csv_record_addfield(this, t2c(field), force_quote=force_quote)
1445ENDIF
1446
1447END SUBROUTINE csv_record_addfield_int
1448
1449
1453SUBROUTINE csv_record_addfield_int_miss(this, field, force_quote)
1454TYPE(csv_record),INTENT(INOUT) :: this
1455INTEGER,INTENT(IN) :: field
1456LOGICAL, INTENT(in), OPTIONAL :: force_quote
1457
1458CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
1459
1460END SUBROUTINE csv_record_addfield_int_miss
1461
1462
1465SUBROUTINE csv_record_addfield_real(this, field, form, force_quote)
1466TYPE(csv_record),INTENT(INOUT) :: this
1467REAL,INTENT(IN) :: field
1468CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1469LOGICAL, INTENT(in), OPTIONAL :: force_quote
1470
1471IF (PRESENT(form)) THEN
1472 CALL csv_record_addfield(this, trim(to_char(field, form)), force_quote=force_quote)
1473ELSE
1474 CALL csv_record_addfield(this, t2c(field), force_quote=force_quote)
1475ENDIF
1476
1477END SUBROUTINE csv_record_addfield_real
1478
1479
1483SUBROUTINE csv_record_addfield_real_miss(this, field, force_quote)
1484TYPE(csv_record),INTENT(INOUT) :: this
1485REAL,INTENT(IN) :: field
1486LOGICAL, INTENT(in), OPTIONAL :: force_quote
1487
1488CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
1489
1490END SUBROUTINE csv_record_addfield_real_miss
1491
1492
1495SUBROUTINE csv_record_addfield_double(this, field, form, force_quote)
1496TYPE(csv_record),INTENT(INOUT) :: this
1497DOUBLE PRECISION,INTENT(IN) :: field
1498CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1499LOGICAL, INTENT(in), OPTIONAL :: force_quote
1500
1501IF (PRESENT(form)) THEN
1502 CALL csv_record_addfield(this, trim(to_char(field, form)), force_quote=force_quote)
1503ELSE
1504 CALL csv_record_addfield(this, t2c(field), force_quote=force_quote)
1505ENDIF
1506
1507END SUBROUTINE csv_record_addfield_double
1508
1509
1513SUBROUTINE csv_record_addfield_double_miss(this, field, force_quote)
1514TYPE(csv_record),INTENT(INOUT) :: this
1515DOUBLE PRECISION,INTENT(IN) :: field
1516LOGICAL, INTENT(in), OPTIONAL :: force_quote
1517
1518CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
1519
1520END SUBROUTINE csv_record_addfield_double_miss
1521
1522
1528SUBROUTINE csv_record_addfield_csv_record(this, record)
1529TYPE(csv_record),INTENT(INOUT) :: this
1530TYPE(csv_record),INTENT(IN) :: record
1531
1532IF (this%csep /= record%csep .OR. this%cquote /= record%cquote) RETURN ! error
1533CALL checkrealloc(this, record%cursor)
1534IF (this%nfield > 0) CALL add_byte(this, this%csep)
1535
1536this%record(this%cursor+1:this%cursor+record%cursor) = &
1537 record%record(1:record%cursor)
1538this%cursor = this%cursor + record%cursor
1539this%nfield = this%nfield + record%nfield
1540
1541END SUBROUTINE csv_record_addfield_csv_record
1542
1543
1546FUNCTION csv_record_getrecord(this, nfield)
1547TYPE(csv_record),INTENT(IN) :: this
1548INTEGER, INTENT(out), OPTIONAL :: nfield
1549
1550CHARACTER(len=this%cursor) :: csv_record_getrecord
1551
1552csv_record_getrecord = transfer(this%record(1:this%cursor), csv_record_getrecord)
1553IF (present(nfield)) nfield = this%nfield
1554
1555END FUNCTION csv_record_getrecord
1556
1557
1563SUBROUTINE csv_record_getfield_char(this, field, flen, ier)
1564TYPE(csv_record),INTENT(INOUT) :: this
1565CHARACTER(len=*),INTENT(OUT),OPTIONAL :: field
1567INTEGER,INTENT(OUT),OPTIONAL :: flen
1568INTEGER,INTENT(OUT),OPTIONAL :: ier
1569
1570LOGICAL :: inquote, inpre, inpost, firstquote
1571INTEGER :: i, ocursor, ofcursor
1572
1573! check end of record
1574IF (csv_record_end(this)) THEN
1575 IF (PRESENT(field)) field = cmiss
1576 IF (PRESENT(ier))THEN
1577 ier = 2
1578 ELSE
1579 CALL l4f_log(l4f_error, &
1580 'in csv_record_getfield, attempt to read past end of record')
1581 CALL raise_error()
1582 ENDIF
1583 RETURN
1584ENDIF
1585! start decoding
1586IF (PRESENT(field)) field = ''
1587IF (PRESENT(ier)) ier = 0
1588ocursor = 0
1589ofcursor = 0
1590inquote = .false.
1591inpre = .true.
1592inpost = .false.
1593firstquote = .false.
1594
1595DO i = this%cursor+1, SIZE(this%record)
1596 IF (inpre) THEN ! sono nel preludio, butto via gli spazi
1597 IF (is_space_b(this%record(i))) THEN
1598 cycle
1599 ELSE
1600 inpre = .false.
1601 ENDIF
1602 ENDIF
1603
1604 IF (.NOT.inquote) THEN ! fuori da " "
1605 IF (this%record(i) == this%cquote) THEN ! ": inizia " "
1606 inquote = .true.
1607 cycle
1608 ELSE IF (this%record(i) == this%csep) THEN ! ,: fine campo
1609 EXIT
1610 ELSE ! carattere normale, elimina "trailing blanks"
1611 CALL add_char(this%record(i), .true., field)
1612 cycle
1613 ENDIF
1614 ELSE ! dentro " "
1615 IF (.NOT.firstquote) THEN ! il precedente non e` "
1616 IF (this%record(i) == this%cquote) THEN ! ": fine " " oppure ""
1617 firstquote = .true.
1618 cycle
1619 ELSE ! carattere normale
1620 CALL add_char(this%record(i), .false., field)
1621 cycle
1622 ENDIF
1623 ELSE ! il precedente e` "
1624 firstquote = .false.
1625 IF (this%record(i) == this%cquote) THEN ! ": sequenza ""
1626 CALL add_char(this%cquote, .false., field)
1627 cycle
1628 ELSE ! carattere normale: e` terminata " "
1629 inquote = .false.
1630 IF (this%record(i) == this%csep) THEN ! , fine campo
1631 EXIT
1632 ELSE ! carattere normale, elimina "trailing blanks"
1633 CALL add_char(this%record(i), .true., field)
1634 cycle
1635 ENDIF
1636 ENDIF
1637 ENDIF
1638 ENDIF
1639ENDDO
1640
1641this%cursor = min(i, SIZE(this%record) + 1)
1642IF (PRESENT(flen)) flen = ofcursor ! restituisco la lunghezza
1643IF (PRESENT(field)) THEN ! controllo overflow di field
1644 IF (ofcursor > len(field)) THEN
1645 IF (PRESENT(ier)) THEN
1646 ier = 1
1647 ELSE
1648 CALL l4f_log(l4f_warn, &
1649 'in csv_record_getfield, CHARACTER variable too short for field: '// &
1650 t2c(len(field))//'/'//t2c(ocursor))
1651 ENDIF
1652 ENDIF
1653ENDIF
1654
1655CONTAINS
1656
1657SUBROUTINE add_char(char, check_space, field)
1658INTEGER(kind=int_b) :: char
1659LOGICAL,INTENT(IN) :: check_space
1660CHARACTER(len=*),INTENT(OUT),OPTIONAL :: field
1661
1662CHARACTER(len=1) :: dummy ! this prevents a memory leak in TRANSFER()???
1663
1664ocursor = ocursor + 1
1665 IF (PRESENT(field)) THEN
1666 IF (ocursor <= len(field)) THEN
1667 field(ocursor:ocursor) = transfer(char, dummy)
1668 ENDIF
1669ENDIF
1670IF (check_space) THEN
1671 IF (.NOT.is_space_b(char)) ofcursor = ocursor
1672ELSE
1673 ofcursor = ocursor
1674ENDIF
1675
1676END SUBROUTINE add_char
1677
1678END SUBROUTINE csv_record_getfield_char
1679
1680
1686SUBROUTINE csv_record_getfield_int(this, field, ier)
1687TYPE(csv_record),INTENT(INOUT) :: this
1688INTEGER,INTENT(OUT) :: field
1689INTEGER,INTENT(OUT),OPTIONAL :: ier
1690
1691CHARACTER(len=32) :: cfield
1692INTEGER :: lier
1693
1694CALL csv_record_getfield(this, field=cfield, ier=ier)
1695IF (c_e(cfield) .AND. len_trim(cfield) /= 0) THEN
1696 READ(cfield, '(I32)', iostat=lier) field
1697 IF (lier /= 0) THEN
1698 field = imiss
1699 IF (.NOT.PRESENT(ier)) THEN
1700 CALL l4f_log(l4f_error, &
1701 'in csv_record_getfield, invalid integer field: '//trim(cfield))
1702 CALL raise_error()
1703 ELSE
1704 ier = 3 ! conversion error
1705 ENDIF
1706 ENDIF
1707ELSE
1708 field = imiss
1709ENDIF
1710
1711END SUBROUTINE csv_record_getfield_int
1712
1713
1719SUBROUTINE csv_record_getfield_real(this, field, ier)
1720TYPE(csv_record),INTENT(INOUT) :: this
1721REAL,INTENT(OUT) :: field
1722INTEGER,INTENT(OUT),OPTIONAL :: ier
1723
1724CHARACTER(len=32) :: cfield
1725INTEGER :: lier
1726
1727CALL csv_record_getfield(this, field=cfield, ier=ier)
1728IF (c_e(cfield) .AND. len_trim(cfield) /= 0) THEN
1729 READ(cfield, '(F32.0)', iostat=lier) field
1730 IF (lier /= 0) THEN
1731 field = rmiss
1732 IF (.NOT.PRESENT(ier)) THEN
1733 CALL l4f_log(l4f_error, &
1734 'in csv_record_getfield, invalid real field: '//trim(cfield))
1735 CALL raise_error()
1736 ELSE
1737 ier = 3 ! conversion error
1738 ENDIF
1739 ENDIF
1740ELSE
1741 field = rmiss
1742ENDIF
1743
1744END SUBROUTINE csv_record_getfield_real
1745
1746
1752SUBROUTINE csv_record_getfield_double(this, field, ier)
1753TYPE(csv_record),INTENT(INOUT) :: this
1754DOUBLE PRECISION,INTENT(OUT) :: field
1755INTEGER,INTENT(OUT),OPTIONAL :: ier
1756
1757CHARACTER(len=32) :: cfield
1758INTEGER :: lier
1759
1760CALL csv_record_getfield(this, field=cfield, ier=ier)
1761IF (c_e(cfield) .AND. len_trim(cfield) /= 0) THEN
1762 READ(cfield, '(F32.0)', iostat=lier) field
1763 IF (lier /= 0) THEN
1764 field = dmiss
1765 IF (.NOT.PRESENT(ier)) THEN
1766 CALL l4f_log(l4f_error, &
1767 'in csv_record_getfield, invalid double precision field: '//trim(cfield))
1768 CALL raise_error()
1769 ELSE
1770 ier = 3 ! conversion error
1771 ENDIF
1772 ENDIF
1773ELSE
1774 field = dmiss
1775ENDIF
1776
1777END SUBROUTINE csv_record_getfield_double
1778
1779
1782FUNCTION csv_record_end(this)
1783TYPE(csv_record), INTENT(IN) :: this
1784LOGICAL :: csv_record_end
1785
1786csv_record_end = this%cursor > SIZE(this%record)
1787
1788END FUNCTION csv_record_end
1789
1790
1791FUNCTION is_space_c(char) RESULT(is_space)
1792CHARACTER(len=1) :: char
1793LOGICAL :: is_space
1794
1795is_space = (ichar(char) == 32 .OR. ichar(char) == 9) ! improve
1796
1797END FUNCTION is_space_c
1798
1799
1800FUNCTION is_space_b(char) RESULT(is_space)
1801INTEGER(kind=int_b) :: char
1802LOGICAL :: is_space
1803
1804is_space = (char == 32 .OR. char == 9) ! improve
1805
1806END FUNCTION is_space_b
1807
1808
1809END 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.