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 1834 of file suews_ctrl_output.f95.

      ! count the number of valid lines in a file
      ! invalid line starting with -9
 
      !========================================================================================
      IMPLICIT NONE
      CHARACTER(len=*) :: filename
      INTEGER :: nlines
      INTEGER :: io, iv
 
      OPEN (10, file=filename, iostat=io, status='old')
 
      ! if io error found, report iostat and exit
      IF (io /= 0) THEN
         print *, 'io', io, 'for', filename
         stop 'Cannot open file! '
      END IF
 
      nlines = 0
      DO
         READ (10, *, iostat=io) iv
         IF (io < 0 .OR. iv == -9) EXIT
 
         nlines = nlines + 1
      END DO
      CLOSE (10)
      nlines = nlines - 1 ! skip header

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 1675 of file suews_ctrl_output.f95.

      USE datetime_module
 
      IMPLICIT NONE
      REAL(KIND(1D0)), DIMENSION(:, :), INTENT(in) :: dataOutX ! to determine year & output frequency
      TYPE(varAttr), DIMENSION(:), INTENT(in) :: varList ! to determine output group
      INTEGER, INTENT(in) :: iyr ! to determine year
      INTEGER, INTENT(in) :: Gridiv ! to determine grid name as in SiteSelect
      INTEGER, INTENT(in), OPTIONAL :: opt_fmt ! to determine if a format file
      CHARACTER(len=365), INTENT(out) :: FileOutX ! the output file name
 
      CHARACTER(len=20) :: str_out_min, str_grid, &
                           str_date, str_year, str_doy, str_grp, str_sfx
      INTEGER :: year_int, DOY_int, val_fmt, delta_t_min
      TYPE(datetime) :: dt1, dt2
      TYPE(timedelta) :: dt_x
 
      ! initialise with a default value
      val_fmt = -999
 
      IF (PRESENT(opt_fmt)) val_fmt = opt_fmt
 
      ! PRINT*, varList(:)%header
      ! PRINT*, 'dataOutX(1)',dataOutX(1,:)
 
      ! date:
      doy_int = int(dataoutx(1, 2))
      WRITE (str_doy, '(i3.3)') doy_int
 
! #ifdef nc
!       ! year for nc use that in dataOutX
!       year_int = INT(dataOutX(1, 1))
!       WRITE (str_year, '(i4)') year_int
!       str_date = '_'//TRIM(ADJUSTL(str_year))
!       ! add DOY as a specifier
!       IF (ncMode == 1) str_date = TRIM(ADJUSTL(str_date))//TRIM(ADJUSTL(str_DOY))
! #endif
 
      ! year for txt use specified value to avoid conflicts when crossing years
      year_int = iyr
      WRITE (str_year, '(i4)') year_int
      str_date = '_'//trim(adjustl(str_year))
 
      ! output frequency in minute:
      IF (varlist(6)%group == 'DailyState') THEN
         str_out_min = '' ! ignore this for DailyState
      ELSE
         ! derive output frequency from output arrays
         ! dt_x=
         dt1 = datetime(int(dataoutx(1, 1)), 1, 1) + &
               timedelta(days=int(dataoutx(1, 2) - 1), &
                         hours=int(dataoutx(1, 3)), &
                         minutes=int(dataoutx(1, 4)))
 
         dt2 = datetime(int(dataoutx(2, 1)), 1, 1) + &
               timedelta(days=int(dataoutx(2, 2) - 1), &
                         hours=int(dataoutx(2, 3)), &
                         minutes=int(dataoutx(2, 4)))
 
         dt_x = dt2 - dt1
         delta_t_min = int(dt_x%total_seconds()/60)
         WRITE (str_out_min, '(i4)') delta_t_min
         str_out_min = '_'//trim(adjustl(str_out_min))
      END IF
 
      ! group: output type
      str_grp = varlist(6)%group
      IF (len(trim(str_grp)) > 0) str_grp = '_'//trim(adjustl(str_grp))
 
      ! grid name:
      WRITE (str_grid, '(i10)') grididmatrix(gridiv)
! #ifdef nc
!       IF (ncMode == 1) str_grid = '' ! grid name not needed by nc files
! #endif
 
      ! suffix:
      str_sfx = '.txt'
! #ifdef nc
!       IF (ncMode == 1) str_sfx = '.nc'
! #endif
 
      ! filename: FileOutX
      fileoutx = trim(fileoutputpath)// &
                 trim(filecode)// &
                 trim(adjustl(str_grid))// &
                 trim(adjustl(str_date))// &
                 trim(adjustl(str_grp))// &
                 trim(adjustl(str_out_min))// &
                 trim(adjustl(str_sfx))
 
      ! filename: format
      IF (val_fmt == 1) THEN
         fileoutx = trim(fileoutputpath)// &
                    trim(filecode)// &
                    trim(adjustl(str_grp))// &
                    '_OutputFormat.txt'
      END IF
 

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 1431 of file suews_ctrl_output.f95.

      IMPLICIT NONE
      REAL(KIND(1D0)), DIMENSION(:, :), INTENT(in) :: dataOutX
      TYPE(varAttr), DIMENSION(:), INTENT(in) :: varList
      INTEGER, INTENT(in) :: iyr, Gridiv, outLevel
 
      TYPE(varAttr), DIMENSION(:), ALLOCATABLE :: varListSel
      INTEGER :: xx, err, fn, i
      CHARACTER(len=365) :: FileOutX
      CHARACTER(len=100*300) :: str_cat
      CHARACTER(len=100) :: str_x = ''
      CHARACTER(len=3) :: itextX
 
      ! get filename
      CALL filename_gen(dataoutx, varlist, iyr, gridiv, fileoutx, 1)
 
      !select variables to output
      xx = count((varlist%level <= outlevel), dim=1)
      ALLOCATE (varlistsel(xx), stat=err)
      IF (err /= 0) print *, "varListSel: Allocation request denied"
      varlistsel = pack(varlist, mask=(varlist%level <= outlevel))
 
      ! create file
      fn = 9
      OPEN (fn, file=trim(adjustl(fileoutx)), status='unknown')
 
      ! write out format strings
      ! column number:
      str_cat = ''
      DO i = 1, SIZE(varlistsel)
         WRITE (itextx, '(i3)') i
         IF (i == 1) THEN
            str_cat = trim(adjustl(itextx))
         ELSE
            str_cat = trim(str_cat)//';'//adjustl(itextx)
         END IF
      END DO
      WRITE (fn, '(a)') trim(str_cat)
 
      ! header:
      str_cat = ''
      DO i = 1, SIZE(varlistsel)
         str_x = varlistsel(i)%header
         IF (i == 1) THEN
            str_cat = trim(adjustl(str_x))
         ELSE
            str_cat = trim(str_cat)//';'//adjustl(str_x)
         END IF
      END DO
      WRITE (fn, '(a)') trim(str_cat)
 
      ! long name:
      str_cat = ''
      DO i = 1, SIZE(varlistsel)
         str_x = varlistsel(i)%longNm
         IF (i == 1) THEN
            str_cat = trim(adjustl(str_x))
         ELSE
            str_cat = trim(str_cat)//';'//adjustl(str_x)
         END IF
      END DO
      WRITE (fn, '(a)') trim(str_cat)
 
      ! unit:
      str_cat = ''
      DO i = 1, SIZE(varlistsel)
         str_x = varlistsel(i)%unit
         IF (i == 1) THEN
            str_cat = trim(adjustl(str_x))
         ELSE
            str_cat = trim(str_cat)//';'//adjustl(str_x)
         END IF
      END DO
      WRITE (fn, '(a)') trim(str_cat)
 
      ! format:
      str_cat = ''
      DO i = 1, SIZE(varlistsel)
         str_x = varlistsel(i)%fmt
         IF (i == 1) THEN
            str_cat = trim(adjustl(str_x))
         ELSE
            str_cat = trim(str_cat)//';'//adjustl(str_x)
         END IF
      END DO
      WRITE (fn, '(a)') trim(str_cat)
 
      ! aggregation method:
      str_cat = ''
      DO i = 1, SIZE(varlistsel)
         str_x = varlistsel(i)%aggreg
         IF (i == 1) THEN
            str_cat = trim(adjustl(str_x))
         ELSE
            str_cat = trim(str_cat)//';'//adjustl(str_x)
         END IF
      END DO
      WRITE (fn, '(a)') trim(str_cat)
 
      ! close file
      CLOSE (fn)
 
      ! clean up
      IF (ALLOCATED(varlistsel)) DEALLOCATE (varlistsel, stat=err)
      IF (err /= 0) print *, "varListSel: Deallocation request denied"
 

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 1814 of file suews_ctrl_output.f95.

      IMPLICIT NONE
      CHARACTER(len=365), INTENT(in) :: FileName ! the output file name
      LOGICAL :: existQ
      CHARACTER(len=1000) :: longstring
 
      INQUIRE (file=trim(filename), exist=existq)
      IF (existq) THEN
         OPEN (10, file=trim(filename))
         READ (10, '(a)') longstring
         ! print*, 'longstring: ',longstring
         IF (verify(longstring, 'Year') == 0) initq_file = .false.
         CLOSE (unit=10)
      ELSE
         initq_file = .false.
      END IF
 

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 1172 of file suews_ctrl_output.f95.

      IMPLICIT NONE
      INTEGER, INTENT(in) :: irMax
! #ifdef nc
!       INTEGER, INTENT(in), OPTIONAL ::iv, Gridiv, iyr
! #else
      INTEGER, INTENT(in) :: iv, Gridiv, iyr
! #endif
 
      INTEGER :: n_group_use, err, outLevel, i
      TYPE(varAttr), DIMENSION(:), ALLOCATABLE :: varListX
      CHARACTER(len=10) :: groupList0(10)
      CHARACTER(len=10), DIMENSION(:), ALLOCATABLE :: grpList
      LOGICAL :: groupCond(10)
 
      ! determine outLevel
      SELECT CASE (writeoutoption)
      CASE (0) !all (not snow-related)
         outlevel = 1
      CASE (1) !all plus snow-related
         outlevel = 2
      CASE (2) !minimal output
         outlevel = 0
      END SELECT
 
      ! determine groups to output
      ! TODO: needs to be smarter, automate this filtering
      grouplist0(1) = 'SUEWS'
      grouplist0(2) = 'BEERS'
      grouplist0(3) = 'BL'
      grouplist0(4) = 'snow'
      grouplist0(5) = 'ESTM'
      grouplist0(6) = 'DailyState'
      grouplist0(7) = 'RSL'
      grouplist0(8) = 'debug'
      grouplist0(9) = 'SPARTACUS'
      grouplist0(10) = 'EHC'
      groupcond = [ &
                  .true., &
                  .true., &
                  cbluse >= 1, &
                  snowuse >= 1, &
                  storageheatmethod == 4 .OR. storageheatmethod == 14, &
                  .true., &
                  .true., &
                  .true., &
                  .true., &
                  storageheatmethod == 5 &
                  ]
      n_group_use = count(groupcond)
 
      ! PRINT*, grpList0,xx
 
      ALLOCATE (grplist(n_group_use), stat=err)
      IF (err /= 0) print *, "grpList: Allocation request denied"
 
      grplist = pack(grouplist0, mask=groupcond)
 
      ! PRINT*, grpList,SIZE(grpList, dim=1)
 
      ! loop over all groups
      DO i = 1, SIZE(grplist), 1
         !PRINT*, 'i',i
         n_group_use = count(varlistall%group == trim(grplist(i)), dim=1)
         !  PRINT*, 'number of variables:',xx, 'in group: ',grpList(i)
         !  print*, 'all group names: ',varList%group
         ALLOCATE (varlistx(5 + n_group_use), stat=err)
         IF (err /= 0) print *, "varListX: Allocation request denied"
         ! datetime
         varlistx(1:5) = varlistall(1:5)
         ! variable
         varlistx(6:5 + n_group_use) = pack(varlistall, mask=(varlistall%group == trim(grplist(i))))
 
         IF (trim(varlistx(SIZE(varlistx))%group) /= 'DailyState') THEN
            ! all output arrays but DailyState
            ! all output frequency option:
            ! as forcing:
            IF (resolutionfilesout == tstep .OR. keeptstepfilesout == 1) THEN
               CALL suews_output_txt_grp(iv, irmax, iyr, varlistx, gridiv, outlevel, tstep)
            END IF
            !  as specified ResolutionFilesOut:
            IF (resolutionfilesout /= tstep) THEN
               CALL suews_output_txt_grp(iv, irmax, iyr, varlistx, gridiv, outlevel, resolutionfilesout)
            END IF
         ELSE
            !  DailyState array, which does not need aggregation
            CALL suews_output_txt_grp(iv, irmax, iyr, varlistx, gridiv, outlevel, tstep)
 
         END IF
 
         IF (ALLOCATED(varlistx)) DEALLOCATE (varlistx, stat=err)
         IF (err /= 0) print *, "varListX: Deallocation request denied"
         !  PRINT*, 'i',i,'end'
 
      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.

Here is the call 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 1540 of file suews_ctrl_output.f95.

      IMPLICIT NONE
      REAL(KIND(1D0)), DIMENSION(:, :), INTENT(in) :: dataOutX
      TYPE(varAttr), DIMENSION(:), INTENT(in) :: varList
      INTEGER, INTENT(in) :: irMax, outFreq_s
      REAL(KIND(1D0)), DIMENSION(:, :), ALLOCATABLE, INTENT(out) :: dataOut_agg
 
      INTEGER :: nlinesOut, i, j, x
      REAL(KIND(1D0)) :: dataOut_aggX(1:SIZE(varList))
      REAL(KIND(1D0)), DIMENSION(:, :), ALLOCATABLE :: dataOut_agg0
      nlinesout = int(nsh/(60.*60/outfreq_s))
      ! nGrid=SIZE(dataOutX, dim=3)
 
      ALLOCATE (dataout_agg(int(irmax/nlinesout), SIZE(varlist)))
      ALLOCATE (dataout_agg0(nlinesout, SIZE(varlist)))
 
      DO i = nlinesout, irmax, nlinesout
         x = i/nlinesout
         dataout_agg0 = dataoutx(i - nlinesout + 1:i, :)
         DO j = 1, SIZE(varlist), 1
            IF (diagnose == 1) THEN
               print *, "aggregating variable ", j, " of ", varlist(j)%header, 'in group ', varlist(j)%group
            END IF
            ! aggregating different variables
            SELECT CASE (varlist(j)%aggreg)
            CASE (at) !time columns, aT
               dataout_aggx(j) = dataout_agg0(nlinesout, j)
            CASE (aa) !average, aA
               dataout_aggx(j) = sum(dataout_agg0(:, j))/nlinesout
            CASE (as) !sum, aS
               dataout_aggx(j) = sum(dataout_agg0(:, j))
            CASE (al) !last value, aL
               dataout_aggx(j) = dataout_agg0(nlinesout, j)
            END SELECT
 
            IF (diagnose == 1 .AND. i == irmax) THEN
               ! IF ( i==irMax ) THEN
               print *, 'raw data of ', j, ':'
               print *, dataout_agg0(:, j)
               print *, 'aggregated with method: ', varlist(j)%aggreg
               print *, dataout_aggx(j)
               print *, ''
            END IF
         END DO
         dataout_agg(x, :) = dataout_aggx
      END DO
 

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 1367 of file suews_ctrl_output.f95.

      IMPLICIT NONE
      REAL(KIND(1D0)), DIMENSION(:, :), INTENT(in) :: dataOutX
      TYPE(varAttr), DIMENSION(:), INTENT(in) :: varList
      INTEGER, INTENT(in) :: iyr, Gridiv, outLevel
 
      TYPE(varAttr), DIMENSION(:), ALLOCATABLE :: varListSel
      INTEGER :: xx, err, fn, i, nargs
      CHARACTER(len=365) :: FileOutX
      CHARACTER(len=3) :: itextX
      CHARACTER(len=6) :: args(5)
      CHARACTER(len=16*SIZE(varList)) :: FormatOut
      CHARACTER(len=16) :: formatX
      CHARACTER(len=16), DIMENSION(:), ALLOCATABLE :: headerOut
 
      ! select variables to output
      xx = count((varlist%level <= outlevel), dim=1)
      WRITE (itextx, '(i3)') xx
      ALLOCATE (varlistsel(xx), stat=err)
      IF (err /= 0) print *, "varListSel: Allocation request denied"
      varlistsel = pack(varlist, mask=(varlist%level <= outlevel))
 
      ! generate file name
      CALL filename_gen(dataoutx, varlist, iyr, gridiv, fileoutx)
 
      ! store right-aligned headers
      ALLOCATE (headerout(xx), stat=err)
      IF (err /= 0) print *, "headerOut: Allocation request denied"
 
      ! create format string:
      DO i = 1, SIZE(varlistsel)
         CALL parse(varlistsel(i)%fmt, 'if.,', args, nargs)
         formatx = adjustl('(a'//trim(args(2))//',1x)')
         ! adjust headers to right-aligned
         WRITE (headerout(i), formatx) adjustr(trim(adjustl(varlistsel(i)%header)))
         IF (i == 1) THEN
            formatout = adjustl(trim(formatx))
         ELSE
            formatout = trim(formatout)//' '//adjustl(trim(formatx))
         END IF
      END DO
      formatout = '('//trim(adjustl(formatout))//')'
 
      ! create file
      fn = 9
      OPEN (fn, file=trim(adjustl(fileoutx)), status='unknown')
      ! PRINT*, 'FileOutX in SUEWS_Output_Init: ',FileOutX
 
      ! write out headers
      WRITE (fn, formatout) headerout
      CLOSE (fn)
 
      ! write out format file
      CALL formatfile_gen(dataoutx, varlist, iyr, gridiv, outlevel)
 
      ! clean up
      IF (ALLOCATED(varlistsel)) DEALLOCATE (varlistsel, stat=err)
      IF (err /= 0) print *, "varListSel: Deallocation request denied"
      IF (ALLOCATED(headerout)) DEALLOCATE (headerout, stat=err)
      IF (err /= 0) print *, "headerOut: Deallocation request denied"
 

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 1270 of file suews_ctrl_output.f95.

      IMPLICIT NONE
 
      TYPE(varAttr), DIMENSION(:), INTENT(in) :: varListX
      INTEGER, INTENT(in) :: iv, irMax, iyr, Gridiv, outLevel, outFreq_s
 
      INTEGER :: err
      INTEGER :: n_var
 
      INTEGER, DIMENSION(:), ALLOCATABLE :: id_seq ! id sequence as in the dataOutX/dataOutX_agg
      REAL(KIND(1D0)), DIMENSION(:, :), ALLOCATABLE :: dataOutX
      REAL(KIND(1D0)), DIMENSION(:, :), ALLOCATABLE :: dataOutX_agg
 
      ! number of varialbes for output
      n_var = SIZE(varlistx)
 
      IF (.NOT. ALLOCATED(dataoutx)) THEN
         ALLOCATE (dataoutx(irmax, n_var), stat=err)
         IF (err /= 0) print *, "dataOutX: Allocation request denied"
      END IF
 
      ! determine dataOutX array according to variable group
      SELECT CASE (trim(varlistx(n_var)%group))
      CASE ('SUEWS') !default
         dataoutx = dataoutsuews(1:irmax, 1:n_var, gridiv)
 
      CASE ('BEERS') !SOLWEIG
         dataoutx = dataoutbeers(1:irmax, 1:n_var, gridiv)
         ! dataOutX = dataOutSOLWEIG(1:irMax, 1:n_var, Gridiv)
 
      CASE ('BL') !BL
         dataoutx = dataoutbl(1:irmax, 1:n_var, gridiv)
 
      CASE ('snow') !snow
         dataoutx = dataoutsnow(1:irmax, 1:n_var, gridiv)
 
      CASE ('ESTM') !ESTM
         dataoutx = dataoutestm(1:irmax, 1:n_var, gridiv)
 
      CASE ('RSL') !RSL
         dataoutx = dataoutrsl(1:irmax, 1:n_var, gridiv)
 
      CASE ('debug') !debug
         dataoutx = dataoutdebug(1:irmax, 1:n_var, gridiv)
 
      CASE ('SPARTACUS') !SPARTACUS
         dataoutx = dataoutspartacus(1:irmax, 1:n_var, gridiv)
 
      CASE ('EHC') !EHC
         dataoutx = dataoutehc(1:irmax, 1:n_var, gridiv)
 
      CASE ('DailyState') !DailyState
         ! get correct day index
         CALL unique(int(pack(dataoutsuews(1:irmax, 2, gridiv), &
                              mask=(dataoutsuews(1:irmax, 3, gridiv) == 23 &
                                    .AND. dataoutsuews(1:irmax, 4, gridiv) == (nsh - 1.)/nsh*60))), &
                     id_seq)
 
         IF (ALLOCATED(dataoutx)) THEN
            DEALLOCATE (dataoutx)
            IF (err /= 0) print *, "dataOutX: Deallocation request denied"
         END IF
 
         IF (.NOT. ALLOCATED(dataoutx)) THEN
            ALLOCATE (dataoutx(SIZE(id_seq), n_var), stat=err)
            IF (err /= 0) print *, "dataOutX: Allocation request denied"
         END IF
 
         dataoutx = dataoutdailystate(id_seq, 1:n_var, gridiv)
         ! print*, id_seq
         ! print*, dataOutDailyState(id_seq,1:SIZE(varListX),Gridiv)
         ! print*, 1/(nsh-nsh)
      END SELECT
 
      ! aggregation:
      ! aggregation is done for every group but 'DailyState'
      IF (trim(varlistx(SIZE(varlistx))%group) /= 'DailyState') THEN
 
         CALL suews_output_agg(dataoutx_agg, dataoutx, varlistx, irmax, outfreq_s)
      ELSE
         IF (.NOT. ALLOCATED(dataoutx_agg)) THEN
            ALLOCATE (dataoutx_agg(SIZE(dataoutx, dim=1), SIZE(varlistx)), stat=err)
            IF (err /= 0) print *, ": Allocation request denied"
         END IF
         dataoutx_agg = dataoutx
      END IF
 
      ! output:
      ! initialise file when processing first metblock
      IF (iv == 1) CALL suews_output_init(dataoutx_agg, varlistx, iyr, gridiv, outlevel)
 
      ! append the aggregated data to the specific txt file
      CALL suews_write_txt(dataoutx_agg, varlistx, iyr, gridiv, outlevel)
 

References allocatearray::dataoutbeers, allocatearray::dataoutbl, allocatearray::dataoutdailystate, allocatearray::dataoutdebug, allocatearray::dataoutehc, allocatearray::dataoutestm, 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 1590 of file suews_ctrl_output.f95.

      IMPLICIT NONE
      REAL(KIND(1D0)), DIMENSION(:, :), INTENT(in) :: dataOutX
      TYPE(varAttr), DIMENSION(:), INTENT(in) :: varList
      INTEGER, INTENT(in) :: iyr, Gridiv, outLevel
 
      REAL(KIND(1D0)), DIMENSION(:, :), ALLOCATABLE :: dataOutSel
      TYPE(varAttr), DIMENSION(:), ALLOCATABLE :: varListSel
      CHARACTER(len=365) :: FileOutX
      INTEGER :: fn, i, xx, err
      INTEGER :: sizeVarListSel, sizedataOutX
      CHARACTER(len=12*SIZE(varList)) :: FormatOut
      ! LOGICAL :: initQ_file
      formatout = ''
 
      IF (diagnose == 1) WRITE (*, *) 'Writting data of group: ', varlist(SIZE(varlist))%group
 
      !select variables to output
      sizevarlistsel = count((varlist%level <= outlevel), dim=1)
      ALLOCATE (varlistsel(sizevarlistsel), stat=err)
      IF (err /= 0) print *, "varListSel: Allocation request denied"
      varlistsel = pack(varlist, mask=(varlist%level <= outlevel))
 
      ! copy data accordingly
      sizedataoutx = SIZE(dataoutx, dim=1)
      ALLOCATE (dataoutsel(sizedataoutx, sizevarlistsel), stat=err)
      IF (err /= 0) print *, "dataOutSel: Allocation request denied"
      ! print*, SIZE(varList%level),PACK((/(i,i=1,SIZE(varList%level))/), varList%level <= outLevel)
      ! print*, irMax,shape(dataOutX)
      dataoutsel = dataoutx(:, pack((/(i, i=1, SIZE(varlist%level))/), varlist%level <= outlevel))
      ! do i = 1, 5
      !    print*, 'first several lines of dataOutX:', i, dataOutX(i,:)
 
      ! end do
 
      ! create format string:
      DO i = 1, sizevarlistsel
         ! PRINT*,''
         ! PRINT*,i
         ! PRINT*, LEN_TRIM(FormatOut),TRIM(FormatOut)
         ! PRINT*, LEN_TRIM(TRIM(FormatOut)//','),TRIM(FormatOut)//','
         IF (i == 1) THEN
            ! FormatOut=ADJUSTL(varListSel(i)%fmt)
            formatout = varlistsel(i)%fmt
         ELSE
 
            ! FormatOut=TRIM(FormatOut)//','//ADJUSTL(varListSel(i)%fmt)
            formatout = trim(formatout)//','//trim(varlistsel(i)%fmt)
         END IF
         ! PRINT*,''
         ! PRINT*,i
         ! PRINT*, 'FormatOut',FormatOut
      END DO
      formatout = '('//trim(adjustl(formatout))//')'
 
      ! get filename
      CALL filename_gen(dataoutsel, varlistsel, iyr, gridiv, fileoutx)
      ! PRINT*, 'FileOutX in SUEWS_Write_txt: ',FileOutX
 
      ! test if FileOutX has been initialised
      ! IF ( .NOT. initQ_file(FileOutX) ) THEN
      !    CALL SUEWS_Output_Init(dataOutSel,varListSel,Gridiv,outLevel)
      ! END IF
 
      ! write out data
      fn = 50
      OPEN (fn, file=trim(fileoutx), position='append') !,err=112)
      DO i = 1, sizedataoutx
         ! PRINT*, 'Writting line',i
         ! PRINT*, 'FormatOut in writing',FormatOut
         ! PRINT*, dataOutSel(i,1:sizeVarListSel)
         WRITE (fn, formatout) &
            (int(dataoutsel(i, xx)), xx=1, 4), &
            (dataoutsel(i, xx), xx=5, sizevarlistsel)
      END DO
      CLOSE (fn)
 
      IF (ALLOCATED(varlistsel)) DEALLOCATE (varlistsel, stat=err)
      IF (err /= 0) print *, "varListSel: Deallocation request denied"
 
      IF (ALLOCATED(dataoutsel)) DEALLOCATE (dataoutsel, stat=err)
      IF (err /= 0) print *, "dataOutSel: Deallocation request denied"
 

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 1775 of file suews_ctrl_output.f95.

      ! Return only the unique values from vec.
 
      IMPLICIT NONE
 
      INTEGER, DIMENSION(:), INTENT(in) :: vec
      INTEGER, DIMENSION(:), ALLOCATABLE, INTENT(out) :: vec_unique
 
      INTEGER :: i, num
      LOGICAL, DIMENSION(SIZE(vec)) :: mask
 
      mask = .false.
 
      DO i = 1, SIZE(vec)
 
         !count the number of occurrences of this element:
         num = count(vec(i) == vec)
 
         IF (num == 1) THEN
            !there is only one, flag it:
            mask(i) = .true.
         ELSE
            !flag this value only if it hasn't already been flagged:
            IF (.NOT. any(vec(i) == vec .AND. mask)) mask(i) = .true.
         END IF
 
      END DO
 
      !return only flagged elements:
      ALLOCATE (vec_unique(count(mask)))
      vec_unique = pack(vec, mask)
 
      !if you also need it sorted, then do so.
      ! For example, with slatec routine:
      !call ISORT (vec_unique, [0], size(vec_unique), 1)
 

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.

   CHARACTER(len=1), PARAMETER :: & ! Define aggregation methods here
      aT = 'T', & !time columns
      aa = 'A', & !average
      as = 'S', & !sum
      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.

   CHARACTER(len=10), PARAMETER :: & !Define useful formats here
      fy = 'i0004,1X', & !4 digit integer for year
      ft = 'i0004,1X', & !3 digit integer for id, it, imin
      fd = 'f08.4,1X', & !3 digits + 4 dp for dectime
      f94 = 'f09.4,1X', & !standard output format: 4 dp + 4 digits
      f104 = 'f10.4,1X', & !standard output format: 4 dp + 5 digits
      f106 = 'f10.6,1X', & !standard output format: 6 dp + 3 digits
      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.

   CHARACTER(len=3) :: itext

n

integer ctrl_output::n

Definition at line 37 of file suews_ctrl_output.f95.

   INTEGER :: n

varlistall

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

Definition at line 68 of file suews_ctrl_output.f95.

   TYPE(varAttr) :: varListAll(1200)

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