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

Referenced by suews_program().

1206  ! count the number of valid lines in a file
1207  ! invalid line starting with -9
1208 
1209  !========================================================================================
1210  IMPLICIT NONE
1211  CHARACTER(len=*) :: filename
1212  INTEGER :: nlines
1213  INTEGER :: io, iv
1214 
1215  OPEN (10, file=filename, iostat=io, status='old')
1216 
1217  ! if io error found, report iostat and exit
1218  IF (io /= 0) THEN
1219  print *, 'io', io, 'for', filename
1220  stop 'Cannot open file! '
1221  ENDIF
1222 
1223  nlines = 0
1224  DO
1225  READ (10, *, iostat=io) iv
1226  IF (io < 0 .OR. iv == -9) EXIT
1227 
1228  nlines = nlines + 1
1229  END DO
1230  CLOSE (10)
1231  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 1047 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().

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

References filename_gen().

Referenced by suews_output_init().

810  IMPLICIT NONE
811  REAL(KIND(1d0)), DIMENSION(:, :), INTENT(in)::dataoutx
812  TYPE(varattr), DIMENSION(:), INTENT(in)::varlist
813  INTEGER, INTENT(in) :: iyr, gridiv, outlevel
814 
815  TYPE(varattr), DIMENSION(:), ALLOCATABLE::varlistsel
816  INTEGER :: xx, err, fn, i
817  CHARACTER(len=365) :: fileoutx
818  CHARACTER(len=100*300) :: str_cat
819  CHARACTER(len=100) :: str_x = ''
820  CHARACTER(len=3) :: itextx
821 
822  ! get filename
823  CALL filename_gen(dataoutx, varlist, iyr, gridiv, fileoutx, 1)
824 
825  !select variables to output
826  xx = count((varlist%level <= outlevel), dim=1)
827  ALLOCATE (varlistsel(xx), stat=err)
828  IF (err /= 0) print *, "varListSel: Allocation request denied"
829  varlistsel = pack(varlist, mask=(varlist%level <= outlevel))
830 
831  ! create file
832  fn = 9
833  OPEN (fn, file=trim(adjustl(fileoutx)), status='unknown')
834 
835  ! write out format strings
836  ! column number:
837  str_cat = ''
838  DO i = 1, SIZE(varlistsel)
839  WRITE (itextx, '(i3)') i
840  IF (i == 1) THEN
841  str_cat = trim(adjustl(itextx))
842  ELSE
843  str_cat = trim(str_cat)//';'//adjustl(itextx)
844  ENDIF
845  END DO
846  WRITE (fn, '(a)') trim(str_cat)
847 
848  ! header:
849  str_cat = ''
850  DO i = 1, SIZE(varlistsel)
851  str_x = varlistsel(i)%header
852  IF (i == 1) THEN
853  str_cat = trim(adjustl(str_x))
854  ELSE
855  str_cat = trim(str_cat)//';'//adjustl(str_x)
856  ENDIF
857  END DO
858  WRITE (fn, '(a)') trim(str_cat)
859 
860  ! long name:
861  str_cat = ''
862  DO i = 1, SIZE(varlistsel)
863  str_x = varlistsel(i)%longNm
864  IF (i == 1) THEN
865  str_cat = trim(adjustl(str_x))
866  ELSE
867  str_cat = trim(str_cat)//';'//adjustl(str_x)
868  ENDIF
869  END DO
870  WRITE (fn, '(a)') trim(str_cat)
871 
872  ! unit:
873  str_cat = ''
874  DO i = 1, SIZE(varlistsel)
875  str_x = varlistsel(i)%unit
876  IF (i == 1) THEN
877  str_cat = trim(adjustl(str_x))
878  ELSE
879  str_cat = trim(str_cat)//';'//adjustl(str_x)
880  ENDIF
881  END DO
882  WRITE (fn, '(a)') trim(str_cat)
883 
884  ! format:
885  str_cat = ''
886  DO i = 1, SIZE(varlistsel)
887  str_x = varlistsel(i)%fmt
888  IF (i == 1) THEN
889  str_cat = trim(adjustl(str_x))
890  ELSE
891  str_cat = trim(str_cat)//';'//adjustl(str_x)
892  ENDIF
893  END DO
894  WRITE (fn, '(a)') trim(str_cat)
895 
896  ! aggregation method:
897  str_cat = ''
898  DO i = 1, SIZE(varlistsel)
899  str_x = varlistsel(i)%aggreg
900  IF (i == 1) THEN
901  str_cat = trim(adjustl(str_x))
902  ELSE
903  str_cat = trim(str_cat)//';'//adjustl(str_x)
904  ENDIF
905  END DO
906  WRITE (fn, '(a)') trim(str_cat)
907 
908  ! close file
909  CLOSE (fn)
910 
911  ! clean up
912  IF (ALLOCATED(varlistsel)) DEALLOCATE (varlistsel, stat=err)
913  IF (err /= 0) print *, "varListSel: Deallocation request denied"
914 
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 1186 of file suews_ctrl_output.f95.

1186  IMPLICIT NONE
1187  CHARACTER(len=365), INTENT(in) :: filename ! the output file name
1188  LOGICAL :: existq
1189  CHARACTER(len=1000) :: longstring
1190 
1191  INQUIRE (file=trim(filename), exist=existq)
1192  IF (existq) THEN
1193  OPEN (10, file=trim(filename))
1194  READ (10, '(a)') longstring
1195  ! print*, 'longstring: ',longstring
1196  IF (verify(longstring, 'Year') == 0) initq_file = .false.
1197  CLOSE (unit=10)
1198  ELSE
1199  initq_file = .false.
1200  END IF
1201 

◆ 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::solweigpoi_out, 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 = (/.true., &
582  solweigpoi_out == 1, &
583  cbluse >= 1, &
584  snowuse >= 1, &
585  storageheatmethod == 4 .OR. storageheatmethod == 14, &
586  .true., &
587  .true./)
588  xx = count(grpcond)
589 
590  ! PRINT*, grpList0,xx
591 
592  ALLOCATE (grplist(xx), stat=err)
593  IF (err /= 0) print *, "grpList: Allocation request denied"
594 
595  grplist = pack(grplist0, mask=grpcond)
596 
597  ! PRINT*, grpList,SIZE(grpList, dim=1)
598 
599  ! loop over all groups
600  DO i = 1, SIZE(grplist), 1
601  !PRINT*, 'i',i
602  xx = count(varlistall%group == trim(grplist(i)), dim=1)
603  ! PRINT*, 'number of variables:',xx, 'in group: ',grpList(i)
604  ! print*, 'all group names: ',varList%group
605  ALLOCATE (varlistx(5 + xx), stat=err)
606  IF (err /= 0) print *, "varListX: Allocation request denied"
607  ! datetime
608  varlistx(1:5) = varlistall(1:5)
609  ! variable
610  varlistx(6:5 + xx) = pack(varlistall, mask=(varlistall%group == trim(grplist(i))))
611 
612  IF (trim(varlistx(SIZE(varlistx))%group) /= 'DailyState') THEN
613  ! all output arrays but DailyState
614  ! all output frequency option:
615  ! as forcing:
616  IF (resolutionfilesout == tstep .OR. keeptstepfilesout == 1) THEN
617 ! #ifdef nc
618 ! IF (PRESENT(Gridiv)) THEN
619 ! #endif
620  CALL suews_output_txt_grp(iv, irmax, iyr, varlistx, gridiv, outlevel, tstep)
621 ! #ifdef nc
622 ! ELSE
623 ! CALL SUEWS_Output_nc_grp(irMax, varListX, outLevel, Tstep)
624 ! ENDIF
625 ! #endif
626 
627  ENDIF
628  ! as specified ResolutionFilesOut:
629  IF (resolutionfilesout /= tstep) THEN
630 ! #ifdef nc
631 ! IF (PRESENT(Gridiv)) THEN
632 ! #endif
633  CALL suews_output_txt_grp(iv, irmax, iyr, varlistx, gridiv, outlevel, resolutionfilesout)
634 ! #ifdef nc
635 ! ELSE
636 ! CALL SUEWS_Output_nc_grp(irMax, varListX, outLevel, ResolutionFilesOut)
637 ! ENDIF
638 ! #endif
639  ENDIF
640  ELSE
641  ! DailyState array, which does not need aggregation
642 ! #ifdef nc
643 ! IF (PRESENT(Gridiv)) THEN
644 ! #endif
645  CALL suews_output_txt_grp(iv, irmax, iyr, varlistx, gridiv, outlevel, tstep)
646 ! #ifdef nc
647 ! ELSE
648 ! CALL SUEWS_Output_nc_grp(irMax, varListX, outLevel, Tstep)
649 ! ENDIF
650 ! #endif
651  ENDIF
652 
653  IF (ALLOCATED(varlistx)) DEALLOCATE (varlistx, stat=err)
654  IF (err /= 0) print *, "varListX: Deallocation request denied"
655  ! PRINT*, 'i',i,'end'
656 
657  END DO
integer keeptstepfilesout
integer resolutionfilesout
integer solweigpoi_out
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 919 of file suews_ctrl_output.f95.

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

Referenced by suews_output_txt_grp().

919  IMPLICIT NONE
920  REAL(KIND(1d0)), DIMENSION(:, :), INTENT(in)::dataoutx
921  TYPE(varattr), DIMENSION(:), INTENT(in)::varlist
922  INTEGER, INTENT(in) :: irmax, outfreq_s
923  REAL(KIND(1d0)), DIMENSION(:, :), ALLOCATABLE, INTENT(out)::dataout_agg
924 
925  INTEGER :: nlinesout, i, j, x
926  REAL(KIND(1d0))::dataout_aggx(1:size(varlist))
927  REAL(KIND(1d0)), DIMENSION(:, :), ALLOCATABLE::dataout_agg0
928  nlinesout = int(nsh/(60.*60/outfreq_s))
929  ! nGrid=SIZE(dataOutX, dim=3)
930 
931  ALLOCATE (dataout_agg(int(irmax/nlinesout), SIZE(varlist)))
932  ALLOCATE (dataout_agg0(nlinesout, SIZE(varlist)))
933 
934  DO i = nlinesout, irmax, nlinesout
935  x = i/nlinesout
936  dataout_agg0 = dataoutx(i - nlinesout + 1:i, :)
937  DO j = 1, SIZE(varlist), 1
938  ! aggregating different variables
939  SELECT CASE (varlist(j)%aggreg)
940  CASE (at) !time columns, aT
941  dataout_aggx(j) = dataout_agg0(nlinesout, j)
942  CASE (aa) !average, aA
943  dataout_aggx(j) = sum(dataout_agg0(:, j))/nlinesout
944  CASE (as) !sum, aS
945  dataout_aggx(j) = sum(dataout_agg0(:, j))
946  CASE (al) !last value, aL
947  dataout_aggx(j) = dataout_agg0(nlinesout, j)
948  END SELECT
949 
950  IF (diagnose == 1 .AND. i == irmax) THEN
951  ! IF ( i==irMax ) THEN
952  print *, 'raw data of ', j, ':'
953  print *, dataout_agg0(:, j)
954  print *, 'aggregated with method: ', varlist(j)%aggreg
955  print *, dataout_aggx(j)
956  print *, ''
957  END IF
958  END DO
959  dataout_agg(x, :) = dataout_aggx
960  END DO
961 
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 746 of file suews_ctrl_output.f95.

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

Referenced by suews_output_txt_grp().

746  IMPLICIT NONE
747  REAL(KIND(1d0)), DIMENSION(:, :), INTENT(in)::dataoutx
748  TYPE(varattr), DIMENSION(:), INTENT(in)::varlist
749  INTEGER, INTENT(in) :: iyr, gridiv, outlevel
750 
751  TYPE(varattr), DIMENSION(:), ALLOCATABLE::varlistsel
752  INTEGER :: xx, err, fn, i, nargs
753  CHARACTER(len=365) :: fileoutx
754  CHARACTER(len=3) :: itextx
755  CHARACTER(len=6) :: args(5)
756  CHARACTER(len=16*SIZE(varList)) :: formatout
757  CHARACTER(len=16) :: formatx
758  CHARACTER(len=16), DIMENSION(:), ALLOCATABLE:: headerout
759 
760  ! select variables to output
761  xx = count((varlist%level <= outlevel), dim=1)
762  WRITE (itextx, '(i3)') xx
763  ALLOCATE (varlistsel(xx), stat=err)
764  IF (err /= 0) print *, "varListSel: Allocation request denied"
765  varlistsel = pack(varlist, mask=(varlist%level <= outlevel))
766 
767  ! generate file name
768  CALL filename_gen(dataoutx, varlist, iyr, gridiv, fileoutx)
769 
770  ! store right-aligned headers
771  ALLOCATE (headerout(xx), stat=err)
772  IF (err /= 0) print *, "headerOut: Allocation request denied"
773 
774  ! create format string:
775  DO i = 1, SIZE(varlistsel)
776  CALL parse(varlistsel(i)%fmt, 'if.,', args, nargs)
777  formatx = adjustl('(a'//trim(args(2))//',1x)')
778  ! adjust headers to right-aligned
779  WRITE (headerout(i), formatx) adjustr(trim(adjustl(varlistsel(i)%header)))
780  IF (i == 1) THEN
781  formatout = adjustl(trim(formatx))
782  ELSE
783  formatout = trim(formatout)//' '//adjustl(trim(formatx))
784  END IF
785  END DO
786  formatout = '('//trim(adjustl(formatout))//')'
787 
788  ! create file
789  fn = 9
790  OPEN (fn, file=trim(adjustl(fileoutx)), status='unknown')
791  ! PRINT*, 'FileOutX in SUEWS_Output_Init: ',FileOutX
792 
793  ! write out headers
794  WRITE (fn, formatout) headerout
795  CLOSE (fn)
796 
797  ! write out format file
798  CALL formatfile_gen(dataoutx, varlist, iyr, gridiv, outlevel)
799 
800  ! clean up
801  IF (ALLOCATED(varlistsel)) DEALLOCATE (varlistsel, stat=err)
802  IF (err /= 0) print *, "varListSel: Deallocation request denied"
803  IF (ALLOCATED(headerout)) DEALLOCATE (headerout, stat=err)
804  IF (err /= 0) print *, "headerOut: Deallocation request denied"
805 
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 662 of file suews_ctrl_output.f95.

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

Referenced by suews_output().

662  IMPLICIT NONE
663 
664  TYPE(varattr), DIMENSION(:), INTENT(in)::varlistx
665  INTEGER, INTENT(in) :: iv, irmax, iyr, gridiv, outlevel, outfreq_s
666 
667  INTEGER :: err
668 
669  INTEGER, DIMENSION(:), ALLOCATABLE ::id_seq ! id sequence as in the dataOutX/dataOutX_agg
670  REAL(KIND(1d0)), DIMENSION(:, :), ALLOCATABLE::dataoutx
671  REAL(KIND(1d0)), DIMENSION(:, :), ALLOCATABLE::dataoutx_agg
672 
673  IF (.NOT. ALLOCATED(dataoutx)) THEN
674  ALLOCATE (dataoutx(irmax, SIZE(varlistx)), stat=err)
675  IF (err /= 0) print *, "dataOutX: Allocation request denied"
676  ENDIF
677 
678  ! determine dataOutX array according to variable group
679  SELECT CASE (trim(varlistx(SIZE(varlistx))%group))
680  CASE ('SUEWS') !default
681  dataoutx = dataoutsuews(1:irmax, 1:SIZE(varlistx), gridiv)
682 
683  ! CASE ('SOLWEIG') !SOLWEIG
684  ! ! todo: inconsistent data structure
685  ! dataOutX = dataOutSOL(1:irMax, 1:SIZE(varListX), Gridiv)
686 
687  CASE ('BL') !BL
688  dataoutx = dataoutbl(1:irmax, 1:SIZE(varlistx), gridiv)
689 
690  CASE ('snow') !snow
691  dataoutx = dataoutsnow(1:irmax, 1:SIZE(varlistx), gridiv)
692 
693  CASE ('ESTM') !ESTM
694  dataoutx = dataoutestm(1:irmax, 1:SIZE(varlistx), gridiv)
695 
696  CASE ('RSL') !ESTM
697  dataoutx = dataoutrsl(1:irmax, 1:SIZE(varlistx), gridiv)
698 
699  CASE ('DailyState') !DailyState
700  ! get correct day index
701  CALL unique(int(pack(dataoutsuews(1:irmax, 2, gridiv), &
702  mask=(dataoutsuews(1:irmax, 3, gridiv) == 23 &
703  .AND. dataoutsuews(1:irmax, 4, gridiv) == (nsh - 1.)/nsh*60))), &
704  id_seq)
705 
706  IF (ALLOCATED(dataoutx)) THEN
707  DEALLOCATE (dataoutx)
708  IF (err /= 0) print *, "dataOutX: Deallocation request denied"
709  ENDIF
710 
711  IF (.NOT. ALLOCATED(dataoutx)) THEN
712  ALLOCATE (dataoutx(SIZE(id_seq), SIZE(varlistx)), stat=err)
713  IF (err /= 0) print *, "dataOutX: Allocation request denied"
714  ENDIF
715 
716  dataoutx = dataoutdailystate(id_seq, 1:SIZE(varlistx), gridiv)
717  ! print*, id_seq
718  ! print*, dataOutDailyState(id_seq,1:SIZE(varListX),Gridiv)
719  ! print*, 1/(nsh-nsh)
720  END SELECT
721 
722  ! aggregation:
723  ! aggregation is done for every group but 'DailyState'
724  IF (trim(varlistx(SIZE(varlistx))%group) /= 'DailyState') THEN
725 
726  CALL suews_output_agg(dataoutx_agg, dataoutx, varlistx, irmax, outfreq_s)
727  ELSE
728  IF (.NOT. ALLOCATED(dataoutx_agg)) THEN
729  ALLOCATE (dataoutx_agg(SIZE(dataoutx, dim=1), SIZE(varlistx)), stat=err)
730  IF (err /= 0) print *, ": Allocation request denied"
731  ENDIF
732  dataoutx_agg = dataoutx
733  ENDIF
734 
735  ! output:
736  ! initialise file when processing first metblock
737  IF (iv == 1) CALL suews_output_init(dataoutx_agg, varlistx, iyr, gridiv, outlevel)
738 
739  ! append the aggregated data to the specific txt file
740  CALL suews_write_txt(dataoutx_agg, varlistx, iyr, gridiv, outlevel)
741 
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
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 966 of file suews_ctrl_output.f95.

References data_in::diagnose, and filename_gen().

Referenced by suews_output_txt_grp().

966  IMPLICIT NONE
967  REAL(KIND(1d0)), DIMENSION(:, :), INTENT(in)::dataoutx
968  TYPE(varattr), DIMENSION(:), INTENT(in)::varlist
969  INTEGER, INTENT(in) :: iyr, gridiv, outlevel
970 
971  REAL(KIND(1d0)), DIMENSION(:, :), ALLOCATABLE::dataoutsel
972  TYPE(varattr), DIMENSION(:), ALLOCATABLE::varlistsel
973  CHARACTER(len=365) :: fileoutx
974  INTEGER :: fn, i, xx, err
975  INTEGER :: sizevarlistsel, sizedataoutx
976  CHARACTER(len=12*SIZE(varList)) :: formatout
977  ! LOGICAL :: initQ_file
978  formatout = ''
979 
980  IF (diagnose == 1) WRITE (*, *) 'Writting data of group: ', varlist(SIZE(varlist))%group
981 
982  !select variables to output
983  sizevarlistsel = count((varlist%level <= outlevel), dim=1)
984  ALLOCATE (varlistsel(sizevarlistsel), stat=err)
985  IF (err /= 0) print *, "varListSel: Allocation request denied"
986  varlistsel = pack(varlist, mask=(varlist%level <= outlevel))
987 
988  ! copy data accordingly
989  sizedataoutx = SIZE(dataoutx, dim=1)
990  ALLOCATE (dataoutsel(sizedataoutx, sizevarlistsel), stat=err)
991  IF (err /= 0) print *, "dataOutSel: Allocation request denied"
992  ! print*, SIZE(varList%level),PACK((/(i,i=1,SIZE(varList%level))/), varList%level <= outLevel)
993  ! print*, irMax,shape(dataOutX)
994  dataoutsel = dataoutx(:, pack((/(i, i=1, SIZE(varlist%level))/), varlist%level <= outlevel))
995 
996  ! create format string:
997  DO i = 1, sizevarlistsel
998  ! PRINT*,''
999  ! PRINT*,i
1000  ! PRINT*, LEN_TRIM(FormatOut),TRIM(FormatOut)
1001  ! PRINT*, LEN_TRIM(TRIM(FormatOut)//','),TRIM(FormatOut)//','
1002  IF (i == 1) THEN
1003  ! FormatOut=ADJUSTL(varListSel(i)%fmt)
1004  formatout = varlistsel(i)%fmt
1005  ELSE
1006 
1007  ! FormatOut=TRIM(FormatOut)//','//ADJUSTL(varListSel(i)%fmt)
1008  formatout = trim(formatout)//','//trim(varlistsel(i)%fmt)
1009  END IF
1010  ! PRINT*,''
1011  ! PRINT*,i
1012  ! PRINT*, 'FormatOut',FormatOut
1013  END DO
1014  formatout = '('//trim(adjustl(formatout))//')'
1015 
1016  ! get filename
1017  CALL filename_gen(dataoutsel, varlistsel, iyr, gridiv, fileoutx)
1018  ! PRINT*, 'FileOutX in SUEWS_Write_txt: ',FileOutX
1019 
1020  ! test if FileOutX has been initialised
1021  ! IF ( .NOT. initQ_file(FileOutX) ) THEN
1022  ! CALL SUEWS_Output_Init(dataOutSel,varListSel,Gridiv,outLevel)
1023  ! END IF
1024 
1025  ! write out data
1026  fn = 50
1027  OPEN (fn, file=trim(fileoutx), position='append')!,err=112)
1028  DO i = 1, sizedataoutx
1029  ! PRINT*, 'Writting',i
1030  ! PRINT*, 'FormatOut',FormatOut
1031  ! PRINT*, dataOutSel(i,1:sizeVarListSel)
1032  WRITE (fn, formatout) &
1033  (int(dataoutsel(i, xx)), xx=1, 4), &
1034  (dataoutsel(i, xx), xx=5, sizevarlistsel)
1035  ENDDO
1036  CLOSE (fn)
1037 
1038  IF (ALLOCATED(varlistsel)) DEALLOCATE (varlistsel, stat=err)
1039  IF (err /= 0) print *, "varListSel: Deallocation request denied"
1040 
1041  IF (ALLOCATED(dataoutsel)) DEALLOCATE (dataoutsel, stat=err)
1042  IF (err /= 0) print *, "dataOutSel: Deallocation request denied"
1043 
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 1147 of file suews_ctrl_output.f95.

Referenced by suews_output_txt_grp().

1147  ! Return only the unique values from vec.
1148 
1149  IMPLICIT NONE
1150 
1151  INTEGER, DIMENSION(:), INTENT(in) :: vec
1152  INTEGER, DIMENSION(:), ALLOCATABLE, INTENT(out) :: vec_unique
1153 
1154  INTEGER :: i, num
1155  LOGICAL, DIMENSION(SIZE(vec)) :: mask
1156 
1157  mask = .false.
1158 
1159  DO i = 1, SIZE(vec)
1160 
1161  !count the number of occurrences of this element:
1162  num = count(vec(i) == vec)
1163 
1164  IF (num == 1) THEN
1165  !there is only one, flag it:
1166  mask(i) = .true.
1167  ELSE
1168  !flag this value only if it hasn't already been flagged:
1169  IF (.NOT. any(vec(i) == vec .AND. mask)) mask(i) = .true.
1170  END IF
1171 
1172  END DO
1173 
1174  !return only flagged elements:
1175  ALLOCATE (vec_unique(count(mask)))
1176  vec_unique = pack(vec, mask)
1177 
1178  !if you also need it sorted, then do so.
1179  ! For example, with slatec routine:
1180  !call ISORT (vec_unique, [0], size(vec_unique), 1)
1181 
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)