Changeset 4172 for palm


Ignore:
Timestamp:
Aug 20, 2019 11:55:33 AM (5 years ago)
Author:
oliver.maas
Message:

Added optional method for recycling of absolute values of pt and q instead of recycling only the deviations from the mean profile at the recycling plane. With the new method two problems are solved: 1. A horizontally homogeneous temperature and humidity field is achieved, even for non-neutral boundary layers and thus no thermal circulation is triggered. 2. No gravity waves build up at the inflow due to cyclic boundary conditions for pt and q.

Location:
palm/trunk/SOURCE
Files:
3 edited

Legend:

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

    r4142 r4172  
    2525! -----------------
    2626! $Id$
     27! added conversion from recycle_absolute_quantities to raq for recycling of
     28! absolute quantities and added error message PA184 for not implemented quantities
     29!
     30! 4142 2019-08-05 12:38:31Z suehring
    2731! Consider spinup in number of output timesteps for averaged 2D output (merge
    2832! from branch resler).
     
    866870    INTEGER(iwp) ::  k                               !< loop index
    867871    INTEGER(iwp) ::  kk                              !< loop index
     872    INTEGER(iwp) ::  r                               !< loop index
    868873    INTEGER(iwp) ::  mid                             !< masked output running index
    869874    INTEGER(iwp) ::  netcdf_data_format_save         !< initial value of netcdf_data_format
     
    36473652          CALL message( 'check_parameters', 'PA0421', 1, 2, 0, 6, 0 )
    36483653       ENDIF
     3654
     3655!
     3656!--    Convert recycle_absolute_quantities (list of strings that define the quantities for
     3657!--    absolute recycling) to raq (list of logicals with length 7 corresponding to u,v,w,pt,e,q,s).
     3658!--    Output error message for not implemented quantities.
     3659       DO r = LBOUND( recycle_absolute_quantities, 1 ), UBOUND( recycle_absolute_quantities, 1 )
     3660          SELECT CASE ( TRIM( recycle_absolute_quantities(r) ) )
     3661             CASE ( 'theta' )
     3662                raq(4) = .TRUE.
     3663             CASE ( 'q' )
     3664                raq(6) = .TRUE.
     3665             CASE ( '' )
     3666                CONTINUE
     3667             CASE DEFAULT
     3668                message_string = 'absolute recycling not implemented for variable ' // &
     3669                TRIM( recycle_absolute_quantities(r) )
     3670                CALL message( 'inflow_turbulence', 'PA184', 1, 2, 0, 6, 0 )
     3671          END SELECT
     3672       ENDDO
    36493673    ENDIF
    36503674
  • palm/trunk/SOURCE/inflow_turbulence.f90

    r3655 r4172  
    2525! -----------------
    2626! $Id$
     27! added optional recycling of absolute values for pt and q
     28!
     29! 3655 2019-01-07 16:51:22Z knoop
    2730! Corrected "Former revisions" section
    2831!
     
    8790       
    8891    USE control_parameters,                                                    &
    89         ONLY:  humidity, passive_scalar, recycling_plane, recycling_yshift
     92        ONLY:  humidity, passive_scalar, recycling_plane, recycling_yshift, raq
    9093       
    9194    USE cpulog,                                                                &
     
    101104
    102105    IMPLICIT NONE
    103 
     106   
    104107    INTEGER(iwp) ::  i        !< loop index
    105108    INTEGER(iwp) ::  j        !< loop index
     
    119122    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,7,nbgp) ::                         &
    120123       local_inflow_dist  !< auxiliary variable for inflow_dist, used for yshift
    121 
     124   
    122125    CALL cpu_log( log_point(40), 'inflow_turbulence', 'start' )
    123 
     126   
    124127!
    125128!-- Carry out spanwise averaging in the recycling plane
     
    187190!
    188191!-- Calculate the disturbances at the recycling plane
     192!-- for recycling of absolute quantities, the disturbance is defined as the absolute value
     193!-- (and not as the deviation from the mean profile)
    189194    i = recycling_plane
    190195
     
    198203                inflow_dist(k,j,2,l) = v(k,j,i)   - avpr(k,2,l)
    199204                inflow_dist(k,j,3,l) = w(k,j,i)   - avpr(k,3,l)
    200                 inflow_dist(k,j,4,l) = pt(k,j,i)  - avpr(k,4,l)
     205                IF ( raq(4) )  THEN
     206                   inflow_dist(k,j,4,l) = pt(k,j,i)
     207                ELSE
     208                   inflow_dist(k,j,4,l) = pt(k,j,i) - avpr(k,4,l)
     209                ENDIF
    201210                inflow_dist(k,j,5,l) = e(k,j,i)   - avpr(k,5,l)
    202                 IF ( humidity )                                                &
    203                    inflow_dist(k,j,6,l) = q(k,j,i) - avpr(k,6,l)
     211                IF ( humidity ) THEN
     212                   IF ( raq(6) ) THEN
     213                      inflow_dist(k,j,6,l) = q(k,j,i)
     214                   ELSE
     215                      inflow_dist(k,j,6,l) = q(k,j,i) - avpr(k,6,l)
     216                   ENDIF
     217                ENDIF
    204218                IF ( passive_scalar )                                          &
    205219                   inflow_dist(k,j,7,l) = s(k,j,i) - avpr(k,7,l)
     
    214228       DO  j = nysg, nyng
    215229          DO  k = nzb, nzt+1
    216 
    217230             inflow_dist(k,j,1,l) = u(k,j,i+1) - avpr(k,1,l)
    218231             inflow_dist(k,j,2,l) = v(k,j,i)   - avpr(k,2,l)
    219232             inflow_dist(k,j,3,l) = w(k,j,i)   - avpr(k,3,l)
    220              inflow_dist(k,j,4,l) = pt(k,j,i)  - avpr(k,4,l)
     233             IF ( raq(4) )  THEN
     234                inflow_dist(k,j,4,l) = pt(k,j,i)
     235             ELSE
     236                inflow_dist(k,j,4,l) = pt(k,j,i) - avpr(k,4,l)
     237             ENDIF
    221238             inflow_dist(k,j,5,l) = e(k,j,i)   - avpr(k,5,l)
    222              IF ( humidity )                                                   &
    223                 inflow_dist(k,j,6,l) = q(k,j,i) - avpr(k,6,l)
     239             IF ( humidity )  THEN
     240                IF ( raq(6) ) THEN
     241                   inflow_dist(k,j,6,l) = q(k,j,i)
     242                ELSE
     243                   inflow_dist(k,j,6,l) = q(k,j,i) - avpr(k,6,l)
     244                ENDIF
     245             ENDIF
    224246             IF ( passive_scalar )                                             &
    225247                inflow_dist(k,j,7,l) = s(k,j,i) - avpr(k,7,l)
     
    291313             w(k,j,-nbgp:-1)  =                                             &
    292314                        inflow_dist(k,j,3,1:nbgp) * inflow_damping_factor(k)
    293              pt(k,j,-nbgp:-1) = mean_inflow_profiles(k,4) +                 &
    294                         inflow_dist(k,j,4,1:nbgp) * inflow_damping_factor(k)
    295              e(k,j,-nbgp:-1)  = mean_inflow_profiles(k,5) +                 &
     315             IF ( raq(4) )  THEN
     316                pt(k,j,-nbgp:-1) = inflow_dist(k,j,4,1:nbgp)
     317             ELSE
     318                pt(k,j,-nbgp:-1) = mean_inflow_profiles(k,4) +               &
     319                inflow_dist(k,j,4,1:nbgp) * inflow_damping_factor(k)
     320             ENDIF
     321             e(k,j,-nbgp:-1)  = mean_inflow_profiles(k,5) +                  &
    296322                        inflow_dist(k,j,5,1:nbgp) * inflow_damping_factor(k)
    297323             e(k,j,-nbgp:-1)  = MAX( e(k,j,-nbgp:-1), 0.0_wp )
    298324
    299              IF ( humidity )                                                &
    300                 q(k,j,-nbgp:-1)  = mean_inflow_profiles(k,6) +              &
     325             IF ( humidity )  THEN
     326                IF ( raq(6) )  THEN
     327                   q(k,j,-nbgp:-1)  = inflow_dist(k,j,6,1:nbgp)
     328                ELSE
     329                   q(k,j,-nbgp:-1)  = mean_inflow_profiles(k,6) +           &
    301330                        inflow_dist(k,j,6,1:nbgp) * inflow_damping_factor(k)
     331                ENDIF
     332             ENDIF
    302333             IF ( passive_scalar )                                          &
    303334                s(k,j,-nbgp:-1)  = mean_inflow_profiles(k,7) +              &
    304335                        inflow_dist(k,j,7,1:nbgp) * inflow_damping_factor(k)
    305 
    306336          ENDDO
    307337       ENDDO
  • palm/trunk/SOURCE/modules.f90

    r4168 r4172  
    2525! -----------------
    2626! $Id$
     27! added recycle_absolute_quantities and raq
     28!
     29! 4168 2019-08-16 13:50:17Z suehring
    2730! +topo_top_ind
    2831!
     
    11971200    CHARACTER (LEN=varnamelength), DIMENSION(0:1,500) ::  do2d = ' '  !< label array for 2d output quantities
    11981201    CHARACTER (LEN=varnamelength), DIMENSION(0:1,500) ::  do3d = ' '  !< label array for 3d output quantities
    1199 
     1202     
     1203    CHARACTER (LEN=varnamelength), DIMENSION(7) :: recycle_absolute_quantities = ' '    !< namelist parameter
     1204   
    12001205    INTEGER(iwp), PARAMETER ::  fl_max = 500     !< maximum number of virtual-flight measurements
    12011206    INTEGER(iwp), PARAMETER ::  var_fl_max = 20  !< maximum number of different sampling variables in virtual flight measurements
     
    13131318
    13141319    INTEGER(iwp), DIMENSION(max_masks,mask_xyz_dimension) ::  mask_k_over_surface = -1  !< namelist parameter, k index of height over surface
    1315 
     1320   
    13161321    LOGICAL ::  agent_time_unlimited = .FALSE.                   !< namelist parameter
    13171322    LOGICAL ::  air_chemistry = .FALSE.                          !< chemistry model switch
     
    14311436    LOGICAL ::  data_output_yz(0:1) = .FALSE.                !< output of yz cross-section data?
    14321437
    1433     LOGICAL, DIMENSION(max_masks) ::  mask_surface = .FALSE.      !< flag for surface-following masked output
    1434 
     1438    LOGICAL, DIMENSION(max_masks) ::  mask_surface = .FALSE.   !< flag for surface-following masked output
     1439   
     1440    LOGICAL, DIMENSION(7) ::  raq = .FALSE.                    !< recycle absolute quantities (u,v,w,theta,e,q,s) in inflow_turbulence
     1441   
    14351442    REAL(wp) ::  advected_distance_x = 0.0_wp                  !< advected distance of model domain along x
    14361443                                                               !< (galilei transformation)
Note: See TracChangeset for help on using the changeset viewer.