Changeset 4043 for palm/trunk/SOURCE/lagrangian_particle_model_mod.f90
 Timestamp:
 Jun 18, 2019 4:59:00 PM (2 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

palm/trunk/SOURCE/lagrangian_particle_model_mod.f90
r4028 r4043 25 25 !  26 26 ! $Id$ 27 ! Remove min_nr_particle, Add lpm_droplet_interactions_ptq into module 28 ! 29 ! 4028 20190613 12:21:37Z schwenkel 27 30 ! Further modularization of particle code components 28 31 ! … … 160 163 !! 161 164 MODULE lagrangian_particle_model_mod 162 165 163 166 USE, INTRINSIC :: ISO_C_BINDING 164 167 165 168 USE arrays_3d, & 166 169 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 168 172 169 173 USE averaging, & 170 174 ONLY: ql_c_av, pr_av, pc_av, ql_vp_av, ql_v_av 171 175 172 176 USE basic_constants_and_equations_mod, & 173 177 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 176 180 USE control_parameters, & 177 181 ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, & … … 186 190 USE cpulog, & 187 191 ONLY: cpu_log, log_point, log_point_s 188 192 189 193 USE indices, & 190 194 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 193 197 USE kinds 194 198 195 199 USE pegrid 196 200 197 201 USE particle_attributes 198 202 199 203 USE pmc_particle_interface, & 200 204 ONLY: pmcp_c_get_particle_from_parent, pmcp_p_fill_particle_win, & … … 213 217 id_var_dopts, id_var_time_pts, nc_stat, & 214 218 netcdf_handle_error 215 219 216 220 USE random_function_mod, & 217 221 ONLY: random_function 218 222 219 223 USE statistics, & 220 ONLY: hom 224 ONLY: hom 221 225 222 226 USE surface_mod, & 223 227 ONLY: get_topography_top_index_ji, surf_def_h, surf_lsm_h, surf_usm_h,& 224 228 bc_h 225 229 226 230 #if defined( __parallel ) && !defined( __mpifh ) 227 231 USE MPI … … 236 240 #endif 237 241 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 238 253 IMPLICIT NONE 239 254 240 255 CHARACTER(LEN=15) :: aero_species = 'nacl' !< aerosol species 241 256 CHARACTER(LEN=15) :: aero_type = 'maritime' !< aerosol type … … 245 260 CHARACTER(LEN=15) :: bc_par_t = 'absorb' !< top boundary condition 246 261 CHARACTER(LEN=15) :: collision_kernel = 'none' !< collision kernel 247 262 248 263 CHARACTER(LEN=5) :: splitting_function = 'gamma' !< function for calculation critical weighting factor 249 264 CHARACTER(LEN=5) :: splitting_mode = 'const' !< splitting mode … … 260 275 INTEGER(iwp) :: particles_per_point = 1 !< namelist parameter (see documentation) 261 276 INTEGER(iwp) :: radius_classes = 20 !< namelist parameter (see documentation) 262 263 277 INTEGER(iwp) :: splitting_factor = 2 !< namelist parameter (see documentation) 264 278 INTEGER(iwp) :: splitting_factor_max = 5 !< namelist parameter (see documentation) … … 272 286 INTEGER(iwp) :: trsp_count_recv_sum !< parameter for particle exchange of PEs 273 287 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 276 290 LOGICAL :: lagrangian_particle_model = .FALSE. !< namelist parameter (see documentation) 277 291 LOGICAL :: curvature_solution_effects = .FALSE. !< namelist parameter (see documentation) … … 285 299 LOGICAL :: use_kernel_tables = .FALSE. !< parameter, which turns on the use of precalculated collision kernels 286 300 LOGICAL :: write_particle_statistics = .FALSE. !< namelist parameter (see documentation) 287 301 288 302 LOGICAL, DIMENSION(max_number_of_particle_groups) :: vertical_particle_advection = .TRUE. !< Switch for vertical particle transport 289 303 290 304 REAL(wp) :: aero_weight = 1.0_wp !< namelist parameter (see documentation) 291 305 REAL(wp) :: dt_min_part = 0.0002_wp !< minimum particle time step when SGS velocities are used (s) … … 306 320 REAL(wp) :: weight_factor_split = 1.0_wp !< namelist parameter (see documentation) 307 321 REAL(wp) :: z0_av_global !< horizontal mean value of z0 308 322 309 323 REAL(wp) :: rclass_lbound !< 310 324 REAL(wp) :: rclass_ubound !< 311 325 312 326 REAL(wp), PARAMETER :: c_0 = 3.0_wp !< parameter for lagrangian timescale 313 327 314 328 REAL(wp), DIMENSION(max_number_of_particle_groups) :: density_ratio = 9999999.9_wp !< namelist parameter (see documentation) 315 329 REAL(wp), DIMENSION(max_number_of_particle_groups) :: pdx = 9999999.9_wp !< namelist parameter (see documentation) … … 325 339 326 340 REAL(wp), DIMENSION(:), ALLOCATABLE :: log_z_z0 !< Precalculate LOG(z/z0) 327 341 328 342 INTEGER(iwp), PARAMETER :: NR_2_direction_move = 10000 !< 329 343 INTEGER(iwp) :: nr_move_north !< … … 332 346 TYPE(particle_type), DIMENSION(:), ALLOCATABLE :: move_also_north 333 347 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 !< 337 351 338 352 REAL(wp), DIMENSION(:), ALLOCATABLE :: epsclass !< dissipation rate class 339 353 REAL(wp), DIMENSION(:), ALLOCATABLE :: radclass !< radius class 340 354 REAL(wp), DIMENSION(:), ALLOCATABLE :: winf !< 341 355 342 356 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ec !< 343 357 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ecf !< … … 345 359 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: hkernel !< 346 360 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: hwratio !< 347 348 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ckernel !< 349 361 362 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ckernel !< 363 350 364 INTEGER(iwp), PARAMETER :: PHASE_INIT = 1 !< 351 365 INTEGER(iwp), PARAMETER, PUBLIC :: PHASE_RELEASE = 2 !< 352 366 353 367 SAVE 354 368 355 369 PRIVATE 356 370 357 371 PUBLIC lpm_parin, & 358 372 lpm_header, & 359 lpm_init_arrays,& 373 lpm_init_arrays,& 360 374 lpm_init, & 361 375 lpm_actions, & 362 lpm_data_output_ptseries, & 376 lpm_data_output_ptseries, & 377 lpm_interaction_droplets_ptq, & 363 378 lpm_rrd_local_particles, & 364 379 lpm_wrd_local, & … … 368 383 lpm_check_parameters 369 384 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 379 386 380 387 INTERFACE lpm_check_parameters … … 384 391 INTERFACE lpm_parin 385 392 MODULE PROCEDURE lpm_parin 386 END INTERFACE lpm_parin 387 393 END INTERFACE lpm_parin 394 388 395 INTERFACE lpm_header 389 396 MODULE PROCEDURE lpm_header 390 397 END INTERFACE lpm_header 391 398 392 399 INTERFACE lpm_init_arrays 393 400 MODULE PROCEDURE lpm_init_arrays 394 END INTERFACE lpm_init_arrays 401 END INTERFACE lpm_init_arrays 395 402 396 403 INTERFACE lpm_init 397 404 MODULE PROCEDURE lpm_init 398 END INTERFACE lpm_init 399 405 END INTERFACE lpm_init 406 400 407 INTERFACE lpm_actions 401 408 MODULE PROCEDURE lpm_actions 402 409 END INTERFACE lpm_actions 403 410 404 411 INTERFACE lpm_data_output_ptseries 405 412 MODULE PROCEDURE lpm_data_output_ptseries 406 413 END INTERFACE 407 414 408 415 INTERFACE lpm_rrd_local_particles 409 416 MODULE PROCEDURE lpm_rrd_local_particles 410 END INTERFACE lpm_rrd_local_particles 411 417 END INTERFACE lpm_rrd_local_particles 418 412 419 INTERFACE lpm_rrd_global 413 420 MODULE PROCEDURE lpm_rrd_global 414 421 END INTERFACE lpm_rrd_global 415 422 416 423 INTERFACE lpm_rrd_local 417 424 MODULE PROCEDURE lpm_rrd_local 418 END INTERFACE lpm_rrd_local 425 END INTERFACE lpm_rrd_local 419 426 420 427 INTERFACE lpm_wrd_local 421 428 MODULE PROCEDURE lpm_wrd_local 422 429 END INTERFACE lpm_wrd_local 423 430 424 431 INTERFACE lpm_wrd_global 425 432 MODULE PROCEDURE lpm_wrd_global 426 END INTERFACE lpm_wrd_global 427 433 END INTERFACE lpm_wrd_global 434 428 435 INTERFACE lpm_advec 429 436 MODULE PROCEDURE lpm_advec 430 437 END INTERFACE lpm_advec 431 438 432 439 INTERFACE lpm_calc_liquid_water_content 433 440 MODULE PROCEDURE lpm_calc_liquid_water_content 434 441 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 436 448 INTERFACE lpm_boundary_conds 437 449 MODULE PROCEDURE lpm_boundary_conds 438 450 END INTERFACE lpm_boundary_conds 439 451 440 452 INTERFACE lpm_droplet_condensation 441 453 MODULE PROCEDURE lpm_droplet_condensation 442 454 END INTERFACE 443 455 444 456 INTERFACE lpm_droplet_collision 445 457 MODULE PROCEDURE lpm_droplet_collision 446 458 END INTERFACE lpm_droplet_collision 447 459 448 460 INTERFACE lpm_init_kernels 449 461 MODULE PROCEDURE lpm_init_kernels 450 462 END INTERFACE lpm_init_kernels 451 463 452 464 INTERFACE lpm_splitting 453 465 MODULE PROCEDURE lpm_splitting 454 466 END INTERFACE lpm_splitting 455 467 456 468 INTERFACE lpm_merging 457 469 MODULE PROCEDURE lpm_merging 458 470 END INTERFACE lpm_merging 459 471 460 472 INTERFACE lpm_exchange_horiz 461 473 MODULE PROCEDURE lpm_exchange_horiz … … 473 485 MODULE PROCEDURE dealloc_particles_array 474 486 END INTERFACE dealloc_particles_array 475 487 476 488 INTERFACE lpm_sort_in_subboxes 477 489 MODULE PROCEDURE lpm_sort_in_subboxes … … 481 493 MODULE PROCEDURE lpm_sort_timeloop_done 482 494 END INTERFACE lpm_sort_timeloop_done 483 495 484 496 INTERFACE lpm_pack 485 497 MODULE PROCEDURE lpm_pack 486 498 END INTERFACE lpm_pack 487 488 489 499 490 500 CONTAINS 491 501 … … 499 509 500 510 CHARACTER (LEN=80) :: line !< 501 511 502 512 NAMELIST /particles_par/ & 503 513 aero_species, & 504 514 aero_type, & 505 aero_weight, & 515 aero_weight, & 506 516 alloc_factor, & 507 517 bc_par_b, & … … 523 533 max_number_particles_per_gridbox, & 524 534 merging, & 525 min_nr_particle, &526 535 na, & 527 536 number_concentration, & … … 559 568 weight_factor_split, & 560 569 write_particle_statistics 561 562 NAMELIST /particle_parameters/ &570 571 NAMELIST /particle_parameters/ & 563 572 aero_species, & 564 573 aero_type, & 565 aero_weight, & 574 aero_weight, & 566 575 alloc_factor, & 567 576 bc_par_b, & … … 583 592 max_number_particles_per_gridbox, & 584 593 merging, & 585 min_nr_particle, &586 594 na, & 587 595 number_concentration, & … … 619 627 weight_factor_split, & 620 628 write_particle_statistics 621 629 622 630 ! 623 631 ! Position the namelistfile at the beginning (it was already opened in … … 657 665 ! Read userdefined namelist 658 666 READ ( 11, particles_par, ERR = 13, END = 14 ) 659 660 667 661 668 message_string = 'namelist particles_par is deprecated and will be ' // & 662 669 'removed in near future. Please use namelist ' // & … … 1390 1397 alloc_size = MAX( INT( local_count(kp,jp,ip) * & 1391 1398 ( 1.0_wp + alloc_factor / 100.0_wp ) ), & 1392 min_nr_particle)1399 1 ) 1393 1400 ELSE 1394 alloc_size = min_nr_particle1401 alloc_size = 1 1395 1402 ENDIF 1396 1403 ALLOCATE(grid_particles(kp,jp,ip)%particles(1:alloc_size)) … … 1402 1409 new_size = local_count(kp,jp,ip) + prt_count(kp,jp,ip) 1403 1410 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 ) 1405 1412 IF( alloc_size > SIZE( grid_particles(kp,jp,ip)%particles) ) THEN 1406 1413 CALL realloc_particles_array(ip,jp,kp,alloc_size) … … 2867 2874 ! 2868 2875 ! If less particles are stored on the restart file than prescribed by 2869 ! min_nr_particle, the remainder is initialized by zero_particle to avoid2876 ! 1, the remainder is initialized by zero_particle to avoid 2870 2877 ! errors. 2871 2878 zero_particle = particle_type( 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, & … … 2894 2901 alloc_size = MAX( INT( number_of_particles * & 2895 2902 ( 1.0_wp + alloc_factor / 100.0_wp ) ), & 2896 min_nr_particle)2903 1 ) 2897 2904 ELSE 2898 alloc_size = min_nr_particle2905 alloc_size = 1 2899 2906 ENDIF 2900 2907 … … 3080 3087 3081 3088 END SUBROUTINE lpm_wrd_local 3082 3083 3089 3090 3084 3091 !! 3085 3092 ! Description: … … 3321 3328 u_int(n) = usws_int / ( us_int * kappa + 1E10_wp ) & 3322 3329 * log_z_z0_int  u_gtrans 3323 3330 3324 3331 ENDIF 3325 3332 ! … … 3494 3501 ! velocities 3495 3502 IF ( use_sgs_for_particles .AND. .NOT. cloud_droplets ) THEN 3496 3503 3497 3504 DO nb = 0,7 3498 3499 subbox_at_wall = .FALSE. 3505 3506 subbox_at_wall = .FALSE. 3500 3507 ! 3501 3508 ! In case of topography check if subbox is adjacent to a wall … … 3519 3526 ! 3520 3527 ! 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 3522 3529 ELSE 3523 3530 i = ip + block_offset(nb)%i_off … … 4897 4904 4898 4905 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 4901 4966 !! 4902 4967 ! Description: … … 4956 5021 END SUBROUTINE lpm_calc_liquid_water_content 4957 5022 4958 5023 4959 5024 !! 4960 5025 ! Description: … … 4975 5040 !! 4976 5041 SUBROUTINE lpm_droplet_collision (i,j,k) 4977 5042 4978 5043 INTEGER(iwp), INTENT(IN) :: i !< 4979 5044 INTEGER(iwp), INTENT(IN) :: j !< … … 4988 5053 REAL(wp) :: collection_probability !< probability for collection 4989 5054 REAL(wp) :: ddV !< inverse grid box volume 4990 REAL(wp) :: epsilon 5055 REAL(wp) :: epsilon_collision !< dissipation rate 4991 5056 REAL(wp) :: factor_volume_to_mass !< 4.0 / 3.0 * pi * rho_l 4992 5057 REAL(wp) :: xm !< droplet mass of superdroplet m … … 5015 5080 eclass = INT( diss(k,j,i) * 1.0E4_wp / 600.0_wp * & 5016 5081 dissipation_classes ) + 1 5017 epsilon = diss(k,j,i)5082 epsilon_collision = diss(k,j,i) 5018 5083 ELSE 5019 epsilon = 0.0_wp5084 epsilon_collision = 0.0_wp 5020 5085 ENDIF 5021 5086 5022 IF ( hall_kernel .OR. epsilon * 1.0E4_wp < 0.001_wp ) THEN5087 IF ( hall_kernel .OR. epsilon_collision * 1.0E4_wp < 0.001_wp ) THEN 5023 5088 eclass = 0 ! Hall kernel is used 5024 5089 ELSE … … 5242 5307 DO k = 1, dissipation_classes 5243 5308 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 ) 5246 5311 5247 5312 CALL turbsd … … 5339 5404 5340 5405 IF ( wang_kernel ) THEN 5341 epsilon = diss(k1,j1,i1) ! dissipation rate in m**2/s**35406 epsilon_collision = diss(k1,j1,i1) ! dissipation rate in m**2/s**3 5342 5407 ELSE 5343 epsilon = 0.0_wp5408 epsilon_collision = 0.0_wp 5344 5409 ENDIF 5345 urms = 2.02_wp * ( epsilon / 0.04_wp )**( 0.33333333333_wp )5346 5347 IF ( wang_kernel .AND. epsilon > 1.0E7_wp ) THEN5410 urms = 2.02_wp * ( epsilon_collision / 0.04_wp )**( 0.33333333333_wp ) 5411 5412 IF ( wang_kernel .AND. epsilon_collision > 1.0E7_wp ) THEN 5348 5413 ! 5349 5414 ! Call routines to calculate efficiencies for the Wang kernel … … 5444 5509 REAL(wp), DIMENSION(1:radius_classes) :: tau !< inertial time scale 5445 5510 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_wp5511 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 5452 5517 vk = eta / tauk 5453 5518 … … 5961 6026 ! 5962 6027 ! Linear interpolation of turbulent enhancement factor 5963 IF ( epsilon <= 0.01_wp ) THEN5964 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 ) * y25966 ELSEIF ( epsilon <= 0.06_wp ) THEN5967 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 ) * y36028 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 5969 6034 ELSE 5970 6035 ecf(j,i) = ( 0.06_wp  0.04_wp ) / ( 0.01_wp  0.04_wp ) * y2 & … … 6120 6185 ENDIF 6121 6186 ENDDO 6122 6187 6123 6188 ENDDO 6124 6189 ENDDO … … 7569 7634 ENDIF 7570 7635 7571 new_size = MAX( new_size, min_nr_particle, old_size + 1 )7636 new_size = MAX( new_size, 1, old_size + 1 ) 7572 7637 7573 7638 IF ( old_size <= 500 ) THEN … … 7632 7697 ! 7633 7698 ! 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. & 7637 7702 old_size  number_of_particles * & 7638 7703 ( 1.0_wp + 0.01_wp * alloc_factor ) > 0.0_wp ) ) 7639 7640 7704 7641 7705 IF ( dealloc ) THEN 7642 IF ( number_of_particles < min_nr_particle) THEN7643 new_size = min_nr_particle7706 IF ( number_of_particles < 1 ) THEN 7707 new_size = 1 7644 7708 ELSE 7645 7709 new_size = INT( number_of_particles * ( 1.0_wp + 0.01_wp * alloc_factor ) )
Note: See TracChangeset
for help on using the changeset viewer.