New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 3592 – NEMO

Changeset 3592


Ignore:
Timestamp:
2012-11-19T12:39:00+01:00 (12 years ago)
Author:
vichi
Message:

OBC and BDY optimization by CMCC

Also Added ARCH/CMCC folder with PW6_calypso archfiles.

The CMCC achitecture files for calypso are :

  • PW6_calypso fro compiling NEMO release configuration
  • PW6_calypso_debug for debugging NEMO
  • PW6_calypso_tools to compile toolswith xlf90 for serial job
Location:
branches/2012/dev_r3365_CMCC1_BDYOBCopt/NEMOGCM
Files:
4 added
11 edited

Legend:

Unmodified
Added
Removed

  • branches/2012/dev_r3365_CMCC1_BDYOBCopt/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90

    r3294 r3592  
    55   !!====================================================================== 
    66   !! History :  3.4  !  2011     (D. Storkey) new module as part of BDY rewrite 
     7   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_bdy  
    … …  
    5152            CYCLE 
    5253         CASE(jp_frs) 
    53             CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy) ) 
     54            CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 
    5455         CASE(jp_flather) 
    55             CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy) ) 
     56            CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 
    5657         CASE DEFAULT 
    5758            CALL ctl_stop( 'bdy_dyn2d : unrecognised option for open boundaries for barotropic variables' ) 
    … …  
    6162   END SUBROUTINE bdy_dyn2d 
    6263 
    63    SUBROUTINE bdy_dyn2d_frs( idx, dta ) 
     64   SUBROUTINE bdy_dyn2d_frs( idx, dta, ib_bdy ) 
    6465      !!---------------------------------------------------------------------- 
    6566      !!                  ***  SUBROUTINE bdy_dyn2d_frs  *** 
    … …  
    7475      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    7576      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
     77      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    7678      !! 
    7779      INTEGER  ::   jb, jk         ! dummy loop indices 
    … …  
    9799         pv2d(ii,ij) = ( pv2d(ii,ij) + zwgt * ( dta%v2d(jb) - pv2d(ii,ij) ) ) * vmask(ii,ij,1) 
    98100      END DO  
    99       CALL lbc_lnk( pu2d, 'U', -1. )  
    100       CALL lbc_lnk( pv2d, 'V', -1. )   ! Boundary points should be updated 
     101      CALL lbc_bdy_lnk( pu2d, 'U', -1., ib_bdy )  
     102      CALL lbc_bdy_lnk( pv2d, 'V', -1., ib_bdy)   ! Boundary points should be updated 
    101103      ! 
    102104      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_frs') 
    … …  
    106108 
    107109 
    108    SUBROUTINE bdy_dyn2d_fla( idx, dta ) 
     110   SUBROUTINE bdy_dyn2d_fla( idx, dta, ib_bdy ) 
    109111      !!---------------------------------------------------------------------- 
    110112      !!                 ***  SUBROUTINE bdy_dyn2d_fla  *** 
    … …  
    127129      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
    128130      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
     131      INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index 
    129132 
    130133      INTEGER  ::   jb, igrd                         ! dummy loop indices 
    … …  
    177180         pv2d(ii,ij) = zforc + zcorr * vmask(ii,ij,1) 
    178181      END DO 
    179       CALL lbc_lnk( pu2d, 'U', -1. )   ! Boundary points should be updated 
    180       CALL lbc_lnk( pv2d, 'V', -1. )   ! 
     182      CALL lbc_bdy_lnk( pu2d, 'U', -1., ib_bdy )   ! Boundary points should be updated 
     183      CALL lbc_bdy_lnk( pv2d, 'V', -1., ib_bdy )   ! 
    181184      ! 
    182185      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_fla') 

  • branches/2012/dev_r3365_CMCC1_BDYOBCopt/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90

    r3294 r3592  
    55   !!====================================================================== 
    66   !! History :  3.4  !  2011     (D. Storkey) new module as part of BDY rewrite  
     7   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_bdy  
    … …  
    5455            CYCLE 
    5556         CASE(jp_frs) 
    56             CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
     57            CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    5758         CASE DEFAULT 
    5859            CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 
    … …  
    6263   END SUBROUTINE bdy_dyn3d 
    6364 
    64    SUBROUTINE bdy_dyn3d_frs( idx, dta, kt ) 
     65   SUBROUTINE bdy_dyn3d_frs( idx, dta, kt, ib_bdy ) 
    6566      !!---------------------------------------------------------------------- 
    6667      !!                  ***  SUBROUTINE bdy_dyn3d_frs  *** 
    … …  
    7677      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    7778      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
     79      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    7880      !! 
    7981      INTEGER  ::   jb, jk         ! dummy loop indices 
    … …  
    103105         END DO 
    104106      END DO  
    105       CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )   ! Boundary points should be updated 
     107      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ;   CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy )   ! Boundary points should be updated 
    106108      ! 
    107109      IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 

  • branches/2012/dev_r3365_CMCC1_BDYOBCopt/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim2.F90

    r3347 r3592  
    66   !!  History :  3.3  !  2010-09 (D. Storkey)  Original code 
    77   !!             3.4  !  2011    (D. Storkey) rewrite in preparation for OBC-BDY merge 
     8   !!             3.5  !  2012    (S. Mocavero, I. Epicoco) Optimization of BDY communications 
    89   !!---------------------------------------------------------------------- 
    910#if defined   key_bdy   &&   defined key_lim2 
    … …  
    5354            CYCLE 
    5455         CASE(jp_frs) 
    55             CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy) ) 
     56            CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 
    5657         CASE DEFAULT 
    5758            CALL ctl_stop( 'bdy_ice_lim_2 : unrecognised option for open boundaries for ice fields' ) 
    … …  
    6162   END SUBROUTINE bdy_ice_lim_2 
    6263 
    63    SUBROUTINE bdy_ice_frs( idx, dta ) 
     64   SUBROUTINE bdy_ice_frs( idx, dta, ib_bdy ) 
    6465      !!------------------------------------------------------------------------------ 
    6566      !!                 ***  SUBROUTINE bdy_ice_frs  *** 
    … …  
    7374      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    7475      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
     76      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    7577      !! 
    7678      INTEGER  ::   jb, jk, jgrd   ! dummy loop indices 
    … …  
    9496         END DO 
    9597      END DO  
    96       CALL lbc_lnk( frld, 'T', 1. )                                         ! lateral boundary conditions 
    97       CALL lbc_lnk( hicif, 'T', 1. )   ;   CALL lbc_lnk( hsnif, 'T', 1. ) 
     98      CALL lbc_bdy_lnk( frld, 'T', 1., ib_bdy )                                         ! lateral boundary conditions 
     99      CALL lbc_bdy_lnk( hicif, 'T', 1., ib_bdy )   ;   CALL lbc_bdy_lnk( hsnif, 'T', 1., ib_bdy ) 
    98100      !       
    99101      IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_frs') 

  • branches/2012/dev_r3365_CMCC1_BDYOBCopt/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r3298 r3592  
    1111   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions 
    1212   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge 
     13   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Updates for the  
     14   !!                             optimization of BDY communications 
    1315   !!---------------------------------------------------------------------- 
    1416#if defined key_bdy 
    … …  
    3436   !!---------------------------------------------------------------------- 
    3537   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    36    !! $Id$  
     38   !! $Id: bdyini.F90 3298 2012-02-07 17:12:09Z cbricaud $  
    3739   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3840   !!---------------------------------------------------------------------- 
    … …  
    7678      CHARACTER(LEN=80),DIMENSION(jpbgrd)  ::   clfile 
    7779      CHARACTER(LEN=1),DIMENSION(jpbgrd)   ::   cgrid 
     80      INTEGER :: com_east, com_west, com_south, com_north          ! Flags for boundaries sending 
     81      INTEGER :: com_east_b, com_west_b, com_south_b, com_north_b  ! Flags for boundaries receiving 
     82      INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4)                ! Arrays for neighbours coordinates 
     83 
    7884      !! 
    7985      NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file,             & 
    … …  
    543549      in = mjg(1) + nlcj-1 - 1   ! if monotasking and no zoom, in=jpjm1 
    544550 
     551      ALLOCATE( nbondi_bdy(nb_bdy)) 
     552      ALLOCATE( nbondj_bdy(nb_bdy)) 
     553      nbondi_bdy(:)=2 
     554      nbondj_bdy(:)=2 
     555      ALLOCATE( nbondi_bdy_b(nb_bdy)) 
     556      ALLOCATE( nbondj_bdy_b(nb_bdy)) 
     557      nbondi_bdy_b(:)=2 
     558      nbondj_bdy_b(:)=2 
     559 
     560      ! Work out dimensions of boundary data on each neighbour process 
     561      IF(nbondi .eq. 0) THEN 
     562         iw_b(1) = jpizoom + nimppt(nowe+1) 
     563         ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3 
     564         is_b(1) = jpjzoom + njmppt(nowe+1) 
     565         in_b(1) = jpjzoom + njmppt(nowe+1)+nlcjt(nowe+1)-3 
     566 
     567         iw_b(2) = jpizoom + nimppt(noea+1) 
     568         ie_b(2) = jpizoom + nimppt(noea+1)+nlcit(noea+1)-3 
     569         is_b(2) = jpjzoom + njmppt(noea+1) 
     570         in_b(2) = jpjzoom + njmppt(noea+1)+nlcjt(noea+1)-3 
     571      ELSEIF(nbondi .eq. 1) THEN 
     572         iw_b(1) = jpizoom + nimppt(nowe+1) 
     573         ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3 
     574         is_b(1) = jpjzoom + njmppt(nowe+1) 
     575         in_b(1) = jpjzoom + njmppt(nowe+1)+nlcjt(nowe+1)-3 
     576      ELSEIF(nbondi .eq. -1) THEN 
     577         iw_b(2) = jpizoom + nimppt(noea+1) 
     578         ie_b(2) = jpizoom + nimppt(noea+1)+nlcit(noea+1)-3 
     579         is_b(2) = jpjzoom + njmppt(noea+1) 
     580         in_b(2) = jpjzoom + njmppt(noea+1)+nlcjt(noea+1)-3 
     581      ENDIF 
     582 
     583      IF(nbondj .eq. 0) THEN 
     584         iw_b(3) = jpizoom + nimppt(noso+1) 
     585         ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3 
     586         is_b(3) = jpjzoom + njmppt(noso+1) 
     587         in_b(3) = jpjzoom + njmppt(noso+1)+nlcjt(noso+1)-3 
     588 
     589         iw_b(4) = jpizoom + nimppt(nono+1) 
     590         ie_b(4) = jpizoom + nimppt(nono+1)+nlcit(nono+1)-3 
     591         is_b(4) = jpjzoom + njmppt(nono+1) 
     592         in_b(4) = jpjzoom + njmppt(nono+1)+nlcjt(nono+1)-3 
     593      ELSEIF(nbondj .eq. 1) THEN 
     594         iw_b(3) = jpizoom + nimppt(noso+1) 
     595         ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3 
     596         is_b(3) = jpjzoom + njmppt(noso+1) 
     597         in_b(3) = jpjzoom + njmppt(noso+1)+nlcjt(noso+1)-3 
     598      ELSEIF(nbondj .eq. -1) THEN 
     599         iw_b(4) = jpizoom + nimppt(nono+1) 
     600         ie_b(4) = jpizoom + nimppt(nono+1)+nlcit(nono+1)-3 
     601         is_b(4) = jpjzoom + njmppt(nono+1) 
     602         in_b(4) = jpjzoom + njmppt(nono+1)+nlcjt(nono+1)-3 
     603      ENDIF 
     604 
    545605      DO ib_bdy = 1, nb_bdy 
    546606         DO igrd = 1, jpbgrd 
    … …  
    585645         ! ----------------------------------------------------------------- 
    586646 
     647         com_east = 0 
     648         com_west = 0 
     649         com_south = 0 
     650         com_north = 0 
     651 
     652         com_east_b = 0 
     653         com_west_b = 0 
     654         com_south_b = 0 
     655         com_north_b = 0 
    587656         DO igrd = 1, jpbgrd 
    588657            icount  = 0 
    … …  
    598667                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+1 
    599668                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1 
     669                     ! check if point has to be sent 
     670                     ii = idx_bdy(ib_bdy)%nbi(icount,igrd) 
     671                     ij = idx_bdy(ib_bdy)%nbj(icount,igrd) 
     672                     if((com_east .ne. 1) .and. (ii .eq. (nlci-1)) .and. (nbondi .le. 0)) then 
     673                        com_east = 1 
     674                     elseif((com_west .ne. 1) .and. (ii .eq. 2) .and. (nbondi .ge. 0) .and. (nbondi .ne. 2)) then 
     675                        com_west = 1 
     676                     endif  
     677                     if((com_south .ne. 1) .and. (ij .eq. 2) .and. (nbondj .ge. 0) .and. (nbondj .ne. 2)) then 
     678                        com_south = 1 
     679                     elseif((com_north .ne. 1) .and. (ij .eq. (nlcj-1)) .and. (nbondj .le. 0)) then 
     680                        com_north = 1 
     681                     endif  
    600682                     idx_bdy(ib_bdy)%nbr(icount,igrd)   = nbrdta(ib,igrd,ib_bdy) 
    601683                     idx_bdy(ib_bdy)%nbmap(icount,igrd) = ib 
    602684                  ENDIF 
     685                  ! check if point has to be received from a neighbour 
     686                  IF(nbondi .eq. 0) THEN 
     687                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND.   & 
     688                       & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND.   & 
     689                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
     690                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2 
     691                       if((com_west_b .ne. 1) .and. (ii .eq. (nlcit(nowe+1)-1))) then 
     692                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2 
     693                          if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then 
     694                            com_south = 1 
     695                          elseif((ij .eq. nlcjt(nowe+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then 
     696                            com_north = 1 
     697                          endif 
     698                          com_west_b = 1 
     699                       endif  
     700                     ENDIF 
     701                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(2) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(2) .AND.   & 
     702                       & nbjdta(ib,igrd,ib_bdy) >= is_b(2) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(2) .AND.   & 
     703                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
     704                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2 
     705                       if((com_east_b .ne. 1) .and. (ii .eq. 2)) then 
     706                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2 
     707                          if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then 
     708                            com_south = 1 
     709                          elseif((ij .eq. nlcjt(noea+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then 
     710                            com_north = 1 
     711                          endif 
     712                          com_east_b = 1 
     713                       endif  
     714                     ENDIF 
     715                  ELSEIF(nbondi .eq. 1) THEN 
     716                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND.   & 
     717                       & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND.   & 
     718                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
     719                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2 
     720                       if((com_west_b .ne. 1) .and. (ii .eq. (nlcit(nowe+1)-1))) then 
     721                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2 
     722                          if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then 
     723                            com_south = 1 
     724                          elseif((ij .eq. nlcjt(nowe+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then 
     725                            com_north = 1 
     726                          endif 
     727                          com_west_b = 1 
     728                       endif  
     729                     ENDIF 
     730                  ELSEIF(nbondi .eq. -1) THEN 
     731                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(2) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(2) .AND.   & 
     732                       & nbjdta(ib,igrd,ib_bdy) >= is_b(2) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(2) .AND.   & 
     733                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
     734                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2 
     735                       if((com_east_b .ne. 1) .and. (ii .eq. 2)) then 
     736                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2 
     737                          if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then 
     738                            com_south = 1 
     739                          elseif((ij .eq. nlcjt(noea+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then 
     740                            com_north = 1 
     741                          endif 
     742                          com_east_b = 1 
     743                       endif  
     744                     ENDIF 
     745                  ENDIF 
     746                  IF(nbondj .eq. 0) THEN 
     747                     IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1 .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. & 
     748                       & nbjdta(ib,igrd,ib_bdy) == is_b(4) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN 
     749                       com_north_b = 1  
     750                     ENDIF 
     751                     IF(com_south_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(3)-1 .OR. nbidta(ib,igrd,ib_bdy) == ie_b(3)+1) .AND. & 
     752                       & nbjdta(ib,igrd,ib_bdy) == in_b(3) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN 
     753                       com_south_b = 1  
     754                     ENDIF 
     755                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(3) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(3) .AND.   & 
     756                       & nbjdta(ib,igrd,ib_bdy) >= is_b(3) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(3) .AND.   & 
     757                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
     758                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2 
     759                       if((com_south_b .ne. 1) .and. (ij .eq. (nlcjt(noso+1)-1))) then 
     760                          com_south_b = 1 
     761                       endif  
     762                     ENDIF 
     763                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(4) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(4) .AND.   & 
     764                       & nbjdta(ib,igrd,ib_bdy) >= is_b(4) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(4) .AND.   & 
     765                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
     766                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2 
     767                       if((com_north_b .ne. 1) .and. (ij .eq. 2)) then 
     768                          com_north_b = 1 
     769                       endif  
     770                     ENDIF 
     771                  ELSEIF(nbondj .eq. 1) THEN 
     772                     IF(com_south_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(3)-1 .OR. nbidta(ib,igrd,ib_bdy) == ie_b(3)+1) .AND. & 
     773                       & nbjdta(ib,igrd,ib_bdy) == in_b(3) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN 
     774                       com_south_b = 1  
     775                     ENDIF 
     776                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(3) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(3) .AND.   & 
     777                       & nbjdta(ib,igrd,ib_bdy) >= is_b(3) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(3) .AND.   & 
     778                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
     779                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2 
     780                       if((com_south_b .ne. 1) .and. (ij .eq. (nlcjt(noso+1)-1))) then 
     781                          com_south_b = 1 
     782                       endif  
     783                     ENDIF 
     784                  ELSEIF(nbondj .eq. -1) THEN 
     785                     IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1 .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. & 
     786                       & nbjdta(ib,igrd,ib_bdy) == is_b(4) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN 
     787                       com_north_b = 1  
     788                     ENDIF 
     789                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(4) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(4) .AND.   & 
     790                       & nbjdta(ib,igrd,ib_bdy) >= is_b(4) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(4) .AND.   & 
     791                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
     792                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2 
     793                       if((com_north_b .ne. 1) .and. (ij .eq. 2)) then 
     794                          com_north_b = 1 
     795                       endif  
     796                     ENDIF 
     797                  ENDIF 
    603798               ENDDO 
    604799            ENDDO 
    605800         ENDDO  
     801         ! definition of the i- and j- direction local boundaries arrays 
     802         ! used for sending the boudaries 
     803         IF((com_east .eq. 1) .and. (com_west .eq. 1)) THEN 
     804            nbondi_bdy(ib_bdy) = 0 
     805         ELSEIF ((com_east .eq. 1) .and. (com_west .eq. 0)) THEN 
     806            nbondi_bdy(ib_bdy) = -1 
     807         ELSEIF ((com_east .eq. 0) .and. (com_west .eq. 1)) THEN 
     808            nbondi_bdy(ib_bdy) = 1 
     809         ENDIF 
     810 
     811         IF((com_north .eq. 1) .and. (com_south .eq. 1)) THEN 
     812            nbondj_bdy(ib_bdy) = 0 
     813         ELSEIF ((com_north .eq. 1) .and. (com_south .eq. 0)) THEN 
     814            nbondj_bdy(ib_bdy) = -1 
     815         ELSEIF ((com_north .eq. 0) .and. (com_south .eq. 1)) THEN 
     816            nbondj_bdy(ib_bdy) = 1 
     817         ENDIF 
     818 
     819         ! definition of the i- and j- direction local boundaries arrays 
     820         ! used for receiving the boudaries 
     821         IF((com_east_b .eq. 1) .and. (com_west_b .eq. 1)) THEN 
     822            nbondi_bdy_b(ib_bdy) = 0 
     823         ELSEIF ((com_east_b .eq. 1) .and. (com_west_b .eq. 0)) THEN 
     824            nbondi_bdy_b(ib_bdy) = -1 
     825         ELSEIF ((com_east_b .eq. 0) .and. (com_west_b .eq. 1)) THEN 
     826            nbondi_bdy_b(ib_bdy) = 1 
     827         ENDIF 
     828 
     829         IF((com_north_b .eq. 1) .and. (com_south_b .eq. 1)) THEN 
     830            nbondj_bdy_b(ib_bdy) = 0 
     831         ELSEIF ((com_north_b .eq. 1) .and. (com_south_b .eq. 0)) THEN 
     832            nbondj_bdy_b(ib_bdy) = -1 
     833         ELSEIF ((com_north_b .eq. 0) .and. (com_south_b .eq. 1)) THEN 
     834            nbondj_bdy_b(ib_bdy) = 1 
     835         ENDIF 
    606836 
    607837         ! Compute rim weights for FRS scheme 

  • branches/2012/dev_r3365_CMCC1_BDYOBCopt/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90

    r3294 r3592  
    77   !!            3.0  !  2008-04  (NEMO team)  add in the reference version 
    88   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge 
     9   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications 
    910   !!---------------------------------------------------------------------- 
    1011#if defined key_bdy 
    … …  
    3031   !!---------------------------------------------------------------------- 
    3132   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    32    !! $Id$  
     33   !! $Id: bdytra.F90 3294 2012-01-28 16:44:18Z rblod $  
    3334   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3435   !!---------------------------------------------------------------------- 
    … …  
    5253            CYCLE 
    5354         CASE(jp_frs) 
    54             CALL bdy_tra_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
     55            CALL bdy_tra_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    5556         CASE DEFAULT 
    5657            CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 
    … …  
    6061   END SUBROUTINE bdy_tra 
    6162 
    62    SUBROUTINE bdy_tra_frs( idx, dta, kt ) 
     63   SUBROUTINE bdy_tra_frs( idx, dta, kt, ib_bdy ) 
    6364      !!---------------------------------------------------------------------- 
    6465      !!                 ***  SUBROUTINE bdy_tra_frs  *** 
    … …  
    7172      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    7273      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
     74      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    7375      !!  
    7476      REAL(wp) ::   zwgt           ! boundary weight 
    … …  
    8991         END DO 
    9092      END DO  
    91       ! 
    92       CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )   ; CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )    ! Boundary points should be updated 
     93      CALL lbc_bdy_lnk( tsa(:,:,:,jp_tem), 'T', 1., ib_bdy )   ; CALL lbc_bdy_lnk( tsa(:,:,:,jp_sal), 'T', 1., ib_bdy )    ! Boundary points should be updated 
    9394      ! 
    9495      IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 

  • branches/2012/dev_r3365_CMCC1_BDYOBCopt/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r3294 r3592  
    88   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level 
    99   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
     10   !!            3.5  ! 2012     (S. Mocavero, I. Epicoco) Add arrays associated 
     11   !!                             to the optimization of BDY communications 
    1012   !!---------------------------------------------------------------------- 
    1113 
    … …  
    8183   INTEGER, PUBLIC ::   narea             !: number for local area 
    8284   INTEGER, PUBLIC ::   nbondi, nbondj    !: mark of i- and j-direction local boundaries 
     85   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy(:)    !: mark i-direction local boundaries for BDY open boundaries 
     86   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy(:)    !: mark j-direction local boundaries for BDY open boundaries 
     87   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy_b(:)  !: mark i-direction of neighbours local boundaries for BDY open boundaries   
     88   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy_b(:)  !: mark j-direction of neighbours local boundaries for BDY open boundaries   
     89 
    8390   INTEGER, PUBLIC ::   npolj             !: north fold mark (0, 3 or 4) 
    8491   INTEGER, PUBLIC ::   nlci, nldi, nlei  !: i-dimensions of the local subdomain and its first and last indoor indices 
    … …  
    237244   !!---------------------------------------------------------------------- 
    238245   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    239    !! $Id$  
     246   !! $Id: dom_oce.F90 3294 2012-01-28 16:44:18Z rblod $  
    240247   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    241248   !!---------------------------------------------------------------------- 

  • branches/2012/dev_r3365_CMCC1_BDYOBCopt/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r2442 r3592  
    77   !!   NEMO     1.0  ! 2002-09  (G. Madec)     F90: Free form and module 
    88   !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment   
     9   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco) Add 'lbc_bdy_lnk'  
     10   !!                            and lbc_obc_lnk' routine to optimize   
     11   !!                            the BDY/OBC communications 
    912   !!---------------------------------------------------------------------- 
    1013#if   defined key_mpp_mpi 
    … …  
    1417   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp 
    1518   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 
     19   !!   lbc_bdy_lnk  : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp 
     20   !!   lbc_obc_lnk  : generic interface for mpp_lnk_obc_2d and mpp_lnk_obc_3d routines defined in lib_mpp 
    1621   !!---------------------------------------------------------------------- 
    1722   USE lib_mpp          ! distributed memory computing library 
    … …  
    2126   END INTERFACE 
    2227 
     28   INTERFACE lbc_bdy_lnk 
     29      MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 
     30   END INTERFACE 
     31   INTERFACE lbc_obc_lnk 
     32      MODULE PROCEDURE mpp_lnk_obc_2d, mpp_lnk_obc_3d 
     33   END INTERFACE 
     34 
    2335   INTERFACE lbc_lnk_e 
    2436      MODULE PROCEDURE mpp_lnk_2d_e 
    … …  
    2739   PUBLIC lbc_lnk       ! ocean lateral boundary conditions 
    2840   PUBLIC lbc_lnk_e 
     41   PUBLIC lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 
     42   PUBLIC lbc_obc_lnk   ! ocean lateral BDY boundary conditions 
    2943 
    3044   !!---------------------------------------------------------------------- 
    3145   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    32    !! $Id$ 
     46   !! $Id: lbclnk.F90 2442 2010-11-27 18:05:38Z gm $ 
    3347   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3448   !!---------------------------------------------------------------------- 
    … …  
    4155   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable on ocean mesh 
    4256   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable on ocean mesh 
     57   !!   lbc_bdy_lnk  : set the lateral BDY boundary condition 
     58   !!   lbc_obc_lnk  : set the lateral OBC boundary condition 
    4359   !!---------------------------------------------------------------------- 
    4460   USE oce             ! ocean dynamics and tracers    
    … …  
    5874   END INTERFACE 
    5975 
     76   INTERFACE lbc_bdy_lnk 
     77      MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d 
     78   END INTERFACE 
     79   INTERFACE lbc_obc_lnk 
     80      MODULE PROCEDURE lbc_lnk_2d, lbc_lnk_3d 
     81   END INTERFACE 
     82 
    6083   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions 
    6184   PUBLIC   lbc_lnk_e  
     85   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 
     86   PUBLIC   lbc_obc_lnk   ! ocean lateral OBC boundary conditions 
    6287    
    6388   !!---------------------------------------------------------------------- 
    6489   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    65    !! $Id$ 
     90   !! $Id: lbclnk.F90 2442 2010-11-27 18:05:38Z gm $ 
    6691   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6792   !!---------------------------------------------------------------------- 
    … …  
    180205   END SUBROUTINE lbc_lnk_3d 
    181206 
     207   SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy ) 
     208      !!--------------------------------------------------------------------- 
     209      !!                  ***  ROUTINE lbc_bdy_lnk  *** 
     210      !! 
     211      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used 
     212      !!                to maintain the same interface with regards to the mpp case 
     213      !! 
     214      !!---------------------------------------------------------------------- 
     215      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
     216      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
     217      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign  
     218      INTEGER                                                   ::   ib_bdy    ! BDY boundary set 
     219      !! 
     220      CALL lbc_lnk_3d( pt3d, cd_type, psgn) 
     221 
     222   END SUBROUTINE lbc_bdy_lnk_3d 
     223 
     224   SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy ) 
     225      !!--------------------------------------------------------------------- 
     226      !!                  ***  ROUTINE lbc_bdy_lnk  *** 
     227      !! 
     228      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used 
     229      !!                to maintain the same interface with regards to the mpp case 
     230      !! 
     231      !!---------------------------------------------------------------------- 
     232      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
     233      REAL(wp), DIMENSION(jpi,jpj),     INTENT(inout)           ::   pt2d      ! 3D array on which the lbc is applied 
     234      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign  
     235      INTEGER                                                   ::   ib_bdy    ! BDY boundary set 
     236      !! 
     237      CALL lbc_lnk_2d( pt2d, cd_type, psgn) 
     238 
     239   END SUBROUTINE lbc_bdy_lnk_2d 
    182240 
    183241   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 

  • branches/2012/dev_r3365_CMCC1_BDYOBCopt/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r3294 r3592  
    1919   !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl  
    2020   !!            4.0  !  2011  (G. Madec)  move ctl_ routines from in_out_manager 
     21   !!            3.5  !  2012  (S.Mocavero, I. Epicoco) Add 'mpp_lnk_bdy_3d', 'mpp_lnk_obc_3d',  
     22   !!                          'mpp_lnk_bdy_2d' and 'mpp_lnk_obc_2d' routines and update 
     23   !!                          the mppobc routine to optimize the BDY and OBC communications 
    2124   !!---------------------------------------------------------------------- 
    2225 
    … …  
    6871   PUBLIC   mppsize 
    6972   PUBLIC   lib_mpp_alloc   ! Called in nemogcm.F90 
     73   PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 
     74   PUBLIC   mpp_lnk_obc_2d, mpp_lnk_obc_3d 
    7075 
    7176   !! * Interfaces 
    … …  
    186191   !!---------------------------------------------------------------------- 
    187192   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    188    !! $Id$ 
     193   !! $Id: lib_mpp.F90 3294 2012-01-28 16:44:18Z rblod $ 
    189194   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    190195   !!---------------------------------------------------------------------- 
    … …  
    361366   END FUNCTION mynode 
    362367 
    363  
    364    SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval ) 
    365       !!---------------------------------------------------------------------- 
    366       !!                  ***  routine mpp_lnk_3d  *** 
     368   SUBROUTINE mpp_lnk_obc_3d( ptab, cd_type, psgn ) 
     369      !!---------------------------------------------------------------------- 
     370      !!                  ***  routine mpp_lnk_obc_3d  *** 
    367371      !! 
    368372      !! ** Purpose :   Message passing manadgement 
    369373      !! 
    370       !! ** Method  :   Use mppsend and mpprecv function for passing mask  
     374      !! ** Method  :   Use mppsend and mpprecv function for passing OBC boundaries  
    371375      !!      between processors following neighboring subdomains. 
    372376      !!            domain parameters 
    … …  
    388392      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    389393      !                                                             ! =  1. , the sign is kept 
    390       CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only  
    391       REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    392394      !! 
    393395      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
    … …  
    398400      !!---------------------------------------------------------------------- 
    399401 
    400       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
    401       ELSE                         ;   zland = 0.e0      ! zero by default 
    402       ENDIF 
     402      zland = 0.e0      ! zero by default 
    403403 
    404404      ! 1. standard boundary treatment 
    405405      ! ------------------------------ 
    406       IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
    407          ! 
    408          ! WARNING ptab is defined only between nld and nle 
    409          DO jk = 1, jpk 
    410             DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    411                ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk)    
    412                ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk) 
    413                ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk) 
    414             END DO 
    415             DO ji = nlci+1, jpi                 ! added column(s) (full) 
    416                ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk) 
    417                ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk) 
    418                ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk) 
    419             END DO 
    420          END DO 
    421          ! 
    422       ELSE                              ! standard close or cyclic treatment  
    423          ! 
    424          !                                   ! East-West boundaries 
    425          !                                        !* Cyclic east-west 
    426          IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    427             ptab( 1 ,:,:) = ptab(jpim1,:,:) 
    428             ptab(jpi,:,:) = ptab(  2  ,:,:) 
    429          ELSE                                     !* closed 
    430             IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
    431                                          ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
    432          ENDIF 
    433          !                                   ! North-South boundaries (always closed) 
    434          IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point 
    435                                       ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north 
    436          ! 
     406      IF( nbondi == 2) THEN 
     407        IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN 
     408          ptab( 1 ,:,:) = ptab(jpim1,:,:) 
     409          ptab(jpi,:,:) = ptab(  2  ,:,:) 
     410        ELSE 
     411          IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
     412          ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
     413        ENDIF 
     414      ELSEIF(nbondi == -1) THEN 
     415        IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
     416      ELSEIF(nbondi == 1) THEN 
     417        ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
     418      ENDIF                                     !* closed 
     419 
     420      IF (nbondj == 2 .OR. nbondj == -1) THEN 
     421        IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point 
     422      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN 
     423        ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north 
    437424      ENDIF 
    438425 
    … …  
    441428      ! we play with the neigbours AND the row number because of the periodicity  
    442429      ! 
     430      IF(nbondj .ne. 0) THEN 
    443431      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    444432      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    … …  
    479467            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2) 
    480468         END DO 
    481       CASE ( 0 )  
     469      CASE ( 0 ) 
    482470         DO jl = 1, jpreci 
    483471            ptab(jl      ,:,:) = t3we(:,jl,:,2) 
    … …  
    489477         END DO 
    490478      END SELECT 
     479      ENDIF 
    491480 
    492481 
    … …  
    495484      ! always closed : we play only with the neigbours 
    496485      ! 
     486      IF(nbondi .ne. 0) THEN 
    497487      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    498488         ijhom = nlcj-nrecj 
    … …  
    532522            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2) 
    533523         END DO 
    534       CASE ( 0 )  
     524      CASE ( 0 ) 
    535525         DO jl = 1, jprecj 
    536526            ptab(:,jl      ,:) = t3sn(:,jl,:,2) 
    … …  
    542532         END DO 
    543533      END SELECT 
     534      ENDIF 
    544535 
    545536 
    … …  
    547538      ! ----------------------- 
    548539      ! 
    549       IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
     540      IF( npolj /= 0 ) THEN 
    550541         ! 
    551542         SELECT CASE ( jpni ) 
    … …  
    556547      ENDIF 
    557548      ! 
    558    END SUBROUTINE mpp_lnk_3d 
    559  
    560  
    561    SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
    562       !!---------------------------------------------------------------------- 
    563       !!                  ***  routine mpp_lnk_2d  *** 
     549   END SUBROUTINE mpp_lnk_obc_3d 
     550 
     551 
     552   SUBROUTINE mpp_lnk_obc_2d( pt2d, cd_type, psgn ) 
     553      !!---------------------------------------------------------------------- 
     554      !!                  ***  routine mpp_lnk_obc_2d  *** 
    564555      !!                   
    565556      !! ** Purpose :   Message passing manadgement for 2d array 
    566557      !! 
    567       !! ** Method  :   Use mppsend and mpprecv function for passing mask  
     558      !! ** Method  :   Use mppsend and mpprecv function for passing OBC boundaries  
    568559      !!      between processors following neighboring subdomains. 
    569560      !!            domain parameters 
    … …  
    583574      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    584575      !                                                         ! =  1. , the sign is kept 
    585       CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only  
    586       REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    587576      !! 
    588577      INTEGER  ::   ji, jj, jl   ! dummy loop indices 
    … …  
    593582      !!---------------------------------------------------------------------- 
    594583 
    595       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
    596       ELSE                         ;   zland = 0.e0      ! zero by default 
    597       ENDIF 
     584      zland = 0.e0      ! zero by default 
    598585 
    599586      ! 1. standard boundary treatment 
    600587      ! ------------------------------ 
    601588      ! 
    602       IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
    603          ! 
    604          ! WARNING pt2d is defined only between nld and nle 
    605          DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    606             pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej)    
    607             pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej) 
    608             pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej) 
    609          END DO 
    610          DO ji = nlci+1, jpi                 ! added column(s) (full) 
    611             pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej) 
    612             pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     ) 
    613             pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej) 
    614          END DO 
    615          ! 
    616       ELSE                              ! standard close or cyclic treatment  
    617          ! 
    618          !                                   ! East-West boundaries 
    619          IF( nbondi == 2 .AND.   &                ! Cyclic east-west 
    620             &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    621             pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west 
    622             pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east 
    623          ELSE                                     ! closed 
    624             IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point 
    625                                          pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north 
    626          ENDIF 
    627          !                                   ! North-South boundaries (always closed) 
    628             IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point 
    629                                          pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north 
    630          ! 
     589      IF( nbondi == 2) THEN 
     590        IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN 
     591          pt2d( 1 ,:) = pt2d(jpim1,:) 
     592          pt2d(jpi,:) = pt2d(  2  ,:) 
     593        ELSE 
     594          IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point 
     595          pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north 
     596        ENDIF 
     597      ELSEIF(nbondi == -1) THEN 
     598        IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point 
     599      ELSEIF(nbondi == 1) THEN 
     600        pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north 
     601      ENDIF                                     !* closed 
     602 
     603      IF (nbondj == 2 .OR. nbondj == -1) THEN 
     604        IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland       ! south except F-point 
     605      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN 
     606        pt2d(:,nlcj-jprecj+1:jpj) = zland       ! north 
    631607      ENDIF 
    632608 
    … …  
    741717      ! ----------------------- 
    742718      ! 
     719      IF( npolj /= 0 ) THEN 
     720         ! 
     721         SELECT CASE ( jpni ) 
     722         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp 
     723         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs. 
     724         END SELECT 
     725         ! 
     726      ENDIF 
     727      ! 
     728   END SUBROUTINE mpp_lnk_obc_2d 
     729 
     730   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval ) 
     731      !!---------------------------------------------------------------------- 
     732      !!                  ***  routine mpp_lnk_3d  *** 
     733      !! 
     734      !! ** Purpose :   Message passing manadgement 
     735      !! 
     736      !! ** Method  :   Use mppsend and mpprecv function for passing mask  
     737      !!      between processors following neighboring subdomains. 
     738      !!            domain parameters 
     739      !!                    nlci   : first dimension of the local subdomain 
     740      !!                    nlcj   : second dimension of the local subdomain 
     741      !!                    nbondi : mark for "east-west local boundary" 
     742      !!                    nbondj : mark for "north-south local boundary" 
     743      !!                    noea   : number for local neighboring processors  
     744      !!                    nowe   : number for local neighboring processors 
     745      !!                    noso   : number for local neighboring processors 
     746      !!                    nono   : number for local neighboring processors 
     747      !! 
     748      !! ** Action  :   ptab with update value at its periphery 
     749      !! 
     750      !!---------------------------------------------------------------------- 
     751      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied 
     752      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
     753      !                                                             ! = T , U , V , F , W points 
     754      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
     755      !                                                             ! =  1. , the sign is kept 
     756      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only  
     757      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
     758      !! 
     759      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
     760      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
     761      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
     762      REAL(wp) ::   zland 
     763      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
     764      !!---------------------------------------------------------------------- 
     765 
     766      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
     767      ELSE                         ;   zland = 0.e0      ! zero by default 
     768      ENDIF 
     769 
     770      ! 1. standard boundary treatment 
     771      ! ------------------------------ 
     772      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
     773         ! 
     774         ! WARNING ptab is defined only between nld and nle 
     775         DO jk = 1, jpk 
     776            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
     777               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk)    
     778               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk) 
     779               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk) 
     780            END DO 
     781            DO ji = nlci+1, jpi                 ! added column(s) (full) 
     782               ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk) 
     783               ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk) 
     784               ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk) 
     785            END DO 
     786         END DO 
     787         ! 
     788      ELSE                              ! standard close or cyclic treatment  
     789         ! 
     790         !                                   ! East-West boundaries 
     791         !                                        !* Cyclic east-west 
     792         IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
     793            ptab( 1 ,:,:) = ptab(jpim1,:,:) 
     794            ptab(jpi,:,:) = ptab(  2  ,:,:) 
     795         ELSE                                     !* closed 
     796            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
     797                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
     798         ENDIF 
     799         !                                   ! North-South boundaries (always closed) 
     800         IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point 
     801                                      ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north 
     802         ! 
     803      ENDIF 
     804 
     805      ! 2. East and west directions exchange 
     806      ! ------------------------------------ 
     807      ! we play with the neigbours AND the row number because of the periodicity  
     808      ! 
     809      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     810      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
     811         iihom = nlci-nreci 
     812         DO jl = 1, jpreci 
     813            t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 
     814            t3we(:,jl,:,1) = ptab(iihom +jl,:,:) 
     815         END DO 
     816      END SELECT   
     817      ! 
     818      !                           ! Migrations 
     819      imigr = jpreci * jpj * jpk 
     820      ! 
     821      SELECT CASE ( nbondi )  
     822      CASE ( -1 ) 
     823         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 ) 
     824         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea ) 
     825         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     826      CASE ( 0 ) 
     827         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
     828         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 ) 
     829         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea ) 
     830         CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe ) 
     831         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     832         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
     833      CASE ( 1 ) 
     834         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
     835         CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe ) 
     836         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     837      END SELECT 
     838      ! 
     839      !                           ! Write Dirichlet lateral conditions 
     840      iihom = nlci-jpreci 
     841      ! 
     842      SELECT CASE ( nbondi ) 
     843      CASE ( -1 ) 
     844         DO jl = 1, jpreci 
     845            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2) 
     846         END DO 
     847      CASE ( 0 )  
     848         DO jl = 1, jpreci 
     849            ptab(jl      ,:,:) = t3we(:,jl,:,2) 
     850            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2) 
     851         END DO 
     852      CASE ( 1 ) 
     853         DO jl = 1, jpreci 
     854            ptab(jl      ,:,:) = t3we(:,jl,:,2) 
     855         END DO 
     856      END SELECT 
     857 
     858 
     859      ! 3. North and south directions 
     860      ! ----------------------------- 
     861      ! always closed : we play only with the neigbours 
     862      ! 
     863      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
     864         ijhom = nlcj-nrecj 
     865         DO jl = 1, jprecj 
     866            t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 
     867            t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 
     868         END DO 
     869      ENDIF 
     870      ! 
     871      !                           ! Migrations 
     872      imigr = jprecj * jpi * jpk 
     873      ! 
     874      SELECT CASE ( nbondj )      
     875      CASE ( -1 ) 
     876         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 ) 
     877         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono ) 
     878         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     879      CASE ( 0 ) 
     880         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 ) 
     881         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 ) 
     882         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono ) 
     883         CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso ) 
     884         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     885         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
     886      CASE ( 1 )  
     887         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 ) 
     888         CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso ) 
     889         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     890      END SELECT 
     891      ! 
     892      !                           ! Write Dirichlet lateral conditions 
     893      ijhom = nlcj-jprecj 
     894      ! 
     895      SELECT CASE ( nbondj ) 
     896      CASE ( -1 ) 
     897         DO jl = 1, jprecj 
     898            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2) 
     899         END DO 
     900      CASE ( 0 )  
     901         DO jl = 1, jprecj 
     902            ptab(:,jl      ,:) = t3sn(:,jl,:,2) 
     903            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2) 
     904         END DO 
     905      CASE ( 1 ) 
     906         DO jl = 1, jprecj 
     907            ptab(:,jl,:) = t3sn(:,jl,:,2) 
     908         END DO 
     909      END SELECT 
     910 
     911 
     912      ! 4. north fold treatment 
     913      ! ----------------------- 
     914      ! 
     915      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
     916         ! 
     917         SELECT CASE ( jpni ) 
     918         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp 
     919         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs. 
     920         END SELECT 
     921         ! 
     922      ENDIF 
     923      ! 
     924   END SUBROUTINE mpp_lnk_3d 
     925 
     926 
     927   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
     928      !!---------------------------------------------------------------------- 
     929      !!                  ***  routine mpp_lnk_2d  *** 
     930      !!                   
     931      !! ** Purpose :   Message passing manadgement for 2d array 
     932      !! 
     933      !! ** Method  :   Use mppsend and mpprecv function for passing mask  
     934      !!      between processors following neighboring subdomains. 
     935      !!            domain parameters 
     936      !!                    nlci   : first dimension of the local subdomain 
     937      !!                    nlcj   : second dimension of the local subdomain 
     938      !!                    nbondi : mark for "east-west local boundary" 
     939      !!                    nbondj : mark for "north-south local boundary" 
     940      !!                    noea   : number for local neighboring processors  
     941      !!                    nowe   : number for local neighboring processors 
     942      !!                    noso   : number for local neighboring processors 
     943      !!                    nono   : number for local neighboring processors 
     944      !! 
     945      !!---------------------------------------------------------------------- 
     946      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied 
     947      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
     948      !                                                         ! = T , U , V , F , W and I points 
     949      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
     950      !                                                         ! =  1. , the sign is kept 
     951      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only  
     952      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
     953      !! 
     954      INTEGER  ::   ji, jj, jl   ! dummy loop indices 
     955      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
     956      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
     957      REAL(wp) ::   zland 
     958      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
     959      !!---------------------------------------------------------------------- 
     960 
     961      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
     962      ELSE                         ;   zland = 0.e0      ! zero by default 
     963      ENDIF 
     964 
     965      ! 1. standard boundary treatment 
     966      ! ------------------------------ 
     967      ! 
     968      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
     969         ! 
     970         ! WARNING pt2d is defined only between nld and nle 
     971         DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
     972            pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej)    
     973            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej) 
     974            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej) 
     975         END DO 
     976         DO ji = nlci+1, jpi                 ! added column(s) (full) 
     977            pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej) 
     978            pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     ) 
     979            pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej) 
     980         END DO 
     981         ! 
     982      ELSE                              ! standard close or cyclic treatment  
     983         ! 
     984         !                                   ! East-West boundaries 
     985         IF( nbondi == 2 .AND.   &                ! Cyclic east-west 
     986            &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
     987            pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west 
     988            pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east 
     989         ELSE                                     ! closed 
     990            IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point 
     991                                         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north 
     992         ENDIF 
     993         !                                   ! North-South boundaries (always closed) 
     994            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point 
     995                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north 
     996         ! 
     997      ENDIF 
     998 
     999      ! 2. East and west directions exchange 
     1000      ! ------------------------------------ 
     1001      ! we play with the neigbours AND the row number because of the periodicity  
     1002      ! 
     1003      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     1004      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
     1005         iihom = nlci-nreci 
     1006         DO jl = 1, jpreci 
     1007            t2ew(:,jl,1) = pt2d(jpreci+jl,:) 
     1008            t2we(:,jl,1) = pt2d(iihom +jl,:) 
     1009         END DO 
     1010      END SELECT 
     1011      ! 
     1012      !                           ! Migrations 
     1013      imigr = jpreci * jpj 
     1014      ! 
     1015      SELECT CASE ( nbondi ) 
     1016      CASE ( -1 ) 
     1017         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 ) 
     1018         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea ) 
     1019         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     1020      CASE ( 0 ) 
     1021         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 
     1022         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 ) 
     1023         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea ) 
     1024         CALL mpprecv( 2, t2we(1,1,2), imigr, nowe ) 
     1025         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     1026         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
     1027      CASE ( 1 ) 
     1028         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 
     1029         CALL mpprecv( 2, t2we(1,1,2), imigr, nowe ) 
     1030         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     1031      END SELECT 
     1032      ! 
     1033      !                           ! Write Dirichlet lateral conditions 
     1034      iihom = nlci - jpreci 
     1035      ! 
     1036      SELECT CASE ( nbondi ) 
     1037      CASE ( -1 ) 
     1038         DO jl = 1, jpreci 
     1039            pt2d(iihom+jl,:) = t2ew(:,jl,2) 
     1040         END DO 
     1041      CASE ( 0 ) 
     1042         DO jl = 1, jpreci 
     1043            pt2d(jl      ,:) = t2we(:,jl,2) 
     1044            pt2d(iihom+jl,:) = t2ew(:,jl,2) 
     1045         END DO 
     1046      CASE ( 1 ) 
     1047         DO jl = 1, jpreci 
     1048            pt2d(jl      ,:) = t2we(:,jl,2) 
     1049         END DO 
     1050      END SELECT 
     1051 
     1052 
     1053      ! 3. North and south directions 
     1054      ! ----------------------------- 
     1055      ! always closed : we play only with the neigbours 
     1056      ! 
     1057      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
     1058         ijhom = nlcj-nrecj 
     1059         DO jl = 1, jprecj 
     1060            t2sn(:,jl,1) = pt2d(:,ijhom +jl) 
     1061            t2ns(:,jl,1) = pt2d(:,jprecj+jl) 
     1062         END DO 
     1063      ENDIF 
     1064      ! 
     1065      !                           ! Migrations 
     1066      imigr = jprecj * jpi 
     1067      ! 
     1068      SELECT CASE ( nbondj ) 
     1069      CASE ( -1 ) 
     1070         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 ) 
     1071         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono ) 
     1072         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     1073      CASE ( 0 ) 
     1074         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 
     1075         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 ) 
     1076         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono ) 
     1077         CALL mpprecv( 4, t2sn(1,1,2), imigr, noso ) 
     1078         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     1079         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
     1080      CASE ( 1 ) 
     1081         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 
     1082         CALL mpprecv( 4, t2sn(1,1,2), imigr, noso ) 
     1083         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     1084      END SELECT 
     1085      ! 
     1086      !                           ! Write Dirichlet lateral conditions 
     1087      ijhom = nlcj - jprecj 
     1088      ! 
     1089      SELECT CASE ( nbondj ) 
     1090      CASE ( -1 ) 
     1091         DO jl = 1, jprecj 
     1092            pt2d(:,ijhom+jl) = t2ns(:,jl,2) 
     1093         END DO 
     1094      CASE ( 0 ) 
     1095         DO jl = 1, jprecj 
     1096            pt2d(:,jl      ) = t2sn(:,jl,2) 
     1097            pt2d(:,ijhom+jl) = t2ns(:,jl,2) 
     1098         END DO 
     1099      CASE ( 1 )  
     1100         DO jl = 1, jprecj 
     1101            pt2d(:,jl      ) = t2sn(:,jl,2) 
     1102         END DO 
     1103      END SELECT 
     1104 
     1105 
     1106      ! 4. north fold treatment 
     1107      ! ----------------------- 
     1108      ! 
    7431109      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
    7441110         ! 
    … …  
    17902156      INTEGER ::   ml_stat(MPI_STATUS_SIZE)    ! for key_mpi_isend 
    17912157      REAL(wp), POINTER, DIMENSION(:,:) ::   ztab   ! temporary workspace 
     2158      LOGICAL :: lmigr ! is true for those processors that have to migrate the OB 
    17922159      !!---------------------------------------------------------------------- 
    17932160 
    … …  
    18152182         CALL mppstop 
    18162183      ENDIF 
    1817        
     2184 
    18182185      ! Communication level by level 
    18192186      ! ---------------------------- 
    18202187!!gm Remark : this is very time consumming!!! 
    18212188      !                                         ! ------------------------ ! 
     2189            IF( ijpt0 > ijpt1 .OR. iipt0 > iipt1 ) THEN 
     2190            ! there is nothing to be migrated 
     2191               lmigr = .FALSE. 
     2192            ELSE 
     2193              lmigr = .TRUE. 
     2194            ENDIF 
     2195 
     2196      IF( lmigr ) THEN 
     2197 
    18222198      DO jk = 1, kk                             !   Loop over the levels   ! 
    18232199         !                                      ! ------------------------ ! 
    … …  
    18412217         ! --------------------------- 
    18422218         ! 
     2219       IF( ktype == 1 ) THEN 
     2220 
    18432221         IF( nbondi /= 2 ) THEN         ! Read Dirichlet lateral conditions 
    18442222            iihom = nlci-nreci 
    1845             DO jl = 1, jpreci 
    1846                t2ew(:,jl,1) = ztab(jpreci+jl,:) 
    1847                t2we(:,jl,1) = ztab(iihom +jl,:) 
    1848             END DO 
     2223            t2ew(1:jpreci,1,1) = ztab(jpreci+1:nreci, ijpt0) 
     2224            t2we(1:jpreci,1,1) = ztab(iihom+1:iihom+jpreci, ijpt0) 
    18492225         ENDIF 
    18502226         ! 
    18512227         !                              ! Migrations 
    1852          imigr=jpreci*jpj 
     2228         imigr = jpreci 
    18532229         ! 
    18542230         IF( nbondi == -1 ) THEN 
    … …  
    18732249         ! 
    18742250         IF( nbondi == 0 .OR. nbondi == 1 ) THEN 
    1875             DO jl = 1, jpreci 
    1876                ztab(jl,:) = t2we(:,jl,2) 
    1877             END DO 
     2251            ztab(1:jpreci, ijpt0) = t2we(1:jpreci,1,2) 
    18782252         ENDIF 
    18792253         IF( nbondi == -1 .OR. nbondi == 0 ) THEN 
    1880             DO jl = 1, jpreci 
    1881                ztab(iihom+jl,:) = t2ew(:,jl,2) 
    1882             END DO 
     2254            ztab(iihom+1:iihom+jpreci, ijpt0) = t2ew(1:jpreci,1,2) 
    18832255         ENDIF 
    1884  
     2256       ENDIF  ! (ktype == 1) 
    18852257 
    18862258         ! 2. North and south directions 
    18872259         ! ----------------------------- 
    18882260         ! 
     2261       IF(ktype == 2 ) THEN 
    18892262         IF( nbondj /= 2 ) THEN         ! Read Dirichlet lateral conditions 
    18902263            ijhom = nlcj-nrecj 
    1891             DO jl = 1, jprecj 
    1892                t2sn(:,jl,1) = ztab(:,ijhom +jl) 
    1893                t2ns(:,jl,1) = ztab(:,jprecj+jl) 
    1894             END DO 
     2264            t2sn(1:jprecj,1,1) = ztab(iipt0, ijhom+1:ijhom+jprecj) 
     2265            t2ns(1:jprecj,1,1) = ztab(iipt0, jprecj+1:nrecj) 
    18952266         ENDIF 
    18962267         ! 
    18972268         !                              ! Migrations 
    1898          imigr = jprecj * jpi 
     2269         imigr = jprecj 
    18992270         ! 
    19002271         IF( nbondj == -1 ) THEN 
    … …  
    19182289         ijhom = nlcj - jprecj 
    19192290         IF( nbondj == 0 .OR. nbondj == 1 ) THEN 
    1920             DO jl = 1, jprecj 
    1921                ztab(:,jl) = t2sn(:,jl,2) 
    1922             END DO 
     2291            ztab(iipt0,1:jprecj) = t2sn(1:jprecj,1,2) 
    19232292         ENDIF 
    19242293         IF( nbondj == 0 .OR. nbondj == -1 ) THEN 
    1925             DO jl = 1, jprecj 
    1926                ztab(:,ijhom+jl) = t2ns(:,jl,2) 
    1927             END DO 
     2294            ztab(iipt0, ijhom+1:ijhom+jprecj) = t2ns(1:jprecj,1,2) 
    19282295         ENDIF 
     2296         ENDIF    ! (ktype == 2) 
    19292297         IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN 
    19302298            DO jj = ijpt0, ijpt1            ! north/south boundaries 
    19312299               DO ji = iipt0,ilpt1 
    1932                   ptab(ji,jk) = ztab(ji,jj)   
     2300                  ptab(ji,jk) = ztab(ji,jj) 
    19332301               END DO 
    19342302            END DO 
    … …  
    19362304            DO jj = ijpt0, ilpt1            ! east/west boundaries 
    19372305               DO ji = iipt0,iipt1 
    1938                   ptab(jj,jk) = ztab(ji,jj)  
     2306                  ptab(jj,jk) = ztab(ji,jj) 
    19392307               END DO 
    19402308            END DO 
    … …  
    19432311      END DO 
    19442312      ! 
     2313      ENDIF ! ( lmigr ) 
    19452314      CALL wrk_dealloc( jpi,jpj, ztab ) 
    19462315      ! 
    … …  
    25392908   END SUBROUTINE mpp_lbc_north_e 
    25402909 
     2910      SUBROUTINE mpp_lnk_bdy_3d( ptab, cd_type, psgn, ib_bdy ) 
     2911      !!---------------------------------------------------------------------- 
     2912      !!                  ***  routine mpp_lnk_bdy_3d  *** 
     2913      !! 
     2914      !! ** Purpose :   Message passing management 
     2915      !! 
     2916      !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries  
     2917      !!      between processors following neighboring subdomains. 
     2918      !!            domain parameters 
     2919      !!                    nlci   : first dimension of the local subdomain 
     2920      !!                    nlcj   : second dimension of the local subdomain 
     2921      !!                    nbondi_bdy : mark for "east-west local boundary" 
     2922      !!                    nbondj_bdy : mark for "north-south local boundary" 
     2923      !!                    noea   : number for local neighboring processors  
     2924      !!                    nowe   : number for local neighboring processors 
     2925      !!                    noso   : number for local neighboring processors 
     2926      !!                    nono   : number for local neighboring processors 
     2927      !! 
     2928      !! ** Action  :   ptab with update value at its periphery 
     2929      !! 
     2930      !!---------------------------------------------------------------------- 
     2931 
     2932      USE lbcnfd          ! north fold 
     2933 
     2934      INCLUDE 'mpif.h' 
     2935 
     2936      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied 
     2937      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
     2938      !                                                             ! = T , U , V , F , W points 
     2939      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
     2940      !                                                             ! =  1. , the sign is kept 
     2941      INTEGER                         , INTENT(in   ) ::   ib_bdy   ! BDY boundary set 
     2942      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
     2943      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
     2944      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
     2945      REAL(wp) ::   zland 
     2946      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
     2947      !!---------------------------------------------------------------------- 
     2948 
     2949      zland = 0.e0 
     2950 
     2951      ! 1. standard boundary treatment 
     2952      ! ------------------------------ 
     2953       
     2954      !                                   ! East-West boundaries 
     2955      !                                        !* Cyclic east-west 
     2956 
     2957      IF( nbondi == 2) THEN 
     2958        IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN 
     2959          ptab( 1 ,:,:) = ptab(jpim1,:,:) 
     2960          ptab(jpi,:,:) = ptab(  2  ,:,:) 
     2961        ELSE 
     2962          IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
     2963          ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
     2964        ENDIF 
     2965      ELSEIF(nbondi == -1) THEN 
     2966        IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
     2967      ELSEIF(nbondi == 1) THEN 
     2968        ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
     2969      ENDIF                                     !* closed 
     2970 
     2971      IF (nbondj == 2 .OR. nbondj == -1) THEN 
     2972        IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point 
     2973      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN 
     2974        ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north 
     2975      ENDIF 
     2976       
     2977      ! 
     2978 
     2979      ! 2. East and west directions exchange 
     2980      ! ------------------------------------ 
     2981      ! we play with the neigbours AND the row number because of the periodicity  
     2982      ! 
     2983      SELECT CASE ( nbondi_bdy(ib_bdy) )      ! Read Dirichlet lateral conditions 
     2984      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
     2985         iihom = nlci-nreci 
     2986         DO jl = 1, jpreci 
     2987            t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 
     2988            t3we(:,jl,:,1) = ptab(iihom +jl,:,:) 
     2989         END DO 
     2990      END SELECT 
     2991      ! 
     2992      !                           ! Migrations 
     2993      imigr = jpreci * jpj * jpk 
     2994      ! 
     2995      SELECT CASE ( nbondi_bdy(ib_bdy) ) 
     2996      CASE ( -1 ) 
     2997         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 ) 
     2998      CASE ( 0 ) 
     2999         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
     3000         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 ) 
     3001      CASE ( 1 ) 
     3002         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
     3003      END SELECT 
     3004      ! 
     3005      SELECT CASE ( nbondi_bdy_b(ib_bdy) ) 
     3006      CASE ( -1 ) 
     3007         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea ) 
     3008      CASE ( 0 ) 
     3009         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea ) 
     3010         CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe ) 
     3011      CASE ( 1 ) 
     3012         CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe ) 
     3013      END SELECT 
     3014      ! 
     3015      SELECT CASE ( nbondi_bdy(ib_bdy) ) 
     3016      CASE ( -1 ) 
     3017         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     3018      CASE ( 0 ) 
     3019         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     3020         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
     3021      CASE ( 1 ) 
     3022         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     3023      END SELECT 
     3024      ! 
     3025      !                           ! Write Dirichlet lateral conditions 
     3026      iihom = nlci-jpreci 
     3027      ! 
     3028      SELECT CASE ( nbondi_bdy_b(ib_bdy) ) 
     3029      CASE ( -1 ) 
     3030         DO jl = 1, jpreci 
     3031            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2) 
     3032         END DO 
     3033      CASE ( 0 ) 
     3034         DO jl = 1, jpreci 
     3035            ptab(jl      ,:,:) = t3we(:,jl,:,2) 
     3036            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2) 
     3037         END DO 
     3038      CASE ( 1 ) 
     3039         DO jl = 1, jpreci 
     3040            ptab(jl      ,:,:) = t3we(:,jl,:,2) 
     3041         END DO 
     3042      END SELECT 
     3043 
     3044 
     3045      ! 3. North and south directions 
     3046      ! ----------------------------- 
     3047      ! always closed : we play only with the neigbours 
     3048      ! 
     3049      IF( nbondj_bdy(ib_bdy) /= 2 ) THEN      ! Read Dirichlet lateral conditions 
     3050         ijhom = nlcj-nrecj 
     3051         DO jl = 1, jprecj 
     3052            t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 
     3053            t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 
     3054         END DO 
     3055      ENDIF 
     3056      ! 
     3057      !                           ! Migrations 
     3058      imigr = jprecj * jpi * jpk 
     3059      ! 
     3060      SELECT CASE ( nbondj_bdy(ib_bdy) ) 
     3061      CASE ( -1 ) 
     3062         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 ) 
     3063      CASE ( 0 ) 
     3064         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 ) 
     3065         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 ) 
     3066      CASE ( 1 ) 
     3067         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 ) 
     3068      END SELECT 
     3069      ! 
     3070      SELECT CASE ( nbondj_bdy_b(ib_bdy) ) 
     3071      CASE ( -1 ) 
     3072         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono ) 
     3073      CASE ( 0 ) 
     3074         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono ) 
     3075         CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso ) 
     3076      CASE ( 1 ) 
     3077         CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso ) 
     3078      END SELECT 
     3079      ! 
     3080      SELECT CASE ( nbondj_bdy(ib_bdy) ) 
     3081      CASE ( -1 ) 
     3082         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     3083      CASE ( 0 ) 
     3084         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     3085         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
     3086      CASE ( 1 ) 
     3087         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     3088      END SELECT 
     3089      ! 
     3090      !                           ! Write Dirichlet lateral conditions 
     3091      ijhom = nlcj-jprecj 
     3092      ! 
     3093      SELECT CASE ( nbondj_bdy_b(ib_bdy) ) 
     3094      CASE ( -1 ) 
     3095         DO jl = 1, jprecj 
     3096            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2) 
     3097         END DO 
     3098      CASE ( 0 ) 
     3099         DO jl = 1, jprecj 
     3100            ptab(:,jl      ,:) = t3sn(:,jl,:,2) 
     3101            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2) 
     3102         END DO 
     3103      CASE ( 1 ) 
     3104         DO jl = 1, jprecj 
     3105            ptab(:,jl,:) = t3sn(:,jl,:,2) 
     3106         END DO 
     3107      END SELECT 
     3108 
     3109 
     3110      ! 4. north fold treatment 
     3111      ! ----------------------- 
     3112      ! 
     3113      IF( npolj /= 0) THEN 
     3114         ! 
     3115         SELECT CASE ( jpni ) 
     3116         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp 
     3117         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs. 
     3118         END SELECT 
     3119         ! 
     3120      ENDIF 
     3121      ! 
     3122   END SUBROUTINE mpp_lnk_bdy_3d 
     3123 
     3124      SUBROUTINE mpp_lnk_bdy_2d( ptab, cd_type, psgn, ib_bdy ) 
     3125      !!---------------------------------------------------------------------- 
     3126      !!                  ***  routine mpp_lnk_bdy_2d  *** 
     3127      !! 
     3128      !! ** Purpose :   Message passing management 
     3129      !! 
     3130      !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries  
     3131      !!      between processors following neighboring subdomains. 
     3132      !!            domain parameters 
     3133      !!                    nlci   : first dimension of the local subdomain 
     3134      !!                    nlcj   : second dimension of the local subdomain 
     3135      !!                    nbondi_bdy : mark for "east-west local boundary" 
     3136      !!                    nbondj_bdy : mark for "north-south local boundary" 
     3137      !!                    noea   : number for local neighboring processors  
     3138      !!                    nowe   : number for local neighboring processors 
     3139      !!                    noso   : number for local neighboring processors 
     3140      !!                    nono   : number for local neighboring processors 
     3141      !! 
     3142      !! ** Action  :   ptab with update value at its periphery 
     3143      !! 
     3144      !!---------------------------------------------------------------------- 
     3145 
     3146      USE lbcnfd          ! north fold 
     3147 
     3148      INCLUDE 'mpif.h' 
     3149 
     3150      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied 
     3151      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
     3152      !                                                             ! = T , U , V , F , W points 
     3153      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
     3154      !                                                             ! =  1. , the sign is kept 
     3155      INTEGER                         , INTENT(in   ) ::   ib_bdy   ! BDY boundary set 
     3156      INTEGER  ::   ji, jj, jl             ! dummy loop indices 
     3157      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
     3158      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
     3159      REAL(wp) ::   zland 
     3160      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
     3161      !!---------------------------------------------------------------------- 
     3162 
     3163      zland = 0.e0 
     3164 
     3165      ! 1. standard boundary treatment 
     3166      ! ------------------------------ 
     3167       
     3168      !                                   ! East-West boundaries 
     3169      !                                        !* Cyclic east-west 
     3170 
     3171      IF( nbondi == 2) THEN 
     3172        IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN 
     3173          ptab( 1 ,:) = ptab(jpim1,:) 
     3174          ptab(jpi,:) = ptab(  2  ,:) 
     3175        ELSE 
     3176          IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:) = zland    ! south except F-point 
     3177          ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north 
     3178        ENDIF 
     3179      ELSEIF(nbondi == -1) THEN 
     3180        IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:) = zland    ! south except F-point 
     3181      ELSEIF(nbondi == 1) THEN 
     3182        ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north 
     3183      ENDIF                                     !* closed 
     3184 
     3185      IF (nbondj == 2 .OR. nbondj == -1) THEN 
     3186        IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj) = zland       ! south except F-point 
     3187      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN 
     3188        ptab(:,nlcj-jprecj+1:jpj) = zland       ! north 
     3189      ENDIF 
     3190       
     3191      ! 
     3192 
     3193      ! 2. East and west directions exchange 
     3194      ! ------------------------------------ 
     3195      ! we play with the neigbours AND the row number because of the periodicity  
     3196      ! 
     3197      SELECT CASE ( nbondi_bdy(ib_bdy) )      ! Read Dirichlet lateral conditions 
     3198      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
     3199         iihom = nlci-nreci 
     3200         DO jl = 1, jpreci 
     3201            t2ew(:,jl,1) = ptab(jpreci+jl,:) 
     3202            t2we(:,jl,1) = ptab(iihom +jl,:) 
     3203         END DO 
     3204      END SELECT 
     3205      ! 
     3206      !                           ! Migrations 
     3207      imigr = jpreci * jpj 
     3208      ! 
     3209      SELECT CASE ( nbondi_bdy(ib_bdy) ) 
     3210      CASE ( -1 ) 
     3211         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 ) 
     3212      CASE ( 0 ) 
     3213         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 
     3214         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 ) 
     3215      CASE ( 1 ) 
     3216         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 
     3217      END SELECT 
     3218      ! 
     3219      SELECT CASE ( nbondi_bdy_b(ib_bdy) ) 
     3220      CASE ( -1 ) 
     3221         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea ) 
     3222      CASE ( 0 ) 
     3223         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea ) 
     3224         CALL mpprecv( 2, t2we(1,1,2), imigr, nowe ) 
     3225      CASE ( 1 ) 
     3226         CALL mpprecv( 2, t2we(1,1,2), imigr, nowe ) 
     3227      END SELECT 
     3228      ! 
     3229      SELECT CASE ( nbondi_bdy(ib_bdy) ) 
     3230      CASE ( -1 ) 
     3231         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     3232      CASE ( 0 ) 
     3233         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     3234         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
     3235      CASE ( 1 ) 
     3236         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     3237      END SELECT 
     3238      ! 
     3239      !                           ! Write Dirichlet lateral conditions 
     3240      iihom = nlci-jpreci 
     3241      ! 
     3242      SELECT CASE ( nbondi_bdy_b(ib_bdy) ) 
     3243      CASE ( -1 ) 
     3244         DO jl = 1, jpreci 
     3245            ptab(iihom+jl,:) = t2ew(:,jl,2) 
     3246         END DO 
     3247      CASE ( 0 ) 
     3248         DO jl = 1, jpreci 
     3249            ptab(jl      ,:) = t2we(:,jl,2) 
     3250            ptab(iihom+jl,:) = t2ew(:,jl,2) 
     3251         END DO 
     3252      CASE ( 1 ) 
     3253         DO jl = 1, jpreci 
     3254            ptab(jl      ,:) = t2we(:,jl,2) 
     3255         END DO 
     3256      END SELECT 
     3257 
     3258 
     3259      ! 3. North and south directions 
     3260      ! ----------------------------- 
     3261      ! always closed : we play only with the neigbours 
     3262      ! 
     3263      IF( nbondj_bdy(ib_bdy) /= 2 ) THEN      ! Read Dirichlet lateral conditions 
     3264         ijhom = nlcj-nrecj 
     3265         DO jl = 1, jprecj 
     3266            t2sn(:,jl,1) = ptab(:,ijhom +jl) 
     3267            t2ns(:,jl,1) = ptab(:,jprecj+jl) 
     3268         END DO 
     3269      ENDIF 
     3270      ! 
     3271      !                           ! Migrations 
     3272      imigr = jprecj * jpi 
     3273      ! 
     3274      SELECT CASE ( nbondj_bdy(ib_bdy) ) 
     3275      CASE ( -1 ) 
     3276         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 ) 
     3277      CASE ( 0 ) 
     3278         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 
     3279         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 ) 
     3280      CASE ( 1 ) 
     3281         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 
     3282      END SELECT 
     3283      ! 
     3284      SELECT CASE ( nbondj_bdy_b(ib_bdy) ) 
     3285      CASE ( -1 ) 
     3286         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono ) 
     3287      CASE ( 0 ) 
     3288         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono ) 
     3289         CALL mpprecv( 4, t2sn(1,1,2), imigr, noso ) 
     3290      CASE ( 1 ) 
     3291         CALL mpprecv( 4, t2sn(1,1,2), imigr, noso ) 
     3292      END SELECT 
     3293      ! 
     3294      SELECT CASE ( nbondj_bdy(ib_bdy) ) 
     3295      CASE ( -1 ) 
     3296         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     3297      CASE ( 0 ) 
     3298         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     3299         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
     3300      CASE ( 1 ) 
     3301         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     3302      END SELECT 
     3303      ! 
     3304      !                           ! Write Dirichlet lateral conditions 
     3305      ijhom = nlcj-jprecj 
     3306      ! 
     3307      SELECT CASE ( nbondj_bdy_b(ib_bdy) ) 
     3308      CASE ( -1 ) 
     3309         DO jl = 1, jprecj 
     3310            ptab(:,ijhom+jl) = t2ns(:,jl,2) 
     3311         END DO 
     3312      CASE ( 0 ) 
     3313         DO jl = 1, jprecj 
     3314            ptab(:,jl      ) = t2sn(:,jl,2) 
     3315            ptab(:,ijhom+jl) = t2ns(:,jl,2) 
     3316         END DO 
     3317      CASE ( 1 ) 
     3318         DO jl = 1, jprecj 
     3319            ptab(:,jl) = t2sn(:,jl,2) 
     3320         END DO 
     3321      END SELECT 
     3322 
     3323 
     3324      ! 4. north fold treatment 
     3325      ! ----------------------- 
     3326      ! 
     3327      IF( npolj /= 0) THEN 
     3328         ! 
     3329         SELECT CASE ( jpni ) 
     3330         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp 
     3331         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs. 
     3332         END SELECT 
     3333         ! 
     3334      ENDIF 
     3335      ! 
     3336   END SUBROUTINE mpp_lnk_bdy_2d 
    25413337 
    25423338   SUBROUTINE mpi_init_opa( ldtxt, ksft, code ) 

  • branches/2012/dev_r3365_CMCC1_BDYOBCopt/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn.F90

    r3294 r3592  
    55   !! Ocean dynamics:   Radiation of velocities on each open boundary 
    66   !!================================================================================= 
    7  
     7   !! History :  3.5  !  2012     (S. Mocavero, I. Epicoco) Updates for the  
     8   !!                             optimization of OBC communications 
    89   !!--------------------------------------------------------------------------------- 
    910   !!   obc_dyn        : call the subroutine for each open boundary 
    … …  
    105106      IF( lk_mpp ) THEN 
    106107         IF( kt >= nit000+3 .AND. ln_rstart ) THEN 
    107             CALL lbc_lnk( ub, 'U', -1. ) 
    108             CALL lbc_lnk( vb, 'V', -1. ) 
     108            CALL lbc_obc_lnk( ub, 'U', -1. ) 
     109            CALL lbc_obc_lnk( vb, 'V', -1. ) 
    109110         END IF 
    110          CALL lbc_lnk( ua, 'U', -1. ) 
    111          CALL lbc_lnk( va, 'V', -1. ) 
     111         CALL lbc_obc_lnk( ua, 'U', -1. ) 
     112         CALL lbc_obc_lnk( va, 'V', -1. ) 
    112113      ENDIF 
    113114 

  • branches/2012/dev_r3365_CMCC1_BDYOBCopt/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90

    r3294 r3592  
    55   !!====================================================================== 
    66   !! History :  1.0  ! 2005-12  (V. Garnier) original code 
     7   !!            3.5  ! 2012     (S. Mocavero, I. Epicoco) Updates for the  
     8   !!                             optimization of OBC communications 
    79   !!---------------------------------------------------------------------- 
    810#if ( defined key_dynspg_ts || defined key_dynspg_exp ) && defined key_obc 
    … …  
    6567      IF( lk_mpp ) THEN 
    6668         IF( kt >= nit000+3 .AND. ln_rstart ) THEN 
    67             CALL lbc_lnk( sshb, 'T',  1. ) 
    68             CALL lbc_lnk( ub  , 'U', -1. ) 
    69             CALL lbc_lnk( vb  , 'V', -1. ) 
     69            CALL lbc_obc_lnk( sshb, 'T',  1. ) 
     70            CALL lbc_obc_lnk( ub  , 'U', -1. ) 
     71            CALL lbc_obc_lnk( vb  , 'V', -1. ) 
    7072         END IF 
    71          CALL lbc_lnk( sshn, 'T',  1. ) 
    72          CALL lbc_lnk( ua  , 'U', -1. ) 
    73          CALL lbc_lnk( va  , 'V', -1. ) 
     73         CALL lbc_obc_lnk( sshn, 'T',  1. ) 
     74         CALL lbc_obc_lnk( ua  , 'U', -1. ) 
     75         CALL lbc_obc_lnk( va  , 'V', -1. ) 
    7476      ENDIF 
    7577 

  • branches/2012/dev_r3365_CMCC1_BDYOBCopt/NEMOGCM/NEMO/OPA_SRC/OBC/obctra.F90

    r3294 r3592  
    44   !! Ocean tracers:   Radiation of tracers on each open boundary 
    55   !!================================================================================= 
     6   !! History :  3.5  !  2012     (S. Mocavero, I. Epicoco) Updates for the  
     7   !!                             optimization of OBC communications 
    68#if defined key_obc 
    79   !!--------------------------------------------------------------------------------- 
    … …  
    101103      IF( lk_mpp ) THEN                  !!bug ??? 
    102104         IF( kt >= nit000+3 .AND. ln_rstart ) THEN 
    103             CALL lbc_lnk( tsb(:,:,:,jp_tem), 'T', 1. ) 
    104             CALL lbc_lnk( tsb(:,:,:,jp_sal), 'T', 1. ) 
     105            CALL lbc_obc_lnk( tsb(:,:,:,jp_tem), 'T', 1. ) 
     106            CALL lbc_obc_lnk( tsb(:,:,:,jp_sal), 'T', 1. ) 
    105107         END IF 
    106          CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) 
    107          CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 
     108         CALL lbc_obc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) 
     109         CALL lbc_obc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 
    108110      ENDIF 
    109111 
Note: See TracChangeset for help on using the changeset viewer.