libsim Versione 7.2.4
|
◆ csv_record_getfield_int()
Returns next field from the record this as an The field pointer is advanced to the next field. If all the fields have already been interpreted or the field cannot be interpreted as an integer, or if it is longer than 32 characters, it returns a missing value.
Definizione alla linea 901 del file file_utilities.F90. 902! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
903! authors:
904! Davide Cesari <dcesari@arpa.emr.it>
905! Paolo Patruno <ppatruno@arpa.emr.it>
906
907! This program is free software; you can redistribute it and/or
908! modify it under the terms of the GNU General Public License as
909! published by the Free Software Foundation; either version 2 of
910! the License, or (at your option) any later version.
911
912! This program is distributed in the hope that it will be useful,
913! but WITHOUT ANY WARRANTY; without even the implied warranty of
914! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
915! GNU General Public License for more details.
916
917! You should have received a copy of the GNU General Public License
918! along with this program. If not, see <http://www.gnu.org/licenses/>.
919#include "config.h"
920
934IMPLICIT NONE
935
936CHARACTER(len=128), PARAMETER :: package_name = package
937CHARACTER(len=128), PARAMETER :: prefix = prefix
938
939INTEGER, PARAMETER, PRIVATE :: nftype = 2
940CHARACTER(len=10), PARAMETER, PRIVATE :: &
941 preflist(2,nftype) = reshape((/ &
942 '/usr/local', '/usr ', &
943 '/usr/local', ' '/), &
944 (/2,nftype/))
945CHARACTER(len=6), PARAMETER, PRIVATE :: &
946 postfix(nftype) = (/ '/share', '/etc ' /)
947CHARACTER(len=6), PARAMETER, PRIVATE :: &
948 filetypename(nftype) = (/ 'DATA ', 'CONFIG' /)
949INTEGER, PARAMETER :: filetype_data = 1
950INTEGER, PARAMETER :: filetype_config = 2
951
952
957 PRIVATE
958 INTEGER :: cursor, action, nfield !, ntotal
959 INTEGER(KIND=int_b) :: csep, cquote
960 INTEGER(KIND=int_b), POINTER :: record(:)
962
963INTEGER, PARAMETER, PRIVATE :: csv_basereclen=1024, &
964 csv_action_read=0, csv_action_write=1
965
969 MODULE PROCEDURE csv_record_init
970END INTERFACE
971
976 MODULE PROCEDURE csv_record_delete
977END INTERFACE
978
993 MODULE PROCEDURE csv_record_getfield_char, csv_record_getfield_int, &
994 csv_record_getfield_real, csv_record_getfield_double
995END INTERFACE
996
1003 MODULE PROCEDURE csv_record_addfield_char, csv_record_addfield_int, &
1004 csv_record_addfield_real, csv_record_addfield_double, &
1005 csv_record_addfield_csv_record
1006END INTERFACE
1007
1014 MODULE PROCEDURE csv_record_addfield_char_miss, csv_record_addfield_int_miss, &
1015 csv_record_addfield_real_miss, csv_record_addfield_double_miss
1016END INTERFACE
1017
1018
1019PRIVATE csv_record_init, csv_record_delete, csv_record_getfield_char, &
1020 csv_record_getfield_int, csv_record_getfield_real, csv_record_getfield_double, &
1021 csv_record_addfield_char, csv_record_addfield_int, csv_record_addfield_real, &
1022 csv_record_addfield_double, csv_record_addfield_csv_record, &
1023 csv_record_addfield_char_miss, csv_record_addfield_int_miss, &
1024 csv_record_addfield_real_miss, csv_record_addfield_double_miss, &
1025 checkrealloc, add_byte
1026
1027CONTAINS
1028
1041FUNCTION getunit() RESULT(unit)
1042INTEGER :: unit
1043
1044LOGICAL :: op
1045
1046DO unit = 100, 32767
1047 INQUIRE(unit, opened=op)
1048 IF (.NOT. op) RETURN
1049ENDDO
1050
1051CALL l4f_log(l4f_error, 'Too many open files')
1052CALL raise_error()
1053unit = -1
1054
1055END FUNCTION getunit
1056
1066FUNCTION get_package_filepath(filename, filetype) RESULT(path)
1067CHARACTER(len=*), INTENT(in) :: filename
1068INTEGER, INTENT(in) :: filetype
1069character(len=len(filename)) :: lfilename
1070
1071INTEGER :: j
1072CHARACTER(len=512) :: path
1073LOGICAL :: exist,cwd,share
1074
1075!IF (package_name == ' ') THEN
1076! CALL getarg(0, package_name)
1077!ENDIF
1078
1079IF (filetype < 1 .OR. filetype > nftype) THEN
1080 path = ''
1082 ' not valid')
1083 CALL raise_error()
1084 RETURN
1085ENDIF
1086
1087share = filename(:6) == "share:"
1088cwd = filename(:4) == "cwd:"
1089
1090lfilename=filename
1091if (share) lfilename=filename(7:)
1092if (cwd) lfilename=filename(5:)
1093
1094if ( .not. share .and. .not. cwd .and. filetype == filetype_data) then
1095 share=.true.
1096 cwd=.true.
1097end if
1098
1099if (cwd) then
1100 ! try with current dir
1101 path = lfilename
1102 CALL l4f_log(l4f_debug, 'inquire local file '//trim(path))
1103 INQUIRE(file=path, exist=exist)
1104 IF (exist) THEN
1105 CALL l4f_log(l4f_info, 'local file '//trim(path)//' found')
1106 RETURN
1107 ENDIF
1108end if
1109
1110if (share .or. filetype == filetype_config) then
1111
1112 ! try with environment variable
1113 CALL getenv(trim(uppercase(package_name))//'_'//trim(filetypename(filetype)), path)
1114 IF (path /= ' ') THEN
1115
1116 path(len_trim(path)+1:) = '/'//lfilename
1117 CALL l4f_log(l4f_debug, 'inquire env package file '//trim(path))
1118 INQUIRE(file=path, exist=exist)
1119 IF (exist) THEN
1120 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1121 RETURN
1122 ENDIF
1123 ENDIF
1124
1125 ! try with install prefix
1126 path = trim(prefix)//trim(postfix(filetype)) &
1127 //'/'//trim(package_name)//'/'//lfilename
1128 CALL l4f_log(l4f_debug, 'inquire install package file '//trim(path))
1129 INQUIRE(file=path, exist=exist)
1130 IF (exist) THEN
1131 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1132 RETURN
1133 ENDIF
1134
1135 ! try with default install prefix
1136 DO j = 1, SIZE(preflist,1)
1137 IF (preflist(j,filetype) == ' ') EXIT
1138 path = trim(preflist(j,filetype))//trim(postfix(filetype)) &
1139 //'/'//trim(package_name)//'/'//lfilename
1140 CALL l4f_log(l4f_debug, 'inquire package file '//trim(path))
1141 INQUIRE(file=path, exist=exist)
1142 IF (exist) THEN
1143 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1144 RETURN
1145 ENDIF
1146 ENDDO
1147
1148end if
1149
1150CALL l4f_log(l4f_info, 'package file '//trim(lfilename)//' not found')
1151path = cmiss
1152
1153END FUNCTION get_package_filepath
1154
1155
1160FUNCTION open_package_file(filename, filetype) RESULT(unit)
1161CHARACTER(len=*), INTENT(in) :: filename
1162INTEGER, INTENT(in) :: filetype
1163INTEGER :: unit, i
1164
1165CHARACTER(len=512) :: path
1166
1167unit = -1
1168path=get_package_filepath(filename, filetype)
1169IF (path == '') RETURN
1170
1171unit = getunit()
1172IF (unit == -1) RETURN
1173
1174OPEN(unit, file=path, status='old', iostat = i)
1175IF (i == 0) THEN
1176 CALL l4f_log(l4f_info, 'package file '//trim(path)//' opened')
1177 RETURN
1178ENDIF
1179
1180CALL l4f_log(l4f_error, 'package file '//trim(filename)//' not found')
1181CALL raise_error()
1182unit = -1
1183
1184END FUNCTION open_package_file
1185
1186
1200SUBROUTINE csv_record_init(this, record, csep, cquote, nfield)
1201TYPE(csv_record),INTENT(INOUT) :: this
1202CHARACTER(len=*),INTENT(IN), OPTIONAL :: record
1203CHARACTER(len=1),INTENT(IN),OPTIONAL :: csep
1204CHARACTER(len=1),INTENT(IN),OPTIONAL :: cquote
1205INTEGER,INTENT(OUT),OPTIONAL :: nfield
1206
1207INTEGER :: l
1208
1209IF (PRESENT(csep)) THEN
1210 this%csep = transfer(csep, this%csep)
1211ELSE
1212 this%csep = transfer(',', this%csep)
1213ENDIF
1214IF (PRESENT(cquote)) THEN
1215 this%cquote = transfer(cquote, this%cquote)
1216ELSE
1217 this%cquote = transfer('"', this%cquote)
1218ENDIF
1219
1220this%cursor = 0
1221this%nfield = 0
1222IF (PRESENT(record)) THEN
1223 l = len_trim(record)
1224 ALLOCATE(this%record(l))
1225 this%record(:) = transfer(record, this%record, l) ! ice in pgf90 with TRIM(record)
1226
1227 IF (PRESENT(nfield)) THEN
1228 nfield = 0
1229 DO WHILE(.NOT.csv_record_end(this)) ! faccio un giro a vuoto sul record
1230 nfield = nfield + 1
1232 ENDDO
1233 this%cursor = 0 ! riazzero il cursore
1234 ENDIF
1235ELSE
1236 ALLOCATE(this%record(csv_basereclen))
1237ENDIF
1238
1239END SUBROUTINE csv_record_init
1240
1241
1243SUBROUTINE csv_record_delete(this)
1244TYPE(csv_record), INTENT(INOUT) :: this
1245
1246DEALLOCATE(this%record)
1247
1248END SUBROUTINE csv_record_delete
1249
1250
1252SUBROUTINE csv_record_rewind(this)
1253TYPE(csv_record),INTENT(INOUT) :: this
1254
1255this%cursor = 0
1256this%nfield = 0
1257
1258END SUBROUTINE csv_record_rewind
1259
1260
1264SUBROUTINE csv_record_addfield_char(this, field, force_quote)
1265TYPE(csv_record),INTENT(INOUT) :: this
1266CHARACTER(len=*),INTENT(IN) :: field
1267LOGICAL, INTENT(in), OPTIONAL :: force_quote
1268
1269INTEGER :: i
1270LOGICAL :: lquote
1271
1272lquote = optio_log(force_quote)
1273IF (len(field) == 0) THEN ! Particular case to be handled separately
1274 CALL checkrealloc(this, 1)
1275 IF (this%nfield > 0) THEN
1276 CALL add_byte(this, this%csep) ! add separator if necessary
1277 ELSE
1278 CALL add_byte(this, this%cquote) ! if first record is empty it should be quoted
1279 CALL add_byte(this, this%cquote) ! in case it is the only one
1280 ENDIF
1282 .AND. index(field, transfer(this%cquote,field(1:1))) == 0 &
1283 .AND. .NOT.is_space_c(field(1:1)) &
1284 .AND. .NOT.is_space_c(field(len(field):len(field))) &
1285 .AND. .NOT.lquote) THEN ! quote not required
1286 CALL checkrealloc(this, len(field)+1)
1287 IF (this%nfield > 0) CALL add_byte(this, this%csep) ! add separator if necessary
1288 this%record(this%cursor+1:this%cursor+len(field)) = transfer(field, this%record)
1289 this%cursor = this%cursor + len(field)
1290ELSE ! quote required
1291 CALL checkrealloc(this, 2*len(field)+3) ! worst case """""""""
1292 IF (this%nfield > 0) CALL add_byte(this, this%csep) ! add separator if necessary
1293 CALL add_byte(this, this%cquote) ! add quote
1294 DO i = 1, len(field)
1295 CALL add_char(field(i:i))
1296 ENDDO
1297 CALL add_byte(this, this%cquote) ! add quote
1298ENDIF
1299
1300this%nfield = this%nfield + 1
1301
1302CONTAINS
1303
1304! add a character, doubling it if it's a quote
1305SUBROUTINE add_char(char)
1306CHARACTER(len=1) :: char
1307
1308this%cursor = this%cursor+1
1309this%record(this%cursor) = transfer(char, this%record(1))
1310IF (this%record(this%cursor) == this%cquote) THEN ! double the quote
1311 this%cursor = this%cursor+1
1312 this%record(this%cursor) = this%cquote
1313ENDIF
1314
1315END SUBROUTINE add_char
1316
1317END SUBROUTINE csv_record_addfield_char
1318
1319
1320! Reallocate record if necessary
1321SUBROUTINE checkrealloc(this, enlarge)
1322TYPE(csv_record),INTENT(INOUT) :: this
1323INTEGER, INTENT(in) :: enlarge
1324
1325INTEGER(KIND=int_b), POINTER :: tmpptr(:)
1326
1327IF (this%cursor+enlarge+1 > SIZE(this%record)) THEN
1328 ALLOCATE(tmpptr(SIZE(this%record)+max(csv_basereclen, enlarge)))
1329 tmpptr(1:SIZE(this%record)) = this%record(:)
1330 DEALLOCATE(this%record)
1331 this%record => tmpptr
1332ENDIF
1333
1334END SUBROUTINE checkrealloc
1335
1336
1337! add a byte
1338SUBROUTINE add_byte(this, char)
1339TYPE(csv_record),INTENT(INOUT) :: this
1340INTEGER(kind=int_b) :: char
1341
1342this%cursor = this%cursor+1
1343this%record(this%cursor) = char
1344
1345END SUBROUTINE add_byte
1346
1347
1351SUBROUTINE csv_record_addfield_char_miss(this, field, force_quote)
1352TYPE(csv_record),INTENT(INOUT) :: this
1353CHARACTER(len=*),INTENT(IN) :: field
1354LOGICAL, INTENT(in), OPTIONAL :: force_quote
1355
1357
1358END SUBROUTINE csv_record_addfield_char_miss
1359
1360
1363SUBROUTINE csv_record_addfield_int(this, field, form, force_quote)
1364TYPE(csv_record),INTENT(INOUT) :: this
1365INTEGER,INTENT(IN) :: field
1366CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1367LOGICAL, INTENT(in), OPTIONAL :: force_quote
1368
1369IF (PRESENT(form)) THEN
1371ELSE
1373ENDIF
1374
1375END SUBROUTINE csv_record_addfield_int
1376
1377
1381SUBROUTINE csv_record_addfield_int_miss(this, field, force_quote)
1382TYPE(csv_record),INTENT(INOUT) :: this
1383INTEGER,INTENT(IN) :: field
1384LOGICAL, INTENT(in), OPTIONAL :: force_quote
1385
1387
1388END SUBROUTINE csv_record_addfield_int_miss
1389
1390
1393SUBROUTINE csv_record_addfield_real(this, field, form, force_quote)
1394TYPE(csv_record),INTENT(INOUT) :: this
1395REAL,INTENT(IN) :: field
1396CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1397LOGICAL, INTENT(in), OPTIONAL :: force_quote
1398
1399IF (PRESENT(form)) THEN
1401ELSE
1403ENDIF
1404
1405END SUBROUTINE csv_record_addfield_real
1406
1407
1411SUBROUTINE csv_record_addfield_real_miss(this, field, force_quote)
1412TYPE(csv_record),INTENT(INOUT) :: this
1413REAL,INTENT(IN) :: field
1414LOGICAL, INTENT(in), OPTIONAL :: force_quote
1415
1417
1418END SUBROUTINE csv_record_addfield_real_miss
1419
1420
1423SUBROUTINE csv_record_addfield_double(this, field, form, force_quote)
1424TYPE(csv_record),INTENT(INOUT) :: this
1425DOUBLE PRECISION,INTENT(IN) :: field
1426CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1427LOGICAL, INTENT(in), OPTIONAL :: force_quote
1428
1429IF (PRESENT(form)) THEN
1431ELSE
1433ENDIF
1434
1435END SUBROUTINE csv_record_addfield_double
1436
1437
1441SUBROUTINE csv_record_addfield_double_miss(this, field, force_quote)
1442TYPE(csv_record),INTENT(INOUT) :: this
1443DOUBLE PRECISION,INTENT(IN) :: field
1444LOGICAL, INTENT(in), OPTIONAL :: force_quote
1445
1447
1448END SUBROUTINE csv_record_addfield_double_miss
1449
1450
1456SUBROUTINE csv_record_addfield_csv_record(this, record)
1457TYPE(csv_record),INTENT(INOUT) :: this
1458TYPE(csv_record),INTENT(IN) :: record
1459
1460IF (this%csep /= record%csep .OR. this%cquote /= record%cquote) RETURN ! error
1461CALL checkrealloc(this, record%cursor)
1462IF (this%nfield > 0) CALL add_byte(this, this%csep)
1463
1464this%record(this%cursor+1:this%cursor+record%cursor) = &
1465 record%record(1:record%cursor)
1466this%cursor = this%cursor + record%cursor
1467this%nfield = this%nfield + record%nfield
1468
1469END SUBROUTINE csv_record_addfield_csv_record
1470
1471
1474FUNCTION csv_record_getrecord(this, nfield)
1475TYPE(csv_record),INTENT(IN) :: this
1476INTEGER, INTENT(out), OPTIONAL :: nfield
1477
1478CHARACTER(len=this%cursor) :: csv_record_getrecord
1479
1480csv_record_getrecord = transfer(this%record(1:this%cursor), csv_record_getrecord)
1481IF (present(nfield)) nfield = this%nfield
1482
1483END FUNCTION csv_record_getrecord
1484
1485
1491SUBROUTINE csv_record_getfield_char(this, field, flen, ier)
1492TYPE(csv_record),INTENT(INOUT) :: this
1493CHARACTER(len=*),INTENT(OUT),OPTIONAL :: field
1495INTEGER,INTENT(OUT),OPTIONAL :: flen
1496INTEGER,INTENT(OUT),OPTIONAL :: ier
1497
1498LOGICAL :: inquote, inpre, inpost, firstquote
1499INTEGER :: i, ocursor, ofcursor
1500
1501! check end of record
1502IF (csv_record_end(this)) THEN
1503 IF (PRESENT(field)) field = cmiss
1504 IF (PRESENT(ier))THEN
1505 ier = 2
1506 ELSE
1507 CALL l4f_log(l4f_error, &
1508 'in csv_record_getfield, attempt to read past end of record')
1509 CALL raise_error()
1510 ENDIF
1511 RETURN
1512ENDIF
1513! start decoding
1514IF (PRESENT(field)) field = ''
1515IF (PRESENT(ier)) ier = 0
1516ocursor = 0
1517ofcursor = 0
1518inquote = .false.
1519inpre = .true.
1520inpost = .false.
1521firstquote = .false.
1522
1523DO i = this%cursor+1, SIZE(this%record)
1524 IF (inpre) THEN ! sono nel preludio, butto via gli spazi
1525 IF (is_space_b(this%record(i))) THEN
1526 cycle
1527 ELSE
1528 inpre = .false.
1529 ENDIF
1530 ENDIF
1531
1532 IF (.NOT.inquote) THEN ! fuori da " "
1533 IF (this%record(i) == this%cquote) THEN ! ": inizia " "
1534 inquote = .true.
1535 cycle
1536 ELSE IF (this%record(i) == this%csep) THEN ! ,: fine campo
1537 EXIT
1538 ELSE ! carattere normale, elimina "trailing blanks"
1539 CALL add_char(this%record(i), .true., field)
1540 cycle
1541 ENDIF
1542 ELSE ! dentro " "
1543 IF (.NOT.firstquote) THEN ! il precedente non e` "
1544 IF (this%record(i) == this%cquote) THEN ! ": fine " " oppure ""
1545 firstquote = .true.
1546 cycle
1547 ELSE ! carattere normale
1548 CALL add_char(this%record(i), .false., field)
1549 cycle
1550 ENDIF
1551 ELSE ! il precedente e` "
1552 firstquote = .false.
1553 IF (this%record(i) == this%cquote) THEN ! ": sequenza ""
1554 CALL add_char(this%cquote, .false., field)
1555 cycle
1556 ELSE ! carattere normale: e` terminata " "
1557 inquote = .false.
1558 IF (this%record(i) == this%csep) THEN ! , fine campo
1559 EXIT
1560 ELSE ! carattere normale, elimina "trailing blanks"
1561 CALL add_char(this%record(i), .true., field)
1562 cycle
1563 ENDIF
1564 ENDIF
1565 ENDIF
1566 ENDIF
1567ENDDO
1568
1569this%cursor = min(i, SIZE(this%record) + 1)
1570IF (PRESENT(flen)) flen = ofcursor ! restituisco la lunghezza
1571IF (PRESENT(field)) THEN ! controllo overflow di field
1572 IF (ofcursor > len(field)) THEN
1573 IF (PRESENT(ier)) THEN
1574 ier = 1
1575 ELSE
1576 CALL l4f_log(l4f_warn, &
1577 'in csv_record_getfield, CHARACTER variable too short for field: '// &
1579 ENDIF
1580 ENDIF
1581ENDIF
1582
1583CONTAINS
1584
1585SUBROUTINE add_char(char, check_space, field)
1586INTEGER(kind=int_b) :: char
1587LOGICAL,INTENT(IN) :: check_space
1588CHARACTER(len=*),INTENT(OUT),OPTIONAL :: field
1589
1590CHARACTER(len=1) :: dummy ! this prevents a memory leak in TRANSFER()???
1591
1592ocursor = ocursor + 1
1593 IF (PRESENT(field)) THEN
1594 IF (ocursor <= len(field)) THEN
1595 field(ocursor:ocursor) = transfer(char, dummy)
1596 ENDIF
1597ENDIF
1598IF (check_space) THEN
1599 IF (.NOT.is_space_b(char)) ofcursor = ocursor
1600ELSE
1601 ofcursor = ocursor
1602ENDIF
1603
1604END SUBROUTINE add_char
1605
1606END SUBROUTINE csv_record_getfield_char
1607
1608
1614SUBROUTINE csv_record_getfield_int(this, field, ier)
1615TYPE(csv_record),INTENT(INOUT) :: this
1616INTEGER,INTENT(OUT) :: field
1617INTEGER,INTENT(OUT),OPTIONAL :: ier
1618
1619CHARACTER(len=32) :: cfield
1620INTEGER :: lier
1621
1624 READ(cfield, '(I32)', iostat=lier) field
1625 IF (lier /= 0) THEN
1626 field = imiss
1627 IF (.NOT.PRESENT(ier)) THEN
1628 CALL l4f_log(l4f_error, &
1629 'in csv_record_getfield, invalid integer field: '//trim(cfield))
1630 CALL raise_error()
1631 ELSE
1632 ier = 3 ! conversion error
1633 ENDIF
1634 ENDIF
1635ELSE
1636 field = imiss
1637ENDIF
1638
1639END SUBROUTINE csv_record_getfield_int
1640
1641
1647SUBROUTINE csv_record_getfield_real(this, field, ier)
1648TYPE(csv_record),INTENT(INOUT) :: this
1649REAL,INTENT(OUT) :: field
1650INTEGER,INTENT(OUT),OPTIONAL :: ier
1651
1652CHARACTER(len=32) :: cfield
1653INTEGER :: lier
1654
1657 READ(cfield, '(F32.0)', iostat=lier) field
1658 IF (lier /= 0) THEN
1659 field = rmiss
1660 IF (.NOT.PRESENT(ier)) THEN
1661 CALL l4f_log(l4f_error, &
1662 'in csv_record_getfield, invalid real field: '//trim(cfield))
1663 CALL raise_error()
1664 ELSE
1665 ier = 3 ! conversion error
1666 ENDIF
1667 ENDIF
1668ELSE
1669 field = rmiss
1670ENDIF
1671
1672END SUBROUTINE csv_record_getfield_real
1673
1674
1680SUBROUTINE csv_record_getfield_double(this, field, ier)
1681TYPE(csv_record),INTENT(INOUT) :: this
1682DOUBLE PRECISION,INTENT(OUT) :: field
1683INTEGER,INTENT(OUT),OPTIONAL :: ier
1684
1685CHARACTER(len=32) :: cfield
1686INTEGER :: lier
1687
1690 READ(cfield, '(F32.0)', iostat=lier) field
1691 IF (lier /= 0) THEN
1692 field = dmiss
1693 IF (.NOT.PRESENT(ier)) THEN
1694 CALL l4f_log(l4f_error, &
1695 'in csv_record_getfield, invalid double precision field: '//trim(cfield))
1696 CALL raise_error()
1697 ELSE
1698 ier = 3 ! conversion error
1699 ENDIF
1700 ENDIF
1701ELSE
1702 field = dmiss
1703ENDIF
1704
1705END SUBROUTINE csv_record_getfield_double
1706
1707
1710FUNCTION csv_record_end(this)
1711TYPE(csv_record), INTENT(IN) :: this
1712LOGICAL :: csv_record_end
1713
1714csv_record_end = this%cursor > SIZE(this%record)
1715
1716END FUNCTION csv_record_end
1717
1718
1719FUNCTION is_space_c(char) RESULT(is_space)
1720CHARACTER(len=1) :: char
1721LOGICAL :: is_space
1722
1723is_space = (ichar(char) == 32 .OR. ichar(char) == 9) ! improve
1724
1725END FUNCTION is_space_c
1726
1727
1728FUNCTION is_space_b(char) RESULT(is_space)
1729INTEGER(kind=int_b) :: char
1730LOGICAL :: is_space
1731
1732is_space = (char == 32 .OR. char == 9) ! improve
1733
1734END FUNCTION is_space_b
1735
1736
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 |