Ignore:
Timestamp:
Aug 23, 2019 7:33:16 AM (5 years ago)
Author:
oliver.maas
Message:

simplified steering of recycling of absolute values. Replaced initialization parameter recycle_absolute_quantities by recycling_method_for_thermodynamic_quantities.

File:
1 edited

Legend:

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

    r4182 r4183  
    2525! -----------------
    2626! $Id$
     27! removed recycle_absolute_quantities and raq
     28! added recycling_method_for_thermodynamic_quantities
     29!
     30! 4182 2019-08-22 15:20:23Z scharf
    2731! Corrected "Former revisions" section
    2832!
     
    496500    CHARACTER (LEN=20)   ::  mixing_length_1d = 'blackadar'               !< namelist parameter
    497501    CHARACTER (LEN=20)   ::  random_generator = 'random-parallel'         !< namelist parameter
     502    CHARACTER (LEN=20)   ::  recycling_method_for_thermodynamic_quantities = 'turbulent_fluctuation'        !< namelist parameter
    498503    CHARACTER (LEN=20)   ::  reference_state = 'initial_profile'          !< namelist parameter 
    499504    CHARACTER (LEN=20)   ::  timestep_scheme = 'runge-kutta-3'            !< namelist parameter       
     
    527532    CHARACTER (LEN=varnamelength), DIMENSION(0:1,500) ::  do3d = ' '  !< label array for 3d output quantities
    528533
    529     CHARACTER (LEN=varnamelength), DIMENSION(7) :: recycle_absolute_quantities = ' '    !< namelist parameter
    530    
    531534    INTEGER(iwp), PARAMETER ::  fl_max = 500     !< maximum number of virtual-flight measurements
    532535    INTEGER(iwp), PARAMETER ::  var_fl_max = 20  !< maximum number of different sampling variables in virtual flight measurements
     
    764767
    765768    LOGICAL, DIMENSION(max_masks) ::  mask_surface = .FALSE.   !< flag for surface-following masked output
    766    
    767     LOGICAL, DIMENSION(7) ::  raq = .FALSE.                    !< recycle absolute quantities (u,v,w,theta,e,q,s) in inflow_turbulence
    768    
     769
    769770    REAL(wp) ::  advected_distance_x = 0.0_wp                  !< advected distance of model domain along x
    770771                                                               !< (galilei transformation)
Note: See TracChangeset for help on using the changeset viewer.