WIP

UMEP-dev · Oct 10, 2024 · b2600f8 · b2600f8
1 parent 17553a7
commit b2600f8
Show file tree

Hide file tree

Showing 5 changed files with 76 additions and 56 deletions.
diff --git a/src/suews/src/suews_ctrl_const.f95 b/src/suews/src/suews_ctrl_const.f95
@@ -88,7 +88,7 @@ MODULE allocateArray
                          ncolumnsDataOutRSL = 30*4 + 5 + 13 + 2, &
                          ncolumnsDataOutDebug = 5 + 103 + 14 + 5 + 4 + 3 + 1, &
                          ncolumnsDataOutSPARTACUS = 5 + 7 + 4*15 + 3 + 6*15 + 2*15 + 4, &
-                         ncolumnsDataOutSTEBBS = 5 + 5
+                         ncolumnsDataOutSTEBBS = 5 + 6
 
    ! ---- Define input file headers ---------------------------------------------------------------
    CHARACTER(len=20), DIMENSION(ncolumnsSiteSelect) :: HeaderSiteSelect_File !Header for SiteSelect.txt

diff --git a/src/suews/src/suews_ctrl_driver.f95 b/src/suews/src/suews_ctrl_driver.f95
@@ -206,6 +206,7 @@ SUBROUTINE SUEWS_cal_Main( &
             dataOutLineDebug = -999.
             dataOutLineSPARTACUS = -999.
             dataOutLineDailyState = -999.
+            dataOutLineSTEBBS = -999.
 
             !########################################################################################
             !           main calculation starts here
@@ -470,6 +471,7 @@ SUBROUTINE SUEWS_cal_Main( &
                datetimeLine, & ! input
                dataOutLineSTEBBS) ! output
 
+
             !==============translation of  output variables into output array===========
             IF (Diagnose == 1) WRITE (*, *) 'Calling BEERS_cal_main_DTS...'
             CALL SUEWS_update_outputLine_DTS( &
@@ -3661,7 +3663,8 @@ SUBROUTINE SUEWS_update_output( &
       ReadLinesMetdata, NumberOfGrids, &
       ir, gridiv, &
       dataOutLineSUEWS, dataOutLineSnow, dataOutLineESTM, dataoutLineRSL, dataOutLineBEERS, &
-      dataoutlineDebug, dataoutlineSPARTACUS, dataOutLineEHC, dataOutLineSTEBBS, & !input
+      dataoutlineDebug, dataoutlineSPARTACUS, dataOutLineEHC, &
+      dataOutLineSTEBBS, & !input
       dataOutSUEWS, dataOutSnow, dataOutESTM, dataOutRSL, dataOutBEERS, dataOutDebug, dataOutSPARTACUS, &
       dataOutEHC, dataOutSTEBBS) !inout
       IMPLICIT NONE
@@ -4109,7 +4112,7 @@ SUBROUTINE SUEWS_cal_multitsteps( &
       sw_dn_direct_frac, air_ext_sw, air_ssa_sw, &
       veg_ssa_sw, air_ext_lw, air_ssa_lw, veg_ssa_lw, &
       veg_fsd_const, veg_contact_fraction_const, &
-      ground_albedo_dir_mult_fact, use_sw_direct_albedo, nbtype, & !input
+      ground_albedo_dir_mult_fact, use_sw_direct_albedo, & !input
       height, building_frac, veg_frac, building_scale, veg_scale, & !input: SPARTACUS
       alb_roof, emis_roof, alb_wall, emis_wall, &
       roof_albedo_dir_mult_fact, wall_specular_frac, &
@@ -4195,7 +4198,7 @@ SUBROUTINE SUEWS_cal_multitsteps( &
       INTEGER, INTENT(IN) :: SnowUse ! Determines whether the snow part of the model runs[-]
       LOGICAL, INTENT(IN) :: use_sw_direct_albedo !boolean, Specify ground and roof albedos separately for direct solar radiation [-]
       INTEGER, INTENT(IN) :: OHMIncQF ! Determines whether the storage heat flux calculation uses Q* or ( Q* +QF) [-]
-      INTEGER, INTENT(IN) :: nbtype ! number of building types [-] STEBBS
+      ! INTEGER, INTENT(IN) :: nbtype ! number of building types [-] STEBBS
 
       ! ---lumps-related variables
       TYPE(LUMPS_PRM) :: lumpsPrm
@@ -5326,7 +5329,8 @@ SUBROUTINE SUEWS_cal_multitsteps( &
             output_line_suews%dataOutLineSTEBBS, & !input
             dataOutBlockSUEWS_X, dataOutBlockSnow_X, dataOutBlockESTM_X, & !
             dataOutBlockRSL_X, dataOutBlockBEERS_X, dataOutBlockDebug_X, dataOutBlockSPARTACUS_X, dataOutBlockEHC_X, &
-            dataOutBlockSTEBBS_X) !inout
+            dataOutBlockSTEBBS_X &
+            ) !inout
 
       END DO
 

diff --git a/src/suews/src/suews_ctrl_output.f95 b/src/suews/src/suews_ctrl_output.f95
@@ -1188,10 +1188,12 @@ MODULE ctrl_output
         + ncolumnsDataOutSTEBBS - 5 &
         )/ &
       varAttr('QStar', 'W m-2', f104, 'Net all-wave radiation', aA, 'STEBBS', 0), &
-      varAttr('QEC', 'W m-2', f104, 'Energy Consumption (TEMP)', aA, 'STEBBS', 0), &
       varAttr('QH', 'W m-2', f104, 'Sensible heat flux', aA, 'STEBBS', 0), &
       varAttr('QS', 'W m-2', f104, 'Storage heat flux', aA, 'STEBBS', 0), &
-      varAttr('QWaste', 'W m-2', f104, 'Waste heat flux (TEMP)', aA, 'STEBBS', 0) &
+      varAttr('QEC', 'W m-2', f104, 'Energy Consumption (TEMP)', aA, 'STEBBS', 0), &
+      varAttr('QWaste', 'W m-2', f104, 'Waste heat flux (TEMP)', aA, 'STEBBS', 0), &
+      ! varAttr('Qsw_abs_wr', 'W m-2', f104, 'TEMP', aA, 'STEBBS', 0), &
+      varAttr('Textwallroof', 'degC', f104, 'TEMP', aA, 'STEBBS', 0) &
       /
 
 CONTAINS
@@ -1207,9 +1209,9 @@ SUBROUTINE SUEWS_Output(irMax, iv, Gridiv, iyr)
 
       INTEGER :: n_group_use, err, outLevel, i
       TYPE(varAttr), DIMENSION(:), ALLOCATABLE :: varListX
-      CHARACTER(len=10) :: groupList0(10)
+      CHARACTER(len=10) :: groupList0(11)
       CHARACTER(len=10), DIMENSION(:), ALLOCATABLE :: grpList
-      LOGICAL :: groupCond(10)
+      LOGICAL :: groupCond(11)
 
       ! determine outLevel
       SELECT CASE (WriteOutOption)
@@ -1233,6 +1235,7 @@ SUBROUTINE SUEWS_Output(irMax, iv, Gridiv, iyr)
       groupList0(8) = 'debug'
       groupList0(9) = 'SPARTACUS'
       groupList0(10) = 'EHC'
+      groupList0(11) = 'STEBBS'
       groupCond = [ &
                   .TRUE., &
                   .TRUE., &
@@ -1243,7 +1246,8 @@ SUBROUTINE SUEWS_Output(irMax, iv, Gridiv, iyr)
                   .TRUE., &
                   .TRUE., &
                   .TRUE., &
-                  StorageHeatMethod == 5 &
+                  StorageHeatMethod == 5, &
+                  .TRUE. &
                   ]
       n_group_use = COUNT(groupCond)
 

diff --git a/src/suews/src/suews_ctrl_type.f95 b/src/suews/src/suews_ctrl_type.f95
@@ -929,6 +929,7 @@ SUBROUTINE output_line_init(self)
       self%dataOutLineSPARTACUS = -999.0
       self%dataOutLineDailyState = -999.0
       self%dataOutLineSTEBBS = -999.0
+      ! WRITE(*, *) ncolumnsDataOutSTEBBS
    END SUBROUTINE output_line_init
 
    SUBROUTINE output_block_init(self, len)

diff --git a/src/suews/src/suews_phys_stebbs.f95 b/src/suews/src/suews_phys_stebbs.f95
@@ -675,8 +675,8 @@ MODULE stebbs_module
    SUBROUTINE stebbsonlinecouple( &
       timer, config, forcing, siteInfo, & ! Input
       modState, & ! Input/Output
-      datetimeLine, & ! Input
-      dataoutLineSTEBBS) ! Output
+      datetimeLine, &
+      dataOutLineSTEBBS) ! Output
 !
       USE modulestebbs, ONLY: nbtype, blds, cases, fnmls, resolution
       USE modulesuewsstebbscouple, ONLY: sout ! Defines sout
@@ -698,18 +698,19 @@ SUBROUTINE stebbsonlinecouple( &
 !
       TYPE(SUEWS_STATE), INTENT(INOUT) :: modState
 !
-      REAL(KIND(1D0)), INTENT(out), DIMENSION(ncolumnsDataOutSTEBBS - 5) :: dataoutLineSTEBBS
+      REAL(KIND(1D0)), INTENT(OUT), DIMENSION(ncolumnsDataOutSTEBBS - 5) :: dataOutLineSTEBBS
 !
       INTEGER :: i, ios
       ! INTEGER, INTENT(in) :: timestep ! MP replaced from line 706
-      INTEGER :: timestep
+      ! INTEGER :: timestep
       INTEGER, SAVE :: flginit = 0
       CHARACTER(LEN=256) :: command, filename
       CHARACTER(LEN=256), ALLOCATABLE :: file_list(:)
       INTEGER :: num_files
 !
       ! REAL(rprc), INTENT(in) :: Tair_sout, Tsurf_sout, Kroof_sout, &
       !                           Kwall_sout, Lwall_sout, Lroof_sout, ws
+
       REAL(rprc), DIMENSION(5), INTENT(in) :: datetimeLine ! To replace
 !
       ! NAMELIST /settings/ nbtype, resolution
@@ -721,6 +722,7 @@ SUBROUTINE stebbsonlinecouple( &
       REAL(rprc) :: Kwall_sout, Lwall_sout
       ! REAL(rprc) :: Kroof_sout, Lroof_sout
       REAL(rprc) :: QStar, QH, QS, QEC, QWaste
+      REAL(rprc) :: Qsw_absorbed_wallroof, Textwallroof
       ! REAL(rprc) :: ws, Tair_sout
       REAL(rprc) :: Tsurf_sout
 
@@ -750,8 +752,7 @@ SUBROUTINE stebbsonlinecouple( &
             Least => bldgState%Least, &
             Lwest => bldgState%Lwest &
             )
-
-!
+            !
             wallStatesK(1) = Knorth
             wallStatesK(2) = Ksouth
             wallStatesK(3) = Keast
@@ -765,8 +766,8 @@ SUBROUTINE stebbsonlinecouple( &
             wallStatesL(3) = Least
             wallStatesL(4) = Lwest
             Lwall_sout = SUM(wallStatesL)/SIZE(wallStatesL)
-
-!       !
+            
+            !       !
             IF (flginit == 0) THEN
 
                command = 'ls ./BuildClasses/*.nml > file_list.txt'
@@ -809,7 +810,6 @@ SUBROUTINE stebbsonlinecouple( &
 !          !
 
                DO i = 1, nbtype, 1
-                  ! fnmls(i) = './BuildClasses/'//TRIM(cases(i))//'.nml'
                   fnmls(i) = TRIM(cases(i))
                   WRITE(*, *) '    + Building class file : ', TRIM(fnmls(i))
                   CALL create_building(cases(i), blds(i), i) ! also changed cases here
@@ -864,7 +864,9 @@ SUBROUTINE stebbsonlinecouple( &
 !       !
             DO i = 1, nbtype, 1
                CALL suewsstebbscouple(blds(i), &
-                                      QStar, QH, QS, QEC, QWaste)
+                                      QStar, QH, QS, QEC, QWaste, &
+                                      Qsw_absorbed_wallroof, Textwallroof &
+                                      )
             END DO
 !       !
 !       !
@@ -876,8 +878,8 @@ SUBROUTINE stebbsonlinecouple( &
 !       !
 !       !
             flginit = 1
-            !
-            dataoutLineSTEBBS = [QStar, QH, QS, QEC, QWaste]
+
+            dataOutLineSTEBBS = [QStar, QH, QS, QEC, QWaste, Qsw_absorbed_wallroof]
             RETURN
 !          !
          END ASSOCIATE
@@ -992,15 +994,18 @@ END SUBROUTINE readsuewsout
 !
 !
 SUBROUTINE suewsstebbscouple(self, &
-                             QStar, QH, QS, QEC, QWaste) ! Output
+                             QStar, QH, QS, QEC, QWaste, &
+                             Qsw_absorbed_wallroof, Textwallroof) ! Output
 !
    USE modulestebbsprecision
    USE modulestebbs, ONLY: LBM, resolution
    USE modulestebbsfunc, ONLY: ext_conv_coeff
    USE modulesuewsstebbscouple, ONLY: &
       sout, &
       Tair_out, Tground_deep, Tsurf, density_air_out, &
-      cp_air_out, Qsw_dn_extroof, Qsw_dn_extwall, &
+      cp_air_out, &
+      Qsw_dn_extroof, &
+      Qsw_dn_extwall, &
       Qlw_dn_extwall, Qlw_dn_extroof
 !
    IMPLICIT NONE
@@ -1015,42 +1020,48 @@ SUBROUTINE suewsstebbscouple(self, &
                  Qconv_extwindow_to_outair, Qconv_extwallroof_to_outair, QH, QS, &
                  Qcond_ground, Q_ventilation, QBAE, Q_waste, QWaste, &
                  temp, Textwallroof, Tintwallroof, Textwindow, Tintwindow, Tair_ind
+               !   Qlw_dn_extroof, Qlw_dn_extwall, Qsw_dn_extroof, Qsw_dn_extwall                 
 !
    REAL(rprc), DIMENSION(6) :: bem_qf_1
    REAL(rprc), DIMENSION(25) :: energyEx
    CHARACTER(len=256) :: CASE
    CHARACTER(len=256), DIMENSION(4) :: fout
 !
-   INTENT(OUT) :: QStar, QH, QS, QEC, QWaste
+   ! INTENT(OUT) :: QStar, QH, QS, QEC, QWaste
+   ! INTENT(OUT) :: Qsw_transmitted_window, Qsw_absorbed_window, Qsw_absorbed_wallroof, &
+   !          qmc, qir, qirw, qirf, qia, avr, qwc, qwic, qfc, qha, qwcon, qwicon, &
+   !          qfcon, Qcond_ground, Qlw_net_extwallroof_to_outair, Qlw_net_extwindow_to_outair, &
+   !          Qconv_extwallroof_to_outair, Qconv_extwindow_to_outair, qwaste, QS, QS_fabric, QS_air
 !
+   INTENT(OUT) :: QStar, QH, QS, QEC, QWaste, Qsw_absorbed_wallroof, Textwallroof
 !
    CASE = self%CASE
    Area = self%Afootprint
 !
 !
 !
-   IF (self%flginit == 0) THEN
-!
-!     Output file
-!
-      ! fout(1) = 'Output_'//TRIM(CASE)//'.csv'; fout(2) = 'HeatFluxes_'//TRIM(CASE)//'.csv'
-      ! fout(3) = 'EnergyBalance_'//TRIM(CASE)//'.csv'; fout(4) = 'Temp_'//TRIM(CASE)//'.csv'
-      fout(1) = 'Output.csv'; fout(2) = 'HeatFluxes.csv'
-      fout(3) = 'EnergyBalance.csv'; fout(4) = 'Temp.csv'
-!
-      DO i = 1, 4, 1
-         OPEN (i + 100*self%idLBM, file=TRIM(fout(i)), status='unknown', form='formatted')
-      END DO
-
-      WRITE (1 + 100*self%idLBM, *) ',qheat_dom, qcool_dom, dom_tind, qfb_hw_dom, qfm_dom, qfb_dom_air'
-      WRITE (2 + 100*self%idLBM, *) ',Qsw_transmitted_window, Qsw_absorbed_window, Qsw_absorbed_wallroof, '// &
-         'qmc, qir, qirw, qirf, qia, avr, qwc, qwic, qfc, qha, qwcon, qwicon, '// &
-         'qfcon, Qcond_ground, Qlw_net_extwallroof_to_outair, Qlw_net_extwindow_to_outair, '// &
-         'Qconv_extwallroof_to_outair, Qconv_extwindow_to_outair, qwaste, QS, QS_fabric, QS_air'
-      WRITE (3 + 100*self%idLBM, *) ',QStar, QEC, QH, QS, QBAE, QWaste'
-      WRITE (4 + 100*self%idLBM, *) ',Textwallroof, Tintwallroof, Textwindow, Tintwindow, Tair_ind'
-!
-   END IF
+!    IF (self%flginit == 0) THEN
+! !
+! !     Output file
+! !
+!       ! fout(1) = 'Output_'//TRIM(CASE)//'.csv'; fout(2) = 'HeatFluxes_'//TRIM(CASE)//'.csv'
+!       ! fout(3) = 'EnergyBalance_'//TRIM(CASE)//'.csv'; fout(4) = 'Temp_'//TRIM(CASE)//'.csv'
+!       fout(1) = 'Output.csv'; fout(2) = 'HeatFluxes.csv'
+!       fout(3) = 'EnergyBalance.csv'; fout(4) = 'Temp.csv'
+! !
+!       DO i = 1, 4, 1
+!          OPEN (i + 100*self%idLBM, file=TRIM(fout(i)), status='unknown', form='formatted')
+!       END DO
+
+!       WRITE (1 + 100*self%idLBM, *) ',qheat_dom, qcool_dom, dom_tind, qfb_hw_dom, qfm_dom, qfb_dom_air'
+!       WRITE (2 + 100*self%idLBM, *) ',Qsw_transmitted_window, Qsw_absorbed_window, Qsw_absorbed_wallroof, '// &
+!          'qmc, qir, qirw, qirf, qia, avr, qwc, qwic, qfc, qha, qwcon, qwicon, '// &
+!          'qfcon, Qcond_ground, Qlw_net_extwallroof_to_outair, Qlw_net_extwindow_to_outair, '// &
+!          'Qconv_extwallroof_to_outair, Qconv_extwindow_to_outair, qwaste, QS, QS_fabric, QS_air'
+!       WRITE (3 + 100*self%idLBM, *) ',QStar, QEC, QH, QS, QBAE, QWaste'
+!       WRITE (4 + 100*self%idLBM, *) ',Textwallroof, Tintwallroof, Textwindow, Tintwindow, Tair_ind'
+! !
+!    END IF
 !
 !
 !  Time integration start
@@ -1164,14 +1175,14 @@ SUBROUTINE suewsstebbscouple(self, &
 !
 !
 !
-      WRITE (1 + 100*self%idLBM, '(a19,1x,6(",",f10.5))') TRIM(sout%datetime(tstep))//' '//TRIM(sout%hourmin(tstep)), &
-         qheat_dom, qcool_dom, dom_temp, qfb_hw_dom, qfm_dom, qfb_dom_air
-      WRITE (2 + 100*self%idLBM, '(a19,1x,25(",",f15.5))') TRIM(sout%datetime(tstep))//' '//TRIM(sout%hourmin(tstep)), &
-         (energyEx(i)/Area, i=1, 25, 1)
-      WRITE (3 + 100*self%idLBM, '(a19,1x,6(",",f15.5))') TRIM(sout%datetime(tstep))//' '//TRIM(sout%hourmin(tstep)), QStar, QEC, &
-         QH, QS, QBAE, QWaste
-     WRITE (4 + 100*self%idLBM, '(a19,1x,5(",",f15.5))') TRIM(sout%datetime(tstep))//' '//TRIM(sout%hourmin(tstep)), Textwallroof, &
-         Tintwallroof, Textwindow, Tintwindow, Tair_ind
+   !    WRITE (1 + 100*self%idLBM, '(a19,1x,6(",",f10.5))') TRIM(sout%datetime(tstep))//' '//TRIM(sout%hourmin(tstep)), &
+   !       qheat_dom, qcool_dom, dom_temp, qfb_hw_dom, qfm_dom, qfb_dom_air
+   !    WRITE (2 + 100*self%idLBM, '(a19,1x,25(",",f15.5))') TRIM(sout%datetime(tstep))//' '//TRIM(sout%hourmin(tstep)), &
+   !       (energyEx(i)/Area, i=1, 25, 1)
+   !    WRITE (3 + 100*self%idLBM, '(a19,1x,6(",",f15.5))') TRIM(sout%datetime(tstep))//' '//TRIM(sout%hourmin(tstep)), QStar, QEC, &
+   !       QH, QS, QBAE, QWaste
+   !   WRITE (4 + 100*self%idLBM, '(a19,1x,5(",",f15.5))') TRIM(sout%datetime(tstep))//' '//TRIM(sout%hourmin(tstep)), Textwallroof, &
+   !       Tintwallroof, Textwindow, Tintwindow, Tair_ind
 !
 !
 !
@@ -1191,7 +1202,7 @@ SUBROUTINE suewsstebbscouple(self, &
    self%QS = QS
    self%QBAE = QBAE
    self%QWaste = QWaste
-!
+
 !
 !
    self%flginit = 1