SUEWS API Site
Documentation of SUEWS source code
Data Types | Functions/Subroutines | Variables
ctrl_output Module Reference

Data Types

type  varattr
 

Functions/Subroutines

subroutine suews_output (irMax, iv, Gridiv, iyr)
 
subroutine suews_output_txt_grp (iv, irMax, iyr, varListX, Gridiv, outLevel, outFreq_s)
 
subroutine suews_output_init (dataOutX, varList, iyr, Gridiv, outLevel)
 
subroutine formatfile_gen (dataOutX, varList, iyr, Gridiv, outLevel)
 
subroutine suews_output_agg (dataOut_agg, dataOutX, varList, irMax, outFreq_s)
 
subroutine suews_write_txt (dataOutX, varList, iyr, Gridiv, outLevel)
 
subroutine filename_gen (dataOutX, varList, iyr, Gridiv, FileOutX, opt_fmt)
 
subroutine unique (vec, vec_unique)
 
logical function initq_file (FileName)
 
integer function count_lines (filename)
 

Variables

integer n
 
character(len=10), parameter fy = 'i0004,1X'
 
character(len=10), parameter ft = 'i0004,1X'
 
character(len=10), parameter fd = 'f08.4,1X'
 
character(len=10), parameter f94 = 'f09.4,1X'
 
character(len=10), parameter f104 = 'f10.4,1X'
 
character(len=10), parameter f106 = 'f10.6,1X'
 
character(len=10), parameter f146 = 'f14.6,1X'
 
character(len=1), parameter at = 'T'
 
character(len=1), parameter aa = 'A'
 
character(len=1), parameter as = 'S'
 
character(len=1), parameter al = 'L'
 
character(len=3) itext
 
type(varattr), dimension(1200) varlistall
 

Function/Subroutine Documentation

◆ count_lines()

integer function ctrl_output::count_lines ( character(len=*)  filename)

Definition at line 1822 of file suews_ctrl_output.f95.

1823 ! count the number of valid lines in a file
1824 ! invalid line starting with -9
1825
1826 !========================================================================================
1827 IMPLICIT NONE
1828 CHARACTER(len=*) :: filename
1829 INTEGER :: nlines
1830 INTEGER :: io, iv
1831
1832 OPEN (10, file=filename, iostat=io, status='old')
1833
1834 ! if io error found, report iostat and exit
1835 IF (io /= 0) THEN
1836 print *, 'io', io, 'for', filename
1837 stop 'Cannot open file! '
1838 END IF
1839
1840 nlines = 0
1841 DO
1842 READ (10, *, iostat=io) iv
1843 IF (io < 0 .OR. iv == -9) EXIT
1844
1845 nlines = nlines + 1
1846 END DO
1847 CLOSE (10)
1848 nlines = nlines - 1 ! skip header

Referenced by suews_program().

Here is the caller graph for this function:

◆ filename_gen()

subroutine ctrl_output::filename_gen ( real(kind(1d0)), dimension(:, :), intent(in dataOutX,
type(varattr), dimension(:), intent(in varList,
integer, intent(in iyr,
integer, intent(in Gridiv,
character(len=365), intent(out)  FileOutX,
integer, intent(in), optional  opt_fmt 
)

Definition at line 1663 of file suews_ctrl_output.f95.

1664 USE datetime_module
1665
1666 IMPLICIT NONE
1667 REAL(KIND(1D0)), DIMENSION(:, :), INTENT(in) :: dataOutX ! to determine year & output frequency
1668 TYPE(varAttr), DIMENSION(:), INTENT(in) :: varList ! to determine output group
1669 INTEGER, INTENT(in) :: iyr ! to determine year
1670 INTEGER, INTENT(in) :: Gridiv ! to determine grid name as in SiteSelect
1671 INTEGER, INTENT(in), OPTIONAL :: opt_fmt ! to determine if a format file
1672 CHARACTER(len=365), INTENT(out) :: FileOutX ! the output file name
1673
1674 CHARACTER(len=20) :: str_out_min, str_grid, &
1675 str_date, str_year, str_doy, str_grp, str_sfx
1676 INTEGER :: year_int, DOY_int, val_fmt, delta_t_min
1677 TYPE(datetime) :: dt1, dt2
1678 TYPE(timedelta) :: dt_x
1679
1680 ! initialise with a default value
1681 val_fmt = -999
1682
1683 IF (PRESENT(opt_fmt)) val_fmt = opt_fmt
1684
1685 ! PRINT*, varList(:)%header
1686 ! PRINT*, 'dataOutX(1)',dataOutX(1,:)
1687
1688 ! date:
1689 doy_int = int(dataoutx(1, 2))
1690 WRITE (str_doy, '(i3.3)') doy_int
1691
1692! #ifdef nc
1693! ! year for nc use that in dataOutX
1694! year_int = INT(dataOutX(1, 1))
1695! WRITE (str_year, '(i4)') year_int
1696! str_date = '_'//TRIM(ADJUSTL(str_year))
1697! ! add DOY as a specifier
1698! IF (ncMode == 1) str_date = TRIM(ADJUSTL(str_date))//TRIM(ADJUSTL(str_DOY))
1699! #endif
1700
1701 ! year for txt use specified value to avoid conflicts when crossing years
1702 year_int = iyr
1703 WRITE (str_year, '(i4)') year_int
1704 str_date = '_'//trim(adjustl(str_year))
1705
1706 ! output frequency in minute:
1707 IF (varlist(6)%group == 'DailyState') THEN
1708 str_out_min = '' ! ignore this for DailyState
1709 ELSE
1710 ! derive output frequency from output arrays
1711 ! dt_x=
1712 dt1 = datetime(int(dataoutx(1, 1)), 1, 1) + &
1713 timedelta(days=int(dataoutx(1, 2) - 1), &
1714 hours=int(dataoutx(1, 3)), &
1715 minutes=int(dataoutx(1, 4)))
1716
1717 dt2 = datetime(int(dataoutx(2, 1)), 1, 1) + &
1718 timedelta(days=int(dataoutx(2, 2) - 1), &
1719 hours=int(dataoutx(2, 3)), &
1720 minutes=int(dataoutx(2, 4)))
1721
1722 dt_x = dt2 - dt1
1723 delta_t_min = int(dt_x%total_seconds()/60)
1724 WRITE (str_out_min, '(i4)') delta_t_min
1725 str_out_min = '_'//trim(adjustl(str_out_min))
1726 END IF
1727
1728 ! group: output type
1729 str_grp = varlist(6)%group
1730 IF (len(trim(str_grp)) > 0) str_grp = '_'//trim(adjustl(str_grp))
1731
1732 ! grid name:
1733 WRITE (str_grid, '(i10)') grididmatrix(gridiv)
1734! #ifdef nc
1735! IF (ncMode == 1) str_grid = '' ! grid name not needed by nc files
1736! #endif
1737
1738 ! suffix:
1739 str_sfx = '.txt'
1740! #ifdef nc
1741! IF (ncMode == 1) str_sfx = '.nc'
1742! #endif
1743
1744 ! filename: FileOutX
1745 fileoutx = trim(fileoutputpath)// &
1746 trim(filecode)// &
1747 trim(adjustl(str_grid))// &
1748 trim(adjustl(str_date))// &
1749 trim(adjustl(str_grp))// &
1750 trim(adjustl(str_out_min))// &
1751 trim(adjustl(str_sfx))
1752
1753 ! filename: format
1754 IF (val_fmt == 1) THEN
1755 fileoutx = trim(fileoutputpath)// &
1756 trim(filecode)// &
1757 trim(adjustl(str_grp))// &
1758 '_OutputFormat.txt'
1759 END IF
1760

References data_in::filecode, data_in::fileoutputpath, and allocatearray::grididmatrix.

Referenced by formatfile_gen(), suews_output_init(), and suews_write_txt().

Here is the caller graph for this function:

◆ formatfile_gen()

subroutine ctrl_output::formatfile_gen ( real(kind(1d0)), dimension(:, :), intent(in dataOutX,
type(varattr), dimension(:), intent(in varList,
integer, intent(in iyr,
integer, intent(in Gridiv,
integer, intent(in outLevel 
)

Definition at line 1419 of file suews_ctrl_output.f95.

1420 IMPLICIT NONE
1421 REAL(KIND(1D0)), DIMENSION(:, :), INTENT(in) :: dataOutX
1422 TYPE(varAttr), DIMENSION(:), INTENT(in) :: varList
1423 INTEGER, INTENT(in) :: iyr, Gridiv, outLevel
1424
1425 TYPE(varAttr), DIMENSION(:), ALLOCATABLE :: varListSel
1426 INTEGER :: xx, err, fn, i
1427 CHARACTER(len=365) :: FileOutX
1428 CHARACTER(len=100*300) :: str_cat
1429 CHARACTER(len=100) :: str_x = ''
1430 CHARACTER(len=3) :: itextX
1431
1432 ! get filename
1433 CALL filename_gen(dataoutx, varlist, iyr, gridiv, fileoutx, 1)
1434
1435 !select variables to output
1436 xx = count((varlist%level <= outlevel), dim=1)
1437 ALLOCATE (varlistsel(xx), stat=err)
1438 IF (err /= 0) print *, "varListSel: Allocation request denied"
1439 varlistsel = pack(varlist, mask=(varlist%level <= outlevel))
1440
1441 ! create file
1442 fn = 9
1443 OPEN (fn, file=trim(adjustl(fileoutx)), status='unknown')
1444
1445 ! write out format strings
1446 ! column number:
1447 str_cat = ''
1448 DO i = 1, SIZE(varlistsel)
1449 WRITE (itextx, '(i3)') i
1450 IF (i == 1) THEN
1451 str_cat = trim(adjustl(itextx))
1452 ELSE
1453 str_cat = trim(str_cat)//';'//adjustl(itextx)
1454 END IF
1455 END DO
1456 WRITE (fn, '(a)') trim(str_cat)
1457
1458 ! header:
1459 str_cat = ''
1460 DO i = 1, SIZE(varlistsel)
1461 str_x = varlistsel(i)%header
1462 IF (i == 1) THEN
1463 str_cat = trim(adjustl(str_x))
1464 ELSE
1465 str_cat = trim(str_cat)//';'//adjustl(str_x)
1466 END IF
1467 END DO
1468 WRITE (fn, '(a)') trim(str_cat)
1469
1470 ! long name:
1471 str_cat = ''
1472 DO i = 1, SIZE(varlistsel)
1473 str_x = varlistsel(i)%longNm
1474 IF (i == 1) THEN
1475 str_cat = trim(adjustl(str_x))
1476 ELSE
1477 str_cat = trim(str_cat)//';'//adjustl(str_x)
1478 END IF
1479 END DO
1480 WRITE (fn, '(a)') trim(str_cat)
1481
1482 ! unit:
1483 str_cat = ''
1484 DO i = 1, SIZE(varlistsel)
1485 str_x = varlistsel(i)%unit
1486 IF (i == 1) THEN
1487 str_cat = trim(adjustl(str_x))
1488 ELSE
1489 str_cat = trim(str_cat)//';'//adjustl(str_x)
1490 END IF
1491 END DO
1492 WRITE (fn, '(a)') trim(str_cat)
1493
1494 ! format:
1495 str_cat = ''
1496 DO i = 1, SIZE(varlistsel)
1497 str_x = varlistsel(i)%fmt
1498 IF (i == 1) THEN
1499 str_cat = trim(adjustl(str_x))
1500 ELSE
1501 str_cat = trim(str_cat)//';'//adjustl(str_x)
1502 END IF
1503 END DO
1504 WRITE (fn, '(a)') trim(str_cat)
1505
1506 ! aggregation method:
1507 str_cat = ''
1508 DO i = 1, SIZE(varlistsel)
1509 str_x = varlistsel(i)%aggreg
1510 IF (i == 1) THEN
1511 str_cat = trim(adjustl(str_x))
1512 ELSE
1513 str_cat = trim(str_cat)//';'//adjustl(str_x)
1514 END IF
1515 END DO
1516 WRITE (fn, '(a)') trim(str_cat)
1517
1518 ! close file
1519 CLOSE (fn)
1520
1521 ! clean up
1522 IF (ALLOCATED(varlistsel)) DEALLOCATE (varlistsel, stat=err)
1523 IF (err /= 0) print *, "varListSel: Deallocation request denied"
1524

References filename_gen().

Referenced by suews_output_init().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ initq_file()

logical function ctrl_output::initq_file ( character(len=365), intent(in FileName)

Definition at line 1802 of file suews_ctrl_output.f95.

1803 IMPLICIT NONE
1804 CHARACTER(len=365), INTENT(in) :: FileName ! the output file name
1805 LOGICAL :: existQ
1806 CHARACTER(len=1000) :: longstring
1807
1808 INQUIRE (file=trim(filename), exist=existq)
1809 IF (existq) THEN
1810 OPEN (10, file=trim(filename))
1811 READ (10, '(a)') longstring
1812 ! print*, 'longstring: ',longstring
1813 IF (verify(longstring, 'Year') == 0) initq_file = .false.
1814 CLOSE (unit=10)
1815 ELSE
1816 initq_file = .false.
1817 END IF
1818

References initq_file().

Referenced by initq_file().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ suews_output()

subroutine ctrl_output::suews_output ( integer, intent(in irMax,
integer, intent(in iv,
integer, intent(in Gridiv,
integer, intent(in iyr 
)

Definition at line 1160 of file suews_ctrl_output.f95.

1161 IMPLICIT NONE
1162 INTEGER, INTENT(in) :: irMax
1163! #ifdef nc
1164! INTEGER, INTENT(in), OPTIONAL ::iv, Gridiv, iyr
1165! #else
1166 INTEGER, INTENT(in) :: iv, Gridiv, iyr
1167! #endif
1168
1169 INTEGER :: n_group_use, err, outLevel, i
1170 TYPE(varAttr), DIMENSION(:), ALLOCATABLE :: varListX
1171 CHARACTER(len=10) :: groupList0(10)
1172 CHARACTER(len=10), DIMENSION(:), ALLOCATABLE :: grpList
1173 LOGICAL :: groupCond(10)
1174
1175 ! determine outLevel
1176 SELECT CASE (writeoutoption)
1177 CASE (0) !all (not snow-related)
1178 outlevel = 1
1179 CASE (1) !all plus snow-related
1180 outlevel = 2
1181 CASE (2) !minimal output
1182 outlevel = 0
1183 END SELECT
1184
1185 ! determine groups to output
1186 ! TODO: needs to be smarter, automate this filtering
1187 grouplist0(1) = 'SUEWS'
1188 grouplist0(2) = 'BEERS'
1189 grouplist0(3) = 'BL'
1190 grouplist0(4) = 'snow'
1191 grouplist0(5) = 'ESTM'
1192 grouplist0(6) = 'DailyState'
1193 grouplist0(7) = 'RSL'
1194 grouplist0(8) = 'debug'
1195 grouplist0(9) = 'SPARTACUS'
1196 grouplist0(10) = 'ESTMExt'
1197 groupcond = [ &
1198 .true., &
1199 .true., &
1200 cbluse >= 1, &
1201 snowuse >= 1, &
1202 storageheatmethod == 4 .OR. storageheatmethod == 14, &
1203 .true., &
1204 .true., &
1205 .true., &
1206 .true., &
1207 storageheatmethod == 5 &
1208 ]
1209 n_group_use = count(groupcond)
1210
1211 ! PRINT*, grpList0,xx
1212
1213 ALLOCATE (grplist(n_group_use), stat=err)
1214 IF (err /= 0) print *, "grpList: Allocation request denied"
1215
1216 grplist = pack(grouplist0, mask=groupcond)
1217
1218 ! PRINT*, grpList,SIZE(grpList, dim=1)
1219
1220 ! loop over all groups
1221 DO i = 1, SIZE(grplist), 1
1222 !PRINT*, 'i',i
1223 n_group_use = count(varlistall%group == trim(grplist(i)), dim=1)
1224 ! PRINT*, 'number of variables:',xx, 'in group: ',grpList(i)
1225 ! print*, 'all group names: ',varList%group
1226 ALLOCATE (varlistx(5 + n_group_use), stat=err)
1227 IF (err /= 0) print *, "varListX: Allocation request denied"
1228 ! datetime
1229 varlistx(1:5) = varlistall(1:5)
1230 ! variable
1231 varlistx(6:5 + n_group_use) = pack(varlistall, mask=(varlistall%group == trim(grplist(i))))
1232
1233 IF (trim(varlistx(SIZE(varlistx))%group) /= 'DailyState') THEN
1234 ! all output arrays but DailyState
1235 ! all output frequency option:
1236 ! as forcing:
1237 IF (resolutionfilesout == tstep .OR. keeptstepfilesout == 1) THEN
1238 CALL suews_output_txt_grp(iv, irmax, iyr, varlistx, gridiv, outlevel, tstep)
1239 END IF
1240 ! as specified ResolutionFilesOut:
1241 IF (resolutionfilesout /= tstep) THEN
1242 CALL suews_output_txt_grp(iv, irmax, iyr, varlistx, gridiv, outlevel, resolutionfilesout)
1243 END IF
1244 ELSE
1245 ! DailyState array, which does not need aggregation
1246 CALL suews_output_txt_grp(iv, irmax, iyr, varlistx, gridiv, outlevel, tstep)
1247
1248 END IF
1249
1250 IF (ALLOCATED(varlistx)) DEALLOCATE (varlistx, stat=err)
1251 IF (err /= 0) print *, "varListX: Deallocation request denied"
1252 ! PRINT*, 'i',i,'end'
1253
1254 END DO

References data_in::cbluse, data_in::keeptstepfilesout, data_in::resolutionfilesout, data_in::snowuse, data_in::storageheatmethod, suews_output_txt_grp(), sues_data::tstep, varlistall, and data_in::writeoutoption.

Referenced by suews_program().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ suews_output_agg()

subroutine ctrl_output::suews_output_agg ( real(kind(1d0)), dimension(:, :), intent(out), allocatable  dataOut_agg,
real(kind(1d0)), dimension(:, :), intent(in dataOutX,
type(varattr), dimension(:), intent(in varList,
integer, intent(in irMax,
integer, intent(in outFreq_s 
)

Definition at line 1528 of file suews_ctrl_output.f95.

1529 IMPLICIT NONE
1530 REAL(KIND(1D0)), DIMENSION(:, :), INTENT(in) :: dataOutX
1531 TYPE(varAttr), DIMENSION(:), INTENT(in) :: varList
1532 INTEGER, INTENT(in) :: irMax, outFreq_s
1533 REAL(KIND(1D0)), DIMENSION(:, :), ALLOCATABLE, INTENT(out) :: dataOut_agg
1534
1535 INTEGER :: nlinesOut, i, j, x
1536 REAL(KIND(1D0)) :: dataOut_aggX(1:SIZE(varList))
1537 REAL(KIND(1D0)), DIMENSION(:, :), ALLOCATABLE :: dataOut_agg0
1538 nlinesout = int(nsh/(60.*60/outfreq_s))
1539 ! nGrid=SIZE(dataOutX, dim=3)
1540
1541 ALLOCATE (dataout_agg(int(irmax/nlinesout), SIZE(varlist)))
1542 ALLOCATE (dataout_agg0(nlinesout, SIZE(varlist)))
1543
1544 DO i = nlinesout, irmax, nlinesout
1545 x = i/nlinesout
1546 dataout_agg0 = dataoutx(i - nlinesout + 1:i, :)
1547 DO j = 1, SIZE(varlist), 1
1548 IF (diagnose == 1) THEN
1549 print *, "aggregating variable ", j, " of ", varlist(j)%header, 'in group ', varlist(j)%group
1550 END IF
1551 ! aggregating different variables
1552 SELECT CASE (varlist(j)%aggreg)
1553 CASE (at) !time columns, aT
1554 dataout_aggx(j) = dataout_agg0(nlinesout, j)
1555 CASE (aa) !average, aA
1556 dataout_aggx(j) = sum(dataout_agg0(:, j))/nlinesout
1557 CASE (as) !sum, aS
1558 dataout_aggx(j) = sum(dataout_agg0(:, j))
1559 CASE (al) !last value, aL
1560 dataout_aggx(j) = dataout_agg0(nlinesout, j)
1561 END SELECT
1562
1563 IF (diagnose == 1 .AND. i == irmax) THEN
1564 ! IF ( i==irMax ) THEN
1565 print *, 'raw data of ', j, ':'
1566 print *, dataout_agg0(:, j)
1567 print *, 'aggregated with method: ', varlist(j)%aggreg
1568 print *, dataout_aggx(j)
1569 print *, ''
1570 END IF
1571 END DO
1572 dataout_agg(x, :) = dataout_aggx
1573 END DO
1574

References aa, al, as, at, data_in::diagnose, and sues_data::nsh.

Referenced by suews_output_txt_grp().

Here is the caller graph for this function:

◆ suews_output_init()

subroutine ctrl_output::suews_output_init ( real(kind(1d0)), dimension(:, :), intent(in dataOutX,
type(varattr), dimension(:), intent(in varList,
integer, intent(in iyr,
integer, intent(in Gridiv,
integer, intent(in outLevel 
)

Definition at line 1355 of file suews_ctrl_output.f95.

1356 IMPLICIT NONE
1357 REAL(KIND(1D0)), DIMENSION(:, :), INTENT(in) :: dataOutX
1358 TYPE(varAttr), DIMENSION(:), INTENT(in) :: varList
1359 INTEGER, INTENT(in) :: iyr, Gridiv, outLevel
1360
1361 TYPE(varAttr), DIMENSION(:), ALLOCATABLE :: varListSel
1362 INTEGER :: xx, err, fn, i, nargs
1363 CHARACTER(len=365) :: FileOutX
1364 CHARACTER(len=3) :: itextX
1365 CHARACTER(len=6) :: args(5)
1366 CHARACTER(len=16*SIZE(varList)) :: FormatOut
1367 CHARACTER(len=16) :: formatX
1368 CHARACTER(len=16), DIMENSION(:), ALLOCATABLE :: headerOut
1369
1370 ! select variables to output
1371 xx = count((varlist%level <= outlevel), dim=1)
1372 WRITE (itextx, '(i3)') xx
1373 ALLOCATE (varlistsel(xx), stat=err)
1374 IF (err /= 0) print *, "varListSel: Allocation request denied"
1375 varlistsel = pack(varlist, mask=(varlist%level <= outlevel))
1376
1377 ! generate file name
1378 CALL filename_gen(dataoutx, varlist, iyr, gridiv, fileoutx)
1379
1380 ! store right-aligned headers
1381 ALLOCATE (headerout(xx), stat=err)
1382 IF (err /= 0) print *, "headerOut: Allocation request denied"
1383
1384 ! create format string:
1385 DO i = 1, SIZE(varlistsel)
1386 CALL parse(varlistsel(i)%fmt, 'if.,', args, nargs)
1387 formatx = adjustl('(a'//trim(args(2))//',1x)')
1388 ! adjust headers to right-aligned
1389 WRITE (headerout(i), formatx) adjustr(trim(adjustl(varlistsel(i)%header)))
1390 IF (i == 1) THEN
1391 formatout = adjustl(trim(formatx))
1392 ELSE
1393 formatout = trim(formatout)//' '//adjustl(trim(formatx))
1394 END IF
1395 END DO
1396 formatout = '('//trim(adjustl(formatout))//')'
1397
1398 ! create file
1399 fn = 9
1400 OPEN (fn, file=trim(adjustl(fileoutx)), status='unknown')
1401 ! PRINT*, 'FileOutX in SUEWS_Output_Init: ',FileOutX
1402
1403 ! write out headers
1404 WRITE (fn, formatout) headerout
1405 CLOSE (fn)
1406
1407 ! write out format file
1408 CALL formatfile_gen(dataoutx, varlist, iyr, gridiv, outlevel)
1409
1410 ! clean up
1411 IF (ALLOCATED(varlistsel)) DEALLOCATE (varlistsel, stat=err)
1412 IF (err /= 0) print *, "varListSel: Deallocation request denied"
1413 IF (ALLOCATED(headerout)) DEALLOCATE (headerout, stat=err)
1414 IF (err /= 0) print *, "headerOut: Deallocation request denied"
1415

References filename_gen(), formatfile_gen(), and strings::parse().

Referenced by suews_output_txt_grp().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ suews_output_txt_grp()

subroutine ctrl_output::suews_output_txt_grp ( integer, intent(in iv,
integer, intent(in irMax,
integer, intent(in iyr,
type(varattr), dimension(:), intent(in varListX,
integer, intent(in Gridiv,
integer, intent(in outLevel,
integer, intent(in outFreq_s 
)

Definition at line 1258 of file suews_ctrl_output.f95.

1259 IMPLICIT NONE
1260
1261 TYPE(varAttr), DIMENSION(:), INTENT(in) :: varListX
1262 INTEGER, INTENT(in) :: iv, irMax, iyr, Gridiv, outLevel, outFreq_s
1263
1264 INTEGER :: err
1265 INTEGER :: n_var
1266
1267 INTEGER, DIMENSION(:), ALLOCATABLE :: id_seq ! id sequence as in the dataOutX/dataOutX_agg
1268 REAL(KIND(1D0)), DIMENSION(:, :), ALLOCATABLE :: dataOutX
1269 REAL(KIND(1D0)), DIMENSION(:, :), ALLOCATABLE :: dataOutX_agg
1270
1271 ! number of varialbes for output
1272 n_var = SIZE(varlistx)
1273
1274 IF (.NOT. ALLOCATED(dataoutx)) THEN
1275 ALLOCATE (dataoutx(irmax, n_var), stat=err)
1276 IF (err /= 0) print *, "dataOutX: Allocation request denied"
1277 END IF
1278
1279 ! determine dataOutX array according to variable group
1280 SELECT CASE (trim(varlistx(n_var)%group))
1281 CASE ('SUEWS') !default
1282 dataoutx = dataoutsuews(1:irmax, 1:n_var, gridiv)
1283
1284 CASE ('BEERS') !SOLWEIG
1285 dataoutx = dataoutbeers(1:irmax, 1:n_var, gridiv)
1286 ! dataOutX = dataOutSOLWEIG(1:irMax, 1:n_var, Gridiv)
1287
1288 CASE ('BL') !BL
1289 dataoutx = dataoutbl(1:irmax, 1:n_var, gridiv)
1290
1291 CASE ('snow') !snow
1292 dataoutx = dataoutsnow(1:irmax, 1:n_var, gridiv)
1293
1294 CASE ('ESTM') !ESTM
1295 dataoutx = dataoutestm(1:irmax, 1:n_var, gridiv)
1296
1297 CASE ('RSL') !RSL
1298 dataoutx = dataoutrsl(1:irmax, 1:n_var, gridiv)
1299
1300 CASE ('debug') !debug
1301 dataoutx = dataoutdebug(1:irmax, 1:n_var, gridiv)
1302
1303 CASE ('SPARTACUS') !SPARTACUS
1304 dataoutx = dataoutspartacus(1:irmax, 1:n_var, gridiv)
1305
1306 CASE ('ESTMExt') !ESTMExt
1307 dataoutx = dataoutestmext(1:irmax, 1:n_var, gridiv)
1308
1309 CASE ('DailyState') !DailyState
1310 ! get correct day index
1311 CALL unique(int(pack(dataoutsuews(1:irmax, 2, gridiv), &
1312 mask=(dataoutsuews(1:irmax, 3, gridiv) == 23 &
1313 .AND. dataoutsuews(1:irmax, 4, gridiv) == (nsh - 1.)/nsh*60))), &
1314 id_seq)
1315
1316 IF (ALLOCATED(dataoutx)) THEN
1317 DEALLOCATE (dataoutx)
1318 IF (err /= 0) print *, "dataOutX: Deallocation request denied"
1319 END IF
1320
1321 IF (.NOT. ALLOCATED(dataoutx)) THEN
1322 ALLOCATE (dataoutx(SIZE(id_seq), n_var), stat=err)
1323 IF (err /= 0) print *, "dataOutX: Allocation request denied"
1324 END IF
1325
1326 dataoutx = dataoutdailystate(id_seq, 1:n_var, gridiv)
1327 ! print*, id_seq
1328 ! print*, dataOutDailyState(id_seq,1:SIZE(varListX),Gridiv)
1329 ! print*, 1/(nsh-nsh)
1330 END SELECT
1331
1332 ! aggregation:
1333 ! aggregation is done for every group but 'DailyState'
1334 IF (trim(varlistx(SIZE(varlistx))%group) /= 'DailyState') THEN
1335
1336 CALL suews_output_agg(dataoutx_agg, dataoutx, varlistx, irmax, outfreq_s)
1337 ELSE
1338 IF (.NOT. ALLOCATED(dataoutx_agg)) THEN
1339 ALLOCATE (dataoutx_agg(SIZE(dataoutx, dim=1), SIZE(varlistx)), stat=err)
1340 IF (err /= 0) print *, ": Allocation request denied"
1341 END IF
1342 dataoutx_agg = dataoutx
1343 END IF
1344
1345 ! output:
1346 ! initialise file when processing first metblock
1347 IF (iv == 1) CALL suews_output_init(dataoutx_agg, varlistx, iyr, gridiv, outlevel)
1348
1349 ! append the aggregated data to the specific txt file
1350 CALL suews_write_txt(dataoutx_agg, varlistx, iyr, gridiv, outlevel)
1351

References allocatearray::dataoutbeers, allocatearray::dataoutbl, allocatearray::dataoutdailystate, allocatearray::dataoutdebug, allocatearray::dataoutestm, allocatearray::dataoutestmext, allocatearray::dataoutrsl, allocatearray::dataoutsnow, allocatearray::dataoutspartacus, allocatearray::dataoutsuews, sues_data::nsh, suews_output_agg(), suews_output_init(), suews_write_txt(), and unique().

Referenced by suews_output().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ suews_write_txt()

subroutine ctrl_output::suews_write_txt ( real(kind(1d0)), dimension(:, :), intent(in dataOutX,
type(varattr), dimension(:), intent(in varList,
integer, intent(in iyr,
integer, intent(in Gridiv,
integer, intent(in outLevel 
)

Definition at line 1578 of file suews_ctrl_output.f95.

1579 IMPLICIT NONE
1580 REAL(KIND(1D0)), DIMENSION(:, :), INTENT(in) :: dataOutX
1581 TYPE(varAttr), DIMENSION(:), INTENT(in) :: varList
1582 INTEGER, INTENT(in) :: iyr, Gridiv, outLevel
1583
1584 REAL(KIND(1D0)), DIMENSION(:, :), ALLOCATABLE :: dataOutSel
1585 TYPE(varAttr), DIMENSION(:), ALLOCATABLE :: varListSel
1586 CHARACTER(len=365) :: FileOutX
1587 INTEGER :: fn, i, xx, err
1588 INTEGER :: sizeVarListSel, sizedataOutX
1589 CHARACTER(len=12*SIZE(varList)) :: FormatOut
1590 ! LOGICAL :: initQ_file
1591 formatout = ''
1592
1593 IF (diagnose == 1) WRITE (*, *) 'Writting data of group: ', varlist(SIZE(varlist))%group
1594
1595 !select variables to output
1596 sizevarlistsel = count((varlist%level <= outlevel), dim=1)
1597 ALLOCATE (varlistsel(sizevarlistsel), stat=err)
1598 IF (err /= 0) print *, "varListSel: Allocation request denied"
1599 varlistsel = pack(varlist, mask=(varlist%level <= outlevel))
1600
1601 ! copy data accordingly
1602 sizedataoutx = SIZE(dataoutx, dim=1)
1603 ALLOCATE (dataoutsel(sizedataoutx, sizevarlistsel), stat=err)
1604 IF (err /= 0) print *, "dataOutSel: Allocation request denied"
1605 ! print*, SIZE(varList%level),PACK((/(i,i=1,SIZE(varList%level))/), varList%level <= outLevel)
1606 ! print*, irMax,shape(dataOutX)
1607 dataoutsel = dataoutx(:, pack((/(i, i=1, SIZE(varlist%level))/), varlist%level <= outlevel))
1608 ! do i = 1, 5
1609 ! print*, 'first several lines of dataOutX:', i, dataOutX(i,:)
1610
1611 ! end do
1612
1613 ! create format string:
1614 DO i = 1, sizevarlistsel
1615 ! PRINT*,''
1616 ! PRINT*,i
1617 ! PRINT*, LEN_TRIM(FormatOut),TRIM(FormatOut)
1618 ! PRINT*, LEN_TRIM(TRIM(FormatOut)//','),TRIM(FormatOut)//','
1619 IF (i == 1) THEN
1620 ! FormatOut=ADJUSTL(varListSel(i)%fmt)
1621 formatout = varlistsel(i)%fmt
1622 ELSE
1623
1624 ! FormatOut=TRIM(FormatOut)//','//ADJUSTL(varListSel(i)%fmt)
1625 formatout = trim(formatout)//','//trim(varlistsel(i)%fmt)
1626 END IF
1627 ! PRINT*,''
1628 ! PRINT*,i
1629 ! PRINT*, 'FormatOut',FormatOut
1630 END DO
1631 formatout = '('//trim(adjustl(formatout))//')'
1632
1633 ! get filename
1634 CALL filename_gen(dataoutsel, varlistsel, iyr, gridiv, fileoutx)
1635 ! PRINT*, 'FileOutX in SUEWS_Write_txt: ',FileOutX
1636
1637 ! test if FileOutX has been initialised
1638 ! IF ( .NOT. initQ_file(FileOutX) ) THEN
1639 ! CALL SUEWS_Output_Init(dataOutSel,varListSel,Gridiv,outLevel)
1640 ! END IF
1641
1642 ! write out data
1643 fn = 50
1644 OPEN (fn, file=trim(fileoutx), position='append') !,err=112)
1645 DO i = 1, sizedataoutx
1646 ! PRINT*, 'Writting line',i
1647 ! PRINT*, 'FormatOut in writing',FormatOut
1648 ! PRINT*, dataOutSel(i,1:sizeVarListSel)
1649 WRITE (fn, formatout) &
1650 (int(dataoutsel(i, xx)), xx=1, 4), &
1651 (dataoutsel(i, xx), xx=5, sizevarlistsel)
1652 END DO
1653 CLOSE (fn)
1654
1655 IF (ALLOCATED(varlistsel)) DEALLOCATE (varlistsel, stat=err)
1656 IF (err /= 0) print *, "varListSel: Deallocation request denied"
1657
1658 IF (ALLOCATED(dataoutsel)) DEALLOCATE (dataoutsel, stat=err)
1659 IF (err /= 0) print *, "dataOutSel: Deallocation request denied"
1660

References data_in::diagnose, and filename_gen().

Referenced by suews_output_txt_grp().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ unique()

subroutine ctrl_output::unique ( integer, dimension(:), intent(in vec,
integer, dimension(:), intent(out), allocatable  vec_unique 
)

Definition at line 1763 of file suews_ctrl_output.f95.

1764 ! Return only the unique values from vec.
1765
1766 IMPLICIT NONE
1767
1768 INTEGER, DIMENSION(:), INTENT(in) :: vec
1769 INTEGER, DIMENSION(:), ALLOCATABLE, INTENT(out) :: vec_unique
1770
1771 INTEGER :: i, num
1772 LOGICAL, DIMENSION(SIZE(vec)) :: mask
1773
1774 mask = .false.
1775
1776 DO i = 1, SIZE(vec)
1777
1778 !count the number of occurrences of this element:
1779 num = count(vec(i) == vec)
1780
1781 IF (num == 1) THEN
1782 !there is only one, flag it:
1783 mask(i) = .true.
1784 ELSE
1785 !flag this value only if it hasn't already been flagged:
1786 IF (.NOT. any(vec(i) == vec .AND. mask)) mask(i) = .true.
1787 END IF
1788
1789 END DO
1790
1791 !return only flagged elements:
1792 ALLOCATE (vec_unique(count(mask)))
1793 vec_unique = pack(vec, mask)
1794
1795 !if you also need it sorted, then do so.
1796 ! For example, with slatec routine:
1797 !call ISORT (vec_unique, [0], size(vec_unique), 1)
1798

Referenced by suews_output_txt_grp().

Here is the caller graph for this function:

Variable Documentation

◆ aa

character(len=1), parameter ctrl_output::aa = 'A'

Definition at line 48 of file suews_ctrl_output.f95.

Referenced by suews_output_agg().

◆ al

character(len=1), parameter ctrl_output::al = 'L'

Definition at line 48 of file suews_ctrl_output.f95.

Referenced by suews_output_agg().

◆ as

character(len=1), parameter ctrl_output::as = 'S'

Definition at line 48 of file suews_ctrl_output.f95.

Referenced by suews_output_agg().

◆ at

character(len=1), parameter ctrl_output::at = 'T'

Definition at line 48 of file suews_ctrl_output.f95.

48 CHARACTER(len=1), PARAMETER :: & ! Define aggregation methods here
49 aT = 'T', & !time columns
50 aa = 'A', & !average
51 as = 'S', & !sum
52 al = 'L' !last value

Referenced by suews_output_agg().

◆ f104

character(len=10), parameter ctrl_output::f104 = 'f10.4,1X'

Definition at line 39 of file suews_ctrl_output.f95.

◆ f106

character(len=10), parameter ctrl_output::f106 = 'f10.6,1X'

Definition at line 39 of file suews_ctrl_output.f95.

◆ f146

character(len=10), parameter ctrl_output::f146 = 'f14.6,1X'

Definition at line 39 of file suews_ctrl_output.f95.

◆ f94

character(len=10), parameter ctrl_output::f94 = 'f09.4,1X'

Definition at line 39 of file suews_ctrl_output.f95.

◆ fd

character(len=10), parameter ctrl_output::fd = 'f08.4,1X'

Definition at line 39 of file suews_ctrl_output.f95.

◆ ft

character(len=10), parameter ctrl_output::ft = 'i0004,1X'

Definition at line 39 of file suews_ctrl_output.f95.

◆ fy

character(len=10), parameter ctrl_output::fy = 'i0004,1X'

Definition at line 39 of file suews_ctrl_output.f95.

39 CHARACTER(len=10), PARAMETER :: & !Define useful formats here
40 fy = 'i0004,1X', & !4 digit integer for year
41 ft = 'i0004,1X', & !3 digit integer for id, it, imin
42 fd = 'f08.4,1X', & !3 digits + 4 dp for dectime
43 f94 = 'f09.4,1X', & !standard output format: 4 dp + 4 digits
44 f104 = 'f10.4,1X', & !standard output format: 4 dp + 5 digits
45 f106 = 'f10.6,1X', & !standard output format: 6 dp + 3 digits
46 f146 = 'f14.6,1X' !standard output format: 6 dp + 7 digits

◆ itext

character(len=3) ctrl_output::itext

Definition at line 54 of file suews_ctrl_output.f95.

54 CHARACTER(len=3) :: itext

◆ n

integer ctrl_output::n

Definition at line 37 of file suews_ctrl_output.f95.

37 INTEGER :: n

◆ varlistall

type(varattr), dimension(1200) ctrl_output::varlistall

Definition at line 68 of file suews_ctrl_output.f95.

68 TYPE(varAttr) :: varListAll(1200)

Referenced by suews_driver::output_name_n(), suews_driver::output_size(), and suews_output().