Changeset 3786


Ignore:
Timestamp:
Mar 6, 2019 4:58:03 PM (5 years ago)
Author:
raasch
Message:

unused variables removed, interoperable C datatypes introduced in particle type to avoid compiler warnings

Location:
palm/trunk/SOURCE
Files:
4 edited

Legend:

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

    r3767 r3786  
    2525! -----------------
    2626! $Id$
     27! unsed variables removed
     28!
     29! 3767 2019-02-27 08:18:02Z raasch
    2730! unused variable for file index removed from rrd-subroutines parameter list
    2831!
     
    723726
    724727       USE statistics,                                                         &
    725            ONLY: hom, statistic_regions, pr_palm
     728           ONLY: hom, statistic_regions
    726729
    727730       IMPLICIT NONE
     
    821824       IMPLICIT NONE
    822825
    823        INTEGER(iwp) ::  i !<
    824        INTEGER(iwp) ::  j !<
    825        INTEGER(iwp) ::  k !<
    826826!
    827827!--    Liquid water content
     
    893893       INTEGER(iwp) ::  i !<
    894894       INTEGER(iwp) ::  j !<
    895        INTEGER(iwp) ::  k !<
    896895
    897896       CALL location_message( 'initializing bulk cloud module', .FALSE. )
  • palm/trunk/SOURCE/indoor_model_mod.f90

    r3759 r3786  
    2626! -----------------
    2727! $Id$
     28! unused variables removed
     29!
     30! 3759 2019-02-21 15:53:45Z suehring
    2831! - Calculation of total building volume
    2932! - Several bugfixes
     
    161164
    162165    INTEGER(iwp) ::  num_build   !< total number of buildings in domain
    163 
    164     REAL(wp) ::  volume_fraction
    165 
    166     REAL(wp), DIMENSION(:), ALLOCATABLE ::  t_in     !< dummy array for indoor temperature for the
    167                                                      !< total building volume at each discrete height level
    168     REAL(wp), DIMENSION(:), ALLOCATABLE ::  t_in_l   !< dummy array for indoor temperature for the
    169                                                      !< local building volume fraction at each discrete height level
    170166
    171167!
     
    205201    REAL(wp) ::  phi_sol                     !< [W] solar loads
    206202    REAL(wp) ::  phi_st                      !<! [W] mass specific thermal load implied non thermal mass
    207     REAL(wp) ::  q_emission                  !< emissions, in first version = 0, option for second part of the project
     203!    REAL(wp) ::  q_emission                  !< emissions, in first version = 0, option for second part of the project
    208204    REAL(wp) ::  q_wall_win                  !< heat flux from indoor into wall/window
    209205    REAL(wp) ::  q_waste_heat                !< waste heat, sum of waste heat over the roof to Palm
    210     REAL(wp) ::  q_waste_heat_bldg           !< [W/building] waste heat of the complete building, in Palm sum of all indoor_model-calculations
     206!    REAL(wp) ::  q_waste_heat_bldg           !< [W/building] waste heat of the complete building, in Palm sum of all indoor_model-calculations
    211207    REAL(wp) ::  schedule_d                  !< activation for internal loads (low or high + low)
    212208    REAL(wp) ::  skip_time_do_indoor = 0.0_wp  !< [s] Indoor model is not called before this time
     
    222218    REAL(wp) ::  theta_s                     !<! [degree_C] surface temperature of the RC-node
    223219    REAL(wp) ::  time_indoor = 0.0_wp        !< [s] time since last call of indoor model
    224     REAL(wp) ::  time_utc_hour               !< Time in hours per day (UTC)
    225     REAL(wp) ::  ventilation_int_loads       !< Zuteilung der GebÀude fÃŒr Verlauf/AktivitÀt der LÃŒftung und internen Lasten
     220!    REAL(wp) ::  time_utc_hour               !< Time in hours per day (UTC)
    226221   
    227222    REAL(wp) ::  f_sr                        !< [-] factor surface reduction
     
    405400
    406401    INTEGER(iwp) ::  bt   !< local building type
    407     INTEGER(iwp) ::  fa   !< running index for facade elements of each building
    408402    INTEGER(iwp) ::  i    !< running index along x-direction
    409403    INTEGER(iwp) ::  j    !< running index along y-direction
     
    434428    INTEGER(iwp), DIMENSION(0:numprocs-1) ::  num_buildings_l       !< number of buildings with different ID on local subdomain
    435429   
    436     REAL(wp), DIMENSION(:), ALLOCATABLE ::  local_weight   !< dummy representing fraction of local on total building volume,
    437                                                            !< height dependent
    438430    REAL(wp), DIMENSION(:), ALLOCATABLE ::  volume         !< total building volume at each discrete height level
    439431    REAL(wp), DIMENSION(:), ALLOCATABLE ::  volume_l       !< total building volume at each discrete height level,
     
    984976    USE arrays_3d,                                                             &
    985977        ONLY:  ddzw, dzw
    986 
    987     USE basic_constants_and_equations_mod,                                     &
    988         ONLY:  c_p
    989 
    990     USE control_parameters,                                                    &
    991         ONLY:  rho_surface
    992978
    993979    USE date_and_time_mod,                                                     &
  • palm/trunk/SOURCE/land_surface_model_mod.f90

    r3767 r3786  
    2525! -----------------
    2626! $Id$
     27! further unused variables removed
     28!
     29! 3767 2019-02-27 08:18:02Z raasch
    2730! unused variable for file index removed from rrd-subroutines parameter list
    2831!
     
    25842587
    25852588       INTEGER(iwp) ::  i                       !< running index
    2586        INTEGER(iwp) ::  i_off                   !< index offset of surface element, seen from atmospheric grid point
    25872589       INTEGER(iwp) ::  j                       !< running index
    2588        INTEGER(iwp) ::  j_off                   !< index offset of surface element, seen from atmospheric grid point
    25892590       INTEGER(iwp) ::  k                       !< running index
    25902591       INTEGER(iwp) ::  kn                      !< running index
     
    65616562    IMPLICIT NONE
    65626563
    6563     INTEGER(iwp) ::  i                 !<
    65646564    INTEGER(iwp) ::  k                 !<
    65656565    INTEGER(iwp) ::  l                 !< running index surface orientation
     
    72627262       IMPLICIT NONE
    72637263
    7264        INTEGER(iwp)                          :: i, j, k, l, m   !< running indices
     7264       INTEGER(iwp)                          :: i, j, k, m   !< running indices
    72657265
    72667266
  • palm/trunk/SOURCE/mod_particle_attributes.f90

    r3720 r3786  
    2525! -----------------
    2626! $Id$
     27! interoperable C datatypes introduced in particle type to avoid compiler warnings
     28!
     29! 3720 2019-02-06 13:19:55Z knoop
    2730! time_prel replaced by last_particle_release_time
    2831!
     
    217220    REAL(wp), DIMENSION(:), ALLOCATABLE     ::  log_z_z0   !< Precalculate LOG(z/z0)
    218221
    219 
     222!
     223!-- WARNING: For compatibility of derived types, the BIND attribute is required, and interoperable C
     224!-- datatypes must be used. These type are hard wired here! So changes in working precision (wp, iwp)
     225!-- will not affect the particle_type!
     226!-- The main reason for introducing the interoperable datatypes was to avoid compiler warnings of
     227!-- the gfortran compiler.
     228!-- The BIND attribite is required because of C_F_POINTER usage in the pmc particle interface.
    220229    TYPE, BIND(C) ::  particle_type
    221         REAL(wp)    ::  aux1          !< auxiliary multi-purpose feature
    222         REAL(wp)    ::  aux2          !< auxiliary multi-purpose feature
    223         REAL(wp)    ::  radius        !< radius of particle
    224         REAL(wp)    ::  age           !< age of particle
    225         REAL(wp)    ::  age_m         !<
    226         REAL(wp)    ::  dt_sum        !<
    227         REAL(wp)    ::  e_m           !< interpolated sgs tke
    228         REAL(wp)    ::  origin_x      !< origin x-position of particle (changed cyclic bc)
    229         REAL(wp)    ::  origin_y      !< origin y-position of particle (changed cyclic bc)
    230         REAL(wp)    ::  origin_z      !< origin z-position of particle (changed cyclic bc)
    231         REAL(wp)    ::  rvar1         !<
    232         REAL(wp)    ::  rvar2         !<
    233         REAL(wp)    ::  rvar3         !<
    234         REAL(wp)    ::  speed_x       !< speed of particle in x
    235         REAL(wp)    ::  speed_y       !< speed of particle in y
    236         REAL(wp)    ::  speed_z       !< speed of particle in z
    237         REAL(wp)    ::  weight_factor !< weighting factor
    238         REAL(wp)    ::  x             !< x-position
    239         REAL(wp)    ::  y             !< y-position
    240         REAL(wp)    ::  z             !< z-position
    241         INTEGER(iwp) ::  class         !< radius class needed for collision
    242         INTEGER(iwp) ::  group         !< number of particle group
    243         INTEGER(idp) ::  id            !< particle ID (64 bit integer)
     230        REAL(C_DOUBLE) ::  aux1          !< auxiliary multi-purpose feature
     231        REAL(C_DOUBLE) ::  aux2          !< auxiliary multi-purpose feature
     232        REAL(C_DOUBLE) ::  radius        !< radius of particle
     233        REAL(C_DOUBLE) ::  age           !< age of particle
     234        REAL(C_DOUBLE) ::  age_m         !<
     235        REAL(C_DOUBLE) ::  dt_sum        !<
     236        REAL(C_DOUBLE) ::  e_m           !< interpolated sgs tke
     237        REAL(C_DOUBLE) ::  origin_x      !< origin x-position of particle (changed cyclic bc)
     238        REAL(C_DOUBLE) ::  origin_y      !< origin y-position of particle (changed cyclic bc)
     239        REAL(C_DOUBLE) ::  origin_z      !< origin z-position of particle (changed cyclic bc)
     240        REAL(C_DOUBLE) ::  rvar1         !<
     241        REAL(C_DOUBLE) ::  rvar2         !<
     242        REAL(C_DOUBLE) ::  rvar3         !<
     243        REAL(C_DOUBLE) ::  speed_x       !< speed of particle in x
     244        REAL(C_DOUBLE) ::  speed_y       !< speed of particle in y
     245        REAL(C_DOUBLE) ::  speed_z       !< speed of particle in z
     246        REAL(C_DOUBLE) ::  weight_factor !< weighting factor
     247        REAL(C_DOUBLE) ::  x             !< x-position
     248        REAL(C_DOUBLE) ::  y             !< y-position
     249        REAL(C_DOUBLE) ::  z             !< z-position
     250        INTEGER(C_INT) ::  class         !< radius class needed for collision
     251        INTEGER(C_INT) ::  group         !< number of particle group
     252        INTEGER(C_LONG_LONG) ::  id            !< particle ID (64 bit integer)
    244253        LOGICAL(C_BOOL) ::  particle_mask !< if this parameter is set to false the particle will be deleted
    245         INTEGER(iwp) ::  block_nr      !< number for sorting (removable?)
     254        INTEGER(C_INT) ::  block_nr      !< number for sorting (removable?)
    246255    END TYPE particle_type
    247256
Note: See TracChangeset for help on using the changeset viewer.