Ignore:
Timestamp:
Jul 12, 2018 4:21:53 PM (6 years ago)
Author:
suehring
Message:

Correct working precision for REAL and INTEGER numbers

File:
1 edited

Legend:

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

    r3115 r3123  
    2828! -----------------
    2929! $Id$
     30! Correct working precision for INTEGER number
     31!
     32! 3115 2018-07-10 12:49:26Z suehring
    3033! Additional building type to represent bridges
    3134!
     
    586589    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE        ::  aheat             !< daily average of anthropogenic heat (W/m2)
    587590    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  aheatprof         !< diurnal profiles of anthropogenic heat for particular layers
    588     INTEGER(wp)                                    ::  naheatlayers = 1  !< number of layers of anthropogenic heat
     591    INTEGER(iwp)                                   ::  naheatlayers = 1  !< number of layers of anthropogenic heat
    589592
    590593!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Note: See TracChangeset for help on using the changeset viewer.