Changeset 4183


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.

Location:
palm/trunk/SOURCE
Files:
4 edited

Legend:

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

    r4182 r4183  
    2525! -----------------
    2626! 4172 2019-08-20 11:55:33Z oliver.maas
     27! removed conversion from recycle_absolute_quantities to raq, added check and
     28! error message for correct input of recycling_method_for_thermodynamic_quantities
     29!
     30! 11:55:33Z oliver.maas
    2731! Corrected "Former revisions" section
    2832!
     
    164168    INTEGER(iwp) ::  k                               !< loop index
    165169    INTEGER(iwp) ::  kk                              !< loop index
    166     INTEGER(iwp) ::  r                               !< loop index
    167170    INTEGER(iwp) ::  mid                             !< masked output running index
    168171    INTEGER(iwp) ::  netcdf_data_format_save         !< initial value of netcdf_data_format
     
    29282931
    29292932!
    2930 !-- In case of turbulent inflow calculate the index of the recycling plane
     2933!-- In case of turbulent inflow
    29312934    IF ( turbulent_inflow )  THEN
     2935
     2936!
     2937!--    Calculate the index of the recycling plane
    29322938       IF ( recycling_width <= dx  .OR.  recycling_width >= nx * dx )  THEN
    29332939          WRITE( message_string, * )  'illegal value for recycling_width: ',   &
     
    29482954
    29492955!
    2950 !--    Convert recycle_absolute_quantities (list of strings that define the quantities for
    2951 !--    absolute recycling) to raq (list of logicals with length 7 corresponding to u,v,w,pt,e,q,s).
    2952 !--    Output error message for not implemented quantities.
    2953        DO r = LBOUND( recycle_absolute_quantities, 1 ), UBOUND( recycle_absolute_quantities, 1 )
    2954           SELECT CASE ( TRIM( recycle_absolute_quantities(r) ) )
    2955              CASE ( 'theta' )
    2956                 raq(4) = .TRUE.
    2957              CASE ( 'q' )
    2958                 raq(6) = .TRUE.
    2959              CASE ( '' )
    2960                 CONTINUE
    2961              CASE DEFAULT
    2962                 message_string = 'absolute recycling not implemented for variable ' // &
    2963                 TRIM( recycle_absolute_quantities(r) )
    2964                 CALL message( 'inflow_turbulence', 'PA0184', 1, 2, 0, 6, 0 )
    2965           END SELECT
    2966        ENDDO
     2956!--   Check for correct input of recycling method for thermodynamic quantities
     2957       IF ( TRIM( recycling_method_for_thermodynamic_quantities ) /= 'turbulent_fluctuation' .AND. &
     2958            TRIM( recycling_method_for_thermodynamic_quantities ) /= 'absolute_value' )  THEN
     2959          WRITE( message_string, * )  'unknown recycling method for thermodynamic quantities: ',   &
     2960               TRIM( recycling_method_for_thermodynamic_quantities )
     2961          CALL message( 'check_parameters', 'PA0184', 1, 2, 0, 6, 0 )
     2962       ENDIF
     2963
    29672964    ENDIF
    29682965
  • palm/trunk/SOURCE/inflow_turbulence.f90

    r4182 r4183  
    2525! -----------------
    2626! $Id$
     27! simplified steering of recycling of absolute values by initialization
     28! parameter recycling_method_for_thermodynamic_quantities
     29!
     30! 4182 2019-08-22 15:20:23Z scharf
    2731! Corrected "Former revisions" section
    2832!
     
    4751       
    4852    USE control_parameters,                                                    &
    49         ONLY:  humidity, passive_scalar, recycling_plane, recycling_yshift, raq
     53        ONLY:  humidity, passive_scalar, recycling_plane, recycling_yshift,    &
     54               recycling_method_for_thermodynamic_quantities
    5055       
    5156    USE cpulog,                                                                &
     
    156161          DO  j = nysg, nyng
    157162             DO  k = nzb, nzt + 1
    158 
    159163                inflow_dist(k,j,1,l) = u(k,j,i+1) - avpr(k,1,l)
    160164                inflow_dist(k,j,2,l) = v(k,j,i)   - avpr(k,2,l)
    161165                inflow_dist(k,j,3,l) = w(k,j,i)   - avpr(k,3,l)
    162                 IF ( raq(4) )  THEN
     166                IF ( TRIM( recycling_method_for_thermodynamic_quantities )     &
     167                   == 'turbulent_fluctuation' )  THEN
     168                   inflow_dist(k,j,4,l) = pt(k,j,i) - avpr(k,4,l)
     169                ELSEIF ( TRIM( recycling_method_for_thermodynamic_quantities ) &
     170                   == 'absolute_value' )  THEN
    163171                   inflow_dist(k,j,4,l) = pt(k,j,i)
    164                 ELSE
    165                    inflow_dist(k,j,4,l) = pt(k,j,i) - avpr(k,4,l)
    166172                ENDIF
    167173                inflow_dist(k,j,5,l) = e(k,j,i)   - avpr(k,5,l)
    168174                IF ( humidity ) THEN
    169                    IF ( raq(6) ) THEN
     175                   IF ( TRIM( recycling_method_for_thermodynamic_quantities )  &
     176                      == 'turbulent_fluctuation' )  THEN
     177                      inflow_dist(k,j,6,l) = q(k,j,i) - avpr(k,6,l)
     178                   ELSEIF ( TRIM( recycling_method_for_thermodynamic_quantities )  &
     179                      == 'absolute_value' )  THEN
    170180                      inflow_dist(k,j,6,l) = q(k,j,i)
    171                    ELSE
    172                       inflow_dist(k,j,6,l) = q(k,j,i) - avpr(k,6,l)
    173181                   ENDIF
    174182                ENDIF
     
    188196             inflow_dist(k,j,2,l) = v(k,j,i)   - avpr(k,2,l)
    189197             inflow_dist(k,j,3,l) = w(k,j,i)   - avpr(k,3,l)
    190              IF ( raq(4) )  THEN
     198             IF ( TRIM( recycling_method_for_thermodynamic_quantities )        &
     199                   == 'turbulent_fluctuation' )  THEN
     200                inflow_dist(k,j,4,l) = pt(k,j,i) - avpr(k,4,l)
     201             ELSEIF ( TRIM( recycling_method_for_thermodynamic_quantities )    &
     202                   == 'absolute_value' )  THEN
    191203                inflow_dist(k,j,4,l) = pt(k,j,i)
    192              ELSE
    193                 inflow_dist(k,j,4,l) = pt(k,j,i) - avpr(k,4,l)
    194204             ENDIF
    195205             inflow_dist(k,j,5,l) = e(k,j,i)   - avpr(k,5,l)
    196206             IF ( humidity )  THEN
    197                 IF ( raq(6) ) THEN
     207                IF ( TRIM( recycling_method_for_thermodynamic_quantities )     &
     208                      == 'turbulent_fluctuation' )  THEN
     209                   inflow_dist(k,j,6,l) = q(k,j,i) - avpr(k,6,l)
     210                ELSEIF ( TRIM( recycling_method_for_thermodynamic_quantities ) &
     211                      == 'absolute_value' )  THEN
    198212                   inflow_dist(k,j,6,l) = q(k,j,i)
    199                 ELSE
    200                    inflow_dist(k,j,6,l) = q(k,j,i) - avpr(k,6,l)
    201213                ENDIF
    202214             ENDIF
     
    264276          DO  k = nzb, nzt + 1
    265277
    266              u(k,j,-nbgp+1:0) = mean_inflow_profiles(k,1) +                 &
     278             u(k,j,-nbgp+1:0) = mean_inflow_profiles(k,1) +                    &
    267279                        inflow_dist(k,j,1,1:nbgp) * inflow_damping_factor(k)
    268              v(k,j,-nbgp:-1)  = mean_inflow_profiles(k,2) +                 &
     280             v(k,j,-nbgp:-1)  = mean_inflow_profiles(k,2) +                    &
    269281                        inflow_dist(k,j,2,1:nbgp) * inflow_damping_factor(k)
    270              w(k,j,-nbgp:-1)  =                                             &
     282             w(k,j,-nbgp:-1)  =                                                &
    271283                        inflow_dist(k,j,3,1:nbgp) * inflow_damping_factor(k)
    272              IF ( raq(4) )  THEN
     284             IF ( TRIM( recycling_method_for_thermodynamic_quantities )        &
     285                   == 'turbulent_fluctuation' )  THEN
     286                pt(k,j,-nbgp:-1) = mean_inflow_profiles(k,4) +                 &
     287                inflow_dist(k,j,4,1:nbgp) * inflow_damping_factor(k)
     288             ELSEIF ( TRIM( recycling_method_for_thermodynamic_quantities )    &
     289                   == 'absolute_value' )  THEN
    273290                pt(k,j,-nbgp:-1) = inflow_dist(k,j,4,1:nbgp)
    274              ELSE
    275                 pt(k,j,-nbgp:-1) = mean_inflow_profiles(k,4) +               &
    276                 inflow_dist(k,j,4,1:nbgp) * inflow_damping_factor(k)
    277291             ENDIF
    278              e(k,j,-nbgp:-1)  = mean_inflow_profiles(k,5) +                  &
     292             e(k,j,-nbgp:-1)  = mean_inflow_profiles(k,5) +                    &
    279293                        inflow_dist(k,j,5,1:nbgp) * inflow_damping_factor(k)
    280294             e(k,j,-nbgp:-1)  = MAX( e(k,j,-nbgp:-1), 0.0_wp )
    281 
    282295             IF ( humidity )  THEN
    283                 IF ( raq(6) )  THEN
     296                IF ( TRIM( recycling_method_for_thermodynamic_quantities )     &
     297                      == 'turbulent_fluctuation' )  THEN
     298                   q(k,j,-nbgp:-1)  = mean_inflow_profiles(k,6) +              &
     299                      inflow_dist(k,j,6,1:nbgp) * inflow_damping_factor(k)
     300                ELSEIF ( TRIM( recycling_method_for_thermodynamic_quantities ) &
     301                      == 'absolute_value' )  THEN
    284302                   q(k,j,-nbgp:-1)  = inflow_dist(k,j,6,1:nbgp)
    285                 ELSE
    286                    q(k,j,-nbgp:-1)  = mean_inflow_profiles(k,6) +           &
    287                         inflow_dist(k,j,6,1:nbgp) * inflow_damping_factor(k)
    288303                ENDIF
    289304             ENDIF
    290              IF ( passive_scalar )                                          &
    291                 s(k,j,-nbgp:-1)  = mean_inflow_profiles(k,7) +              &
     305             IF ( passive_scalar )                                             &
     306                s(k,j,-nbgp:-1)  = mean_inflow_profiles(k,7) +                 &
    292307                        inflow_dist(k,j,7,1:nbgp) * inflow_damping_factor(k)
     308                       
    293309          ENDDO
    294310       ENDDO
  • 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)
  • palm/trunk/SOURCE/parin.f90

    r4182 r4183  
    2525! -----------------
    2626! $Id$
     27! replaced recycle_absolute_quantities by recycling_method_for_thermodynamic_quantities
     28!
     29! 4182 2019-08-22 15:20:23Z scharf
    2730! Corrected "Former revisions" section
    2831!
     
    254257             random_generator, random_heatflux, rans_const_c, rans_const_sigma,&
    255258             rayleigh_damping_factor, rayleigh_damping_height,                 &
    256              recycling_width, recycling_yshift, recycle_absolute_quantities,   &
     259             recycling_width, recycling_yshift,                                &
     260             recycling_method_for_thermodynamic_quantities,                    &
    257261             reference_state, residual_limit,                                  &
    258262             roughness_length, scalar_advec,                                   &
Note: See TracChangeset for help on using the changeset viewer.