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(500)	varlistall

Function/Subroutine Documentation

count_lines()

integer function ctrl_output::count_lines

(

character(len=*)

filename

)

Definition at line 1183 of file suews_ctrl_output.f95.

Referenced by suews_program().

      ! 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! '
      ENDIF

      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

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

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

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

      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))
      ENDIF

      ! 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

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

References filename_gen().

Referenced by suews_output_init().

      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)
         ENDIF
      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)
         ENDIF
      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)
         ENDIF
      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)
         ENDIF
      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)
         ENDIF
      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)
         ENDIF
      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"

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 1163 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

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

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().

      IMPLICIT NONE
      INTEGER, INTENT(in) :: irmax
! #ifdef nc
!       INTEGER, INTENT(in), OPTIONAL ::iv, Gridiv, iyr
! #else
      INTEGER, INTENT(in) ::iv, gridiv, iyr
! #endif

      INTEGER :: xx, err, outlevel, i
      TYPE(varattr), DIMENSION(:), ALLOCATABLE::varlistx
      CHARACTER(len=10) :: grplist0(7)
      CHARACTER(len=10), DIMENSION(:), ALLOCATABLE :: grplist
      LOGICAL :: grpcond(7)

      ! 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
      grplist0(1) = 'SUEWS'
      grplist0(2) = 'SOLWEIG'
      grplist0(3) = 'BL'
      grplist0(4) = 'snow'
      grplist0(5) = 'ESTM'
      grplist0(6) = 'DailyState'
      grplist0(7) = 'RSL'
      grpcond = [ &
                .true., &
                .true., &
                cbluse >= 1, &
                snowuse >= 1, &
                storageheatmethod == 4 .OR. storageheatmethod == 14, &
                .true., &
                .true.]
      xx = count(grpcond)

      ! PRINT*, grpList0,xx

      ALLOCATE (grplist(xx), stat=err)
      IF (err /= 0) print *, "grpList: Allocation request denied"

      grplist = pack(grplist0, mask=grpcond)

      ! PRINT*, grpList,SIZE(grpList, dim=1)

      ! loop over all groups
      DO i = 1, SIZE(grplist), 1
         !PRINT*, 'i',i
         xx = 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 + xx), stat=err)
         IF (err /= 0) print *, "varListX: Allocation request denied"
         ! datetime
         varlistx(1:5) = varlistall(1:5)
         ! variable
         varlistx(6:5 + xx) = 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)
            ENDIF
            !  as specified ResolutionFilesOut:
            IF (resolutionfilesout /= tstep) THEN
               CALL suews_output_txt_grp(iv, irmax, iyr, varlistx, gridiv, outlevel, resolutionfilesout)
            ENDIF
         ELSE
            !  DailyState array, which does not need aggregation

            CALL suews_output_txt_grp(iv, irmax, iyr, varlistx, gridiv, outlevel, tstep)

         ENDIF

         IF (ALLOCATED(varlistx)) DEALLOCATE (varlistx, stat=err)
         IF (err /= 0) print *, "varListX: Deallocation request denied"
         !  PRINT*, 'i',i,'end'

      END DO

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

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

Referenced by suews_output_txt_grp().

      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
            ! 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

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

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

Referenced by suews_output_txt_grp().

      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"

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

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

Referenced by suews_output().

      IMPLICIT NONE

      TYPE(varattr), DIMENSION(:), INTENT(in)::varlistx
      INTEGER, INTENT(in) :: iv, irmax, iyr, gridiv, outlevel, outfreq_s

      INTEGER :: err

      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

      IF (.NOT. ALLOCATED(dataoutx)) THEN
         ALLOCATE (dataoutx(irmax, SIZE(varlistx)), stat=err)
         IF (err /= 0) print *, "dataOutX: Allocation request denied"
      ENDIF

      ! determine dataOutX array according to variable group
      SELECT CASE (trim(varlistx(SIZE(varlistx))%group))
      CASE ('SUEWS') !default
         dataoutx = dataoutsuews(1:irmax, 1:SIZE(varlistx), gridiv)

      CASE ('SOLWEIG') !SOLWEIG
         dataoutx = dataoutsolweig(1:irmax, 1:SIZE(varlistx), gridiv)

      CASE ('BL') !BL
         dataoutx = dataoutbl(1:irmax, 1:SIZE(varlistx), gridiv)

      CASE ('snow')    !snow
         dataoutx = dataoutsnow(1:irmax, 1:SIZE(varlistx), gridiv)

      CASE ('ESTM')    !ESTM
         dataoutx = dataoutestm(1:irmax, 1:SIZE(varlistx), gridiv)

      CASE ('RSL')    !ESTM
         dataoutx = dataoutrsl(1:irmax, 1:SIZE(varlistx), 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"
         ENDIF

         IF (.NOT. ALLOCATED(dataoutx)) THEN
            ALLOCATE (dataoutx(SIZE(id_seq), SIZE(varlistx)), stat=err)
            IF (err /= 0) print *, "dataOutX: Allocation request denied"
         ENDIF

         dataoutx = dataoutdailystate(id_seq, 1:SIZE(varlistx), 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"
         ENDIF
         dataoutx_agg = dataoutx
      ENDIF

      ! 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)

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

References data_in::diagnose, and filename_gen().

Referenced by suews_output_txt_grp().

      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))

      ! 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',i
         ! PRINT*, 'FormatOut',FormatOut
         ! PRINT*, dataOutSel(i,1:sizeVarListSel)
         WRITE (fn, formatout) &
            (int(dataoutsel(i, xx)), xx=1, 4), &
            (dataoutsel(i, xx), xx=5, sizevarlistsel)
      ENDDO
      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"

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

Referenced by suews_output_txt_grp().

      ! 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)

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.

Referenced by suews_output_agg().

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

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(500) ctrl_output::varlistall

Definition at line 68 of file suews_ctrl_output.f95.

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

   TYPE(varattr) :: varlistall(500)