Changeset 1682 for palm/trunk/SOURCE/poismg_fast.f90
- Timestamp:
- Oct 7, 2015 11:56:08 PM (9 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/poismg_fast.f90 (modified) (33 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/poismg_fast.f90
r1610 r1682 1 MODULE poismg_mod 2 1 !> @file poismg_fast.f90 3 2 !--------------------------------------------------------------------------------! 4 3 ! This file is part of PALM. … … 18 17 !--------------------------------------------------------------------------------! 19 18 ! 20 ! Attention: Loop unrolling and cache optimization in SOR-Red/Black method21 ! still does not give the expected speedup! Further work required.22 !23 19 ! Current revisions: 24 20 ! ----------------- 25 ! 21 ! Code annotations made doxygen readable 26 22 ! 27 23 ! Former revisions: … … 48 44 ! Description: 49 45 ! ------------ 50 ! Solves the Poisson equation for the perturbation pressure with a multigrid 51 ! V- or W-Cycle scheme. 52 ! 53 ! This multigrid method was originally developed for PALM by Joerg Uhlenbrock, 54 ! September 2000 - July 2001. It has been optimised for speed by Klaus 55 ! Ketelsen in November 2014. 46 !> Solves the Poisson equation for the perturbation pressure with a multigrid 47 !> V- or W-Cycle scheme. 48 !> 49 !> This multigrid method was originally developed for PALM by Joerg Uhlenbrock, 50 !> September 2000 - July 2001. It has been optimised for speed by Klaus 51 !> Ketelsen in November 2014. 52 !> 53 !> @attention Loop unrolling and cache optimization in SOR-Red/Black method 54 !> still does not give the expected speedup! 55 !> 56 !> @todo Further work required. 56 57 !------------------------------------------------------------------------------! 58 MODULE poismg_mod 59 57 60 58 61 USE cpulog, & … … 65 68 PRIVATE 66 69 67 INTEGER, SAVE :: ind_even_odd ! :border index between even and odd k index68 INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: even_odd_level ! :stores ind_even_odd for all MG levels69 70 REAL(wp), DIMENSION(:,:), SAVE, ALLOCATABLE :: f1_mg_b, f2_mg_b, f3_mg_b ! :blocked version of f1_mg ...70 INTEGER, SAVE :: ind_even_odd !< border index between even and odd k index 71 INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: even_odd_level !< stores ind_even_odd for all MG levels 72 73 REAL(wp), DIMENSION(:,:), SAVE, ALLOCATABLE :: f1_mg_b, f2_mg_b, f3_mg_b !< blocked version of f1_mg ... 71 74 72 75 INTERFACE poismg_fast … … 84 87 CONTAINS 85 88 89 !------------------------------------------------------------------------------! 90 ! Description: 91 ! ------------ 92 !> Solves the Poisson equation for the perturbation pressure with a multigrid 93 !> V- or W-Cycle scheme. 94 !------------------------------------------------------------------------------! 86 95 SUBROUTINE poismg_fast( r ) 87 96 … … 103 112 IMPLICIT NONE 104 113 105 REAL(wp) :: maxerror ! :106 REAL(wp) :: maximum_mgcycles ! :107 REAL(wp) :: residual_norm ! :108 109 REAL(wp), DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) :: r ! :110 111 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: p3 ! :114 REAL(wp) :: maxerror !< 115 REAL(wp) :: maximum_mgcycles !< 116 REAL(wp) :: residual_norm !< 117 118 REAL(wp), DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) :: r !< 119 120 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: p3 !< 112 121 113 122 … … 215 224 216 225 217 218 SUBROUTINE resid_fast( f_mg, p_mg, r )219 220 226 !------------------------------------------------------------------------------! 221 227 ! Description: 222 228 ! ------------ 223 ! Computes the residual of the perturbation pressure.229 !> Computes the residual of the perturbation pressure. 224 230 !------------------------------------------------------------------------------! 231 SUBROUTINE resid_fast( f_mg, p_mg, r ) 232 225 233 226 234 USE arrays_3d, & … … 247 255 INTEGER(iwp) :: k 248 256 INTEGER(iwp) :: l 249 INTEGER(iwp) :: km1 ! :250 INTEGER(iwp) :: kp1 ! :257 INTEGER(iwp) :: km1 !< 258 INTEGER(iwp) :: kp1 !< 251 259 252 260 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 253 261 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 254 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg ! :262 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg !< 255 263 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 256 264 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 257 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg ! :265 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg !< 258 266 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 259 267 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 260 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: r ! :268 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: r !< 261 269 262 270 ! … … 412 420 413 421 414 415 SUBROUTINE restrict_fast( f_mg, r )416 417 422 !------------------------------------------------------------------------------! 418 423 ! Description: 419 424 ! ------------ 420 ! Interpolates the residual on the next coarser grid with "full weighting"421 ! scheme425 !> Interpolates the residual on the next coarser grid with "full weighting" 426 !> scheme 422 427 !------------------------------------------------------------------------------! 428 SUBROUTINE restrict_fast( f_mg, r ) 429 423 430 424 431 USE control_parameters, & … … 435 442 IMPLICIT NONE 436 443 437 INTEGER(iwp) :: i ! :438 INTEGER(iwp) :: ic ! :439 INTEGER(iwp) :: j ! :440 INTEGER(iwp) :: jc ! :441 INTEGER(iwp) :: k ! :442 INTEGER(iwp) :: kc ! :443 INTEGER(iwp) :: l ! :444 INTEGER(iwp) :: km1 ! :445 INTEGER(iwp) :: kp1 ! :446 447 REAL(wp) :: rkjim ! :448 REAL(wp) :: rkjip ! :449 REAL(wp) :: rkjmi ! :450 REAL(wp) :: rkjmim ! :451 REAL(wp) :: rkjmip ! :452 REAL(wp) :: rkjpi ! :453 REAL(wp) :: rkjpim ! :454 REAL(wp) :: rkjpip ! :455 REAL(wp) :: rkmji ! :456 REAL(wp) :: rkmjim ! :457 REAL(wp) :: rkmjip ! :458 REAL(wp) :: rkmjmi ! :459 REAL(wp) :: rkmjmim ! :460 REAL(wp) :: rkmjmip ! :461 REAL(wp) :: rkmjpi ! :462 REAL(wp) :: rkmjpim ! :463 REAL(wp) :: rkmjpip ! :444 INTEGER(iwp) :: i !< 445 INTEGER(iwp) :: ic !< 446 INTEGER(iwp) :: j !< 447 INTEGER(iwp) :: jc !< 448 INTEGER(iwp) :: k !< 449 INTEGER(iwp) :: kc !< 450 INTEGER(iwp) :: l !< 451 INTEGER(iwp) :: km1 !< 452 INTEGER(iwp) :: kp1 !< 453 454 REAL(wp) :: rkjim !< 455 REAL(wp) :: rkjip !< 456 REAL(wp) :: rkjmi !< 457 REAL(wp) :: rkjmim !< 458 REAL(wp) :: rkjmip !< 459 REAL(wp) :: rkjpi !< 460 REAL(wp) :: rkjpim !< 461 REAL(wp) :: rkjpip !< 462 REAL(wp) :: rkmji !< 463 REAL(wp) :: rkmjim !< 464 REAL(wp) :: rkmjip !< 465 REAL(wp) :: rkmjmi !< 466 REAL(wp) :: rkmjmim !< 467 REAL(wp) :: rkmjmip !< 468 REAL(wp) :: rkmjpi !< 469 REAL(wp) :: rkmjpim !< 470 REAL(wp) :: rkmjpip !< 464 471 465 472 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 466 473 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 467 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg ! :474 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg !< 468 475 469 476 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level+1)+1, & 470 477 nys_mg(grid_level+1)-1:nyn_mg(grid_level+1)+1, & 471 nxl_mg(grid_level+1)-1:nxr_mg(grid_level+1)+1) :: r ! :478 nxl_mg(grid_level+1)-1:nxr_mg(grid_level+1)+1) :: r !< 472 479 473 480 ! … … 658 665 659 666 660 661 SUBROUTINE prolong_fast( p, temp )662 663 667 !------------------------------------------------------------------------------! 664 668 ! Description: 665 669 ! ------------ 666 ! Interpolates the correction of the perturbation pressure667 ! to the next finer grid.670 !> Interpolates the correction of the perturbation pressure 671 !> to the next finer grid. 668 672 !------------------------------------------------------------------------------! 673 SUBROUTINE prolong_fast( p, temp ) 674 669 675 670 676 USE control_parameters, & … … 678 684 IMPLICIT NONE 679 685 680 INTEGER(iwp) :: i ! :681 INTEGER(iwp) :: j ! :682 INTEGER(iwp) :: k ! :683 INTEGER(iwp) :: l ! :684 INTEGER(iwp) :: kp1 ! :685 INTEGER(iwp) :: ke ! :Index for prolog even686 INTEGER(iwp) :: ko ! :Index for prolog odd686 INTEGER(iwp) :: i !< 687 INTEGER(iwp) :: j !< 688 INTEGER(iwp) :: k !< 689 INTEGER(iwp) :: l !< 690 INTEGER(iwp) :: kp1 !< 691 INTEGER(iwp) :: ke !< Index for prolog even 692 INTEGER(iwp) :: ko !< Index for prolog odd 687 693 688 694 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1, & 689 695 nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1, & 690 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1 ) :: p ! :696 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1 ) :: p !< 691 697 692 698 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 693 699 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 694 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: temp ! :700 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: temp !< 695 701 696 702 … … 809 815 810 816 811 812 SUBROUTINE redblack_fast( f_mg, p_mg )813 814 817 !------------------------------------------------------------------------------! 815 818 ! Description: 816 819 ! ------------ 817 ! Relaxation method for the multigrid scheme. A Gauss-Seidel iteration with818 ! 3D-Red-Black decomposition (GS-RB) is used.820 !> Relaxation method for the multigrid scheme. A Gauss-Seidel iteration with 821 !> 3D-Red-Black decomposition (GS-RB) is used. 819 822 !------------------------------------------------------------------------------! 823 SUBROUTINE redblack_fast( f_mg, p_mg ) 824 820 825 821 826 USE arrays_3d, & … … 838 843 IMPLICIT NONE 839 844 840 INTEGER(iwp) :: color ! :841 INTEGER(iwp) :: i ! :842 INTEGER(iwp) :: ic ! :843 INTEGER(iwp) :: j ! :844 INTEGER(iwp) :: jc ! :845 INTEGER(iwp) :: jj ! :846 INTEGER(iwp) :: k ! :847 INTEGER(iwp) :: l ! :848 INTEGER(iwp) :: n ! :849 INTEGER(iwp) :: km1 ! :850 INTEGER(iwp) :: kp1 ! :851 852 LOGICAL :: unroll ! :853 854 REAL(wp) :: wall_left ! :855 REAL(wp) :: wall_north ! :856 REAL(wp) :: wall_right ! :857 REAL(wp) :: wall_south ! :858 REAL(wp) :: wall_total ! :859 REAL(wp) :: wall_top ! :845 INTEGER(iwp) :: color !< 846 INTEGER(iwp) :: i !< 847 INTEGER(iwp) :: ic !< 848 INTEGER(iwp) :: j !< 849 INTEGER(iwp) :: jc !< 850 INTEGER(iwp) :: jj !< 851 INTEGER(iwp) :: k !< 852 INTEGER(iwp) :: l !< 853 INTEGER(iwp) :: n !< 854 INTEGER(iwp) :: km1 !< 855 INTEGER(iwp) :: kp1 !< 856 857 LOGICAL :: unroll !< 858 859 REAL(wp) :: wall_left !< 860 REAL(wp) :: wall_north !< 861 REAL(wp) :: wall_right !< 862 REAL(wp) :: wall_south !< 863 REAL(wp) :: wall_total !< 864 REAL(wp) :: wall_top !< 860 865 861 866 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 862 867 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 863 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg ! :868 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg !< 864 869 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 865 870 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 866 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg ! :871 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg !< 867 872 868 873 l = grid_level … … 1520 1525 1521 1526 1522 1523 SUBROUTINE sort_k_to_even_odd_blocks( p_mg , glevel )1524 1525 1527 !------------------------------------------------------------------------------! 1526 1528 ! Description: 1527 1529 ! ------------ 1528 ! Sort k-Dimension from sequential into blocks of even and odd.1529 ! This is required to vectorize the red-black subroutine.1530 ! Version for 3D-REAL arrays1530 !> Sort k-Dimension from sequential into blocks of even and odd. 1531 !> This is required to vectorize the red-black subroutine. 1532 !> Version for 3D-REAL arrays 1531 1533 !------------------------------------------------------------------------------! 1534 SUBROUTINE sort_k_to_even_odd_blocks( p_mg , glevel ) 1535 1532 1536 1533 1537 USE control_parameters, & … … 1543 1547 REAL(wp), DIMENSION(nzb:nzt_mg(glevel)+1, & 1544 1548 nys_mg(glevel)-1:nyn_mg(glevel)+1, & 1545 nxl_mg(glevel)-1:nxr_mg(glevel)+1) :: p_mg ! :1549 nxl_mg(glevel)-1:nxr_mg(glevel)+1) :: p_mg !< 1546 1550 ! 1547 1551 !-- Local variables 1548 INTEGER(iwp) :: i ! :1549 INTEGER(iwp) :: j ! :1550 INTEGER(iwp) :: k ! :1551 INTEGER(iwp) :: l ! :1552 INTEGER(iwp) :: ind ! :1553 REAL(wp), DIMENSION(nzb:nzt_mg(glevel)+1) :: tmp ! :1552 INTEGER(iwp) :: i !< 1553 INTEGER(iwp) :: j !< 1554 INTEGER(iwp) :: k !< 1555 INTEGER(iwp) :: l !< 1556 INTEGER(iwp) :: ind !< 1557 REAL(wp), DIMENSION(nzb:nzt_mg(glevel)+1) :: tmp !< 1554 1558 1555 1559 … … 1589 1593 1590 1594 1591 1592 SUBROUTINE sort_k_to_even_odd_blocks_1d( f_mg, f_mg_b, glevel )1593 1594 1595 !------------------------------------------------------------------------------! 1595 1596 ! Description: 1596 1597 ! ------------ 1597 ! Sort k-Dimension from sequential into blocks of even and odd.1598 ! This is required to vectorize the red-black subroutine.1599 ! Version for 1D-REAL arrays1598 !> Sort k-Dimension from sequential into blocks of even and odd. 1599 !> This is required to vectorize the red-black subroutine. 1600 !> Version for 1D-REAL arrays 1600 1601 !------------------------------------------------------------------------------! 1602 SUBROUTINE sort_k_to_even_odd_blocks_1d( f_mg, f_mg_b, glevel ) 1603 1601 1604 1602 1605 USE indices, & … … 1612 1615 ! 1613 1616 !-- Local variables 1614 INTEGER(iwp) :: ind ! :1615 INTEGER(iwp) :: k ! :1617 INTEGER(iwp) :: ind !< 1618 INTEGER(iwp) :: k !< 1616 1619 1617 1620 … … 1637 1640 1638 1641 1639 1640 SUBROUTINE sort_k_to_even_odd_blocks_int( i_mg , glevel )1641 1642 1642 !------------------------------------------------------------------------------! 1643 1643 ! Description: 1644 1644 ! ------------ 1645 ! Sort k-Dimension from sequential into blocks of even and odd.1646 ! This is required to vectorize the red-black subroutine.1647 ! Version for 2D-INTEGER arrays1645 !> Sort k-Dimension from sequential into blocks of even and odd. 1646 !> This is required to vectorize the red-black subroutine. 1647 !> Version for 2D-INTEGER arrays 1648 1648 !------------------------------------------------------------------------------! 1649 SUBROUTINE sort_k_to_even_odd_blocks_int( i_mg , glevel ) 1650 1649 1651 1650 1652 USE control_parameters, & … … 1660 1662 INTEGER(iwp), DIMENSION(nzb:nzt_mg(glevel)+1, & 1661 1663 nys_mg(glevel)-1:nyn_mg(glevel)+1, & 1662 nxl_mg(glevel)-1:nxr_mg(glevel)+1) :: i_mg ! :1664 nxl_mg(glevel)-1:nxr_mg(glevel)+1) :: i_mg !< 1663 1665 ! 1664 1666 !-- Local variables 1665 INTEGER(iwp) :: i ! :1666 INTEGER(iwp) :: j ! :1667 INTEGER(iwp) :: k ! :1668 INTEGER(iwp) :: l ! :1669 INTEGER(iwp) :: ind ! :1667 INTEGER(iwp) :: i !< 1668 INTEGER(iwp) :: j !< 1669 INTEGER(iwp) :: k !< 1670 INTEGER(iwp) :: l !< 1671 INTEGER(iwp) :: ind !< 1670 1672 INTEGER(iwp),DIMENSION(nzb:nzt_mg(glevel)+1) :: tmp 1671 1673 … … 1712 1714 1713 1715 1714 1715 SUBROUTINE sort_k_to_sequential( p_mg )1716 1717 1716 !------------------------------------------------------------------------------! 1718 1717 ! Description: 1719 1718 ! ------------ 1720 ! Sort k-dimension from blocks of even and odd into sequential1719 !> Sort k-dimension from blocks of even and odd into sequential 1721 1720 !------------------------------------------------------------------------------! 1721 SUBROUTINE sort_k_to_sequential( p_mg ) 1722 1722 1723 1723 1724 USE control_parameters, & … … 1731 1732 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 1732 1733 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 1733 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg ! :1734 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg !< 1734 1735 ! 1735 1736 !-- Local variables 1736 INTEGER(iwp) :: i ! :1737 INTEGER(iwp) :: j ! :1738 INTEGER(iwp) :: k ! :1739 INTEGER(iwp) :: l ! :1740 INTEGER(iwp) :: ind ! :1737 INTEGER(iwp) :: i !< 1738 INTEGER(iwp) :: j !< 1739 INTEGER(iwp) :: k !< 1740 INTEGER(iwp) :: l !< 1741 INTEGER(iwp) :: ind !< 1741 1742 1742 1743 REAL(wp),DIMENSION(nzb:nzt_mg(grid_level)+1) :: tmp … … 1768 1769 1769 1770 1770 1771 !------------------------------------------------------------------------------! 1772 ! Description: 1773 ! ------------ 1774 !> Gather subdomain data from all PEs. 1775 !------------------------------------------------------------------------------! 1771 1776 SUBROUTINE mg_gather_fast( f2, f2_sub ) 1772 1777 … … 1782 1787 IMPLICIT NONE 1783 1788 1784 INTEGER(iwp) :: i ! :1785 INTEGER(iwp) :: il ! :1786 INTEGER(iwp) :: ir ! :1787 INTEGER(iwp) :: j ! :1788 INTEGER(iwp) :: jn ! :1789 INTEGER(iwp) :: js ! :1790 INTEGER(iwp) :: k ! :1791 INTEGER(iwp) :: nwords ! :1789 INTEGER(iwp) :: i !< 1790 INTEGER(iwp) :: il !< 1791 INTEGER(iwp) :: ir !< 1792 INTEGER(iwp) :: j !< 1793 INTEGER(iwp) :: jn !< 1794 INTEGER(iwp) :: js !< 1795 INTEGER(iwp) :: k !< 1796 INTEGER(iwp) :: nwords !< 1792 1797 1793 1798 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 1794 1799 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 1795 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f2 ! :1800 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f2 !< 1796 1801 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 1797 1802 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 1798 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f2_l ! :1803 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f2_l !< 1799 1804 1800 1805 REAL(wp), DIMENSION(nzb:mg_loc_ind(5,myid)+1, & 1801 1806 mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1, & 1802 mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) :: f2_sub ! :1807 mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) :: f2_sub !< 1803 1808 1804 1809 … … 1844 1849 1845 1850 1851 !------------------------------------------------------------------------------! 1852 ! Description: 1853 ! ------------ 1854 !> @todo It might be possible to improve the speed of this routine by using 1855 !> non-blocking communication 1856 !------------------------------------------------------------------------------! 1846 1857 SUBROUTINE mg_scatter_fast( p2, p2_sub ) 1847 !1848 !-- TODO: It might be possible to improve the speed of this routine by using1849 !-- non-blocking communication1850 1858 1851 1859 USE control_parameters, & … … 1860 1868 IMPLICIT NONE 1861 1869 1862 INTEGER(iwp) :: nwords ! :1870 INTEGER(iwp) :: nwords !< 1863 1871 1864 1872 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1, & 1865 1873 nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1, & 1866 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) :: p2 ! :1874 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) :: p2 !< 1867 1875 1868 1876 REAL(wp), DIMENSION(nzb:mg_loc_ind(5,myid)+1, & 1869 1877 mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1, & 1870 mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) :: p2_sub ! :1878 mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) :: p2_sub !< 1871 1879 1872 1880 ! … … 1886 1894 1887 1895 1888 1889 RECURSIVE SUBROUTINE next_mg_level_fast( f_mg, p_mg, p3, r )1890 1891 1896 !------------------------------------------------------------------------------! 1892 1897 ! Description: 1893 1898 ! ------------ 1894 ! This is where the multigrid technique takes place. V- and W- Cycle are1895 ! implemented and steered by the parameter "gamma". Parameter "nue" determines1896 ! the convergence of the multigrid iterative solution. There are nue times1897 ! RB-GS iterations. It should be set to "1" or "2", considering the time effort1898 ! one would like to invest. Last choice shows a very good converging factor,1899 ! but leads to an increase in computing time.1899 !> This is where the multigrid technique takes place. V- and W- Cycle are 1900 !> implemented and steered by the parameter "gamma". Parameter "nue" determines 1901 !> the convergence of the multigrid iterative solution. There are nue times 1902 !> RB-GS iterations. It should be set to "1" or "2", considering the time effort 1903 !> one would like to invest. Last choice shows a very good converging factor, 1904 !> but leads to an increase in computing time. 1900 1905 !------------------------------------------------------------------------------! 1906 RECURSIVE SUBROUTINE next_mg_level_fast( f_mg, p_mg, p3, r ) 1901 1907 1902 1908 USE control_parameters, & … … 1913 1919 IMPLICIT NONE 1914 1920 1915 INTEGER(iwp) :: i ! :1916 INTEGER(iwp) :: j ! :1917 INTEGER(iwp) :: k ! :1918 INTEGER(iwp) :: nxl_mg_save ! :1919 INTEGER(iwp) :: nxr_mg_save ! :1920 INTEGER(iwp) :: nyn_mg_save ! :1921 INTEGER(iwp) :: nys_mg_save ! :1922 INTEGER(iwp) :: nzt_mg_save ! :1921 INTEGER(iwp) :: i !< 1922 INTEGER(iwp) :: j !< 1923 INTEGER(iwp) :: k !< 1924 INTEGER(iwp) :: nxl_mg_save !< 1925 INTEGER(iwp) :: nxr_mg_save !< 1926 INTEGER(iwp) :: nyn_mg_save !< 1927 INTEGER(iwp) :: nys_mg_save !< 1928 INTEGER(iwp) :: nzt_mg_save !< 1923 1929 1924 1930 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 1925 1931 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 1926 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg ! :1932 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg !< 1927 1933 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 1928 1934 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 1929 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg ! :1935 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg !< 1930 1936 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 1931 1937 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 1932 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p3 ! :1938 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p3 !< 1933 1939 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 1934 1940 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 1935 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: r ! :1941 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: r !< 1936 1942 1937 1943 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1, & 1938 1944 nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1, & 1939 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) :: f2 ! :1945 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) :: f2 !< 1940 1946 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1, & 1941 1947 nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1, & 1942 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) :: p2 ! :1943 1944 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: f2_sub ! :1945 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: p2_sub ! :1948 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) :: p2 !< 1949 1950 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: f2_sub !< 1951 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: p2_sub !< 1946 1952 1947 1953 ! … … 2236 2242 2237 2243 2238 2239 SUBROUTINE init_even_odd_blocks2240 2241 2244 !------------------------------------------------------------------------------! 2242 2245 ! Description: 2243 2246 ! ------------ 2244 ! Initial settings for sorting k-dimension from sequential order (alternate2245 ! even/odd) into blocks of even and odd or vice versa2247 !> Initial settings for sorting k-dimension from sequential order (alternate 2248 !> even/odd) into blocks of even and odd or vice versa 2246 2249 !------------------------------------------------------------------------------! 2250 SUBROUTINE init_even_odd_blocks 2251 2247 2252 2248 2253 USE arrays_3d, & … … 2264 2269 ! 2265 2270 !-- Local variables 2266 INTEGER(iwp) :: i ! :2267 INTEGER(iwp) :: l ! :2271 INTEGER(iwp) :: i !< 2272 INTEGER(iwp) :: l !< 2268 2273 2269 2274 LOGICAL, SAVE :: lfirst = .TRUE. … … 2340 2345 2341 2346 2342 2343 SUBROUTINE special_exchange_horiz ( p_mg, color )2344 2345 2347 !------------------------------------------------------------------------------! 2346 2348 ! Description: 2347 2349 ! ------------ 2348 ! Special exchange_horiz subroutine for use in redblack. Transfers only2349 ! "red" or "black" data points.2350 !> Special exchange_horiz subroutine for use in redblack. Transfers only 2351 !> "red" or "black" data points. 2350 2352 !------------------------------------------------------------------------------! 2353 SUBROUTINE special_exchange_horiz ( p_mg, color ) 2354 2351 2355 2352 2356 USE control_parameters, & … … 2364 2368 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 2365 2369 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 2366 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg ! :2367 2368 INTEGER(iwp), intent(IN) :: color ! :2370 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg !< 2371 2372 INTEGER(iwp), intent(IN) :: color !< 2369 2373 ! 2370 2374 !-- Local variables 2371 INTEGER(iwp) :: i,i1,i2 ! :2372 INTEGER(iwp) :: j,j1,j2 ! :2373 INTEGER(iwp) :: k ! :2374 INTEGER(iwp) :: l ! :2375 INTEGER(iwp) :: jys ! :2376 INTEGER(iwp) :: jyn ! :2377 INTEGER(iwp) :: ixl ! :2378 INTEGER(iwp) :: ixr ! :2379 logical :: sendrecv_in_background_save ! :2380 logical :: synchronous_exchange_save ! :2375 INTEGER(iwp) :: i,i1,i2 !< 2376 INTEGER(iwp) :: j,j1,j2 !< 2377 INTEGER(iwp) :: k !< 2378 INTEGER(iwp) :: l !< 2379 INTEGER(iwp) :: jys !< 2380 INTEGER(iwp) :: jyn !< 2381 INTEGER(iwp) :: ixl !< 2382 INTEGER(iwp) :: ixr !< 2383 logical :: sendrecv_in_background_save !< 2384 logical :: synchronous_exchange_save !< 2381 2385 2382 2386 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1, & 2383 2387 nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1, & 2384 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) :: temp ! :2388 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) :: temp !< 2385 2389 2386 2390 #if defined ( __parallel ) … … 2889 2893 #endif 2890 2894 2891 2892 2893 2895 END SUBROUTINE special_exchange_horiz 2894 2896
Note: See TracChangeset
for help on using the changeset viewer.
