libsim Versione 7.2.1

◆ 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 967 del file file_utilities.F90.

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