Changeset 4429 for palm/trunk/SOURCE
- Timestamp:
- Feb 27, 2020 3:24:30 PM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 14 edited
-
advec_s_bc.f90 (modified) (2 diffs)
-
cpulog_mod.f90 (modified) (2 diffs)
-
data_output_netcdf4_module.f90 (modified) (3 diffs)
-
exchange_horiz.f90 (modified) (3 diffs)
-
global_min_max.f90 (modified) (2 diffs)
-
inflow_turbulence.f90 (modified) (4 diffs)
-
land_surface_model_mod.f90 (modified) (3 diffs)
-
poisfft_mod.f90 (modified) (6 diffs)
-
poismg_mod.f90 (modified) (15 diffs)
-
poismg_noopt_mod.f90 (modified) (10 diffs)
-
radiation_model_mod.f90 (modified) (11 diffs)
-
spectra_mod.f90 (modified) (14 diffs)
-
surface_coupler.f90 (modified) (9 diffs)
-
transpose.f90 (modified) (21 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/advec_s_bc.f90
r4360 r4429 25 25 ! ----------------- 26 26 ! $Id$ 27 ! bugfix: cpp-directives added for serial mode 28 ! 29 ! 4360 2020-01-07 11:25:50Z suehring 27 30 ! Corrected "Former revisions" section 28 31 ! … … 104 107 INTEGER(iwp) :: j !< 105 108 INTEGER(iwp) :: k !< 109 INTEGER(iwp) :: sr !< 110 #if defined( __parallel ) 106 111 INTEGER(iwp) :: ngp !< 107 INTEGER(iwp) :: sr !<108 112 INTEGER(iwp) :: type_xz_2 !< 113 #endif 109 114 110 115 REAL(wp) :: cim !< -
palm/trunk/SOURCE/cpulog_mod.f90
r4378 r4429 25 25 ! ----------------- 26 26 ! $Id$ 27 ! bugfix: cpp-directives added for serial mode 28 ! 29 ! 4378 2020-01-16 13:22:48Z Giersch 27 30 ! Format of rms output changed to allow values >= 100 28 31 ! … … 263 266 INTEGER(iwp) :: i !< 264 267 INTEGER(iwp) :: ii(1) !< 268 #if defined( __parallel ) 265 269 INTEGER(iwp) :: iii !< 266 INTEGER(iwp) :: sender !< 270 INTEGER(iwp) :: sender !< 271 #endif 267 272 REAL(dp) :: average_cputime !< 268 273 REAL(dp), SAVE :: norm = 1.0_dp !< -
palm/trunk/SOURCE/data_output_netcdf4_module.f90
r4408 r4429 25 25 ! ----------------- 26 26 ! $Id$ 27 ! bugfix: cpp-directive moved to avoid compile error due to unused dummy argument 28 ! 29 ! 4408 2020-02-14 10:04:39Z gronemeier 27 30 ! Enable character-array output 28 31 ! … … 427 430 nc_stat = NF90_DEF_VAR( file_id, variable_name, nc_variable_type, dimension_ids, variable_id ) 428 431 429 #if defined( __netcdf4_parallel )430 432 ! 431 433 !-- Define how variable can be accessed by PEs in parallel netcdf file 432 434 IF ( nc_stat == NF90_NOERR .AND. TRIM( mode ) == mode_parallel ) THEN 435 #if defined( __netcdf4_parallel ) 433 436 IF ( is_global ) THEN 434 437 nc_stat = NF90_VAR_PAR_ACCESS( file_id, variable_id, NF90_INDEPENDENT ) … … 436 439 nc_stat = NF90_VAR_PAR_ACCESS( file_id, variable_id, NF90_COLLECTIVE ) 437 440 ENDIF 441 #else 442 CONTINUE 443 #endif 438 444 ENDIF 439 #endif440 445 441 446 IF ( nc_stat /= NF90_NOERR ) THEN -
palm/trunk/SOURCE/exchange_horiz.f90
r4360 r4429 25 25 ! ----------------- 26 26 ! $Id$ 27 ! bugfix: cpp-directives added for serial mode 28 ! 29 ! 4360 2020-01-07 11:25:50Z suehring 27 30 ! Corrected "Former revisions" section 28 31 ! … … 46 49 47 50 USE control_parameters, & 48 ONLY: bc_lr_cyc, bc_ns_cyc, grid_level, mg_switch_to_pe0, synchronous_exchange 51 ONLY: bc_lr_cyc, bc_ns_cyc 52 53 #if defined( __parallel ) 54 USE control_parameters, & 55 ONLY: grid_level, mg_switch_to_pe0, synchronous_exchange 56 #endif 49 57 50 58 USE cpulog, & … … 272 280 !> @todo Missing subroutine description. 273 281 !------------------------------------------------------------------------------! 274 SUBROUTINE exchange_horiz_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nzt_l, nbgp_local) 282 SUBROUTINE exchange_horiz_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nzt_l, nbgp_local ) 283 275 284 276 285 USE control_parameters, & 277 ONLY: bc_lr_cyc, bc_ns_cyc, grid_level 286 ONLY: bc_lr_cyc, bc_ns_cyc 287 288 #if defined( __parallel ) 289 USE control_parameters, & 290 ONLY: grid_level 291 #endif 278 292 279 293 USE indices, & -
palm/trunk/SOURCE/global_min_max.f90
r4360 r4429 25 25 ! ----------------- 26 26 ! $Id$ 27 ! bugfix: cpp-directives added for serial mode 28 ! 29 ! 4360 2020-01-07 11:25:50Z suehring 27 30 ! OpenACC support added 28 31 ! … … 59 62 INTEGER(iwp) :: i1 !< 60 63 INTEGER(iwp) :: i2 !< 64 #if defined( __parallel ) 61 65 INTEGER(iwp) :: id_fmax !< 62 66 INTEGER(iwp) :: id_fmin !< 67 #endif 63 68 INTEGER(iwp) :: j !< 64 69 INTEGER(iwp) :: j1 !< -
palm/trunk/SOURCE/inflow_turbulence.f90
r4360 r4429 25 25 ! ----------------- 26 26 ! $Id$ 27 ! bugfix: cpp-directives added for serial mode 28 ! 29 ! 4360 2020-01-07 11:25:50Z suehring 27 30 ! use y_shift instead of old parameter recycling_yshift 28 31 ! … … 57 60 ONLY: e, inflow_damping_factor, mean_inflow_profiles, pt, q, s, u, v, w 58 61 62 #if defined( __parallel ) 59 63 USE control_parameters, & 60 ONLY: humidity, passive_scalar, recycling_plane, y_shift, &64 ONLY: humidity, passive_scalar, recycling_plane, y_shift, & 61 65 recycling_method_for_thermodynamic_quantities 66 #else 67 USE control_parameters, & 68 ONLY: humidity, passive_scalar, recycling_plane, & 69 recycling_method_for_thermodynamic_quantities 70 #endif 62 71 63 72 USE cpulog, & … … 78 87 INTEGER(iwp) :: k !< loop index 79 88 INTEGER(iwp) :: l !< loop index 80 INTEGER(iwp) :: next !< ID of receiving PE for y-shift81 89 INTEGER(iwp) :: ngp_ifd !< number of grid points stored in avpr 82 90 INTEGER(iwp) :: ngp_pr !< number of grid points stored in inflow_dist 91 #if defined( __parallel ) 92 INTEGER(iwp) :: next !< ID of receiving PE for y-shift 83 93 INTEGER(iwp) :: prev !< ID of sending PE for y-shift 94 #endif 84 95 85 96 REAL(wp), DIMENSION(nzb:nzt+1,7,nbgp) :: & … … 89 100 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,7,nbgp) :: & 90 101 inflow_dist !< turbulence signal of vars, added at inflow boundary 102 #if defined( __parallel ) 91 103 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,7,nbgp) :: & 92 104 local_inflow_dist !< auxiliary variable for inflow_dist, used for y-shift 105 #endif 93 106 94 107 CALL cpu_log( log_point(40), 'inflow_turbulence', 'start' ) -
palm/trunk/SOURCE/land_surface_model_mod.f90
r4381 r4429 25 25 ! ----------------- 26 26 ! $Id$ 27 ! bugfix: missing cpp-directives for serial mode added, misplaced cpp-directives moved 28 ! 29 ! 4381 2020-01-20 13:51:46Z suehring 27 30 ! - Bugfix in nested soil initialization in case no dynamic input file is 28 31 ! present … … 2332 2335 ONLY: nx, ny, topo_min_level 2333 2336 2337 #if defined( __parallel ) 2334 2338 USE pmc_handle_communicator, & 2335 2339 ONLY: pmc_is_rootmodel 2340 #endif 2336 2341 2337 2342 USE pmc_interface, & … … 4447 4452 DEALLOCATE( t_soil_root ) 4448 4453 ENDIF 4449 ENDIF4450 4454 #endif 4455 ENDIF 4451 4456 ! 4452 4457 !-- Proceed with Level 2 initialization. -
palm/trunk/SOURCE/poisfft_mod.f90
r4366 r4429 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Statements added to avoid compile errors due to unused dummy arguments in serial mode 28 ! 29 ! 4366 2020-01-09 08:12:43Z raasch 27 30 ! modification concerning NEC vectorizatio 28 31 ! … … 780 783 comm1dx, ierr ) 781 784 CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' ) 785 #else 786 ! 787 !-- Next line required to avoid compile error about unused dummy argument in serial mode 788 i = SIZE( f_out ) 782 789 #endif 783 790 … … 830 837 comm1dx, ierr ) 831 838 CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' ) 839 #else 840 ! 841 !-- Next line required to avoid compile error about unused dummy argument in serial mode 842 i = SIZE( f_in ) 832 843 #endif 833 844 … … 1172 1183 comm1dy, ierr ) 1173 1184 CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' ) 1185 #else 1186 ! 1187 !-- Next line required to avoid compile error about unused dummy argument in serial mode 1188 i = SIZE( f_out ) 1174 1189 #endif 1175 1190 … … 1206 1221 REAL(wp), DIMENSION(1:nz,nys:nyn,0:nx) :: f_out !< 1207 1222 REAL(wp), DIMENSION(nys:nyn,1:nz,0:nx) :: work !< 1223 1208 1224 1209 1225 ! … … 1216 1232 comm1dy, ierr ) 1217 1233 CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' ) 1234 #else 1235 ! 1236 !-- Next line required to avoid compile error about unused dummy argument in serial mode 1237 i = SIZE( f_in ) 1218 1238 #endif 1219 1239 -
palm/trunk/SOURCE/poismg_mod.f90
r4360 r4429 25 25 ! ----------------- 26 26 ! $Id$ 27 ! statement added to avoid compile error due to unused dummy argument 28 ! bugfix: cpp-directives added for serial mode 29 ! 30 ! 4360 2020-01-07 11:25:50Z suehring 27 31 ! Corrected "Former revisions" section 28 32 ! … … 1210 1214 !> Gather subdomain data from all PEs. 1211 1215 !------------------------------------------------------------------------------! 1216 #if defined( __parallel ) 1212 1217 SUBROUTINE mg_gather( f2, f2_sub ) 1213 1218 … … 1244 1249 1245 1250 1246 #if defined( __parallel )1247 1251 CALL cpu_log( log_point_s(34), 'mg_gather', 'start' ) 1248 1252 … … 1279 1283 1280 1284 CALL cpu_log( log_point_s(34), 'mg_gather', 'stop' ) 1281 #endif1282 1285 1283 1286 END SUBROUTINE mg_gather 1284 1287 #endif 1285 1288 1286 1289 … … 1291 1294 !> non-blocking communication 1292 1295 !------------------------------------------------------------------------------! 1296 #if defined( __parallel ) 1293 1297 SUBROUTINE mg_scatter( p2, p2_sub ) 1294 1298 … … 1303 1307 1304 1308 IMPLICIT NONE 1305 1306 INTEGER(iwp) :: nwords !<1307 1309 1308 1310 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1, & … … 1314 1316 mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) :: p2_sub !< 1315 1317 1316 ! 1317 !-- Find out the number of array elements of the subdomain array 1318 nwords = SIZE( p2_sub ) 1319 1320 #if defined( __parallel ) 1318 1321 1319 CALL cpu_log( log_point_s(35), 'mg_scatter', 'start' ) 1322 1320 … … 1325 1323 1326 1324 CALL cpu_log( log_point_s(35), 'mg_scatter', 'stop' ) 1327 #endif1328 1325 1329 1326 END SUBROUTINE mg_scatter 1330 1327 #endif 1331 1328 1332 1329 !------------------------------------------------------------------------------! … … 1383 1380 1384 1381 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: f2_sub !< 1382 1383 #if defined( __parallel ) 1385 1384 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: p2_sub !< 1385 #endif 1386 1386 1387 1387 ! … … 1472 1472 ! 1473 1473 !-- Gather all arrays from the subdomains on PE0 1474 #if defined( __parallel ) 1474 1475 CALL mg_gather( f2, f2_sub ) 1476 #endif 1475 1477 1476 1478 ! … … 1760 1762 1761 1763 USE control_parameters, & 1762 ONLY: grid_level, mg_switch_to_pe0_level, synchronous_exchange 1764 ONLY: grid_level 1765 1766 #if defined( __parallel ) 1767 USE control_parameters, & 1768 ONLY: mg_switch_to_pe0_level, synchronous_exchange 1769 #endif 1763 1770 1764 1771 USE indices, & 1765 ONLY: nxl, nxl_mg, nxr, nxr_mg, nys, nys_mg, nyn, & 1766 nyn_mg, nzb, nzt, nzt_mg 1772 ONLY: nxl_mg, nxr_mg, nys_mg, nyn_mg, nzb, nzt_mg 1773 1774 #if defined( __parallel ) 1775 USE indices, & 1776 ONLY: nxl, nxr, nys, nyn, nzt 1777 #endif 1767 1778 1768 1779 IMPLICIT NONE … … 1773 1784 p_mg !< treated array 1774 1785 1775 INTEGER(iwp), intent(IN) :: color !< flag for grid point type (red or black) 1786 INTEGER(iwp), INTENT(IN) :: color !< flag for grid point type (red or black) 1787 1788 #if defined ( __parallel ) 1776 1789 ! 1777 1790 !-- Local variables … … 1794 1807 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: temp !< temporary array on next coarser grid level 1795 1808 1796 #if defined ( __parallel )1797 1809 synchronous_exchange_save = synchronous_exchange 1798 1810 synchronous_exchange = .FALSE. … … 2261 2273 2262 2274 IF ( i == nxl_mg(l) ) THEN 2263 !DIR$ IVDEP 2275 !DIR$ IVDEP INTEGER(iwp) :: ngp !< 2276 2264 2277 DO k = nzb+1, ind_even_odd 2265 2278 p_mg(k,j,nxr_mg(l)+1) = temp(k,j1,ixr+1) … … 2299 2312 2300 2313 ! 2314 !-- Next line is to avoid compile error due to unused dummy argument 2315 IF ( color == 1234567 ) RETURN 2316 ! 2301 2317 !-- Standard horizontal ghost boundary exchange for small coarse grid 2302 2318 !-- levels, where the transfer time is latency bound -
palm/trunk/SOURCE/poismg_noopt_mod.f90
r4414 r4429 25 25 ! ----------------- 26 26 ! $Id$ 27 ! bugfix: cpp-directives added for serial mode 28 ! 29 ! 4414 2020-02-19 20:16:04Z suehring 27 30 ! Remove double-declared use only construct. 28 31 ! … … 1172 1175 !> Gather subdomain data from all PEs. 1173 1176 !------------------------------------------------------------------------------! 1177 #if defined( __parallel ) 1174 1178 SUBROUTINE mg_gather_noopt( f2, f2_sub ) 1175 1179 … … 1207 1211 1208 1212 1209 #if defined( __parallel )1210 1213 CALL cpu_log( log_point_s(34), 'mg_gather_noopt', 'start' ) 1211 1214 … … 1242 1245 1243 1246 CALL cpu_log( log_point_s(34), 'mg_gather_noopt', 'stop' ) 1244 #endif1245 1247 1246 1248 END SUBROUTINE mg_gather_noopt 1247 1249 #endif 1248 1250 1249 1251 … … 1254 1256 !> non-blocking communication 1255 1257 !------------------------------------------------------------------------------! 1258 #if defined( __parallel ) 1256 1259 SUBROUTINE mg_scatter_noopt( p2, p2_sub ) 1257 1260 … … 1267 1270 1268 1271 IMPLICIT NONE 1269 1270 INTEGER(iwp) :: nwords !<1271 1272 1272 1273 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1, & … … 1278 1279 mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) :: p2_sub !< 1279 1280 1280 ! 1281 !-- Find out the number of array elements of the subdomain array 1282 nwords = SIZE( p2_sub ) 1283 1284 #if defined( __parallel ) 1281 1285 1282 CALL cpu_log( log_point_s(35), 'mg_scatter_noopt', 'start' ) 1286 1283 … … 1289 1286 1290 1287 CALL cpu_log( log_point_s(35), 'mg_scatter_noopt', 'stop' ) 1291 #endif1292 1288 1293 1289 END SUBROUTINE mg_scatter_noopt 1290 #endif 1294 1291 1295 1292 … … 1352 1349 1353 1350 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: f2_sub !< 1351 1352 #if defined( __parallel ) 1354 1353 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: p2_sub !< 1354 #endif 1355 1355 1356 1356 ! … … 1437 1437 ! 1438 1438 !-- Gather all arrays from the subdomains on PE0 1439 #if defined( __parallel ) 1439 1440 CALL mg_gather_noopt( f2, f2_sub ) 1441 #endif 1440 1442 1441 1443 ! -
palm/trunk/SOURCE/radiation_model_mod.f90
r4400 r4429 28 28 ! ----------------- 29 29 ! $Id$ 30 ! bugfixes: cpp-directives for serial mode moved, small changes to get serial mode compiled 31 ! 32 ! 4400 2020-02-10 20:32:41Z suehring 30 33 ! Initialize radiation arrays with zero 31 34 ! … … 795 798 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: csf !< array of plant canopy sink fators + direct irradiation factors (transparency) 796 799 REAL(wp), DIMENSION(:,:,:), POINTER :: sub_lad !< subset of lad_s within urban surface, transformed to plain Z coordinate 800 #if defined( __parallel ) 797 801 REAL(wp), DIMENSION(:), POINTER :: sub_lad_g !< sub_lad globalized (used to avoid MPI RMA calls in raytracing) 802 #endif 798 803 REAL(wp) :: prototype_lad !< prototype leaf area density for computing effective optical depth 799 804 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: nzterr, plantt !< temporary global arrays for raytracing … … 831 836 INTEGER(iwp) :: win_lad !< MPI RMA window for leaf area density 832 837 INTEGER(iwp) :: win_gridsurf !< MPI RMA window for reverse grid surface index 838 REAL(wp), DIMENSION(:), ALLOCATABLE :: lad_s_ray !< array of received lad_s for appropriate gridboxes crossed by ray 833 839 #endif 834 REAL(wp), DIMENSION(:), ALLOCATABLE :: lad_s_ray !< array of received lad_s for appropriate gridboxes crossed by ray835 840 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: target_surfl 836 841 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: rt2_track … … 1495 1500 ! 1496 1501 !-- Parallel rad_angular_discretization without raytrace_mpi_rma is not implemented 1502 !-- Serial mode does not allow mpi_rma 1497 1503 #if defined( __parallel ) 1498 1504 IF ( rad_angular_discretization .AND. .NOT. raytrace_mpi_rma ) THEN … … 1500 1506 'together with raytrace_mpi_rma or when ' // & 1501 1507 'no parallelization is applied.' 1502 CALL message( 'check_parameters', 'PA0486', 1, 2, 0, 6, 0 ) 1508 CALL message( 'readiation_check_parameters', 'PA0486', 1, 2, 0, 6, 0 ) 1509 ENDIF 1510 #else 1511 IF ( raytrace_mpi_rma ) THEN 1512 message_string = 'raytrace_mpi_rma = .T. not allowed in serial mode' 1513 CALL message( 'readiation_check_parameters', 'PA0710', 1, 2, 0, 6, 0 ) 1503 1514 ENDIF 1504 1515 #endif … … 7370 7381 7371 7382 INTEGER(iwp) :: udim 7372 INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET:: nzterrl_l7373 INTEGER(iwp), DIMENSION(:,:), POINTER :: nzterrl7374 7383 REAL(wp), DIMENSION(:), ALLOCATABLE,TARGET:: csflt_l, pcsflt_l 7375 7384 REAL(wp), DIMENSION(:,:), POINTER :: csflt, pcsflt … … 7385 7394 INTEGER(idp) :: ray_skip_maxdist, ray_skip_minval !< skipped raytracing counts 7386 7395 INTEGER(iwp) :: max_track_len !< maximum 2d track length 7396 #if defined( __parallel ) 7397 INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET:: nzterrl_l 7398 INTEGER(iwp), DIMENSION(:,:), POINTER :: nzterrl 7387 7399 INTEGER(iwp) :: minfo 7388 7400 REAL(wp), DIMENSION(:), POINTER, SAVE :: lad_s_rma !< fortran 1D pointer 7389 7401 TYPE(c_ptr) :: lad_s_rma_p !< allocated c pointer 7390 #if defined( __parallel )7391 7402 INTEGER(kind=MPI_ADDRESS_KIND) :: size_lad_rma 7392 7403 #endif … … 8624 8635 INTEGER(iwp) :: ip !< number of processor where gridbox reside 8625 8636 INTEGER(iwp) :: ig !< 1D index of gridbox in global 2D array 8626 INTEGER(iwp) :: wcount !< RMA window item count8627 8637 INTEGER(iwp) :: maxboxes !< max no of CSF created 8628 8638 INTEGER(iwp) :: nly !< maximum plant canopy height … … 8634 8644 INTEGER(iwp) :: iz 8635 8645 INTEGER(iwp) :: zsgn 8636 INTEGER(iwp) :: lowest_lad !< lowest column cell for which we need LAD8637 8646 INTEGER(iwp) :: lastdir !< wall direction before hitting this column 8638 8647 INTEGER(iwp), DIMENSION(2) :: lastcolumn 8639 8648 8640 8649 #if defined( __parallel ) 8650 INTEGER(iwp) :: lowest_lad !< lowest column cell for which we need LAD 8651 INTEGER(iwp) :: wcount !< RMA window item count 8641 8652 INTEGER(MPI_ADDRESS_KIND) :: wdisp !< RMA window displacement 8642 8653 #endif … … 9055 9066 INTEGER(iwp), INTENT(out) :: iproc 9056 9067 #if defined( __parallel ) 9057 #else9058 INTEGER(iwp) :: target_displ !< index of the grid in the local gridsurf array9059 #endif9060 9068 INTEGER(iwp) :: px, py !< number of processors in x and y direction 9061 9069 !< before the processor in the question 9070 #endif 9071 9062 9072 #if defined( __parallel ) 9063 9073 INTEGER(KIND=MPI_ADDRESS_KIND) :: target_displ !< index of the grid in the local gridsurf array … … 9082 9092 !-- set index target_surfl(i) 9083 9093 isurfl = gridsurf(d,z,y,x) 9094 iproc = 0 ! required to avoid compile error about unused variable in serial mode 9084 9095 #endif 9085 9096 -
palm/trunk/SOURCE/spectra_mod.f90
r4360 r4429 25 25 ! ----------------- 26 26 ! $Id$ 27 ! bugfix: preprocessor directives rearranged for serial mode 28 ! 29 ! 4360 2020-01-07 11:25:50Z suehring 27 30 ! Corrected "Former revisions" section 28 31 ! … … 81 84 END INTERFACE preprocess_spectra 82 85 86 #if defined( __parallel ) 83 87 INTERFACE calc_spectra_x 84 88 MODULE PROCEDURE calc_spectra_x … … 88 92 MODULE PROCEDURE calc_spectra_y 89 93 END INTERFACE calc_spectra_y 94 #endif 90 95 91 96 INTERFACE spectra_check_parameters … … 345 350 346 351 USE arrays_3d, & 347 ONLY: d, tend 352 ONLY: d 353 #if defined( __parallel ) 354 USE arrays_3d, & 355 ONLY: tend 356 #endif 348 357 349 358 USE control_parameters, & … … 362 371 363 372 USE pegrid, & 364 ONLY: myid, pdims 373 ONLY: myid 374 #if defined( __parallel ) 375 USE pegrid, & 376 ONLY: pdims 377 #endif 365 378 366 379 IMPLICIT NONE … … 489 502 USE MPI 490 503 #endif 491 #endif492 504 493 505 USE pegrid, & 494 506 ONLY: collective_wait, comm2d, ierr 507 #endif 495 508 496 509 USE statistics, & … … 583 596 !> @todo Missing subroutine description. 584 597 !------------------------------------------------------------------------------! 598 #if defined( __parallel ) 585 599 SUBROUTINE calc_spectra_x( ddd, m ) 586 600 … … 596 610 USE kinds 597 611 598 #if defined( __parallel )599 612 #if !defined( __mpifh ) 600 613 USE MPI 601 614 #endif 602 #endif603 615 604 616 USE pegrid, & … … 611 623 IMPLICIT NONE 612 624 613 #if defined( __parallel )614 625 #if defined( __mpifh ) 615 626 INCLUDE "mpif.h" 616 #endif617 627 #endif 618 628 … … 718 728 719 729 END SUBROUTINE calc_spectra_x 730 #endif 720 731 721 732 … … 725 736 !> @todo Missing subroutine description. 726 737 !------------------------------------------------------------------------------! 738 #if defined( __parallel ) 727 739 SUBROUTINE calc_spectra_y( ddd, m ) 728 740 … … 738 750 USE kinds 739 751 740 #if defined( __parallel )741 752 #if !defined( __mpifh ) 742 753 USE MPI 743 754 #endif 744 #endif745 755 746 756 USE pegrid, & … … 753 763 IMPLICIT NONE 754 764 755 #if defined( __parallel )756 765 #if defined( __mpifh ) 757 766 INCLUDE "mpif.h" 758 #endif759 767 #endif 760 768 … … 862 870 863 871 END SUBROUTINE calc_spectra_y 872 #endif 864 873 865 874 END MODULE spectra_mod -
palm/trunk/SOURCE/surface_coupler.f90
r4360 r4429 25 25 ! ----------------- 26 26 ! $Id$ 27 ! bugfix: preprocessor directives rearranged for serial mode 28 ! 29 ! 4360 2020-01-07 11:25:50Z suehring 27 30 ! Corrected "Former revisions" section 28 31 ! … … 38 41 !------------------------------------------------------------------------------! 39 42 SUBROUTINE surface_coupler 43 #if defined( __parallel ) 40 44 41 45 … … 78 82 REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) :: surface_flux !< dummy array for surface fluxes on 2D grid 79 83 80 81 #if defined( __parallel )82 84 83 85 CALL cpu_log( log_point(39), 'surface_coupler', 'start' ) … … 454 456 CALL cpu_log( log_point(39), 'surface_coupler', 'stop' ) 455 457 456 #endif457 458 458 459 CONTAINS … … 613 614 END SUBROUTINE transfer_2D_to_1D_unequal 614 615 616 #endif 615 617 END SUBROUTINE surface_coupler 616 618 … … 622 624 !> @todo Missing subroutine description. 623 625 !------------------------------------------------------------------------------! 626 #if defined( __parallel ) 627 624 628 SUBROUTINE interpolate_to_atmos( tag ) 625 626 #if defined( __parallel )627 629 628 630 USE arrays_3d, & … … 701 703 CALL MPI_BARRIER( comm2d, ierr ) 702 704 705 END SUBROUTINE interpolate_to_atmos 706 703 707 #endif 704 705 END SUBROUTINE interpolate_to_atmos706 708 707 709 … … 711 713 !> @todo Missing subroutine description. 712 714 !------------------------------------------------------------------------------! 715 #if defined( __parallel ) 716 713 717 SUBROUTINE interpolate_to_ocean( tag ) 714 715 #if defined( __parallel )716 718 717 719 USE arrays_3d, & … … 786 788 CALL MPI_BARRIER( comm2d, ierr ) 787 789 790 END SUBROUTINE interpolate_to_ocean 791 788 792 #endif 789 790 END SUBROUTINE interpolate_to_ocean -
palm/trunk/SOURCE/transpose.f90
r4415 r4429 25 25 ! ----------------- 26 26 ! $Id$ 27 ! bugfix: cpp-directives added for serial mode 28 ! 29 ! 4415 2020-02-20 10:30:33Z raasch 27 30 ! bugfix for misplaced preprocessor directive 28 31 ! … … 111 114 112 115 116 #if defined( __parallel ) 113 117 USE cpulog, & 114 118 ONLY: cpu_log, cpu_log_nowait, log_point_s 119 #endif 115 120 116 121 USE indices, & … … 129 134 INTEGER(iwp) :: j !< 130 135 INTEGER(iwp) :: k !< 136 137 #if defined( __parallel ) 131 138 INTEGER(iwp) :: l !< 132 139 INTEGER(iwp) :: ys !< 140 #endif 133 141 134 142 REAL(wp) :: f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx) !< 135 143 REAL(wp) :: f_out(0:ny,nxl_y:nxr_y,nzb_y:nzt_y) !< 136 144 145 #if defined( __parallel ) 137 146 REAL(wp), DIMENSION(nyn_x-nys_x+1,nzb_y:nzt_y,nxl_y:nxr_y,0:pdims(2)-1) :: work !< 138 147 #if __acc_fft_device 139 148 !$ACC DECLARE CREATE(work) 149 #endif 140 150 #endif 141 151 … … 271 281 SUBROUTINE transpose_xz( f_in, f_inv ) 272 282 273 283 #if defined( __parallel ) 274 284 USE cpulog, & 275 285 ONLY: cpu_log, cpu_log_nowait, log_point_s … … 277 287 USE fft_xy, & 278 288 ONLY: f_vec_x, temperton_fft_vec 289 #endif 279 290 280 291 USE indices, & 281 ONLY: nnx, nx, nxl, nxr, nyn, nys, nz 292 ONLY: nx, nxl, nxr, nyn, nys, nz 293 #if defined( __parallel ) 294 USE indices, & 295 ONLY: nnx 296 #endif 282 297 283 298 USE kinds … … 293 308 INTEGER(iwp) :: j !< 294 309 INTEGER(iwp) :: k !< 310 #if defined( __parallel ) 295 311 INTEGER(iwp) :: l !< 296 312 INTEGER(iwp) :: mm !< 297 313 INTEGER(iwp) :: xs !< 314 #endif 298 315 299 316 REAL(wp) :: f_in(0:nx,nys_x:nyn_x,nzb_x:nzt_x) !< 300 317 REAL(wp) :: f_inv(nys:nyn,nxl:nxr,1:nz) !< 301 318 319 #if defined( __parallel ) 302 320 REAL(wp), DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) :: work !< 303 321 #if __acc_fft_device 304 322 !$ACC DECLARE CREATE(work) 323 #endif 305 324 #endif 306 325 … … 460 479 461 480 481 #if defined( __parallel ) 462 482 USE cpulog, & 463 483 ONLY: cpu_log, cpu_log_nowait, log_point_s 484 #endif 464 485 465 486 USE indices, & … … 478 499 INTEGER(iwp) :: j !< 479 500 INTEGER(iwp) :: k !< 501 #if defined( __parallel ) 480 502 INTEGER(iwp) :: l !< 481 503 INTEGER(iwp) :: ys !< 504 #endif 482 505 483 506 REAL(wp) :: f_in(0:ny,nxl_y:nxr_y,nzb_y:nzt_y) !< 484 507 REAL(wp) :: f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx) !< 485 508 509 #if defined( __parallel ) 486 510 REAL(wp), DIMENSION(nyn_x-nys_x+1,nzb_y:nzt_y,nxl_y:nxr_y,0:pdims(2)-1) :: work !< 487 511 #if __acc_fft_device 488 512 !$ACC DECLARE CREATE(work) 513 #endif 489 514 #endif 490 515 … … 575 600 !> (k,j,i) (cf. transpose_yx). 576 601 !------------------------------------------------------------------------------! 602 #if defined( __parallel ) 577 603 SUBROUTINE transpose_yxd( f_in, f_out ) 578 604 … … 604 630 REAL(wp) :: f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x) !< 605 631 REAL(wp) :: work(nnx*nny*nnz) !< 606 #if defined( __parallel )607 632 608 633 ! … … 641 666 ENDDO 642 667 643 #endif644 645 668 END SUBROUTINE transpose_yxd 669 #endif 646 670 647 671 … … 703 727 704 728 729 #if defined( __parallel ) 705 730 USE cpulog, & 706 731 ONLY: cpu_log, cpu_log_nowait, log_point_s 732 #endif 707 733 708 734 USE indices, & … … 721 747 INTEGER(iwp) :: j !< 722 748 INTEGER(iwp) :: k !< 749 #if defined( __parallel ) 723 750 INTEGER(iwp) :: l !< 724 751 INTEGER(iwp) :: zs !< 752 #endif 725 753 726 754 REAL(wp) :: f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny) !< 727 755 REAL(wp) :: f_out(nxl_z:nxr_z,nys_z:nyn_z,1:nz) !< 728 756 757 #if defined( __parallel ) 729 758 REAL(wp), DIMENSION(nxl_z:nxr_z,nzt_y-nzb_y+1,nys_z:nyn_z,0:pdims(1)-1) :: work !< 730 759 #if __acc_fft_device 731 760 !$ACC DECLARE CREATE(work) 761 #endif 732 762 #endif 733 763 … … 864 894 865 895 896 #if defined( __parallel ) 866 897 USE cpulog, & 867 898 ONLY: cpu_log, cpu_log_nowait, log_point_s … … 869 900 USE fft_xy, & 870 901 ONLY: f_vec_x, temperton_fft_vec 902 #endif 871 903 872 904 USE indices, & 873 ONLY: nnx, nx, nxl, nxr, nyn, nys, nz 905 ONLY: nx, nxl, nxr, nyn, nys, nz 906 #if defined( __parallel ) 907 USE indices, & 908 ONLY: nnx 909 #endif 874 910 875 911 USE kinds … … 885 921 INTEGER(iwp) :: j !< 886 922 INTEGER(iwp) :: k !< 923 #if defined( __parallel ) 887 924 INTEGER(iwp) :: l !< 888 925 INTEGER(iwp) :: mm !< 889 926 INTEGER(iwp) :: xs !< 927 #endif 890 928 891 929 REAL(wp) :: f_inv(nys:nyn,nxl:nxr,1:nz) !< 892 930 REAL(wp) :: f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x) !< 893 931 932 #if defined( __parallel ) 894 933 REAL(wp), DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) :: work !< 895 934 #if __acc_fft_device 896 935 !$ACC DECLARE CREATE(work) 936 #endif 897 937 #endif 898 938 … … 1054 1094 1055 1095 1096 #if defined( __parallel ) 1056 1097 USE cpulog, & 1057 1098 ONLY: cpu_log, cpu_log_nowait, log_point_s 1099 #endif 1058 1100 1059 1101 USE indices, & … … 1072 1114 INTEGER(iwp) :: j !< 1073 1115 INTEGER(iwp) :: k !< 1116 #if defined( __parallel ) 1074 1117 INTEGER(iwp) :: l !< 1075 1118 INTEGER(iwp) :: zs !< 1119 #endif 1076 1120 1077 1121 REAL(wp) :: f_in(nxl_z:nxr_z,nys_z:nyn_z,1:nz) !< 1078 1122 REAL(wp) :: f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny) !< 1079 1123 1124 #if defined( __parallel ) 1080 1125 REAL(wp), DIMENSION(nxl_z:nxr_z,nzt_y-nzb_y+1,nys_z:nyn_z,0:pdims(1)-1) :: work !< 1081 1126 #if __acc_fft_device 1082 1127 !$ACC DECLARE CREATE(work) 1128 #endif 1083 1129 #endif 1084 1130 … … 1170 1216 !> (k,j,i) (cf. transpose_zy). 1171 1217 !------------------------------------------------------------------------------! 1218 #if defined( __parallel ) 1172 1219 SUBROUTINE transpose_zyd( f_in, f_out ) 1173 1220 … … 1199 1246 REAL(wp) :: f_out(0:ny,nxl_yd:nxr_yd,nzb_yd:nzt_yd) !< 1200 1247 REAL(wp) :: work(nnx*nny*nnz) !< 1201 1202 #if defined( __parallel )1203 1248 1204 1249 ! … … 1253 1298 ENDDO 1254 1299 1255 #endif1256 1257 1300 END SUBROUTINE transpose_zyd 1301 #endif
Note: See TracChangeset
for help on using the changeset viewer.
