Ignore:
Timestamp:
Apr 3, 2018 4:17:10 PM (6 years ago)
Author:
suehring
Message:

Calculate exner function at all height levels in USM In order to avoid segmentation faults in case radiation-interactions are switched-off, calculate exner function at all height levels in USM .

File:
1 edited

Legend:

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

    r2932 r2943  
    2828! -----------------
    2929! $Id$
     30! Calculate exner function at all height levels and remove some un-used
     31! variables.
     32!
     33! 2932 2018-03-26 09:39:22Z maronga
    3034! renamed urban_surface_par to urban_surface_parameters
    3135!
     
    299303   
    300304    USE radiation_model_mod,                                                   &
    301         ONLY:  albedo_type, radiation_interaction, calc_zenith, zenith,                    &
     305        ONLY:  albedo_type, radiation_interaction, calc_zenith, zenith,        &
    302306               rad_sw_in, rad_lw_in, rad_sw_out, rad_lw_out,                   &
    303307               sigma_sb, solar_constant, sun_direction, sun_dir_lat,           &
     
    310314               iup_u, inorth_u, isouth_u, ieast_u, iwest_u, iup_l,             &
    311315               inorth_l, isouth_l, ieast_l, iwest_l, id,                       &
    312                iz, iy, ix, idir, jdir, kdir,  nsurf_type, nzub, nzut,          &
    313                nzu, pch, nsurf, idsvf, ndsvf,                                  &
     316               iz, iy, ix, idir, jdir, kdir,  nsurf_type, nsurf, idsvf, ndsvf, &
    314317               iup_a, idown_a, inorth_a, isouth_a, ieast_a, iwest_a,           &
    315318               idcsf, ndcsf, kdcsf, pct,                                       &
     
    71567159        REAL(wp)                              :: lambda_surface_window !< current value of lambda_surface (heat conductivity between air and window)
    71577160        REAL(wp)                              :: lambda_surface_green  !< current value of lambda_surface (heat conductivity between air and greeb wall)
    7158         REAL(wp), DIMENSION(nzub:nzut)        :: exn                !< value of the Exner function in layers
     7161        REAL(wp), DIMENSION(nzb:nzt)          :: exn                !< value of the Exner function in layers
    71597162       
    71607163        REAL(wp), DIMENSION(0:4)              :: dxdir              !< surface normal direction gridbox length
     
    71667169        dxdir = (/dz,dy,dy,dx,dx/)
    71677170#if ! defined( __nopointer )
    7168         exn(:) = (hyp(nzub:nzut) / 100000.0_wp )**0.286_wp          !< Exner function
     7171        exn(nzb:nzt) = (hyp(nzb:nzt) / 100000.0_wp )**0.286_wp          !< Exner function
    71697172#endif
    71707173!       
     
    73217324              force_radiation_call_l = .TRUE.
    73227325           ENDIF
    7323 !           
    7324 !--        for horizontal surfaces is pt(nzb_s_inner(j,i),j,i) = pt_surf.
    7325 !--        there is no equivalent surface gridpoint for vertical surfaces.
    7326 !--        pt(k,j,i) is calculated for all directions in diffusion_s
    7327 !--        using surface and wall heat fluxes
    7328 #if ! defined( __nopointer )
    7329 !            pt(k-1,j,i) = ( surf_usm_h%frac(0,m) * t_surf_h_p(m)       &
    7330 !                          + surf_usm_h%frac(2,m) * t_surf_window_h_p(m)  &
    7331 !                          + surf_usm_h%frac(1,m) * t_surf_green_h_p(m) ) &
    7332 !                          / exn(k)  ! not for vertical surfaces
    7333 #endif
    7334 
     7326!
    73357327!--        calculate fluxes
    73367328!--        rad_net_l is never used!           
Note: See TracChangeset for help on using the changeset viewer.