Ignore:
Timestamp:
2013-12-06T11:25:13+01:00 (7 years ago)
Author:
davestorkey
Message:

Remove OBC module at NEMO 3.6. See ticket #1189.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r4314 r4328  
    5353   !!   mppsync       : 
    5454   !!   mppstop       : 
    55    !!   mppobc        : variant of mpp_lnk for open boundary condition 
    5655   !!   mpp_ini_north : initialisation of north fold 
    5756   !!   mpp_lbc_north : north fold processors gathering 
     
    7170   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 
    7271   PUBLIC   mppscatter, mppgather 
    73    PUBLIC   mppobc, mpp_ini_ice, mpp_ini_znl 
     72   PUBLIC   mpp_ini_ice, mpp_ini_znl 
    7473   PUBLIC   mppsize 
    7574   PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines 
    7675   PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 
    77    PUBLIC   mpp_lnk_obc_2d, mpp_lnk_obc_3d 
    7876 
    7977   !! * Interfaces 
     
    300298   END FUNCTION mynode 
    301299 
    302    SUBROUTINE mpp_lnk_obc_3d( ptab, cd_type, psgn ) 
    303       !!---------------------------------------------------------------------- 
    304       !!                  ***  routine mpp_lnk_obc_3d  *** 
     300   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval ) 
     301      !!---------------------------------------------------------------------- 
     302      !!                  ***  routine mpp_lnk_3d  *** 
    305303      !! 
    306304      !! ** Purpose :   Message passing manadgement 
    307305      !! 
    308       !! ** Method  :   Use mppsend and mpprecv function for passing OBC boundaries  
     306      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    309307      !!      between processors following neighboring subdomains. 
    310308      !!            domain parameters 
     
    313311      !!                    nbondi : mark for "east-west local boundary" 
    314312      !!                    nbondj : mark for "north-south local boundary" 
    315       !!                    noea   : number for local neighboring processors  
     313      !!                    noea   : number for local neighboring processors 
    316314      !!                    nowe   : number for local neighboring processors 
    317315      !!                    noso   : number for local neighboring processors 
     
    326324      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    327325      !                                                             ! =  1. , the sign is kept 
     326      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
     327      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    328328      !! 
    329329      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
     
    337337 
    338338      !!---------------------------------------------------------------------- 
    339  
     339       
    340340      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   & 
    341341         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  ) 
    342342 
    343       zland = 0.e0      ! zero by default 
     343      ! 
     344      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
     345      ELSE                         ;   zland = 0.e0      ! zero by default 
     346      ENDIF 
    344347 
    345348      ! 1. standard boundary treatment 
    346349      ! ------------------------------ 
    347       IF( nbondi == 2) THEN 
    348         IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN 
    349           ptab( 1 ,:,:) = ptab(jpim1,:,:) 
    350           ptab(jpi,:,:) = ptab(  2  ,:,:) 
    351         ELSE 
    352           IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
    353           ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
    354         ENDIF 
    355       ELSEIF(nbondi == -1) THEN 
    356         IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
    357       ELSEIF(nbondi == 1) THEN 
    358         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
    359       ENDIF                                     !* closed 
    360  
    361       IF (nbondj == 2 .OR. nbondj == -1) THEN 
    362         IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point 
    363       ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN 
    364         ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north 
     350      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
     351         ! 
     352         ! WARNING ptab is defined only between nld and nle 
     353         DO jk = 1, jpk 
     354            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
     355               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk) 
     356               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk) 
     357               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk) 
     358            END DO 
     359            DO ji = nlci+1, jpi                 ! added column(s) (full) 
     360               ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk) 
     361               ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk) 
     362               ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk) 
     363            END DO 
     364         END DO 
     365         ! 
     366      ELSE                              ! standard close or cyclic treatment 
     367         ! 
     368         !                                   ! East-West boundaries 
     369         !                                        !* Cyclic east-west 
     370         IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
     371            ptab( 1 ,:,:) = ptab(jpim1,:,:) 
     372            ptab(jpi,:,:) = ptab(  2  ,:,:) 
     373         ELSE                                     !* closed 
     374            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
     375                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
     376         ENDIF 
     377         !                                   ! North-South boundaries (always closed) 
     378         IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point 
     379                                      ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north 
     380         ! 
    365381      ENDIF 
    366382 
    367383      ! 2. East and west directions exchange 
    368384      ! ------------------------------------ 
    369       ! we play with the neigbours AND the row number because of the periodicity  
    370       ! 
    371       IF(nbondj .ne. 0) THEN 
     385      ! we play with the neigbours AND the row number because of the periodicity 
     386      ! 
    372387      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    373388      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
     
    377392            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 
    378393         END DO 
    379       END SELECT   
     394      END SELECT 
    380395      ! 
    381396      !                           ! Migrations 
    382397      imigr = jpreci * jpj * jpk 
    383398      ! 
    384       SELECT CASE ( nbondi )  
     399      SELECT CASE ( nbondi ) 
    385400      CASE ( -1 ) 
    386401         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 
     
    418433         END DO 
    419434      END SELECT 
    420       ENDIF 
    421435 
    422436 
     
    425439      ! always closed : we play only with the neigbours 
    426440      ! 
    427       IF(nbondi .ne. 0) THEN 
    428441      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    429442         ijhom = nlcj-nrecj 
     
    437450      imigr = jprecj * jpi * jpk 
    438451      ! 
    439       SELECT CASE ( nbondj )      
     452      SELECT CASE ( nbondj ) 
    440453      CASE ( -1 ) 
    441454         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 
     
    449462         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    450463         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    451       CASE ( 1 )  
     464      CASE ( 1 ) 
    452465         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 
    453466         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 
     
    473486         END DO 
    474487      END SELECT 
    475       ENDIF 
    476488 
    477489 
     
    479491      ! ----------------------- 
    480492      ! 
    481       IF( npolj /= 0 ) THEN 
     493      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
    482494         ! 
    483495         SELECT CASE ( jpni ) 
     
    490502      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 
    491503      ! 
    492    END SUBROUTINE mpp_lnk_obc_3d 
    493  
    494  
    495    SUBROUTINE mpp_lnk_obc_2d( pt2d, cd_type, psgn ) 
    496       !!---------------------------------------------------------------------- 
    497       !!                  ***  routine mpp_lnk_obc_2d  *** 
    498       !!                   
     504   END SUBROUTINE mpp_lnk_3d 
     505 
     506 
     507   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
     508      !!---------------------------------------------------------------------- 
     509      !!                  ***  routine mpp_lnk_2d  *** 
     510      !! 
    499511      !! ** Purpose :   Message passing manadgement for 2d array 
    500512      !! 
    501       !! ** Method  :   Use mppsend and mpprecv function for passing OBC boundaries  
     513      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    502514      !!      between processors following neighboring subdomains. 
    503515      !!            domain parameters 
     
    506518      !!                    nbondi : mark for "east-west local boundary" 
    507519      !!                    nbondj : mark for "north-south local boundary" 
    508       !!                    noea   : number for local neighboring processors  
     520      !!                    noea   : number for local neighboring processors 
    509521      !!                    nowe   : number for local neighboring processors 
    510522      !!                    noso   : number for local neighboring processors 
     
    517529      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    518530      !                                                         ! =  1. , the sign is kept 
     531      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
     532      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    519533      !! 
    520534      INTEGER  ::   ji, jj, jl   ! dummy loop indices 
     
    532546         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   ) 
    533547 
    534       zland = 0.e0      ! zero by default 
     548      ! 
     549      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
     550      ELSE                         ;   zland = 0.e0      ! zero by default 
     551      ENDIF 
    535552 
    536553      ! 1. standard boundary treatment 
    537554      ! ------------------------------ 
    538555      ! 
    539       IF( nbondi == 2) THEN 
    540         IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN 
    541           pt2d( 1 ,:) = pt2d(jpim1,:) 
    542           pt2d(jpi,:) = pt2d(  2  ,:) 
    543         ELSE 
    544           IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point 
    545           pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north 
    546         ENDIF 
    547       ELSEIF(nbondi == -1) THEN 
    548         IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point 
    549       ELSEIF(nbondi == 1) THEN 
    550         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north 
    551       ENDIF                                     !* closed 
    552  
    553       IF (nbondj == 2 .OR. nbondj == -1) THEN 
    554         IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland       ! south except F-point 
    555       ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN 
    556         pt2d(:,nlcj-jprecj+1:jpj) = zland       ! north 
     556      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
     557         ! 
     558         ! WARNING pt2d is defined only between nld and nle 
     559         DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
     560            pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej) 
     561            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej) 
     562            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej) 
     563         END DO 
     564         DO ji = nlci+1, jpi                 ! added column(s) (full) 
     565            pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej) 
     566            pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     ) 
     567            pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej) 
     568         END DO 
     569         ! 
     570      ELSE                              ! standard close or cyclic treatment 
     571         ! 
     572         !                                   ! East-West boundaries 
     573         IF( nbondi == 2 .AND.   &                ! Cyclic east-west 
     574            &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
     575            pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west 
     576            pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east 
     577         ELSE                                     ! closed 
     578            IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point 
     579                                         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north 
     580         ENDIF 
     581         !                                   ! North-South boundaries (always closed) 
     582            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point 
     583                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north 
     584         ! 
    557585      ENDIF 
    558586 
    559587      ! 2. East and west directions exchange 
    560588      ! ------------------------------------ 
    561       ! we play with the neigbours AND the row number because of the periodicity  
     589      ! we play with the neigbours AND the row number because of the periodicity 
    562590      ! 
    563591      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     
    657685            pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 
    658686         END DO 
    659       CASE ( 1 )  
    660          DO jl = 1, jprecj 
    661             pt2d(:,jl      ) = zt2sn(:,jl,2) 
    662          END DO 
    663       END SELECT 
    664  
    665  
    666       ! 4. north fold treatment 
    667       ! ----------------------- 
    668       ! 
    669       IF( npolj /= 0 ) THEN 
    670          ! 
    671          SELECT CASE ( jpni ) 
    672          CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp 
    673          CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs. 
    674          END SELECT 
    675          ! 
    676       ENDIF 
    677       ! 
    678       DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 
    679       ! 
    680    END SUBROUTINE mpp_lnk_obc_2d 
    681  
    682    SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval ) 
    683       !!---------------------------------------------------------------------- 
    684       !!                  ***  routine mpp_lnk_3d  *** 
    685       !! 
    686       !! ** Purpose :   Message passing manadgement 
    687       !! 
    688       !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    689       !!      between processors following neighboring subdomains. 
    690       !!            domain parameters 
    691       !!                    nlci   : first dimension of the local subdomain 
    692       !!                    nlcj   : second dimension of the local subdomain 
    693       !!                    nbondi : mark for "east-west local boundary" 
    694       !!                    nbondj : mark for "north-south local boundary" 
    695       !!                    noea   : number for local neighboring processors 
    696       !!                    nowe   : number for local neighboring processors 
    697       !!                    noso   : number for local neighboring processors 
    698       !!                    nono   : number for local neighboring processors 
    699       !! 
    700       !! ** Action  :   ptab with update value at its periphery 
    701       !! 
    702       !!---------------------------------------------------------------------- 
    703       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied 
    704       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
    705       !                                                             ! = T , U , V , F , W points 
    706       REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    707       !                                                             ! =  1. , the sign is kept 
    708       CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    709       REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    710       !! 
    711       INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
    712       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    713       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    714       REAL(wp) ::   zland 
    715       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
    716       ! 
    717       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north 
    718       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east 
    719  
    720       !!---------------------------------------------------------------------- 
    721        
    722       ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   & 
    723          &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  ) 
    724  
    725       ! 
    726       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
    727       ELSE                         ;   zland = 0.e0      ! zero by default 
    728       ENDIF 
    729  
    730       ! 1. standard boundary treatment 
    731       ! ------------------------------ 
    732       IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
    733          ! 
    734          ! WARNING ptab is defined only between nld and nle 
    735          DO jk = 1, jpk 
    736             DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    737                ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk) 
    738                ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk) 
    739                ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk) 
    740             END DO 
    741             DO ji = nlci+1, jpi                 ! added column(s) (full) 
    742                ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk) 
    743                ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk) 
    744                ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk) 
    745             END DO 
    746          END DO 
    747          ! 
    748       ELSE                              ! standard close or cyclic treatment 
    749          ! 
    750          !                                   ! East-West boundaries 
    751          !                                        !* Cyclic east-west 
    752          IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    753             ptab( 1 ,:,:) = ptab(jpim1,:,:) 
    754             ptab(jpi,:,:) = ptab(  2  ,:,:) 
    755          ELSE                                     !* closed 
    756             IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
    757                                          ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
    758          ENDIF 
    759          !                                   ! North-South boundaries (always closed) 
    760          IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point 
    761                                       ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north 
    762          ! 
    763       ENDIF 
    764  
    765       ! 2. East and west directions exchange 
    766       ! ------------------------------------ 
    767       ! we play with the neigbours AND the row number because of the periodicity 
    768       ! 
    769       SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    770       CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    771          iihom = nlci-nreci 
    772          DO jl = 1, jpreci 
    773             zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 
    774             zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 
    775          END DO 
    776       END SELECT 
    777       ! 
    778       !                           ! Migrations 
    779       imigr = jpreci * jpj * jpk 
    780       ! 
    781       SELECT CASE ( nbondi ) 
    782       CASE ( -1 ) 
    783          CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 
    784          CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 
    785          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    786       CASE ( 0 ) 
    787          CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
    788          CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 ) 
    789          CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 
    790          CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 
    791          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    792          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    793       CASE ( 1 ) 
    794          CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
    795          CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 
    796          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    797       END SELECT 
    798       ! 
    799       !                           ! Write Dirichlet lateral conditions 
    800       iihom = nlci-jpreci 
    801       ! 
    802       SELECT CASE ( nbondi ) 
    803       CASE ( -1 ) 
    804          DO jl = 1, jpreci 
    805             ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 
    806          END DO 
    807       CASE ( 0 ) 
    808          DO jl = 1, jpreci 
    809             ptab(jl      ,:,:) = zt3we(:,jl,:,2) 
    810             ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 
    811          END DO 
    812       CASE ( 1 ) 
    813          DO jl = 1, jpreci 
    814             ptab(jl      ,:,:) = zt3we(:,jl,:,2) 
    815          END DO 
    816       END SELECT 
    817  
    818  
    819       ! 3. North and south directions 
    820       ! ----------------------------- 
    821       ! always closed : we play only with the neigbours 
    822       ! 
    823       IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    824          ijhom = nlcj-nrecj 
    825          DO jl = 1, jprecj 
    826             zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 
    827             zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 
    828          END DO 
    829       ENDIF 
    830       ! 
    831       !                           ! Migrations 
    832       imigr = jprecj * jpi * jpk 
    833       ! 
    834       SELECT CASE ( nbondj ) 
    835       CASE ( -1 ) 
    836          CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 
    837          CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 
    838          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    839       CASE ( 0 ) 
    840          CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 
    841          CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 ) 
    842          CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 
    843          CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 
    844          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    845          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    846       CASE ( 1 ) 
    847          CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 
    848          CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 
    849          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    850       END SELECT 
    851       ! 
    852       !                           ! Write Dirichlet lateral conditions 
    853       ijhom = nlcj-jprecj 
    854       ! 
    855       SELECT CASE ( nbondj ) 
    856       CASE ( -1 ) 
    857          DO jl = 1, jprecj 
    858             ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 
    859          END DO 
    860       CASE ( 0 ) 
    861          DO jl = 1, jprecj 
    862             ptab(:,jl      ,:) = zt3sn(:,jl,:,2) 
    863             ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 
    864          END DO 
    865       CASE ( 1 ) 
    866          DO jl = 1, jprecj 
    867             ptab(:,jl,:) = zt3sn(:,jl,:,2) 
    868          END DO 
    869       END SELECT 
    870  
    871  
    872       ! 4. north fold treatment 
    873       ! ----------------------- 
    874       ! 
    875       IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
    876          ! 
    877          SELECT CASE ( jpni ) 
    878          CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp 
    879          CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs. 
    880          END SELECT 
    881          ! 
    882       ENDIF 
    883       ! 
    884       DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 
    885       ! 
    886    END SUBROUTINE mpp_lnk_3d 
    887  
    888  
    889    SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
    890       !!---------------------------------------------------------------------- 
    891       !!                  ***  routine mpp_lnk_2d  *** 
    892       !! 
    893       !! ** Purpose :   Message passing manadgement for 2d array 
    894       !! 
    895       !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    896       !!      between processors following neighboring subdomains. 
    897       !!            domain parameters 
    898       !!                    nlci   : first dimension of the local subdomain 
    899       !!                    nlcj   : second dimension of the local subdomain 
    900       !!                    nbondi : mark for "east-west local boundary" 
    901       !!                    nbondj : mark for "north-south local boundary" 
    902       !!                    noea   : number for local neighboring processors 
    903       !!                    nowe   : number for local neighboring processors 
    904       !!                    noso   : number for local neighboring processors 
    905       !!                    nono   : number for local neighboring processors 
    906       !! 
    907       !!---------------------------------------------------------------------- 
    908       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied 
    909       CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
    910       !                                                         ! = T , U , V , F , W and I points 
    911       REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    912       !                                                         ! =  1. , the sign is kept 
    913       CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    914       REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    915       !! 
    916       INTEGER  ::   ji, jj, jl   ! dummy loop indices 
    917       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    918       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    919       REAL(wp) ::   zland 
    920       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
    921       ! 
    922       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north 
    923       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east 
    924  
    925       !!---------------------------------------------------------------------- 
    926  
    927       ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  & 
    928          &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   ) 
    929  
    930       ! 
    931       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
    932       ELSE                         ;   zland = 0.e0      ! zero by default 
    933       ENDIF 
    934  
    935       ! 1. standard boundary treatment 
    936       ! ------------------------------ 
    937       ! 
    938       IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
    939          ! 
    940          ! WARNING pt2d is defined only between nld and nle 
    941          DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    942             pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej) 
    943             pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej) 
    944             pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej) 
    945          END DO 
    946          DO ji = nlci+1, jpi                 ! added column(s) (full) 
    947             pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej) 
    948             pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     ) 
    949             pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej) 
    950          END DO 
    951          ! 
    952       ELSE                              ! standard close or cyclic treatment 
    953          ! 
    954          !                                   ! East-West boundaries 
    955          IF( nbondi == 2 .AND.   &                ! Cyclic east-west 
    956             &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    957             pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west 
    958             pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east 
    959          ELSE                                     ! closed 
    960             IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point 
    961                                          pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north 
    962          ENDIF 
    963          !                                   ! North-South boundaries (always closed) 
    964             IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point 
    965                                          pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north 
    966          ! 
    967       ENDIF 
    968  
    969       ! 2. East and west directions exchange 
    970       ! ------------------------------------ 
    971       ! we play with the neigbours AND the row number because of the periodicity 
    972       ! 
    973       SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    974       CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    975          iihom = nlci-nreci 
    976          DO jl = 1, jpreci 
    977             zt2ew(:,jl,1) = pt2d(jpreci+jl,:) 
    978             zt2we(:,jl,1) = pt2d(iihom +jl,:) 
    979          END DO 
    980       END SELECT 
    981       ! 
    982       !                           ! Migrations 
    983       imigr = jpreci * jpj 
    984       ! 
    985       SELECT CASE ( nbondi ) 
    986       CASE ( -1 ) 
    987          CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 
    988          CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 
    989          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    990       CASE ( 0 ) 
    991          CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 
    992          CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 
    993          CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 
    994          CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 
    995          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    996          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    997       CASE ( 1 ) 
    998          CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 
    999          CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 
    1000          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    1001       END SELECT 
    1002       ! 
    1003       !                           ! Write Dirichlet lateral conditions 
    1004       iihom = nlci - jpreci 
    1005       ! 
    1006       SELECT CASE ( nbondi ) 
    1007       CASE ( -1 ) 
    1008          DO jl = 1, jpreci 
    1009             pt2d(iihom+jl,:) = zt2ew(:,jl,2) 
    1010          END DO 
    1011       CASE ( 0 ) 
    1012          DO jl = 1, jpreci 
    1013             pt2d(jl      ,:) = zt2we(:,jl,2) 
    1014             pt2d(iihom+jl,:) = zt2ew(:,jl,2) 
    1015          END DO 
    1016       CASE ( 1 ) 
    1017          DO jl = 1, jpreci 
    1018             pt2d(jl      ,:) = zt2we(:,jl,2) 
    1019          END DO 
    1020       END SELECT 
    1021  
    1022  
    1023       ! 3. North and south directions 
    1024       ! ----------------------------- 
    1025       ! always closed : we play only with the neigbours 
    1026       ! 
    1027       IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    1028          ijhom = nlcj-nrecj 
    1029          DO jl = 1, jprecj 
    1030             zt2sn(:,jl,1) = pt2d(:,ijhom +jl) 
    1031             zt2ns(:,jl,1) = pt2d(:,jprecj+jl) 
    1032          END DO 
    1033       ENDIF 
    1034       ! 
    1035       !                           ! Migrations 
    1036       imigr = jprecj * jpi 
    1037       ! 
    1038       SELECT CASE ( nbondj ) 
    1039       CASE ( -1 ) 
    1040          CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 
    1041          CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 
    1042          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    1043       CASE ( 0 ) 
    1044          CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 
    1045          CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 
    1046          CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 
    1047          CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 
    1048          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    1049          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    1050       CASE ( 1 ) 
    1051          CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 
    1052          CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 
    1053          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    1054       END SELECT 
    1055       ! 
    1056       !                           ! Write Dirichlet lateral conditions 
    1057       ijhom = nlcj - jprecj 
    1058       ! 
    1059       SELECT CASE ( nbondj ) 
    1060       CASE ( -1 ) 
    1061          DO jl = 1, jprecj 
    1062             pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 
    1063          END DO 
    1064       CASE ( 0 ) 
    1065          DO jl = 1, jprecj 
    1066             pt2d(:,jl      ) = zt2sn(:,jl,2) 
    1067             pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 
    1068          END DO 
    1069687      CASE ( 1 ) 
    1070688         DO jl = 1, jprecj 
     
    21021720      ! 
    21031721   END SUBROUTINE mppstop 
    2104  
    2105  
    2106    SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij , kumout) 
    2107       !!---------------------------------------------------------------------- 
    2108       !!                  ***  routine mppobc  *** 
    2109       !! 
    2110       !! ** Purpose :   Message passing manadgement for open boundary 
    2111       !!     conditions array 
    2112       !! 
    2113       !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    2114       !!       between processors following neighboring subdomains. 
    2115       !!       domain parameters 
    2116       !!                    nlci   : first dimension of the local subdomain 
    2117       !!                    nlcj   : second dimension of the local subdomain 
    2118       !!                    nbondi : mark for "east-west local boundary" 
    2119       !!                    nbondj : mark for "north-south local boundary" 
    2120       !!                    noea   : number for local neighboring processors 
    2121       !!                    nowe   : number for local neighboring processors 
    2122       !!                    noso   : number for local neighboring processors 
    2123       !!                    nono   : number for local neighboring processors 
    2124       !! 
    2125       !!---------------------------------------------------------------------- 
    2126       USE wrk_nemo        ! Memory allocation 
    2127       ! 
    2128       INTEGER , INTENT(in   )                     ::   kd1, kd2   ! starting and ending indices 
    2129       INTEGER , INTENT(in   )                     ::   kl         ! index of open boundary 
    2130       INTEGER , INTENT(in   )                     ::   kk         ! vertical dimension 
    2131       INTEGER , INTENT(in   )                     ::   ktype      ! define north/south or east/west cdt 
    2132       !                                                           !  = 1  north/south  ;  = 2  east/west 
    2133       INTEGER , INTENT(in   )                     ::   kij        ! horizontal dimension 
    2134       INTEGER , INTENT(in   )                     ::   kumout     ! ocean.output logical unit 
    2135       REAL(wp), INTENT(inout), DIMENSION(kij,kk)  ::   ptab       ! variable array 
    2136       ! 
    2137       INTEGER ::   ji, jj, jk, jl        ! dummy loop indices 
    2138       INTEGER ::   iipt0, iipt1, ilpt1   ! local integers 
    2139       INTEGER ::   ijpt0, ijpt1          !   -       - 
    2140       INTEGER ::   imigr, iihom, ijhom   !   -       - 
    2141       INTEGER ::   ml_req1, ml_req2, ml_err    ! for key_mpi_isend 
    2142       INTEGER ::   ml_stat(MPI_STATUS_SIZE)    ! for key_mpi_isend 
    2143       REAL(wp), POINTER, DIMENSION(:,:) ::   ztab   ! temporary workspace 
    2144       ! 
    2145       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north 
    2146       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east 
    2147       LOGICAL :: lmigr ! is true for those processors that have to migrate the OB 
    2148  
    2149       !!---------------------------------------------------------------------- 
    2150  
    2151       ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),   & 
    2152          &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   ) 
    2153  
    2154       CALL wrk_alloc( jpi,jpj, ztab ) 
    2155  
    2156       ! boundary condition initialization 
    2157       ! --------------------------------- 
    2158       ztab(:,:) = 0.e0 
    2159       ! 
    2160       IF( ktype==1 ) THEN                                  ! north/south boundaries 
    2161          iipt0 = MAX( 1, MIN(kd1 - nimpp+1, nlci     ) ) 
    2162          iipt1 = MAX( 0, MIN(kd2 - nimpp+1, nlci - 1 ) ) 
    2163          ilpt1 = MAX( 1, MIN(kd2 - nimpp+1, nlci     ) ) 
    2164          ijpt0 = MAX( 1, MIN(kl  - njmpp+1, nlcj     ) ) 
    2165          ijpt1 = MAX( 0, MIN(kl  - njmpp+1, nlcj - 1 ) ) 
    2166       ELSEIF( ktype==2 ) THEN                              ! east/west boundaries 
    2167          iipt0 = MAX( 1, MIN(kl  - nimpp+1, nlci     ) ) 
    2168          iipt1 = MAX( 0, MIN(kl  - nimpp+1, nlci - 1 ) ) 
    2169          ijpt0 = MAX( 1, MIN(kd1 - njmpp+1, nlcj     ) ) 
    2170          ijpt1 = MAX( 0, MIN(kd2 - njmpp+1, nlcj - 1 ) ) 
    2171          ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj     ) ) 
    2172       ELSE 
    2173          WRITE(kumout, cform_err) 
    2174          WRITE(kumout,*) 'mppobc : bad ktype' 
    2175          CALL mppstop 
    2176       ENDIF 
    2177  
    2178       ! Communication level by level 
    2179       ! ---------------------------- 
    2180 !!gm Remark : this is very time consumming!!! 
    2181       !                                         ! ------------------------ ! 
    2182         IF(((nbondi .ne. 0) .AND. (ktype .eq. 2)) .OR. ((nbondj .ne. 0) .AND. (ktype .eq. 1))) THEN 
    2183             ! there is nothing to be migrated 
    2184               lmigr = .TRUE. 
    2185             ELSE 
    2186               lmigr = .FALSE. 
    2187             ENDIF 
    2188  
    2189       IF( lmigr ) THEN 
    2190  
    2191       DO jk = 1, kk                             !   Loop over the levels   ! 
    2192          !                                      ! ------------------------ ! 
    2193          ! 
    2194          IF( ktype == 1 ) THEN                               ! north/south boundaries 
    2195             DO jj = ijpt0, ijpt1 
    2196                DO ji = iipt0, iipt1 
    2197                   ztab(ji,jj) = ptab(ji,jk) 
    2198                END DO 
    2199             END DO 
    2200          ELSEIF( ktype == 2 ) THEN                           ! east/west boundaries 
    2201             DO jj = ijpt0, ijpt1 
    2202                DO ji = iipt0, iipt1 
    2203                   ztab(ji,jj) = ptab(jj,jk) 
    2204                END DO 
    2205             END DO 
    2206          ENDIF 
    2207  
    2208  
    2209          ! 1. East and west directions 
    2210          ! --------------------------- 
    2211          ! 
    2212        IF( ktype == 1 ) THEN 
    2213  
    2214          IF( nbondi /= 2 ) THEN         ! Read Dirichlet lateral conditions 
    2215             iihom = nlci-nreci 
    2216             zt2ew(1:jpreci,1,1) = ztab(jpreci+1:nreci, ijpt0) 
    2217             zt2we(1:jpreci,1,1) = ztab(iihom+1:iihom+jpreci, ijpt0) 
    2218          ENDIF 
    2219          ! 
    2220          !                              ! Migrations 
    2221          imigr = jpreci 
    2222          ! 
    2223          IF( nbondi == -1 ) THEN 
    2224             CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 
    2225             CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 
    2226             IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    2227          ELSEIF( nbondi == 0 ) THEN 
    2228             CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 
    2229             CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 
    2230             CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 
    2231             CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 
    2232             IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    2233             IF(l_isend)   CALL mpi_wait( ml_req2, ml_stat, ml_err ) 
    2234          ELSEIF( nbondi == 1 ) THEN 
    2235             CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 
    2236             CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 
    2237             IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    2238          ENDIF 
    2239          ! 
    2240          !                              ! Write Dirichlet lateral conditions 
    2241          iihom = nlci-jpreci 
    2242          ! 
    2243          IF( nbondi == 0 .OR. nbondi == 1 ) THEN 
    2244             ztab(1:jpreci, ijpt0) = zt2we(1:jpreci,1,2) 
    2245          ENDIF 
    2246          IF( nbondi == -1 .OR. nbondi == 0 ) THEN 
    2247             ztab(iihom+1:iihom+jpreci, ijpt0) = zt2ew(1:jpreci,1,2) 
    2248          ENDIF 
    2249        ENDIF  ! (ktype == 1) 
    2250  
    2251          ! 2. North and south directions 
    2252          ! ----------------------------- 
    2253          ! 
    2254        IF(ktype == 2 ) THEN 
    2255          IF( nbondj /= 2 ) THEN         ! Read Dirichlet lateral conditions 
    2256             ijhom = nlcj-nrecj 
    2257             zt2sn(1:jprecj,1,1) = ztab(iipt0, ijhom+1:ijhom+jprecj) 
    2258             zt2ns(1:jprecj,1,1) = ztab(iipt0, jprecj+1:nrecj) 
    2259          ENDIF 
    2260          ! 
    2261          !                              ! Migrations 
    2262          imigr = jprecj 
    2263          ! 
    2264          IF( nbondj == -1 ) THEN 
    2265             CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 
    2266             CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 
    2267             IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    2268          ELSEIF( nbondj == 0 ) THEN 
    2269             CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 
    2270             CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 
    2271             CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 
    2272             CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 
    2273             IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    2274             IF( l_isend )   CALL mpi_wait( ml_req2, ml_stat, ml_err ) 
    2275          ELSEIF( nbondj == 1 ) THEN 
    2276             CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 
    2277             CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso) 
    2278             IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    2279          ENDIF 
    2280          ! 
    2281          !                              ! Write Dirichlet lateral conditions 
    2282          ijhom = nlcj - jprecj 
    2283          IF( nbondj == 0 .OR. nbondj == 1 ) THEN 
    2284             ztab(iipt0,1:jprecj) = zt2sn(1:jprecj,1,2) 
    2285          ENDIF 
    2286          IF( nbondj == 0 .OR. nbondj == -1 ) THEN 
    2287             ztab(iipt0, ijhom+1:ijhom+jprecj) = zt2ns(1:jprecj,1,2) 
    2288          ENDIF 
    2289          ENDIF    ! (ktype == 2) 
    2290          IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN 
    2291             DO jj = ijpt0, ijpt1            ! north/south boundaries 
    2292                DO ji = iipt0,ilpt1 
    2293                   ptab(ji,jk) = ztab(ji,jj) 
    2294                END DO 
    2295             END DO 
    2296          ELSEIF( ktype==2 .AND. kd1 <= jpj+njmpp-1 .AND. njmpp <= kd2 ) THEN 
    2297             DO jj = ijpt0, ilpt1            ! east/west boundaries 
    2298                DO ji = iipt0,iipt1 
    2299                   ptab(jj,jk) = ztab(ji,jj) 
    2300                END DO 
    2301             END DO 
    2302          ENDIF 
    2303          ! 
    2304       END DO 
    2305       ! 
    2306       ENDIF ! ( lmigr ) 
    2307       ! 
    2308       DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 
    2309       CALL wrk_dealloc( jpi,jpj, ztab ) 
    2310       ! 
    2311    END SUBROUTINE mppobc 
    23121722 
    23131723 
     
    34902900      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real 
    34912901   END INTERFACE 
    3492    INTERFACE mppobc 
    3493       MODULE PROCEDURE mppobc_1d, mppobc_2d, mppobc_3d, mppobc_4d 
    3494    END INTERFACE 
    34952902   INTERFACE mpp_minloc 
    34962903      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d 
     
    36193026      WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom 
    36203027   END SUBROUTINE mppmin_int 
    3621  
    3622    SUBROUTINE mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 
    3623       INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum 
    3624       REAL, DIMENSION(:) ::   parr           ! variable array 
    3625       WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1), kd1, kd2, kl, kk, ktype, kij, knum 
    3626    END SUBROUTINE mppobc_1d 
    3627  
    3628    SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 
    3629       INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum 
    3630       REAL, DIMENSION(:,:) ::   parr           ! variable array 
    3631       WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1), kd1, kd2, kl, kk, ktype, kij, knum 
    3632    END SUBROUTINE mppobc_2d 
    3633  
    3634    SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 
    3635       INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum 
    3636       REAL, DIMENSION(:,:,:) ::   parr           ! variable array 
    3637       WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1), kd1, kd2, kl, kk, ktype, kij, knum 
    3638    END SUBROUTINE mppobc_3d 
    3639  
    3640    SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 
    3641       INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum 
    3642       REAL, DIMENSION(:,:,:,:) ::   parr           ! variable array 
    3643       WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1,1), kd1, kd2, kl, kk, ktype, kij, knum 
    3644    END SUBROUTINE mppobc_4d 
    36453028 
    36463029   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki, kj ) 
Note: See TracChangeset for help on using the changeset viewer.