Changeset 1931 for palm/trunk/SOURCE/poismg_mod.f90
- Timestamp:
- Jun 10, 2016 12:06:59 PM (9 years ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/poismg_mod.f90
r1930 r1931 1 !> @file poismg _fast_mod.f901 !> @file poismg.f90 2 2 !--------------------------------------------------------------------------------! 3 3 ! This file is part of PALM. … … 19 19 ! Current revisions: 20 20 ! ----------------- 21 ! 21 ! Rename subroutines and cpu-measure log points to indicate default version 22 22 ! 23 23 ! Former revisions: … … 92 92 REAL(wp), DIMENSION(:,:), SAVE, ALLOCATABLE :: f1_mg_b, f2_mg_b, f3_mg_b !< blocked version of f1_mg ... 93 93 94 INTERFACE poismg _fast95 MODULE PROCEDURE poismg _fast96 END INTERFACE poismg _fast94 INTERFACE poismg 95 MODULE PROCEDURE poismg 96 END INTERFACE poismg 97 97 98 98 INTERFACE sort_k_to_even_odd_blocks … … 102 102 END INTERFACE sort_k_to_even_odd_blocks 103 103 104 PUBLIC poismg _fast104 PUBLIC poismg 105 105 106 106 CONTAINS … … 112 112 !> V- or W-Cycle scheme. 113 113 !------------------------------------------------------------------------------! 114 SUBROUTINE poismg _fast( r )114 SUBROUTINE poismg( r ) 115 115 116 116 USE arrays_3d, & … … 140 140 141 141 142 CALL cpu_log( log_point_s(29), 'poismg _fast', 'start' )142 CALL cpu_log( log_point_s(29), 'poismg', 'start' ) 143 143 ! 144 144 !-- Initialize arrays and variables used in this subroutine … … 198 198 mgcycles < maximum_mgcycles ) 199 199 200 CALL next_mg_level _fast( d, p_loc, p3, r)200 CALL next_mg_level( d, p_loc, p3, r) 201 201 202 202 ! … … 204 204 !-- cycles to be performed 205 205 IF ( maximum_mgcycles == 0 ) THEN 206 CALL resid _fast( d, p_loc, r )206 CALL resid( d, p_loc, r ) 207 207 maxerror = SUM( r(nzb+1:nzt,nys:nyn,nxl:nxr)**2 ) 208 208 … … 224 224 IF ( mgcycles > 1000 .AND. mg_cycles == -1 ) THEN 225 225 message_string = 'no sufficient convergence within 1000 cycles' 226 CALL message( 'poismg _fast', 'PA0283', 1, 2, 0, 6, 0 )226 CALL message( 'poismg', 'PA0283', 1, 2, 0, 6, 0 ) 227 227 ENDIF 228 228 … … 238 238 grid_level = 0 239 239 240 CALL cpu_log( log_point_s(29), 'poismg _fast', 'stop' )241 242 END SUBROUTINE poismg _fast240 CALL cpu_log( log_point_s(29), 'poismg', 'stop' ) 241 242 END SUBROUTINE poismg 243 243 244 244 … … 248 248 !> Computes the residual of the perturbation pressure. 249 249 !------------------------------------------------------------------------------! 250 SUBROUTINE resid _fast( f_mg, p_mg, r )250 SUBROUTINE resid( f_mg, p_mg, r ) 251 251 252 252 … … 366 366 CALL cpu_log( log_point_s(53), 'resid', 'stop' ) 367 367 368 END SUBROUTINE resid _fast368 END SUBROUTINE resid 369 369 370 370 … … 375 375 !> scheme 376 376 !------------------------------------------------------------------------------! 377 SUBROUTINE restrict _fast( f_mg, r )377 SUBROUTINE restrict( f_mg, r ) 378 378 379 379 … … 503 503 CALL sort_k_to_even_odd_blocks( f_mg , l) 504 504 505 END SUBROUTINE restrict _fast505 END SUBROUTINE restrict 506 506 507 507 … … 512 512 !> to the next finer grid. 513 513 !------------------------------------------------------------------------------! 514 SUBROUTINE prolong _fast( p, temp )514 SUBROUTINE prolong( p, temp ) 515 515 516 516 … … 670 670 CALL cpu_log( log_point_s(55), 'prolong', 'stop' ) 671 671 672 END SUBROUTINE prolong _fast672 END SUBROUTINE prolong 673 673 674 674 … … 679 679 !> 3D-Red-Black decomposition (GS-RB) is used. 680 680 !------------------------------------------------------------------------------! 681 SUBROUTINE redblack _fast( f_mg, p_mg )681 SUBROUTINE redblack( f_mg, p_mg ) 682 682 683 683 … … 981 981 ENDDO 982 982 983 END SUBROUTINE redblack _fast983 END SUBROUTINE redblack 984 984 985 985 … … 1236 1236 !> Gather subdomain data from all PEs. 1237 1237 !------------------------------------------------------------------------------! 1238 SUBROUTINE mg_gather _fast( f2, f2_sub )1238 SUBROUTINE mg_gather( f2, f2_sub ) 1239 1239 1240 1240 USE control_parameters, & … … 1307 1307 #endif 1308 1308 1309 END SUBROUTINE mg_gather _fast1309 END SUBROUTINE mg_gather 1310 1310 1311 1311 … … 1317 1317 !> non-blocking communication 1318 1318 !------------------------------------------------------------------------------! 1319 SUBROUTINE mg_scatter _fast( p2, p2_sub )1319 SUBROUTINE mg_scatter( p2, p2_sub ) 1320 1320 1321 1321 USE control_parameters, & … … 1353 1353 #endif 1354 1354 1355 END SUBROUTINE mg_scatter _fast1355 END SUBROUTINE mg_scatter 1356 1356 1357 1357 … … 1366 1366 !> but leads to an increase in computing time. 1367 1367 !------------------------------------------------------------------------------! 1368 RECURSIVE SUBROUTINE next_mg_level _fast( f_mg, p_mg, p3, r )1368 RECURSIVE SUBROUTINE next_mg_level( f_mg, p_mg, p3, r ) 1369 1369 1370 1370 USE control_parameters, & … … 1425 1425 ind_even_odd = even_odd_level(grid_level) 1426 1426 1427 CALL redblack _fast( f_mg, p_mg )1427 CALL redblack( f_mg, p_mg ) 1428 1428 1429 1429 ngsrb = ngsrb / 2 … … 1438 1438 ind_even_odd = even_odd_level(grid_level) 1439 1439 1440 CALL redblack _fast( f_mg, p_mg )1440 CALL redblack( f_mg, p_mg ) 1441 1441 1442 1442 ! 1443 1443 !-- Determination of the actual residual 1444 CALL resid _fast( f_mg, p_mg, r )1444 CALL resid( f_mg, p_mg, r ) 1445 1445 1446 1446 !-- Restriction of the residual (finer grid values!) to the next coarser … … 1485 1485 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ) 1486 1486 1487 CALL restrict _fast( f2_sub, r )1487 CALL restrict( f2_sub, r ) 1488 1488 1489 1489 ! … … 1501 1501 ! 1502 1502 !-- Gather all arrays from the subdomains on PE0 1503 CALL mg_gather _fast( f2, f2_sub )1503 CALL mg_gather( f2, f2_sub ) 1504 1504 1505 1505 ! … … 1546 1546 ELSE 1547 1547 1548 CALL restrict _fast( f2, r )1548 CALL restrict( f2, r ) 1549 1549 1550 1550 ind_even_odd = even_odd_level(grid_level) ! must be after restrict … … 1556 1556 ! 1557 1557 !-- Repeat the same procedure till the coarsest grid is reached 1558 CALL next_mg_level _fast( f2, p2, p3, r )1558 CALL next_mg_level( f2, p2, p3, r ) 1559 1559 1560 1560 ENDIF … … 1577 1577 mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) ) 1578 1578 1579 CALL mg_scatter _fast( p2, p2_sub )1579 CALL mg_scatter( p2, p2_sub ) 1580 1580 1581 1581 ! … … 1647 1647 ENDIF 1648 1648 1649 CALL prolong _fast( p2_sub, p3 )1649 CALL prolong( p2_sub, p3 ) 1650 1650 1651 1651 ! … … 1662 1662 ELSE 1663 1663 1664 CALL prolong _fast( p2, p3 )1664 CALL prolong( p2, p3 ) 1665 1665 1666 1666 ENDIF … … 1679 1679 ! 1680 1680 !-- Relaxation of the new solution 1681 CALL redblack _fast( f_mg, p_mg )1681 CALL redblack( f_mg, p_mg ) 1682 1682 1683 1683 ENDIF … … 1698 1698 1699 1699 ! 1700 !-- Reset counter for the next call of poismg _fast1700 !-- Reset counter for the next call of poismg 1701 1701 grid_level_count(grid_level) = 0 1702 1702 … … 1716 1716 20 CONTINUE 1717 1717 1718 END SUBROUTINE next_mg_level _fast1718 END SUBROUTINE next_mg_level 1719 1719 1720 1720
Note: See TracChangeset
for help on using the changeset viewer.