libsim Versione 7.1.11

◆ csv_record_getfield_real()

subroutine, private csv_record_getfield_real ( type(csv_record), intent(inout)  this,
real, intent(out)  field,
integer, intent(out), optional  ier 
)
private

Returns next field from the record this as a REAL 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 a real, 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, = rmiss if conversion fails
[out]iererror code, 0 = OK, 2 = end of record, 3 = cannot convert to real

Definizione alla linea 940 del file file_utilities.F90.

941! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
942! authors:
943! Davide Cesari <dcesari@arpa.emr.it>
944! Paolo Patruno <ppatruno@arpa.emr.it>
945
946! This program is free software; you can redistribute it and/or
947! modify it under the terms of the GNU General Public License as
948! published by the Free Software Foundation; either version 2 of
949! the License, or (at your option) any later version.
950
951! This program is distributed in the hope that it will be useful,
952! but WITHOUT ANY WARRANTY; without even the implied warranty of
953! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
954! GNU General Public License for more details.
955
956! You should have received a copy of the GNU General Public License
957! along with this program. If not, see <http://www.gnu.org/licenses/>.
958#include "config.h"
959
966MODULE file_utilities
967USE kinds
971USE log4fortran
972USE err_handling
973IMPLICIT NONE
974
975CHARACTER(len=128), PARAMETER :: package_name = package
976CHARACTER(len=128), PARAMETER :: prefix = prefix
977
978INTEGER, PARAMETER, PRIVATE :: nftype = 2
979CHARACTER(len=10), PARAMETER, PRIVATE :: &
980 preflist(2,nftype) = reshape((/ &
981 '/usr/local', '/usr ', &
982 '/usr/local', ' '/), &
983 (/2,nftype/))
984CHARACTER(len=6), PARAMETER, PRIVATE :: &
985 postfix(nftype) = (/ '/share', '/etc ' /)
986CHARACTER(len=6), PARAMETER, PRIVATE :: &
987 filetypename(nftype) = (/ 'DATA ', 'CONFIG' /)
988INTEGER, PARAMETER :: filetype_data = 1
989INTEGER, PARAMETER :: filetype_config = 2
990
991
995TYPE csv_record
996 PRIVATE
997 INTEGER :: cursor, action, nfield !, ntotal
998 INTEGER(KIND=int_b) :: csep, cquote
999 INTEGER(KIND=int_b), POINTER :: record(:)
1000END TYPE csv_record
1001
1002INTEGER, PARAMETER, PRIVATE :: csv_basereclen=1024, &
1003 csv_action_read=0, csv_action_write=1
1004
1007INTERFACE init
1008 MODULE PROCEDURE csv_record_init
1009END INTERFACE
1010
1014INTERFACE delete
1015 MODULE PROCEDURE csv_record_delete
1016END INTERFACE
1017
1031INTERFACE csv_record_getfield
1032 MODULE PROCEDURE csv_record_getfield_char, csv_record_getfield_int, &
1033 csv_record_getfield_real, csv_record_getfield_double
1034END INTERFACE
1035
1041INTERFACE csv_record_addfield
1042 MODULE PROCEDURE csv_record_addfield_char, csv_record_addfield_int, &
1043 csv_record_addfield_real, csv_record_addfield_double, &
1044 csv_record_addfield_csv_record
1045END INTERFACE
1046
1053 MODULE PROCEDURE csv_record_addfield_char_miss, csv_record_addfield_int_miss, &
1054 csv_record_addfield_real_miss, csv_record_addfield_double_miss
1055END INTERFACE
1056
1057
1058PRIVATE csv_record_init, csv_record_delete, csv_record_getfield_char, &
1059 csv_record_getfield_int, csv_record_getfield_real, csv_record_getfield_double, &
1060 csv_record_addfield_char, csv_record_addfield_int, csv_record_addfield_real, &
1061 csv_record_addfield_double, csv_record_addfield_csv_record, &
1062 csv_record_addfield_char_miss, csv_record_addfield_int_miss, &
1063 csv_record_addfield_real_miss, csv_record_addfield_double_miss, &
1064 checkrealloc, add_byte
1065
1066CONTAINS
1067
1080FUNCTION getunit() RESULT(unit)
1081INTEGER :: unit
1082
1083LOGICAL :: op
1084
1085DO unit = 100, 32767
1086 INQUIRE(unit, opened=op)
1087 IF (.NOT. op) RETURN
1088ENDDO
1089
1090CALL l4f_log(l4f_error, 'Too many open files')
1091CALL raise_error()
1092unit = -1
1093
1094END FUNCTION getunit
1095
1105FUNCTION get_package_filepath(filename, filetype) RESULT(path)
1106CHARACTER(len=*), INTENT(in) :: filename
1107INTEGER, INTENT(in) :: filetype
1108character(len=len(filename)) :: lfilename
1109
1110INTEGER :: j
1111CHARACTER(len=512) :: path
1112LOGICAL :: exist,cwd,share
1113
1114!IF (package_name == ' ') THEN
1115! CALL getarg(0, package_name)
1116!ENDIF
1117
1118IF (filetype < 1 .OR. filetype > nftype) THEN
1119 path = ''
1120 CALL l4f_log(l4f_error, 'package file type '//t2c(filetype)// &
1121 ' not valid')
1122 CALL raise_error()
1123 RETURN
1124ENDIF
1125
1126share = filename(:6) == "share:"
1127cwd = filename(:4) == "cwd:"
1128
1129lfilename=filename
1130if (share) lfilename=filename(7:)
1131if (cwd) lfilename=filename(5:)
1132
1133if ( .not. share .and. .not. cwd .and. filetype == filetype_data) then
1134 share=.true.
1135 cwd=.true.
1136end if
1137
1138if (cwd) then
1139 ! try with current dir
1140 path = lfilename
1141 CALL l4f_log(l4f_debug, 'inquire local file '//trim(path))
1142 INQUIRE(file=path, exist=exist)
1143 IF (exist) THEN
1144 CALL l4f_log(l4f_info, 'local file '//trim(path)//' found')
1145 RETURN
1146 ENDIF
1147end if
1148
1149if (share .or. filetype == filetype_config) then
1150
1151 ! try with environment variable
1152 CALL getenv(trim(uppercase(package_name))//'_'//trim(filetypename(filetype)), path)
1153 IF (path /= ' ') THEN
1154
1155 path(len_trim(path)+1:) = '/'//lfilename
1156 CALL l4f_log(l4f_debug, 'inquire env package file '//trim(path))
1157 INQUIRE(file=path, exist=exist)
1158 IF (exist) THEN
1159 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1160 RETURN
1161 ENDIF
1162 ENDIF
1163
1164 ! try with install prefix
1165 path = trim(prefix)//trim(postfix(filetype)) &
1166 //'/'//trim(package_name)//'/'//lfilename
1167 CALL l4f_log(l4f_debug, 'inquire install package file '//trim(path))
1168 INQUIRE(file=path, exist=exist)
1169 IF (exist) THEN
1170 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1171 RETURN
1172 ENDIF
1173
1174 ! try with default install prefix
1175 DO j = 1, SIZE(preflist,1)
1176 IF (preflist(j,filetype) == ' ') EXIT
1177 path = trim(preflist(j,filetype))//trim(postfix(filetype)) &
1178 //'/'//trim(package_name)//'/'//lfilename
1179 CALL l4f_log(l4f_debug, 'inquire package file '//trim(path))
1180 INQUIRE(file=path, exist=exist)
1181 IF (exist) THEN
1182 CALL l4f_log(l4f_info, 'package file '//trim(path)//' found')
1183 RETURN
1184 ENDIF
1185 ENDDO
1186
1187end if
1188
1189CALL l4f_log(l4f_info, 'package file '//trim(lfilename)//' not found')
1190path = cmiss
1191
1192END FUNCTION get_package_filepath
1193
1194
1199FUNCTION open_package_file(filename, filetype) RESULT(unit)
1200CHARACTER(len=*), INTENT(in) :: filename
1201INTEGER, INTENT(in) :: filetype
1202INTEGER :: unit, i
1203
1204CHARACTER(len=512) :: path
1205
1206unit = -1
1207path=get_package_filepath(filename, filetype)
1208IF (path == '') RETURN
1209
1210unit = getunit()
1211IF (unit == -1) RETURN
1212
1213OPEN(unit, file=path, status='old', iostat = i)
1214IF (i == 0) THEN
1215 CALL l4f_log(l4f_info, 'package file '//trim(path)//' opened')
1216 RETURN
1217ENDIF
1218
1219CALL l4f_log(l4f_error, 'package file '//trim(filename)//' not found')
1220CALL raise_error()
1221unit = -1
1222
1223END FUNCTION open_package_file
1224
1225
1239SUBROUTINE csv_record_init(this, record, csep, cquote, nfield)
1240TYPE(csv_record),INTENT(INOUT) :: this
1241CHARACTER(len=*),INTENT(IN), OPTIONAL :: record
1242CHARACTER(len=1),INTENT(IN),OPTIONAL :: csep
1243CHARACTER(len=1),INTENT(IN),OPTIONAL :: cquote
1244INTEGER,INTENT(OUT),OPTIONAL :: nfield
1245
1246INTEGER :: l
1247
1248IF (PRESENT(csep)) THEN
1249 this%csep = transfer(csep, this%csep)
1250ELSE
1251 this%csep = transfer(',', this%csep)
1252ENDIF
1253IF (PRESENT(cquote)) THEN
1254 this%cquote = transfer(cquote, this%cquote)
1255ELSE
1256 this%cquote = transfer('"', this%cquote)
1257ENDIF
1258
1259this%cursor = 0
1260this%nfield = 0
1261IF (PRESENT(record)) THEN
1262 l = len_trim(record)
1263 ALLOCATE(this%record(l))
1264 this%record(:) = transfer(record, this%record, l) ! ice in pgf90 with TRIM(record)
1265
1266 IF (PRESENT(nfield)) THEN
1267 nfield = 0
1268 DO WHILE(.NOT.csv_record_end(this)) ! faccio un giro a vuoto sul record
1269 nfield = nfield + 1
1270 CALL csv_record_getfield(this)
1271 ENDDO
1272 this%cursor = 0 ! riazzero il cursore
1273 ENDIF
1274ELSE
1275 ALLOCATE(this%record(csv_basereclen))
1276ENDIF
1277
1278END SUBROUTINE csv_record_init
1279
1280
1282SUBROUTINE csv_record_delete(this)
1283TYPE(csv_record), INTENT(INOUT) :: this
1284
1285DEALLOCATE(this%record)
1286
1287END SUBROUTINE csv_record_delete
1288
1289
1291SUBROUTINE csv_record_rewind(this)
1292TYPE(csv_record),INTENT(INOUT) :: this
1293
1294this%cursor = 0
1295this%nfield = 0
1296
1297END SUBROUTINE csv_record_rewind
1298
1299
1303SUBROUTINE csv_record_addfield_char(this, field, force_quote)
1304TYPE(csv_record),INTENT(INOUT) :: this
1305CHARACTER(len=*),INTENT(IN) :: field
1306LOGICAL, INTENT(in), OPTIONAL :: force_quote
1307
1308INTEGER :: i
1309LOGICAL :: lquote
1310
1311lquote = optio_log(force_quote)
1312IF (len(field) == 0) THEN ! Particular case to be handled separately
1313 CALL checkrealloc(this, 1)
1314 IF (this%nfield > 0) THEN
1315 CALL add_byte(this, this%csep) ! add separator if necessary
1316 ELSE
1317 CALL add_byte(this, this%cquote) ! if first record is empty it should be quoted
1318 CALL add_byte(this, this%cquote) ! in case it is the only one
1319 ENDIF
1320ELSE IF (index(field, transfer(this%csep,field(1:1))) == 0 &
1321 .AND. index(field, transfer(this%cquote,field(1:1))) == 0 &
1322 .AND. .NOT.is_space_c(field(1:1)) &
1323 .AND. .NOT.is_space_c(field(len(field):len(field))) &
1324 .AND. .NOT.lquote) THEN ! quote not required
1325 CALL checkrealloc(this, len(field)+1)
1326 IF (this%nfield > 0) CALL add_byte(this, this%csep) ! add separator if necessary
1327 this%record(this%cursor+1:this%cursor+len(field)) = transfer(field, this%record)
1328 this%cursor = this%cursor + len(field)
1329ELSE ! quote required
1330 CALL checkrealloc(this, 2*len(field)+3) ! worst case """""""""
1331 IF (this%nfield > 0) CALL add_byte(this, this%csep) ! add separator if necessary
1332 CALL add_byte(this, this%cquote) ! add quote
1333 DO i = 1, len(field)
1334 CALL add_char(field(i:i))
1335 ENDDO
1336 CALL add_byte(this, this%cquote) ! add quote
1337ENDIF
1338
1339this%nfield = this%nfield + 1
1340
1341CONTAINS
1342
1343! add a character, doubling it if it's a quote
1344SUBROUTINE add_char(char)
1345CHARACTER(len=1) :: char
1346
1347this%cursor = this%cursor+1
1348this%record(this%cursor) = transfer(char, this%record(1))
1349IF (this%record(this%cursor) == this%cquote) THEN ! double the quote
1350 this%cursor = this%cursor+1
1351 this%record(this%cursor) = this%cquote
1352ENDIF
1353
1354END SUBROUTINE add_char
1355
1356END SUBROUTINE csv_record_addfield_char
1357
1358
1359! Reallocate record if necessary
1360SUBROUTINE checkrealloc(this, enlarge)
1361TYPE(csv_record),INTENT(INOUT) :: this
1362INTEGER, INTENT(in) :: enlarge
1363
1364INTEGER(KIND=int_b), POINTER :: tmpptr(:)
1365
1366IF (this%cursor+enlarge+1 > SIZE(this%record)) THEN
1367 ALLOCATE(tmpptr(SIZE(this%record)+max(csv_basereclen, enlarge)))
1368 tmpptr(1:SIZE(this%record)) = this%record(:)
1369 DEALLOCATE(this%record)
1370 this%record => tmpptr
1371ENDIF
1372
1373END SUBROUTINE checkrealloc
1374
1375
1376! add a byte
1377SUBROUTINE add_byte(this, char)
1378TYPE(csv_record),INTENT(INOUT) :: this
1379INTEGER(kind=int_b) :: char
1380
1381this%cursor = this%cursor+1
1382this%record(this%cursor) = char
1383
1384END SUBROUTINE add_byte
1385
1386
1390SUBROUTINE csv_record_addfield_char_miss(this, field, force_quote)
1391TYPE(csv_record),INTENT(INOUT) :: this
1392CHARACTER(len=*),INTENT(IN) :: field
1393LOGICAL, INTENT(in), OPTIONAL :: force_quote
1394
1395CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
1396
1397END SUBROUTINE csv_record_addfield_char_miss
1398
1399
1402SUBROUTINE csv_record_addfield_int(this, field, form, force_quote)
1403TYPE(csv_record),INTENT(INOUT) :: this
1404INTEGER,INTENT(IN) :: field
1405CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1406LOGICAL, INTENT(in), OPTIONAL :: force_quote
1407
1408IF (PRESENT(form)) THEN
1409 CALL csv_record_addfield(this, trim(to_char(field, form)), force_quote=force_quote)
1410ELSE
1411 CALL csv_record_addfield(this, t2c(field), force_quote=force_quote)
1412ENDIF
1413
1414END SUBROUTINE csv_record_addfield_int
1415
1416
1420SUBROUTINE csv_record_addfield_int_miss(this, field, force_quote)
1421TYPE(csv_record),INTENT(INOUT) :: this
1422INTEGER,INTENT(IN) :: field
1423LOGICAL, INTENT(in), OPTIONAL :: force_quote
1424
1425CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
1426
1427END SUBROUTINE csv_record_addfield_int_miss
1428
1429
1432SUBROUTINE csv_record_addfield_real(this, field, form, force_quote)
1433TYPE(csv_record),INTENT(INOUT) :: this
1434REAL,INTENT(IN) :: field
1435CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1436LOGICAL, INTENT(in), OPTIONAL :: force_quote
1437
1438IF (PRESENT(form)) THEN
1439 CALL csv_record_addfield(this, trim(to_char(field, form)), force_quote=force_quote)
1440ELSE
1441 CALL csv_record_addfield(this, t2c(field), force_quote=force_quote)
1442ENDIF
1443
1444END SUBROUTINE csv_record_addfield_real
1445
1446
1450SUBROUTINE csv_record_addfield_real_miss(this, field, force_quote)
1451TYPE(csv_record),INTENT(INOUT) :: this
1452REAL,INTENT(IN) :: field
1453LOGICAL, INTENT(in), OPTIONAL :: force_quote
1454
1455CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
1456
1457END SUBROUTINE csv_record_addfield_real_miss
1458
1459
1462SUBROUTINE csv_record_addfield_double(this, field, form, force_quote)
1463TYPE(csv_record),INTENT(INOUT) :: this
1464DOUBLE PRECISION,INTENT(IN) :: field
1465CHARACTER(len=*),INTENT(in),OPTIONAL :: form
1466LOGICAL, INTENT(in), OPTIONAL :: force_quote
1467
1468IF (PRESENT(form)) THEN
1469 CALL csv_record_addfield(this, trim(to_char(field, form)), force_quote=force_quote)
1470ELSE
1471 CALL csv_record_addfield(this, t2c(field), force_quote=force_quote)
1472ENDIF
1473
1474END SUBROUTINE csv_record_addfield_double
1475
1476
1480SUBROUTINE csv_record_addfield_double_miss(this, field, force_quote)
1481TYPE(csv_record),INTENT(INOUT) :: this
1482DOUBLE PRECISION,INTENT(IN) :: field
1483LOGICAL, INTENT(in), OPTIONAL :: force_quote
1484
1485CALL csv_record_addfield(this, t2c(field, ''), force_quote=force_quote)
1486
1487END SUBROUTINE csv_record_addfield_double_miss
1488
1489
1495SUBROUTINE csv_record_addfield_csv_record(this, record)
1496TYPE(csv_record),INTENT(INOUT) :: this
1497TYPE(csv_record),INTENT(IN) :: record
1498
1499IF (this%csep /= record%csep .OR. this%cquote /= record%cquote) RETURN ! error
1500CALL checkrealloc(this, record%cursor)
1501IF (this%nfield > 0) CALL add_byte(this, this%csep)
1502
1503this%record(this%cursor+1:this%cursor+record%cursor) = &
1504 record%record(1:record%cursor)
1505this%cursor = this%cursor + record%cursor
1506this%nfield = this%nfield + record%nfield
1507
1508END SUBROUTINE csv_record_addfield_csv_record
1509
1510
1513FUNCTION csv_record_getrecord(this, nfield)
1514TYPE(csv_record),INTENT(IN) :: this
1515INTEGER, INTENT(out), OPTIONAL :: nfield
1516
1517CHARACTER(len=this%cursor) :: csv_record_getrecord
1518
1519csv_record_getrecord = transfer(this%record(1:this%cursor), csv_record_getrecord)
1520IF (present(nfield)) nfield = this%nfield
1521
1522END FUNCTION csv_record_getrecord
1523
1524
1530SUBROUTINE csv_record_getfield_char(this, field, flen, ier)
1531TYPE(csv_record),INTENT(INOUT) :: this
1532CHARACTER(len=*),INTENT(OUT),OPTIONAL :: field
1534INTEGER,INTENT(OUT),OPTIONAL :: flen
1535INTEGER,INTENT(OUT),OPTIONAL :: ier
1536
1537LOGICAL :: inquote, inpre, inpost, firstquote
1538INTEGER :: i, ocursor, ofcursor
1539
1540! check end of record
1541IF (csv_record_end(this)) THEN
1542 IF (PRESENT(field)) field = cmiss
1543 IF (PRESENT(ier))THEN
1544 ier = 2
1545 ELSE
1546 CALL l4f_log(l4f_error, &
1547 'in csv_record_getfield, attempt to read past end of record')
1548 CALL raise_error()
1549 ENDIF
1550 RETURN
1551ENDIF
1552! start decoding
1553IF (PRESENT(field)) field = ''
1554IF (PRESENT(ier)) ier = 0
1555ocursor = 0
1556ofcursor = 0
1557inquote = .false.
1558inpre = .true.
1559inpost = .false.
1560firstquote = .false.
1561
1562DO i = this%cursor+1, SIZE(this%record)
1563 IF (inpre) THEN ! sono nel preludio, butto via gli spazi
1564 IF (is_space_b(this%record(i))) THEN
1565 cycle
1566 ELSE
1567 inpre = .false.
1568 ENDIF
1569 ENDIF
1570
1571 IF (.NOT.inquote) THEN ! fuori da " "
1572 IF (this%record(i) == this%cquote) THEN ! ": inizia " "
1573 inquote = .true.
1574 cycle
1575 ELSE IF (this%record(i) == this%csep) THEN ! ,: fine campo
1576 EXIT
1577 ELSE ! carattere normale, elimina "trailing blanks"
1578 CALL add_char(this%record(i), .true., field)
1579 cycle
1580 ENDIF
1581 ELSE ! dentro " "
1582 IF (.NOT.firstquote) THEN ! il precedente non e` "
1583 IF (this%record(i) == this%cquote) THEN ! ": fine " " oppure ""
1584 firstquote = .true.
1585 cycle
1586 ELSE ! carattere normale
1587 CALL add_char(this%record(i), .false., field)
1588 cycle
1589 ENDIF
1590 ELSE ! il precedente e` "
1591 firstquote = .false.
1592 IF (this%record(i) == this%cquote) THEN ! ": sequenza ""
1593 CALL add_char(this%cquote, .false., field)
1594 cycle
1595 ELSE ! carattere normale: e` terminata " "
1596 inquote = .false.
1597 IF (this%record(i) == this%csep) THEN ! , fine campo
1598 EXIT
1599 ELSE ! carattere normale, elimina "trailing blanks"
1600 CALL add_char(this%record(i), .true., field)
1601 cycle
1602 ENDIF
1603 ENDIF
1604 ENDIF
1605 ENDIF
1606ENDDO
1607
1608this%cursor = min(i, SIZE(this%record) + 1)
1609IF (PRESENT(flen)) flen = ofcursor ! restituisco la lunghezza
1610IF (PRESENT(field)) THEN ! controllo overflow di field
1611 IF (ofcursor > len(field)) THEN
1612 IF (PRESENT(ier)) THEN
1613 ier = 1
1614 ELSE
1615 CALL l4f_log(l4f_warn, &
1616 'in csv_record_getfield, CHARACTER variable too short for field: '// &
1617 t2c(len(field))//'/'//t2c(ocursor))
1618 ENDIF
1619 ENDIF
1620ENDIF
1621
1622CONTAINS
1623
1624SUBROUTINE add_char(char, check_space, field)
1625INTEGER(kind=int_b) :: char
1626LOGICAL,INTENT(IN) :: check_space
1627CHARACTER(len=*),INTENT(OUT),OPTIONAL :: field
1628
1629CHARACTER(len=1) :: dummy ! this prevents a memory leak in TRANSFER()???
1630
1631ocursor = ocursor + 1
1632 IF (PRESENT(field)) THEN
1633 IF (ocursor <= len(field)) THEN
1634 field(ocursor:ocursor) = transfer(char, dummy)
1635 ENDIF
1636ENDIF
1637IF (check_space) THEN
1638 IF (.NOT.is_space_b(char)) ofcursor = ocursor
1639ELSE
1640 ofcursor = ocursor
1641ENDIF
1642
1643END SUBROUTINE add_char
1644
1645END SUBROUTINE csv_record_getfield_char
1646
1647
1653SUBROUTINE csv_record_getfield_int(this, field, ier)
1654TYPE(csv_record),INTENT(INOUT) :: this
1655INTEGER,INTENT(OUT) :: field
1656INTEGER,INTENT(OUT),OPTIONAL :: ier
1657
1658CHARACTER(len=32) :: cfield
1659INTEGER :: lier
1660
1661CALL csv_record_getfield(this, field=cfield, ier=ier)
1662IF (c_e(cfield) .AND. len_trim(cfield) /= 0) THEN
1663 READ(cfield, '(I32)', iostat=lier) field
1664 IF (lier /= 0) THEN
1665 field = imiss
1666 IF (.NOT.PRESENT(ier)) THEN
1667 CALL l4f_log(l4f_error, &
1668 'in csv_record_getfield, invalid integer field: '//trim(cfield))
1669 CALL raise_error()
1670 ELSE
1671 ier = 3 ! conversion error
1672 ENDIF
1673 ENDIF
1674ELSE
1675 field = imiss
1676ENDIF
1677
1678END SUBROUTINE csv_record_getfield_int
1679
1680
1686SUBROUTINE csv_record_getfield_real(this, field, ier)
1687TYPE(csv_record),INTENT(INOUT) :: this
1688REAL,INTENT(OUT) :: field
1689INTEGER,INTENT(OUT),OPTIONAL :: ier
1690
1691CHARACTER(len=32) :: cfield
1692INTEGER :: lier
1693
1694CALL csv_record_getfield(this, field=cfield, ier=ier)
1695IF (c_e(cfield) .AND. len_trim(cfield) /= 0) THEN
1696 READ(cfield, '(F32.0)', iostat=lier) field
1697 IF (lier /= 0) THEN
1698 field = rmiss
1699 IF (.NOT.PRESENT(ier)) THEN
1700 CALL l4f_log(l4f_error, &
1701 'in csv_record_getfield, invalid real field: '//trim(cfield))
1702 CALL raise_error()
1703 ELSE
1704 ier = 3 ! conversion error
1705 ENDIF
1706 ENDIF
1707ELSE
1708 field = rmiss
1709ENDIF
1710
1711END SUBROUTINE csv_record_getfield_real
1712
1713
1719SUBROUTINE csv_record_getfield_double(this, field, ier)
1720TYPE(csv_record),INTENT(INOUT) :: this
1721DOUBLE PRECISION,INTENT(OUT) :: field
1722INTEGER,INTENT(OUT),OPTIONAL :: ier
1723
1724CHARACTER(len=32) :: cfield
1725INTEGER :: lier
1726
1727CALL csv_record_getfield(this, field=cfield, ier=ier)
1728IF (c_e(cfield) .AND. len_trim(cfield) /= 0) THEN
1729 READ(cfield, '(F32.0)', iostat=lier) field
1730 IF (lier /= 0) THEN
1731 field = dmiss
1732 IF (.NOT.PRESENT(ier)) THEN
1733 CALL l4f_log(l4f_error, &
1734 'in csv_record_getfield, invalid double precision field: '//trim(cfield))
1735 CALL raise_error()
1736 ELSE
1737 ier = 3 ! conversion error
1738 ENDIF
1739 ENDIF
1740ELSE
1741 field = dmiss
1742ENDIF
1743
1744END SUBROUTINE csv_record_getfield_double
1745
1746
1749FUNCTION csv_record_end(this)
1750TYPE(csv_record), INTENT(IN) :: this
1751LOGICAL :: csv_record_end
1752
1753csv_record_end = this%cursor > SIZE(this%record)
1754
1755END FUNCTION csv_record_end
1756
1757
1758FUNCTION is_space_c(char) RESULT(is_space)
1759CHARACTER(len=1) :: char
1760LOGICAL :: is_space
1761
1762is_space = (ichar(char) == 32 .OR. ichar(char) == 9) ! improve
1763
1764END FUNCTION is_space_c
1765
1766
1767FUNCTION is_space_b(char) RESULT(is_space)
1768INTEGER(kind=int_b) :: char
1769LOGICAL :: is_space
1770
1771is_space = (char == 32 .OR. char == 9) ! improve
1772
1773END FUNCTION is_space_b
1774
1775
1776END 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:251
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.