Changeset 1682 for palm/trunk/SOURCE/poismg.f90
- Timestamp:
- Oct 7, 2015 11:56:08 PM (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/poismg.f90
r1354 r1682 1 SUBROUTINE poismg( r ) 2 1 !> @file poismg.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: … … 116 112 ! Description: 117 113 ! ------------ 118 ! Solves the Poisson equation for the perturbation pressure with a multigrid 119 ! V- or W-Cycle scheme. 120 ! 121 ! This multigrid method was originally developed for PALM by Joerg Uhlenbrock, 122 ! September 2000 - July 2001. 114 !> Solves the Poisson equation for the perturbation pressure with a multigrid 115 !> V- or W-Cycle scheme. 116 !> 117 !> This multigrid method was originally developed for PALM by Joerg Uhlenbrock, 118 !> September 2000 - July 2001. 119 !> 120 !> @attention Loop unrolling and cache optimization in SOR-Red/Black method 121 !> still does not give the expected speedup! 122 !> 123 !> @todo Further work required. 123 124 !------------------------------------------------------------------------------! 125 SUBROUTINE poismg( r ) 126 124 127 125 128 USE arrays_3d, & … … 144 147 IMPLICIT NONE 145 148 146 REAL(wp) :: maxerror ! :147 REAL(wp) :: maximum_mgcycles ! :148 REAL(wp) :: residual_norm ! :149 150 REAL(wp), DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) :: r ! :151 152 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: p3 ! :149 REAL(wp) :: maxerror !< 150 REAL(wp) :: maximum_mgcycles !< 151 REAL(wp) :: residual_norm !< 152 153 REAL(wp), DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) :: r !< 154 155 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: p3 !< 153 156 154 157 … … 240 243 241 244 242 243 SUBROUTINE resid( f_mg, p_mg, r )244 245 245 !------------------------------------------------------------------------------! 246 246 ! Description: 247 247 ! ------------ 248 ! Computes the residual of the perturbation pressure.248 !> Computes the residual of the perturbation pressure. 249 249 !------------------------------------------------------------------------------! 250 SUBROUTINE resid( f_mg, p_mg, r ) 251 250 252 251 253 USE arrays_3d, & … … 277 279 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 278 280 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 279 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg ! :281 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg !< 280 282 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 281 283 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 282 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg ! :284 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg !< 283 285 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 284 286 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 285 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: r ! :287 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: r !< 286 288 287 289 ! … … 377 379 378 380 379 380 SUBROUTINE restrict( f_mg, r )381 382 381 !------------------------------------------------------------------------------! 383 382 ! Description: 384 383 ! ------------ 385 ! Interpolates the residual on the next coarser grid with "full weighting"386 ! scheme384 !> Interpolates the residual on the next coarser grid with "full weighting" 385 !> scheme. 387 386 !------------------------------------------------------------------------------! 387 SUBROUTINE restrict( f_mg, r ) 388 388 389 389 390 USE control_parameters, & … … 402 403 IMPLICIT NONE 403 404 404 INTEGER(iwp) :: i ! :405 INTEGER(iwp) :: ic ! :406 INTEGER(iwp) :: j ! :407 INTEGER(iwp) :: jc ! :408 INTEGER(iwp) :: k ! :409 INTEGER(iwp) :: kc ! :410 INTEGER(iwp) :: l ! :411 412 REAL(wp) :: rkjim ! :413 REAL(wp) :: rkjip ! :414 REAL(wp) :: rkjmi ! :415 REAL(wp) :: rkjmim ! :416 REAL(wp) :: rkjmip ! :417 REAL(wp) :: rkjpi ! :418 REAL(wp) :: rkjpim ! :419 REAL(wp) :: rkjpip ! :420 REAL(wp) :: rkmji ! :421 REAL(wp) :: rkmjim ! :422 REAL(wp) :: rkmjip ! :423 REAL(wp) :: rkmjmi ! :424 REAL(wp) :: rkmjmim ! :425 REAL(wp) :: rkmjmip ! :426 REAL(wp) :: rkmjpi ! :427 REAL(wp) :: rkmjpim ! :428 REAL(wp) :: rkmjpip ! :405 INTEGER(iwp) :: i !< 406 INTEGER(iwp) :: ic !< 407 INTEGER(iwp) :: j !< 408 INTEGER(iwp) :: jc !< 409 INTEGER(iwp) :: k !< 410 INTEGER(iwp) :: kc !< 411 INTEGER(iwp) :: l !< 412 413 REAL(wp) :: rkjim !< 414 REAL(wp) :: rkjip !< 415 REAL(wp) :: rkjmi !< 416 REAL(wp) :: rkjmim !< 417 REAL(wp) :: rkjmip !< 418 REAL(wp) :: rkjpi !< 419 REAL(wp) :: rkjpim !< 420 REAL(wp) :: rkjpip !< 421 REAL(wp) :: rkmji !< 422 REAL(wp) :: rkmjim !< 423 REAL(wp) :: rkmjip !< 424 REAL(wp) :: rkmjmi !< 425 REAL(wp) :: rkmjmim !< 426 REAL(wp) :: rkmjmip !< 427 REAL(wp) :: rkmjpi !< 428 REAL(wp) :: rkmjpim !< 429 REAL(wp) :: rkmjpip !< 429 430 430 431 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 431 432 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 432 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg ! :433 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg !< 433 434 434 435 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level+1)+1, & 435 436 nys_mg(grid_level+1)-1:nyn_mg(grid_level+1)+1, & 436 nxl_mg(grid_level+1)-1:nxr_mg(grid_level+1)+1) :: r ! :437 nxl_mg(grid_level+1)-1:nxr_mg(grid_level+1)+1) :: r !< 437 438 438 439 ! … … 585 586 586 587 587 588 SUBROUTINE prolong( p, temp )589 590 588 !------------------------------------------------------------------------------! 591 589 ! Description: 592 590 ! ------------ 593 ! Interpolates the correction of the perturbation pressure594 ! to the next finer grid.591 !> Interpolates the correction of the perturbation pressure 592 !> to the next finer grid. 595 593 !------------------------------------------------------------------------------! 594 SUBROUTINE prolong( p, temp ) 595 596 596 597 597 USE control_parameters, & … … 607 607 IMPLICIT NONE 608 608 609 INTEGER(iwp) :: i ! :610 INTEGER(iwp) :: j ! :611 INTEGER(iwp) :: k ! :612 INTEGER(iwp) :: l ! :609 INTEGER(iwp) :: i !< 610 INTEGER(iwp) :: j !< 611 INTEGER(iwp) :: k !< 612 INTEGER(iwp) :: l !< 613 613 614 614 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1, & 615 615 nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1, & 616 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1 ) :: p ! :616 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1 ) :: p !< 617 617 618 618 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 619 619 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 620 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: temp ! :620 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: temp !< 621 621 622 622 … … 692 692 693 693 694 SUBROUTINE redblack( f_mg, p_mg )695 696 694 !------------------------------------------------------------------------------! 697 695 ! Description: 698 696 ! ------------ 699 ! Relaxation method for the multigrid scheme. A Gauss-Seidel iteration with700 ! 3D-Red-Black decomposition (GS-RB) is used.697 !> Relaxation method for the multigrid scheme. A Gauss-Seidel iteration with 698 !> 3D-Red-Black decomposition (GS-RB) is used. 701 699 !------------------------------------------------------------------------------! 700 SUBROUTINE redblack( f_mg, p_mg ) 701 702 702 703 703 USE arrays_3d, & … … 725 725 IMPLICIT NONE 726 726 727 INTEGER(iwp) :: color ! :728 INTEGER(iwp) :: i ! :729 INTEGER(iwp) :: ic ! :730 INTEGER(iwp) :: j ! :731 INTEGER(iwp) :: jc ! :732 INTEGER(iwp) :: jj ! :733 INTEGER(iwp) :: k ! :734 INTEGER(iwp) :: l ! :735 INTEGER(iwp) :: n ! :736 737 LOGICAL :: unroll ! :738 739 REAL(wp) :: wall_left ! :740 REAL(wp) :: wall_north ! :741 REAL(wp) :: wall_right ! :742 REAL(wp) :: wall_south ! :743 REAL(wp) :: wall_total ! :744 REAL(wp) :: wall_top ! :727 INTEGER(iwp) :: color !< 728 INTEGER(iwp) :: i !< 729 INTEGER(iwp) :: ic !< 730 INTEGER(iwp) :: j !< 731 INTEGER(iwp) :: jc !< 732 INTEGER(iwp) :: jj !< 733 INTEGER(iwp) :: k !< 734 INTEGER(iwp) :: l !< 735 INTEGER(iwp) :: n !< 736 737 LOGICAL :: unroll !< 738 739 REAL(wp) :: wall_left !< 740 REAL(wp) :: wall_north !< 741 REAL(wp) :: wall_right !< 742 REAL(wp) :: wall_south !< 743 REAL(wp) :: wall_total !< 744 REAL(wp) :: wall_top !< 745 745 746 746 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 747 747 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 748 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg ! :748 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg !< 749 749 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 750 750 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 751 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg ! :751 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg !< 752 752 753 753 l = grid_level … … 1144 1144 1145 1145 1146 !------------------------------------------------------------------------------! 1147 ! Description: 1148 ! ------------ 1149 !> Gather subdomain data from all PEs. 1150 !------------------------------------------------------------------------------! 1146 1151 SUBROUTINE mg_gather( f2, f2_sub ) 1147 1152 … … 1161 1166 IMPLICIT NONE 1162 1167 1163 INTEGER(iwp) :: i ! :1164 INTEGER(iwp) :: il ! :1165 INTEGER(iwp) :: ir ! :1166 INTEGER(iwp) :: j ! :1167 INTEGER(iwp) :: jn ! :1168 INTEGER(iwp) :: js ! :1169 INTEGER(iwp) :: k ! :1170 INTEGER(iwp) :: nwords ! :1168 INTEGER(iwp) :: i !< 1169 INTEGER(iwp) :: il !< 1170 INTEGER(iwp) :: ir !< 1171 INTEGER(iwp) :: j !< 1172 INTEGER(iwp) :: jn !< 1173 INTEGER(iwp) :: js !< 1174 INTEGER(iwp) :: k !< 1175 INTEGER(iwp) :: nwords !< 1171 1176 1172 1177 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 1173 1178 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 1174 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f2 ! :1179 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f2 !< 1175 1180 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 1176 1181 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 1177 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f2_l ! :1182 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f2_l !< 1178 1183 1179 1184 REAL(wp), DIMENSION(nzb:mg_loc_ind(5,myid)+1, & 1180 1185 mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1, & 1181 mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) :: f2_sub ! :1186 mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) :: f2_sub !< 1182 1187 1183 1188 … … 1223 1228 1224 1229 1230 !------------------------------------------------------------------------------! 1231 ! Description: 1232 ! ------------ 1233 !> @todo It may be possible to improve the speed of this routine by using 1234 !> non-blocking communication 1235 !------------------------------------------------------------------------------! 1225 1236 SUBROUTINE mg_scatter( p2, p2_sub ) 1226 !1227 !-- TODO: It may be possible to improve the speed of this routine by using1228 !-- non-blocking communication1229 1237 1230 1238 USE control_parameters, & … … 1243 1251 IMPLICIT NONE 1244 1252 1245 INTEGER(iwp) :: nwords ! :1253 INTEGER(iwp) :: nwords !< 1246 1254 1247 1255 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1, & 1248 1256 nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1, & 1249 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) :: p2 ! :1257 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) :: p2 !< 1250 1258 1251 1259 REAL(wp), DIMENSION(nzb:mg_loc_ind(5,myid)+1, & 1252 1260 mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1, & 1253 mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) :: p2_sub ! :1261 mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) :: p2_sub !< 1254 1262 1255 1263 ! … … 1269 1277 1270 1278 1271 1272 RECURSIVE SUBROUTINE next_mg_level( f_mg, p_mg, p3, r )1273 1274 1279 !------------------------------------------------------------------------------! 1275 1280 ! Description: 1276 1281 ! ------------ 1277 ! This is where the multigrid technique takes place. V- and W- Cycle are1278 ! implemented and steered by the parameter "gamma". Parameter "nue" determines1279 ! the convergence of the multigrid iterative solution. There are nue times1280 ! RB-GS iterations. It should be set to "1" or "2", considering the time effort1281 ! one would like to invest. Last choice shows a very good converging factor,1282 ! but leads to an increase in computing time.1282 !> This is where the multigrid technique takes place. V- and W- Cycle are 1283 !> implemented and steered by the parameter "gamma". Parameter "nue" determines 1284 !> the convergence of the multigrid iterative solution. There are nue times 1285 !> RB-GS iterations. It should be set to "1" or "2", considering the time effort 1286 !> one would like to invest. Last choice shows a very good converging factor, 1287 !> but leads to an increase in computing time. 1283 1288 !------------------------------------------------------------------------------! 1289 RECURSIVE SUBROUTINE next_mg_level( f_mg, p_mg, p3, r ) 1284 1290 1285 1291 USE control_parameters, & … … 1301 1307 IMPLICIT NONE 1302 1308 1303 INTEGER(iwp) :: i ! :1304 INTEGER(iwp) :: j ! :1305 INTEGER(iwp) :: k ! :1306 INTEGER(iwp) :: nxl_mg_save ! :1307 INTEGER(iwp) :: nxr_mg_save ! :1308 INTEGER(iwp) :: nyn_mg_save ! :1309 INTEGER(iwp) :: nys_mg_save ! :1310 INTEGER(iwp) :: nzt_mg_save ! :1309 INTEGER(iwp) :: i !< 1310 INTEGER(iwp) :: j !< 1311 INTEGER(iwp) :: k !< 1312 INTEGER(iwp) :: nxl_mg_save !< 1313 INTEGER(iwp) :: nxr_mg_save !< 1314 INTEGER(iwp) :: nyn_mg_save !< 1315 INTEGER(iwp) :: nys_mg_save !< 1316 INTEGER(iwp) :: nzt_mg_save !< 1311 1317 1312 1318 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 1313 1319 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 1314 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg ! :1320 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg !< 1315 1321 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 1316 1322 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 1317 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg ! :1323 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg !< 1318 1324 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 1319 1325 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 1320 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p3 ! :1326 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p3 !< 1321 1327 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1, & 1322 1328 nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & 1323 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: r ! :1329 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: r !< 1324 1330 1325 1331 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1, & 1326 1332 nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1, & 1327 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) :: f2 ! :1333 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) :: f2 !< 1328 1334 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1, & 1329 1335 nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1, & 1330 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) :: p2 ! :1331 1332 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: f2_sub ! :1333 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: p2_sub ! :1336 nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) :: p2 !< 1337 1338 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: f2_sub !< 1339 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: p2_sub !< 1334 1340 1335 1341 !
Note: See TracChangeset
for help on using the changeset viewer.