Ignore:
Timestamp:
Feb 15, 2019 6:38:58 PM (5 years ago)
Author:
suehring
Message:

Coupling of indoor model to atmosphere; output of indoor temperatures and waste heat; enable restarts with indoor model; bugfix plant transpiration; bugfix - missing calculation of 10cm temperature

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/urban_surface_mod.f90

    r3743 r3744  
    2323! Current revisions:
    2424! ------------------
    25 !
     25! - Remove internal flag indoor_model (is a global control parameter)
     26! - add waste heat from buildings to the kinmatic heat flux
     27! - consider waste heat in restart data
     28! - remove unused USE statements
    2629!
    2730! Former revisions:
     
    401404!> @todo Output of _av variables in case of restarts
    402405!> @todo Revise flux conversion in energy-balance solver
    403 !> @todo Bugfixing in nopointer branch
    404406!> @todo Check optimizations for RMA operations
    405407!> @todo Alternatives for MPI_WIN_ALLOCATE? (causes problems with openmpi)
    406408!> @todo Check for load imbalances in CPU measures, e.g. for exchange_horiz_prog
    407409!>       factor 3 between min and max time
    408 !> @todo Move setting of flag indoor_model to indoor_model_mod once available
    409410!> @todo Check divisions in wtend (etc.) calculations for possible division
    410411!>       by zero, e.g. in case fraq(0,m) + fraq(1,m) = 0?!
     
    424425
    425426    USE control_parameters,                                                    &
    426         ONLY:  coupling_start_time, topography, dt_3d, humidity,               &
     427        ONLY:  coupling_start_time, topography, dt_3d, humidity, indoor_model, &
    427428               intermediate_timestep_count, initializing_actions,              &
    428429               intermediate_timestep_count_max, simulated_time, end_time,      &
     
    431432               pt_surface, large_scale_forcing, lsf_surf, spinup,              &
    432433               spinup_pt_mean, spinup_time, time_do3d, dt_do3d,                &
    433                average_count_3d, varnamelength, urban_surface,                 &
    434                plant_canopy, dz
     434               average_count_3d, varnamelength, urban_surface, dz
    435435
    436436    USE bulk_cloud_model_mod,                                                  &
     
    455455             
    456456    USE pegrid
    457    
    458     USE plant_canopy_model_mod,                                                &
    459         ONLY:  pc_heating_rate, pc_transpiration_rate, pc_latent_rate
    460    
     457       
    461458    USE radiation_model_mod,                                                   &
    462459        ONLY:  albedo_type, radiation_interaction, calc_zenith, zenith,        &
     
    535532                                                   !< (e.g.transportation) are used
    536533    LOGICAL ::  force_radiation_call_l = .FALSE.   !< flag parameter for unscheduled radiation model calls
    537     LOGICAL ::  indoor_model = .FALSE.             !< whether to use the indoor model
    538534    LOGICAL ::  read_wall_temp_3d = .FALSE.
    539535    LOGICAL ::  usm_wall_mod = .FALSE.             !< reduces conductivity of the first 2 wall layers by factor 0.1
     
    12571253           ALLOCATE ( surf_usm_v(l)%target_temp_summer(1:surf_usm_v(l)%ns) )
    12581254           ALLOCATE ( surf_usm_v(l)%target_temp_winter(1:surf_usm_v(l)%ns) )
    1259         ENDDO   
     1255        ENDDO
     1256!
     1257!--     In case the indoor model is applied, allocate memory for waste heat
     1258!--     and indoor temperature.
     1259        IF ( indoor_model )  THEN
     1260           ALLOCATE ( surf_usm_h%waste_heat(1:surf_usm_h%ns) )
     1261           surf_usm_h%waste_heat = 0.0_wp
     1262           DO  l = 0, 3
     1263              ALLOCATE ( surf_usm_v(l)%waste_heat(1:surf_usm_v(l)%ns) )
     1264              surf_usm_v(l)%waste_heat = 0.0_wp
     1265           ENDDO
     1266        ENDIF
    12601267!
    12611268!--     Allocate flag indicating ground floor level surface elements
     
    60546061                           usm_material_model,                                 &
    60556062                           wall_category,                                      &
    6056                            indoor_model,                                       &
    60576063                           wall_inner_temperature,                             &
    60586064                           roof_inner_temperature,                             &
     
    60736079                           usm_material_model,                                 &
    60746080                           wall_category,                                      &
    6075                            indoor_model,                                       &
    60766081                           wall_inner_temperature,                             &
    60776082                           roof_inner_temperature,                             &
     
    62646269
    62656270       LOGICAL, INTENT(OUT)  ::  found
     6271!!!    suehring: Why the SAVE attribute?       
     6272       REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE   ::  tmp_surf_wall_h
     6273       REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE   ::  tmp_surf_window_h
     6274       REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE   ::  tmp_surf_green_h
     6275       REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE   ::  tmp_surf_waste_h
    62666276       
    6267        REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE   ::  tmp_surf_wall_h, tmp_surf_window_h, tmp_surf_green_h
    6268        REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  tmp_wall_h, tmp_window_h, tmp_green_h
     6277       REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  tmp_wall_h
     6278       REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  tmp_window_h
     6279       REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE ::  tmp_green_h
    62696280       
    6270        TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE ::  tmp_surf_wall_v, tmp_surf_window_v, tmp_surf_green_v
    6271        TYPE( t_wall_vertical ), DIMENSION(0:3), SAVE ::  tmp_wall_v, tmp_window_v, tmp_green_v
     6281       TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE ::  tmp_surf_wall_v
     6282       TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE ::  tmp_surf_window_v
     6283       TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE ::  tmp_surf_green_v
     6284       TYPE( t_surf_vertical ), DIMENSION(0:3), SAVE ::  tmp_surf_waste_v
     6285       
     6286       TYPE( t_wall_vertical ), DIMENSION(0:3), SAVE ::  tmp_wall_v
     6287       TYPE( t_wall_vertical ), DIMENSION(0:3), SAVE ::  tmp_window_v
     6288       TYPE( t_wall_vertical ), DIMENSION(0:3), SAVE ::  tmp_green_v
    62726289
    62736290
     
    62896306                      DEALLOCATE( tmp_surf_green_h )
    62906307                   IF ( ALLOCATED( tmp_green_h) ) DEALLOCATE( tmp_green_h )
     6308                   IF ( ALLOCATED( tmp_surf_waste_h) )                         &
     6309                      DEALLOCATE( tmp_surf_waste_h )
    62916310 
    62926311!
     
    63056324                   ALLOCATE( tmp_green_h(nzb_wall:nzt_wall+1,                  &
    63066325                                         1:ns_h_on_file_usm) )
     6326                   ALLOCATE( tmp_surf_waste_h(1:ns_h_on_file_usm) )
    63076327
    63086328                ENDIF
     
    63256345                      IF ( ALLOCATED( tmp_green_v(l)%t ) )                     &
    63266346                         DEALLOCATE( tmp_green_v(l)%t )
     6347                      IF ( ALLOCATED( tmp_surf_waste_v(l)%t ) )                &
     6348                         DEALLOCATE( tmp_surf_waste_v(l)%t )
    63276349                   ENDDO
    63286350
     
    63436365                      ALLOCATE( tmp_green_v(l)%t(nzb_wall:nzt_wall+1,          &
    63446366                                                 1:ns_v_on_file_usm(l) ) )
     6367                      ALLOCATE( tmp_surf_waste_v(l)%t(1:ns_v_on_file_usm(l)) )
    63456368                   ENDDO
    63466369
     
    66146637                                        t_surf_window_v_1(3)%t,                & 
    66156638                                        tmp_surf_window_v(3)%t,                &
     6639                                        surf_usm_v(3)%start_index,             &
     6640                                        start_index_on_file,                   &
     6641                                        end_index_on_file,                     &
     6642                                        nxlc, nysc,                            &
     6643                                        nxlf, nxrf, nysf, nynf,                &
     6644                                        nys_on_file, nyn_on_file,              &
     6645                                        nxl_on_file,nxr_on_file )
     6646
     6647             CASE ( 'waste_heat_h' )
     6648                IF ( k == 1 )  THEN
     6649                   IF ( .NOT.  ALLOCATED( surf_usm_h%waste_heat ) )            &
     6650                      ALLOCATE( surf_usm_h%waste_heat(1:surf_usm_h%ns) )
     6651                   READ ( 13 )  tmp_surf_waste_h
     6652                ENDIF             
     6653                CALL surface_restore_elements(                                 &
     6654                                        surf_usm_h%waste_heat,                 &
     6655                                        tmp_surf_waste_h,                      &
     6656                                        surf_usm_h%start_index,                &
     6657                                        start_index_on_file,                   &
     6658                                        end_index_on_file,                     &
     6659                                        nxlc, nysc,                            &
     6660                                        nxlf, nxrf, nysf, nynf,                &
     6661                                        nys_on_file, nyn_on_file,              &
     6662                                        nxl_on_file,nxr_on_file )                 
     6663                                       
     6664             CASE ( 'waste_heat_v(0)' )
     6665                IF ( k == 1 )  THEN
     6666                   IF ( .NOT.  ALLOCATED( surf_usm_v(0)%waste_heat ) )         &
     6667                      ALLOCATE( surf_usm_v(0)%waste_heat(1:surf_usm_v(0)%ns) )
     6668                   READ ( 13 )  tmp_surf_waste_v(0)%t
     6669                ENDIF
     6670                CALL surface_restore_elements(                                 &
     6671                                        surf_usm_v(0)%waste_heat,              &
     6672                                        tmp_surf_waste_v(0)%t,                 &
     6673                                        surf_usm_v(0)%start_index,             &
     6674                                        start_index_on_file,                   &
     6675                                        end_index_on_file,                     &
     6676                                        nxlc, nysc,                            &
     6677                                        nxlf, nxrf, nysf, nynf,                &
     6678                                        nys_on_file, nyn_on_file,              &
     6679                                        nxl_on_file,nxr_on_file )
     6680                     
     6681             CASE ( 'waste_heat_v(1)' )
     6682                IF ( k == 1 )  THEN
     6683                   IF ( .NOT.  ALLOCATED( surf_usm_v(1)%waste_heat ) )         &
     6684                      ALLOCATE( surf_usm_v(1)%waste_heat(1:surf_usm_v(1)%ns) )
     6685                   READ ( 13 )  tmp_surf_waste_v(1)%t
     6686                ENDIF
     6687                CALL surface_restore_elements(                                 &
     6688                                        surf_usm_v(1)%waste_heat,              &
     6689                                        tmp_surf_waste_v(1)%t,                 &
     6690                                        surf_usm_v(1)%start_index,             &
     6691                                        start_index_on_file,                   &
     6692                                        end_index_on_file,                     &
     6693                                        nxlc, nysc,                            &
     6694                                        nxlf, nxrf, nysf, nynf,                &
     6695                                        nys_on_file, nyn_on_file,              &
     6696                                        nxl_on_file,nxr_on_file )
     6697
     6698             CASE ( 'waste_heat_v(2)' )
     6699                IF ( k == 1 )  THEN
     6700                   IF ( .NOT.  ALLOCATED( surf_usm_v(2)%waste_heat ) )         &
     6701                      ALLOCATE( surf_usm_v(2)%waste_heat(1:surf_usm_v(2)%ns) )
     6702                   READ ( 13 )  tmp_surf_waste_v(2)%t
     6703                ENDIF
     6704                CALL surface_restore_elements(                                 &
     6705                                        surf_usm_v(2)%waste_heat,              &
     6706                                        tmp_surf_waste_v(2)%t,                 &
     6707                                        surf_usm_v(2)%start_index,             &
     6708                                        start_index_on_file,                   &
     6709                                        end_index_on_file,                     &
     6710                                        nxlc, nysc,                            &
     6711                                        nxlf, nxrf, nysf, nynf,                &
     6712                                        nys_on_file, nyn_on_file,              &
     6713                                        nxl_on_file,nxr_on_file )
     6714                     
     6715             CASE ( 'waste_heat_v(3)' )
     6716                IF ( k == 1 )  THEN
     6717                   IF ( .NOT.  ALLOCATED( surf_usm_v(3)%waste_heat ) )         &
     6718                      ALLOCATE( surf_usm_v(3)%waste_heat(1:surf_usm_v(3)%ns) )
     6719                   READ ( 13 )  tmp_surf_waste_v(3)%t
     6720                ENDIF
     6721                CALL surface_restore_elements(                                 &
     6722                                        surf_usm_v(3)%waste_heat,              &
     6723                                        tmp_surf_waste_v(3)%t,                 &
    66166724                                        surf_usm_v(3)%start_index,             &
    66176725                                        start_index_on_file,                   &
     
    76277735        j_off = surf_usm_h%joff
    76287736        i_off = surf_usm_h%ioff
    7629 
     7737       
    76307738!       
    76317739!--     First, treat horizontal surface elements
     
    79578065!--        diffusion_s, surface_layer_fluxes,...
    79588066           surf_usm_h%shf(m) = surf_usm_h%wshf_eb(m) / c_p
     8067!
     8068!--        If the indoor model is applied, further add waste heat from buildings to the
     8069!--        kinematic flux.
     8070           IF ( indoor_model )  THEN
     8071              surf_usm_h%shf(m) = surf_usm_h%shf(m) + surf_usm_h%waste_heat(m) / rho_cp
     8072           ENDIF
    79598073     
    79608074
     
    83828496!--           diffusion_s, surface_layer_fluxes,...
    83838497              surf_usm_v(l)%shf(m) = surf_usm_v(l)%wshf_eb(m) / c_p
     8498!
     8499!--           If the indoor model is applied, further add waste heat from buildings to the
     8500!--           kinematic flux.
     8501              IF ( indoor_model )  THEN
     8502                 surf_usm_v(l)%shf(m) = surf_usm_v(l)%shf(m) +                       &
     8503                                        surf_usm_v(l)%waste_heat(m) / rho_cp
     8504              ENDIF             
    83848505
    83858506              IF ( surf_usm_v(l)%frac(ind_pav_green,m) > 0.0_wp ) THEN
     
    86858806        CALL wrd_write_string( 't_surf_green_h' )
    86868807        WRITE ( 14 )  t_surf_green_h
    8687  
     8808!
     8809!--     Write restart data which is especially needed for the urban-surface
     8810!--     model. In order to do not fill up the restart routines in
     8811!--     surface_mod.
     8812!--     Output of waste heat from indoor model. Restart data is required in
     8813!--     this special case, because the indoor model where waste heat is
     8814!--     computed is call each hour (current default), so that waste heat would
     8815!--     have zero value until next call of indoor model.
     8816        IF ( indoor_model )  THEN
     8817           CALL wrd_write_string( 'waste_heat_h' )
     8818           WRITE ( 14 )  surf_usm_h%waste_heat
     8819        ENDIF   
     8820           
    86888821        DO  l = 0, 3
    86898822 
     
    87038836 
    87048837           CALL wrd_write_string( 't_surf_green_v(' // dum // ')' )
    8705            WRITE ( 14 ) t_surf_green_v(l)%t   
     8838           WRITE ( 14 ) t_surf_green_v(l)%t 
     8839           
     8840           IF ( indoor_model )  THEN
     8841              CALL wrd_write_string( 'waste_heat_v(' // dum // ')' )
     8842              WRITE ( 14 )  surf_usm_v(l)%waste_heat
     8843           ENDIF
    87068844           
    87078845        ENDDO
     
    87428880       
    87438881        ENDDO
    8744  
    87458882       
    87468883     END SUBROUTINE usm_wrd_local
Note: See TracChangeset for help on using the changeset viewer.