libsim Versione 7.1.11
|
◆ 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 907 del file file_utilities.F90. 908! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
909! authors:
910! Davide Cesari <dcesari@arpa.emr.it>
911! Paolo Patruno <ppatruno@arpa.emr.it>
912
913! This program is free software; you can redistribute it and/or
914! modify it under the terms of the GNU General Public License as
915! published by the Free Software Foundation; either version 2 of
916! the License, or (at your option) any later version.
917
918! This program is distributed in the hope that it will be useful,
919! but WITHOUT ANY WARRANTY; without even the implied warranty of
920! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
921! GNU General Public License for more details.
922
923! You should have received a copy of the GNU General Public License
924! along with this program. If not, see <http://www.gnu.org/licenses/>.
925#include "config.h"
926
940IMPLICIT NONE
941
942CHARACTER(len=128), PARAMETER :: package_name = package
943CHARACTER(len=128), PARAMETER :: prefix = prefix
944
945INTEGER, PARAMETER, PRIVATE :: nftype = 2
946CHARACTER(len=10), PARAMETER, PRIVATE :: &
947 preflist(2,nftype) = reshape((/ &
948 '/usr/local', '/usr ', &
949 '/usr/local', ' '/), &
950 (/2,nftype/))
951CHARACTER(len=6), PARAMETER, PRIVATE :: &
952 postfix(nftype) = (/ '/share', '/etc ' /)
953CHARACTER(len=6), PARAMETER, PRIVATE :: &
954 filetypename(nftype) = (/ 'DATA ', 'CONFIG' /)
955INTEGER, PARAMETER :: filetype_data = 1
956INTEGER, PARAMETER :: filetype_config = 2
957
958
963 PRIVATE
964 INTEGER :: cursor, action, nfield !, ntotal
965 INTEGER(KIND=int_b) :: csep, cquote
966 INTEGER(KIND=int_b), POINTER :: record(:)
968
969INTEGER, PARAMETER, PRIVATE :: csv_basereclen=1024, &
970 csv_action_read=0, csv_action_write=1
971
975 MODULE PROCEDURE csv_record_init
976END INTERFACE
977
982 MODULE PROCEDURE csv_record_delete
983END INTERFACE
984
999 MODULE PROCEDURE csv_record_getfield_char, csv_record_getfield_int, &
1000 csv_record_getfield_real, csv_record_getfield_double
1001END INTERFACE
1002
1009 MODULE PROCEDURE csv_record_addfield_char, csv_record_addfield_int, &
1010 csv_record_addfield_real, csv_record_addfield_double, &
1011 csv_record_addfield_csv_record
1012END INTERFACE
1013
1020 MODULE PROCEDURE csv_record_addfield_char_miss, csv_record_addfield_int_miss, &
1021 csv_record_addfield_real_miss, csv_record_addfield_double_miss
1022END INTERFACE
1023
1024
1025PRIVATE csv_record_init, csv_record_delete, csv_record_getfield_char, &
1026 csv_record_getfield_int, csv_record_getfield_real, csv_record_getfield_double, &
1027 csv_record_addfield_char, csv_record_addfield_int, csv_record_addfield_real, &
1028 csv_record_addfield_double, csv_record_addfield_csv_record, &
1029 csv_record_addfield_char_miss, csv_record_addfield_int_miss, &
1030 csv_record_addfield_real_miss, csv_record_addfield_double_miss, &
1031 checkrealloc, add_byte
1032
1033CONTAINS
1034
1047FUNCTION getunit() RESULT(unit)
1048INTEGER :: unit
1049
1050LOGICAL :: op
1051
1052DO unit = 100, 32767
1053 INQUIRE(unit, opened=op)
1054 IF (.NOT. op) RETURN
1055ENDDO
1056
1057CALL l4f_log(l4f_error, 'Too many open files')
1058CALL raise_error()
1059unit = -1
1060
1061END FUNCTION getunit
1062
1072FUNCTION get_package_filepath(filename, filetype) RESULT(path)
1073CHARACTER(len=*), INTENT(in) :: filename
1074INTEGER, INTENT(in) :: filetype
1075character(len=len(filename)) :: lfilename
1076
1077INTEGER :: j
1078CHARACTER(len=512) :: path
1079LOGICAL :: exist,cwd,share
1080
1081!IF (package_name == ' ') THEN
1082! CALL getarg(0, package_name)
1083!ENDIF
1084
1085IF (filetype < 1 .OR. filetype > nftype) THEN
1086 path = ''
1088 ' not valid')
1089 CALL raise_error()
1090 RETURN
1091ENDIF
1092
1093share = filename(:6) == "share:"
1094cwd = filename(:4) == "cwd:"
1095
1096lfilename=filename
1097if (share) lfilename=filename(7:)
1098if (cwd) lfilename=filename(5:)
1099
1100if ( .not. share .and. .not. cwd .and. filetype == filetype_data) then
1101 share=.true.
1102 cwd=.true.
1103end if
1104
1105if (cwd) then
1106 ! try with current dir
1107 path = lfilename
1108 CALL l4f_log(l4f_debug, 'inquire local file '//trim(path))
1109 INQUIRE(file=path, exist=exist)
1110 IF (exist) THEN
1111 CALL l4f_log(l4f_info, 'local file '//trim(path)//' found')
1112 RETURN
1113 ENDIF
1114end if
1115
1116if (share .or. filetype == filetype_config) then
1117
1118 ! try with environment variable
1119 CALL getenv(trim(uppercase(package_name))//'_'//trim(filetypename(filetype)), path)
1120 IF (path /= ' ') THEN
1121
1122 path(len_trim(path)+1:) = '/'//lfilename
1123 CALL l4f_log(l4f_debug, 'inquire env package file '//trim(path))
1124 INQUIRE(file=path, exist=exist)
1125 IF (exist) THEN
1126 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1127 RETURN
1128 ENDIF
1129 ENDIF
1130
1131 ! try with install prefix
1132 path = trim(prefix)//trim(postfix(filetype)) &
1133 //'/'//trim(package_name)//'/'//lfilename
1134 CALL l4f_log(l4f_debug, 'inquire install package file '//trim(path))
1135 INQUIRE(file=path, exist=exist)
1136 IF (exist) THEN
1137 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1138 RETURN
1139 ENDIF
1140
1141 ! try with default install prefix
1142 DO j = 1, SIZE(preflist,1)
1143 IF (preflist(j,filetype) == ' ') EXIT
1144 path = trim(preflist(j,filetype))//trim(postfix(filetype)) &
1145 //'/'//trim(package_name)//'/'//lfilename
1146 CALL l4f_log(l4f_debug, 'inquire package file '//trim(path))
1147 INQUIRE(file=path, exist=exist)
1148 IF (exist) THEN
1149 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1150 RETURN
1151 ENDIF
1152 ENDDO
1153
1154end if
1155
1156CALL l4f_log(l4f_info, 'package file '//trim(lfilename)//' not found')
1157path = cmiss
1158
1159END FUNCTION get_package_filepath
1160
1161
1166FUNCTION open_package_file(filename, filetype) RESULT(unit)
1167CHARACTER(len=*), INTENT(in) :: filename
1168INTEGER, INTENT(in) :: filetype
1169INTEGER :: unit, i
1170
1171CHARACTER(len=512) :: path
1172
1173unit = -1
1174path=get_package_filepath(filename, filetype)
1175IF (path == '') RETURN
1176
1177unit = getunit()
1178IF (unit == -1) RETURN
1179
1180OPEN(unit, file=path, status='old', iostat = i)
1181IF (i == 0) THEN
1182 CALL l4f_log(l4f_info, 'package file '//trim(path)//' opened')
1183 RETURN
1184ENDIF
1185
1186CALL l4f_log(l4f_error, 'package file '//trim(filename)//' not found')
1187CALL raise_error()
1188unit = -1
1189
1190END FUNCTION open_package_file
1191
1192
1206SUBROUTINE csv_record_init(this, record, csep, cquote, nfield)
1207TYPE(csv_record),INTENT(INOUT) :: this
1208CHARACTER(len=*),INTENT(IN), OPTIONAL :: record
1209CHARACTER(len=1),INTENT(IN),OPTIONAL :: csep
1210CHARACTER(len=1),INTENT(IN),OPTIONAL :: cquote
1211INTEGER,INTENT(OUT),OPTIONAL :: nfield
1212
1213INTEGER :: l
1214
1215IF (PRESENT(csep)) THEN
1216 this%csep = transfer(csep, this%csep)
1217ELSE
1218 this%csep = transfer(',', this%csep)
1219ENDIF
1220IF (PRESENT(cquote)) THEN
1221 this%cquote = transfer(cquote, this%cquote)
1222ELSE
1223 this%cquote = transfer('"', this%cquote)
1224ENDIF
1225
1226this%cursor = 0
1227this%nfield = 0
1228IF (PRESENT(record)) THEN
1229 l = len_trim(record)
1230 ALLOCATE(this%record(l))
1231 this%record(:) = transfer(record, this%record, l) ! ice in pgf90 with TRIM(record)
1232
1233 IF (PRESENT(nfield)) THEN
1234 nfield = 0
1235 DO WHILE(.NOT.csv_record_end(this)) ! faccio un giro a vuoto sul record
1236 nfield = nfield + 1
1238 ENDDO
1239 this%cursor = 0 ! riazzero il cursore
1240 ENDIF
1241ELSE
1242 ALLOCATE(this%record(csv_basereclen))
1243ENDIF
1244
1245END SUBROUTINE csv_record_init
1246
1247
1249SUBROUTINE csv_record_delete(this)
1250TYPE(csv_record), INTENT(INOUT) :: this
1251
1252DEALLOCATE(this%record)
1253
1254END SUBROUTINE csv_record_delete
1255
1256
1258SUBROUTINE csv_record_rewind(this)
1259TYPE(csv_record),INTENT(INOUT) :: this
1260
1261this%cursor = 0
1262this%nfield = 0
1263
1264END SUBROUTINE csv_record_rewind
1265
1266
1270SUBROUTINE csv_record_addfield_char(this, field, force_quote)
1271TYPE(csv_record),INTENT(INOUT) :: this
1272CHARACTER(len=*),INTENT(IN) :: field
1273LOGICAL, INTENT(in), OPTIONAL :: force_quote
1274
1275INTEGER :: i
1276LOGICAL :: lquote
1277
1278lquote = optio_log(force_quote)
1279IF (len(field) == 0) THEN ! Particular case to be handled separately
1280 CALL checkrealloc(this, 1)
1281 IF (this%nfield > 0) THEN
1282 CALL add_byte(this, this%csep) ! add separator if necessary
1283 ELSE
1284 CALL add_byte(this, this%cquote) ! if first record is empty it should be quoted
1285 CALL add_byte(this, this%cquote) ! in case it is the only one
1286 ENDIF
1288 .AND. index(field, transfer(this%cquote,field(1:1))) == 0 &
1289 .AND. .NOT.is_space_c(field(1:1)) &
1290 .AND. .NOT.is_space_c(field(len(field):len(field))) &
1291 .AND. .NOT.lquote) THEN ! quote not required
1292 CALL checkrealloc(this, len(field)+1)
1293 IF (this%nfield > 0) CALL add_byte(this, this%csep) ! add separator if necessary
1294 this%record(this%cursor+1:this%cursor+len(field)) = transfer(field, this%record)
1295 this%cursor = this%cursor + len(field)
1296ELSE ! quote required
1297 CALL checkrealloc(this, 2*len(field)+3) ! worst case """""""""
1298 IF (this%nfield > 0) CALL add_byte(this, this%csep) ! add separator if necessary
1299 CALL add_byte(this, this%cquote) ! add quote
1300 DO i = 1, len(field)
1301 CALL add_char(field(i:i))
1302 ENDDO
1303 CALL add_byte(this, this%cquote) ! add quote
1304ENDIF
1305
1306this%nfield = this%nfield + 1
1307
1308CONTAINS
1309
1310! add a character, doubling it if it's a quote
1311SUBROUTINE add_char(char)
1312CHARACTER(len=1) :: char
1313
1314this%cursor = this%cursor+1
1315this%record(this%cursor) = transfer(char, this%record(1))
1316IF (this%record(this%cursor) == this%cquote) THEN ! double the quote
1317 this%cursor = this%cursor+1
1318 this%record(this%cursor) = this%cquote
1319ENDIF
1320
1321END SUBROUTINE add_char
1322
1323END SUBROUTINE csv_record_addfield_char
1324
1325
1326! Reallocate record if necessary
1327SUBROUTINE checkrealloc(this, enlarge)
1328TYPE(csv_record),INTENT(INOUT) :: this
1329INTEGER, INTENT(in) :: enlarge
1330
1331INTEGER(KIND=int_b), POINTER :: tmpptr(:)
1332
1333IF (this%cursor+enlarge+1 > SIZE(this%record)) THEN
1334 ALLOCATE(tmpptr(SIZE(this%record)+max(csv_basereclen, enlarge)))
1335 tmpptr(1:SIZE(this%record)) = this%record(:)
1336 DEALLOCATE(this%record)
1337 this%record => tmpptr
1338ENDIF
1339
1340END SUBROUTINE checkrealloc
1341
1342
1343! add a byte
1344SUBROUTINE add_byte(this, char)
1345TYPE(csv_record),INTENT(INOUT) :: this
1346INTEGER(kind=int_b) :: char
1347
1348this%cursor = this%cursor+1
1349this%record(this%cursor) = char
1350
1351END SUBROUTINE add_byte
1352
1353
1357SUBROUTINE csv_record_addfield_char_miss(this, field, force_quote)
1358TYPE(csv_record),INTENT(INOUT) :: this
1359CHARACTER(len=*),INTENT(IN) :: field
1360LOGICAL, INTENT(in), OPTIONAL :: force_quote
1361
1363
1364END SUBROUTINE csv_record_addfield_char_miss
1365
1366
1369SUBROUTINE csv_record_addfield_int(this, field, form, force_quote)
1370TYPE(csv_record),INTENT(INOUT) :: this
1371INTEGER,INTENT(IN) :: field
1372CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1373LOGICAL, INTENT(in), OPTIONAL :: force_quote
1374
1375IF (PRESENT(form)) THEN
1377ELSE
1379ENDIF
1380
1381END SUBROUTINE csv_record_addfield_int
1382
1383
1387SUBROUTINE csv_record_addfield_int_miss(this, field, force_quote)
1388TYPE(csv_record),INTENT(INOUT) :: this
1389INTEGER,INTENT(IN) :: field
1390LOGICAL, INTENT(in), OPTIONAL :: force_quote
1391
1393
1394END SUBROUTINE csv_record_addfield_int_miss
1395
1396
1399SUBROUTINE csv_record_addfield_real(this, field, form, force_quote)
1400TYPE(csv_record),INTENT(INOUT) :: this
1401REAL,INTENT(IN) :: field
1402CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1403LOGICAL, INTENT(in), OPTIONAL :: force_quote
1404
1405IF (PRESENT(form)) THEN
1407ELSE
1409ENDIF
1410
1411END SUBROUTINE csv_record_addfield_real
1412
1413
1417SUBROUTINE csv_record_addfield_real_miss(this, field, force_quote)
1418TYPE(csv_record),INTENT(INOUT) :: this
1419REAL,INTENT(IN) :: field
1420LOGICAL, INTENT(in), OPTIONAL :: force_quote
1421
1423
1424END SUBROUTINE csv_record_addfield_real_miss
1425
1426
1429SUBROUTINE csv_record_addfield_double(this, field, form, force_quote)
1430TYPE(csv_record),INTENT(INOUT) :: this
1431DOUBLE PRECISION,INTENT(IN) :: field
1432CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1433LOGICAL, INTENT(in), OPTIONAL :: force_quote
1434
1435IF (PRESENT(form)) THEN
1437ELSE
1439ENDIF
1440
1441END SUBROUTINE csv_record_addfield_double
1442
1443
1447SUBROUTINE csv_record_addfield_double_miss(this, field, force_quote)
1448TYPE(csv_record),INTENT(INOUT) :: this
1449DOUBLE PRECISION,INTENT(IN) :: field
1450LOGICAL, INTENT(in), OPTIONAL :: force_quote
1451
1453
1454END SUBROUTINE csv_record_addfield_double_miss
1455
1456
1462SUBROUTINE csv_record_addfield_csv_record(this, record)
1463TYPE(csv_record),INTENT(INOUT) :: this
1464TYPE(csv_record),INTENT(IN) :: record
1465
1466IF (this%csep /= record%csep .OR. this%cquote /= record%cquote) RETURN ! error
1467CALL checkrealloc(this, record%cursor)
1468IF (this%nfield > 0) CALL add_byte(this, this%csep)
1469
1470this%record(this%cursor+1:this%cursor+record%cursor) = &
1471 record%record(1:record%cursor)
1472this%cursor = this%cursor + record%cursor
1473this%nfield = this%nfield + record%nfield
1474
1475END SUBROUTINE csv_record_addfield_csv_record
1476
1477
1480FUNCTION csv_record_getrecord(this, nfield)
1481TYPE(csv_record),INTENT(IN) :: this
1482INTEGER, INTENT(out), OPTIONAL :: nfield
1483
1484CHARACTER(len=this%cursor) :: csv_record_getrecord
1485
1486csv_record_getrecord = transfer(this%record(1:this%cursor), csv_record_getrecord)
1487IF (present(nfield)) nfield = this%nfield
1488
1489END FUNCTION csv_record_getrecord
1490
1491
1497SUBROUTINE csv_record_getfield_char(this, field, flen, ier)
1498TYPE(csv_record),INTENT(INOUT) :: this
1499CHARACTER(len=*),INTENT(OUT),OPTIONAL :: field
1501INTEGER,INTENT(OUT),OPTIONAL :: flen
1502INTEGER,INTENT(OUT),OPTIONAL :: ier
1503
1504LOGICAL :: inquote, inpre, inpost, firstquote
1505INTEGER :: i, ocursor, ofcursor
1506
1507! check end of record
1508IF (csv_record_end(this)) THEN
1509 IF (PRESENT(field)) field = cmiss
1510 IF (PRESENT(ier))THEN
1511 ier = 2
1512 ELSE
1513 CALL l4f_log(l4f_error, &
1514 'in csv_record_getfield, attempt to read past end of record')
1515 CALL raise_error()
1516 ENDIF
1517 RETURN
1518ENDIF
1519! start decoding
1520IF (PRESENT(field)) field = ''
1521IF (PRESENT(ier)) ier = 0
1522ocursor = 0
1523ofcursor = 0
1524inquote = .false.
1525inpre = .true.
1526inpost = .false.
1527firstquote = .false.
1528
1529DO i = this%cursor+1, SIZE(this%record)
1530 IF (inpre) THEN ! sono nel preludio, butto via gli spazi
1531 IF (is_space_b(this%record(i))) THEN
1532 cycle
1533 ELSE
1534 inpre = .false.
1535 ENDIF
1536 ENDIF
1537
1538 IF (.NOT.inquote) THEN ! fuori da " "
1539 IF (this%record(i) == this%cquote) THEN ! ": inizia " "
1540 inquote = .true.
1541 cycle
1542 ELSE IF (this%record(i) == this%csep) THEN ! ,: fine campo
1543 EXIT
1544 ELSE ! carattere normale, elimina "trailing blanks"
1545 CALL add_char(this%record(i), .true., field)
1546 cycle
1547 ENDIF
1548 ELSE ! dentro " "
1549 IF (.NOT.firstquote) THEN ! il precedente non e` "
1550 IF (this%record(i) == this%cquote) THEN ! ": fine " " oppure ""
1551 firstquote = .true.
1552 cycle
1553 ELSE ! carattere normale
1554 CALL add_char(this%record(i), .false., field)
1555 cycle
1556 ENDIF
1557 ELSE ! il precedente e` "
1558 firstquote = .false.
1559 IF (this%record(i) == this%cquote) THEN ! ": sequenza ""
1560 CALL add_char(this%cquote, .false., field)
1561 cycle
1562 ELSE ! carattere normale: e` terminata " "
1563 inquote = .false.
1564 IF (this%record(i) == this%csep) THEN ! , fine campo
1565 EXIT
1566 ELSE ! carattere normale, elimina "trailing blanks"
1567 CALL add_char(this%record(i), .true., field)
1568 cycle
1569 ENDIF
1570 ENDIF
1571 ENDIF
1572 ENDIF
1573ENDDO
1574
1575this%cursor = min(i, SIZE(this%record) + 1)
1576IF (PRESENT(flen)) flen = ofcursor ! restituisco la lunghezza
1577IF (PRESENT(field)) THEN ! controllo overflow di field
1578 IF (ofcursor > len(field)) THEN
1579 IF (PRESENT(ier)) THEN
1580 ier = 1
1581 ELSE
1582 CALL l4f_log(l4f_warn, &
1583 'in csv_record_getfield, CHARACTER variable too short for field: '// &
1585 ENDIF
1586 ENDIF
1587ENDIF
1588
1589CONTAINS
1590
1591SUBROUTINE add_char(char, check_space, field)
1592INTEGER(kind=int_b) :: char
1593LOGICAL,INTENT(IN) :: check_space
1594CHARACTER(len=*),INTENT(OUT),OPTIONAL :: field
1595
1596CHARACTER(len=1) :: dummy ! this prevents a memory leak in TRANSFER()???
1597
1598ocursor = ocursor + 1
1599 IF (PRESENT(field)) THEN
1600 IF (ocursor <= len(field)) THEN
1601 field(ocursor:ocursor) = transfer(char, dummy)
1602 ENDIF
1603ENDIF
1604IF (check_space) THEN
1605 IF (.NOT.is_space_b(char)) ofcursor = ocursor
1606ELSE
1607 ofcursor = ocursor
1608ENDIF
1609
1610END SUBROUTINE add_char
1611
1612END SUBROUTINE csv_record_getfield_char
1613
1614
1620SUBROUTINE csv_record_getfield_int(this, field, ier)
1621TYPE(csv_record),INTENT(INOUT) :: this
1622INTEGER,INTENT(OUT) :: field
1623INTEGER,INTENT(OUT),OPTIONAL :: ier
1624
1625CHARACTER(len=32) :: cfield
1626INTEGER :: lier
1627
1630 READ(cfield, '(I32)', iostat=lier) field
1631 IF (lier /= 0) THEN
1632 field = imiss
1633 IF (.NOT.PRESENT(ier)) THEN
1634 CALL l4f_log(l4f_error, &
1635 'in csv_record_getfield, invalid integer field: '//trim(cfield))
1636 CALL raise_error()
1637 ELSE
1638 ier = 3 ! conversion error
1639 ENDIF
1640 ENDIF
1641ELSE
1642 field = imiss
1643ENDIF
1644
1645END SUBROUTINE csv_record_getfield_int
1646
1647
1653SUBROUTINE csv_record_getfield_real(this, field, ier)
1654TYPE(csv_record),INTENT(INOUT) :: this
1655REAL,INTENT(OUT) :: field
1656INTEGER,INTENT(OUT),OPTIONAL :: ier
1657
1658CHARACTER(len=32) :: cfield
1659INTEGER :: lier
1660
1663 READ(cfield, '(F32.0)', iostat=lier) field
1664 IF (lier /= 0) THEN
1665 field = rmiss
1666 IF (.NOT.PRESENT(ier)) THEN
1667 CALL l4f_log(l4f_error, &
1668 'in csv_record_getfield, invalid real field: '//trim(cfield))
1669 CALL raise_error()
1670 ELSE
1671 ier = 3 ! conversion error
1672 ENDIF
1673 ENDIF
1674ELSE
1675 field = rmiss
1676ENDIF
1677
1678END SUBROUTINE csv_record_getfield_real
1679
1680
1686SUBROUTINE csv_record_getfield_double(this, field, ier)
1687TYPE(csv_record),INTENT(INOUT) :: this
1688DOUBLE PRECISION,INTENT(OUT) :: field
1689INTEGER,INTENT(OUT),OPTIONAL :: ier
1690
1691CHARACTER(len=32) :: cfield
1692INTEGER :: lier
1693
1696 READ(cfield, '(F32.0)', iostat=lier) field
1697 IF (lier /= 0) THEN
1698 field = dmiss
1699 IF (.NOT.PRESENT(ier)) THEN
1700 CALL l4f_log(l4f_error, &
1701 'in csv_record_getfield, invalid double precision field: '//trim(cfield))
1702 CALL raise_error()
1703 ELSE
1704 ier = 3 ! conversion error
1705 ENDIF
1706 ENDIF
1707ELSE
1708 field = dmiss
1709ENDIF
1710
1711END SUBROUTINE csv_record_getfield_double
1712
1713
1716FUNCTION csv_record_end(this)
1717TYPE(csv_record), INTENT(IN) :: this
1718LOGICAL :: csv_record_end
1719
1720csv_record_end = this%cursor > SIZE(this%record)
1721
1722END FUNCTION csv_record_end
1723
1724
1725FUNCTION is_space_c(char) RESULT(is_space)
1726CHARACTER(len=1) :: char
1727LOGICAL :: is_space
1728
1729is_space = (ichar(char) == 32 .OR. ichar(char) == 9) ! improve
1730
1731END FUNCTION is_space_c
1732
1733
1734FUNCTION is_space_b(char) RESULT(is_space)
1735INTEGER(kind=int_b) :: char
1736LOGICAL :: is_space
1737
1738is_space = (char == 32 .OR. char == 9) ! improve
1739
1740END FUNCTION is_space_b
1741
1742
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 |