- Timestamp:
- 2013-11-05T12:59:53+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r4148 r4152 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 … … 72 73 PUBLIC mppsize 73 74 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 74 PUBLIC lib_mpp_alloc ! Called in nemogcm.F9075 75 PUBLIC mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 76 76 PUBLIC mpp_lnk_obc_2d, mpp_lnk_obc_3d … … 151 151 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon ! buffer in case of bsend 152 152 153 ! message passing arrays154 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE :: t4ns, t4sn ! 2 x 3d for north-south & south-north155 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE :: t4ew, t4we ! 2 x 3d for east-west & west-east156 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE :: t4p1, t4p2 ! 2 x 3d for north fold157 REAL(wp), DIMENSION(:,:,:,:) , ALLOCATABLE, SAVE :: t3ns, t3sn ! 3d for north-south & south-north158 REAL(wp), DIMENSION(:,:,:,:) , ALLOCATABLE, SAVE :: t3ew, t3we ! 3d for east-west & west-east159 REAL(wp), DIMENSION(:,:,:,:) , ALLOCATABLE, SAVE :: t3p1, t3p2 ! 3d for north fold160 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: t2ns, t2sn ! 2d for north-south & south-north161 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: t2ew, t2we ! 2d for east-west & west-east162 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: t2p1, t2p2 ! 2d for north fold163 164 ! Arrays used in mpp_lbc_north_3d()165 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: tab_3d, xnorthloc166 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: xnorthgloio167 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: foldwk ! Workspace for message transfers avoiding mpi_allgather168 169 ! Arrays used in mpp_lbc_north_2d()170 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: tab_2d, xnorthloc_2d171 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: xnorthgloio_2d172 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: foldwk_2d ! Workspace for message transfers avoiding mpi_allgather173 174 ! Arrays used in mpp_lbc_north_e()175 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: tab_e, xnorthloc_e176 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: xnorthgloio_e177 178 153 ! North fold arrays used to minimise the use of allgather operations. Set in nemo_northcomms (nemogcm) so need to be public 179 154 INTEGER, PUBLIC, PARAMETER :: jpmaxngh = 8 ! Assumed maximum number of active neighbours … … 190 165 !!---------------------------------------------------------------------- 191 166 CONTAINS 192 193 INTEGER FUNCTION lib_mpp_alloc( kumout )194 !!----------------------------------------------------------------------195 !! *** routine lib_mpp_alloc ***196 !!----------------------------------------------------------------------197 INTEGER, INTENT(in) :: kumout ! ocean.output logical unit198 !!----------------------------------------------------------------------199 !200 ALLOCATE( t4ns(jpi,jprecj,jpk,2,2) , t4sn(jpi,jprecj,jpk,2,2) , &201 & t4ew(jpj,jpreci,jpk,2,2) , t4we(jpj,jpreci,jpk,2,2) , &202 & t4p1(jpi,jprecj,jpk,2,2) , t4p2(jpi,jprecj,jpk,2,2) , &203 & t3ns(jpi,jprecj,jpk,2) , t3sn(jpi,jprecj,jpk,2) , &204 & t3ew(jpj,jpreci,jpk,2) , t3we(jpj,jpreci,jpk,2) , &205 & t3p1(jpi,jprecj,jpk,2) , t3p2(jpi,jprecj,jpk,2) , &206 & t2ns(jpi,jprecj ,2) , t2sn(jpi,jprecj ,2) , &207 & t2ew(jpj,jpreci ,2) , t2we(jpj,jpreci ,2) , &208 & t2p1(jpi,jprecj ,2) , t2p2(jpi,jprecj ,2) , &209 !210 & tab_3d(jpiglo,4,jpk) , xnorthloc(jpi,4,jpk) , xnorthgloio(jpi,4,jpk,jpni) , &211 & foldwk(jpi,4,jpk) , &212 !213 & tab_2d(jpiglo,4) , xnorthloc_2d(jpi,4) , xnorthgloio_2d(jpi,4,jpni) , &214 & foldwk_2d(jpi,4) , &215 !216 & tab_e(jpiglo,4+2*jpr2dj) , xnorthloc_e(jpi,4+2*jpr2dj) , xnorthgloio_e(jpi,4+2*jpr2dj,jpni) , &217 !218 & STAT=lib_mpp_alloc )219 !220 IF( lib_mpp_alloc /= 0 ) THEN221 WRITE(kumout,cform_war)222 WRITE(kumout,*) 'lib_mpp_alloc : failed to allocate arrays'223 ENDIF224 !225 END FUNCTION lib_mpp_alloc226 167 227 168 … … 395 336 REAL(wp) :: zland 396 337 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 397 !!---------------------------------------------------------------------- 338 ! 339 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! 3d for north-south & south-north 340 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east 341 342 !!---------------------------------------------------------------------- 343 344 ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2), & 345 & zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2) ) 398 346 399 347 zland = 0.e0 ! zero by default … … 430 378 iihom = nlci-nreci 431 379 DO jl = 1, jpreci 432 t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)433 t3we(:,jl,:,1) = ptab(iihom +jl,:,:)380 zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 381 zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 434 382 END DO 435 383 END SELECT … … 440 388 SELECT CASE ( nbondi ) 441 389 CASE ( -1 ) 442 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )443 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )390 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 391 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 444 392 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 445 393 CASE ( 0 ) 446 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )447 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )448 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )449 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )394 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 395 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 ) 396 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 397 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 450 398 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 451 399 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 452 400 CASE ( 1 ) 453 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )454 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )401 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 402 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 455 403 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 456 404 END SELECT … … 462 410 CASE ( -1 ) 463 411 DO jl = 1, jpreci 464 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)412 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 465 413 END DO 466 414 CASE ( 0 ) 467 415 DO jl = 1, jpreci 468 ptab(jl ,:,:) = t3we(:,jl,:,2)469 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)416 ptab(jl ,:,:) = zt3we(:,jl,:,2) 417 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 470 418 END DO 471 419 CASE ( 1 ) 472 420 DO jl = 1, jpreci 473 ptab(jl ,:,:) = t3we(:,jl,:,2)421 ptab(jl ,:,:) = zt3we(:,jl,:,2) 474 422 END DO 475 423 END SELECT … … 485 433 ijhom = nlcj-nrecj 486 434 DO jl = 1, jprecj 487 t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)488 t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)435 zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 436 zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 489 437 END DO 490 438 ENDIF … … 495 443 SELECT CASE ( nbondj ) 496 444 CASE ( -1 ) 497 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )498 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )445 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 446 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 499 447 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 500 448 CASE ( 0 ) 501 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )502 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )503 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )504 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )449 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 450 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 ) 451 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 452 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 505 453 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 506 454 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 507 455 CASE ( 1 ) 508 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )509 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )456 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 457 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 510 458 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 511 459 END SELECT … … 517 465 CASE ( -1 ) 518 466 DO jl = 1, jprecj 519 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)467 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 520 468 END DO 521 469 CASE ( 0 ) 522 470 DO jl = 1, jprecj 523 ptab(:,jl ,:) = t3sn(:,jl,:,2)524 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)471 ptab(:,jl ,:) = zt3sn(:,jl,:,2) 472 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 525 473 END DO 526 474 CASE ( 1 ) 527 475 DO jl = 1, jprecj 528 ptab(:,jl,:) = t3sn(:,jl,:,2)476 ptab(:,jl,:) = zt3sn(:,jl,:,2) 529 477 END DO 530 478 END SELECT … … 543 491 ! 544 492 ENDIF 493 ! 494 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 545 495 ! 546 496 END SUBROUTINE mpp_lnk_obc_3d … … 577 527 REAL(wp) :: zland 578 528 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 579 !!---------------------------------------------------------------------- 529 ! 530 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 531 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 532 533 !!---------------------------------------------------------------------- 534 535 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), & 536 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) ) 580 537 581 538 zland = 0.e0 ! zero by default … … 612 569 iihom = nlci-nreci 613 570 DO jl = 1, jpreci 614 t2ew(:,jl,1) = pt2d(jpreci+jl,:)615 t2we(:,jl,1) = pt2d(iihom +jl,:)571 zt2ew(:,jl,1) = pt2d(jpreci+jl,:) 572 zt2we(:,jl,1) = pt2d(iihom +jl,:) 616 573 END DO 617 574 END SELECT … … 622 579 SELECT CASE ( nbondi ) 623 580 CASE ( -1 ) 624 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )625 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )581 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 582 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 626 583 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 627 584 CASE ( 0 ) 628 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )629 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )630 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )631 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )585 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 586 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 587 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 588 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 632 589 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 633 590 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 634 591 CASE ( 1 ) 635 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )636 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )592 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 593 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 637 594 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 638 595 END SELECT … … 644 601 CASE ( -1 ) 645 602 DO jl = 1, jpreci 646 pt2d(iihom+jl,:) = t2ew(:,jl,2)603 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 647 604 END DO 648 605 CASE ( 0 ) 649 606 DO jl = 1, jpreci 650 pt2d(jl ,:) = t2we(:,jl,2)651 pt2d(iihom+jl,:) = t2ew(:,jl,2)607 pt2d(jl ,:) = zt2we(:,jl,2) 608 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 652 609 END DO 653 610 CASE ( 1 ) 654 611 DO jl = 1, jpreci 655 pt2d(jl ,:) = t2we(:,jl,2)612 pt2d(jl ,:) = zt2we(:,jl,2) 656 613 END DO 657 614 END SELECT … … 665 622 ijhom = nlcj-nrecj 666 623 DO jl = 1, jprecj 667 t2sn(:,jl,1) = pt2d(:,ijhom +jl)668 t2ns(:,jl,1) = pt2d(:,jprecj+jl)624 zt2sn(:,jl,1) = pt2d(:,ijhom +jl) 625 zt2ns(:,jl,1) = pt2d(:,jprecj+jl) 669 626 END DO 670 627 ENDIF … … 675 632 SELECT CASE ( nbondj ) 676 633 CASE ( -1 ) 677 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )678 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )634 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 635 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 679 636 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 680 637 CASE ( 0 ) 681 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )682 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )683 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )684 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )638 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 639 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 640 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 641 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 685 642 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 686 643 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 687 644 CASE ( 1 ) 688 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )689 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )645 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 646 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 690 647 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 691 648 END SELECT … … 697 654 CASE ( -1 ) 698 655 DO jl = 1, jprecj 699 pt2d(:,ijhom+jl) = t2ns(:,jl,2)656 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 700 657 END DO 701 658 CASE ( 0 ) 702 659 DO jl = 1, jprecj 703 pt2d(:,jl ) = t2sn(:,jl,2)704 pt2d(:,ijhom+jl) = t2ns(:,jl,2)660 pt2d(:,jl ) = zt2sn(:,jl,2) 661 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 705 662 END DO 706 663 CASE ( 1 ) 707 664 DO jl = 1, jprecj 708 pt2d(:,jl ) = t2sn(:,jl,2)665 pt2d(:,jl ) = zt2sn(:,jl,2) 709 666 END DO 710 667 END SELECT … … 722 679 ! 723 680 ENDIF 681 ! 682 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 724 683 ! 725 684 END SUBROUTINE mpp_lnk_obc_2d … … 759 718 REAL(wp) :: zland 760 719 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 761 !!---------------------------------------------------------------------- 762 720 ! 721 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! 3d for north-south & south-north 722 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east 723 724 !!---------------------------------------------------------------------- 725 726 ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2), & 727 & zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2) ) 728 729 ! 763 730 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value 764 731 ELSE ; zland = 0.e0 ! zero by default … … 808 775 iihom = nlci-nreci 809 776 DO jl = 1, jpreci 810 t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)811 t3we(:,jl,:,1) = ptab(iihom +jl,:,:)777 zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 778 zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 812 779 END DO 813 780 END SELECT … … 818 785 SELECT CASE ( nbondi ) 819 786 CASE ( -1 ) 820 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )821 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )787 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 788 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 822 789 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 823 790 CASE ( 0 ) 824 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )825 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )826 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )827 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )791 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 792 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 ) 793 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 794 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 828 795 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 829 796 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 830 797 CASE ( 1 ) 831 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )832 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )798 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 799 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 833 800 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 834 801 END SELECT … … 840 807 CASE ( -1 ) 841 808 DO jl = 1, jpreci 842 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)809 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 843 810 END DO 844 811 CASE ( 0 ) 845 812 DO jl = 1, jpreci 846 ptab(jl ,:,:) = t3we(:,jl,:,2)847 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)813 ptab(jl ,:,:) = zt3we(:,jl,:,2) 814 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 848 815 END DO 849 816 CASE ( 1 ) 850 817 DO jl = 1, jpreci 851 ptab(jl ,:,:) = t3we(:,jl,:,2)818 ptab(jl ,:,:) = zt3we(:,jl,:,2) 852 819 END DO 853 820 END SELECT … … 861 828 ijhom = nlcj-nrecj 862 829 DO jl = 1, jprecj 863 t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)864 t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)830 zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 831 zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 865 832 END DO 866 833 ENDIF … … 871 838 SELECT CASE ( nbondj ) 872 839 CASE ( -1 ) 873 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )874 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )840 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 841 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 875 842 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 876 843 CASE ( 0 ) 877 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )878 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )879 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )880 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )844 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 845 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 ) 846 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 847 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 881 848 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 882 849 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 883 850 CASE ( 1 ) 884 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )885 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )851 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 852 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 886 853 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 887 854 END SELECT … … 893 860 CASE ( -1 ) 894 861 DO jl = 1, jprecj 895 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)862 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 896 863 END DO 897 864 CASE ( 0 ) 898 865 DO jl = 1, jprecj 899 ptab(:,jl ,:) = t3sn(:,jl,:,2)900 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)866 ptab(:,jl ,:) = zt3sn(:,jl,:,2) 867 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 901 868 END DO 902 869 CASE ( 1 ) 903 870 DO jl = 1, jprecj 904 ptab(:,jl,:) = t3sn(:,jl,:,2)871 ptab(:,jl,:) = zt3sn(:,jl,:,2) 905 872 END DO 906 873 END SELECT … … 918 885 ! 919 886 ENDIF 887 ! 888 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 920 889 ! 921 890 END SUBROUTINE mpp_lnk_3d … … 954 923 REAL(wp) :: zland 955 924 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 956 !!---------------------------------------------------------------------- 957 925 ! 926 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 927 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 928 929 !!---------------------------------------------------------------------- 930 931 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), & 932 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) ) 933 934 ! 958 935 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value 959 936 ELSE ; zland = 0.e0 ! zero by default … … 1002 979 iihom = nlci-nreci 1003 980 DO jl = 1, jpreci 1004 t2ew(:,jl,1) = pt2d(jpreci+jl,:)1005 t2we(:,jl,1) = pt2d(iihom +jl,:)981 zt2ew(:,jl,1) = pt2d(jpreci+jl,:) 982 zt2we(:,jl,1) = pt2d(iihom +jl,:) 1006 983 END DO 1007 984 END SELECT … … 1012 989 SELECT CASE ( nbondi ) 1013 990 CASE ( -1 ) 1014 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )1015 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )991 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 992 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 1016 993 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1017 994 CASE ( 0 ) 1018 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )1019 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )1020 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )1021 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )995 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 996 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 997 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 998 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 1022 999 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1023 1000 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1024 1001 CASE ( 1 ) 1025 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )1026 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )1002 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 1003 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 1027 1004 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1028 1005 END SELECT … … 1034 1011 CASE ( -1 ) 1035 1012 DO jl = 1, jpreci 1036 pt2d(iihom+jl,:) = t2ew(:,jl,2)1013 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 1037 1014 END DO 1038 1015 CASE ( 0 ) 1039 1016 DO jl = 1, jpreci 1040 pt2d(jl ,:) = t2we(:,jl,2)1041 pt2d(iihom+jl,:) = t2ew(:,jl,2)1017 pt2d(jl ,:) = zt2we(:,jl,2) 1018 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 1042 1019 END DO 1043 1020 CASE ( 1 ) 1044 1021 DO jl = 1, jpreci 1045 pt2d(jl ,:) = t2we(:,jl,2)1022 pt2d(jl ,:) = zt2we(:,jl,2) 1046 1023 END DO 1047 1024 END SELECT … … 1055 1032 ijhom = nlcj-nrecj 1056 1033 DO jl = 1, jprecj 1057 t2sn(:,jl,1) = pt2d(:,ijhom +jl)1058 t2ns(:,jl,1) = pt2d(:,jprecj+jl)1034 zt2sn(:,jl,1) = pt2d(:,ijhom +jl) 1035 zt2ns(:,jl,1) = pt2d(:,jprecj+jl) 1059 1036 END DO 1060 1037 ENDIF … … 1065 1042 SELECT CASE ( nbondj ) 1066 1043 CASE ( -1 ) 1067 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )1068 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )1044 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 1045 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 1069 1046 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1070 1047 CASE ( 0 ) 1071 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )1072 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )1073 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )1074 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )1048 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 1049 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 1050 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 1051 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 1075 1052 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1076 1053 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1077 1054 CASE ( 1 ) 1078 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )1079 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )1055 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 1056 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 1080 1057 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1081 1058 END SELECT … … 1087 1064 CASE ( -1 ) 1088 1065 DO jl = 1, jprecj 1089 pt2d(:,ijhom+jl) = t2ns(:,jl,2)1066 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 1090 1067 END DO 1091 1068 CASE ( 0 ) 1092 1069 DO jl = 1, jprecj 1093 pt2d(:,jl ) = t2sn(:,jl,2)1094 pt2d(:,ijhom+jl) = t2ns(:,jl,2)1070 pt2d(:,jl ) = zt2sn(:,jl,2) 1071 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 1095 1072 END DO 1096 1073 CASE ( 1 ) 1097 1074 DO jl = 1, jprecj 1098 pt2d(:,jl ) = t2sn(:,jl,2)1075 pt2d(:,jl ) = zt2sn(:,jl,2) 1099 1076 END DO 1100 1077 END SELECT … … 1112 1089 ! 1113 1090 ENDIF 1091 ! 1092 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 1114 1093 ! 1115 1094 END SUBROUTINE mpp_lnk_2d … … 1147 1126 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 1148 1127 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 1149 !!---------------------------------------------------------------------- 1128 ! 1129 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zt4ns, zt4sn ! 2 x 3d for north-south & south-north 1130 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zt4ew, zt4we ! 2 x 3d for east-west & west-east 1131 1132 !!---------------------------------------------------------------------- 1133 ALLOCATE( zt4ns(jpi,jprecj,jpk,2,2), zt4sn(jpi,jprecj,jpk,2,2) , & 1134 & zt4ew(jpj,jpreci,jpk,2,2), zt4we(jpj,jpreci,jpk,2,2) ) 1135 1150 1136 1151 1137 ! 1. standard boundary treatment … … 1181 1167 iihom = nlci-nreci 1182 1168 DO jl = 1, jpreci 1183 t4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:)1184 t4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:)1185 t4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:)1186 t4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:)1169 zt4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:) 1170 zt4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:) 1171 zt4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:) 1172 zt4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:) 1187 1173 END DO 1188 1174 END SELECT … … 1193 1179 SELECT CASE ( nbondi ) 1194 1180 CASE ( -1 ) 1195 CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 )1196 CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea )1181 CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req1 ) 1182 CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea ) 1197 1183 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1198 1184 CASE ( 0 ) 1199 CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )1200 CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req2 )1201 CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea )1202 CALL mpprecv( 2, t4we(1,1,1,1,2), imigr, nowe )1185 CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 1186 CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req2 ) 1187 CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea ) 1188 CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe ) 1203 1189 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1204 1190 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 1205 1191 CASE ( 1 ) 1206 CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )1207 CALL mpprecv( 2, t4we(1,1,1,1,2), imigr, nowe )1192 CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 1193 CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe ) 1208 1194 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1209 1195 END SELECT … … 1215 1201 CASE ( -1 ) 1216 1202 DO jl = 1, jpreci 1217 ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)1218 ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)1203 ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2) 1204 ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2) 1219 1205 END DO 1220 1206 CASE ( 0 ) 1221 1207 DO jl = 1, jpreci 1222 ptab1(jl ,:,:) = t4we(:,jl,:,1,2)1223 ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)1224 ptab2(jl ,:,:) = t4we(:,jl,:,2,2)1225 ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)1208 ptab1(jl ,:,:) = zt4we(:,jl,:,1,2) 1209 ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2) 1210 ptab2(jl ,:,:) = zt4we(:,jl,:,2,2) 1211 ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2) 1226 1212 END DO 1227 1213 CASE ( 1 ) 1228 1214 DO jl = 1, jpreci 1229 ptab1(jl ,:,:) = t4we(:,jl,:,1,2)1230 ptab2(jl ,:,:) = t4we(:,jl,:,2,2)1215 ptab1(jl ,:,:) = zt4we(:,jl,:,1,2) 1216 ptab2(jl ,:,:) = zt4we(:,jl,:,2,2) 1231 1217 END DO 1232 1218 END SELECT … … 1240 1226 ijhom = nlcj - nrecj 1241 1227 DO jl = 1, jprecj 1242 t4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:)1243 t4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:)1244 t4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:)1245 t4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:)1228 zt4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:) 1229 zt4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:) 1230 zt4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:) 1231 zt4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:) 1246 1232 END DO 1247 1233 ENDIF … … 1252 1238 SELECT CASE ( nbondj ) 1253 1239 CASE ( -1 ) 1254 CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req1 )1255 CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono )1240 CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req1 ) 1241 CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono ) 1256 1242 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1257 1243 CASE ( 0 ) 1258 CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )1259 CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req2 )1260 CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono )1261 CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr, noso )1244 CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 1245 CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req2 ) 1246 CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono ) 1247 CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso ) 1262 1248 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1263 1249 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 1264 1250 CASE ( 1 ) 1265 CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )1266 CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr, noso )1251 CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 1252 CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso ) 1267 1253 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1268 1254 END SELECT … … 1274 1260 CASE ( -1 ) 1275 1261 DO jl = 1, jprecj 1276 ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)1277 ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)1262 ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2) 1263 ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2) 1278 1264 END DO 1279 1265 CASE ( 0 ) 1280 1266 DO jl = 1, jprecj 1281 ptab1(:,jl ,:) = t4sn(:,jl,:,1,2)1282 ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)1283 ptab2(:,jl ,:) = t4sn(:,jl,:,2,2)1284 ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)1267 ptab1(:,jl ,:) = zt4sn(:,jl,:,1,2) 1268 ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2) 1269 ptab2(:,jl ,:) = zt4sn(:,jl,:,2,2) 1270 ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2) 1285 1271 END DO 1286 1272 CASE ( 1 ) 1287 1273 DO jl = 1, jprecj 1288 ptab1(:,jl,:) = t4sn(:,jl,:,1,2)1289 ptab2(:,jl,:) = t4sn(:,jl,:,2,2)1274 ptab1(:,jl,:) = zt4sn(:,jl,:,1,2) 1275 ptab2(:,jl,:) = zt4sn(:,jl,:,2,2) 1290 1276 END DO 1291 1277 END SELECT … … 1306 1292 ! 1307 1293 ENDIF 1294 ! 1295 DEALLOCATE( zt4ns, zt4sn, zt4ew, zt4we ) 1308 1296 ! 1309 1297 END SUBROUTINE mpp_lnk_3d_gather … … 2158 2146 INTEGER :: ml_stat(MPI_STATUS_SIZE) ! for key_mpi_isend 2159 2147 REAL(wp), POINTER, DIMENSION(:,:) :: ztab ! temporary workspace 2148 ! 2149 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 2150 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 2160 2151 LOGICAL :: lmigr ! is true for those processors that have to migrate the OB 2161 !!---------------------------------------------------------------------- 2152 2153 !!---------------------------------------------------------------------- 2154 2155 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), & 2156 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) ) 2162 2157 2163 2158 CALL wrk_alloc( jpi,jpj, ztab ) … … 2223 2218 IF( nbondi /= 2 ) THEN ! Read Dirichlet lateral conditions 2224 2219 iihom = nlci-nreci 2225 t2ew(1:jpreci,1,1) = ztab(jpreci+1:nreci, ijpt0)2226 t2we(1:jpreci,1,1) = ztab(iihom+1:iihom+jpreci, ijpt0)2220 zt2ew(1:jpreci,1,1) = ztab(jpreci+1:nreci, ijpt0) 2221 zt2we(1:jpreci,1,1) = ztab(iihom+1:iihom+jpreci, ijpt0) 2227 2222 ENDIF 2228 2223 ! … … 2231 2226 ! 2232 2227 IF( nbondi == -1 ) THEN 2233 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )2234 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )2228 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 2229 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 2235 2230 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2236 2231 ELSEIF( nbondi == 0 ) THEN 2237 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )2238 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )2239 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )2240 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )2232 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 2233 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 2234 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 2235 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 2241 2236 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2242 2237 IF(l_isend) CALL mpi_wait( ml_req2, ml_stat, ml_err ) 2243 2238 ELSEIF( nbondi == 1 ) THEN 2244 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )2245 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )2239 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 2240 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 2246 2241 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2247 2242 ENDIF … … 2251 2246 ! 2252 2247 IF( nbondi == 0 .OR. nbondi == 1 ) THEN 2253 ztab(1:jpreci, ijpt0) = t2we(1:jpreci,1,2)2248 ztab(1:jpreci, ijpt0) = zt2we(1:jpreci,1,2) 2254 2249 ENDIF 2255 2250 IF( nbondi == -1 .OR. nbondi == 0 ) THEN 2256 ztab(iihom+1:iihom+jpreci, ijpt0) = t2ew(1:jpreci,1,2)2251 ztab(iihom+1:iihom+jpreci, ijpt0) = zt2ew(1:jpreci,1,2) 2257 2252 ENDIF 2258 2253 ENDIF ! (ktype == 1) … … 2264 2259 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 2265 2260 ijhom = nlcj-nrecj 2266 t2sn(1:jprecj,1,1) = ztab(iipt0, ijhom+1:ijhom+jprecj)2267 t2ns(1:jprecj,1,1) = ztab(iipt0, jprecj+1:nrecj)2261 zt2sn(1:jprecj,1,1) = ztab(iipt0, ijhom+1:ijhom+jprecj) 2262 zt2ns(1:jprecj,1,1) = ztab(iipt0, jprecj+1:nrecj) 2268 2263 ENDIF 2269 2264 ! … … 2272 2267 ! 2273 2268 IF( nbondj == -1 ) THEN 2274 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )2275 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )2269 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 2270 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 2276 2271 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2277 2272 ELSEIF( nbondj == 0 ) THEN 2278 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )2279 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )2280 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )2281 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )2273 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 2274 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 2275 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 2276 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 2282 2277 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2283 2278 IF( l_isend ) CALL mpi_wait( ml_req2, ml_stat, ml_err ) 2284 2279 ELSEIF( nbondj == 1 ) THEN 2285 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )2286 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso)2280 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 2281 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso) 2287 2282 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 2288 2283 ENDIF … … 2291 2286 ijhom = nlcj - jprecj 2292 2287 IF( nbondj == 0 .OR. nbondj == 1 ) THEN 2293 ztab(iipt0,1:jprecj) = t2sn(1:jprecj,1,2)2288 ztab(iipt0,1:jprecj) = zt2sn(1:jprecj,1,2) 2294 2289 ENDIF 2295 2290 IF( nbondj == 0 .OR. nbondj == -1 ) THEN 2296 ztab(iipt0, ijhom+1:ijhom+jprecj) = t2ns(1:jprecj,1,2)2291 ztab(iipt0, ijhom+1:ijhom+jprecj) = zt2ns(1:jprecj,1,2) 2297 2292 ENDIF 2298 2293 ENDIF ! (ktype == 2) … … 2314 2309 ! 2315 2310 ENDIF ! ( lmigr ) 2311 ! 2312 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 2316 2313 CALL wrk_dealloc( jpi,jpj, ztab ) 2317 2314 ! … … 2603 2600 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather 2604 2601 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for mpi_isend when avoiding mpi_allgather 2605 !!---------------------------------------------------------------------- 2606 ! 2602 ! ! Workspace for message transfers avoiding mpi_allgather 2603 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: ztab 2604 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: znorthloc, zfoldwk 2605 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: znorthgloio 2606 2607 !!---------------------------------------------------------------------- 2608 ! 2609 ALLOCATE( ztab(jpiglo,4,jpk), znorthloc(jpi,4,jpk), zfoldwk(jpi,4,jpk), znorthgloio(jpi,4,jpk,jpni) ) 2610 2607 2611 ijpj = 4 2608 2612 ityp = -1 2609 2613 ijpjm1 = 3 2610 tab_3d(:,:,:) = 0.e02611 ! 2612 DO jj = nlcj - ijpj +1, nlcj ! put in xnorthloc the last 4 jlines of pt3d2614 ztab(:,:,:) = 0.e0 2615 ! 2616 DO jj = nlcj - ijpj +1, nlcj ! put in znorthloc the last 4 jlines of pt3d 2613 2617 ij = jj - nlcj + ijpj 2614 xnorthloc(:,ij,:) = pt3d(:,jj,:)2618 znorthloc(:,ij,:) = pt3d(:,jj,:) 2615 2619 END DO 2616 2620 ! 2617 ! ! Build in procs of ncomm_north the xnorthgloio2621 ! ! Build in procs of ncomm_north the znorthgloio 2618 2622 itaille = jpi * jpk * ijpj 2619 2623 IF ( l_north_nogather ) THEN … … 2625 2629 ij = jj - nlcj + ijpj 2626 2630 DO ji = 1, nlci 2627 tab_3d(ji+nimpp-1,ij,:) = pt3d(ji,jj,:)2631 ztab(ji+nimpp-1,ij,:) = pt3d(ji,jj,:) 2628 2632 END DO 2629 2633 END DO … … 2650 2654 2651 2655 DO jr = 1,nsndto(ityp) 2652 CALL mppsend(5, xnorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) )2656 CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2653 2657 END DO 2654 2658 DO jr = 1,nsndto(ityp) 2655 CALL mpprecv(5, foldwk, itaille, isendto(jr,ityp))2659 CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp)) 2656 2660 iproc = isendto(jr,ityp) + 1 2657 2661 ildi = nldit (iproc) … … 2660 2664 DO jj = 1, ijpj 2661 2665 DO ji = ildi, ilei 2662 tab_3d(ji+iilb-1,jj,:) =foldwk(ji,jj,:)2666 ztab(ji+iilb-1,jj,:) = zfoldwk(ji,jj,:) 2663 2667 END DO 2664 2668 END DO … … 2675 2679 2676 2680 IF ( ityp .lt. 0 ) THEN 2677 CALL MPI_ALLGATHER( xnorthloc , itaille, MPI_DOUBLE_PRECISION, &2678 & xnorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2681 CALL MPI_ALLGATHER( znorthloc , itaille, MPI_DOUBLE_PRECISION, & 2682 & znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2679 2683 ! 2680 2684 DO jr = 1, ndim_rank_north ! recover the global north array … … 2685 2689 DO jj = 1, ijpj 2686 2690 DO ji = ildi, ilei 2687 tab_3d(ji+iilb-1,jj,:) = xnorthgloio(ji,jj,:,jr)2691 ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr) 2688 2692 END DO 2689 2693 END DO … … 2691 2695 ENDIF 2692 2696 ! 2693 ! The tab_3darray has been either:2697 ! The ztab array has been either: 2694 2698 ! a. Fully populated by the mpi_allgather operation or 2695 2699 ! b. Had the active points for this domain and northern neighbours populated … … 2698 2702 ! this domain will be identical. 2699 2703 ! 2700 CALL lbc_nfd( tab_3d, cd_type, psgn ) ! North fold boundary condition2704 CALL lbc_nfd( ztab, cd_type, psgn ) ! North fold boundary condition 2701 2705 ! 2702 2706 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt3d 2703 2707 ij = jj - nlcj + ijpj 2704 2708 DO ji= 1, nlci 2705 pt3d(ji,jj,:) = tab_3d(ji+nimpp-1,ij,:)2709 pt3d(ji,jj,:) = ztab(ji+nimpp-1,ij,:) 2706 2710 END DO 2707 2711 END DO 2712 ! 2713 DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio ) 2708 2714 ! 2709 2715 END SUBROUTINE mpp_lbc_north_3d … … 2735 2741 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather 2736 2742 INTEGER, DIMENSION(MPI_STATUS_SIZE):: ml_stat ! for mpi_isend when avoiding mpi_allgather 2737 !!---------------------------------------------------------------------- 2743 ! ! Workspace for message transfers avoiding mpi_allgather 2744 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ztab 2745 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: znorthloc, zfoldwk 2746 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: znorthgloio 2747 !!---------------------------------------------------------------------- 2748 ! 2749 ALLOCATE( ztab(jpiglo,4), znorthloc(jpi,4), zfoldwk(jpi,4), znorthgloio(jpi,4,jpni) ) 2738 2750 ! 2739 2751 ijpj = 4 2740 2752 ityp = -1 2741 2753 ijpjm1 = 3 2742 tab_2d(:,:) = 0.e02743 ! 2744 DO jj = nlcj-ijpj+1, nlcj ! put in xnorthloc_2dthe last 4 jlines of pt2d2754 ztab(:,:) = 0.e0 2755 ! 2756 DO jj = nlcj-ijpj+1, nlcj ! put in znorthloc the last 4 jlines of pt2d 2745 2757 ij = jj - nlcj + ijpj 2746 xnorthloc_2d(:,ij) = pt2d(:,jj)2758 znorthloc(:,ij) = pt2d(:,jj) 2747 2759 END DO 2748 2760 2749 ! ! Build in procs of ncomm_north the xnorthgloio_2d2761 ! ! Build in procs of ncomm_north the znorthgloio 2750 2762 itaille = jpi * ijpj 2751 2763 IF ( l_north_nogather ) THEN … … 2757 2769 ij = jj - nlcj + ijpj 2758 2770 DO ji = 1, nlci 2759 tab_2d(ji+nimpp-1,ij) = pt2d(ji,jj)2771 ztab(ji+nimpp-1,ij) = pt2d(ji,jj) 2760 2772 END DO 2761 2773 END DO … … 2783 2795 2784 2796 DO jr = 1,nsndto(ityp) 2785 CALL mppsend(5, xnorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) )2797 CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2786 2798 END DO 2787 2799 DO jr = 1,nsndto(ityp) 2788 CALL mpprecv(5, foldwk_2d, itaille, isendto(jr,ityp))2800 CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp)) 2789 2801 iproc = isendto(jr,ityp) + 1 2790 2802 ildi = nldit (iproc) … … 2793 2805 DO jj = 1, ijpj 2794 2806 DO ji = ildi, ilei 2795 tab_2d(ji+iilb-1,jj) = foldwk_2d(ji,jj)2807 ztab(ji+iilb-1,jj) = zfoldwk(ji,jj) 2796 2808 END DO 2797 2809 END DO … … 2808 2820 2809 2821 IF ( ityp .lt. 0 ) THEN 2810 CALL MPI_ALLGATHER( xnorthloc_2d, itaille, MPI_DOUBLE_PRECISION, &2811 & xnorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2822 CALL MPI_ALLGATHER( znorthloc , itaille, MPI_DOUBLE_PRECISION, & 2823 & znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2812 2824 ! 2813 2825 DO jr = 1, ndim_rank_north ! recover the global north array … … 2818 2830 DO jj = 1, ijpj 2819 2831 DO ji = ildi, ilei 2820 tab_2d(ji+iilb-1,jj) = xnorthgloio_2d(ji,jj,jr)2832 ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr) 2821 2833 END DO 2822 2834 END DO … … 2824 2836 ENDIF 2825 2837 ! 2826 ! The tab array has been either:2838 ! The ztab array has been either: 2827 2839 ! a. Fully populated by the mpi_allgather operation or 2828 2840 ! b. Had the active points for this domain and northern neighbours populated … … 2831 2843 ! this domain will be identical. 2832 2844 ! 2833 CALL lbc_nfd( tab_2d, cd_type, psgn ) ! North fold boundary condition2845 CALL lbc_nfd( ztab, cd_type, psgn ) ! North fold boundary condition 2834 2846 ! 2835 2847 ! … … 2837 2849 ij = jj - nlcj + ijpj 2838 2850 DO ji = 1, nlci 2839 pt2d(ji,jj) = tab_2d(ji+nimpp-1,ij)2851 pt2d(ji,jj) = ztab(ji+nimpp-1,ij) 2840 2852 END DO 2841 2853 END DO 2854 ! 2855 DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio ) 2842 2856 ! 2843 2857 END SUBROUTINE mpp_lbc_north_2d … … 2867 2881 INTEGER :: ierr, itaille, ildi, ilei, iilb 2868 2882 INTEGER :: ijpj, ij, iproc 2869 !!---------------------------------------------------------------------- 2883 ! 2884 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ztab_e, znorthloc_e 2885 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: znorthgloio_e 2886 2887 !!---------------------------------------------------------------------- 2888 ! 2889 ALLOCATE( ztab_e(jpiglo,4+2*jpr2dj), znorthloc_e(jpi,4+2*jpr2dj), znorthgloio_e(jpi,4+2*jpr2dj,jpni) ) 2890 2870 2891 ! 2871 2892 ijpj=4 2872 tab_e(:,:) = 0.e02893 ztab_e(:,:) = 0.e0 2873 2894 2874 2895 ij=0 2875 ! put in xnorthloc_e the last 4 jlines of pt2d2896 ! put in znorthloc_e the last 4 jlines of pt2d 2876 2897 DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj 2877 2898 ij = ij + 1 2878 2899 DO ji = 1, jpi 2879 xnorthloc_e(ji,ij)=pt2d(ji,jj)2900 znorthloc_e(ji,ij)=pt2d(ji,jj) 2880 2901 END DO 2881 2902 END DO 2882 2903 ! 2883 2904 itaille = jpi * ( ijpj + 2 * jpr2dj ) 2884 CALL MPI_ALLGATHER( xnorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, &2885 & xnorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2905 CALL MPI_ALLGATHER( znorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, & 2906 & znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2886 2907 ! 2887 2908 DO jr = 1, ndim_rank_north ! recover the global north array … … 2892 2913 DO jj = 1, ijpj+2*jpr2dj 2893 2914 DO ji = ildi, ilei 2894 tab_e(ji+iilb-1,jj) = xnorthgloio_e(ji,jj,jr)2915 ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr) 2895 2916 END DO 2896 2917 END DO … … 2900 2921 ! 2. North-Fold boundary conditions 2901 2922 ! ---------------------------------- 2902 CALL lbc_nfd( tab_e(:,:), cd_type, psgn, pr2dj = jpr2dj )2923 CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj ) 2903 2924 2904 2925 ij = jpr2dj … … 2907 2928 ij = ij +1 2908 2929 DO ji= 1, nlci 2909 pt2d(ji,jj) = tab_e(ji+nimpp-1,ij)2930 pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij) 2910 2931 END DO 2911 2932 END DO 2933 ! 2934 DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e ) 2912 2935 ! 2913 2936 END SUBROUTINE mpp_lbc_north_e … … 2950 2973 REAL(wp) :: zland 2951 2974 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 2952 !!---------------------------------------------------------------------- 2975 ! 2976 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! 3d for north-south & south-north 2977 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east 2978 2979 !!---------------------------------------------------------------------- 2980 2981 ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2), & 2982 & zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2) ) 2953 2983 2954 2984 zland = 0.e0 … … 2990 3020 iihom = nlci-nreci 2991 3021 DO jl = 1, jpreci 2992 t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)2993 t3we(:,jl,:,1) = ptab(iihom +jl,:,:)3022 zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 3023 zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 2994 3024 END DO 2995 3025 END SELECT … … 3000 3030 SELECT CASE ( nbondi_bdy(ib_bdy) ) 3001 3031 CASE ( -1 ) 3002 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )3003 CASE ( 0 ) 3004 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )3005 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )3032 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 3033 CASE ( 0 ) 3034 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 3035 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 ) 3006 3036 CASE ( 1 ) 3007 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )3037 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 3008 3038 END SELECT 3009 3039 ! 3010 3040 SELECT CASE ( nbondi_bdy_b(ib_bdy) ) 3011 3041 CASE ( -1 ) 3012 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )3013 CASE ( 0 ) 3014 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )3015 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )3042 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 3043 CASE ( 0 ) 3044 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 3045 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 3016 3046 CASE ( 1 ) 3017 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )3047 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 3018 3048 END SELECT 3019 3049 ! … … 3034 3064 CASE ( -1 ) 3035 3065 DO jl = 1, jpreci 3036 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)3066 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 3037 3067 END DO 3038 3068 CASE ( 0 ) 3039 3069 DO jl = 1, jpreci 3040 ptab(jl ,:,:) = t3we(:,jl,:,2)3041 ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)3070 ptab(jl ,:,:) = zt3we(:,jl,:,2) 3071 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 3042 3072 END DO 3043 3073 CASE ( 1 ) 3044 3074 DO jl = 1, jpreci 3045 ptab(jl ,:,:) = t3we(:,jl,:,2)3075 ptab(jl ,:,:) = zt3we(:,jl,:,2) 3046 3076 END DO 3047 3077 END SELECT … … 3055 3085 ijhom = nlcj-nrecj 3056 3086 DO jl = 1, jprecj 3057 t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)3058 t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)3087 zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 3088 zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 3059 3089 END DO 3060 3090 ENDIF … … 3065 3095 SELECT CASE ( nbondj_bdy(ib_bdy) ) 3066 3096 CASE ( -1 ) 3067 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )3068 CASE ( 0 ) 3069 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )3070 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )3097 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 3098 CASE ( 0 ) 3099 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 3100 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 ) 3071 3101 CASE ( 1 ) 3072 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )3102 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 3073 3103 END SELECT 3074 3104 ! 3075 3105 SELECT CASE ( nbondj_bdy_b(ib_bdy) ) 3076 3106 CASE ( -1 ) 3077 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )3078 CASE ( 0 ) 3079 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )3080 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )3107 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 3108 CASE ( 0 ) 3109 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 3110 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 3081 3111 CASE ( 1 ) 3082 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )3112 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 3083 3113 END SELECT 3084 3114 ! … … 3099 3129 CASE ( -1 ) 3100 3130 DO jl = 1, jprecj 3101 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)3131 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 3102 3132 END DO 3103 3133 CASE ( 0 ) 3104 3134 DO jl = 1, jprecj 3105 ptab(:,jl ,:) = t3sn(:,jl,:,2)3106 ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)3135 ptab(:,jl ,:) = zt3sn(:,jl,:,2) 3136 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 3107 3137 END DO 3108 3138 CASE ( 1 ) 3109 3139 DO jl = 1, jprecj 3110 ptab(:,jl,:) = t3sn(:,jl,:,2)3140 ptab(:,jl,:) = zt3sn(:,jl,:,2) 3111 3141 END DO 3112 3142 END SELECT … … 3124 3154 ! 3125 3155 ENDIF 3156 ! 3157 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 3126 3158 ! 3127 3159 END SUBROUTINE mpp_lnk_bdy_3d … … 3164 3196 REAL(wp) :: zland 3165 3197 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 3166 !!---------------------------------------------------------------------- 3198 ! 3199 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 3200 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 3201 3202 !!---------------------------------------------------------------------- 3203 3204 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), & 3205 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) ) 3167 3206 3168 3207 zland = 0.e0 … … 3204 3243 iihom = nlci-nreci 3205 3244 DO jl = 1, jpreci 3206 t2ew(:,jl,1) = ptab(jpreci+jl,:)3207 t2we(:,jl,1) = ptab(iihom +jl,:)3245 zt2ew(:,jl,1) = ptab(jpreci+jl,:) 3246 zt2we(:,jl,1) = ptab(iihom +jl,:) 3208 3247 END DO 3209 3248 END SELECT … … 3214 3253 SELECT CASE ( nbondi_bdy(ib_bdy) ) 3215 3254 CASE ( -1 ) 3216 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )3217 CASE ( 0 ) 3218 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )3219 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )3255 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 3256 CASE ( 0 ) 3257 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 3258 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 3220 3259 CASE ( 1 ) 3221 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )3260 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 3222 3261 END SELECT 3223 3262 ! 3224 3263 SELECT CASE ( nbondi_bdy_b(ib_bdy) ) 3225 3264 CASE ( -1 ) 3226 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )3227 CASE ( 0 ) 3228 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )3229 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )3265 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 3266 CASE ( 0 ) 3267 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 3268 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 3230 3269 CASE ( 1 ) 3231 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )3270 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 3232 3271 END SELECT 3233 3272 ! … … 3248 3287 CASE ( -1 ) 3249 3288 DO jl = 1, jpreci 3250 ptab(iihom+jl,:) = t2ew(:,jl,2)3289 ptab(iihom+jl,:) = zt2ew(:,jl,2) 3251 3290 END DO 3252 3291 CASE ( 0 ) 3253 3292 DO jl = 1, jpreci 3254 ptab(jl ,:) = t2we(:,jl,2)3255 ptab(iihom+jl,:) = t2ew(:,jl,2)3293 ptab(jl ,:) = zt2we(:,jl,2) 3294 ptab(iihom+jl,:) = zt2ew(:,jl,2) 3256 3295 END DO 3257 3296 CASE ( 1 ) 3258 3297 DO jl = 1, jpreci 3259 ptab(jl ,:) = t2we(:,jl,2)3298 ptab(jl ,:) = zt2we(:,jl,2) 3260 3299 END DO 3261 3300 END SELECT … … 3269 3308 ijhom = nlcj-nrecj 3270 3309 DO jl = 1, jprecj 3271 t2sn(:,jl,1) = ptab(:,ijhom +jl)3272 t2ns(:,jl,1) = ptab(:,jprecj+jl)3310 zt2sn(:,jl,1) = ptab(:,ijhom +jl) 3311 zt2ns(:,jl,1) = ptab(:,jprecj+jl) 3273 3312 END DO 3274 3313 ENDIF … … 3279 3318 SELECT CASE ( nbondj_bdy(ib_bdy) ) 3280 3319 CASE ( -1 ) 3281 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )3282 CASE ( 0 ) 3283 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )3284 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )3320 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 3321 CASE ( 0 ) 3322 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 3323 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 3285 3324 CASE ( 1 ) 3286 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )3325 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 3287 3326 END SELECT 3288 3327 ! 3289 3328 SELECT CASE ( nbondj_bdy_b(ib_bdy) ) 3290 3329 CASE ( -1 ) 3291 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )3292 CASE ( 0 ) 3293 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )3294 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )3330 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 3331 CASE ( 0 ) 3332 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 3333 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 3295 3334 CASE ( 1 ) 3296 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )3335 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 3297 3336 END SELECT 3298 3337 ! … … 3313 3352 CASE ( -1 ) 3314 3353 DO jl = 1, jprecj 3315 ptab(:,ijhom+jl) = t2ns(:,jl,2)3354 ptab(:,ijhom+jl) = zt2ns(:,jl,2) 3316 3355 END DO 3317 3356 CASE ( 0 ) 3318 3357 DO jl = 1, jprecj 3319 ptab(:,jl ) = t2sn(:,jl,2)3320 ptab(:,ijhom+jl) = t2ns(:,jl,2)3358 ptab(:,jl ) = zt2sn(:,jl,2) 3359 ptab(:,ijhom+jl) = zt2ns(:,jl,2) 3321 3360 END DO 3322 3361 CASE ( 1 ) 3323 3362 DO jl = 1, jprecj 3324 ptab(:,jl) = t2sn(:,jl,2)3363 ptab(:,jl) = zt2sn(:,jl,2) 3325 3364 END DO 3326 3365 END SELECT … … 3338 3377 ! 3339 3378 ENDIF 3379 ! 3380 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 3340 3381 ! 3341 3382 END SUBROUTINE mpp_lnk_bdy_2d
Note: See TracChangeset
for help on using the changeset viewer.
