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

1183  ! count the number of valid lines in a file
1184  ! invalid line starting with -9
1185 
1186  !========================================================================================
1187  IMPLICIT NONE
1188  CHARACTER(len=*) :: filename
1189  INTEGER :: nlines
1190  INTEGER :: io, iv
1191 
1192  OPEN (10, file=filename, iostat=io, status='old')
1193 
1194  ! if io error found, report iostat and exit
1195  IF (io /= 0) THEN
1196  print *, 'io', io, 'for', filename
1197  stop 'Cannot open file! '
1198  ENDIF
1199 
1200  nlines = 0
1201  DO
1202  READ (10, *, iostat=io) iv
1203  IF (io < 0 .OR. iv == -9) EXIT
1204 
1205  nlines = nlines + 1
1206  END DO
1207  CLOSE (10)
1208  nlines = nlines - 1 ! skip header
integer nlines
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().

1024  USE datetime_module
1025 
1026  IMPLICIT NONE
1027  REAL(KIND(1d0)), DIMENSION(:, :), INTENT(in)::dataoutx ! to determine year & output frequency
1028  TYPE(varattr), DIMENSION(:), INTENT(in)::varlist ! to determine output group
1029  INTEGER, INTENT(in) :: iyr ! to determine year
1030  INTEGER, INTENT(in) :: gridiv ! to determine grid name as in SiteSelect
1031  INTEGER, INTENT(in), OPTIONAL :: opt_fmt ! to determine if a format file
1032  CHARACTER(len=365), INTENT(out) :: fileoutx ! the output file name
1033 
1034  CHARACTER(len=20):: str_out_min, str_grid, &
1035  str_date, str_year, str_doy, str_grp, str_sfx
1036  INTEGER :: year_int, doy_int, val_fmt, delta_t_min
1037  TYPE(datetime) :: dt1, dt2
1038  TYPE(timedelta) :: dt_x
1039 
1040  ! initialise with a default value
1041  val_fmt = -999
1042 
1043  IF (PRESENT(opt_fmt)) val_fmt = opt_fmt
1044 
1045  ! PRINT*, varList(:)%header
1046  ! PRINT*, 'dataOutX(1)',dataOutX(1,:)
1047 
1048  ! date:
1049  doy_int = int(dataoutx(1, 2))
1050  WRITE (str_doy, '(i3.3)') doy_int
1051 
1052 ! #ifdef nc
1053 ! ! year for nc use that in dataOutX
1054 ! year_int = INT(dataOutX(1, 1))
1055 ! WRITE (str_year, '(i4)') year_int
1056 ! str_date = '_'//TRIM(ADJUSTL(str_year))
1057 ! ! add DOY as a specifier
1058 ! IF (ncMode == 1) str_date = TRIM(ADJUSTL(str_date))//TRIM(ADJUSTL(str_DOY))
1059 ! #endif
1060 
1061  ! year for txt use specified value to avoid conflicts when crossing years
1062  year_int = iyr
1063  WRITE (str_year, '(i4)') year_int
1064  str_date = '_'//trim(adjustl(str_year))
1065 
1066  ! output frequency in minute:
1067  IF (varlist(6)%group == 'DailyState') THEN
1068  str_out_min = '' ! ignore this for DailyState
1069  ELSE
1070  ! derive output frequency from output arrays
1071  ! dt_x=
1072  dt1 = datetime(int(dataoutx(1, 1)), 1, 1) + &
1073  timedelta(days=int(dataoutx(1, 2) - 1), &
1074  hours=int(dataoutx(1, 3)), &
1075  minutes=int(dataoutx(1, 4)))
1076 
1077  dt2 = datetime(int(dataoutx(2, 1)), 1, 1) + &
1078  timedelta(days=int(dataoutx(2, 2) - 1), &
1079  hours=int(dataoutx(2, 3)), &
1080  minutes=int(dataoutx(2, 4)))
1081 
1082  dt_x = dt2 - dt1
1083  delta_t_min = int(dt_x%total_seconds()/60)
1084  WRITE (str_out_min, '(i4)') delta_t_min
1085  str_out_min = '_'//trim(adjustl(str_out_min))
1086  ENDIF
1087 
1088  ! group: output type
1089  str_grp = varlist(6)%group
1090  IF (len(trim(str_grp)) > 0) str_grp = '_'//trim(adjustl(str_grp))
1091 
1092  ! grid name:
1093  WRITE (str_grid, '(i10)') grididmatrix(gridiv)
1094 ! #ifdef nc
1095 ! IF (ncMode == 1) str_grid = '' ! grid name not needed by nc files
1096 ! #endif
1097 
1098  ! suffix:
1099  str_sfx = '.txt'
1100 ! #ifdef nc
1101 ! IF (ncMode == 1) str_sfx = '.nc'
1102 ! #endif
1103 
1104  ! filename: FileOutX
1105  fileoutx = trim(fileoutputpath)// &
1106  trim(filecode)// &
1107  trim(adjustl(str_grid))// &
1108  trim(adjustl(str_date))// &
1109  trim(adjustl(str_grp))// &
1110  trim(adjustl(str_out_min))// &
1111  trim(adjustl(str_sfx))
1112 
1113  ! filename: format
1114  IF (val_fmt == 1) THEN
1115  fileoutx = trim(fileoutputpath)// &
1116  trim(filecode)// &
1117  trim(adjustl(str_grp))// &
1118  '_OutputFormat.txt'
1119  END IF
1120 
character(len=15) datetime
integer, dimension(:), allocatable grididmatrix
character(len=20) filecode
character(len=150) fileoutputpath
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().

787  IMPLICIT NONE
788  REAL(KIND(1d0)), DIMENSION(:, :), INTENT(in)::dataoutx
789  TYPE(varattr), DIMENSION(:), INTENT(in)::varlist
790  INTEGER, INTENT(in) :: iyr, gridiv, outlevel
791 
792  TYPE(varattr), DIMENSION(:), ALLOCATABLE::varlistsel
793  INTEGER :: xx, err, fn, i
794  CHARACTER(len=365) :: fileoutx
795  CHARACTER(len=100*300) :: str_cat
796  CHARACTER(len=100) :: str_x = ''
797  CHARACTER(len=3) :: itextx
798 
799  ! get filename
800  CALL filename_gen(dataoutx, varlist, iyr, gridiv, fileoutx, 1)
801 
802  !select variables to output
803  xx = count((varlist%level <= outlevel), dim=1)
804  ALLOCATE (varlistsel(xx), stat=err)
805  IF (err /= 0) print *, "varListSel: Allocation request denied"
806  varlistsel = pack(varlist, mask=(varlist%level <= outlevel))
807 
808  ! create file
809  fn = 9
810  OPEN (fn, file=trim(adjustl(fileoutx)), status='unknown')
811 
812  ! write out format strings
813  ! column number:
814  str_cat = ''
815  DO i = 1, SIZE(varlistsel)
816  WRITE (itextx, '(i3)') i
817  IF (i == 1) THEN
818  str_cat = trim(adjustl(itextx))
819  ELSE
820  str_cat = trim(str_cat)//';'//adjustl(itextx)
821  ENDIF
822  END DO
823  WRITE (fn, '(a)') trim(str_cat)
824 
825  ! header:
826  str_cat = ''
827  DO i = 1, SIZE(varlistsel)
828  str_x = varlistsel(i)%header
829  IF (i == 1) THEN
830  str_cat = trim(adjustl(str_x))
831  ELSE
832  str_cat = trim(str_cat)//';'//adjustl(str_x)
833  ENDIF
834  END DO
835  WRITE (fn, '(a)') trim(str_cat)
836 
837  ! long name:
838  str_cat = ''
839  DO i = 1, SIZE(varlistsel)
840  str_x = varlistsel(i)%longNm
841  IF (i == 1) THEN
842  str_cat = trim(adjustl(str_x))
843  ELSE
844  str_cat = trim(str_cat)//';'//adjustl(str_x)
845  ENDIF
846  END DO
847  WRITE (fn, '(a)') trim(str_cat)
848 
849  ! unit:
850  str_cat = ''
851  DO i = 1, SIZE(varlistsel)
852  str_x = varlistsel(i)%unit
853  IF (i == 1) THEN
854  str_cat = trim(adjustl(str_x))
855  ELSE
856  str_cat = trim(str_cat)//';'//adjustl(str_x)
857  ENDIF
858  END DO
859  WRITE (fn, '(a)') trim(str_cat)
860 
861  ! format:
862  str_cat = ''
863  DO i = 1, SIZE(varlistsel)
864  str_x = varlistsel(i)%fmt
865  IF (i == 1) THEN
866  str_cat = trim(adjustl(str_x))
867  ELSE
868  str_cat = trim(str_cat)//';'//adjustl(str_x)
869  ENDIF
870  END DO
871  WRITE (fn, '(a)') trim(str_cat)
872 
873  ! aggregation method:
874  str_cat = ''
875  DO i = 1, SIZE(varlistsel)
876  str_x = varlistsel(i)%aggreg
877  IF (i == 1) THEN
878  str_cat = trim(adjustl(str_x))
879  ELSE
880  str_cat = trim(str_cat)//';'//adjustl(str_x)
881  ENDIF
882  END DO
883  WRITE (fn, '(a)') trim(str_cat)
884 
885  ! close file
886  CLOSE (fn)
887 
888  ! clean up
889  IF (ALLOCATED(varlistsel)) DEALLOCATE (varlistsel, stat=err)
890  IF (err /= 0) print *, "varListSel: Deallocation request denied"
891 
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.

1163  IMPLICIT NONE
1164  CHARACTER(len=365), INTENT(in) :: filename ! the output file name
1165  LOGICAL :: existq
1166  CHARACTER(len=1000) :: longstring
1167 
1168  INQUIRE (file=trim(filename), exist=existq)
1169  IF (existq) THEN
1170  OPEN (10, file=trim(filename))
1171  READ (10, '(a)') longstring
1172  ! print*, 'longstring: ',longstring
1173  IF (verify(longstring, 'Year') == 0) initq_file = .false.
1174  CLOSE (unit=10)
1175  ELSE
1176  initq_file = .false.
1177  END IF
1178 

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

548  IMPLICIT NONE
549  INTEGER, INTENT(in) :: irmax
550 ! #ifdef nc
551 ! INTEGER, INTENT(in), OPTIONAL ::iv, Gridiv, iyr
552 ! #else
553  INTEGER, INTENT(in) ::iv, gridiv, iyr
554 ! #endif
555 
556  INTEGER :: xx, err, outlevel, i
557  TYPE(varattr), DIMENSION(:), ALLOCATABLE::varlistx
558  CHARACTER(len=10) :: grplist0(7)
559  CHARACTER(len=10), DIMENSION(:), ALLOCATABLE :: grplist
560  LOGICAL :: grpcond(7)
561 
562  ! determine outLevel
563  SELECT CASE (writeoutoption)
564  CASE (0) !all (not snow-related)
565  outlevel = 1
566  CASE (1) !all plus snow-related
567  outlevel = 2
568  CASE (2) !minimal output
569  outlevel = 0
570  END SELECT
571 
572  ! determine groups to output
573  ! TODO: needs to be smarter, automate this filtering
574  grplist0(1) = 'SUEWS'
575  grplist0(2) = 'SOLWEIG'
576  grplist0(3) = 'BL'
577  grplist0(4) = 'snow'
578  grplist0(5) = 'ESTM'
579  grplist0(6) = 'DailyState'
580  grplist0(7) = 'RSL'
581  grpcond = [ &
582  .true., &
583  .true., &
584  cbluse >= 1, &
585  snowuse >= 1, &
586  storageheatmethod == 4 .OR. storageheatmethod == 14, &
587  .true., &
588  .true.]
589  xx = count(grpcond)
590 
591  ! PRINT*, grpList0,xx
592 
593  ALLOCATE (grplist(xx), stat=err)
594  IF (err /= 0) print *, "grpList: Allocation request denied"
595 
596  grplist = pack(grplist0, mask=grpcond)
597 
598  ! PRINT*, grpList,SIZE(grpList, dim=1)
599 
600  ! loop over all groups
601  DO i = 1, SIZE(grplist), 1
602  !PRINT*, 'i',i
603  xx = count(varlistall%group == trim(grplist(i)), dim=1)
604  ! PRINT*, 'number of variables:',xx, 'in group: ',grpList(i)
605  ! print*, 'all group names: ',varList%group
606  ALLOCATE (varlistx(5 + xx), stat=err)
607  IF (err /= 0) print *, "varListX: Allocation request denied"
608  ! datetime
609  varlistx(1:5) = varlistall(1:5)
610  ! variable
611  varlistx(6:5 + xx) = pack(varlistall, mask=(varlistall%group == trim(grplist(i))))
612 
613  IF (trim(varlistx(SIZE(varlistx))%group) /= 'DailyState') THEN
614  ! all output arrays but DailyState
615  ! all output frequency option:
616  ! as forcing:
617  IF (resolutionfilesout == tstep .OR. keeptstepfilesout == 1) THEN
618  CALL suews_output_txt_grp(iv, irmax, iyr, varlistx, gridiv, outlevel, tstep)
619  ENDIF
620  ! as specified ResolutionFilesOut:
621  IF (resolutionfilesout /= tstep) THEN
622  CALL suews_output_txt_grp(iv, irmax, iyr, varlistx, gridiv, outlevel, resolutionfilesout)
623  ENDIF
624  ELSE
625  ! DailyState array, which does not need aggregation
626 
627  CALL suews_output_txt_grp(iv, irmax, iyr, varlistx, gridiv, outlevel, tstep)
628 
629  ENDIF
630 
631  IF (ALLOCATED(varlistx)) DEALLOCATE (varlistx, stat=err)
632  IF (err /= 0) print *, "varListX: Deallocation request denied"
633  ! PRINT*, 'i',i,'end'
634 
635  END DO
integer keeptstepfilesout
integer resolutionfilesout
integer snowuse
integer writeoutoption
integer cbluse
integer storageheatmethod
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().

896  IMPLICIT NONE
897  REAL(KIND(1d0)), DIMENSION(:, :), INTENT(in)::dataoutx
898  TYPE(varattr), DIMENSION(:), INTENT(in)::varlist
899  INTEGER, INTENT(in) :: irmax, outfreq_s
900  REAL(KIND(1d0)), DIMENSION(:, :), ALLOCATABLE, INTENT(out)::dataout_agg
901 
902  INTEGER :: nlinesout, i, j, x
903  REAL(KIND(1d0))::dataout_aggx(1:size(varlist))
904  REAL(KIND(1d0)), DIMENSION(:, :), ALLOCATABLE::dataout_agg0
905  nlinesout = int(nsh/(60.*60/outfreq_s))
906  ! nGrid=SIZE(dataOutX, dim=3)
907 
908  ALLOCATE (dataout_agg(int(irmax/nlinesout), SIZE(varlist)))
909  ALLOCATE (dataout_agg0(nlinesout, SIZE(varlist)))
910 
911  DO i = nlinesout, irmax, nlinesout
912  x = i/nlinesout
913  dataout_agg0 = dataoutx(i - nlinesout + 1:i, :)
914  DO j = 1, SIZE(varlist), 1
915  ! aggregating different variables
916  SELECT CASE (varlist(j)%aggreg)
917  CASE (at) !time columns, aT
918  dataout_aggx(j) = dataout_agg0(nlinesout, j)
919  CASE (aa) !average, aA
920  dataout_aggx(j) = sum(dataout_agg0(:, j))/nlinesout
921  CASE (as) !sum, aS
922  dataout_aggx(j) = sum(dataout_agg0(:, j))
923  CASE (al) !last value, aL
924  dataout_aggx(j) = dataout_agg0(nlinesout, j)
925  END SELECT
926 
927  IF (diagnose == 1 .AND. i == irmax) THEN
928  ! IF ( i==irMax ) THEN
929  print *, 'raw data of ', j, ':'
930  print *, dataout_agg0(:, j)
931  print *, 'aggregated with method: ', varlist(j)%aggreg
932  print *, dataout_aggx(j)
933  print *, ''
934  END IF
935  END DO
936  dataout_agg(x, :) = dataout_aggx
937  END DO
938 
integer diagnose
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().

723  IMPLICIT NONE
724  REAL(KIND(1d0)), DIMENSION(:, :), INTENT(in)::dataoutx
725  TYPE(varattr), DIMENSION(:), INTENT(in)::varlist
726  INTEGER, INTENT(in) :: iyr, gridiv, outlevel
727 
728  TYPE(varattr), DIMENSION(:), ALLOCATABLE::varlistsel
729  INTEGER :: xx, err, fn, i, nargs
730  CHARACTER(len=365) :: fileoutx
731  CHARACTER(len=3) :: itextx
732  CHARACTER(len=6) :: args(5)
733  CHARACTER(len=16*SIZE(varList)) :: formatout
734  CHARACTER(len=16) :: formatx
735  CHARACTER(len=16), DIMENSION(:), ALLOCATABLE:: headerout
736 
737  ! select variables to output
738  xx = count((varlist%level <= outlevel), dim=1)
739  WRITE (itextx, '(i3)') xx
740  ALLOCATE (varlistsel(xx), stat=err)
741  IF (err /= 0) print *, "varListSel: Allocation request denied"
742  varlistsel = pack(varlist, mask=(varlist%level <= outlevel))
743 
744  ! generate file name
745  CALL filename_gen(dataoutx, varlist, iyr, gridiv, fileoutx)
746 
747  ! store right-aligned headers
748  ALLOCATE (headerout(xx), stat=err)
749  IF (err /= 0) print *, "headerOut: Allocation request denied"
750 
751  ! create format string:
752  DO i = 1, SIZE(varlistsel)
753  CALL parse(varlistsel(i)%fmt, 'if.,', args, nargs)
754  formatx = adjustl('(a'//trim(args(2))//',1x)')
755  ! adjust headers to right-aligned
756  WRITE (headerout(i), formatx) adjustr(trim(adjustl(varlistsel(i)%header)))
757  IF (i == 1) THEN
758  formatout = adjustl(trim(formatx))
759  ELSE
760  formatout = trim(formatout)//' '//adjustl(trim(formatx))
761  END IF
762  END DO
763  formatout = '('//trim(adjustl(formatout))//')'
764 
765  ! create file
766  fn = 9
767  OPEN (fn, file=trim(adjustl(fileoutx)), status='unknown')
768  ! PRINT*, 'FileOutX in SUEWS_Output_Init: ',FileOutX
769 
770  ! write out headers
771  WRITE (fn, formatout) headerout
772  CLOSE (fn)
773 
774  ! write out format file
775  CALL formatfile_gen(dataoutx, varlist, iyr, gridiv, outlevel)
776 
777  ! clean up
778  IF (ALLOCATED(varlistsel)) DEALLOCATE (varlistsel, stat=err)
779  IF (err /= 0) print *, "varListSel: Deallocation request denied"
780  IF (ALLOCATED(headerout)) DEALLOCATE (headerout, stat=err)
781  IF (err /= 0) print *, "headerOut: Deallocation request denied"
782 
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().

640  IMPLICIT NONE
641 
642  TYPE(varattr), DIMENSION(:), INTENT(in)::varlistx
643  INTEGER, INTENT(in) :: iv, irmax, iyr, gridiv, outlevel, outfreq_s
644 
645  INTEGER :: err
646 
647  INTEGER, DIMENSION(:), ALLOCATABLE ::id_seq ! id sequence as in the dataOutX/dataOutX_agg
648  REAL(KIND(1d0)), DIMENSION(:, :), ALLOCATABLE::dataoutx
649  REAL(KIND(1d0)), DIMENSION(:, :), ALLOCATABLE::dataoutx_agg
650 
651  IF (.NOT. ALLOCATED(dataoutx)) THEN
652  ALLOCATE (dataoutx(irmax, SIZE(varlistx)), stat=err)
653  IF (err /= 0) print *, "dataOutX: Allocation request denied"
654  ENDIF
655 
656  ! determine dataOutX array according to variable group
657  SELECT CASE (trim(varlistx(SIZE(varlistx))%group))
658  CASE ('SUEWS') !default
659  dataoutx = dataoutsuews(1:irmax, 1:SIZE(varlistx), gridiv)
660 
661  CASE ('SOLWEIG') !SOLWEIG
662  dataoutx = dataoutsolweig(1:irmax, 1:SIZE(varlistx), gridiv)
663 
664  CASE ('BL') !BL
665  dataoutx = dataoutbl(1:irmax, 1:SIZE(varlistx), gridiv)
666 
667  CASE ('snow') !snow
668  dataoutx = dataoutsnow(1:irmax, 1:SIZE(varlistx), gridiv)
669 
670  CASE ('ESTM') !ESTM
671  dataoutx = dataoutestm(1:irmax, 1:SIZE(varlistx), gridiv)
672 
673  CASE ('RSL') !ESTM
674  dataoutx = dataoutrsl(1:irmax, 1:SIZE(varlistx), gridiv)
675 
676  CASE ('DailyState') !DailyState
677  ! get correct day index
678  CALL unique(int(pack(dataoutsuews(1:irmax, 2, gridiv), &
679  mask=(dataoutsuews(1:irmax, 3, gridiv) == 23 &
680  .AND. dataoutsuews(1:irmax, 4, gridiv) == (nsh - 1.)/nsh*60))), &
681  id_seq)
682 
683  IF (ALLOCATED(dataoutx)) THEN
684  DEALLOCATE (dataoutx)
685  IF (err /= 0) print *, "dataOutX: Deallocation request denied"
686  ENDIF
687 
688  IF (.NOT. ALLOCATED(dataoutx)) THEN
689  ALLOCATE (dataoutx(SIZE(id_seq), SIZE(varlistx)), stat=err)
690  IF (err /= 0) print *, "dataOutX: Allocation request denied"
691  ENDIF
692 
693  dataoutx = dataoutdailystate(id_seq, 1:SIZE(varlistx), gridiv)
694  ! print*, id_seq
695  ! print*, dataOutDailyState(id_seq,1:SIZE(varListX),Gridiv)
696  ! print*, 1/(nsh-nsh)
697  END SELECT
698 
699  ! aggregation:
700  ! aggregation is done for every group but 'DailyState'
701  IF (trim(varlistx(SIZE(varlistx))%group) /= 'DailyState') THEN
702 
703  CALL suews_output_agg(dataoutx_agg, dataoutx, varlistx, irmax, outfreq_s)
704  ELSE
705  IF (.NOT. ALLOCATED(dataoutx_agg)) THEN
706  ALLOCATE (dataoutx_agg(SIZE(dataoutx, dim=1), SIZE(varlistx)), stat=err)
707  IF (err /= 0) print *, ": Allocation request denied"
708  ENDIF
709  dataoutx_agg = dataoutx
710  ENDIF
711 
712  ! output:
713  ! initialise file when processing first metblock
714  IF (iv == 1) CALL suews_output_init(dataoutx_agg, varlistx, iyr, gridiv, outlevel)
715 
716  ! append the aggregated data to the specific txt file
717  CALL suews_write_txt(dataoutx_agg, varlistx, iyr, gridiv, outlevel)
718 
real(kind(1d0)), dimension(:, :, :), allocatable dataoutestm
real(kind(1d0)), dimension(:, :, :), allocatable dataoutbl
real(kind(1d0)), dimension(:, :, :), allocatable dataoutdailystate
real(kind(1d0)), dimension(:, :, :), allocatable dataoutsuews
real(kind(1d0)), dimension(:, :, :), allocatable dataoutrsl
real(kind(1d0)), dimension(:, :, :), allocatable dataoutsnow
real(kind(1d0)), dimension(:, :, :), allocatable dataoutsolweig
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().

943  IMPLICIT NONE
944  REAL(KIND(1d0)), DIMENSION(:, :), INTENT(in)::dataoutx
945  TYPE(varattr), DIMENSION(:), INTENT(in)::varlist
946  INTEGER, INTENT(in) :: iyr, gridiv, outlevel
947 
948  REAL(KIND(1d0)), DIMENSION(:, :), ALLOCATABLE::dataoutsel
949  TYPE(varattr), DIMENSION(:), ALLOCATABLE::varlistsel
950  CHARACTER(len=365) :: fileoutx
951  INTEGER :: fn, i, xx, err
952  INTEGER :: sizevarlistsel, sizedataoutx
953  CHARACTER(len=12*SIZE(varList)) :: formatout
954  ! LOGICAL :: initQ_file
955  formatout = ''
956 
957  IF (diagnose == 1) WRITE (*, *) 'Writting data of group: ', varlist(SIZE(varlist))%group
958 
959  !select variables to output
960  sizevarlistsel = count((varlist%level <= outlevel), dim=1)
961  ALLOCATE (varlistsel(sizevarlistsel), stat=err)
962  IF (err /= 0) print *, "varListSel: Allocation request denied"
963  varlistsel = pack(varlist, mask=(varlist%level <= outlevel))
964 
965  ! copy data accordingly
966  sizedataoutx = SIZE(dataoutx, dim=1)
967  ALLOCATE (dataoutsel(sizedataoutx, sizevarlistsel), stat=err)
968  IF (err /= 0) print *, "dataOutSel: Allocation request denied"
969  ! print*, SIZE(varList%level),PACK((/(i,i=1,SIZE(varList%level))/), varList%level <= outLevel)
970  ! print*, irMax,shape(dataOutX)
971  dataoutsel = dataoutx(:, pack((/(i, i=1, SIZE(varlist%level))/), varlist%level <= outlevel))
972 
973  ! create format string:
974  DO i = 1, sizevarlistsel
975  ! PRINT*,''
976  ! PRINT*,i
977  ! PRINT*, LEN_TRIM(FormatOut),TRIM(FormatOut)
978  ! PRINT*, LEN_TRIM(TRIM(FormatOut)//','),TRIM(FormatOut)//','
979  IF (i == 1) THEN
980  ! FormatOut=ADJUSTL(varListSel(i)%fmt)
981  formatout = varlistsel(i)%fmt
982  ELSE
983 
984  ! FormatOut=TRIM(FormatOut)//','//ADJUSTL(varListSel(i)%fmt)
985  formatout = trim(formatout)//','//trim(varlistsel(i)%fmt)
986  END IF
987  ! PRINT*,''
988  ! PRINT*,i
989  ! PRINT*, 'FormatOut',FormatOut
990  END DO
991  formatout = '('//trim(adjustl(formatout))//')'
992 
993  ! get filename
994  CALL filename_gen(dataoutsel, varlistsel, iyr, gridiv, fileoutx)
995  ! PRINT*, 'FileOutX in SUEWS_Write_txt: ',FileOutX
996 
997  ! test if FileOutX has been initialised
998  ! IF ( .NOT. initQ_file(FileOutX) ) THEN
999  ! CALL SUEWS_Output_Init(dataOutSel,varListSel,Gridiv,outLevel)
1000  ! END IF
1001 
1002  ! write out data
1003  fn = 50
1004  OPEN (fn, file=trim(fileoutx), position='append')!,err=112)
1005  DO i = 1, sizedataoutx
1006  ! PRINT*, 'Writting',i
1007  ! PRINT*, 'FormatOut',FormatOut
1008  ! PRINT*, dataOutSel(i,1:sizeVarListSel)
1009  WRITE (fn, formatout) &
1010  (int(dataoutsel(i, xx)), xx=1, 4), &
1011  (dataoutsel(i, xx), xx=5, sizevarlistsel)
1012  ENDDO
1013  CLOSE (fn)
1014 
1015  IF (ALLOCATED(varlistsel)) DEALLOCATE (varlistsel, stat=err)
1016  IF (err /= 0) print *, "varListSel: Deallocation request denied"
1017 
1018  IF (ALLOCATED(dataoutsel)) DEALLOCATE (dataoutsel, stat=err)
1019  IF (err /= 0) print *, "dataOutSel: Deallocation request denied"
1020 
integer diagnose
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().

1124  ! Return only the unique values from vec.
1125 
1126  IMPLICIT NONE
1127 
1128  INTEGER, DIMENSION(:), INTENT(in) :: vec
1129  INTEGER, DIMENSION(:), ALLOCATABLE, INTENT(out) :: vec_unique
1130 
1131  INTEGER :: i, num
1132  LOGICAL, DIMENSION(SIZE(vec)) :: mask
1133 
1134  mask = .false.
1135 
1136  DO i = 1, SIZE(vec)
1137 
1138  !count the number of occurrences of this element:
1139  num = count(vec(i) == vec)
1140 
1141  IF (num == 1) THEN
1142  !there is only one, flag it:
1143  mask(i) = .true.
1144  ELSE
1145  !flag this value only if it hasn't already been flagged:
1146  IF (.NOT. any(vec(i) == vec .AND. mask)) mask(i) = .true.
1147  END IF
1148 
1149  END DO
1150 
1151  !return only flagged elements:
1152  ALLOCATE (vec_unique(count(mask)))
1153  vec_unique = pack(vec, mask)
1154 
1155  !if you also need it sorted, then do so.
1156  ! For example, with slatec routine:
1157  !call ISORT (vec_unique, [0], size(vec_unique), 1)
1158 
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().

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

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

68  TYPE(varattr) :: varlistall(500)