Changeset 4457 for palm/trunk/SOURCE/exchange_horiz_mod.f90
- Timestamp:
- Mar 11, 2020 2:20:43 PM (13 months ago)
- File:
-
- 1 moved
-
palm/trunk/SOURCE/exchange_horiz_mod.f90 (moved) (moved from palm/trunk/SOURCE/exchange_horiz.f90) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/exchange_horiz_mod.f90
r4456 r4457 25 25 ! ----------------- 26 26 ! $Id$ 27 ! routine has been modularized, file exchange_horiz_2d has been merged 28 ! 29 ! 4429 2020-02-27 15:24:30Z raasch 27 30 ! bugfix: cpp-directives added for serial mode 28 31 ! … … 45 48 !> lateral boundary conditions, respectively. 46 49 !------------------------------------------------------------------------------! 50 MODULE exchange_horiz_mod 51 52 USE kinds 53 54 USE pegrid 55 56 IMPLICIT NONE 57 58 PRIVATE 59 PUBLIC exchange_horiz, exchange_horiz_int, exchange_horiz_2d, exchange_horiz_2d_byte, & 60 exchange_horiz_2d_int 61 62 INTERFACE exchange_horiz 63 MODULE PROCEDURE exchange_horiz 64 END INTERFACE exchange_horiz 65 66 INTERFACE exchange_horiz_int 67 MODULE PROCEDURE exchange_horiz_int 68 END INTERFACE exchange_horiz_int 69 70 INTERFACE exchange_horiz_2d 71 MODULE PROCEDURE exchange_horiz_2d 72 END INTERFACE exchange_horiz_2d 73 74 INTERFACE exchange_horiz_2d_byte 75 MODULE PROCEDURE exchange_horiz_2d_byte 76 END INTERFACE exchange_horiz_2d_byte 77 78 INTERFACE exchange_horiz_2d_int 79 MODULE PROCEDURE exchange_horiz_2d_int 80 END INTERFACE exchange_horiz_2d_int 81 82 83 CONTAINS 84 85 47 86 SUBROUTINE exchange_horiz( ar, nbgp_local) 48 49 87 50 88 USE control_parameters, & … … 62 100 ONLY: nxl, nxr, nyn, nys, nzb, nzt 63 101 64 USE kinds65 66 USE pegrid67 68 IMPLICIT NONE69 70 102 71 103 #if defined( _OPENACC ) … … 293 325 USE indices, & 294 326 ONLY: nzb 295 296 USE kinds297 298 USE pegrid299 300 IMPLICIT NONE301 327 302 328 INTEGER(iwp) :: nxl_l !< local index bound at current grid level, left side … … 379 405 #endif 380 406 381 382 407 END SUBROUTINE exchange_horiz_int 408 409 ! Description: 410 ! ------------ 411 !> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic 412 !> boundary conditions, respectively, for 2D-arrays. 413 !------------------------------------------------------------------------------! 414 SUBROUTINE exchange_horiz_2d( ar ) 415 416 USE control_parameters, & 417 ONLY : bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, & 418 bc_dirichlet_s, bc_radiation_l, & 419 bc_radiation_n, bc_radiation_r, bc_radiation_s 420 421 USE cpulog, & 422 ONLY : cpu_log, log_point_s 423 424 USE indices, & 425 ONLY : nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg 426 427 #if ! defined( __parallel ) 428 USE control_parameters, & 429 ONLY: bc_lr_cyc, bc_ns_cyc 430 #endif 431 432 433 INTEGER(iwp) :: i !< 434 435 REAL(wp) :: ar(nysg:nyng,nxlg:nxrg) !< 436 437 438 CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' ) 439 440 #if defined( __parallel ) 441 442 ! 443 !-- Exchange of lateral boundary values for parallel computers 444 IF ( pdims(1) == 1 ) THEN 445 446 ! 447 !-- One-dimensional decomposition along y, boundary values can be exchanged 448 !-- within the PE memory 449 ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr) 450 ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1) 451 452 ELSE 453 ! 454 !-- Send left boundary, receive right one 455 456 CALL MPI_SENDRECV( ar(nysg,nxl), 1, type_y, pleft, 0, & 457 ar(nysg,nxr+1), 1, type_y, pright, 0, & 458 comm2d, status, ierr ) 459 ! 460 !-- Send right boundary, receive left one 461 CALL MPI_SENDRECV( ar(nysg,nxr+1-nbgp), 1, type_y, pright, 1, & 462 ar(nysg,nxlg), 1, type_y, pleft, 1, & 463 comm2d, status, ierr ) 464 465 466 ENDIF 467 468 IF ( pdims(2) == 1 ) THEN 469 ! 470 !-- One-dimensional decomposition along x, boundary values can be exchanged 471 !-- within the PE memory 472 ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:) 473 ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:) 474 475 ELSE 476 ! 477 !-- Send front boundary, receive rear one 478 479 CALL MPI_SENDRECV( ar(nys,nxlg), 1, type_x, psouth, 0, & 480 ar(nyn+1,nxlg), 1, type_x, pnorth, 0, & 481 comm2d, status, ierr ) 482 ! 483 !-- Send rear boundary, receive front one 484 CALL MPI_SENDRECV( ar(nyn+1-nbgp,nxlg), 1, type_x, pnorth, 1, & 485 ar(nysg,nxlg), 1, type_x, psouth, 1, & 486 comm2d, status, ierr ) 487 488 ENDIF 489 490 #else 491 492 ! 493 !-- Lateral boundary conditions in the non-parallel case 494 IF ( bc_lr_cyc ) THEN 495 ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr) 496 ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1) 497 ENDIF 498 499 IF ( bc_ns_cyc ) THEN 500 ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:) 501 ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:) 502 ENDIF 503 504 #endif 505 506 ! 507 !-- Neumann-conditions at inflow/outflow/nested boundaries 508 IF ( bc_dirichlet_l .OR. bc_radiation_l ) THEN 509 DO i = nbgp, 1, -1 510 ar(:,nxl-i) = ar(:,nxl) 511 ENDDO 512 ENDIF 513 IF ( bc_dirichlet_r .OR. bc_radiation_r ) THEN 514 DO i = 1, nbgp 515 ar(:,nxr+i) = ar(:,nxr) 516 ENDDO 517 ENDIF 518 IF ( bc_dirichlet_s .OR. bc_radiation_s ) THEN 519 DO i = nbgp, 1, -1 520 ar(nys-i,:) = ar(nys,:) 521 ENDDO 522 ENDIF 523 IF ( bc_dirichlet_n .OR. bc_radiation_n ) THEN 524 DO i = 1, nbgp 525 ar(nyn+i,:) = ar(nyn,:) 526 ENDDO 527 ENDIF 528 529 CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' ) 530 531 END SUBROUTINE exchange_horiz_2d 532 533 534 !------------------------------------------------------------------------------! 535 ! Description: 536 ! ------------ 537 !> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic 538 !> boundary conditions, respectively, for 2D 8-bit integer arrays. 539 !------------------------------------------------------------------------------! 540 SUBROUTINE exchange_horiz_2d_byte( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local ) 541 542 543 USE control_parameters, & 544 ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, & 545 bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s, & 546 bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s 547 548 USE cpulog, & 549 ONLY: cpu_log, log_point_s 550 551 #if ! defined( __parallel ) 552 USE control_parameters, & 553 ONLY: bc_lr_cyc, bc_ns_cyc 554 #endif 555 556 INTEGER(iwp) :: i !< dummy index to zero-gradient conditions at in/outflow boundaries 557 INTEGER(iwp) :: nxl_l !< local index bound at current grid level, left side 558 INTEGER(iwp) :: nxr_l !< local index bound at current grid level, right side 559 INTEGER(iwp) :: nyn_l !< local index bound at current grid level, north side 560 INTEGER(iwp) :: nys_l !< local index bound at current grid level, south side 561 INTEGER(iwp) :: nbgp_local !< number of ghost layers to be exchanged 562 563 INTEGER(KIND=1), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local, & 564 nxl_l-nbgp_local:nxr_l+nbgp_local) :: ar !< treated array 565 566 CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' ) 567 568 #if defined( __parallel ) 569 570 ! 571 !-- Exchange of lateral boundary values for parallel computers 572 IF ( pdims(1) == 1 ) THEN 573 574 ! 575 !-- One-dimensional decomposition along y, boundary values can be exchanged 576 !-- within the PE memory 577 ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l) 578 ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1) 579 580 ELSE 581 ! 582 !-- Send left boundary, receive right one 583 CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l), 1, & 584 type_y_byte, pleft, 0, & 585 ar(nys_l-nbgp_local,nxr_l+1), 1, & 586 type_y_byte, pright, 0, & 587 comm2d, status, ierr ) 588 ! 589 !-- Send right boundary, receive left one 590 CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, & 591 type_y_byte, pright, 1, & 592 ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, & 593 type_y_byte, pleft, 1, & 594 comm2d, status, ierr ) 595 596 ENDIF 597 598 IF ( pdims(2) == 1 ) THEN 599 ! 600 !-- One-dimensional decomposition along x, boundary values can be exchanged 601 !-- within the PE memory 602 ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:) 603 ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:) 604 605 606 ELSE 607 ! 608 !-- Send front boundary, receive rear one 609 CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local), 1, & 610 type_x_byte, psouth, 0, & 611 ar(nyn_l+1,nxl_l-nbgp_local), 1, & 612 type_x_byte, pnorth, 0, & 613 comm2d, status, ierr ) 614 615 ! 616 !-- Send rear boundary, receive front one 617 CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1, & 618 type_x_byte, pnorth, 1, & 619 ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, & 620 type_x_byte, psouth, 1, & 621 comm2d, status, ierr ) 622 623 ENDIF 624 625 #else 626 627 ! 628 !-- Lateral boundary conditions in the non-parallel case 629 IF ( bc_lr_cyc ) THEN 630 ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l) 631 ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1) 632 ENDIF 633 634 IF ( bc_ns_cyc ) THEN 635 ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:) 636 ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:) 637 ENDIF 638 639 #endif 640 ! 641 !-- Neumann-conditions at inflow/outflow/nested boundaries 642 IF ( bc_dirichlet_l .OR. bc_radiation_l ) THEN 643 DO i = nbgp_local, 1, -1 644 ar(:,nxl_l-i) = ar(:,nxl_l) 645 ENDDO 646 ENDIF 647 IF ( bc_dirichlet_r .OR. bc_radiation_r ) THEN 648 DO i = 1, nbgp_local 649 ar(:,nxr_l+i) = ar(:,nxr_l) 650 ENDDO 651 ENDIF 652 IF ( bc_dirichlet_s .OR. bc_radiation_s ) THEN 653 DO i = nbgp_local, 1, -1 654 ar(nys_l-i,:) = ar(nys_l,:) 655 ENDDO 656 ENDIF 657 IF ( bc_dirichlet_n .OR. bc_radiation_n ) THEN 658 DO i = 1, nbgp_local 659 ar(nyn_l+i,:) = ar(nyn_l,:) 660 ENDDO 661 ENDIF 662 663 CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' ) 664 665 END SUBROUTINE exchange_horiz_2d_byte 666 667 668 !------------------------------------------------------------------------------! 669 ! Description: 670 ! ------------ 671 !> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic 672 !> boundary conditions, respectively, for 2D 32-bit integer arrays. 673 !------------------------------------------------------------------------------! 674 SUBROUTINE exchange_horiz_2d_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local ) 675 676 677 USE control_parameters, & 678 ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, & 679 bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s, & 680 bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s 681 682 #if defined( __parallel ) 683 USE control_parameters, & 684 ONLY: grid_level 685 #endif 686 687 USE cpulog, & 688 ONLY: cpu_log, log_point_s 689 690 #if ! defined( __parallel ) 691 USE control_parameters, & 692 ONLY: bc_lr_cyc, bc_ns_cyc 693 #endif 694 695 INTEGER(iwp) :: i !< dummy index to zero-gradient conditions at in/outflow boundaries 696 INTEGER(iwp) :: nxl_l !< local index bound at current grid level, left side 697 INTEGER(iwp) :: nxr_l !< local index bound at current grid level, right side 698 INTEGER(iwp) :: nyn_l !< local index bound at current grid level, north side 699 INTEGER(iwp) :: nys_l !< local index bound at current grid level, south side 700 INTEGER(iwp) :: nbgp_local !< number of ghost layers to be exchanged 701 702 INTEGER(iwp), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local, & 703 nxl_l-nbgp_local:nxr_l+nbgp_local) :: ar !< treated array 704 705 CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' ) 706 707 #if defined( __parallel ) 708 709 ! 710 !-- Exchange of lateral boundary values for parallel computers 711 IF ( pdims(1) == 1 ) THEN 712 713 ! 714 !-- One-dimensional decomposition along y, boundary values can be exchanged 715 !-- within the PE memory 716 ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l) 717 ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1) 718 719 ELSE 720 ! 721 !-- Send left boundary, receive right one 722 CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l), 1, & 723 type_y_int(grid_level), pleft, 0, & 724 ar(nys_l-nbgp_local,nxr_l+1), 1, & 725 type_y_int(grid_level), pright, 0, & 726 comm2d, status, ierr ) 727 ! 728 !-- Send right boundary, receive left one 729 CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, & 730 type_y_int(grid_level), pright, 1, & 731 ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, & 732 type_y_int(grid_level), pleft, 1, & 733 comm2d, status, ierr ) 734 735 ENDIF 736 737 IF ( pdims(2) == 1 ) THEN 738 ! 739 !-- One-dimensional decomposition along x, boundary values can be exchanged 740 !-- within the PE memory 741 ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:) 742 ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:) 743 744 745 ELSE 746 ! 747 !-- Send front boundary, receive rear one 748 CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local), 1, & 749 type_x_int(grid_level), psouth, 0, & 750 ar(nyn_l+1,nxl_l-nbgp_local), 1, & 751 type_x_int(grid_level), pnorth, 0, & 752 comm2d, status, ierr ) 753 754 ! 755 !-- Send rear boundary, receive front one 756 CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1, & 757 type_x_int(grid_level), pnorth, 1, & 758 ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, & 759 type_x_int(grid_level), psouth, 1, & 760 comm2d, status, ierr ) 761 762 ENDIF 763 764 #else 765 766 ! 767 !-- Lateral boundary conditions in the non-parallel case 768 IF ( bc_lr_cyc ) THEN 769 ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l) 770 ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1) 771 ENDIF 772 773 IF ( bc_ns_cyc ) THEN 774 ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:) 775 ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:) 776 ENDIF 777 778 #endif 779 ! 780 !-- Neumann-conditions at inflow/outflow/nested boundaries 781 IF ( bc_dirichlet_l .OR. bc_radiation_l ) THEN 782 DO i = nbgp_local, 1, -1 783 ar(:,nxl_l-i) = ar(:,nxl_l) 784 ENDDO 785 ENDIF 786 IF ( bc_dirichlet_r .OR. bc_radiation_r ) THEN 787 DO i = 1, nbgp_local 788 ar(:,nxr_l+i) = ar(:,nxr_l) 789 ENDDO 790 ENDIF 791 IF ( bc_dirichlet_s .OR. bc_radiation_s ) THEN 792 DO i = nbgp_local, 1, -1 793 ar(nys_l-i,:) = ar(nys_l,:) 794 ENDDO 795 ENDIF 796 IF ( bc_dirichlet_n .OR. bc_radiation_n ) THEN 797 DO i = 1, nbgp_local 798 ar(nyn_l+i,:) = ar(nyn_l,:) 799 ENDDO 800 ENDIF 801 802 CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' ) 803 804 END SUBROUTINE exchange_horiz_2d_int 805 806 807 END MODULE exchange_horiz_mod
Note: See TracChangeset
for help on using the changeset viewer.
