Changeset 2801 for palm/trunk/SOURCE/pmc_interface_mod.f90
- Timestamp:
- Feb 14, 2018 4:01:55 PM (6 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (114 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_mod.f90
r2795 r2801 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Introduce particle transfer in nested models. 28 ! 29 ! 2795 2018-02-07 14:48:48Z hellstea 27 30 ! Bugfix in computation of the anterpolation under-relaxation functions. 28 31 ! … … 214 217 ! routine 215 218 ! @todo Data transfer of qc and nc is prepared but not activated 216 !------------------------------------------------------------------------------ -!219 !------------------------------------------------------------------------------! 217 220 MODULE pmc_interface 221 222 USE ISO_C_BINDING 223 218 224 219 225 #if defined( __nopointer ) … … 228 234 #endif 229 235 230 USE control_parameters, 231 ONLY: air_chemistry, cloud_physics, coupling_char, dt_3d, dz, humidity,&232 message_string, microphysics_morrison, microphysics_seifert,&233 nest_bound_l, nest_bound_r, nest_bound_s, nest_bound_n,&234 nest_ domain, neutral, passive_scalar, roughness_length, &235 simulated_time, topography, volume_flow236 USE control_parameters, & 237 ONLY: air_chemistry, cloud_physics, coupling_char, dt_3d, dz, & 238 humidity, message_string, microphysics_morrison, & 239 microphysics_seifert, nest_bound_l, nest_bound_r, nest_bound_s, & 240 nest_bound_n, nest_domain, neutral, passive_scalar, & 241 roughness_length, simulated_time, topography, volume_flow 236 242 237 243 USE chem_modules, & … … 250 256 ONLY: nbgp, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nyn, nyng, nys, nysg, & 251 257 nysv, nz, nzb, nzt, wall_flags_0 258 259 USE particle_attributes, & 260 ONLY: particle_advection 252 261 253 262 USE kinds … … 275 284 USE pmc_handle_communicator, & 276 285 ONLY: pmc_get_model_info, pmc_init_model, pmc_is_rootmodel, & 277 pmc_no_namelist_found, pmc_parent_for_child 286 pmc_no_namelist_found, pmc_parent_for_child, m_couplers 278 287 279 288 USE pmc_mpi_wrapper, & … … 297 306 ! 298 307 !-- Constants 299 INTEGER(iwp), PARAMETER :: child_to_parent = 2 ! :300 INTEGER(iwp), PARAMETER :: parent_to_child = 1 ! :308 INTEGER(iwp), PARAMETER :: child_to_parent = 2 !< 309 INTEGER(iwp), PARAMETER :: parent_to_child = 1 !< 301 310 ! 302 311 !-- Coupler setup 303 INTEGER(iwp), SAVE :: comm_world_nesting !:304 INTEGER(iwp), SAVE :: cpl_id = 1 !:305 CHARACTER(LEN=32), SAVE :: cpl_name !:306 INTEGER(iwp), SAVE :: cpl_npe_total !:307 INTEGER(iwp), SAVE :: cpl_parent_id !:312 INTEGER(iwp), SAVE :: comm_world_nesting !< 313 INTEGER(iwp), SAVE :: cpl_id = 1 !< 314 CHARACTER(LEN=32), SAVE :: cpl_name !< 315 INTEGER(iwp), SAVE :: cpl_npe_total !< 316 INTEGER(iwp), SAVE :: cpl_parent_id !< 308 317 ! 309 318 !-- Control parameters, will be made input parameters later 310 CHARACTER(LEN=7), SAVE :: nesting_datatransfer_mode = 'mixed' ! :steering311 ! :parameter for data-312 ! :transfer mode313 CHARACTER(LEN=8), SAVE :: nesting_mode = 'two-way' ! :steering parameter314 ! :for 1- or 2-way nesting315 316 LOGICAL, SAVE :: nested_run = .FALSE. ! :general switch317 318 REAL(wp), SAVE :: anterp_relax_length_l = -1.0_wp ! :319 REAL(wp), SAVE :: anterp_relax_length_r = -1.0_wp ! :320 REAL(wp), SAVE :: anterp_relax_length_s = -1.0_wp ! :321 REAL(wp), SAVE :: anterp_relax_length_n = -1.0_wp ! :322 REAL(wp), SAVE :: anterp_relax_length_t = -1.0_wp ! :319 CHARACTER(LEN=7), SAVE :: nesting_datatransfer_mode = 'mixed' !< steering 320 !< parameter for data- 321 !< transfer mode 322 CHARACTER(LEN=8), SAVE :: nesting_mode = 'two-way' !< steering parameter 323 !< for 1- or 2-way nesting 324 325 LOGICAL, SAVE :: nested_run = .FALSE. !< general switch 326 327 REAL(wp), SAVE :: anterp_relax_length_l = -1.0_wp !< 328 REAL(wp), SAVE :: anterp_relax_length_r = -1.0_wp !< 329 REAL(wp), SAVE :: anterp_relax_length_s = -1.0_wp !< 330 REAL(wp), SAVE :: anterp_relax_length_n = -1.0_wp !< 331 REAL(wp), SAVE :: anterp_relax_length_t = -1.0_wp !< 323 332 ! 324 333 !-- Geometry 325 REAL(wp), SAVE :: area_t !: 326 REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE :: coord_x !: 327 REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE :: coord_y !: 328 REAL(wp), SAVE :: lower_left_coord_x !: 329 REAL(wp), SAVE :: lower_left_coord_y !: 334 REAL(wp), SAVE :: area_t !< 335 REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE, PUBLIC :: coord_x !< 336 REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE, PUBLIC :: coord_y !< 337 REAL(wp), SAVE, PUBLIC :: lower_left_coord_x !< 338 REAL(wp), SAVE, PUBLIC :: lower_left_coord_y !< 339 330 340 ! 331 341 !-- Child coarse data arrays 332 INTEGER(iwp), DIMENSION(5) :: coarse_bound !: 333 334 REAL(wp), SAVE :: xexl !: 335 REAL(wp), SAVE :: xexr !: 336 REAL(wp), SAVE :: yexs !: 337 REAL(wp), SAVE :: yexn !: 338 REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE :: tkefactor_l !: 339 REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE :: tkefactor_n !: 340 REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE :: tkefactor_r !: 341 REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE :: tkefactor_s !: 342 REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE :: tkefactor_t !: 343 344 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ec !: 345 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ptc !: 346 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: uc !: 347 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: vc !: 348 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wc !: 349 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: q_c !: 350 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: qcc !: 351 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: qrc !: 352 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: nrc !: 353 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ncc !: 354 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: sc !: 342 INTEGER(iwp), DIMENSION(5),PUBLIC :: coarse_bound !< 343 344 REAL(wp), SAVE :: xexl !< 345 REAL(wp), SAVE :: xexr !< 346 REAL(wp), SAVE :: yexs !< 347 REAL(wp), SAVE :: yexn !< 348 REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE :: tkefactor_l !< 349 REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE :: tkefactor_n !< 350 REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE :: tkefactor_r !< 351 REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE :: tkefactor_s !< 352 REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE :: tkefactor_t !< 353 354 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ec !< 355 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ptc !< 356 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: uc !< 357 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: vc !< 358 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wc !< 359 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: q_c !< 360 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: qcc !< 361 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: qrc !< 362 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: nrc !< 363 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ncc !< 364 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: sc !< 365 INTEGER(idp), SAVE, DIMENSION(:,:), ALLOCATABLE, TARGET, PUBLIC :: nr_partc !< 366 INTEGER(idp), SAVE, DIMENSION(:,:), ALLOCATABLE, TARGET, PUBLIC :: part_adrc !< 367 355 368 356 369 REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: chem_spec_c !< child coarse data array for chemical species … … 359 372 !-- Child interpolation coefficients and child-array indices to be 360 373 !-- precomputed and stored. 361 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: ico ! :362 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: icu ! :363 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: jco ! :364 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: jcv ! :365 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kco ! :366 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kcw ! :367 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r1xo ! :368 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2xo ! :369 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r1xu ! :370 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2xu ! :371 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r1yo ! :372 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2yo ! :373 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r1yv ! :374 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2yv ! :375 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r1zo ! :376 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2zo ! :377 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r1zw ! :378 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2zw ! :374 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: ico !< 375 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: icu !< 376 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: jco !< 377 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: jcv !< 378 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kco !< 379 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kcw !< 380 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r1xo !< 381 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2xo !< 382 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r1xu !< 383 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2xu !< 384 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r1yo !< 385 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2yo !< 386 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r1yv !< 387 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2yv !< 388 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r1zo !< 389 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2zo !< 390 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r1zw !< 391 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2zw !< 379 392 ! 380 393 !-- Child index arrays and log-ratio arrays for the log-law near-wall 381 394 !-- corrections. These are not truly 3-D arrays but multiple 2-D arrays. 382 INTEGER(iwp), SAVE :: ncorr ! :4th dimension of the log_ratio-arrays383 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_u_l ! :384 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_u_n ! :385 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_u_r ! :386 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_u_s ! :387 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_v_l ! :388 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_v_n ! :389 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_v_r ! :390 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_v_s ! :391 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_w_l ! :392 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_w_n ! :393 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_w_r ! :394 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_w_s ! :395 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_u_l ! :396 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_u_n ! :397 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_u_r ! :398 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_u_s ! :399 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_v_l ! :400 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_v_n ! :401 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_v_r ! :402 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_v_s ! :403 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_w_l ! :404 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_w_n ! :405 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_w_r ! :406 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_w_s ! :395 INTEGER(iwp), SAVE :: ncorr !< 4th dimension of the log_ratio-arrays 396 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_u_l !< 397 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_u_n !< 398 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_u_r !< 399 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_u_s !< 400 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_v_l !< 401 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_v_n !< 402 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_v_r !< 403 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_v_s !< 404 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_w_l !< 405 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_w_n !< 406 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_w_r !< 407 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_w_s !< 408 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_u_l !< 409 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_u_n !< 410 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_u_r !< 411 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_u_s !< 412 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_v_l !< 413 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_v_n !< 414 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_v_r !< 415 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_v_s !< 416 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_w_l !< 417 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_w_n !< 418 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_w_r !< 419 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_w_s !< 407 420 ! 408 421 !-- Upper bounds for k in anterpolation. 409 INTEGER(iwp), SAVE :: kctu ! :410 INTEGER(iwp), SAVE :: kctw ! :422 INTEGER(iwp), SAVE :: kctu !< 423 INTEGER(iwp), SAVE :: kctw !< 411 424 ! 412 425 !-- Upper bound for k in log-law correction in interpolation. 413 INTEGER(iwp), SAVE :: nzt_topo_nestbc_l ! :414 INTEGER(iwp), SAVE :: nzt_topo_nestbc_n ! :415 INTEGER(iwp), SAVE :: nzt_topo_nestbc_r ! :416 INTEGER(iwp), SAVE :: nzt_topo_nestbc_s ! :426 INTEGER(iwp), SAVE :: nzt_topo_nestbc_l !< 427 INTEGER(iwp), SAVE :: nzt_topo_nestbc_n !< 428 INTEGER(iwp), SAVE :: nzt_topo_nestbc_r !< 429 INTEGER(iwp), SAVE :: nzt_topo_nestbc_s !< 417 430 ! 418 431 !-- Number of ghost nodes in coarse-grid arrays for i and j in anterpolation. 419 INTEGER(iwp), SAVE :: nhll ! :420 INTEGER(iwp), SAVE :: nhlr ! :421 INTEGER(iwp), SAVE :: nhls ! :422 INTEGER(iwp), SAVE :: nhln ! :432 INTEGER(iwp), SAVE :: nhll !< 433 INTEGER(iwp), SAVE :: nhlr !< 434 INTEGER(iwp), SAVE :: nhls !< 435 INTEGER(iwp), SAVE :: nhln !< 423 436 ! 424 437 !-- Spatial under-relaxation coefficients for anterpolation. 425 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: frax ! :426 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: fray ! :427 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: fraz ! :438 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: frax !< 439 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: fray !< 440 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: fraz !< 428 441 ! 429 442 !-- Child-array indices to be precomputed and stored for anterpolation. 430 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: iflu ! :431 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: ifuu ! :432 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: iflo ! :433 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: ifuo ! :434 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: jflv ! :435 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: jfuv ! :436 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: jflo ! :437 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: jfuo ! :438 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kflw ! :439 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kfuw ! :440 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kflo ! :441 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kfuo ! :443 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: iflu !< 444 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: ifuu !< 445 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: iflo !< 446 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: ifuo !< 447 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: jflv !< 448 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: jfuv !< 449 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: jflo !< 450 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: jfuo !< 451 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kflw !< 452 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kfuw !< 453 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kflo !< 454 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kfuo !< 442 455 ! 443 456 !-- Number of fine-grid nodes inside coarse-grid ij-faces 444 457 !-- to be precomputed for anterpolation. 445 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: ijfc_u ! :446 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: ijfc_v ! :447 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: ijfc_s ! :448 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kfc_w ! :449 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kfc_s ! :458 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: ijfc_u !< 459 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: ijfc_v !< 460 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: ijfc_s !< 461 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kfc_w !< 462 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kfc_s !< 450 463 451 INTEGER(iwp), DIMENSION(3) :: parent_grid_info_int !: 452 REAL(wp), DIMENSION(7) :: parent_grid_info_real !: 464 INTEGER(iwp), DIMENSION(3) :: parent_grid_info_int !< 465 REAL(wp), DIMENSION(7) :: parent_grid_info_real !< 466 REAL(wp), DIMENSION(2) :: zmax_coarse !< 453 467 454 468 TYPE coarsegrid_def 455 INTEGER(iwp) :: nx 456 INTEGER(iwp) :: ny 457 INTEGER(iwp) :: nz 458 REAL(wp) :: dx 459 REAL(wp) :: dy 460 REAL(wp) :: dz 461 REAL(wp) :: lower_left_coord_x 462 REAL(wp) :: lower_left_coord_y 463 REAL(wp) :: xend 464 REAL(wp) :: yend 465 REAL(wp), DIMENSION(:), ALLOCATABLE :: coord_x 466 REAL(wp), DIMENSION(:), ALLOCATABLE :: coord_y 467 REAL(wp), DIMENSION(:), ALLOCATABLE :: dzu 468 REAL(wp), DIMENSION(:), ALLOCATABLE :: dzw 469 REAL(wp), DIMENSION(:), ALLOCATABLE :: zu 470 REAL(wp), DIMENSION(:), ALLOCATABLE :: zw 469 INTEGER(iwp) :: nx !< 470 INTEGER(iwp) :: ny !< 471 INTEGER(iwp) :: nz !< 472 REAL(wp) :: dx !< 473 REAL(wp) :: dy !< 474 REAL(wp) :: dz !< 475 REAL(wp) :: lower_left_coord_x !< 476 REAL(wp) :: lower_left_coord_y !< 477 REAL(wp) :: xend !< 478 REAL(wp) :: yend !< 479 REAL(wp), DIMENSION(:), ALLOCATABLE :: coord_x !< 480 REAL(wp), DIMENSION(:), ALLOCATABLE :: coord_y !< 481 REAL(wp), DIMENSION(:), ALLOCATABLE :: dzu !< 482 REAL(wp), DIMENSION(:), ALLOCATABLE :: dzw !< 483 REAL(wp), DIMENSION(:), ALLOCATABLE :: zu !< 484 REAL(wp), DIMENSION(:), ALLOCATABLE :: zw !< 471 485 END TYPE coarsegrid_def 472 473 TYPE(coarsegrid_def), SAVE :: cg !: 474 486 487 TYPE(coarsegrid_def), SAVE, PUBLIC :: cg !< 488 489 !- Variables for particle coupling 490 491 TYPE, PUBLIC :: childgrid_def 492 INTEGER(iwp) :: nx !< 493 INTEGER(iwp) :: ny !< 494 INTEGER(iwp) :: nz !< 495 REAL(wp) :: dx !< 496 REAL(wp) :: dy !< 497 REAL(wp) :: dz !< 498 REAL(wp) :: lx_coord, lx_coord_b !< 499 REAL(wp) :: rx_coord, rx_coord_b !< 500 REAL(wp) :: sy_coord, sy_coord_b !< 501 REAL(wp) :: ny_coord, ny_coord_b !< 502 REAL(wp) :: uz_coord, uz_coord_b !< 503 END TYPE childgrid_def 504 505 TYPE(childgrid_def), SAVE, ALLOCATABLE, DIMENSION(:), PUBLIC :: childgrid !< 506 507 INTEGER(idp),ALLOCATABLE,DIMENSION(:,:),PUBLIC,TARGET :: nr_part !< 508 INTEGER(idp),ALLOCATABLE,DIMENSION(:,:),PUBLIC,TARGET :: part_adr !< 509 475 510 INTERFACE pmci_boundary_conds 476 511 MODULE PROCEDURE pmci_boundary_conds 477 512 END INTERFACE pmci_boundary_conds 478 513 479 514 INTERFACE pmci_check_setting_mismatches 480 515 MODULE PROCEDURE pmci_check_setting_mismatches … … 509 544 END INTERFACE 510 545 546 INTERFACE get_number_of_childs 547 MODULE PROCEDURE get_number_of_childs 548 END INTERFACE get_number_of_childs 549 550 INTERFACE get_childid 551 MODULE PROCEDURE get_childid 552 END INTERFACE get_childid 553 554 INTERFACE get_child_edges 555 MODULE PROCEDURE get_child_edges 556 END INTERFACE get_child_edges 557 558 INTERFACE get_child_gridspacing 559 MODULE PROCEDURE get_child_gridspacing 560 END INTERFACE get_child_gridspacing 561 562 511 563 INTERFACE pmci_set_swaplevel 512 564 MODULE PROCEDURE pmci_set_swaplevel 513 565 END INTERFACE pmci_set_swaplevel 514 566 515 PUBLIC anterp_relax_length_l, anterp_relax_length_r, 516 anterp_relax_length_s, anterp_relax_length_n, 517 anterp_relax_length_t, child_to_parent, comm_world_nesting, 518 cpl_id, nested_run, nesting_datatransfer_mode, nesting_mode, 567 PUBLIC anterp_relax_length_l, anterp_relax_length_r, & 568 anterp_relax_length_s, anterp_relax_length_n, & 569 anterp_relax_length_t, child_to_parent, comm_world_nesting, & 570 cpl_id, nested_run, nesting_datatransfer_mode, nesting_mode, & 519 571 parent_to_child 520 572 … … 528 580 PUBLIC pmci_synchronize 529 581 PUBLIC pmci_set_swaplevel 582 PUBLIC get_number_of_childs, get_childid, get_child_edges, get_child_gridspacing 583 530 584 531 585 … … 535 589 SUBROUTINE pmci_init( world_comm ) 536 590 537 USE control_parameters, 591 USE control_parameters, & 538 592 ONLY: message_string 539 593 540 594 IMPLICIT NONE 541 595 542 INTEGER , INTENT(OUT) :: world_comm !:596 INTEGER(iwp), INTENT(OUT) :: world_comm !< 543 597 544 598 #if defined( __parallel ) 545 599 546 INTEGER(iwp) :: ierr ! :547 INTEGER(iwp) :: istat ! :548 INTEGER(iwp) :: pmc_status ! :549 550 551 CALL pmc_init_model( world_comm, nesting_datatransfer_mode, nesting_mode, 600 INTEGER(iwp) :: ierr !< 601 INTEGER(iwp) :: istat !< 602 INTEGER(iwp) :: pmc_status !< 603 604 605 CALL pmc_init_model( world_comm, nesting_datatransfer_mode, nesting_mode, & 552 606 pmc_status ) 553 607 … … 564 618 ! 565 619 !-- Check steering parameter values 566 IF ( TRIM( nesting_mode ) /= 'one-way' .AND. 567 TRIM( nesting_mode ) /= 'two-way' .AND. 568 TRIM( nesting_mode ) /= 'vertical' ) 620 IF ( TRIM( nesting_mode ) /= 'one-way' .AND. & 621 TRIM( nesting_mode ) /= 'two-way' .AND. & 622 TRIM( nesting_mode ) /= 'vertical' ) & 569 623 THEN 570 624 message_string = 'illegal nesting mode: ' // TRIM( nesting_mode ) … … 572 626 ENDIF 573 627 574 IF ( TRIM( nesting_datatransfer_mode ) /= 'cascade' .AND. 575 TRIM( nesting_datatransfer_mode ) /= 'mixed' .AND. 576 TRIM( nesting_datatransfer_mode ) /= 'overlap' ) 628 IF ( TRIM( nesting_datatransfer_mode ) /= 'cascade' .AND. & 629 TRIM( nesting_datatransfer_mode ) /= 'mixed' .AND. & 630 TRIM( nesting_datatransfer_mode ) /= 'overlap' ) & 577 631 THEN 578 message_string = 'illegal nesting datatransfer mode: ' 632 message_string = 'illegal nesting datatransfer mode: ' & 579 633 // TRIM( nesting_datatransfer_mode ) 580 634 CALL message( 'pmci_init', 'PA0418', 3, 2, 0, 6, 0 ) … … 586 640 !-- Get some variables required by the pmc-interface (and in some cases in the 587 641 !-- PALM code out of the pmci) out of the pmc-core 588 CALL pmc_get_model_info( comm_world_nesting = comm_world_nesting, 589 cpl_id = cpl_id, cpl_parent_id = cpl_parent_id, 590 cpl_name = cpl_name, npe_total = cpl_npe_total, 591 lower_left_x = lower_left_coord_x, 642 CALL pmc_get_model_info( comm_world_nesting = comm_world_nesting, & 643 cpl_id = cpl_id, cpl_parent_id = cpl_parent_id, & 644 cpl_name = cpl_name, npe_total = cpl_npe_total, & 645 lower_left_x = lower_left_coord_x, & 592 646 lower_left_y = lower_left_coord_y ) 593 647 ! … … 661 715 662 716 CHARACTER(LEN=32) :: myname 663 664 INTEGER(iwp) :: child_id !: 665 INTEGER(iwp) :: ierr !: 666 INTEGER(iwp) :: i !: 667 INTEGER(iwp) :: j !: 668 INTEGER(iwp) :: k !: 669 INTEGER(iwp) :: m !: 670 INTEGER(iwp) :: mm !: 717 718 INTEGER(iwp) :: child_id !< 719 INTEGER(iwp) :: ierr !< 720 INTEGER(iwp) :: i !< 721 INTEGER(iwp) :: j !< 722 INTEGER(iwp) :: k !< 723 INTEGER(iwp) :: m !< 724 INTEGER(iwp) :: mid !< 725 INTEGER(iwp) :: mm !< 671 726 INTEGER(iwp) :: n = 1 !< running index for chemical species 672 INTEGER(iwp) :: nest_overlap !: 673 INTEGER(iwp) :: nomatch !: 674 INTEGER(iwp) :: nx_cl !: 675 INTEGER(iwp) :: ny_cl !: 676 INTEGER(iwp) :: nz_cl !: 677 678 INTEGER(iwp), DIMENSION(5) :: val !: 679 680 681 REAL(wp), DIMENSION(:), ALLOCATABLE :: ch_xl !: 682 REAL(wp), DIMENSION(:), ALLOCATABLE :: ch_xr !: 683 REAL(wp), DIMENSION(:), ALLOCATABLE :: ch_ys !: 684 REAL(wp), DIMENSION(:), ALLOCATABLE :: ch_yn !: 685 REAL(wp) :: cl_height !: 686 REAL(wp) :: dx_cl !: 687 REAL(wp) :: dy_cl !: 688 REAL(wp) :: left_limit !: 689 REAL(wp) :: north_limit !: 690 REAL(wp) :: right_limit !: 691 REAL(wp) :: south_limit !: 692 REAL(wp) :: xez !: 693 REAL(wp) :: yez !: 694 695 REAL(wp), DIMENSION(1) :: fval !: 696 697 REAL(wp), DIMENSION(:), ALLOCATABLE :: cl_coord_x !: 698 REAL(wp), DIMENSION(:), ALLOCATABLE :: cl_coord_y !: 727 INTEGER(iwp) :: nest_overlap !< 728 INTEGER(iwp) :: nomatch !< 729 INTEGER(iwp) :: nx_cl !< 730 INTEGER(iwp) :: ny_cl !< 731 INTEGER(iwp) :: nz_cl !< 732 733 INTEGER(iwp), DIMENSION(5) :: val !< 734 735 736 REAL(wp), DIMENSION(:), ALLOCATABLE :: ch_xl !< 737 REAL(wp), DIMENSION(:), ALLOCATABLE :: ch_xr !< 738 REAL(wp), DIMENSION(:), ALLOCATABLE :: ch_ys !< 739 REAL(wp), DIMENSION(:), ALLOCATABLE :: ch_yn !< 740 REAL(wp) :: cl_height !< 741 REAL(wp) :: dx_cl !< 742 REAL(wp) :: dy_cl !< 743 REAL(wp) :: dz_cl !< 744 REAL(wp) :: left_limit !< 745 REAL(wp) :: north_limit !< 746 REAL(wp) :: right_limit !< 747 REAL(wp) :: south_limit !< 748 REAL(wp) :: xez !< 749 REAL(wp) :: yez !< 750 751 REAL(wp), DIMENSION(5) :: fval !< 752 753 REAL(wp), DIMENSION(:), ALLOCATABLE :: cl_coord_x !< 754 REAL(wp), DIMENSION(:), ALLOCATABLE :: cl_coord_y !< 699 755 700 756 ! … … 709 765 ALLOCATE( ch_yn(1:SIZE( pmc_parent_for_child ) - 1) ) 710 766 ENDIF 767 IF ( ( SIZE( pmc_parent_for_child ) - 1 > 0 ) ) THEN 768 ALLOCATE( childgrid(1:SIZE( pmc_parent_for_child ) - 1) ) 769 ENDIF 770 711 771 ! 712 772 !-- Get coordinates from all children … … 719 779 CALL pmc_recv_from_child( child_id, fval, size(fval), 0, 124, ierr ) 720 780 721 nx_cl = val(1) 722 ny_cl = val(2) 723 dx_cl = val(4) 724 dy_cl = val(5) 781 nx_cl = val(1) 782 ny_cl = val(2) 783 dx_cl = fval(3) 784 dy_cl = fval(4) 785 dz_cl = fval(5) 725 786 cl_height = fval(1) 787 726 788 nz_cl = nz 727 789 ! … … 734 796 ENDIF 735 797 ENDDO 798 799 zmax_coarse = fval(1:2) 800 cl_height = fval(1) 801 736 802 ! 737 803 !-- Get absolute coordinates from the child … … 739 805 ALLOCATE( cl_coord_y(-nbgp:ny_cl+nbgp) ) 740 806 741 CALL pmc_recv_from_child( child_id, cl_coord_x, SIZE( cl_coord_x ), 807 CALL pmc_recv_from_child( child_id, cl_coord_x, SIZE( cl_coord_x ), & 742 808 0, 11, ierr ) 743 CALL pmc_recv_from_child( child_id, cl_coord_y, SIZE( cl_coord_y ), 809 CALL pmc_recv_from_child( child_id, cl_coord_y, SIZE( cl_coord_y ), & 744 810 0, 12, ierr ) 745 811 … … 761 827 right_limit = parent_grid_info_real(5) 762 828 north_limit = parent_grid_info_real(6) 763 IF ( ( cl_coord_x(nx_cl+1) /= right_limit ) .OR. 829 IF ( ( cl_coord_x(nx_cl+1) /= right_limit ) .OR. & 764 830 ( cl_coord_y(ny_cl+1) /= north_limit ) ) THEN 765 831 nomatch = 1 … … 774 840 south_limit = lower_left_coord_y + yez 775 841 north_limit = parent_grid_info_real(6) - yez 776 IF ( ( cl_coord_x(0) < left_limit ) .OR. 777 ( cl_coord_x(nx_cl+1) > right_limit ) .OR. 778 ( cl_coord_y(0) < south_limit ) .OR. 842 IF ( ( cl_coord_x(0) < left_limit ) .OR. & 843 ( cl_coord_x(nx_cl+1) > right_limit ) .OR. & 844 ( cl_coord_y(0) < south_limit ) .OR. & 779 845 ( cl_coord_y(ny_cl+1) > north_limit ) ) THEN 780 846 nomatch = 1 … … 785 851 !-- that the top ghost layer of the child grid does not exceed 786 852 !-- the parent domain top boundary. 853 787 854 IF ( cl_height > zw(nz) ) THEN 788 855 nomatch = 1 … … 798 865 799 866 IF ( m > 1 ) THEN 800 DO mm = 1, m-1 801 IF ( ( ch_xl(m) < ch_xr(mm) .OR. & 802 ch_xr(m) > ch_xl(mm) ) .AND. & 803 ( ch_ys(m) < ch_yn(mm) .OR. & 804 ch_yn(m) > ch_ys(mm) ) ) THEN 805 nest_overlap = 1 867 DO mm = 1, m - 1 868 mid = pmc_parent_for_child(mm) 869 ! 870 !-- Check Only different nest level 871 IF (m_couplers(child_id)%parent_id /= m_couplers(mid)%parent_id) THEN 872 IF ( ( ch_xl(m) < ch_xr(mm) .OR. & 873 ch_xr(m) > ch_xl(mm) ) .AND. & 874 ( ch_ys(m) < ch_yn(mm) .OR. & 875 ch_yn(m) > ch_ys(mm) ) ) THEN 876 nest_overlap = 1 877 ENDIF 806 878 ENDIF 807 879 ENDDO … … 809 881 ENDIF 810 882 883 CALL set_child_edge_coords 884 811 885 DEALLOCATE( cl_coord_x ) 812 886 DEALLOCATE( cl_coord_y ) 813 887 ! 814 888 !-- Send coarse grid information to child 815 CALL pmc_send_to_child( child_id, parent_grid_info_real, 816 SIZE( parent_grid_info_real ), 0, 21, 889 CALL pmc_send_to_child( child_id, parent_grid_info_real, & 890 SIZE( parent_grid_info_real ), 0, 21, & 817 891 ierr ) 818 CALL pmc_send_to_child( child_id, parent_grid_info_int, 3, 0, 892 CALL pmc_send_to_child( child_id, parent_grid_info_int, 3, 0, & 819 893 22, ierr ) 820 894 ! 821 895 !-- Send local grid to child 822 CALL pmc_send_to_child( child_id, coord_x, nx+1+2*nbgp, 0, 24, 896 CALL pmc_send_to_child( child_id, coord_x, nx+1+2*nbgp, 0, 24, & 823 897 ierr ) 824 CALL pmc_send_to_child( child_id, coord_y, ny+1+2*nbgp, 0, 25, 898 CALL pmc_send_to_child( child_id, coord_y, ny+1+2*nbgp, 0, 25, & 825 899 ierr ) 826 900 ! … … 835 909 CALL MPI_BCAST( nomatch, 1, MPI_INTEGER, 0, comm2d, ierr ) 836 910 IF ( nomatch /= 0 ) THEN 837 WRITE ( message_string, * ) 'nested child domain does ', 911 WRITE ( message_string, * ) 'nested child domain does ', & 838 912 'not fit into its parent domain' 839 913 CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 ) … … 847 921 848 922 CALL MPI_BCAST( nz_cl, 1, MPI_INTEGER, 0, comm2d, ierr ) 923 CALL MPI_BCAST( childgrid(m), c_sizeof(childgrid(1)), MPI_BYTE, 0, comm2d, ierr ) 924 849 925 ! 850 926 !-- TO_DO: Klaus: please give a comment what is done here … … 852 928 ! 853 929 !-- Include couple arrays into parent content 854 !-- TO_DO: Klaus: please give a more meaningful comment 930 !-- The adresses of the PALM 2D or 3D array (here server coarse grid) which are candidates 931 !-- for coupling are stored once into the pmc context. While data transfer, the array do not 932 !-- have to be specified again 933 855 934 CALL pmc_s_clear_next_array_list 856 935 DO WHILE ( pmc_s_getnextarray( child_id, myname ) ) … … 881 960 IMPLICIT NONE 882 961 883 INTEGER(iwp) :: i ! :884 INTEGER(iwp) :: ic ! :885 INTEGER(iwp) :: ierr ! :886 INTEGER(iwp) :: j ! :887 INTEGER(iwp) :: k ! :888 INTEGER(iwp) :: m ! :889 INTEGER(iwp) :: n ! :890 INTEGER(iwp) :: npx ! :891 INTEGER(iwp) :: npy ! :892 INTEGER(iwp) :: nrx ! :893 INTEGER(iwp) :: nry ! :894 INTEGER(iwp) :: px ! :895 INTEGER(iwp) :: py ! :896 INTEGER(iwp) :: parent_pe ! :897 898 INTEGER(iwp), DIMENSION(2) :: scoord ! :899 INTEGER(iwp), DIMENSION(2) :: size_of_array ! :900 901 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: coarse_bound_all ! :902 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: index_list ! :962 INTEGER(iwp) :: i !< 963 INTEGER(iwp) :: ic !< 964 INTEGER(iwp) :: ierr !< 965 INTEGER(iwp) :: j !< 966 INTEGER(iwp) :: k !< 967 INTEGER(iwp) :: m !< 968 INTEGER(iwp) :: n !< 969 INTEGER(iwp) :: npx !< 970 INTEGER(iwp) :: npy !< 971 INTEGER(iwp) :: nrx !< 972 INTEGER(iwp) :: nry !< 973 INTEGER(iwp) :: px !< 974 INTEGER(iwp) :: py !< 975 INTEGER(iwp) :: parent_pe !< 976 977 INTEGER(iwp), DIMENSION(2) :: scoord !< 978 INTEGER(iwp), DIMENSION(2) :: size_of_array !< 979 980 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: coarse_bound_all !< 981 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: index_list !< 903 982 904 983 IF ( myid == 0 ) THEN … … 907 986 CALL pmc_recv_from_child( child_id, size_of_array, 2, 0, 40, ierr ) 908 987 ALLOCATE( coarse_bound_all(size_of_array(1),size_of_array(2)) ) 909 CALL pmc_recv_from_child( child_id, coarse_bound_all, 988 CALL pmc_recv_from_child( child_id, coarse_bound_all, & 910 989 SIZE( coarse_bound_all ), 0, 41, ierr ) 911 990 ! … … 983 1062 END SUBROUTINE pmci_create_index_list 984 1063 1064 SUBROUTINE set_child_edge_coords 1065 IMPLICIT NONE 1066 1067 INTEGER(iwp) :: nbgp_lpm = 1 1068 1069 nbgp_lpm = min(nbgp_lpm, nbgp) 1070 1071 childgrid(m)%nx = nx_cl 1072 childgrid(m)%ny = ny_cl 1073 childgrid(m)%nz = nz_cl 1074 childgrid(m)%dx = dx_cl 1075 childgrid(m)%dy = dy_cl 1076 childgrid(m)%dz = dz_cl 1077 1078 childgrid(m)%lx_coord = cl_coord_x(0) 1079 childgrid(m)%lx_coord_b = cl_coord_x(-nbgp_lpm) 1080 childgrid(m)%rx_coord = cl_coord_x(nx_cl)+dx_cl 1081 childgrid(m)%rx_coord_b = cl_coord_x(nx_cl+nbgp_lpm)+dx_cl 1082 childgrid(m)%sy_coord = cl_coord_y(0) 1083 childgrid(m)%sy_coord_b = cl_coord_y(-nbgp_lpm) 1084 childgrid(m)%ny_coord = cl_coord_y(ny_cl)+dy_cl 1085 childgrid(m)%ny_coord_b = cl_coord_y(ny_cl+nbgp_lpm)+dy_cl 1086 childgrid(m)%uz_coord = zmax_coarse(2) 1087 childgrid(m)%uz_coord_b = zmax_coarse(1) 1088 1089 WRITE(9,*) 'edge coordinates for child id ',child_id,m 1090 WRITE(9,*) 'Number of Boundray cells lpm ',nbgp_lpm 1091 WRITE(9,'(a,3i7,2f10.2)') ' model size ', nx_cl, ny_cl, nz_cl, dx_cl, dy_cl 1092 WRITE(9,'(a,5f10.2)') ' model edge ', childgrid(m)%lx_coord, childgrid(m)%rx_coord, childgrid(m)%sy_coord, childgrid(m)%ny_coord,childgrid(m)%uz_coord 1093 WRITE(9,'(a,4f10.2)') ' model edge with Boundary ', childgrid(m)%lx_coord_b, childgrid(m)%rx_coord_b, childgrid(m)%sy_coord_b, childgrid(m)%ny_coord_b 1094 1095 END SUBROUTINE set_child_edge_coords 1096 985 1097 #endif 986 1098 END SUBROUTINE pmci_setup_parent … … 1005 1117 INTEGER(iwp) :: n !< running index for number of chemical species 1006 1118 1007 INTEGER(iwp), DIMENSION(5) :: val ! :1119 INTEGER(iwp), DIMENSION(5) :: val !< 1008 1120 1009 REAL(wp) :: xcs ! :1010 REAL(wp) :: xce ! :1011 REAL(wp) :: ycs ! :1012 REAL(wp) :: yce ! :1013 1014 REAL(wp), DIMENSION( 1) :: fval !:1121 REAL(wp) :: xcs !< 1122 REAL(wp) :: xce !< 1123 REAL(wp) :: ycs !< 1124 REAL(wp) :: yce !< 1125 1126 REAL(wp), DIMENSION(5) :: fval !< 1015 1127 1016 1128 ! 1017 !-- TO_DO: describe what is happening in this if-clause 1018 !-- Root model does not have a parent and is not a child 1129 !-- Child setup 1130 !-- Root model does not have a parent and is not a child, therefore no child setup on root model 1131 1019 1132 IF ( .NOT. pmc_is_rootmodel() ) THEN 1020 1133 … … 1057 1170 ENDIF 1058 1171 1172 IF( particle_advection ) THEN 1173 CALL pmc_set_dataarray_name( 'coarse', 'nr_part' ,'fine', 'nr_part', ierr ) 1174 CALL pmc_set_dataarray_name( 'coarse', 'part_adr' ,'fine', 'part_adr', ierr ) 1175 ENDIF 1176 1059 1177 IF ( air_chemistry ) THEN 1060 1178 DO n = 1, nspec … … 1078 1196 val(5) = dy 1079 1197 fval(1) = zw(nzt+1) 1198 fval(2) = zw(nzt) 1199 fval(3) = dx 1200 fval(4) = dy 1201 fval(5) = dz 1080 1202 1081 1203 IF ( myid == 0 ) THEN … … 1087 1209 ! 1088 1210 !-- Receive Coarse grid information. 1089 CALL pmc_recv_from_parent( parent_grid_info_real, 1211 CALL pmc_recv_from_parent( parent_grid_info_real, & 1090 1212 SIZE(parent_grid_info_real), 0, 21, ierr ) 1091 1213 CALL pmc_recv_from_parent( parent_grid_info_int, 3, 0, 22, ierr ) 1092 1214 ! 1093 1215 !-- Debug-printouts - keep them 1094 ! WRITE(0,*) 'Coarse grid from parent '1095 ! WRITE(0,*) 'startx_tot = ',parent_grid_info_real(1)1096 ! WRITE(0,*) 'starty_tot = ',parent_grid_info_real(2)1097 ! WRITE(0,*) 'endx_tot = ',parent_grid_info_real(5)1098 ! WRITE(0,*) 'endy_tot = ',parent_grid_info_real(6)1099 ! WRITE(0,*) 'dx = ',parent_grid_info_real(3)1100 ! WRITE(0,*) 'dy = ',parent_grid_info_real(4)1101 ! WRITE(0,*) 'dz = ',parent_grid_info_real(7)1102 ! WRITE(0,*) 'nx_coarse = ',parent_grid_info_int(1)1103 ! WRITE(0,*) 'ny_coarse = ',parent_grid_info_int(2)1104 ! WRITE(0,*) 'nz_coarse = ',parent_grid_info_int(3)1105 ENDIF 1106 1107 CALL MPI_BCAST( parent_grid_info_real, SIZE(parent_grid_info_real), 1216 ! WRITE(0,*) 'Coarse grid from parent ' 1217 ! WRITE(0,*) 'startx_tot = ',parent_grid_info_real(1) 1218 ! WRITE(0,*) 'starty_tot = ',parent_grid_info_real(2) 1219 ! WRITE(0,*) 'endx_tot = ',parent_grid_info_real(5) 1220 ! WRITE(0,*) 'endy_tot = ',parent_grid_info_real(6) 1221 ! WRITE(0,*) 'dx = ',parent_grid_info_real(3) 1222 ! WRITE(0,*) 'dy = ',parent_grid_info_real(4) 1223 ! WRITE(0,*) 'dz = ',parent_grid_info_real(7) 1224 ! WRITE(0,*) 'nx_coarse = ',parent_grid_info_int(1) 1225 ! WRITE(0,*) 'ny_coarse = ',parent_grid_info_int(2) 1226 ! WRITE(0,*) 'nz_coarse = ',parent_grid_info_int(3) 1227 ENDIF 1228 1229 CALL MPI_BCAST( parent_grid_info_real, SIZE(parent_grid_info_real), & 1108 1230 MPI_REAL, 0, comm2d, ierr ) 1109 1231 CALL MPI_BCAST( parent_grid_info_int, 3, MPI_INTEGER, 0, comm2d, ierr ) … … 1158 1280 n = 1 1159 1281 DO WHILE ( pmc_c_getnextarray( myname ) ) 1160 !-- Note that cg%nz is not th eoriginal nz of parent, but the highest1282 !-- Note that cg%nz is not the original nz of parent, but the highest 1161 1283 !-- parent-grid level needed for nesting. 1162 1284 !-- Please note, in case of chemical species an additional parameter … … 1186 1308 !-- Precompute the index arrays and relaxation functions for the 1187 1309 !-- anterpolation 1188 IF ( TRIM( nesting_mode ) == 'two-way' .OR. 1310 IF ( TRIM( nesting_mode ) == 'two-way' .OR. & 1189 1311 nesting_mode == 'vertical' ) THEN 1190 1312 CALL pmci_init_anterp_tophat … … 1206 1328 IMPLICIT NONE 1207 1329 1208 INTEGER(iwp), DIMENSION(5,numprocs) :: coarse_bound_all ! :1209 INTEGER(iwp), DIMENSION(2) :: size_of_array ! :1330 INTEGER(iwp), DIMENSION(5,numprocs) :: coarse_bound_all !< 1331 INTEGER(iwp), DIMENSION(2) :: size_of_array !< 1210 1332 1211 REAL(wp) :: loffset ! :1212 REAL(wp) :: noffset ! :1213 REAL(wp) :: roffset ! :1214 REAL(wp) :: soffset ! :1333 REAL(wp) :: loffset !< 1334 REAL(wp) :: noffset !< 1335 REAL(wp) :: roffset !< 1336 REAL(wp) :: soffset !< 1215 1337 1216 1338 ! … … 1283 1405 !-- Note that MPI_Gather receives data from all processes in the rank order 1284 1406 !-- TO_DO: refer to the line where this fact becomes important 1285 CALL MPI_GATHER( coarse_bound, 5, MPI_INTEGER, coarse_bound_all, 5, 1407 CALL MPI_GATHER( coarse_bound, 5, MPI_INTEGER, coarse_bound_all, 5, & 1286 1408 MPI_INTEGER, 0, comm2d, ierr ) 1287 1409 … … 1290 1412 size_of_array(2) = SIZE( coarse_bound_all, 2 ) 1291 1413 CALL pmc_send_to_parent( size_of_array, 2, 0, 40, ierr ) 1292 CALL pmc_send_to_parent( coarse_bound_all, SIZE( coarse_bound_all ), 1414 CALL pmc_send_to_parent( coarse_bound_all, SIZE( coarse_bound_all ), & 1293 1415 0, 41, ierr ) 1294 1416 ENDIF … … 1306 1428 IMPLICIT NONE 1307 1429 1308 INTEGER(iwp) :: i ! :1309 INTEGER(iwp) :: i1 ! :1310 INTEGER(iwp) :: j ! :1311 INTEGER(iwp) :: j1 ! :1312 INTEGER(iwp) :: k ! :1313 INTEGER(iwp) :: kc ! :1314 INTEGER(iwp) :: kdzo ! :1315 INTEGER(iwp) :: kdzw ! :1316 1317 REAL(wp) :: xb ! :1318 REAL(wp) :: xcsu ! :1319 REAL(wp) :: xfso ! :1320 REAL(wp) :: xcso ! :1321 REAL(wp) :: xfsu ! :1322 REAL(wp) :: yb ! :1323 REAL(wp) :: ycso ! :1324 REAL(wp) :: ycsv ! :1325 REAL(wp) :: yfso ! :1326 REAL(wp) :: yfsv ! :1327 REAL(wp) :: zcso ! :1328 REAL(wp) :: zcsw ! :1329 REAL(wp) :: zfso ! :1330 REAL(wp) :: zfsw ! :1430 INTEGER(iwp) :: i !< 1431 INTEGER(iwp) :: i1 !< 1432 INTEGER(iwp) :: j !< 1433 INTEGER(iwp) :: j1 !< 1434 INTEGER(iwp) :: k !< 1435 INTEGER(iwp) :: kc !< 1436 INTEGER(iwp) :: kdzo !< 1437 INTEGER(iwp) :: kdzw !< 1438 1439 REAL(wp) :: xb !< 1440 REAL(wp) :: xcsu !< 1441 REAL(wp) :: xfso !< 1442 REAL(wp) :: xcso !< 1443 REAL(wp) :: xfsu !< 1444 REAL(wp) :: yb !< 1445 REAL(wp) :: ycso !< 1446 REAL(wp) :: ycsv !< 1447 REAL(wp) :: yfso !< 1448 REAL(wp) :: yfsv !< 1449 REAL(wp) :: zcso !< 1450 REAL(wp) :: zcsw !< 1451 REAL(wp) :: zfso !< 1452 REAL(wp) :: zfsw !< 1331 1453 1332 1454 … … 1391 1513 kcw(k) = kc - 1 1392 1514 1393 !if ( myid == 0 .and. nx==191 ) then1394 ! write(162,*)nx, nzt+1, k, zw(k), cg%nz+1, kcw(k), cg%zw(kcw(k))1395 !endif1396 !if ( myid == 0 .and. nx==383 ) then1397 ! write(163,*)nx, nzt+1, k, zw(k), cg%nz+1, kcw(k), cg%zw(kcw(k))1398 !endif1399 1400 1515 DO kc = 0, cg%nz+1 1401 1516 IF ( cg%zu(kc) > zfso ) EXIT … … 1945 2060 inc = 1 1946 2061 wall_index = j 1947 CALL pmci_define_loglaw_correction_parameters( lc, lcr, 2062 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 1948 2063 k, j, inc, wall_index, z0_topo, kb, direction, ncorr ) 1949 2064 ! … … 2188 2303 IMPLICIT NONE 2189 2304 2190 INTEGER(iwp), INTENT(IN) :: direction !:2191 INTEGER(iwp), INTENT(IN) :: ij !:2192 INTEGER(iwp), INTENT(IN) :: inc !:2193 INTEGER(iwp), INTENT(IN) :: k !:2194 INTEGER(iwp), INTENT(IN) :: kb !:2195 INTEGER(iwp), INTENT(OUT) :: lc !:2196 INTEGER(iwp), INTENT(IN) :: ncorr !:2197 INTEGER(iwp), INTENT(IN) :: wall_index !:2198 2199 INTEGER(iwp) :: alcorr ! :2200 INTEGER(iwp) :: corr_index ! :2201 INTEGER(iwp) :: lcorr ! :2202 2203 LOGICAL :: more ! :2204 2205 REAL(wp), DIMENSION(0:ncorr-1), INTENT(OUT) :: lcr ! :2206 REAL(wp), INTENT(IN) :: z0_l ! :2305 INTEGER(iwp), INTENT(IN) :: direction !< 2306 INTEGER(iwp), INTENT(IN) :: ij !< 2307 INTEGER(iwp), INTENT(IN) :: inc !< 2308 INTEGER(iwp), INTENT(IN) :: k !< 2309 INTEGER(iwp), INTENT(IN) :: kb !< 2310 INTEGER(iwp), INTENT(OUT) :: lc !< 2311 INTEGER(iwp), INTENT(IN) :: ncorr !< 2312 INTEGER(iwp), INTENT(IN) :: wall_index !< 2313 2314 INTEGER(iwp) :: alcorr !< 2315 INTEGER(iwp) :: corr_index !< 2316 INTEGER(iwp) :: lcorr !< 2317 2318 LOGICAL :: more !< 2319 2320 REAL(wp), DIMENSION(0:ncorr-1), INTENT(OUT) :: lcr !< 2321 REAL(wp), INTENT(IN) :: z0_l !< 2207 2322 2208 REAL(wp) :: logvelc1 ! :2323 REAL(wp) :: logvelc1 !< 2209 2324 2210 2325 … … 2296 2411 IMPLICIT NONE 2297 2412 2298 INTEGER(iwp), INTENT(IN) :: kb ! :2299 INTEGER(iwp), INTENT(OUT) :: lc ! :2300 2301 INTEGER(iwp) :: kbc ! :2302 INTEGER(iwp) :: k1 ! :2303 2304 REAL(wp), INTENT(OUT) :: logzc1 ! :2305 REAL(wp), INTENT(IN) :: z0_l ! :2306 2307 REAL(wp) :: zuc1 ! :2413 INTEGER(iwp), INTENT(IN) :: kb !< 2414 INTEGER(iwp), INTENT(OUT) :: lc !< 2415 2416 INTEGER(iwp) :: kbc !< 2417 INTEGER(iwp) :: k1 !< 2418 2419 REAL(wp), INTENT(OUT) :: logzc1 !< 2420 REAL(wp), INTENT(IN) :: z0_l !< 2421 2422 REAL(wp) :: zuc1 !< 2308 2423 2309 2424 … … 2335 2450 IMPLICIT NONE 2336 2451 2337 INTEGER(iwp), INTENT(IN) :: inc ! :increment must be 1 or -1.2338 INTEGER(iwp), INTENT(IN) :: j ! :2339 INTEGER(iwp), INTENT(IN) :: jw ! :2340 INTEGER(iwp), INTENT(OUT) :: lc ! :2341 2342 INTEGER(iwp) :: j1 ! :2343 2344 REAL(wp), INTENT(IN) :: z0_l ! :2345 2346 REAL(wp) :: logyc1 ! :2347 REAL(wp) :: yc1 ! :2452 INTEGER(iwp), INTENT(IN) :: inc !< increment must be 1 or -1. 2453 INTEGER(iwp), INTENT(IN) :: j !< 2454 INTEGER(iwp), INTENT(IN) :: jw !< 2455 INTEGER(iwp), INTENT(OUT) :: lc !< 2456 2457 INTEGER(iwp) :: j1 !< 2458 2459 REAL(wp), INTENT(IN) :: z0_l !< 2460 2461 REAL(wp) :: logyc1 !< 2462 REAL(wp) :: yc1 !< 2348 2463 2349 2464 ! … … 2376 2491 IMPLICIT NONE 2377 2492 2378 INTEGER(iwp), INTENT(IN) :: i ! :2379 INTEGER(iwp), INTENT(IN) :: inc ! :increment must be 1 or -1.2380 INTEGER(iwp), INTENT(IN) :: iw ! :2381 INTEGER(iwp), INTENT(OUT) :: lc ! :2382 2383 INTEGER(iwp) :: i1 ! :2384 2385 REAL(wp), INTENT(IN) :: z0_l ! :2386 2387 REAL(wp) :: logxc1 ! :2388 REAL(wp) :: xc1 ! :2493 INTEGER(iwp), INTENT(IN) :: i !< 2494 INTEGER(iwp), INTENT(IN) :: inc !< increment must be 1 or -1. 2495 INTEGER(iwp), INTENT(IN) :: iw !< 2496 INTEGER(iwp), INTENT(OUT) :: lc !< 2497 2498 INTEGER(iwp) :: i1 !< 2499 2500 REAL(wp), INTENT(IN) :: z0_l !< 2501 2502 REAL(wp) :: logxc1 !< 2503 REAL(wp) :: xc1 !< 2389 2504 2390 2505 ! … … 2417 2532 IMPLICIT NONE 2418 2533 2419 INTEGER(iwp) :: i ! :Fine-grid index2420 INTEGER(iwp) :: ifc_o ! :2421 INTEGER(iwp) :: ifc_u ! :2422 INTEGER(iwp) :: ii ! :Coarse-grid index2423 INTEGER(iwp) :: istart ! :2424 INTEGER(iwp) :: ir ! :2425 INTEGER(iwp) :: j ! :Fine-grid index2426 INTEGER(iwp) :: jj ! :Coarse-grid index2427 INTEGER(iwp) :: jstart ! :2428 INTEGER(iwp) :: jr ! :2429 INTEGER(iwp) :: k ! :Fine-grid index2430 INTEGER(iwp) :: kk ! :Coarse-grid index2431 INTEGER(iwp) :: kstart ! :2432 REAL(wp) :: xi ! :2433 REAL(wp) :: eta ! :2434 REAL(wp) :: zeta ! :2534 INTEGER(iwp) :: i !< Fine-grid index 2535 INTEGER(iwp) :: ifc_o !< 2536 INTEGER(iwp) :: ifc_u !< 2537 INTEGER(iwp) :: ii !< Coarse-grid index 2538 INTEGER(iwp) :: istart !< 2539 INTEGER(iwp) :: ir !< 2540 INTEGER(iwp) :: j !< Fine-grid index 2541 INTEGER(iwp) :: jj !< Coarse-grid index 2542 INTEGER(iwp) :: jstart !< 2543 INTEGER(iwp) :: jr !< 2544 INTEGER(iwp) :: k !< Fine-grid index 2545 INTEGER(iwp) :: kk !< Coarse-grid index 2546 INTEGER(iwp) :: kstart !< 2547 REAL(wp) :: xi !< 2548 REAL(wp) :: eta !< 2549 REAL(wp) :: zeta !< 2435 2550 2436 2551 ! … … 2490 2605 DO ii = icl, icr-1 2491 2606 i = istart 2492 DO WHILE ( ( coord_x(i) < cg%coord_x(ii) - 0.5_wp * cg%dx ) .AND. 2607 DO WHILE ( ( coord_x(i) < cg%coord_x(ii) - 0.5_wp * cg%dx ) .AND. & 2493 2608 ( i < nxrg ) ) 2494 2609 i = i + 1 … … 2496 2611 iflu(ii) = MIN( MAX( i, nxlg ), nxrg ) 2497 2612 ir = i 2498 DO WHILE ( ( coord_x(ir) <= cg%coord_x(ii) + 0.5_wp * cg%dx ) .AND. 2613 DO WHILE ( ( coord_x(ir) <= cg%coord_x(ii) + 0.5_wp * cg%dx ) .AND.& 2499 2614 ( i < nxrg+1 ) ) 2500 2615 i = i + 1 … … 2512 2627 DO ii = icl, icr-1 2513 2628 i = istart 2514 DO WHILE ( ( coord_x(i) + 0.5_wp * dx < cg%coord_x(ii) ) .AND. 2629 DO WHILE ( ( coord_x(i) + 0.5_wp * dx < cg%coord_x(ii) ) .AND. & 2515 2630 ( i < nxrg ) ) 2516 2631 i = i + 1 … … 2518 2633 iflo(ii) = MIN( MAX( i, nxlg ), nxrg ) 2519 2634 ir = i 2520 DO WHILE ( ( coord_x(ir) + 0.5_wp * dx <= cg%coord_x(ii) + cg%dx ) 2635 DO WHILE ( ( coord_x(ir) + 0.5_wp * dx <= cg%coord_x(ii) + cg%dx ) & 2521 2636 .AND. ( i < nxrg+1 ) ) 2522 2637 i = i + 1 … … 2534 2649 DO jj = jcs, jcn-1 2535 2650 j = jstart 2536 DO WHILE ( ( coord_y(j) < cg%coord_y(jj) - 0.5_wp * cg%dy ) .AND. 2651 DO WHILE ( ( coord_y(j) < cg%coord_y(jj) - 0.5_wp * cg%dy ) .AND. & 2537 2652 ( j < nyng ) ) 2538 2653 j = j + 1 … … 2540 2655 jflv(jj) = MIN( MAX( j, nysg ), nyng ) 2541 2656 jr = j 2542 DO WHILE ( ( coord_y(jr) <= cg%coord_y(jj) + 0.5_wp * cg%dy ) .AND. 2657 DO WHILE ( ( coord_y(jr) <= cg%coord_y(jj) + 0.5_wp * cg%dy ) .AND.& 2543 2658 ( j < nyng+1 ) ) 2544 2659 j = j + 1 … … 2556 2671 DO jj = jcs, jcn-1 2557 2672 j = jstart 2558 DO WHILE ( ( coord_y(j) + 0.5_wp * dy < cg%coord_y(jj) ) .AND. 2673 DO WHILE ( ( coord_y(j) + 0.5_wp * dy < cg%coord_y(jj) ) .AND. & 2559 2674 ( j < nyng ) ) 2560 2675 j = j + 1 … … 2562 2677 jflo(jj) = MIN( MAX( j, nysg ), nyng ) 2563 2678 jr = j 2564 DO WHILE ( ( coord_y(jr) + 0.5_wp * dy <= cg%coord_y(jj) + cg%dy ) 2679 DO WHILE ( ( coord_y(jr) + 0.5_wp * dy <= cg%coord_y(jj) + cg%dy ) & 2565 2680 .AND. ( j < nyng+1 ) ) 2566 2681 j = j + 1 … … 2636 2751 DO ii = icl, icr 2637 2752 IF ( ifuu(ii) < ( nx + 1 ) / 2 ) THEN 2638 xi = ( MAX( 0.0_wp, ( cg%coord_x(ii) - 2753 xi = ( MAX( 0.0_wp, ( cg%coord_x(ii) - & 2639 2754 lower_left_coord_x ) ) / anterp_relax_length_l )**4 2640 2755 frax(ii) = xi / ( 1.0_wp + xi ) 2641 2756 ELSE 2642 xi = ( MAX( 0.0_wp, ( lower_left_coord_x + ( nx + 1 ) * dx - 2643 cg%coord_x(ii) ) ) / 2757 xi = ( MAX( 0.0_wp, ( lower_left_coord_x + ( nx + 1 ) * dx - & 2758 cg%coord_x(ii) ) ) / & 2644 2759 anterp_relax_length_r )**4 2645 2760 frax(ii) = xi / ( 1.0_wp + xi ) … … 2650 2765 DO jj = jcs, jcn 2651 2766 IF ( jfuv(jj) < ( ny + 1 ) / 2 ) THEN 2652 eta = ( MAX( 0.0_wp, ( cg%coord_y(jj) - 2767 eta = ( MAX( 0.0_wp, ( cg%coord_y(jj) - & 2653 2768 lower_left_coord_y ) ) / anterp_relax_length_s )**4 2654 2769 fray(jj) = eta / ( 1.0_wp + eta ) 2655 2770 ELSE 2656 eta = ( MAX( 0.0_wp, ( lower_left_coord_y + ( ny + 1 ) * dy - 2657 cg%coord_y(jj)) ) / 2771 eta = ( MAX( 0.0_wp, ( lower_left_coord_y + ( ny + 1 ) * dy - & 2772 cg%coord_y(jj)) ) / & 2658 2773 anterp_relax_length_n )**4 2659 2774 fray(jj) = eta / ( 1.0_wp + eta ) … … 2683 2798 IMPLICIT NONE 2684 2799 2685 INTEGER(iwp) :: k ! :index variable along z2686 INTEGER(iwp) :: k_wall ! :topography-top index along z2687 INTEGER(iwp) :: kc ! :2688 2689 REAL(wp), PARAMETER :: cfw = 0.2_wp ! :2690 REAL(wp), PARAMETER :: c_tkef = 0.6_wp ! :2691 REAL(wp) :: fw ! :2692 REAL(wp), PARAMETER :: fw0 = 0.9_wp ! :2693 REAL(wp) :: glsf ! :2694 REAL(wp) :: glsc ! :2695 REAL(wp) :: height ! :2696 REAL(wp), PARAMETER :: p13 = 1.0_wp/3.0_wp ! :2697 REAL(wp), PARAMETER :: p23 = 2.0_wp/3.0_wp ! :2800 INTEGER(iwp) :: k !< index variable along z 2801 INTEGER(iwp) :: k_wall !< topography-top index along z 2802 INTEGER(iwp) :: kc !< 2803 2804 REAL(wp), PARAMETER :: cfw = 0.2_wp !< 2805 REAL(wp), PARAMETER :: c_tkef = 0.6_wp !< 2806 REAL(wp) :: fw !< 2807 REAL(wp), PARAMETER :: fw0 = 0.9_wp !< 2808 REAL(wp) :: glsf !< 2809 REAL(wp) :: glsc !< 2810 REAL(wp) :: height !< 2811 REAL(wp), PARAMETER :: p13 = 1.0_wp/3.0_wp !< 2812 REAL(wp), PARAMETER :: p23 = 2.0_wp/3.0_wp !< 2698 2813 2699 2814 IF ( nest_bound_l ) THEN … … 2711 2826 height = zu(k) - zu(k_wall) 2712 2827 fw = EXP( -cfw * height / glsf ) 2713 tkefactor_l(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * 2828 tkefactor_l(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * & 2714 2829 ( glsf / glsc )**p23 ) 2715 2830 ENDDO … … 2732 2847 height = zu(k) - zu(k_wall) 2733 2848 fw = EXP( -cfw * height / glsf ) 2734 tkefactor_r(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * 2849 tkefactor_r(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * & 2735 2850 ( glsf / glsc )**p23 ) 2736 2851 ENDDO … … 2753 2868 height = zu(k) - zu(k_wall) 2754 2869 fw = EXP( -cfw*height / glsf ) 2755 tkefactor_s(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * 2870 tkefactor_s(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * & 2756 2871 ( glsf / glsc )**p23 ) 2757 2872 ENDDO … … 2812 2927 IMPLICIT NONE 2813 2928 2814 INTEGER(iwp) :: i ! :2815 INTEGER(iwp) :: j ! :2929 INTEGER(iwp) :: i !< 2930 INTEGER(iwp) :: j !< 2816 2931 2817 2932 ! … … 2838 2953 IMPLICIT NONE 2839 2954 2840 INTEGER , INTENT(IN) :: child_id !:2841 INTEGER , INTENT(IN) :: nz_cl !:2842 INTEGER , INTENT(IN),OPTIONAL :: n !< index of chemical species2843 2844 CHARACTER(LEN=*), INTENT(IN) :: name ! :2955 INTEGER(iwp), INTENT(IN) :: child_id !< 2956 INTEGER(iwp), INTENT(IN) :: nz_cl !< 2957 INTEGER(iwp), INTENT(IN),OPTIONAL :: n !< index of chemical species 2958 2959 CHARACTER(LEN=*), INTENT(IN) :: name !< 2845 2960 2846 2961 #if defined( __parallel ) 2847 INTEGER(iwp) :: ierr !: 2848 INTEGER(iwp) :: istat !: 2849 2850 REAL(wp), POINTER, DIMENSION(:,:) :: p_2d !: 2851 REAL(wp), POINTER, DIMENSION(:,:) :: p_2d_sec !: 2852 REAL(wp), POINTER, DIMENSION(:,:,:) :: p_3d !: 2853 REAL(wp), POINTER, DIMENSION(:,:,:) :: p_3d_sec !: 2962 INTEGER(iwp) :: ierr !< 2963 INTEGER(iwp) :: istat !< 2964 2965 REAL(wp), POINTER, DIMENSION(:,:) :: p_2d !< 2966 REAL(wp), POINTER, DIMENSION(:,:) :: p_2d_sec !< 2967 REAL(wp), POINTER, DIMENSION(:,:,:) :: p_3d !< 2968 REAL(wp), POINTER, DIMENSION(:,:,:) :: p_3d_sec !< 2969 INTEGER(idp), POINTER, DIMENSION(:,:) :: i_2d !< 2854 2970 2855 2971 2856 2972 NULLIFY( p_3d ) 2857 2973 NULLIFY( p_2d ) 2974 NULLIFY( i_2d ) 2975 2858 2976 ! 2859 2977 !-- List of array names, which can be coupled. … … 2870 2988 IF ( TRIM(name) == "nc" ) p_3d => nc 2871 2989 IF ( TRIM(name) == "s" ) p_3d => s 2990 IF ( TRIM(name) == "nr_part" ) i_2d => nr_part 2991 IF ( TRIM(name) == "part_adr" ) i_2d => part_adr 2872 2992 IF ( INDEX( TRIM(name), "chem_" ) /= 0 ) p_3d => chem_species(n)%conc 2873 2993 … … 2882 3002 ELSEIF ( ASSOCIATED( p_2d ) ) THEN 2883 3003 CALL pmc_s_set_dataarray( child_id, p_2d ) 3004 ELSEIF ( ASSOCIATED( i_2d ) ) THEN 3005 CALL pmc_s_set_dataarray( child_id, i_2d ) 2884 3006 ELSE 2885 3007 ! … … 2887 3009 IF ( myid == 0 .AND. cpl_id == 1 ) THEN 2888 3010 2889 message_string = 'pointer for array "' // TRIM( name ) // 3011 message_string = 'pointer for array "' // TRIM( name ) // & 2890 3012 '" can''t be associated' 2891 3013 CALL message( 'pmci_set_array_pointer', 'PA0117', 3, 2, 0, 6, 0 ) … … 2911 3033 2912 3034 IF ( ASSOCIATED( p_3d ) ) THEN 2913 CALL pmc_s_set_dataarray( child_id, p_3d, nz_cl, nz, 3035 CALL pmc_s_set_dataarray( child_id, p_3d, nz_cl, nz, & 2914 3036 array_2 = p_3d_sec ) 2915 3037 ELSEIF ( ASSOCIATED( p_2d ) ) THEN 2916 3038 CALL pmc_s_set_dataarray( child_id, p_2d ) 3039 ELSEIF ( ASSOCIATED( i_2d ) ) THEN 3040 CALL pmc_s_set_dataarray( child_id, i_2d ) 2917 3041 ELSE 2918 3042 ! … … 2920 3044 IF ( myid == 0 .AND. cpl_id == 1 ) THEN 2921 3045 2922 message_string = 'pointer for array "' // TRIM( name ) // 3046 message_string = 'pointer for array "' // TRIM( name ) // & 2923 3047 '" can''t be associated' 2924 3048 CALL message( 'pmci_set_array_pointer', 'PA0117', 3, 2, 0, 6, 0 ) … … 2933 3057 2934 3058 #endif 2935 END SUBROUTINE pmci_set_array_pointer 2936 2937 2938 2939 SUBROUTINE pmci_create_child_arrays( name, is, ie, js, je, nzc, n ) 3059 END SUBROUTINE pmci_set_array_pointer 3060 3061 INTEGER FUNCTION get_number_of_childs () 3062 IMPLICIT NONE 3063 3064 get_number_of_childs = SIZE( pmc_parent_for_child ) - 1 3065 3066 RETURN 3067 END FUNCTION get_number_of_childs 3068 3069 INTEGER FUNCTION get_childid (id_index) 3070 IMPLICIT NONE 3071 3072 INTEGER,INTENT(IN) :: id_index 3073 3074 get_childid = pmc_parent_for_child(id_index) 3075 3076 RETURN 3077 END FUNCTION get_childid 3078 3079 SUBROUTINE get_child_edges (m, lx_coord, lx_coord_b, rx_coord, rx_coord_b, & 3080 sy_coord, sy_coord_b, ny_coord, ny_coord_b, & 3081 uz_coord, uz_coord_b) 3082 IMPLICIT NONE 3083 INTEGER,INTENT(IN) :: m 3084 REAL(wp),INTENT(OUT) :: lx_coord, lx_coord_b 3085 REAL(wp),INTENT(OUT) :: rx_coord, rx_coord_b 3086 REAL(wp),INTENT(OUT) :: sy_coord, sy_coord_b 3087 REAL(wp),INTENT(OUT) :: ny_coord, ny_coord_b 3088 REAL(wp),INTENT(OUT) :: uz_coord, uz_coord_b 3089 3090 lx_coord = childgrid(m)%lx_coord 3091 rx_coord = childgrid(m)%rx_coord 3092 sy_coord = childgrid(m)%sy_coord 3093 ny_coord = childgrid(m)%ny_coord 3094 uz_coord = childgrid(m)%uz_coord 3095 3096 lx_coord_b = childgrid(m)%lx_coord_b 3097 rx_coord_b = childgrid(m)%rx_coord_b 3098 sy_coord_b = childgrid(m)%sy_coord_b 3099 ny_coord_b = childgrid(m)%ny_coord_b 3100 uz_coord_b = childgrid(m)%uz_coord_b 3101 3102 END SUBROUTINE get_child_edges 3103 3104 SUBROUTINE get_child_gridspacing (m, dx,dy,dz) 3105 3106 IMPLICIT NONE 3107 INTEGER,INTENT(IN) :: m 3108 REAL(wp),INTENT(OUT) :: dx,dy 3109 REAL(wp),INTENT(OUT),OPTIONAL :: dz 3110 3111 dx = childgrid(m)%dx 3112 dy = childgrid(m)%dy 3113 IF(PRESENT(dz)) THEN 3114 dz = childgrid(m)%dz 3115 ENDIF 3116 3117 END SUBROUTINE get_child_gridspacing 3118 3119 SUBROUTINE pmci_create_child_arrays( name, is, ie, js, je, nzc,n ) 2940 3120 2941 3121 IMPLICIT NONE 2942 3122 2943 CHARACTER(LEN=*), INTENT(IN) :: name ! :2944 2945 INTEGER(iwp), INTENT(IN) :: ie ! :2946 INTEGER(iwp), INTENT(IN) :: is ! :2947 INTEGER(iwp), INTENT(IN) :: je ! :2948 INTEGER(iwp), INTENT(IN) :: js ! :2949 INTEGER(iwp), INTENT(IN) :: nzc ! :Note that nzc is cg%nz3123 CHARACTER(LEN=*), INTENT(IN) :: name !< 3124 3125 INTEGER(iwp), INTENT(IN) :: ie !< 3126 INTEGER(iwp), INTENT(IN) :: is !< 3127 INTEGER(iwp), INTENT(IN) :: je !< 3128 INTEGER(iwp), INTENT(IN) :: js !< 3129 INTEGER(iwp), INTENT(IN) :: nzc !< Note that nzc is cg%nz 2950 3130 2951 3131 INTEGER(iwp), INTENT(IN), OPTIONAL :: n !< number of chemical species 2952 3132 2953 3133 #if defined( __parallel ) 2954 INTEGER(iwp) :: ierr !: 2955 INTEGER(iwp) :: istat !: 2956 2957 REAL(wp), POINTER,DIMENSION(:,:) :: p_2d !: 2958 REAL(wp), POINTER,DIMENSION(:,:,:) :: p_3d !: 3134 INTEGER(iwp) :: ierr !< 3135 INTEGER(iwp) :: istat !< 3136 3137 REAL(wp), POINTER,DIMENSION(:,:) :: p_2d !< 3138 REAL(wp), POINTER,DIMENSION(:,:,:) :: p_3d !< 3139 INTEGER(idp), POINTER,DIMENSION(:,:) :: i_2d !< 2959 3140 2960 3141 2961 3142 NULLIFY( p_3d ) 2962 3143 NULLIFY( p_2d ) 3144 NULLIFY( i_2d ) 3145 2963 3146 ! 2964 3147 !-- List of array names, which can be coupled … … 2996 3179 IF ( .NOT. ALLOCATED( sc ) ) ALLOCATE( sc(0:nzc+1,js:je,is:ie) ) 2997 3180 p_3d => sc 3181 ELSEIF (trim(name) == "nr_part") then 3182 IF (.not.allocated(nr_partc)) allocate(nr_partc(js:je, is:ie)) 3183 i_2d => nr_partc 3184 ELSEIF (trim(name) == "part_adr") then 3185 IF (.not.allocated(part_adrc)) allocate(part_adrc(js:je, is:ie)) 3186 i_2d => part_adrc 2998 3187 ELSEIF ( TRIM( name(1:5) ) == "chem_" ) THEN 2999 3188 IF ( .NOT. ALLOCATED( chem_spec_c ) ) & … … 3009 3198 ELSEIF ( ASSOCIATED( p_2d ) ) THEN 3010 3199 CALL pmc_c_set_dataarray( p_2d ) 3200 ELSEIF ( ASSOCIATED( i_2d ) ) THEN 3201 CALL pmc_c_set_dataarray( i_2d ) 3011 3202 ELSE 3012 3203 ! … … 3014 3205 IF ( myid == 0 .AND. cpl_id == 2 ) THEN 3015 3206 3016 message_string = 'pointer for array "' // TRIM( name ) // 3207 message_string = 'pointer for array "' // TRIM( name ) // & 3017 3208 '" can''t be associated' 3018 3209 CALL message( 'pmci_create_child_arrays', 'PA0170', 3, 2, 0, 6, 0 ) … … 3037 3228 IMPLICIT NONE 3038 3229 3039 INTEGER(iwp) :: child_id ! :3040 INTEGER(iwp) :: m ! :3041 3042 REAL(wp) :: waittime ! :3230 INTEGER(iwp) :: child_id !< 3231 INTEGER(iwp) :: m !< 3232 3233 REAL(wp) :: waittime !< 3043 3234 3044 3235 … … 3086 3277 ! 3087 3278 !-- The interpolation. 3088 CALL pmci_interp_tril_all ( u, uc, icu, jco, kco, r1xu, r2xu, r1yo, 3279 CALL pmci_interp_tril_all ( u, uc, icu, jco, kco, r1xu, r2xu, r1yo, & 3089 3280 r2yo, r1zo, r2zo, 'u' ) 3090 CALL pmci_interp_tril_all ( v, vc, ico, jcv, kco, r1xo, r2xo, r1yv, 3281 CALL pmci_interp_tril_all ( v, vc, ico, jcv, kco, r1xo, r2xo, r1yv, & 3091 3282 r2yv, r1zo, r2zo, 'v' ) 3092 CALL pmci_interp_tril_all ( w, wc, ico, jco, kcw, r1xo, r2xo, r1yo, 3283 CALL pmci_interp_tril_all ( w, wc, ico, jco, kcw, r1xo, r2xo, r1yo, & 3093 3284 r2yo, r1zw, r2zw, 'w' ) 3094 CALL pmci_interp_tril_all ( e, ec, ico, jco, kco, r1xo, r2xo, r1yo, 3285 CALL pmci_interp_tril_all ( e, ec, ico, jco, kco, r1xo, r2xo, r1yo, & 3095 3286 r2yo, r1zo, r2zo, 'e' ) 3096 3287 3097 3288 IF ( .NOT. neutral ) THEN 3098 CALL pmci_interp_tril_all ( pt, ptc, ico, jco, kco, r1xo, r2xo, 3289 CALL pmci_interp_tril_all ( pt, ptc, ico, jco, kco, r1xo, r2xo, & 3099 3290 r1yo, r2yo, r1zo, r2zo, 's' ) 3100 3291 ENDIF … … 3102 3293 IF ( humidity ) THEN 3103 3294 3104 CALL pmci_interp_tril_all ( q, q_c, ico, jco, kco, r1xo, r2xo, r1yo, 3295 CALL pmci_interp_tril_all ( q, q_c, ico, jco, kco, r1xo, r2xo, r1yo, & 3105 3296 r2yo, r1zo, r2zo, 's' ) 3106 3297 3107 3298 IF ( cloud_physics .AND. microphysics_morrison ) THEN 3108 CALL pmci_interp_tril_all ( qc, qcc, ico, jco, kco, r1xo, r2xo, 3299 CALL pmci_interp_tril_all ( qc, qcc, ico, jco, kco, r1xo, r2xo, & 3109 3300 r1yo, r2yo, r1zo, r2zo, 's' ) 3110 CALL pmci_interp_tril_all ( nc, ncc, ico, jco, kco, r1xo, r2xo, 3301 CALL pmci_interp_tril_all ( nc, ncc, ico, jco, kco, r1xo, r2xo, & 3111 3302 r1yo, r2yo, r1zo, r2zo, 's' ) 3112 3303 ENDIF 3113 3304 3114 3305 IF ( cloud_physics .AND. microphysics_seifert ) THEN 3115 CALL pmci_interp_tril_all ( qr, qrc, ico, jco, kco, r1xo, r2xo, 3306 CALL pmci_interp_tril_all ( qr, qrc, ico, jco, kco, r1xo, r2xo, & 3116 3307 r1yo, r2yo, r1zo, r2zo, 's' ) 3117 CALL pmci_interp_tril_all ( nr, nrc, ico, jco, kco, r1xo, r2xo, 3308 CALL pmci_interp_tril_all ( nr, nrc, ico, jco, kco, r1xo, r2xo, & 3118 3309 r1yo, r2yo, r1zo, r2zo, 's' ) 3119 3310 ENDIF … … 3122 3313 3123 3314 IF ( passive_scalar ) THEN 3124 CALL pmci_interp_tril_all ( s, sc, ico, jco, kco, r1xo, r2xo, r1yo, 3315 CALL pmci_interp_tril_all ( s, sc, ico, jco, kco, r1xo, r2xo, r1yo, & 3125 3316 r2yo, r1zo, r2zo, 's' ) 3126 3317 ENDIF … … 3169 3360 3170 3361 3171 SUBROUTINE pmci_interp_tril_all( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, 3362 SUBROUTINE pmci_interp_tril_all( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, & 3172 3363 r1z, r2z, var ) 3173 3364 ! … … 3177 3368 IMPLICIT NONE 3178 3369 3179 CHARACTER(LEN=1), INTENT(IN) :: var ! :3180 3181 INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) :: ic ! :3182 INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) :: jc ! :3183 INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) :: kc ! :3184 3185 INTEGER(iwp) :: i ! :3186 INTEGER(iwp) :: ib ! :3187 INTEGER(iwp) :: ie ! :3188 INTEGER(iwp) :: j ! :3189 INTEGER(iwp) :: jb ! :3190 INTEGER(iwp) :: je ! :3191 INTEGER(iwp) :: k ! :3192 INTEGER(iwp) :: k_wall ! :3193 INTEGER(iwp) :: k1 ! :3194 INTEGER(iwp) :: kbc ! :3195 INTEGER(iwp) :: l ! :3196 INTEGER(iwp) :: m ! :3197 INTEGER(iwp) :: n ! :3198 3199 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f ! :3200 REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: fc ! :3201 REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r1x ! :3202 REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r2x ! :3203 REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r1y ! :3204 REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r2y ! :3205 REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r1z ! :3206 REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r2z ! :3207 3208 REAL(wp) :: fk ! :3209 REAL(wp) :: fkj ! :3210 REAL(wp) :: fkjp ! :3211 REAL(wp) :: fkp ! :3212 REAL(wp) :: fkpj ! :3213 REAL(wp) :: fkpjp ! :3214 REAL(wp) :: logratio ! :3215 REAL(wp) :: logzuc1 ! :3216 REAL(wp) :: zuc1 ! :3217 REAL(wp) :: z0_topo ! :roughness at vertical walls3370 CHARACTER(LEN=1), INTENT(IN) :: var !< 3371 3372 INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) :: ic !< 3373 INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) :: jc !< 3374 INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) :: kc !< 3375 3376 INTEGER(iwp) :: i !< 3377 INTEGER(iwp) :: ib !< 3378 INTEGER(iwp) :: ie !< 3379 INTEGER(iwp) :: j !< 3380 INTEGER(iwp) :: jb !< 3381 INTEGER(iwp) :: je !< 3382 INTEGER(iwp) :: k !< 3383 INTEGER(iwp) :: k_wall !< 3384 INTEGER(iwp) :: k1 !< 3385 INTEGER(iwp) :: kbc !< 3386 INTEGER(iwp) :: l !< 3387 INTEGER(iwp) :: m !< 3388 INTEGER(iwp) :: n !< 3389 3390 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !< 3391 REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: fc !< 3392 REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r1x !< 3393 REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r2x !< 3394 REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r1y !< 3395 REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r2y !< 3396 REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r1z !< 3397 REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r2z !< 3398 3399 REAL(wp) :: fk !< 3400 REAL(wp) :: fkj !< 3401 REAL(wp) :: fkjp !< 3402 REAL(wp) :: fkp !< 3403 REAL(wp) :: fkpj !< 3404 REAL(wp) :: fkpjp !< 3405 REAL(wp) :: logratio !< 3406 REAL(wp) :: logzuc1 !< 3407 REAL(wp) :: zuc1 !< 3408 REAL(wp) :: z0_topo !< roughness at vertical walls 3218 3409 3219 3410 … … 3292 3483 k = k_wall + 1 3293 3484 DO WHILE ( zu(k) < zuc1 ) 3294 logratio = ( LOG( ( zu(k) - zu(k_wall) ) / z0_topo ) ) / 3485 logratio = ( LOG( ( zu(k) - zu(k_wall) ) / z0_topo ) ) / & 3295 3486 logzuc1 3296 3487 f(k,j,i) = logratio * f(k1,j,i) … … 3331 3522 #if defined( __parallel ) 3332 3523 3333 USE control_parameters, 3524 USE control_parameters, & 3334 3525 ONLY: dt_restart, end_time, message_string, restart_time, time_restart 3335 3526 … … 3353 3544 IF ( .NOT. pmc_is_rootmodel() ) THEN 3354 3545 IF ( end_time /= end_time_root ) THEN 3355 WRITE( message_string, * ) 'mismatch between root model and ', 3356 'child settings & end_time(root) = ', end_time_root, 3357 ' & end_time(child) = ', end_time, ' & child value is set', 3546 WRITE( message_string, * ) 'mismatch between root model and ', & 3547 'child settings & end_time(root) = ', end_time_root, & 3548 ' & end_time(child) = ', end_time, ' & child value is set', & 3358 3549 ' to root value' 3359 CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, 3550 CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, & 3360 3551 0 ) 3361 3552 end_time = end_time_root … … 3369 3560 IF ( .NOT. pmc_is_rootmodel() ) THEN 3370 3561 IF ( restart_time /= restart_time_root ) THEN 3371 WRITE( message_string, * ) 'mismatch between root model and ', 3372 'child settings & restart_time(root) = ', restart_time_root, 3373 ' & restart_time(child) = ', restart_time, ' & child ', 3562 WRITE( message_string, * ) 'mismatch between root model and ', & 3563 'child settings & restart_time(root) = ', restart_time_root, & 3564 ' & restart_time(child) = ', restart_time, ' & child ', & 3374 3565 'value is set to root value' 3375 CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, 3566 CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, & 3376 3567 0 ) 3377 3568 restart_time = restart_time_root … … 3385 3576 IF ( .NOT. pmc_is_rootmodel() ) THEN 3386 3577 IF ( dt_restart /= dt_restart_root ) THEN 3387 WRITE( message_string, * ) 'mismatch between root model and ', 3388 'child settings & dt_restart(root) = ', dt_restart_root, 3389 ' & dt_restart(child) = ', dt_restart, ' & child ', 3578 WRITE( message_string, * ) 'mismatch between root model and ', & 3579 'child settings & dt_restart(root) = ', dt_restart_root, & 3580 ' & dt_restart(child) = ', dt_restart, ' & child ', & 3390 3581 'value is set to root value' 3391 CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, 3582 CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, & 3392 3583 0 ) 3393 3584 dt_restart = dt_restart_root … … 3401 3592 IF ( .NOT. pmc_is_rootmodel() ) THEN 3402 3593 IF ( time_restart /= time_restart_root ) THEN 3403 WRITE( message_string, * ) 'mismatch between root model and ', 3404 'child settings & time_restart(root) = ', time_restart_root, 3405 ' & time_restart(child) = ', time_restart, ' & child ', 3594 WRITE( message_string, * ) 'mismatch between root model and ', & 3595 'child settings & time_restart(root) = ', time_restart_root, & 3596 ' & time_restart(child) = ', time_restart, ' & child ', & 3406 3597 'value is set to root value' 3407 CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, 3598 CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, & 3408 3599 0 ) 3409 3600 time_restart = time_restart_root … … 3424 3615 IMPLICIT NONE 3425 3616 3426 INTEGER(iwp) :: i ! :3427 INTEGER(iwp) :: ierr ! :3428 INTEGER(iwp) :: j ! :3429 INTEGER(iwp) :: k ! :3430 3431 REAL(wp) :: dxdy ! :3432 REAL(wp) :: innor ! :3433 REAL(wp) :: w_lt ! :3434 REAL(wp), DIMENSION(1:3) :: volume_flow_l ! :3617 INTEGER(iwp) :: i !< 3618 INTEGER(iwp) :: ierr !< 3619 INTEGER(iwp) :: j !< 3620 INTEGER(iwp) :: k !< 3621 3622 REAL(wp) :: dxdy !< 3623 REAL(wp) :: innor !< 3624 REAL(wp) :: w_lt !< 3625 REAL(wp), DIMENSION(1:3) :: volume_flow_l !< 3435 3626 3436 3627 ! … … 3465 3656 #if defined( __parallel ) 3466 3657 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 3467 CALL MPI_ALLREDUCE( volume_flow_l(1), volume_flow(1), 1, MPI_REAL, 3658 CALL MPI_ALLREDUCE( volume_flow_l(1), volume_flow(1), 1, MPI_REAL, & 3468 3659 MPI_SUM, comm2d, ierr ) 3469 3660 #else … … 3502 3693 #if defined( __parallel ) 3503 3694 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 3504 CALL MPI_ALLREDUCE( volume_flow_l(2), volume_flow(2), 1, MPI_REAL, 3695 CALL MPI_ALLREDUCE( volume_flow_l(2), volume_flow(2), 1, MPI_REAL, & 3505 3696 MPI_SUM, comm2d, ierr ) 3506 3697 #else … … 3522 3713 #if defined( __parallel ) 3523 3714 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 3524 CALL MPI_ALLREDUCE( volume_flow_l(3), volume_flow(3), 1, MPI_REAL, 3715 CALL MPI_ALLREDUCE( volume_flow_l(3), volume_flow(3), 1, MPI_REAL, & 3525 3716 MPI_SUM, comm2d, ierr ) 3526 3717 #else … … 3553 3744 IMPLICIT NONE 3554 3745 3555 INTEGER(iwp) :: ierr ! :3556 REAL(wp), DIMENSION(1) :: dtl ! :3557 REAL(wp), DIMENSION(1) :: dtg ! :3746 INTEGER(iwp) :: ierr !< 3747 REAL(wp), DIMENSION(1) :: dtl !< 3748 REAL(wp), DIMENSION(1) :: dtg !< 3558 3749 3559 3750 … … 3575 3766 IMPLICIT NONE 3576 3767 3577 INTEGER(iwp), INTENT(IN) :: swaplevel ! :swaplevel (1 or 2) of PALM's3578 ! :timestep3579 3580 INTEGER(iwp) :: child_id ! :3581 INTEGER(iwp) :: m ! :3768 INTEGER(iwp), INTENT(IN) :: swaplevel !< swaplevel (1 or 2) of PALM's 3769 !< timestep 3770 3771 INTEGER(iwp) :: child_id !< 3772 INTEGER(iwp) :: m !< 3582 3773 3583 3774 #if defined( __parallel ) … … 3603 3794 IMPLICIT NONE 3604 3795 3605 INTEGER(iwp) :: ierr ! :3606 INTEGER(iwp) :: istat ! :3796 INTEGER(iwp) :: ierr !< 3797 INTEGER(iwp) :: istat !< 3607 3798 3608 3799 CHARACTER(LEN=*), INTENT(IN) :: local_nesting_mode … … 3651 3842 IMPLICIT NONE 3652 3843 3653 INTEGER(iwp), INTENT(IN) :: direction ! :3844 INTEGER(iwp), INTENT(IN) :: direction !< 3654 3845 3655 3846 #if defined( __parallel ) 3656 INTEGER(iwp) :: child_id ! :3657 INTEGER(iwp) :: i ! :3658 INTEGER(iwp) :: ierr ! :3659 INTEGER(iwp) :: j ! :3660 INTEGER(iwp) :: k ! :3661 INTEGER(iwp) :: m ! :3662 3663 REAL(wp) :: waittime ! :3664 REAL(wp), DIMENSION(1) :: dtc ! :3665 REAL(wp), DIMENSION(1) :: dtl ! :3847 INTEGER(iwp) :: child_id !< 3848 INTEGER(iwp) :: i !< 3849 INTEGER(iwp) :: ierr !< 3850 INTEGER(iwp) :: j !< 3851 INTEGER(iwp) :: k !< 3852 INTEGER(iwp) :: m !< 3853 3854 REAL(wp) :: waittime !< 3855 REAL(wp), DIMENSION(1) :: dtc !< 3856 REAL(wp), DIMENSION(1) :: dtl !< 3666 3857 3667 3858 … … 3722 3913 IMPLICIT NONE 3723 3914 3724 INTEGER(iwp), INTENT(IN) :: direction ! :3915 INTEGER(iwp), INTENT(IN) :: direction !< 3725 3916 3726 3917 #if defined( __parallel ) 3727 INTEGER(iwp) :: ierr ! :3728 INTEGER(iwp) :: icl ! :3729 INTEGER(iwp) :: icr ! :3730 INTEGER(iwp) :: jcs ! :3731 INTEGER(iwp) :: jcn ! :3918 INTEGER(iwp) :: ierr !< 3919 INTEGER(iwp) :: icl !< 3920 INTEGER(iwp) :: icr !< 3921 INTEGER(iwp) :: jcs !< 3922 INTEGER(iwp) :: jcn !< 3732 3923 3733 REAL(wp), DIMENSION(1) :: dtl ! :3734 REAL(wp), DIMENSION(1) :: dts ! :3924 REAL(wp), DIMENSION(1) :: dtl !< 3925 REAL(wp), DIMENSION(1) :: dts !< 3735 3926 3736 3927 … … 3788 3979 !-- Left border pe: 3789 3980 IF ( nest_bound_l ) THEN 3790 CALL pmci_interp_tril_lr( u, uc, icu, jco, kco, r1xu, r2xu, 3791 r1yo, r2yo, r1zo, r2zo, 3792 logc_u_l, logc_ratio_u_l, 3981 CALL pmci_interp_tril_lr( u, uc, icu, jco, kco, r1xu, r2xu, & 3982 r1yo, r2yo, r1zo, r2zo, & 3983 logc_u_l, logc_ratio_u_l, & 3793 3984 nzt_topo_nestbc_l, 'l', 'u' ) 3794 3985 3795 CALL pmci_interp_tril_lr( v, vc, ico, jcv, kco, r1xo, r2xo, 3796 r1yv, r2yv, r1zo, r2zo, 3797 logc_v_l, logc_ratio_v_l, 3986 CALL pmci_interp_tril_lr( v, vc, ico, jcv, kco, r1xo, r2xo, & 3987 r1yv, r2yv, r1zo, r2zo, & 3988 logc_v_l, logc_ratio_v_l, & 3798 3989 nzt_topo_nestbc_l, 'l', 'v' ) 3799 3990 3800 CALL pmci_interp_tril_lr( w, wc, ico, jco, kcw, r1xo, r2xo, 3801 r1yo, r2yo, r1zw, r2zw, 3802 logc_w_l, logc_ratio_w_l, 3991 CALL pmci_interp_tril_lr( w, wc, ico, jco, kcw, r1xo, r2xo, & 3992 r1yo, r2yo, r1zw, r2zw, & 3993 logc_w_l, logc_ratio_w_l, & 3803 3994 nzt_topo_nestbc_l, 'l', 'w' ) 3804 3995 3805 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, 3806 r1yo, r2yo, r1zo, r2zo, 3807 logc_u_l, logc_ratio_u_l, 3996 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, & 3997 r1yo, r2yo, r1zo, r2zo, & 3998 logc_u_l, logc_ratio_u_l, & 3808 3999 nzt_topo_nestbc_l, 'l', 'e' ) 3809 4000 3810 4001 IF ( .NOT. neutral ) THEN 3811 CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo, 3812 r1yo, r2yo, r1zo, r2zo, 3813 logc_u_l, logc_ratio_u_l, 4002 CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo, & 4003 r1yo, r2yo, r1zo, r2zo, & 4004 logc_u_l, logc_ratio_u_l, & 3814 4005 nzt_topo_nestbc_l, 'l', 's' ) 3815 4006 ENDIF … … 3817 4008 IF ( humidity ) THEN 3818 4009 3819 CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo, 3820 r1yo, r2yo, r1zo, r2zo, 3821 logc_u_l, logc_ratio_u_l, 4010 CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo, & 4011 r1yo, r2yo, r1zo, r2zo, & 4012 logc_u_l, logc_ratio_u_l, & 3822 4013 nzt_topo_nestbc_l, 'l', 's' ) 3823 4014 … … 3853 4044 3854 4045 IF ( passive_scalar ) THEN 3855 CALL pmci_interp_tril_lr( s, sc, ico, jco, kco, r1xo, r2xo, 3856 r1yo, r2yo, r1zo, r2zo, 3857 logc_u_l, logc_ratio_u_l, 4046 CALL pmci_interp_tril_lr( s, sc, ico, jco, kco, r1xo, r2xo, & 4047 r1yo, r2yo, r1zo, r2zo, & 4048 logc_u_l, logc_ratio_u_l, & 3858 4049 nzt_topo_nestbc_l, 'l', 's' ) 3859 4050 ENDIF … … 3916 4107 !-- Right border pe 3917 4108 IF ( nest_bound_r ) THEN 3918 CALL pmci_interp_tril_lr( u, uc, icu, jco, kco, r1xu, r2xu, 3919 r1yo, r2yo, r1zo, r2zo, 3920 logc_u_r, logc_ratio_u_r, 4109 CALL pmci_interp_tril_lr( u, uc, icu, jco, kco, r1xu, r2xu, & 4110 r1yo, r2yo, r1zo, r2zo, & 4111 logc_u_r, logc_ratio_u_r, & 3921 4112 nzt_topo_nestbc_r, 'r', 'u' ) 3922 4113 3923 CALL pmci_interp_tril_lr( v, vc, ico, jcv, kco, r1xo, r2xo, 3924 r1yv, r2yv, r1zo, r2zo, 3925 logc_v_r, logc_ratio_v_r, 4114 CALL pmci_interp_tril_lr( v, vc, ico, jcv, kco, r1xo, r2xo, & 4115 r1yv, r2yv, r1zo, r2zo, & 4116 logc_v_r, logc_ratio_v_r, & 3926 4117 nzt_topo_nestbc_r, 'r', 'v' ) 3927 4118 3928 CALL pmci_interp_tril_lr( w, wc, ico, jco, kcw, r1xo, r2xo, 3929 r1yo, r2yo, r1zw, r2zw, 3930 logc_w_r, logc_ratio_w_r, 4119 CALL pmci_interp_tril_lr( w, wc, ico, jco, kcw, r1xo, r2xo, & 4120 r1yo, r2yo, r1zw, r2zw, & 4121 logc_w_r, logc_ratio_w_r, & 3931 4122 nzt_topo_nestbc_r, 'r', 'w' ) 3932 4123 3933 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, 3934 r1yo,r2yo, r1zo, r2zo, 3935 logc_u_r, logc_ratio_u_r, 4124 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, & 4125 r1yo,r2yo, r1zo, r2zo, & 4126 logc_u_r, logc_ratio_u_r, & 3936 4127 nzt_topo_nestbc_r, 'r', 'e' ) 3937 4128 3938 4129 3939 4130 IF ( .NOT. neutral ) THEN 3940 CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo, 3941 r1yo, r2yo, r1zo, r2zo, 3942 logc_u_r, logc_ratio_u_r, 4131 CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo, & 4132 r1yo, r2yo, r1zo, r2zo, & 4133 logc_u_r, logc_ratio_u_r, & 3943 4134 nzt_topo_nestbc_r, 'r', 's' ) 3944 4135 … … 3946 4137 3947 4138 IF ( humidity ) THEN 3948 CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo, 3949 r1yo, r2yo, r1zo, r2zo, 3950 logc_u_r, logc_ratio_u_r, 4139 CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo, & 4140 r1yo, r2yo, r1zo, r2zo, & 4141 logc_u_r, logc_ratio_u_r, & 3951 4142 nzt_topo_nestbc_r, 'r', 's' ) 3952 4143 … … 4047 4238 !-- South border pe 4048 4239 IF ( nest_bound_s ) THEN 4049 CALL pmci_interp_tril_sn( u, uc, icu, jco, kco, r1xu, r2xu, 4050 r1yo, r2yo, r1zo, r2zo, 4051 logc_u_s, logc_ratio_u_s, 4240 CALL pmci_interp_tril_sn( u, uc, icu, jco, kco, r1xu, r2xu, & 4241 r1yo, r2yo, r1zo, r2zo, & 4242 logc_u_s, logc_ratio_u_s, & 4052 4243 nzt_topo_nestbc_s, 's', 'u' ) 4053 CALL pmci_interp_tril_sn( v, vc, ico, jcv, kco, r1xo, r2xo, 4054 r1yv, r2yv, r1zo, r2zo, 4055 logc_v_s, logc_ratio_v_s, 4244 CALL pmci_interp_tril_sn( v, vc, ico, jcv, kco, r1xo, r2xo, & 4245 r1yv, r2yv, r1zo, r2zo, & 4246 logc_v_s, logc_ratio_v_s, & 4056 4247 nzt_topo_nestbc_s, 's', 'v' ) 4057 CALL pmci_interp_tril_sn( w, wc, ico, jco, kcw, r1xo, r2xo, 4058 r1yo, r2yo, r1zw, r2zw, 4059 logc_w_s, logc_ratio_w_s, 4248 CALL pmci_interp_tril_sn( w, wc, ico, jco, kcw, r1xo, r2xo, & 4249 r1yo, r2yo, r1zw, r2zw, & 4250 logc_w_s, logc_ratio_w_s, & 4060 4251 nzt_topo_nestbc_s, 's','w' ) 4061 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, 4062 r1yo, r2yo, r1zo, r2zo, 4063 logc_u_s, logc_ratio_u_s, 4252 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, & 4253 r1yo, r2yo, r1zo, r2zo, & 4254 logc_u_s, logc_ratio_u_s, & 4064 4255 nzt_topo_nestbc_s, 's', 'e' ) 4065 4256 4066 4257 IF ( .NOT. neutral ) THEN 4067 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, 4068 r1yo, r2yo, r1zo, r2zo, 4069 logc_u_s, logc_ratio_u_s, 4258 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, & 4259 r1yo, r2yo, r1zo, r2zo, & 4260 logc_u_s, logc_ratio_u_s, & 4070 4261 nzt_topo_nestbc_s, 's', 's' ) 4071 4262 ENDIF 4072 4263 4073 4264 IF ( humidity ) THEN 4074 CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo, 4075 r1yo,r2yo, r1zo, r2zo, 4076 logc_u_s, logc_ratio_u_s, 4265 CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo, & 4266 r1yo,r2yo, r1zo, r2zo, & 4267 logc_u_s, logc_ratio_u_s, & 4077 4268 nzt_topo_nestbc_s, 's', 's' ) 4078 4269 … … 4112 4303 4113 4304 IF ( passive_scalar ) THEN 4114 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo, 4115 r1yo,r2yo, r1zo, r2zo, 4116 logc_u_s, logc_ratio_u_s, 4305 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo, & 4306 r1yo,r2yo, r1zo, r2zo, & 4307 logc_u_s, logc_ratio_u_s, & 4117 4308 nzt_topo_nestbc_s, 's', 's' ) 4118 4309 ENDIF … … 4120 4311 IF ( air_chemistry ) THEN 4121 4312 DO n = 1, nspec 4122 CALL pmci_interp_tril_sn( chem_species(n)%conc, 4123 chem_spec_c(:,:,:,n), 4124 ico, jco, kco, r1xo, r2xo, 4125 r1yo, r2yo, r1zo, r2zo, 4126 logc_u_s, logc_ratio_u_s, 4313 CALL pmci_interp_tril_sn( chem_species(n)%conc, & 4314 chem_spec_c(:,:,:,n), & 4315 ico, jco, kco, r1xo, r2xo, & 4316 r1yo, r2yo, r1zo, r2zo, & 4317 logc_u_s, logc_ratio_u_s, & 4127 4318 nzt_topo_nestbc_s, 's', 's' ) 4128 4319 ENDDO … … 4172 4363 !-- North border pe 4173 4364 IF ( nest_bound_n ) THEN 4174 CALL pmci_interp_tril_sn( u, uc, icu, jco, kco, r1xu, r2xu, 4175 r1yo, r2yo, r1zo, r2zo, 4176 logc_u_n, logc_ratio_u_n, 4365 CALL pmci_interp_tril_sn( u, uc, icu, jco, kco, r1xu, r2xu, & 4366 r1yo, r2yo, r1zo, r2zo, & 4367 logc_u_n, logc_ratio_u_n, & 4177 4368 nzt_topo_nestbc_n, 'n', 'u' ) 4178 4369 4179 CALL pmci_interp_tril_sn( v, vc, ico, jcv, kco, r1xo, r2xo, 4180 r1yv, r2yv, r1zo, r2zo, 4181 logc_v_n, logc_ratio_v_n, 4370 CALL pmci_interp_tril_sn( v, vc, ico, jcv, kco, r1xo, r2xo, & 4371 r1yv, r2yv, r1zo, r2zo, & 4372 logc_v_n, logc_ratio_v_n, & 4182 4373 nzt_topo_nestbc_n, 'n', 'v' ) 4183 4374 4184 CALL pmci_interp_tril_sn( w, wc, ico, jco, kcw, r1xo, r2xo, 4185 r1yo, r2yo, r1zw, r2zw, 4186 logc_w_n, logc_ratio_w_n, 4375 CALL pmci_interp_tril_sn( w, wc, ico, jco, kcw, r1xo, r2xo, & 4376 r1yo, r2yo, r1zw, r2zw, & 4377 logc_w_n, logc_ratio_w_n, & 4187 4378 nzt_topo_nestbc_n, 'n', 'w' ) 4188 4379 4189 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, 4190 r1yo, r2yo, r1zo, r2zo, 4191 logc_u_n, logc_ratio_u_n, 4380 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, & 4381 r1yo, r2yo, r1zo, r2zo, & 4382 logc_u_n, logc_ratio_u_n, & 4192 4383 nzt_topo_nestbc_n, 'n', 'e' ) 4193 4384 4194 4385 IF ( .NOT. neutral ) THEN 4195 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, 4196 r1yo, r2yo, r1zo, r2zo, 4197 logc_u_n, logc_ratio_u_n, 4386 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, & 4387 r1yo, r2yo, r1zo, r2zo, & 4388 logc_u_n, logc_ratio_u_n, & 4198 4389 nzt_topo_nestbc_n, 'n', 's' ) 4199 4390 ENDIF 4200 4391 4201 4392 IF ( humidity ) THEN 4202 CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo, 4203 r1yo, r2yo, r1zo, r2zo, 4204 logc_u_n, logc_ratio_u_n, 4393 CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo, & 4394 r1yo, r2yo, r1zo, r2zo, & 4395 logc_u_n, logc_ratio_u_n, & 4205 4396 nzt_topo_nestbc_n, 'n', 's' ) 4206 4397 … … 4240 4431 4241 4432 IF ( passive_scalar ) THEN 4242 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo, 4243 r1yo, r2yo, r1zo, r2zo, 4244 logc_u_n, logc_ratio_u_n, 4433 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo, & 4434 r1yo, r2yo, r1zo, r2zo, & 4435 logc_u_n, logc_ratio_u_n, & 4245 4436 nzt_topo_nestbc_n, 'n', 's' ) 4246 4437 ENDIF … … 4479 4670 IMPLICIT NONE 4480 4671 4481 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), 4482 INTENT(INOUT) :: f ! :4483 REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), 4484 INTENT(IN) :: fc ! :4485 REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nys:nyn), 4486 INTENT(IN) :: logc_ratio ! :4487 REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r1x ! :4488 REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r2x ! :4489 REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r1y ! :4490 REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r2y ! :4491 REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r1z ! :4492 REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r2z ! :4672 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 4673 INTENT(INOUT) :: f !< 4674 REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), & 4675 INTENT(IN) :: fc !< 4676 REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nys:nyn), & 4677 INTENT(IN) :: logc_ratio !< 4678 REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r1x !< 4679 REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r2x !< 4680 REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r1y !< 4681 REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r2y !< 4682 REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r1z !< 4683 REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r2z !< 4493 4684 4494 INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) :: ic ! :4495 INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) :: jc ! :4496 INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) :: kc ! :4497 INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nys:nyn), 4498 INTENT(IN) :: logc ! :4499 INTEGER(iwp) :: nzt_topo_nestbc ! :4500 4501 CHARACTER(LEN=1), INTENT(IN) :: edge ! :4502 CHARACTER(LEN=1), INTENT(IN) :: var ! :4503 4504 INTEGER(iwp) :: i ! :4505 INTEGER(iwp) :: ib ! :4506 INTEGER(iwp) :: ibgp ! :4507 INTEGER(iwp) :: iw ! :4508 INTEGER(iwp) :: j ! :4509 INTEGER(iwp) :: jco ! :4510 INTEGER(iwp) :: jcorr ! :4511 INTEGER(iwp) :: jinc ! :4512 INTEGER(iwp) :: jw ! :4513 INTEGER(iwp) :: j1 ! :4514 INTEGER(iwp) :: k ! :4515 INTEGER(iwp) :: k_wall ! :vertical index of topography top4516 INTEGER(iwp) :: kco ! :4517 INTEGER(iwp) :: kcorr ! :4518 INTEGER(iwp) :: k1 ! :4519 INTEGER(iwp) :: l ! :4520 INTEGER(iwp) :: m ! :4521 INTEGER(iwp) :: n ! :4522 INTEGER(iwp) :: kbc ! :4685 INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) :: ic !< 4686 INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) :: jc !< 4687 INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) :: kc !< 4688 INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nys:nyn), & 4689 INTENT(IN) :: logc !< 4690 INTEGER(iwp) :: nzt_topo_nestbc !< 4691 4692 CHARACTER(LEN=1), INTENT(IN) :: edge !< 4693 CHARACTER(LEN=1), INTENT(IN) :: var !< 4694 4695 INTEGER(iwp) :: i !< 4696 INTEGER(iwp) :: ib !< 4697 INTEGER(iwp) :: ibgp !< 4698 INTEGER(iwp) :: iw !< 4699 INTEGER(iwp) :: j !< 4700 INTEGER(iwp) :: jco !< 4701 INTEGER(iwp) :: jcorr !< 4702 INTEGER(iwp) :: jinc !< 4703 INTEGER(iwp) :: jw !< 4704 INTEGER(iwp) :: j1 !< 4705 INTEGER(iwp) :: k !< 4706 INTEGER(iwp) :: k_wall !< vertical index of topography top 4707 INTEGER(iwp) :: kco !< 4708 INTEGER(iwp) :: kcorr !< 4709 INTEGER(iwp) :: k1 !< 4710 INTEGER(iwp) :: l !< 4711 INTEGER(iwp) :: m !< 4712 INTEGER(iwp) :: n !< 4713 INTEGER(iwp) :: kbc !< 4523 4714 4524 REAL(wp) :: coarse_dx ! :4525 REAL(wp) :: coarse_dy ! :4526 REAL(wp) :: coarse_dz ! :4527 REAL(wp) :: fkj ! :4528 REAL(wp) :: fkjp ! :4529 REAL(wp) :: fkpj ! :4530 REAL(wp) :: fkpjp ! :4531 REAL(wp) :: fk ! :4532 REAL(wp) :: fkp ! :4715 REAL(wp) :: coarse_dx !< 4716 REAL(wp) :: coarse_dy !< 4717 REAL(wp) :: coarse_dz !< 4718 REAL(wp) :: fkj !< 4719 REAL(wp) :: fkjp !< 4720 REAL(wp) :: fkpj !< 4721 REAL(wp) :: fkpjp !< 4722 REAL(wp) :: fk !< 4723 REAL(wp) :: fkp !< 4533 4724 4534 4725 ! … … 4640 4831 DO kcorr = 0, ncorr-1 4641 4832 kco = k + kcorr 4642 f(kco,jco,i) = 0.5_wp * ( logc_ratio(1,kcorr,k,j) * 4643 f(k1,j,i) 4644 + logc_ratio(2,jcorr,k,j) * 4833 f(kco,jco,i) = 0.5_wp * ( logc_ratio(1,kcorr,k,j) * & 4834 f(k1,j,i) & 4835 + logc_ratio(2,jcorr,k,j) * & 4645 4836 f(k,j1,i) ) 4646 4837 ENDDO … … 4695 4886 4696 4887 4697 SUBROUTINE pmci_interp_tril_sn( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, 4888 SUBROUTINE pmci_interp_tril_sn( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, & 4698 4889 r2z, logc, logc_ratio, & 4699 4890 nzt_topo_nestbc, edge, var ) … … 4706 4897 IMPLICIT NONE 4707 4898 4708 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), 4709 INTENT(INOUT) :: f ! :4710 REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), 4711 INTENT(IN) :: fc ! :4712 REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nxl:nxr), 4713 INTENT(IN) :: logc_ratio ! :4714 REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r1x ! :4715 REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r2x ! :4716 REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r1y ! :4717 REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r2y ! :4718 REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r1z ! :4719 REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r2z ! :4899 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 4900 INTENT(INOUT) :: f !< 4901 REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), & 4902 INTENT(IN) :: fc !< 4903 REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nxl:nxr), & 4904 INTENT(IN) :: logc_ratio !< 4905 REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r1x !< 4906 REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r2x !< 4907 REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r1y !< 4908 REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r2y !< 4909 REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r1z !< 4910 REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r2z !< 4720 4911 4721 INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) :: ic ! :4722 INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) :: jc ! :4723 INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) :: kc ! :4724 INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nxl:nxr), 4725 INTENT(IN) :: logc ! :4726 INTEGER(iwp) :: nzt_topo_nestbc ! :4727 4728 CHARACTER(LEN=1), INTENT(IN) :: edge ! :4729 CHARACTER(LEN=1), INTENT(IN) :: var ! :4912 INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) :: ic !< 4913 INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) :: jc !< 4914 INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) :: kc !< 4915 INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nxl:nxr), & 4916 INTENT(IN) :: logc !< 4917 INTEGER(iwp) :: nzt_topo_nestbc !< 4918 4919 CHARACTER(LEN=1), INTENT(IN) :: edge !< 4920 CHARACTER(LEN=1), INTENT(IN) :: var !< 4730 4921 4731 INTEGER(iwp) :: i ! :4732 INTEGER(iwp) :: iinc ! :4733 INTEGER(iwp) :: icorr ! :4734 INTEGER(iwp) :: ico ! :4735 INTEGER(iwp) :: i1 ! :4736 INTEGER(iwp) :: j ! :4737 INTEGER(iwp) :: jb ! :4738 INTEGER(iwp) :: jbgp ! :4739 INTEGER(iwp) :: k ! :4740 INTEGER(iwp) :: k_wall ! :vertical index of topography top4741 INTEGER(iwp) :: kcorr ! :4742 INTEGER(iwp) :: kco ! :4743 INTEGER(iwp) :: k1 ! :4744 INTEGER(iwp) :: l ! :4745 INTEGER(iwp) :: m ! :4746 INTEGER(iwp) :: n ! :4922 INTEGER(iwp) :: i !< 4923 INTEGER(iwp) :: iinc !< 4924 INTEGER(iwp) :: icorr !< 4925 INTEGER(iwp) :: ico !< 4926 INTEGER(iwp) :: i1 !< 4927 INTEGER(iwp) :: j !< 4928 INTEGER(iwp) :: jb !< 4929 INTEGER(iwp) :: jbgp !< 4930 INTEGER(iwp) :: k !< 4931 INTEGER(iwp) :: k_wall !< vertical index of topography top 4932 INTEGER(iwp) :: kcorr !< 4933 INTEGER(iwp) :: kco !< 4934 INTEGER(iwp) :: k1 !< 4935 INTEGER(iwp) :: l !< 4936 INTEGER(iwp) :: m !< 4937 INTEGER(iwp) :: n !< 4747 4938 4748 REAL(wp) :: coarse_dx ! :4749 REAL(wp) :: coarse_dy ! :4750 REAL(wp) :: coarse_dz ! :4751 REAL(wp) :: fk ! :4752 REAL(wp) :: fkj ! :4753 REAL(wp) :: fkjp ! :4754 REAL(wp) :: fkpj ! :4755 REAL(wp) :: fkpjp ! :4756 REAL(wp) :: fkp ! :4939 REAL(wp) :: coarse_dx !< 4940 REAL(wp) :: coarse_dy !< 4941 REAL(wp) :: coarse_dz !< 4942 REAL(wp) :: fk !< 4943 REAL(wp) :: fkj !< 4944 REAL(wp) :: fkjp !< 4945 REAL(wp) :: fkpj !< 4946 REAL(wp) :: fkpjp !< 4947 REAL(wp) :: fkp !< 4757 4948 4758 4949 ! … … 4865 5056 DO kcorr = 0, ncorr-1 4866 5057 kco = k + kcorr 4867 f(kco,j,ico) = 0.5_wp * ( logc_ratio(1,kcorr,k,i) * 4868 f(k1,j,i) 4869 + logc_ratio(2,icorr,k,i) * 5058 f(kco,j,ico) = 0.5_wp * ( logc_ratio(1,kcorr,k,i) * & 5059 f(k1,j,i) & 5060 + logc_ratio(2,icorr,k,i) * & 4870 5061 f(k,j,i1) ) 4871 5062 ENDDO … … 4918 5109 4919 5110 4920 SUBROUTINE pmci_interp_tril_t( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, 5111 SUBROUTINE pmci_interp_tril_t( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, & 4921 5112 r2z, var ) 4922 5113 … … 4928 5119 IMPLICIT NONE 4929 5120 4930 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), 4931 INTENT(INOUT) :: f ! :4932 REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), 4933 INTENT(IN) :: fc ! :4934 REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r1x ! :4935 REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r2x ! :4936 REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r1y ! :4937 REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r2y ! :4938 REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r1z ! :4939 REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r2z ! :5121 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 5122 INTENT(INOUT) :: f !< 5123 REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), & 5124 INTENT(IN) :: fc !< 5125 REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r1x !< 5126 REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r2x !< 5127 REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r1y !< 5128 REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r2y !< 5129 REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r1z !< 5130 REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r2z !< 4940 5131 4941 INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) :: ic ! :4942 INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) :: jc ! :4943 INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) :: kc ! :5132 INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) :: ic !< 5133 INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) :: jc !< 5134 INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) :: kc !< 4944 5135 4945 CHARACTER(LEN=1), INTENT(IN) :: var ! :4946 4947 INTEGER(iwp) :: i ! :4948 INTEGER(iwp) :: ib ! :4949 INTEGER(iwp) :: ie ! :4950 INTEGER(iwp) :: j ! :4951 INTEGER(iwp) :: jb ! :4952 INTEGER(iwp) :: je ! :4953 INTEGER(iwp) :: k ! :4954 INTEGER(iwp) :: l ! :4955 INTEGER(iwp) :: m ! :4956 INTEGER(iwp) :: n ! :5136 CHARACTER(LEN=1), INTENT(IN) :: var !< 5137 5138 INTEGER(iwp) :: i !< 5139 INTEGER(iwp) :: ib !< 5140 INTEGER(iwp) :: ie !< 5141 INTEGER(iwp) :: j !< 5142 INTEGER(iwp) :: jb !< 5143 INTEGER(iwp) :: je !< 5144 INTEGER(iwp) :: k !< 5145 INTEGER(iwp) :: l !< 5146 INTEGER(iwp) :: m !< 5147 INTEGER(iwp) :: n !< 4957 5148 4958 REAL(wp) :: coarse_dx ! :4959 REAL(wp) :: coarse_dy ! :4960 REAL(wp) :: coarse_dz ! :4961 REAL(wp) :: fk ! :4962 REAL(wp) :: fkj ! :4963 REAL(wp) :: fkjp ! :4964 REAL(wp) :: fkpj ! :4965 REAL(wp) :: fkpjp ! :4966 REAL(wp) :: fkp ! :5149 REAL(wp) :: coarse_dx !< 5150 REAL(wp) :: coarse_dy !< 5151 REAL(wp) :: coarse_dz !< 5152 REAL(wp) :: fk !< 5153 REAL(wp) :: fkj !< 5154 REAL(wp) :: fkjp !< 5155 REAL(wp) :: fkpj !< 5156 REAL(wp) :: fkpjp !< 5157 REAL(wp) :: fkp !< 4967 5158 4968 5159 … … 5036 5227 IMPLICIT NONE 5037 5228 5038 CHARACTER(LEN=1), INTENT(IN) :: edge ! :5039 CHARACTER(LEN=1), INTENT(IN) :: var ! :5040 5041 INTEGER(iwp) :: i ! :5042 INTEGER(iwp) :: ib ! :5043 INTEGER(iwp) :: ibgp ! :5044 INTEGER(iwp) :: ied ! :5045 INTEGER(iwp) :: j ! :5046 INTEGER(iwp) :: k ! :5047 INTEGER(iwp) :: k_wall ! :5048 5049 REAL(wp) :: outnor ! :5050 REAL(wp) :: vdotnor ! :5051 5052 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f ! :5229 CHARACTER(LEN=1), INTENT(IN) :: edge !< 5230 CHARACTER(LEN=1), INTENT(IN) :: var !< 5231 5232 INTEGER(iwp) :: i !< 5233 INTEGER(iwp) :: ib !< 5234 INTEGER(iwp) :: ibgp !< 5235 INTEGER(iwp) :: ied !< 5236 INTEGER(iwp) :: j !< 5237 INTEGER(iwp) :: k !< 5238 INTEGER(iwp) :: k_wall !< 5239 5240 REAL(wp) :: outnor !< 5241 REAL(wp) :: vdotnor !< 5242 5243 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !< 5053 5244 ! 5054 5245 !-- Check which edge is to be handled: left or right … … 5114 5305 IMPLICIT NONE 5115 5306 5116 CHARACTER(LEN=1), INTENT(IN) :: edge ! :5117 CHARACTER(LEN=1), INTENT(IN) :: var ! :5307 CHARACTER(LEN=1), INTENT(IN) :: edge !< 5308 CHARACTER(LEN=1), INTENT(IN) :: var !< 5118 5309 5119 INTEGER(iwp) :: i ! :5120 INTEGER(iwp) :: j ! :5121 INTEGER(iwp) :: jb ! :5122 INTEGER(iwp) :: jbgp ! :5123 INTEGER(iwp) :: jed ! :5124 INTEGER(iwp) :: k ! :5125 INTEGER(iwp) :: k_wall ! :5126 5127 REAL(wp) :: outnor ! :5128 REAL(wp) :: vdotnor ! :5129 5130 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f ! :5310 INTEGER(iwp) :: i !< 5311 INTEGER(iwp) :: j !< 5312 INTEGER(iwp) :: jb !< 5313 INTEGER(iwp) :: jbgp !< 5314 INTEGER(iwp) :: jed !< 5315 INTEGER(iwp) :: k !< 5316 INTEGER(iwp) :: k_wall !< 5317 5318 REAL(wp) :: outnor !< 5319 REAL(wp) :: vdotnor !< 5320 5321 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !< 5131 5322 5132 5323 ! … … 5191 5382 IMPLICIT NONE 5192 5383 5193 CHARACTER(LEN=1), INTENT(IN) :: var ! :5384 CHARACTER(LEN=1), INTENT(IN) :: var !< 5194 5385 5195 INTEGER(iwp) :: i ! :5196 INTEGER(iwp) :: j ! :5197 INTEGER(iwp) :: k ! :5198 INTEGER(iwp) :: ked ! :5199 5200 REAL(wp) :: vdotnor ! :5201 5202 REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp), 5203 INTENT(INOUT) :: f ! :5386 INTEGER(iwp) :: i !< 5387 INTEGER(iwp) :: j !< 5388 INTEGER(iwp) :: k !< 5389 INTEGER(iwp) :: ked !< 5390 5391 REAL(wp) :: vdotnor !< 5392 5393 REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp), & 5394 INTENT(INOUT) :: f !< 5204 5395 5205 5396 … … 5232 5423 5233 5424 5234 SUBROUTINE pmci_anterp_tophat( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu, 5425 SUBROUTINE pmci_anterp_tophat( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu, & 5235 5426 ijfc, kfc, var ) 5236 5427 ! … … 5351 5542 !-- Spatial under-relaxation. 5352 5543 fra = frax(ii) * fray(jj) * fraz(kk) 5353 fc(kk,jj,ii) = ( 1.0_wp - fra ) * fc(kk,jj,ii) + 5544 fc(kk,jj,ii) = ( 1.0_wp - fra ) * fc(kk,jj,ii) + & 5354 5545 fra * cellsum / REAL( nfc, KIND = wp ) 5355 5546
Note: See TracChangeset
for help on using the changeset viewer.
