Ignore:
Timestamp:
Feb 28, 2019 10:16:49 AM (5 years ago)
Author:
moh.hefny
Message:

removed unused variables from urban_surface_mod radiation_model_mod and part of module_interface

File:
1 edited

Legend:

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

    r3767 r3769  
    2828! -----------------
    2929! $Id$
     30! removed unused variables
     31!
     32! 3767 2019-02-27 08:18:02Z raasch
    3033! unused variables removed from rrd-subroutines parameter list
    3134!
     
    529532                field_capacity = 9999999.9_wp,          &  !< NAMELIST fc
    530533                hydraulic_conductivity = 9999999.9_wp,  &  !< NAMELIST gamma_w_green_sat
    531                 lambda_h_green_sat = 0.0_wp,            &  !< heat conductivity for saturated soil
    532534                l_vangenuchten = 9999999.9_wp,          &  !< NAMELIST l_vg
    533535                n_vangenuchten = 9999999.9_wp,          &  !< NAMELIST n_vg
     
    28422844        REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr)     ::  temp_pf    !< temp array for urban surface output procedure
    28432845       
    2844         CHARACTER (len=varnamelength)                          :: var     !< trimmed variable name
    2845         INTEGER(iwp), PARAMETER                                :: nd = 5  !< number of directions
    2846         CHARACTER(len=6), DIMENSION(0:nd-1), PARAMETER         :: dirname = (/ '_roof ', '_south', '_north', '_west ', '_east ' /)
    2847         INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER             :: dirint =  (/    iup_u, isouth_u, inorth_u,  iwest_u,  ieast_u /)
    2848         INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER             :: diridx =  (/       -1,        1,        0,        3,        2 /)
    2849                                                                      !< index for surf_*_v: 0:3 = (North, South, East, West)
    2850         INTEGER(iwp)                                           :: ids,idsint,idsidx,isvf
    2851         INTEGER(iwp)                                           :: i,j,k,iwl,istat, l, m  !< running indices
     2846        CHARACTER (len=varnamelength)                      :: var     !< trimmed variable name
     2847        INTEGER(iwp), PARAMETER                            :: nd = 5  !< number of directions
     2848        CHARACTER(len=6), DIMENSION(0:nd-1), PARAMETER     :: dirname = (/ '_roof ', '_south', '_north', '_west ', '_east ' /)
     2849        INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER         :: dirint =  (/    iup_u, isouth_u, inorth_u,  iwest_u,  ieast_u /)
     2850        INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER         :: diridx =  (/       -1,        1,        0,        3,        2 /)
     2851                                                                      !< index for surf_*_v: 0:3 = (North, South, East, West)
     2852        INTEGER(iwp)                   :: ids,idsint,idsidx
     2853        INTEGER(iwp)                   :: i,j,k,iwl,istat, l, m  !< running indices
    28522854
    28532855        found = .TRUE.
     
    40264028        INTEGER(iwp) ::  st                  !< dummy 
    40274029
    4028         REAL(wp)     ::  c, d, tin, twin
     4030        REAL(wp)     ::  c, tin, twin
    40294031        REAL(wp)     ::  ground_floor_level_l         !< local height of ground floor level
    40304032        REAL(wp)     ::  z_agl                        !< height above ground
Note: See TracChangeset for help on using the changeset viewer.