libsim Versione 7.1.11
|
◆ csv_record_end()
Tells whether end of record was reached (
Definizione alla linea 1003 del file file_utilities.F90. 1004! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1005! authors:
1006! Davide Cesari <dcesari@arpa.emr.it>
1007! Paolo Patruno <ppatruno@arpa.emr.it>
1008
1009! This program is free software; you can redistribute it and/or
1010! modify it under the terms of the GNU General Public License as
1011! published by the Free Software Foundation; either version 2 of
1012! the License, or (at your option) any later version.
1013
1014! This program is distributed in the hope that it will be useful,
1015! but WITHOUT ANY WARRANTY; without even the implied warranty of
1016! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1017! GNU General Public License for more details.
1018
1019! You should have received a copy of the GNU General Public License
1020! along with this program. If not, see <http://www.gnu.org/licenses/>.
1021#include "config.h"
1022
1036IMPLICIT NONE
1037
1038CHARACTER(len=128), PARAMETER :: package_name = package
1039CHARACTER(len=128), PARAMETER :: prefix = prefix
1040
1041INTEGER, PARAMETER, PRIVATE :: nftype = 2
1042CHARACTER(len=10), PARAMETER, PRIVATE :: &
1043 preflist(2,nftype) = reshape((/ &
1044 '/usr/local', '/usr ', &
1045 '/usr/local', ' '/), &
1046 (/2,nftype/))
1047CHARACTER(len=6), PARAMETER, PRIVATE :: &
1048 postfix(nftype) = (/ '/share', '/etc ' /)
1049CHARACTER(len=6), PARAMETER, PRIVATE :: &
1050 filetypename(nftype) = (/ 'DATA ', 'CONFIG' /)
1051INTEGER, PARAMETER :: filetype_data = 1
1052INTEGER, PARAMETER :: filetype_config = 2
1053
1054
1059 PRIVATE
1060 INTEGER :: cursor, action, nfield !, ntotal
1061 INTEGER(KIND=int_b) :: csep, cquote
1062 INTEGER(KIND=int_b), POINTER :: record(:)
1064
1065INTEGER, PARAMETER, PRIVATE :: csv_basereclen=1024, &
1066 csv_action_read=0, csv_action_write=1
1067
1071 MODULE PROCEDURE csv_record_init
1072END INTERFACE
1073
1078 MODULE PROCEDURE csv_record_delete
1079END INTERFACE
1080
1095 MODULE PROCEDURE csv_record_getfield_char, csv_record_getfield_int, &
1096 csv_record_getfield_real, csv_record_getfield_double
1097END INTERFACE
1098
1105 MODULE PROCEDURE csv_record_addfield_char, csv_record_addfield_int, &
1106 csv_record_addfield_real, csv_record_addfield_double, &
1107 csv_record_addfield_csv_record
1108END INTERFACE
1109
1116 MODULE PROCEDURE csv_record_addfield_char_miss, csv_record_addfield_int_miss, &
1117 csv_record_addfield_real_miss, csv_record_addfield_double_miss
1118END INTERFACE
1119
1120
1121PRIVATE csv_record_init, csv_record_delete, csv_record_getfield_char, &
1122 csv_record_getfield_int, csv_record_getfield_real, csv_record_getfield_double, &
1123 csv_record_addfield_char, csv_record_addfield_int, csv_record_addfield_real, &
1124 csv_record_addfield_double, csv_record_addfield_csv_record, &
1125 csv_record_addfield_char_miss, csv_record_addfield_int_miss, &
1126 csv_record_addfield_real_miss, csv_record_addfield_double_miss, &
1127 checkrealloc, add_byte
1128
1129CONTAINS
1130
1143FUNCTION getunit() RESULT(unit)
1144INTEGER :: unit
1145
1146LOGICAL :: op
1147
1148DO unit = 100, 32767
1149 INQUIRE(unit, opened=op)
1150 IF (.NOT. op) RETURN
1151ENDDO
1152
1153CALL l4f_log(l4f_error, 'Too many open files')
1154CALL raise_error()
1155unit = -1
1156
1157END FUNCTION getunit
1158
1168FUNCTION get_package_filepath(filename, filetype) RESULT(path)
1169CHARACTER(len=*), INTENT(in) :: filename
1170INTEGER, INTENT(in) :: filetype
1171character(len=len(filename)) :: lfilename
1172
1173INTEGER :: j
1174CHARACTER(len=512) :: path
1175LOGICAL :: exist,cwd,share
1176
1177!IF (package_name == ' ') THEN
1178! CALL getarg(0, package_name)
1179!ENDIF
1180
1181IF (filetype < 1 .OR. filetype > nftype) THEN
1182 path = ''
1184 ' not valid')
1185 CALL raise_error()
1186 RETURN
1187ENDIF
1188
1189share = filename(:6) == "share:"
1190cwd = filename(:4) == "cwd:"
1191
1192lfilename=filename
1193if (share) lfilename=filename(7:)
1194if (cwd) lfilename=filename(5:)
1195
1196if ( .not. share .and. .not. cwd .and. filetype == filetype_data) then
1197 share=.true.
1198 cwd=.true.
1199end if
1200
1201if (cwd) then
1202 ! try with current dir
1203 path = lfilename
1204 CALL l4f_log(l4f_debug, 'inquire local file '//trim(path))
1205 INQUIRE(file=path, exist=exist)
1206 IF (exist) THEN
1207 CALL l4f_log(l4f_info, 'local file '//trim(path)//' found')
1208 RETURN
1209 ENDIF
1210end if
1211
1212if (share .or. filetype == filetype_config) then
1213
1214 ! try with environment variable
1215 CALL getenv(trim(uppercase(package_name))//'_'//trim(filetypename(filetype)), path)
1216 IF (path /= ' ') THEN
1217
1218 path(len_trim(path)+1:) = '/'//lfilename
1219 CALL l4f_log(l4f_debug, 'inquire env package file '//trim(path))
1220 INQUIRE(file=path, exist=exist)
1221 IF (exist) THEN
1222 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1223 RETURN
1224 ENDIF
1225 ENDIF
1226
1227 ! try with install prefix
1228 path = trim(prefix)//trim(postfix(filetype)) &
1229 //'/'//trim(package_name)//'/'//lfilename
1230 CALL l4f_log(l4f_debug, 'inquire install package file '//trim(path))
1231 INQUIRE(file=path, exist=exist)
1232 IF (exist) THEN
1233 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1234 RETURN
1235 ENDIF
1236
1237 ! try with default install prefix
1238 DO j = 1, SIZE(preflist,1)
1239 IF (preflist(j,filetype) == ' ') EXIT
1240 path = trim(preflist(j,filetype))//trim(postfix(filetype)) &
1241 //'/'//trim(package_name)//'/'//lfilename
1242 CALL l4f_log(l4f_debug, 'inquire package file '//trim(path))
1243 INQUIRE(file=path, exist=exist)
1244 IF (exist) THEN
1245 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1246 RETURN
1247 ENDIF
1248 ENDDO
1249
1250end if
1251
1252CALL l4f_log(l4f_info, 'package file '//trim(lfilename)//' not found')
1253path = cmiss
1254
1255END FUNCTION get_package_filepath
1256
1257
1262FUNCTION open_package_file(filename, filetype) RESULT(unit)
1263CHARACTER(len=*), INTENT(in) :: filename
1264INTEGER, INTENT(in) :: filetype
1265INTEGER :: unit, i
1266
1267CHARACTER(len=512) :: path
1268
1269unit = -1
1270path=get_package_filepath(filename, filetype)
1271IF (path == '') RETURN
1272
1273unit = getunit()
1274IF (unit == -1) RETURN
1275
1276OPEN(unit, file=path, status='old', iostat = i)
1277IF (i == 0) THEN
1278 CALL l4f_log(l4f_info, 'package file '//trim(path)//' opened')
1279 RETURN
1280ENDIF
1281
1282CALL l4f_log(l4f_error, 'package file '//trim(filename)//' not found')
1283CALL raise_error()
1284unit = -1
1285
1286END FUNCTION open_package_file
1287
1288
1302SUBROUTINE csv_record_init(this, record, csep, cquote, nfield)
1303TYPE(csv_record),INTENT(INOUT) :: this
1304CHARACTER(len=*),INTENT(IN), OPTIONAL :: record
1305CHARACTER(len=1),INTENT(IN),OPTIONAL :: csep
1306CHARACTER(len=1),INTENT(IN),OPTIONAL :: cquote
1307INTEGER,INTENT(OUT),OPTIONAL :: nfield
1308
1309INTEGER :: l
1310
1311IF (PRESENT(csep)) THEN
1312 this%csep = transfer(csep, this%csep)
1313ELSE
1314 this%csep = transfer(',', this%csep)
1315ENDIF
1316IF (PRESENT(cquote)) THEN
1317 this%cquote = transfer(cquote, this%cquote)
1318ELSE
1319 this%cquote = transfer('"', this%cquote)
1320ENDIF
1321
1322this%cursor = 0
1323this%nfield = 0
1324IF (PRESENT(record)) THEN
1325 l = len_trim(record)
1326 ALLOCATE(this%record(l))
1327 this%record(:) = transfer(record, this%record, l) ! ice in pgf90 with TRIM(record)
1328
1329 IF (PRESENT(nfield)) THEN
1330 nfield = 0
1331 DO WHILE(.NOT.csv_record_end(this)) ! faccio un giro a vuoto sul record
1332 nfield = nfield + 1
1334 ENDDO
1335 this%cursor = 0 ! riazzero il cursore
1336 ENDIF
1337ELSE
1338 ALLOCATE(this%record(csv_basereclen))
1339ENDIF
1340
1341END SUBROUTINE csv_record_init
1342
1343
1345SUBROUTINE csv_record_delete(this)
1346TYPE(csv_record), INTENT(INOUT) :: this
1347
1348DEALLOCATE(this%record)
1349
1350END SUBROUTINE csv_record_delete
1351
1352
1354SUBROUTINE csv_record_rewind(this)
1355TYPE(csv_record),INTENT(INOUT) :: this
1356
1357this%cursor = 0
1358this%nfield = 0
1359
1360END SUBROUTINE csv_record_rewind
1361
1362
1366SUBROUTINE csv_record_addfield_char(this, field, force_quote)
1367TYPE(csv_record),INTENT(INOUT) :: this
1368CHARACTER(len=*),INTENT(IN) :: field
1369LOGICAL, INTENT(in), OPTIONAL :: force_quote
1370
1371INTEGER :: i
1372LOGICAL :: lquote
1373
1374lquote = optio_log(force_quote)
1375IF (len(field) == 0) THEN ! Particular case to be handled separately
1376 CALL checkrealloc(this, 1)
1377 IF (this%nfield > 0) THEN
1378 CALL add_byte(this, this%csep) ! add separator if necessary
1379 ELSE
1380 CALL add_byte(this, this%cquote) ! if first record is empty it should be quoted
1381 CALL add_byte(this, this%cquote) ! in case it is the only one
1382 ENDIF
1384 .AND. index(field, transfer(this%cquote,field(1:1))) == 0 &
1385 .AND. .NOT.is_space_c(field(1:1)) &
1386 .AND. .NOT.is_space_c(field(len(field):len(field))) &
1387 .AND. .NOT.lquote) THEN ! quote not required
1388 CALL checkrealloc(this, len(field)+1)
1389 IF (this%nfield > 0) CALL add_byte(this, this%csep) ! add separator if necessary
1390 this%record(this%cursor+1:this%cursor+len(field)) = transfer(field, this%record)
1391 this%cursor = this%cursor + len(field)
1392ELSE ! quote required
1393 CALL checkrealloc(this, 2*len(field)+3) ! worst case """""""""
1394 IF (this%nfield > 0) CALL add_byte(this, this%csep) ! add separator if necessary
1395 CALL add_byte(this, this%cquote) ! add quote
1396 DO i = 1, len(field)
1397 CALL add_char(field(i:i))
1398 ENDDO
1399 CALL add_byte(this, this%cquote) ! add quote
1400ENDIF
1401
1402this%nfield = this%nfield + 1
1403
1404CONTAINS
1405
1406! add a character, doubling it if it's a quote
1407SUBROUTINE add_char(char)
1408CHARACTER(len=1) :: char
1409
1410this%cursor = this%cursor+1
1411this%record(this%cursor) = transfer(char, this%record(1))
1412IF (this%record(this%cursor) == this%cquote) THEN ! double the quote
1413 this%cursor = this%cursor+1
1414 this%record(this%cursor) = this%cquote
1415ENDIF
1416
1417END SUBROUTINE add_char
1418
1419END SUBROUTINE csv_record_addfield_char
1420
1421
1422! Reallocate record if necessary
1423SUBROUTINE checkrealloc(this, enlarge)
1424TYPE(csv_record),INTENT(INOUT) :: this
1425INTEGER, INTENT(in) :: enlarge
1426
1427INTEGER(KIND=int_b), POINTER :: tmpptr(:)
1428
1429IF (this%cursor+enlarge+1 > SIZE(this%record)) THEN
1430 ALLOCATE(tmpptr(SIZE(this%record)+max(csv_basereclen, enlarge)))
1431 tmpptr(1:SIZE(this%record)) = this%record(:)
1432 DEALLOCATE(this%record)
1433 this%record => tmpptr
1434ENDIF
1435
1436END SUBROUTINE checkrealloc
1437
1438
1439! add a byte
1440SUBROUTINE add_byte(this, char)
1441TYPE(csv_record),INTENT(INOUT) :: this
1442INTEGER(kind=int_b) :: char
1443
1444this%cursor = this%cursor+1
1445this%record(this%cursor) = char
1446
1447END SUBROUTINE add_byte
1448
1449
1453SUBROUTINE csv_record_addfield_char_miss(this, field, force_quote)
1454TYPE(csv_record),INTENT(INOUT) :: this
1455CHARACTER(len=*),INTENT(IN) :: field
1456LOGICAL, INTENT(in), OPTIONAL :: force_quote
1457
1459
1460END SUBROUTINE csv_record_addfield_char_miss
1461
1462
1465SUBROUTINE csv_record_addfield_int(this, field, form, force_quote)
1466TYPE(csv_record),INTENT(INOUT) :: this
1467INTEGER,INTENT(IN) :: field
1468CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1469LOGICAL, INTENT(in), OPTIONAL :: force_quote
1470
1471IF (PRESENT(form)) THEN
1473ELSE
1475ENDIF
1476
1477END SUBROUTINE csv_record_addfield_int
1478
1479
1483SUBROUTINE csv_record_addfield_int_miss(this, field, force_quote)
1484TYPE(csv_record),INTENT(INOUT) :: this
1485INTEGER,INTENT(IN) :: field
1486LOGICAL, INTENT(in), OPTIONAL :: force_quote
1487
1489
1490END SUBROUTINE csv_record_addfield_int_miss
1491
1492
1495SUBROUTINE csv_record_addfield_real(this, field, form, force_quote)
1496TYPE(csv_record),INTENT(INOUT) :: this
1497REAL,INTENT(IN) :: field
1498CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1499LOGICAL, INTENT(in), OPTIONAL :: force_quote
1500
1501IF (PRESENT(form)) THEN
1503ELSE
1505ENDIF
1506
1507END SUBROUTINE csv_record_addfield_real
1508
1509
1513SUBROUTINE csv_record_addfield_real_miss(this, field, force_quote)
1514TYPE(csv_record),INTENT(INOUT) :: this
1515REAL,INTENT(IN) :: field
1516LOGICAL, INTENT(in), OPTIONAL :: force_quote
1517
1519
1520END SUBROUTINE csv_record_addfield_real_miss
1521
1522
1525SUBROUTINE csv_record_addfield_double(this, field, form, force_quote)
1526TYPE(csv_record),INTENT(INOUT) :: this
1527DOUBLE PRECISION,INTENT(IN) :: field
1528CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1529LOGICAL, INTENT(in), OPTIONAL :: force_quote
1530
1531IF (PRESENT(form)) THEN
1533ELSE
1535ENDIF
1536
1537END SUBROUTINE csv_record_addfield_double
1538
1539
1543SUBROUTINE csv_record_addfield_double_miss(this, field, force_quote)
1544TYPE(csv_record),INTENT(INOUT) :: this
1545DOUBLE PRECISION,INTENT(IN) :: field
1546LOGICAL, INTENT(in), OPTIONAL :: force_quote
1547
1549
1550END SUBROUTINE csv_record_addfield_double_miss
1551
1552
1558SUBROUTINE csv_record_addfield_csv_record(this, record)
1559TYPE(csv_record),INTENT(INOUT) :: this
1560TYPE(csv_record),INTENT(IN) :: record
1561
1562IF (this%csep /= record%csep .OR. this%cquote /= record%cquote) RETURN ! error
1563CALL checkrealloc(this, record%cursor)
1564IF (this%nfield > 0) CALL add_byte(this, this%csep)
1565
1566this%record(this%cursor+1:this%cursor+record%cursor) = &
1567 record%record(1:record%cursor)
1568this%cursor = this%cursor + record%cursor
1569this%nfield = this%nfield + record%nfield
1570
1571END SUBROUTINE csv_record_addfield_csv_record
1572
1573
1576FUNCTION csv_record_getrecord(this, nfield)
1577TYPE(csv_record),INTENT(IN) :: this
1578INTEGER, INTENT(out), OPTIONAL :: nfield
1579
1580CHARACTER(len=this%cursor) :: csv_record_getrecord
1581
1582csv_record_getrecord = transfer(this%record(1:this%cursor), csv_record_getrecord)
1583IF (present(nfield)) nfield = this%nfield
1584
1585END FUNCTION csv_record_getrecord
1586
1587
1593SUBROUTINE csv_record_getfield_char(this, field, flen, ier)
1594TYPE(csv_record),INTENT(INOUT) :: this
1595CHARACTER(len=*),INTENT(OUT),OPTIONAL :: field
1597INTEGER,INTENT(OUT),OPTIONAL :: flen
1598INTEGER,INTENT(OUT),OPTIONAL :: ier
1599
1600LOGICAL :: inquote, inpre, inpost, firstquote
1601INTEGER :: i, ocursor, ofcursor
1602
1603! check end of record
1604IF (csv_record_end(this)) THEN
1605 IF (PRESENT(field)) field = cmiss
1606 IF (PRESENT(ier))THEN
1607 ier = 2
1608 ELSE
1609 CALL l4f_log(l4f_error, &
1610 'in csv_record_getfield, attempt to read past end of record')
1611 CALL raise_error()
1612 ENDIF
1613 RETURN
1614ENDIF
1615! start decoding
1616IF (PRESENT(field)) field = ''
1617IF (PRESENT(ier)) ier = 0
1618ocursor = 0
1619ofcursor = 0
1620inquote = .false.
1621inpre = .true.
1622inpost = .false.
1623firstquote = .false.
1624
1625DO i = this%cursor+1, SIZE(this%record)
1626 IF (inpre) THEN ! sono nel preludio, butto via gli spazi
1627 IF (is_space_b(this%record(i))) THEN
1628 cycle
1629 ELSE
1630 inpre = .false.
1631 ENDIF
1632 ENDIF
1633
1634 IF (.NOT.inquote) THEN ! fuori da " "
1635 IF (this%record(i) == this%cquote) THEN ! ": inizia " "
1636 inquote = .true.
1637 cycle
1638 ELSE IF (this%record(i) == this%csep) THEN ! ,: fine campo
1639 EXIT
1640 ELSE ! carattere normale, elimina "trailing blanks"
1641 CALL add_char(this%record(i), .true., field)
1642 cycle
1643 ENDIF
1644 ELSE ! dentro " "
1645 IF (.NOT.firstquote) THEN ! il precedente non e` "
1646 IF (this%record(i) == this%cquote) THEN ! ": fine " " oppure ""
1647 firstquote = .true.
1648 cycle
1649 ELSE ! carattere normale
1650 CALL add_char(this%record(i), .false., field)
1651 cycle
1652 ENDIF
1653 ELSE ! il precedente e` "
1654 firstquote = .false.
1655 IF (this%record(i) == this%cquote) THEN ! ": sequenza ""
1656 CALL add_char(this%cquote, .false., field)
1657 cycle
1658 ELSE ! carattere normale: e` terminata " "
1659 inquote = .false.
1660 IF (this%record(i) == this%csep) THEN ! , fine campo
1661 EXIT
1662 ELSE ! carattere normale, elimina "trailing blanks"
1663 CALL add_char(this%record(i), .true., field)
1664 cycle
1665 ENDIF
1666 ENDIF
1667 ENDIF
1668 ENDIF
1669ENDDO
1670
1671this%cursor = min(i, SIZE(this%record) + 1)
1672IF (PRESENT(flen)) flen = ofcursor ! restituisco la lunghezza
1673IF (PRESENT(field)) THEN ! controllo overflow di field
1674 IF (ofcursor > len(field)) THEN
1675 IF (PRESENT(ier)) THEN
1676 ier = 1
1677 ELSE
1678 CALL l4f_log(l4f_warn, &
1679 'in csv_record_getfield, CHARACTER variable too short for field: '// &
1681 ENDIF
1682 ENDIF
1683ENDIF
1684
1685CONTAINS
1686
1687SUBROUTINE add_char(char, check_space, field)
1688INTEGER(kind=int_b) :: char
1689LOGICAL,INTENT(IN) :: check_space
1690CHARACTER(len=*),INTENT(OUT),OPTIONAL :: field
1691
1692CHARACTER(len=1) :: dummy ! this prevents a memory leak in TRANSFER()???
1693
1694ocursor = ocursor + 1
1695 IF (PRESENT(field)) THEN
1696 IF (ocursor <= len(field)) THEN
1697 field(ocursor:ocursor) = transfer(char, dummy)
1698 ENDIF
1699ENDIF
1700IF (check_space) THEN
1701 IF (.NOT.is_space_b(char)) ofcursor = ocursor
1702ELSE
1703 ofcursor = ocursor
1704ENDIF
1705
1706END SUBROUTINE add_char
1707
1708END SUBROUTINE csv_record_getfield_char
1709
1710
1716SUBROUTINE csv_record_getfield_int(this, field, ier)
1717TYPE(csv_record),INTENT(INOUT) :: this
1718INTEGER,INTENT(OUT) :: field
1719INTEGER,INTENT(OUT),OPTIONAL :: ier
1720
1721CHARACTER(len=32) :: cfield
1722INTEGER :: lier
1723
1726 READ(cfield, '(I32)', iostat=lier) field
1727 IF (lier /= 0) THEN
1728 field = imiss
1729 IF (.NOT.PRESENT(ier)) THEN
1730 CALL l4f_log(l4f_error, &
1731 'in csv_record_getfield, invalid integer field: '//trim(cfield))
1732 CALL raise_error()
1733 ELSE
1734 ier = 3 ! conversion error
1735 ENDIF
1736 ENDIF
1737ELSE
1738 field = imiss
1739ENDIF
1740
1741END SUBROUTINE csv_record_getfield_int
1742
1743
1749SUBROUTINE csv_record_getfield_real(this, field, ier)
1750TYPE(csv_record),INTENT(INOUT) :: this
1751REAL,INTENT(OUT) :: field
1752INTEGER,INTENT(OUT),OPTIONAL :: ier
1753
1754CHARACTER(len=32) :: cfield
1755INTEGER :: lier
1756
1759 READ(cfield, '(F32.0)', iostat=lier) field
1760 IF (lier /= 0) THEN
1761 field = rmiss
1762 IF (.NOT.PRESENT(ier)) THEN
1763 CALL l4f_log(l4f_error, &
1764 'in csv_record_getfield, invalid real field: '//trim(cfield))
1765 CALL raise_error()
1766 ELSE
1767 ier = 3 ! conversion error
1768 ENDIF
1769 ENDIF
1770ELSE
1771 field = rmiss
1772ENDIF
1773
1774END SUBROUTINE csv_record_getfield_real
1775
1776
1782SUBROUTINE csv_record_getfield_double(this, field, ier)
1783TYPE(csv_record),INTENT(INOUT) :: this
1784DOUBLE PRECISION,INTENT(OUT) :: field
1785INTEGER,INTENT(OUT),OPTIONAL :: ier
1786
1787CHARACTER(len=32) :: cfield
1788INTEGER :: lier
1789
1792 READ(cfield, '(F32.0)', iostat=lier) field
1793 IF (lier /= 0) THEN
1794 field = dmiss
1795 IF (.NOT.PRESENT(ier)) THEN
1796 CALL l4f_log(l4f_error, &
1797 'in csv_record_getfield, invalid double precision field: '//trim(cfield))
1798 CALL raise_error()
1799 ELSE
1800 ier = 3 ! conversion error
1801 ENDIF
1802 ENDIF
1803ELSE
1804 field = dmiss
1805ENDIF
1806
1807END SUBROUTINE csv_record_getfield_double
1808
1809
1812FUNCTION csv_record_end(this)
1813TYPE(csv_record), INTENT(IN) :: this
1814LOGICAL :: csv_record_end
1815
1816csv_record_end = this%cursor > SIZE(this%record)
1817
1818END FUNCTION csv_record_end
1819
1820
1821FUNCTION is_space_c(char) RESULT(is_space)
1822CHARACTER(len=1) :: char
1823LOGICAL :: is_space
1824
1825is_space = (ichar(char) == 32 .OR. ichar(char) == 9) ! improve
1826
1827END FUNCTION is_space_c
1828
1829
1830FUNCTION is_space_b(char) RESULT(is_space)
1831INTEGER(kind=int_b) :: char
1832LOGICAL :: is_space
1833
1834is_space = (char == 32 .OR. char == 9) ! improve
1835
1836END FUNCTION is_space_b
1837
1838
Set of functions that return a trimmed CHARACTER representation of the input variable. Definition: char_utilities.F90:284 Set of functions that return a CHARACTER representation of the input variable. Definition: char_utilities.F90:259 Methods for successively adding fields to a csv_record object. Definition: file_utilities.F90:306 Methods for successively adding fields to a csv_record object. Definition: file_utilities.F90:295 Methods for successively obtaining the fields of a csv_record object. Definition: file_utilities.F90:285 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:251 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:249 |