libsim Versione 7.2.4
|
◆ csv_record_end()
Tells whether end of record was reached (
Definizione alla linea 997 del file file_utilities.F90. 998! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
999! authors:
1000! Davide Cesari <dcesari@arpa.emr.it>
1001! Paolo Patruno <ppatruno@arpa.emr.it>
1002
1003! This program is free software; you can redistribute it and/or
1004! modify it under the terms of the GNU General Public License as
1005! published by the Free Software Foundation; either version 2 of
1006! the License, or (at your option) any later version.
1007
1008! This program is distributed in the hope that it will be useful,
1009! but WITHOUT ANY WARRANTY; without even the implied warranty of
1010! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1011! GNU General Public License for more details.
1012
1013! You should have received a copy of the GNU General Public License
1014! along with this program. If not, see <http://www.gnu.org/licenses/>.
1015#include "config.h"
1016
1030IMPLICIT NONE
1031
1032CHARACTER(len=128), PARAMETER :: package_name = package
1033CHARACTER(len=128), PARAMETER :: prefix = prefix
1034
1035INTEGER, PARAMETER, PRIVATE :: nftype = 2
1036CHARACTER(len=10), PARAMETER, PRIVATE :: &
1037 preflist(2,nftype) = reshape((/ &
1038 '/usr/local', '/usr ', &
1039 '/usr/local', ' '/), &
1040 (/2,nftype/))
1041CHARACTER(len=6), PARAMETER, PRIVATE :: &
1042 postfix(nftype) = (/ '/share', '/etc ' /)
1043CHARACTER(len=6), PARAMETER, PRIVATE :: &
1044 filetypename(nftype) = (/ 'DATA ', 'CONFIG' /)
1045INTEGER, PARAMETER :: filetype_data = 1
1046INTEGER, PARAMETER :: filetype_config = 2
1047
1048
1053 PRIVATE
1054 INTEGER :: cursor, action, nfield !, ntotal
1055 INTEGER(KIND=int_b) :: csep, cquote
1056 INTEGER(KIND=int_b), POINTER :: record(:)
1058
1059INTEGER, PARAMETER, PRIVATE :: csv_basereclen=1024, &
1060 csv_action_read=0, csv_action_write=1
1061
1065 MODULE PROCEDURE csv_record_init
1066END INTERFACE
1067
1072 MODULE PROCEDURE csv_record_delete
1073END INTERFACE
1074
1089 MODULE PROCEDURE csv_record_getfield_char, csv_record_getfield_int, &
1090 csv_record_getfield_real, csv_record_getfield_double
1091END INTERFACE
1092
1099 MODULE PROCEDURE csv_record_addfield_char, csv_record_addfield_int, &
1100 csv_record_addfield_real, csv_record_addfield_double, &
1101 csv_record_addfield_csv_record
1102END INTERFACE
1103
1110 MODULE PROCEDURE csv_record_addfield_char_miss, csv_record_addfield_int_miss, &
1111 csv_record_addfield_real_miss, csv_record_addfield_double_miss
1112END INTERFACE
1113
1114
1115PRIVATE csv_record_init, csv_record_delete, csv_record_getfield_char, &
1116 csv_record_getfield_int, csv_record_getfield_real, csv_record_getfield_double, &
1117 csv_record_addfield_char, csv_record_addfield_int, csv_record_addfield_real, &
1118 csv_record_addfield_double, csv_record_addfield_csv_record, &
1119 csv_record_addfield_char_miss, csv_record_addfield_int_miss, &
1120 csv_record_addfield_real_miss, csv_record_addfield_double_miss, &
1121 checkrealloc, add_byte
1122
1123CONTAINS
1124
1137FUNCTION getunit() RESULT(unit)
1138INTEGER :: unit
1139
1140LOGICAL :: op
1141
1142DO unit = 100, 32767
1143 INQUIRE(unit, opened=op)
1144 IF (.NOT. op) RETURN
1145ENDDO
1146
1147CALL l4f_log(l4f_error, 'Too many open files')
1148CALL raise_error()
1149unit = -1
1150
1151END FUNCTION getunit
1152
1162FUNCTION get_package_filepath(filename, filetype) RESULT(path)
1163CHARACTER(len=*), INTENT(in) :: filename
1164INTEGER, INTENT(in) :: filetype
1165character(len=len(filename)) :: lfilename
1166
1167INTEGER :: j
1168CHARACTER(len=512) :: path
1169LOGICAL :: exist,cwd,share
1170
1171!IF (package_name == ' ') THEN
1172! CALL getarg(0, package_name)
1173!ENDIF
1174
1175IF (filetype < 1 .OR. filetype > nftype) THEN
1176 path = ''
1178 ' not valid')
1179 CALL raise_error()
1180 RETURN
1181ENDIF
1182
1183share = filename(:6) == "share:"
1184cwd = filename(:4) == "cwd:"
1185
1186lfilename=filename
1187if (share) lfilename=filename(7:)
1188if (cwd) lfilename=filename(5:)
1189
1190if ( .not. share .and. .not. cwd .and. filetype == filetype_data) then
1191 share=.true.
1192 cwd=.true.
1193end if
1194
1195if (cwd) then
1196 ! try with current dir
1197 path = lfilename
1198 CALL l4f_log(l4f_debug, 'inquire local file '//trim(path))
1199 INQUIRE(file=path, exist=exist)
1200 IF (exist) THEN
1201 CALL l4f_log(l4f_info, 'local file '//trim(path)//' found')
1202 RETURN
1203 ENDIF
1204end if
1205
1206if (share .or. filetype == filetype_config) then
1207
1208 ! try with environment variable
1209 CALL getenv(trim(uppercase(package_name))//'_'//trim(filetypename(filetype)), path)
1210 IF (path /= ' ') THEN
1211
1212 path(len_trim(path)+1:) = '/'//lfilename
1213 CALL l4f_log(l4f_debug, 'inquire env package file '//trim(path))
1214 INQUIRE(file=path, exist=exist)
1215 IF (exist) THEN
1216 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1217 RETURN
1218 ENDIF
1219 ENDIF
1220
1221 ! try with install prefix
1222 path = trim(prefix)//trim(postfix(filetype)) &
1223 //'/'//trim(package_name)//'/'//lfilename
1224 CALL l4f_log(l4f_debug, 'inquire install package file '//trim(path))
1225 INQUIRE(file=path, exist=exist)
1226 IF (exist) THEN
1227 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1228 RETURN
1229 ENDIF
1230
1231 ! try with default install prefix
1232 DO j = 1, SIZE(preflist,1)
1233 IF (preflist(j,filetype) == ' ') EXIT
1234 path = trim(preflist(j,filetype))//trim(postfix(filetype)) &
1235 //'/'//trim(package_name)//'/'//lfilename
1236 CALL l4f_log(l4f_debug, 'inquire package file '//trim(path))
1237 INQUIRE(file=path, exist=exist)
1238 IF (exist) THEN
1239 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1240 RETURN
1241 ENDIF
1242 ENDDO
1243
1244end if
1245
1246CALL l4f_log(l4f_info, 'package file '//trim(lfilename)//' not found')
1247path = cmiss
1248
1249END FUNCTION get_package_filepath
1250
1251
1256FUNCTION open_package_file(filename, filetype) RESULT(unit)
1257CHARACTER(len=*), INTENT(in) :: filename
1258INTEGER, INTENT(in) :: filetype
1259INTEGER :: unit, i
1260
1261CHARACTER(len=512) :: path
1262
1263unit = -1
1264path=get_package_filepath(filename, filetype)
1265IF (path == '') RETURN
1266
1267unit = getunit()
1268IF (unit == -1) RETURN
1269
1270OPEN(unit, file=path, status='old', iostat = i)
1271IF (i == 0) THEN
1272 CALL l4f_log(l4f_info, 'package file '//trim(path)//' opened')
1273 RETURN
1274ENDIF
1275
1276CALL l4f_log(l4f_error, 'package file '//trim(filename)//' not found')
1277CALL raise_error()
1278unit = -1
1279
1280END FUNCTION open_package_file
1281
1282
1296SUBROUTINE csv_record_init(this, record, csep, cquote, nfield)
1297TYPE(csv_record),INTENT(INOUT) :: this
1298CHARACTER(len=*),INTENT(IN), OPTIONAL :: record
1299CHARACTER(len=1),INTENT(IN),OPTIONAL :: csep
1300CHARACTER(len=1),INTENT(IN),OPTIONAL :: cquote
1301INTEGER,INTENT(OUT),OPTIONAL :: nfield
1302
1303INTEGER :: l
1304
1305IF (PRESENT(csep)) THEN
1306 this%csep = transfer(csep, this%csep)
1307ELSE
1308 this%csep = transfer(',', this%csep)
1309ENDIF
1310IF (PRESENT(cquote)) THEN
1311 this%cquote = transfer(cquote, this%cquote)
1312ELSE
1313 this%cquote = transfer('"', this%cquote)
1314ENDIF
1315
1316this%cursor = 0
1317this%nfield = 0
1318IF (PRESENT(record)) THEN
1319 l = len_trim(record)
1320 ALLOCATE(this%record(l))
1321 this%record(:) = transfer(record, this%record, l) ! ice in pgf90 with TRIM(record)
1322
1323 IF (PRESENT(nfield)) THEN
1324 nfield = 0
1325 DO WHILE(.NOT.csv_record_end(this)) ! faccio un giro a vuoto sul record
1326 nfield = nfield + 1
1328 ENDDO
1329 this%cursor = 0 ! riazzero il cursore
1330 ENDIF
1331ELSE
1332 ALLOCATE(this%record(csv_basereclen))
1333ENDIF
1334
1335END SUBROUTINE csv_record_init
1336
1337
1339SUBROUTINE csv_record_delete(this)
1340TYPE(csv_record), INTENT(INOUT) :: this
1341
1342DEALLOCATE(this%record)
1343
1344END SUBROUTINE csv_record_delete
1345
1346
1348SUBROUTINE csv_record_rewind(this)
1349TYPE(csv_record),INTENT(INOUT) :: this
1350
1351this%cursor = 0
1352this%nfield = 0
1353
1354END SUBROUTINE csv_record_rewind
1355
1356
1360SUBROUTINE csv_record_addfield_char(this, field, force_quote)
1361TYPE(csv_record),INTENT(INOUT) :: this
1362CHARACTER(len=*),INTENT(IN) :: field
1363LOGICAL, INTENT(in), OPTIONAL :: force_quote
1364
1365INTEGER :: i
1366LOGICAL :: lquote
1367
1368lquote = optio_log(force_quote)
1369IF (len(field) == 0) THEN ! Particular case to be handled separately
1370 CALL checkrealloc(this, 1)
1371 IF (this%nfield > 0) THEN
1372 CALL add_byte(this, this%csep) ! add separator if necessary
1373 ELSE
1374 CALL add_byte(this, this%cquote) ! if first record is empty it should be quoted
1375 CALL add_byte(this, this%cquote) ! in case it is the only one
1376 ENDIF
1378 .AND. index(field, transfer(this%cquote,field(1:1))) == 0 &
1379 .AND. .NOT.is_space_c(field(1:1)) &
1380 .AND. .NOT.is_space_c(field(len(field):len(field))) &
1381 .AND. .NOT.lquote) THEN ! quote not required
1382 CALL checkrealloc(this, len(field)+1)
1383 IF (this%nfield > 0) CALL add_byte(this, this%csep) ! add separator if necessary
1384 this%record(this%cursor+1:this%cursor+len(field)) = transfer(field, this%record)
1385 this%cursor = this%cursor + len(field)
1386ELSE ! quote required
1387 CALL checkrealloc(this, 2*len(field)+3) ! worst case """""""""
1388 IF (this%nfield > 0) CALL add_byte(this, this%csep) ! add separator if necessary
1389 CALL add_byte(this, this%cquote) ! add quote
1390 DO i = 1, len(field)
1391 CALL add_char(field(i:i))
1392 ENDDO
1393 CALL add_byte(this, this%cquote) ! add quote
1394ENDIF
1395
1396this%nfield = this%nfield + 1
1397
1398CONTAINS
1399
1400! add a character, doubling it if it's a quote
1401SUBROUTINE add_char(char)
1402CHARACTER(len=1) :: char
1403
1404this%cursor = this%cursor+1
1405this%record(this%cursor) = transfer(char, this%record(1))
1406IF (this%record(this%cursor) == this%cquote) THEN ! double the quote
1407 this%cursor = this%cursor+1
1408 this%record(this%cursor) = this%cquote
1409ENDIF
1410
1411END SUBROUTINE add_char
1412
1413END SUBROUTINE csv_record_addfield_char
1414
1415
1416! Reallocate record if necessary
1417SUBROUTINE checkrealloc(this, enlarge)
1418TYPE(csv_record),INTENT(INOUT) :: this
1419INTEGER, INTENT(in) :: enlarge
1420
1421INTEGER(KIND=int_b), POINTER :: tmpptr(:)
1422
1423IF (this%cursor+enlarge+1 > SIZE(this%record)) THEN
1424 ALLOCATE(tmpptr(SIZE(this%record)+max(csv_basereclen, enlarge)))
1425 tmpptr(1:SIZE(this%record)) = this%record(:)
1426 DEALLOCATE(this%record)
1427 this%record => tmpptr
1428ENDIF
1429
1430END SUBROUTINE checkrealloc
1431
1432
1433! add a byte
1434SUBROUTINE add_byte(this, char)
1435TYPE(csv_record),INTENT(INOUT) :: this
1436INTEGER(kind=int_b) :: char
1437
1438this%cursor = this%cursor+1
1439this%record(this%cursor) = char
1440
1441END SUBROUTINE add_byte
1442
1443
1447SUBROUTINE csv_record_addfield_char_miss(this, field, force_quote)
1448TYPE(csv_record),INTENT(INOUT) :: this
1449CHARACTER(len=*),INTENT(IN) :: field
1450LOGICAL, INTENT(in), OPTIONAL :: force_quote
1451
1453
1454END SUBROUTINE csv_record_addfield_char_miss
1455
1456
1459SUBROUTINE csv_record_addfield_int(this, field, form, force_quote)
1460TYPE(csv_record),INTENT(INOUT) :: this
1461INTEGER,INTENT(IN) :: field
1462CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1463LOGICAL, INTENT(in), OPTIONAL :: force_quote
1464
1465IF (PRESENT(form)) THEN
1467ELSE
1469ENDIF
1470
1471END SUBROUTINE csv_record_addfield_int
1472
1473
1477SUBROUTINE csv_record_addfield_int_miss(this, field, force_quote)
1478TYPE(csv_record),INTENT(INOUT) :: this
1479INTEGER,INTENT(IN) :: field
1480LOGICAL, INTENT(in), OPTIONAL :: force_quote
1481
1483
1484END SUBROUTINE csv_record_addfield_int_miss
1485
1486
1489SUBROUTINE csv_record_addfield_real(this, field, form, force_quote)
1490TYPE(csv_record),INTENT(INOUT) :: this
1491REAL,INTENT(IN) :: field
1492CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1493LOGICAL, INTENT(in), OPTIONAL :: force_quote
1494
1495IF (PRESENT(form)) THEN
1497ELSE
1499ENDIF
1500
1501END SUBROUTINE csv_record_addfield_real
1502
1503
1507SUBROUTINE csv_record_addfield_real_miss(this, field, force_quote)
1508TYPE(csv_record),INTENT(INOUT) :: this
1509REAL,INTENT(IN) :: field
1510LOGICAL, INTENT(in), OPTIONAL :: force_quote
1511
1513
1514END SUBROUTINE csv_record_addfield_real_miss
1515
1516
1519SUBROUTINE csv_record_addfield_double(this, field, form, force_quote)
1520TYPE(csv_record),INTENT(INOUT) :: this
1521DOUBLE PRECISION,INTENT(IN) :: field
1522CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1523LOGICAL, INTENT(in), OPTIONAL :: force_quote
1524
1525IF (PRESENT(form)) THEN
1527ELSE
1529ENDIF
1530
1531END SUBROUTINE csv_record_addfield_double
1532
1533
1537SUBROUTINE csv_record_addfield_double_miss(this, field, force_quote)
1538TYPE(csv_record),INTENT(INOUT) :: this
1539DOUBLE PRECISION,INTENT(IN) :: field
1540LOGICAL, INTENT(in), OPTIONAL :: force_quote
1541
1543
1544END SUBROUTINE csv_record_addfield_double_miss
1545
1546
1552SUBROUTINE csv_record_addfield_csv_record(this, record)
1553TYPE(csv_record),INTENT(INOUT) :: this
1554TYPE(csv_record),INTENT(IN) :: record
1555
1556IF (this%csep /= record%csep .OR. this%cquote /= record%cquote) RETURN ! error
1557CALL checkrealloc(this, record%cursor)
1558IF (this%nfield > 0) CALL add_byte(this, this%csep)
1559
1560this%record(this%cursor+1:this%cursor+record%cursor) = &
1561 record%record(1:record%cursor)
1562this%cursor = this%cursor + record%cursor
1563this%nfield = this%nfield + record%nfield
1564
1565END SUBROUTINE csv_record_addfield_csv_record
1566
1567
1570FUNCTION csv_record_getrecord(this, nfield)
1571TYPE(csv_record),INTENT(IN) :: this
1572INTEGER, INTENT(out), OPTIONAL :: nfield
1573
1574CHARACTER(len=this%cursor) :: csv_record_getrecord
1575
1576csv_record_getrecord = transfer(this%record(1:this%cursor), csv_record_getrecord)
1577IF (present(nfield)) nfield = this%nfield
1578
1579END FUNCTION csv_record_getrecord
1580
1581
1587SUBROUTINE csv_record_getfield_char(this, field, flen, ier)
1588TYPE(csv_record),INTENT(INOUT) :: this
1589CHARACTER(len=*),INTENT(OUT),OPTIONAL :: field
1591INTEGER,INTENT(OUT),OPTIONAL :: flen
1592INTEGER,INTENT(OUT),OPTIONAL :: ier
1593
1594LOGICAL :: inquote, inpre, inpost, firstquote
1595INTEGER :: i, ocursor, ofcursor
1596
1597! check end of record
1598IF (csv_record_end(this)) THEN
1599 IF (PRESENT(field)) field = cmiss
1600 IF (PRESENT(ier))THEN
1601 ier = 2
1602 ELSE
1603 CALL l4f_log(l4f_error, &
1604 'in csv_record_getfield, attempt to read past end of record')
1605 CALL raise_error()
1606 ENDIF
1607 RETURN
1608ENDIF
1609! start decoding
1610IF (PRESENT(field)) field = ''
1611IF (PRESENT(ier)) ier = 0
1612ocursor = 0
1613ofcursor = 0
1614inquote = .false.
1615inpre = .true.
1616inpost = .false.
1617firstquote = .false.
1618
1619DO i = this%cursor+1, SIZE(this%record)
1620 IF (inpre) THEN ! sono nel preludio, butto via gli spazi
1621 IF (is_space_b(this%record(i))) THEN
1622 cycle
1623 ELSE
1624 inpre = .false.
1625 ENDIF
1626 ENDIF
1627
1628 IF (.NOT.inquote) THEN ! fuori da " "
1629 IF (this%record(i) == this%cquote) THEN ! ": inizia " "
1630 inquote = .true.
1631 cycle
1632 ELSE IF (this%record(i) == this%csep) THEN ! ,: fine campo
1633 EXIT
1634 ELSE ! carattere normale, elimina "trailing blanks"
1635 CALL add_char(this%record(i), .true., field)
1636 cycle
1637 ENDIF
1638 ELSE ! dentro " "
1639 IF (.NOT.firstquote) THEN ! il precedente non e` "
1640 IF (this%record(i) == this%cquote) THEN ! ": fine " " oppure ""
1641 firstquote = .true.
1642 cycle
1643 ELSE ! carattere normale
1644 CALL add_char(this%record(i), .false., field)
1645 cycle
1646 ENDIF
1647 ELSE ! il precedente e` "
1648 firstquote = .false.
1649 IF (this%record(i) == this%cquote) THEN ! ": sequenza ""
1650 CALL add_char(this%cquote, .false., field)
1651 cycle
1652 ELSE ! carattere normale: e` terminata " "
1653 inquote = .false.
1654 IF (this%record(i) == this%csep) THEN ! , fine campo
1655 EXIT
1656 ELSE ! carattere normale, elimina "trailing blanks"
1657 CALL add_char(this%record(i), .true., field)
1658 cycle
1659 ENDIF
1660 ENDIF
1661 ENDIF
1662 ENDIF
1663ENDDO
1664
1665this%cursor = min(i, SIZE(this%record) + 1)
1666IF (PRESENT(flen)) flen = ofcursor ! restituisco la lunghezza
1667IF (PRESENT(field)) THEN ! controllo overflow di field
1668 IF (ofcursor > len(field)) THEN
1669 IF (PRESENT(ier)) THEN
1670 ier = 1
1671 ELSE
1672 CALL l4f_log(l4f_warn, &
1673 'in csv_record_getfield, CHARACTER variable too short for field: '// &
1675 ENDIF
1676 ENDIF
1677ENDIF
1678
1679CONTAINS
1680
1681SUBROUTINE add_char(char, check_space, field)
1682INTEGER(kind=int_b) :: char
1683LOGICAL,INTENT(IN) :: check_space
1684CHARACTER(len=*),INTENT(OUT),OPTIONAL :: field
1685
1686CHARACTER(len=1) :: dummy ! this prevents a memory leak in TRANSFER()???
1687
1688ocursor = ocursor + 1
1689 IF (PRESENT(field)) THEN
1690 IF (ocursor <= len(field)) THEN
1691 field(ocursor:ocursor) = transfer(char, dummy)
1692 ENDIF
1693ENDIF
1694IF (check_space) THEN
1695 IF (.NOT.is_space_b(char)) ofcursor = ocursor
1696ELSE
1697 ofcursor = ocursor
1698ENDIF
1699
1700END SUBROUTINE add_char
1701
1702END SUBROUTINE csv_record_getfield_char
1703
1704
1710SUBROUTINE csv_record_getfield_int(this, field, ier)
1711TYPE(csv_record),INTENT(INOUT) :: this
1712INTEGER,INTENT(OUT) :: field
1713INTEGER,INTENT(OUT),OPTIONAL :: ier
1714
1715CHARACTER(len=32) :: cfield
1716INTEGER :: lier
1717
1720 READ(cfield, '(I32)', iostat=lier) field
1721 IF (lier /= 0) THEN
1722 field = imiss
1723 IF (.NOT.PRESENT(ier)) THEN
1724 CALL l4f_log(l4f_error, &
1725 'in csv_record_getfield, invalid integer field: '//trim(cfield))
1726 CALL raise_error()
1727 ELSE
1728 ier = 3 ! conversion error
1729 ENDIF
1730 ENDIF
1731ELSE
1732 field = imiss
1733ENDIF
1734
1735END SUBROUTINE csv_record_getfield_int
1736
1737
1743SUBROUTINE csv_record_getfield_real(this, field, ier)
1744TYPE(csv_record),INTENT(INOUT) :: this
1745REAL,INTENT(OUT) :: field
1746INTEGER,INTENT(OUT),OPTIONAL :: ier
1747
1748CHARACTER(len=32) :: cfield
1749INTEGER :: lier
1750
1753 READ(cfield, '(F32.0)', iostat=lier) field
1754 IF (lier /= 0) THEN
1755 field = rmiss
1756 IF (.NOT.PRESENT(ier)) THEN
1757 CALL l4f_log(l4f_error, &
1758 'in csv_record_getfield, invalid real field: '//trim(cfield))
1759 CALL raise_error()
1760 ELSE
1761 ier = 3 ! conversion error
1762 ENDIF
1763 ENDIF
1764ELSE
1765 field = rmiss
1766ENDIF
1767
1768END SUBROUTINE csv_record_getfield_real
1769
1770
1776SUBROUTINE csv_record_getfield_double(this, field, ier)
1777TYPE(csv_record),INTENT(INOUT) :: this
1778DOUBLE PRECISION,INTENT(OUT) :: field
1779INTEGER,INTENT(OUT),OPTIONAL :: ier
1780
1781CHARACTER(len=32) :: cfield
1782INTEGER :: lier
1783
1786 READ(cfield, '(F32.0)', iostat=lier) field
1787 IF (lier /= 0) THEN
1788 field = dmiss
1789 IF (.NOT.PRESENT(ier)) THEN
1790 CALL l4f_log(l4f_error, &
1791 'in csv_record_getfield, invalid double precision field: '//trim(cfield))
1792 CALL raise_error()
1793 ELSE
1794 ier = 3 ! conversion error
1795 ENDIF
1796 ENDIF
1797ELSE
1798 field = dmiss
1799ENDIF
1800
1801END SUBROUTINE csv_record_getfield_double
1802
1803
1806FUNCTION csv_record_end(this)
1807TYPE(csv_record), INTENT(IN) :: this
1808LOGICAL :: csv_record_end
1809
1810csv_record_end = this%cursor > SIZE(this%record)
1811
1812END FUNCTION csv_record_end
1813
1814
1815FUNCTION is_space_c(char) RESULT(is_space)
1816CHARACTER(len=1) :: char
1817LOGICAL :: is_space
1818
1819is_space = (ichar(char) == 32 .OR. ichar(char) == 9) ! improve
1820
1821END FUNCTION is_space_c
1822
1823
1824FUNCTION is_space_b(char) RESULT(is_space)
1825INTEGER(kind=int_b) :: char
1826LOGICAL :: is_space
1827
1828is_space = (char == 32 .OR. char == 9) ! improve
1829
1830END FUNCTION is_space_b
1831
1832
Set of functions that return a trimmed CHARACTER representation of the input variable. Definition char_utilities.F90:278 Set of functions that return a CHARACTER representation of the input variable. Definition char_utilities.F90:253 Methods for successively adding fields to a csv_record object. Definition file_utilities.F90:300 Methods for successively adding fields to a csv_record object. Definition file_utilities.F90:289 Methods for successively obtaining the fields of a csv_record object. Definition file_utilities.F90:279 Function to check whether a value is missing or not. Definition missing_values.f90:72 Definition of constants to be used for declaring variables of a desired type. Definition kinds.F90:245 Definitions of constants and functions for working with missing values. Definition missing_values.f90:50 Module for quickly interpreting the OPTIONAL parameters passed to a subprogram. Definition optional_values.f90:28 Class for interpreting the records of a csv file. Definition file_utilities.F90:243 |