Changeset 1931 for palm/trunk/SOURCE
- Timestamp:
- Jun 10, 2016 12:06:59 PM (8 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 6 edited
- 2 moved
-
Makefile (modified) (3 diffs)
-
check_parameters.f90 (modified) (2 diffs)
-
cpulog_mod.f90 (modified) (4 diffs)
-
header.f90 (modified) (2 diffs)
-
init_grid.f90 (modified) (7 diffs)
-
poismg_mod.f90 (moved) (moved from palm/trunk/SOURCE/poismg_fast_mod.f90) (35 diffs)
-
poismg_noopt.f90 (moved) (moved from palm/trunk/SOURCE/poismg.f90) (38 diffs)
-
pres.f90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/Makefile
r1917 r1931 20 20 # Current revisions: 21 21 # ------------------ 22 # 22 # poismg renamed poismg_noopt, poismg_fast_mod renamed poismg_mod 23 23 # 24 24 # Former revisions: … … 310 310 package_parin.f90 palm.f90 parin.f90 plant_canopy_model_mod.f90 pmc_interface_mod.f90 \ 311 311 pmc_client_mod.f90 pmc_general_mod.f90 pmc_handle_communicator_mod.f90 \ 312 pmc_mpi_wrapper_mod.f90 pmc_server_mod.f90 poisfft_mod.f90 poismg .f90 \313 poismg_ fast_mod.f90 pres.f90 print_1d.f90 production_e.f90 \312 pmc_mpi_wrapper_mod.f90 pmc_server_mod.f90 poisfft_mod.f90 poismg_mod.f90 \ 313 poismg_noopt.f90 pres.f90 print_1d.f90 production_e.f90 \ 314 314 prognostic_equations.f90 progress_bar_mod.f90 radiation_model_mod.f90 \ 315 315 random_function_mod.f90 random_gauss.f90 random_generator_parallel_mod.f90 \ … … 501 501 pmc_server_mod.o: pmc_general_mod.o pmc_handle_communicator_mod.o pmc_mpi_wrapper_mod.o 502 502 poisfft_mod.o: modules.o cpulog_mod.o fft_xy_mod.o mod_kinds.o tridia_solver_mod.o 503 poismg .o: modules.o cpulog_mod.o mod_kinds.o504 poismg_ fast_mod.o: modules.o cpulog_mod.o mod_kinds.o505 pres.o: modules.o cpulog_mod.o mod_kinds.o poisfft_mod.o poismg_ fast_mod.o503 poismg_mod.o: modules.o cpulog_mod.o mod_kinds.o 504 poismg_noopt.o: modules.o cpulog_mod.o mod_kinds.o 505 pres.o: modules.o cpulog_mod.o mod_kinds.o poisfft_mod.o poismg_mod.o 506 506 print_1d.o: modules.o cpulog_mod.o mod_kinds.o 507 507 production_e.o: modules.o mod_kinds.o wall_fluxes.o -
palm/trunk/SOURCE/check_parameters.f90
r1930 r1931 19 19 ! Current revisions: 20 20 ! ----------------- 21 ! 21 ! Rename multigrid into multigrid_noopt and multigrid_fast into multigrid 22 22 ! 23 23 ! Former revisions: … … 829 829 !-- Pressure solver: 830 830 IF ( psolver /= 'poisfft' .AND. psolver /= 'sor' .AND. & 831 psolver /= 'multigrid' .AND. psolver /= 'multigrid_ fast' ) THEN831 psolver /= 'multigrid' .AND. psolver /= 'multigrid_noopt' ) THEN 832 832 message_string = 'unknown solver for perturbation pressure: psolver' // & 833 833 ' = "' // TRIM( psolver ) // '"' -
palm/trunk/SOURCE/cpulog_mod.f90
r1851 r1931 19 19 ! Current revisions: 20 20 ! ----------------- 21 ! 21 ! Adjustment in character length and format statement 22 22 ! 23 23 ! Former revisions: … … 155 155 REAL(wp) :: vector !< 156 156 INTEGER(iwp) :: counts !< 157 CHARACTER (LEN=2 0) :: place !<157 CHARACTER (LEN=25) :: place !< 158 158 END TYPE logpoint 159 159 … … 550 550 101 FORMAT (/'special measures:'/ & 551 551 &'-----------------------------------------------------------', & 552 &'-------------------- ')553 554 102 FORMAT (A2 0,2X,F9.3,2X,F7.2,1X,I7,3(1X,F9.3))552 &'------------------------') 553 554 102 FORMAT (A25,2X,F9.3,2X,F7.2,1X,I7,3(1X,F9.3)) 555 555 103 FORMAT (/'Barriers are set in front of collective operations') 556 556 104 FORMAT (/'No barriers are set in front of collective operations') … … 560 560 108 FORMAT ('Accelerator boards per node: ',14X,I2) 561 561 109 FORMAT ('Accelerator boards: ',23X,I2) 562 110 FORMAT ('---------------------------------------------------------- ',&563 &'--------- ---'//&564 &'place: mean counts min ',&562 110 FORMAT ('-------------------------------------------------------------', & 563 &'---------'//& 564 &'place: mean counts min ',& 565 565 &' max rms'/ & 566 &' sec. % sec. ', &566 &' sec. % sec. ', & 567 567 &' sec. sec.'/ & 568 &'-----------------------------------------------------------', &569 &'------------------- ')568 &'-----------------------------------------------------------', & 569 &'------------------------') 570 570 111 FORMAT (/'Barriers are set at beginning (start/continue) of measurements') 571 571 -
palm/trunk/SOURCE/header.f90
r1903 r1931 19 19 ! Current revisions: 20 20 ! ----------------- 21 ! 21 ! Rename multigrid into multigrid_noopt 22 22 ! 23 23 ! Former revisions: … … 553 553 nzt_mg(1) 554 554 ENDIF 555 IF ( psolver == 'multigrid ' .AND. masking_method ) WRITE ( io, 144 )555 IF ( psolver == 'multigrid_noopt' .AND. masking_method ) WRITE ( io, 144 ) 556 556 ENDIF 557 557 IF ( call_psolver_at_all_substeps .AND. timestep_scheme(1:5) == 'runge' ) & -
palm/trunk/SOURCE/init_grid.f90
r1911 r1931 19 19 ! Current revisions: 20 20 ! ----------------- 21 ! 21 ! Rename multigrid into multigrid_noopt and multigrid_fast into multigrid 22 22 ! 23 23 ! Former revisions: … … 225 225 INTEGER(iwp) :: cyn !< index for north canyon wall 226 226 INTEGER(iwp) :: cys !< index for south canyon wall 227 INTEGER(iwp) :: gls !< number of lateral ghost points at total model 228 !< domain boundaries required for multigrid solver 227 INTEGER(iwp) :: gls !< number of lateral ghost points at total model domain boundaries required for multigrid solver 229 228 INTEGER(iwp) :: i !< index variable along x 230 229 INTEGER(iwp) :: ii !< loop variable for reading topography file … … 242 241 243 242 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: & 244 vertical_influence !< number of vertical grid points above 245 !< obstacle where adjustment of near- 246 !< wall mixing length is required 243 vertical_influence !< number of vertical grid points above obstacle where adjustment of near-wall mixing length is required 247 244 248 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: corner_nl !< index of 249 !< north-left corner location to limit 250 !< near-wall mixing length 245 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: corner_nl !< index of north-left corner location to limit near-wall mixing length 251 246 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: corner_nr !< north-right 252 247 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: corner_sl !< south-left 253 248 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: corner_sr !< south-right 254 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: wall_l !< distance to 255 !< adjacent left-facing 249 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: wall_l !< distance to adjacent left-facing 256 250 !< wall 257 251 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: wall_n !< north-facing … … 260 254 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: nzb_local !< index for topography 261 255 !< top at cell-center 262 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: nzb_tmp !< dummy to calculate 263 !< topography indices 264 !< on u- and v-grid 256 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: nzb_tmp !< dummy to calculate topography indices on u- and v-grid 265 257 266 258 LOGICAL :: flag_set = .FALSE. !< steering variable for advection flags … … 270 262 REAL(wp) :: dz_stretched !< stretched vertical grid spacing 271 263 272 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: topo_height !< input variable for 273 !< topography height 264 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: topo_height !< input variable for topography height 274 265 275 266 … … 1138 1129 1139 1130 ! 1140 !-- Calculate wall flag arrays for the multigrid method 1141 IF ( psolver(1:9) == 'multigrid' ) THEN 1131 !-- Calculate wall flag arrays for the multigrid method. 1132 !-- Please note, wall flags are only applied in the not cache-optimized 1133 !-- version. 1134 IF ( psolver == 'multigrid_noopt' ) THEN 1142 1135 ! 1143 1136 !-- Gridpoint increment of the current level … … 1193 1186 !-- In case of masking method, flags are not set and multigrid method 1194 1187 !-- works like FFT-solver 1195 IF ( psolver == 'multigrid' .AND..NOT. masking_method ) THEN1188 IF ( .NOT. masking_method ) THEN 1196 1189 1197 1190 DO i = nxl_l-1, nxr_l+1 -
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 -
palm/trunk/SOURCE/poismg_noopt.f90
r1930 r1931 1 !> @file poismg .f901 !> @file poismg_noopt.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 _noopt version 22 22 ! 23 23 ! Former revisions: … … 129 129 !> @todo Further work required. 130 130 !------------------------------------------------------------------------------! 131 SUBROUTINE poismg ( r )131 SUBROUTINE poismg_noopt( r ) 132 132 133 133 … … 162 162 163 163 164 CALL cpu_log( log_point_s(29), 'poismg ', 'start' )164 CALL cpu_log( log_point_s(29), 'poismg_noopt', 'start' ) 165 165 ! 166 166 !-- Initialize arrays and variables used in this subroutine … … 206 206 mgcycles < maximum_mgcycles ) 207 207 208 CALL next_mg_level ( d, p_loc, p3, r)208 CALL next_mg_level_noopt( d, p_loc, p3, r) 209 209 210 210 ! … … 212 212 !-- cycles to be performed 213 213 IF ( maximum_mgcycles == 0 ) THEN 214 CALL resid ( d, p_loc, r )214 CALL resid_noopt( d, p_loc, r ) 215 215 maxerror = SUM( r(nzb+1:nzt,nys:nyn,nxl:nxr)**2 ) 216 216 … … 232 232 IF ( mgcycles > 1000 .AND. mg_cycles == -1 ) THEN 233 233 message_string = 'no sufficient convergence within 1000 cycles' 234 CALL message( 'poismg ', 'PA0283', 1, 2, 0, 6, 0 )234 CALL message( 'poismg_noopt', 'PA0283', 1, 2, 0, 6, 0 ) 235 235 ENDIF 236 236 … … 244 244 grid_level = 0 245 245 246 CALL cpu_log( log_point_s(29), 'poismg ', 'stop' )247 248 END SUBROUTINE poismg 246 CALL cpu_log( log_point_s(29), 'poismg_noopt', 'stop' ) 247 248 END SUBROUTINE poismg_noopt 249 249 250 250 … … 254 254 !> Computes the residual of the perturbation pressure. 255 255 !------------------------------------------------------------------------------! 256 SUBROUTINE resid ( f_mg, p_mg, r )256 SUBROUTINE resid_noopt( f_mg, p_mg, r ) 257 257 258 258 … … 391 391 392 392 393 END SUBROUTINE resid 393 END SUBROUTINE resid_noopt 394 394 395 395 … … 400 400 !> scheme. 401 401 !------------------------------------------------------------------------------! 402 SUBROUTINE restrict ( f_mg, r )402 SUBROUTINE restrict_noopt( f_mg, r ) 403 403 404 404 … … 607 607 608 608 609 END SUBROUTINE restrict 609 END SUBROUTINE restrict_noopt 610 610 611 611 … … 616 616 !> to the next finer grid. 617 617 !------------------------------------------------------------------------------! 618 SUBROUTINE prolong ( p, temp )618 SUBROUTINE prolong_noopt( p, temp ) 619 619 620 620 … … 722 722 723 723 724 END SUBROUTINE prolong 724 END SUBROUTINE prolong_noopt 725 725 726 726 … … 731 731 !> 3D-Red-Black decomposition (GS-RB) is used. 732 732 !------------------------------------------------------------------------------! 733 SUBROUTINE redblack ( f_mg, p_mg )733 SUBROUTINE redblack_noopt( f_mg, p_mg ) 734 734 735 735 … … 821 821 IF ( .NOT. unroll ) THEN 822 822 823 CALL cpu_log( log_point_s(36), 'redblack_no_unroll ', 'start' )823 CALL cpu_log( log_point_s(36), 'redblack_no_unroll_noopt', 'start' ) 824 824 825 825 ! … … 923 923 ENDDO 924 924 ENDDO 925 CALL cpu_log( log_point_s(36), 'redblack_no_unroll ', 'stop' )925 CALL cpu_log( log_point_s(36), 'redblack_no_unroll_noopt', 'stop' ) 926 926 927 927 ELSE … … 929 929 ! 930 930 !-- Loop unrolling along y, only one i loop for better cache use 931 CALL cpu_log( log_point_s(38), 'redblack_unroll ', 'start' )931 CALL cpu_log( log_point_s(38), 'redblack_unroll_noopt', 'start' ) 932 932 DO ic = nxl_mg(l), nxr_mg(l), 2 933 933 DO jc = nys_mg(l), nyn_mg(l), 4 … … 1090 1090 ENDDO 1091 1091 ENDDO 1092 CALL cpu_log( log_point_s(38), 'redblack_unroll ', 'stop' )1092 CALL cpu_log( log_point_s(38), 'redblack_unroll_noopt', 'stop' ) 1093 1093 1094 1094 ENDIF … … 1174 1174 1175 1175 1176 END SUBROUTINE redblack 1176 END SUBROUTINE redblack_noopt 1177 1177 1178 1178 … … 1183 1183 !> Gather subdomain data from all PEs. 1184 1184 !------------------------------------------------------------------------------! 1185 SUBROUTINE mg_gather ( f2, f2_sub )1185 SUBROUTINE mg_gather_noopt( f2, f2_sub ) 1186 1186 1187 1187 USE control_parameters, & … … 1222 1222 1223 1223 #if defined( __parallel ) 1224 CALL cpu_log( log_point_s(34), 'mg_gather ', 'start' )1224 CALL cpu_log( log_point_s(34), 'mg_gather_noopt', 'start' ) 1225 1225 1226 1226 f2_l = 0.0_wp … … 1255 1255 nwords, MPI_REAL, MPI_SUM, comm2d, ierr ) 1256 1256 1257 CALL cpu_log( log_point_s(34), 'mg_gather ', 'stop' )1257 CALL cpu_log( log_point_s(34), 'mg_gather_noopt', 'stop' ) 1258 1258 #endif 1259 1259 1260 END SUBROUTINE mg_gather 1260 END SUBROUTINE mg_gather_noopt 1261 1261 1262 1262 … … 1268 1268 !> non-blocking communication 1269 1269 !------------------------------------------------------------------------------! 1270 SUBROUTINE mg_scatter ( p2, p2_sub )1270 SUBROUTINE mg_scatter_noopt( p2, p2_sub ) 1271 1271 1272 1272 USE control_parameters, & … … 1300 1300 1301 1301 #if defined( __parallel ) 1302 CALL cpu_log( log_point_s(35), 'mg_scatter ', 'start' )1302 CALL cpu_log( log_point_s(35), 'mg_scatter_noopt', 'start' ) 1303 1303 1304 1304 p2_sub = p2(:,mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1, & 1305 1305 mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) 1306 1306 1307 CALL cpu_log( log_point_s(35), 'mg_scatter ', 'stop' )1307 CALL cpu_log( log_point_s(35), 'mg_scatter_noopt', 'stop' ) 1308 1308 #endif 1309 1309 1310 END SUBROUTINE mg_scatter 1310 END SUBROUTINE mg_scatter_noopt 1311 1311 1312 1312 … … 1321 1321 !> but leads to an increase in computing time. 1322 1322 !------------------------------------------------------------------------------! 1323 RECURSIVE SUBROUTINE next_mg_level ( f_mg, p_mg, p3, r )1323 RECURSIVE SUBROUTINE next_mg_level_noopt( f_mg, p_mg, p3, r ) 1324 1324 1325 1325 USE control_parameters, & … … 1383 1383 ngsrb = 2 * ngsrb 1384 1384 1385 CALL redblack ( f_mg, p_mg )1385 CALL redblack_noopt( f_mg, p_mg ) 1386 1386 1387 1387 ngsrb = ngsrb / 2 … … 1394 1394 ! 1395 1395 !-- Solution on the actual grid level 1396 CALL redblack ( f_mg, p_mg )1396 CALL redblack_noopt( f_mg, p_mg ) 1397 1397 1398 1398 ! 1399 1399 !-- Determination of the actual residual 1400 CALL resid ( f_mg, p_mg, r )1400 CALL resid_noopt( f_mg, p_mg, r ) 1401 1401 1402 1402 ! … … 1441 1441 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ) 1442 1442 1443 CALL restrict ( f2_sub, r )1443 CALL restrict_noopt( f2_sub, r ) 1444 1444 1445 1445 ! … … 1457 1457 ! 1458 1458 !-- Gather all arrays from the subdomains on PE0 1459 CALL mg_gather ( f2, f2_sub )1459 CALL mg_gather_noopt( f2, f2_sub ) 1460 1460 1461 1461 ! … … 1502 1502 ELSE 1503 1503 1504 CALL restrict ( f2, r )1504 CALL restrict_noopt( f2, r ) 1505 1505 1506 1506 ENDIF … … 1510 1510 ! 1511 1511 !-- Repeat the same procedure till the coarsest grid is reached 1512 CALL next_mg_level ( f2, p2, p3, r )1512 CALL next_mg_level_noopt( f2, p2, p3, r ) 1513 1513 1514 1514 ENDIF … … 1531 1531 mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) ) 1532 1532 1533 CALL mg_scatter ( p2, p2_sub )1533 CALL mg_scatter_noopt( p2, p2_sub ) 1534 1534 1535 1535 ! … … 1601 1601 ENDIF 1602 1602 1603 CALL prolong ( p2_sub, p3 )1603 CALL prolong_noopt( p2_sub, p3 ) 1604 1604 1605 1605 ! … … 1616 1616 ELSE 1617 1617 1618 CALL prolong ( p2, p3 )1618 CALL prolong_noopt( p2, p3 ) 1619 1619 1620 1620 ENDIF … … 1633 1633 ! 1634 1634 !-- Relaxation of the new solution 1635 CALL redblack ( f_mg, p_mg )1635 CALL redblack_noopt( f_mg, p_mg ) 1636 1636 1637 1637 ENDIF … … 1652 1652 1653 1653 ! 1654 !-- Reset counter for the next call of poismg 1654 !-- Reset counter for the next call of poismg_noopt 1655 1655 grid_level_count(grid_level) = 0 1656 1656 … … 1668 1668 20 CONTINUE 1669 1669 1670 END SUBROUTINE next_mg_level 1670 END SUBROUTINE next_mg_level_noopt -
palm/trunk/SOURCE/pres.f90
r1930 r1931 19 19 ! Current revisions: 20 20 ! ------------------ 21 ! 21 ! Rename multigrid into multigrid_noopt and multigrid_fast into multigrid 22 22 ! 23 23 ! Former revisions: … … 570 570 CALL poismg( tend ) 571 571 ELSE 572 CALL poismg_ fast( tend )572 CALL poismg_noopt( tend ) 573 573 ENDIF 574 574
Note: See TracChangeset
for help on using the changeset viewer.
