Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Ignore:
Timestamp:
Jun 18, 2019 4:59:00 PM (5 years ago)
Author:
schwenkel
Message:

further modularization of lpm and delete min_nr_particle

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/lagrangian_particle_model_mod.f90

    r4028 r4043  
    2525! -----------------
    2626! $Id$
     27! Remove min_nr_particle, Add lpm_droplet_interactions_ptq into module
     28!
     29! 4028 2019-06-13 12:21:37Z schwenkel
    2730! Further modularization of particle code components
    2831!
    … …  
    160163!------------------------------------------------------------------------------!
    161164 MODULE lagrangian_particle_model_mod
    162        
     165
    163166    USE, INTRINSIC ::  ISO_C_BINDING
    164        
     167
    165168    USE arrays_3d,                                                             &
    166169        ONLY:  de_dx, de_dy, de_dz, dzw, zu, zw,  ql_c, ql_v, ql_vp, hyp,      &
    167                pt, q, exner, ql, diss, e, u, v, w, km, ql_1, ql_2     
     170               pt, q, exner, ql, diss, e, u, v, w, km, ql_1, ql_2, pt_p, q_p,  &
     171               d_exner
    168172 
    169173    USE averaging,                                                             &
    170174        ONLY:  ql_c_av, pr_av, pc_av, ql_vp_av, ql_v_av
    171        
     175
    172176    USE basic_constants_and_equations_mod,                                     &
    173177        ONLY: molecular_weight_of_solute, molecular_weight_of_water, magnus,   &
    174               pi, rd_d_rv, rho_l, r_v, rho_s, vanthoff, l_v, kappa, g               
    175        
     178              pi, rd_d_rv, rho_l, r_v, rho_s, vanthoff, l_v, kappa, g, lv_d_cp
     179
    176180    USE control_parameters,                                                    &
    177181        ONLY:  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, &
    … …  
    186190    USE cpulog,                                                                &
    187191        ONLY:  cpu_log, log_point, log_point_s
    188        
     192
    189193    USE indices,                                                               &
    190194        ONLY:  nx, nxl, nxlg, nxrg, nxr, ny, nyn, nys, nyng, nysg, nz, nzb,    &
    191                nzb_max, nzt, wall_flags_0,nbgp, ngp_2dh_outer               
    192        
     195               nzb_max, nzt, wall_flags_0,nbgp, ngp_2dh_outer
     196
    193197    USE kinds
    194            
     198
    195199    USE pegrid
    196    
     200
    197201    USE particle_attributes
    198    
     202
    199203    USE pmc_particle_interface,                                                &
    200204        ONLY: pmcp_c_get_particle_from_parent, pmcp_p_fill_particle_win,       &
    … …  
    213217               id_var_dopts, id_var_time_pts, nc_stat,                         &
    214218               netcdf_handle_error
    215              
     219
    216220    USE random_function_mod,                                                   &
    217221        ONLY:  random_function
    218                    
     222
    219223    USE statistics,                                                            &
    220         ONLY:  hom                   
     224        ONLY:  hom
    221225
    222226    USE surface_mod,                                                           &
    223227        ONLY:  get_topography_top_index_ji, surf_def_h, surf_lsm_h, surf_usm_h,&
    224228               bc_h
    225        
     229
    226230#if defined( __parallel )  &&  !defined( __mpifh )
    227231    USE MPI
    … …  
    236240#endif
    237241
     242
     243     USE arrays_3d,                                                             &
     244        ONLY:
     245
     246    USE indices,                                                               &
     247        ONLY:  nxl, nxr, nyn, nys, nzb, nzt, wall_flags_0
     248
     249    USE kinds
     250
     251    USE pegrid
     252
    238253    IMPLICIT NONE
    239    
     254
    240255    CHARACTER(LEN=15) ::  aero_species = 'nacl'                    !< aerosol species
    241256    CHARACTER(LEN=15) ::  aero_type    = 'maritime'                !< aerosol type
    … …  
    245260    CHARACTER(LEN=15) ::  bc_par_t     = 'absorb'                  !< top boundary condition
    246261    CHARACTER(LEN=15) ::  collision_kernel   = 'none'              !< collision kernel   
    247    
     262
    248263    CHARACTER(LEN=5)  ::  splitting_function = 'gamma'             !< function for calculation critical weighting factor
    249264    CHARACTER(LEN=5)  ::  splitting_mode     = 'const'             !< splitting mode
    … …  
    260275    INTEGER(iwp) ::  particles_per_point = 1                      !< namelist parameter (see documentation)
    261276    INTEGER(iwp) ::  radius_classes = 20                          !< namelist parameter (see documentation)
    262    
    263277    INTEGER(iwp) ::  splitting_factor = 2                         !< namelist parameter (see documentation)
    264278    INTEGER(iwp) ::  splitting_factor_max = 5                     !< namelist parameter (see documentation)
    … …  
    272286    INTEGER(iwp) ::  trsp_count_recv_sum                          !< parameter for particle exchange of PEs
    273287    INTEGER(iwp) ::  trnp_count_sum                               !< parameter for particle exchange of PEs
    274     INTEGER(iwp) ::  trnp_count_recv_sum                          !< parameter for particle exchange of PEs   
    275    
     288    INTEGER(iwp) ::  trnp_count_recv_sum                          !< parameter for particle exchange of PEs
     289
    276290    LOGICAL ::  lagrangian_particle_model = .FALSE.       !< namelist parameter (see documentation)
    277291    LOGICAL ::  curvature_solution_effects = .FALSE.      !< namelist parameter (see documentation)
    … …  
    285299    LOGICAL ::  use_kernel_tables = .FALSE.               !< parameter, which turns on the use of precalculated collision kernels
    286300    LOGICAL ::  write_particle_statistics = .FALSE.       !< namelist parameter (see documentation)
    287    
     301
    288302    LOGICAL, DIMENSION(max_number_of_particle_groups) ::   vertical_particle_advection = .TRUE. !< Switch for vertical particle transport
    289    
     303
    290304    REAL(wp) ::  aero_weight = 1.0_wp                      !< namelist parameter (see documentation)
    291305    REAL(wp) ::  dt_min_part = 0.0002_wp                   !< minimum particle time step when SGS velocities are used (s)
    … …  
    306320    REAL(wp) ::  weight_factor_split = -1.0_wp             !< namelist parameter (see documentation)
    307321    REAL(wp) ::  z0_av_global                              !< horizontal mean value of z0
    308    
     322
    309323    REAL(wp) ::  rclass_lbound !<
    310324    REAL(wp) ::  rclass_ubound !<
    311325
    312326    REAL(wp), PARAMETER ::  c_0 = 3.0_wp         !< parameter for lagrangian timescale
    313    
     327
    314328    REAL(wp), DIMENSION(max_number_of_particle_groups) ::  density_ratio = 9999999.9_wp  !< namelist parameter (see documentation)
    315329    REAL(wp), DIMENSION(max_number_of_particle_groups) ::  pdx = 9999999.9_wp            !< namelist parameter (see documentation)
    … …  
    325339
    326340    REAL(wp), DIMENSION(:), ALLOCATABLE     ::  log_z_z0   !< Precalculate LOG(z/z0) 
    327    
     341
    328342    INTEGER(iwp), PARAMETER ::  NR_2_direction_move = 10000 !<
    329343    INTEGER(iwp)            ::  nr_move_north               !<
    … …  
    332346    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  move_also_north
    333347    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  move_also_south
    334    
    335     REAL(wp) ::  epsilon      !<
    336     REAL(wp) ::  urms          !<
     348
     349    REAL(wp) ::  epsilon_collision !<
     350    REAL(wp) ::  urms              !<
    337351
    338352    REAL(wp), DIMENSION(:),   ALLOCATABLE ::  epsclass  !< dissipation rate class
    339353    REAL(wp), DIMENSION(:),   ALLOCATABLE ::  radclass  !< radius class
    340354    REAL(wp), DIMENSION(:),   ALLOCATABLE ::  winf      !<
    341    
     355
    342356    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ec        !<
    343357    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ecf       !<
    … …  
    345359    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  hkernel   !<
    346360    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  hwratio   !<
    347        
    348     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ckernel !<       
    349        
     361
     362    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ckernel !<
     363
    350364    INTEGER(iwp), PARAMETER         :: PHASE_INIT    = 1  !<
    351365    INTEGER(iwp), PARAMETER, PUBLIC :: PHASE_RELEASE = 2  !<
    352366
    353367    SAVE
    354    
     368
    355369    PRIVATE
    356    
     370
    357371    PUBLIC lpm_parin,     &
    358372           lpm_header,    &
    359            lpm_init_arrays,&           
     373           lpm_init_arrays,&
    360374           lpm_init,      &
    361375           lpm_actions,   &
    362            lpm_data_output_ptseries, &           
     376           lpm_data_output_ptseries, &
     377           lpm_interaction_droplets_ptq, &
    363378           lpm_rrd_local_particles, &
    364379           lpm_wrd_local, &
    … …  
    368383           lpm_check_parameters
    369384
    370     PUBLIC lagrangian_particle_model, &
    371            max_number_particles_per_gridbox, &
    372            radius_merge, &
    373            radius_split, &
    374            splitting_factor, &
    375            splitting_factor_max, &
    376            weight_factor_merge, &
    377            weight_factor_split
    378            
     385    PUBLIC lagrangian_particle_model
    379386
    380387    INTERFACE lpm_check_parameters
    … …  
    384391    INTERFACE lpm_parin
    385392       MODULE PROCEDURE lpm_parin
    386     END INTERFACE lpm_parin   
    387    
     393    END INTERFACE lpm_parin
     394
    388395    INTERFACE lpm_header
    389396       MODULE PROCEDURE lpm_header
    390397    END INTERFACE lpm_header
    391    
     398
    392399    INTERFACE lpm_init_arrays
    393400       MODULE PROCEDURE lpm_init_arrays
    394     END INTERFACE lpm_init_arrays             
     401    END INTERFACE lpm_init_arrays
    395402 
    396403    INTERFACE lpm_init
    397404       MODULE PROCEDURE lpm_init
    398     END INTERFACE lpm_init       
    399    
     405    END INTERFACE lpm_init
     406
    400407    INTERFACE lpm_actions
    401408       MODULE PROCEDURE lpm_actions
    402409    END INTERFACE lpm_actions
    403    
     410
    404411    INTERFACE lpm_data_output_ptseries
    405412       MODULE PROCEDURE lpm_data_output_ptseries
    406413    END INTERFACE
    407        
     414
    408415    INTERFACE lpm_rrd_local_particles
    409416       MODULE PROCEDURE lpm_rrd_local_particles
    410     END INTERFACE lpm_rrd_local_particles   
    411        
     417    END INTERFACE lpm_rrd_local_particles
     418
    412419    INTERFACE lpm_rrd_global
    413420       MODULE PROCEDURE lpm_rrd_global
    414421    END INTERFACE lpm_rrd_global
    415    
     422
    416423    INTERFACE lpm_rrd_local
    417424       MODULE PROCEDURE lpm_rrd_local
    418     END INTERFACE lpm_rrd_local       
     425    END INTERFACE lpm_rrd_local
    419426
    420427    INTERFACE lpm_wrd_local
    421428       MODULE PROCEDURE lpm_wrd_local
    422429    END INTERFACE lpm_wrd_local
    423    
     430
    424431    INTERFACE lpm_wrd_global
    425432       MODULE PROCEDURE lpm_wrd_global
    426     END INTERFACE lpm_wrd_global   
    427        
     433    END INTERFACE lpm_wrd_global
     434
    428435    INTERFACE lpm_advec
    429436       MODULE PROCEDURE lpm_advec
    430437    END INTERFACE lpm_advec
    431    
     438
    432439    INTERFACE lpm_calc_liquid_water_content
    433440       MODULE PROCEDURE lpm_calc_liquid_water_content
    434441    END INTERFACE
    435    
     442
     443    INTERFACE lpm_interaction_droplets_ptq
     444       MODULE PROCEDURE lpm_interaction_droplets_ptq
     445       MODULE PROCEDURE lpm_interaction_droplets_ptq_ij
     446    END INTERFACE lpm_interaction_droplets_ptq
     447
    436448    INTERFACE lpm_boundary_conds
    437449       MODULE PROCEDURE lpm_boundary_conds
    438450    END INTERFACE lpm_boundary_conds
    439    
     451
    440452    INTERFACE lpm_droplet_condensation
    441453       MODULE PROCEDURE lpm_droplet_condensation
    442454    END INTERFACE
    443    
     455
    444456    INTERFACE lpm_droplet_collision
    445457       MODULE PROCEDURE lpm_droplet_collision
    446458    END INTERFACE lpm_droplet_collision
    447    
     459
    448460    INTERFACE lpm_init_kernels
    449461       MODULE PROCEDURE lpm_init_kernels
    450462    END INTERFACE lpm_init_kernels
    451    
     463
    452464    INTERFACE lpm_splitting
    453465       MODULE PROCEDURE lpm_splitting
    454466    END INTERFACE lpm_splitting
    455    
     467
    456468    INTERFACE lpm_merging
    457469       MODULE PROCEDURE lpm_merging
    458470    END INTERFACE lpm_merging
    459    
     471
    460472    INTERFACE lpm_exchange_horiz
    461473       MODULE PROCEDURE lpm_exchange_horiz
    … …  
    473485       MODULE PROCEDURE dealloc_particles_array
    474486    END INTERFACE dealloc_particles_array
    475    
     487
    476488    INTERFACE lpm_sort_in_subboxes
    477489       MODULE PROCEDURE lpm_sort_in_subboxes
    … …  
    481493       MODULE PROCEDURE lpm_sort_timeloop_done
    482494    END INTERFACE lpm_sort_timeloop_done
    483    
     495
    484496    INTERFACE lpm_pack
    485497       MODULE PROCEDURE lpm_pack
    486498    END INTERFACE lpm_pack
    487    
    488    
    489    
     499
    490500 CONTAINS
    491501 
    … …  
    499509 
    500510    CHARACTER (LEN=80) ::  line  !<
    501    
     511
    502512    NAMELIST /particles_par/ &
    503513       aero_species, &
    504514       aero_type, &
    505        aero_weight, &       
     515       aero_weight, &
    506516       alloc_factor, &
    507517       bc_par_b, &
    … …  
    523533       max_number_particles_per_gridbox, &
    524534       merging, &
    525        min_nr_particle, &
    526535       na, &
    527536       number_concentration, &
    … …  
    559568       weight_factor_split, &
    560569       write_particle_statistics
    561                                  
    562     NAMELIST /particle_parameters/ &
     570
     571       NAMELIST /particle_parameters/ &
    563572       aero_species, &
    564573       aero_type, &
    565        aero_weight, &       
     574       aero_weight, &
    566575       alloc_factor, &
    567576       bc_par_b, &
    … …  
    583592       max_number_particles_per_gridbox, &
    584593       merging, &
    585        min_nr_particle, &
    586594       na, &
    587595       number_concentration, &
    … …  
    619627       weight_factor_split, &
    620628       write_particle_statistics
    621        
     629
    622630!
    623631!-- Position the namelist-file at the beginning (it was already opened in
    … …  
    657665!-- Read user-defined namelist
    658666    READ ( 11, particles_par, ERR = 13, END = 14 )
    659    
    660    
     667
    661668    message_string = 'namelist particles_par is deprecated and will be ' //    &
    662669                     'removed in near future. Please use namelist ' //         &
    … …  
    13901397                         alloc_size = MAX( INT( local_count(kp,jp,ip) *        &
    13911398                            ( 1.0_wp + alloc_factor / 100.0_wp ) ),            &
    1392                             min_nr_particle )
     1399                            1 )
    13931400                      ELSE
    1394                          alloc_size = min_nr_particle
     1401                         alloc_size = 1
    13951402                      ENDIF
    13961403                      ALLOCATE(grid_particles(kp,jp,ip)%particles(1:alloc_size))
    … …  
    14021409                         new_size   = local_count(kp,jp,ip) + prt_count(kp,jp,ip)
    14031410                         alloc_size = MAX( INT( new_size * ( 1.0_wp +          &
    1404                             alloc_factor / 100.0_wp ) ), min_nr_particle )
     1411                            alloc_factor / 100.0_wp ) ), 1 )
    14051412                         IF( alloc_size > SIZE( grid_particles(kp,jp,ip)%particles) )  THEN
    14061413                            CALL realloc_particles_array(ip,jp,kp,alloc_size)
    … …  
    28672874!
    28682875!-- If less particles are stored on the restart file than prescribed by
    2869 !-- min_nr_particle, the remainder is initialized by zero_particle to avoid
     2876!-- 1, the remainder is initialized by zero_particle to avoid
    28702877!-- errors.
    28712878    zero_particle = particle_type( 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp,     &
    … …  
    28942901                alloc_size = MAX( INT( number_of_particles *                   &
    28952902                             ( 1.0_wp + alloc_factor / 100.0_wp ) ),           &
    2896                              min_nr_particle )
     2903                             1 )
    28972904             ELSE
    2898                 alloc_size = min_nr_particle
     2905                alloc_size = 1
    28992906             ENDIF
    29002907
    … …  
    30803087
    30813088 END SUBROUTINE lpm_wrd_local
    3082  
    3083  
     3089
     3090
    30843091!------------------------------------------------------------------------------!
    30853092! Description:
    … …  
    33213328                u_int(n) = -usws_int / ( us_int * kappa + 1E-10_wp )           &
    33223329                            * log_z_z0_int - u_gtrans
    3323                
     3330
    33243331             ENDIF
    33253332!
    … …  
    34943501!-- velocities
    34953502    IF ( use_sgs_for_particles  .AND.  .NOT. cloud_droplets )  THEN
    3496    
     3503
    34973504       DO  nb = 0,7
    3498          
    3499           subbox_at_wall = .FALSE.         
     3505
     3506          subbox_at_wall = .FALSE.
    35003507!
    35013508!--       In case of topography check if subbox is adjacent to a wall
    … …  
    35193526!
    35203527!--          Set flag for stochastic equation.
    3521              term_1_2(start_index(nb):end_index(nb)) = 0.0_wp             
     3528             term_1_2(start_index(nb):end_index(nb)) = 0.0_wp
    35223529          ELSE
    35233530             i = ip + block_offset(nb)%i_off
    … …  
    48974904
    48984905 END SUBROUTINE lpm_droplet_condensation
    4899  
    4900  
     4906
     4907
     4908!------------------------------------------------------------------------------!
     4909! Description:
     4910! ------------
     4911!> Release of latent heat and change of mixing ratio due to condensation /
     4912!> evaporation of droplets.
     4913!------------------------------------------------------------------------------!
     4914 SUBROUTINE lpm_interaction_droplets_ptq
     4915
     4916    INTEGER(iwp) ::  i    !< running index x direction
     4917    INTEGER(iwp) ::  j    !< running index y direction
     4918    INTEGER(iwp) ::  k    !< running index z direction
     4919
     4920    REAL(wp) ::  flag     !< flag to mask topography grid points
     4921
     4922    DO  i = nxl, nxr
     4923       DO  j = nys, nyn
     4924          DO  k = nzb+1, nzt
     4925!
     4926!--          Predetermine flag to mask topography
     4927             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     4928
     4929             q_p(k,j,i)  = q_p(k,j,i)  - ql_c(k,j,i) * flag
     4930             pt_p(k,j,i) = pt_p(k,j,i) + lv_d_cp * ql_c(k,j,i) * d_exner(k) &
     4931                                                     * flag
     4932          ENDDO
     4933       ENDDO
     4934    ENDDO
     4935
     4936 END SUBROUTINE lpm_interaction_droplets_ptq
     4937
     4938
     4939!------------------------------------------------------------------------------!
     4940! Description:
     4941! ------------
     4942!> Release of latent heat and change of mixing ratio due to condensation /
     4943!> evaporation of droplets. Call for grid point i,j
     4944!------------------------------------------------------------------------------!
     4945 SUBROUTINE lpm_interaction_droplets_ptq_ij( i, j )
     4946
     4947    INTEGER(iwp) ::  i    !< running index x direction
     4948    INTEGER(iwp) ::  j    !< running index y direction
     4949    INTEGER(iwp) ::  k    !< running index z direction
     4950
     4951    REAL(wp) ::  flag     !< flag to mask topography grid points
     4952
     4953
     4954    DO  k = nzb+1, nzt
     4955!
     4956!--    Predetermine flag to mask topography
     4957       flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
     4958
     4959       q_p(k,j,i)  = q_p(k,j,i)  - ql_c(k,j,i) * flag
     4960       pt_p(k,j,i) = pt_p(k,j,i) + lv_d_cp * ql_c(k,j,i) * d_exner(k) * flag
     4961    ENDDO
     4962
     4963 END SUBROUTINE lpm_interaction_droplets_ptq_ij
     4964
     4965
    49014966!------------------------------------------------------------------------------!
    49024967! Description:
    … …  
    49565021 END SUBROUTINE lpm_calc_liquid_water_content
    49575022
    4958  
     5023
    49595024!------------------------------------------------------------------------------!
    49605025! Description:
    … …  
    49755040!------------------------------------------------------------------------------!
    49765041 SUBROUTINE lpm_droplet_collision (i,j,k)
    4977    
     5042
    49785043    INTEGER(iwp), INTENT(IN) ::  i        !<
    49795044    INTEGER(iwp), INTENT(IN) ::  j        !<
    … …  
    49885053    REAL(wp) ::  collection_probability  !< probability for collection
    49895054    REAL(wp) ::  ddV                     !< inverse grid box volume
    4990     REAL(wp) ::  epsilon                 !< dissipation rate
     5055    REAL(wp) ::  epsilon_collision       !< dissipation rate
    49915056    REAL(wp) ::  factor_volume_to_mass   !< 4.0 / 3.0 * pi * rho_l
    49925057    REAL(wp) ::  xm                      !< droplet mass of super-droplet m
    … …  
    50155080             eclass = INT( diss(k,j,i) * 1.0E4_wp / 600.0_wp * &
    50165081                           dissipation_classes ) + 1
    5017              epsilon = diss(k,j,i)
     5082             epsilon_collision = diss(k,j,i)
    50185083          ELSE
    5019              epsilon = 0.0_wp
     5084             epsilon_collision = 0.0_wp
    50205085          ENDIF
    50215086
    5022           IF ( hall_kernel  .OR.  epsilon * 1.0E4_wp < 0.001_wp )  THEN
     5087          IF ( hall_kernel  .OR.  epsilon_collision * 1.0E4_wp < 0.001_wp )  THEN
    50235088             eclass = 0   ! Hall kernel is used
    50245089          ELSE
    … …  
    52425307       DO  k = 1, dissipation_classes
    52435308
    5244           epsilon = epsclass(k)
    5245           urms    = 2.02_wp * ( epsilon / 0.04_wp )**( 1.0_wp / 3.0_wp )
     5309          epsilon_collision = epsclass(k)
     5310          urms    = 2.02_wp * ( epsilon_collision / 0.04_wp )**( 1.0_wp / 3.0_wp )
    52465311
    52475312          CALL turbsd
    … …  
    53395404
    53405405    IF ( wang_kernel )  THEN
    5341        epsilon = diss(k1,j1,i1)   ! dissipation rate in m**2/s**3
     5406       epsilon_collision = diss(k1,j1,i1)   ! dissipation rate in m**2/s**3
    53425407    ELSE
    5343        epsilon = 0.0_wp
     5408       epsilon_collision = 0.0_wp
    53445409    ENDIF
    5345     urms    = 2.02_wp * ( epsilon / 0.04_wp )**( 0.33333333333_wp )
    5346 
    5347     IF ( wang_kernel  .AND.  epsilon > 1.0E-7_wp )  THEN
     5410    urms    = 2.02_wp * ( epsilon_collision / 0.04_wp )**( 0.33333333333_wp )
     5411
     5412    IF ( wang_kernel  .AND.  epsilon_collision > 1.0E-7_wp )  THEN
    53485413!
    53495414!--    Call routines to calculate efficiencies for the Wang kernel
    … …  
    54445509    REAL(wp), DIMENSION(1:radius_classes) ::  tau !< inertial time scale
    54455510
    5446     lambda    = urms * SQRT( 15.0_wp * molecular_viscosity / epsilon )
    5447     lambda_re = urms**2 * SQRT( 15.0_wp / epsilon / molecular_viscosity )
    5448     tl        = urms**2 / epsilon
    5449     lf        = 0.5_wp * urms**3 / epsilon
    5450     tauk      = SQRT( molecular_viscosity / epsilon )
    5451     eta       = ( molecular_viscosity**3 / epsilon )**0.25_wp
     5511    lambda    = urms * SQRT( 15.0_wp * molecular_viscosity / epsilon_collision )
     5512    lambda_re = urms**2 * SQRT( 15.0_wp / epsilon_collision / molecular_viscosity )
     5513    tl        = urms**2 / epsilon_collision
     5514    lf        = 0.5_wp * urms**3 / epsilon_collision
     5515    tauk      = SQRT( molecular_viscosity / epsilon_collision )
     5516    eta       = ( molecular_viscosity**3 / epsilon_collision )**0.25_wp
    54525517    vk        = eta / tauk
    54535518
    … …  
    59616026!
    59626027!--       Linear interpolation of turbulent enhancement factor
    5963           IF ( epsilon <= 0.01_wp )  THEN
    5964              ecf(j,i) = ( epsilon - 0.01_wp ) / ( 0.0_wp  - 0.01_wp ) * y1 &
    5965                       + ( epsilon - 0.0_wp  ) / ( 0.01_wp - 0.0_wp  ) * y2
    5966           ELSEIF ( epsilon <= 0.06_wp )  THEN
    5967              ecf(j,i) = ( epsilon - 0.04_wp ) / ( 0.01_wp - 0.04_wp ) * y2 &
    5968                       + ( epsilon - 0.01_wp ) / ( 0.04_wp - 0.01_wp ) * y3
     6028          IF ( epsilon_collision <= 0.01_wp )  THEN
     6029             ecf(j,i) = ( epsilon_collision - 0.01_wp ) / ( 0.0_wp  - 0.01_wp ) * y1 &
     6030                      + ( epsilon_collision - 0.0_wp  ) / ( 0.01_wp - 0.0_wp  ) * y2
     6031          ELSEIF ( epsilon_collision <= 0.06_wp )  THEN
     6032             ecf(j,i) = ( epsilon_collision - 0.04_wp ) / ( 0.01_wp - 0.04_wp ) * y2 &
     6033                      + ( epsilon_collision - 0.01_wp ) / ( 0.04_wp - 0.01_wp ) * y3
    59696034          ELSE
    59706035             ecf(j,i) = ( 0.06_wp - 0.04_wp ) / ( 0.01_wp - 0.04_wp ) * y2 &
    … …  
    61206185                   ENDIF
    61216186                ENDDO
    6122                
     6187
    61236188             ENDDO
    61246189          ENDDO
    … …  
    75697634    ENDIF
    75707635
    7571     new_size = MAX( new_size, min_nr_particle, old_size + 1 )
     7636    new_size = MAX( new_size, 1, old_size + 1 )
    75727637
    75737638    IF ( old_size <= 500 )  THEN
    … …  
    76327697!
    76337698!--          Check for large unused memory
    7634              dealloc = ( ( number_of_particles < min_nr_particle .AND.         &
    7635                            old_size            > min_nr_particle )  .OR.       &
    7636                          ( number_of_particles > min_nr_particle .AND.         &
     7699             dealloc = ( ( number_of_particles < 1 .AND.         &
     7700                           old_size            > 1 )  .OR.       &
     7701                         ( number_of_particles > 1 .AND.         &
    76377702                           old_size - number_of_particles *                    &
    76387703                              ( 1.0_wp + 0.01_wp * alloc_factor ) > 0.0_wp ) )
    7639                          
    76407704
    76417705             IF ( dealloc )  THEN
    7642                 IF ( number_of_particles < min_nr_particle )  THEN
    7643                    new_size = min_nr_particle
     7706                IF ( number_of_particles < 1 )  THEN
     7707                   new_size = 1
    76447708                ELSE
    76457709                   new_size = INT( number_of_particles * ( 1.0_wp + 0.01_wp * alloc_factor ) )
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |