Changeset 1003 for palm/trunk/SOURCE/transpose.f90
- Timestamp:
- Sep 14, 2012 2:35:53 PM (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.