Changeset 4883 for palm/trunk
- Timestamp:
- Feb 23, 2021 4:32:41 PM (4 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 4 edited
-
lagrangian_particle_model_mod.f90 (modified) (3 diffs)
-
pmc_handle_communicator_mod.f90 (modified) (9 diffs)
-
pmc_interface_mod.f90 (modified) (22 diffs)
-
pmc_particle_interface.f90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/lagrangian_particle_model_mod.f90
r4865 r4883 24 24 ! ----------------- 25 25 ! $Id$ 26 ! User switch for particle coupling added 27 ! 28 ! 4865 2021-02-03 11:51:40Z schwenkel 26 29 ! Remove unnecessary interface decalrations and public statments for private routines 27 30 ! … … 251 254 252 255 USE pmc_interface, & 253 ONLY: nested_run 256 ONLY: nested_run, particle_coupling 254 257 255 258 USE grid_variables, & … … 2253 2256 ! 2254 2257 !-- In case of nested runs do the transfer of particles after every full model time step 2255 IF ( nested_run ) THEN 2256 CALL particles_from_parent_to_child 2257 CALL particles_from_child_to_parent 2258 CALL pmcp_p_delete_particles_in_fine_grid_area 2259 2258 !-- if requested ( particle_coupling = .TRUE. ) 2259 IF ( nested_run ) THEN 2260 IF ( particle_coupling ) THEN 2261 CALL particles_from_parent_to_child 2262 CALL particles_from_child_to_parent 2263 CALL pmcp_p_delete_particles_in_fine_grid_area 2264 ENDIF 2260 2265 CALL lpm_sort_and_delete 2261 2266 -
palm/trunk/SOURCE/pmc_handle_communicator_mod.f90
r4843 r4883 25 25 ! ----------------- 26 26 ! $Id$ 27 ! User switch for particle coupling added 28 ! 29 ! 4843 2021-01-15 15:22:11Z raasch 27 30 ! local namelist parameter added to switch off the module although the respective module namelist 28 31 ! appears in the namelist file … … 146 149 !--------------------------------------------------------------------------------------------------! 147 150 SUBROUTINE pmc_init_model( comm, nesting_datatransfer_mode, nesting_mode, & 148 anterpolation_buffer_width, anterpolation_starting_height, pmc_status ) 151 anterpolation_buffer_width, anterpolation_starting_height, & 152 particle_coupling, pmc_status ) 149 153 150 154 USE control_parameters, & … … 154 158 ONLY: myid 155 159 156 160 IMPLICIT NONE 157 161 158 162 CHARACTER(LEN=7), INTENT(INOUT) :: nesting_datatransfer_mode !< … … 164 168 165 169 REAL(wp), INTENT(INOUT) :: anterpolation_starting_height !< steering parameter for canopy restricted anterpolation 170 LOGICAL, INTENT(INOUT) :: particle_coupling !< switch for particle coupling (default .TRUE.) 166 171 167 172 INTEGER :: childcount !< … … 190 195 191 196 CALL read_coupling_layout( nesting_datatransfer_mode, nesting_mode, & 192 anterpolation_buffer_width, anterpolation_starting_height, 197 anterpolation_buffer_width, anterpolation_starting_height, particle_coupling, & 193 198 pmc_status ) 194 199 … … 264 269 CALL MPI_BCAST( anterpolation_buffer_width, 1, MPI_INT, 0, MPI_COMM_WORLD, istat ) 265 270 CALL MPI_BCAST( anterpolation_starting_height, 1, MPI_REAL, 0, MPI_COMM_WORLD, istat ) 271 CALL MPI_BCAST( particle_coupling, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, istat ) 266 272 ! 267 273 !-- Assign global MPI processes to individual models by setting the couple id … … 435 441 SUBROUTINE read_coupling_layout( nesting_datatransfer_mode, nesting_mode, & 436 442 anterpolation_buffer_width, anterpolation_starting_height, & 437 p mc_status )443 particle_coupling, pmc_status ) 438 444 439 445 IMPLICIT NONE … … 446 452 447 453 REAL(wp), INTENT(INOUT) :: anterpolation_starting_height !< steering parameter for canopy restricted anterpolation 454 LOGICAL, INTENT(INOUT) :: particle_coupling !< switch for particle coupling (default .TRUE.) 448 455 449 456 INTEGER(iwp) :: bad_llcorner !< … … 462 469 nesting_datatransfer_mode, & 463 470 nesting_mode, & 464 switch_off_module 471 switch_off_module, & 472 particle_coupling 465 473 466 474 -
palm/trunk/SOURCE/pmc_interface_mod.f90
r4828 r4883 25 25 ! ----------------- 26 26 ! $Id$ 27 ! User switch for particle coupling added. Some code reformatting according to follow PALM coding standard. 28 ! Some missing doxygen comments added. 29 ! 30 ! 4828 2021-01-05 11:21:41Z Giersch 27 31 ! Bugfix in setting up the nesting configuration for chemical and aerosol species in case of more 28 32 ! than one child domain … … 456 460 457 461 INTEGER(iwp), SAVE :: comm_world_nesting !< Global nesting communicator 458 INTEGER(iwp), SAVE :: cpl_id = 1 !< 462 INTEGER(iwp), SAVE :: cpl_id = 1 !< Model (domain) id (1 for root, 2,... for nested domains). 459 463 INTEGER(iwp), SAVE :: cpl_npe_total !< 460 464 INTEGER(iwp), SAVE :: cpl_parent_id !< … … 470 474 471 475 LOGICAL, SAVE :: nested_run = .FALSE. !< general switch 476 LOGICAL, SAVE :: particle_coupling = .TRUE. !< switch for particle coupling (meaningful only when lpm is used) 472 477 LOGICAL, SAVE :: rans_mode_parent = .FALSE. !< mode of parent model (.F. - LES mode, .T. - RANS mode) 473 478 ! … … 561 566 ! 562 567 !-- Work arrays for interpolation and user-defined type definitions for horizontal work-array exchange 563 INTEGER(iwp) :: workarr_lr_exchange_type !< 564 INTEGER(iwp) :: workarr_sn_exchange_type !< 565 INTEGER(iwp) :: workarr_t_exchange_type_x !< 566 INTEGER(iwp) :: workarr_t_exchange_type_y !< 568 INTEGER(iwp) :: workarr_lr_exchange_type !< type definition for work-array exchange on left and right boundaries 569 INTEGER(iwp) :: workarr_sn_exchange_type !< type definition for work-array exchange on south and north boundaries 570 INTEGER(iwp) :: workarr_t_exchange_type_x !< type definition for work-array exchange on top boundary between left-right 571 !< neighbouring subdomains 572 INTEGER(iwp) :: workarr_t_exchange_type_y !< type definition for work-array exchange on top boundary between south-north 573 !< neighbouring subdomains 567 574 568 575 INTEGER(iwp), DIMENSION(3) :: parent_grid_info_int !< Array for communicating the parent-grid dimensions to its children. … … 572 579 !< children. 573 580 574 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarr_lr !< 575 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarr_sn !< 576 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarr_t !< 581 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarr_lr !< work array for interpolation on left and right boundaries 582 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarr_sn !< work array for interpolation on south and north boundaries 583 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarr_t !< work array for interpolation on top boundary 577 584 578 585 TYPE parentgrid_def … … 599 606 !-- Variables for particle coupling 600 607 TYPE, PUBLIC :: childgrid_def 601 INTEGER(iwp) :: nx !< 602 INTEGER(iwp) :: ny !< 603 INTEGER(iwp) :: nz !< 604 REAL(wp) :: dx !< 605 REAL(wp) :: dy !< 606 REAL(wp) :: dz !< 607 REAL(wp) :: lx_coord, lx_coord_b !< ! split onto separate lines 608 REAL(wp) :: rx_coord, rx_coord_b !< 609 REAL(wp) :: sy_coord, sy_coord_b !< 610 REAL(wp) :: ny_coord, ny_coord_b !< 611 REAL(wp) :: uz_coord, uz_coord_b !< 608 INTEGER(iwp) :: nx !< 609 INTEGER(iwp) :: ny !< 610 INTEGER(iwp) :: nz !< 611 REAL(wp) :: dx !< 612 REAL(wp) :: dy !< 613 REAL(wp) :: dz !< 614 REAL(wp) :: lx_coord !< 615 REAL(wp) :: rx_coord !< 616 REAL(wp) :: sy_coord !< 617 REAL(wp) :: ny_coord !< 618 REAL(wp) :: uz_coord !< 619 REAL(wp) :: lx_coord_b !< 620 REAL(wp) :: rx_coord_b !< 621 REAL(wp) :: sy_coord_b !< 622 REAL(wp) :: ny_coord_b !< 623 REAL(wp) :: uz_coord_b !< 612 624 END TYPE childgrid_def 613 625 … … 685 697 nesting_mode, & 686 698 parent_to_child, & 699 particle_coupling, & 687 700 rans_mode_parent 688 701 … … 711 724 IMPLICIT NONE 712 725 713 INTEGER(iwp), INTENT(OUT) :: world_comm !< 726 INTEGER(iwp), INTENT(OUT) :: world_comm !< global communicator 714 727 715 728 #if defined( __parallel ) 716 729 717 INTEGER(iwp) :: pmc_status !< 730 INTEGER(iwp) :: pmc_status !< status parameter indicating if the nesting_parameters namelist 731 !< was succesfully input or not 718 732 719 733 720 734 CALL pmc_init_model( world_comm, nesting_datatransfer_mode, nesting_mode, & 721 anterpolation_buffer_width, anterpolation_starting_height, pmc_status )722 735 anterpolation_buffer_width, anterpolation_starting_height, & 736 particle_coupling, pmc_status ) 723 737 IF ( pmc_status == pmc_no_namelist_found ) THEN 724 738 ! … … 1745 1759 IMPLICIT NONE 1746 1760 1747 INTEGER(iwp) :: i !< Child-grid index in the x-direction1748 INTEGER(iwp) :: ii !< Parent-grid index in the x-direction1749 INTEGER(iwp) :: istart !< 1750 INTEGER(iwp) :: ir !< 1751 INTEGER(iwp) :: iw !< Child-grid index limited to -1 <= iw <= nx+1 for wall_flags_total_01752 INTEGER(iwp) :: j !< Child-grid index in the y-direction1753 INTEGER(iwp) :: jj !< Parent-grid index in the y-direction1754 INTEGER(iwp) :: jstart !< 1755 INTEGER(iwp) :: jr !< 1756 INTEGER(iwp) :: jw !< Child-grid index limited to -1 <= jw <= ny+1 for wall_flags_total_01757 INTEGER(iwp) :: k !< Child-grid index in the z-direction1758 INTEGER(iwp) :: kk !< Parent-grid index in the z-direction1759 INTEGER(iwp) :: kstart !< 1760 INTEGER(iwp) :: kw !< Child-grid index limited to kw <= nzt+1 for wall_flags_total_01761 1762 REAL(wp) :: tolex !< Tolerance for grid-line matching in x-direction1763 REAL(wp) :: toley !< Tolerance for grid-line matching in y-direction1764 REAL(wp) :: tolez !< Tolerance for grid-line matching in z-direction1761 INTEGER(iwp) :: i !< child-grid index in the x-direction 1762 INTEGER(iwp) :: ii !< parent-grid index in the x-direction 1763 INTEGER(iwp) :: istart !< starting index for the index-mapping search loop in the x-direction 1764 INTEGER(iwp) :: ir !< search-loop running index in the x-direction 1765 INTEGER(iwp) :: iw !< child-grid index limited to -1 <= iw <= nx+1 for wall_flags_total_0 1766 INTEGER(iwp) :: j !< child-grid index in the y-direction 1767 INTEGER(iwp) :: jj !< parent-grid index in the y-direction 1768 INTEGER(iwp) :: jstart !< starting index for the index-mapping search loop in the y-direction 1769 INTEGER(iwp) :: jr !< search-loop running index in the y-direction 1770 INTEGER(iwp) :: jw !< child-grid index limited to -1 <= jw <= ny+1 for wall_flags_total_0 1771 INTEGER(iwp) :: k !< child-grid index in the z-direction 1772 INTEGER(iwp) :: kk !< parent-grid index in the z-direction 1773 INTEGER(iwp) :: kstart !< starting index for the index-mapping search loop in the z-direction 1774 INTEGER(iwp) :: kw !< child-grid index limited to kw <= nzt+1 for wall_flags_total_0 1775 1776 REAL(wp) :: tolex !< tolerance for grid-line matching in x-direction 1777 REAL(wp) :: toley !< tolerance for grid-line matching in y-direction 1778 REAL(wp) :: tolez !< tolerance for grid-line matching in z-direction 1765 1779 1766 1780 ! … … 2638 2652 IMPLICIT NONE 2639 2653 2640 INTEGER(iwp) :: i !< 2641 INTEGER(iwp) :: j !< 2654 INTEGER(iwp) :: i !< grid index in the x-direction 2655 INTEGER(iwp) :: j !< grid index in the y-direction 2642 2656 2643 2657 ! … … 3713 3727 IMPLICIT NONE 3714 3728 3715 INTEGER(iwp), INTENT(IN) :: direction !< Transfer direction: parent_to_child or child_to_parent3729 INTEGER(iwp), INTENT(IN) :: direction !< transfer direction: parent_to_child or child_to_parent 3716 3730 3717 3731 #if defined( __parallel ) 3718 3732 3719 REAL(wp), DIMENSION(1) :: dtl !< Time step size3733 REAL(wp), DIMENSION(1) :: dtl !< time step size 3720 3734 3721 3735 … … 4126 4140 4127 4141 IMPLICIT NONE 4128 INTEGER(iwp) :: lb !< Running index for aerosol size bins4129 INTEGER(iwp) :: lc !< Running index for aerosol mass bins4130 INTEGER(iwp) :: lg !< Running index for salsa gases4131 INTEGER(iwp) :: n !< Running index for number of chemical species4142 INTEGER(iwp) :: lb !< running index for aerosol size bins 4143 INTEGER(iwp) :: lc !< running index for aerosol mass bins 4144 INTEGER(iwp) :: lg !< running index for salsa gases 4145 INTEGER(iwp) :: n !< running index for number of chemical species 4132 4146 4133 4147 … … 4216 4230 IMPLICIT NONE 4217 4231 4218 CHARACTER(LEN=1), INTENT(IN) :: edge !< Edge symbol: 'l' or 'r'4219 CHARACTER(LEN=1), INTENT(IN) :: var !< Variable symbol: 'u', 'v', 'w' or 's'4220 4221 INTEGER(iwp), INTENT(IN) :: kct !< The parent-grid index in z-direction just below the boundary value node4222 4223 INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) :: jfl !< Indicates start index of child cells belonging to certain4232 CHARACTER(LEN=1), INTENT(IN) :: edge !< edge symbol: 'l' or 'r' 4233 CHARACTER(LEN=1), INTENT(IN) :: var !< variable symbol: 'u', 'v', 'w' or 's' 4234 4235 INTEGER(iwp), INTENT(IN) :: kct !< the parent-grid index in z-direction just below the boundary value node 4236 4237 INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) :: jfl !< indicates start index of child cells belonging to certain 4224 4238 !< parent cell - y direction 4225 INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) :: jfu !< Indicates end index of child cells belonging to certain4239 INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) :: jfu !< indicates end index of child cells belonging to certain 4226 4240 !< parent cell - y direction 4227 INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) :: kfl !< Indicates start index of child cells belonging to certain4241 INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) :: kfl !< indicates start index of child cells belonging to certain 4228 4242 !< parent cell - z direction 4229 INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) :: kfu !< Indicates end index of child cells belonging to certain4243 INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) :: kfu !< indicates end index of child cells belonging to certain 4230 4244 !< parent cell - z direction 4231 4245 … … 4236 4250 ! 4237 4251 !-- Local variables: 4238 INTEGER(iwp) :: icb !< Fixed child-grid index in the x-direction pointing to the node just behind the4252 INTEGER(iwp) :: icb !< fixed child-grid index in the x-direction pointing to the node just behind the 4239 4253 !< boundary-value node 4240 INTEGER(iwp) :: icbc !< Fixed child-grid index in the x-direction pointing to the boundary-value nodes4241 INTEGER(iwp) :: icbgp !< Index running over the redundant boundary ghost points in the x-direction4254 INTEGER(iwp) :: icbc !< fixed child-grid index in the x-direction pointing to the boundary-value nodes 4255 INTEGER(iwp) :: icbgp !< index running over the redundant boundary ghost points in the x-direction 4242 4256 INTEGER(iwp) :: ierr !< MPI error code 4243 INTEGER(iwp) :: ipbeg !< Parent-grid index in the x-direction pointing to the starting point of workarr_lr4257 INTEGER(iwp) :: ipbeg !< parent-grid index in the x-direction pointing to the starting point of workarr_lr 4244 4258 !< in the parent-grid array 4245 INTEGER(iwp) :: ipw !< Reduced parent-grid index in the x-direction for workarr_lr pointing to4259 INTEGER(iwp) :: ipw !< reduced parent-grid index in the x-direction for workarr_lr pointing to 4246 4260 !< the boundary ghost node 4247 INTEGER(iwp) :: ipwp !< Reduced parent-grid index in the x-direction for workarr_lr pointing to4261 INTEGER(iwp) :: ipwp !< reduced parent-grid index in the x-direction for workarr_lr pointing to 4248 4262 !< the first prognostic node 4249 INTEGER(iwp) :: jc !< Running child-grid index in the y-direction 4250 INTEGER(iwp) :: jp !< Running parent-grid index in the y-direction 4251 INTEGER(iwp) :: kc !< Running child-grid index in the z-direction 4252 INTEGER(iwp) :: kp !< Running parent-grid index in the z-direction 4253 4254 REAL(wp) :: cb !< Interpolation coefficient for the boundary ghost node 4255 REAL(wp) :: cp !< Interpolation coefficient for the first prognostic node 4256 REAL(wp) :: c_interp_1 !< Value interpolated to the flux point in x direction from the parent-grid data 4257 REAL(wp) :: c_interp_2 !< Auxiliary value interpolated to the flux point in x direction from the parent-grid data 4263 INTEGER(iwp) :: jc !< running child-grid index in the y-direction 4264 INTEGER(iwp) :: jp !< running parent-grid index in the y-direction 4265 INTEGER(iwp) :: kc !< running child-grid index in the z-direction 4266 INTEGER(iwp) :: kp !< running parent-grid index in the z-direction 4267 4268 REAL(wp) :: cb !< interpolation coefficient for the boundary ghost node 4269 REAL(wp) :: cp !< interpolation coefficient for the first prognostic node 4270 REAL(wp) :: c_interp_1 !< value interpolated to the flux point in x direction from the parent-grid data 4271 REAL(wp) :: c_interp_2 !< auxiliary value interpolated to the flux point in x direction from the parent-grid data 4272 4258 4273 ! 4259 4274 !-- Check which edge is to be handled … … 4453 4468 IMPLICIT NONE 4454 4469 4455 CHARACTER(LEN=1), INTENT(IN) :: edge !< Edge symbol: 's' or 'n'4456 CHARACTER(LEN=1), INTENT(IN) :: var !< Variable symbol: 'u', 'v', 'w' or 's'4457 4458 INTEGER(iwp), INTENT(IN) :: kct !< The parent-grid index in z-direction just below the boundary value node4459 4460 INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) :: ifl !< Indicates start index of child cells belonging to certain4470 CHARACTER(LEN=1), INTENT(IN) :: edge !< edge symbol: 's' or 'n' 4471 CHARACTER(LEN=1), INTENT(IN) :: var !< variable symbol: 'u', 'v', 'w' or 's' 4472 4473 INTEGER(iwp), INTENT(IN) :: kct !< the parent-grid index in z-direction just below the boundary value node 4474 4475 INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) :: ifl !< indicates start index of child cells belonging to certain 4461 4476 !< parent cell - x direction 4462 INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) :: ifu !< Indicates end index of child cells belonging to certain4477 INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) :: ifu !< indicates end index of child cells belonging to certain 4463 4478 !< parent cell - x direction 4464 INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) :: kfl !< Indicates start index of child cells belonging to certain4479 INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) :: kfl !< indicates start index of child cells belonging to certain 4465 4480 !< parent cell - z direction 4466 INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) :: kfu !< Indicates end index of child cells belonging to certain4481 INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) :: kfu !< indicates end index of child cells belonging to certain 4467 4482 !< parent cell - z direction 4468 4483 … … 4472 4487 ! 4473 4488 !-- Local variables: 4474 INTEGER(iwp) :: ic !< Running child-grid index in the x-direction4489 INTEGER(iwp) :: ic !< running child-grid index in the x-direction 4475 4490 INTEGER(iwp) :: ierr !< MPI error code 4476 INTEGER(iwp) :: ip !< Running parent-grid index in the x-direction4477 INTEGER(iwp) :: jcb !< Fixed child-grid index in the y-direction pointing to the node just behind the4491 INTEGER(iwp) :: ip !< running parent-grid index in the x-direction 4492 INTEGER(iwp) :: jcb !< fixed child-grid index in the y-direction pointing to the node just behind the 4478 4493 !< boundary-value node 4479 INTEGER(iwp) :: jcbc !< Fixed child-grid index in the y-direction pointing to the boundary-value nodes4480 INTEGER(iwp) :: jcbgp !< Index running over the redundant boundary ghost points in y-direction4481 INTEGER(iwp) :: jpbeg !< Parent-grid index in the y-direction pointing to the starting point of workarr_sn4494 INTEGER(iwp) :: jcbc !< fixed child-grid index in the y-direction pointing to the boundary-value nodes 4495 INTEGER(iwp) :: jcbgp !< index running over the redundant boundary ghost points in y-direction 4496 INTEGER(iwp) :: jpbeg !< parent-grid index in the y-direction pointing to the starting point of workarr_sn 4482 4497 !< in the parent-grid array 4483 INTEGER(iwp) :: jpw !< Reduced parent-grid index in the y-direction for workarr_sn pointing to4498 INTEGER(iwp) :: jpw !< reduced parent-grid index in the y-direction for workarr_sn pointing to 4484 4499 !< the boundary ghost node 4485 INTEGER(iwp) :: jpwp !< Reduced parent-grid index in the y-direction for workarr_sn pointing to4500 INTEGER(iwp) :: jpwp !< reduced parent-grid index in the y-direction for workarr_sn pointing to 4486 4501 !< the first prognostic node 4487 INTEGER(iwp) :: kc !< Running child-grid index in the z-direction 4488 INTEGER(iwp) :: kp !< Running parent-grid index in the z-direction 4489 4490 REAL(wp) :: cb !< Interpolation coefficient for the boundary ghost node 4491 REAL(wp) :: cp !< Interpolation coefficient for the first prognostic node 4492 REAL(wp) :: c_interp_1 !< Value interpolated to the flux point in x direction from the parent-grid data 4493 REAL(wp) :: c_interp_2 !< Auxiliary value interpolated to the flux point in x direction from the parent-grid data 4494 4502 INTEGER(iwp) :: kc !< running child-grid index in the z-direction 4503 INTEGER(iwp) :: kp !< running parent-grid index in the z-direction 4504 4505 REAL(wp) :: cb !< interpolation coefficient for the boundary ghost node 4506 REAL(wp) :: cp !< interpolation coefficient for the first prognostic node 4507 REAL(wp) :: c_interp_1 !< value interpolated to the flux point in x direction from the parent-grid data 4508 REAL(wp) :: c_interp_2 !< auxiliary value interpolated to the flux point in x direction from the parent-grid data 4495 4509 4496 4510 ! … … 4692 4706 IMPLICIT NONE 4693 4707 4694 CHARACTER(LEN=1), INTENT(IN) :: var !< Variable symbol: 'u', 'v', 'w' or 's'4695 4696 INTEGER(iwp), INTENT(IN) :: kct !< The parent-grid index in z-direction just below the boundary value node4697 4698 INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) :: ifl !< Indicates start index of child cells belonging to certain4708 CHARACTER(LEN=1), INTENT(IN) :: var !< variable symbol: 'u', 'v', 'w' or 's' 4709 4710 INTEGER(iwp), INTENT(IN) :: kct !< the parent-grid index in z-direction just below the boundary value node 4711 4712 INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) :: ifl !< indicates start index of child cells belonging to certain 4699 4713 !< parent cell - x direction 4700 INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) :: ifu !< Indicates end index of child cells belonging to certain4714 INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) :: ifu !< indicates end index of child cells belonging to certain 4701 4715 !< parent cell - x direction 4702 INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) :: jfl !< Indicates start index of child cells belonging to certain4716 INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) :: jfl !< indicates start index of child cells belonging to certain 4703 4717 !< parent cell - y direction 4704 INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) :: jfu !< Indicates end index of child cells belonging to certain4718 INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) :: jfu !< indicates end index of child cells belonging to certain 4705 4719 !< parent cell - y direction 4706 4720 … … 4709 4723 REAL(wp), DIMENSION(0:pg%nz+1,jps:jpn,ipl:ipr), INTENT(IN) :: parent_array !< Parent-grid array 4710 4724 4711 4712 4725 ! 4713 4726 !-- Local variables: 4714 INTEGER(iwp) :: ic !< Running child-grid index in the x-direction4727 INTEGER(iwp) :: ic !< running child-grid index in the x-direction 4715 4728 INTEGER(iwp) :: ierr !< MPI error code 4716 INTEGER(iwp) :: iplc !< Lower parent-grid index limit in the x-direction for copying parent-grid4729 INTEGER(iwp) :: iplc !< lower parent-grid index limit in the x-direction for copying parent-grid 4717 4730 !< array data to workarr_t 4718 INTEGER(iwp) :: iprc !< Upper parent-grid index limit in the x-direction for copying parent-grid4731 INTEGER(iwp) :: iprc !< upper parent-grid index limit in the x-direction for copying parent-grid 4719 4732 !< array data to workarr_t 4720 INTEGER(iwp) :: jc !< Running child-grid index in the y-direction4721 INTEGER(iwp) :: jpsc !< Lower parent-grid index limit in the y-direction for copying parent-grid4733 INTEGER(iwp) :: jc !< running child-grid index in the y-direction 4734 INTEGER(iwp) :: jpsc !< lower parent-grid index limit in the y-direction for copying parent-grid 4722 4735 !< array data to workarr_t 4723 INTEGER(iwp) :: jpnc !< Upper parent-grid-index limit in the y-direction for copying parent-grid4736 INTEGER(iwp) :: jpnc !< upper parent-grid-index limit in the y-direction for copying parent-grid 4724 4737 !< array data to workarr_t 4725 INTEGER(iwp) :: kc !< Vertical child-grid index fixed to the boundary-value level4726 INTEGER(iwp) :: ip !< Running parent-grid index in the x-direction4727 INTEGER(iwp) :: jp !< Running parent-grid index in the y-direction4728 INTEGER(iwp) :: kpw !< Reduced parent-grid index in the z-direction for workarr_t pointing to4738 INTEGER(iwp) :: kc !< vertical child-grid index fixed to the boundary-value level 4739 INTEGER(iwp) :: ip !< running parent-grid index in the x-direction 4740 INTEGER(iwp) :: jp !< running parent-grid index in the y-direction 4741 INTEGER(iwp) :: kpw !< reduced parent-grid index in the z-direction for workarr_t pointing to 4729 4742 !< the boundary ghost node 4730 4743 4731 REAL(wp) :: c31 !< Interpolation coefficient for the 3rd-order WS scheme4732 REAL(wp) :: c32 !< Interpolation coefficient for the 3rd-order WS scheme4733 REAL(wp) :: c33 !< Interpolation coefficient for the 3rd-order WS scheme4734 REAL(wp) :: c_interp_1 !< Value interpolated to the flux point in z direction from the parent-grid data4735 REAL(wp) :: c_interp_2 !< Auxiliary value interpolated to the flux point in z direction from the parent-grid data4744 REAL(wp) :: c31 !< interpolation coefficient for the 3rd-order WS scheme 4745 REAL(wp) :: c32 !< interpolation coefficient for the 3rd-order WS scheme 4746 REAL(wp) :: c33 !< interpolation coefficient for the 3rd-order WS scheme 4747 REAL(wp) :: c_interp_1 !< value interpolated to the flux point in z direction from the parent-grid data 4748 REAL(wp) :: c_interp_2 !< auxiliary value interpolated to the flux point in z direction from the parent-grid data 4736 4749 4737 4750 … … 4964 4977 IMPLICIT NONE 4965 4978 4966 CHARACTER(LEN=*), INTENT(IN) :: var !< Variable symbol: 'u', 'v', 'w' or 's'4967 4968 INTEGER(iwp), INTENT(IN) :: kct !< Top boundary index for anterpolation along z4979 CHARACTER(LEN=*), INTENT(IN) :: var !< variable symbol: 'u', 'v', 'w' or 's' 4980 4981 INTEGER(iwp), INTENT(IN) :: kct !< top boundary index for anterpolation along z 4969 4982 4970 4983 INTEGER(iwp), DIMENSION(0:pg%nz+1,jpsa:jpna,ipla:ipra), INTENT(IN) :: ijkfc !< number of child grid points contributing 4971 4984 !< to a parent grid box 4972 INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) :: ifl !< Indicates start index of child cells belonging to certain4985 INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) :: ifl !< indicates start index of child cells belonging to certain 4973 4986 !< parent cell - x direction 4974 INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) :: ifu !< Indicates end index of child cells belonging to certain4987 INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) :: ifu !< indicates end index of child cells belonging to certain 4975 4988 !< parent cell - x direction 4976 INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) :: jfl !< Indicates start index of child cells belonging to certain4989 INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) :: jfl !< indicates start index of child cells belonging to certain 4977 4990 !< parent cell - y direction 4978 INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) :: jfu !< Indicates end index of child cells belonging to certain4991 INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) :: jfu !< indicates end index of child cells belonging to certain 4979 4992 !< parent cell - y direction 4980 INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) :: kfl !< Indicates start index of child cells belonging to certain4993 INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) :: kfl !< indicates start index of child cells belonging to certain 4981 4994 !< parent cell - z direction 4982 INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) :: kfu !< Indicates end index of child cells belonging to certain4995 INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) :: kfu !< indicates end index of child cells belonging to certain 4983 4996 !< parent cell - z direction 4984 4997 4985 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) :: child_array !< Child-grid array4986 4987 REAL(wp), DIMENSION(0:pg%nz+1,jps:jpn,ipl:ipr), INTENT(INOUT) :: parent_array !< Parent-grid array4998 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) :: child_array !< child-grid array 4999 5000 REAL(wp), DIMENSION(0:pg%nz+1,jps:jpn,ipl:ipr), INTENT(INOUT) :: parent_array !< parent-grid array 4988 5001 4989 5002 ! 4990 5003 !-- Local variables: 4991 INTEGER(iwp) :: ic !< Running index x-direction - child grid4992 INTEGER(iwp) :: ip !< Running index x-direction - parent grid4993 INTEGER(iwp) :: ipl_anterp !< Left boundary index for anterpolation along x4994 INTEGER(iwp) :: ipr_anterp !< Right boundary index for anterpolation along x4995 INTEGER(iwp) :: jc !< Running index y-direction - child grid4996 INTEGER(iwp) :: jp !< Running index y-direction - parent grid4997 INTEGER(iwp) :: jpn_anterp !< North boundary index for anterpolation along y4998 INTEGER(iwp) :: jps_anterp !< South boundary index for anterpolation along y4999 INTEGER(iwp) :: kc !< Running index z-direction - child grid5000 INTEGER(iwp) :: kp !< Running index z-direction - parent grid5001 INTEGER(iwp) :: kpt_anterp !< Top boundary index for anterpolation along z5004 INTEGER(iwp) :: ic !< running index x-direction - child grid 5005 INTEGER(iwp) :: ip !< running index x-direction - parent grid 5006 INTEGER(iwp) :: ipl_anterp !< left boundary index for anterpolation along x 5007 INTEGER(iwp) :: ipr_anterp !< right boundary index for anterpolation along x 5008 INTEGER(iwp) :: jc !< running index y-direction - child grid 5009 INTEGER(iwp) :: jp !< running index y-direction - parent grid 5010 INTEGER(iwp) :: jpn_anterp !< north boundary index for anterpolation along y 5011 INTEGER(iwp) :: jps_anterp !< south boundary index for anterpolation along y 5012 INTEGER(iwp) :: kc !< running index z-direction - child grid 5013 INTEGER(iwp) :: kp !< running index z-direction - parent grid 5014 INTEGER(iwp) :: kpt_anterp !< top boundary index for anterpolation along z 5002 5015 INTEGER(iwp) :: var_flag !< bit number used to flag topography on respective grid 5003 5016 5004 REAL(wp) :: cellsum !< Sum of respective child cells belonging to parent cell5017 REAL(wp) :: cellsum !< sum of respective child cells belonging to parent cell 5005 5018 5006 5019 ! … … 5092 5105 IMPLICIT NONE 5093 5106 5094 INTEGER(iwp) :: ic !< Index along x-direction5095 INTEGER(iwp) :: jc !< Index along y-direction5096 INTEGER(iwp) :: kc !< Index along z-direction5097 INTEGER(iwp) :: lb !< Running index for aerosol size bins5098 INTEGER(iwp) :: lc !< Running index for aerosol mass bins5099 INTEGER(iwp) :: lg !< Running index for salsa gases5100 INTEGER(iwp) :: m !< Running index for surface type5101 INTEGER(iwp) :: n !< Running index for number of chemical species5107 INTEGER(iwp) :: ic !< index along x-direction 5108 INTEGER(iwp) :: jc !< index along y-direction 5109 INTEGER(iwp) :: kc !< index along z-direction 5110 INTEGER(iwp) :: lb !< running index for aerosol size bins 5111 INTEGER(iwp) :: lc !< running index for aerosol mass bins 5112 INTEGER(iwp) :: lg !< running index for salsa gases 5113 INTEGER(iwp) :: m !< running index for surface type 5114 INTEGER(iwp) :: n !< running index for number of chemical species 5102 5115 5103 5116 … … 5307 5320 IMPLICIT NONE 5308 5321 5309 INTEGER(iwp) :: i !< Running index in the x-direction5322 INTEGER(iwp) :: i !< running index in the x-direction 5310 5323 INTEGER(iwp) :: ierr !< MPI error code 5311 INTEGER(iwp) :: j !< Running index in the y-direction 5312 INTEGER(iwp) :: k !< Running index in the z-direction 5313 INTEGER(iwp) :: n !< Running index over the boundary faces: l, r, s, n and t 5314 5315 REAL(wp) :: dxdy !< Surface area of grid cell top face 5316 REAL(wp) :: innor !< Inner normal vector of the grid cell face 5317 REAL(wp) :: sub_sum !< Intermediate sum for reducing the loss of signifigant digits in 2-D summations 5318 REAL(wp) :: u_corr_left !< Correction added to the left boundary value of u 5319 REAL(wp) :: u_corr_right !< Correction added to the right boundary value of u 5320 REAL(wp) :: v_corr_south !< Correction added to the south boundary value of v 5321 REAL(wp) :: v_corr_north !< Correction added to the north boundary value of v 5322 REAL(wp) :: volume_flux_integral !< Surface integral of volume flux over the domain boundaries 5323 REAL(wp) :: volume_flux_local !< Surface integral of volume flux over the subdomain boundary face 5324 REAL(wp) :: w_corr_top !< Correction added to the top boundary value of w 5325 5326 REAL(wp), DIMENSION(5) :: volume_flux !< Surface integral of volume flux over each boundary face of the domain 5327 5324 INTEGER(iwp) :: j !< running index in the y-direction 5325 INTEGER(iwp) :: k !< running index in the z-direction 5326 INTEGER(iwp) :: n !< running index over the boundary faces: l, r, s, n and t 5327 5328 REAL(wp) :: dxdy !< surface area of grid cell top face 5329 REAL(wp) :: innor !< inner normal vector of the grid cell face 5330 REAL(wp) :: sub_sum !< intermediate sum for reducing the loss of signifigant digits in 2-D summations 5331 REAL(wp) :: u_corr_left !< correction added to the left boundary value of u 5332 REAL(wp) :: u_corr_right !< correction added to the right boundary value of u 5333 REAL(wp) :: v_corr_south !< correction added to the south boundary value of v 5334 REAL(wp) :: v_corr_north !< correction added to the north boundary value of v 5335 REAL(wp) :: volume_flux_integral !< surface integral of volume flux over the domain boundaries 5336 REAL(wp) :: volume_flux_local !< surface integral of volume flux over the subdomain boundary face 5337 REAL(wp) :: w_corr_top !< correction added to the top boundary value of w 5338 5339 REAL(wp), DIMENSION(5) :: volume_flux !< surface integral of volume flux over each boundary face of the domain 5328 5340 5329 5341 ! … … 5534 5546 IMPLICIT NONE 5535 5547 5536 INTEGER(iwp) :: i !< Running index in the x-direction5548 INTEGER(iwp) :: i !< running index in the x-direction 5537 5549 INTEGER(iwp) :: ierr !< MPI error code 5538 INTEGER(iwp) :: j !< Running index in the y-direction5539 INTEGER(iwp) :: k !< Running index in the z-direction5540 5541 REAL(wp) :: dxdy !< Surface area of grid cell top face5542 REAL(wp) :: sub_sum !< Intermediate sum for reducing the loss of signifigant digits in 2-D summations5543 REAL(wp) :: top_area !< Top boundary face area5544 REAL(wp) :: volume_flux !< Surface integral of volume flux over the top boundary face5545 REAL(wp) :: volume_flux_local !< Surface integral of volume flux over the subdomain boundary face5546 REAL(wp) :: w_corr_top !< Correction added to the top boundary value of w5550 INTEGER(iwp) :: j !< running index in the y-direction 5551 INTEGER(iwp) :: k !< running index in the z-direction 5552 5553 REAL(wp) :: dxdy !< surface area of grid cell top face 5554 REAL(wp) :: sub_sum !< intermediate sum for reducing the loss of signifigant digits in 2-D summations 5555 REAL(wp) :: top_area !< top boundary face area 5556 REAL(wp) :: volume_flux !< surface integral of volume flux over the top boundary face 5557 REAL(wp) :: volume_flux_local !< surface integral of volume flux over the subdomain boundary face 5558 REAL(wp) :: w_corr_top !< correction added to the top boundary value of w 5547 5559 5548 5560 -
palm/trunk/SOURCE/pmc_particle_interface.f90
r4828 r4883 1 MODULE pmc_particle_interface2 1 !--------------------------------------------------------------------------------------------------! 3 2 ! This file is part of the PALM model system. … … 25 24 ! ----------------- 26 25 ! $Id$ 26 ! User switch for particle coupling added. Some code reformatting according to follow PALM coding standard. 27 ! 28 ! 4828 2021-01-05 11:21:41Z Giersch 27 29 ! File re-formatted to follow the PALM coding standard 28 30 ! … … 59 61 ! Interface to palm lpm model to handel particle transfer between parent and child model. 60 62 !--------------------------------------------------------------------------------------------------! 61 #if defined( __parallel ) 62 63 USE, INTRINSIC :: ISO_C_BINDING 64 65 USE MPI 66 67 USE kinds 68 69 USE pegrid, & 70 ONLY: myidx, & 71 myidy 72 73 USE indices, & 74 ONLY: nbgp, & 75 nx, & 76 nxl, & 77 nxr, & 78 nxlg, & 79 nxrg, & 80 ny, & 81 nys, & 82 nyn, & 83 nysg, & 84 nyng, & 85 nzb, & 86 nzt 87 88 89 USE grid_variables, & 90 ONLY: dx, & 91 dy 92 93 USE arrays_3d, & 94 ONLY: zw 95 96 USE control_parameters, & 97 ONLY: message_string 98 99 USE particle_attributes, & 100 ONLY: alloc_factor, & 101 grid_particles, & 102 ibc_par_lr, & 103 ibc_par_ns, & 104 ibc_par_t, & 105 particles, & 106 particle_type, & 107 prt_count, & 108 number_of_particles, & 109 zero_particle 110 111 112 113 114 115 ! USE lpm_pack_and_sort_mod 116 117 #if defined( __parallel ) 118 USE pmc_general, & 119 ONLY: pedef 120 121 USE pmc_parent, & 122 ONLY: children, & 123 pmc_s_fillbuffer, & 124 pmc_s_getdata_from_buffer, & 125 pmc_s_get_child_npes 126 127 USE pmc_child, & 128 ONLY: me, & 129 pmc_c_getbuffer, & 130 pmc_c_putbuffer 131 132 USE pmc_interface, & 133 ONLY: coord_x, & 134 coord_y, & 135 cpl_id, & 136 get_childid, & 137 get_child_edges, & 138 get_child_gridspacing, & 139 get_number_of_children, & 140 lower_left_coord_x, & 141 lower_left_coord_y, & 142 nr_part, & 143 nr_partc, & 144 parent_bound, & 145 part_adr, & 146 part_adrc, & 147 pg, & 148 nested_run 149 150 151 USE pmc_handle_communicator, & 152 ONLY: pmc_parent_for_child 153 154 USE pmc_mpi_wrapper, & 155 ONLY: pmc_recv_from_child, & 156 pmc_send_to_parent 157 158 #endif 159 160 IMPLICIT NONE 161 162 163 PRIVATE 164 SAVE 165 166 TYPE coarse_particle_def 167 INTEGER(iwp) :: nr_particle !< 168 169 TYPE(particle_type),ALLOCATABLE,DIMENSION(:) :: parent_particles !< 170 END TYPE coarse_particle_def 171 172 INTEGER(iwp),PARAMETER :: max_nr_particle_in_rma_win = 100000 !< 173 INTEGER(iwp),PARAMETER :: min_particles_per_column = 100 !< 174 175 176 INTEGER(iwp) :: nr_fine_in_coarse !< Number of fine grid cells in coarse grid (one direction) 177 INTEGER(iwp) :: particle_win_child !< 178 179 INTEGER(iwp),ALLOCATABLE,DIMENSION(:) :: particle_win_parent !< 180 181 TYPE(C_PTR), ALLOCATABLE,DIMENSION(:) :: buf_ptr !< 182 183 TYPE(particle_type), DIMENSION(:),POINTER :: particle_in_win !< 184 185 TYPE(coarse_particle_def),ALLOCATABLE,DIMENSION(:,:) :: coarse_particles !< 186 187 188 189 INTERFACE pmcp_g_init 190 MODULE PROCEDURE pmcp_g_init 191 END INTERFACE pmcp_g_init 192 193 INTERFACE pmcp_g_alloc_win 194 MODULE PROCEDURE pmcp_g_alloc_win 195 END INTERFACE pmcp_g_alloc_win 196 197 INTERFACE pmcp_c_get_particle_from_parent 198 MODULE PROCEDURE pmcp_c_get_particle_from_parent 199 END INTERFACE pmcp_c_get_particle_from_parent 200 201 INTERFACE pmcp_c_send_particle_to_parent 202 MODULE PROCEDURE pmcp_c_send_particle_to_parent 203 END INTERFACE pmcp_c_send_particle_to_parent 204 205 INTERFACE pmcp_p_fill_particle_win 206 MODULE PROCEDURE pmcp_p_fill_particle_win 207 END INTERFACE pmcp_p_fill_particle_win 208 209 INTERFACE pmcp_p_empty_particle_win 210 MODULE PROCEDURE pmcp_p_empty_particle_win 211 END INTERFACE pmcp_p_empty_particle_win 212 213 INTERFACE pmcp_g_print_number_of_particles 214 MODULE PROCEDURE pmcp_g_print_number_of_particles 215 END INTERFACE pmcp_g_print_number_of_particles 216 217 INTERFACE pmcp_p_delete_particles_in_fine_grid_area 218 MODULE PROCEDURE pmcp_p_delete_particles_in_fine_grid_area 219 END INTERFACE pmcp_p_delete_particles_in_fine_grid_area 220 221 PUBLIC pmcp_g_init, pmcp_g_alloc_win, pmcp_c_get_particle_from_parent 222 PUBLIC pmcp_c_send_particle_to_parent, pmcp_p_fill_particle_win, pmcp_g_print_number_of_particles 223 PUBLIC pmcp_p_empty_particle_win, pmcp_p_delete_particles_in_fine_grid_area 63 MODULE pmc_particle_interface 64 65 #if defined( __parallel ) 66 67 USE, INTRINSIC :: ISO_C_BINDING 68 69 USE MPI 70 71 USE kinds 72 73 USE pegrid, & 74 ONLY: myidx, & 75 myidy 76 77 USE indices, & 78 ONLY: nbgp, & 79 nx, & 80 nxl, & 81 nxr, & 82 nxlg, & 83 nxrg, & 84 ny, & 85 nys, & 86 nyn, & 87 nysg, & 88 nyng, & 89 nzb, & 90 nzt 91 92 USE grid_variables, & 93 ONLY: dx, & 94 dy 95 96 USE arrays_3d, & 97 ONLY: zw 98 99 USE control_parameters, & 100 ONLY: message_string 101 102 USE particle_attributes, & 103 ONLY: alloc_factor, & 104 grid_particles, & 105 ibc_par_lr, & 106 ibc_par_ns, & 107 ibc_par_t, & 108 particles, & 109 particle_type, & 110 prt_count, & 111 number_of_particles, & 112 zero_particle 113 114 ! USE lpm_pack_and_sort_mod 115 116 #if defined( __parallel ) 117 USE pmc_general, & 118 ONLY: pedef 119 120 USE pmc_parent, & 121 ONLY: children, & 122 pmc_s_fillbuffer, & 123 pmc_s_getdata_from_buffer, & 124 pmc_s_get_child_npes 125 126 USE pmc_child, & 127 ONLY: me, & 128 pmc_c_getbuffer, & 129 pmc_c_putbuffer 130 131 USE pmc_interface, & 132 ONLY: coord_x, & 133 coord_y, & 134 cpl_id, & 135 get_childid, & 136 get_child_edges, & 137 get_child_gridspacing, & 138 get_number_of_children, & 139 lower_left_coord_x, & 140 lower_left_coord_y, & 141 nested_run, & 142 nr_part, & 143 nr_partc, & 144 parent_bound, & 145 particle_coupling, & 146 part_adr, & 147 part_adrc, & 148 pg 149 150 USE pmc_handle_communicator, & 151 ONLY: pmc_parent_for_child 152 153 USE pmc_mpi_wrapper, & 154 ONLY: pmc_recv_from_child, & 155 pmc_send_to_parent 156 157 #endif 158 159 IMPLICIT NONE 160 161 PRIVATE 162 SAVE 163 164 TYPE coarse_particle_def 165 INTEGER(iwp) :: nr_particle !< 166 167 TYPE(particle_type),ALLOCATABLE,DIMENSION(:) :: parent_particles !< 168 END TYPE coarse_particle_def 169 170 INTEGER(iwp),PARAMETER :: max_nr_particle_in_rma_win = 100000 !< 171 INTEGER(iwp),PARAMETER :: min_particles_per_column = 100 !< 172 173 174 INTEGER(iwp) :: nr_fine_in_coarse !< Number of fine grid cells in coarse grid (one direction) 175 INTEGER(iwp) :: particle_win_child !< 176 177 INTEGER(iwp),ALLOCATABLE,DIMENSION(:) :: particle_win_parent !< 178 179 TYPE(C_PTR), ALLOCATABLE,DIMENSION(:) :: buf_ptr !< 180 181 TYPE(particle_type), DIMENSION(:),POINTER :: particle_in_win !< 182 183 TYPE(coarse_particle_def),ALLOCATABLE,DIMENSION(:,:) :: coarse_particles !< 184 185 INTERFACE pmcp_g_init 186 MODULE PROCEDURE pmcp_g_init 187 END INTERFACE pmcp_g_init 188 189 INTERFACE pmcp_g_alloc_win 190 MODULE PROCEDURE pmcp_g_alloc_win 191 END INTERFACE pmcp_g_alloc_win 192 193 INTERFACE pmcp_c_get_particle_from_parent 194 MODULE PROCEDURE pmcp_c_get_particle_from_parent 195 END INTERFACE pmcp_c_get_particle_from_parent 196 197 INTERFACE pmcp_c_send_particle_to_parent 198 MODULE PROCEDURE pmcp_c_send_particle_to_parent 199 END INTERFACE pmcp_c_send_particle_to_parent 200 201 INTERFACE pmcp_p_fill_particle_win 202 MODULE PROCEDURE pmcp_p_fill_particle_win 203 END INTERFACE pmcp_p_fill_particle_win 204 205 INTERFACE pmcp_p_empty_particle_win 206 MODULE PROCEDURE pmcp_p_empty_particle_win 207 END INTERFACE pmcp_p_empty_particle_win 208 209 INTERFACE pmcp_g_print_number_of_particles 210 MODULE PROCEDURE pmcp_g_print_number_of_particles 211 END INTERFACE pmcp_g_print_number_of_particles 212 213 INTERFACE pmcp_p_delete_particles_in_fine_grid_area 214 MODULE PROCEDURE pmcp_p_delete_particles_in_fine_grid_area 215 END INTERFACE pmcp_p_delete_particles_in_fine_grid_area 216 217 PUBLIC pmcp_g_init, pmcp_g_alloc_win, pmcp_c_get_particle_from_parent 218 PUBLIC pmcp_c_send_particle_to_parent, pmcp_p_fill_particle_win, pmcp_g_print_number_of_particles 219 PUBLIC pmcp_p_empty_particle_win, pmcp_p_delete_particles_in_fine_grid_area 224 220 225 221 CONTAINS … … 249 245 part_adr = 0 250 246 ENDIF 251 252 247 ! 253 248 !-- Set the boundary conditions to nested for all non root (i.e child) models 254 249 IF ( cpl_id > 1 ) THEN 255 256 IF ( ibc_par_t /= 3 ) THEN 257 ibc_par_t = 3 258 message_string = 'In Child model: ibc_par_t is automatically set to nested ' 259 CALL message( 'pmcp_g_init ', 'PA0477', 0, 1, 0, 6, 0 ) 250 IF ( particle_coupling ) THEN 251 IF ( ibc_par_t /= 3 ) THEN 252 ibc_par_t = 3 253 message_string = 'In Child model: ibc_par_t is automatically set to nested ' 254 CALL message( 'pmcp_g_init ', 'PA0477', 0, 1, 0, 6, 0 ) 255 ENDIF 256 257 IF ( ibc_par_lr /= 3 ) THEN 258 ibc_par_lr = 3 259 message_string = 'In Child model: ibc_par_lr is automatically set to nested ' 260 CALL message( 'pmcp_g_init ', 'PA0478', 0, 1, 0, 6, 0 ) 261 ENDIF 262 263 IF ( ibc_par_ns /= 3 ) THEN 264 ibc_par_ns = 3 265 message_string = 'In Child model: ibc_par_ns is automatically set to nested ' 266 CALL message( 'pmcp_g_init ', 'PA0479', 0, 1, 0, 6, 0 ) 267 ENDIF 260 268 ENDIF 261 269 262 IF ( ibc_par_lr /= 3 ) THEN263 ibc_par_lr = 3264 message_string = 'In Child model: ibc_par_lr is automatically set to nested '265 CALL message( 'pmcp_g_init ', 'PA0478', 0, 1, 0, 6, 0 )266 ENDIF267 268 IF ( ibc_par_ns /= 3 ) THEN269 ibc_par_ns = 3270 message_string = 'In Child model: ibc_par_ns is automatically set to nested '271 CALL message( 'pmcp_g_init ', 'PA0479', 0, 1, 0, 6, 0 )272 ENDIF273 274 270 ENDIF 275 271 276 272 #endif 277 273 END SUBROUTINE pmcp_g_init 274 275 278 276 !--------------------------------------------------------------------------------------------------! 279 277 ! Description:
Note: See TracChangeset
for help on using the changeset viewer.
