- Timestamp:
- 2013-09-09T12:13:17+02:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r3918 r4015 22 22 !! 'mpp_lnk_bdy_2d' and 'mpp_lnk_obc_2d' routines and update 23 23 !! the mppobc routine to optimize the BDY and OBC communications 24 !! 3.6 ! 2013 ( C. Ethe, G. Madec ) message passing arrays as local variables 24 25 !!---------------------------------------------------------------------- 25 26 … … 71 72 PUBLIC mppsize 72 73 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 73 PUBLIC lib_mpp_alloc ! Called in nemogcm.F9074 74 PUBLIC mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 75 75 PUBLIC mpp_lnk_obc_2d, mpp_lnk_obc_3d … … 150 150 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon ! buffer in case of bsend 151 151 152 ! message passing arrays153 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE :: t4ns, t4sn ! 2 x 3d for north-south & south-north154 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE :: t4ew, t4we ! 2 x 3d for east-west & west-east155 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE :: t4p1, t4p2 ! 2 x 3d for north fold156 REAL(wp), DIMENSION(:,:,:,:) , ALLOCATABLE, SAVE :: t3ns, t3sn ! 3d for north-south & south-north157 REAL(wp), DIMENSION(:,:,:,:) , ALLOCATABLE, SAVE :: t3ew, t3we ! 3d for east-west & west-east158 REAL(wp), DIMENSION(:,:,:,:) , ALLOCATABLE, SAVE :: t3p1, t3p2 ! 3d for north fold159 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: t2ns, t2sn ! 2d for north-south & south-north160 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: t2ew, t2we ! 2d for east-west & west-east161 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: t2p1, t2p2 ! 2d for north fold162 163 ! Arrays used in mpp_lbc_north_3d()164 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: tab_3d, xnorthloc165 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: xnorthgloio166 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: foldwk ! Workspace for message transfers avoiding mpi_allgather167 168 ! Arrays used in mpp_lbc_north_2d()169 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: tab_2d, xnorthloc_2d170 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: xnorthgloio_2d171 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: foldwk_2d ! Workspace for message transfers avoiding mpi_allgather172 173 ! Arrays used in mpp_lbc_north_e()174 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: tab_e, xnorthloc_e175 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: xnorthgloio_e176 177 152 ! North fold arrays used to minimise the use of allgather operations. Set in nemo_northcomms (nemogcm) so need to be public 178 153 INTEGER, PUBLIC, PARAMETER :: jpmaxngh = 8 ! Assumed maximum number of active neighbours … … 189 164 !!---------------------------------------------------------------------- 190 165 CONTAINS 191 192 INTEGER FUNCTION lib_mpp_alloc( kumout )193 !!----------------------------------------------------------------------194 !! *** routine lib_mpp_alloc ***195 !!----------------------------------------------------------------------196 INTEGER, INTENT(in) :: kumout ! ocean.output logical unit197 !!----------------------------------------------------------------------198 !199 ALLOCATE( t4ns(jpi,jprecj,jpk,2,2) , t4sn(jpi,jprecj,jpk,2,2) , &200 & t4ew(jpj,jpreci,jpk,2,2) , t4we(jpj,jpreci,jpk,2,2) , &201 & t4p1(jpi,jprecj,jpk,2,2) , t4p2(jpi,jprecj,jpk,2,2) , &202 & t3ns(jpi,jprecj,jpk,2) , t3sn(jpi,jprecj,jpk,2) , &203 & t3ew(jpj,jpreci,jpk,2) , t3we(jpj,jpreci,jpk,2) , &204 & t3p1(jpi,jprecj,jpk,2) , t3p2(jpi,jprecj,jpk,2) , &205 & t2ns(jpi,jprecj ,2) , t2sn(jpi,jprecj ,2) , &206 & t2ew(jpj,jpreci ,2) , t2we(jpj,jpreci ,2) , &207 & t2p1(jpi,jprecj ,2) , t2p2(jpi,jprecj ,2) , &208 !209 & tab_3d(jpiglo,4,jpk) , xnorthloc(jpi,4,jpk) , xnorthgloio(jpi,4,jpk,jpni) , &210 & foldwk(jpi,4,jpk) , &211 !212 & tab_2d(jpiglo,4) , xnorthloc_2d(jpi,4) , xnorthgloio_2d(jpi,4,jpni) , &213 & foldwk_2d(jpi,4) , &214 !215 & tab_e(jpiglo,4+2*jpr2dj) , xnorthloc_e(jpi,4+2*jpr2dj) , xnorthgloio_e(jpi,4+2*jpr2dj,jpni) , &216 !217 & STAT=lib_mpp_alloc )218 !219 IF( lib_mpp_alloc /= 0 ) THEN220 WRITE(kumout,cform_war)221 WRITE(kumout,*) 'lib_mpp_alloc : failed to allocate arrays'222 ENDIF223 !224 END FUNCTION lib_mpp_alloc225 166 226 167 … … 385 326 REAL(wp) :: zland 386 327 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 387 !!---------------------------------------------------------------------- 328 ! 329 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! 3d for north-south & south-north 330 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east 331 332 !!---------------------------------------------------------------------- 333 334 ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2), & 335 & zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2) ) 388 336 389 337 zland = 0.e0 ! zero by default … … 420 368 iihom = nlci-nreci 421 369 DO jl = 1, jpreci 422 t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)423 t3we(:,jl,:,1) = ptab(iihom +jl,:,:)370 zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 371 zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 424 372 END DO 425 373 END SELECT … … 430 378 SELECT CASE ( nbondi ) 431 379 CASE ( -1 ) 432 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )433 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )380 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 381 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 434 382 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 435 383 CASE ( 0 ) 436 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )437 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )438 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )439 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )384 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 385 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 ) 386 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 387 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 440 388 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 441 389 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 442 390 CASE ( 1 ) 443 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )444 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )391 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 392 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 445 393 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 446 394 END SELECT … … 452 400 CASE ( -1 ) 453 401 DO jl = 1, jpreci 454 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)402 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 455 403 END DO 456 404 CASE ( 0 ) 457 405 DO jl = 1, jpreci 458 ptab(jl ,:,:) = t3we(:,jl,:,2)459 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)406 ptab(jl ,:,:) = zt3we(:,jl,:,2) 407 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 460 408 END DO 461 409 CASE ( 1 ) 462 410 DO jl = 1, jpreci 463 ptab(jl ,:,:) = t3we(:,jl,:,2)411 ptab(jl ,:,:) = zt3we(:,jl,:,2) 464 412 END DO 465 413 END SELECT … … 475 423 ijhom = nlcj-nrecj 476 424 DO jl = 1, jprecj 477 t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)478 t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)425 zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 426 zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 479 427 END DO 480 428 ENDIF … … 485 433 SELECT CASE ( nbondj ) 486 434 CASE ( -1 ) 487 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )488 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )435 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 436 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 489 437 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 490 438 CASE ( 0 ) 491 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )492 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )493 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )494 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )439 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 440 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 ) 441 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 442 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 495 443 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 496 444 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 497 445 CASE ( 1 ) 498 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )499 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )446 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 447 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 500 448 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 501 449 END SELECT … … 507 455 CASE ( -1 ) 508 456 DO jl = 1, jprecj 509 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)457 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 510 458 END DO 511 459 CASE ( 0 ) 512 460 DO jl = 1, jprecj 513 ptab(:,jl ,:) = t3sn(:,jl,:,2)514 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)461 ptab(:,jl ,:) = zt3sn(:,jl,:,2) 462 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 515 463 END DO 516 464 CASE ( 1 ) 517 465 DO jl = 1, jprecj 518 ptab(:,jl,:) = t3sn(:,jl,:,2)466 ptab(:,jl,:) = zt3sn(:,jl,:,2) 519 467 END DO 520 468 END SELECT … … 533 481 ! 534 482 ENDIF 483 ! 484 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 535 485 ! 536 486 END SUBROUTINE mpp_lnk_obc_3d … … 567 517 REAL(wp) :: zland 568 518 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 569 !!---------------------------------------------------------------------- 519 ! 520 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 521 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 522 523 !!---------------------------------------------------------------------- 524 525 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), & 526 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) ) 570 527 571 528 zland = 0.e0 ! zero by default … … 602 559 iihom = nlci-nreci 603 560 DO jl = 1, jpreci 604 t2ew(:,jl,1) = pt2d(jpreci+jl,:)605 t2we(:,jl,1) = pt2d(iihom +jl,:)561 zt2ew(:,jl,1) = pt2d(jpreci+jl,:) 562 zt2we(:,jl,1) = pt2d(iihom +jl,:) 606 563 END DO 607 564 END SELECT … … 612 569 SELECT CASE ( nbondi ) 613 570 CASE ( -1 ) 614 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )615 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )571 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 572 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 616 573 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 617 574 CASE ( 0 ) 618 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )619 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )620 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )621 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )575 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 576 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 577 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 578 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 622 579 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 623 580 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 624 581 CASE ( 1 ) 625 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )626 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )582 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 583 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 627 584 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 628 585 END SELECT … … 634 591 CASE ( -1 ) 635 592 DO jl = 1, jpreci 636 pt2d(iihom+jl,:) = t2ew(:,jl,2)593 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 637 594 END DO 638 595 CASE ( 0 ) 639 596 DO jl = 1, jpreci 640 pt2d(jl ,:) = t2we(:,jl,2)641 pt2d(iihom+jl,:) = t2ew(:,jl,2)597 pt2d(jl ,:) = zt2we(:,jl,2) 598 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 642 599 END DO 643 600 CASE ( 1 ) 644 601 DO jl = 1, jpreci 645 pt2d(jl ,:) = t2we(:,jl,2)602 pt2d(jl ,:) = zt2we(:,jl,2) 646 603 END DO 647 604 END SELECT … … 655 612 ijhom = nlcj-nrecj 656 613 DO jl = 1, jprecj 657 t2sn(:,jl,1) = pt2d(:,ijhom +jl)658 t2ns(:,jl,1) = pt2d(:,jprecj+jl)614 zt2sn(:,jl,1) = pt2d(:,ijhom +jl) 615 zt2ns(:,jl,1) = pt2d(:,jprecj+jl) 659 616 END DO 660 617 ENDIF … … 665 622 SELECT CASE ( nbondj ) 666 623 CASE ( -1 ) 667 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )668 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )624 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 625 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 669 626 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 670 627 CASE ( 0 ) 671 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )672 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )673 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )674 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )628 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 629 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 630 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 631 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 675 632 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 676 633 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 677 634 CASE ( 1 ) 678 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )679 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )635 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 636 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 680 637 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 681 638 END SELECT … … 687 644 CASE ( -1 ) 688 645 DO jl = 1, jprecj 689 pt2d(:,ijhom+jl) = t2ns(:,jl,2)646 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 690 647 END DO 691 648 CASE ( 0 ) 692 649 DO jl = 1, jprecj 693 pt2d(:,jl ) = t2sn(:,jl,2)694 pt2d(:,ijhom+jl) = t2ns(:,jl,2)650 pt2d(:,jl ) = zt2sn(:,jl,2) 651 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 695 652 END DO 696 653 CASE ( 1 ) 697 654 DO jl = 1, jprecj 698 pt2d(:,jl ) = t2sn(:,jl,2)655 pt2d(:,jl ) = zt2sn(:,jl,2) 699 656 END DO 700 657 END SELECT … … 712 669 ! 713 670 ENDIF 671 ! 672 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 714 673 ! 715 674 END SUBROUTINE mpp_lnk_obc_2d … … 749 708 REAL(wp) :: zland 750 709 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 751 !!---------------------------------------------------------------------- 752 710 ! 711 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! 3d for north-south & south-north 712 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east 713 714 !!---------------------------------------------------------------------- 715 716 ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2), & 717 & zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2) ) 718 719 ! 753 720 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value 754 721 ELSE ; zland = 0.e0 ! zero by default … … 798 765 iihom = nlci-nreci 799 766 DO jl = 1, jpreci 800 t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)801 t3we(:,jl,:,1) = ptab(iihom +jl,:,:)767 zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 768 zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 802 769 END DO 803 770 END SELECT … … 808 775 SELECT CASE ( nbondi ) 809 776 CASE ( -1 ) 810 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )811 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )777 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 778 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 812 779 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 813 780 CASE ( 0 ) 814 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )815 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )816 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )817 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )781 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 782 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 ) 783 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 784 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 818 785 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 819 786 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 820 787 CASE ( 1 ) 821 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )822 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )788 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 789 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 823 790 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 824 791 END SELECT … … 830 797 CASE ( -1 ) 831 798 DO jl = 1, jpreci 832 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)799 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 833 800 END DO 834 801 CASE ( 0 ) 835 802 DO jl = 1, jpreci 836 ptab(jl ,:,:) = t3we(:,jl,:,2)837 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)803 ptab(jl ,:,:) = zt3we(:,jl,:,2) 804 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 838 805 END DO 839 806 CASE ( 1 ) 840 807 DO jl = 1, jpreci 841 ptab(jl ,:,:) = t3we(:,jl,:,2)808 ptab(jl ,:,:) = zt3we(:,jl,:,2) 842 809 END DO 843 810 END SELECT … … 851 818 ijhom = nlcj-nrecj 852 819 DO jl = 1, jprecj 853 t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)854 t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)820 zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 821 zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 855 822 END DO 856 823 ENDIF … … 861 828 SELECT CASE ( nbondj ) 862 829 CASE ( -1 ) 863 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )864 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )830 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 831 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 865 832 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 866 833 CASE ( 0 ) 867 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )868 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )869 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )870 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )834 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 835 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 ) 836 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 837 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 871 838 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 872 839 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 873 840 CASE ( 1 ) 874 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )875 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )841 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 842 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 876 843 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 877 844 END SELECT … … 883 850 CASE ( -1 ) 884 851 DO jl = 1, jprecj 885 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)852 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 886 853 END DO 887 854 CASE ( 0 ) 888 855 DO jl = 1, jprecj 889 ptab(:,jl ,:) = t3sn(:,jl,:,2)890 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)856 ptab(:,jl ,:) = zt3sn(:,jl,:,2) 857 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 891 858 END DO 892 859 CASE ( 1 ) 893 860 DO jl = 1, jprecj 894 ptab(:,jl,:) = t3sn(:,jl,:,2)861 ptab(:,jl,:) = zt3sn(:,jl,:,2) 895 862 END DO 896 863 END SELECT … … 908 875 ! 909 876 ENDIF 877 ! 878 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 910 879 ! 911 880 END SUBROUTINE mpp_lnk_3d … … 944 913 REAL(wp) :: zland 945 914 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 946 !!---------------------------------------------------------------------- 947 915 ! 916 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 917 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 918 919 !!---------------------------------------------------------------------- 920 921 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), & 922 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) ) 923 924 ! 948 925 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value 949 926 ELSE ; zland = 0.e0 ! zero by default … … 992 969 iihom = nlci-nreci 993 970 DO jl = 1, jpreci 994 t2ew(:,jl,1) = pt2d(jpreci+jl,:)995 t2we(:,jl,1) = pt2d(iihom +jl,:)971 zt2ew(:,jl,1) = pt2d(jpreci+jl,:) 972 zt2we(:,jl,1) = pt2d(iihom +jl,:) 996 973 END DO 997 974 END SELECT … … 1002 979 SELECT CASE ( nbondi ) 1003 980 CASE ( -1 ) 1004 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )1005 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )981 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 982 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 1006 983 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1007 984 CASE ( 0 ) 1008 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )1009 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )1010 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )1011 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )985 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 986 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 987 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 988 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 1012 989 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1013 990 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1014 991 CASE ( 1 ) 1015 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )1016 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )992 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 993 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 1017 994 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1018 995 END SELECT … … 1024 1001 CASE ( -1 ) 1025 1002 DO jl = 1, jpreci 1026 pt2d(iihom+jl,:) = t2ew(:,jl,2)1003 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 1027 1004 END DO 1028 1005 CASE ( 0 ) 1029 1006 DO jl = 1, jpreci 1030 pt2d(jl ,:) = t2we(:,jl,2)1031 pt2d(iihom+jl,:) = t2ew(:,jl,2)1007 pt2d(jl ,:) = zt2we(:,jl,2) 1008 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 1032 1009 END DO 1033 1010 CASE ( 1 ) 1034 1011 DO jl = 1, jpreci 1035 pt2d(jl ,:) = t2we(:,jl,2)1012 pt2d(jl ,:) = zt2we(:,jl,2) 1036 1013 END DO 1037 1014 END SELECT … … 1045 1022 ijhom = nlcj-nrecj 1046 1023 DO jl = 1, jprecj 1047 t2sn(:,jl,1) = pt2d(:,ijhom +jl)1048 t2ns(:,jl,1) = pt2d(:,jprecj+jl)1024 zt2sn(:,jl,1) = pt2d(:,ijhom +jl) 1025 zt2ns(:,jl,1) = pt2d(:,jprecj+jl) 1049 1026 END DO 1050 1027 ENDIF … … 1055 1032 SELECT CASE ( nbondj ) 1056 1033 CASE ( -1 ) 1057 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )1058 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )1034 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 1035 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 1059 1036 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1060 1037 CASE ( 0 ) 1061 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )1062 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )1063 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )1064 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )1038 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 1039 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 1040 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 1041 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 1065 1042 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1066 1043 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1067 1044 CASE ( 1 ) 1068 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )1069 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )1045 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 1046 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 1070 1047 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1071 1048 END SELECT … … 1077 1054 CASE ( -1 ) 1078 1055 DO jl = 1, jprecj 1079 pt2d(:,ijhom+jl) = t2ns(:,jl,2)1056 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 1080 1057 END DO 1081 1058 CASE ( 0 ) 1082 1059 DO jl = 1, jprecj 1083 pt2d(:,jl ) = t2sn(:,jl,2)1084 pt2d(:,ijhom+jl) = t2ns(:,jl,2)1060 pt2d(:,jl ) = zt2sn(:,jl,2) 1061 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 1085 1062 END DO 1086 1063 CASE ( 1 ) 1087 1064 DO jl = 1, jprecj 1088 pt2d(:,jl ) = t2sn(:,jl,2)1065 pt2d(:,jl ) = zt2sn(:,jl,2) 1089 1066 END DO 1090 1067 END SELECT … … 1102 1079 ! 1103 1080 ENDIF 1081 ! 1082 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 1104 1083 ! 1105 1084 END SUBROUTINE mpp_lnk_2d … … 1137 1116 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 1138 1117 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 1139 !!---------------------------------------------------------------------- 1118 ! 1119 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zt4ns, zt4sn ! 2 x 3d for north-south & south-north 1120 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zt4ew, zt4we ! 2 x 3d for east-west & west-east 1121 1122 !!---------------------------------------------------------------------- 1123 ALLOCATE( zt4ns(jpi,jprecj,jpk,2,2), zt4sn(jpi,jprecj,jpk,2,2) , & 1124 & zt4ew(jpj,jpreci,jpk,2,2), zt4we(jpj,jpreci,jpk,2,2) ) 1125 1140 1126 1141 1127 ! 1. standard boundary treatment … … 1171 1157 iihom = nlci-nreci 1172 1158 DO jl = 1, jpreci 1173 t4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:)1174 t4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:)1175 t4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:)1176 t4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:)1159 zt4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:) 1160 zt4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:) 1161 zt4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:) 1162 zt4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:) 1177 1163 END DO 1178 1164 END SELECT … … 1183 1169 SELECT CASE ( nbondi ) 1184 1170 CASE ( -1 ) 1185 CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 )1186 CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea )1171 CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req1 ) 1172 CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea ) 1187 1173 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1188 1174 CASE ( 0 ) 1189 CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )1190 CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req2 )1191 CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea )1192 CALL mpprecv( 2, t4we(1,1,1,1,2), imigr, nowe )1175 CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 1176 CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req2 ) 1177 CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea ) 1178 CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe ) 1193 1179 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1194 1180 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 1195 1181 CASE ( 1 ) 1196 CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )1197 CALL mpprecv( 2, t4we(1,1,1,1,2), imigr, nowe )1182 CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 1183 CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe ) 1198 1184 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1199 1185 END SELECT … … 1205 1191 CASE ( -1 ) 1206 1192 DO jl = 1, jpreci 1207 ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)1208 ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)1193 ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2) 1194 ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2) 1209 1195 END DO 1210 1196 CASE ( 0 ) 1211 1197 DO jl = 1, jpreci 1212 ptab1(jl ,:,:) = t4we(:,jl,:,1,2)1213 ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)1214 ptab2(jl ,:,:) = t4we(:,jl,:,2,2)1215 ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)1198 ptab1(jl ,:,:) = zt4we(:,jl,:,1,2) 1199 ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2) 1200 ptab2(jl ,:,:) = zt4we(:,jl,:,2,2) 1201 ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2) 1216 1202 END DO 1217 1203 CASE ( 1 ) 1218 1204 DO jl = 1, jpreci 1219 ptab1(jl ,:,:) = t4we(:,jl,:,1,2)1220 ptab2(jl ,:,:) = t4we(:,jl,:,2,2)1205 ptab1(jl ,:,:) = zt4we(:,jl,:,1,2) 1206 ptab2(jl ,:,:) = zt4we(:,jl,:,2,2) 1221 1207 END DO 1222 1208 END SELECT … … 1230 1216 ijhom = nlcj - nrecj 1231 1217 DO jl = 1, jprecj 1232 t4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:)1233 t4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:)1234 t4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:)1235 t4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:)1218 zt4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:) 1219 zt4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:) 1220 zt4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:) 1221 zt4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:) 1236 1222 END DO 1237 1223 ENDIF … … 1242 1228 SELECT CASE ( nbondj ) 1243 1229 CASE ( -1 ) 1244 CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req1 )1245 CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono )1230 CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req1 ) 1231 CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono ) 1246 1232 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1247 1233 CASE ( 0 ) 1248 CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )1249 CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req2 )1250 CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono )1251 CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr, noso )1234 CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 1235 CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req2 ) 1236 CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono ) 1237 CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso ) 1252 1238 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1253 1239 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 1254 1240 CASE ( 1 ) 1255 CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )1256 CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr, noso )1241 CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 1242 CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso ) 1257 1243 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1258 1244 END SELECT … … 1264 1250 CASE ( -1 ) 1265 1251 DO jl = 1, jprecj 1266 ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)1267 ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)1252 ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2) 1253 ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2) 1268 1254 END DO 1269 1255 CASE ( 0 ) 1270 1256 DO jl = 1, jprecj 1271 ptab1(:,jl ,:) = t4sn(:,jl,:,1,2)1272 ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)1273 ptab2(:,jl ,:) = t4sn(:,jl,:,2,2)1274 ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)1257 ptab1(:,jl ,:) = zt4sn(:,jl,:,1,2) 1258 ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2) 1259 ptab2(:,jl ,:) = zt4sn(:,jl,:,2,2) 1260 ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2) 1275 1261 END DO 1276 1262 CASE ( 1 ) 1277 1263 DO jl = 1, jprecj 1278 ptab1(:,jl,:) = t4sn(:,jl,:,1,2)1279 ptab2(:,jl,:) = t4sn(:,jl,:,2,2)1264 ptab1(:,jl,:) = zt4sn(:,jl,:,1,2) 1265 ptab2(:,jl,:) = zt4sn(:,jl,:,2,2) 1280 1266 END DO 1281 1267 END SELECT … … 1296 1282 ! 1297 1283 ENDIF 1284 ! 1285 DEALLOCATE( zt4ns, zt4sn, zt4ew, zt4we ) 1298 1286 ! 1299 1287 END SUBROUTINE mpp_lnk_3d_gather … … 2148 2136 INTEGER :: ml_stat(MPI_STATUS_SIZE) ! for key_mpi_isend 2149 2137 REAL(wp), POINTER, DIMENSION(:,:) :: ztab ! temporary workspace 2138 ! 2139 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 2140 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 2150 2141 LOGICAL :: lmigr ! is true for those processors that have to migrate the OB 2151 !!---------------------------------------------------------------------- 2142 2143 !!---------------------------------------------------------------------- 2144 2145 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), & 2146 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) ) 2152 2147 2153 2148 CALL wrk_alloc( jpi,jpj, ztab ) … … 2213 2208 IF( nbondi /= 2 ) THEN ! Read Dirichlet lateral conditions 2214 2209 iihom = nlci-nreci 2215 t2ew(1:jpreci,1,1) = ztab(jpreci+1:nreci, ijpt0)2216 t2we(1:jpreci,1,1) = ztab(iihom+1:iihom+jpreci, ijpt0)2210 zt2ew(1:jpreci,1,1) = ztab(jpreci+1:nreci, ijpt0) 2211 zt2we(1:jpreci,1,1) = ztab(iihom+1:iihom+jpreci, ijpt0) 2217 2212 ENDIF 2218 2213 ! … … 2221 2216 ! 2222 2217 IF( nbondi == -1 ) THEN 2223 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )2224 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )2218 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 2219 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 2225 2220 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2226 2221 ELSEIF( nbondi == 0 ) THEN 2227 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )2228 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )2229 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )2230 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )2222 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 2223 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 2224 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 2225 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 2231 2226 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2232 2227 IF(l_isend) CALL mpi_wait( ml_req2, ml_stat, ml_err ) 2233 2228 ELSEIF( nbondi == 1 ) THEN 2234 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )2235 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )2229 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 2230 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 2236 2231 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2237 2232 ENDIF … … 2241 2236 ! 2242 2237 IF( nbondi == 0 .OR. nbondi == 1 ) THEN 2243 ztab(1:jpreci, ijpt0) = t2we(1:jpreci,1,2)2238 ztab(1:jpreci, ijpt0) = zt2we(1:jpreci,1,2) 2244 2239 ENDIF 2245 2240 IF( nbondi == -1 .OR. nbondi == 0 ) THEN 2246 ztab(iihom+1:iihom+jpreci, ijpt0) = t2ew(1:jpreci,1,2)2241 ztab(iihom+1:iihom+jpreci, ijpt0) = zt2ew(1:jpreci,1,2) 2247 2242 ENDIF 2248 2243 ENDIF ! (ktype == 1) … … 2254 2249 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 2255 2250 ijhom = nlcj-nrecj 2256 t2sn(1:jprecj,1,1) = ztab(iipt0, ijhom+1:ijhom+jprecj)2257 t2ns(1:jprecj,1,1) = ztab(iipt0, jprecj+1:nrecj)2251 zt2sn(1:jprecj,1,1) = ztab(iipt0, ijhom+1:ijhom+jprecj) 2252 zt2ns(1:jprecj,1,1) = ztab(iipt0, jprecj+1:nrecj) 2258 2253 ENDIF 2259 2254 ! … … 2262 2257 ! 2263 2258 IF( nbondj == -1 ) THEN 2264 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )2265 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )2259 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 2260 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 2266 2261 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2267 2262 ELSEIF( nbondj == 0 ) THEN 2268 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )2269 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )2270 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )2271 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )2263 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 2264 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 2265 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 2266 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 2272 2267 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2273 2268 IF( l_isend ) CALL mpi_wait( ml_req2, ml_stat, ml_err ) 2274 2269 ELSEIF( nbondj == 1 ) THEN 2275 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )2276 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso)2270 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 2271 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso) 2277 2272 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2278 2273 ENDIF … … 2281 2276 ijhom = nlcj - jprecj 2282 2277 IF( nbondj == 0 .OR. nbondj == 1 ) THEN 2283 ztab(iipt0,1:jprecj) = t2sn(1:jprecj,1,2)2278 ztab(iipt0,1:jprecj) = zt2sn(1:jprecj,1,2) 2284 2279 ENDIF 2285 2280 IF( nbondj == 0 .OR. nbondj == -1 ) THEN 2286 ztab(iipt0, ijhom+1:ijhom+jprecj) = t2ns(1:jprecj,1,2)2281 ztab(iipt0, ijhom+1:ijhom+jprecj) = zt2ns(1:jprecj,1,2) 2287 2282 ENDIF 2288 2283 ENDIF ! (ktype == 2) … … 2304 2299 ! 2305 2300 ENDIF ! ( lmigr ) 2301 ! 2302 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 2306 2303 CALL wrk_dealloc( jpi,jpj, ztab ) 2307 2304 ! … … 2593 2590 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather 2594 2591 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for mpi_isend when avoiding mpi_allgather 2595 !!---------------------------------------------------------------------- 2596 ! 2592 ! ! Workspace for message transfers avoiding mpi_allgather 2593 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: ztab 2594 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: znorthloc, zfoldwk 2595 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: znorthgloio 2596 2597 !!---------------------------------------------------------------------- 2598 ! 2599 ALLOCATE( ztab(jpiglo,4,jpk), znorthloc(jpi,4,jpk), zfoldwk(jpi,4,jpk), znorthgloio(jpi,4,jpk,jpni) ) 2600 2597 2601 ijpj = 4 2598 2602 ityp = -1 2599 2603 ijpjm1 = 3 2600 tab_3d(:,:,:) = 0.e02601 ! 2602 DO jj = nlcj - ijpj +1, nlcj ! put in xnorthloc the last 4 jlines of pt3d2604 ztab(:,:,:) = 0.e0 2605 ! 2606 DO jj = nlcj - ijpj +1, nlcj ! put in znorthloc the last 4 jlines of pt3d 2603 2607 ij = jj - nlcj + ijpj 2604 xnorthloc(:,ij,:) = pt3d(:,jj,:)2608 znorthloc(:,ij,:) = pt3d(:,jj,:) 2605 2609 END DO 2606 2610 ! 2607 ! ! Build in procs of ncomm_north the xnorthgloio2611 ! ! Build in procs of ncomm_north the znorthgloio 2608 2612 itaille = jpi * jpk * ijpj 2609 2613 IF ( l_north_nogather ) THEN … … 2615 2619 ij = jj - nlcj + ijpj 2616 2620 DO ji = 1, nlci 2617 tab_3d(ji+nimpp-1,ij,:) = pt3d(ji,jj,:)2621 ztab(ji+nimpp-1,ij,:) = pt3d(ji,jj,:) 2618 2622 END DO 2619 2623 END DO … … 2640 2644 2641 2645 DO jr = 1,nsndto(ityp) 2642 CALL mppsend(5, xnorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) )2646 CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2643 2647 END DO 2644 2648 DO jr = 1,nsndto(ityp) 2645 CALL mpprecv(5, foldwk, itaille, isendto(jr,ityp))2649 CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp)) 2646 2650 iproc = isendto(jr,ityp) + 1 2647 2651 ildi = nldit (iproc) … … 2650 2654 DO jj = 1, ijpj 2651 2655 DO ji = ildi, ilei 2652 tab_3d(ji+iilb-1,jj,:) =foldwk(ji,jj,:)2656 ztab(ji+iilb-1,jj,:) = zfoldwk(ji,jj,:) 2653 2657 END DO 2654 2658 END DO … … 2665 2669 2666 2670 IF ( ityp .lt. 0 ) THEN 2667 CALL MPI_ALLGATHER( xnorthloc , itaille, MPI_DOUBLE_PRECISION, &2668 & xnorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2671 CALL MPI_ALLGATHER( znorthloc , itaille, MPI_DOUBLE_PRECISION, & 2672 & znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2669 2673 ! 2670 2674 DO jr = 1, ndim_rank_north ! recover the global north array … … 2675 2679 DO jj = 1, ijpj 2676 2680 DO ji = ildi, ilei 2677 tab_3d(ji+iilb-1,jj,:) = xnorthgloio(ji,jj,:,jr)2681 ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr) 2678 2682 END DO 2679 2683 END DO … … 2681 2685 ENDIF 2682 2686 ! 2683 ! The tab_3darray has been either:2687 ! The ztab array has been either: 2684 2688 ! a. Fully populated by the mpi_allgather operation or 2685 2689 ! b. Had the active points for this domain and northern neighbours populated … … 2688 2692 ! this domain will be identical. 2689 2693 ! 2690 CALL lbc_nfd( tab_3d, cd_type, psgn ) ! North fold boundary condition2694 CALL lbc_nfd( ztab, cd_type, psgn ) ! North fold boundary condition 2691 2695 ! 2692 2696 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt3d 2693 2697 ij = jj - nlcj + ijpj 2694 2698 DO ji= 1, nlci 2695 pt3d(ji,jj,:) = tab_3d(ji+nimpp-1,ij,:)2699 pt3d(ji,jj,:) = ztab(ji+nimpp-1,ij,:) 2696 2700 END DO 2697 2701 END DO 2702 ! 2703 DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio ) 2698 2704 ! 2699 2705 END SUBROUTINE mpp_lbc_north_3d … … 2725 2731 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather 2726 2732 INTEGER, DIMENSION(MPI_STATUS_SIZE):: ml_stat ! for mpi_isend when avoiding mpi_allgather 2727 !!---------------------------------------------------------------------- 2733 ! ! Workspace for message transfers avoiding mpi_allgather 2734 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ztab 2735 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: znorthloc, zfoldwk 2736 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: znorthgloio 2737 !!---------------------------------------------------------------------- 2738 ! 2739 ALLOCATE( ztab(jpiglo,4), znorthloc(jpi,4), zfoldwk(jpi,4), znorthgloio(jpi,4,jpni) ) 2728 2740 ! 2729 2741 ijpj = 4 2730 2742 ityp = -1 2731 2743 ijpjm1 = 3 2732 tab_2d(:,:) = 0.e02733 ! 2734 DO jj = nlcj-ijpj+1, nlcj ! put in xnorthloc_2dthe last 4 jlines of pt2d2744 ztab(:,:) = 0.e0 2745 ! 2746 DO jj = nlcj-ijpj+1, nlcj ! put in znorthloc the last 4 jlines of pt2d 2735 2747 ij = jj - nlcj + ijpj 2736 xnorthloc_2d(:,ij) = pt2d(:,jj)2748 znorthloc(:,ij) = pt2d(:,jj) 2737 2749 END DO 2738 2750 2739 ! ! Build in procs of ncomm_north the xnorthgloio_2d2751 ! ! Build in procs of ncomm_north the znorthgloio 2740 2752 itaille = jpi * ijpj 2741 2753 IF ( l_north_nogather ) THEN … … 2747 2759 ij = jj - nlcj + ijpj 2748 2760 DO ji = 1, nlci 2749 tab_2d(ji+nimpp-1,ij) = pt2d(ji,jj)2761 ztab(ji+nimpp-1,ij) = pt2d(ji,jj) 2750 2762 END DO 2751 2763 END DO … … 2773 2785 2774 2786 DO jr = 1,nsndto(ityp) 2775 CALL mppsend(5, xnorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) )2787 CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2776 2788 END DO 2777 2789 DO jr = 1,nsndto(ityp) 2778 CALL mpprecv(5, foldwk_2d, itaille, isendto(jr,ityp))2790 CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp)) 2779 2791 iproc = isendto(jr,ityp) + 1 2780 2792 ildi = nldit (iproc) … … 2783 2795 DO jj = 1, ijpj 2784 2796 DO ji = ildi, ilei 2785 tab_2d(ji+iilb-1,jj) = foldwk_2d(ji,jj)2797 ztab(ji+iilb-1,jj) = zfoldwk(ji,jj) 2786 2798 END DO 2787 2799 END DO … … 2798 2810 2799 2811 IF ( ityp .lt. 0 ) THEN 2800 CALL MPI_ALLGATHER( xnorthloc_2d, itaille, MPI_DOUBLE_PRECISION, &2801 & xnorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2812 CALL MPI_ALLGATHER( znorthloc , itaille, MPI_DOUBLE_PRECISION, & 2813 & znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2802 2814 ! 2803 2815 DO jr = 1, ndim_rank_north ! recover the global north array … … 2808 2820 DO jj = 1, ijpj 2809 2821 DO ji = ildi, ilei 2810 tab_2d(ji+iilb-1,jj) = xnorthgloio_2d(ji,jj,jr)2822 ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr) 2811 2823 END DO 2812 2824 END DO … … 2814 2826 ENDIF 2815 2827 ! 2816 ! The tab array has been either:2828 ! The ztab array has been either: 2817 2829 ! a. Fully populated by the mpi_allgather operation or 2818 2830 ! b. Had the active points for this domain and northern neighbours populated … … 2821 2833 ! this domain will be identical. 2822 2834 ! 2823 CALL lbc_nfd( tab_2d, cd_type, psgn ) ! North fold boundary condition2835 CALL lbc_nfd( ztab, cd_type, psgn ) ! North fold boundary condition 2824 2836 ! 2825 2837 ! … … 2827 2839 ij = jj - nlcj + ijpj 2828 2840 DO ji = 1, nlci 2829 pt2d(ji,jj) = tab_2d(ji+nimpp-1,ij)2841 pt2d(ji,jj) = ztab(ji+nimpp-1,ij) 2830 2842 END DO 2831 2843 END DO 2844 ! 2845 DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio ) 2832 2846 ! 2833 2847 END SUBROUTINE mpp_lbc_north_2d … … 2857 2871 INTEGER :: ierr, itaille, ildi, ilei, iilb 2858 2872 INTEGER :: ijpj, ij, iproc 2859 !!---------------------------------------------------------------------- 2873 ! 2874 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ztab_e, znorthloc_e 2875 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: znorthgloio_e 2876 2877 !!---------------------------------------------------------------------- 2878 ! 2879 ALLOCATE( ztab_e(jpiglo,4+2*jpr2dj), znorthloc_e(jpi,4+2*jpr2dj), znorthgloio_e(jpi,4+2*jpr2dj,jpni) ) 2880 2860 2881 ! 2861 2882 ijpj=4 2862 tab_e(:,:) = 0.e02883 ztab_e(:,:) = 0.e0 2863 2884 2864 2885 ij=0 2865 ! put in xnorthloc_e the last 4 jlines of pt2d2886 ! put in znorthloc_e the last 4 jlines of pt2d 2866 2887 DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj 2867 2888 ij = ij + 1 2868 2889 DO ji = 1, jpi 2869 xnorthloc_e(ji,ij)=pt2d(ji,jj)2890 znorthloc_e(ji,ij)=pt2d(ji,jj) 2870 2891 END DO 2871 2892 END DO 2872 2893 ! 2873 2894 itaille = jpi * ( ijpj + 2 * jpr2dj ) 2874 CALL MPI_ALLGATHER( xnorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, &2875 & xnorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2895 CALL MPI_ALLGATHER( znorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, & 2896 & znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2876 2897 ! 2877 2898 DO jr = 1, ndim_rank_north ! recover the global north array … … 2882 2903 DO jj = 1, ijpj+2*jpr2dj 2883 2904 DO ji = ildi, ilei 2884 tab_e(ji+iilb-1,jj) = xnorthgloio_e(ji,jj,jr)2905 ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr) 2885 2906 END DO 2886 2907 END DO … … 2890 2911 ! 2. North-Fold boundary conditions 2891 2912 ! ---------------------------------- 2892 CALL lbc_nfd( tab_e(:,:), cd_type, psgn, pr2dj = jpr2dj )2913 CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj ) 2893 2914 2894 2915 ij = jpr2dj … … 2897 2918 ij = ij +1 2898 2919 DO ji= 1, nlci 2899 pt2d(ji,jj) = tab_e(ji+nimpp-1,ij)2920 pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij) 2900 2921 END DO 2901 2922 END DO 2923 ! 2924 DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e ) 2902 2925 ! 2903 2926 END SUBROUTINE mpp_lbc_north_e … … 2940 2963 REAL(wp) :: zland 2941 2964 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 2942 !!---------------------------------------------------------------------- 2965 ! 2966 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! 3d for north-south & south-north 2967 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east 2968 2969 !!---------------------------------------------------------------------- 2970 2971 ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2), & 2972 & zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2) ) 2943 2973 2944 2974 zland = 0.e0 … … 2980 3010 iihom = nlci-nreci 2981 3011 DO jl = 1, jpreci 2982 t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)2983 t3we(:,jl,:,1) = ptab(iihom +jl,:,:)3012 zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 3013 zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 2984 3014 END DO 2985 3015 END SELECT … … 2990 3020 SELECT CASE ( nbondi_bdy(ib_bdy) ) 2991 3021 CASE ( -1 ) 2992 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )2993 CASE ( 0 ) 2994 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )2995 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )3022 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 3023 CASE ( 0 ) 3024 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 3025 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 ) 2996 3026 CASE ( 1 ) 2997 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )3027 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 2998 3028 END SELECT 2999 3029 ! 3000 3030 SELECT CASE ( nbondi_bdy_b(ib_bdy) ) 3001 3031 CASE ( -1 ) 3002 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )3003 CASE ( 0 ) 3004 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )3005 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )3032 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 3033 CASE ( 0 ) 3034 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 3035 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 3006 3036 CASE ( 1 ) 3007 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )3037 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 3008 3038 END SELECT 3009 3039 ! … … 3024 3054 CASE ( -1 ) 3025 3055 DO jl = 1, jpreci 3026 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)3056 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 3027 3057 END DO 3028 3058 CASE ( 0 ) 3029 3059 DO jl = 1, jpreci 3030 ptab(jl ,:,:) = t3we(:,jl,:,2)3031 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)3060 ptab(jl ,:,:) = zt3we(:,jl,:,2) 3061 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 3032 3062 END DO 3033 3063 CASE ( 1 ) 3034 3064 DO jl = 1, jpreci 3035 ptab(jl ,:,:) = t3we(:,jl,:,2)3065 ptab(jl ,:,:) = zt3we(:,jl,:,2) 3036 3066 END DO 3037 3067 END SELECT … … 3045 3075 ijhom = nlcj-nrecj 3046 3076 DO jl = 1, jprecj 3047 t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)3048 t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)3077 zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 3078 zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 3049 3079 END DO 3050 3080 ENDIF … … 3055 3085 SELECT CASE ( nbondj_bdy(ib_bdy) ) 3056 3086 CASE ( -1 ) 3057 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )3058 CASE ( 0 ) 3059 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )3060 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )3087 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 3088 CASE ( 0 ) 3089 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 3090 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 ) 3061 3091 CASE ( 1 ) 3062 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )3092 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 3063 3093 END SELECT 3064 3094 ! 3065 3095 SELECT CASE ( nbondj_bdy_b(ib_bdy) ) 3066 3096 CASE ( -1 ) 3067 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )3068 CASE ( 0 ) 3069 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )3070 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )3097 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 3098 CASE ( 0 ) 3099 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 3100 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 3071 3101 CASE ( 1 ) 3072 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )3102 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 3073 3103 END SELECT 3074 3104 ! … … 3089 3119 CASE ( -1 ) 3090 3120 DO jl = 1, jprecj 3091 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)3121 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 3092 3122 END DO 3093 3123 CASE ( 0 ) 3094 3124 DO jl = 1, jprecj 3095 ptab(:,jl ,:) = t3sn(:,jl,:,2)3096 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)3125 ptab(:,jl ,:) = zt3sn(:,jl,:,2) 3126 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 3097 3127 END DO 3098 3128 CASE ( 1 ) 3099 3129 DO jl = 1, jprecj 3100 ptab(:,jl,:) = t3sn(:,jl,:,2)3130 ptab(:,jl,:) = zt3sn(:,jl,:,2) 3101 3131 END DO 3102 3132 END SELECT … … 3114 3144 ! 3115 3145 ENDIF 3146 ! 3147 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 3116 3148 ! 3117 3149 END SUBROUTINE mpp_lnk_bdy_3d … … 3154 3186 REAL(wp) :: zland 3155 3187 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 3156 !!---------------------------------------------------------------------- 3188 ! 3189 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 3190 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 3191 3192 !!---------------------------------------------------------------------- 3193 3194 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), & 3195 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) ) 3157 3196 3158 3197 zland = 0.e0 … … 3194 3233 iihom = nlci-nreci 3195 3234 DO jl = 1, jpreci 3196 t2ew(:,jl,1) = ptab(jpreci+jl,:)3197 t2we(:,jl,1) = ptab(iihom +jl,:)3235 zt2ew(:,jl,1) = ptab(jpreci+jl,:) 3236 zt2we(:,jl,1) = ptab(iihom +jl,:) 3198 3237 END DO 3199 3238 END SELECT … … 3204 3243 SELECT CASE ( nbondi_bdy(ib_bdy) ) 3205 3244 CASE ( -1 ) 3206 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )3207 CASE ( 0 ) 3208 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )3209 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )3245 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 3246 CASE ( 0 ) 3247 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 3248 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 3210 3249 CASE ( 1 ) 3211 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )3250 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 3212 3251 END SELECT 3213 3252 ! 3214 3253 SELECT CASE ( nbondi_bdy_b(ib_bdy) ) 3215 3254 CASE ( -1 ) 3216 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )3217 CASE ( 0 ) 3218 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )3219 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )3255 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 3256 CASE ( 0 ) 3257 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 3258 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 3220 3259 CASE ( 1 ) 3221 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )3260 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 3222 3261 END SELECT 3223 3262 ! … … 3238 3277 CASE ( -1 ) 3239 3278 DO jl = 1, jpreci 3240 ptab(iihom+jl,:) = t2ew(:,jl,2)3279 ptab(iihom+jl,:) = zt2ew(:,jl,2) 3241 3280 END DO 3242 3281 CASE ( 0 ) 3243 3282 DO jl = 1, jpreci 3244 ptab(jl ,:) = t2we(:,jl,2)3245 ptab(iihom+jl,:) = t2ew(:,jl,2)3283 ptab(jl ,:) = zt2we(:,jl,2) 3284 ptab(iihom+jl,:) = zt2ew(:,jl,2) 3246 3285 END DO 3247 3286 CASE ( 1 ) 3248 3287 DO jl = 1, jpreci 3249 ptab(jl ,:) = t2we(:,jl,2)3288 ptab(jl ,:) = zt2we(:,jl,2) 3250 3289 END DO 3251 3290 END SELECT … … 3259 3298 ijhom = nlcj-nrecj 3260 3299 DO jl = 1, jprecj 3261 t2sn(:,jl,1) = ptab(:,ijhom +jl)3262 t2ns(:,jl,1) = ptab(:,jprecj+jl)3300 zt2sn(:,jl,1) = ptab(:,ijhom +jl) 3301 zt2ns(:,jl,1) = ptab(:,jprecj+jl) 3263 3302 END DO 3264 3303 ENDIF … … 3269 3308 SELECT CASE ( nbondj_bdy(ib_bdy) ) 3270 3309 CASE ( -1 ) 3271 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )3272 CASE ( 0 ) 3273 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )3274 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )3310 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 3311 CASE ( 0 ) 3312 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 3313 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 3275 3314 CASE ( 1 ) 3276 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )3315 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 3277 3316 END SELECT 3278 3317 ! 3279 3318 SELECT CASE ( nbondj_bdy_b(ib_bdy) ) 3280 3319 CASE ( -1 ) 3281 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )3282 CASE ( 0 ) 3283 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )3284 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )3320 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 3321 CASE ( 0 ) 3322 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 3323 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 3285 3324 CASE ( 1 ) 3286 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )3325 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 3287 3326 END SELECT 3288 3327 ! … … 3303 3342 CASE ( -1 ) 3304 3343 DO jl = 1, jprecj 3305 ptab(:,ijhom+jl) = t2ns(:,jl,2)3344 ptab(:,ijhom+jl) = zt2ns(:,jl,2) 3306 3345 END DO 3307 3346 CASE ( 0 ) 3308 3347 DO jl = 1, jprecj 3309 ptab(:,jl ) = t2sn(:,jl,2)3310 ptab(:,ijhom+jl) = t2ns(:,jl,2)3348 ptab(:,jl ) = zt2sn(:,jl,2) 3349 ptab(:,ijhom+jl) = zt2ns(:,jl,2) 3311 3350 END DO 3312 3351 CASE ( 1 ) 3313 3352 DO jl = 1, jprecj 3314 ptab(:,jl) = t2sn(:,jl,2)3353 ptab(:,jl) = zt2sn(:,jl,2) 3315 3354 END DO 3316 3355 END SELECT … … 3328 3367 ! 3329 3368 ENDIF 3369 ! 3370 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 3330 3371 ! 3331 3372 END SUBROUTINE mpp_lnk_bdy_2d
Note: See TracChangeset
for help on using the changeset viewer.
