Changeset 1003 for palm/trunk
- Timestamp:
- Sep 14, 2012 2:35:53 PM (12 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 13 edited
-
calc_spectra.f90 (modified) (5 diffs)
-
check_parameters.f90 (modified) (3 diffs)
-
header.f90 (modified) (3 diffs)
-
init_3d_model.f90 (modified) (2 diffs)
-
init_advec.f90 (modified) (2 diffs)
-
init_pegrid.f90 (modified) (20 diffs)
-
modules.f90 (modified) (6 diffs)
-
parin.f90 (modified) (2 diffs)
-
poisfft.f90 (modified) (20 diffs)
-
pres.f90 (modified) (4 diffs)
-
read_var_list.f90 (modified) (2 diffs)
-
transpose.f90 (modified) (32 diffs)
-
write_var_list.f90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/calc_spectra.f90
r708 r1003 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! adjustment of array tend for cases with unequal subdomain sizes removed 7 7 ! 8 8 ! Former revisions: … … 73 73 IF ( psolver == 'multigrid' ) THEN 74 74 DEALLOCATE( d ) 75 ALLOCATE( d(nzb+1:nzta,nys:nyna,nxl:nxra) ) 76 ENDIF 77 78 ! 79 !-- Enlarge the size of tend, used as a working array for the transpositions 80 IF ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) THEN 81 DEALLOCATE( tend ) 82 ALLOCATE( tend(1:nza,nys:nyna,nxl:nxra) ) 75 ALLOCATE( d(nzb+1:nzt,nys:nyn,nxl:nxr) ) 83 76 ENDIF 84 77 … … 154 147 !-- Increase counter for averaging process in routine plot_spectra 155 148 average_count_sp = average_count_sp + 1 156 157 !158 !-- Resize tend to its normal size159 IF ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) THEN160 DEALLOCATE( tend )161 ALLOCATE( tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )162 ENDIF163 149 164 150 CALL cpu_log( log_point(30), 'calc_spectra', 'stop' ) … … 249 235 REAL, DIMENSION(0:nx/2,100):: sums_spectra 250 236 251 REAL, DIMENSION(0:nx a,nys_x:nyn_xa,nzb_x:nzt_xa) :: ddd237 REAL, DIMENSION(0:nx,nys_x:nyn_x,nzb_x:nzt_x) :: ddd 252 238 253 239 ! … … 359 345 REAL, DIMENSION(0:ny/2,100):: sums_spectra 360 346 361 REAL, DIMENSION(0:ny a,nxl_yd:nxr_yda,nzb_yd:nzt_yda) :: ddd347 REAL, DIMENSION(0:ny,nxl_yd:nxr_yd,nzb_yd:nzt_yd) :: ddd 362 348 363 349 -
palm/trunk/SOURCE/check_parameters.f90
r1002 r1003 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! checks for cases with unequal subdomain sizes removed 7 7 ! 8 8 ! Former revisions: … … 597 597 CALL message( 'check_parameters', 'PA0017', 1, 2, 0, 6, 0 ) 598 598 ENDIF 599 IF ( psolver == 'poisfft_hybrid' .AND. &600 ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) .OR. &601 psolver == 'multigrid' .AND. &602 ( nxra > nxr .OR. nyna > nyn ) ) THEN603 message_string = 'psolver = "' // TRIM( psolver ) // '" does not ' // &604 'work for subdomains with unequal size & please ' // &605 'set grid_matching = ''strict'' in the parameter file'606 CALL message( 'check_parameters', 'PA0018', 1, 2, 0, 6, 0 )607 ENDIF608 599 #else 609 600 IF ( psolver == 'poisfft_hybrid' ) THEN … … 809 800 'is not allowed simultaneously' 810 801 CALL message( 'check_parameters', 'PA0038', 1, 2, 0, 6, 0 ) 811 ENDIF812 813 IF ( grid_matching /= 'strict' .AND. grid_matching /= 'match' ) THEN814 message_string = 'illegal value "' // TRIM( grid_matching ) // &815 '" found for parameter grid_matching'816 CALL message( 'check_parameters', 'PA0040', 1, 2, 0, 6, 0 )817 802 ENDIF 818 803 -
palm/trunk/SOURCE/header.f90
r1002 r1003 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! output of information about equal/unequal subdomain size removed 7 7 ! 8 8 ! Former revisions: … … 433 433 WRITE ( io, 254 ) nx, ny, nzt+1, MIN( nnx, nx+1 ), MIN( nny, ny+1 ), & 434 434 MIN( nnz+2, nzt+2 ) 435 IF ( numprocs > 1 ) THEN436 IF ( nxa == nx .AND. nya == ny .AND. nza == nz ) THEN437 WRITE ( io, 255 )438 ELSE439 WRITE ( io, 256 ) nnx-(nxa-nx), nny-(nya-ny), nzt+2440 ENDIF441 ENDIF442 435 IF ( sloping_surface ) WRITE ( io, 260 ) alpha_surface 443 436 … … 1693 1686 254 FORMAT (' Number of gridpoints (x,y,z): (0:',I4,', 0:',I4,', 0:',I4,')'/ & 1694 1687 ' Subdomain size (x,y,z): ( ',I4,', ',I4,', ',I4,')'/) 1695 255 FORMAT (' Subdomains have equal size')1696 256 FORMAT (' Subdomains at the upper edges of the virtual processor grid ', &1697 'have smaller sizes'/ &1698 ' Size of smallest subdomain: ( ',I4,', ',I4,', ',I4,')')1699 1688 260 FORMAT (/' The model has a slope in x-direction. Inclination angle: ',F6.2,& 1700 1689 ' degrees') -
palm/trunk/SOURCE/init_3d_model.f90
r1002 r1003 7 7 ! Current revisions: 8 8 ! ------------------ 9 ! 9 ! nxra,nyna, nzta replaced ny nxr, nyn, nzt 10 10 ! 11 11 ! Former revisions: … … 235 235 z0h(nysg:nyng,nxlg:nxrg) ) 236 236 237 ALLOCATE( d(nzb+1:nzt a,nys:nyna,nxl:nxra),&237 ALLOCATE( d(nzb+1:nzt,nys:nyn,nxl:nxr), & 238 238 e_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 239 239 e_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & -
palm/trunk/SOURCE/init_advec.f90
r1002 r1003 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! obsolete variables removed 7 7 ! 8 8 ! Former revisions: … … 34 34 IMPLICIT NONE 35 35 36 INTEGER :: i, intervals, j, k 37 REAL :: delt, dn, dnneu, ex1, ex2, ex3, ex4, ex5, ex6, spl_alpha, & 38 spl_beta, sterm 39 REAL, DIMENSION(:), ALLOCATABLE :: spl_u, temp 36 INTEGER :: i, intervals, j 37 REAL :: delt, dn, dnneu, ex1, ex2, ex3, ex4, ex5, ex6, sterm 40 38 41 39 -
palm/trunk/SOURCE/init_pegrid.f90
r1002 r1003 1 1 SUBROUTINE init_pegrid 2 3 2 !------------------------------------------------------------------------------! 4 3 ! Current revisions: 5 4 ! ----------------- 6 ! 5 ! subdomains must have identical size (grid matching = "match" removed) 7 6 ! 8 7 ! Former revisions: … … 255 254 256 255 ! 257 !-- Find a grid (used for array d) which will match the transposition demands 258 IF ( grid_matching == 'strict' ) THEN 259 260 nxa = nx; nya = ny; nza = nz 261 262 ELSE 263 264 found = .FALSE. 265 xn: DO nxa = nx, 2*nx 266 ! 267 !-- Meet conditions for nx 268 IF ( MOD( nxa+1, pdims(1) ) /= 0 .OR. & 269 MOD( nxa+1, pdims(2) ) /= 0 ) CYCLE xn 270 271 yn: DO nya = ny, 2*ny 272 ! 273 !-- Meet conditions for ny 274 IF ( MOD( nya+1, pdims(2) ) /= 0 .OR. & 275 MOD( nya+1, pdims(1) ) /= 0 ) CYCLE yn 276 277 278 zn: DO nza = nz, 2*nz 279 ! 280 !-- Meet conditions for nz 281 IF ( ( MOD( nza, pdims(1) ) /= 0 .AND. pdims(1) /= 1 .AND. & 282 pdims(2) /= 1 ) .OR. & 283 ( MOD( nza, pdims(2) ) /= 0 .AND. dt_dosp /= 9999999.9 & 284 ) ) THEN 285 CYCLE zn 286 ELSE 287 found = .TRUE. 288 EXIT xn 289 ENDIF 290 291 ENDDO zn 292 293 ENDDO yn 294 295 ENDDO xn 296 297 IF ( .NOT. found ) THEN 298 message_string = 'no matching grid for transpositions found' 299 CALL message( 'init_pegrid', 'PA0224', 1, 2, 0, 6, 0 ) 300 ENDIF 301 302 ENDIF 303 304 ! 305 !-- Calculate array bounds in x-direction for every PE. 306 !-- The last PE along x may get less grid points than the others 256 !-- Calculate array bounds along x-direction for every PE. 307 257 ALLOCATE( nxlf(0:pdims(1)-1), nxrf(0:pdims(1)-1), nynf(0:pdims(2)-1), & 308 nysf(0:pdims(2)-1) , nnx_pe(0:pdims(1)-1), nny_pe(0:pdims(2)-1))309 310 IF ( MOD( nx a+1 , pdims(1) ) /= 0 ) THEN258 nysf(0:pdims(2)-1) ) 259 260 IF ( MOD( nx+1 , pdims(1) ) /= 0 ) THEN 311 261 WRITE( message_string, * ) 'x-direction: gridpoint number (',nx+1,') ',& 312 262 'is not an& integral divisor of the number ', & … … 314 264 CALL message( 'init_pegrid', 'PA0225', 1, 2, 0, 6, 0 ) 315 265 ELSE 316 nnx = ( nx a+ 1 ) / pdims(1)266 nnx = ( nx + 1 ) / pdims(1) 317 267 IF ( nnx*pdims(1) - ( nx + 1) > nnx ) THEN 318 268 WRITE( message_string, * ) 'x-direction: nx does not match the', & … … 329 279 nxlf(i) = i * nnx 330 280 nxrf(i) = ( i + 1 ) * nnx - 1 331 nnx_pe(i) = MIN( nx, nxrf(i) ) - nxlf(i) + 1332 281 ENDDO 333 282 334 283 ! 335 284 !-- Calculate array bounds in y-direction for every PE. 336 IF ( MOD( ny a+1 , pdims(2) ) /= 0 ) THEN285 IF ( MOD( ny+1 , pdims(2) ) /= 0 ) THEN 337 286 WRITE( message_string, * ) 'y-direction: gridpoint number (',ny+1,') ', & 338 287 'is not an& integral divisor of the number of', & … … 340 289 CALL message( 'init_pegrid', 'PA0227', 1, 2, 0, 6, 0 ) 341 290 ELSE 342 nny = ( ny a+ 1 ) / pdims(2)291 nny = ( ny + 1 ) / pdims(2) 343 292 IF ( nny*pdims(2) - ( ny + 1) > nny ) THEN 344 293 WRITE( message_string, * ) 'y-direction: ny does not match the', & … … 355 304 nysf(j) = j * nny 356 305 nynf(j) = ( j + 1 ) * nny - 1 357 nny_pe(j) = MIN( ny, nynf(j) ) - nysf(j) + 1358 306 ENDDO 359 307 360 308 ! 361 309 !-- Local array bounds of the respective PEs 362 nxl = nxlf(pcoord(1)) 363 nxra = nxrf(pcoord(1)) 364 nxr = MIN( nx, nxra ) 365 nys = nysf(pcoord(2)) 366 nyna = nynf(pcoord(2)) 367 nyn = MIN( ny, nyna ) 368 nzb = 0 369 nzta = nza 370 nzt = MIN( nz, nzta ) 371 nnz = nza 310 nxl = nxlf(pcoord(1)) 311 nxr = nxrf(pcoord(1)) 312 nys = nysf(pcoord(2)) 313 nyn = nynf(pcoord(2)) 314 nzb = 0 315 nzt = nz 316 nnz = nz 372 317 373 318 ! … … 390 335 IF ( pdims(2) /= 1 ) THEN 391 336 392 nys_x = nys 393 nyn_xa = nyna 394 nyn_x = nyn 395 nny_x = nny 396 IF ( MOD( nza , pdims(1) ) /= 0 ) THEN 337 nys_x = nys 338 nyn_x = nyn 339 nny_x = nny 340 IF ( MOD( nz , pdims(1) ) /= 0 ) THEN 397 341 WRITE( message_string, * ) 'transposition z --> x:', & 398 342 '&nz=',nz,' is not an integral divisior of pdims(1)=', & … … 400 344 CALL message( 'init_pegrid', 'PA0230', 1, 2, 0, 6, 0 ) 401 345 ENDIF 402 nnz_x = nza / pdims(1) 403 nzb_x = 1 + myidx * nnz_x 404 nzt_xa = ( myidx + 1 ) * nnz_x 405 nzt_x = MIN( nzt, nzt_xa ) 406 346 nnz_x = nz / pdims(1) 347 nzb_x = 1 + myidx * nnz_x 348 nzt_x = ( myidx + 1 ) * nnz_x 407 349 sendrecvcount_zx = nnx * nny * nnz_x 408 350 … … 412 354 !--- the next step x --> y 413 355 !--- WARNING: This case has still to be clarified!!!!!!!!!!!! 414 nnz_x = 1 415 nzb_x = 1 416 nzt_xa = 1 417 nzt_x = 1 418 nny_x = nny 356 nnz_x = 1 357 nzb_x = 1 358 nzt_x = 1 359 nny_x = nny 419 360 420 361 ENDIF … … 422 363 ! 423 364 !-- 2. transposition x --> y 424 nnz_y = nnz_x 425 nzb_y = nzb_x 426 nzt_ya = nzt_xa 427 nzt_y = nzt_x 428 IF ( MOD( nxa+1 , pdims(2) ) /= 0 ) THEN 365 nnz_y = nnz_x 366 nzb_y = nzb_x 367 nzt_y = nzt_x 368 IF ( MOD( nx+1 , pdims(2) ) /= 0 ) THEN 429 369 WRITE( message_string, * ) 'transposition x --> y:', & 430 370 '&nx+1=',nx+1,' is not an integral divisor of ',& … … 432 372 CALL message( 'init_pegrid', 'PA0231', 1, 2, 0, 6, 0 ) 433 373 ENDIF 434 nnx_y = (nx a+1) / pdims(2)374 nnx_y = (nx+1) / pdims(2) 435 375 nxl_y = myidy * nnx_y 436 nxr_ya = ( myidy + 1 ) * nnx_y - 1 437 nxr_y = MIN( nx, nxr_ya ) 438 376 nxr_y = ( myidy + 1 ) * nnx_y - 1 439 377 sendrecvcount_xy = nnx_y * nny_x * nnz_y 440 378 … … 447 385 !-- This transposition is not neccessary in case of a 1d-decomposition 448 386 !-- along x, except that the uptream-spline method is switched on 449 nnx_z = nnx_y 450 nxl_z = nxl_y 451 nxr_za = nxr_ya 452 nxr_z = nxr_y 453 IF ( MOD( nya+1 , pdims(1) ) /= 0 ) THEN 387 nnx_z = nnx_y 388 nxl_z = nxl_y 389 nxr_z = nxr_y 390 IF ( MOD( ny+1 , pdims(1) ) /= 0 ) THEN 454 391 WRITE( message_string, * ) 'transposition y --> z:', & 455 392 '& ny+1=',ny+1,' is not an integral divisor of ',& … … 457 394 CALL message( 'init_pegrid', 'PA0232', 1, 2, 0, 6, 0 ) 458 395 ENDIF 459 nny_z = (nya+1) / pdims(1) 460 nys_z = myidx * nny_z 461 nyn_za = ( myidx + 1 ) * nny_z - 1 462 nyn_z = MIN( ny, nyn_za ) 463 396 nny_z = (ny+1) / pdims(1) 397 nys_z = myidx * nny_z 398 nyn_z = ( myidx + 1 ) * nny_z - 1 464 399 sendrecvcount_yz = nnx_y * nny_z * nnz_y 465 400 … … 467 402 ! 468 403 !-- x --> y. This condition must be fulfilled for a 1D-decomposition along x 469 IF ( MOD( ny a+1 , pdims(1) ) /= 0 ) THEN404 IF ( MOD( ny+1 , pdims(1) ) /= 0 ) THEN 470 405 WRITE( message_string, * ) 'transposition x --> y:', & 471 406 '& ny+1=',ny+1,' is not an integral divisor of ',& … … 479 414 !-- Indices for direct transpositions z --> y (used for calculating spectra) 480 415 IF ( dt_dosp /= 9999999.9 ) THEN 481 IF ( MOD( nz a, pdims(2) ) /= 0 ) THEN416 IF ( MOD( nz, pdims(2) ) /= 0 ) THEN 482 417 WRITE( message_string, * ) 'direct transposition z --> y (needed ', & 483 418 'for spectra):& nz=',nz,' is not an integral divisor of ',& … … 485 420 CALL message( 'init_pegrid', 'PA0234', 1, 2, 0, 6, 0 ) 486 421 ELSE 487 nxl_yd = nxl 488 nxr_yda = nxra 489 nxr_yd = nxr 490 nzb_yd = 1 + myidy * ( nza / pdims(2) ) 491 nzt_yda = ( myidy + 1 ) * ( nza / pdims(2) ) 492 nzt_yd = MIN( nzt, nzt_yda ) 493 494 sendrecvcount_zyd = nnx * nny * ( nza / pdims(2) ) 422 nxl_yd = nxl 423 nxr_yd = nxr 424 nzb_yd = 1 + myidy * ( nz / pdims(2) ) 425 nzt_yd = ( myidy + 1 ) * ( nz / pdims(2) ) 426 sendrecvcount_zyd = nnx * nny * ( nz / pdims(2) ) 495 427 ENDIF 496 428 ENDIF … … 500 432 !-- of a 1d-decomposition along x) 501 433 IF ( pdims(2) == 1 ) THEN 502 nny_x = nny / pdims(1) 503 nys_x = myid * nny_x 504 nyn_xa = ( myid + 1 ) * nny_x - 1 505 nyn_x = MIN( ny, nyn_xa ) 506 nzb_x = 1 507 nzt_xa = nza 508 nzt_x = nz 509 sendrecvcount_xy = nnx * nny_x * nza 434 nny_x = nny / pdims(1) 435 nys_x = myid * nny_x 436 nyn_x = ( myid + 1 ) * nny_x - 1 437 nzb_x = 1 438 nzt_x = nz 439 sendrecvcount_xy = nnx * nny_x * nz 510 440 ENDIF 511 441 … … 514 444 !-- of a 1d-decomposition along y) 515 445 IF ( pdims(1) == 1 ) THEN 516 nnx_y = nnx / pdims(2) 517 nxl_y = myid * nnx_y 518 nxr_ya = ( myid + 1 ) * nnx_y - 1 519 nxr_y = MIN( nx, nxr_ya ) 520 nzb_y = 1 521 nzt_ya = nza 522 nzt_y = nz 523 sendrecvcount_xy = nnx_y * nny * nza 446 nnx_y = nnx / pdims(2) 447 nxl_y = myid * nnx_y 448 nxr_y = ( myid + 1 ) * nnx_y - 1 449 nzb_y = 1 450 nzt_y = nz 451 sendrecvcount_xy = nnx_y * nny * nz 524 452 ENDIF 525 453 … … 782 710 !-- Array bounds when running on a single PE (respectively a non-parallel 783 711 !-- machine) 784 nxl = 0 785 nxr = nx 786 nxra = nx 787 nnx = nxr - nxl + 1 788 nys = 0 789 nyn = ny 790 nyna = ny 791 nny = nyn - nys + 1 792 nzb = 0 793 nzt = nz 794 nzta = nz 795 nnz = nz 712 nxl = 0 713 nxr = nx 714 nnx = nxr - nxl + 1 715 nys = 0 716 nyn = ny 717 nny = nyn - nys + 1 718 nzb = 0 719 nzt = nz 720 nnz = nz 796 721 797 722 ALLOCATE( hor_index_bounds(4,0:0) ) … … 804 729 !-- Array bounds for the pressure solver (in the parallel code, these bounds 805 730 !-- are the ones for the transposed arrays) 806 nys_x = nys 807 nyn_x = nyn 808 nyn_xa = nyn 809 nzb_x = nzb + 1 810 nzt_x = nzt 811 nzt_xa = nzt 812 813 nxl_y = nxl 814 nxr_y = nxr 815 nxr_ya = nxr 816 nzb_y = nzb + 1 817 nzt_y = nzt 818 nzt_ya = nzt 819 820 nxl_z = nxl 821 nxr_z = nxr 822 nxr_za = nxr 823 nys_z = nys 824 nyn_z = nyn 825 nyn_za = nyn 731 nys_x = nys 732 nyn_x = nyn 733 nzb_x = nzb + 1 734 nzt_x = nzt 735 736 nxl_y = nxl 737 nxr_y = nxr 738 nzb_y = nzb + 1 739 nzt_y = nzt 740 741 nxl_z = nxl 742 nxr_z = nxr 743 nys_z = nys 744 nyn_z = nyn 826 745 827 746 #endif -
palm/trunk/SOURCE/modules.f90
r1002 r1003 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! -grid_matching, nxa, nya, etc., nnx_pe, nny_pe, spl_* 7 7 ! 8 8 ! Former revisions: … … 296 296 !------------------------------------------------------------------------------! 297 297 298 REAL :: spl_gamma_x, spl_gamma_y 299 300 REAL, DIMENSION(:), ALLOCATABLE :: aex, bex, dex, eex, spl_z_x, spl_z_y 301 REAL, DIMENSION(:,:), ALLOCATABLE :: spl_tri_x, spl_tri_y, spl_tri_zu, & 302 spl_tri_zw 298 REAL, DIMENSION(:), ALLOCATABLE :: aex, bex, dex, eex 303 299 304 300 SAVE … … 484 480 CHARACTER (LEN=2) :: coupling_char = '' 485 481 CHARACTER (LEN=5) :: write_binary = 'false' 486 CHARACTER (LEN=6) :: grid_matching = 'strict'487 482 CHARACTER (LEN=8) :: run_date, run_time 488 483 CHARACTER (LEN=9) :: simulated_time_chr … … 926 921 !------------------------------------------------------------------------------! 927 922 928 INTEGER :: nbgp = 3, ngp_sums, nnx, nx = 0, nx_a, nx_o, nx a, nxl, nxlg, &929 nxlu, nxr, nxr a, nxrg, nx_on_file, nny, ny = 0, ny_a, ny_o, &930 ny a, nyn, nyna, nyng, nys, nysg, nysv, ny_on_file, nnz, nz = 0,&931 nz a, nzb, nzb_diff, nzb_max, nzt, nzta, nzt_diff923 INTEGER :: nbgp = 3, ngp_sums, nnx, nx = 0, nx_a, nx_o, nxl, nxlg, & 924 nxlu, nxr, nxrg, nx_on_file, nny, ny = 0, ny_a, ny_o, & 925 nyn, nyng, nys, nysg, nysv, ny_on_file, nnz, nz = 0,& 926 nzb, nzb_diff, nzb_max, nzt, nzt_diff 932 927 933 928 … … 936 931 937 932 INTEGER, DIMENSION(:), ALLOCATABLE :: & 938 ngp_2dh, n nx_pe, nny_pe, nxl_mg, nxr_mg, nyn_mg, nys_mg, nzt_mg933 ngp_2dh, nxl_mg, nxr_mg, nyn_mg, nys_mg, nzt_mg 939 934 940 935 … … 1515 1510 !------------------------------------------------------------------------------! 1516 1511 1517 INTEGER :: nxl_y, nxl_yd, nxl_z, nxr_y, nxr_ya, nxr_yd, nxr_yda, nxr_z, & 1518 nxr_za, nyn_x, nyn_xa, nyn_z, nyn_za, nys_x, nys_z, nzb_x, & 1519 nzb_y, nzb_yd, nzt_x, nzt_xa, nzt_y, nzt_ya, nzt_yd, nzt_yda 1512 INTEGER :: nxl_y, nxl_yd, nxl_z, nxr_y, nxr_yd, nxr_z, nyn_x, nyn_z, & 1513 nys_x, nys_z, nzb_x, nzb_y, nzb_yd, nzt_x, nzt_y, nzt_yd 1520 1514 1521 1515 -
palm/trunk/SOURCE/parin.f90
r1002 r1003 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! -grid_matching 7 7 ! 8 8 ! Former revisions: … … 175 175 dt, dt_pr_1d, dt_run_control_1d, dx, dy, dz, dz_max, & 176 176 dz_stretch_factor, dz_stretch_level, e_init, e_min, end_time_1d, & 177 fft_method, galilei_transformation, grid_matching,humidity, &177 fft_method, galilei_transformation, humidity, & 178 178 inflow_damping_height, inflow_damping_width, & 179 179 inflow_disturbance_begin, inflow_disturbance_end, & -
palm/trunk/SOURCE/poisfft.f90
r941 r1003 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! indices nxa, nya, etc. replaced by nx, ny, etc. 7 7 ! 8 8 ! Former revisions: … … 157 157 IMPLICIT NONE 158 158 159 REAL, DIMENSION(1:nz a,nys:nyna,nxl:nxra) :: ar, work159 REAL, DIMENSION(1:nz,nys:nyn,nxl:nxr) :: ar, work 160 160 161 161 … … 315 315 316 316 #if defined( __parallel ) 317 REAL :: ar(nxl_z:nxr_z a,nys_z:nyn_za,1:nza)317 REAL :: ar(nxl_z:nxr_z,nys_z:nyn_z,1:nz) 318 318 #else 319 319 REAL :: ar(1:nz,nys_z:nyn_z,nxl_z:nxr_z) … … 462 462 REAL :: tri(5,nxl_z:nxr_z,0:nz-1) 463 463 #if defined( __parallel ) 464 REAL :: ar(nxl_z:nxr_z a,nys_z:nyn_za,1:nza)464 REAL :: ar(nxl_z:nxr_z,nys_z:nyn_z,1:nz) 465 465 #else 466 466 REAL :: ar(1:nz,nys_z:nyn_z,nxl_z:nxr_z) … … 570 570 CHARACTER (LEN=*) :: direction 571 571 INTEGER :: j, k 572 REAL :: ar(0:nx a,nys_x:nyn_xa,nzb_x:nzt_xa)572 REAL :: ar(0:nx,nys_x:nyn_x,nzb_x:nzt_x) 573 573 574 574 ! … … 624 624 CHARACTER (LEN=*) :: direction 625 625 INTEGER :: i, k 626 REAL :: ar(0:ny a,nxl_y:nxr_ya,nzb_y:nzt_ya)626 REAL :: ar(0:ny,nxl_y:nxr_y,nzb_y:nzt_y) 627 627 628 628 ! … … 698 698 REAL, DIMENSION(0:ny+1,1:nz,nxl:nxr) :: work_ffty_vec 699 699 #endif 700 REAL, DIMENSION(1:nz a,0:nya,nxl:nxra) :: f_in701 REAL, DIMENSION(nnx,1:nz a,nys_x:nyn_xa,pdims(1)) :: f_out702 REAL, DIMENSION(nxl:nxr a,1:nza,0:nya) :: work700 REAL, DIMENSION(1:nz,0:ny,nxl:nxr) :: f_in 701 REAL, DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) :: f_out 702 REAL, DIMENSION(nxl:nxr,1:nz,0:ny) :: work 703 703 704 704 ! … … 814 814 REAL, DIMENSION(0:ny+1,1:nz,nxl:nxr) :: work_ffty_vec 815 815 #endif 816 REAL, DIMENSION(nnx,1:nz a,nys_x:nyn_xa,pdims(1)) :: f_in817 REAL, DIMENSION(1:nz a,0:nya,nxl:nxra):: f_out818 REAL, DIMENSION(nxl:nxr a,1:nza,0:nya):: work816 REAL, DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) :: f_in 817 REAL, DIMENSION(1:nz,0:ny,nxl:nxr) :: f_out 818 REAL, DIMENSION(nxl:nxr,1:nz,0:ny) :: work 819 819 820 820 ! … … 931 931 INTEGER :: i, j, k, m, n, omp_get_thread_num, tn 932 932 933 REAL, DIMENSION(0:nx) 934 REAL, DIMENSION(0:nx,1:nz) 935 REAL, DIMENSION(nnx,1:nz a,nys_x:nyn_xa,pdims(1)) :: ar936 REAL, DIMENSION(:,:,:,:), ALLOCATABLE 933 REAL, DIMENSION(0:nx) :: work_fftx 934 REAL, DIMENSION(0:nx,1:nz) :: work_trix 935 REAL, DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) :: ar 936 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: tri 937 937 938 938 … … 954 954 m = 0 955 955 DO n = 1, pdims(1) 956 DO i = 1, nnx _pe( n-1 ) ! WARN: pcoord(i) should be used!!956 DO i = 1, nnx 957 957 work_trix(m,k) = ar(i,k,j,n) 958 958 m = m + 1 … … 971 971 m = 0 972 972 DO n = 1, pdims(1) 973 DO i = 1, nnx _pe( n-1 ) ! WARN: pcoord(i) should be used!!973 DO i = 1, nnx 974 974 work_fftx(m) = ar(i,k,j,n) 975 975 m = m + 1 … … 1000 1000 m = 0 1001 1001 DO n = 1, pdims(1) 1002 DO i = 1, nnx _pe( n-1 ) ! WARN: pcoord(i) should be used!!1002 DO i = 1, nnx 1003 1003 ar(i,k,j,n) = work_trix(m,k) 1004 1004 m = m + 1 … … 1021 1021 m = 0 1022 1022 DO n = 1, pdims(1) 1023 DO i = 1, nnx _pe( n-1 ) ! WARN: pcoord(i) should be used!!1023 DO i = 1, nnx 1024 1024 ar(i,k,j,n) = work_fftx(m) 1025 1025 m = m + 1 … … 1062 1062 INTEGER :: i, j, k 1063 1063 1064 REAL, DIMENSION(0:nx,1:nz,nys:nyn) 1065 REAL, DIMENSION(1:nz a,nys:nyna,0:nxa):: f_in1066 REAL, DIMENSION(nny,1:nz a,nxl_y:nxr_ya,pdims(2)) :: f_out1067 REAL, DIMENSION(nys:nyn a,1:nza,0:nxa):: work1064 REAL, DIMENSION(0:nx,1:nz,nys:nyn) :: work_fftx 1065 REAL, DIMENSION(1:nz,nys:nyn,0:nx) :: f_in 1066 REAL, DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) :: f_out 1067 REAL, DIMENSION(nys:nyn,1:nz,0:nx) :: work 1068 1068 1069 1069 ! … … 1166 1166 INTEGER :: i, j, k 1167 1167 1168 REAL, DIMENSION(0:nx,1:nz,nys:nyn) 1169 REAL, DIMENSION(nny,1:nz a,nxl_y:nxr_ya,pdims(2)) :: f_in1170 REAL, DIMENSION(1:nz a,nys:nyna,0:nxa):: f_out1171 REAL, DIMENSION(nys:nyn a,1:nza,0:nxa):: work1168 REAL, DIMENSION(0:nx,1:nz,nys:nyn) :: work_fftx 1169 REAL, DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) :: f_in 1170 REAL, DIMENSION(1:nz,nys:nyn,0:nx) :: f_out 1171 REAL, DIMENSION(nys:nyn,1:nz,0:nx) :: work 1172 1172 1173 1173 ! … … 1271 1271 INTEGER :: i, j, k, m, n, omp_get_thread_num, tn 1272 1272 1273 REAL, DIMENSION(0:ny) 1274 REAL, DIMENSION(0:ny,1:nz) 1275 REAL, DIMENSION(nny,1:nz a,nxl_y:nxr_ya,pdims(2)) :: ar1276 REAL, DIMENSION(:,:,:,:), ALLOCATABLE 1273 REAL, DIMENSION(0:ny) :: work_ffty 1274 REAL, DIMENSION(0:ny,1:nz) :: work_triy 1275 REAL, DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) :: ar 1276 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: tri 1277 1277 1278 1278 … … 1294 1294 m = 0 1295 1295 DO n = 1, pdims(2) 1296 DO j = 1, nny _pe( n-1 ) ! WARN: pcoord(j) should be used!!1296 DO j = 1, nny 1297 1297 work_triy(m,k) = ar(j,k,i,n) 1298 1298 m = m + 1 … … 1311 1311 m = 0 1312 1312 DO n = 1, pdims(2) 1313 DO j = 1, nny _pe( n-1 ) ! WARN: pcoord(j) should be used!!1313 DO j = 1, nny 1314 1314 work_ffty(m) = ar(j,k,i,n) 1315 1315 m = m + 1 … … 1340 1340 m = 0 1341 1341 DO n = 1, pdims(2) 1342 DO j = 1, nny _pe( n-1 ) ! WARN: pcoord(j) should be used!!1342 DO j = 1, nny 1343 1343 ar(j,k,i,n) = work_triy(m,k) 1344 1344 m = m + 1 … … 1361 1361 m = 0 1362 1362 DO n = 1, pdims(2) 1363 DO j = 1, nny _pe( n-1 ) ! WARN: pcoord(j) should be used!!1363 DO j = 1, nny 1364 1364 ar(j,k,i,n) = work_ffty(m) 1365 1365 m = m + 1 -
palm/trunk/SOURCE/pres.f90
r779 r1003 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! adjustment of array tend for cases with unequal subdomain sizes removed 7 7 ! 8 8 ! Former revisions: … … 279 279 ELSE 280 280 !$OMP PARALLEL DO SCHEDULE( STATIC ) 281 DO i = nxl, nxr a282 DO j = nys, nyn a283 DO k = nzb+1, nzt a281 DO i = nxl, nxr 282 DO j = nys, nyn 283 DO k = nzb+1, nzt 284 284 d(k,j,i) = 0.0 285 285 ENDDO … … 409 409 410 410 ! 411 !-- Enlarge the size of tend, used as a working array for the transpositions412 IF ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) THEN413 DEALLOCATE( tend )414 ALLOCATE( tend(1:nza,nys:nyna,nxl:nxra) )415 ENDIF416 417 !418 411 !-- Solve Poisson equation via FFT and solution of tridiagonal matrices 419 412 IF ( psolver == 'poisfft' ) THEN … … 427 420 !-- are some optimization problems in poisfft 428 421 CALL poisfft_hybrid( d ) 429 ENDIF430 431 !432 !-- Resize tend to its normal size433 IF ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) THEN434 DEALLOCATE( tend )435 ALLOCATE( tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )436 422 ENDIF 437 423 -
palm/trunk/SOURCE/read_var_list.f90
r1002 r1003 4 4 ! Current revisions: 5 5 ! ------------------ 6 ! 6 ! -grid_matching 7 7 ! 8 8 ! Former revisions: … … 363 363 CASE ( 'galilei_transformation' ) 364 364 READ ( 13 ) galilei_transformation 365 CASE ( 'grid_matching' )366 READ ( 13 ) grid_matching367 365 CASE ( 'hom' ) 368 366 READ ( 13 ) hom -
palm/trunk/SOURCE/transpose.f90
r684 r1003 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! indices nxa, nya, etc. replaced by nx, ny, etc. 7 7 ! 8 8 ! Former revisions: … … 54 54 INTEGER :: i, j, k, l, m, ys 55 55 56 REAL :: f_in(0:nx a,nys_x:nyn_xa,nzb_x:nzt_xa),&57 f_inv(nys_x:nyn_x a,nzb_x:nzt_xa,0:nxa),&58 f_out(0:ny a,nxl_y:nxr_ya,nzb_y:nzt_ya),&56 REAL :: f_in(0:nx,nys_x:nyn_x,nzb_x:nzt_x), & 57 f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx), & 58 f_out(0:ny,nxl_y:nxr_y,nzb_y:nzt_y), & 59 59 work(nnx*nny*nnz) 60 60 … … 66 66 !$OMP PARALLEL PRIVATE ( i, j, k ) 67 67 !$OMP DO 68 DO i = 0, nx a69 DO k = nzb_x, nzt_x a70 DO j = nys_x, nyn_x a68 DO i = 0, nx 69 DO k = nzb_x, nzt_x 70 DO j = nys_x, nyn_x 71 71 f_inv(j,k,i) = f_in(i,j,k) 72 72 ENDDO … … 89 89 !$OMP DO 90 90 DO l = 0, pdims(2) - 1 91 m = l * ( nxr_y a - nxl_y + 1 ) * ( nzt_ya- nzb_y + 1 ) * &92 ( nyn_x a- nys_x + 1 )93 ys = 0 + l * ( nyn_x a- nys_x + 1 )94 DO i = nxl_y, nxr_y a95 DO k = nzb_y, nzt_y a96 DO j = ys, ys + nyn_x a- nys_x91 m = l * ( nxr_y - nxl_y + 1 ) * ( nzt_y - nzb_y + 1 ) * & 92 ( nyn_x - nys_x + 1 ) 93 ys = 0 + l * ( nyn_x - nys_x + 1 ) 94 DO i = nxl_y, nxr_y 95 DO k = nzb_y, nzt_y 96 DO j = ys, ys + nyn_x - nys_x 97 97 m = m + 1 98 98 f_out(j,i,k) = work(m) … … 128 128 INTEGER :: i, j, k, l, m, xs 129 129 130 REAL :: f_in(0:nx a,nys_x:nyn_xa,nzb_x:nzt_xa),&131 f_inv(nys:nyn a,nxl:nxra,1:nza),&132 f_out(1:nz a,nys:nyna,nxl:nxra),&130 REAL :: f_in(0:nx,nys_x:nyn_x,nzb_x:nzt_x), & 131 f_inv(nys:nyn,nxl:nxr,1:nz), & 132 f_out(1:nz,nys:nyn,nxl:nxr), & 133 133 work(nnx*nny*nnz) 134 134 … … 144 144 !$OMP DO 145 145 DO l = 0, pdims(1) - 1 146 m = l * ( nzt_x a - nzb_x + 1 ) * nnx * ( nyn_xa- nys_x + 1 )146 m = l * ( nzt_x - nzb_x + 1 ) * nnx * ( nyn_x - nys_x + 1 ) 147 147 xs = 0 + l * nnx 148 DO k = nzb_x, nzt_x a148 DO k = nzb_x, nzt_x 149 149 DO i = xs, xs + nnx - 1 150 DO j = nys_x, nyn_x a150 DO j = nys_x, nyn_x 151 151 m = m + 1 152 152 work(m) = f_in(i,j,k) … … 170 170 !$OMP PARALLEL PRIVATE ( i, j, k ) 171 171 !$OMP DO 172 DO k = 1, nz a173 DO i = nxl, nxr a174 DO j = nys, nyn a172 DO k = 1, nz 173 DO i = nxl, nxr 174 DO j = nys, nyn 175 175 f_out(k,j,i) = f_inv(j,i,k) 176 176 ENDDO … … 183 183 !$OMP PARALLEL PRIVATE ( i, j, k ) 184 184 !$OMP DO 185 DO i = nxl, nxr a186 DO j = nys, nyn a187 DO k = 1, nz a185 DO i = nxl, nxr 186 DO j = nys, nyn 187 DO k = 1, nz 188 188 f_inv(j,i,k) = f_in(i,j,k) 189 189 ENDDO … … 194 194 !$OMP PARALLEL PRIVATE ( i, j, k ) 195 195 !$OMP DO 196 DO k = 1, nz a197 DO i = nxl, nxr a198 DO j = nys, nyn a196 DO k = 1, nz 197 DO i = nxl, nxr 198 DO j = nys, nyn 199 199 f_out(k,j,i) = f_inv(j,i,k) 200 200 ENDDO … … 231 231 INTEGER :: i, j, k, l, m, ys 232 232 233 REAL :: f_in(0:ny a,nxl_y:nxr_ya,nzb_y:nzt_ya),&234 f_inv(nys_x:nyn_x a,nzb_x:nzt_xa,0:nxa),&235 f_out(0:nx a,nys_x:nyn_xa,nzb_x:nzt_xa),&233 REAL :: f_in(0:ny,nxl_y:nxr_y,nzb_y:nzt_y), & 234 f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx), & 235 f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x), & 236 236 work(nnx*nny*nnz) 237 237 … … 243 243 !$OMP DO 244 244 DO l = 0, pdims(2) - 1 245 m = l * ( nxr_y a - nxl_y + 1 ) * ( nzt_ya- nzb_y + 1 ) * &246 ( nyn_x a- nys_x + 1 )247 ys = 0 + l * ( nyn_x a- nys_x + 1 )248 DO i = nxl_y, nxr_y a249 DO k = nzb_y, nzt_y a250 DO j = ys, ys + nyn_x a- nys_x245 m = l * ( nxr_y - nxl_y + 1 ) * ( nzt_y - nzb_y + 1 ) * & 246 ( nyn_x - nys_x + 1 ) 247 ys = 0 + l * ( nyn_x - nys_x + 1 ) 248 DO i = nxl_y, nxr_y 249 DO k = nzb_y, nzt_y 250 DO j = ys, ys + nyn_x - nys_x 251 251 m = m + 1 252 252 work(m) = f_in(j,i,k) … … 270 270 !$OMP PARALLEL PRIVATE ( i, j, k ) 271 271 !$OMP DO 272 DO i = 0, nx a273 DO k = nzb_x, nzt_x a274 DO j = nys_x, nyn_x a272 DO i = 0, nx 273 DO k = nzb_x, nzt_x 274 DO j = nys_x, nyn_x 275 275 f_out(i,j,k) = f_inv(j,k,i) 276 276 ENDDO … … 306 306 INTEGER :: i, j, k, l, m, recvcount_yx, sendcount_yx, xs 307 307 308 REAL :: f_in(1:nz a,nys:nyna,nxl:nxra), f_inv(nxl:nxra,1:nza,nys:nyna), &309 f_out(0:nx a,nys_x:nyn_xa,nzb_x:nzt_xa),&308 REAL :: f_in(1:nz,nys:nyn,nxl:nxr), f_inv(nxl:nxr,1:nz,nys:nyn), & 309 f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x), & 310 310 work(nnx*nny*nnz) 311 311 … … 315 315 !-- Rearrange indices of input array in order to make data to be send 316 316 !-- by MPI contiguous 317 DO k = 1, nz a318 DO j = nys, nyn a319 DO i = nxl, nxr a317 DO k = 1, nz 318 DO j = nys, nyn 319 DO i = nxl, nxr 320 320 f_inv(i,k,j) = f_in(k,j,i) 321 321 ENDDO … … 337 337 DO l = 0, pdims(1) - 1 338 338 xs = 0 + l * nnx 339 DO j = nys_x, nyn_x a340 DO k = 1, nz a339 DO j = nys_x, nyn_x 340 DO k = 1, nz 341 341 DO i = xs, xs + nnx - 1 342 342 m = m + 1 … … 372 372 INTEGER :: i, j, k, l, m, zs 373 373 374 REAL :: f_in(0:ny a,nxl_y:nxr_ya,nzb_y:nzt_ya),&375 f_inv(nxl_y:nxr_y a,nzb_y:nzt_ya,0:nya),&376 f_out(nxl_z:nxr_z a,nys_z:nyn_za,1:nza),&374 REAL :: f_in(0:ny,nxl_y:nxr_y,nzb_y:nzt_y), & 375 f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny), & 376 f_out(nxl_z:nxr_z,nys_z:nyn_z,1:nz), & 377 377 work(nnx*nny*nnz) 378 378 … … 384 384 !$OMP PARALLEL PRIVATE ( i, j, k ) 385 385 !$OMP DO 386 DO j = 0, ny a387 DO k = nzb_y, nzt_y a388 DO i = nxl_y, nxr_y a386 DO j = 0, ny 387 DO k = nzb_y, nzt_y 388 DO i = nxl_y, nxr_y 389 389 f_inv(i,k,j) = f_in(j,i,k) 390 390 ENDDO … … 401 401 !$OMP PARALLEL PRIVATE ( i, j, k ) 402 402 !$OMP DO 403 DO j = 0, ny a404 DO k = nzb_y, nzt_y a405 DO i = nxl_y, nxr_y a403 DO j = 0, ny 404 DO k = nzb_y, nzt_y 405 DO i = nxl_y, nxr_y 406 406 f_out(i,j,k) = f_inv(i,k,j) 407 407 ENDDO … … 426 426 !$OMP DO 427 427 DO l = 0, pdims(1) - 1 428 m = l * ( nyn_z a - nys_z + 1 ) * ( nzt_ya- nzb_y + 1 ) * &429 ( nxr_z a- nxl_z + 1 )430 zs = 1 + l * ( nzt_y a- nzb_y + 1 )431 DO j = nys_z, nyn_z a432 DO k = zs, zs + nzt_y a- nzb_y433 DO i = nxl_z, nxr_z a428 m = l * ( nyn_z - nys_z + 1 ) * ( nzt_y - nzb_y + 1 ) * & 429 ( nxr_z - nxl_z + 1 ) 430 zs = 1 + l * ( nzt_y - nzb_y + 1 ) 431 DO j = nys_z, nyn_z 432 DO k = zs, zs + nzt_y - nzb_y 433 DO i = nxl_z, nxr_z 434 434 m = m + 1 435 435 f_out(i,j,k) = work(m) … … 465 465 INTEGER :: i, j, k, l, m, xs 466 466 467 REAL :: f_in(1:nz a,nys:nyna,nxl:nxra), f_inv(nys:nyna,nxl:nxra,1:nza), &468 f_out(0:nx a,nys_x:nyn_xa,nzb_x:nzt_xa),&467 REAL :: f_in(1:nz,nys:nyn,nxl:nxr), f_inv(nys:nyn,nxl:nxr,1:nz), & 468 f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x), & 469 469 work(nnx*nny*nnz) 470 470 … … 476 476 !$OMP PARALLEL PRIVATE ( i, j, k ) 477 477 !$OMP DO 478 DO k = 1,nz a479 DO i = nxl, nxr a480 DO j = nys, nyn a478 DO k = 1,nz 479 DO i = nxl, nxr 480 DO j = nys, nyn 481 481 f_inv(j,i,k) = f_in(k,j,i) 482 482 ENDDO … … 493 493 !$OMP PARALLEL PRIVATE ( i, j, k ) 494 494 !$OMP DO 495 DO k = 1, nz a496 DO i = nxl, nxr a497 DO j = nys, nyn a495 DO k = 1, nz 496 DO i = nxl, nxr 497 DO j = nys, nyn 498 498 f_out(i,j,k) = f_inv(j,i,k) 499 499 ENDDO … … 518 518 !$OMP DO 519 519 DO l = 0, pdims(1) - 1 520 m = l * ( nzt_x a - nzb_x + 1 ) * nnx * ( nyn_xa- nys_x + 1 )520 m = l * ( nzt_x - nzb_x + 1 ) * nnx * ( nyn_x - nys_x + 1 ) 521 521 xs = 0 + l * nnx 522 DO k = nzb_x, nzt_x a522 DO k = nzb_x, nzt_x 523 523 DO i = xs, xs + nnx - 1 524 DO j = nys_x, nyn_x a524 DO j = nys_x, nyn_x 525 525 m = m + 1 526 526 f_out(i,j,k) = work(m) … … 556 556 INTEGER :: i, j, k, l, m, zs 557 557 558 REAL :: f_in(nxl_z:nxr_z a,nys_z:nyn_za,1:nza),&559 f_inv(nxl_y:nxr_y a,nzb_y:nzt_ya,0:nya),&560 f_out(0:ny a,nxl_y:nxr_ya,nzb_y:nzt_ya),&558 REAL :: f_in(nxl_z:nxr_z,nys_z:nyn_z,1:nz), & 559 f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny), & 560 f_out(0:ny,nxl_y:nxr_y,nzb_y:nzt_y), & 561 561 work(nnx*nny*nnz) 562 562 … … 572 572 !$OMP DO 573 573 DO l = 0, pdims(1) - 1 574 m = l * ( nyn_z a - nys_z + 1 ) * ( nzt_ya- nzb_y + 1 ) * &575 ( nxr_z a- nxl_z + 1 )576 zs = 1 + l * ( nzt_y a- nzb_y + 1 )577 DO j = nys_z, nyn_z a578 DO k = zs, zs + nzt_y a- nzb_y579 DO i = nxl_z, nxr_z a574 m = l * ( nyn_z - nys_z + 1 ) * ( nzt_y - nzb_y + 1 ) * & 575 ( nxr_z - nxl_z + 1 ) 576 zs = 1 + l * ( nzt_y - nzb_y + 1 ) 577 DO j = nys_z, nyn_z 578 DO k = zs, zs + nzt_y - nzb_y 579 DO i = nxl_z, nxr_z 580 580 m = m + 1 581 581 work(m) = f_in(i,j,k) … … 599 599 !$OMP PARALLEL PRIVATE ( i, j, k ) 600 600 !$OMP DO 601 DO j = 0, ny a602 DO k = nzb_y, nzt_y a603 DO i = nxl_y, nxr_y a601 DO j = 0, ny 602 DO k = nzb_y, nzt_y 603 DO i = nxl_y, nxr_y 604 604 f_out(j,i,k) = f_inv(i,k,j) 605 605 ENDDO … … 612 612 !$OMP PARALLEL PRIVATE ( i, j, k ) 613 613 !$OMP DO 614 DO k = nzb_y, nzt_y a615 DO j = 0, ny a616 DO i = nxl_y, nxr_y a614 DO k = nzb_y, nzt_y 615 DO j = 0, ny 616 DO i = nxl_y, nxr_y 617 617 f_inv(i,k,j) = f_in(i,j,k) 618 618 ENDDO … … 624 624 !$OMP PARALLEL PRIVATE ( i, j, k ) 625 625 !$OMP DO 626 DO k = nzb_y, nzt_y a627 DO i = nxl_y, nxr_y a628 DO j = 0, ny a626 DO k = nzb_y, nzt_y 627 DO i = nxl_y, nxr_y 628 DO j = 0, ny 629 629 f_out(j,i,k) = f_inv(i,k,j) 630 630 ENDDO … … 662 662 INTEGER :: i, j, k, l, m, ys 663 663 664 REAL :: f_in(1:nz a,nys:nyna,nxl:nxra), f_inv(nys:nyna,nxl:nxra,1:nza), &665 f_out(0:ny a,nxl_yd:nxr_yda,nzb_yd:nzt_yda),&664 REAL :: f_in(1:nz,nys:nyn,nxl:nxr), f_inv(nys:nyn,nxl:nxr,1:nz), & 665 f_out(0:ny,nxl_yd:nxr_yd,nzb_yd:nzt_yd), & 666 666 work(nnx*nny*nnz) 667 667 … … 671 671 !-- Rearrange indices of input array in order to make data to be send 672 672 !-- by MPI contiguous 673 DO i = nxl, nxr a674 DO j = nys, nyn a675 DO k = 1, nz a673 DO i = nxl, nxr 674 DO j = nys, nyn 675 DO k = 1, nz 676 676 f_inv(j,i,k) = f_in(k,j,i) 677 677 ENDDO … … 685 685 !-- of the data is necessary and no transposition has to be done. 686 686 IF ( pdims(2) == 1 ) THEN 687 DO k = 1, nz a688 DO i = nxl, nxr a689 DO j = nys, nyn a687 DO k = 1, nz 688 DO i = nxl, nxr 689 DO j = nys, nyn 690 690 f_out(j,i,k) = f_inv(j,i,k) 691 691 ENDDO … … 709 709 DO l = 0, pdims(2) - 1 710 710 ys = 0 + l * nny 711 DO k = nzb_yd, nzt_yd a712 DO i = nxl_yd, nxr_yd a711 DO k = nzb_yd, nzt_yd 712 DO i = nxl_yd, nxr_yd 713 713 DO j = ys, ys + nny - 1 714 714 m = m + 1 -
palm/trunk/SOURCE/write_var_list.f90
r1002 r1003 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! -grid_matching 7 7 ! 8 8 ! Former revisions: … … 285 285 WRITE ( 14 ) 'galilei_transformation ' 286 286 WRITE ( 14 ) galilei_transformation 287 WRITE ( 14 ) 'grid_matching '288 WRITE ( 14 ) grid_matching289 287 WRITE ( 14 ) 'hom ' 290 288 WRITE ( 14 ) hom
Note: See TracChangeset
for help on using the changeset viewer.
