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 11536 for NEMO/trunk/src/OCE/BDY – NEMO

Ignore:
Timestamp:
2019-09-11T15:54:18+02:00 (5 years ago)
Author:
smasson
Message:

trunk: merge dev_r10984_HPC-13 into the trunk

Location:
NEMO/trunk/src/OCE/BDY
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk/src/OCE/BDY/bdy_oce.F90

    r10934 r11536  
    2222      INTEGER ,          DIMENSION(jpbgrd) ::  nblen 
    2323      INTEGER ,          DIMENSION(jpbgrd) ::  nblenrim 
     24      INTEGER ,          DIMENSION(jpbgrd) ::  nblenrim0 
    2425      INTEGER , POINTER, DIMENSION(:,:)    ::  nbi 
    2526      INTEGER , POINTER, DIMENSION(:,:)    ::  nbj 
    2627      INTEGER , POINTER, DIMENSION(:,:)    ::  nbr 
    2728      INTEGER , POINTER, DIMENSION(:,:)    ::  nbmap 
     29      INTEGER , POINTER, DIMENSION(:,:)    ::  ntreat 
    2830      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbw 
    2931      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbd 
    … …  
    4042   TYPE, PUBLIC ::   OBC_DATA     !: Storage for external data 
    4143      INTEGER          , DIMENSION(2)   ::  nread 
    42       LOGICAL                           ::  ll_ssh 
    43       LOGICAL                           ::  ll_u2d 
    44       LOGICAL                           ::  ll_v2d 
    45       LOGICAL                           ::  ll_u3d 
    46       LOGICAL                           ::  ll_v3d 
    47       LOGICAL                           ::  ll_tem 
    48       LOGICAL                           ::  ll_sal 
    49       LOGICAL                           ::  ll_fvl 
     44      LOGICAL                           ::  lneed_ssh 
     45      LOGICAL                           ::  lneed_dyn2d 
     46      LOGICAL                           ::  lneed_dyn3d 
     47      LOGICAL                           ::  lneed_tra 
     48      LOGICAL                           ::  lneed_ice 
    5049      REAL(wp), POINTER, DIMENSION(:)   ::  ssh 
    5150      REAL(wp), POINTER, DIMENSION(:)   ::  u2d 
    … …  
    5554      REAL(wp), POINTER, DIMENSION(:,:) ::  tem 
    5655      REAL(wp), POINTER, DIMENSION(:,:) ::  sal 
    57 #if defined key_si3 
    58       LOGICAL                           ::   ll_a_i 
    59       LOGICAL                           ::   ll_h_i 
    60       LOGICAL                           ::   ll_h_s 
    61       REAL(wp), POINTER, DIMENSION(:,:) ::   a_i    !: now ice leads fraction climatology 
    62       REAL(wp), POINTER, DIMENSION(:,:) ::   h_i    !: Now ice  thickness climatology 
    63       REAL(wp), POINTER, DIMENSION(:,:) ::   h_s    !: now snow thickness 
    64 #endif 
     56      REAL(wp), POINTER, DIMENSION(:,:) ::  a_i    !: now ice leads fraction climatology 
     57      REAL(wp), POINTER, DIMENSION(:,:) ::  h_i    !: Now ice  thickness climatology 
     58      REAL(wp), POINTER, DIMENSION(:,:) ::  h_s    !: now snow thickness 
     59      REAL(wp), POINTER, DIMENSION(:,:) ::  t_i    !: now ice  temperature 
     60      REAL(wp), POINTER, DIMENSION(:,:) ::  t_s    !: now snow temperature 
     61      REAL(wp), POINTER, DIMENSION(:,:) ::  tsu    !: now surf temperature 
     62      REAL(wp), POINTER, DIMENSION(:,:) ::  s_i    !: now ice  salinity 
     63      REAL(wp), POINTER, DIMENSION(:,:) ::  aip    !: now ice  pond concentration 
     64      REAL(wp), POINTER, DIMENSION(:,:) ::  hip    !: now ice  pond depth 
    6565#if defined key_top 
    6666      CHARACTER(LEN=20)                   :: cn_obc  !: type of boundary condition to apply 
    … …  
    7474   !! Namelist variables 
    7575   !!---------------------------------------------------------------------- 
     76   !                                                   !!** nambdy ** 
    7677   LOGICAL, PUBLIC            ::   ln_bdy                   !: Unstructured Ocean Boundary Condition 
    7778 
    … …  
    8586   ! 
    8687   INTEGER                    ::   nb_bdy                   !: number of open boundary sets 
    87    INTEGER, DIMENSION(jp_bdy) ::   nb_jpk_bdy               !: number of levels in the bdy data (set < 0 if consistent with planned run) 
    8888   INTEGER, DIMENSION(jp_bdy) ::   nn_rimwidth              !: boundary rim width for Flow Relaxation Scheme 
    8989   INTEGER                    ::   nn_volctl                !: = 0 the total volume will have the variability of the surface Flux E-P  
    … …  
    108108   INTEGER , DIMENSION(jp_bdy)          ::   nn_ice_dta     !: = 0 use the initial state as bdy dta ;  
    109109                                                            !: = 1 read it in a NetCDF file 
    110    REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_tem              !: choice of the temperature of incoming sea ice 
    111    REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_sal              !: choice of the salinity    of incoming sea ice 
    112    REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_age              !: choice of the age         of incoming sea ice 
     110   !  
     111   !                                                   !!** nambdy_dta ** 
     112   REAL(wp), DIMENSION(jp_bdy) ::   rice_tem                !: temperature of incoming sea ice 
     113   REAL(wp), DIMENSION(jp_bdy) ::   rice_sal                !: salinity    of incoming sea ice 
     114   REAL(wp), DIMENSION(jp_bdy) ::   rice_age                !: age         of incoming sea ice 
     115   REAL(wp), DIMENSION(jp_bdy) ::   rice_apnd               !: pond conc.  of incoming sea ice 
     116   REAL(wp), DIMENSION(jp_bdy) ::   rice_hpnd               !: pond thick. of incoming sea ice 
    113117   ! 
    114     
    115118   !!---------------------------------------------------------------------- 
    116119   !! Global variables 
    … …  
    128131   INTEGER,  DIMENSION(jp_bdy)                     ::   nn_dta            !: =0 => *all* data is set to initial conditions 
    129132                                                                          !: =1 => some data to be read in from data files 
    130    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global        !: workspace for reading in global data arrays (unstr.  bdy) 
    131    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global_z      !: workspace for reading in global depth arrays (unstr.  bdy) 
    132    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global_dz     !: workspace for reading in global depth arrays (unstr.  bdy) 
    133    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2       !: workspace for reading in global data arrays (struct. bdy) 
    134    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2_z     !: workspace for reading in global depth arrays (struct. bdy) 
    135    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2_dz    !: workspace for reading in global depth arrays (struct. bdy) 
    136133!$AGRIF_DO_NOT_TREAT 
    137134   TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy           !: bdy indices (local process) 
    138135   TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET      ::   dta_bdy           !: bdy external data (local process) 
    139136!$AGRIF_END_DO_NOT_TREAT 
     137   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lsend_bdy      !: mark needed communication for given boundary, grid and neighbour 
     138   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lrecv_bdy      !:  when searching in any direction 
     139   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lsend_bdyint   !: mark needed communication for given boundary, grid and neighbour 
     140   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lrecv_bdyint   !:  when searching towards the interior of the computational domain 
     141   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lsend_bdyext   !: mark needed communication for given boundary, grid and neighbour 
     142   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lrecv_bdyext   !:  when searching towards the exterior of the computational domain 
    140143   !!---------------------------------------------------------------------- 
    141144   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 

  • NEMO/trunk/src/OCE/BDY/bdydta.F90

    r11229 r11536  
    4343   PUBLIC   bdy_dta_init     ! routine called by nemogcm.F90 
    4444 
    45    INTEGER, ALLOCATABLE, DIMENSION(:)   ::   nb_bdy_fld        ! Number of fields to update for each boundary set. 
    46    INTEGER                              ::   nb_bdy_fld_sum    ! Total number of fields to update for all boundary sets. 
    47    LOGICAL,           DIMENSION(jp_bdy) ::   ln_full_vel_array ! =T => full velocities in 3D boundary conditions 
    48                                                                ! =F => baroclinic velocities in 3D boundary conditions 
     45   INTEGER , PARAMETER ::   jpbdyfld  = 16    ! maximum number of files to read  
     46   INTEGER , PARAMETER ::   jp_bdyssh = 1     !  
     47   INTEGER , PARAMETER ::   jp_bdyu2d = 2     !  
     48   INTEGER , PARAMETER ::   jp_bdyv2d = 3     ! 
     49   INTEGER , PARAMETER ::   jp_bdyu3d = 4     ! 
     50   INTEGER , PARAMETER ::   jp_bdyv3d = 5     ! 
     51   INTEGER , PARAMETER ::   jp_bdytem = 6     !  
     52   INTEGER , PARAMETER ::   jp_bdysal = 7     !  
     53   INTEGER , PARAMETER ::   jp_bdya_i = 8     !  
     54   INTEGER , PARAMETER ::   jp_bdyh_i = 9     !  
     55   INTEGER , PARAMETER ::   jp_bdyh_s = 10    !  
     56   INTEGER , PARAMETER ::   jp_bdyt_i = 11    !  
     57   INTEGER , PARAMETER ::   jp_bdyt_s = 12    !  
     58   INTEGER , PARAMETER ::   jp_bdytsu = 13    !  
     59   INTEGER , PARAMETER ::   jp_bdys_i = 14    !  
     60   INTEGER , PARAMETER ::   jp_bdyaip = 15    !  
     61   INTEGER , PARAMETER ::   jp_bdyhip = 16    !  
     62#if ! defined key_si3 
     63   INTEGER , PARAMETER ::   jpl = 1 
     64#endif 
     65 
    4966!$AGRIF_DO_NOT_TREAT 
    50    TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET ::   bf        ! structure of input fields (file informations, fields read) 
     67   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET ::   bf   ! structure of input fields (file informations, fields read) 
    5168!$AGRIF_END_DO_NOT_TREAT 
    52    TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr   ! array of pointers to nbmap 
    53  
    54 #if defined key_si3 
    55    INTEGER ::   nice_cat                      ! number of categories in the input file 
    56    INTEGER ::   jfld_hti, jfld_hts, jfld_ai   ! indices of ice thickness, snow thickness and concentration in bf structure 
    57    INTEGER, DIMENSION(jp_bdy) :: jfld_htit, jfld_htst, jfld_ait 
    58 #endif 
    5969 
    6070   !!---------------------------------------------------------------------- 
    … …  
    6575CONTAINS 
    6676 
    67       SUBROUTINE bdy_dta( kt, jit, time_offset ) 
     77   SUBROUTINE bdy_dta( kt, kit, kt_offset ) 
    6878      !!---------------------------------------------------------------------- 
    6979      !!                   ***  SUBROUTINE bdy_dta  *** 
    … …  
    7585      !!---------------------------------------------------------------------- 
    7686      INTEGER, INTENT(in)           ::   kt           ! ocean time-step index  
    77       INTEGER, INTENT(in), OPTIONAL ::   jit          ! subcycle time-step index (for timesplitting option) 
    78       INTEGER, INTENT(in), OPTIONAL ::   time_offset  ! time offset in units of timesteps. NB. if jit 
     87      INTEGER, INTENT(in), OPTIONAL ::   kit          ! subcycle time-step index (for timesplitting option) 
     88      INTEGER, INTENT(in), OPTIONAL ::   kt_offset    ! time offset in units of timesteps. NB. if kit 
    7989      !                                               ! is present then units = subcycle timesteps. 
    80       !                                               ! time_offset = 0 => get data at "now" time level 
    81       !                                               ! time_offset = -1 => get data at "before" time level 
    82       !                                               ! time_offset = +1 => get data at "after" time level 
     90      !                                               ! kt_offset = 0 => get data at "now" time level 
     91      !                                               ! kt_offset = -1 => get data at "before" time level 
     92      !                                               ! kt_offset = +1 => get data at "after" time level 
    8393      !                                               ! etc. 
    8494      ! 
    85       INTEGER ::  jbdy, jfld, jstart, jend, ib, jl  ! dummy loop indices 
    86       INTEGER ::  ii, ij, ik, igrd                  ! local integers 
    87       INTEGER,          DIMENSION(jpbgrd) ::   ilen1  
    88       INTEGER, POINTER, DIMENSION(:)      ::   nblen, nblenrim  ! short cuts 
    89       TYPE(OBC_DATA), POINTER             ::   dta              ! short cut 
     95      INTEGER ::  jbdy, jfld, jstart, jend, ib, jl    ! dummy loop indices 
     96      INTEGER ::  ii, ij, ik, igrd, ipl               ! local integers 
     97      INTEGER,   DIMENSION(jpbgrd)     ::   ilen1  
     98      INTEGER,   DIMENSION(:), POINTER ::   nblen, nblenrim  ! short cuts 
     99      TYPE(OBC_DATA)         , POINTER ::   dta_alias        ! short cut 
     100      TYPE(FLD), DIMENSION(:), POINTER ::   bf_alias 
    90101      !!--------------------------------------------------------------------------- 
    91102      ! 
    … …  
    94105      ! Initialise data arrays once for all from initial conditions where required 
    95106      !--------------------------------------------------------------------------- 
    96       IF( kt == nit000 .AND. .NOT.PRESENT(jit) ) THEN 
     107      IF( kt == nit000 .AND. .NOT.PRESENT(kit) ) THEN 
    97108 
    98109         ! Calculate depth-mean currents 
    99110         !----------------------------- 
    100           
     111 
    101112         DO jbdy = 1, nb_bdy 
    102113            ! 
    103114            nblen    => idx_bdy(jbdy)%nblen 
    104115            nblenrim => idx_bdy(jbdy)%nblenrim 
    105             dta      => dta_bdy(jbdy) 
    106116            ! 
    107117            IF( nn_dyn2d_dta(jbdy) == 0 ) THEN  
    108118               ilen1(:) = nblen(:) 
    109                IF( dta%ll_ssh ) THEN  
     119               IF( dta_bdy(jbdy)%lneed_ssh ) THEN  
    110120                  igrd = 1 
    111121                  DO ib = 1, ilen1(igrd) 
    … …  
    113123                     ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    114124                     dta_bdy(jbdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)          
    115                   END DO  
    116                ENDIF 
    117                IF( dta%ll_u2d ) THEN  
     125                  END DO 
     126               ENDIF 
     127               IF( dta_bdy(jbdy)%lneed_dyn2d) THEN  
    118128                  igrd = 2 
    119129                  DO ib = 1, ilen1(igrd) 
    … …  
    121131                     ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    122132                     dta_bdy(jbdy)%u2d(ib) = un_b(ii,ij) * umask(ii,ij,1)          
    123                   END DO  
    124                ENDIF 
    125                IF( dta%ll_v2d ) THEN  
     133                  END DO 
    126134                  igrd = 3 
    127135                  DO ib = 1, ilen1(igrd) 
    … …  
    129137                     ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    130138                     dta_bdy(jbdy)%v2d(ib) = vn_b(ii,ij) * vmask(ii,ij,1)          
    131                   END DO  
     139                  END DO 
    132140               ENDIF 
    133141            ENDIF 
    … …  
    135143            IF( nn_dyn3d_dta(jbdy) == 0 ) THEN  
    136144               ilen1(:) = nblen(:) 
    137                IF( dta%ll_u3d ) THEN  
     145               IF( dta_bdy(jbdy)%lneed_dyn3d ) THEN  
    138146                  igrd = 2  
    139147                  DO ib = 1, ilen1(igrd) 
    … …  
    143151                        dta_bdy(jbdy)%u3d(ib,ik) =  ( un(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik)          
    144152                     END DO 
    145                   END DO  
    146                ENDIF 
    147                IF( dta%ll_v3d ) THEN  
     153                  END DO 
    148154                  igrd = 3  
    149155                  DO ib = 1, ilen1(igrd) 
    … …  
    152158                        ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    153159                        dta_bdy(jbdy)%v3d(ib,ik) =  ( vn(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik)          
    154                         END DO 
    155                   END DO  
     160                     END DO 
     161                  END DO 
    156162               ENDIF 
    157163            ENDIF 
    … …  
    159165            IF( nn_tra_dta(jbdy) == 0 ) THEN  
    160166               ilen1(:) = nblen(:) 
    161                IF( dta%ll_tem ) THEN 
     167               IF( dta_bdy(jbdy)%lneed_tra ) THEN 
    162168                  igrd = 1  
    163169                  DO ib = 1, ilen1(igrd) 
    … …  
    165171                        ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    166172                        ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    167                         dta_bdy(jbdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik)          
     173                        dta_bdy(jbdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_bdytem) * tmask(ii,ij,ik)          
     174                        dta_bdy(jbdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_bdysal) * tmask(ii,ij,ik)          
    168175                     END DO 
    169                   END DO  
    170                ENDIF 
    171                IF( dta%ll_sal ) THEN 
    172                   igrd = 1  
    173                   DO ib = 1, ilen1(igrd) 
    174                      DO ik = 1, jpkm1 
    175                         ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    176                         ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    177                         dta_bdy(jbdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)          
    178                      END DO 
    179                   END DO  
     176                  END DO 
    180177               ENDIF 
    181178            ENDIF 
    … …  
    184181            IF( nn_ice_dta(jbdy) == 0 ) THEN    ! set ice to initial values 
    185182               ilen1(:) = nblen(:) 
    186                IF( dta%ll_a_i ) THEN 
     183               IF( dta_bdy(jbdy)%lneed_ice ) THEN 
    187184                  igrd = 1    
    188185                  DO jl = 1, jpl 
    … …  
    190187                        ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    191188                        ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    192                         dta_bdy(jbdy)%a_i (ib,jl) =  a_i(ii,ij,jl) * tmask(ii,ij,1)  
    193                      END DO 
    194                   END DO 
    195                ENDIF 
    196                IF( dta%ll_h_i ) THEN 
    197                   igrd = 1    
    198                   DO jl = 1, jpl 
    199                      DO ib = 1, ilen1(igrd) 
    200                         ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    201                         ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    202                         dta_bdy(jbdy)%h_i (ib,jl) =  h_i(ii,ij,jl) * tmask(ii,ij,1)  
    203                      END DO 
    204                   END DO 
    205                ENDIF 
    206                IF( dta%ll_h_s ) THEN 
    207                   igrd = 1    
    208                   DO jl = 1, jpl 
    209                      DO ib = 1, ilen1(igrd) 
    210                         ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    211                         ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    212                         dta_bdy(jbdy)%h_s (ib,jl) =  h_s(ii,ij,jl) * tmask(ii,ij,1)  
     189                        dta_bdy(jbdy)%a_i(ib,jl) =  a_i (ii,ij,jl) * tmask(ii,ij,1)  
     190                        dta_bdy(jbdy)%h_i(ib,jl) =  h_i (ii,ij,jl) * tmask(ii,ij,1)  
     191                        dta_bdy(jbdy)%h_s(ib,jl) =  h_s (ii,ij,jl) * tmask(ii,ij,1)  
     192                        dta_bdy(jbdy)%t_i(ib,jl) =  SUM(t_i (ii,ij,:,jl)) * r1_nlay_i * tmask(ii,ij,1)  
     193                        dta_bdy(jbdy)%t_s(ib,jl) =  SUM(t_s (ii,ij,:,jl)) * r1_nlay_s * tmask(ii,ij,1) 
     194                        dta_bdy(jbdy)%tsu(ib,jl) =  t_su(ii,ij,jl) * tmask(ii,ij,1)  
     195                        dta_bdy(jbdy)%s_i(ib,jl) =  s_i (ii,ij,jl) * tmask(ii,ij,1) 
     196                        ! melt ponds 
     197                        dta_bdy(jbdy)%aip(ib,jl) =  a_ip(ii,ij,jl) * tmask(ii,ij,1)  
     198                        dta_bdy(jbdy)%hip(ib,jl) =  h_ip(ii,ij,jl) * tmask(ii,ij,1)  
    213199                     END DO 
    214200                  END DO 
    … …  
    222208      ! update external data from files 
    223209      !-------------------------------- 
    224       
    225       jstart = 1 
    226       DO jbdy = 1, nb_bdy    
    227          dta => dta_bdy(jbdy) 
    228          IF( nn_dta(jbdy) == 1 ) THEN ! skip this bit if no external data required 
    229        
    230             IF( PRESENT(jit) ) THEN 
    231                ! Update barotropic boundary conditions only 
    232                ! jit is optional argument for fld_read and bdytide_update 
    233                IF( cn_dyn2d(jbdy) /= 'none' ) THEN 
    234                   IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
    235                      IF( dta%ll_ssh ) dta%ssh(:) = 0._wp 
    236                      IF( dta%ll_u2d ) dta%u2d(:) = 0._wp 
    237                      IF( dta%ll_u3d ) dta%v2d(:) = 0._wp 
    238                   ENDIF 
    239                   IF (cn_tra(jbdy) /= 'runoff') THEN 
    240                      IF( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 ) THEN 
    241  
    242                         jend = jstart + dta%nread(2) - 1 
    243                         IF( ln_full_vel_array(jbdy) ) THEN 
    244                            CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend),  & 
    245                                      & kit=jit, kt_offset=time_offset , jpk_bdy=nb_jpk_bdy(jbdy),   & 
    246                                      & fvl=ln_full_vel_array(jbdy)  ) 
    247                         ELSE 
    248                            CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend),  & 
    249                                      & kit=jit, kt_offset=time_offset  ) 
    250                         ENDIF 
    251  
    252                         ! If full velocities in boundary data then extract barotropic velocities from 3D fields 
    253                         IF( ln_full_vel_array(jbdy) .AND.                                             & 
    254                           &    ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 .OR.  & 
    255                           &      nn_dyn3d_dta(jbdy) == 1 ) )THEN 
    256  
    257                            igrd = 2                      ! zonal velocity 
    258                            dta%u2d(:) = 0._wp 
    259                            DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    260                               ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    261                               ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
    262                               DO ik = 1, jpkm1 
    263                                  dta%u2d(ib) = dta%u2d(ib) & 
    264                        &                          + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
    265                               END DO 
    266                               dta%u2d(ib) =  dta%u2d(ib) * r1_hu_n(ii,ij) 
    267                            END DO 
    268                            igrd = 3                      ! meridional velocity 
    269                            dta%v2d(:) = 0._wp 
    270                            DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    271                               ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    272                               ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
    273                               DO ik = 1, jpkm1 
    274                                  dta%v2d(ib) = dta%v2d(ib) & 
    275                        &                       + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
    276                               END DO 
    277                               dta%v2d(ib) =  dta%v2d(ib) * r1_hv_n(ii,ij) 
    278                            END DO 
    279                         ENDIF                     
    280                      ENDIF 
    281                      IF( nn_dyn2d_dta(jbdy) .ge. 2 ) THEN ! update tidal harmonic forcing 
    282                         CALL bdytide_update( kt=kt, idx=idx_bdy(jbdy), dta=dta, td=tides(jbdy),   &  
    283                           &                 jit=jit, time_offset=time_offset ) 
    284                      ENDIF 
    285                   ENDIF 
    286                ENDIF 
    287             ELSE 
    288                IF (cn_tra(jbdy) == 'runoff') then      ! runoff condition 
    289                   jend = nb_bdy_fld(jbdy) 
    290                   CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend),  & 
    291                                & map=nbmap_ptr(jstart:jend), kt_offset=time_offset ) 
    292                   ! 
    293                   igrd = 2                      ! zonal velocity 
    294                   DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    295                      ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    296                      ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
    297                      dta%u2d(ib) = dta%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 
    298                   END DO 
    299                   ! 
    300                   igrd = 3                      ! meridional velocity 
    301                   DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    302                      ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    303                      ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
    304                      dta%v2d(ib) = dta%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 
    305                   END DO 
    306                ELSE 
    307                   IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
    308                      IF( dta%ll_ssh ) dta%ssh(:) = 0._wp 
    309                      IF( dta%ll_u2d ) dta%u2d(:) = 0._wp 
    310                      IF( dta%ll_v2d ) dta%v2d(:) = 0._wp 
    311                   ENDIF 
    312                   IF( dta%nread(1) .gt. 0 ) THEN ! update external data 
    313                      jend = jstart + dta%nread(1) - 1 
    314                      CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 
    315                                   & map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy(jbdy),   & 
    316                                   & fvl=ln_full_vel_array(jbdy) ) 
    317                   ENDIF 
    318                   ! If full velocities in boundary data then split into barotropic and baroclinic data 
    319                   IF( ln_full_vel_array(jbdy) .and.                                             & 
    320                     & ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 .OR. & 
    321                     &   nn_dyn3d_dta(jbdy) == 1 ) ) THEN 
    322                      igrd = 2                      ! zonal velocity 
    323                      dta%u2d(:) = 0._wp 
    324                      DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    325                         ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    326                         ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
    327                         DO ik = 1, jpkm1 
    328                            dta%u2d(ib) = dta%u2d(ib) & 
    329                  &                       + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
    330                         END DO 
    331                         dta%u2d(ib) =  dta%u2d(ib) * r1_hu_n(ii,ij) 
    332                         DO ik = 1, jpkm1 
    333                            dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib) 
    334                         END DO 
    335                      END DO 
    336                      igrd = 3                      ! meridional velocity 
    337                      dta%v2d(:) = 0._wp 
    338                      DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    339                         ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    340                         ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
    341                         DO ik = 1, jpkm1 
    342                            dta%v2d(ib) = dta%v2d(ib) & 
    343                  &                       + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
    344                         END DO 
    345                         dta%v2d(ib) =  dta%v2d(ib) * r1_hv_n(ii,ij) 
    346                         DO ik = 1, jpkm1 
    347                            dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib) 
    348                         END DO 
    349                      END DO 
    350                   ENDIF 
    351  
    352                ENDIF 
     210 
     211      DO jbdy = 1, nb_bdy 
     212 
     213         dta_alias => dta_bdy(jbdy) 
     214         bf_alias  => bf(:,jbdy) 
     215 
     216         ! read/update all bdy data 
     217         ! ------------------------ 
     218         CALL fld_read( kt, 1, bf_alias, kit = kit, kt_offset = kt_offset ) 
     219 
     220         ! apply some corrections in some specific cases... 
     221         ! -------------------------------------------------- 
     222         ! 
     223         ! if runoff condition: change river flow we read (in m3/s) into barotropic velocity (m/s) 
     224         IF( cn_tra(jbdy) == 'runoff' .AND. TRIM(bf_alias(jp_bdyu2d)%clrootname) /= 'NOT USED' ) THEN   ! runoff and we read u/v2d 
     225            ! 
     226            igrd = 2                      ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 
     227            DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
     228               ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
     229               ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
     230               dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 
     231            END DO 
     232            igrd = 3                      ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 
     233            DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
     234               ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
     235               ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
     236               dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 
     237            END DO 
     238         ENDIF 
     239 
     240         ! tidal harmonic forcing ONLY: initialise arrays 
     241         IF( nn_dyn2d_dta(jbdy) == 2 ) THEN   ! we did not read ssh, u/v2d  
     242            IF( dta_alias%lneed_ssh   ) dta_alias%ssh(:) = 0._wp 
     243            IF( dta_alias%lneed_dyn2d ) dta_alias%u2d(:) = 0._wp 
     244            IF( dta_alias%lneed_dyn2d ) dta_alias%v2d(:) = 0._wp 
     245         ENDIF 
     246 
     247         ! If full velocities in boundary data, then split it into barotropic and baroclinic component 
     248         IF( bf_alias(jp_bdyu3d)%ltotvel ) THEN     ! if we read 3D total velocity (can be true only if u3d was read) 
     249            ! 
     250            igrd = 2                       ! zonal velocity 
     251            dta_alias%u2d(:) = 0._wp       ! compute barotrope zonal velocity and put it in u2d 
     252            DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
     253               ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
     254               ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
     255               DO ik = 1, jpkm1 
     256                  dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 
     257               END DO 
     258               dta_alias%u2d(ib) =  dta_alias%u2d(ib) * r1_hu_n(ii,ij) 
     259               DO ik = 1, jpkm1            ! compute barocline zonal velocity and put it in u3d 
     260                  dta_alias%u3d(ib,ik) = dta_alias%u3d(ib,ik) - dta_alias%u2d(ib) 
     261               END DO 
     262            END DO 
     263            igrd = 3                       ! meridional velocity 
     264            dta_alias%v2d(:) = 0._wp       ! compute barotrope meridional velocity and put it in v2d 
     265            DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
     266               ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
     267               ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
     268               DO ik = 1, jpkm1 
     269                  dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 
     270               END DO 
     271               dta_alias%v2d(ib) =  dta_alias%v2d(ib) * r1_hv_n(ii,ij) 
     272               DO ik = 1, jpkm1            ! compute barocline meridional velocity and put it in v3d 
     273                  dta_alias%v3d(ib,ik) = dta_alias%v3d(ib,ik) - dta_alias%v2d(ib) 
     274               END DO 
     275            END DO 
     276         ENDIF   ! ltotvel 
     277 
     278         ! update tidal harmonic forcing 
     279         IF( PRESENT(kit) .AND. nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 
     280            CALL bdytide_update( kt = kt, idx = idx_bdy(jbdy), dta = dta_alias, td = tides(jbdy),   &  
     281               &                 kit = kit, kt_offset = kt_offset ) 
     282         ENDIF 
     283 
     284         !  atm surface pressure : add inverted barometer effect to ssh if it was read 
     285         IF ( ln_apr_obc .AND. TRIM(bf_alias(jp_bdyssh)%clrootname) /= 'NOT USED' ) THEN 
     286            igrd = 1 
     287            DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd)   ! ssh is used only on the rim 
     288               ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
     289               ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
     290               dta_alias%ssh(ib) = dta_alias%ssh(ib) + ssh_ib(ii,ij) 
     291            END DO 
     292         ENDIF 
     293 
    353294#if defined key_si3 
    354                ! convert N-cat fields (input) into jpl-cat (output) 
    355                IF( cn_ice(jbdy) /= 'none' .AND. nn_ice_dta(jbdy) == 1 ) THEN 
    356                   jfld_hti = jfld_htit(jbdy) 
    357                   jfld_hts = jfld_htst(jbdy) 
    358                   jfld_ai  = jfld_ait(jbdy) 
    359                   CALL ice_var_itd( bf(jfld_hti)%fnow(:,1,:), bf(jfld_hts)%fnow(:,1,:), bf(jfld_ai)%fnow(:,1,:), & 
    360                      &              dta_bdy(jbdy)%h_i       , dta_bdy(jbdy)%h_s       , dta_bdy(jbdy)%a_i      ) 
    361                ENDIF 
     295         IF( dta_alias%lneed_ice ) THEN 
     296            ! fill temperature and salinity arrays 
     297            IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyt_i)%fnow(:,1,:) = rice_tem (jbdy) 
     298            IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyt_s)%fnow(:,1,:) = rice_tem (jbdy) 
     299            IF( TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' )   bf_alias(jp_bdytsu)%fnow(:,1,:) = rice_tem (jbdy) 
     300            IF( TRIM(bf_alias(jp_bdys_i)%clrootname) == 'NOT USED' )   bf_alias(jp_bdys_i)%fnow(:,1,:) = rice_sal (jbdy) 
     301            IF( TRIM(bf_alias(jp_bdyaip)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyaip)%fnow(:,1,:) = rice_apnd(jbdy) * & ! rice_apnd is the pond fraction 
     302               &                                                                         bf_alias(jp_bdya_i)%fnow(:,1,:)     !   ( a_ip = rice_apnd * a_i ) 
     303            IF( TRIM(bf_alias(jp_bdyhip)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyhip)%fnow(:,1,:) = rice_hpnd(jbdy) 
     304            ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2 
     305            IF( TRIM(bf_alias(jp_bdytsu)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) & 
     306               &   bf_alias(jp_bdyt_i)%fnow(:,1,:) = 0.5_wp * ( bf_alias(jp_bdytsu)%fnow(:,1,:) + 271.15 ) 
     307            ! if T_su is read and not T_s, set T_s = T_su 
     308            IF( TRIM(bf_alias(jp_bdytsu)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_s)%clrootname) == 'NOT USED' ) & 
     309               &   bf_alias(jp_bdyt_s)%fnow(:,1,:) = bf_alias(jp_bdytsu)%fnow(:,1,:) 
     310            ! if T_s is read and not T_su, set T_su = T_s 
     311            IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) & 
     312               &   bf_alias(jp_bdytsu)%fnow(:,1,:) = bf_alias(jp_bdyt_s)%fnow(:,1,:) 
     313            ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2 
     314            IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) & 
     315               &   bf_alias(jp_bdyt_i)%fnow(:,1,:) = 0.5_wp * ( bf_alias(jp_bdyt_s)%fnow(:,1,:) + 271.15 ) 
     316 
     317            ! make sure ponds = 0 if no ponds scheme 
     318            IF ( .NOT.ln_pnd ) THEN 
     319               bf_alias(jp_bdyaip)%fnow(:,1,:) = 0._wp 
     320               bf_alias(jp_bdyhip)%fnow(:,1,:) = 0._wp 
     321            ENDIF 
     322             
     323            ! convert N-cat fields (input) into jpl-cat (output) 
     324            ipl = SIZE(bf_alias(jp_bdya_i)%fnow, 3)             
     325            IF( ipl /= jpl ) THEN      ! ice: convert N-cat fields (input) into jpl-cat (output) 
     326               CALL ice_var_itd( bf_alias(jp_bdyh_i)%fnow(:,1,:), bf_alias(jp_bdyh_s)%fnow(:,1,:), bf_alias(jp_bdya_i)%fnow(:,1,:), & 
     327                  &              dta_alias%h_i                  , dta_alias%h_s                  , dta_alias%a_i                  , & 
     328                  &              bf_alias(jp_bdyt_i)%fnow(:,1,:), bf_alias(jp_bdyt_s)%fnow(:,1,:), & 
     329                  &              bf_alias(jp_bdytsu)%fnow(:,1,:), bf_alias(jp_bdys_i)%fnow(:,1,:), & 
     330                  &              bf_alias(jp_bdyaip)%fnow(:,1,:), bf_alias(jp_bdyhip)%fnow(:,1,:), & 
     331                  &              dta_alias%t_i                  , dta_alias%t_s                  , & 
     332                  &              dta_alias%tsu                  , dta_alias%s_i                  , & 
     333                  &              dta_alias%aip                  , dta_alias%hip ) 
     334            ENDIF 
     335         ENDIF 
    362336#endif 
    363             ENDIF 
    364             jstart = jstart + dta%nread(1) 
    365          ENDIF    ! nn_dta(jbdy) = 1 
    366337      END DO  ! jbdy 
    367  
    368       IF ( ln_apr_obc ) THEN 
    369          DO jbdy = 1, nb_bdy 
    370             IF (cn_tra(jbdy) /= 'runoff')THEN 
    371                igrd = 1                      ! meridional velocity 
    372                DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd) 
    373                   ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    374                   ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
    375                   dta_bdy(jbdy)%ssh(ib) = dta_bdy(jbdy)%ssh(ib) + ssh_ib(ii,ij) 
    376                END DO 
    377             ENDIF 
    378          END DO 
    379       ENDIF 
    380338 
    381339      IF ( ln_tide ) THEN 
    382340         IF (ln_dynspg_ts) THEN      ! Fill temporary arrays with slow-varying bdy data                            
    383             DO jbdy = 1, nb_bdy    ! Tidal component added in ts loop 
    384                IF ( nn_dyn2d_dta(jbdy) .ge. 2 ) THEN 
     341            DO jbdy = 1, nb_bdy      ! Tidal component added in ts loop 
     342               IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 
    385343                  nblen => idx_bdy(jbdy)%nblen 
    386344                  nblenrim => idx_bdy(jbdy)%nblenrim 
    387                   IF( cn_dyn2d(jbdy) == 'frs' ) THEN; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF  
    388                   IF ( dta_bdy(jbdy)%ll_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 
    389                   IF ( dta_bdy(jbdy)%ll_u2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 
    390                   IF ( dta_bdy(jbdy)%ll_v2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 
    391                ENDIF 
    392             END DO 
    393          ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 
    394             ! 
    395             CALL bdy_dta_tides( kt=kt, time_offset=time_offset ) 
    396          ENDIF 
    397       ENDIF 
    398  
    399       ! 
    400       IF( ln_timing )   CALL timing_stop('bdy_dta') 
    401       ! 
    402    END SUBROUTINE bdy_dta 
     345                  IF( cn_dyn2d(jbdy) == 'frs' ) THEN ; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF  
     346                     IF ( dta_bdy(jbdy)%lneed_ssh   ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 
     347                     IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 
     348                     IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 
     349                  ENDIF 
     350               END DO 
     351            ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 
     352               ! 
     353               CALL bdy_dta_tides( kt=kt, kt_offset=kt_offset ) 
     354            ENDIF 
     355         ENDIF 
     356         ! 
     357         IF( ln_timing )   CALL timing_stop('bdy_dta') 
     358         ! 
     359      END SUBROUTINE bdy_dta 
    403360 
    404361 
    … …  
    413370      !!                 
    414371      !!---------------------------------------------------------------------- 
    415       INTEGER ::   jbdy, jfld, jstart, jend, ierror, ios     ! Local integers 
     372      INTEGER ::   jbdy, jfld    ! Local integers 
     373      INTEGER ::   ierror, ios     !  
    416374      ! 
     375      CHARACTER(len=3)                       ::   cl3           !  
    417376      CHARACTER(len=100)                     ::   cn_dir        ! Root directory for location of data files 
    418       CHARACTER(len=100), DIMENSION(nb_bdy)  ::   cn_dir_array  ! Root directory for location of data files 
    419       CHARACTER(len = 256)::   clname                           ! temporary file name 
    420377      LOGICAL                                ::   ln_full_vel   ! =T => full velocities in 3D boundary data 
    421378      !                                                         ! =F => baroclinic velocities in 3D boundary data 
    422       INTEGER                                ::   ilen_global   ! Max length required for global bdy dta arrays 
    423       INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ilen1, ilen3  ! size of 1st and 3rd dimensions of local arrays 
    424       INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ibdy           ! bdy set for a particular jfld 
    425       INTEGER, ALLOCATABLE, DIMENSION(:)     ::   igrid         ! index for grid type (1,2,3 = T,U,V) 
    426       INTEGER, POINTER, DIMENSION(:)         ::   nblen, nblenrim  ! short cuts 
    427       TYPE(OBC_DATA), POINTER                ::   dta           ! short cut 
    428 #if defined key_si3 
    429       INTEGER               ::   kndims   ! number of dimensions in an array (i.e. 3 = wo ice cat; 4 = w ice cat) 
    430       INTEGER, DIMENSION(4) ::   kdimsz   ! size   of dimensions 
    431       INTEGER               ::   inum,id1 ! local integer 
    432 #endif 
    433       TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   blf_i         !  array of namelist information structures 
    434       TYPE(FLD_N) ::   bn_tem, bn_sal, bn_u3d, bn_v3d   !  
    435       TYPE(FLD_N) ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read 
    436 #if defined key_si3 
    437       TYPE(FLD_N) ::   bn_a_i, bn_h_i, bn_h_s       
    438 #endif 
     379      LOGICAL                                ::   ln_zinterp    ! =T => requires a vertical interpolation of the bdydta 
     380      REAL(wp)                               ::   rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd  
     381      INTEGER                                ::   ipk,ipl       ! 
     382      INTEGER                                ::   idvar         ! variable ID 
     383      INTEGER                                ::   indims        ! number of dimensions of the variable 
     384      INTEGER                                ::   iszdim        ! number of dimensions of the variable 
     385      INTEGER, DIMENSION(4)                  ::   i4dimsz       ! size of variable dimensions  
     386      INTEGER                                ::   igrd          ! index for grid type (1,2,3 = T,U,V) 
     387      LOGICAL                                ::   lluld         ! is the variable using the unlimited dimension 
     388      LOGICAL                                ::   llneed        ! 
     389      LOGICAL                                ::   llread        ! 
     390      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_tem, bn_sal, bn_u3d, bn_v3d   ! must be an array to be used with fld_fill 
     391      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read 
     392      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip        
     393      TYPE(FLD_N), DIMENSION(:), POINTER ::   bn_alias                        ! must be an array to be used with fld_fill 
     394      TYPE(FLD  ), DIMENSION(:), POINTER ::   bf_alias 
     395      ! 
    439396      NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d  
    440 #if defined key_si3 
    441       NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s 
    442 #endif 
    443       NAMELIST/nambdy_dta/ ln_full_vel 
     397      NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip 
     398      NAMELIST/nambdy_dta/ rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd 
     399      NAMELIST/nambdy_dta/ ln_full_vel, ln_zinterp 
    444400      !!--------------------------------------------------------------------------- 
    445401      ! 
    … …  
    449405      IF(lwp) WRITE(numout,*) '' 
    450406 
    451       ! Set nn_dta 
    452       DO jbdy = 1, nb_bdy 
    453          nn_dta(jbdy) = MAX(   nn_dyn2d_dta  (jbdy)    & 
    454             &                , nn_dyn3d_dta  (jbdy)    & 
    455             &                , nn_tra_dta    (jbdy)    & 
    456 #if defined key_si3 
    457             &                , nn_ice_dta    (jbdy)    & 
    458 #endif 
    459                               ) 
    460          IF(nn_dta(jbdy) > 1)   nn_dta(jbdy) = 1 
    461       END DO 
    462  
    463       ! Work out upper bound of how many fields there are to read in and allocate arrays 
    464       ! --------------------------------------------------------------------------- 
    465       ALLOCATE( nb_bdy_fld(nb_bdy) ) 
    466       nb_bdy_fld(:) = 0 
    467       DO jbdy = 1, nb_bdy          
    468          IF( cn_dyn2d(jbdy) /= 'none' .AND. ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) ) THEN 
    469             nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 3 
    470          ENDIF 
    471          IF( cn_dyn3d(jbdy) /= 'none' .AND. nn_dyn3d_dta(jbdy) == 1 ) THEN 
    472             nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 2 
    473          ENDIF 
    474          IF( cn_tra(jbdy) /= 'none' .AND. nn_tra_dta(jbdy) == 1  ) THEN 
    475             nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 2 
    476          ENDIF 
    477 #if defined key_si3 
    478          IF( cn_ice(jbdy) /= 'none' .AND. nn_ice_dta(jbdy) == 1  ) THEN 
    479             nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 3 
    480          ENDIF 
    481 #endif                
    482          IF(lwp) WRITE(numout,*) 'Maximum number of files to open =', nb_bdy_fld(jbdy) 
    483       END DO             
    484  
    485       nb_bdy_fld_sum = SUM( nb_bdy_fld ) 
    486  
    487       ALLOCATE( bf(nb_bdy_fld_sum), STAT=ierror ) 
     407      ALLOCATE( bf(jpbdyfld,nb_bdy), STAT=ierror ) 
    488408      IF( ierror > 0 ) THEN    
    489409         CALL ctl_stop( 'bdy_dta: unable to allocate bf structure' )   ;   RETURN   
    490410      ENDIF 
    491       ALLOCATE( blf_i(nb_bdy_fld_sum), STAT=ierror ) 
    492       IF( ierror > 0 ) THEN    
    493          CALL ctl_stop( 'bdy_dta: unable to allocate blf_i structure' )   ;   RETURN   
    494       ENDIF 
    495       ALLOCATE( nbmap_ptr(nb_bdy_fld_sum), STAT=ierror ) 
    496       IF( ierror > 0 ) THEN    
    497          CALL ctl_stop( 'bdy_dta: unable to allocate nbmap_ptr structure' )   ;   RETURN   
    498       ENDIF 
    499       ALLOCATE( ilen1(nb_bdy_fld_sum), ilen3(nb_bdy_fld_sum) )  
    500       ALLOCATE( ibdy(nb_bdy_fld_sum) )  
    501       ALLOCATE( igrid(nb_bdy_fld_sum) )  
    502  
     411      bf(:,:)%clrootname = 'NOT USED'   ! default definition used as a flag in fld_read to do nothing. 
     412      bf(:,:)%lzint      = .FALSE.      ! default definition 
     413      bf(:,:)%ltotvel    = .FALSE.      ! default definition 
     414  
    503415      ! Read namelists 
    504416      ! -------------- 
    505417      REWIND(numnam_cfg) 
    506       jfld = 0  
    507       DO jbdy = 1, nb_bdy          
    508          IF( nn_dta(jbdy) == 1 ) THEN 
    509             REWIND(numnam_ref) 
    510             READ  ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 
    511 901         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp ) 
     418      DO jbdy = 1, nb_bdy 
     419 
     420         WRITE(ctmp1, '(a,i2)') 'BDY number ', jbdy 
     421         WRITE(ctmp2, '(a,i2)') 'block nambdy_dta number ', jbdy 
     422 
     423         ! There is only one nambdy_dta block in namelist_ref -> use it for each bdy so we do a rewind  
     424         REWIND(numnam_ref) 
     425         READ  ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 
     426901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in reference namelist' ) 
     427 
     428         !   by-pass nambdy_dta reading if no input data used in this bdy    
     429         IF(       ( dta_bdy(jbdy)%lneed_dyn2d .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 )   & 
     430            & .OR. ( dta_bdy(jbdy)%lneed_dyn3d .AND.     nn_dyn3d_dta(jbdy)    == 1 )   & 
     431            & .OR. ( dta_bdy(jbdy)%lneed_tra   .AND.       nn_tra_dta(jbdy)    == 1 )   & 
     432            & .OR. ( dta_bdy(jbdy)%lneed_ice   .AND.       nn_ice_dta(jbdy)    == 1 )   )   THEN 
     433            ! WARNING: we don't do a rewind here, each bdy reads its own nambdy_dta block one after another 
    512434            READ  ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 ) 
    513 902         IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp ) 
    514             IF(lwm) WRITE( numond, nambdy_dta ) 
    515  
    516             cn_dir_array(jbdy) = cn_dir 
    517             ln_full_vel_array(jbdy) = ln_full_vel 
    518  
    519             nblen => idx_bdy(jbdy)%nblen 
    520             nblenrim => idx_bdy(jbdy)%nblenrim 
    521             dta => dta_bdy(jbdy) 
    522             dta%nread(2) = 0 
    523  
    524             ! Only read in necessary fields for this set. 
    525             ! Important that barotropic variables come first. 
    526             IF( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) THEN  
    527  
    528                IF( dta%ll_ssh ) THEN  
    529                   if(lwp) write(numout,*) '++++++ reading in ssh field' 
    530                   jfld = jfld + 1 
    531                   blf_i(jfld) = bn_ssh 
    532                   ibdy(jfld) = jbdy 
    533                   igrid(jfld) = 1 
    534                   ilen1(jfld) = nblen(igrid(jfld)) 
    535                   ilen3(jfld) = 1 
    536                   dta%nread(2) = dta%nread(2) + 1 
    537                ENDIF 
    538  
    539                IF( dta%ll_u2d .and. .not. ln_full_vel_array(jbdy) ) THEN 
    540                   if(lwp) write(numout,*) '++++++ reading in u2d field' 
    541                   jfld = jfld + 1 
    542                   blf_i(jfld) = bn_u2d 
    543                   ibdy(jfld) = jbdy 
    544                   igrid(jfld) = 2 
    545                   ilen1(jfld) = nblen(igrid(jfld)) 
    546                   ilen3(jfld) = 1 
    547                   dta%nread(2) = dta%nread(2) + 1 
    548                ENDIF 
    549  
    550                IF( dta%ll_v2d .and. .not. ln_full_vel_array(jbdy) ) THEN 
    551                   if(lwp) write(numout,*) '++++++ reading in v2d field' 
    552                   jfld = jfld + 1 
    553                   blf_i(jfld) = bn_v2d 
    554                   ibdy(jfld) = jbdy 
    555                   igrid(jfld) = 3 
    556                   ilen1(jfld) = nblen(igrid(jfld)) 
    557                   ilen3(jfld) = 1 
    558                   dta%nread(2) = dta%nread(2) + 1 
    559                ENDIF 
    560  
    561             ENDIF 
    562  
    563             ! read 3D velocities if baroclinic velocities require OR if 
    564             ! barotropic velocities required and ln_full_vel set to .true. 
    565             IF( nn_dyn3d_dta(jbdy) == 1 .OR. & 
    566            &  ( ln_full_vel_array(jbdy) .AND. ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 ) ) ) THEN 
    567  
    568                IF( dta%ll_u3d .OR. ( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) ) THEN 
    569                   if(lwp) write(numout,*) '++++++ reading in u3d field' 
    570                   jfld = jfld + 1 
    571                   blf_i(jfld) = bn_u3d 
    572                   ibdy(jfld) = jbdy 
    573                   igrid(jfld) = 2 
    574                   ilen1(jfld) = nblen(igrid(jfld)) 
    575                   ilen3(jfld) = jpk 
    576                   IF( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) dta%nread(2) = dta%nread(2) + 1 
    577                ENDIF 
    578  
    579                IF( dta%ll_v3d .OR. ( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) ) THEN 
    580                   if(lwp) write(numout,*) '++++++ reading in v3d field' 
    581                   jfld = jfld + 1 
    582                   blf_i(jfld) = bn_v3d 
    583                   ibdy(jfld) = jbdy 
    584                   igrid(jfld) = 3 
    585                   ilen1(jfld) = nblen(igrid(jfld)) 
    586                   ilen3(jfld) = jpk 
    587                   IF( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) dta%nread(2) = dta%nread(2) + 1 
    588                ENDIF 
    589  
    590             ENDIF 
    591  
    592             ! temperature and salinity 
    593             IF( nn_tra_dta(jbdy) == 1 ) THEN 
    594  
    595                IF( dta%ll_tem ) THEN 
    596                   if(lwp) write(numout,*) '++++++ reading in tem field' 
    597                   jfld = jfld + 1 
    598                   blf_i(jfld) = bn_tem 
    599                   ibdy(jfld) = jbdy 
    600                   igrid(jfld) = 1 
    601                   ilen1(jfld) = nblen(igrid(jfld)) 
    602                   ilen3(jfld) = jpk 
    603                ENDIF 
    604  
    605                IF( dta%ll_sal ) THEN 
    606                   if(lwp) write(numout,*) '++++++ reading in sal field' 
    607                   jfld = jfld + 1 
    608                   blf_i(jfld) = bn_sal 
    609                   ibdy(jfld) = jbdy 
    610                   igrid(jfld) = 1 
    611                   ilen1(jfld) = nblen(igrid(jfld)) 
    612                   ilen3(jfld) = jpk 
    613                ENDIF 
    614  
    615             ENDIF 
     435902         IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist' ) 
     436            IF(lwm) WRITE( numond, nambdy_dta )            
     437         ENDIF 
     438 
     439         ! get the number of ice categories in bdy data file (use a_i information to do this) 
     440         ipl = jpl   ! default definition 
     441         IF( dta_bdy(jbdy)%lneed_ice ) THEN    ! if we need ice bdy data 
     442            IF( nn_ice_dta(jbdy) == 1 ) THEN   ! if we get ice bdy data from netcdf file 
     443               CALL fld_fill(  bf(jp_bdya_i,jbdy:jbdy), bn_a_i, cn_dir, 'bdy_dta', 'a_i'//' '//ctmp1, ctmp2 )   ! use namelist info 
     444               CALL fld_clopn( bf(jp_bdya_i,jbdy), nyear, nmonth, nday )   ! not a problem when we call it again after 
     445               idvar = iom_varid( bf(jp_bdya_i,jbdy)%num, bf(jp_bdya_i,jbdy)%clvar, kndims=indims, kdimsz=i4dimsz, lduld=lluld ) 
     446               IF( indims == 4 .OR. ( indims == 3 .AND. .NOT. lluld ) ) THEN   ;   ipl = i4dimsz(3)   ! xylt or xyl 
     447               ELSE                                                            ;   ipl = 1            ! xy or xyt 
     448               ENDIF 
     449            ENDIF 
     450         ENDIF 
    616451 
    617452#if defined key_si3 
    618             ! sea ice 
    619             IF( nn_ice_dta(jbdy) == 1 ) THEN 
    620                ! Test for types of ice input (1cat or Xcat)  
    621                ! Build file name to find dimensions  
    622                clname=TRIM( cn_dir )//TRIM(bn_a_i%clname) 
    623                IF( .NOT. bn_a_i%ln_clim ) THEN    
    624                                                   WRITE(clname, '(a,"_y",i4.4)' ) TRIM( clname ), nyear    ! add year 
    625                   IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname ), nmonth   ! add month 
    626                ELSE 
    627                   IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( clname ), nmonth   ! add month 
    628                ENDIF 
    629                IF( bn_a_i%cltype == 'daily' .OR. bn_a_i%cltype(1:4) == 'week' ) & 
    630                &                                  WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname ), nday     ! add day 
     453         IF( .NOT.ln_pnd ) THEN 
     454            rn_ice_apnd = 0. ; rn_ice_hpnd = 0. 
     455            CALL ctl_warn( 'rn_ice_apnd & rn_ice_hpnd = 0 when no ponds' ) 
     456         ENDIF 
     457#endif 
     458 
     459         ! temp, salt, age and ponds of incoming ice 
     460         rice_tem (jbdy) = rn_ice_tem 
     461         rice_sal (jbdy) = rn_ice_sal 
     462         rice_age (jbdy) = rn_ice_age 
     463         rice_apnd(jbdy) = rn_ice_apnd 
     464         rice_hpnd(jbdy) = rn_ice_hpnd 
     465          
     466          
     467         DO jfld = 1, jpbdyfld 
     468 
     469            ! ===================== 
     470            !          ssh  
     471            ! ===================== 
     472            IF( jfld == jp_bdyssh ) THEN 
     473               cl3 = 'ssh' 
     474               igrd = 1                                                    ! T point 
     475               ipk = 1                                                     ! surface data 
     476               llneed = dta_bdy(jbdy)%lneed_ssh                            ! dta_bdy(jbdy)%ssh will be needed 
     477               llread = MOD(nn_dyn2d_dta(jbdy),2) == 1                     ! get data from NetCDF file 
     478               bf_alias => bf(jp_bdyssh,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy 
     479               bn_alias => bn_ssh                                          ! alias for ssh structure of nambdy_dta  
     480               iszdim = idx_bdy(jbdy)%nblenrim(igrd)                       ! length of this bdy on this MPI processus : used only on the rim 
     481            ENDIF 
     482            ! ===================== 
     483            !         dyn2d 
     484            ! ===================== 
     485            IF( jfld == jp_bdyu2d ) THEN 
     486               cl3 = 'u2d' 
     487               igrd = 2                                                    ! U point 
     488               ipk = 1                                                     ! surface data 
     489               llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%ssh will be needed 
     490               llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1   ! don't get u2d from u3d and read NetCDF file 
     491               bf_alias => bf(jp_bdyu2d,jbdy:jbdy)                         ! alias for u2d structure of bdy number jbdy 
     492               bn_alias => bn_u2d                                          ! alias for u2d structure of nambdy_dta 
     493               IF( ln_full_vel ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd)      ! will be computed from u3d -> need on the full bdy 
     494               ELSE                    ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd)   ! used only on the rim 
     495               ENDIF 
     496            ENDIF 
     497            IF( jfld == jp_bdyv2d ) THEN 
     498               cl3 = 'v2d' 
     499               igrd = 3                                                    ! V point 
     500               ipk = 1                                                     ! surface data 
     501               llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%ssh will be needed 
     502               llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1   ! don't get v2d from v3d and read NetCDF file 
     503               bf_alias => bf(jp_bdyv2d,jbdy:jbdy)                         ! alias for v2d structure of bdy number jbdy 
     504               bn_alias => bn_v2d                                          ! alias for v2d structure of nambdy_dta  
     505               IF( ln_full_vel ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd)      ! will be computed from v3d -> need on the full bdy 
     506               ELSE                    ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd)   ! used only on the rim 
     507               ENDIF 
     508            ENDIF 
     509            ! ===================== 
     510            !         dyn3d 
     511            ! ===================== 
     512            IF( jfld == jp_bdyu3d ) THEN 
     513               cl3 = 'u3d' 
     514               igrd = 2                                                    ! U point 
     515               ipk = jpk                                                   ! 3d data 
     516               llneed = dta_bdy(jbdy)%lneed_dyn3d .OR.               &     ! dta_bdy(jbdy)%u3d will be needed 
     517                  &   ( dta_bdy(jbdy)%lneed_dyn2d .AND. ln_full_vel )      !   u3d needed to compute u2d 
     518               llread = nn_dyn3d_dta(jbdy) == 1                            ! get data from NetCDF file 
     519               bf_alias => bf(jp_bdyu3d,jbdy:jbdy)                         ! alias for u3d structure of bdy number jbdy 
     520               bn_alias => bn_u3d                                          ! alias for u3d structure of nambdy_dta  
     521               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus 
     522           ENDIF 
     523            IF( jfld == jp_bdyv3d ) THEN 
     524               cl3 = 'v3d' 
     525               igrd = 3                                                    ! V point 
     526               ipk = jpk                                                   ! 3d data 
     527               llneed = dta_bdy(jbdy)%lneed_dyn3d .OR.               &     ! dta_bdy(jbdy)%v3d will be needed 
     528                  &   ( dta_bdy(jbdy)%lneed_dyn2d .AND. ln_full_vel )      !   v3d needed to compute v2d 
     529               llread = nn_dyn3d_dta(jbdy) == 1                            ! get data from NetCDF file 
     530               bf_alias => bf(jp_bdyv3d,jbdy:jbdy)                         ! alias for v3d structure of bdy number jbdy 
     531               bn_alias => bn_v3d                                          ! alias for v3d structure of nambdy_dta  
     532               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus 
     533           ENDIF 
     534 
     535            ! ===================== 
     536            !          tra 
     537            ! ===================== 
     538            IF( jfld == jp_bdytem ) THEN 
     539               cl3 = 'tem' 
     540               igrd = 1                                                    ! T point 
     541               ipk = jpk                                                   ! 3d data 
     542               llneed = dta_bdy(jbdy)%lneed_tra                            ! dta_bdy(jbdy)%tem will be needed 
     543               llread = nn_tra_dta(jbdy) == 1                              ! get data from NetCDF file 
     544               bf_alias => bf(jp_bdytem,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy 
     545               bn_alias => bn_tem                                          ! alias for ssh structure of nambdy_dta  
     546               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus 
     547            ENDIF 
     548            IF( jfld == jp_bdysal ) THEN 
     549               cl3 = 'sal' 
     550               igrd = 1                                                    ! T point 
     551               ipk = jpk                                                   ! 3d data 
     552               llneed = dta_bdy(jbdy)%lneed_tra                            ! dta_bdy(jbdy)%sal will be needed 
     553               llread = nn_tra_dta(jbdy) == 1                              ! get data from NetCDF file 
     554               bf_alias => bf(jp_bdysal,jbdy:jbdy)                         ! alias for ssh structure of bdy number jbdy 
     555               bn_alias => bn_sal                                          ! alias for ssh structure of nambdy_dta  
     556               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus 
     557            ENDIF 
     558 
     559            ! ===================== 
     560            !          ice 
     561            ! ===================== 
     562            IF(  jfld == jp_bdya_i .OR. jfld == jp_bdyh_i .OR. jfld == jp_bdyh_s .OR. & 
     563               & jfld == jp_bdyt_i .OR. jfld == jp_bdyt_s .OR. jfld == jp_bdytsu .OR. & 
     564               & jfld == jp_bdys_i .OR. jfld == jp_bdyaip .OR. jfld == jp_bdyhip      ) THEN 
     565               igrd = 1                                                    ! T point 
     566               ipk = ipl                                                   ! jpl-cat data 
     567               llneed = dta_bdy(jbdy)%lneed_ice                            ! ice will be needed 
     568               llread = nn_ice_dta(jbdy) == 1                              ! get data from NetCDF file 
     569               iszdim = idx_bdy(jbdy)%nblen(igrd)                          ! length of this bdy on this MPI processus 
     570            ENDIF 
     571            IF( jfld == jp_bdya_i ) THEN 
     572               cl3 = 'a_i' 
     573               bf_alias => bf(jp_bdya_i,jbdy:jbdy)                         ! alias for a_i structure of bdy number jbdy 
     574               bn_alias => bn_a_i                                          ! alias for a_i structure of nambdy_dta  
     575            ENDIF 
     576            IF( jfld == jp_bdyh_i ) THEN 
     577               cl3 = 'h_i' 
     578               bf_alias => bf(jp_bdyh_i,jbdy:jbdy)                         ! alias for h_i structure of bdy number jbdy 
     579               bn_alias => bn_h_i                                          ! alias for h_i structure of nambdy_dta  
     580            ENDIF 
     581            IF( jfld == jp_bdyh_s ) THEN 
     582               cl3 = 'h_s' 
     583               bf_alias => bf(jp_bdyh_s,jbdy:jbdy)                         ! alias for h_s structure of bdy number jbdy 
     584               bn_alias => bn_h_s                                          ! alias for h_s structure of nambdy_dta  
     585            ENDIF 
     586            IF( jfld == jp_bdyt_i ) THEN 
     587               cl3 = 't_i' 
     588               bf_alias => bf(jp_bdyt_i,jbdy:jbdy)                         ! alias for t_i structure of bdy number jbdy 
     589               bn_alias => bn_t_i                                          ! alias for t_i structure of nambdy_dta  
     590            ENDIF 
     591            IF( jfld == jp_bdyt_s ) THEN 
     592               cl3 = 't_s' 
     593               bf_alias => bf(jp_bdyt_s,jbdy:jbdy)                         ! alias for t_s structure of bdy number jbdy 
     594               bn_alias => bn_t_s                                          ! alias for t_s structure of nambdy_dta  
     595            ENDIF 
     596            IF( jfld == jp_bdytsu ) THEN 
     597               cl3 = 'tsu' 
     598               bf_alias => bf(jp_bdytsu,jbdy:jbdy)                         ! alias for tsu structure of bdy number jbdy 
     599               bn_alias => bn_tsu                                          ! alias for tsu structure of nambdy_dta  
     600            ENDIF 
     601            IF( jfld == jp_bdys_i ) THEN 
     602               cl3 = 's_i' 
     603               bf_alias => bf(jp_bdys_i,jbdy:jbdy)                         ! alias for s_i structure of bdy number jbdy 
     604               bn_alias => bn_s_i                                          ! alias for s_i structure of nambdy_dta  
     605            ENDIF 
     606            IF( jfld == jp_bdyaip ) THEN 
     607               cl3 = 'aip' 
     608               bf_alias => bf(jp_bdyaip,jbdy:jbdy)                         ! alias for aip structure of bdy number jbdy 
     609               bn_alias => bn_aip                                          ! alias for aip structure of nambdy_dta  
     610            ENDIF 
     611            IF( jfld == jp_bdyhip ) THEN 
     612               cl3 = 'hip' 
     613               bf_alias => bf(jp_bdyhip,jbdy:jbdy)                         ! alias for hip structure of bdy number jbdy 
     614               bn_alias => bn_hip                                          ! alias for hip structure of nambdy_dta  
     615            ENDIF 
     616 
     617            IF( llneed ) THEN                                              ! dta_bdy(jbdy)%xxx will be needed 
     618               !                                                           !   -> must be associated with an allocated target 
     619               ALLOCATE( bf_alias(1)%fnow( iszdim, 1, ipk ) )              ! allocate the target 
    631620               ! 
    632                CALL iom_open  ( clname, inum ) 
    633                id1 = iom_varid( inum, bn_a_i%clvar, kdimsz=kdimsz, kndims=kndims, ldstop = .FALSE. ) 
    634                CALL iom_close ( inum ) 
    635  
    636                 IF ( kndims == 4 ) THEN 
    637                  nice_cat = kdimsz(4)   ! Xcat input 
    638                ELSE 
    639                  nice_cat = 1           ! 1cat input       
    640                ENDIF 
    641                ! End test 
    642  
    643                IF( dta%ll_a_i ) THEN 
    644                   jfld = jfld + 1 
    645                   blf_i(jfld) = bn_a_i 
    646                   ibdy(jfld)  = jbdy 
    647                   igrid(jfld) = 1 
    648                   ilen1(jfld) = nblen(igrid(jfld)) 
    649                   ilen3(jfld) = nice_cat 
    650                ENDIF 
    651  
    652                IF( dta%ll_h_i ) THEN 
    653                   jfld = jfld + 1 
    654                   blf_i(jfld) = bn_h_i 
    655                   ibdy(jfld)  = jbdy 
    656                   igrid(jfld) = 1 
    657                   ilen1(jfld) = nblen(igrid(jfld)) 
    658                   ilen3(jfld) = nice_cat 
    659                ENDIF 
    660  
    661                IF( dta%ll_h_s ) THEN 
    662                   jfld = jfld + 1 
    663                   blf_i(jfld) = bn_h_s 
    664                   ibdy(jfld)  = jbdy 
    665                   igrid(jfld) = 1 
    666                   ilen1(jfld) = nblen(igrid(jfld)) 
    667                   ilen3(jfld) = nice_cat 
    668                ENDIF 
    669  
    670             ENDIF 
    671 #endif 
    672             ! Recalculate field counts 
    673             !------------------------- 
    674             IF( jbdy == 1 ) THEN  
    675                nb_bdy_fld_sum = 0 
    676                nb_bdy_fld(jbdy) = jfld 
    677                nb_bdy_fld_sum     = jfld               
    678             ELSE 
    679                nb_bdy_fld(jbdy) = jfld - nb_bdy_fld_sum 
    680                nb_bdy_fld_sum = nb_bdy_fld_sum + nb_bdy_fld(jbdy) 
    681             ENDIF 
    682  
    683             dta%nread(1) = nb_bdy_fld(jbdy) 
    684  
    685          ENDIF ! nn_dta == 1 
    686       ENDDO ! jbdy 
    687  
    688       DO jfld = 1, nb_bdy_fld_sum 
    689          ALLOCATE( bf(jfld)%fnow(ilen1(jfld),1,ilen3(jfld)) ) 
    690          IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) ) 
    691          nbmap_ptr(jfld)%ptr => idx_bdy(ibdy(jfld))%nbmap(:,igrid(jfld)) 
    692          nbmap_ptr(jfld)%ll_unstruc = ln_coords_file(ibdy(jfld)) 
    693       ENDDO 
    694  
    695       ! fill bf with blf_i and control print 
    696       !------------------------------------- 
    697       jstart = 1 
    698       DO jbdy = 1, nb_bdy 
    699          jend = jstart - 1 + nb_bdy_fld(jbdy)  
    700          CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(jbdy), 'bdy_dta',   & 
    701          &              'open boundary conditions', 'nambdy_dta' ) 
    702          jstart = jend + 1 
    703       ENDDO 
    704  
    705       DO jfld = 1, nb_bdy_fld_sum 
    706          bf(jfld)%igrd = igrid(jfld) 
    707          bf(jfld)%ibdy = ibdy(jfld) 
    708       ENDDO 
    709  
    710       ! Initialise local boundary data arrays 
    711       ! nn_xxx_dta=0 : allocate space - will be filled from initial conditions later 
    712       ! nn_xxx_dta=1 : point to "fnow" arrays 
    713       !------------------------------------- 
    714  
    715       jfld = 0 
    716       DO jbdy=1, nb_bdy 
    717  
    718          nblen => idx_bdy(jbdy)%nblen 
    719          dta => dta_bdy(jbdy) 
    720  
    721          if(lwp) then 
    722             write(numout,*) '++++++ dta%ll_ssh = ',dta%ll_ssh 
    723             write(numout,*) '++++++ dta%ll_u2d = ',dta%ll_u2d 
    724             write(numout,*) '++++++ dta%ll_v2d = ',dta%ll_v2d 
    725             write(numout,*) '++++++ dta%ll_u3d = ',dta%ll_u3d 
    726             write(numout,*) '++++++ dta%ll_v3d = ',dta%ll_v3d 
    727             write(numout,*) '++++++ dta%ll_tem = ',dta%ll_tem 
    728             write(numout,*) '++++++ dta%ll_sal = ',dta%ll_sal 
    729          endif 
    730  
    731          IF ( nn_dyn2d_dta(jbdy) == 0 .or. nn_dyn2d_dta(jbdy) == 2 ) THEN 
    732             if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space' 
    733             IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) ) 
    734             IF( dta%ll_u2d ) ALLOCATE( dta%u2d(nblen(2)) ) 
    735             IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) ) 
    736          ENDIF 
    737          IF ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) THEN 
    738             IF( dta%ll_ssh ) THEN 
    739                if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow' 
    740                jfld = jfld + 1 
    741                dta%ssh => bf(jfld)%fnow(:,1,1) 
    742             ENDIF 
    743             IF ( dta%ll_u2d ) THEN 
    744                IF ( ln_full_vel_array(jbdy) ) THEN 
    745                   if(lwp) write(numout,*) '++++++ dta%u2d allocated space' 
    746                   ALLOCATE( dta%u2d(nblen(2)) ) 
    747                ELSE 
    748                   if(lwp) write(numout,*) '++++++ dta%u2d pointing to fnow' 
    749                   jfld = jfld + 1 
    750                   dta%u2d => bf(jfld)%fnow(:,1,1) 
    751                ENDIF 
    752             ENDIF 
    753             IF ( dta%ll_v2d ) THEN 
    754                IF ( ln_full_vel_array(jbdy) ) THEN 
    755                   if(lwp) write(numout,*) '++++++ dta%v2d allocated space' 
    756                   ALLOCATE( dta%v2d(nblen(3)) ) 
    757                ELSE 
    758                   if(lwp) write(numout,*) '++++++ dta%v2d pointing to fnow' 
    759                   jfld = jfld + 1 
    760                   dta%v2d => bf(jfld)%fnow(:,1,1) 
    761                ENDIF 
    762             ENDIF 
    763          ENDIF 
    764  
    765          IF ( nn_dyn3d_dta(jbdy) == 0 ) THEN 
    766             if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space' 
    767             IF( dta%ll_u3d ) ALLOCATE( dta_bdy(jbdy)%u3d(nblen(2),jpk) ) 
    768             IF( dta%ll_v3d ) ALLOCATE( dta_bdy(jbdy)%v3d(nblen(3),jpk) ) 
    769          ENDIF 
    770          IF ( nn_dyn3d_dta(jbdy) == 1 .or. & 
    771            &  ( ln_full_vel_array(jbdy) .and. ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) ) ) THEN 
    772             IF ( dta%ll_u3d .or. ( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) ) THEN 
    773                if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow' 
    774                jfld = jfld + 1 
    775                dta_bdy(jbdy)%u3d => bf(jfld)%fnow(:,1,:) 
    776             ENDIF 
    777             IF ( dta%ll_v3d .or. ( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) ) THEN 
    778                if(lwp) write(numout,*) '++++++ dta%v3d pointing to fnow' 
    779                jfld = jfld + 1 
    780                dta_bdy(jbdy)%v3d => bf(jfld)%fnow(:,1,:) 
    781             ENDIF 
    782          ENDIF 
    783  
    784          IF( nn_tra_dta(jbdy) == 0 ) THEN 
    785             if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space' 
    786             IF( dta%ll_tem ) ALLOCATE( dta_bdy(jbdy)%tem(nblen(1),jpk) ) 
    787             IF( dta%ll_sal ) ALLOCATE( dta_bdy(jbdy)%sal(nblen(1),jpk) ) 
    788          ELSE 
    789             IF( dta%ll_tem ) THEN 
    790                if(lwp) write(numout,*) '++++++ dta%tem pointing to fnow' 
    791                jfld = jfld + 1 
    792                dta_bdy(jbdy)%tem => bf(jfld)%fnow(:,1,:) 
    793             ENDIF 
    794             IF( dta%ll_sal ) THEN  
    795                if(lwp) write(numout,*) '++++++ dta%sal pointing to fnow' 
    796                jfld = jfld + 1 
    797                dta_bdy(jbdy)%sal => bf(jfld)%fnow(:,1,:) 
    798             ENDIF 
    799          ENDIF 
    800  
    801 #if defined key_si3 
    802          IF (cn_ice(jbdy) /= 'none') THEN 
    803             IF( nn_ice_dta(jbdy) == 0 ) THEN 
    804                ALLOCATE( dta_bdy(jbdy)%a_i(nblen(1),jpl) ) 
    805                ALLOCATE( dta_bdy(jbdy)%h_i(nblen(1),jpl) ) 
    806                ALLOCATE( dta_bdy(jbdy)%h_s(nblen(1),jpl) ) 
    807             ELSE 
    808                IF ( nice_cat == jpl ) THEN ! case input cat = jpl 
    809                   jfld = jfld + 1 
    810                   dta_bdy(jbdy)%a_i => bf(jfld)%fnow(:,1,:) 
    811                   jfld = jfld + 1 
    812                   dta_bdy(jbdy)%h_i => bf(jfld)%fnow(:,1,:) 
    813                   jfld = jfld + 1 
    814                   dta_bdy(jbdy)%h_s => bf(jfld)%fnow(:,1,:) 
    815                ELSE                        ! case input cat = 1 OR (/=1 and /=jpl) 
    816                   jfld_ait(jbdy)  = jfld + 1 
    817                   jfld_htit(jbdy) = jfld + 2 
    818                   jfld_htst(jbdy) = jfld + 3 
    819                   jfld     = jfld + 3 
    820                   ALLOCATE( dta_bdy(jbdy)%a_i(nblen(1),jpl) ) 
    821                   ALLOCATE( dta_bdy(jbdy)%h_i(nblen(1),jpl) ) 
    822                   ALLOCATE( dta_bdy(jbdy)%h_s(nblen(1),jpl) ) 
    823                   dta_bdy(jbdy)%a_i(:,:) = 0._wp 
    824                   dta_bdy(jbdy)%h_i(:,:) = 0._wp 
    825                   dta_bdy(jbdy)%h_s(:,:) = 0._wp 
    826                ENDIF 
    827  
    828             ENDIF 
    829          ENDIF 
    830 #endif 
     621               IF( llread ) THEN                                           ! get data from NetCDF file 
     622                  CALL fld_fill( bf_alias, bn_alias, cn_dir, 'bdy_dta', cl3//' '//ctmp1, ctmp2 )   ! use namelist info 
     623                  IF( bf_alias(1)%ln_tint ) ALLOCATE( bf_alias(1)%fdta( iszdim, 1, ipk, 2 ) ) 
     624                  bf_alias(1)%imap    => idx_bdy(jbdy)%nbmap(1:iszdim,igrd)   ! associate the mapping used for this bdy 
     625                  bf_alias(1)%igrd    = igrd                                  ! used only for vertical integration of 3D arrays 
     626                  bf_alias(1)%ltotvel = ln_full_vel                           ! T if u3d is full velocity 
     627                  bf_alias(1)%lzint   = ln_zinterp                            ! T if it requires a vertical interpolation 
     628               ENDIF 
     629 
     630               ! associate the pointer and get rid of the dimensions with a size equal to 1 
     631               IF( jfld == jp_bdyssh )        dta_bdy(jbdy)%ssh => bf_alias(1)%fnow(:,1,1) 
     632               IF( jfld == jp_bdyu2d )        dta_bdy(jbdy)%u2d => bf_alias(1)%fnow(:,1,1) 
     633               IF( jfld == jp_bdyv2d )        dta_bdy(jbdy)%v2d => bf_alias(1)%fnow(:,1,1) 
     634               IF( jfld == jp_bdyu3d )        dta_bdy(jbdy)%u3d => bf_alias(1)%fnow(:,1,:) 
     635               IF( jfld == jp_bdyv3d )        dta_bdy(jbdy)%v3d => bf_alias(1)%fnow(:,1,:) 
     636               IF( jfld == jp_bdytem )        dta_bdy(jbdy)%tem => bf_alias(1)%fnow(:,1,:) 
     637               IF( jfld == jp_bdysal )        dta_bdy(jbdy)%sal => bf_alias(1)%fnow(:,1,:) 
     638               IF( jfld == jp_bdya_i ) THEN 
     639                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%a_i => bf_alias(1)%fnow(:,1,:) 
     640                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%a_i(iszdim,jpl) ) 
     641                  ENDIF 
     642               ENDIF 
     643               IF( jfld == jp_bdyh_i ) THEN 
     644                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%h_i => bf_alias(1)%fnow(:,1,:) 
     645                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%h_i(iszdim,jpl) ) 
     646                  ENDIF 
     647               ENDIF 
     648               IF( jfld == jp_bdyh_s ) THEN 
     649                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%h_s => bf_alias(1)%fnow(:,1,:) 
     650                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%h_s(iszdim,jpl) ) 
     651                  ENDIF 
     652               ENDIF 
     653               IF( jfld == jp_bdyt_i ) THEN 
     654                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%t_i => bf_alias(1)%fnow(:,1,:) 
     655                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%t_i(iszdim,jpl) ) 
     656                  ENDIF 
     657               ENDIF 
     658               IF( jfld == jp_bdyt_s ) THEN 
     659                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%t_s => bf_alias(1)%fnow(:,1,:) 
     660                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%t_s(iszdim,jpl) ) 
     661                  ENDIF 
     662               ENDIF 
     663               IF( jfld == jp_bdytsu ) THEN 
     664                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%tsu => bf_alias(1)%fnow(:,1,:) 
     665                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%tsu(iszdim,jpl) ) 
     666                  ENDIF 
     667               ENDIF 
     668               IF( jfld == jp_bdys_i ) THEN 
     669                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%s_i => bf_alias(1)%fnow(:,1,:) 
     670                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%s_i(iszdim,jpl) ) 
     671                  ENDIF 
     672               ENDIF 
     673               IF( jfld == jp_bdyaip ) THEN 
     674                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%aip => bf_alias(1)%fnow(:,1,:) 
     675                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%aip(iszdim,jpl) ) 
     676                  ENDIF 
     677               ENDIF 
     678               IF( jfld == jp_bdyhip ) THEN 
     679                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%hip => bf_alias(1)%fnow(:,1,:) 
     680                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%hip(iszdim,jpl) ) 
     681                  ENDIF 
     682               ENDIF 
     683            ENDIF 
     684 
     685         END DO   ! jpbdyfld 
    831686         ! 
    832687      END DO ! jbdy  
    833688      ! 
    834689   END SUBROUTINE bdy_dta_init 
    835  
     690    
    836691   !!============================================================================== 
    837692END MODULE bdydta 

  • NEMO/trunk/src/OCE/BDY/bdydyn2d.F90

    r11072 r11536  
    1414   !!   bdy_ssh            : Duplicate sea level across open boundaries 
    1515   !!---------------------------------------------------------------------- 
    16    USE oce             ! ocean dynamics and tracers  
    1716   USE dom_oce         ! ocean space and time domain 
    1817   USE bdy_oce         ! ocean open boundary conditions 
    … …  
    5049      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pssh 
    5150      !! 
    52       INTEGER                                  ::   ib_bdy ! Loop counter 
    53  
    54       DO ib_bdy=1, nb_bdy 
    55  
    56          SELECT CASE( cn_dyn2d(ib_bdy) ) 
    57          CASE('none') 
    58             CYCLE 
    59          CASE('frs') 
    60             CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d ) 
    61          CASE('flather') 
    62             CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d, pssh, phur, phvr ) 
    63          CASE('orlanski') 
    64             CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, & 
    65                                      & pua2d, pva2d, pub2d, pvb2d, ll_npo=.false.) 
    66          CASE('orlanski_npo') 
    67             CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, & 
    68                                      & pua2d, pva2d, pub2d, pvb2d, ll_npo=.true. ) 
    69          CASE DEFAULT 
    70             CALL ctl_stop( 'bdy_dyn2d : unrecognised option for open boundaries for barotropic variables' ) 
    71          END SELECT 
    72       ENDDO 
    73  
     51      INTEGER  ::   ib_bdy, ir     ! BDY set index, rim index 
     52      LOGICAL  ::   llrim0         ! indicate if rim 0 is treated 
     53      LOGICAL, DIMENSION(4) :: llsend2, llrecv2, llsend3, llrecv3  ! indicate how communications are to be carried out 
     54       
     55      llsend2(:) = .false.   ;   llrecv2(:) = .false. 
     56      llsend3(:) = .false.   ;   llrecv3(:) = .false. 
     57      DO ir = 1, 0, -1   ! treat rim 1 before rim 0 
     58         IF( ir == 0 ) THEN   ;   llrim0 = .TRUE. 
     59         ELSE                 ;   llrim0 = .FALSE. 
     60         END IF 
     61         DO ib_bdy=1, nb_bdy 
     62            SELECT CASE( cn_dyn2d(ib_bdy) ) 
     63            CASE('none') 
     64               CYCLE 
     65            CASE('frs')   ! treat the whole boundary at once 
     66               IF( llrim0 )   CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d ) 
     67            CASE('flather') 
     68               CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d, pssh, phur, phvr, llrim0 ) 
     69            CASE('orlanski') 
     70               CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, & 
     71                    & pua2d, pva2d, pub2d, pvb2d, llrim0, ll_npo=.false. ) 
     72            CASE('orlanski_npo') 
     73               CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, & 
     74                    & pua2d, pva2d, pub2d, pvb2d, llrim0, ll_npo=.true.  ) 
     75            CASE DEFAULT 
     76               CALL ctl_stop( 'bdy_dyn2d : unrecognised option for open boundaries for barotropic variables' ) 
     77            END SELECT 
     78         ENDDO 
     79         ! 
     80         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 
     81         IF( nn_hls == 1 ) THEN 
     82            llsend2(:) = .false.   ;   llrecv2(:) = .false. 
     83            llsend3(:) = .false.   ;   llrecv3(:) = .false. 
     84         END IF 
     85         DO ib_bdy=1, nb_bdy 
     86            SELECT CASE( cn_dyn2d(ib_bdy) ) 
     87            CASE('flather') 
     88               llsend2(1:2) = llsend2(1:2) .OR. lsend_bdyint(ib_bdy,2,1:2,ir)   ! west/east, U points 
     89               llsend2(1)   = llsend2(1)   .OR. lsend_bdyext(ib_bdy,2,1,ir)     ! neighbour might search point towards its east bdy 
     90               llrecv2(1:2) = llrecv2(1:2) .OR. lrecv_bdyint(ib_bdy,2,1:2,ir)   ! west/east, U points 
     91               llrecv2(2)   = llrecv2(2)   .OR. lrecv_bdyext(ib_bdy,2,2,ir)     ! might search point towards bdy on the east 
     92               llsend3(3:4) = llsend3(3:4) .OR. lsend_bdyint(ib_bdy,3,3:4,ir)   ! north/south, V points 
     93               llsend3(3)   = llsend3(3)   .OR. lsend_bdyext(ib_bdy,3,3,ir)     ! neighbour might search point towards its north bdy  
     94               llrecv3(3:4) = llrecv3(3:4) .OR. lrecv_bdyint(ib_bdy,3,3:4,ir)   ! north/south, V points 
     95               llrecv3(4)   = llrecv3(4)   .OR. lrecv_bdyext(ib_bdy,3,4,ir)     ! might search point towards bdy on the north 
     96            CASE('orlanski', 'orlanski_npo') 
     97               llsend2(:) = llsend2(:) .OR. lsend_bdy(ib_bdy,2,:,ir)   ! possibly every direction, U points 
     98               llrecv2(:) = llrecv2(:) .OR. lrecv_bdy(ib_bdy,2,:,ir)   ! possibly every direction, U points 
     99               llsend3(:) = llsend3(:) .OR. lsend_bdy(ib_bdy,3,:,ir)   ! possibly every direction, V points 
     100               llrecv3(:) = llrecv3(:) .OR. lrecv_bdy(ib_bdy,3,:,ir)   ! possibly every direction, V points 
     101            END SELECT 
     102         END DO 
     103         IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction 
     104            CALL lbc_lnk( 'bdydyn2d', pua2d, 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 
     105         END IF 
     106         IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction 
     107            CALL lbc_lnk( 'bdydyn2d', pva2d, 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 
     108         END IF 
     109         ! 
     110      END DO   ! ir 
     111      ! 
    74112   END SUBROUTINE bdy_dyn2d 
    75113 
    … …  
    90128      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d  
    91129      !! 
    92       INTEGER  ::   jb, jk         ! dummy loop indices 
     130      INTEGER  ::   jb             ! dummy loop indices 
    93131      INTEGER  ::   ii, ij, igrd   ! local integers 
    94132      REAL(wp) ::   zwgt           ! boundary weight 
    … …  
    110148         pva2d(ii,ij) = ( pva2d(ii,ij) + zwgt * ( dta%v2d(jb) - pva2d(ii,ij) ) ) * vmask(ii,ij,1) 
    111149      END DO  
    112       CALL lbc_bdy_lnk( 'bdydyn2d', pua2d, 'U', -1., ib_bdy )  
    113       CALL lbc_bdy_lnk( 'bdydyn2d', pva2d, 'V', -1., ib_bdy)   ! Boundary points should be updated 
    114150      ! 
    115151   END SUBROUTINE bdy_dyn2d_frs 
    116152 
    117153 
    118    SUBROUTINE bdy_dyn2d_fla( idx, dta, ib_bdy, pua2d, pva2d, pssh, phur, phvr ) 
     154   SUBROUTINE bdy_dyn2d_fla( idx, dta, ib_bdy, pua2d, pva2d, pssh, phur, phvr, llrim0 ) 
    119155      !!---------------------------------------------------------------------- 
    120156      !!                 ***  SUBROUTINE bdy_dyn2d_fla  *** 
    … …  
    139175      INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index 
    140176      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 
    141       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pssh, phur, phvr  
    142  
     177      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pssh, phur, phvr 
     178      LOGICAL                     , INTENT(in) ::   llrim0   ! indicate if rim 0 is treated 
     179      INTEGER  ::   ibeg, iend                       ! length of rim to be treated (rim 0 or rim 1) 
    143180      INTEGER  ::   jb, igrd                         ! dummy loop indices 
    144       INTEGER  ::   ii, ij, iim1, iip1, ijm1, ijp1   ! 2D addresses 
    145       REAL(wp), POINTER :: flagu, flagv              ! short cuts 
    146       REAL(wp) ::   zcorr                            ! Flather correction 
    147       REAL(wp) ::   zforc                            ! temporary scalar 
    148       REAL(wp) ::   zflag, z1_2                      !    "        " 
     181      INTEGER  ::   ii, ij                           ! 2D addresses 
     182      INTEGER  ::   iiTrim, ijTrim                   ! T pts i/j-indice on the rim 
     183      INTEGER  ::   iiToce, ijToce, iiUoce, ijVoce   ! T, U and V pts i/j-indice of the ocean next to the rim 
     184      REAL(wp) ::   flagu, flagv                     ! short cuts 
     185      REAL(wp) ::   zfla                             ! Flather correction 
     186      REAL(wp) ::   z1_2                             !  
     187      REAL(wp), DIMENSION(jpi,jpj) ::   sshdta       ! 2D version of dta%ssh 
    149188      !!---------------------------------------------------------------------- 
    150189 
    … …  
    153192      ! ---------------------------------! 
    154193      ! Flather boundary conditions     :! 
    155       ! ---------------------------------!  
    156       
    157 !!! REPLACE spgu with nemo_wrk work space 
    158  
    159       ! Fill temporary array with ssh data (here spgu): 
     194      ! ---------------------------------! 
     195 
     196      ! Fill temporary array with ssh data (here we use spgu with the alias sshdta): 
    160197      igrd = 1 
    161       spgu(:,:) = 0.0 
    162       DO jb = 1, idx%nblenrim(igrd) 
     198      IF( llrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd) 
     199      ELSE                ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd) 
     200      END IF 
     201      ! 
     202      DO jb = ibeg, iend 
    163203         ii = idx%nbi(jb,igrd) 
    164204         ij = idx%nbj(jb,igrd) 
    165          IF( ll_wd ) THEN 
    166             spgu(ii, ij) = dta%ssh(jb)  - ssh_ref  
    167          ELSE 
    168             spgu(ii, ij) = dta%ssh(jb) 
     205         IF( ll_wd ) THEN   ;   sshdta(ii, ij) = dta%ssh(jb) - ssh_ref  
     206         ELSE               ;   sshdta(ii, ij) = dta%ssh(jb) 
    169207         ENDIF 
    170208      END DO 
    171  
    172       CALL lbc_bdy_lnk( 'bdydyn2d', spgu(:,:), 'T', 1., ib_bdy ) 
    173       ! 
    174       igrd = 2      ! Flather bc on u-velocity;  
     209      ! 
     210      igrd = 2      ! Flather bc on u-velocity 
    175211      !             ! remember that flagu=-1 if normal velocity direction is outward 
    176212      !             ! I think we should rather use after ssh ? 
    177       DO jb = 1, idx%nblenrim(igrd) 
    178          ii  = idx%nbi(jb,igrd) 
    179          ij  = idx%nbj(jb,igrd)  
    180          flagu => idx%flagu(jb,igrd) 
    181          iim1 = ii + MAX( 0, INT( flagu ) )   ! T pts i-indice inside the boundary 
    182          iip1 = ii - MIN( 0, INT( flagu ) )   ! T pts i-indice outside the boundary  
    183          ! 
    184          zcorr = - flagu * SQRT( grav * phur(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) ) 
    185  
    186          ! jchanut tschanges: Set zflag to 0 below to revert to Flather scheme 
    187          ! Use characteristics method instead 
    188          zflag = ABS(flagu) 
    189          zforc = dta%u2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pua2d(ii+NINT(flagu),ij) 
    190          pua2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * umask(ii,ij,1)  
     213      IF( llrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd) 
     214      ELSE                ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd) 
     215      END IF 
     216      DO jb = ibeg, iend 
     217         ii    = idx%nbi(jb,igrd) 
     218         ij    = idx%nbj(jb,igrd) 
     219         flagu = idx%flagu(jb,igrd) 
     220         IF( flagu == 0. ) THEN 
     221            pua2d(ii,ij) = dta%u2d(jb) 
     222         ELSE      ! T pts j-indice       on the rim          on the ocean next to the rim on T and U points 
     223            IF( flagu ==  1. ) THEN   ;   iiTrim = ii     ;   iiToce = ii+1   ;   iiUoce = ii+1   ;   ENDIF 
     224            IF( flagu == -1. ) THEN   ;   iiTrim = ii+1   ;   iiToce = ii     ;   iiUoce = ii-1   ;   ENDIF 
     225            ! 
     226            ! Rare case : rim is parallel to the mpi subdomain border and on the halo : point will be received 
     227            IF( iiTrim > jpi .OR. iiToce > jpi .OR. iiUoce > jpi .OR. iiUoce < 1 )   CYCLE    
     228            ! 
     229            zfla = dta%u2d(jb) - flagu * SQRT( grav * phur(ii, ij) ) * ( pssh(iiToce,ij) - sshdta(iiTrim,ij) ) 
     230            ! 
     231            ! jchanut tschanges, use characteristics method (Blayo et Debreu, 2005) : 
     232            ! mix Flather scheme with velocity of the ocean next to the rim 
     233            pua2d(ii,ij) =  z1_2 * ( pua2d(iiUoce,ij) + zfla ) 
     234         END IF 
    191235      END DO 
    192236      ! 
    193237      igrd = 3      ! Flather bc on v-velocity 
    194238      !             ! remember that flagv=-1 if normal velocity direction is outward 
    195       DO jb = 1, idx%nblenrim(igrd) 
    196          ii  = idx%nbi(jb,igrd) 
    197          ij  = idx%nbj(jb,igrd)  
    198          flagv => idx%flagv(jb,igrd) 
    199          ijm1 = ij + MAX( 0, INT( flagv ) )   ! T pts j-indice inside the boundary 
    200          ijp1 = ij - MIN( 0, INT( flagv ) )   ! T pts j-indice outside the boundary  
    201          ! 
    202          zcorr = - flagv * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) ) 
    203  
    204          ! jchanut tschanges: Set zflag to 0 below to revert to std Flather scheme 
    205          ! Use characteristics method instead 
    206          zflag = ABS(flagv) 
    207          zforc  = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pva2d(ii,ij+NINT(flagv)) 
    208          pva2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * vmask(ii,ij,1) 
    209       END DO 
    210       CALL lbc_bdy_lnk( 'bdydyn2d', pua2d, 'U', -1., ib_bdy )   ! Boundary points should be updated 
    211       CALL lbc_bdy_lnk( 'bdydyn2d', pva2d, 'V', -1., ib_bdy )   ! 
     239      IF( llrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd) 
     240      ELSE                ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd) 
     241      END IF 
     242      DO jb = ibeg, iend 
     243         ii    = idx%nbi(jb,igrd) 
     244         ij    = idx%nbj(jb,igrd) 
     245         flagv = idx%flagv(jb,igrd) 
     246         IF( flagv == 0. ) THEN 
     247            pva2d(ii,ij) = dta%v2d(jb) 
     248         ELSE      ! T pts j-indice       on the rim          on the ocean next to the rim on T and V points 
     249            IF( flagv ==  1. ) THEN   ;   ijTrim = ij     ;   ijToce = ij+1   ;   ijVoce = ij+1   ;   ENDIF 
     250            IF( flagv == -1. ) THEN   ;   ijTrim = ij+1   ;   ijToce = ij     ;   ijVoce = ij-1   ;   ENDIF 
     251            ! 
     252            ! Rare case : rim is parallel to the mpi subdomain border and on the halo : point will be received 
     253            IF( ijTrim > jpj .OR. ijToce > jpj .OR. ijVoce > jpj .OR. ijVoce < 1 )   CYCLE 
     254            ! 
     255            zfla = dta%v2d(jb) - flagv * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii,ijToce) - sshdta(ii,ijTrim) ) 
     256            ! 
     257            ! jchanut tschanges, use characteristics method (Blayo et Debreu, 2005) : 
     258            ! mix Flather scheme with velocity of the ocean next to the rim 
     259            pva2d(ii,ij) =  z1_2 * ( pva2d(ii,ijVoce) + zfla ) 
     260         END IF 
     261      END DO 
    212262      ! 
    213263   END SUBROUTINE bdy_dyn2d_fla 
    214264 
    215265 
    216    SUBROUTINE bdy_dyn2d_orlanski( idx, dta, ib_bdy, pua2d, pva2d, pub2d, pvb2d, ll_npo ) 
     266   SUBROUTINE bdy_dyn2d_orlanski( idx, dta, ib_bdy, pua2d, pva2d, pub2d, pvb2d, llrim0, ll_npo ) 
    217267      !!---------------------------------------------------------------------- 
    218268      !!                 ***  SUBROUTINE bdy_dyn2d_orlanski  *** 
    … …  
    231281      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pub2d, pvb2d  
    232282      LOGICAL,                      INTENT(in) ::   ll_npo  ! flag for NPO version 
    233  
     283      LOGICAL,                      INTENT(in) ::   llrim0   ! indicate if rim 0 is treated 
    234284      INTEGER  ::   ib, igrd                               ! dummy loop indices 
    235285      INTEGER  ::   ii, ij, iibm1, ijbm1                   ! indices 
    … …  
    238288      igrd = 2      ! Orlanski bc on u-velocity;  
    239289      !             
    240       CALL bdy_orlanski_2d( idx, igrd, pub2d, pua2d, dta%u2d, ll_npo ) 
     290      CALL bdy_orlanski_2d( idx, igrd, pub2d, pua2d, dta%u2d, llrim0, ll_npo ) 
    241291 
    242292      igrd = 3      ! Orlanski bc on v-velocity 
    243293      !   
    244       CALL bdy_orlanski_2d( idx, igrd, pvb2d, pva2d, dta%v2d, ll_npo ) 
    245       ! 
    246       CALL lbc_bdy_lnk( 'bdydyn2d', pua2d, 'U', -1., ib_bdy )   ! Boundary points should be updated 
    247       CALL lbc_bdy_lnk( 'bdydyn2d', pva2d, 'V', -1., ib_bdy )   ! 
     294      CALL bdy_orlanski_2d( idx, igrd, pvb2d, pva2d, dta%v2d, llrim0, ll_npo ) 
    248295      ! 
    249296   END SUBROUTINE bdy_dyn2d_orlanski 
    … …  
    257304      !! 
    258305      !!---------------------------------------------------------------------- 
    259       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   zssh ! Sea level 
    260       !! 
    261       INTEGER  ::   ib_bdy, ib, igrd                        ! local integers 
    262       INTEGER  ::   ii, ij, zcoef, zcoef1, zcoef2, ip, jp   !   "       " 
    263  
    264       igrd = 1                       ! Everything is at T-points here 
    265  
    266       DO ib_bdy = 1, nb_bdy 
    267          DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
    268             ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    269             ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    270             ! Set gradient direction: 
    271             zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  ) 
    272             zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1) 
    273             IF ( zcoef1+zcoef2 == 0 ) THEN   ! corner 
    274                zcoef = bdytmask(ii-1,ij-1) + bdytmask(ii+1,ij+1) + bdytmask(ii+1,ij-1) + bdytmask(ii-1,ij+1) 
    275                zssh(ii,ij) = zssh( ii-1, ij-1 ) * bdytmask( ii-1, ij-1) + & 
    276                  &           zssh( ii+1, ij+1 ) * bdytmask( ii+1, ij+1) + & 
    277                  &           zssh( ii+1, ij-1 ) * bdytmask( ii+1, ij-1) + & 
    278                  &           zssh( ii-1, ij+1 ) * bdytmask( ii-1, ij+1) 
    279                zssh(ii,ij) = ( zssh(ii,ij) / MAX( 1, zcoef) ) * tmask(ii,ij,1) 
    280             ELSE 
    281                ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  ) 
    282                jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1) 
    283                zssh(ii,ij) = zssh(ii+ip,ij+jp) * tmask(ii+ip,ij+jp,1) 
    284             ENDIF 
     306      REAL(wp), DIMENSION(jpi,jpj,1), INTENT(inout) ::   zssh ! Sea level, need 3 dimensions to be used by bdy_nmn 
     307      !! 
     308      INTEGER ::   ib_bdy, ir      ! bdy index, rim index 
     309      INTEGER ::   ibeg, iend      ! length of rim to be treated (rim 0 or rim 1) 
     310      LOGICAL ::   llrim0          ! indicate if rim 0 is treated 
     311      LOGICAL, DIMENSION(4) :: llsend1, llrecv1  ! indicate how communications are to be carried out 
     312      !!---------------------------------------------------------------------- 
     313      llsend1(:) = .false.   ;   llrecv1(:) = .false. 
     314      DO ir = 1, 0, -1   ! treat rim 1 before rim 0 
     315         IF( nn_hls == 1 ) THEN   ;   llsend1(:) = .false.   ;   llrecv1(:) = .false.   ;   END IF 
     316         IF( ir == 0 ) THEN   ;   llrim0 = .TRUE. 
     317         ELSE                 ;   llrim0 = .FALSE. 
     318         END IF 
     319         DO ib_bdy = 1, nb_bdy 
     320            CALL bdy_nmn( idx_bdy(ib_bdy), 1, zssh, llrim0 )   ! zssh is masked 
     321            llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     322            llrecv1(:) = llrecv1(:) .OR. lrecv_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points 
    285323         END DO 
    286  
    287          ! Boundary points should be updated 
    288          CALL lbc_bdy_lnk( 'bdydyn2d', zssh(:,:), 'T', 1., ib_bdy ) 
    289       END DO 
    290  
     324         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 
     325         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
     326            CALL lbc_lnk( 'bdydyn2d', zssh(:,:,1), 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     327         END IF 
     328      END DO 
     329      ! 
    291330   END SUBROUTINE bdy_ssh 
    292331 

  • NEMO/trunk/src/OCE/BDY/bdydyn3d.F90

    r10529 r11536  
    4242      INTEGER, INTENT(in) ::   kt   ! Main time step counter 
    4343      ! 
    44       INTEGER ::   ib_bdy   ! loop index 
    45       !!---------------------------------------------------------------------- 
    46       ! 
    47       DO ib_bdy=1, nb_bdy 
     44      INTEGER  ::   ib_bdy, ir     ! BDY set index, rim index 
     45      LOGICAL  ::   llrim0         ! indicate if rim 0 is treated 
     46      LOGICAL, DIMENSION(4) :: llsend2, llrecv2, llsend3, llrecv3  ! indicate how communications are to be carried out 
     47 
     48      !!---------------------------------------------------------------------- 
     49      llsend2(:) = .false.   ;   llrecv2(:) = .false. 
     50      llsend3(:) = .false.   ;   llrecv3(:) = .false. 
     51      DO ir = 1, 0, -1   ! treat rim 1 before rim 0 
     52         IF( ir == 0 ) THEN   ;   llrim0 = .TRUE. 
     53         ELSE                 ;   llrim0 = .FALSE. 
     54         END IF 
     55         DO ib_bdy=1, nb_bdy 
     56            ! 
     57            SELECT CASE( cn_dyn3d(ib_bdy) ) 
     58            CASE('none')        ;   CYCLE 
     59            CASE('frs' )        ! treat the whole boundary at once 
     60               IF( ir == 0) CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     61            CASE('specified')   ! treat the whole rim      at once 
     62               IF( ir == 0) CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     63            CASE('zero')        ! treat the whole rim      at once 
     64               IF( ir == 0) CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     65            CASE('orlanski' )   ;   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, llrim0, ll_npo=.false. ) 
     66            CASE('orlanski_npo');   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, llrim0, ll_npo=.true.  ) 
     67            CASE('zerograd')    ;   CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy, llrim0 ) 
     68            CASE('neumann')     ;   CALL bdy_dyn3d_nmn( idx_bdy(ib_bdy), ib_bdy, llrim0 ) 
     69            CASE DEFAULT        ;   CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 
     70            END SELECT 
     71         END DO 
    4872         ! 
    49          SELECT CASE( cn_dyn3d(ib_bdy) ) 
    50          CASE('none')        ;   CYCLE 
    51          CASE('frs' )        ;   CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    52          CASE('specified')   ;   CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    53          CASE('zero')        ;   CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    54          CASE('orlanski' )   ;   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 
    55          CASE('orlanski_npo');   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 
    56          CASE('zerograd')    ;   CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    57          CASE('neumann')     ;   CALL bdy_dyn3d_nmn( idx_bdy(ib_bdy), ib_bdy ) 
    58          CASE DEFAULT        ;   CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 
    59          END SELECT 
    60       END DO 
     73         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 
     74         IF( nn_hls == 1 ) THEN 
     75            llsend2(:) = .false.   ;   llrecv2(:) = .false. 
     76            llsend3(:) = .false.   ;   llrecv3(:) = .false. 
     77         END IF 
     78         DO ib_bdy=1, nb_bdy 
     79            SELECT CASE( cn_dyn3d(ib_bdy) ) 
     80            CASE('orlanski', 'orlanski_npo') 
     81               llsend2(:) = llsend2(:) .OR. lsend_bdy(ib_bdy,2,:,ir)   ! possibly every direction, U points 
     82               llrecv2(:) = llrecv2(:) .OR. lrecv_bdy(ib_bdy,2,:,ir)   ! possibly every direction, U points 
     83               llsend3(:) = llsend3(:) .OR. lsend_bdy(ib_bdy,3,:,ir)   ! possibly every direction, V points 
     84               llrecv3(:) = llrecv3(:) .OR. lrecv_bdy(ib_bdy,3,:,ir)   ! possibly every direction, V points 
     85            CASE('zerograd') 
     86               llsend2(3:4) = llsend2(3:4) .OR. lsend_bdyint(ib_bdy,2,3:4,ir)   ! north/south, U points 
     87               llrecv2(3:4) = llrecv2(3:4) .OR. lrecv_bdyint(ib_bdy,2,3:4,ir)   ! north/south, U points 
     88               llsend3(1:2) = llsend3(1:2) .OR. lsend_bdyint(ib_bdy,3,1:2,ir)   ! west/east, V points 
     89               llrecv3(1:2) = llrecv3(1:2) .OR. lrecv_bdyint(ib_bdy,3,1:2,ir)   ! west/east, V points 
     90            CASE('neumann') 
     91               llsend2(:) = llsend2(:) .OR. lsend_bdyint(ib_bdy,2,:,ir)   ! possibly every direction, U points 
     92               llrecv2(:) = llrecv2(:) .OR. lrecv_bdyint(ib_bdy,2,:,ir)   ! possibly every direction, U points 
     93               llsend3(:) = llsend3(:) .OR. lsend_bdyint(ib_bdy,3,:,ir)   ! possibly every direction, V points 
     94               llrecv3(:) = llrecv3(:) .OR. lrecv_bdyint(ib_bdy,3,:,ir)   ! possibly every direction, V points 
     95            END SELECT 
     96         END DO 
     97         ! 
     98         IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction 
     99            CALL lbc_lnk( 'bdydyn2d', ua, 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 
     100         END IF 
     101         IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction 
     102            CALL lbc_lnk( 'bdydyn2d', va, 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 
     103         END IF 
     104      END DO   ! ir 
    61105      ! 
    62106   END SUBROUTINE bdy_dyn3d 
    … …  
    78122      INTEGER  ::   jb, jk         ! dummy loop indices 
    79123      INTEGER  ::   ii, ij, igrd   ! local integers 
    80       REAL(wp) ::   zwgt           ! boundary weight 
    81124      !!---------------------------------------------------------------------- 
    82125      ! 
    … …  
    98141         END DO 
    99142      END DO 
    100       CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy )   ! Boundary points should be updated   
    101       CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy )    
    102       ! 
    103       IF( kt == nit000 )   CLOSE( unit = 102 ) 
    104143      ! 
    105144   END SUBROUTINE bdy_dyn3d_spe 
    106145 
    107146 
    108    SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt , ib_bdy ) 
     147   SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt, ib_bdy, llrim0 ) 
    109148      !!---------------------------------------------------------------------- 
    110149      !!                  ***  SUBROUTINE bdy_dyn3d_zgrad  *** 
    … …  
    114153      !!---------------------------------------------------------------------- 
    115154      INTEGER                     ::   kt 
    116       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    117       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    118       INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
     155      TYPE(OBC_INDEX), INTENT(in) ::   idx      ! OBC indices 
     156      TYPE(OBC_DATA),  INTENT(in) ::   dta      ! OBC external data 
     157      INTEGER,         INTENT(in) ::   ib_bdy   ! BDY set index 
     158      LOGICAL,         INTENT(in) ::   llrim0   ! indicate if rim 0 is treated 
    119159      !! 
    120160      INTEGER  ::   jb, jk         ! dummy loop indices 
    121161      INTEGER  ::   ii, ij, igrd   ! local integers 
    122       REAL(wp) ::   zwgt           ! boundary weight 
    123       INTEGER  ::   fu, fv 
     162      INTEGER  ::   flagu, flagv           ! short cuts 
     163      INTEGER  ::   ibeg, iend     ! length of rim to be treated (rim 0 or rim 1 or both) 
    124164      !!---------------------------------------------------------------------- 
    125165      ! 
    126166      igrd = 2                      ! Copying tangential velocity into bdy points 
    127       DO jb = 1, idx%nblenrim(igrd) 
    128          DO jk = 1, jpkm1 
    129             ii   = idx%nbi(jb,igrd) 
    130             ij   = idx%nbj(jb,igrd) 
    131             fu   = ABS( ABS (NINT( idx%flagu(jb,igrd) ) ) - 1 ) 
    132             ua(ii,ij,jk) = ua(ii,ij,jk) * REAL( 1 - fu) + ( ua(ii,ij+fu,jk) * umask(ii,ij+fu,jk) & 
    133                         &+ ua(ii,ij-fu,jk) * umask(ii,ij-fu,jk) ) * umask(ii,ij,jk) * REAL( fu ) 
    134          END DO 
     167      IF( llrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd) 
     168      ELSE                ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd) 
     169      ENDIF 
     170      DO jb = ibeg, iend 
     171         ii    = idx%nbi(jb,igrd) 
     172         ij    = idx%nbj(jb,igrd) 
     173         flagu = NINT(idx%flagu(jb,igrd)) 
     174         flagv = NINT(idx%flagv(jb,igrd)) 
     175         ! 
     176         IF( flagu == 0 )   THEN              ! north/south bdy 
     177            IF( ij+flagv > jpj .OR. ij+flagv < 1 )   CYCLE       
     178            ! 
     179            DO jk = 1, jpkm1 
     180               ua(ii,ij,jk) = ua(ii,ij+flagv,jk) * umask(ii,ij+flagv,jk) 
     181            END DO 
     182            ! 
     183         END IF 
    135184      END DO 
    136185      ! 
    137186      igrd = 3                      ! Copying tangential velocity into bdy points 
    138       DO jb = 1, idx%nblenrim(igrd) 
    139          DO jk = 1, jpkm1 
    140             ii   = idx%nbi(jb,igrd) 
    141             ij   = idx%nbj(jb,igrd) 
    142             fv   = ABS( ABS (NINT( idx%flagv(jb,igrd) ) ) - 1 ) 
    143             va(ii,ij,jk) = va(ii,ij,jk) * REAL( 1 - fv ) + ( va(ii+fv,ij,jk) * vmask(ii+fv,ij,jk) & 
    144                         &+ va(ii-fv,ij,jk) * vmask(ii-fv,ij,jk) ) * vmask(ii,ij,jk) * REAL( fv ) 
    145          END DO 
    146       END DO 
    147       CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy )   ! Boundary points should be updated   
    148       CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy )    
    149       ! 
    150       IF( kt == nit000 )   CLOSE( unit = 102 ) 
     187      IF( llrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd) 
     188      ELSE                ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd) 
     189      ENDIF 
     190      DO jb = ibeg, iend 
     191         ii    = idx%nbi(jb,igrd) 
     192         ij    = idx%nbj(jb,igrd) 
     193         flagu = NINT(idx%flagu(jb,igrd)) 
     194         flagv = NINT(idx%flagv(jb,igrd)) 
     195         ! 
     196         IF( flagv == 0 )   THEN              !  west/east  bdy 
     197            IF( ii+flagu > jpi .OR. ii+flagu < 1 )   CYCLE       
     198            ! 
     199            DO jk = 1, jpkm1 
     200               va(ii,ij,jk) = va(ii+flagu,ij,jk) * vmask(ii+flagu,ij,jk) 
     201            END DO 
     202            ! 
     203         END IF 
     204      END DO 
    151205      ! 
    152206   END SUBROUTINE bdy_dyn3d_zgrad 
    … …  
    167221      INTEGER  ::   ib, ik         ! dummy loop indices 
    168222      INTEGER  ::   ii, ij, igrd   ! local integers 
    169       REAL(wp) ::   zwgt           ! boundary weight 
    170223      !!---------------------------------------------------------------------- 
    171224      ! 
    … …  
    178231         END DO 
    179232      END DO 
    180  
     233      ! 
    181234      igrd = 3                       ! Everything is at T-points here 
    182235      DO ib = 1, idx%nblenrim(igrd) 
    … …  
    187240         END DO 
    188241      END DO 
    189       ! 
    190       CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy )   ;   CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1.,ib_bdy )   ! Boundary points should be updated 
    191       ! 
    192       IF( kt == nit000 )   CLOSE( unit = 102 ) 
    193242      ! 
    194243   END SUBROUTINE bdy_dyn3d_zro 
    … …  
    234283            va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta%v3d(jb,jk) - va(ii,ij,jk) ) ) * vmask(ii,ij,jk) 
    235284         END DO 
    236       END DO  
    237       CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy )    ! Boundary points should be updated 
    238       CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy )    
    239       ! 
    240       IF( kt == nit000 )   CLOSE( unit = 102 ) 
     285      END DO    
    241286      ! 
    242287   END SUBROUTINE bdy_dyn3d_frs 
    243288 
    244289 
    245    SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, ll_npo ) 
     290   SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, llrim0, ll_npo ) 
    246291      !!---------------------------------------------------------------------- 
    247292      !!                 ***  SUBROUTINE bdy_dyn3d_orlanski  *** 
    … …  
    255300      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
    256301      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
    257       INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index 
    258       LOGICAL,                      INTENT(in) ::   ll_npo  ! switch for NPO version 
     302      INTEGER,                      INTENT(in) ::   ib_bdy   ! BDY set index 
     303      LOGICAL,                      INTENT(in) ::   llrim0   ! indicate if rim 0 is treated 
     304      LOGICAL,                      INTENT(in) ::   ll_npo   ! switch for NPO version 
    259305 
    260306      INTEGER  ::   jb, igrd                               ! dummy loop indices 
    … …  
    265311      igrd = 2      ! Orlanski bc on u-velocity;  
    266312      !             
    267       CALL bdy_orlanski_3d( idx, igrd, ub, ua, dta%u3d, ll_npo ) 
     313      CALL bdy_orlanski_3d( idx, igrd, ub, ua, dta%u3d, ll_npo, llrim0 ) 
    268314 
    269315      igrd = 3      ! Orlanski bc on v-velocity 
    270316      !   
    271       CALL bdy_orlanski_3d( idx, igrd, vb, va, dta%v3d, ll_npo ) 
    272       ! 
    273       CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy )    ! Boundary points should be updated 
    274       CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy )    
     317      CALL bdy_orlanski_3d( idx, igrd, vb, va, dta%v3d, ll_npo, llrim0 ) 
    275318      ! 
    276319   END SUBROUTINE bdy_dyn3d_orlanski 
    … …  
    320363      END DO 
    321364      ! 
    322       CALL lbc_lnk_multi( 'bdydyn3d', ua, 'U', -1.,  va, 'V', -1. )   ! Boundary points should be updated 
    323       ! 
    324365      IF( ln_timing )   CALL timing_stop('bdy_dyn3d_dmp') 
    325366      ! 
    … …  
    327368 
    328369 
    329    SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy ) 
     370   SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy, llrim0 ) 
    330371      !!---------------------------------------------------------------------- 
    331372      !!                 ***  SUBROUTINE bdy_dyn3d_nmn  *** 
    … …  
    336377      !! 
    337378      !!---------------------------------------------------------------------- 
    338       TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
    339       INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index 
    340  
    341       INTEGER  ::   jb, igrd                               ! dummy loop indices 
     379      TYPE(OBC_INDEX), INTENT(in) ::   idx      ! OBC indices 
     380      INTEGER,         INTENT(in) ::   ib_bdy   ! BDY set index 
     381      LOGICAL,         INTENT(in) ::   llrim0   ! indicate if rim 0 is treated 
     382      INTEGER  ::   igrd                        ! dummy indice 
    342383      !!---------------------------------------------------------------------- 
    343384      ! 
    … …  
    346387      igrd = 2      ! Neumann bc on u-velocity;  
    347388      !             
    348       CALL bdy_nmn( idx, igrd, ua ) 
     389      CALL bdy_nmn( idx, igrd, ua, llrim0 )   ! ua is masked 
    349390 
    350391      igrd = 3      ! Neumann bc on v-velocity 
    351392      !   
    352       CALL bdy_nmn( idx, igrd, va ) 
    353       ! 
    354       CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy )    ! Boundary points should be updated 
    355       CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy ) 
     393      CALL bdy_nmn( idx, igrd, va, llrim0 )   ! va is masked 
    356394      ! 
    357395   END SUBROUTINE bdy_dyn3d_nmn 

  • NEMO/trunk/src/OCE/BDY/bdyice.F90

    r11041 r11536  
    5555      INTEGER, INTENT(in) ::   kt   ! Main time step counter 
    5656      ! 
    57       INTEGER ::   jbdy   ! BDY set index 
     57      INTEGER ::   jbdy, ir                             ! BDY set index, rim index 
     58      INTEGER ::   ibeg, iend                           ! length of rim to be treated (rim 0 or rim 1) 
     59      LOGICAL ::   llrim0                               ! indicate if rim 0 is treated 
     60      LOGICAL, DIMENSION(4)  :: llsend1, llrecv1        ! indicate how communications are to be carried out 
    5861      !!---------------------------------------------------------------------- 
    5962      ! controls 
    6063      IF( ln_timing    )   CALL timing_start('bdy_ice_thd')                                                            ! timing 
    6164      IF( ln_icediachk )   CALL ice_cons_hsm(0,'bdy_ice_thd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
     65      IF( ln_icediachk )   CALL ice_cons2D  (0,'bdy_ice_thd',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation 
    6266      ! 
    6367      CALL ice_var_glo2eqv 
    6468      ! 
    65       DO jbdy = 1, nb_bdy 
     69      llsend1(:) = .false.   ;   llrecv1(:) = .false. 
     70      DO ir = 1, 0, -1   ! treat rim 1 before rim 0 
     71         IF( ir == 0 ) THEN   ;   llrim0 = .TRUE. 
     72         ELSE                 ;   llrim0 = .FALSE. 
     73         END IF 
     74         DO jbdy = 1, nb_bdy 
     75            ! 
     76            SELECT CASE( cn_ice(jbdy) ) 
     77            CASE('none')   ;   CYCLE 
     78            CASE('frs' )   ;   CALL bdy_ice_frs( idx_bdy(jbdy), dta_bdy(jbdy), kt, jbdy, llrim0 ) 
     79            CASE DEFAULT 
     80               CALL ctl_stop( 'bdy_ice : unrecognised option for open boundaries for ice fields' ) 
     81            END SELECT 
     82            ! 
     83         END DO 
    6684         ! 
    67          SELECT CASE( cn_ice(jbdy) ) 
    68          CASE('none')   ;   CYCLE 
    69          CASE('frs' )   ;   CALL bdy_ice_frs( idx_bdy(jbdy), dta_bdy(jbdy), kt, jbdy ) 
    70          CASE DEFAULT 
    71             CALL ctl_stop( 'bdy_ice : unrecognised option for open boundaries for ice fields' ) 
    72          END SELECT 
    73          ! 
    74       END DO 
     85         ! Update bdy points         
     86         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 
     87         IF( nn_hls == 1 ) THEN   ;   llsend1(:) = .false.   ;   llrecv1(:) = .false.   ;   END IF 
     88         DO jbdy = 1, nb_bdy 
     89            IF( cn_ice(jbdy) == 'frs' ) THEN 
     90               llsend1(:) = llsend1(:) .OR. lsend_bdyint(jbdy,1,:,ir)   ! possibly every direction, T points 
     91               llrecv1(:) = llrecv1(:) .OR. lrecv_bdyint(jbdy,1,:,ir)   ! possibly every direction, T points 
     92            END IF 
     93         END DO   ! jbdy 
     94         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
     95            ! exchange 3d arrays 
     96            CALL lbc_lnk_multi( 'bdyice', a_i , 'T', 1., h_i , 'T', 1., h_s , 'T', 1., oa_i, 'T', 1. & 
     97                 &                      , a_ip, 'T', 1., v_ip, 'T', 1., s_i , 'T', 1., t_su, 'T', 1. & 
     98                 &                      , v_i , 'T', 1., v_s , 'T', 1., sv_i, 'T', 1.                & 
     99                 &                      , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1      ) 
     100            ! exchange 4d arrays :   third dimension = 1   and then   third dimension = jpk 
     101            CALL lbc_lnk_multi( 'bdyice', t_s , 'T', 1., e_s , 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     102            CALL lbc_lnk_multi( 'bdyice', t_i , 'T', 1., e_i , 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     103         END IF 
     104      END DO   ! ir 
    75105      ! 
    76106      CALL ice_cor( kt , 0 )      ! -- In case categories are out of bounds, do a remapping 
    … …  
    80110      ! 
    81111      ! controls 
     112      IF( ln_icectl    )   CALL ice_prt     ( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' )                        ! prints 
    82113      IF( ln_icediachk )   CALL ice_cons_hsm(1,'bdy_ice_thd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
    83       IF( ln_icectl    )   CALL ice_prt     ( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' )                        ! prints 
     114      IF( ln_icediachk )   CALL ice_cons2D  (1,'bdy_ice_thd',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation 
    84115      IF( ln_timing    )   CALL timing_stop ('bdy_ice_thd')                                                            ! timing 
    85116      ! 
    … …  
    87118 
    88119 
    89    SUBROUTINE bdy_ice_frs( idx, dta, kt, jbdy ) 
     120   SUBROUTINE bdy_ice_frs( idx, dta, kt, jbdy, llrim0 ) 
    90121      !!------------------------------------------------------------------------------ 
    91122      !!                 ***  SUBROUTINE bdy_ice_frs  *** 
    … …  
    96127      !!             dimensional baroclinic ocean model with realistic topography. Tellus, 365-382. 
    97128      !!------------------------------------------------------------------------------ 
    98       TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices 
    99       TYPE(OBC_DATA),  INTENT(in) ::   dta     ! OBC external data 
    100       INTEGER,         INTENT(in) ::   kt      ! main time-step counter 
    101       INTEGER,         INTENT(in) ::   jbdy    ! BDY set index 
     129      TYPE(OBC_INDEX), INTENT(in) ::   idx      ! OBC indices 
     130      TYPE(OBC_DATA),  INTENT(in) ::   dta      ! OBC external data 
     131      INTEGER,         INTENT(in) ::   kt       ! main time-step counter 
     132      INTEGER,         INTENT(in) ::   jbdy     ! BDY set index 
     133      LOGICAL,         INTENT(in) ::   llrim0   ! indicate if rim 0 is treated 
    102134      ! 
    103135      INTEGER  ::   jpbound            ! 0 = incoming ice 
    104136      !                                ! 1 = outgoing ice 
     137      INTEGER  ::   ibeg, iend         ! length of rim to be treated (rim 0 or rim 1) 
    105138      INTEGER  ::   i_bdy, jgrd        ! dummy loop indices 
    106139      INTEGER  ::   ji, jj, jk, jl, ib, jb 
    107140      REAL(wp) ::   zwgt, zwgt1        ! local scalar 
    108141      REAL(wp) ::   ztmelts, zdh 
     142      REAL(wp), POINTER  :: flagu, flagv              ! short cuts 
    109143      !!------------------------------------------------------------------------------ 
    110144      ! 
    111145      jgrd = 1      ! Everything is at T-points here 
     146      IF( llrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(jgrd) 
     147      ELSE                ;   ibeg = idx%nblenrim0(jgrd)+1   ;   iend = idx%nblenrim(jgrd) 
     148      END IF 
    112149      ! 
    113150      DO jl = 1, jpl 
    114          DO i_bdy = 1, idx%nblenrim(jgrd) 
     151         DO i_bdy = ibeg, iend 
    115152            ji    = idx%nbi(i_bdy,jgrd) 
    116153            jj    = idx%nbj(i_bdy,jgrd) 
    117154            zwgt  = idx%nbw(i_bdy,jgrd) 
    118155            zwgt1 = 1.e0 - idx%nbw(i_bdy,jgrd) 
    119             a_i(ji,jj,jl) = ( a_i(ji,jj,jl) * zwgt1 + dta%a_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Leads fraction  
    120             h_i(ji,jj,jl) = ( h_i(ji,jj,jl) * zwgt1 + dta%h_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice depth  
    121             h_s(ji,jj,jl) = ( h_s(ji,jj,jl) * zwgt1 + dta%h_s(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Snow depth 
    122  
     156            a_i (ji,jj,  jl) = ( a_i (ji,jj,  jl) * zwgt1 + dta%a_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice  concentration  
     157            h_i (ji,jj,  jl) = ( h_i (ji,jj,  jl) * zwgt1 + dta%h_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice  depth  
     158            h_s (ji,jj,  jl) = ( h_s (ji,jj,  jl) * zwgt1 + dta%h_s(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Snow depth 
     159            t_i (ji,jj,:,jl) = ( t_i (ji,jj,:,jl) * zwgt1 + dta%t_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice  temperature 
     160            t_s (ji,jj,:,jl) = ( t_s (ji,jj,:,jl) * zwgt1 + dta%t_s(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Snow temperature 
     161            t_su(ji,jj,  jl) = ( t_su(ji,jj,  jl) * zwgt1 + dta%tsu(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Surf temperature 
     162            s_i (ji,jj,  jl) = ( s_i (ji,jj,  jl) * zwgt1 + dta%s_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice  salinity 
     163            a_ip(ji,jj,  jl) = ( a_ip(ji,jj,  jl) * zwgt1 + dta%aip(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice  pond concentration 
     164            h_ip(ji,jj,  jl) = ( h_ip(ji,jj,  jl) * zwgt1 + dta%hip(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice  pond depth 
     165            ! 
     166            sz_i(ji,jj,:,jl) = s_i(ji,jj,jl) 
     167            ! 
     168            ! make sure ponds = 0 if no ponds scheme 
     169            IF( .NOT.ln_pnd ) THEN 
     170               a_ip(ji,jj,jl) = 0._wp 
     171               h_ip(ji,jj,jl) = 0._wp 
     172            ENDIF 
     173            ! 
    123174            ! ----------------- 
    124175            ! Pathological case 
    … …  
    135186            h_i(ji,jj,jl) = MIN( hi_max(jl), h_i(ji,jj,jl) + zdh ) 
    136187            h_s(ji,jj,jl) = MAX( 0._wp, h_s(ji,jj,jl) - zdh * rhoi / rhos )  
    137  
     188            ! 
    138189         ENDDO 
    139190      ENDDO 
    140       CALL lbc_bdy_lnk( 'bdyice', a_i(:,:,:), 'T', 1., jbdy ) 
    141       CALL lbc_bdy_lnk( 'bdyice', h_i(:,:,:), 'T', 1., jbdy ) 
    142       CALL lbc_bdy_lnk( 'bdyice', h_s(:,:,:), 'T', 1., jbdy ) 
    143191 
    144192      DO jl = 1, jpl 
    145          DO i_bdy = 1, idx%nblenrim(jgrd) 
     193         DO i_bdy = ibeg, iend 
    146194            ji = idx%nbi(i_bdy,jgrd) 
    147195            jj = idx%nbj(i_bdy,jgrd) 
    148  
     196            flagu => idx%flagu(i_bdy,jgrd) 
     197            flagv => idx%flagv(i_bdy,jgrd) 
    149198            ! condition on ice thickness depends on the ice velocity 
    150199            ! if velocity is outward (strictly), then ice thickness, volume... must be equal to adjacent values 
    151200            jpbound = 0   ;   ib = ji   ;   jb = jj 
    152201            ! 
    153             IF( u_ice(ji  ,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. )   jpbound = 1 ; ib = ji+1 
    154             IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji  ,jj  ,1) == 0. )   jpbound = 1 ; ib = ji-1 
    155             IF( v_ice(ji  ,jj  ) < 0. .AND. vmask(ji  ,jj-1,1) == 0. )   jpbound = 1 ; jb = jj+1 
    156             IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj  ,1) == 0. )   jpbound = 1 ; jb = jj-1 
     202            IF( flagu ==  1. )   THEN 
     203               IF( ji+1 > jpi )   CYCLE 
     204               IF( u_ice(ji  ,jj  ) < 0. )   jpbound = 1 ; ib = ji+1 
     205            END IF 
     206            IF( flagu == -1. )   THEN 
     207               IF( ji-1 < 1   )   CYCLE 
     208               IF( u_ice(ji-1,jj  ) < 0. )   jpbound = 1 ; ib = ji-1 
     209            END IF 
     210            IF( flagv ==  1. )   THEN 
     211               IF( jj+1 > jpj )   CYCLE 
     212               IF( v_ice(ji  ,jj  ) < 0. )   jpbound = 1 ; jb = jj+1 
     213            END IF 
     214            IF( flagv == -1. )   THEN 
     215               IF( jj-1 < 1   )   CYCLE 
     216               IF( v_ice(ji  ,jj-1) < 0. )   jpbound = 1 ; jb = jj-1 
     217            END IF 
    157218            ! 
    158219            IF( nn_ice_dta(jbdy) == 0 )   jpbound = 0 ; ib = ji ; jb = jj   ! case ice boundaries = initial conditions 
    … …  
    161222            IF( a_i(ib,jb,jl) > 0._wp ) THEN   ! there is ice at the boundary 
    162223               ! 
    163                a_i(ji,jj,jl) = a_i(ib,jb,jl) ! concentration 
    164                h_i(ji,jj,jl) = h_i(ib,jb,jl) ! thickness ice 
    165                h_s(ji,jj,jl) = h_s(ib,jb,jl) ! thickness snw 
    166                ! 
    167                SELECT CASE( jpbound ) 
    168                   ! 
    169                CASE( 0 )   ! velocity is inward 
    170                   ! 
    171                   oa_i(ji,jj,  jl) = rn_ice_age(jbdy) * a_i(ji,jj,jl) ! age 
    172                   a_ip(ji,jj,  jl) = 0._wp                            ! pond concentration 
    173                   v_ip(ji,jj,  jl) = 0._wp                            ! pond volume 
    174                   t_su(ji,jj,  jl) = rn_ice_tem(jbdy)                 ! temperature surface 
    175                   t_s (ji,jj,:,jl) = rn_ice_tem(jbdy)                 ! temperature snw 
    176                   t_i (ji,jj,:,jl) = rn_ice_tem(jbdy)                 ! temperature ice 
    177                   s_i (ji,jj,  jl) = rn_ice_sal(jbdy)                 ! salinity 
    178                   sz_i(ji,jj,:,jl) = rn_ice_sal(jbdy)                 ! salinity profile 
    179                   ! 
    180                CASE( 1 )   ! velocity is outward 
    181                   ! 
    182                   oa_i(ji,jj,  jl) = oa_i(ib,jb,  jl) ! age 
    183                   a_ip(ji,jj,  jl) = a_ip(ib,jb,  jl) ! pond concentration 
    184                   v_ip(ji,jj,  jl) = v_ip(ib,jb,  jl) ! pond volume 
    185                   t_su(ji,jj,  jl) = t_su(ib,jb,  jl) ! temperature surface 
    186                   t_s (ji,jj,:,jl) = t_s (ib,jb,:,jl) ! temperature snw 
    187                   t_i (ji,jj,:,jl) = t_i (ib,jb,:,jl) ! temperature ice 
    188                   s_i (ji,jj,  jl) = s_i (ib,jb,  jl) ! salinity 
    189                   sz_i(ji,jj,:,jl) = sz_i(ib,jb,:,jl) ! salinity profile 
    190                   ! 
    191                END SELECT 
     224               a_i (ji,jj,  jl) = a_i (ib,jb,  jl) 
     225               h_i (ji,jj,  jl) = h_i (ib,jb,  jl) 
     226               h_s (ji,jj,  jl) = h_s (ib,jb,  jl) 
     227               t_i (ji,jj,:,jl) = t_i (ib,jb,:,jl) 
     228               t_s (ji,jj,:,jl) = t_s (ib,jb,:,jl) 
     229               t_su(ji,jj,  jl) = t_su(ib,jb,  jl) 
     230               s_i (ji,jj,  jl) = s_i (ib,jb,  jl) 
     231               a_ip(ji,jj,  jl) = a_ip(ib,jb,  jl) 
     232               h_ip(ji,jj,  jl) = h_ip(ib,jb,  jl) 
     233               ! 
     234               sz_i(ji,jj,:,jl) = sz_i(ib,jb,:,jl) 
     235               ! 
     236               ! ice age 
     237               IF    ( jpbound == 0 ) THEN  ! velocity is inward 
     238                  oa_i(ji,jj,jl) = rice_age(jbdy) * a_i(ji,jj,jl) 
     239               ELSEIF( jpbound == 1 ) THEN  ! velocity is outward 
     240                  oa_i(ji,jj,jl) = oa_i(ib,jb,jl) 
     241               ENDIF 
    192242               ! 
    193243               IF( nn_icesal == 1 ) THEN     ! if constant salinity 
    … …  
    214264               END DO 
    215265               ! 
     266               ! melt ponds 
     267               IF( a_i(ji,jj,jl) > epsi10 ) THEN 
     268                  a_ip_frac(ji,jj,jl) = a_ip(ji,jj,jl) / a_i (ji,jj,jl) 
     269               ELSE 
     270                  a_ip_frac(ji,jj,jl) = 0._wp 
     271               ENDIF 
     272               v_ip(ji,jj,jl) = h_ip(ji,jj,jl) * a_ip(ji,jj,jl) 
     273               ! 
    216274            ELSE   ! no ice at the boundary 
    217275               ! 
    … …  
    225283               t_s (ji,jj,:,jl) = rt0 
    226284               t_i (ji,jj,:,jl) = rt0  
     285 
     286               a_ip_frac(ji,jj,jl) = 0._wp 
     287               h_ip     (ji,jj,jl) = 0._wp 
     288               a_ip     (ji,jj,jl) = 0._wp 
     289               v_ip     (ji,jj,jl) = 0._wp 
    227290                
    228291               IF( nn_icesal == 1 ) THEN     ! if constant salinity 
    … …  
    246309         ! 
    247310      END DO ! jl 
    248  
    249       CALL lbc_bdy_lnk( 'bdyice', a_i (:,:,:)  , 'T', 1., jbdy ) 
    250       CALL lbc_bdy_lnk( 'bdyice', h_i (:,:,:)  , 'T', 1., jbdy ) 
    251       CALL lbc_bdy_lnk( 'bdyice', h_s (:,:,:)  , 'T', 1., jbdy ) 
    252       CALL lbc_bdy_lnk( 'bdyice', oa_i(:,:,:)  , 'T', 1., jbdy ) 
    253       CALL lbc_bdy_lnk( 'bdyice', a_ip(:,:,:)  , 'T', 1., jbdy ) 
    254       CALL lbc_bdy_lnk( 'bdyice', v_ip(:,:,:)  , 'T', 1., jbdy ) 
    255       CALL lbc_bdy_lnk( 'bdyice', s_i (:,:,:)  , 'T', 1., jbdy ) 
    256       CALL lbc_bdy_lnk( 'bdyice', t_su(:,:,:)  , 'T', 1., jbdy ) 
    257       CALL lbc_bdy_lnk( 'bdyice', v_i (:,:,:)  , 'T', 1., jbdy ) 
    258       CALL lbc_bdy_lnk( 'bdyice', v_s (:,:,:)  , 'T', 1., jbdy ) 
    259       CALL lbc_bdy_lnk( 'bdyice', sv_i(:,:,:)  , 'T', 1., jbdy ) 
    260       CALL lbc_bdy_lnk( 'bdyice', t_s (:,:,:,:), 'T', 1., jbdy ) 
    261       CALL lbc_bdy_lnk( 'bdyice', e_s (:,:,:,:), 'T', 1., jbdy ) 
    262       CALL lbc_bdy_lnk( 'bdyice', t_i (:,:,:,:), 'T', 1., jbdy ) 
    263       CALL lbc_bdy_lnk( 'bdyice', e_i (:,:,:,:), 'T', 1., jbdy ) 
    264311      !       
    265312   END SUBROUTINE bdy_ice_frs 
    … …  
    279326      CHARACTER(len=1), INTENT(in)  ::   cd_type   ! nature of velocity grid-points 
    280327      ! 
    281       INTEGER  ::   i_bdy, jgrd      ! dummy loop indices 
    282       INTEGER  ::   ji, jj           ! local scalar 
    283       INTEGER  ::   jbdy             ! BDY set index 
     328      INTEGER  ::   i_bdy, jgrd       ! dummy loop indices 
     329      INTEGER  ::   ji, jj            ! local scalar 
     330      INTEGER  ::   jbdy, ir     ! BDY set index, rim index 
     331      INTEGER  ::   ibeg, iend   ! length of rim to be treated (rim 0 or rim 1) 
    284332      REAL(wp) ::   zmsk1, zmsk2, zflag 
     333      LOGICAL, DIMENSION(4) :: llsend2, llrecv2, llsend3, llrecv3  ! indicate how communications are to be carried out 
    285334      !!------------------------------------------------------------------------------ 
    286335      IF( ln_timing )   CALL timing_start('bdy_ice_dyn') 
    287336      ! 
    288       DO jbdy=1, nb_bdy 
     337      llsend2(:) = .false.   ;   llrecv2(:) = .false. 
     338      llsend3(:) = .false.   ;   llrecv3(:) = .false. 
     339      DO ir = 1, 0, -1 
     340         DO jbdy = 1, nb_bdy 
     341            ! 
     342            SELECT CASE( cn_ice(jbdy) ) 
     343               ! 
     344            CASE('none') 
     345               CYCLE 
     346               ! 
     347            CASE('frs') 
     348               ! 
     349               IF( nn_ice_dta(jbdy) == 0 ) CYCLE            ! case ice boundaries = initial conditions  
     350               !                                            !      do not change ice velocity (it is only computed by rheology) 
     351               SELECT CASE ( cd_type ) 
     352                  !      
     353               CASE ( 'U' )   
     354                  jgrd = 2      ! u velocity 
     355                  IF( ir == 0 ) THEN   ;   ibeg = 1                                 ;   iend = idx_bdy(jbdy)%nblenrim0(jgrd) 
     356                  ELSE                 ;   ibeg = idx_bdy(jbdy)%nblenrim0(jgrd)+1   ;   iend = idx_bdy(jbdy)%nblenrim(jgrd) 
     357                  END IF 
     358                  DO i_bdy = ibeg, iend 
     359                     ji    = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 
     360                     jj    = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 
     361                     zflag = idx_bdy(jbdy)%flagu(i_bdy,jgrd) 
     362                     !     i-1  i   i    |  !        i  i i+1 |  !          i  i i+1 | 
     363                     !      >  ice  >    |  !        o  > ice |  !          o  >  o  |       
     364                     ! => set at u_ice(i-1) !  => set to O       !  => unchanged 
     365                     IF( zflag == -1. .AND. ji > 1 .AND. ji < jpi )   THEN   
     366                        IF    ( vt_i(ji  ,jj) > 0. )   THEN   ;   u_ice(ji,jj) = u_ice(ji-1,jj)  
     367                        ELSEIF( vt_i(ji+1,jj) > 0. )   THEN   ;   u_ice(ji,jj) = 0._wp 
     368                        END IF 
     369                     END IF 
     370                     ! |    i  i+1 i+1        !  |  i   i i+1        !  | i  i i+1 
     371                     ! |    >  ice  >         !  | ice  >  o         !  | o  >  o    
     372                     ! => set at u_ice(i+1)   !     => set to O      !     =>  unchanged 
     373                     IF( zflag ==  1. .AND. ji+1 < jpi+1 )   THEN 
     374                        IF    ( vt_i(ji+1,jj) > 0. )   THEN   ;   u_ice(ji,jj) = u_ice(ji+1,jj) 
     375                        ELSEIF( vt_i(ji  ,jj) > 0. )   THEN   ;   u_ice(ji,jj) = 0._wp 
     376                        END IF 
     377                     END IF 
     378                     ! 
     379                     IF( zflag ==  0. )   u_ice(ji,jj) = 0._wp   ! u_ice = 0  if north/south bdy   
     380                     ! 
     381                  END DO 
     382                  ! 
     383               CASE ( 'V' ) 
     384                  jgrd = 3      ! v velocity 
     385                  IF( ir == 0 ) THEN   ;   ibeg = 1                                 ;   iend = idx_bdy(jbdy)%nblenrim0(jgrd) 
     386                  ELSE                 ;   ibeg = idx_bdy(jbdy)%nblenrim0(jgrd)+1   ;   iend = idx_bdy(jbdy)%nblenrim(jgrd) 
     387                  END IF 
     388                  DO i_bdy = ibeg, iend 
     389                     ji    = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 
     390                     jj    = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 
     391                     zflag = idx_bdy(jbdy)%flagv(i_bdy,jgrd) 
     392                     !                         !      ice   (jj+1)       !       o    (jj+1) 
     393                     !       ^    (jj  )       !       ^    (jj  )       !       ^    (jj  )        
     394                     !      ice   (jj  )       !       o    (jj  )       !       o    (jj  )        
     395                     !       ^    (jj-1)       !                         ! 
     396                     ! => set to u_ice(jj-1)   !  =>   set to 0          !   => unchanged         
     397                     IF( zflag == -1. .AND. jj > 1 .AND. jj < jpj )   THEN                  
     398                        IF    ( vt_i(ji,jj  ) > 0. )   THEN   ;   v_ice(ji,jj) = v_ice(ji,jj-1) 
     399                        ELSEIF( vt_i(ji,jj+1) > 0. )   THEN   ;   v_ice(ji,jj) = 0._wp 
     400                        END IF 
     401                     END IF 
     402                     !       ^    (jj+1)       !                         !               
     403                     !      ice   (jj+1)       !       o    (jj+1)       !       o    (jj+1)        
     404                     !       ^    (jj  )       !       ^    (jj  )       !       ^    (jj  ) 
     405                     !   ________________      !  ____ice___(jj  )_      !  _____o____(jj  )  
     406                     ! => set to u_ice(jj+1)   !    => set to 0          !    => unchanged   
     407                     IF( zflag ==  1. .AND. jj < jpj )   THEN               
     408                        IF    ( vt_i(ji,jj+1) > 0. )   THEN   ;   v_ice(ji,jj) = v_ice(ji,jj+1) 
     409                        ELSEIF( vt_i(ji,jj  ) > 0. )   THEN   ;   v_ice(ji,jj) = 0._wp 
     410                        END IF 
     411                     END IF 
     412                     ! 
     413                     IF( zflag ==  0. )   v_ice(ji,jj) = 0._wp   ! v_ice = 0  if west/east bdy   
     414                     ! 
     415                  END DO 
     416                  ! 
     417               END SELECT 
     418               ! 
     419            CASE DEFAULT 
     420               CALL ctl_stop( 'bdy_ice_dyn : unrecognised option for open boundaries for ice fields' ) 
     421            END SELECT 
     422            ! 
     423         END DO    ! jbdy 
    289424         ! 
    290          SELECT CASE( cn_ice(jbdy) ) 
    291          ! 
    292          CASE('none') 
    293             CYCLE 
    294             ! 
    295          CASE('frs') 
    296             ! 
    297             IF( nn_ice_dta(jbdy) == 0 ) CYCLE            ! case ice boundaries = initial conditions  
    298             !                                            !      do not change ice velocity (it is only computed by rheology) 
    299             SELECT CASE ( cd_type ) 
    300             !      
    301             CASE ( 'U' )   
    302                jgrd = 2      ! u velocity 
    303                DO i_bdy = 1, idx_bdy(jbdy)%nblenrim(jgrd) 
    304                   ji    = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 
    305                   jj    = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 
    306                   zflag = idx_bdy(jbdy)%flagu(i_bdy,jgrd) 
    307                   ! 
    308                   IF ( ABS( zflag ) == 1. ) THEN  ! eastern and western boundaries 
    309                      ! one of the two zmsk is always 0 (because of zflag) 
    310                      zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji+1,jj) ) ) ! 0 if no ice 
    311                      zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj) ) )   ! 0 if no ice 
    312                      !   
    313                      ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then do not change u_ice) 
    314                      u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & 
    315                         &            u_ice(ji-1,jj) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + & 
    316                         &            u_ice(ji  ,jj) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) ) 
    317                   ELSE                             ! everywhere else 
    318                      u_ice(ji,jj) = 0._wp 
    319                   ENDIF 
    320                   ! 
    321                END DO 
    322                CALL lbc_bdy_lnk( 'bdyice', u_ice(:,:), 'U', -1., jbdy ) 
    323                ! 
    324             CASE ( 'V' ) 
    325                jgrd = 3      ! v velocity 
    326                DO i_bdy = 1, idx_bdy(jbdy)%nblenrim(jgrd) 
    327                   ji    = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 
    328                   jj    = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 
    329                   zflag = idx_bdy(jbdy)%flagv(i_bdy,jgrd) 
    330                   ! 
    331                   IF ( ABS( zflag ) == 1. ) THEN  ! northern and southern boundaries 
    332                      ! one of the two zmsk is always 0 (because of zflag) 
    333                      zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj+1) ) ) ! 0 if no ice 
    334                      zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj) ) )   ! 0 if no ice 
    335                      !   
    336                      ! v_ice = v_ice of the adjacent grid point except if this grid point is ice-free (then do not change v_ice) 
    337                      v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & 
    338                         &            v_ice(ji,jj-1) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + & 
    339                         &            v_ice(ji,jj  ) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) ) 
    340                   ELSE                             ! everywhere else 
    341                      v_ice(ji,jj) = 0._wp 
    342                   ENDIF 
    343                   ! 
    344                END DO 
    345                CALL lbc_bdy_lnk( 'bdyice', v_ice(:,:), 'V', -1., jbdy ) 
    346                ! 
    347             END SELECT 
    348             ! 
    349          CASE DEFAULT 
    350             CALL ctl_stop( 'bdy_ice_dyn : unrecognised option for open boundaries for ice fields' ) 
     425         SELECT CASE ( cd_type )         
     426         CASE ( 'U' )  
     427         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 
     428         IF( nn_hls == 1 ) THEN   ;   llsend2(:) = .false.   ;   llrecv2(:) = .false.   ;   END IF 
     429            DO jbdy = 1, nb_bdy 
     430               IF( cn_ice(jbdy) == 'frs' .AND. nn_ice_dta(jbdy) /= 0 ) THEN 
     431                  llsend2(:) = llsend2(:) .OR. lsend_bdyint(jbdy,2,:,ir)   ! possibly every direction, U points 
     432                  llsend2(1) = llsend2(1) .OR. lsend_bdyext(jbdy,2,1,ir)   ! neighbour might search point towards its west bdy 
     433                  llrecv2(:) = llrecv2(:) .OR. lrecv_bdyint(jbdy,2,:,ir)   ! possibly every direction, U points 
     434                  llrecv2(2) = llrecv2(2) .OR. lrecv_bdyext(jbdy,2,2,ir)   ! might search point towards east bdy 
     435               END IF 
     436            END DO 
     437            IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction 
     438               CALL lbc_lnk( 'bdyice', u_ice, 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 
     439            END IF 
     440         CASE ( 'V' ) 
     441         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 
     442         IF( nn_hls == 1 ) THEN   ;   llsend3(:) = .false.   ;   llrecv3(:) = .false.   ;   END IF 
     443            DO jbdy = 1, nb_bdy 
     444               IF( cn_ice(jbdy) == 'frs' .AND. nn_ice_dta(jbdy) /= 0 ) THEN 
     445                  llsend3(:) = llsend3(:) .OR. lsend_bdyint(jbdy,3,:,ir)   ! possibly every direction, V points 
     446                  llsend3(3) = llsend3(3) .OR. lsend_bdyext(jbdy,3,3,ir)   ! neighbour might search point towards its south bdy 
     447                  llrecv3(:) = llrecv3(:) .OR. lrecv_bdyint(jbdy,3,:,ir)   ! possibly every direction, V points 
     448                  llrecv3(4) = llrecv3(4) .OR. lrecv_bdyext(jbdy,3,4,ir)   ! might search point towards north bdy 
     449               END IF 
     450            END DO 
     451            IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction 
     452               CALL lbc_lnk( 'bdyice', v_ice, 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 
     453            END IF 
    351454         END SELECT 
    352          ! 
    353       END DO 
     455      END DO   ! ir 
    354456      ! 
    355457      IF( ln_timing )   CALL timing_stop('bdy_ice_dyn') 

  • NEMO/trunk/src/OCE/BDY/bdyini.F90

    r10983 r11536  
    3333   PRIVATE 
    3434 
    35    PUBLIC   bdy_init   ! routine called in nemo_init 
     35   PUBLIC   bdy_init    ! routine called in nemo_init 
     36   PUBLIC   find_neib   ! routine called in bdy_nmn 
    3637 
    3738   INTEGER, PARAMETER ::   jp_nseg = 100   !  
    38    INTEGER, PARAMETER ::   nrimmax =  20   ! maximum rimwidth in structured 
    39                                                ! open boundary data files 
    4039   ! Straight open boundary segment parameters: 
    4140   INTEGER  ::   nbdysege, nbdysegw, nbdysegn, nbdysegs  
    … …  
    6867         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 
    6968         &             cn_ice, nn_ice_dta,                                     & 
    70          &             rn_ice_tem, rn_ice_sal, rn_ice_age,                     & 
    71          &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy 
     69         &             ln_vol, nn_volctl, nn_rimwidth 
    7270         ! 
    7371      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    … …  
    7977      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries 
    8078      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 901) 
    81 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 
     79901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist' ) 
     80      ! make sur that all elements of the namelist variables have a default definition from namelist_ref 
     81      ln_coords_file (2:jp_bdy) = ln_coords_file (1) 
     82      cn_coords_file (2:jp_bdy) = cn_coords_file (1) 
     83      cn_dyn2d       (2:jp_bdy) = cn_dyn2d       (1) 
     84      nn_dyn2d_dta   (2:jp_bdy) = nn_dyn2d_dta   (1) 
     85      cn_dyn3d       (2:jp_bdy) = cn_dyn3d       (1) 
     86      nn_dyn3d_dta   (2:jp_bdy) = nn_dyn3d_dta   (1) 
     87      cn_tra         (2:jp_bdy) = cn_tra         (1) 
     88      nn_tra_dta     (2:jp_bdy) = nn_tra_dta     (1)     
     89      ln_tra_dmp     (2:jp_bdy) = ln_tra_dmp     (1) 
     90      ln_dyn3d_dmp   (2:jp_bdy) = ln_dyn3d_dmp   (1) 
     91      rn_time_dmp    (2:jp_bdy) = rn_time_dmp    (1) 
     92      rn_time_dmp_out(2:jp_bdy) = rn_time_dmp_out(1) 
     93      cn_ice         (2:jp_bdy) = cn_ice         (1) 
     94      nn_ice_dta     (2:jp_bdy) = nn_ice_dta     (1) 
    8295      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries 
    8396      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 ) 
    84 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 
     97902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist' ) 
    8598      IF(lwm) WRITE ( numond, nambdy ) 
    8699 
    87100      IF( .NOT. Agrif_Root() ) ln_bdy = .FALSE.   ! forced for Agrif children 
     101 
     102      IF( nb_bdy == 0 ) ln_bdy = .FALSE. 
    88103       
    89104      ! ----------------------------------------- 
    … …  
    96111         ! 
    97112         ! Open boundaries definition (arrays and masks) 
    98          CALL bdy_segs 
     113         CALL bdy_def 
     114         IF( ln_meshmask )   CALL bdy_meshwri() 
    99115         ! 
    100116         ! Open boundaries initialisation of external data arrays 
    … …  
    114130 
    115131 
    116    SUBROUTINE bdy_segs 
     132   SUBROUTINE bdy_def 
    117133      !!---------------------------------------------------------------------- 
    118134      !!                 ***  ROUTINE bdy_init  *** 
    … …  
    125141      !! ** Input   :  bdy_init.nc, input file for unstructured open boundaries 
    126142      !!----------------------------------------------------------------------       
    127       INTEGER  ::   ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices 
    128       INTEGER  ::   icount, icountr, ibr_max, ilen1, ibm1  ! local integers 
     143      INTEGER  ::   ib_bdy, ii, ij, igrd, ib, ir, iseg     ! dummy loop indices 
     144      INTEGER  ::   icount, icountr, icountr0, ibr_max     ! local integers 
     145      INTEGER  ::   ilen1                                  !   -       - 
    129146      INTEGER  ::   iwe, ies, iso, ino, inum, id_dummy     !   -       - 
    130       INTEGER  ::   igrd_start, igrd_end, jpbdta           !   -       - 
    131       INTEGER  ::   jpbdtau, jpbdtas                       !   -       - 
     147      INTEGER  ::   jpbdta                                 !   -       - 
    132148      INTEGER  ::   ib_bdy1, ib_bdy2, ib1, ib2             !   -       - 
    133       INTEGER  ::   i_offset, j_offset                     !   -       - 
    134       INTEGER , POINTER  ::  nbi, nbj, nbr                 ! short cuts 
    135       REAL(wp), POINTER, DIMENSION(:,:)       ::   pmask    ! pointer to 2D mask fields 
    136       REAL(wp) ::   zefl, zwfl, znfl, zsfl                 ! local scalars 
    137       INTEGER, DIMENSION (2)                  ::   kdimsz 
    138       INTEGER, DIMENSION(jpbgrd,jp_bdy)       ::   nblendta         ! Length of index arrays  
    139       INTEGER, ALLOCATABLE, DIMENSION(:,:,:)  ::   nbidta, nbjdta   ! Index arrays: i and j indices of bdy dta 
    140       INTEGER, ALLOCATABLE, DIMENSION(:,:,:)  ::   nbrdta           ! Discrete distance from rim points 
    141       CHARACTER(LEN=1),DIMENSION(jpbgrd)      ::   cgrid 
    142       INTEGER :: com_east, com_west, com_south, com_north, jpk_max  ! Flags for boundaries sending 
    143       INTEGER :: com_east_b, com_west_b, com_south_b, com_north_b  ! Flags for boundaries receiving 
    144       INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4)                ! Arrays for neighbours coordinates 
    145       REAL(wp), TARGET, DIMENSION(jpi,jpj) ::   zfmask  ! temporary fmask array excluding coastal boundary condition (shlat) 
    146       !! 
    147       CHARACTER(LEN=1)                     ::   ctypebdy   !     -        -  
    148       INTEGER                              ::   nbdyind, nbdybeg, nbdyend 
    149       !! 
    150       NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend 
    151       INTEGER  ::   ios                 ! Local integer output status for namelist read 
     149      INTEGER  ::   ii1, ii2, ii3, ij1, ij2, ij3           !   -       - 
     150      INTEGER  ::   iibe, ijbe, iibi, ijbi                 !   -       - 
     151      INTEGER  ::   flagu, flagv                           ! short cuts 
     152      INTEGER  ::   nbdyind, nbdybeg, nbdyend 
     153      INTEGER              , DIMENSION(4)             ::   kdimsz 
     154      INTEGER              , DIMENSION(jpbgrd,jp_bdy) ::   nblendta          ! Length of index arrays  
     155      INTEGER,  ALLOCATABLE, DIMENSION(:,:,:)         ::   nbidta, nbjdta    ! Index arrays: i and j indices of bdy dta 
     156      INTEGER,  ALLOCATABLE, DIMENSION(:,:,:)         ::   nbrdta            ! Discrete distance from rim points 
     157      CHARACTER(LEN=1)     , DIMENSION(jpbgrd)        ::   cgrid 
     158      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     ::   zz_read                 ! work space for 2D global boundary data 
     159      REAL(wp), POINTER    , DIMENSION(:,:)     ::   zmask                   ! pointer to 2D mask fields 
     160      REAL(wp)             , DIMENSION(jpi,jpj) ::   zfmask   ! temporary fmask array excluding coastal boundary condition (shlat) 
     161      REAL(wp)             , DIMENSION(jpi,jpj) ::   ztmask, zumask, zvmask  ! temporary u/v mask array 
    152162      !!---------------------------------------------------------------------- 
    153163      ! 
    … …  
    160170         &                               ' and general open boundary condition are not compatible' ) 
    161171 
    162       IF( nb_bdy == 0 ) THEN  
    163         IF(lwp) WRITE(numout,*) 'nb_bdy = 0, NO OPEN BOUNDARIES APPLIED.' 
    164       ELSE 
    165         IF(lwp) WRITE(numout,*) 'Number of open boundary sets : ', nb_bdy 
     172      IF(lwp) WRITE(numout,*) 'Number of open boundary sets : ', nb_bdy 
     173 
     174      DO ib_bdy = 1,nb_bdy 
     175 
     176         IF(lwp) THEN 
     177            WRITE(numout,*) ' '  
     178            WRITE(numout,*) '------ Open boundary data set ',ib_bdy,' ------'  
     179            IF( ln_coords_file(ib_bdy) ) THEN 
     180               WRITE(numout,*) 'Boundary definition read from file '//TRIM(cn_coords_file(ib_bdy)) 
     181            ELSE 
     182               WRITE(numout,*) 'Boundary defined in namelist.' 
     183            ENDIF 
     184            WRITE(numout,*) 
     185         ENDIF 
     186 
     187         ! barotropic bdy 
     188         !---------------- 
     189         IF(lwp) THEN 
     190            WRITE(numout,*) 'Boundary conditions for barotropic solution:  ' 
     191            SELECT CASE( cn_dyn2d(ib_bdy) )                   
     192            CASE( 'none' )           ;   WRITE(numout,*) '      no open boundary condition'         
     193            CASE( 'frs' )            ;   WRITE(numout,*) '      Flow Relaxation Scheme' 
     194            CASE( 'flather' )        ;   WRITE(numout,*) '      Flather radiation condition' 
     195            CASE( 'orlanski' )       ;   WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging' 
     196            CASE( 'orlanski_npo' )   ;   WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging' 
     197            CASE DEFAULT             ;   CALL ctl_stop( 'unrecognised value for cn_dyn2d' ) 
     198            END SELECT 
     199         ENDIF 
     200 
     201         dta_bdy(ib_bdy)%lneed_ssh   = cn_dyn2d(ib_bdy) == 'flather' 
     202         dta_bdy(ib_bdy)%lneed_dyn2d = cn_dyn2d(ib_bdy) /= 'none' 
     203 
     204         IF( lwp .AND. dta_bdy(ib_bdy)%lneed_dyn2d ) THEN 
     205            SELECT CASE( nn_dyn2d_dta(ib_bdy) )                   !  
     206            CASE( 0 )      ;   WRITE(numout,*) '      initial state used for bdy data'         
     207            CASE( 1 )      ;   WRITE(numout,*) '      boundary data taken from file' 
     208            CASE( 2 )      ;   WRITE(numout,*) '      tidal harmonic forcing taken from file' 
     209            CASE( 3 )      ;   WRITE(numout,*) '      boundary data AND tidal harmonic forcing taken from files' 
     210            CASE DEFAULT   ;   CALL ctl_stop( 'nn_dyn2d_dta must be between 0 and 3' ) 
     211            END SELECT 
     212         ENDIF 
     213         IF ( dta_bdy(ib_bdy)%lneed_dyn2d .AND. nn_dyn2d_dta(ib_bdy) .GE. 2  .AND. .NOT.ln_tide ) THEN 
     214            CALL ctl_stop( 'You must activate with ln_tide to add tidal forcing at open boundaries' ) 
     215         ENDIF 
     216         IF(lwp) WRITE(numout,*) 
     217 
     218         ! baroclinic bdy 
     219         !---------------- 
     220         IF(lwp) THEN 
     221            WRITE(numout,*) 'Boundary conditions for baroclinic velocities:  ' 
     222            SELECT CASE( cn_dyn3d(ib_bdy) )                   
     223            CASE('none')           ;   WRITE(numout,*) '      no open boundary condition'         
     224            CASE('frs')            ;   WRITE(numout,*) '      Flow Relaxation Scheme' 
     225            CASE('specified')      ;   WRITE(numout,*) '      Specified value' 
     226            CASE('neumann')        ;   WRITE(numout,*) '      Neumann conditions' 
     227            CASE('zerograd')       ;   WRITE(numout,*) '      Zero gradient for baroclinic velocities' 
     228            CASE('zero')           ;   WRITE(numout,*) '      Zero baroclinic velocities (runoff case)' 
     229            CASE('orlanski')       ;   WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging' 
     230            CASE('orlanski_npo')   ;   WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging' 
     231            CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_dyn3d' ) 
     232            END SELECT 
     233         ENDIF 
     234 
     235         dta_bdy(ib_bdy)%lneed_dyn3d = cn_dyn3d(ib_bdy) == 'frs'      .OR. cn_dyn3d(ib_bdy) == 'specified'   & 
     236            &                     .OR. cn_dyn3d(ib_bdy) == 'orlanski' .OR. cn_dyn3d(ib_bdy) == 'orlanski_npo' 
     237 
     238         IF( lwp .AND. dta_bdy(ib_bdy)%lneed_dyn3d ) THEN 
     239            SELECT CASE( nn_dyn3d_dta(ib_bdy) )                   !  
     240            CASE( 0 )      ;   WRITE(numout,*) '      initial state used for bdy data'         
     241            CASE( 1 )      ;   WRITE(numout,*) '      boundary data taken from file' 
     242            CASE DEFAULT   ;   CALL ctl_stop( 'nn_dyn3d_dta must be 0 or 1' ) 
     243            END SELECT 
     244         END IF 
     245 
     246         IF ( ln_dyn3d_dmp(ib_bdy) ) THEN 
     247            IF ( cn_dyn3d(ib_bdy) == 'none' ) THEN 
     248               IF(lwp) WRITE(numout,*) 'No open boundary condition for baroclinic velocities: ln_dyn3d_dmp is set to .false.' 
     249               ln_dyn3d_dmp(ib_bdy) = .false. 
     250            ELSEIF ( cn_dyn3d(ib_bdy) == 'frs' ) THEN 
     251               CALL ctl_stop( 'Use FRS OR relaxation' ) 
     252            ELSE 
     253               IF(lwp) WRITE(numout,*) '      + baroclinic velocities relaxation zone' 
     254               IF(lwp) WRITE(numout,*) '      Damping time scale: ',rn_time_dmp(ib_bdy),' days' 
     255               IF(rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' ) 
     256               dta_bdy(ib_bdy)%lneed_dyn3d = .TRUE. 
     257            ENDIF 
     258         ELSE 
     259            IF(lwp) WRITE(numout,*) '      NO relaxation on baroclinic velocities' 
     260         ENDIF 
     261         IF(lwp) WRITE(numout,*) 
     262 
     263         !    tra bdy 
     264         !---------------- 
     265         IF(lwp) THEN 
     266            WRITE(numout,*) 'Boundary conditions for temperature and salinity:  ' 
     267            SELECT CASE( cn_tra(ib_bdy) )                   
     268            CASE('none')           ;   WRITE(numout,*) '      no open boundary condition'         
     269            CASE('frs')            ;   WRITE(numout,*) '      Flow Relaxation Scheme' 
     270            CASE('specified')      ;   WRITE(numout,*) '      Specified value' 
     271            CASE('neumann')        ;   WRITE(numout,*) '      Neumann conditions' 
     272            CASE('runoff')         ;   WRITE(numout,*) '      Runoff conditions : Neumann for T and specified to 0.1 for salinity' 
     273            CASE('orlanski')       ;   WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging' 
     274            CASE('orlanski_npo')   ;   WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging' 
     275            CASE DEFAULT           ;   CALL ctl_stop( 'unrecognised value for cn_tra' ) 
     276            END SELECT 
     277         ENDIF 
     278 
     279         dta_bdy(ib_bdy)%lneed_tra = cn_tra(ib_bdy) == 'frs'       .OR. cn_tra(ib_bdy) == 'specified'   & 
     280            &                   .OR. cn_tra(ib_bdy) == 'orlanski'  .OR. cn_tra(ib_bdy) == 'orlanski_npo'  
     281 
     282         IF( lwp .AND. dta_bdy(ib_bdy)%lneed_tra ) THEN 
     283            SELECT CASE( nn_tra_dta(ib_bdy) )                   !  
     284            CASE( 0 )      ;   WRITE(numout,*) '      initial state used for bdy data'         
     285            CASE( 1 )      ;   WRITE(numout,*) '      boundary data taken from file' 
     286            CASE DEFAULT   ;   CALL ctl_stop( 'nn_tra_dta must be 0 or 1' ) 
     287            END SELECT 
     288         ENDIF 
     289 
     290         IF ( ln_tra_dmp(ib_bdy) ) THEN 
     291            IF ( cn_tra(ib_bdy) == 'none' ) THEN 
     292               IF(lwp) WRITE(numout,*) 'No open boundary condition for tracers: ln_tra_dmp is set to .false.' 
     293               ln_tra_dmp(ib_bdy) = .false. 
     294            ELSEIF ( cn_tra(ib_bdy) == 'frs' ) THEN 
     295               CALL ctl_stop( 'Use FRS OR relaxation' ) 
     296            ELSE 
     297               IF(lwp) WRITE(numout,*) '      + T/S relaxation zone' 
     298               IF(lwp) WRITE(numout,*) '      Damping time scale: ',rn_time_dmp(ib_bdy),' days' 
     299               IF(lwp) WRITE(numout,*) '      Outflow damping time scale: ',rn_time_dmp_out(ib_bdy),' days' 
     300               IF(lwp.AND.rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' ) 
     301               dta_bdy(ib_bdy)%lneed_tra = .TRUE. 
     302            ENDIF 
     303         ELSE 
     304            IF(lwp) WRITE(numout,*) '      NO T/S relaxation' 
     305         ENDIF 
     306         IF(lwp) WRITE(numout,*) 
     307 
     308#if defined key_si3 
     309         IF(lwp) THEN 
     310            WRITE(numout,*) 'Boundary conditions for sea ice:  ' 
     311            SELECT CASE( cn_ice(ib_bdy) )                   
     312            CASE('none')   ;   WRITE(numout,*) '      no open boundary condition'         
     313            CASE('frs')    ;   WRITE(numout,*) '      Flow Relaxation Scheme' 
     314            CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice' ) 
     315            END SELECT 
     316         ENDIF 
     317 
     318         dta_bdy(ib_bdy)%lneed_ice = cn_ice(ib_bdy) /= 'none' 
     319 
     320         IF( lwp .AND. dta_bdy(ib_bdy)%lneed_ice ) THEN  
     321            SELECT CASE( nn_ice_dta(ib_bdy) )                   !  
     322            CASE( 0 )      ;   WRITE(numout,*) '      initial state used for bdy data'         
     323            CASE( 1 )      ;   WRITE(numout,*) '      boundary data taken from file' 
     324            CASE DEFAULT   ;   CALL ctl_stop( 'nn_ice_dta must be 0 or 1' ) 
     325            END SELECT 
     326         ENDIF 
     327#else 
     328         dta_bdy(ib_bdy)%lneed_ice = .FALSE. 
     329#endif 
     330         ! 
     331         IF(lwp) WRITE(numout,*) 
     332         IF(lwp) WRITE(numout,*) '      Width of relaxation zone = ', nn_rimwidth(ib_bdy) 
     333         IF(lwp) WRITE(numout,*) 
     334         ! 
     335      END DO   ! nb_bdy 
     336 
     337      IF( lwp ) THEN 
     338         IF( ln_vol ) THEN                     ! check volume conservation (nn_volctl value) 
     339            WRITE(numout,*) 'Volume correction applied at open boundaries' 
     340            WRITE(numout,*) 
     341            SELECT CASE ( nn_volctl ) 
     342            CASE( 1 )      ;   WRITE(numout,*) '      The total volume will be constant' 
     343            CASE( 0 )      ;   WRITE(numout,*) '      The total volume will vary according to the surface E-P flux' 
     344            CASE DEFAULT   ;   CALL ctl_stop( 'nn_volctl must be 0 or 1' ) 
     345            END SELECT 
     346            WRITE(numout,*) 
     347            ! 
     348            ! sanity check if used with tides         
     349            IF( ln_tide ) THEN  
     350               WRITE(numout,*) ' The total volume correction is not working with tides. ' 
     351               WRITE(numout,*) ' Set ln_vol to .FALSE. ' 
     352               WRITE(numout,*) ' or ' 
     353               WRITE(numout,*) ' equilibriate your bdy input files ' 
     354               CALL ctl_stop( 'The total volume correction is not working with tides.' ) 
     355            END IF 
     356         ELSE 
     357            WRITE(numout,*) 'No volume correction applied at open boundaries' 
     358            WRITE(numout,*) 
     359         ENDIF 
    166360      ENDIF 
    167  
    168       DO ib_bdy = 1,nb_bdy 
    169         IF(lwp) WRITE(numout,*) ' '  
    170         IF(lwp) WRITE(numout,*) '------ Open boundary data set ',ib_bdy,'------'  
    171  
    172         IF( ln_coords_file(ib_bdy) ) THEN 
    173            IF(lwp) WRITE(numout,*) 'Boundary definition read from file '//TRIM(cn_coords_file(ib_bdy)) 
    174         ELSE 
    175            IF(lwp) WRITE(numout,*) 'Boundary defined in namelist.' 
    176         ENDIF 
    177         IF(lwp) WRITE(numout,*) 
    178  
    179         IF(lwp) WRITE(numout,*) 'Boundary conditions for barotropic solution:  ' 
    180         SELECT CASE( cn_dyn2d(ib_bdy) )                   
    181           CASE( 'none' )          
    182              IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    183              dta_bdy(ib_bdy)%ll_ssh = .false. 
    184              dta_bdy(ib_bdy)%ll_u2d = .false. 
    185              dta_bdy(ib_bdy)%ll_v2d = .false. 
    186           CASE( 'frs' )           
    187              IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    188              dta_bdy(ib_bdy)%ll_ssh = .false. 
    189              dta_bdy(ib_bdy)%ll_u2d = .true. 
    190              dta_bdy(ib_bdy)%ll_v2d = .true. 
    191           CASE( 'flather' )       
    192              IF(lwp) WRITE(numout,*) '      Flather radiation condition' 
    193              dta_bdy(ib_bdy)%ll_ssh = .true. 
    194              dta_bdy(ib_bdy)%ll_u2d = .true. 
    195              dta_bdy(ib_bdy)%ll_v2d = .true. 
    196           CASE( 'orlanski' )      
    197              IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging' 
    198              dta_bdy(ib_bdy)%ll_ssh = .false. 
    199              dta_bdy(ib_bdy)%ll_u2d = .true. 
    200              dta_bdy(ib_bdy)%ll_v2d = .true. 
    201           CASE( 'orlanski_npo' )  
    202              IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging' 
    203              dta_bdy(ib_bdy)%ll_ssh = .false. 
    204              dta_bdy(ib_bdy)%ll_u2d = .true. 
    205              dta_bdy(ib_bdy)%ll_v2d = .true. 
    206           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_dyn2d' ) 
    207         END SELECT 
    208         IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN 
    209            SELECT CASE( nn_dyn2d_dta(ib_bdy) )                   !  
    210               CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    211               CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file' 
    212               CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '      tidal harmonic forcing taken from file' 
    213               CASE( 3 )      ;   IF(lwp) WRITE(numout,*) '      boundary data AND tidal harmonic forcing taken from files' 
    214               CASE DEFAULT   ;   CALL ctl_stop( 'nn_dyn2d_dta must be between 0 and 3' ) 
    215            END SELECT 
    216            IF (( nn_dyn2d_dta(ib_bdy) .ge. 2 ).AND.(.NOT.ln_tide)) THEN 
    217              CALL ctl_stop( 'You must activate with ln_tide to add tidal forcing at open boundaries' ) 
    218            ENDIF 
    219         ENDIF 
    220         IF(lwp) WRITE(numout,*) 
    221  
    222         IF(lwp) WRITE(numout,*) 'Boundary conditions for baroclinic velocities:  ' 
    223         SELECT CASE( cn_dyn3d(ib_bdy) )                   
    224           CASE('none') 
    225              IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    226              dta_bdy(ib_bdy)%ll_u3d = .false. 
    227              dta_bdy(ib_bdy)%ll_v3d = .false. 
    228           CASE('frs')        
    229              IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    230              dta_bdy(ib_bdy)%ll_u3d = .true. 
    231              dta_bdy(ib_bdy)%ll_v3d = .true. 
    232           CASE('specified') 
    233              IF(lwp) WRITE(numout,*) '      Specified value' 
    234              dta_bdy(ib_bdy)%ll_u3d = .true. 
    235              dta_bdy(ib_bdy)%ll_v3d = .true. 
    236           CASE('neumann') 
    237              IF(lwp) WRITE(numout,*) '      Neumann conditions' 
    238              dta_bdy(ib_bdy)%ll_u3d = .false. 
    239              dta_bdy(ib_bdy)%ll_v3d = .false. 
    240           CASE('zerograd') 
    241              IF(lwp) WRITE(numout,*) '      Zero gradient for baroclinic velocities' 
    242              dta_bdy(ib_bdy)%ll_u3d = .false. 
    243              dta_bdy(ib_bdy)%ll_v3d = .false. 
    244           CASE('zero') 
    245              IF(lwp) WRITE(numout,*) '      Zero baroclinic velocities (runoff case)' 
    246              dta_bdy(ib_bdy)%ll_u3d = .false. 
    247              dta_bdy(ib_bdy)%ll_v3d = .false. 
    248           CASE('orlanski') 
    249              IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging' 
    250              dta_bdy(ib_bdy)%ll_u3d = .true. 
    251              dta_bdy(ib_bdy)%ll_v3d = .true. 
    252           CASE('orlanski_npo') 
    253              IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging' 
    254              dta_bdy(ib_bdy)%ll_u3d = .true. 
    255              dta_bdy(ib_bdy)%ll_v3d = .true. 
    256           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_dyn3d' ) 
    257         END SELECT 
    258         IF( cn_dyn3d(ib_bdy) /= 'none' ) THEN 
    259            SELECT CASE( nn_dyn3d_dta(ib_bdy) )                   !  
    260               CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    261               CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file' 
    262               CASE DEFAULT   ;   CALL ctl_stop( 'nn_dyn3d_dta must be 0 or 1' ) 
    263            END SELECT 
    264         ENDIF 
    265  
    266         IF ( ln_dyn3d_dmp(ib_bdy) ) THEN 
    267            IF ( cn_dyn3d(ib_bdy) == 'none' ) THEN 
    268               IF(lwp) WRITE(numout,*) 'No open boundary condition for baroclinic velocities: ln_dyn3d_dmp is set to .false.' 
    269               ln_dyn3d_dmp(ib_bdy)=.false. 
    270            ELSEIF ( cn_dyn3d(ib_bdy) == 'frs' ) THEN 
    271               CALL ctl_stop( 'Use FRS OR relaxation' ) 
    272            ELSE 
    273               IF(lwp) WRITE(numout,*) '      + baroclinic velocities relaxation zone' 
    274               IF(lwp) WRITE(numout,*) '      Damping time scale: ',rn_time_dmp(ib_bdy),' days' 
    275               IF((lwp).AND.rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' ) 
    276               dta_bdy(ib_bdy)%ll_u3d = .true. 
    277               dta_bdy(ib_bdy)%ll_v3d = .true. 
    278            ENDIF 
    279         ELSE 
    280            IF(lwp) WRITE(numout,*) '      NO relaxation on baroclinic velocities' 
    281         ENDIF 
    282         IF(lwp) WRITE(numout,*) 
    283  
    284         IF(lwp) WRITE(numout,*) 'Boundary conditions for temperature and salinity:  ' 
    285         SELECT CASE( cn_tra(ib_bdy) )                   
    286           CASE('none') 
    287              IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    288              dta_bdy(ib_bdy)%ll_tem = .false. 
    289              dta_bdy(ib_bdy)%ll_sal = .false. 
    290           CASE('frs') 
    291              IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    292              dta_bdy(ib_bdy)%ll_tem = .true. 
    293              dta_bdy(ib_bdy)%ll_sal = .true. 
    294           CASE('specified') 
    295              IF(lwp) WRITE(numout,*) '      Specified value' 
    296              dta_bdy(ib_bdy)%ll_tem = .true. 
    297              dta_bdy(ib_bdy)%ll_sal = .true. 
    298           CASE('neumann') 
    299              IF(lwp) WRITE(numout,*) '      Neumann conditions' 
    300              dta_bdy(ib_bdy)%ll_tem = .false. 
    301              dta_bdy(ib_bdy)%ll_sal = .false. 
    302           CASE('runoff') 
    303              IF(lwp) WRITE(numout,*) '      Runoff conditions : Neumann for T and specified to 0.1 for salinity' 
    304              dta_bdy(ib_bdy)%ll_tem = .false. 
    305              dta_bdy(ib_bdy)%ll_sal = .false. 
    306           CASE('orlanski') 
    307              IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging' 
    308              dta_bdy(ib_bdy)%ll_tem = .true. 
    309              dta_bdy(ib_bdy)%ll_sal = .true. 
    310           CASE('orlanski_npo') 
    311              IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging' 
    312              dta_bdy(ib_bdy)%ll_tem = .true. 
    313              dta_bdy(ib_bdy)%ll_sal = .true. 
    314           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_tra' ) 
    315         END SELECT 
    316         IF( cn_tra(ib_bdy) /= 'none' ) THEN 
    317            SELECT CASE( nn_tra_dta(ib_bdy) )                   !  
    318               CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    319               CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file' 
    320               CASE DEFAULT   ;   CALL ctl_stop( 'nn_tra_dta must be 0 or 1' ) 
    321            END SELECT 
    322         ENDIF 
    323  
    324         IF ( ln_tra_dmp(ib_bdy) ) THEN 
    325            IF ( cn_tra(ib_bdy) == 'none' ) THEN 
    326               IF(lwp) WRITE(numout,*) 'No open boundary condition for tracers: ln_tra_dmp is set to .false.' 
    327               ln_tra_dmp(ib_bdy)=.false. 
    328            ELSEIF ( cn_tra(ib_bdy) == 'frs' ) THEN 
    329               CALL ctl_stop( 'Use FRS OR relaxation' ) 
    330            ELSE 
    331               IF(lwp) WRITE(numout,*) '      + T/S relaxation zone' 
    332               IF(lwp) WRITE(numout,*) '      Damping time scale: ',rn_time_dmp(ib_bdy),' days' 
    333               IF(lwp) WRITE(numout,*) '      Outflow damping time scale: ',rn_time_dmp_out(ib_bdy),' days' 
    334               IF((lwp).AND.rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' ) 
    335               dta_bdy(ib_bdy)%ll_tem = .true. 
    336               dta_bdy(ib_bdy)%ll_sal = .true. 
    337            ENDIF 
    338         ELSE 
    339            IF(lwp) WRITE(numout,*) '      NO T/S relaxation' 
    340         ENDIF 
    341         IF(lwp) WRITE(numout,*) 
    342  
    343 #if defined key_si3 
    344          IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  ' 
    345          SELECT CASE( cn_ice(ib_bdy) )                   
    346          CASE('none') 
    347              IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    348              dta_bdy(ib_bdy)%ll_a_i = .false. 
    349              dta_bdy(ib_bdy)%ll_h_i = .false. 
    350              dta_bdy(ib_bdy)%ll_h_s = .false. 
    351          CASE('frs') 
    352              IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    353              dta_bdy(ib_bdy)%ll_a_i = .true. 
    354              dta_bdy(ib_bdy)%ll_h_i = .true. 
    355              dta_bdy(ib_bdy)%ll_h_s = .true. 
    356          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice' ) 
    357          END SELECT 
    358         IF( cn_ice(ib_bdy) /= 'none' ) THEN  
    359            SELECT CASE( nn_ice_dta(ib_bdy) )                   !  
    360               CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    361               CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file' 
    362               CASE DEFAULT   ;   CALL ctl_stop( 'nn_ice_dta must be 0 or 1' ) 
    363            END SELECT 
    364         ENDIF 
    365         IF(lwp) WRITE(numout,*) 
    366         IF(lwp) WRITE(numout,*) '      tem of bdy sea-ice = ', rn_ice_tem(ib_bdy)          
    367         IF(lwp) WRITE(numout,*) '      sal of bdy sea-ice = ', rn_ice_sal(ib_bdy)          
    368         IF(lwp) WRITE(numout,*) '      age of bdy sea-ice = ', rn_ice_age(ib_bdy)          
    369 #endif 
    370  
    371         IF(lwp) WRITE(numout,*) '      Width of relaxation zone = ', nn_rimwidth(ib_bdy) 
    372         IF(lwp) WRITE(numout,*) 
    373          ! 
    374       END DO 
    375  
    376      IF( nb_bdy > 0 ) THEN 
    377         IF( ln_vol ) THEN                     ! check volume conservation (nn_volctl value) 
    378           IF(lwp) WRITE(numout,*) 'Volume correction applied at open boundaries' 
    379           IF(lwp) WRITE(numout,*) 
    380           SELECT CASE ( nn_volctl ) 
    381             CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      The total volume will be constant' 
    382             CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      The total volume will vary according to the surface E-P flux' 
    383             CASE DEFAULT   ;   CALL ctl_stop( 'nn_volctl must be 0 or 1' ) 
    384           END SELECT 
    385           IF(lwp) WRITE(numout,*) 
    386           ! 
    387           ! sanity check if used with tides         
    388           IF( ln_tide ) THEN  
    389              IF(lwp) WRITE(numout,*) ' The total volume correction is not working with tides. ' 
    390              IF(lwp) WRITE(numout,*) ' Set ln_vol to .FALSE. ' 
    391              IF(lwp) WRITE(numout,*) ' or ' 
    392              IF(lwp) WRITE(numout,*) ' equilibriate your bdy input files ' 
    393              CALL ctl_stop( 'The total volume correction is not working with tides.' ) 
    394           END IF 
    395         ELSE 
    396           IF(lwp) WRITE(numout,*) 'No volume correction applied at open boundaries' 
    397           IF(lwp) WRITE(numout,*) 
    398         ENDIF 
    399         IF( nb_jpk_bdy(ib_bdy) > 0 ) THEN 
    400            IF(lwp) WRITE(numout,*) '*** open boundary will be interpolate in the vertical onto the native grid ***' 
    401         ELSE 
    402            IF(lwp) WRITE(numout,*) '*** open boundary will be read straight onto the native grid without vertical interpolation ***' 
    403         ENDIF 
    404      ENDIF 
    405361 
    406362      ! ------------------------------------------------- 
    … …  
    408364      ! ------------------------------------------------- 
    409365 
    410       ! Work out global dimensions of boundary data 
    411       ! --------------------------------------------- 
    412366      REWIND( numnam_cfg )      
    413  
    414367      nblendta(:,:) = 0 
    415368      nbdysege = 0 
    … …  
    417370      nbdysegn = 0 
    418371      nbdysegs = 0 
    419       icount   = 0 ! count user defined segments 
    420       ! Dimensions below are used to allocate arrays to read external data 
    421       jpbdtas = 1 ! Maximum size of boundary data (structured case) 
    422       jpbdtau = 1 ! Maximum size of boundary data (unstructured case) 
    423  
     372 
     373      ! Define all boundaries  
     374      ! --------------------- 
    424375      DO ib_bdy = 1, nb_bdy 
    425  
    426          IF( .NOT. ln_coords_file(ib_bdy) ) THEN ! Work out size of global arrays from namelist parameters 
    427   
    428             icount = icount + 1 
    429             ! No REWIND here because may need to read more than one nambdy_index namelist. 
    430             ! Read only namelist_cfg to avoid unseccessfull overwrite  
    431             ! keep full control of the configuration namelist 
    432             READ  ( numnam_cfg, nambdy_index, IOSTAT = ios, ERR = 904 ) 
    433 904         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_index in configuration namelist', lwp ) 
    434             IF(lwm) WRITE ( numond, nambdy_index ) 
    435  
    436             SELECT CASE ( TRIM(ctypebdy) ) 
    437               CASE( 'N' ) 
    438                  IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1 
    439                     nbdyind  = jpjglo - 2  ! set boundary to whole side of model domain. 
    440                     nbdybeg  = 2 
    441                     nbdyend  = jpiglo - 1 
    442                  ENDIF 
    443                  nbdysegn = nbdysegn + 1 
    444                  npckgn(nbdysegn) = ib_bdy ! Save bdy package number 
    445                  jpjnob(nbdysegn) = nbdyind 
    446                  jpindt(nbdysegn) = nbdybeg 
    447                  jpinft(nbdysegn) = nbdyend 
    448                  ! 
    449               CASE( 'S' ) 
    450                  IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1 
    451                     nbdyind  = 2           ! set boundary to whole side of model domain. 
    452                     nbdybeg  = 2 
    453                     nbdyend  = jpiglo - 1 
    454                  ENDIF 
    455                  nbdysegs = nbdysegs + 1 
    456                  npckgs(nbdysegs) = ib_bdy ! Save bdy package number 
    457                  jpjsob(nbdysegs) = nbdyind 
    458                  jpisdt(nbdysegs) = nbdybeg 
    459                  jpisft(nbdysegs) = nbdyend 
    460                  ! 
    461               CASE( 'E' ) 
    462                  IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1 
    463                     nbdyind  = jpiglo - 2  ! set boundary to whole side of model domain. 
    464                     nbdybeg  = 2 
    465                     nbdyend  = jpjglo - 1 
    466                  ENDIF 
    467                  nbdysege = nbdysege + 1  
    468                  npckge(nbdysege) = ib_bdy ! Save bdy package number 
    469                  jpieob(nbdysege) = nbdyind 
    470                  jpjedt(nbdysege) = nbdybeg 
    471                  jpjeft(nbdysege) = nbdyend 
    472                  ! 
    473               CASE( 'W' ) 
    474                  IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1 
    475                     nbdyind  = 2           ! set boundary to whole side of model domain. 
    476                     nbdybeg  = 2 
    477                     nbdyend  = jpjglo - 1 
    478                  ENDIF 
    479                  nbdysegw = nbdysegw + 1 
    480                  npckgw(nbdysegw) = ib_bdy ! Save bdy package number 
    481                  jpiwob(nbdysegw) = nbdyind 
    482                  jpjwdt(nbdysegw) = nbdybeg 
    483                  jpjwft(nbdysegw) = nbdyend 
    484                  ! 
    485               CASE DEFAULT   ;   CALL ctl_stop( 'ctypebdy must be N, S, E or W' ) 
    486             END SELECT 
    487  
    488             ! For simplicity we assume that in case of straight bdy, arrays have the same length 
    489             ! (even if it is true that last tangential velocity points 
    490             ! are useless). This simplifies a little bit boundary data format (and agrees with format 
    491             ! used so far in obc package) 
    492  
    493             nblendta(1:jpbgrd,ib_bdy) =  (nbdyend - nbdybeg + 1) * nn_rimwidth(ib_bdy) 
    494             jpbdtas = MAX(jpbdtas, (nbdyend - nbdybeg + 1)) 
    495             IF (lwp.and.(nn_rimwidth(ib_bdy)>nrimmax)) & 
    496             & CALL ctl_stop( 'rimwidth must be lower than nrimmax' ) 
    497  
    498          ELSE            ! Read size of arrays in boundary coordinates file. 
     376         ! 
     377         IF( .NOT. ln_coords_file(ib_bdy) ) THEN     ! build bdy coordinates with segments defined in namelist 
     378 
     379            CALL bdy_read_seg( ib_bdy, nblendta(:,ib_bdy) ) 
     380 
     381         ELSE                                        ! Read size of arrays in boundary coordinates file. 
     382             
    499383            CALL iom_open( cn_coords_file(ib_bdy), inum ) 
    500384            DO igrd = 1, jpbgrd 
    501385               id_dummy = iom_varid( inum, 'nbi'//cgrid(igrd), kdimsz=kdimsz )   
    502386               nblendta(igrd,ib_bdy) = MAXVAL(kdimsz) 
    503                jpbdtau = MAX(jpbdtau, MAXVAL(kdimsz)) 
    504387            END DO 
    505388            CALL iom_close( inum ) 
    506             ! 
    507          ENDIF  
     389         ENDIF 
    508390         ! 
    509391      END DO ! ib_bdy 
    510392 
    511       IF (nb_bdy>0) THEN 
    512          jpbdta = MAXVAL(nblendta(1:jpbgrd,1:nb_bdy)) 
    513  
    514          ! Allocate arrays 
    515          !--------------- 
    516          ALLOCATE( nbidta(jpbdta, jpbgrd, nb_bdy), nbjdta(jpbdta, jpbgrd, nb_bdy),    & 
    517             &      nbrdta(jpbdta, jpbgrd, nb_bdy) ) 
    518           
    519          jpk_max = MAXVAL(nb_jpk_bdy) 
    520          jpk_max = MAX(jpk_max, jpk) 
    521  
    522          ALLOCATE( dta_global(jpbdtau, 1, jpk_max) ) 
    523          ALLOCATE( dta_global_z(jpbdtau, 1, jpk_max) ) ! needed ?? TODO 
    524          ALLOCATE( dta_global_dz(jpbdtau, 1, jpk_max) )! needed ?? TODO 
    525  
    526          IF ( icount>0 ) THEN 
    527             ALLOCATE( dta_global2(jpbdtas, nrimmax, jpk_max) ) 
    528             ALLOCATE( dta_global2_z(jpbdtas, nrimmax, jpk_max) ) ! needed ?? TODO 
    529             ALLOCATE( dta_global2_dz(jpbdtas, nrimmax, jpk_max) )! needed ?? TODO   
    530          ENDIF 
    531          !  
    532       ENDIF 
    533  
    534393      ! Now look for crossings in user (namelist) defined open boundary segments: 
    535       !-------------------------------------------------------------------------- 
    536       IF( icount>0 )   CALL bdy_ctl_seg 
    537  
     394      IF( nbdysege > 0 .OR. nbdysegw > 0 .OR. nbdysegn > 0 .OR. nbdysegs > 0)   CALL bdy_ctl_seg 
     395       
     396      ! Allocate arrays 
     397      !--------------- 
     398      jpbdta = MAXVAL(nblendta(1:jpbgrd,1:nb_bdy)) 
     399      ALLOCATE( nbidta(jpbdta, jpbgrd, nb_bdy), nbjdta(jpbdta, jpbgrd, nb_bdy), nbrdta(jpbdta, jpbgrd, nb_bdy) ) 
     400     
    538401      ! Calculate global boundary index arrays or read in from file 
    539402      !------------------------------------------------------------                
    … …  
    543406         IF( ln_coords_file(ib_bdy) ) THEN 
    544407            ! 
     408            ALLOCATE( zz_read( MAXVAL(nblendta), 1 ) )           
    545409            CALL iom_open( cn_coords_file(ib_bdy), inum ) 
     410            ! 
    546411            DO igrd = 1, jpbgrd 
    547                CALL iom_get( inum, jpdom_unknown, 'nbi'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) ) 
     412               CALL iom_get( inum, jpdom_unknown, 'nbi'//cgrid(igrd), zz_read(1:nblendta(igrd,ib_bdy),:) ) 
    548413               DO ii = 1,nblendta(igrd,ib_bdy) 
    549                   nbidta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) ) 
     414                  nbidta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) 
    550415               END DO 
    551                CALL iom_get( inum, jpdom_unknown, 'nbj'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) ) 
     416               CALL iom_get( inum, jpdom_unknown, 'nbj'//cgrid(igrd), zz_read(1:nblendta(igrd,ib_bdy),:) ) 
    552417               DO ii = 1,nblendta(igrd,ib_bdy) 
    553                   nbjdta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) ) 
     418                  nbjdta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) 
    554419               END DO 
    555                CALL iom_get( inum, jpdom_unknown, 'nbr'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) ) 
     420               CALL iom_get( inum, jpdom_unknown, 'nbr'//cgrid(igrd), zz_read(1:nblendta(igrd,ib_bdy),:) ) 
    556421               DO ii = 1,nblendta(igrd,ib_bdy) 
    557                   nbrdta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) ) 
     422                  nbrdta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) 
    558423               END DO 
    559424               ! 
    … …  
    563428               IF(lwp) WRITE(numout,*) ' nn_rimwidth from namelist is ', nn_rimwidth(ib_bdy) 
    564429               IF (ibr_max < nn_rimwidth(ib_bdy))   & 
    565                      CALL ctl_stop( 'nn_rimwidth is larger than maximum rimwidth in file',cn_coords_file(ib_bdy) ) 
    566             END DO 
     430                  CALL ctl_stop( 'nn_rimwidth is larger than maximum rimwidth in file',cn_coords_file(ib_bdy) ) 
     431            END DO 
     432            ! 
    567433            CALL iom_close( inum ) 
     434            DEALLOCATE( zz_read ) 
    568435            ! 
    569          ENDIF  
    570          ! 
    571       END DO       
    572      
     436         ENDIF 
     437         ! 
     438      END DO 
     439 
    573440      ! 2. Now fill indices corresponding to straight open boundary arrays: 
    574       ! East 
    575       !----- 
    576       DO iseg = 1, nbdysege 
    577          ib_bdy = npckge(iseg) 
    578          ! 
    579          ! ------------ T points ------------- 
    580          igrd=1 
    581          icount=0 
    582          DO ir = 1, nn_rimwidth(ib_bdy) 
    583             DO ij = jpjedt(iseg), jpjeft(iseg) 
    584                icount = icount + 1 
    585                nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir 
    586                nbjdta(icount, igrd, ib_bdy) = ij 
    587                nbrdta(icount, igrd, ib_bdy) = ir 
    588             ENDDO 
    589          ENDDO 
    590          ! 
    591          ! ------------ U points ------------- 
    592          igrd=2 
    593          icount=0 
    594          DO ir = 1, nn_rimwidth(ib_bdy) 
    595             DO ij = jpjedt(iseg), jpjeft(iseg) 
    596                icount = icount + 1 
    597                nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 1 - ir 
    598                nbjdta(icount, igrd, ib_bdy) = ij 
    599                nbrdta(icount, igrd, ib_bdy) = ir 
    600             ENDDO 
    601          ENDDO 
    602          ! 
    603          ! ------------ V points ------------- 
    604          igrd=3 
    605          icount=0 
    606          DO ir = 1, nn_rimwidth(ib_bdy) 
    607 !            DO ij = jpjedt(iseg), jpjeft(iseg) - 1 
    608             DO ij = jpjedt(iseg), jpjeft(iseg) 
    609                icount = icount + 1 
    610                nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir 
    611                nbjdta(icount, igrd, ib_bdy) = ij 
    612                nbrdta(icount, igrd, ib_bdy) = ir 
    613             ENDDO 
    614             nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point 
    615             nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point 
    616          ENDDO 
    617       ENDDO 
    618       ! 
    619       ! West 
    620       !----- 
    621       DO iseg = 1, nbdysegw 
    622          ib_bdy = npckgw(iseg) 
    623          ! 
    624          ! ------------ T points ------------- 
    625          igrd=1 
    626          icount=0 
    627          DO ir = 1, nn_rimwidth(ib_bdy) 
    628             DO ij = jpjwdt(iseg), jpjwft(iseg) 
    629                icount = icount + 1 
    630                nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 
    631                nbjdta(icount, igrd, ib_bdy) = ij 
    632                nbrdta(icount, igrd, ib_bdy) = ir 
    633             ENDDO 
    634          ENDDO 
    635          ! 
    636          ! ------------ U points ------------- 
    637          igrd=2 
    638          icount=0 
    639          DO ir = 1, nn_rimwidth(ib_bdy) 
    640             DO ij = jpjwdt(iseg), jpjwft(iseg) 
    641                icount = icount + 1 
    642                nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 
    643                nbjdta(icount, igrd, ib_bdy) = ij 
    644                nbrdta(icount, igrd, ib_bdy) = ir 
    645             ENDDO 
    646          ENDDO 
    647          ! 
    648          ! ------------ V points ------------- 
    649          igrd=3 
    650          icount=0 
    651          DO ir = 1, nn_rimwidth(ib_bdy) 
    652 !            DO ij = jpjwdt(iseg), jpjwft(iseg) - 1 
    653             DO ij = jpjwdt(iseg), jpjwft(iseg) 
    654                icount = icount + 1 
    655                nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 
    656                nbjdta(icount, igrd, ib_bdy) = ij 
    657                nbrdta(icount, igrd, ib_bdy) = ir 
    658             ENDDO 
    659             nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point 
    660             nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point 
    661          ENDDO 
    662       ENDDO 
    663       ! 
    664       ! North 
    665       !----- 
    666       DO iseg = 1, nbdysegn 
    667          ib_bdy = npckgn(iseg) 
    668          ! 
    669          ! ------------ T points ------------- 
    670          igrd=1 
    671          icount=0 
    672          DO ir = 1, nn_rimwidth(ib_bdy) 
    673             DO ii = jpindt(iseg), jpinft(iseg) 
    674                icount = icount + 1 
    675                nbidta(icount, igrd, ib_bdy) = ii 
    676                nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir  
    677                nbrdta(icount, igrd, ib_bdy) = ir 
    678             ENDDO 
    679          ENDDO 
    680          ! 
    681          ! ------------ U points ------------- 
    682          igrd=2 
    683          icount=0 
    684          DO ir = 1, nn_rimwidth(ib_bdy) 
    685 !            DO ii = jpindt(iseg), jpinft(iseg) - 1 
    686             DO ii = jpindt(iseg), jpinft(iseg) 
    687                icount = icount + 1 
    688                nbidta(icount, igrd, ib_bdy) = ii 
    689                nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir 
    690                nbrdta(icount, igrd, ib_bdy) = ir 
    691             ENDDO 
    692             nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point 
    693             nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point 
    694          ENDDO 
    695          ! 
    696          ! ------------ V points ------------- 
    697          igrd=3 
    698          icount=0 
    699          DO ir = 1, nn_rimwidth(ib_bdy) 
    700             DO ii = jpindt(iseg), jpinft(iseg) 
    701                icount = icount + 1 
    702                nbidta(icount, igrd, ib_bdy) = ii 
    703                nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 1 - ir 
    704                nbrdta(icount, igrd, ib_bdy) = ir 
    705             ENDDO 
    706          ENDDO 
    707       ENDDO 
    708       ! 
    709       ! South 
    710       !----- 
    711       DO iseg = 1, nbdysegs 
    712          ib_bdy = npckgs(iseg) 
    713          ! 
    714          ! ------------ T points ------------- 
    715          igrd=1 
    716          icount=0 
    717          DO ir = 1, nn_rimwidth(ib_bdy) 
    718             DO ii = jpisdt(iseg), jpisft(iseg) 
    719                icount = icount + 1 
    720                nbidta(icount, igrd, ib_bdy) = ii 
    721                nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 
    722                nbrdta(icount, igrd, ib_bdy) = ir 
    723             ENDDO 
    724          ENDDO 
    725          ! 
    726          ! ------------ U points ------------- 
    727          igrd=2 
    728          icount=0 
    729          DO ir = 1, nn_rimwidth(ib_bdy) 
    730 !            DO ii = jpisdt(iseg), jpisft(iseg) - 1 
    731             DO ii = jpisdt(iseg), jpisft(iseg) 
    732                icount = icount + 1 
    733                nbidta(icount, igrd, ib_bdy) = ii 
    734                nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 
    735                nbrdta(icount, igrd, ib_bdy) = ir 
    736             ENDDO 
    737             nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point 
    738             nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point 
    739          ENDDO 
    740          ! 
    741          ! ------------ V points ------------- 
    742          igrd=3 
    743          icount=0 
    744          DO ir = 1, nn_rimwidth(ib_bdy) 
    745             DO ii = jpisdt(iseg), jpisft(iseg) 
    746                icount = icount + 1 
    747                nbidta(icount, igrd, ib_bdy) = ii 
    748                nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 
    749                nbrdta(icount, igrd, ib_bdy) = ir 
    750             ENDDO 
    751          ENDDO 
    752       ENDDO 
     441      CALL bdy_coords_seg( nbidta, nbjdta, nbrdta ) 
    753442 
    754443      !  Deal with duplicated points 
    … …  
    764453                     DO ib2 = 1, nblendta(igrd,ib_bdy2) 
    765454                        IF ((nbidta(ib1, igrd, ib_bdy1)==nbidta(ib2, igrd, ib_bdy2)).AND. & 
    766                         &   (nbjdta(ib1, igrd, ib_bdy1)==nbjdta(ib2, igrd, ib_bdy2))) THEN 
    767 !                           IF ((lwp).AND.(igrd==1)) WRITE(numout,*) ' found coincident point ji, jj:', &  
    768 !                                                       &              nbidta(ib1, igrd, ib_bdy1),      &  
    769 !                                                       &              nbjdta(ib2, igrd, ib_bdy2) 
     455                           &   (nbjdta(ib1, igrd, ib_bdy1)==nbjdta(ib2, igrd, ib_bdy2))) THEN 
     456                           !                           IF ((lwp).AND.(igrd==1)) WRITE(numout,*) ' found coincident point ji, jj:', &  
     457                           !                                                       &              nbidta(ib1, igrd, ib_bdy1),      &  
     458                           !                                                       &              nbjdta(ib2, igrd, ib_bdy2) 
    770459                           ! keep only points with the lowest distance to boundary: 
    771460                           IF (nbrdta(ib1, igrd, ib_bdy1)<nbrdta(ib2, igrd, ib_bdy2)) THEN 
    772                              nbidta(ib2, igrd, ib_bdy2) =-ib_bdy2 
    773                              nbjdta(ib2, igrd, ib_bdy2) =-ib_bdy2 
     461                              nbidta(ib2, igrd, ib_bdy2) =-ib_bdy2 
     462                              nbjdta(ib2, igrd, ib_bdy2) =-ib_bdy2 
    774463                           ELSEIF (nbrdta(ib1, igrd, ib_bdy1)>nbrdta(ib2, igrd, ib_bdy2)) THEN 
    775                              nbidta(ib1, igrd, ib_bdy1) =-ib_bdy1 
    776                              nbjdta(ib1, igrd, ib_bdy1) =-ib_bdy1 
    777                            ! Arbitrary choice if distances are the same: 
     464                              nbidta(ib1, igrd, ib_bdy1) =-ib_bdy1 
     465                              nbjdta(ib1, igrd, ib_bdy1) =-ib_bdy1 
     466                              ! Arbitrary choice if distances are the same: 
    778467                           ELSE 
    779                              nbidta(ib1, igrd, ib_bdy1) =-ib_bdy1 
    780                              nbjdta(ib1, igrd, ib_bdy1) =-ib_bdy1 
     468                              nbidta(ib1, igrd, ib_bdy1) =-ib_bdy1 
     469                              nbjdta(ib1, igrd, ib_bdy1) =-ib_bdy1 
    781470                           ENDIF 
    782471                        END IF 
    … …  
    787476         END DO 
    788477      END DO 
    789  
    790       ! Work out dimensions of boundary data on each processor 
    791       ! ------------------------------------------------------ 
    792  
    793       ! Rather assume that boundary data indices are given on global domain 
    794       ! TO BE DISCUSSED ? 
    795 !      iw = mig(1) + 1            ! if monotasking and no zoom, iw=2 
    796 !      ie = mig(1) + nlci-1 - 1   ! if monotasking and no zoom, ie=jpim1 
    797 !      is = mjg(1) + 1            ! if monotasking and no zoom, is=2 
    798 !      in = mjg(1) + nlcj-1 - 1   ! if monotasking and no zoom, in=jpjm1       
    799       iwe = mig(1) - 1 + 2         ! if monotasking and no zoom, iw=2 
    800       ies = mig(1) + nlci-1 - 1  ! if monotasking and no zoom, ie=jpim1 
    801       iso = mjg(1) - 1 + 2         ! if monotasking and no zoom, is=2 
    802       ino = mjg(1) + nlcj-1 - 1  ! if monotasking and no zoom, in=jpjm1 
    803  
    804       ALLOCATE( nbondi_bdy(nb_bdy)) 
    805       ALLOCATE( nbondj_bdy(nb_bdy)) 
    806       nbondi_bdy(:)=2 
    807       nbondj_bdy(:)=2 
    808       ALLOCATE( nbondi_bdy_b(nb_bdy)) 
    809       ALLOCATE( nbondj_bdy_b(nb_bdy)) 
    810       nbondi_bdy_b(:)=2 
    811       nbondj_bdy_b(:)=2 
    812  
    813       ! Work out dimensions of boundary data on each neighbour process 
    814       IF(nbondi == 0) THEN 
    815          iw_b(1) = 1 + nimppt(nowe+1) 
    816          ie_b(1) = 1 + nimppt(nowe+1)+nlcit(nowe+1)-3 
    817          is_b(1) = 1 + njmppt(nowe+1) 
    818          in_b(1) = 1 + njmppt(nowe+1)+nlcjt(nowe+1)-3 
    819  
    820          iw_b(2) = 1 + nimppt(noea+1) 
    821          ie_b(2) = 1 + nimppt(noea+1)+nlcit(noea+1)-3 
    822          is_b(2) = 1 + njmppt(noea+1) 
    823          in_b(2) = 1 + njmppt(noea+1)+nlcjt(noea+1)-3 
    824       ELSEIF(nbondi == 1) THEN 
    825          iw_b(1) = 1 + nimppt(nowe+1) 
    826          ie_b(1) = 1 + nimppt(nowe+1)+nlcit(nowe+1)-3 
    827          is_b(1) = 1 + njmppt(nowe+1) 
    828          in_b(1) = 1 + njmppt(nowe+1)+nlcjt(nowe+1)-3 
    829       ELSEIF(nbondi == -1) THEN 
    830          iw_b(2) = 1 + nimppt(noea+1) 
    831          ie_b(2) = 1 + nimppt(noea+1)+nlcit(noea+1)-3 
    832          is_b(2) = 1 + njmppt(noea+1) 
    833          in_b(2) = 1 + njmppt(noea+1)+nlcjt(noea+1)-3 
    834       ENDIF 
    835  
    836       IF(nbondj == 0) THEN 
    837          iw_b(3) = 1 + nimppt(noso+1) 
    838          ie_b(3) = 1 + nimppt(noso+1)+nlcit(noso+1)-3 
    839          is_b(3) = 1 + njmppt(noso+1) 
    840          in_b(3) = 1 + njmppt(noso+1)+nlcjt(noso+1)-3 
    841  
    842          iw_b(4) = 1 + nimppt(nono+1) 
    843          ie_b(4) = 1 + nimppt(nono+1)+nlcit(nono+1)-3 
    844          is_b(4) = 1 + njmppt(nono+1) 
    845          in_b(4) = 1 + njmppt(nono+1)+nlcjt(nono+1)-3 
    846       ELSEIF(nbondj == 1) THEN 
    847          iw_b(3) = 1 + nimppt(noso+1) 
    848          ie_b(3) = 1 + nimppt(noso+1)+nlcit(noso+1)-3 
    849          is_b(3) = 1 + njmppt(noso+1) 
    850          in_b(3) = 1 + njmppt(noso+1)+nlcjt(noso+1)-3 
    851       ELSEIF(nbondj == -1) THEN 
    852          iw_b(4) = 1 + nimppt(nono+1) 
    853          ie_b(4) = 1 + nimppt(nono+1)+nlcit(nono+1)-3 
    854          is_b(4) = 1 + njmppt(nono+1) 
    855          in_b(4) = 1 + njmppt(nono+1)+nlcjt(nono+1)-3 
    856       ENDIF 
    857  
     478      ! 
     479      ! Find lenght of boundaries and rim on local mpi domain 
     480      !------------------------------------------------------ 
     481      ! 
     482      iwe = mig(1) 
     483      ies = mig(jpi) 
     484      iso = mjg(1)  
     485      ino = mjg(jpj)  
     486      ! 
    858487      DO ib_bdy = 1, nb_bdy 
    859488         DO igrd = 1, jpbgrd 
    860             icount  = 0 
    861             icountr = 0 
    862             idx_bdy(ib_bdy)%nblen(igrd)    = 0 
    863             idx_bdy(ib_bdy)%nblenrim(igrd) = 0 
     489            icount   = 0   ! initialization of local bdy length 
     490            icountr  = 0   ! initialization of local rim 0 and rim 1 bdy length 
     491            icountr0 = 0   ! initialization of local rim 0 bdy length 
     492            idx_bdy(ib_bdy)%nblen(igrd)     = 0 
     493            idx_bdy(ib_bdy)%nblenrim(igrd)  = 0 
     494            idx_bdy(ib_bdy)%nblenrim0(igrd) = 0 
    864495            DO ib = 1, nblendta(igrd,ib_bdy) 
    865496               ! check that data is in correct order in file 
    866                ibm1 = MAX(1,ib-1) 
    867                IF(lwp) THEN         ! Since all procs read global data only need to do this check on one proc... 
    868                   IF( nbrdta(ib,igrd,ib_bdy) < nbrdta(ibm1,igrd,ib_bdy) ) THEN 
     497               IF( ib > 1 ) THEN 
     498                  IF( nbrdta(ib,igrd,ib_bdy) < nbrdta(ib-1,igrd,ib_bdy) ) THEN 
    869499                     CALL ctl_stop('bdy_segs : ERROR : boundary data in file must be defined ', & 
    870                           &        ' in order of distance from edge nbr A utility for re-ordering ', & 
    871                           &        ' boundary coordinates and data files exists in the TOOLS/OBC directory') 
    872                   ENDIF     
     500                        &        ' in order of distance from edge nbr A utility for re-ordering ', & 
     501                        &        ' boundary coordinates and data files exists in the TOOLS/OBC directory') 
     502                  ENDIF 
    873503               ENDIF 
    874504               ! check if point is in local domain 
    … …  
    876506                  & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino      ) THEN 
    877507                  ! 
    878                   icount = icount  + 1 
    879                   ! 
    880                   IF( nbrdta(ib,igrd,ib_bdy) == 1 )   icountr = icountr+1 
     508                  icount = icount + 1 
     509                  IF( nbrdta(ib,igrd,ib_bdy) == 1 .OR. nbrdta(ib,igrd,ib_bdy) == 0 )   icountr = icountr + 1 
     510                  IF( nbrdta(ib,igrd,ib_bdy) == 0 )   icountr0 = icountr0 + 1 
    881511               ENDIF 
    882512            END DO 
    883             idx_bdy(ib_bdy)%nblenrim(igrd) = icountr !: length of rim boundary data on each proc 
    884             idx_bdy(ib_bdy)%nblen   (igrd) = icount  !: length of boundary data on each proc         
    885          END DO  ! igrd 
     513            idx_bdy(ib_bdy)%nblen    (igrd) = icount   !: length of boundary data on each proc 
     514            idx_bdy(ib_bdy)%nblenrim (igrd) = icountr  !: length of rim 0 and rim 1 boundary data on each proc    
     515            idx_bdy(ib_bdy)%nblenrim0(igrd) = icountr0 !: length of rim 0 boundary data on each proc      
     516         END DO   ! igrd 
    886517 
    887518         ! Allocate index arrays for this boundary set 
    … …  
    893524            &      idx_bdy(ib_bdy)%nbd   (ilen1,jpbgrd) ,   & 
    894525            &      idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) ,   & 
     526            &      idx_bdy(ib_bdy)%ntreat(ilen1,jpbgrd) ,   & 
    895527            &      idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) ,   & 
    896528            &      idx_bdy(ib_bdy)%nbw   (ilen1,jpbgrd) ,   & 
    … …  
    900532         ! Dispatch mapping indices and discrete distances on each processor 
    901533         ! ----------------------------------------------------------------- 
    902  
    903          com_east  = 0 
    904          com_west  = 0 
    905          com_south = 0 
    906          com_north = 0 
    907  
    908          com_east_b  = 0 
    909          com_west_b  = 0 
    910          com_south_b = 0 
    911          com_north_b = 0 
    912  
    913534         DO igrd = 1, jpbgrd 
    914535            icount  = 0 
    915             ! Loop on rimwidth to ensure outermost points come first in the local arrays. 
    916             DO ir=1, nn_rimwidth(ib_bdy) 
     536            ! Outer loop on rimwidth to ensure outermost points come first in the local arrays. 
     537            DO ir = 0, nn_rimwidth(ib_bdy) 
    917538               DO ib = 1, nblendta(igrd,ib_bdy) 
    918539                  ! check if point is in local domain and equals ir 
    … …  
    922543                     ! 
    923544                     icount = icount  + 1 
    924  
    925                      ! Rather assume that boundary data indices are given on global domain 
    926                      ! TO BE DISCUSSED ? 
    927 !                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+1 
    928 !                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1 
    929                      idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+1 
    930                      idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1 
    931                      ! check if point has to be sent 
    932                      ii = idx_bdy(ib_bdy)%nbi(icount,igrd) 
    933                      ij = idx_bdy(ib_bdy)%nbj(icount,igrd) 
    934                      if((com_east .ne. 1) .and. (ii == (nlci-1)) .and. (nbondi .le. 0)) then 
    935                         com_east = 1 
    936                      elseif((com_west .ne. 1) .and. (ii == 2) .and. (nbondi .ge. 0) .and. (nbondi .ne. 2)) then 
    937                         com_west = 1 
    938                      endif  
    939                      if((com_south .ne. 1) .and. (ij == 2) .and. (nbondj .ge. 0) .and. (nbondj .ne. 2)) then 
    940                         com_south = 1 
    941                      elseif((com_north .ne. 1) .and. (ij == (nlcj-1)) .and. (nbondj .le. 0)) then 
    942                         com_north = 1 
    943                      endif  
     545                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+1   ! global to local indexes 
     546                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1   ! global to local indexes 
    944547                     idx_bdy(ib_bdy)%nbr(icount,igrd)   = nbrdta(ib,igrd,ib_bdy) 
    945548                     idx_bdy(ib_bdy)%nbmap(icount,igrd) = ib 
    946549                  ENDIF 
    947                   ! check if point has to be received from a neighbour 
    948                   IF(nbondi == 0) THEN 
    949                      IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND.   & 
    950                        & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND.   & 
    951                        & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    952                        ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2 
    953                        if( ii == (nlcit(nowe+1)-1) ) then 
    954                           ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2 
    955                           if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 
    956                             com_south = 1 
    957                           elseif((ij == nlcjt(nowe+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 
    958                             com_north = 1 
    959                           endif 
    960                           com_west_b = 1 
    961                        endif  
    962                      ENDIF 
    963                      IF( nbidta(ib,igrd,ib_bdy) >= iw_b(2) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(2) .AND.   & 
    964                        & nbjdta(ib,igrd,ib_bdy) >= is_b(2) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(2) .AND.   & 
    965                        & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    966                        ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2 
    967                        if( ii == 2 ) then 
    968                           ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2 
    969                           if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 
    970                             com_south = 1 
    971                           elseif((ij == nlcjt(noea+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 
    972                             com_north = 1 
    973                           endif 
    974                           com_east_b = 1 
    975                        endif  
    976                      ENDIF 
    977                   ELSEIF(nbondi == 1) THEN 
    978                      IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND.   & 
    979                        & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND.   & 
    980                        & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    981                        ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2 
    982                        if( ii == (nlcit(nowe+1)-1) ) then 
    983                           ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2 
    984                           if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 
    985                             com_south = 1 
    986                           elseif((ij == nlcjt(nowe+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 
    987                             com_north = 1 
    988                           endif 
    989                           com_west_b = 1 
    990                        endif  
    991                      ENDIF 
    992                   ELSEIF(nbondi == -1) THEN 
    993                      IF( nbidta(ib,igrd,ib_bdy) >= iw_b(2) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(2) .AND.   & 
    994                        & nbjdta(ib,igrd,ib_bdy) >= is_b(2) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(2) .AND.   & 
    995                        & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    996                        ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2 
    997                        if( ii == 2 ) then 
    998                           ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2 
    999                           if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 
    1000                             com_south = 1 
    1001                           elseif((ij == nlcjt(noea+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 
    1002                             com_north = 1 
    1003                           endif 
    1004                           com_east_b = 1 
    1005                        endif  
    1006                      ENDIF 
    1007                   ENDIF 
    1008                   IF(nbondj == 0) THEN 
    1009                      IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1  & 
    1010                        & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. & 
    1011                        & nbjdta(ib,igrd,ib_bdy) == is_b(4) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN 
    1012                        com_north_b = 1  
    1013                      ENDIF 
    1014                      IF(com_south_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(3)-1  & 
    1015                        &.OR. nbidta(ib,igrd,ib_bdy) == ie_b(3)+1) .AND. & 
    1016                        & nbjdta(ib,igrd,ib_bdy) == in_b(3) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN 
    1017                        com_south_b = 1  
    1018                      ENDIF 
    1019                      IF( nbidta(ib,igrd,ib_bdy) >= iw_b(3) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(3) .AND.   & 
    1020                        & nbjdta(ib,igrd,ib_bdy) >= is_b(3) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(3) .AND.   & 
    1021                        & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    1022                        ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2 
    1023                        if((com_south_b .ne. 1) .and. (ij == (nlcjt(noso+1)-1))) then 
    1024                           com_south_b = 1 
    1025                        endif  
    1026                      ENDIF 
    1027                      IF( nbidta(ib,igrd,ib_bdy) >= iw_b(4) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(4) .AND.   & 
    1028                        & nbjdta(ib,igrd,ib_bdy) >= is_b(4) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(4) .AND.   & 
    1029                        & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    1030                        ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2 
    1031                        if((com_north_b .ne. 1) .and. (ij == 2)) then 
    1032                           com_north_b = 1 
    1033                        endif  
    1034                      ENDIF 
    1035                   ELSEIF(nbondj == 1) THEN 
    1036                      IF( com_south_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(3)-1 .OR. & 
    1037                        & nbidta(ib,igrd,ib_bdy) == ie_b(3)+1) .AND. & 
    1038                        & nbjdta(ib,igrd,ib_bdy) == in_b(3) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN 
    1039                        com_south_b = 1  
    1040                      ENDIF 
    1041                      IF( nbidta(ib,igrd,ib_bdy) >= iw_b(3) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(3) .AND.   & 
    1042                        & nbjdta(ib,igrd,ib_bdy) >= is_b(3) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(3) .AND.   & 
    1043                        & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    1044                        ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2 
    1045                        if((com_south_b .ne. 1) .and. (ij == (nlcjt(noso+1)-1))) then 
    1046                           com_south_b = 1 
    1047                        endif  
    1048                      ENDIF 
    1049                   ELSEIF(nbondj == -1) THEN 
    1050                      IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1  & 
    1051                        & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. & 
    1052                        & nbjdta(ib,igrd,ib_bdy) == is_b(4) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN 
    1053                        com_north_b = 1  
    1054                      ENDIF 
    1055                      IF( nbidta(ib,igrd,ib_bdy) >= iw_b(4) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(4) .AND.   & 
    1056                        & nbjdta(ib,igrd,ib_bdy) >= is_b(4) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(4) .AND.   & 
    1057                        & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    1058                        ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2 
    1059                        if((com_north_b .ne. 1) .and. (ij == 2)) then 
    1060                           com_north_b = 1 
    1061                        endif  
    1062                      ENDIF 
    1063                   ENDIF 
    1064                ENDDO 
    1065             ENDDO 
    1066          ENDDO  
    1067  
    1068          ! definition of the i- and j- direction local boundaries arrays used for sending the boundaries 
    1069          IF(     (com_east  == 1) .and. (com_west  == 1) ) THEN   ;   nbondi_bdy(ib_bdy) =  0 
    1070          ELSEIF( (com_east  == 1) .and. (com_west  == 0) ) THEN   ;   nbondi_bdy(ib_bdy) = -1 
    1071          ELSEIF( (com_east  == 0) .and. (com_west  == 1) ) THEN   ;   nbondi_bdy(ib_bdy) =  1 
    1072          ENDIF 
    1073          IF(     (com_north == 1) .and. (com_south == 1) ) THEN   ;   nbondj_bdy(ib_bdy) =  0 
    1074          ELSEIF( (com_north == 1) .and. (com_south == 0) ) THEN   ;   nbondj_bdy(ib_bdy) = -1 
    1075          ELSEIF( (com_north == 0) .and. (com_south == 1) ) THEN   ;   nbondj_bdy(ib_bdy) =  1 
    1076          ENDIF 
    1077  
    1078          ! definition of the i- and j- direction local boundaries arrays used for receiving the boundaries 
    1079          IF(     (com_east_b  == 1) .and. (com_west_b  == 1) ) THEN   ;   nbondi_bdy_b(ib_bdy) =  0 
    1080          ELSEIF( (com_east_b  == 1) .and. (com_west_b  == 0) ) THEN   ;   nbondi_bdy_b(ib_bdy) = -1 
    1081          ELSEIF( (com_east_b  == 0) .and. (com_west_b  == 1) ) THEN   ;   nbondi_bdy_b(ib_bdy) =  1 
    1082          ENDIF 
    1083          IF(     (com_north_b == 1) .and. (com_south_b == 1) ) THEN   ;   nbondj_bdy_b(ib_bdy) =  0 
    1084          ELSEIF( (com_north_b == 1) .and. (com_south_b == 0) ) THEN   ;   nbondj_bdy_b(ib_bdy) = -1 
    1085          ELSEIF( (com_north_b == 0) .and. (com_south_b == 1) ) THEN   ;   nbondj_bdy_b(ib_bdy) =  1 
    1086          ENDIF 
     550               END DO 
     551            END DO 
     552         END DO   ! igrd 
     553 
     554      END DO   ! ib_bdy 
     555 
     556      ! Initialize array indicating communications in bdy 
     557      ! ------------------------------------------------- 
     558      ALLOCATE( lsend_bdy(nb_bdy,jpbgrd,4,0:1), lrecv_bdy(nb_bdy,jpbgrd,4,0:1) ) 
     559      lsend_bdy(:,:,:,:) = .false. 
     560      lrecv_bdy(:,:,:,:) = .false.  
     561 
     562      DO ib_bdy = 1, nb_bdy 
     563         DO igrd = 1, jpbgrd 
     564            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   ! only the rim triggers communications, see bdy routines 
     565               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     566               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     567               IF( ib .LE. idx_bdy(ib_bdy)%nblenrim0(igrd) ) THEN   ;   ir = 0 
     568               ELSE                                                 ;   ir = 1 
     569               END IF 
     570               ! 
     571               ! check if point has to be sent     to   a neighbour 
     572               ! W neighbour and on the inner left  side 
     573               IF( ii == 2     .and. (nbondi == 0 .or. nbondi ==  1) )   lsend_bdy(ib_bdy,igrd,1,ir) = .true. 
     574               ! E neighbour and on the inner right side 
     575               IF( ii == jpi-1 .and. (nbondi == 0 .or. nbondi == -1) )   lsend_bdy(ib_bdy,igrd,2,ir) = .true. 
     576               ! S neighbour and on the inner down side 
     577               IF( ij == 2     .and. (nbondj == 0 .or. nbondj ==  1) )   lsend_bdy(ib_bdy,igrd,3,ir) = .true. 
     578               ! N neighbour and on the inner up   side 
     579               IF( ij == jpj-1 .and. (nbondj == 0 .or. nbondj == -1) )   lsend_bdy(ib_bdy,igrd,4,ir) = .true. 
     580               ! 
     581               ! check if point has to be received from a neighbour 
     582               ! W neighbour and on the outter left  side 
     583               IF( ii == 1     .and. (nbondi == 0 .or. nbondi ==  1) )   lrecv_bdy(ib_bdy,igrd,1,ir) = .true. 
     584               ! E neighbour and on the outter right side 
     585               IF( ii == jpi   .and. (nbondi == 0 .or. nbondi == -1) )   lrecv_bdy(ib_bdy,igrd,2,ir) = .true. 
     586               ! S neighbour and on the outter down side 
     587               IF( ij == 1     .and. (nbondj == 0 .or. nbondj ==  1) )   lrecv_bdy(ib_bdy,igrd,3,ir) = .true. 
     588               ! N neighbour and on the outter up   side 
     589               IF( ij == jpj   .and. (nbondj == 0 .or. nbondj == -1) )   lrecv_bdy(ib_bdy,igrd,4,ir) = .true. 
     590               ! 
     591            END DO 
     592         END DO  ! igrd 
    1087593 
    1088594         ! Compute rim weights for FRS scheme 
    … …  
    1090596         DO igrd = 1, jpbgrd 
    1091597            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    1092                nbr => idx_bdy(ib_bdy)%nbr(ib,igrd) 
    1093                idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( REAL( nbr - 1 ) *0.5 )      ! tanh formulation 
    1094 !               idx_bdy(ib_bdy)%nbw(ib,igrd) = (REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.  ! quadratic 
    1095 !               idx_bdy(ib_bdy)%nbw(ib,igrd) =  REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy))       ! linear 
    1096             END DO 
    1097          END DO  
     598               ir = MAX( 1, idx_bdy(ib_bdy)%nbr(ib,igrd) )   ! both rim 0 and rim 1 have the same weights 
     599               idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( REAL( ir - 1 ) *0.5 )      ! tanh formulation 
     600               !               idx_bdy(ib_bdy)%nbw(ib,igrd) = (REAL(nn_rimwidth(ib_bdy)+1-ir)/REAL(nn_rimwidth(ib_bdy)))**2.  ! quadratic 
     601               !               idx_bdy(ib_bdy)%nbw(ib,igrd) =  REAL(nn_rimwidth(ib_bdy)+1-ir)/REAL(nn_rimwidth(ib_bdy))       ! linear 
     602            END DO 
     603         END DO 
    1098604 
    1099605         ! Compute damping coefficients 
    … …  
    1101607         DO igrd = 1, jpbgrd 
    1102608            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    1103                nbr => idx_bdy(ib_bdy)%nbr(ib,igrd) 
     609               ir = MAX( 1, idx_bdy(ib_bdy)%nbr(ib,igrd) )   ! both rim 0 and rim 1 have the same damping coefficients 
    1104610               idx_bdy(ib_bdy)%nbd(ib,igrd) = 1. / ( rn_time_dmp(ib_bdy) * rday ) &  
    1105                & *(REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
     611                  & *(REAL(nn_rimwidth(ib_bdy)+1-ir)/REAL(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
    1106612               idx_bdy(ib_bdy)%nbdout(ib,igrd) = 1. / ( rn_time_dmp_out(ib_bdy) * rday ) &  
    1107                & *(REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
    1108             END DO 
    1109          END DO  
    1110  
    1111       END DO 
     613                  & *(REAL(nn_rimwidth(ib_bdy)+1-ir)/REAL(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
     614            END DO 
     615         END DO 
     616 
     617      END DO ! ib_bdy 
    1112618 
    1113619      ! ------------------------------------------------------ 
    1114620      ! Initialise masks and find normal/tangential directions 
    1115621      ! ------------------------------------------------------ 
     622 
     623      ! ------------------------------------------ 
     624      ! handle rim0, do as if rim 1 was free ocean 
     625      ! ------------------------------------------ 
     626 
     627      ztmask(:,:) = tmask(:,:,1)   ;   zumask(:,:) = umask(:,:,1)   ;   zvmask(:,:) = vmask(:,:,1) 
     628      ! For the flagu/flagv calculation below we require a version of fmask without 
     629      ! the land boundary condition (shlat) included: 
     630      DO ij = 1, jpjm1 
     631         DO ii = 1, jpim1 
     632            zfmask(ii,ij) =  ztmask(ii,ij  ) * ztmask(ii+1,ij  )   & 
     633               &           * ztmask(ii,ij+1) * ztmask(ii+1,ij+1) 
     634         END DO 
     635      END DO 
     636      CALL lbc_lnk( 'bdyini', zfmask, 'F', 1. ) 
    1116637 
    1117638      ! Read global 2D mask at T-points: bdytmask 
    … …  
    1119640      ! bdytmask = 1  on the computational domain AND on open boundaries 
    1120641      !          = 0  elsewhere    
    1121   
     642 
    1122643      bdytmask(:,:) = ssmask(:,:) 
    1123644 
    1124645      ! Derive mask on U and V grid from mask on T grid 
    1125  
    1126       bdyumask(:,:) = 0._wp 
    1127       bdyvmask(:,:) = 0._wp 
    1128646      DO ij = 1, jpjm1 
    1129647         DO ii = 1, jpim1 
    1130             bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij ) 
     648            bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1,ij ) 
    1131649            bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii  ,ij+1)   
    1132650         END DO 
    1133651      END DO 
    1134       CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1. , bdyvmask, 'V', 1. )   ! Lateral boundary cond.  
    1135  
    1136       ! bdy masks are now set to zero on boundary points: 
    1137       ! 
    1138       igrd = 1 
     652      CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1., bdyvmask, 'V', 1. )   ! Lateral boundary cond. 
     653 
     654      ! bdy masks are now set to zero on rim 0 points: 
    1139655      DO ib_bdy = 1, nb_bdy 
    1140         DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)       
    1141           bdytmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 
    1142         END DO 
    1143       END DO 
    1144       ! 
    1145       igrd = 2 
     656         DO ib = 1, idx_bdy(ib_bdy)%nblenrim0(1)   ! extent of rim 0 
     657            bdytmask(idx_bdy(ib_bdy)%nbi(ib,1), idx_bdy(ib_bdy)%nbj(ib,1)) = 0._wp 
     658         END DO 
     659         DO ib = 1, idx_bdy(ib_bdy)%nblenrim0(2)   ! extent of rim 0 
     660            bdyumask(idx_bdy(ib_bdy)%nbi(ib,2), idx_bdy(ib_bdy)%nbj(ib,2)) = 0._wp 
     661         END DO 
     662         DO ib = 1, idx_bdy(ib_bdy)%nblenrim0(3)   ! extent of rim 0 
     663            bdyvmask(idx_bdy(ib_bdy)%nbi(ib,3), idx_bdy(ib_bdy)%nbj(ib,3)) = 0._wp 
     664         END DO 
     665      END DO 
     666 
     667      CALL bdy_rim_treat( zumask, zvmask, zfmask, .true. )   ! compute flagu, flagv, ntreat on rim 0 
     668 
     669      ! ------------------------------------ 
     670      ! handle rim1, do as if rim 0 was land 
     671      ! ------------------------------------ 
     672       
     673      ! z[tuv]mask are now set to zero on rim 0 points: 
    1146674      DO ib_bdy = 1, nb_bdy 
    1147         DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
    1148           bdyumask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 
    1149         END DO 
    1150       END DO 
    1151       ! 
    1152       igrd = 3 
     675         DO ib = 1, idx_bdy(ib_bdy)%nblenrim0(1)   ! extent of rim 0 
     676            ztmask(idx_bdy(ib_bdy)%nbi(ib,1), idx_bdy(ib_bdy)%nbj(ib,1)) = 0._wp 
     677         END DO 
     678         DO ib = 1, idx_bdy(ib_bdy)%nblenrim0(2)   ! extent of rim 0 
     679            zumask(idx_bdy(ib_bdy)%nbi(ib,2), idx_bdy(ib_bdy)%nbj(ib,2)) = 0._wp 
     680         END DO 
     681         DO ib = 1, idx_bdy(ib_bdy)%nblenrim0(3)   ! extent of rim 0 
     682            zvmask(idx_bdy(ib_bdy)%nbi(ib,3), idx_bdy(ib_bdy)%nbj(ib,3)) = 0._wp 
     683         END DO 
     684      END DO 
     685 
     686      ! Recompute zfmask 
     687      DO ij = 1, jpjm1 
     688         DO ii = 1, jpim1 
     689            zfmask(ii,ij) =  ztmask(ii,ij  ) * ztmask(ii+1,ij  )   & 
     690               &           * ztmask(ii,ij+1) * ztmask(ii+1,ij+1) 
     691         END DO 
     692      END DO 
     693      CALL lbc_lnk( 'bdyini', zfmask, 'F', 1. ) 
     694 
     695      ! bdy masks are now set to zero on rim1 points: 
    1153696      DO ib_bdy = 1, nb_bdy 
    1154         DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
    1155           bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 
    1156         END DO 
    1157       END DO 
    1158  
    1159       ! For the flagu/flagv calculation below we require a version of fmask without 
    1160       ! the land boundary condition (shlat) included: 
    1161       zfmask(:,:) = 0 
    1162       DO ij = 2, jpjm1 
    1163          DO ii = 2, jpim1 
    1164             zfmask(ii,ij) = tmask(ii,ij  ,1) * tmask(ii+1,ij  ,1)   & 
    1165            &              * tmask(ii,ij+1,1) * tmask(ii+1,ij+1,1) 
    1166          END DO       
    1167       END DO 
    1168  
    1169       ! Lateral boundary conditions 
    1170       CALL lbc_lnk( 'bdyini', zfmask, 'F', 1. )  
    1171       CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1. , bdyvmask, 'V', 1., bdytmask, 'T', 1. ) 
     697         DO ib = idx_bdy(ib_bdy)%nblenrim0(1) + 1,  idx_bdy(ib_bdy)%nblenrim(1)   ! extent of rim 1 
     698            bdytmask(idx_bdy(ib_bdy)%nbi(ib,1), idx_bdy(ib_bdy)%nbj(ib,1)) = 0._wp 
     699         END DO 
     700         DO ib = idx_bdy(ib_bdy)%nblenrim0(2) + 1,  idx_bdy(ib_bdy)%nblenrim(2)   ! extent of rim 1 
     701            bdyumask(idx_bdy(ib_bdy)%nbi(ib,2), idx_bdy(ib_bdy)%nbj(ib,2)) = 0._wp 
     702         END DO 
     703         DO ib = idx_bdy(ib_bdy)%nblenrim0(3) + 1,  idx_bdy(ib_bdy)%nblenrim(3)   ! extent of rim 1 
     704            bdyvmask(idx_bdy(ib_bdy)%nbi(ib,3), idx_bdy(ib_bdy)%nbj(ib,3)) = 0._wp 
     705         END DO 
     706      END DO 
     707 
     708      CALL bdy_rim_treat( zumask, zvmask, zfmask, .false. )   ! compute flagu, flagv, ntreat on rim 1 
     709      ! 
     710      ! Check which boundaries might need communication 
     711      ALLOCATE( lsend_bdyint(nb_bdy,jpbgrd,4,0:1), lrecv_bdyint(nb_bdy,jpbgrd,4,0:1) ) 
     712      lsend_bdyint(:,:,:,:) = .false. 
     713      lrecv_bdyint(:,:,:,:) = .false.  
     714      ALLOCATE( lsend_bdyext(nb_bdy,jpbgrd,4,0:1), lrecv_bdyext(nb_bdy,jpbgrd,4,0:1) ) 
     715      lsend_bdyext(:,:,:,:) = .false. 
     716      lrecv_bdyext(:,:,:,:) = .false. 
     717      ! 
     718      DO igrd = 1, jpbgrd 
     719         DO ib_bdy = 1, nb_bdy 
     720            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
     721               IF( idx_bdy(ib_bdy)%ntreat(ib,igrd) == -1 ) CYCLE 
     722               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     723               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     724               ir = idx_bdy(ib_bdy)%nbr(ib,igrd) 
     725               flagu = NINT(idx_bdy(ib_bdy)%flagu(ib,igrd)) 
     726               flagv = NINT(idx_bdy(ib_bdy)%flagv(ib,igrd)) 
     727               iibe = ii - flagu   ! neighbouring point towards the exterior of the computational domain 
     728               ijbe = ij - flagv 
     729               iibi = ii + flagu   ! neighbouring point towards the interior of the computational domain 
     730               ijbi = ij + flagv 
     731               CALL find_neib( ii, ij, idx_bdy(ib_bdy)%ntreat(ib,igrd), ii1, ij1, ii2, ij2, ii3, ij3 )   ! free ocean neighbours 
     732               ! 
     733               ! search neighbour in the  west/east  direction 
     734               ! Rim is on the halo and computed ocean is towards exterior of mpi domain   
     735               !      <--    (o exterior)     -->   
     736               ! (1)  o|x         OR    (2)   x|o 
     737               !       |___                 ___|  
     738               IF( iibi == 0     .OR. ii1 == 0     .OR. ii2 == 0     .OR. ii3 == 0     )   lrecv_bdyint(ib_bdy,igrd,1,ir) = .true. 
     739               IF( iibi == jpi+1 .OR. ii1 == jpi+1 .OR. ii2 == jpi+1 .OR. ii3 == jpi+1 )   lrecv_bdyint(ib_bdy,igrd,2,ir) = .true.   
     740               IF( iibe == 0                                                           )   lrecv_bdyext(ib_bdy,igrd,1,ir) = .true. 
     741               IF( iibe == jpi+1                                                       )   lrecv_bdyext(ib_bdy,igrd,2,ir) = .true.   
     742               ! Check if neighbour has its rim parallel to its mpi subdomain border and located next to its halo 
     743               ! :¨¨¨¨¨|¨¨-->    |                                             |    <--¨¨|¨¨¨¨¨:  
     744               ! :     |  x:o    |    neighbour limited by ... would need o    |    o:x  |     : 
     745               ! :.....|_._:_____|   (1) W neighbour         E neighbour (2)   |_____:_._|.....: 
     746               IF( ii == 2     .AND. ( nbondi ==  1 .OR. nbondi == 0 ) .AND. & 
     747                  & ( iibi == 3     .OR. ii1 == 3     .OR. ii2 == 3     .OR. ii3 == 3    ) )   lsend_bdyint(ib_bdy,igrd,1,ir)=.true. 
     748               IF( ii == jpi-1 .AND. ( nbondi == -1 .OR. nbondi == 0 ) .AND. & 
     749                  & ( iibi == jpi-2 .OR. ii1 == jpi-2 .OR. ii2 == jpi-2 .OR. ii3 == jpi-2) )   lsend_bdyint(ib_bdy,igrd,2,ir)=.true. 
     750               IF( ii == 2     .AND. ( nbondi ==  1 .OR. nbondi == 0 ) .AND. iibe == 3     )   lsend_bdyext(ib_bdy,igrd,1,ir)=.true. 
     751               IF( ii == jpi-1 .AND. ( nbondi == -1 .OR. nbondi == 0 ) .AND. iibe == jpi-2 )   lsend_bdyext(ib_bdy,igrd,2,ir)=.true. 
     752               ! 
     753               ! search neighbour in the north/south direction    
     754               ! Rim is on the halo and computed ocean is towards exterior of mpi domain 
     755               !(3)   |       |         ^   ___o___      
     756               !  |   |___x___|   OR    |  |   x   | 
     757               !  v       o           (4)  |       | 
     758               IF( ijbi == 0     .OR. ij1 == 0     .OR. ij2 == 0     .OR. ij3 == 0     )   lrecv_bdyint(ib_bdy,igrd,3,ir) = .true. 
     759               IF( ijbi == jpj+1 .OR. ij1 == jpj+1 .OR. ij2 == jpj+1 .OR. ij3 == jpj+1 )   lrecv_bdyint(ib_bdy,igrd,4,ir) = .true. 
     760               IF( ijbe == 0                                                           )   lrecv_bdyext(ib_bdy,igrd,3,ir) = .true. 
     761               IF( ijbe == jpj+1                                                       )   lrecv_bdyext(ib_bdy,igrd,4,ir) = .true. 
     762               ! Check if neighbour has its rim parallel to its mpi subdomain     _________  border and next to its halo 
     763               !   ^  |    o    |                                                :         :  
     764               !   |  |¨¨¨¨x¨¨¨¨|   neighbour limited by ... would need o     |  |....x....| 
     765               !      :_________:  (3) S neighbour          N neighbour (4)   v  |    o    |    
     766               IF( ij == 2     .AND. ( nbondj ==  1 .OR. nbondj == 0 ) .AND. & 
     767                  & ( ijbi == 3     .OR. ij1 == 3     .OR. ij2 == 3     .OR. ij3 == 3    ) )   lsend_bdyint(ib_bdy,igrd,3,ir)=.true. 
     768               IF( ij == jpj-1 .AND. ( nbondj == -1 .OR. nbondj == 0 ) .AND. & 
     769                  & ( ijbi == jpj-2 .OR. ij1 == jpj-2 .OR. ij2 == jpj-2 .OR. ij3 == jpj-2) )   lsend_bdyint(ib_bdy,igrd,4,ir)=.true. 
     770               IF( ij == 2     .AND. ( nbondj ==  1 .OR. nbondj == 0 ) .AND. ijbe == 3     )   lsend_bdyext(ib_bdy,igrd,3,ir)=.true. 
     771               IF( ij == jpj-1 .AND. ( nbondj == -1 .OR. nbondj == 0 ) .AND. ijbe == jpj-2 )   lsend_bdyext(ib_bdy,igrd,4,ir)=.true. 
     772            END DO 
     773         END DO 
     774      END DO 
     775 
     776      DO ib_bdy = 1,nb_bdy 
     777         IF(  cn_dyn2d(ib_bdy) == 'orlanski' .OR. cn_dyn2d(ib_bdy) == 'orlanski_npo' .OR. & 
     778            & cn_dyn3d(ib_bdy) == 'orlanski' .OR. cn_dyn3d(ib_bdy) == 'orlanski_npo' .OR. & 
     779            & cn_tra(ib_bdy)   == 'orlanski' .OR. cn_tra(ib_bdy)   == 'orlanski_npo'      ) THEN 
     780            DO igrd = 1, jpbgrd 
     781               DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
     782                  ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     783                  ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     784                  IF(  mig(ii) > 2 .AND. mig(ii) < jpiglo-2 .AND. mjg(ij) > 2 .AND. mjg(ij) < jpjglo-2  ) THEN 
     785                     WRITE(ctmp1,*) ' Orlanski is not safe when the open boundaries are on the interior of the computational domain' 
     786                     CALL ctl_stop( ctmp1 ) 
     787                  END IF 
     788               END DO 
     789            END DO 
     790         END IF 
     791      END DO 
     792      ! 
     793      DEALLOCATE( nbidta, nbjdta, nbrdta ) 
     794      ! 
     795   END SUBROUTINE bdy_def 
     796 
     797 
     798   SUBROUTINE bdy_rim_treat( pumask, pvmask, pfmask, lrim0 ) 
     799      !!---------------------------------------------------------------------- 
     800      !!                 ***  ROUTINE bdy_rim_treat  *** 
     801      !! 
     802      !! ** Purpose :   Initialize structures ( flagu, flagv, ntreat ) indicating how rim points 
     803      !!                  are to be handled in the boundary condition treatment 
     804      !! 
     805      !! ** Method  :   - to handle rim 0 zmasks must indicate ocean points      (set at one on rim 0 and rim 1 and interior) 
     806      !!                            and bdymasks must be set at 0 on rim 0       (set at one on rim 1 and interior) 
     807      !!                    (as if rim 1 was free ocean) 
     808      !!                - to handle rim 1 zmasks must be set at 0 on rim 0       (set at one on rim 1 and interior) 
     809      !!                            and bdymasks must indicate free ocean points (set at one on interior) 
     810      !!                    (as if rim 0 was land) 
     811      !!                - we can then check in which direction the interior of the computational domain is with the difference 
     812      !!                         mask array values on both sides to compute flagu and flagv 
     813      !!                - and look at the ocean neighbours to compute ntreat 
     814      !!---------------------------------------------------------------------- 
     815      REAL(wp), TARGET, DIMENSION(jpi,jpj), INTENT (in   ) :: pfmask   ! temporary fmask excluding coastal boundary condition (shlat) 
     816      REAL(wp), TARGET, DIMENSION(jpi,jpj), INTENT (in   ) :: pumask, pvmask   ! temporary t/u/v mask array 
     817      LOGICAL                             , INTENT (in   ) :: lrim0    ! .true. -> rim 0   .false. -> rim 1 
     818      INTEGER  ::   ib_bdy, ii, ij, igrd, ib, icount       ! dummy loop indices 
     819      INTEGER  ::   i_offset, j_offset, inn                ! local integer 
     820      INTEGER  ::   ibeg, iend                             ! local integer 
     821      LOGICAL  ::   llnon, llson, llean, llwen             ! local logicals indicating the presence of a ocean neighbour 
     822      REAL(wp), POINTER, DIMENSION(:,:)       ::   zmask   ! pointer to 2D mask fields 
     823      REAL(wp) ::   zefl, zwfl, znfl, zsfl                 ! local scalars 
     824      CHARACTER(LEN=1), DIMENSION(jpbgrd)     ::   cgrid 
     825      REAL(wp)        , DIMENSION(jpi,jpj)    ::   ztmp 
     826      !!---------------------------------------------------------------------- 
     827 
     828      cgrid = (/'t','u','v'/) 
     829 
    1172830      DO ib_bdy = 1, nb_bdy       ! Indices and directions of rim velocity components 
    1173  
    1174          idx_bdy(ib_bdy)%flagu(:,:) = 0._wp 
    1175          idx_bdy(ib_bdy)%flagv(:,:) = 0._wp 
    1176          icount = 0  
    1177831 
    1178832         ! Calculate relationship of U direction to the local orientation of the boundary 
    … …  
    1180834         ! flagu =  0 : u is tangential 
    1181835         ! flagu =  1 : u is normal to the boundary and is direction is inward 
    1182    
    1183836         DO igrd = 1, jpbgrd  
    1184837            SELECT CASE( igrd ) 
    1185                CASE( 1 )   ;   pmask => umask   (:,:,1)   ;   i_offset = 0 
    1186                CASE( 2 )   ;   pmask => bdytmask(:,:)     ;   i_offset = 1 
    1187                CASE( 3 )   ;   pmask => zfmask  (:,:)     ;   i_offset = 0 
     838               CASE( 1 )   ;   zmask => pumask     ;   i_offset = 0 
     839               CASE( 2 )   ;   zmask => bdytmask   ;   i_offset = 1 
     840               CASE( 3 )   ;   zmask => pfmask     ;   i_offset = 0 
    1188841            END SELECT  
    1189842            icount = 0 
    1190             DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
    1191                nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    1192                nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1193                zefl = pmask(nbi+i_offset-1,nbj) 
    1194                zwfl = pmask(nbi+i_offset,nbj) 
     843            ztmp(:,:) = -999._wp 
     844            IF( lrim0 ) THEN   ! extent of rim 0 
     845               ibeg = 1                                     ;   iend = idx_bdy(ib_bdy)%nblenrim0(igrd) 
     846            ELSE               ! extent of rim 1 
     847               ibeg = idx_bdy(ib_bdy)%nblenrim0(igrd) + 1   ;   iend = idx_bdy(ib_bdy)%nblenrim(igrd) 
     848            END IF 
     849            DO ib = ibeg, iend  
     850               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     851               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     852               IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE 
     853               zwfl = zmask(ii+i_offset-1,ij) 
     854               zefl = zmask(ii+i_offset  ,ij) 
    1195855               ! This error check only works if you are using the bdyXmask arrays 
    1196                IF( i_offset == 1 .and. zefl + zwfl == 2 ) THEN 
     856               IF( i_offset == 1 .and. zefl + zwfl == 2. ) THEN 
    1197857                  icount = icount + 1 
    1198                   IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(nbi),mjg(nbj) 
     858                  IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii),mjg(ij) 
    1199859               ELSE 
    1200                   idx_bdy(ib_bdy)%flagu(ib,igrd) = -zefl + zwfl 
     860                  ztmp(ii,ij) = -zwfl + zefl 
    1201861               ENDIF 
    1202862            END DO 
    1203863            IF( icount /= 0 ) THEN 
    1204                WRITE(ctmp1,*) ' E R R O R : Some ',cgrid(igrd),' grid points,',   & 
     864               WRITE(ctmp1,*) 'Some ',cgrid(igrd),' grid points,',   & 
    1205865                  ' are not boundary points (flagu calculation). Check nbi, nbj, indices for boundary set ',ib_bdy 
    1206                WRITE(ctmp2,*) ' ========== ' 
    1207                CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
     866               CALL ctl_stop( ctmp1 ) 
    1208867            ENDIF  
     868            SELECT CASE( igrd ) 
     869               CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. )  
     870               CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. )  
     871               CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. )  
     872            END SELECT  
     873            DO ib = ibeg, iend 
     874               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     875               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     876               idx_bdy(ib_bdy)%flagu(ib,igrd) = ztmp(ii,ij) 
     877            END DO 
    1209878         END DO 
    1210879 
    … …  
    1213882         ! flagv =  0 : v is tangential 
    1214883         ! flagv =  1 : v is normal to the boundary and is direction is inward 
    1215  
    1216884         DO igrd = 1, jpbgrd  
    1217885            SELECT CASE( igrd ) 
    1218                CASE( 1 )   ;   pmask => vmask (:,:,1)   ;   j_offset = 0 
    1219                CASE( 2 )   ;   pmask => zfmask(:,:)     ;   j_offset = 0 
    1220                CASE( 3 )   ;   pmask => bdytmask        ;   j_offset = 1 
     886               CASE( 1 )   ;   zmask => pvmask     ;   j_offset = 0 
     887               CASE( 2 )   ;   zmask => pfmask     ;   j_offset = 0 
     888               CASE( 3 )   ;   zmask => bdytmask   ;   j_offset = 1 
    1221889            END SELECT  
    1222890            icount = 0 
    1223             DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
    1224                nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    1225                nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1226                znfl = pmask(nbi,nbj+j_offset-1) 
    1227                zsfl = pmask(nbi,nbj+j_offset  ) 
     891            ztmp(:,:) = -999._wp 
     892            IF( lrim0 ) THEN   ! extent of rim 0 
     893               ibeg = 1                                     ;   iend = idx_bdy(ib_bdy)%nblenrim0(igrd) 
     894            ELSE               ! extent of rim 1 
     895               ibeg = idx_bdy(ib_bdy)%nblenrim0(igrd) + 1   ;   iend = idx_bdy(ib_bdy)%nblenrim(igrd) 
     896            END IF 
     897            DO ib = ibeg, iend 
     898               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     899               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     900               IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE 
     901               zsfl = zmask(ii,ij+j_offset-1) 
     902               znfl = zmask(ii,ij+j_offset  ) 
    1228903               ! This error check only works if you are using the bdyXmask arrays 
    1229                IF( j_offset == 1 .and. znfl + zsfl == 2 ) THEN 
    1230                   IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(nbi),mjg(nbj) 
     904               IF( j_offset == 1 .and. znfl + zsfl == 2. ) THEN 
     905                  IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii),mjg(ij) 
    1231906                  icount = icount + 1 
    1232907               ELSE 
    1233                   idx_bdy(ib_bdy)%flagv(ib,igrd) = -znfl + zsfl 
     908                  ztmp(ii,ij) = -zsfl + znfl 
    1234909               END IF 
    1235910            END DO 
    1236911            IF( icount /= 0 ) THEN 
    1237                WRITE(ctmp1,*) ' E R R O R : Some ',cgrid(igrd),' grid points,',   & 
     912               WRITE(ctmp1,*) 'Some ',cgrid(igrd),' grid points,',   & 
    1238913                  ' are not boundary points (flagv calculation). Check nbi, nbj, indices for boundary set ',ib_bdy 
    1239                WRITE(ctmp2,*) ' ========== ' 
    1240                CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
    1241             ENDIF  
    1242          END DO 
    1243          ! 
    1244       END DO 
    1245       ! 
    1246       ! Tidy up 
    1247       !-------- 
    1248       IF( nb_bdy>0 )   DEALLOCATE( nbidta, nbjdta, nbrdta ) 
    1249       ! 
    1250    END SUBROUTINE bdy_segs 
    1251  
     914               CALL ctl_stop( ctmp1 ) 
     915            ENDIF 
     916            SELECT CASE( igrd ) 
     917               CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. )  
     918               CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. )  
     919               CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. )  
     920            END SELECT  
     921            DO ib = ibeg, iend 
     922               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     923               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     924               idx_bdy(ib_bdy)%flagv(ib,igrd) = ztmp(ii,ij) 
     925            END DO 
     926         END DO 
     927         ! 
     928      END DO ! ib_bdy 
     929       
     930      DO ib_bdy = 1, nb_bdy 
     931         DO igrd = 1, jpbgrd 
     932            SELECT CASE( igrd ) 
     933               CASE( 1 )   ;   zmask => bdytmask  
     934               CASE( 2 )   ;   zmask => bdyumask  
     935               CASE( 3 )   ;   zmask => bdyvmask  
     936            END SELECT 
     937            ztmp(:,:) = -999._wp 
     938            IF( lrim0 ) THEN   ! extent of rim 0 
     939               ibeg = 1                                     ;   iend = idx_bdy(ib_bdy)%nblenrim0(igrd) 
     940            ELSE               ! extent of rim 1 
     941               ibeg = idx_bdy(ib_bdy)%nblenrim0(igrd) + 1   ;   iend = idx_bdy(ib_bdy)%nblenrim(igrd) 
     942            END IF 
     943            DO ib = ibeg, iend 
     944               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     945               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     946               IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )   CYCLE 
     947               llnon = zmask(ii  ,ij+1) == 1.   
     948               llson = zmask(ii  ,ij-1) == 1.  
     949               llean = zmask(ii+1,ij  ) == 1.  
     950               llwen = zmask(ii-1,ij  ) == 1.  
     951               inn  = COUNT( (/ llnon, llson, llean, llwen /) ) 
     952               IF( inn == 0 ) THEN   ! no neighbours -> interior of a corner  or  cluster of rim points 
     953                  !               !              !     _____     !     _____    !    __     __ 
     954                  !  1 |   o      !  2  o   |    !  3 | x        !  4     x |   !      |   |   -> error 
     955                  !    |_x_ _     !    _ _x_|    !    |   o      !      o   |   !      |x_x| 
     956                  IF(     zmask(ii+1,ij+1) == 1. ) THEN   ;   ztmp(ii,ij) = 1. 
     957                  ELSEIF( zmask(ii-1,ij+1) == 1. ) THEN   ;   ztmp(ii,ij) = 2. 
     958                  ELSEIF( zmask(ii+1,ij-1) == 1. ) THEN   ;   ztmp(ii,ij) = 3. 
     959                  ELSEIF( zmask(ii-1,ij-1) == 1. ) THEN   ;   ztmp(ii,ij) = 4. 
     960                  ELSE                                    ;   ztmp(ii,ij) = -1. 
     961                     WRITE(ctmp1,*) 'Problem with  ',cgrid(igrd) ,' grid point', ii, ij,   & 
     962                       ' on boundary set ', ib_bdy, ' has no free ocean neighbour' 
     963                     IF( lrim0 ) THEN 
     964                        WRITE(ctmp2,*) ' There seems to be a cluster of rim 0 points.' 
     965                     ELSE 
     966                        WRITE(ctmp2,*) ' There seems to be a cluster of rim 1 points.' 
     967                     END IF 
     968                     CALL ctl_warn( ctmp1, ctmp2 ) 
     969                  END IF 
     970               END IF 
     971               IF( inn == 1 ) THEN   ! middle of linear bdy  or incomplete corner  ! ___ o 
     972                  !    |         !         |   !      o     !    ______            !    |x___ 
     973                  ! 5  | x o     ! 6   o x |   ! 7  __x__   ! 8    x 
     974                  !    |         !         |   !            !      o 
     975                  IF( llean )   ztmp(ii,ij) = 5. 
     976                  IF( llwen )   ztmp(ii,ij) = 6. 
     977                  IF( llnon )   ztmp(ii,ij) = 7. 
     978                  IF( llson )   ztmp(ii,ij) = 8. 
     979               END IF 
     980               IF( inn == 2 ) THEN   ! exterior of a corner 
     981                  !        o      !        o      !    _____|       !       |_____   
     982                  !  9 ____x o    ! 10   o x___   ! 11     x o      ! 12   o x       
     983                  !         |     !       |       !        o        !        o  
     984                  IF( llnon .AND. llean )   ztmp(ii,ij) =  9. 
     985                  IF( llnon .AND. llwen )   ztmp(ii,ij) = 10. 
     986                  IF( llson .AND. llean )   ztmp(ii,ij) = 11. 
     987                  IF( llson .AND. llwen )   ztmp(ii,ij) = 12. 
     988               END IF 
     989               IF( inn == 3 ) THEN   ! 3 neighbours     __   __ 
     990                  !    |_  o      !        o  _|  !       |_|     !       o          
     991                  ! 13  _| x o    ! 14   o x |_   ! 15   o x o    ! 16  o x o        
     992                  !    |   o      !        o   |  !        o      !    __|¨|__     
     993                  IF( llnon .AND. llean .AND. llson )   ztmp(ii,ij) = 13. 
     994                  IF( llnon .AND. llwen .AND. llson )   ztmp(ii,ij) = 14. 
     995                  IF( llwen .AND. llson .AND. llean )   ztmp(ii,ij) = 15. 
     996                  IF( llwen .AND. llnon .AND. llean )   ztmp(ii,ij) = 16. 
     997               END IF 
     998               IF( inn == 4 ) THEN 
     999                  WRITE(ctmp1,*)  'Problem with  ',cgrid(igrd) ,' grid point', ii, ij,   & 
     1000                       ' on boundary set ', ib_bdy, ' have 4 neighbours' 
     1001                  CALL ctl_stop( ctmp1 ) 
     1002               END IF 
     1003            END DO 
     1004            SELECT CASE( igrd ) 
     1005               CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. )  
     1006               CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. )  
     1007               CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. )  
     1008            END SELECT  
     1009            DO ib = ibeg, iend 
     1010               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1011               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1012               idx_bdy(ib_bdy)%ntreat(ib,igrd) = NINT(ztmp(ii,ij)) 
     1013            END DO 
     1014         END DO 
     1015      END DO 
     1016 
     1017    END SUBROUTINE bdy_rim_treat 
     1018 
     1019    
     1020    SUBROUTINE find_neib( ii, ij, itreat, ii1, ij1, ii2, ij2, ii3, ij3 ) 
     1021      !!---------------------------------------------------------------------- 
     1022      !!                 ***  ROUTINE find_neib  *** 
     1023      !! 
     1024      !! ** Purpose :   get ii1, ij1, ii2, ij2, ii3, ij3, the indices of 
     1025      !!               the free ocean neighbours of (ii,ij) for bdy treatment 
     1026      !! 
     1027      !! ** Method  :  use itreat input to select a case 
     1028      !!               N.B. ntreat is defined for all bdy points in routine bdy_rim_treat 
     1029      !! 
     1030      !!---------------------------------------------------------------------- 
     1031      INTEGER, INTENT(in   )      ::   ii, ij, itreat 
     1032      INTEGER, INTENT(  out)      ::   ii1, ij1, ii2, ij2, ii3, ij3 
     1033      !!---------------------------------------------------------------------- 
     1034      SELECT CASE( itreat )   ! points that will be used by bdy routines, -1 will be discarded 
     1035         !               !               !     _____     !     _____      
     1036         !  1 |   o      !  2  o   |     !  3 | x        !  4     x |     
     1037         !    |_x_ _     !    _ _x_|     !    |   o      !      o   | 
     1038      CASE( 1 )    ;   ii1 = ii+1   ;   ij1 = ij+1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1 
     1039      CASE( 2 )    ;   ii1 = ii-1   ;   ij1 = ij+1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1 
     1040      CASE( 3 )    ;   ii1 = ii+1   ;   ij1 = ij-1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1 
     1041      CASE( 4 )    ;   ii1 = ii-1   ;   ij1 = ij-1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1 
     1042         !    |          !         |     !      o        !    ______                   ! or incomplete corner 
     1043         ! 5  | x o      ! 6   o x |     ! 7  __x__      ! 8    x                      !  7  ____ o 
     1044         !    |          !         |     !               !      o                      !         |x___ 
     1045      CASE( 5 )    ;   ii1 = ii+1   ;   ij1 = ij     ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1 
     1046      CASE( 6 )    ;   ii1 = ii-1   ;   ij1 = ij     ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1 
     1047      CASE( 7 )    ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1 
     1048      CASE( 8 )    ;   ii1 = ii     ;   ij1 = ij-1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1 
     1049         !        o      !        o      !    _____|     !       |_____   
     1050         !  9 ____x o    ! 10   o x___   ! 11     x o    ! 12   o x       
     1051         !         |     !       |       !        o      !        o       
     1052      CASE( 9  )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii+1   ;   ij2 = ij     ;   ii3 = -1     ;   ij3 = -1  
     1053      CASE( 10 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii-1   ;   ij2 = ij     ;   ii3 = -1     ;   ij3 = -1 
     1054      CASE( 11 )   ;   ii1 = ii     ;   ij1 = ij-1   ;   ii2 = ii+1   ;   ij2 = ij     ;   ii3 = -1     ;   ij3 = -1 
     1055      CASE( 12 )   ;   ii1 = ii     ;   ij1 = ij-1   ;   ii2 = ii-1   ;   ij2 = ij     ;   ii3 = -1     ;   ij3 = -1 
     1056         !    |_  o      !        o  _|  !     ¨¨|_|¨¨   !       o          
     1057         ! 13  _| x o    !  14  o x |_   !  15  o x o    ! 16  o x o        
     1058         !    |   o      !        o   |  !        o      !    __|¨|__  
     1059      CASE( 13 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii+1   ;   ij2 = ij     ;   ii3 = ii     ;   ij3 = ij-1    
     1060      CASE( 14 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii-1   ;   ij2 = ij     ;   ii3 = ii     ;   ij3 = ij-1  
     1061      CASE( 15 )   ;   ii1 = ii-1   ;   ij1 = ij     ;   ii2 = ii     ;   ij2 = ij-1   ;   ii3 = ii+1   ;   ij3 = ij    
     1062      CASE( 16 )   ;   ii1 = ii-1   ;   ij1 = ij     ;   ii2 = ii     ;   ij2 = ij+1   ;   ii3 = ii+1   ;   ij3 = ij 
     1063      END SELECT 
     1064   END SUBROUTINE find_neib 
     1065     
     1066 
     1067   SUBROUTINE bdy_read_seg( kb_bdy, knblendta )  
     1068      !!---------------------------------------------------------------------- 
     1069      !!                 ***  ROUTINE bdy_coords_seg  *** 
     1070      !! 
     1071      !! ** Purpose :  build bdy coordinates with segments defined in namelist 
     1072      !! 
     1073      !! ** Method  :  read namelist nambdy_index blocks 
     1074      !! 
     1075      !!---------------------------------------------------------------------- 
     1076      INTEGER                   , INTENT (in   ) ::   kb_bdy           ! bdy number 
     1077      INTEGER, DIMENSION(jpbgrd), INTENT (  out) ::   knblendta        ! length of index arrays  
     1078      !! 
     1079      INTEGER          ::   ios                 ! Local integer output status for namelist read 
     1080      INTEGER          ::   nbdyind, nbdybeg, nbdyend 
     1081      CHARACTER(LEN=1) ::   ctypebdy   !     -        -  
     1082      NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend 
     1083      !!---------------------------------------------------------------------- 
     1084 
     1085      ! No REWIND here because may need to read more than one nambdy_index namelist. 
     1086      ! Read only namelist_cfg to avoid unseccessfull overwrite  
     1087      ! keep full control of the configuration namelist 
     1088      READ  ( numnam_cfg, nambdy_index, IOSTAT = ios, ERR = 904 ) 
     1089904   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_index in configuration namelist' ) 
     1090      IF(lwm) WRITE ( numond, nambdy_index ) 
     1091       
     1092      SELECT CASE ( TRIM(ctypebdy) ) 
     1093      CASE( 'N' ) 
     1094         IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1 
     1095            nbdyind  = jpjglo - 2  ! set boundary to whole side of model domain. 
     1096            nbdybeg  = 2 
     1097            nbdyend  = jpiglo - 1 
     1098         ENDIF 
     1099         nbdysegn = nbdysegn + 1 
     1100         npckgn(nbdysegn) = kb_bdy ! Save bdy package number 
     1101         jpjnob(nbdysegn) = nbdyind 
     1102         jpindt(nbdysegn) = nbdybeg 
     1103         jpinft(nbdysegn) = nbdyend 
     1104         ! 
     1105      CASE( 'S' ) 
     1106         IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1 
     1107            nbdyind  = 2           ! set boundary to whole side of model domain. 
     1108            nbdybeg  = 2 
     1109            nbdyend  = jpiglo - 1 
     1110         ENDIF 
     1111         nbdysegs = nbdysegs + 1 
     1112         npckgs(nbdysegs) = kb_bdy ! Save bdy package number 
     1113         jpjsob(nbdysegs) = nbdyind 
     1114         jpisdt(nbdysegs) = nbdybeg 
     1115         jpisft(nbdysegs) = nbdyend 
     1116         ! 
     1117      CASE( 'E' ) 
     1118         IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1 
     1119            nbdyind  = jpiglo - 2  ! set boundary to whole side of model domain. 
     1120            nbdybeg  = 2 
     1121            nbdyend  = jpjglo - 1 
     1122         ENDIF 
     1123         nbdysege = nbdysege + 1  
     1124         npckge(nbdysege) = kb_bdy ! Save bdy package number 
     1125         jpieob(nbdysege) = nbdyind 
     1126         jpjedt(nbdysege) = nbdybeg 
     1127         jpjeft(nbdysege) = nbdyend 
     1128         ! 
     1129      CASE( 'W' ) 
     1130         IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1 
     1131            nbdyind  = 2           ! set boundary to whole side of model domain. 
     1132            nbdybeg  = 2 
     1133            nbdyend  = jpjglo - 1 
     1134         ENDIF 
     1135         nbdysegw = nbdysegw + 1 
     1136         npckgw(nbdysegw) = kb_bdy ! Save bdy package number 
     1137         jpiwob(nbdysegw) = nbdyind 
     1138         jpjwdt(nbdysegw) = nbdybeg 
     1139         jpjwft(nbdysegw) = nbdyend 
     1140         ! 
     1141      CASE DEFAULT   ;   CALL ctl_stop( 'ctypebdy must be N, S, E or W' ) 
     1142      END SELECT 
     1143       
     1144      ! For simplicity we assume that in case of straight bdy, arrays have the same length 
     1145      ! (even if it is true that last tangential velocity points 
     1146      ! are useless). This simplifies a little bit boundary data format (and agrees with format 
     1147      ! used so far in obc package) 
     1148       
     1149      knblendta(1:jpbgrd) =  (nbdyend - nbdybeg + 1) * nn_rimwidth(kb_bdy) 
     1150       
     1151   END SUBROUTINE bdy_read_seg 
     1152 
     1153    
    12521154   SUBROUTINE bdy_ctl_seg 
    12531155      !!---------------------------------------------------------------------- 
    … …  
    12791181            &(jpjnob(ib).le.1))        CALL ctl_stop( 'nbdyind out of domain' ) 
    12801182         IF (jpindt(ib).ge.jpinft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' ) 
    1281          IF (jpindt(ib).le.1     )     CALL ctl_stop( 'Start index out of domain' ) 
    1282          IF (jpinft(ib).ge.jpiglo)     CALL ctl_stop( 'End index out of domain' ) 
     1183         IF (jpindt(ib).lt.1     )     CALL ctl_stop( 'Start index out of domain' ) 
     1184         IF (jpinft(ib).gt.jpiglo)     CALL ctl_stop( 'End index out of domain' ) 
    12831185      END DO 
    12841186      ! 
    … …  
    12881190            &(jpjsob(ib).le.1))        CALL ctl_stop( 'nbdyind out of domain' ) 
    12891191         IF (jpisdt(ib).ge.jpisft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' ) 
    1290          IF (jpisdt(ib).le.1     )     CALL ctl_stop( 'Start index out of domain' ) 
    1291          IF (jpisft(ib).ge.jpiglo)     CALL ctl_stop( 'End index out of domain' ) 
     1192         IF (jpisdt(ib).lt.1     )     CALL ctl_stop( 'Start index out of domain' ) 
     1193         IF (jpisft(ib).gt.jpiglo)     CALL ctl_stop( 'End index out of domain' ) 
    12921194      END DO 
    12931195      ! 
    … …  
    12971199            &(jpieob(ib).le.1))        CALL ctl_stop( 'nbdyind out of domain' ) 
    12981200         IF (jpjedt(ib).ge.jpjeft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' ) 
    1299          IF (jpjedt(ib).le.1     )     CALL ctl_stop( 'Start index out of domain' ) 
    1300          IF (jpjeft(ib).ge.jpjglo)     CALL ctl_stop( 'End index out of domain' ) 
     1201         IF (jpjedt(ib).lt.1     )     CALL ctl_stop( 'Start index out of domain' ) 
     1202         IF (jpjeft(ib).gt.jpjglo)     CALL ctl_stop( 'End index out of domain' ) 
    13011203      END DO 
    13021204      ! 
    … …  
    13061208            &(jpiwob(ib).le.1))        CALL ctl_stop( 'nbdyind out of domain' ) 
    13071209         IF (jpjwdt(ib).ge.jpjwft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' ) 
    1308          IF (jpjwdt(ib).le.1     )     CALL ctl_stop( 'Start index out of domain' ) 
    1309          IF (jpjwft(ib).ge.jpjglo)     CALL ctl_stop( 'End index out of domain' ) 
     1210         IF (jpjwdt(ib).lt.1     )     CALL ctl_stop( 'Start index out of domain' ) 
     1211         IF (jpjwft(ib).gt.jpjglo)     CALL ctl_stop( 'End index out of domain' ) 
    13101212      ENDDO 
    13111213      ! 
    … …  
    13361238                     icorns(ib2,1) = npckgw(ib1) 
    13371239                  ELSEIF ((jpisft(ib2)==jpiwob(ib1)).AND.(jpjwft(ib1)==jpjsob(ib2))) THEN 
    1338                      WRITE(ctmp1,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 
     1240                     WRITE(ctmp1,*) ' Found an acute open boundary corner at point (i,j)= ', & 
    13391241                        &                                     jpisft(ib2), jpjwft(ib1) 
    1340                      WRITE(ctmp2,*) ' ==========  Not allowed yet' 
    1341                      WRITE(ctmp3,*) '             Crossing problem with West segment: ',npckgw(ib1), &  
    1342                         &                                        ' and South segment: ',npckgs(ib2) 
    1343                      CALL ctl_stop( ' ', ctmp1, ctmp2, ctmp3, ' ' ) 
     1242                     WRITE(ctmp2,*) ' Not allowed yet' 
     1243                     WRITE(ctmp3,*) ' Crossing problem with West segment: ',npckgw(ib1), &  
     1244                        &                            ' and South segment: ',npckgs(ib2) 
     1245                     CALL ctl_stop( ctmp1, ctmp2, ctmp3 ) 
    13441246                  ELSE 
    1345                      WRITE(ctmp1,*) ' E R R O R : Check South and West Open boundary indices' 
    1346                      WRITE(ctmp2,*) ' ==========  Crossing problem with West segment: ',npckgw(ib1) , & 
    1347                         &                                         ' and South segment: ',npckgs(ib2) 
    1348                      CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
     1247                     WRITE(ctmp1,*) ' Check South and West Open boundary indices' 
     1248                     WRITE(ctmp2,*) ' Crossing problem with West segment: ',npckgw(ib1) , & 
     1249                        &                            ' and South segment: ',npckgs(ib2) 
     1250                     CALL ctl_stop( ctmp1, ctmp2 ) 
    13491251                  END IF 
    13501252               END IF 
    … …  
    13681270                     icorns(ib2,2) = npckge(ib1) 
    13691271                  ELSEIF ((jpjeft(ib1)==jpjsob(ib2)).AND.(jpisdt(ib2)==jpieob(ib1)+1)) THEN 
    1370                      WRITE(ctmp1,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 
     1272                     WRITE(ctmp1,*) ' Found an acute open boundary corner at point (i,j)= ', & 
    13711273                        &                                     jpisdt(ib2), jpjeft(ib1) 
    1372                      WRITE(ctmp2,*) ' ==========  Not allowed yet' 
    1373                      WRITE(ctmp3,*) '             Crossing problem with East segment: ',npckge(ib1), & 
    1374                         &                                        ' and South segment: ',npckgs(ib2) 
    1375                      CALL ctl_stop( ' ', ctmp1, ctmp2, ctmp3, ' ' ) 
     1274                     WRITE(ctmp2,*) ' Not allowed yet' 
     1275                     WRITE(ctmp3,*) ' Crossing problem with East segment: ',npckge(ib1), & 
     1276                        &                            ' and South segment: ',npckgs(ib2) 
     1277                     CALL ctl_stop( ctmp1, ctmp2, ctmp3 ) 
    13761278                  ELSE 
    1377                      WRITE(ctmp1,*) ' E R R O R : Check South and East Open boundary indices' 
    1378                      WRITE(ctmp2,*) ' ==========  Crossing problem with East segment: ',npckge(ib1), & 
    1379                      &                                           ' and South segment: ',npckgs(ib2) 
    1380                      CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
     1279                     WRITE(ctmp1,*) ' Check South and East Open boundary indices' 
     1280                     WRITE(ctmp2,*) ' Crossing problem with East segment: ',npckge(ib1), & 
     1281                     &                               ' and South segment: ',npckgs(ib2) 
     1282                     CALL ctl_stop( ctmp1, ctmp2 ) 
    13811283                  END IF 
    13821284               END IF 
    … …  
    14001302                     icornn(ib2,1) = npckgw(ib1) 
    14011303                  ELSEIF ((jpjwdt(ib1)==jpjnob(ib2)+1).AND.(jpinft(ib2)==jpiwob(ib1))) THEN 
    1402                      WRITE(ctmp1,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 
     1304                     WRITE(ctmp1,*) ' Found an acute open boundary corner at point (i,j)= ', & 
    14031305                     &                                     jpinft(ib2), jpjwdt(ib1) 
    1404                      WRITE(ctmp2,*) ' ==========  Not allowed yet' 
    1405                      WRITE(ctmp3,*) '             Crossing problem with West segment: ',npckgw(ib1), & 
    1406                      &                                                    ' and North segment: ',npckgn(ib2) 
    1407                      CALL ctl_stop( ' ', ctmp1, ctmp2, ctmp3, ' ' ) 
     1306                     WRITE(ctmp2,*) ' Not allowed yet' 
     1307                     WRITE(ctmp3,*) ' Crossing problem with West segment: ',npckgw(ib1), & 
     1308                     &                               ' and North segment: ',npckgn(ib2) 
     1309                     CALL ctl_stop( ctmp1, ctmp2, ctmp3 ) 
    14081310                  ELSE 
    1409                      WRITE(ctmp1,*) ' E R R O R : Check North and West Open boundary indices' 
    1410                      WRITE(ctmp2,*) ' ==========  Crossing problem with West segment: ',npckgw(ib1), & 
    1411                      &                                                    ' and North segment: ',npckgn(ib2) 
    1412                      CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
     1311                     WRITE(ctmp1,*) ' Check North and West Open boundary indices' 
     1312                     WRITE(ctmp2,*) ' Crossing problem with West segment: ',npckgw(ib1), & 
     1313                     &                               ' and North segment: ',npckgn(ib2) 
     1314                     CALL ctl_stop( ctmp1, ctmp2 ) 
    14131315                  END IF 
    14141316               END IF 
    … …  
    14321334                     icornn(ib2,2) = npckge(ib1) 
    14331335                  ELSEIF ((jpjedt(ib1)==jpjnob(ib2)+1).AND.(jpindt(ib2)==jpieob(ib1)+1)) THEN 
    1434                      WRITE(ctmp1,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', & 
     1336                     WRITE(ctmp1,*) ' Found an acute open boundary corner at point (i,j)= ', & 
    14351337                     &                                     jpindt(ib2), jpjedt(ib1) 
    1436                      WRITE(ctmp2,*) ' ==========  Not allowed yet' 
    1437                      WRITE(ctmp3,*) '             Crossing problem with East segment: ',npckge(ib1), & 
    1438                      &                                           ' and North segment: ',npckgn(ib2) 
    1439                      CALL ctl_stop( ' ', ctmp1, ctmp2, ctmp3, ' ' ) 
     1338                     WRITE(ctmp2,*) ' Not allowed yet' 
     1339                     WRITE(ctmp3,*) ' Crossing problem with East segment: ',npckge(ib1), & 
     1340                     &                               ' and North segment: ',npckgn(ib2) 
     1341                     CALL ctl_stop( ctmp1, ctmp2, ctmp3 ) 
    14401342                  ELSE 
    1441                      WRITE(ctmp1,*) ' E R R O R : Check North and East Open boundary indices' 
    1442                      WRITE(ctmp2,*) ' ==========  Crossing problem with East segment: ',npckge(ib1), & 
    1443                      &                                           ' and North segment: ',npckgn(ib2) 
    1444                      CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
     1343                     WRITE(ctmp1,*) ' Check North and East Open boundary indices' 
     1344                     WRITE(ctmp2,*) ' Crossing problem with East segment: ',npckge(ib1), & 
     1345                     &                               ' and North segment: ',npckgn(ib2) 
     1346                     CALL ctl_stop( ctmp1, ctmp2 ) 
    14451347                  END IF 
    14461348               END IF 
    … …  
    14681370         IF (ztestmask(1)==1) THEN  
    14691371            IF (icornw(ib,1)==0) THEN 
    1470                WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgw(ib) 
    1471                WRITE(ctmp2,*) ' ==========  does not start on land or on a corner'                                                   
    1472                CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
     1372               WRITE(ctmp1,*) ' Open boundary segment ', npckgw(ib) 
     1373               CALL ctl_stop( ctmp1, ' does not start on land or on a corner' ) 
    14731374            ELSE 
    14741375               ! This is a corner 
    … …  
    14801381         IF (ztestmask(2)==1) THEN 
    14811382            IF (icornw(ib,2)==0) THEN 
    1482                WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgw(ib) 
    1483                WRITE(ctmp2,*) ' ==========  does not end on land or on a corner'                                                   
    1484                CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
     1383               WRITE(ctmp1,*) ' Open boundary segment ', npckgw(ib) 
     1384               CALL ctl_stop( ' ', ctmp1, ' does not end on land or on a corner' ) 
    14851385            ELSE 
    14861386               ! This is a corner 
    … …  
    15081408         IF (ztestmask(1)==1) THEN 
    15091409            IF (icorne(ib,1)==0) THEN 
    1510                WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckge(ib) 
    1511                WRITE(ctmp2,*) ' ==========  does not start on land or on a corner'                                                   
    1512                CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
     1410               WRITE(ctmp1,*) ' Open boundary segment ', npckge(ib) 
     1411               CALL ctl_stop( ctmp1, ' does not start on land or on a corner' ) 
    15131412            ELSE 
    15141413               ! This is a corner 
    … …  
    15201419         IF (ztestmask(2)==1) THEN 
    15211420            IF (icorne(ib,2)==0) THEN 
    1522                WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckge(ib) 
    1523                WRITE(ctmp2,*) ' ==========  does not end on land or on a corner'                                                   
    1524                CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
     1421               WRITE(ctmp1,*) ' Open boundary segment ', npckge(ib) 
     1422               CALL ctl_stop( ctmp1, ' does not end on land or on a corner' ) 
    15251423            ELSE 
    15261424               ! This is a corner 
    … …  
    15471445 
    15481446         IF ((ztestmask(1)==1).AND.(icorns(ib,1)==0)) THEN 
    1549             WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgs(ib) 
    1550             WRITE(ctmp2,*) ' ==========  does not start on land or on a corner'                                                   
    1551             CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
     1447            WRITE(ctmp1,*) ' Open boundary segment ', npckgs(ib) 
     1448            CALL ctl_stop( ctmp1, ' does not start on land or on a corner' ) 
    15521449         ENDIF 
    15531450         IF ((ztestmask(2)==1).AND.(icorns(ib,2)==0)) THEN 
    1554             WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgs(ib) 
    1555             WRITE(ctmp2,*) ' ==========  does not end on land or on a corner'                                                   
    1556             CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
     1451            WRITE(ctmp1,*) ' Open boundary segment ', npckgs(ib) 
     1452            CALL ctl_stop( ctmp1, ' does not end on land or on a corner' ) 
    15571453         ENDIF 
    15581454      END DO 
    … …  
    15731469 
    15741470         IF ((ztestmask(1)==1).AND.(icornn(ib,1)==0)) THEN 
    1575             WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgn(ib) 
    1576             WRITE(ctmp2,*) ' ==========  does not start on land'                                                   
    1577             CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
     1471            WRITE(ctmp1,*) ' Open boundary segment ', npckgn(ib) 
     1472            CALL ctl_stop( ctmp1, ' does not start on land' ) 
    15781473         ENDIF 
    15791474         IF ((ztestmask(2)==1).AND.(icornn(ib,2)==0)) THEN 
    1580             WRITE(ctmp1,*) ' E R R O R : Open boundary segment ', npckgn(ib) 
    1581             WRITE(ctmp2,*) ' ==========  does not end on land'                                                   
    1582             CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
     1475            WRITE(ctmp1,*) ' Open boundary segment ', npckgn(ib) 
     1476            CALL ctl_stop( ctmp1, ' does not end on land' ) 
    15831477         ENDIF 
    15841478      END DO 
    … …  
    15931487   END SUBROUTINE bdy_ctl_seg 
    15941488 
    1595  
     1489    
     1490   SUBROUTINE bdy_coords_seg( nbidta, nbjdta, nbrdta )  
     1491      !!---------------------------------------------------------------------- 
     1492      !!                 ***  ROUTINE bdy_coords_seg  *** 
     1493      !! 
     1494      !! ** Purpose :  build nbidta, nbidta, nbrdta for bdy built with segments 
     1495      !! 
     1496      !! ** Method  :   
     1497      !! 
     1498      !!---------------------------------------------------------------------- 
     1499      INTEGER, DIMENSION(:,:,:), intent(  out)  ::   nbidta, nbjdta, nbrdta   ! Index arrays: i and j indices of bdy dta 
     1500      !! 
     1501      INTEGER  ::   ii, ij, ir, iseg 
     1502      INTEGER  ::   igrd         ! grid type (t=1, u=2, v=3) 
     1503      INTEGER  ::   icount       !  
     1504      INTEGER  ::   ib_bdy       ! bdy number 
     1505      !!---------------------------------------------------------------------- 
     1506 
     1507      ! East 
     1508      !----- 
     1509      DO iseg = 1, nbdysege 
     1510         ib_bdy = npckge(iseg) 
     1511         ! 
     1512         ! ------------ T points ------------- 
     1513         igrd=1 
     1514         icount=0 
     1515         DO ir = 1, nn_rimwidth(ib_bdy) 
     1516            DO ij = jpjedt(iseg), jpjeft(iseg) 
     1517               icount = icount + 1 
     1518               nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir 
     1519               nbjdta(icount, igrd, ib_bdy) = ij 
     1520               nbrdta(icount, igrd, ib_bdy) = ir 
     1521            ENDDO 
     1522         ENDDO 
     1523         ! 
     1524         ! ------------ U points ------------- 
     1525         igrd=2 
     1526         icount=0 
     1527         DO ir = 1, nn_rimwidth(ib_bdy) 
     1528            DO ij = jpjedt(iseg), jpjeft(iseg) 
     1529               icount = icount + 1 
     1530               nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 1 - ir 
     1531               nbjdta(icount, igrd, ib_bdy) = ij 
     1532               nbrdta(icount, igrd, ib_bdy) = ir 
     1533            ENDDO 
     1534         ENDDO 
     1535         ! 
     1536         ! ------------ V points ------------- 
     1537         igrd=3 
     1538         icount=0 
     1539         DO ir = 1, nn_rimwidth(ib_bdy) 
     1540            !            DO ij = jpjedt(iseg), jpjeft(iseg) - 1 
     1541            DO ij = jpjedt(iseg), jpjeft(iseg) 
     1542               icount = icount + 1 
     1543               nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir 
     1544               nbjdta(icount, igrd, ib_bdy) = ij 
     1545               nbrdta(icount, igrd, ib_bdy) = ir 
     1546            ENDDO 
     1547            nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point 
     1548            nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point 
     1549         ENDDO 
     1550      ENDDO 
     1551      ! 
     1552      ! West 
     1553      !----- 
     1554      DO iseg = 1, nbdysegw 
     1555         ib_bdy = npckgw(iseg) 
     1556         ! 
     1557         ! ------------ T points ------------- 
     1558         igrd=1 
     1559         icount=0 
     1560         DO ir = 1, nn_rimwidth(ib_bdy) 
     1561            DO ij = jpjwdt(iseg), jpjwft(iseg) 
     1562               icount = icount + 1 
     1563               nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 
     1564               nbjdta(icount, igrd, ib_bdy) = ij 
     1565               nbrdta(icount, igrd, ib_bdy) = ir 
     1566            ENDDO 
     1567         ENDDO 
     1568         ! 
     1569         ! ------------ U points ------------- 
     1570         igrd=2 
     1571         icount=0 
     1572         DO ir = 1, nn_rimwidth(ib_bdy) 
     1573            DO ij = jpjwdt(iseg), jpjwft(iseg) 
     1574               icount = icount + 1 
     1575               nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 
     1576               nbjdta(icount, igrd, ib_bdy) = ij 
     1577               nbrdta(icount, igrd, ib_bdy) = ir 
     1578            ENDDO 
     1579         ENDDO 
     1580         ! 
     1581         ! ------------ V points ------------- 
     1582         igrd=3 
     1583         icount=0 
     1584         DO ir = 1, nn_rimwidth(ib_bdy) 
     1585            !            DO ij = jpjwdt(iseg), jpjwft(iseg) - 1 
     1586            DO ij = jpjwdt(iseg), jpjwft(iseg) 
     1587               icount = icount + 1 
     1588               nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 
     1589               nbjdta(icount, igrd, ib_bdy) = ij 
     1590               nbrdta(icount, igrd, ib_bdy) = ir 
     1591            ENDDO 
     1592            nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point 
     1593            nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point 
     1594         ENDDO 
     1595      ENDDO 
     1596      ! 
     1597      ! North 
     1598      !----- 
     1599      DO iseg = 1, nbdysegn 
     1600         ib_bdy = npckgn(iseg) 
     1601         ! 
     1602         ! ------------ T points ------------- 
     1603         igrd=1 
     1604         icount=0 
     1605         DO ir = 1, nn_rimwidth(ib_bdy) 
     1606            DO ii = jpindt(iseg), jpinft(iseg) 
     1607               icount = icount + 1 
     1608               nbidta(icount, igrd, ib_bdy) = ii 
     1609               nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir  
     1610               nbrdta(icount, igrd, ib_bdy) = ir 
     1611            ENDDO 
     1612         ENDDO 
     1613         ! 
     1614         ! ------------ U points ------------- 
     1615         igrd=2 
     1616         icount=0 
     1617         DO ir = 1, nn_rimwidth(ib_bdy) 
     1618            !            DO ii = jpindt(iseg), jpinft(iseg) - 1 
     1619            DO ii = jpindt(iseg), jpinft(iseg) 
     1620               icount = icount + 1 
     1621               nbidta(icount, igrd, ib_bdy) = ii 
     1622               nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir 
     1623               nbrdta(icount, igrd, ib_bdy) = ir 
     1624            ENDDO 
     1625            nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point 
     1626            nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point 
     1627         ENDDO 
     1628         ! 
     1629         ! ------------ V points ------------- 
     1630         igrd=3 
     1631         icount=0 
     1632         DO ir = 1, nn_rimwidth(ib_bdy) 
     1633            DO ii = jpindt(iseg), jpinft(iseg) 
     1634               icount = icount + 1 
     1635               nbidta(icount, igrd, ib_bdy) = ii 
     1636               nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 1 - ir 
     1637               nbrdta(icount, igrd, ib_bdy) = ir 
     1638            ENDDO 
     1639         ENDDO 
     1640      ENDDO 
     1641      ! 
     1642      ! South 
     1643      !----- 
     1644      DO iseg = 1, nbdysegs 
     1645         ib_bdy = npckgs(iseg) 
     1646         ! 
     1647         ! ------------ T points ------------- 
     1648         igrd=1 
     1649         icount=0 
     1650         DO ir = 1, nn_rimwidth(ib_bdy) 
     1651            DO ii = jpisdt(iseg), jpisft(iseg) 
     1652               icount = icount + 1 
     1653               nbidta(icount, igrd, ib_bdy) = ii 
     1654               nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 
     1655               nbrdta(icount, igrd, ib_bdy) = ir 
     1656            ENDDO 
     1657         ENDDO 
     1658         ! 
     1659         ! ------------ U points ------------- 
     1660         igrd=2 
     1661         icount=0 
     1662         DO ir = 1, nn_rimwidth(ib_bdy) 
     1663            !            DO ii = jpisdt(iseg), jpisft(iseg) - 1 
     1664            DO ii = jpisdt(iseg), jpisft(iseg) 
     1665               icount = icount + 1 
     1666               nbidta(icount, igrd, ib_bdy) = ii 
     1667               nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 
     1668               nbrdta(icount, igrd, ib_bdy) = ir 
     1669            ENDDO 
     1670            nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point 
     1671            nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point 
     1672         ENDDO 
     1673         ! 
     1674         ! ------------ V points ------------- 
     1675         igrd=3 
     1676         icount=0 
     1677         DO ir = 1, nn_rimwidth(ib_bdy) 
     1678            DO ii = jpisdt(iseg), jpisft(iseg) 
     1679               icount = icount + 1 
     1680               nbidta(icount, igrd, ib_bdy) = ii 
     1681               nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 
     1682               nbrdta(icount, igrd, ib_bdy) = ir 
     1683            ENDDO 
     1684         ENDDO 
     1685      ENDDO 
     1686 
     1687       
     1688   END SUBROUTINE bdy_coords_seg 
     1689    
     1690    
    15961691   SUBROUTINE bdy_ctl_corn( ib1, ib2 ) 
    15971692      !!---------------------------------------------------------------------- 
    … …  
    16191714      ! 
    16201715      IF( itest>0 ) THEN 
    1621          WRITE(ctmp1,*) ' E R R O R : Segments ', ib1, 'and ', ib2 
    1622          WRITE(ctmp2,*) ' ==========  have different open bdy schemes'                                                   
    1623          CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
     1716         WRITE(ctmp1,*) ' Segments ', ib1, 'and ', ib2 
     1717         CALL ctl_stop( ctmp1, ' have different open bdy schemes' ) 
    16241718      ENDIF 
    16251719      ! 
    16261720   END SUBROUTINE bdy_ctl_corn 
    16271721 
     1722 
     1723   SUBROUTINE bdy_meshwri() 
     1724      !!---------------------------------------------------------------------- 
     1725      !!                 ***  ROUTINE bdy_meshwri  *** 
     1726      !!          
     1727      !! ** Purpose :   write netcdf file with nbr, flagu, flagv, ntreat for T, U  
     1728      !!                and V points in 2D arrays for easier visualisation/control 
     1729      !! 
     1730      !! ** Method  :   use iom_rstput as in domwri.F 
     1731      !!----------------------------------------------------------------------       
     1732      INTEGER  ::   ib_bdy, ii, ij, igrd, ib     ! dummy loop indices 
     1733      INTEGER  ::   inum                                   !   -       - 
     1734      REAL(wp), POINTER, DIMENSION(:,:)     ::   zmask                   ! pointer to 2D mask fields 
     1735      REAL(wp)         , DIMENSION(jpi,jpj) ::   ztmp 
     1736      CHARACTER(LEN=1) , DIMENSION(jpbgrd)  ::   cgrid 
     1737      !!----------------------------------------------------------------------       
     1738      cgrid = (/'t','u','v'/) 
     1739      CALL iom_open( 'bdy_mesh', inum, ldwrt = .TRUE. ) 
     1740      DO igrd = 1, jpbgrd 
     1741         SELECT CASE( igrd ) 
     1742         CASE( 1 )   ;   zmask => tmask(:,:,1) 
     1743         CASE( 2 )   ;   zmask => umask(:,:,1) 
     1744         CASE( 3 )   ;   zmask => vmask(:,:,1) 
     1745         END SELECT 
     1746         ztmp(:,:) = zmask(:,:) 
     1747         DO ib_bdy = 1, nb_bdy 
     1748            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)      ! nbr deined for all rims 
     1749               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1750               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1751               ztmp(ii,ij) = REAL(idx_bdy(ib_bdy)%nbr(ib,igrd), wp) + 10. 
     1752               IF( zmask(ii,ij) == 0. ) ztmp(ii,ij) = - ztmp(ii,ij) 
     1753            END DO 
     1754         END DO 
     1755         CALL iom_rstput( 0, 0, inum, 'bdy_nbr_'//cgrid(igrd), ztmp(:,:), ktype = jp_i4 ) 
     1756         ztmp(:,:) = zmask(:,:) 
     1757         DO ib_bdy = 1, nb_bdy 
     1758            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   ! flagu defined only for rims 0 and 1 
     1759               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1760               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1761               ztmp(ii,ij) = REAL(idx_bdy(ib_bdy)%flagu(ib,igrd), wp) + 10. 
     1762               IF( zmask(ii,ij) == 0. ) ztmp(ii,ij) = - ztmp(ii,ij) 
     1763            END DO 
     1764         END DO 
     1765         CALL iom_rstput( 0, 0, inum, 'flagu_'//cgrid(igrd), ztmp(:,:), ktype = jp_i4 ) 
     1766         ztmp(:,:) = zmask(:,:) 
     1767         DO ib_bdy = 1, nb_bdy 
     1768            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   ! flagv defined only for rims 0 and 1 
     1769               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1770               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1771               ztmp(ii,ij) = REAL(idx_bdy(ib_bdy)%flagv(ib,igrd), wp) + 10. 
     1772               IF( zmask(ii,ij) == 0. ) ztmp(ii,ij) = - ztmp(ii,ij) 
     1773            END DO 
     1774         END DO 
     1775         CALL iom_rstput( 0, 0, inum, 'flagv_'//cgrid(igrd), ztmp(:,:), ktype = jp_i4 ) 
     1776         ztmp(:,:) = zmask(:,:) 
     1777         DO ib_bdy = 1, nb_bdy 
     1778            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   ! ntreat defined only for rims 0 and 1 
     1779               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1780               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1781               ztmp(ii,ij) = REAL(idx_bdy(ib_bdy)%ntreat(ib,igrd), wp) + 10. 
     1782               IF( zmask(ii,ij) == 0. ) ztmp(ii,ij) = - ztmp(ii,ij) 
     1783            END DO 
     1784         END DO 
     1785         CALL iom_rstput( 0, 0, inum, 'ntreat_'//cgrid(igrd), ztmp(:,:), ktype = jp_i4 ) 
     1786      END DO 
     1787      CALL iom_close( inum ) 
     1788 
     1789   END SUBROUTINE bdy_meshwri 
     1790    
    16281791   !!================================================================================= 
    16291792END MODULE bdyini 

  • NEMO/trunk/src/OCE/BDY/bdylib.F90

    r10529 r11536  
    1515   USE bdy_oce        ! ocean open boundary conditions 
    1616   USE phycst         ! physical constants 
     17   USE bdyini 
    1718   ! 
    1819   USE in_out_manager ! 
    … …  
    7576      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend 
    7677      !! 
    77       REAL(wp) ::   zwgt           ! boundary weight 
    7878      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    7979      INTEGER  ::   ii, ij         ! 2D addresses 
    … …  
    9292 
    9393 
    94    SUBROUTINE bdy_orl( idx, ptb, pta, dta, ll_npo ) 
     94   SUBROUTINE bdy_orl( idx, ptb, pta, dta, lrim0, ll_npo ) 
    9595      !!---------------------------------------------------------------------- 
    9696      !!                 ***  SUBROUTINE bdy_orl  *** 
    … …  
    104104      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptb  ! before tracer field 
    105105      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend 
     106      LOGICAL                 , OPTIONAL,  INTENT(in) ::   lrim0   ! indicate if rim 0 is treated 
    106107      LOGICAL,                             INTENT(in) ::   ll_npo  ! switch for NPO version 
    107108      !! 
    … …  
    111112      igrd = 1                       ! Everything is at T-points here 
    112113      ! 
    113       CALL bdy_orlanski_3d( idx, igrd, ptb(:,:,:), pta(:,:,:), dta, ll_npo ) 
     114      CALL bdy_orlanski_3d( idx, igrd, ptb(:,:,:), pta(:,:,:), dta, lrim0, ll_npo ) 
    114115      ! 
    115116   END SUBROUTINE bdy_orl 
    116117 
    117118 
    118    SUBROUTINE bdy_orlanski_2d( idx, igrd, phib, phia, phi_ext, ll_npo ) 
     119   SUBROUTINE bdy_orlanski_2d( idx, igrd, phib, phia, phi_ext, lrim0, ll_npo ) 
    119120      !!---------------------------------------------------------------------- 
    120121      !!                 ***  SUBROUTINE bdy_orlanski_2d  *** 
    … …  
    132133      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   phia     ! model after 2D field (to be updated) 
    133134      REAL(wp), DIMENSION(:)  , INTENT(in   ) ::   phi_ext  ! external forcing data 
     135      LOGICAL, OPTIONAL,        INTENT(in   ) ::   lrim0    ! indicate if rim 0 is treated 
    134136      LOGICAL ,                 INTENT(in   ) ::   ll_npo   ! switch for NPO version 
    135137      ! 
    … …  
    140142      INTEGER  ::   ii_offset, ij_offset                   ! offsets for mask indices 
    141143      INTEGER  ::   flagu, flagv                           ! short cuts 
     144      INTEGER  ::   ibeg, iend                             ! length of rim to be treated (rim 0 or rim 1 or both) 
    142145      REAL(wp) ::   zmask_x, zmask_y1, zmask_y2 
    143146      REAL(wp) ::   zex1, zex2, zey, zey1, zey2 
    … …  
    146149      REAL(wp) ::   zdy_1, zdy_2, zsign_ups 
    147150      REAL(wp), PARAMETER :: zepsilon = 1.e-30                 ! local small value 
    148       REAL(wp), POINTER, DIMENSION(:,:)          :: pmask      ! land/sea mask for field 
    149       REAL(wp), POINTER, DIMENSION(:,:)          :: pmask_xdif ! land/sea mask for x-derivatives 
    150       REAL(wp), POINTER, DIMENSION(:,:)          :: pmask_ydif ! land/sea mask for y-derivatives 
     151      REAL(wp), POINTER, DIMENSION(:,:)          :: zmask      ! land/sea mask for field 
     152      REAL(wp), POINTER, DIMENSION(:,:)          :: zmask_xdif ! land/sea mask for x-derivatives 
     153      REAL(wp), POINTER, DIMENSION(:,:)          :: zmask_ydif ! land/sea mask for y-derivatives 
    151154      REAL(wp), POINTER, DIMENSION(:,:)          :: pe_xdif    ! scale factors for x-derivatives 
    152155      REAL(wp), POINTER, DIMENSION(:,:)          :: pe_ydif    ! scale factors for y-derivatives 
    … …  
    159162      SELECT CASE(igrd) 
    160163         CASE(1) 
    161             pmask      => tmask(:,:,1) 
    162             pmask_xdif => umask(:,:,1) 
    163             pmask_ydif => vmask(:,:,1) 
     164            zmask      => tmask(:,:,1) 
     165            zmask_xdif => umask(:,:,1) 
     166            zmask_ydif => vmask(:,:,1) 
    164167            pe_xdif    => e1u(:,:) 
    165168            pe_ydif    => e2v(:,:) 
    … …  
    167170            ij_offset = 0 
    168171         CASE(2) 
    169             pmask      => umask(:,:,1) 
    170             pmask_xdif => tmask(:,:,1) 
    171             pmask_ydif => fmask(:,:,1) 
     172            zmask      => umask(:,:,1) 
     173            zmask_xdif => tmask(:,:,1) 
     174            zmask_ydif => fmask(:,:,1) 
    172175            pe_xdif    => e1t(:,:) 
    173176            pe_ydif    => e2f(:,:) 
    … …  
    175178            ij_offset = 0 
    176179         CASE(3) 
    177             pmask      => vmask(:,:,1) 
    178             pmask_xdif => fmask(:,:,1) 
    179             pmask_ydif => tmask(:,:,1) 
     180            zmask      => vmask(:,:,1) 
     181            zmask_xdif => fmask(:,:,1) 
     182            zmask_ydif => tmask(:,:,1) 
    180183            pe_xdif    => e1f(:,:) 
    181184            pe_ydif    => e2t(:,:) 
    … …  
    185188      END SELECT 
    186189      ! 
    187       DO jb = 1, idx%nblenrim(igrd) 
     190      IF( PRESENT(lrim0) ) THEN 
     191         IF( lrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)   ! rim 0 
     192         ELSE               ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)    ! rim 1 
     193         END IF 
     194      ELSE                  ;   ibeg = 1                       ;   iend = idx%nblenrim(igrd)    ! both 
     195      END IF 
     196      ! 
     197      DO jb = ibeg, iend 
    188198         ii  = idx%nbi(jb,igrd) 
    189199         ij  = idx%nbj(jb,igrd)  
     200         IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )   CYCLE 
    190201         flagu = int( idx%flagu(jb,igrd) ) 
    191202         flagv = int( idx%flagv(jb,igrd) ) 
    … …  
    203214         ! 
    204215         ! Calculate scale factors for calculation of spatial derivatives.         
    205          zex1 = ( abs(iibm1-iibm2) * pe_xdif(iibm1+ii_offset,ijbm1          )         & 
    206         &       + abs(ijbm1-ijbm2) * pe_ydif(iibm1          ,ijbm1+ij_offset) )  
    207          zex2 = ( abs(iibm1-iibm2) * pe_xdif(iibm2+ii_offset,ijbm2          )         & 
    208         &       + abs(ijbm1-ijbm2) * pe_ydif(iibm2          ,ijbm2+ij_offset) )  
    209          zey1 = ( (iibm1-iibm1jm1) * pe_xdif(iibm1jm1+ii_offset,ijbm1jm1          )  &  
     216         zex1 = ( abs(iibm1-iibm2) * pe_xdif(iibm1   +ii_offset,ijbm1             )   & 
     217        &       + abs(ijbm1-ijbm2) * pe_ydif(iibm1             ,ijbm1   +ij_offset) )  
     218         zex2 = ( abs(iibm1-iibm2) * pe_xdif(iibm2   +ii_offset,ijbm2             )   & 
     219        &       + abs(ijbm1-ijbm2) * pe_ydif(iibm2             ,ijbm2   +ij_offset) )  
     220         zey1 = ( (iibm1-iibm1jm1) * pe_xdif(iibm1jm1+ii_offset,ijbm1jm1          )   &  
    210221        &      +  (ijbm1-ijbm1jm1) * pe_ydif(iibm1jm1          ,ijbm1jm1+ij_offset) )  
    211          zey2 = ( (iibm1jp1-iibm1) * pe_xdif(iibm1+ii_offset,ijbm1)                  & 
    212         &      +  (ijbm1jp1-ijbm1) * pe_ydif(iibm1          ,ijbm1+ij_offset) )  
     222         zey2 = ( (iibm1jp1-iibm1) * pe_xdif(iibm1   +ii_offset,ijbm1             )   & 
     223        &      +  (ijbm1jp1-ijbm1) * pe_ydif(iibm1             ,ijbm1   +ij_offset) )  
    213224         ! make sure scale factors are nonzero 
    214225         if( zey1 .lt. rsmall ) zey1 = zey2 
    … …  
    217228         zey1 = max(zey1,rsmall); zey2 = max(zey2,rsmall);  
    218229         ! 
    219          ! Calculate masks for calculation of spatial derivatives.         
    220          zmask_x = ( abs(iibm1-iibm2) * pmask_xdif(iibm2+ii_offset,ijbm2          )         & 
    221         &          + abs(ijbm1-ijbm2) * pmask_ydif(iibm2          ,ijbm2+ij_offset) )  
    222          zmask_y1 = ( (iibm1-iibm1jm1) * pmask_xdif(iibm1jm1+ii_offset,ijbm1jm1          )  &  
    223         &          +  (ijbm1-ijbm1jm1) * pmask_ydif(iibm1jm1          ,ijbm1jm1+ij_offset) )  
    224          zmask_y2 = ( (iibm1jp1-iibm1) * pmask_xdif(iibm1+ii_offset,ijbm1)                  & 
    225         &          +  (ijbm1jp1-ijbm1) * pmask_ydif(iibm1          ,ijbm1+ij_offset) )  
     230         ! Calculate masks for calculation of spatial derivatives. 
     231         zmask_x  = ( abs(iibm1-iibm2) * zmask_xdif(iibm2   +ii_offset,ijbm2               )   & 
     232        &           + abs(ijbm1-ijbm2) * zmask_ydif(iibm2             ,ijbm2   +ij_offset) )  
     233         zmask_y1 = ( (iibm1-iibm1jm1) * zmask_xdif(iibm1jm1+ii_offset,ijbm1jm1            )   &  
     234        &          +  (ijbm1-ijbm1jm1) * zmask_ydif(iibm1jm1          ,ijbm1jm1+ij_offset) )  
     235         zmask_y2 = ( (iibm1jp1-iibm1) * zmask_xdif(iibm1   +ii_offset,ijbm1               )   & 
     236        &          +  (ijbm1jp1-ijbm1) * zmask_ydif(iibm1             ,ijbm1   +ij_offset) )  
    226237 
    227238         ! Calculation of terms required for both versions of the scheme.  
    … …  
    231242         ! Note no rdt factor in expression for zdt because it cancels in the expressions for  
    232243         ! zrx and zry. 
    233          zdt = phia(iibm1,ijbm1) - phib(iibm1,ijbm1) 
    234          zdx = ( ( phia(iibm1,ijbm1) - phia(iibm2,ijbm2) ) / zex2 ) * zmask_x  
     244         zdt   =     phia(iibm1   ,ijbm1   ) - phib(iibm1   ,ijbm1   ) 
     245         zdx   = ( ( phia(iibm1   ,ijbm1   ) - phia(iibm2   ,ijbm2   ) ) / zex2 ) * zmask_x  
    235246         zdy_1 = ( ( phib(iibm1   ,ijbm1   ) - phib(iibm1jm1,ijbm1jm1) ) / zey1 ) * zmask_y1     
    236          zdy_2 = ( ( phib(iibm1jp1,ijbm1jp1) - phib(iibm1   ,ijbm1)    ) / zey2 ) * zmask_y2  
     247         zdy_2 = ( ( phib(iibm1jp1,ijbm1jp1) - phib(iibm1   ,ijbm1   ) ) / zey2 ) * zmask_y2  
    237248         zdy_centred = 0.5 * ( zdy_1 + zdy_2 ) 
    238249!!$         zdy_centred = phib(iibm1jp1,ijbm1jp1) - phib(iibm1jm1,ijbm1jm1) 
    … …  
    265276           &                    + zwgt * ( phi_ext(jb) - phib(ii,ij) ) ) / ( 1. + zrx )  
    266277         end if 
    267          phia(ii,ij) = phia(ii,ij) * pmask(ii,ij) 
     278         phia(ii,ij) = phia(ii,ij) * zmask(ii,ij) 
    268279      END DO 
    269280      ! 
    … …  
    271282 
    272283 
    273    SUBROUTINE bdy_orlanski_3d( idx, igrd, phib, phia, phi_ext, ll_npo ) 
     284   SUBROUTINE bdy_orlanski_3d( idx, igrd, phib, phia, phi_ext, lrim0, ll_npo ) 
    274285      !!---------------------------------------------------------------------- 
    275286      !!                 ***  SUBROUTINE bdy_orlanski_3d  *** 
    … …  
    287298      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phia     ! model after 3D field (to be updated) 
    288299      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   phi_ext  ! external forcing data 
     300      LOGICAL, OPTIONAL,          INTENT(in   ) ::   lrim0    ! indicate if rim 0 is treated 
    289301      LOGICAL ,                   INTENT(in   ) ::   ll_npo   ! switch for NPO version 
    290302      ! 
    … …  
    295307      INTEGER  ::   ii_offset, ij_offset                   ! offsets for mask indices 
    296308      INTEGER  ::   flagu, flagv                           ! short cuts 
     309      INTEGER  ::   ibeg, iend                             ! length of rim to be treated (rim 0 or rim 1 or both) 
    297310      REAL(wp) ::   zmask_x, zmask_y1, zmask_y2 
    298311      REAL(wp) ::   zex1, zex2, zey, zey1, zey2 
    … …  
    301314      REAL(wp) ::   zdy_1, zdy_2,  zsign_ups 
    302315      REAL(wp), PARAMETER :: zepsilon = 1.e-30                 ! local small value 
    303       REAL(wp), POINTER, DIMENSION(:,:,:)        :: pmask      ! land/sea mask for field 
    304       REAL(wp), POINTER, DIMENSION(:,:,:)        :: pmask_xdif ! land/sea mask for x-derivatives 
    305       REAL(wp), POINTER, DIMENSION(:,:,:)        :: pmask_ydif ! land/sea mask for y-derivatives 
     316      REAL(wp), POINTER, DIMENSION(:,:,:)        :: zmask      ! land/sea mask for field 
     317      REAL(wp), POINTER, DIMENSION(:,:,:)        :: zmask_xdif ! land/sea mask for x-derivatives 
     318      REAL(wp), POINTER, DIMENSION(:,:,:)        :: zmask_ydif ! land/sea mask for y-derivatives 
    306319      REAL(wp), POINTER, DIMENSION(:,:)          :: pe_xdif    ! scale factors for x-derivatives 
    307320      REAL(wp), POINTER, DIMENSION(:,:)          :: pe_ydif    ! scale factors for y-derivatives 
    … …  
    314327      SELECT CASE(igrd) 
    315328         CASE(1) 
    316             pmask      => tmask(:,:,:) 
    317             pmask_xdif => umask(:,:,:) 
    318             pmask_ydif => vmask(:,:,:) 
     329            zmask      => tmask(:,:,:) 
     330            zmask_xdif => umask(:,:,:) 
     331            zmask_ydif => vmask(:,:,:) 
    319332            pe_xdif    => e1u(:,:) 
    320333            pe_ydif    => e2v(:,:) 
    … …  
    322335            ij_offset = 0 
    323336         CASE(2) 
    324             pmask      => umask(:,:,:) 
    325             pmask_xdif => tmask(:,:,:) 
    326             pmask_ydif => fmask(:,:,:) 
     337            zmask      => umask(:,:,:) 
     338            zmask_xdif => tmask(:,:,:) 
     339            zmask_ydif => fmask(:,:,:) 
    327340            pe_xdif    => e1t(:,:) 
    328341            pe_ydif    => e2f(:,:) 
    … …  
    330343            ij_offset = 0 
    331344         CASE(3) 
    332             pmask      => vmask(:,:,:) 
    333             pmask_xdif => fmask(:,:,:) 
    334             pmask_ydif => tmask(:,:,:) 
     345            zmask      => vmask(:,:,:) 
     346            zmask_xdif => fmask(:,:,:) 
     347            zmask_ydif => tmask(:,:,:) 
    335348            pe_xdif    => e1f(:,:) 
    336349            pe_ydif    => e2t(:,:) 
    … …  
    339352         CASE DEFAULT ;   CALL ctl_stop( 'unrecognised value for igrd in bdy_orlanksi_2d' ) 
    340353      END SELECT 
    341  
     354      ! 
     355      IF( PRESENT(lrim0) ) THEN 
     356         IF( lrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)   ! rim 0 
     357         ELSE               ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)    ! rim 1 
     358         END IF 
     359      ELSE                  ;   ibeg = 1                       ;   iend = idx%nblenrim(igrd)    ! both 
     360      END IF 
     361      ! 
    342362      DO jk = 1, jpk 
    343363         !             
    344          DO jb = 1, idx%nblenrim(igrd) 
     364         DO jb = ibeg, iend 
    345365            ii  = idx%nbi(jb,igrd) 
    346366            ij  = idx%nbj(jb,igrd)  
     367            IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )   CYCLE 
    347368            flagu = int( idx%flagu(jb,igrd) ) 
    348369            flagv = int( idx%flagv(jb,igrd) ) 
    … …  
    360381            ! 
    361382            ! Calculate scale factors for calculation of spatial derivatives.         
    362             zex1 = ( abs(iibm1-iibm2) * pe_xdif(iibm1+ii_offset,ijbm1          )         & 
    363            &       + abs(ijbm1-ijbm2) * pe_ydif(iibm1          ,ijbm1+ij_offset) )  
    364             zex2 = ( abs(iibm1-iibm2) * pe_xdif(iibm2+ii_offset,ijbm2          )         & 
    365            &       + abs(ijbm1-ijbm2) * pe_ydif(iibm2          ,ijbm2+ij_offset) )  
    366             zey1 = ( (iibm1-iibm1jm1) * pe_xdif(iibm1jm1+ii_offset,ijbm1jm1          )  &  
     383            zex1 = ( abs(iibm1-iibm2) * pe_xdif(iibm1   +ii_offset,ijbm1             )   & 
     384           &       + abs(ijbm1-ijbm2) * pe_ydif(iibm1             ,ijbm1+ij_offset   ) )  
     385            zex2 = ( abs(iibm1-iibm2) * pe_xdif(iibm2   +ii_offset,ijbm2             )   & 
     386           &       + abs(ijbm1-ijbm2) * pe_ydif(iibm2             ,ijbm2+ij_offset   ) )  
     387            zey1 = ( (iibm1-iibm1jm1) * pe_xdif(iibm1jm1+ii_offset,ijbm1jm1          )   &  
    367388           &      +  (ijbm1-ijbm1jm1) * pe_ydif(iibm1jm1          ,ijbm1jm1+ij_offset) )  
    368             zey2 = ( (iibm1jp1-iibm1) * pe_xdif(iibm1+ii_offset,ijbm1)                  & 
    369            &      +  (ijbm1jp1-ijbm1) * pe_ydif(iibm1          ,ijbm1+ij_offset) )  
     389            zey2 = ( (iibm1jp1-iibm1) * pe_xdif(iibm1   +ii_offset,ijbm1             )   & 
     390           &      +  (ijbm1jp1-ijbm1) * pe_ydif(iibm1             ,ijbm1+ij_offset   ) )  
    370391            ! make sure scale factors are nonzero 
    371392            if( zey1 .lt. rsmall ) zey1 = zey2 
    … …  
    375396            ! 
    376397            ! Calculate masks for calculation of spatial derivatives.         
    377             zmask_x = ( abs(iibm1-iibm2) * pmask_xdif(iibm2+ii_offset,ijbm2          ,jk)          & 
    378            &          + abs(ijbm1-ijbm2) * pmask_ydif(iibm2          ,ijbm2+ij_offset,jk) )  
    379             zmask_y1 = ( (iibm1-iibm1jm1) * pmask_xdif(iibm1jm1+ii_offset,ijbm1jm1          ,jk)   &  
    380            &          +  (ijbm1-ijbm1jm1) * pmask_ydif(iibm1jm1          ,ijbm1jm1+ij_offset,jk) )  
    381             zmask_y2 = ( (iibm1jp1-iibm1) * pmask_xdif(iibm1+ii_offset,ijbm1          ,jk)         & 
    382            &          +  (ijbm1jp1-ijbm1) * pmask_ydif(iibm1          ,ijbm1+ij_offset,jk) )  
     398            zmask_x  = ( abs(iibm1-iibm2) * zmask_xdif(iibm2   +ii_offset,ijbm2             ,jk)   & 
     399           &           + abs(ijbm1-ijbm2) * zmask_ydif(iibm2             ,ijbm2   +ij_offset,jk) )  
     400            zmask_y1 = ( (iibm1-iibm1jm1) * zmask_xdif(iibm1jm1+ii_offset,ijbm1jm1          ,jk)   &  
     401           &          +  (ijbm1-ijbm1jm1) * zmask_ydif(iibm1jm1          ,ijbm1jm1+ij_offset,jk) )  
     402            zmask_y2 = ( (iibm1jp1-iibm1) * zmask_xdif(iibm1   +ii_offset,ijbm1             ,jk)   & 
     403           &          +  (ijbm1jp1-ijbm1) * zmask_ydif(iibm1             ,ijbm1   +ij_offset,jk) )  
    383404            ! 
    384405            ! Calculate normal (zrx) and tangential (zry) components of radiation velocities. 
    … …  
    386407            ! Centred derivative is calculated as average of "left" and "right" derivatives for  
    387408            ! this reason.  
    388             zdt = phia(iibm1,ijbm1,jk) - phib(iibm1,ijbm1,jk) 
    389             zdx = ( ( phia(iibm1,ijbm1,jk) - phia(iibm2,ijbm2,jk) ) / zex2 ) * zmask_x                   
     409            zdt   =     phia(iibm1   ,ijbm1   ,jk) - phib(iibm1   ,ijbm1   ,jk) 
     410            zdx   = ( ( phia(iibm1   ,ijbm1   ,jk) - phia(iibm2   ,ijbm2   ,jk) ) / zex2 ) * zmask_x                   
    390411            zdy_1 = ( ( phib(iibm1   ,ijbm1   ,jk) - phib(iibm1jm1,ijbm1jm1,jk) ) / zey1 ) * zmask_y1   
    391412            zdy_2 = ( ( phib(iibm1jp1,ijbm1jp1,jk) - phib(iibm1   ,ijbm1   ,jk) ) / zey2 ) * zmask_y2       
    … …  
    421442              &                       + zwgt * ( phi_ext(jb,jk) - phib(ii,ij,jk) ) ) / ( 1. + zrx )  
    422443            end if 
    423             phia(ii,ij,jk) = phia(ii,ij,jk) * pmask(ii,ij,jk) 
     444            phia(ii,ij,jk) = phia(ii,ij,jk) * zmask(ii,ij,jk) 
    424445         END DO 
    425446         ! 
    … …  
    428449   END SUBROUTINE bdy_orlanski_3d 
    429450 
    430    SUBROUTINE bdy_nmn( idx, igrd, phia ) 
     451   SUBROUTINE bdy_nmn( idx, igrd, phia, lrim0 ) 
    431452      !!---------------------------------------------------------------------- 
    432453      !!                 ***  SUBROUTINE bdy_nmn  *** 
    … …  
    434455      !! ** Purpose : Duplicate the value at open boundaries, zero gradient. 
    435456      !!  
    436       !!---------------------------------------------------------------------- 
    437       INTEGER,                    INTENT(in)     ::   igrd     ! grid index 
    438       REAL(wp), DIMENSION(:,:,:), INTENT(inout)  ::   phia     ! model after 3D field (to be updated) 
    439       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
     457      !! 
     458      !! ** Method  : - take the average of free ocean neighbours 
     459      !! 
     460      !!      ___   !   |_____|   !   ___|    !   __|x o   !   |_   _|     ! |       
     461      !!   __|x     !      x      !     x o   !      o     !     |_|       ! |x o    
     462      !!      o     !      o      !     o     !            !    o x o      ! |x_x_  
     463      !!                                                   !      o       
     464      !!---------------------------------------------------------------------- 
     465      INTEGER,                    INTENT(in   )  ::   igrd     ! grid index 
     466      REAL(wp), DIMENSION(:,:,:), INTENT(inout)  ::   phia     ! model after 3D field (to be updated), must be masked 
     467      TYPE(OBC_INDEX),            INTENT(in   )  ::   idx      ! OBC indices 
     468      LOGICAL, OPTIONAL,          INTENT(in   )  ::   lrim0    ! indicate if rim 0 is treated 
    440469      !!  
    441       REAL(wp) ::   zcoef, zcoef1, zcoef2 
    442       REAL(wp), POINTER, DIMENSION(:,:,:)        :: pmask      ! land/sea mask for field 
    443       REAL(wp), POINTER, DIMENSION(:,:)        :: bdypmask      ! land/sea mask for field 
     470      REAL(wp) ::   zweight 
     471      REAL(wp), POINTER, DIMENSION(:,:,:)      :: zmask         ! land/sea mask for field 
    444472      INTEGER  ::   ib, ik   ! dummy loop indices 
    445       INTEGER  ::   ii, ij, ip, jp   ! 2D addresses 
    446       !!---------------------------------------------------------------------- 
     473      INTEGER  ::   ii, ij   ! 2D addresses 
     474      INTEGER  ::   ipkm1    ! size of phia third dimension minus 1 
     475      INTEGER  ::   ibeg, iend                          ! length of rim to be treated (rim 0 or rim 1 or both) 
     476      INTEGER  ::   ii1, ii2, ii3, ij1, ij2, ij3, itreat 
     477      !!---------------------------------------------------------------------- 
     478      ! 
     479      ipkm1 = MAX( SIZE(phia,3) - 1, 1 )  
    447480      ! 
    448481      SELECT CASE(igrd) 
    449          CASE(1) 
    450             pmask => tmask(:,:,:) 
    451             bdypmask => bdytmask(:,:) 
    452          CASE(2) 
    453             pmask => umask(:,:,:) 
    454             bdypmask => bdyumask(:,:) 
    455          CASE(3) 
    456             pmask => vmask(:,:,:) 
    457             bdypmask => bdyvmask(:,:) 
     482         CASE(1)   ;   zmask => tmask(:,:,:) 
     483         CASE(2)   ;   zmask => umask(:,:,:) 
     484         CASE(3)   ;   zmask => vmask(:,:,:) 
    458485         CASE DEFAULT ;   CALL ctl_stop( 'unrecognised value for igrd in bdy_nmn' ) 
    459486      END SELECT 
    460       DO ib = 1, idx%nblenrim(igrd) 
     487      ! 
     488      IF( PRESENT(lrim0) ) THEN 
     489         IF( lrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)   ! rim 0 
     490         ELSE               ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)    ! rim 1 
     491         END IF 
     492      ELSE                  ;   ibeg = 1                       ;   iend = idx%nblenrim(igrd)    ! both 
     493      END IF 
     494      ! 
     495      DO ib = ibeg, iend 
    461496         ii = idx%nbi(ib,igrd) 
    462497         ij = idx%nbj(ib,igrd) 
    463          DO ik = 1, jpkm1 
    464             ! search the sense of the gradient 
    465             zcoef1 = bdypmask(ii-1,ij  )*pmask(ii-1,ij,ik) +  bdypmask(ii+1,ij  )*pmask(ii+1,ij,ik) 
    466             zcoef2 = bdypmask(ii  ,ij-1)*pmask(ii,ij-1,ik) +  bdypmask(ii  ,ij+1)*pmask(ii,ij+1,ik) 
    467             IF ( nint(zcoef1+zcoef2) == 0) THEN 
    468                ! corner **** we probably only want to set the tangentail component for the dynamics here 
    469                zcoef = pmask(ii-1,ij,ik) + pmask(ii+1,ij,ik) +  pmask(ii,ij-1,ik) +  pmask(ii,ij+1,ik) 
    470                IF (zcoef > .5_wp) THEN ! Only set none isolated points. 
    471                  phia(ii,ij,ik) = phia(ii-1,ij  ,ik) * pmask(ii-1,ij  ,ik) + & 
    472                    &              phia(ii+1,ij  ,ik) * pmask(ii+1,ij  ,ik) + & 
    473                    &              phia(ii  ,ij-1,ik) * pmask(ii  ,ij-1,ik) + & 
    474                    &              phia(ii  ,ij+1,ik) * pmask(ii  ,ij+1,ik) 
    475                  phia(ii,ij,ik) = ( phia(ii,ij,ik) / zcoef ) * pmask(ii,ij,ik) 
    476                ELSE 
    477                  phia(ii,ij,ik) = phia(ii,ij  ,ik) * pmask(ii,ij  ,ik) 
    478                ENDIF 
    479             ELSEIF ( nint(zcoef1+zcoef2) == 2) THEN 
    480                ! oblique corner **** we probably only want to set the normal component for the dynamics here 
    481                zcoef = pmask(ii-1,ij,ik)*bdypmask(ii-1,ij  ) + pmask(ii+1,ij,ik)*bdypmask(ii+1,ij  ) + & 
    482                    &   pmask(ii,ij-1,ik)*bdypmask(ii,ij -1 ) +  pmask(ii,ij+1,ik)*bdypmask(ii,ij+1  ) 
    483                phia(ii,ij,ik) = phia(ii-1,ij  ,ik) * pmask(ii-1,ij  ,ik)*bdypmask(ii-1,ij  ) + & 
    484                    &            phia(ii+1,ij  ,ik) * pmask(ii+1,ij  ,ik)*bdypmask(ii+1,ij  )  + & 
    485                    &            phia(ii  ,ij-1,ik) * pmask(ii  ,ij-1,ik)*bdypmask(ii,ij -1 ) + & 
    486                    &            phia(ii  ,ij+1,ik) * pmask(ii  ,ij+1,ik)*bdypmask(ii,ij+1  ) 
    487   
    488                phia(ii,ij,ik) = ( phia(ii,ij,ik) / MAX(1._wp, zcoef) ) * pmask(ii,ij,ik) 
    489             ELSE 
    490                ip = nint(bdypmask(ii+1,ij  )*pmask(ii+1,ij,ik) - bdypmask(ii-1,ij  )*pmask(ii-1,ij,ik)) 
    491                jp = nint(bdypmask(ii  ,ij+1)*pmask(ii,ij+1,ik) - bdypmask(ii  ,ij-1)*pmask(ii,ij-1,ik)) 
    492                phia(ii,ij,ik) = phia(ii+ip,ij+jp,ik) * pmask(ii+ip,ij+jp,ik) 
    493             ENDIF 
    494          END DO 
     498         itreat = idx%ntreat(ib,igrd) 
     499         CALL find_neib( ii, ij, itreat, ii1, ij1, ii2, ij2, ii3, ij3 )   ! find free ocean neighbours 
     500         SELECT CASE( itreat ) 
     501         CASE( 1:8 ) 
     502            IF( ii1 < 1 .OR. ii1 > jpi .OR. ij1 < 1 .OR. ij1 > jpj )   CYCLE 
     503            DO ik = 1, ipkm1 
     504               IF( zmask(ii1,ij1,ik) /= 0. )   phia(ii,ij,ik) = phia(ii1,ij1,ik)   
     505            END DO 
     506         CASE( 9:12 ) 
     507            IF( ii1 < 1 .OR. ii1 > jpi .OR. ij1 < 1 .OR. ij1 > jpj )   CYCLE 
     508            IF( ii2 < 1 .OR. ii2 > jpi .OR. ij2 < 1 .OR. ij2 > jpj )   CYCLE 
     509            DO ik = 1, ipkm1 
     510               zweight = zmask(ii1,ij1,ik) + zmask(ii2,ij2,ik) 
     511               IF( zweight /= 0. )   phia(ii,ij,ik) = ( phia(ii1,ij1,ik) + phia(ii2,ij2,ik) ) / zweight 
     512            END DO 
     513         CASE( 13:16 ) 
     514            IF( ii1 < 1 .OR. ii1 > jpi .OR. ij1 < 1 .OR. ij1 > jpj )   CYCLE 
     515            IF( ii2 < 1 .OR. ii2 > jpi .OR. ij2 < 1 .OR. ij2 > jpj )   CYCLE 
     516            IF( ii3 < 1 .OR. ii3 > jpi .OR. ij3 < 1 .OR. ij3 > jpj )   CYCLE 
     517            DO ik = 1, ipkm1 
     518               zweight = zmask(ii1,ij1,ik) + zmask(ii2,ij2,ik) + zmask(ii3,ij3,ik) 
     519               IF( zweight /= 0. )   phia(ii,ij,ik) = ( phia(ii1,ij1,ik) + phia(ii2,ij2,ik) + phia(ii3,ij3,ik) ) / zweight 
     520            END DO 
     521         END SELECT 
    495522      END DO 
    496523      ! 

  • NEMO/trunk/src/OCE/BDY/bdytides.F90

    r10068 r11536  
    7070      INTEGER                                   ::   inum, igrd 
    7171      INTEGER, DIMENSION(3)                     ::   ilen0       !: length of boundary data (from OBC arrays) 
    72       INTEGER, POINTER, DIMENSION(:)            ::   nblen, nblenrim     ! short cuts 
    7372      INTEGER                                   ::   ios                 ! Local integer output status for namelist read 
    7473      CHARACTER(len=80)                         ::   clfile              !: full file name for tidal input file  
    … …  
    7776      !! 
    7877      TYPE(TIDES_DATA),  POINTER                ::   td                  !: local short cut    
    79       TYPE(MAP_POINTER), DIMENSION(jpbgrd)      ::   ibmap_ptr           !: array of pointers to nbmap 
    8078      !! 
    8179      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj 
    8280      !!---------------------------------------------------------------------- 
    8381      ! 
    84       IF (nb_bdy>0) THEN 
    85          IF(lwp) WRITE(numout,*) 
    86          IF(lwp) WRITE(numout,*) 'bdytide_init : initialization of tidal harmonic forcing at open boundaries' 
    87          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    88       ENDIF 
     82      IF(lwp) WRITE(numout,*) 
     83      IF(lwp) WRITE(numout,*) 'bdytide_init : initialization of tidal harmonic forcing at open boundaries' 
     84      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    8985 
    9086      REWIND(numnam_cfg) 
    … …  
    9490            ! 
    9591            td => tides(ib_bdy) 
    96             nblen => idx_bdy(ib_bdy)%nblen 
    97             nblenrim => idx_bdy(ib_bdy)%nblenrim 
    9892 
    9993            ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries 
    10094            filtide(:) = '' 
    10195 
     96            REWIND( numnam_ref ) 
     97            READ  ( numnam_ref, nambdy_tide, IOSTAT = ios, ERR = 901) 
     98901         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_tide in reference namelist' ) 
    10299            ! Don't REWIND here - may need to read more than one of these namelists.  
    103             READ  ( numnam_ref, nambdy_tide, IOSTAT = ios, ERR = 901) 
    104 901         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_tide in reference namelist', lwp ) 
    105100            READ  ( numnam_cfg, nambdy_tide, IOSTAT = ios, ERR = 902 ) 
    106 902         IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist', lwp ) 
     101902         IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist' ) 
    107102            IF(lwm) WRITE ( numond, nambdy_tide ) 
    108103            !                                               ! Parameter control and print 
    … …  
    125120            ! JC: If FRS scheme is used, we assume that tidal is needed over the whole 
    126121            ! relaxation area       
    127             IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = nblen   (:) 
    128             ELSE                                   ;   ilen0(:) = nblenrim(:) 
     122            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = idx_bdy(ib_bdy)%nblen   (:) 
     123            ELSE                                   ;   ilen0(:) = idx_bdy(ib_bdy)%nblenrim(:) 
    129124            ENDIF 
    130125 
    … …  
    161156                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    162157                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     158                     IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    163159                     td%ssh0(ib,itide,1) = ztr(ii,ij) 
    164160                     td%ssh0(ib,itide,2) = zti(ii,ij) 
    … …  
    177173                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    178174                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     175                     IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    179176                     td%u0(ib,itide,1) = ztr(ii,ij) 
    180177                     td%u0(ib,itide,2) = zti(ii,ij) 
    … …  
    193190                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    194191                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     192                     IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    195193                     td%v0(ib,itide,1) = ztr(ii,ij) 
    196194                     td%v0(ib,itide,2) = zti(ii,ij) 
    … …  
    207205               ALLOCATE( dta_read( MAXVAL(ilen0(1:3)), 1, 1 ) ) 
    208206               ! 
    209                ! Set map structure 
    210                ibmap_ptr(1)%ptr => idx_bdy(ib_bdy)%nbmap(:,1)   ;   ibmap_ptr(1)%ll_unstruc = ln_coords_file(ib_bdy) 
    211                ibmap_ptr(2)%ptr => idx_bdy(ib_bdy)%nbmap(:,2)   ;   ibmap_ptr(2)%ll_unstruc = ln_coords_file(ib_bdy) 
    212                ibmap_ptr(3)%ptr => idx_bdy(ib_bdy)%nbmap(:,3)   ;   ibmap_ptr(3)%ll_unstruc = ln_coords_file(ib_bdy) 
    213  
    214207               ! Open files and read in tidal forcing data 
    215208               ! ----------------------------------------- 
    … …  
    219212                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_T.nc' 
    220213                  CALL iom_open( clfile, inum ) 
    221                   CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1,  ibmap_ptr(1) ) 
     214                  CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 
    222215                  td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1) 
    223                   CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1,  ibmap_ptr(1) ) 
     216                  CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 
    224217                  td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1) 
    225218                  CALL iom_close( inum ) 
    … …  
    227220                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_U.nc' 
    228221                  CALL iom_open( clfile, inum ) 
    229                   CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, ibmap_ptr(2) ) 
     222                  CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 
    230223                  td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1) 
    231                   CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, ibmap_ptr(2) ) 
     224                  CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 
    232225                  td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1) 
    233226                  CALL iom_close( inum ) 
    … …  
    235228                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_V.nc' 
    236229                  CALL iom_open( clfile, inum ) 
    237                   CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, ibmap_ptr(3) ) 
     230                  CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 
    238231                  td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1) 
    239                   CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, ibmap_ptr(3) ) 
     232                  CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 
    240233                  td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1) 
    241234                  CALL iom_close( inum ) 
    … …  
    269262 
    270263 
    271    SUBROUTINE bdytide_update( kt, idx, dta, td, jit, time_offset ) 
     264   SUBROUTINE bdytide_update( kt, idx, dta, td, kit, kt_offset ) 
    272265      !!---------------------------------------------------------------------- 
    273266      !!                 ***  SUBROUTINE bdytide_update  *** 
    … …  
    280273      TYPE(OBC_DATA)   , INTENT(inout) ::   dta         ! OBC external data 
    281274      TYPE(TIDES_DATA) , INTENT(inout) ::   td          ! tidal harmonics data 
    282       INTEGER, OPTIONAL, INTENT(in   ) ::   jit         ! Barotropic timestep counter (for timesplitting option) 
    283       INTEGER, OPTIONAL, INTENT(in   ) ::   time_offset ! time offset in units of timesteps. NB. if jit 
     275      INTEGER, OPTIONAL, INTENT(in   ) ::   kit         ! Barotropic timestep counter (for timesplitting option) 
     276      INTEGER, OPTIONAL, INTENT(in   ) ::   kt_offset   ! time offset in units of timesteps. NB. if kit 
    284277      !                                                 ! is present then units = subcycle timesteps. 
    285       !                                                 ! time_offset = 0  => get data at "now"    time level 
    286       !                                                 ! time_offset = -1 => get data at "before" time level 
    287       !                                                 ! time_offset = +1 => get data at "after"  time level 
     278      !                                                 ! kt_offset = 0  => get data at "now"    time level 
     279      !                                                 ! kt_offset = -1 => get data at "before" time level 
     280      !                                                 ! kt_offset = +1 => get data at "after"  time level 
    288281      !                                                 ! etc. 
    289282      ! 
    … …  
    300293 
    301294      zflag=1 
    302       IF ( PRESENT(jit) ) THEN 
    303         IF ( jit /= 1 ) zflag=0 
     295      IF ( PRESENT(kit) ) THEN 
     296        IF ( kit /= 1 ) zflag=0 
    304297      ENDIF 
    305298 
    … …  
    320313 
    321314      time_add = 0 
    322       IF( PRESENT(time_offset) ) THEN 
    323          time_add = time_offset 
     315      IF( PRESENT(kt_offset) ) THEN 
     316         time_add = kt_offset 
    324317      ENDIF 
    325318          
    326       IF( PRESENT(jit) ) THEN   
    327          z_arg = ((kt-kt_tide) * rdt + (jit+0.5_wp*(time_add-1)) * rdt / REAL(nn_baro,wp) ) 
     319      IF( PRESENT(kit) ) THEN   
     320         z_arg = ((kt-kt_tide) * rdt + (kit+0.5_wp*(time_add-1)) * rdt / REAL(nn_baro,wp) ) 
    328321      ELSE                               
    329322         z_arg = ((kt-kt_tide)+time_add) * rdt 
    … …  
    358351 
    359352 
    360    SUBROUTINE bdy_dta_tides( kt, kit, time_offset ) 
     353   SUBROUTINE bdy_dta_tides( kt, kit, kt_offset ) 
    361354      !!---------------------------------------------------------------------- 
    362355      !!                 ***  SUBROUTINE bdy_dta_tides  *** 
    … …  
    367360      INTEGER,           INTENT(in) ::   kt          ! Main timestep counter 
    368361      INTEGER, OPTIONAL, INTENT(in) ::   kit         ! Barotropic timestep counter (for timesplitting option) 
    369       INTEGER, OPTIONAL, INTENT(in) ::   time_offset ! time offset in units of timesteps. NB. if kit 
     362      INTEGER, OPTIONAL, INTENT(in) ::   kt_offset  ! time offset in units of timesteps. NB. if kit 
    370363      !                                              ! is present then units = subcycle timesteps. 
    371       !                                              ! time_offset = 0  => get data at "now"    time level 
    372       !                                              ! time_offset = -1 => get data at "before" time level 
    373       !                                              ! time_offset = +1 => get data at "after"  time level 
     364      !                                              ! kt_offset = 0  => get data at "now"    time level 
     365      !                                              ! kt_offset = -1 => get data at "before" time level 
     366      !                                              ! kt_offset = +1 => get data at "after"  time level 
    374367      !                                              ! etc. 
    375368      ! 
    … …  
    386379 
    387380      time_add = 0 
    388       IF( PRESENT(time_offset) ) THEN 
    389          time_add = time_offset 
     381      IF( PRESENT(kt_offset) ) THEN 
     382         time_add = kt_offset 
    390383      ENDIF 
    391384       
    … …  
    432425            ! If time splitting, initialize arrays from slow varying open boundary data: 
    433426            IF ( PRESENT(kit) ) THEN            
    434                IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 
    435                IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 
    436                IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 
     427               IF ( dta_bdy(ib_bdy)%lneed_ssh  ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 
     428               IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 
     429               IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 
    437430            ENDIF 
    438431            ! 
    … …  
    444437               z_sist = zramp * SIN( z_sarg ) 
    445438               ! 
    446                IF ( dta_bdy(ib_bdy)%ll_ssh ) THEN 
     439               IF ( dta_bdy(ib_bdy)%lneed_ssh ) THEN 
    447440                  igrd=1                              ! SSH on tracer grid 
    448441                  DO ib = 1, ilen0(igrd) 
    … …  
    453446               ENDIF 
    454447               ! 
    455                IF ( dta_bdy(ib_bdy)%ll_u2d ) THEN 
     448               IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) THEN 
    456449                  igrd=2                              ! U grid 
    457450                  DO ib = 1, ilen0(igrd) 
    … …  
    460453                        &                        tides(ib_bdy)%u(ib,itide,2)*z_sist ) 
    461454                  END DO 
    462                ENDIF 
    463                ! 
    464                IF ( dta_bdy(ib_bdy)%ll_v2d ) THEN 
    465455                  igrd=3                              ! V grid 
    466456                  DO ib = 1, ilen0(igrd)  

  • NEMO/trunk/src/OCE/BDY/bdytra.F90

    r10529 r11536  
    4949      INTEGER, INTENT(in) ::   kt   ! Main time step counter 
    5050      ! 
    51       INTEGER                        :: ib_bdy, jn, igrd   ! Loop indeces 
    52       TYPE(ztrabdy), DIMENSION(jpts) :: zdta               ! Temporary data structure 
     51      INTEGER                        :: ib_bdy, jn, igrd, ir   ! Loop indeces 
     52      TYPE(ztrabdy), DIMENSION(jpts) :: zdta                   ! Temporary data structure 
     53      LOGICAL                        :: llrim0                 ! indicate if rim 0 is treated 
     54      LOGICAL, DIMENSION(4)          :: llsend1, llrecv1       ! indicate how communications are to be carried out 
    5355      !!---------------------------------------------------------------------- 
    5456      igrd = 1  
    55  
    56       DO ib_bdy=1, nb_bdy 
     57      llsend1(:) = .false.  ;   llrecv1(:) = .false. 
     58      DO ir = 1, 0, -1   ! treat rim 1 before rim 0 
     59         IF( ir == 0 ) THEN   ;   llrim0 = .TRUE. 
     60         ELSE                 ;   llrim0 = .FALSE. 
     61         END IF 
     62         DO ib_bdy=1, nb_bdy 
     63            ! 
     64            zdta(1)%tra => dta_bdy(ib_bdy)%tem 
     65            zdta(2)%tra => dta_bdy(ib_bdy)%sal 
     66            ! 
     67            DO jn = 1, jpts 
     68               ! 
     69               SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 
     70               CASE('none'        )   ;   CYCLE 
     71               CASE('frs'         )   ! treat the whole boundary at once 
     72                  IF( ir == 0 ) CALL bdy_frs ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra ) 
     73               CASE('specified'   )   ! treat the whole rim      at once 
     74                  IF( ir == 0 ) CALL bdy_spe ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra ) 
     75               CASE('neumann'     )   ;   CALL bdy_nmn ( idx_bdy(ib_bdy), igrd         , tsa(:,:,:,jn), llrim0 )   ! tsa masked 
     76               CASE('orlanski'    )   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), & 
     77                    & zdta(jn)%tra, llrim0, ll_npo=.false. ) 
     78               CASE('orlanski_npo')   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), & 
     79                    & zdta(jn)%tra, llrim0, ll_npo=.true.  ) 
     80               CASE('runoff'      )   ;   CALL bdy_rnf ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), jn, llrim0 ) 
     81               CASE DEFAULT           ;   CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 
     82               END SELECT 
     83               !  
     84            END DO 
     85         END DO 
    5786         ! 
    58          zdta(1)%tra => dta_bdy(ib_bdy)%tem 
    59          zdta(2)%tra => dta_bdy(ib_bdy)%sal 
     87         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 
     88         IF( nn_hls == 1 ) THEN   ;   llsend1(:) = .false.   ;   llrecv1(:) = .false.   ;   END IF 
     89         DO ib_bdy=1, nb_bdy 
     90            SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 
     91            CASE('neumann','runoff') 
     92               llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     93               llrecv1(:) = llrecv1(:) .OR. lrecv_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     94            CASE('orlanski', 'orlanski_npo') 
     95               llsend1(:) = llsend1(:) .OR. lsend_bdy(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     96               llrecv1(:) = llrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     97            END SELECT 
     98         END DO 
     99         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
     100            CALL lbc_lnk( 'bdytra', tsa, 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     101         END IF 
    60102         ! 
    61          DO jn = 1, jpts 
    62             ! 
    63             SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 
    64             CASE('none'        )   ;   CYCLE 
    65             CASE('frs'         )   ;   CALL bdy_frs ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra ) 
    66             CASE('specified'   )   ;   CALL bdy_spe ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra ) 
    67             CASE('neumann'     )   ;   CALL bdy_nmn ( idx_bdy(ib_bdy), igrd         , tsa(:,:,:,jn)               ) 
    68             CASE('orlanski'    )   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.false. ) 
    69             CASE('orlanski_npo')   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.true. ) 
    70             CASE('runoff'      )   ;   CALL bdy_rnf ( idx_bdy(ib_bdy),                tsa(:,:,:,jn),               jn ) 
    71             CASE DEFAULT           ;   CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 
    72             END SELECT 
    73             ! Boundary points should be updated 
    74             CALL lbc_bdy_lnk( 'bdytra', tsa(:,:,:,jn), 'T', 1., ib_bdy ) 
    75             !  
    76          END DO 
    77       END DO 
     103      END DO   ! ir 
    78104      ! 
    79105   END SUBROUTINE bdy_tra 
    80106 
    81107 
    82    SUBROUTINE bdy_rnf( idx, pta, jpa ) 
     108   SUBROUTINE bdy_rnf( idx, pta, jpa, llrim0 ) 
    83109      !!---------------------------------------------------------------------- 
    84110      !!                 ***  SUBROUTINE bdy_rnf  *** 
    … …  
    89115      !!  
    90116      !!---------------------------------------------------------------------- 
    91       TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices 
    92       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend 
    93       INTEGER,                             INTENT(in) ::   jpa  ! TRA index 
     117      TYPE(OBC_INDEX),                     INTENT(in) ::   idx      ! OBC indices 
     118      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta      ! tracer trend 
     119      INTEGER,                             INTENT(in) ::   jpa      ! TRA index 
     120      LOGICAL,                             INTENT(in) ::   llrim0   ! indicate if rim 0 is treated 
    94121      ! 
    95       REAL(wp) ::   zwgt           ! boundary weight 
    96       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    97       INTEGER  ::   ii, ij, ip, jp ! 2D addresses 
     122      INTEGER  ::   ib, ii, ij, igrd   ! dummy loop indices 
     123      INTEGER  ::   ik, ip, jp ! 2D addresses 
    98124      !!---------------------------------------------------------------------- 
    99125      ! 
    100126      igrd = 1                       ! Everything is at T-points here 
    101       DO ib = 1, idx%nblenrim(igrd) 
    102          ii = idx%nbi(ib,igrd) 
    103          ij = idx%nbj(ib,igrd) 
    104          DO ik = 1, jpkm1 
    105             ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  ) 
    106             jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1) 
    107             if (jpa == jp_tem) pta(ii,ij,ik) = pta(ii+ip,ij+jp,ik) * tmask(ii,ij,ik) 
    108             if (jpa == jp_sal) pta(ii,ij,ik) =                 0.1 * tmask(ii,ij,ik) 
     127      IF(      jpa == jp_tem ) THEN 
     128         CALL bdy_nmn( idx, igrd, pta, llrim0 ) 
     129      ELSE IF( jpa == jp_sal ) THEN 
     130         IF( .NOT. llrim0 )   RETURN 
     131         DO ib = 1, idx%nblenrim(igrd)   ! if llrim0 then treat the whole rim 
     132            ii = idx%nbi(ib,igrd) 
     133            ij = idx%nbj(ib,igrd) 
     134            pta(ii,ij,1:jpkm1) = 0.1 * tmask(ii,ij,1:jpkm1) 
    109135         END DO 
    110       END DO 
     136      END IF 
    111137      ! 
    112138   END SUBROUTINE bdy_rnf 

  • NEMO/trunk/src/OCE/BDY/bdyvol.F90

    r10481 r11536  
    9999            ii = idx%nbi(jb,jgrd) 
    100100            ij = idx%nbj(jb,jgrd) 
     101            IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! sum : else halo couted twice 
    101102            zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * pua2d(ii,ij) * e2u(ii,ij) * phu(ii,ij) * tmask_i(ii,ij) * tmask_i(ii+1,ij) 
    102103         END DO 
    … …  
    105106            ii = idx%nbi(jb,jgrd) 
    106107            ij = idx%nbj(jb,jgrd) 
     108            IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! sum : else halo couted twice 
    107109            zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * pva2d(ii,ij) * e1v(ii,ij) * phv(ii,ij) * tmask_i(ii,ij) * tmask_i(ii,ij+1) 
    108110         END DO 
    … …  
    126128               ii = idx%nbi(jb,jgrd) 
    127129               ij = idx%nbj(jb,jgrd) 
     130               !IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove ? 
    128131               pua2d(ii,ij) = pua2d(ii,ij) - idx%flagu(jb,jgrd) * zubtpecor * tmask_i(ii,ij) * tmask_i(ii+1,ij) 
    129132         END DO 
    … …  
    132135               ii = idx%nbi(jb,jgrd) 
    133136               ij = idx%nbj(jb,jgrd) 
     137               !IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove ? 
    134138               pva2d(ii,ij) = pva2d(ii,ij) - idx%flagv(jb,jgrd) * zubtpecor * tmask_i(ii,ij) * tmask_i(ii,ij+1) 
    135139         END DO 
    … …  
    139143      ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected 
    140144      ! ------------------------------------------------------ 
    141       IF( MOD( kt, nwrite ) == 0 .AND. ( kc == 1 ) ) THEN 
     145      IF( MOD( kt, nn_write ) == 0 .AND. ( kc == 1 ) ) THEN 
    142146         ! 
    143147         ! compute residual transport across boundary 
    … …  
    150154                  ii = idx%nbi(jb,jgrd) 
    151155                  ij = idx%nbj(jb,jgrd) 
     156                  IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE 
    152157                  ztranst = ztranst + idx%flagu(jb,jgrd) * pua2d(ii,ij) * e2u(ii,ij) * phu(ii,ij) * tmask_i(ii,ij) * tmask_i(ii+1,ij) 
    153158            END DO 
    … …  
    156161                  ii = idx%nbi(jb,jgrd) 
    157162                  ij = idx%nbj(jb,jgrd) 
     163                  IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE 
    158164                  ztranst = ztranst + idx%flagv(jb,jgrd) * pva2d(ii,ij) * e1v(ii,ij) * phv(ii,ij) * tmask_i(ii,ij) * tmask_i(ii,ij+1) 
    159165            END DO 
    … …  
    195201            nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    196202            nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
     203            IF( nbi == 1 .OR. nbi == jpi .OR. nbj == 1 .OR. nbj == jpj )  CYCLE 
    197204            zflagu => idx_bdy(ib_bdy)%flagu(ib,igrd) 
    198205            bdy_segs_surf = bdy_segs_surf + phu(nbi, nbj)                              & 
    … …  
    207214            nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    208215            nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
     216            IF( nbi == 1 .OR. nbi == jpi .OR. nbj == 1 .OR. nbj == jpj )  CYCLE 
    209217            zflagv => idx_bdy(ib_bdy)%flagv(ib,igrd) 
    210218            bdy_segs_surf = bdy_segs_surf + phv(nbi, nbj)                              & 
Note: See TracChangeset for help on using the changeset viewer.