Changeset 2797


Ignore:
Timestamp:
2011-07-11T12:53:56+02:00 (9 years ago)
Author:
davestorkey
Message:

Delete BDY module and first implementation of new OBC module.

  1. Initial restructuring.
  2. Use fldread to read open boundary data.
Location:
branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC
Files:
4 added
6 deleted
26 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r2528 r2797  
    1818   USE lib_mpp         ! distributed memory computing library 
    1919   USE trabbc          ! bottom boundary condition 
    20    USE bdy_par         ! (for lk_bdy) 
    2120   USE obc_par         ! (for lk_obc) 
    2221 
     
    205204      WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 
    206205      WRITE(numout,*) "~~~~~~~  output written in the 'heat_salt_volume_budgets.txt' ASCII file" 
    207       IF( lk_obc .OR. lk_bdy) THEN 
     206      IF( lk_obc ) THEN 
    208207         CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )          
    209208      ENDIF 
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r2715 r2797  
    2525   USE oce             ! ocean dynamics and tracers 
    2626   USE dom_oce         ! ocean space and time domain 
    27    USE obc_oce         ! ocean open boundary conditions 
    2827   USE in_out_manager  ! I/O manager 
    2928   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r2715 r2797  
    2727   USE sbc_oce, ONLY : ln_rnf   ! surface boundary condition: ocean 
    2828   USE sbcrnf          ! river runoff  
    29    USE obc_oce         ! ocean lateral open boundary condition 
    3029   USE cla             ! cross land advection             (cla_div routine) 
    3130   USE in_out_manager  ! I/O manager 
     
    121120         END DO 
    122121 
    123 #if defined key_obc 
    124          IF( Agrif_Root() ) THEN 
    125             ! open boundaries (div must be zero behind the open boundary) 
    126             !  mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 
    127             IF( lp_obc_east  )   hdivn(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.e0      ! east 
    128             IF( lp_obc_west  )   hdivn(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.e0      ! west 
    129             IF( lp_obc_north )   hdivn(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.e0      ! north 
    130             IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south 
    131          ENDIF 
    132 #endif          
    133122         IF( .NOT. AGRIF_Root() ) THEN 
    134123            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east 
     
    304293         END DO   
    305294 
    306 #if defined key_obc 
    307          IF( Agrif_Root() ) THEN 
    308             ! open boundaries (div must be zero behind the open boundary) 
    309             !  mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 
    310             IF( lp_obc_east  )   hdivn(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.e0      ! east 
    311             IF( lp_obc_west  )   hdivn(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.e0      ! west 
    312             IF( lp_obc_north )   hdivn(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.e0      ! north 
    313             IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south 
    314          ENDIF 
    315 #endif          
    316295         IF( .NOT. AGRIF_Root() ) THEN 
    317296            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east 
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r2779 r2797  
    3030   USE domvvl          ! variable volume 
    3131   USE obc_oce         ! ocean open boundary conditions 
    32    USE obcdyn          ! open boundary condition for momentum (obc_dyn routine) 
    33    USE obcdyn_bt       ! 2D open boundary condition for momentum (obc_dyn_bt routine) 
     32   USE obcdyn3d        ! open boundary condition for baroclinic velocities 
     33   USE obcdyn2d        ! open boundary condition for barotropic variables 
    3434   USE obcvol          ! ocean open boundary condition (obc_vol routines) 
    35    USE bdy_oce         ! unstructured open boundary conditions 
    36    USE bdydta          ! unstructured open boundary conditions 
    37    USE bdydyn          ! unstructured open boundary conditions 
    3835   USE in_out_manager  ! I/O manager 
    3936   USE lbclnk          ! lateral boundary condition (or mpp link) 
     
    7774      !!              * Apply lateral boundary conditions on after velocity  
    7875      !!             at the local domain boundaries through lbc_lnk call, 
    79       !!             at the radiative open boundaries (lk_obc=T), 
    80       !!             at the relaxed   open boundaries (lk_bdy=T), and 
     76      !!             at the one-way open boundaries (lk_obc=T), 
    8177      !!             at the AGRIF zoom     boundaries (lk_agrif=T) 
    8278      !! 
     
    157153# if defined key_obc 
    158154      !                                !* OBC open boundaries 
    159       CALL obc_dyn( kt ) 
    160       ! 
    161155      IF( .NOT. lk_dynspg_flt ) THEN 
    162          ! Flather boundary condition : - Update sea surface height on each open boundary 
    163          !                                       sshn   (= after ssh   ) for explicit case (lk_dynspg_exp=T) 
    164          !                                       sshn_b (= after ssha_b) for time-splitting case (lk_dynspg_ts=T) 
    165          !                              - Correct the barotropic velocities 
    166          CALL obc_dyn_bt( kt ) 
     156 
     157         CALL obc_dyn3d( kt ) 
     158         ! 
     159    !!!! ENDA'S FIX: NEED TO THINK ABOUT THIS !!!! 
     160         CALL obc_dta( kt+1, jit=0 ) 
     161         CALL obc_dyn2d( kt, sshn_b ) 
    167162         ! 
    168163!!gm ERROR - potential BUG: sshn should not be modified at this stage !!   ssh_nxt not alrady called 
     
    174169      ENDIF 
    175170      ! 
    176 # elif defined key_bdy  
    177       !                                !* BDY open boundaries 
    178       IF( .NOT. lk_dynspg_flt ) THEN 
    179          CALL bdy_dyn_frs( kt ) 
    180 #  if ! defined key_vvl 
    181          ua_e(:,:) = 0.e0 
    182          va_e(:,:) = 0.e0 
    183          ! Set these variables for use in bdy_dyn_fla 
    184          hur_e(:,:) = hur(:,:) 
    185          hvr_e(:,:) = hvr(:,:) 
    186          DO jk = 1, jpkm1   !! Vertically integrated momentum trends 
    187             ua_e(:,:) = ua_e(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
    188             va_e(:,:) = va_e(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
    189          END DO 
    190          ua_e(:,:) = ua_e(:,:) * hur(:,:) 
    191          va_e(:,:) = va_e(:,:) * hvr(:,:) 
    192          DO jk = 1 , jpkm1 
    193             ua(:,:,jk) = ua(:,:,jk) - ua_e(:,:) 
    194             va(:,:,jk) = va(:,:,jk) - va_e(:,:) 
    195          END DO 
    196          CALL bdy_dta_fla( kt+1, 0,2*nn_baro) 
    197          CALL bdy_dyn_fla( sshn_b ) 
    198          CALL lbc_lnk( ua_e, 'U', -1. )   ! Boundary points should be updated 
    199          CALL lbc_lnk( va_e, 'V', -1. )   ! 
    200          DO jk = 1 , jpkm1 
    201             ua(:,:,jk) = ( ua(:,:,jk) + ua_e(:,:) ) * umask(:,:,jk) 
    202             va(:,:,jk) = ( va(:,:,jk) + va_e(:,:) ) * vmask(:,:,jk) 
    203          END DO 
    204 #  endif 
    205       ENDIF 
    206171# endif 
    207172      ! 
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r2715 r2797  
    1515   USE dom_oce        ! ocean space and time domain variables 
    1616   USE phycst         ! physical constants 
    17    USE obc_oce        ! ocean open boundary conditions 
    1817   USE sbc_oce        ! surface boundary condition: ocean 
    1918   USE sbcapr         ! surface boundary condition: atmospheric pressure 
     
    222221      ENDIF 
    223222 
    224 #if defined key_obc 
    225       !                        ! Conservation of ocean volume (key_dynspg_flt) 
    226       IF( lk_dynspg_flt )   ln_vol_cst = .true. 
    227  
    228       !                        ! Application of Flather's algorithm at open boundaries 
    229       IF( lk_dynspg_flt )   ln_obc_fla = .false. 
    230       IF( lk_dynspg_exp )   ln_obc_fla = .true. 
    231       IF( lk_dynspg_ts  )   ln_obc_fla = .true. 
    232 #endif 
    233223      ! 
    234224   END SUBROUTINE dyn_spg_init 
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

    r2715 r2797  
    2020   USE obc_oce         ! Lateral open boundary condition 
    2121   USE phycst          ! physical constants 
    22    USE obc_par         ! open boundary condition parameters 
    2322   USE obcdta          ! open boundary condition data     (obc_dta_bt routine) 
    2423   USE in_out_manager  ! I/O manager 
     
    7877 
    7978!!gm bug ??  Rachid we have to discuss of the call below. I don't understand why it is here and not in ssh_wzv 
    80       IF( lk_obc )   CALL obc_dta_bt( kt, 0 )      ! OBC: read or estimate ssh and vertically integrated velocities 
     79      IF( lk_obc )   CALL obc_dta( kt, jit=0 )      ! OBC: read or estimate ssh and vertically integrated velocities 
    8180!!gm 
    8281 
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r2715 r2797  
    3333   USE solpcg          ! preconditionned conjugate gradient solver 
    3434   USE solsor          ! Successive Over-relaxation solver 
    35    USE obcdyn          ! ocean open boundary condition (obc_dyn routines) 
     35   USE obcdyn3d        ! ocean open boundary condition (obc_dyn3d routines) 
    3636   USE obcvol          ! ocean open boundary condition (obc_vol routines) 
    37    USE bdy_oce         ! Unstructured open boundaries condition 
    38    USE bdydyn          ! Unstructured open boundaries condition (bdy_dyn routine)  
    39    USE bdyvol          ! Unstructured open boundaries condition (bdy_vol routine) 
    4037   USE cla             ! cross land advection 
    4138   USE in_out_manager  ! I/O manager 
     
    183180 
    184181#if defined key_obc 
    185       CALL obc_dyn( kt )      ! Update velocities on each open boundary with the radiation algorithm 
     182      CALL obc_dyn3d( kt )    ! Update velocities on each open boundary 
    186183      CALL obc_vol( kt )      ! Correction of the barotropic componant velocity to control the volume of the system 
    187 #endif 
    188 #if defined key_bdy 
    189       CALL bdy_dyn_frs( kt )       ! Update velocities on unstructured boundary using the Flow Relaxation Scheme 
    190       CALL bdy_vol( kt )           ! Correction of the barotropic component velocity to control the volume of the system 
    191184#endif 
    192185#if defined key_agrif 
     
    304297#if defined key_obc 
    305298            ! caution : grad D = 0 along open boundaries 
     299            ! Remark: The filtering force could be reduced here in the FRS zone 
     300            !         by multiplying spgu/spgv by (1-alpha) ??   
    306301            spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj) 
    307302            spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj) 
    308 #elif defined key_bdy 
    309             ! caution : grad D = 0 along open boundaries 
    310             ! Remark: The filtering force could be reduced here in the FRS zone 
    311             !         by multiplying spgu/spgv by (1-alpha) ??   
    312             spgu(ji,jj) = z2dt * ztdgu * bdyumask(ji,jj) 
    313             spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj)            
    314303#else 
    315304            spgu(ji,jj) = z2dt * ztdgu 
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r2724 r2797  
    2525   USE domvvl          ! variable volume 
    2626   USE zdfbfr          ! bottom friction 
    27    USE obcdta          ! open boundary condition data      
    28    USE obcfla          ! Flather open boundary condition   
    2927   USE dynvor          ! vorticity term 
    3028   USE obc_oce         ! Lateral open boundary condition 
    31    USE obc_par         ! open boundary condition parameters 
    32    USE bdy_oce         ! unstructured open boundaries 
    33    USE bdy_par         ! unstructured open boundaries 
    34    USE bdydta          ! unstructured open boundaries 
    35    USE bdydyn          ! unstructured open boundaries 
    36    USE bdytides        ! tidal forcing at unstructured open boundaries. 
     29   USE obcdta          ! open boundary condition data      
     30   USE obcdyn2d        ! open boundary conditions on barotropic variables 
    3731   USE lib_mpp         ! distributed memory computing library 
    3832   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     
    352346      zssh_sum(:,:) = sshn (:,:) 
    353347 
    354 #if defined key_obc 
    355       ! set ssh corrections to 0 
    356       ! ssh corrections are applied to normal velocities (Flather's algorithm) and averaged over the barotropic loop 
    357       IF( lp_obc_east  )   sshfoe_b(:,:) = 0.e0 
    358       IF( lp_obc_west  )   sshfow_b(:,:) = 0.e0 
    359       IF( lp_obc_south )   sshfos_b(:,:) = 0.e0 
    360       IF( lp_obc_north )   sshfon_b(:,:) = 0.e0 
    361 #endif 
    362  
    363348      !                                             ! ==================== ! 
    364349      DO jn = 1, icycle                             !  sub-time-step loop  ! (from NOW to AFTER+1) 
     
    367352         IF( jn == 1 )   z2dt_e = rdt / nn_baro 
    368353 
    369          !                                                !* Update the forcing (OBC, BDY and tides) 
     354         !                                                !* Update the forcing (OBC and tides) 
    370355         !                                                !  ------------------ 
    371          IF( lk_obc )   CALL obc_dta_bt ( kt, jn   ) 
    372          IF( lk_bdy )   CALL bdy_dta_fla( kt, jn+1, icycle ) 
     356         IF( lk_obc )   CALL obc_dta ( kt, jit=jn   ) 
    373357 
    374358         !                                                !* after ssh_e 
     
    384368         ! 
    385369#if defined key_obc 
    386          !                                                     ! OBC : zhdiv must be zero behind the open boundary 
    387 !!  mpp remark: The zeroing of hdiv can probably be extended to 1->jpi/jpj for the correct row/column 
    388          IF( lp_obc_east  )   zhdiv(nie0p1:nie1p1,nje0  :nje1  ) = 0.e0      ! east 
    389          IF( lp_obc_west  )   zhdiv(niw0  :niw1  ,njw0  :njw1  ) = 0.e0      ! west 
    390          IF( lp_obc_north )   zhdiv(nin0  :nin1  ,njn0p1:njn1p1) = 0.e0      ! north 
    391          IF( lp_obc_south )   zhdiv(nis0  :nis1  ,njs0  :njs1  ) = 0.e0      ! south 
    392 #endif 
    393 #if defined key_bdy 
    394          zhdiv(:,:) = zhdiv(:,:) * bdytmask(:,:)               ! BDY mask 
     370         zhdiv(:,:) = zhdiv(:,:) * obctmask(:,:)               ! OBC mask 
    395371#endif 
    396372         ! 
     
    489465         !                                                !* domain lateral boundary 
    490466         !                                                !  ----------------------- 
    491          !                                                      ! Flather's boundary condition for the barotropic loop : 
    492          !                                                      !         - Update sea surface height on each open boundary 
    493          !                                                      !         - Correct the velocity 
    494  
    495          IF( lk_obc               )   CALL obc_fla_ts ( ua_e, va_e, sshn_e, ssha_e ) 
    496          IF( lk_bdy .OR. ln_tides )   CALL bdy_dyn_fla( sshn_e )  
     467                                                               ! OBC open boundaries 
     468         IF( lk_obc .OR. ln_tides )   CALL obc_dyn2d( kt, sshn_e )  
    497469         ! 
    498470         CALL lbc_lnk( ua_e  , 'U', -1. )                      ! local domain boundaries  
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r2715 r2797  
    2626   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    2727   USE lib_mpp         ! MPP library 
    28    USE obc_par         ! open boundary cond. parameter 
    2928   USE obc_oce 
    30    USE bdy_oce 
    3129   USE diaar5, ONLY:   lk_diaar5 
    3230   USE iom 
     
    175173#endif 
    176174#if defined key_obc 
    177       IF( Agrif_Root() ) THEN  
    178          ssha(:,:) = ssha(:,:) * obctmsk(:,:) 
    179          CALL lbc_lnk( ssha, 'T', 1. )                 ! absolutly compulsory !! (jmm) 
    180       ENDIF 
    181 #endif 
    182 #if defined key_bdy 
    183       ssha(:,:) = ssha(:,:) * bdytmask(:,:) 
    184       CALL lbc_lnk( ssha, 'T', 1. )  
     175      ssha(:,:) = ssha(:,:) * obctmask(:,:) 
     176      CALL lbc_lnk( ssha, 'T', 1. )                 ! absolutly compulsory !! (jmm) 
    185177#endif 
    186178 
     
    217209            &                      - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    & 
    218210            &                         * tmask(:,:,jk) * z1_2dt 
    219 #if defined key_bdy 
    220          wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:) 
     211#if defined key_obc 
     212         wn(:,:,jk) = wn(:,:,jk) * obctmask(:,:) 
    221213#endif 
    222214      END DO 
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r2731 r2797  
    4747   !!   mppsync       : 
    4848   !!   mppstop       : 
    49    !!   mppobc        : variant of mpp_lnk for open boundary condition 
    5049   !!   mpp_ini_north : initialisation of north fold 
    5150   !!   mpp_lbc_north : north fold processors gathering 
     
    6463   PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 
    6564   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 
    66    PUBLIC   mppobc, mpp_ini_ice, mpp_ini_znl 
     65   PUBLIC   mpp_ini_ice, mpp_ini_znl 
    6766   PUBLIC   mppsize 
    6867   PUBLIC   lib_mpp_alloc   ! Called in nemogcm.F90 
     
    17261725   END SUBROUTINE mppstop 
    17271726 
    1728  
    1729    SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij , kumout) 
    1730       !!---------------------------------------------------------------------- 
    1731       !!                  ***  routine mppobc  *** 
    1732       !!  
    1733       !! ** Purpose :   Message passing manadgement for open boundary 
    1734       !!     conditions array 
    1735       !! 
    1736       !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    1737       !!       between processors following neighboring subdomains. 
    1738       !!       domain parameters 
    1739       !!                    nlci   : first dimension of the local subdomain 
    1740       !!                    nlcj   : second dimension of the local subdomain 
    1741       !!                    nbondi : mark for "east-west local boundary" 
    1742       !!                    nbondj : mark for "north-south local boundary" 
    1743       !!                    noea   : number for local neighboring processors  
    1744       !!                    nowe   : number for local neighboring processors 
    1745       !!                    noso   : number for local neighboring processors 
    1746       !!                    nono   : number for local neighboring processors 
    1747       !! 
    1748       !!---------------------------------------------------------------------- 
    1749       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    1750       USE wrk_nemo, ONLY:   ztab => wrk_2d_1 
    1751       ! 
    1752       INTEGER , INTENT(in   )                     ::   kd1, kd2   ! starting and ending indices 
    1753       INTEGER , INTENT(in   )                     ::   kl         ! index of open boundary 
    1754       INTEGER , INTENT(in   )                     ::   kk         ! vertical dimension 
    1755       INTEGER , INTENT(in   )                     ::   ktype      ! define north/south or east/west cdt 
    1756       !                                                           !  = 1  north/south  ;  = 2  east/west 
    1757       INTEGER , INTENT(in   )                     ::   kij        ! horizontal dimension 
    1758       INTEGER , INTENT(in   )                     ::   kumout     ! ocean.output logical unit 
    1759       REAL(wp), INTENT(inout), DIMENSION(kij,kk)  ::   ptab       ! variable array 
    1760       ! 
    1761       INTEGER ::   ji, jj, jk, jl        ! dummy loop indices 
    1762       INTEGER ::   iipt0, iipt1, ilpt1   ! local integers 
    1763       INTEGER ::   ijpt0, ijpt1          !   -       - 
    1764       INTEGER ::   imigr, iihom, ijhom   !   -       - 
    1765       INTEGER ::   ml_req1, ml_req2, ml_err    ! for key_mpi_isend 
    1766       INTEGER ::   ml_stat(MPI_STATUS_SIZE)    ! for key_mpi_isend 
    1767       !!---------------------------------------------------------------------- 
    1768  
    1769       IF( wrk_in_use(2, 1) ) THEN 
    1770          WRITE(kumout, cform_err) 
    1771          WRITE(kumout,*) 'mppobc : requested workspace array unavailable' 
    1772          CALL mppstop 
    1773       ENDIF 
    1774  
    1775       ! boundary condition initialization 
    1776       ! --------------------------------- 
    1777       ztab(:,:) = 0.e0 
    1778       ! 
    1779       IF( ktype==1 ) THEN                                  ! north/south boundaries 
    1780          iipt0 = MAX( 1, MIN(kd1 - nimpp+1, nlci     ) ) 
    1781          iipt1 = MAX( 0, MIN(kd2 - nimpp+1, nlci - 1 ) ) 
    1782          ilpt1 = MAX( 1, MIN(kd2 - nimpp+1, nlci     ) ) 
    1783          ijpt0 = MAX( 1, MIN(kl  - njmpp+1, nlcj     ) ) 
    1784          ijpt1 = MAX( 0, MIN(kl  - njmpp+1, nlcj - 1 ) ) 
    1785       ELSEIF( ktype==2 ) THEN                              ! east/west boundaries 
    1786          iipt0 = MAX( 1, MIN(kl  - nimpp+1, nlci     ) ) 
    1787          iipt1 = MAX( 0, MIN(kl  - nimpp+1, nlci - 1 ) ) 
    1788          ijpt0 = MAX( 1, MIN(kd1 - njmpp+1, nlcj     ) ) 
    1789          ijpt1 = MAX( 0, MIN(kd2 - njmpp+1, nlcj - 1 ) ) 
    1790          ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj     ) ) 
    1791       ELSE 
    1792          WRITE(kumout, cform_err) 
    1793          WRITE(kumout,*) 'mppobc : bad ktype' 
    1794          CALL mppstop 
    1795       ENDIF 
    1796        
    1797       ! Communication level by level 
    1798       ! ---------------------------- 
    1799 !!gm Remark : this is very time consumming!!! 
    1800       !                                         ! ------------------------ ! 
    1801       DO jk = 1, kk                             !   Loop over the levels   ! 
    1802          !                                      ! ------------------------ ! 
    1803          ! 
    1804          IF( ktype == 1 ) THEN                               ! north/south boundaries 
    1805             DO jj = ijpt0, ijpt1 
    1806                DO ji = iipt0, iipt1 
    1807                   ztab(ji,jj) = ptab(ji,jk) 
    1808                END DO 
    1809             END DO 
    1810          ELSEIF( ktype == 2 ) THEN                           ! east/west boundaries 
    1811             DO jj = ijpt0, ijpt1 
    1812                DO ji = iipt0, iipt1 
    1813                   ztab(ji,jj) = ptab(jj,jk) 
    1814                END DO 
    1815             END DO 
    1816          ENDIF 
    1817  
    1818  
    1819          ! 1. East and west directions 
    1820          ! --------------------------- 
    1821          ! 
    1822          IF( nbondi /= 2 ) THEN         ! Read Dirichlet lateral conditions 
    1823             iihom = nlci-nreci 
    1824             DO jl = 1, jpreci 
    1825                t2ew(:,jl,1) = ztab(jpreci+jl,:) 
    1826                t2we(:,jl,1) = ztab(iihom +jl,:) 
    1827             END DO 
    1828          ENDIF 
    1829          ! 
    1830          !                              ! Migrations 
    1831          imigr=jpreci*jpj 
    1832          ! 
    1833          IF( nbondi == -1 ) THEN 
    1834             CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 ) 
    1835             CALL mpprecv( 1, t2ew(1,1,2), imigr ) 
    1836             IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    1837          ELSEIF( nbondi == 0 ) THEN 
    1838             CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 
    1839             CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 ) 
    1840             CALL mpprecv( 1, t2ew(1,1,2), imigr ) 
    1841             CALL mpprecv( 2, t2we(1,1,2), imigr ) 
    1842             IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    1843             IF(l_isend)   CALL mpi_wait( ml_req2, ml_stat, ml_err ) 
    1844          ELSEIF( nbondi == 1 ) THEN 
    1845             CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 
    1846             CALL mpprecv( 2, t2we(1,1,2), imigr ) 
    1847             IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    1848          ENDIF 
    1849          ! 
    1850          !                              ! Write Dirichlet lateral conditions 
    1851          iihom = nlci-jpreci 
    1852          ! 
    1853          IF( nbondi == 0 .OR. nbondi == 1 ) THEN 
    1854             DO jl = 1, jpreci 
    1855                ztab(jl,:) = t2we(:,jl,2) 
    1856             END DO 
    1857          ENDIF 
    1858          IF( nbondi == -1 .OR. nbondi == 0 ) THEN 
    1859             DO jl = 1, jpreci 
    1860                ztab(iihom+jl,:) = t2ew(:,jl,2) 
    1861             END DO 
    1862          ENDIF 
    1863  
    1864  
    1865          ! 2. North and south directions 
    1866          ! ----------------------------- 
    1867          ! 
    1868          IF( nbondj /= 2 ) THEN         ! Read Dirichlet lateral conditions 
    1869             ijhom = nlcj-nrecj 
    1870             DO jl = 1, jprecj 
    1871                t2sn(:,jl,1) = ztab(:,ijhom +jl) 
    1872                t2ns(:,jl,1) = ztab(:,jprecj+jl) 
    1873             END DO 
    1874          ENDIF 
    1875          ! 
    1876          !                              ! Migrations 
    1877          imigr = jprecj * jpi 
    1878          ! 
    1879          IF( nbondj == -1 ) THEN 
    1880             CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 ) 
    1881             CALL mpprecv( 3, t2ns(1,1,2), imigr ) 
    1882             IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    1883          ELSEIF( nbondj == 0 ) THEN 
    1884             CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 
    1885             CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 ) 
    1886             CALL mpprecv( 3, t2ns(1,1,2), imigr ) 
    1887             CALL mpprecv( 4, t2sn(1,1,2), imigr ) 
    1888             IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    1889             IF( l_isend )   CALL mpi_wait( ml_req2, ml_stat, ml_err ) 
    1890          ELSEIF( nbondj == 1 ) THEN 
    1891             CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 
    1892             CALL mpprecv( 4, t2sn(1,1,2), imigr) 
    1893             IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    1894          ENDIF 
    1895          ! 
    1896          !                              ! Write Dirichlet lateral conditions 
    1897          ijhom = nlcj - jprecj 
    1898          IF( nbondj == 0 .OR. nbondj == 1 ) THEN 
    1899             DO jl = 1, jprecj 
    1900                ztab(:,jl) = t2sn(:,jl,2) 
    1901             END DO 
    1902          ENDIF 
    1903          IF( nbondj == 0 .OR. nbondj == -1 ) THEN 
    1904             DO jl = 1, jprecj 
    1905                ztab(:,ijhom+jl) = t2ns(:,jl,2) 
    1906             END DO 
    1907          ENDIF 
    1908          IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN 
    1909             DO jj = ijpt0, ijpt1            ! north/south boundaries 
    1910                DO ji = iipt0,ilpt1 
    1911                   ptab(ji,jk) = ztab(ji,jj)   
    1912                END DO 
    1913             END DO 
    1914          ELSEIF( ktype==2 .AND. kd1 <= jpj+njmpp-1 .AND. njmpp <= kd2 ) THEN 
    1915             DO jj = ijpt0, ilpt1            ! east/west boundaries 
    1916                DO ji = iipt0,iipt1 
    1917                   ptab(jj,jk) = ztab(ji,jj)  
    1918                END DO 
    1919             END DO 
    1920          ENDIF 
    1921          ! 
    1922       END DO 
    1923       ! 
    1924       IF( wrk_not_released(2, 1) ) THEN 
    1925          WRITE(kumout, cform_err) 
    1926          WRITE(kumout,*) 'mppobc : failed to release workspace array' 
    1927          CALL mppstop 
    1928       ENDIF 
    1929       ! 
    1930    END SUBROUTINE mppobc 
    1931     
    1932  
    19331727   SUBROUTINE mpp_comm_free( kcom ) 
    19341728      !!---------------------------------------------------------------------- 
     
    24882282      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real 
    24892283   END INTERFACE 
    2490    INTERFACE mppobc 
    2491       MODULE PROCEDURE mppobc_1d, mppobc_2d, mppobc_3d, mppobc_4d 
    2492    END INTERFACE 
    24932284   INTERFACE mpp_minloc 
    24942285      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d 
     
    26032394      WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom 
    26042395   END SUBROUTINE mppmin_int 
    2605  
    2606    SUBROUTINE mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 
    2607       INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum 
    2608       REAL, DIMENSION(:) ::   parr           ! variable array 
    2609       WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1), kd1, kd2, kl, kk, ktype, kij, knum 
    2610    END SUBROUTINE mppobc_1d 
    2611  
    2612    SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 
    2613       INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum 
    2614       REAL, DIMENSION(:,:) ::   parr           ! variable array 
    2615       WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1), kd1, kd2, kl, kk, ktype, kij, knum 
    2616    END SUBROUTINE mppobc_2d 
    2617  
    2618    SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 
    2619       INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum 
    2620       REAL, DIMENSION(:,:,:) ::   parr           ! variable array 
    2621       WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1), kd1, kd2, kl, kk, ktype, kij, knum 
    2622    END SUBROUTINE mppobc_3d 
    2623  
    2624    SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 
    2625       INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum 
    2626       REAL, DIMENSION(:,:,:,:) ::   parr           ! variable array 
    2627       WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1,1), kd1, kd2, kl, kk, ktype, kij, knum 
    2628    END SUBROUTINE mppobc_4d 
    26292396 
    26302397   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki, kj ) 
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce.F90

    r2715 r2797  
    11MODULE obc_oce 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE obc_oce   *** 
    4    !! Open Boundary Cond. :   define related variables 
    5    !!============================================================================== 
    6    !! history :  OPA  ! 1991-01 (CLIPPER)  Original code  
    7    !!   NEMO     1.0  ! 2002-02 (C. Talandier)  modules, F90 
     4   !! Unstructured Open Boundary Cond. :   define related variables 
     5   !!====================================================================== 
     6   !! History :  1.0  !  2001-05  (J. Chanut, A. Sellar)  Original code 
     7   !!            3.0  !  2008-04  (NEMO team)  add in the reference version      
     8   !!            3.3  !  2010-09  (D. Storkey) add ice boundary conditions 
     9   !!            3.4  !  2011     (D. Storkey, J. Chanut) OBC-BDY merge 
    810   !!---------------------------------------------------------------------- 
    9 #if defined key_obc 
     11#if defined key_obc  
    1012   !!---------------------------------------------------------------------- 
    11    !!   'key_obc' :                                Open Boundary Condition 
     13   !!   'key_obc'                      Unstructured Open Boundary Condition 
    1214   !!---------------------------------------------------------------------- 
    1315   USE par_oce         ! ocean parameters 
    14    USE obc_par         ! open boundary condition parameters 
     16   USE obc_par         ! Unstructured boundary parameters 
     17   USE lib_mpp         ! distributed memory computing 
    1518 
    1619   IMPLICIT NONE 
    1720   PUBLIC 
    18     
    19    PUBLIC   obc_oce_alloc   ! called by obcini.F90 module 
     21 
     22   TYPE, PUBLIC ::   OBC_INDEX    !: Indices and weights which define the open boundary 
     23      INTEGER,          DIMENSION(jpbgrd) ::  nblen 
     24      INTEGER,          DIMENSION(jpbgrd) ::  nblenrim 
     25      INTEGER, POINTER, DIMENSION(:,:)   ::  nbi 
     26      INTEGER, POINTER, DIMENSION(:,:)   ::  nbj 
     27      INTEGER, POINTER, DIMENSION(:,:)   ::  nbr 
     28      INTEGER, POINTER, DIMENSION(:,:)   ::  nbmap 
     29      REAL   , POINTER, DIMENSION(:,:)   ::  nbw 
     30      REAL   , POINTER, DIMENSION(:)     ::  flagu 
     31      REAL   , POINTER, DIMENSION(:)     ::  flagv 
     32   END TYPE OBC_INDEX 
     33 
     34   TYPE, PUBLIC ::   OBC_DATA     !: Storage for external data 
     35      REAL, POINTER, DIMENSION(:)     ::  ssh 
     36      REAL, POINTER, DIMENSION(:)     ::  u2d 
     37      REAL, POINTER, DIMENSION(:)     ::  v2d 
     38      REAL, POINTER, DIMENSION(:,:)   ::  u3d 
     39      REAL, POINTER, DIMENSION(:,:)   ::  v3d 
     40      REAL, POINTER, DIMENSION(:,:)   ::  tem 
     41      REAL, POINTER, DIMENSION(:,:)   ::  sal 
     42#if defined key_lim2 
     43      REAL, POINTER, DIMENSION(:)     ::  frld 
     44      REAL, POINTER, DIMENSION(:)     ::  hicif 
     45      REAL, POINTER, DIMENSION(:)     ::  hsnif 
     46#endif 
     47   END TYPE OBC_DATA 
    2048 
    2149   !!---------------------------------------------------------------------- 
    22    !! open boundary variables 
     50   !! Namelist variables 
    2351   !!---------------------------------------------------------------------- 
     52   CHARACTER(len=80), DIMENSION(jp_obc) ::   cn_coords_file !: Name of obc coordinates file 
     53   CHARACTER(len=80)                    ::   cn_mask_file   !: Name of obc mask file 
    2454   ! 
    25    !                                            !!* Namelist namobc: open boundary condition * 
    26    INTEGER           ::   nn_obcdta   = 0        !:  = 0 use the initial state as obc data 
    27    !                                             !   = 1 read obc data in obcxxx.dta files 
    28    CHARACTER(len=20) ::   cn_obcdta   = 'annual' !: set to annual  if obc datafile hold 1 year of data 
    29    !                                             !  set to monthly if obc datafile hold 1 month of data 
    30    LOGICAL           ::   ln_obc_clim = .true.   !:  obc data files are climatological 
    31    LOGICAL           ::   ln_obc_fla  = .false.  !:  Flather open boundary condition not used 
    32    LOGICAL           ::   ln_vol_cst  = .true.   !:  Conservation of the whole volume 
    33    REAL(wp)          ::   rn_dpein    =  1.      !: damping time scale for inflow at East open boundary 
    34    REAL(wp)          ::   rn_dpwin    =  1.      !:    "                      "   at West open boundary 
    35    REAL(wp)          ::   rn_dpsin    =  1.      !:    "                      "   at South open boundary 
    36    REAL(wp)          ::   rn_dpnin    =  1.      !:    "                      "   at North open boundary 
    37    REAL(wp)          ::   rn_dpeob    = 15.      !: damping time scale for the climatology at East open boundary 
    38    REAL(wp)          ::   rn_dpwob    = 15.      !:    "                           "       at West open boundary 
    39    REAL(wp)          ::   rn_dpsob    = 15.      !:    "                           "       at South open boundary 
    40    REAL(wp)          ::   rn_dpnob    = 15.      !:    "                           "       at North open boundary 
    41    REAL(wp)          ::   rn_volemp   =  1.      !: = 0 the total volume will have the variability of the  
    42    !                                             !      surface Flux E-P else (volemp = 1) the volume will be constant 
    43    !                                             !  = 1 the volume will be constant during all the integration. 
     55   LOGICAL, DIMENSION(jp_obc) ::   ln_coords_file           !: =T read obc coordinates from file;  
     56   !                                                        !: =F read obc coordinates from namelist 
     57   LOGICAL                    ::   ln_mask_file             !: =T read obcmask from file 
     58   LOGICAL, DIMENSION(jp_obc) ::   ln_tides                 !: =T apply tidal harmonic forcing along open boundaries 
     59   LOGICAL                    ::   ln_vol                   !: =T volume correction              
     60   LOGICAL, DIMENSION(jp_obc) ::   ln_clim                  !: =T obc data files contain climatological data (time-cyclic) 
     61   ! 
     62   INTEGER                    ::   nb_obc                   !: number of open boundary sets 
     63   INTEGER, DIMENSION(jp_obc) ::   nn_rimwidth              !: boundary rim width 
     64   INTEGER, DIMENSION(jp_obc) ::   nn_dtactl           !: = 0 use the initial state as obc dta ;  
     65                                                            !: = 1 read it in a NetCDF file 
     66   INTEGER                    ::   nn_volctl                !: = 0 the total volume will have the variability of the surface Flux E-P  
     67   !                                                        !  = 1 the volume will be constant during all the integration. 
     68   INTEGER, DIMENSION(jp_obc) ::   nn_dyn2d                 ! Choice of boundary condition for barotropic variables (U,V,SSH) 
     69   INTEGER, DIMENSION(jp_obc) ::   nn_dyn3d                 ! Choice of boundary condition for baroclinic velocities  
     70   INTEGER, DIMENSION(jp_obc) ::   nn_tra                   ! Choice of boundary condition for active tracers (T and S) 
     71#if defined key_lim2 
     72   INTEGER, DIMENSION(jp_obc) ::   nn_ice_lim2              ! Choice of boundary condition for sea ice variables  
     73#endif 
     74   ! 
     75   INTEGER, DIMENSION(jp_obc) ::   nn_dmp2d_in              ! Damping timescale (days) for 2D solution for inward radiation or FRS  
     76   INTEGER, DIMENSION(jp_obc) ::   nn_dmp2d_out             ! Damping timescale (days) for 2D solution for outward radiation  
     77   INTEGER, DIMENSION(jp_obc) ::   nn_dmp3d_in              ! Damping timescale (days) for 3D solution for inward radiation or FRS  
     78   INTEGER, DIMENSION(jp_obc) ::   nn_dmp3d_out             ! Damping timescale (days) for 3D solution for outward radiation 
    4479 
    45    !                                  !!! OLD non-DOCTOR name of namelist variables 
    46    INTEGER  ::   nbobc                 !: number of open boundaries ( 1=< nbobc =< 4 )  
    47    INTEGER  ::   nobc_dta              !:  = 0 use the initial state as obc data 
    48    REAL(wp) ::   rdpein                !: damping time scale for inflow at East open boundary 
    49    REAL(wp) ::   rdpwin                !:    "                      "   at West open boundary 
    50    REAL(wp) ::   rdpsin                !:    "                      "   at South open boundary 
    51    REAL(wp) ::   rdpnin                !:    "                      "   at North open boundary 
    52    REAL(wp) ::   rdpeob                !: damping time scale for the climatology at East open boundary 
    53    REAL(wp) ::   rdpwob                !:    "                           "       at West open boundary 
    54    REAL(wp) ::   rdpsob                !:    "                           "       at South open boundary 
    55    REAL(wp) ::   rdpnob                !:    "                           "       at North open boundary 
    56    REAL(wp) ::   volemp                !: = 0 the total volume will have the variability of the  
    57    CHARACTER(len=20) :: cffile 
     80    
     81   !!---------------------------------------------------------------------- 
     82   !! Global variables 
     83   !!---------------------------------------------------------------------- 
     84   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   obctmask   !: Mask defining computational domain at T-points 
     85   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   obcumask   !: Mask defining computational domain at U-points 
     86   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   obcvmask   !: Mask defining computational domain at V-points 
    5887 
    59  
    60    !!General variables for open boundaries: 
    61    !!-------------------------------------- 
    62    LOGICAL ::   lfbceast, lfbcwest      !: logical flag for a fixed East and West open boundaries        
    63    LOGICAL ::   lfbcnorth, lfbcsouth    !: logical flag for a fixed North and South open boundaries        
    64    !                                    !  These logical flags are set to 'true' if damping time  
    65    !                                    !  scale are set to 0 in the namelist, for both inflow and outflow). 
    66  
    67    REAL(wp), PUBLIC ::   obcsurftot       !: Total lateral surface of open boundaries 
    68     
    69    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: &  !: 
    70       obctmsk,            &  !: mask array identical to tmask, execpt along OBC where it is set to 0 
    71       !                      !  it used to calculate the cumulate flux E-P in the obcvol.F90 routine 
    72       obcumask, obcvmask     !: u-, v- Force filtering mask for the open 
    73       !                      !  boundary condition on grad D 
    74  
    75    !!-------------------- 
    76    !! East open boundary: 
    77    !!-------------------- 
    78    INTEGER ::   nie0  , nie1      !: do loop index in mpp case for jpieob 
    79    INTEGER ::   nie0p1, nie1p1    !: do loop index in mpp case for jpieob+1 
    80    INTEGER ::   nie0m1, nie1m1    !: do loop index in mpp case for jpieob-1 
    81    INTEGER ::   nje0  , nje1      !: do loop index in mpp case for jpjed, jpjef 
    82    INTEGER ::   nje0p1, nje1m1    !: do loop index in mpp case for jpjedp1,jpjefm1 
    83    INTEGER ::   nje1m2, nje0m1    !: do loop index in mpp case for jpjefm1-1,jpjed 
    84  
    85    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !: 
    86       sshfoe,           & !: now climatology of the east boundary sea surface height 
    87       ubtfoe,vbtfoe       !: now climatology of the east boundary barotropic transport 
    88       
    89    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !: 
    90       ufoe, vfoe,       & !: now climatology of the east boundary velocities  
    91       tfoe, sfoe,       & !: now climatology of the east boundary temperature and salinity 
    92       uclie               !: baroclinic componant of the zonal velocity after radiation  
    93       !                   ! in the obcdyn.F90 routine 
    94  
    95    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshfoe_b   !: east boundary ssh correction averaged over the barotropic loop 
    96       !                                            !  (if Flather's algoritm applied at open boundary) 
    97  
    98    !!------------------------------- 
    99    !! Arrays for radiative East OBC:  
    100    !!------------------------------- 
    101    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   uebnd, vebnd      !: baroclinic u & v component of the velocity over 3 rows  
    102       !                                                    !  and 3 time step (now, before, and before before) 
    103    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tebnd, sebnd      !: East boundary temperature and salinity over 2 rows  
    104       !                                                    !  and 2 time step (now and before) 
    105    REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   u_cxebnd, v_cxebnd    !: Zonal component of the phase speed ratio computed with  
    106       !                                                    !  radiation of u and v velocity (respectively) at the  
    107       !                                                    !  east open boundary (u_cxebnd = cx rdt ) 
    108    REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   uemsk, vemsk, temsk   !: 2D mask for the East OB 
    109  
    110    ! Note that those arrays are optimized for mpp case  
    111    ! (hence the dimension jpj is the size of one processor subdomain) 
    112  
    113    !!-------------------- 
    114    !! West open boundary 
    115    !!-------------------- 
    116    INTEGER ::   niw0  , niw1       !: do loop index in mpp case for jpiwob 
    117    INTEGER ::   niw0p1, niw1p1     !: do loop index in mpp case for jpiwob+1 
    118    INTEGER ::   njw0  , njw1       !: do loop index in mpp case for jpjwd, jpjwf 
    119    INTEGER ::   njw0p1, njw1m1     !: do loop index in mpp case for jpjwdp1,jpjwfm1 
    120    INTEGER ::   njw1m2, njw0m1     !: do loop index in mpp case for jpjwfm2,jpjwd 
    121  
    122    REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:) ::   &  !: 
    123       sshfow,           & !: now climatology of the west boundary sea surface height 
    124       ubtfow,vbtfow       !: now climatology of the west boundary barotropic transport 
    125  
    126    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !: 
    127       ufow, vfow,       & !: now climatology of the west velocities  
    128       tfow, sfow,       & !: now climatology of the west temperature and salinity 
    129       ucliw               !: baroclinic componant of the zonal velocity after the radiation  
    130       !                   !  in the obcdyn.F90 routine 
    131  
    132    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshfow_b    !: west boundary ssh correction averaged over the barotropic loop 
    133       !                                          !  (if Flather's algoritm applied at open boundary) 
    134  
    135    !!------------------------------- 
    136    !! Arrays for radiative West OBC 
    137    !!------------------------------- 
    138    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   uwbnd, vwbnd     !: baroclinic u & v components of the velocity over 3 rows  
    139       !                                                   !  and 3 time step (now, before, and before before) 
    140    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   twbnd, swbnd     !: west boundary temperature and salinity over 2 rows and  
    141       !                                                   !  2 time step (now and before) 
    142    REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   u_cxwbnd, v_cxwbnd   !: Zonal component of the phase speed ratio computed with  
    143       !                                                   !  radiation of zonal and meridional velocity (respectively)  
    144       !                                                   !  at the west open boundary (u_cxwbnd = cx rdt ) 
    145    REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   uwmsk, vwmsk, twmsk  !: 2D mask for the West OB 
    146  
    147    ! Note that those arrays are optimized for mpp case  
    148    ! (hence the dimension jpj is the size of one processor subdomain) 
    149  
    150    !!--------------------- 
    151    !! North open boundary 
    152    !!--------------------- 
    153    INTEGER ::   nin0  , nin1       !: do loop index in mpp case for jpind, jpinf 
    154    INTEGER ::   nin0p1, nin1m1     !: do loop index in mpp case for jpindp1, jpinfm1 
    155    INTEGER ::   nin1m2, nin0m1     !: do loop index in mpp case for jpinfm1-1,jpind 
    156    INTEGER ::   njn0  , njn1       !: do loop index in mpp case for jpnob 
    157    INTEGER ::   njn0p1, njn1p1     !: do loop index in mpp case for jpnob+1 
    158    INTEGER ::   njn0m1, njn1m1     !: do loop index in mpp case for jpnob-1 
    159  
    160    REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:) ::   &  !: 
    161       sshfon,           & !: now climatology of the north boundary sea surface height 
    162       ubtfon,vbtfon       !: now climatology of the north boundary barotropic transport 
    163  
    164    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &    !: 
    165       ufon, vfon,       & !: now climatology of the north boundary velocities 
    166       tfon, sfon,       & !: now climatology of the north boundary temperature and salinity 
    167       vclin               !: baroclinic componant of the meridian velocity after the radiation 
    168       !                   !  in yhe obcdyn.F90 routine 
    169  
    170    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshfon_b      !: north boundary ssh correction averaged over the barotropic loop 
    171       !                                            !  (if Flather's algoritm applied at open boundary) 
    172  
    173    !!-------------------------------- 
    174    !! Arrays for radiative North OBC 
    175    !!-------------------------------- 
    176    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   unbnd, vnbnd      !: baroclinic u & v components of the velocity over 3 
    177       !                                                    !  rows and 3 time step (now, before, and before before) 
    178    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tnbnd, snbnd      !: north boundary temperature and salinity over 
    179       !                                                    !  2 rows and 2 time step (now and before) 
    180    REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   u_cynbnd, v_cynbnd    !: Meridional component of the phase speed ratio compu- 
    181       !                                                    !  ted with radiation of zonal and meridional velocity  
    182       !                                                    !  (respectively) at the north OB (u_cynbnd = cx rdt ) 
    183    REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   unmsk, vnmsk, tnmsk   !: 2D mask for the North OB 
    184  
    185    ! Note that those arrays are optimized for mpp case  
    186    ! (hence the dimension jpj is the size of one processor subdomain) 
    187     
    188    !!--------------------- 
    189    !! South open boundary 
    190    !!--------------------- 
    191    INTEGER ::   nis0  , nis1       !: do loop index in mpp case for jpisd, jpisf 
    192    INTEGER ::   nis0p1, nis1m1     !: do loop index in mpp case for jpisdp1, jpisfm1 
    193    INTEGER ::   nis1m2, nis0m1     !: do loop index in mpp case for jpisfm1-1,jpisd 
    194    INTEGER ::   njs0  , njs1       !: do loop index in mpp case for jpsob 
    195    INTEGER ::   njs0p1, njs1p1     !: do loop index in mpp case for jpsob+1 
    196  
    197    REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:) ::    &   !: 
    198       sshfos,           & !: now climatology of the south boundary sea surface height 
    199       ubtfos,vbtfos       !: now climatology of the south boundary barotropic transport 
    200  
    201    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::    &   !: 
    202       ufos, vfos,       & !: now climatology of the south boundary velocities  
    203       tfos, sfos,       & !: now climatology of the south boundary temperature and salinity 
    204       vclis               !: baroclinic componant of the meridian velocity after the radiation  
    205       !                   !  in the obcdyn.F90 routine 
    206  
    207    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshfos_b     !: south boundary ssh correction averaged over the barotropic loop 
    208       !                                           !  (if Flather's algoritm applied at open boundary) 
    209  
    210    !!-------------------------------- 
    211    !! Arrays for radiative South OBC   (computed by the forward time step in dynspg) 
    212    !!-------------------------------- 
    213    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   usbnd, vsbnd     !: baroclinic u & v components of the velocity over 3  
    214       !                                                   !  rows and 3 time step (now, before, and before before) 
    215    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsbnd, ssbnd     !: south boundary temperature and salinity over 
    216       !                                                   !  2 rows and 2 time step (now and before) 
    217    REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   u_cysbnd, v_cysbnd   !: Meridional component of the phase speed ratio 
    218       !                                                   !  computed with radiation of zonal and meridional velocity  
    219       !                                                   !  (repsectively) at the south OB (u_cynbnd = cx rdt ) 
    220    REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   usmsk, vsmsk, tsmsk  !: 2D mask for the South OB 
     88   REAL(wp)                                    ::   obcsurftot !: Lateral surface of unstructured open boundary 
    22189 
    22290   !!---------------------------------------------------------------------- 
    223    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     91   !! open boundary data variables 
     92   !!---------------------------------------------------------------------- 
     93 
     94   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)       ::   dta_global        !: workspace for reading in global data arrays 
     95   TYPE(OBC_INDEX), DIMENSION(jp_obc), TARGET    ::   idx_obc           !: obc indices (local process) 
     96   TYPE(OBC_DATA) , DIMENSION(jp_obc)            ::   dta_obc           !: obc external data (local process) 
     97 
     98   !!---------------------------------------------------------------------- 
     99   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    224100   !! $Id$  
    225    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     101   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    226102   !!---------------------------------------------------------------------- 
    227103CONTAINS 
    228104 
    229    INTEGER FUNCTION obc_oce_alloc() 
     105   FUNCTION obc_oce_alloc() 
    230106      !!---------------------------------------------------------------------- 
    231       !!               ***  FUNCTION obc_oce_alloc  *** 
     107      USE lib_mpp, ONLY: ctl_warn, mpp_sum 
     108      ! 
     109      INTEGER :: obc_oce_alloc 
    232110      !!---------------------------------------------------------------------- 
    233  
    234       ALLOCATE(                                                               & 
    235               !! East open boundary 
    236               obctmsk(jpi,jpj), obcumask(jpi,jpj), obcvmask(jpi,jpj),        & 
    237               sshfoe(jpjed:jpjef), ubtfoe(jpjed:jpjef), vbtfoe(jpjed:jpjef), & 
    238               ufoe(jpj,jpk), vfoe(jpj,jpk), tfoe(jpj,jpk), sfoe(jpj,jpk),    & 
    239               uclie(jpj,jpk), sshfoe_b(jpjed:jpjef,jpj),                     & 
    240               !! Arrays for radiative East OBC 
    241               uebnd(jpj,jpk,3,3), vebnd(jpj,jpk,3,3) ,                       & 
    242               tebnd(jpj,jpk,2,2), sebnd(jpj,jpk,2,2),                        & 
    243               u_cxebnd(jpj,jpk), v_cxebnd(jpj,jpk),                          & 
    244               uemsk(jpj,jpk), vemsk(jpj,jpk), temsk(jpj,jpk),                & 
    245               !! West open boundary 
    246               sshfow(jpjwd:jpjwf), ubtfow(jpjwd:jpjwf), vbtfow(jpjwd:jpjwf), & 
    247               ufow(jpj,jpk), vfow(jpj,jpk), tfow(jpj,jpk),                   & 
    248               sfow(jpj,jpk), ucliw(jpj,jpk), sshfow_b(jpjwd:jpjwf,jpj),      & 
    249               !! Arrays for radiative West OBC 
    250               uwbnd(jpj,jpk,3,3), vwbnd(jpj,jpk,3,3),                        & 
    251               twbnd(jpj,jpk,2,2), swbnd(jpj,jpk,2,2),                        & 
    252               u_cxwbnd(jpj,jpk), v_cxwbnd(jpj,jpk),                          & 
    253               uwmsk(jpj,jpk), vwmsk(jpj,jpk), twmsk(jpj,jpk),                & 
    254               !! North open boundary 
    255               sshfon(jpind:jpinf), ubtfon(jpind:jpinf), vbtfon(jpind:jpinf), & 
    256               ufon(jpi,jpk), vfon(jpi,jpk), tfon(jpi,jpk),                   & 
    257               sfon(jpi,jpk), vclin(jpi,jpk), sshfon_b(jpind:jpinf,jpj),      & 
    258               !! Arrays for radiative North OBC 
    259               unbnd(jpi,jpk,3,3), vnbnd(jpi,jpk,3,3),                        & 
    260               tnbnd(jpi,jpk,2,2), snbnd(jpi,jpk,2,2),                        & 
    261               u_cynbnd(jpi,jpk), v_cynbnd(jpi,jpk),                          & 
    262               unmsk(jpi,jpk), vnmsk(jpi,jpk), tnmsk (jpi,jpk),               & 
    263               !! South open boundary 
    264               sshfos(jpisd:jpisf), ubtfos(jpisd:jpisf), vbtfos(jpisd:jpisf), & 
    265               ufos(jpi,jpk), vfos(jpi,jpk), tfos(jpi,jpk),                   & 
    266               sfos(jpi,jpk), vclis(jpi,jpk),                                 & 
    267               sshfos_b(jpisd:jpisf,jpj),                                     & 
    268               !! Arrays for radiative South OBC  
    269               usbnd(jpi,jpk,3,3), vsbnd(jpi,jpk,3,3),                        & 
    270               tsbnd(jpi,jpk,2,2), ssbnd(jpi,jpk,2,2),                        & 
    271               u_cysbnd(jpi,jpk), v_cysbnd(jpi,jpk),                          & 
    272               usmsk(jpi,jpk), vsmsk(jpi,jpk), tsmsk(jpi,jpk),                & 
    273               !! 
    274               STAT=obc_oce_alloc ) 
     111      ! 
     112      ALLOCATE( obctmask(jpi,jpj) , obcumask(jpi,jpj), obcvmask(jpi,jpj),                    &   
     113         &      STAT=obc_oce_alloc ) 
     114         ! 
     115      IF( lk_mpp             )   CALL mpp_sum ( obc_oce_alloc ) 
     116      IF( obc_oce_alloc /= 0 )   CALL ctl_warn('obc_oce_alloc: failed to allocate arrays.') 
    275117      ! 
    276118   END FUNCTION obc_oce_alloc 
    277     
     119 
    278120#else 
    279121   !!---------------------------------------------------------------------- 
    280    !!   Default option         Empty module                          No OBC 
     122   !!   Dummy module                NO Unstructured Open Boundary Condition 
    281123   !!---------------------------------------------------------------------- 
     124   LOGICAL ::   ln_tides = .false.  !: =T apply tidal harmonic forcing along open boundaries 
    282125#endif 
    283126 
    284127   !!====================================================================== 
    285128END MODULE obc_oce 
     129 
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par.F90

    r2715 r2797  
    11MODULE obc_par 
    2    !!============================================================================== 
    3    !!                  ***  MODULE obc_par   *** 
    4    !! Open Boundary Cond. :   define related parameters 
    5    !!============================================================================== 
    6    !! history :  OPA  ! 1991-01 (CLIPPER)  Original code  
    7    !!   NEMO     1.0  ! 2002-04   (C. Talandier)  modules 
    8    !!             -   ! 2004/06   (F. Durand) jptobc is defined as a parameter 
     2   !!====================================================================== 
     3   !!                      ***  MODULE obc_par   *** 
     4   !! Unstructured Open Boundary Cond. :   define related parameters 
     5   !!====================================================================== 
     6   !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code 
     7   !!            3.0  !  2008-04  (NEMO team)  add in the reference version 
     8   !!            3.3  !  2010-09  (D. Storkey and E. O'Dea) update for Shelf configurations 
    99   !!---------------------------------------------------------------------- 
    10 #if defined key_obc 
     10#if defined   key_obc 
    1111   !!---------------------------------------------------------------------- 
    12    !!   'key_obc' :                                Open Boundary Condition 
     12   !!   'key_obc' :                    Unstructured Open Boundary Condition 
    1313   !!---------------------------------------------------------------------- 
    14    USE par_oce         ! ocean parameters 
    1514 
    1615   IMPLICIT NONE 
    1716   PUBLIC 
    1817 
    19 #if ! defined key_agrif 
    20    LOGICAL, PUBLIC, PARAMETER ::   lk_obc = .TRUE.     !: Ocean Boundary Condition flag 
    21 #else 
    22    LOGICAL, PUBLIC            ::   lk_obc = .TRUE.     !: Ocean Boundary Condition flag 
    23 #endif 
     18   LOGICAL, PUBLIC, PARAMETER ::   lk_obc  = .TRUE.   !: Unstructured Ocean Boundary Condition flag 
     19   INTEGER, PUBLIC, PARAMETER ::   jp_obc  = 10       !: Maximum number of obc sets 
     20   INTEGER, PUBLIC, PARAMETER ::   jpbtime = 1000     !: Max number of time dumps per file 
     21   INTEGER, PUBLIC, PARAMETER ::   jpbgrd  = 3        !: Number of horizontal grid types used  (T, U, V) 
    2422 
    25 # if defined key_eel_r5 
    26    !!---------------------------------------------------------------------- 
    27    !!   'key_eel_r5' :                                 EEL R5 configuration 
    28    !!---------------------------------------------------------------------- 
    29 #    include "obc_par_EEL_R5.h90" 
    30  
    31 # elif defined key_pomme_r025 
    32    !!---------------------------------------------------------------------- 
    33    !!   'key_pomme_r025' :                         POMME R025 configuration 
    34    !!---------------------------------------------------------------------- 
    35 #    include "obc_par_POMME_R025.h90" 
    36  
    37 # else 
    38    !!--------------------------------------------------------------------- 
    39    !! open boundary parameter 
    40    !!--------------------------------------------------------------------- 
    41    INTEGER, PARAMETER ::   jptobc      =  2        !: time dimension of the BCS fields on input 
    42     
    43    !! * EAST open boundary 
    44    LOGICAL, PARAMETER ::   lp_obc_east = .FALSE.   !: to active or not the East open boundary 
    45    INTEGER   & 
    46 #if !defined key_agrif 
    47      , PARAMETER   &  
    48 #endif 
    49     ::     &  
    50       jpieob  = jpiglo-2,    &  !: i-localization of the East open boundary (must be ocean U-point) 
    51       jpjed   =        2,    &  !: j-starting indice of the East open boundary (must be land T-point) 
    52       jpjef   = jpjglo-1,    &  !: j-ending   indice of the East open boundary (must be land T-point) 
    53       jpjedp1 =  jpjed+1,    &  !: first ocean point         "                 " 
    54       jpjefm1 =  jpjef-1        !: last  ocean point         "                 " 
    55  
    56    !! * WEST open boundary 
    57    LOGICAL, PARAMETER ::   lp_obc_west = .FALSE.   !: to active or not the West open boundary 
    58    INTEGER   & 
    59 #if !defined key_agrif 
    60      , PARAMETER   &  
    61 #endif 
    62     ::     &  
    63       jpiwob  =          2,    &  !: i-localization of the West open boundary (must be ocean U-point) 
    64       jpjwd   =          2,    &  !: j-starting indice of the West open boundary (must be land T-point) 
    65       jpjwf   = jpjglo-1,    &  !: j-ending   indice of the West open boundary (must be land T-point) 
    66       jpjwdp1 =  jpjwd+1,    &  !: first ocean point         "                 " 
    67       jpjwfm1 =  jpjwf-1        !: last  ocean point         "                 " 
    68  
    69    !! * NORTH open boundary 
    70    LOGICAL, PARAMETER ::   lp_obc_north = .FALSE.   !: to active or not the North open boundary 
    71      INTEGER   & 
    72 #if !defined key_agrif 
    73      , PARAMETER   &  
    74 #endif 
    75     ::     &  
    76       jpjnob  = jpjglo-2,    &  !: j-localization of the North open boundary (must be ocean V-point) 
    77       jpind   =        2,    &  !: i-starting indice of the North open boundary (must be land T-point) 
    78       jpinf   = jpiglo-1,    &  !: i-ending   indice of the North open boundary (must be land T-point) 
    79       jpindp1 =  jpind+1,    &  !: first ocean point         "                 " 
    80       jpinfm1 =  jpinf-1        !: last  ocean point         "                 " 
    81  
    82    !! * SOUTH open boundary 
    83    LOGICAL, PARAMETER ::   lp_obc_south = .FALSE.   !: to active or not the South open boundary 
    84      INTEGER   & 
    85 #if !defined key_agrif 
    86      , PARAMETER   &  
    87 #endif 
    88     ::     &  
    89       jpjsob  =        2,    &  !: j-localization of the South open boundary (must be ocean V-point) 
    90       jpisd   =        2,    &  !: i-starting indice of the South open boundary (must be land T-point) 
    91       jpisf   = jpiglo-1,    &  !: i-ending   indice of the South open boundary (must be land T-point) 
    92       jpisdp1 =  jpisd+1,    &  !: first ocean point         "                 " 
    93       jpisfm1 =  jpisf-1        !: last  ocean point         "                 " 
    94     
    95    INTEGER, PARAMETER ::   jpnic = 2700   !: maximum number of isolated coastlines points  
    96  
    97 # endif 
    98  
     23   !! Flags for choice of schemes 
     24   INTEGER, PUBLIC, PARAMETER ::   jp_none         = 0        !: Flag for no open boundary condition 
     25   INTEGER, PUBLIC, PARAMETER ::   jp_frs          = 1        !: Flag for Flow Relaxation Scheme 
     26   INTEGER, PUBLIC, PARAMETER ::   jp_flather      = 2        !: Flag for Flather 
    9927#else 
    10028   !!---------------------------------------------------------------------- 
    101    !!   Default option :                         NO open boundary condition 
     29   !!   Default option :            NO Unstructured open boundary condition 
    10230   !!---------------------------------------------------------------------- 
    103    LOGICAL, PUBLIC, PARAMETER ::   lk_obc = .FALSE.  !: Ocean Boundary Condition flag 
     31   LOGICAL, PUBLIC, PARAMETER ::   lk_obc = .FALSE.   !: Unstructured Ocean Boundary Condition flag 
    10432#endif 
    10533 
     
    10735   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    10836   !! $Id$  
    109    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     37   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    11038   !!====================================================================== 
    11139END MODULE obc_par 
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90

    r2722 r2797  
    11MODULE obcdta 
    2    !!============================================================================== 
    3    !!                            ***  MODULE obcdta  *** 
    4    !! Open boundary data : read the data for the open boundaries. 
    5    !!============================================================================== 
    6    !! History :  OPA  ! 1998-05 (J.M. Molines) Original code 
    7    !!            8.5  ! 2002-10 (C. Talandier, A-M. Treguier) Free surface, F90 
    8    !!   NEMO     1.0  ! 2004-06 (F. Durand, A-M. Treguier) Netcdf BC files on input 
    9    !!            3.0  ! 2007-2008 (C. Langlais, P. Mathiot, J.M. Molines) high frequency boundaries data 
    10    !!------------------------------------------------------------------------------ 
     2   !!====================================================================== 
     3   !!                       ***  MODULE obcdta  *** 
     4   !! Open boundary data : read the data for the unstructured open boundaries. 
     5   !!====================================================================== 
     6   !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code 
     7   !!             -   !  2007-01  (D. Storkey) Update to use IOM module 
     8   !!             -   !  2007-07  (D. Storkey) add obc_dta_fla 
     9   !!            3.0  !  2008-04  (NEMO team)  add in the reference version 
     10   !!            3.3  !  2010-09  (E.O'Dea) modifications for Shelf configurations  
     11   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions 
     12   !!            3.4  ???????????????? 
     13   !!---------------------------------------------------------------------- 
    1114#if defined key_obc 
    12    !!------------------------------------------------------------------------------ 
    13    !!   'key_obc'         :                                Open Boundary Conditions 
    14    !!------------------------------------------------------------------------------ 
    15    !!   obc_dta           : read u, v, t, s data along each open boundary 
    16    !!------------------------------------------------------------------------------ 
    17    USE oce             ! ocean dynamics and tracers  
     15   !!---------------------------------------------------------------------- 
     16   !!   'key_obc'                     Open Boundary Conditions 
     17   !!---------------------------------------------------------------------- 
     18   !!    obc_dta        : read external data along open boundaries from file 
     19   !!    obc_dta_init   : initialise arrays etc for reading of external data 
     20   !!---------------------------------------------------------------------- 
     21   USE oce             ! ocean dynamics and tracers 
    1822   USE dom_oce         ! ocean space and time domain 
    19    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2023   USE phycst          ! physical constants 
    21    USE obc_par         ! ocean open boundary conditions 
    2224   USE obc_oce         ! ocean open boundary conditions 
     25   USE obctides        ! tidal forcing at boundaries 
     26   USE fldread         ! read input fields 
     27   USE iom             ! IOM library 
    2328   USE in_out_manager  ! I/O logical units 
    24    USE lib_mpp         ! distributed memory computing 
    25    USE dynspg_oce      ! ocean: surface pressure gradient 
    26    USE ioipsl          ! now only for  ymds2ju function  
    27    USE iom             !  
     29#if defined key_lim2 
     30   USE ice_2 
     31#endif 
    2832 
    2933   IMPLICIT NONE 
    3034   PRIVATE 
    3135 
    32    PUBLIC   obc_dta         ! routine  called by step.F90 
    33    PUBLIC   obc_dta_bt      ! routine  called by dynspg_ts.F90 
    34    PUBLIC   obc_dta_alloc   ! function called by obcini.F90 
    35  
    36    REAL(wp),  DIMENSION(2)              ::   zjcnes_obc   !  
    37    REAL(wp),  DIMENSION(:), ALLOCATABLE ::   ztcobc 
    38    REAL(wp) :: rdt_obc 
    39    REAL(wp) :: zjcnes 
    40    INTEGER :: imm0, iyy0, idd0, iyy, imm, idd 
    41    INTEGER :: nt_a=2, nt_b=1, itobc, ndate0_cnes, nday_year0 
    42    INTEGER ::  itobce, itobcw, itobcs, itobcn, itobc_b  ! number of time steps in OBC files 
    43  
    44    INTEGER ::   ntobc        ! where we are in the obc file 
    45    INTEGER ::   ntobc_b      ! first record used 
    46    INTEGER ::   ntobc_a      ! second record used 
    47  
    48    CHARACTER (len=40) ::   cl_obc_eTS, cl_obc_eU   ! name of data files 
    49    CHARACTER (len=40) ::   cl_obc_wTS, cl_obc_wU   !   -       - 
    50    CHARACTER (len=40) ::   cl_obc_nTS, cl_obc_nV   !   -       - 
    51    CHARACTER (len=40) ::   cl_obc_sTS, cl_obc_sV   !   -       - 
    52  
    53    ! bt arrays for interpolating time dependent data on the boundaries 
    54    INTEGER ::   nt_m=0, ntobc_m 
    55    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtedta, vbtedta, sshedta    ! East 
    56    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtwdta, vbtwdta, sshwdta    ! West 
    57    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtndta, vbtndta, sshndta    ! North 
    58    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtsdta, vbtsdta, sshsdta    ! South 
    59    ! arrays used for interpolating time dependent data on the boundaries 
    60    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uedta, vedta, tedta, sedta    ! East 
    61    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uwdta, vwdta, twdta, swdta    ! West 
    62    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: undta, vndta, tndta, sndta    ! North 
    63    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: usdta, vsdta, tsdta, ssdta    ! South 
    64  
    65    ! Masks set to .TRUE. after successful allocation below 
    66    LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ltemsk, luemsk, lvemsk  ! boolean msks 
    67    LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ltwmsk, luwmsk, lvwmsk  ! used for outliers 
    68    LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ltnmsk, lunmsk, lvnmsk  ! checks 
    69    LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ltsmsk, lusmsk, lvsmsk 
    70  
    71    !! * Substitutions 
    72 #  include "obc_vectopt_loop_substitute.h90" 
    73 #  include "domzgr_substitute.h90" 
     36   PUBLIC   obc_dta          ! routine called by step.F90 and dynspg_ts.F90 
     37   PUBLIC   obc_dta_init     ! routine called by nemogcm.F90 
     38 
     39   INTEGER, ALLOCATABLE, DIMENSION(:)   ::   nb_obc_fld        ! Number of fields to update for each boundary set. 
     40   INTEGER                              ::   nb_obc_fld_sum    ! Total number of fields to update for all boundary sets. 
     41 
     42   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET ::   bf        ! structure of input fields (file informations, fields read) 
     43 
     44   TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr   ! array of pointers to nbmap 
     45 
    7446   !!---------------------------------------------------------------------- 
    7547   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    76    !! $Id$ 
    77    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     48   !! $Id$  
     49   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    7850   !!---------------------------------------------------------------------- 
    7951CONTAINS 
    8052 
    81    INTEGER FUNCTION obc_dta_alloc() 
    82       !!------------------------------------------------------------------- 
    83       !!                     ***  ROUTINE obc_dta_alloc  *** 
    84       !!------------------------------------------------------------------- 
    85       INTEGER :: ierr(2) 
    86       !!------------------------------------------------------------------- 
    87 # if defined key_dynspg_ts 
    88       ALLOCATE(   &     ! time-splitting : 0:jptobc 
    89          ! bt arrays for interpolating time dependent data on the boundaries 
    90          &      ubtedta  (jpj,0:jptobc) , vbtedta  (jpj,0:jptobc) , sshedta  (jpj,0:jptobc) ,    & 
    91          &      ubtwdta  (jpj,0:jptobc) , vbtwdta  (jpj,0:jptobc) , sshwdta  (jpj,0:jptobc) ,    & 
    92          &      ubtndta  (jpi,0:jptobc) , vbtndta  (jpi,0:jptobc) , sshndta  (jpi,0:jptobc) ,    & 
    93          &      ubtsdta  (jpi,0:jptobc) , vbtsdta  (jpi,0:jptobc) , sshsdta  (jpi,0:jptobc) ,    & 
    94          ! arrays used for interpolating time dependent data on the boundaries 
    95          &      uedta(jpj,jpk,0:jptobc) , vedta(jpj,jpk,0:jptobc)                           ,     & 
    96          &      tedta(jpj,jpk,0:jptobc) , sedta(jpj,jpk,0:jptobc)                           ,     & 
    97          &      uwdta(jpj,jpk,0:jptobc) , vwdta(jpj,jpk,0:jptobc)                           ,     & 
    98          &      twdta(jpj,jpk,0:jptobc) , swdta(jpj,jpk,0:jptobc)                           ,     & 
    99          &      undta(jpi,jpk,0:jptobc) , vndta(jpi,jpk,0:jptobc)                           ,     & 
    100          &      tndta(jpi,jpk,0:jptobc) , sndta(jpi,jpk,0:jptobc)                           ,     & 
    101          &      usdta(jpi,jpk,0:jptobc) , vsdta(jpi,jpk,0:jptobc)                           ,     & 
    102          &      tsdta(jpi,jpk,0:jptobc) , ssdta(jpi,jpk,0:jptobc)                           , STAT=ierr(1) ) 
    103 # else 
    104       ALLOCATE(   &     ! no time splitting : 1:jptobc 
    105          ! bt arrays for interpolating time dependent data on the boundaries 
    106          &      ubtedta  (jpj,jptobc) , vbtedta  (jpj,jptobc) , sshedta  (jpj,jptobc)  ,     & 
    107          &      ubtwdta  (jpj,jptobc) , vbtwdta  (jpj,jptobc) , sshwdta  (jpj,jptobc)  ,     & 
    108          &      ubtndta  (jpi,jptobc) , vbtndta  (jpi,jptobc) , sshndta  (jpi,jptobc)  ,     & 
    109          &      ubtsdta  (jpi,jptobc) , vbtsdta  (jpi,jptobc) , sshsdta  (jpi,jptobc)  ,     & 
    110          ! arrays used for interpolating time dependent data on the boundaries 
    111          &      uedta(jpj,jpk,jptobc) , vedta(jpj,jpk,jptobc)                          ,     & 
    112          &      tedta(jpj,jpk,jptobc) , sedta(jpj,jpk,jptobc)                          ,     & 
    113          &      uwdta(jpj,jpk,jptobc) , vwdta(jpj,jpk,jptobc)                          ,     & 
    114          &      twdta(jpj,jpk,jptobc) , swdta(jpj,jpk,jptobc)                          ,     & 
    115          &      undta(jpi,jpk,jptobc) , vndta(jpi,jpk,jptobc)                          ,     & 
    116          &      tndta(jpi,jpk,jptobc) , sndta(jpi,jpk,jptobc)                          ,     & 
    117          &      usdta(jpi,jpk,jptobc) , vsdta(jpi,jpk,jptobc)                          ,     & 
    118          &      tsdta(jpi,jpk,jptobc) , ssdta(jpi,jpk,jptobc)                          , STAT=ierr(1) ) 
    119 # endif 
    120  
    121       ALLOCATE( ltemsk(jpj,jpk) , luemsk(jpj,jpk) , lvemsk(jpj,jpk) ,     & 
    122          &      ltwmsk(jpj,jpk) , luwmsk(jpj,jpk) , lvwmsk(jpj,jpk) ,     & 
    123          &      ltnmsk(jpj,jpk) , lunmsk(jpj,jpk) , lvnmsk(jpj,jpk) ,     & 
    124          &      ltsmsk(jpj,jpk) , lusmsk(jpj,jpk) , lvsmsk(jpj,jpk) , STAT=ierr(2) ) 
    125  
    126       obc_dta_alloc = MAXVAL( ierr ) 
    127       IF( lk_mpp )   CALL mpp_sum( obc_dta_alloc ) 
    128  
    129       IF( obc_dta_alloc == 0 )  THEN         ! Initialise mask values following successful allocation 
    130          !      east            !          west            !          north           !          south           ! 
    131          ltemsk(:,:) = .TRUE.   ;   ltwmsk(:,:) = .TRUE.   ;   ltnmsk(:,:) = .TRUE.   ;   ltsmsk(:,:) = .TRUE. 
    132          luemsk(:,:) = .TRUE.   ;   luwmsk(:,:) = .TRUE.   ;   lunmsk(:,:) = .TRUE.   ;   lusmsk(:,:) = .TRUE. 
    133          lvemsk(:,:) = .TRUE.   ;   lvwmsk(:,:) = .TRUE.   ;   lvnmsk(:,:) = .TRUE.   ;   lvsmsk(:,:) = .TRUE. 
    134       END IF 
    135       ! 
    136    END FUNCTION obc_dta_alloc 
    137  
    138  
    139    SUBROUTINE obc_dta( kt ) 
    140       !!--------------------------------------------------------------------------- 
    141       !!                      ***  SUBROUTINE obc_dta  *** 
     53      SUBROUTINE obc_dta( kt, jit ) 
     54      !!---------------------------------------------------------------------- 
     55      !!                   ***  SUBROUTINE obc_dta  *** 
    14256      !!                     
    143       !! ** Purpose :   Find the climatological  boundary arrays for the specified date,  
    144       !!                The boundary arrays are netcdf files. Three possible cases:  
    145       !!                - one time frame only in the file (time dimension = 1). 
    146       !!                in that case the boundary data does not change in time. 
    147       !!                - many time frames. In that case,  if we have 12 frames 
    148       !!                we assume monthly fields.  
    149       !!                Else, we assume that time_counter is in seconds  
    150       !!                since the beginning of either the current year or a reference 
    151       !!                year given in the namelist. 
    152       !!                (no check is done so far but one would have to check the "unit" 
    153       !!                 attribute of variable time_counter). 
     57      !! ** Purpose :   Update external data for open boundary conditions 
     58      !! 
     59      !! ** Method  :   Use fldread.F90 
     60      !!                 
     61      !!---------------------------------------------------------------------- 
     62      INTEGER, INTENT( in )           ::   kt    ! ocean time-step index  
     63      INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option) 
     64      !! 
     65      INTEGER     ::  ib_obc, jfld, jstart, jend            ! local indices 
     66      INTEGER, POINTER, DIMENSION(:)  ::   nblen, nblenrim  ! short cuts 
    15467      !! 
    15568      !!--------------------------------------------------------------------------- 
    156       INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    157       ! 
    158       INTEGER, SAVE :: immfile, iyyfile                     ! 
    159       INTEGER :: nt              !  record indices (incrementation) 
    160       REAL(wp) ::   zsec, zxy, znum, zden ! time interpolation weight 
     69 
     70      ! for nn_dtactl = 0, initialise data arrays once for all 
     71      ! from initial conditions 
     72      !------------------------------------------------------- 
     73      IF( kt .eq. 1 .and. .not. PRESENT(jit) ) THEN 
     74 
     75         DO ib_obc = 1, nb_obc 
     76            IF( nn_dtactl(ib_obc) .eq. 0 ) THEN 
     77 
     78               !!! TO BE DONE !!! 
     79 
     80            ENDIF 
     81         ENDDO 
     82 
     83      ENDIF 
     84 
     85      ! for nn_dtactl = 1, update external data from files 
     86      !--------------------------------------------------- 
     87      
     88      jstart = 1 
     89      DO ib_obc = 1, nb_obc    
     90         IF( nn_dtactl(ib_obc) .eq. 1 ) THEN 
     91       
     92            IF( PRESENT(jit) ) THEN 
     93               ! Update barotropic boundary conditions only 
     94               ! jit is optional argument for fld_read 
     95               IF( nn_dyn2d(ib_obc) .gt. 0 ) THEN 
     96                  jend = jstart + 2 
     97                  CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), jit=jit ) 
     98               ENDIF 
     99            ELSE 
     100               jend = jstart + nb_obc_fld(ib_obc) - 1 
     101               CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend ), map=nbmap_ptr(jstart:jend), timeshift=1 ) 
     102            ENDIF 
     103            jstart = jend+1 
     104 
     105         END IF ! nn_dtactl(ib_obc) = 1 
     106      END DO  ! ib_obc 
     107 
     108      END SUBROUTINE obc_dta 
     109 
     110 
     111      SUBROUTINE obc_dta_init 
     112      !!---------------------------------------------------------------------- 
     113      !!                   ***  SUBROUTINE obc_dta_init  *** 
     114      !!                     
     115      !! ** Purpose :   Initialise arrays for reading of external data  
     116      !!                for open boundary conditions 
     117      !! 
     118      !! ** Method  :   Use fldread.F90 
     119      !!                 
     120      !!---------------------------------------------------------------------- 
     121      INTEGER     ::  ib_obc, jfld, jstart, jend, ierror  ! local indices 
     122      !! 
     123      CHARACTER(len=100)                     ::   cn_dir        ! Root directory for location of data files 
     124      CHARACTER(len=100), DIMENSION(nb_obc)  ::   cn_dir_array  ! Root directory for location of data files 
     125      INTEGER                                ::   ilen_global   ! Max length required for global obc dta arrays 
     126      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ilen1, ilen3  ! size of 1st and 3rd dimensions of local arrays 
     127      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   iobc           ! obc set for a particular jfld 
     128      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   igrid         ! index for grid type (1,2,3 = T,U,V) 
     129      INTEGER, POINTER, DIMENSION(:)         ::   nblen, nblenrim  ! short cuts 
     130      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   blf_i         !  array of namelist information structures 
     131      TYPE(FLD_N) ::   bn_tem, bn_sal, bn_u3d, bn_v3d   !  
     132      TYPE(FLD_N) ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read 
     133#if defined key_lim2 
     134      TYPE(FLD_N) ::   bn_frld, bn_hicif, bn_hsnif      ! 
     135#endif 
     136      NAMELIST/namobc_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d  
     137#if defined key_lim2 
     138      NAMELIST/namobc_dta/ bn_frld, bn_hicif, bn_hsnif 
     139#endif 
    161140      !!--------------------------------------------------------------------------- 
    162141 
    163       ! 0.  initialisation : 
    164       ! -------------------- 
    165       IF ( kt == nit000  )  CALL obc_dta_ini ( kt ) 
    166       IF ( nobc_dta == 0 )  RETURN   ! already done in obc_dta_ini 
    167       IF ( itobc == 1    )  RETURN   ! case of only one time frame in file done in obc_dta_ini 
    168  
    169       ! in the following code, we assume that obc data are read from files, with more than 1 time frame in it 
    170  
    171       iyyfile=iyy ; immfile = 00  ! set component of the current file name 
    172       IF ( cffile /= 'annual') immfile = imm   !  
    173       IF ( ln_obc_clim       ) iyyfile = 0000  ! assume that climatological files are labeled y0000 
    174  
    175       ! 1. Synchronize time of run with time of data files 
    176       !--------------------------------------------------- 
    177       ! nday_year is the day number in the current year ( 1 for 01/01 ) 
    178       zsec=MOD( (kt-nit000)*rdt - (nday_year - nday_year0 )*rday, rday ) ! number of seconds in the current day 
    179       IF (ln_obc_clim)  THEN  
    180          zjcnes = nday_year - 1  + zsec/rday 
    181       ELSE 
    182          zjcnes = zjcnes + rdt/rday 
     142      ! Work out how many fields there are to read in and allocate arrays 
     143      ! ----------------------------------------------------------------- 
     144      ALLOCATE( nb_obc_fld(nb_obc) ) 
     145      nb_obc_fld(:) = 0 
     146      DO ib_obc = 1, nb_obc          
     147         IF( nn_dtactl(ib_obc) .eq. 1 ) THEN 
     148            IF( nn_dyn2d(ib_obc) .gt. 0 ) THEN 
     149               nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 3 
     150            ENDIF 
     151            IF( nn_dyn3d(ib_obc) .gt. 0 ) THEN 
     152               nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 2 
     153            ENDIF 
     154            IF( nn_tra(ib_obc) .gt. 0 ) THEN 
     155               nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 2 
     156            ENDIF 
     157#if defined key_lim2 
     158            IF( nn_ice_lim2(ib_obc) .gt. 0 ) THEN 
     159               nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 3 
     160            ENDIF 
     161#endif                
     162         ENDIF 
     163      ENDDO             
     164 
     165      nb_obc_fld_sum = SUM( nb_obc_fld ) 
     166 
     167      ALLOCATE( bf(nb_obc_fld_sum), STAT=ierror ) 
     168      IF( ierror > 0 ) THEN    
     169         CALL ctl_stop( 'obc_dta: unable to allocate bf structure' )   ;   RETURN   
    183170      ENDIF 
    184  
    185       ! look for 'before' record number in the current file 
    186       ntobc = nrecbef ()  ! this function return the record number for 'before', relative to zjcnes 
    187  
    188       IF (MOD(kt-1,10)==0) THEN 
    189          IF (lwp) WRITE(numout,*) 'kt= ',kt,' zjcnes =', zjcnes,' ndastp =',ndastp, 'mm =',imm  
    190       END IF 
    191  
    192       ! 2. read a new data if necessary  
    193       !-------------------------------- 
    194       IF ( ntobc /= ntobc_b ) THEN 
    195          ! we need to read the 'after' record 
    196          ! swap working index: 
    197 # if defined key_dynspg_ts 
    198          nt=nt_m ; nt_m=nt_b ; nt_b=nt 
    199 # endif 
    200          nt=nt_b ; nt_b=nt_a ; nt_a=nt 
    201          ntobc_b = ntobc 
    202  
    203          ! new record number : 
    204          ntobc_a = ntobc_a + 1  
    205  
    206          ! all tricky things related to record number, changing files etc... are managed by obc_read 
    207  
    208          CALL obc_read (kt, nt_a, ntobc_a, iyyfile, immfile ) 
    209  
    210          ! update zjcnes_obc 
    211 # if defined key_dynspg_ts 
    212          ntobc_m=mod(ntobc_b-2+itobc,itobc)+1 
    213          zjcnes_obc(nt_m)= ztcobc(ntobc_m) 
    214 # endif 
    215          zjcnes_obc(nt_b)= ztcobc(ntobc_b) 
    216          zjcnes_obc(nt_a)= ztcobc(ntobc_a) 
     171      ALLOCATE( blf_i(nb_obc_fld_sum), STAT=ierror ) 
     172      IF( ierror > 0 ) THEN    
     173         CALL ctl_stop( 'obc_dta: unable to allocate blf_i structure' )   ;   RETURN   
    217174      ENDIF 
    218  
    219       ! 3.   interpolation at each time step 
    220       ! ------------------------------------ 
    221       IF( ln_obc_clim) THEN 
    222          znum= MOD(zjcnes           - zjcnes_obc(nt_b), REAL(nyear_len(1),wp) ) 
    223          IF( znum < 0 ) znum = znum + REAL(nyear_len(1),wp) 
    224          zden= MOD(zjcnes_obc(nt_a) - zjcnes_obc(nt_b), REAL(nyear_len(1),wp) )  
    225          IF( zden < 0 ) zden = zden + REAL(nyear_len(1),wp) 
    226       ELSE 
    227          znum= zjcnes           - zjcnes_obc(nt_b) 
    228          zden= zjcnes_obc(nt_a) - zjcnes_obc(nt_b) 
     175      ALLOCATE( nbmap_ptr(nb_obc_fld_sum), STAT=ierror ) 
     176      IF( ierror > 0 ) THEN    
     177         CALL ctl_stop( 'obc_dta: unable to allocate nbmap_ptr structure' )   ;   RETURN   
    229178      ENDIF 
    230       zxy = znum / zden 
    231  
    232       IF( lp_obc_east ) THEN 
    233          !  fills sfoe, tfoe, ufoe ,vfoe 
    234          sfoe(:,:) = zxy * sedta (:,:,nt_a) + (1. - zxy)*sedta(:,:,nt_b) 
    235          tfoe(:,:) = zxy * tedta (:,:,nt_a) + (1. - zxy)*tedta(:,:,nt_b) 
    236          ufoe(:,:) = zxy * uedta (:,:,nt_a) + (1. - zxy)*uedta(:,:,nt_b) 
    237          vfoe(:,:) = zxy * vedta (:,:,nt_a) + (1. - zxy)*vedta(:,:,nt_b) 
     179      ALLOCATE( ilen1(nb_obc_fld_sum), ilen3(nb_obc_fld_sum) )  
     180      ALLOCATE( iobc(nb_obc_fld_sum) )  
     181      ALLOCATE( igrid(nb_obc_fld_sum) )  
     182 
     183      ! Read namelists 
     184      ! -------------- 
     185      REWIND(numnam) 
     186      jfld = 0  
     187      DO ib_obc = 1, nb_obc          
     188         IF( nn_dtactl(ib_obc) .eq. 1 ) THEN 
     189            ! set file information 
     190            cn_dir = './'        ! directory in which the model is executed 
     191            ! ... default values (NB: frequency positive => hours, negative => months) 
     192            !                    !  file       ! frequency !  variable        ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  ! 
     193            !                    !  name       !  (hours)  !   name           !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs     ! 
     194            bn_ssh     = FLD_N(  'obc_ssh'     ,    24     ,  'sossheig'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     195            bn_u2d     = FLD_N(  'obc_vel2d_u' ,    24     ,  'vobtcrtx'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     196            bn_v2d     = FLD_N(  'obc_vel2d_v' ,    24     ,  'vobtcrty'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     197            bn_u3d     = FLD_N(  'obc_vel3d_u' ,    24     ,  'vozocrtx'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     198            bn_v3d     = FLD_N(  'obc_vel3d_v' ,    24     ,  'vomecrty'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     199            bn_tem     = FLD_N(  'obc_tem'     ,    24     ,  'votemper'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     200            bn_sal     = FLD_N(  'obc_sal'     ,    24     ,  'vosaline'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     201#if defined key_lim2 
     202            bn_frld    = FLD_N(  'obc_frld'    ,    24     ,  'ildsconc'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     203            bn_hicif   = FLD_N(  'obc_hicif'   ,    24     ,  'iicethic'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     204            bn_hsnif   = FLD_N(  'obc_hsnif'   ,    24     ,  'isnothic'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     205#endif 
     206 
     207            ! Important NOT to rewind here. 
     208            READ( numnam, namobc_dta ) 
     209 
     210            cn_dir_array(ib_obc) = cn_dir 
     211 
     212            nblen => idx_obc(ib_obc)%nblen 
     213            nblenrim => idx_obc(ib_obc)%nblenrim 
     214 
     215            ! Only read in necessary fields for this set. 
     216            ! Important that barotropic variables come first. 
     217            IF( nn_dyn2d(ib_obc) .gt. 0 ) THEN  
     218 
     219               jfld = jfld + 1 
     220               blf_i(jfld) = bn_ssh 
     221               iobc(jfld) = ib_obc 
     222               igrid(jfld) = 1 
     223               IF( nn_dyn2d(ib_obc) .eq. jp_frs ) THEN 
     224                  ilen1(jfld) = nblen(igrid(jfld)) 
     225               ELSE 
     226                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     227               ENDIF 
     228               ilen3(jfld) = 1 
     229 
     230               jfld = jfld + 1 
     231               blf_i(jfld) = bn_u2d 
     232               iobc(jfld) = ib_obc 
     233               igrid(jfld) = 2 
     234               IF( nn_dyn2d(ib_obc) .eq. jp_frs ) THEN 
     235                  ilen1(jfld) = nblen(igrid(jfld)) 
     236               ELSE 
     237                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     238               ENDIF 
     239               ilen3(jfld) = 1 
     240 
     241               jfld = jfld + 1 
     242               blf_i(jfld) = bn_v2d 
     243               iobc(jfld) = ib_obc 
     244               igrid(jfld) = 3 
     245               IF( nn_dyn2d(ib_obc) .eq. jp_frs ) THEN 
     246                  ilen1(jfld) = nblen(igrid(jfld)) 
     247               ELSE 
     248                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     249               ENDIF 
     250               ilen3(jfld) = 1 
     251 
     252            ENDIF 
     253 
     254            ! baroclinic velocities 
     255            IF( nn_dyn3d(ib_obc) .gt. 0 ) THEN 
     256 
     257               jfld = jfld + 1 
     258               blf_i(jfld) = bn_u3d 
     259               iobc(jfld) = ib_obc 
     260               igrid(jfld) = 2 
     261               IF( nn_dyn3d(ib_obc) .eq. jp_frs ) THEN 
     262                  ilen1(jfld) = nblen(igrid(jfld)) 
     263               ELSE 
     264                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     265               ENDIF 
     266               ilen3(jfld) = jpk 
     267 
     268               jfld = jfld + 1 
     269               blf_i(jfld) = bn_v3d 
     270               iobc(jfld) = ib_obc 
     271               igrid(jfld) = 3 
     272               IF( nn_dyn3d(ib_obc) .eq. jp_frs ) THEN 
     273                  ilen1(jfld) = nblen(igrid(jfld)) 
     274               ELSE 
     275                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     276               ENDIF 
     277               ilen3(jfld) = jpk 
     278 
     279            ENDIF 
     280 
     281            ! temperature and salinity 
     282            IF( nn_tra(ib_obc) .gt. 0 ) THEN 
     283 
     284               jfld = jfld + 1 
     285               blf_i(jfld) = bn_tem 
     286               iobc(jfld) = ib_obc 
     287               igrid(jfld) = 1 
     288               IF( nn_tra(ib_obc) .eq. jp_frs ) THEN 
     289                  ilen1(jfld) = nblen(igrid(jfld)) 
     290               ELSE 
     291                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     292               ENDIF 
     293               ilen3(jfld) = jpk 
     294 
     295               jfld = jfld + 1 
     296               blf_i(jfld) = bn_sal 
     297               iobc(jfld) = ib_obc 
     298               igrid(jfld) = 1 
     299               IF( nn_tra(ib_obc) .eq. jp_frs ) THEN 
     300                  ilen1(jfld) = nblen(igrid(jfld)) 
     301               ELSE 
     302                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     303               ENDIF 
     304               ilen3(jfld) = jpk 
     305 
     306            ENDIF 
     307 
     308#if defined key_lim2 
     309            ! sea ice 
     310            IF( nn_tra(ib_obc) .gt. 0 ) THEN 
     311 
     312               jfld = jfld + 1 
     313               blf_i(jfld) = bn_frld 
     314               iobc(jfld) = ib_obc 
     315               igrid(jfld) = 1 
     316               IF( nn_ice_lim2(ib_obc) .eq. jp_frs ) THEN 
     317                  ilen1(jfld) = nblen(igrid(jfld)) 
     318               ELSE 
     319                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     320               ENDIF 
     321               ilen3(jfld) = 1 
     322 
     323               jfld = jfld + 1 
     324               blf_i(jfld) = bn_hicif 
     325               iobc(jfld) = ib_obc 
     326               igrid(jfld) = 1 
     327               IF( nn_ice_lim2(ib_obc) .eq. jp_frs ) THEN 
     328                  ilen1(jfld) = nblen(igrid(jfld)) 
     329               ELSE 
     330                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     331               ENDIF 
     332               ilen3(jfld) = 1 
     333 
     334               jfld = jfld + 1 
     335               blf_i(jfld) = bn_hsnif 
     336               iobc(jfld) = ib_obc 
     337               igrid(jfld) = 1 
     338               IF( nn_ice_lim2(ib_obc) .eq. jp_frs ) THEN 
     339                  ilen1(jfld) = nblen(igrid(jfld)) 
     340               ELSE 
     341                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     342               ENDIF 
     343               ilen3(jfld) = 1 
     344 
     345            ENDIF 
     346#endif 
     347         ENDIF ! nn_dtactl .eq. 1 
     348      ENDDO ! ib_obc 
     349 
     350      IF( jfld .ne. nb_obc_fld_sum ) THEN 
     351         CALL ctl_stop( 'obc_dta: error in initialisation: jpfld .ne. nb_obc_fld_sum' )   ;   RETURN   
    238352      ENDIF 
    239353 
    240       IF( lp_obc_west) THEN 
    241          !  fills sfow, tfow, ufow ,vfow 
    242          sfow(:,:) = zxy * swdta (:,:,nt_a) + (1. - zxy)*swdta(:,:,nt_b) 
    243          tfow(:,:) = zxy * twdta (:,:,nt_a) + (1. - zxy)*twdta(:,:,nt_b) 
    244          ufow(:,:) = zxy * uwdta (:,:,nt_a) + (1. - zxy)*uwdta(:,:,nt_b) 
    245          vfow(:,:) = zxy * vwdta (:,:,nt_a) + (1. - zxy)*vwdta(:,:,nt_b) 
    246       ENDIF 
    247  
    248       IF( lp_obc_north) THEN 
    249          !  fills sfon, tfon, ufon ,vfon 
    250          sfon(:,:) = zxy * sndta (:,:,nt_a) + (1. - zxy)*sndta(:,:,nt_b) 
    251          tfon(:,:) = zxy * tndta (:,:,nt_a) + (1. - zxy)*tndta(:,:,nt_b) 
    252          ufon(:,:) = zxy * undta (:,:,nt_a) + (1. - zxy)*undta(:,:,nt_b) 
    253          vfon(:,:) = zxy * vndta (:,:,nt_a) + (1. - zxy)*vndta(:,:,nt_b) 
    254       ENDIF 
    255  
    256       IF( lp_obc_south) THEN 
    257          !  fills sfos, tfos, ufos ,vfos 
    258          sfos(:,:) = zxy * ssdta (:,:,nt_a) + (1. - zxy)*ssdta(:,:,nt_b) 
    259          tfos(:,:) = zxy * tsdta (:,:,nt_a) + (1. - zxy)*tsdta(:,:,nt_b) 
    260          ufos(:,:) = zxy * usdta (:,:,nt_a) + (1. - zxy)*usdta(:,:,nt_b) 
    261          vfos(:,:) = zxy * vsdta (:,:,nt_a) + (1. - zxy)*vsdta(:,:,nt_b) 
    262       ENDIF 
     354      DO jfld = 1, nb_obc_fld_sum 
     355         ALLOCATE( bf(jfld)%fnow(ilen1(jfld),1,ilen3(jfld)) ) 
     356         IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) ) 
     357         nbmap_ptr(jfld)%ptr => idx_obc(iobc(jfld))%nbmap(:,igrid(jfld)) 
     358      ENDDO 
     359 
     360      ! fill bf with blf_i and control print 
     361      !------------------------------------- 
     362      jstart = 1 
     363      DO ib_obc = 1, nb_obc 
     364         jend = jstart + nb_obc_fld(ib_obc) - 1 
     365         CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(ib_obc), 'obc_dta', 'open boundary conditions', 'namobc_dta' ) 
     366         jstart = jend + 1 
     367      ENDDO 
     368 
     369      ! Initialise local boundary data arrays 
     370      ! nn_dtactl=0 : allocate space - will be filled from initial conditions later 
     371      ! nn_dtactl=1 : point to "fnow" arrays 
     372      !------------------------------------- 
     373 
     374      jfld = 0 
     375      DO ib_obc=1, nb_obc 
     376 
     377         nblen => idx_obc(ib_obc)%nblen 
     378         nblenrim => idx_obc(ib_obc)%nblenrim 
     379 
     380         IF( nn_dtactl(ib_obc) .eq. 0 ) THEN 
     381                
     382            ! nn_dtactl = 0  
     383            ! Allocate space 
     384            !--------------- 
     385            IF (nn_dyn2d(ib_obc) .gt. 0) THEN 
     386               IF( nn_dyn2d(ib_obc) .eq. jp_frs ) THEN 
     387                  ilen1(1) = nblen(1) 
     388                  ilen1(2) = nblen(2) 
     389                  ilen1(3) = nblen(3) 
     390               ELSE 
     391                  ilen1(1) = nblenrim(1) 
     392                  ilen1(2) = nblenrim(2) 
     393                  ilen1(3) = nblenrim(3) 
     394               ENDIF 
     395               ALLOCATE( dta_obc(ib_obc)%ssh(ilen1(1)) ) 
     396               ALLOCATE( dta_obc(ib_obc)%u2d(ilen1(2)) ) 
     397               ALLOCATE( dta_obc(ib_obc)%v2d(ilen1(3)) ) 
     398            ENDIF 
     399            IF (nn_dyn3d(ib_obc) .gt. 0) THEN 
     400               IF( nn_dyn3d(ib_obc) .eq. jp_frs ) THEN 
     401                  ilen1(2) = nblen(2) 
     402                  ilen1(3) = nblen(3) 
     403               ELSE 
     404                  ilen1(2) = nblenrim(2) 
     405                  ilen1(3) = nblenrim(3) 
     406               ENDIF 
     407               ALLOCATE( dta_obc(ib_obc)%u3d(ilen1(2),jpk) ) 
     408               ALLOCATE( dta_obc(ib_obc)%v3d(ilen1(3),jpk) ) 
     409            ENDIF 
     410            IF (nn_tra(ib_obc) .gt. 0) THEN 
     411               IF( nn_tra(ib_obc) .eq. jp_frs ) THEN 
     412                  ilen1(1) = nblen(1) 
     413               ELSE 
     414                  ilen1(1) = nblenrim(1) 
     415               ENDIF 
     416               ALLOCATE( dta_obc(ib_obc)%tem(ilen1(1),jpk) ) 
     417               ALLOCATE( dta_obc(ib_obc)%sal(ilen1(1),jpk) ) 
     418            ENDIF 
     419#if defined key_lim2 
     420            IF (nn_ice_lim2(ib_obc) .gt. 0) THEN 
     421               IF( nn_ice_lim2(ib_obc) .eq. jp_frs ) THEN 
     422                  ilen1(1) = nblen(igrid(jfld)) 
     423               ELSE 
     424                  ilen1(1) = nblenrim(igrid(jfld)) 
     425               ENDIF 
     426               ALLOCATE( dta_obc(ib_obc)%ssh(ilen1(1)) ) 
     427               ALLOCATE( dta_obc(ib_obc)%u2d(ilen1(1)) ) 
     428               ALLOCATE( dta_obc(ib_obc)%v2d(ilen1(1)) ) 
     429            ENDIF 
     430#endif 
     431 
     432         ELSE 
     433 
     434            ! nn_dtactl = 1 
     435            ! Set boundary data arrays to point to relevant "fnow" arrays 
     436            !----------------------------------------------------------- 
     437            IF (nn_dyn2d(ib_obc) .gt. 0) THEN 
     438               jfld = jfld + 1 
     439               dta_obc(ib_obc)%ssh => bf(jfld)%fnow(:,1,1) 
     440               jfld = jfld + 1 
     441               dta_obc(ib_obc)%u2d => bf(jfld)%fnow(:,1,1) 
     442               jfld = jfld + 1 
     443               dta_obc(ib_obc)%v2d => bf(jfld)%fnow(:,1,1) 
     444            ENDIF 
     445            IF (nn_dyn3d(ib_obc) .gt. 0) THEN 
     446               jfld = jfld + 1 
     447               dta_obc(ib_obc)%u3d => bf(jfld)%fnow(:,1,:) 
     448               jfld = jfld + 1 
     449               dta_obc(ib_obc)%v3d => bf(jfld)%fnow(:,1,:) 
     450            ENDIF 
     451            IF (nn_tra(ib_obc) .gt. 0) THEN 
     452               jfld = jfld + 1 
     453               dta_obc(ib_obc)%tem => bf(jfld)%fnow(:,1,:) 
     454               jfld = jfld + 1 
     455               dta_obc(ib_obc)%sal => bf(jfld)%fnow(:,1,:) 
     456            ENDIF 
     457#if defined key_lim2 
     458            IF (nn_ice_lim2(ib_obc) .gt. 0) THEN 
     459               jfld = jfld + 1 
     460               dta_obc(ib_obc)%frld  => bf(jfld)%fnow(:,1,1) 
     461               jfld = jfld + 1 
     462               dta_obc(ib_obc)%hicif => bf(jfld)%fnow(:,1,1) 
     463               jfld = jfld + 1 
     464               dta_obc(ib_obc)%hsnif => bf(jfld)%fnow(:,1,1) 
     465            ENDIF 
     466#endif 
     467 
     468         ENDIF ! nn_dtactl .eq. 0 
     469 
     470      ENDDO ! ib_obc  
     471 
     472      END SUBROUTINE obc_dta_init 
     473 
     474#else 
     475   !!---------------------------------------------------------------------- 
     476   !!   Dummy module                   NO Open Boundary Conditions 
     477   !!---------------------------------------------------------------------- 
     478CONTAINS 
     479   SUBROUTINE obc_dta( kt, jit )              ! Empty routine 
     480      WRITE(*,*) 'obc_dta: You should not have seen this print! error?', kt 
    263481   END SUBROUTINE obc_dta 
    264  
    265  
    266    SUBROUTINE obc_dta_ini( kt ) 
    267       !!----------------------------------------------------------------------------- 
    268       !!                       ***  SUBROUTINE obc_dta_ini  *** 
    269       !! 
    270       !! ** Purpose :   When obc_dta first call, realize some data initialization 
    271       !!---------------------------------------------------------------------------- 
    272       INTEGER, INTENT(in)  :: kt      ! ocean time-step index 
    273       ! 
    274       INTEGER ::   ji, jj   ! dummy loop indices 
    275       INTEGER, SAVE :: immfile, iyyfile                     ! 
    276  
    277       ! variables for the julian day calculation 
    278       INTEGER :: iyear, imonth, iday 
    279       REAL(wp) :: zsec , zjulian, zjuliancnes    
    280  
    281       IF(lwp) WRITE(numout,*) 
    282       IF(lwp) WRITE(numout,*)  'obc_dta : find boundary data' 
    283       IF(lwp) WRITE(numout,*)  '~~~~~~~' 
    284       IF (lwp) THEN 
    285          IF ( nobc_dta == 0 ) THEN  
    286             WRITE(numout,*)  '          OBC data taken from initial conditions.' 
    287          ELSE       
    288             WRITE(numout,*)  '          OBC data taken from netcdf files.' 
    289          ENDIF 
    290       ENDIF 
    291       nday_year0 = nday_year  ! to remember the day when kt=nit000 
    292  
    293       sedta(:,:,:) = 0.e0 ; tedta(:,:,:) = 0.e0 ; uedta(:,:,:) = 0.e0 ; vedta(:,:,:) = 0.e0 ! East 
    294       swdta(:,:,:) = 0.e0 ; twdta(:,:,:) = 0.e0 ; uwdta(:,:,:) = 0.e0 ; vwdta(:,:,:) = 0.e0 ! West 
    295       sndta(:,:,:) = 0.e0 ; tndta(:,:,:) = 0.e0 ; undta(:,:,:) = 0.e0 ; vndta(:,:,:) = 0.e0 ! North 
    296       ssdta(:,:,:) = 0.e0 ; tsdta(:,:,:) = 0.e0 ; usdta(:,:,:) = 0.e0 ; vsdta(:,:,:) = 0.e0 ! South 
    297  
    298       sfoe(:,:) = 0.e0  ; tfoe(:,:) = 0.e0 ; ufoe(:,:) = 0.e0 ; vfoe(:,:) = 0.e0   ! East 
    299       sfow(:,:) = 0.e0  ; tfow(:,:) = 0.e0 ; ufow(:,:) = 0.e0 ; vfow(:,:) = 0.e0   ! West 
    300       sfon(:,:) = 0.e0  ; tfon(:,:) = 0.e0 ; ufon(:,:) = 0.e0 ; vfon(:,:) = 0.e0   ! North 
    301       sfos(:,:) = 0.e0  ; tfos(:,:) = 0.e0 ; ufos(:,:) = 0.e0 ; vfos(:,:) = 0.e0   ! South 
    302  
    303       IF (nobc_dta == 0 ) THEN   ! boundary data are the initial data of this run (set only at nit000) 
    304          IF (lp_obc_east) THEN  ! East 
    305             DO ji = nie0 , nie1     
    306                sfoe(nje0:nje1,:) = temsk(nje0:nje1,:) * sn (ji+1 , nje0:nje1 , :) * tmask(ji+1,nje0:nje1 , :) 
    307                tfoe(nje0:nje1,:) = temsk(nje0:nje1,:) * tn (ji+1 , nje0:nje1 , :) * tmask(ji+1,nje0:nje1 , :) 
    308                ufoe(nje0:nje1,:) = uemsk(nje0:nje1,:) * un (ji   , nje0:nje1 , :) * umask(ji,  nje0:nje1 , :) 
    309                vfoe(nje0:nje1,:) = vemsk(nje0:nje1,:) * vn (ji+1 , nje0:nje1 , :) * vmask(ji+1,nje0:nje1 , :) 
    310             END DO 
    311          ENDIF 
    312  
    313          IF (lp_obc_west) THEN  ! West 
    314             DO ji = niw0 , niw1     
    315                sfow(njw0:njw1,:) = twmsk(njw0:njw1,:) * sn (ji , njw0:njw1 , :) * tmask(ji , njw0:njw1 , :) 
    316                tfow(njw0:njw1,:) = twmsk(njw0:njw1,:) * tn (ji , njw0:njw1 , :) * tmask(ji , njw0:njw1 , :) 
    317                ufow(njw0:njw1,:) = uwmsk(njw0:njw1,:) * un (ji , njw0:njw1 , :) * umask(ji , njw0:njw1 , :) 
    318                vfow(njw0:njw1,:) = vwmsk(njw0:njw1,:) * vn (ji , njw0:njw1 , :) * vmask(ji , njw0:njw1 , :) 
    319             END DO 
    320          ENDIF 
    321  
    322          IF (lp_obc_north) THEN ! North 
    323             DO jj = njn0 , njn1 
    324                sfon(nin0:nin1,:) = tnmsk(nin0:nin1,:) * sn (nin0:nin1 , jj+1 , :) * tmask(nin0:nin1 , jj+1 , :) 
    325                tfon(nin0:nin1,:) = tnmsk(nin0:nin1,:) * tn (nin0:nin1 , jj+1 , :) * tmask(nin0:nin1 , jj+1 , :) 
    326                ufon(nin0:nin1,:) = unmsk(nin0:nin1,:) * un (nin0:nin1 , jj+1 , :) * umask(nin0:nin1 , jj+1 , :) 
    327                vfon(nin0:nin1,:) = vnmsk(nin0:nin1,:) * vn (nin0:nin1 , jj   , :) * vmask(nin0:nin1 , jj   , :) 
    328             END DO 
    329          ENDIF 
    330  
    331          IF (lp_obc_south) THEN ! South 
    332             DO jj = njs0 , njs1 
    333                sfos(nis0:nis1,:) = tsmsk(nis0:nis1,:) * sn (nis0:nis1 , jj , :) * tmask(nis0:nis1 , jj , :) 
    334                tfos(nis0:nis1,:) = tsmsk(nis0:nis1,:) * tn (nis0:nis1 , jj , :) * tmask(nis0:nis1 , jj , :) 
    335                ufos(nis0:nis1,:) = usmsk(nis0:nis1,:) * un (nis0:nis1 , jj , :) * umask(nis0:nis1 , jj , :) 
    336                vfos(nis0:nis1,:) = vsmsk(nis0:nis1,:) * vn (nis0:nis1 , jj , :) * vmask(nis0:nis1 , jj , :) 
    337             END DO 
    338          ENDIF 
    339          RETURN  ! exit the routine all is done 
    340       ENDIF  ! nobc_dta = 0  
    341  
    342 !!!! In the following OBC data are read from files. 
    343       ! all logical-mask are initialzed to true when declared 
    344       WHERE ( temsk == 0 ) ltemsk=.FALSE.  
    345       WHERE ( uemsk == 0 ) luemsk=.FALSE.  
    346       WHERE ( vemsk == 0 ) lvemsk=.FALSE.  
    347  
    348       WHERE ( twmsk == 0 ) ltwmsk=.FALSE.  
    349       WHERE ( uwmsk == 0 ) luwmsk=.FALSE.  
    350       WHERE ( vwmsk == 0 ) lvwmsk=.FALSE.  
    351  
    352       WHERE ( tnmsk == 0 ) ltnmsk=.FALSE.  
    353       WHERE ( unmsk == 0 ) lunmsk=.FALSE.  
    354       WHERE ( vnmsk == 0 ) lvnmsk=.FALSE.  
    355  
    356       WHERE ( tsmsk == 0 ) ltsmsk=.FALSE.  
    357       WHERE ( usmsk == 0 ) lusmsk=.FALSE.  
    358       WHERE ( vsmsk == 0 ) lvsmsk=.FALSE.  
    359  
    360       iyear=1950;  imonth=01; iday=01;  zsec=0.  
    361       ! zjuliancnes : julian day corresonding  to  01/01/1950 
    362       CALL ymds2ju(iyear, imonth, iday,zsec , zjuliancnes) 
    363  
    364       !current year and curent month  
    365       iyy=INT(ndastp/10000) ; imm=INT((ndastp -iyy*10000)/100) ; idd=(ndastp-iyy*10000-imm*100) 
    366       IF (iyy <  1900)  iyy = iyy+1900  ! always assume that years are on 4 digits. 
    367       CALL ymds2ju(iyy, imm, idd ,zsec , zjulian) 
    368       ndate0_cnes = zjulian - zjuliancnes   ! jcnes day when call to obc_dta_ini 
    369  
    370       iyyfile=iyy ; immfile=0  ! set component of the current file name 
    371       IF ( cffile /= 'annual') immfile=imm 
    372       IF ( ln_obc_clim) iyyfile = 0  ! assume that climatological files are labeled y0000 
    373  
    374       CALL obc_dta_chktime ( iyyfile, immfile ) 
    375  
    376       IF ( itobc == 1 ) THEN  
    377          ! in this case we will provide boundary data only once. 
    378          nt_a=1 ; ntobc_a=1 
    379          CALL obc_read (nit000, nt_a, ntobc_a, iyyfile, immfile)  
    380          IF( lp_obc_east ) THEN 
    381             !  fills sfoe, tfoe, ufoe ,vfoe 
    382             sfoe(:,:) =  sedta (:,:,1) ; tfoe(:,:) =  tedta (:,:,1) 
    383             ufoe(:,:) =  uedta (:,:,1) ; vfoe(:,:) =  vedta (:,:,1) 
    384          ENDIF 
    385  
    386          IF( lp_obc_west) THEN 
    387             !  fills sfow, tfow, ufow ,vfow 
    388             sfow(:,:) =  swdta (:,:,1) ; tfow(:,:) =  twdta (:,:,1) 
    389             ufow(:,:) =  uwdta (:,:,1) ; vfow(:,:) =  vwdta (:,:,1) 
    390          ENDIF 
    391  
    392          IF( lp_obc_north) THEN 
    393             !  fills sfon, tfon, ufon ,vfon 
    394             sfon(:,:) =  sndta (:,:,1) ; tfon(:,:) =  tndta (:,:,1) 
    395             ufon(:,:) =  undta (:,:,1) ; vfon(:,:) =  vndta (:,:,1) 
    396          ENDIF 
    397  
    398          IF( lp_obc_south) THEN 
    399             !  fills sfos, tfos, ufos ,vfos 
    400             sfos(:,:) =  ssdta (:,:,1) ; tfos(:,:) =  tsdta (:,:,1) 
    401             ufos(:,:) =  usdta (:,:,1) ; vfos(:,:) =  vsdta (:,:,1) 
    402          ENDIF 
    403          RETURN  ! we go out of obc_dta_ini -------------------------------------->>>>> 
    404       ENDIF 
    405  
    406       ! nday_year is the day number in the current year ( 1 for 01/01 ) 
    407       ! we suppose that we always start from the begining of a day 
    408       !    zsec=MOD( (kt-nit000)*rdt - (nday_year - nday_year0 )*rday, rday ) ! number of seconds in the current day 
    409       zsec=0.e0  ! here, kt=nit000, nday_year = ndat_year0  
    410  
    411       IF (ln_obc_clim)  THEN  
    412          zjcnes = nday_year - 1  + zsec/rday  ! for clim file time is in days in a year 
    413       ELSE 
    414          zjcnes = ndate0_cnes + (nday_year - nday_year0 ) + zsec/rday 
    415       ENDIF 
    416  
    417       ! look for 'before' record number in the current file 
    418       ntobc = nrecbef () 
    419  
    420       IF (lwp) WRITE(numout,*) 'obc files frequency :',cffile 
    421       IF (lwp) WRITE(numout,*) ' zjcnes0 =',zjcnes,' ndastp0 =',ndastp 
    422       IF (lwp) WRITE(numout,*) ' annee0 ',iyy,' month0 ', imm,' day0 ', idd 
    423       IF (lwp) WRITE(numout,*) 'first file open :',cl_obc_nTS 
    424  
    425       ! record initialisation 
    426       !-------------------- 
    427       nt_b = 1 ; nt_a = 2 
    428  
    429       ntobc_a = ntobc + 1 
    430       ntobc_b = ntobc 
    431  
    432       CALL obc_read (kt, nt_b, ntobc_b, iyyfile, immfile)  ! read 'before' fields 
    433       CALL obc_read (kt, nt_a, ntobc_a, iyyfile, immfile)  ! read 'after' fields 
    434  
    435       ! additional frame in case of time-splitting 
    436 # if defined key_dynspg_ts 
    437       nt_m = 0 
    438       ntobc_m=mod(ntobc_b-2+itobc,itobc)+1 
    439       zjcnes_obc(nt_m)= ztcobc(ntobc_m) ! FDbug has not checked that this is correct!! 
    440       IF (ln_rstart) THEN 
    441          CALL obc_read (kt, nt_m, ntobc_m, iyyfile, immfile)  ! read 'after' fields 
    442       ENDIF 
    443 # endif 
    444  
    445       zjcnes_obc(nt_b)= ztcobc(ntobc_b) 
    446       zjcnes_obc(nt_a)= ztcobc(ntobc_a) 
    447       !  
    448    END SUBROUTINE obc_dta_ini 
    449  
    450  
    451    SUBROUTINE obc_dta_chktime (kyyfile, kmmfile) 
    452       ! 
    453       ! check the number of time steps in the files and read ztcobc  
    454       ! 
    455       ! * Arguments 
    456       INTEGER, INTENT(in) :: kyyfile, kmmfile 
    457       ! * local variables 
    458       INTEGER :: istop       ! error control 
    459       INTEGER :: ji          ! dummy loop index 
    460  
    461       INTEGER ::  idvar, id_e, id_w, id_n, id_s       ! file identifiers 
    462       INTEGER, DIMENSION(1)  :: itmp 
    463       CHARACTER(LEN=25) :: cl_vname 
    464  
    465       ntobc_a = 0; itobce =0 ; itobcw = 0; itobcn = 0; itobcs = 0 
    466       ! build file name 
    467       IF(ln_obc_clim) THEN   ! revert to old convention for climatological OBC forcing 
    468          cl_obc_eTS='obceast_TS.nc' 
    469          cl_obc_wTS='obcwest_TS.nc' 
    470          cl_obc_nTS='obcnorth_TS.nc' 
    471          cl_obc_sTS='obcsouth_TS.nc' 
    472       ELSE                   ! convention for climatological OBC 
    473          WRITE(cl_obc_eTS ,'("obc_east_TS_y",i4.4,"m",i2.2,".nc")'  ) kyyfile,kmmfile 
    474          WRITE(cl_obc_wTS ,'("obc_west_TS_y",i4.4,"m",i2.2,".nc")'  ) kyyfile,kmmfile 
    475          WRITE(cl_obc_nTS ,'("obc_north_TS_y",i4.4,"m",i2.2,".nc")' ) kyyfile,kmmfile 
    476          WRITE(cl_obc_sTS ,'("obc_south_TS_y",i4.4,"m",i2.2,".nc")' ) kyyfile,kmmfile 
    477       ENDIF 
    478  
    479       cl_vname = 'time_counter' 
    480       IF ( lp_obc_east ) THEN 
    481          CALL iom_open ( cl_obc_eTS , id_e ) 
    482          idvar = iom_varid( id_e, cl_vname, kdimsz = itmp ); itobce=itmp(1) 
    483       ENDIF 
    484       IF ( lp_obc_west ) THEN 
    485          CALL iom_open ( cl_obc_wTS , id_w ) 
    486          idvar = iom_varid( id_w, cl_vname, kdimsz = itmp ) ; itobcw=itmp(1) 
    487       ENDIF 
    488       IF ( lp_obc_north ) THEN 
    489          CALL iom_open ( cl_obc_nTS , id_n ) 
    490          idvar = iom_varid( id_n, cl_vname, kdimsz = itmp ) ; itobcn=itmp(1) 
    491       ENDIF 
    492       IF ( lp_obc_south ) THEN 
    493          CALL iom_open ( cl_obc_sTS , id_s ) 
    494          idvar = iom_varid( id_s, cl_vname, kdimsz = itmp ) ; itobcs=itmp(1) 
    495       ENDIF 
    496  
    497       itobc = MAX( itobce, itobcw, itobcn, itobcs ) 
    498       istop = 0 
    499       IF ( lp_obc_east  .AND. itobce /= itobc ) istop = istop+1  
    500       IF ( lp_obc_west  .AND. itobcw /= itobc ) istop = istop+1       
    501       IF ( lp_obc_north .AND. itobcn /= itobc ) istop = istop+1 
    502       IF ( lp_obc_south .AND. itobcs /= itobc ) istop = istop+1  
    503       nstop = nstop + istop 
    504  
    505       IF ( istop /=  0 )  THEN 
    506          WRITE(ctmp1,*) ' east, west, north, south: ', itobce, itobcw, itobcn, itobcs 
    507          CALL ctl_stop( 'obcdta : all files must have the same number of time steps', ctmp1 ) 
    508       ENDIF 
    509  
    510       IF ( itobc == 1 ) THEN  
    511          IF (lwp) THEN 
    512             WRITE(numout,*) ' obcdta found one time step only in the OBC files' 
    513             IF (ln_obc_clim) THEN 
    514                ! OK no problem 
    515             ELSE 
    516                ln_obc_clim=.true. 
    517                WRITE(numout,*) ' we force ln_obc_clim to T' 
    518             ENDIF 
    519          ENDIF 
    520       ELSE 
    521          IF ( ALLOCATED(ztcobc) ) DEALLOCATE ( ztcobc ) 
    522          ALLOCATE (ztcobc(itobc)) 
    523          DO ji=1,1   ! use a dummy loop to read ztcobc only once 
    524             IF ( lp_obc_east ) THEN 
    525                CALL iom_gettime ( id_e, ztcobc, cl_vname ) ; CALL iom_close (id_e) ; EXIT 
    526             ENDIF 
    527             IF ( lp_obc_west ) THEN 
    528                CALL iom_gettime ( id_w, ztcobc, cl_vname ) ; CALL iom_close (id_w) ; EXIT 
    529             ENDIF 
    530             IF ( lp_obc_north ) THEN 
    531                CALL iom_gettime ( id_n, ztcobc, cl_vname ) ; CALL iom_close (id_n) ; EXIT 
    532             ENDIF 
    533             IF ( lp_obc_south ) THEN 
    534                CALL iom_gettime ( id_s, ztcobc, cl_vname ) ; CALL iom_close (id_s) ; EXIT 
    535             ENDIF 
    536          END DO 
    537          rdt_obc = ztcobc(2)-ztcobc(1)  !  just an information, not used for any computation 
    538          IF (lwp) WRITE(numout,*) ' obcdta found', itobc,' time steps in the OBC files' 
    539          IF (lwp) WRITE(numout,*) ' time step of obc data :', rdt_obc,' days'             
    540       ENDIF 
    541       zjcnes = zjcnes - rdt/rday  ! trick : zcnes is always incremented by rdt/rday in obc_dta! 
    542    END SUBROUTINE obc_dta_chktime 
    543  
    544 # if defined key_dynspg_ts || defined key_dynspg_exp 
    545    SUBROUTINE obc_dta_bt( kt, kbt ) 
    546       !!--------------------------------------------------------------------------- 
    547       !!                      ***  SUBROUTINE obc_dta  *** 
    548       !! 
    549       !! ** Purpose :   time interpolation of barotropic data for time-splitting scheme 
    550       !!                Data at the boundary must be in m2/s  
    551       !! 
    552       !! History :  9.0  !  05-11 (V. garnier) Original code 
    553       !!--------------------------------------------------------------------------- 
    554       INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    555       INTEGER, INTENT( in ) ::   kbt         ! barotropic ocean time-step index 
    556       ! 
    557       INTEGER ::   ji, jj  ! dummy loop indices 
    558       INTEGER ::   i15 
    559       INTEGER ::   itobcm, itobcp 
    560       REAL(wp) ::  zxy 
    561       INTEGER ::   isrel           ! number of seconds since 1/1/1992 
    562       !!--------------------------------------------------------------------------- 
    563  
    564       ! 1.   First call: check time frames available in files. 
    565       ! ------------------------------------------------------- 
    566  
    567       IF( kt == nit000 ) THEN 
    568  
    569          ! 1.1  Barotropic tangential velocities set to zero 
    570          ! ------------------------------------------------- 
    571          IF( lp_obc_east  ) vbtfoe(:) = 0.e0 
    572          IF( lp_obc_west  ) vbtfow(:) = 0.e0 
    573          IF( lp_obc_south ) ubtfos(:) = 0.e0 
    574          IF( lp_obc_north ) ubtfon(:) = 0.e0 
    575  
    576          ! 1.2  Sea surface height and normal barotropic velocities set to zero 
    577          !                               or initial conditions if nobc_dta == 0 
    578          ! -------------------------------------------------------------------- 
    579  
    580          IF( lp_obc_east ) THEN 
    581             ! initialisation to zero 
    582             sshedta(:,:) = 0.e0 
    583             ubtedta(:,:) = 0.e0 
    584             vbtedta(:,:) = 0.e0 ! tangential component 
    585             !                                        ! ================== ! 
    586             IF( nobc_dta == 0 )   THEN               ! initial state used ! 
    587                !                                     ! ================== ! 
    588                !  Fills sedta, tedta, uedta (global arrays) 
    589                !  Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 
    590                DO ji = nie0, nie1 
    591                   DO jj = 1, jpj 
    592                      sshedta(jj,1) = sshn(ji+1,jj) * tmask(ji+1,jj,1) 
    593                   END DO 
    594                END DO 
    595             ENDIF 
    596          ENDIF 
    597  
    598          IF( lp_obc_west) THEN 
    599             ! initialisation to zero 
    600             sshwdta(:,:) = 0.e0 
    601             ubtwdta(:,:) = 0.e0 
    602             vbtwdta(:,:) = 0.e0 ! tangential component 
    603             !                                        ! ================== ! 
    604             IF( nobc_dta == 0 )   THEN               ! initial state used ! 
    605                !                                     ! ================== ! 
    606                !  Fills swdta, twdta, uwdta (global arrays) 
    607                !  Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 
    608                DO ji = niw0, niw1 
    609                   DO jj = 1, jpj 
    610                      sshwdta(jj,1) = sshn(ji,jj) * tmask(ji,jj,1) 
    611                   END DO 
    612                END DO 
    613             ENDIF 
    614          ENDIF 
    615  
    616          IF( lp_obc_north) THEN 
    617             ! initialisation to zero 
    618             sshndta(:,:) = 0.e0 
    619             ubtndta(:,:) = 0.e0 ! tangential component 
    620             vbtndta(:,:) = 0.e0 
    621             !                                        ! ================== ! 
    622             IF( nobc_dta == 0 ) THEN                 ! initial state used ! 
    623                !                                     ! ================== ! 
    624                !  Fills sndta, tndta, vndta (global arrays) 
    625                !  Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 
    626                DO jj = njn0, njn1 
    627                   DO ji = 1, jpi 
    628                      sshndta(ji,1) = sshn(ji,jj+1) * tmask(ji,jj+1,1) 
    629                   END DO 
    630                END DO 
    631             ENDIF 
    632          ENDIF 
    633  
    634          IF( lp_obc_south) THEN 
    635             ! initialisation to zero 
    636             sshsdta(:,:) = 0.e0 
    637             ubtsdta(:,:) = 0.e0 ! tangential component 
    638             vbtsdta(:,:) = 0.e0 
    639             !                                        ! ================== ! 
    640             IF( nobc_dta == 0 )   THEN               ! initial state used ! 
    641                !                                     ! ================== ! 
    642                !  Fills ssdta, tsdta, vsdta (global arrays) 
    643                !  Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 
    644                DO jj = njs0, njs1 
    645                   DO ji = 1, jpi 
    646                      sshsdta(ji,1) = sshn(ji,jj) * tmask(ji,jj,1) 
    647                   END DO 
    648                END DO 
    649             ENDIF 
    650          ENDIF 
    651  
    652          IF( nobc_dta == 0 ) CALL obc_depth_average(1)   ! depth averaged velocity from the OBC depth-dependent frames 
    653  
    654       ENDIF        !       END kt == nit000 
    655  
    656       !!------------------------------------------------------------------------------------ 
    657       ! 2.      Initialize the time we are at. Does this every time the routine is called, 
    658       !         excepted when nobc_dta = 0 
    659       ! 
    660  
    661       ! 3.  Call at every time step : Linear interpolation of BCs to current time step 
    662       ! ---------------------------------------------------------------------- 
    663  
    664       IF( lk_dynspg_ts ) THEN 
    665          isrel = (kt-1)*rdt + kbt*(rdt/REAL(nn_baro,wp)) 
    666       ELSE IF( lk_dynspg_exp ) THEN 
    667          isrel=kt*rdt 
    668       ENDIF 
    669  
    670       itobcm = nt_b 
    671       itobcp = nt_a 
    672       IF( itobc == 1 .OR. nobc_dta == 0 ) THEN 
    673          zxy = 0.e0 
    674          itobcm = 1 
    675          itobcp = 1 
    676       ELSE IF( itobc == 12 ) THEN 
    677          i15   = nday / 16 
    678          zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 
    679       ELSE 
    680          zxy = (zjcnes_obc(nt_a)-FLOAT(isrel)) / (zjcnes_obc(nt_a)-zjcnes_obc(nt_b)) 
    681          IF( zxy < 0. ) THEN   ! case of extrapolation, switch to old time frames 
    682             itobcm = nt_m 
    683             itobcp = nt_b 
    684             zxy = (zjcnes_obc(nt_b)-FLOAT(isrel)) / (zjcnes_obc(nt_b)-zjcnes_obc(nt_m)) 
    685          ENDIF 
    686       ENDIF 
    687  
    688       IF( lp_obc_east ) THEN           !  fills sshfoe, ubtfoe (local to each processor) 
    689          DO jj = 1, jpj 
    690             sshfoe(jj) = zxy * sshedta(jj,itobcp) + (1.-zxy) * sshedta(jj,itobcm) 
    691             ubtfoe(jj) = zxy * ubtedta(jj,itobcp) + (1.-zxy) * ubtedta(jj,itobcm) 
    692             vbtfoe(jj) = zxy * vbtedta(jj,itobcp) + (1.-zxy) * vbtedta(jj,itobcm) 
    693          END DO 
    694       ENDIF 
    695  
    696       IF( lp_obc_west) THEN            !  fills sshfow, ubtfow (local to each processor) 
    697          DO jj = 1, jpj 
    698             sshfow(jj) = zxy * sshwdta(jj,itobcp) + (1.-zxy) * sshwdta(jj,itobcm) 
    699             ubtfow(jj) = zxy * ubtwdta(jj,itobcp) + (1.-zxy) * ubtwdta(jj,itobcm) 
    700             vbtfow(jj) = zxy * vbtwdta(jj,itobcp) + (1.-zxy) * vbtwdta(jj,itobcm) 
    701          END DO 
    702       ENDIF 
    703  
    704       IF( lp_obc_north) THEN           !  fills sshfon, vbtfon (local to each processor) 
    705          DO ji = 1, jpi 
    706             sshfon(ji) = zxy * sshndta(ji,itobcp) + (1.-zxy) * sshndta(ji,itobcm) 
    707             ubtfon(ji) = zxy * ubtndta(ji,itobcp) + (1.-zxy) * ubtndta(ji,itobcm) 
    708             vbtfon(ji) = zxy * vbtndta(ji,itobcp) + (1.-zxy) * vbtndta(ji,itobcm) 
    709          END DO 
    710       ENDIF 
    711  
    712       IF( lp_obc_south) THEN           !  fills sshfos, vbtfos (local to each processor) 
    713          DO ji = 1, jpi 
    714             sshfos(ji) = zxy * sshsdta(ji,itobcp) + (1.-zxy) * sshsdta(ji,itobcm) 
    715             ubtfos(ji) = zxy * ubtsdta(ji,itobcp) + (1.-zxy) * ubtsdta(ji,itobcm) 
    716             vbtfos(ji) = zxy * vbtsdta(ji,itobcp) + (1.-zxy) * vbtsdta(ji,itobcm) 
    717          END DO 
    718       ENDIF 
    719  
    720    END SUBROUTINE obc_dta_bt 
    721  
    722 # else 
    723    !!----------------------------------------------------------------------------- 
    724    !!   Default option 
    725    !!----------------------------------------------------------------------------- 
    726    SUBROUTINE obc_dta_bt ( kt, kbt )       ! Empty routine 
    727       !! * Arguments 
    728       INTEGER,INTENT(in) :: kt 
    729       INTEGER, INTENT( in ) ::   kbt         ! barotropic ocean time-step index 
    730       WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kt 
    731       WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kbt 
    732    END SUBROUTINE obc_dta_bt 
    733 # endif 
    734  
    735    SUBROUTINE obc_read (kt, nt_x, ntobc_x, iyy, imm) 
    736       !!------------------------------------------------------------------------- 
    737       !!                      ***  ROUTINE obc_read  *** 
    738       !! 
    739       !! ** Purpose :  Read the boundary data in files identified by iyy and imm 
    740       !!               According to the validated open boundaries, return the  
    741       !!               following arrays : 
    742       !!                sedta, tedta : East OBC salinity and temperature 
    743       !!                uedta, vedta :   "   "  u and v velocity component       
    744       !! 
    745       !!                swdta, twdta : West OBC salinity and temperature 
    746       !!                uwdta, vwdta :   "   "  u and v velocity component       
    747       !! 
    748       !!                sndta, tndta : North OBC salinity and temperature 
    749       !!                undta, vndta :   "   "  u and v velocity component       
    750       !! 
    751       !!                ssdta, tsdta : South OBC salinity and temperature 
    752       !!                usdta, vsdta :   "   "  u and v velocity component       
    753       !! 
    754       !! ** Method  :  These fields are read in the record ntobc_x of the files. 
    755       !!               The number of records is already known. If  ntobc_x is greater 
    756       !!               than the number of record, this routine will look for next file, 
    757       !!               updating the indices (case of inter-annual obcs) or loop at the 
    758       !!               begining in case of climatological file (ln_obc_clim = true ). 
    759       !! ------------------------------------------------------------------------- 
    760       !! History:     !  2005  ( P. Mathiot, C. Langlais ) Original code 
    761       !!              !  2008  ( J,M, Molines ) Use IOM and cleaning 
    762       !!-------------------------------------------------------------------------- 
    763  
    764       ! * Arguments 
    765       INTEGER, INTENT( in ) :: kt, nt_x 
    766       INTEGER, INTENT( inout ) :: ntobc_x , iyy, imm      ! yes ! inout ! 
    767  
    768       ! * Local variables 
    769       CHARACTER (len=40) :: &    ! file names 
    770          cl_obc_eTS   , cl_obc_eU,  cl_obc_eV,& 
    771          cl_obc_wTS   , cl_obc_wU,  cl_obc_wV,& 
    772          cl_obc_nTS   , cl_obc_nU,  cl_obc_nV,& 
    773          cl_obc_sTS   , cl_obc_sU,  cl_obc_sV 
    774  
    775       INTEGER :: ikprint 
    776       REAL(wp) :: zmin, zmax   ! control of boundary values 
    777  
    778       !IOM stuff 
    779       INTEGER :: id_e, id_w, id_n, id_s 
    780       INTEGER, DIMENSION(2) :: istart, icount 
    781  
    782       !-------------------------------------------------------------------------- 
    783       IF ( ntobc_x > itobc ) THEN 
    784          IF (ln_obc_clim) THEN  ! just loop on the same file 
    785             ntobc_x = 1  
    786          ELSE 
    787             ! need to change file : it is always for an 'after' data 
    788             IF ( cffile == 'annual' ) THEN ! go to next year file 
    789                iyy = iyy + 1 
    790             ELSE IF ( cffile =='monthly' ) THEN  ! go to next month file 
    791                imm = imm + 1  
    792                IF ( imm == 13 ) THEN  
    793                   imm = 1 ; iyy = iyy + 1 
    794                ENDIF 
    795             ELSE 
    796                ctmp1='obcread : this type of obc file is not supported :( ' 
    797                ctmp2=TRIM(cffile) 
    798                CALL ctl_stop (ctmp1, ctmp2) 
    799                ! cffile should be either annual or monthly ... 
    800             ENDIF 
    801             ! as the file is changed, need to update itobc etc ... 
    802             CALL obc_dta_chktime (iyy,imm) 
    803             ntobc_x = nrecbef() + 1 ! remember : this case occur for an after data 
    804          ENDIF 
    805       ENDIF 
    806  
    807       IF( lp_obc_east ) THEN  
    808          ! ... Read datafile and set temperature, salinity and normal velocity 
    809          ! ... initialise the sedta, tedta, uedta arrays 
    810          IF(ln_obc_clim) THEN  ! revert to old convention for climatological OBC forcing 
    811             cl_obc_eTS='obceast_TS.nc' 
    812             cl_obc_eU ='obceast_U.nc' 
    813             cl_obc_eV ='obceast_V.nc' 
    814          ELSE                  ! convention for climatological OBC 
    815             WRITE(cl_obc_eTS ,'("obc_east_TS_y"  ,i4.4,"m",i2.2,".nc")' ) iyy,imm 
    816             WRITE(cl_obc_eU  ,'("obc_east_U_y"   ,i4.4,"m",i2.2,".nc")' ) iyy,imm 
    817             WRITE(cl_obc_eV  ,'("obc_east_V_y"   ,i4.4,"m",i2.2,".nc")' ) iyy,imm 
    818          ENDIF 
    819          ! JMM this may change depending on the obc data format ... 
    820          istart(:)=(/nje0+njmpp-1,1/) ; icount(:)=(/nje1-nje0 +1,jpk/) 
    821          IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_eTS) 
    822          IF (nje1 >= nje0 ) THEN 
    823             CALL iom_open ( cl_obc_eTS , id_e ) 
    824             CALL iom_get ( id_e, jpdom_unknown, 'votemper', tedta(nje0:nje1,:,nt_x), & 
    825                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    826             CALL iom_get ( id_e, jpdom_unknown, 'vosaline', sedta(nje0:nje1,:,nt_x), & 
    827                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    828 # if defined key_dynspg_ts || defined key_dynspg_exp 
    829             CALL iom_get ( id_e, jpdom_unknown, 'vossurfh', sshedta(nje0:nje1,nt_x), & 
    830                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    831 # endif 
    832             CALL iom_close (id_e) 
    833             ! 
    834             CALL iom_open ( cl_obc_eU , id_e ) 
    835             CALL iom_get  ( id_e, jpdom_unknown, 'vozocrtx', uedta(nje0:nje1,:,nt_x), & 
    836                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    837             CALL iom_close ( id_e ) 
    838             ! 
    839             CALL iom_open ( cl_obc_eV , id_e ) 
    840             CALL iom_get ( id_e, jpdom_unknown, 'vomecrty', vedta(nje0:nje1,:,nt_x), & 
    841                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    842             CALL iom_close ( id_e ) 
    843  
    844             ! mask the boundary values 
    845             tedta(:,:,nt_x) = tedta(:,:,nt_x)*temsk(:,:) ;  sedta(:,:,nt_x) = sedta(:,:,nt_x)*temsk(:,:) 
    846             uedta(:,:,nt_x) = uedta(:,:,nt_x)*uemsk(:,:) ;  vedta(:,:,nt_x) = vedta(:,:,nt_x)*vemsk(:,:) 
    847  
    848             ! check any outliers  
    849             zmin=MINVAL( sedta(:,:,nt_x), mask=ltemsk ) ; zmax=MAXVAL(sedta(:,:,nt_x), mask=ltemsk) 
    850             IF (  zmin < 5 .OR. zmax > 50)   THEN 
    851                CALL ctl_stop('Error in sedta',' routine obcdta') 
    852             ENDIF 
    853             zmin=MINVAL( tedta(:,:,nt_x), mask=ltemsk ) ; zmax=MAXVAL(tedta(:,:,nt_x), mask=ltemsk) 
    854             IF (  zmin < -10. .OR. zmax > 40)   THEN 
    855                CALL ctl_stop('Error in tedta',' routine obcdta') 
    856             ENDIF 
    857             zmin=MINVAL( uedta(:,:,nt_x), mask=luemsk ) ; zmax=MAXVAL(uedta(:,:,nt_x), mask=luemsk) 
    858             IF (  zmin < -5. .OR. zmax > 5.)   THEN 
    859                CALL ctl_stop('Error in uedta',' routine obcdta') 
    860             ENDIF 
    861             zmin=MINVAL( vedta(:,:,nt_x), mask=lvemsk ) ; zmax=MAXVAL(vedta(:,:,nt_x), mask=lvemsk) 
    862             IF (  zmin < -5. .OR. zmax > 5.)   THEN 
    863                CALL ctl_stop('Error in vedta',' routine obcdta') 
    864             ENDIF 
    865  
    866             !               Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1       
    867             IF ( lwp .AND.  ( kt == nit000 .OR. nprint /= 0 )  ) THEN 
    868                WRITE(numout,*) 
    869                WRITE(numout,*) ' Read East OBC data records ', ntobc_x 
    870                ikprint = jpj/20 +1 
    871                WRITE(numout,*) ' Temperature  record 1 - printout every 3 level' 
    872                CALL prihre( tedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 
    873                WRITE(numout,*) 
    874                WRITE(numout,*) ' Salinity  record 1 - printout every 3 level' 
    875                CALL prihre( sedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 
    876                WRITE(numout,*) 
    877                WRITE(numout,*) ' Normal velocity U  record 1  - printout every 3 level' 
    878                CALL prihre( uedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 
    879                WRITE(numout,*) 
    880                WRITE(numout,*) ' Tangential velocity V  record 1  - printout every 3 level' 
    881                CALL prihre( vedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 
    882             ENDIF 
    883          ENDIF 
    884       ENDIF 
    885 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    886       IF ( lp_obc_west ) THEN 
    887          ! ... Read datafile and set temperature, salinity and normal velocity 
    888          ! ... initialise the swdta, twdta, uwdta arrays 
    889          IF (ln_obc_clim) THEN   ! revert to old convention for climatological OBC forcing 
    890             cl_obc_wTS='obcwest_TS.nc' 
    891             cl_obc_wU ='obcwest_U.nc' 
    892             cl_obc_wV ='obcwest_V.nc' 
    893          ELSE                    ! convention for climatological OBC 
    894             WRITE(cl_obc_wTS ,'("obc_west_TS_y"  ,i4.4,"m",i2.2,".nc")' ) iyy,imm 
    895             WRITE(cl_obc_wU  ,'("obc_west_U_y"   ,i4.4,"m",i2.2,".nc")' ) iyy,imm 
    896             WRITE(cl_obc_wV  ,'("obc_west_V_y"   ,i4.4,"m",i2.2,".nc")' ) iyy,imm 
    897          ENDIF 
    898          istart(:)=(/njw0+njmpp-1,1/) ; icount(:)=(/njw1-njw0 +1,jpk/) 
    899          IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_wTS) 
    900  
    901          IF ( njw1 >= njw0 ) THEN 
    902             CALL iom_open ( cl_obc_wTS , id_w ) 
    903             CALL iom_get ( id_w, jpdom_unknown, 'votemper', twdta(njw0:njw1,:,nt_x), &  
    904                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    905  
    906             CALL iom_get ( id_w, jpdom_unknown, 'vosaline', swdta(njw0:njw1,:,nt_x), & 
    907                &               ktime=ntobc_x , kstart=istart, kcount= icount) 
    908 # if defined key_dynspg_ts || defined key_dynspg_exp 
    909             CALL iom_get ( id_w, jpdom_unknown, 'vossurfh', sshwdta(njw0:njw1,nt_x), & 
    910                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    911 # endif 
    912             CALL iom_close (id_w) 
    913             ! 
    914             CALL iom_open ( cl_obc_wU , id_w ) 
    915             CALL iom_get  ( id_w, jpdom_unknown, 'vozocrtx', uwdta(njw0:njw1,:,nt_x),& 
    916                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    917             CALL iom_close ( id_w ) 
    918             ! 
    919             CALL iom_open ( cl_obc_wV , id_w ) 
    920             CALL iom_get ( id_w, jpdom_unknown, 'vomecrty', vwdta(njw0:njw1,:,nt_x), & 
    921                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    922             CALL iom_close ( id_w ) 
    923  
    924             ! mask the boundary values 
    925             twdta(:,:,nt_x) = twdta(:,:,nt_x)*twmsk(:,:) ;  swdta(:,:,nt_x) = swdta(:,:,nt_x)*twmsk(:,:) 
    926             uwdta(:,:,nt_x) = uwdta(:,:,nt_x)*uwmsk(:,:) ;  vwdta(:,:,nt_x) = vwdta(:,:,nt_x)*vwmsk(:,:) 
    927  
    928             ! check any outliers 
    929             zmin=MINVAL( swdta(:,:,nt_x), mask=ltwmsk ) ; zmax=MAXVAL(swdta(:,:,nt_x), mask=ltwmsk) 
    930             IF (  zmin < 5 .OR. zmax > 50)   THEN 
    931                CALL ctl_stop('Error in swdta',' routine obcdta') 
    932             ENDIF 
    933             zmin=MINVAL( twdta(:,:,nt_x), mask=ltwmsk ) ; zmax=MAXVAL(twdta(:,:,nt_x), mask=ltwmsk) 
    934             IF (  zmin < -10. .OR. zmax > 40)   THEN 
    935                CALL ctl_stop('Error in twdta',' routine obcdta') 
    936             ENDIF 
    937             zmin=MINVAL( uwdta(:,:,nt_x), mask=luwmsk ) ; zmax=MAXVAL(uwdta(:,:,nt_x), mask=luwmsk) 
    938             IF (  zmin < -5. .OR. zmax > 5.)   THEN 
    939                CALL ctl_stop('Error in uwdta',' routine obcdta') 
    940             ENDIF 
    941             zmin=MINVAL( vwdta(:,:,nt_x), mask=lvwmsk ) ; zmax=MAXVAL(vwdta(:,:,nt_x), mask=lvwmsk) 
    942             IF (  zmin < -5. .OR. zmax > 5.)   THEN 
    943                CALL ctl_stop('Error in vwdta',' routine obcdta') 
    944             ENDIF 
    945  
    946  
    947             IF ( lwp .AND.  ( kt == nit000 .OR. nprint /= 0 )  ) THEN 
    948                WRITE(numout,*) 
    949                WRITE(numout,*) ' Read West OBC data records ', ntobc_x 
    950                ikprint = jpj/20 +1 
    951                WRITE(numout,*) ' Temperature  record 1 - printout every 3 level' 
    952                CALL prihre( twdta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 
    953                WRITE(numout,*) 
    954                WRITE(numout,*) ' Salinity  record 1 - printout every 3 level' 
    955                CALL prihre( swdta(:,:,nt_x),jpj,jpk, 1, jpj, ikprint,   jpk, 1, -3, 1., numout ) 
    956                WRITE(numout,*) 
    957                WRITE(numout,*) ' Normal velocity U  record 1  - printout every 3 level' 
    958                CALL prihre( uwdta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 
    959                WRITE(numout,*) 
    960                WRITE(numout,*) ' Tangential velocity V  record 1  - printout every 3 level' 
    961                CALL prihre( vwdta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 
    962             ENDIF 
    963          END IF 
    964       ENDIF 
    965 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    966       IF( lp_obc_north) THEN 
    967          IF(ln_obc_clim) THEN   ! revert to old convention for climatological OBC forcing 
    968             cl_obc_nTS='obcnorth_TS.nc' 
    969             cl_obc_nU ='obcnorth_U.nc' 
    970             cl_obc_nV ='obcnorth_V.nc' 
    971          ELSE                   ! convention for climatological OBC 
    972             WRITE(cl_obc_nTS ,'("obc_north_TS_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 
    973             WRITE(cl_obc_nV  ,'("obc_north_V_y"  ,i4.4,"m",i2.2,".nc")' ) iyy,imm 
    974             WRITE(cl_obc_nU  ,'("obc_north_U_y"  ,i4.4,"m",i2.2,".nc")' ) iyy,imm 
    975          ENDIF 
    976          istart(:)=(/nin0+nimpp-1,1/) ; icount(:)=(/nin1-nin0 +1,jpk/) 
    977          IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_nTS) 
    978          IF ( nin1 >= nin0 ) THEN 
    979             CALL iom_open ( cl_obc_nTS , id_n ) 
    980             CALL iom_get ( id_n, jpdom_unknown, 'votemper', tndta(nin0:nin1,:,nt_x), & 
    981                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    982             CALL iom_get ( id_n, jpdom_unknown, 'vosaline', sndta(nin0:nin1,:,nt_x), & 
    983                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    984 # if defined key_dynspg_ts || defined key_dynspg_exp 
    985             CALL iom_get ( id_n, jpdom_unknown, 'vossurfh', sshndta(nin0:nin1,nt_x), & 
    986                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    987 # endif 
    988             CALL iom_close (id_n) 
    989             ! 
    990             CALL iom_open ( cl_obc_nU , id_n ) 
    991             CALL iom_get  ( id_n, jpdom_unknown, 'vozocrtx', undta(nin0:nin1,:,nt_x), & 
    992                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    993             CALL iom_close ( id_n ) 
    994             ! 
    995             CALL iom_open ( cl_obc_nV , id_n ) 
    996             CALL iom_get  ( id_n, jpdom_unknown, 'vomecrty', vndta(nin0:nin1,:,nt_x), & 
    997                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    998             CALL iom_close ( id_n ) 
    999  
    1000             ! mask the boundary values 
    1001             tndta(:,:,nt_x) = tndta(:,:,nt_x)*tnmsk(:,:) ;  sndta(:,:,nt_x) = sndta(:,:,nt_x)*tnmsk(:,:) 
    1002             undta(:,:,nt_x) = undta(:,:,nt_x)*unmsk(:,:) ;  vndta(:,:,nt_x) = vndta(:,:,nt_x)*vnmsk(:,:) 
    1003  
    1004             ! check any outliers 
    1005             zmin=MINVAL( sndta(:,:,nt_x), mask=ltnmsk ) ; zmax=MAXVAL(sndta(:,:,nt_x), mask=ltnmsk) 
    1006             IF (  zmin < 5 .OR. zmax > 50)   THEN 
    1007                CALL ctl_stop('Error in sndta',' routine obcdta') 
    1008             ENDIF 
    1009             zmin=MINVAL( tndta(:,:,nt_x), mask=ltnmsk ) ; zmax=MAXVAL(tndta(:,:,nt_x), mask=ltnmsk) 
    1010             IF (  zmin < -10. .OR. zmax > 40)   THEN 
    1011                CALL ctl_stop('Error in tndta',' routine obcdta') 
    1012             ENDIF 
    1013             zmin=MINVAL( undta(:,:,nt_x), mask=lunmsk ) ; zmax=MAXVAL(undta(:,:,nt_x), mask=lunmsk) 
    1014             IF (  zmin < -5. .OR. zmax > 5.)   THEN 
    1015                CALL ctl_stop('Error in undta',' routine obcdta') 
    1016             ENDIF 
    1017             zmin=MINVAL( vndta(:,:,nt_x), mask=lvnmsk ) ; zmax=MAXVAL(vndta(:,:,nt_x), mask=lvnmsk) 
    1018             IF (  zmin < -5. .OR. zmax > 5.)   THEN 
    1019                CALL ctl_stop('Error in vndta',' routine obcdta') 
    1020             ENDIF 
    1021  
    1022             IF ( lwp .AND.  ( kt == nit000 .OR. nprint /= 0 )  ) THEN 
    1023                WRITE(numout,*) 
    1024                WRITE(numout,*) ' Read North OBC data records ', ntobc_x 
    1025                ikprint = jpi/20 +1 
    1026                WRITE(numout,*) ' Temperature  record 1 - printout every 3 level' 
    1027                CALL prihre( tndta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 
    1028                WRITE(numout,*) 
    1029                WRITE(numout,*) ' Salinity  record 1 - printout every 3 level' 
    1030                CALL prihre( sndta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 
    1031                WRITE(numout,*) 
    1032                WRITE(numout,*) ' Normal velocity V  record 1  - printout every 3 level' 
    1033                CALL prihre( vndta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 
    1034                WRITE(numout,*) 
    1035                WRITE(numout,*) ' Tangential  velocity U  record 1  - printout every 3 level' 
    1036                CALL prihre( undta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 
    1037             ENDIF 
    1038          ENDIF 
    1039       ENDIF 
    1040 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    1041       IF( lp_obc_south) THEN  
    1042          IF(ln_obc_clim) THEN   ! revert to old convention for climatological OBC forcing 
    1043             cl_obc_sTS='obcsouth_TS.nc' 
    1044             cl_obc_sU ='obcsouth_U.nc' 
    1045             cl_obc_sV ='obcsouth_V.nc' 
    1046          ELSE                    ! convention for climatological OBC 
    1047             WRITE(cl_obc_sTS ,'("obc_south_TS_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 
    1048             WRITE(cl_obc_sV  ,'("obc_south_V_y"  ,i4.4,"m",i2.2,".nc")' ) iyy,imm 
    1049             WRITE(cl_obc_sU  ,'("obc_south_U_y"  ,i4.4,"m",i2.2,".nc")' ) iyy,imm 
    1050          ENDIF 
    1051          istart(:)=(/nis0+nimpp-1,1/) ; icount(:)=(/nis1-nis0 +1,jpk/) 
    1052          IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_sTS) 
    1053          IF ( nis1 >= nis0 ) THEN  
    1054             CALL iom_open ( cl_obc_sTS , id_s ) 
    1055             CALL iom_get ( id_s, jpdom_unknown, 'votemper', tsdta(nis0:nis1,:,nt_x), & 
    1056                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    1057             CALL iom_get ( id_s, jpdom_unknown, 'vosaline', ssdta(nis0:nis1,:,nt_x), & 
    1058                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    1059 # if defined key_dynspg_ts || defined key_dynspg_exp 
    1060             CALL iom_get ( id_s, jpdom_unknown, 'vossurfh', sshsdta(nis0:nis1,nt_x), & 
    1061                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    1062 # endif 
    1063             CALL iom_close (id_s) 
    1064             ! 
    1065             CALL iom_open ( cl_obc_sU , id_s ) 
    1066             CALL iom_get  ( id_s, jpdom_unknown, 'vozocrtx', usdta(nis0:nis1,:,nt_x), & 
    1067                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    1068             CALL iom_close ( id_s ) 
    1069             ! 
    1070             CALL iom_open ( cl_obc_sV , id_s ) 
    1071             CALL iom_get  ( id_s, jpdom_unknown, 'vomecrty', vsdta(nis0:nis1,:,nt_x), & 
    1072                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    1073             CALL iom_close ( id_s ) 
    1074  
    1075             ! mask the boundary values 
    1076             tsdta(:,:,nt_x) = tsdta(:,:,nt_x)*tsmsk(:,:) ;  ssdta(:,:,nt_x) = ssdta(:,:,nt_x)*tsmsk(:,:) 
    1077             usdta(:,:,nt_x) = usdta(:,:,nt_x)*usmsk(:,:) ;  vsdta(:,:,nt_x) = vsdta(:,:,nt_x)*vsmsk(:,:) 
    1078  
    1079             ! check any outliers 
    1080             zmin=MINVAL( ssdta(:,:,nt_x), mask=ltsmsk ) ; zmax=MAXVAL(ssdta(:,:,nt_x), mask=ltsmsk) 
    1081             IF (  zmin < 5 .OR. zmax > 50)   THEN 
    1082                CALL ctl_stop('Error in ssdta',' routine obcdta') 
    1083             ENDIF 
    1084             zmin=MINVAL( tsdta(:,:,nt_x), mask=ltsmsk ) ; zmax=MAXVAL(tsdta(:,:,nt_x), mask=ltsmsk) 
    1085             IF (  zmin < -10. .OR. zmax > 40)   THEN 
    1086                CALL ctl_stop('Error in tsdta',' routine obcdta') 
    1087             ENDIF 
    1088             zmin=MINVAL( usdta(:,:,nt_x), mask=lusmsk ) ; zmax=MAXVAL(usdta(:,:,nt_x), mask=lusmsk) 
    1089             IF (  zmin < -5. .OR. zmax > 5.)   THEN 
    1090                CALL ctl_stop('Error in usdta',' routine obcdta') 
    1091             ENDIF 
    1092             zmin=MINVAL( vsdta(:,:,nt_x), mask=lvsmsk ) ; zmax=MAXVAL(vsdta(:,:,nt_x), mask=lvsmsk) 
    1093             IF (  zmin < -5. .OR. zmax > 5.)   THEN 
    1094                CALL ctl_stop('Error in vsdta',' routine obcdta') 
    1095             ENDIF 
    1096  
    1097             IF ( lwp .AND.  ( kt == nit000 .OR. nprint /= 0 )  ) THEN 
    1098                WRITE(numout,*) 
    1099                WRITE(numout,*) ' Read South OBC data records ', ntobc_x 
    1100                ikprint = jpi/20 +1 
    1101                WRITE(numout,*) ' Temperature  record 1 - printout every 3 level' 
    1102                CALL prihre( tsdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 
    1103                WRITE(numout,*) 
    1104                WRITE(numout,*) ' Salinity  record 1 - printout every 3 level' 
    1105                CALL prihre( ssdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 
    1106                WRITE(numout,*) 
    1107                WRITE(numout,*) ' Normal velocity V  record 1  - printout every 3 level' 
    1108                CALL prihre( vsdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 
    1109                WRITE(numout,*) 
    1110                WRITE(numout,*) ' Tangential velocity U  record 1  - printout every 3 level' 
    1111                CALL prihre( usdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 
    1112             ENDIF 
    1113          ENDIF 
    1114       ENDIF 
    1115  
    1116 # if defined key_dynspg_ts || defined key_dynspg_exp 
    1117       CALL obc_depth_average(nt_x)   ! computation of depth-averaged velocity 
    1118 # endif 
    1119  
    1120 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    1121    END SUBROUTINE obc_read 
    1122  
    1123  
    1124    INTEGER FUNCTION nrecbef() 
    1125       !!----------------------------------------------------------------------- 
    1126       !!                     ***    FUNCTION nrecbef   *** 
    1127       !! 
    1128       !!  Purpose : - provide the before record number in files, with respect to zjcnes 
    1129       !! 
    1130       !!    History : 2008-04 : ( J.M. Molines ) Original code 
    1131       !!----------------------------------------------------------------------- 
    1132  
    1133       INTEGER :: it , idum 
    1134  
    1135       idum = itobc 
    1136       DO it =1, itobc 
    1137          IF ( ztcobc(it) > zjcnes ) THEN ;  idum = it - 1 ; EXIT ;  ENDIF 
    1138          ENDDO 
    1139          ! idum can be 0 (climato, before first record) 
    1140          IF ( idum == 0 ) THEN 
    1141             IF ( ln_obc_clim ) THEN 
    1142                idum = itobc 
    1143             ELSE 
    1144                ctmp1='obc_dta: find ntobc == 0 for  non climatological file ' 
    1145                ctmp2='consider adding a first record in your data file ' 
    1146                CALL ctl_stop(ctmp1, ctmp2) 
    1147             ENDIF 
    1148          ENDIF 
    1149          ! idum can be itobc ( zjcnes > ztcobc (itobc) ) 
    1150          !  This is not a problem ... 
    1151          nrecbef = idum 
    1152  
    1153       END FUNCTION nrecbef 
    1154  
    1155  
    1156       SUBROUTINE obc_depth_average(nt_x) 
    1157          !!----------------------------------------------------------------------- 
    1158          !!                     ***    ROUTINE obc_depth_average   *** 
    1159          !! 
    1160          !!  Purpose : - compute the depth-averaged velocity from depth-dependent OBC frames 
    1161          !! 
    1162          !!    History : 2009-01 : ( Fred Dupont ) Original code 
    1163          !!----------------------------------------------------------------------- 
    1164  
    1165          ! * Arguments 
    1166          INTEGER, INTENT( in ) :: nt_x 
    1167  
    1168          ! * Local variables 
    1169          INTEGER :: ji, jj, jk 
    1170  
    1171  
    1172          IF( lp_obc_east ) THEN 
    1173             ! initialisation to zero 
    1174             ubtedta(:,nt_x) = 0.e0 
    1175             vbtedta(:,nt_x) = 0.e0 
    1176             DO ji = nie0, nie1 
    1177                DO jj = 1, jpj 
    1178                   DO jk = 1, jpkm1 
    1179                      ubtedta(jj,nt_x) = ubtedta(jj,nt_x) + uedta(jj,jk,nt_x)*fse3u(ji,jj,jk) 
    1180                      vbtedta(jj,nt_x) = vbtedta(jj,nt_x) + vedta(jj,jk,nt_x)*fse3v(ji+1,jj,jk) 
    1181                   END DO 
    1182                END DO 
    1183             END DO 
    1184          ENDIF 
    1185  
    1186          IF( lp_obc_west) THEN 
    1187             ! initialisation to zero 
    1188             ubtwdta(:,nt_x) = 0.e0 
    1189             vbtwdta(:,nt_x) = 0.e0 
    1190             DO ji = niw0, niw1 
    1191                DO jj = 1, jpj 
    1192                   DO jk = 1, jpkm1 
    1193                      ubtwdta(jj,nt_x) = ubtwdta(jj,nt_x) + uwdta(jj,jk,nt_x)*fse3u(ji,jj,jk) 
    1194                      vbtwdta(jj,nt_x) = vbtwdta(jj,nt_x) + vwdta(jj,jk,nt_x)*fse3v(ji,jj,jk) 
    1195                   END DO 
    1196                END DO 
    1197             END DO 
    1198          ENDIF 
    1199  
    1200          IF( lp_obc_north) THEN 
    1201             ! initialisation to zero 
    1202             ubtndta(:,nt_x) = 0.e0 
    1203             vbtndta(:,nt_x) = 0.e0 
    1204             DO jj = njn0, njn1 
    1205                DO ji = 1, jpi 
    1206                   DO jk = 1, jpkm1 
    1207                      ubtndta(ji,nt_x) = ubtndta(ji,nt_x) + undta(ji,jk,nt_x)*fse3u(ji,jj+1,jk) 
    1208                      vbtndta(ji,nt_x) = vbtndta(ji,nt_x) + vndta(ji,jk,nt_x)*fse3v(ji,jj,jk) 
    1209                   END DO 
    1210                END DO 
    1211             END DO 
    1212          ENDIF 
    1213  
    1214          IF( lp_obc_south) THEN 
    1215             ! initialisation to zero 
    1216             ubtsdta(:,nt_x) = 0.e0 
    1217             vbtsdta(:,nt_x) = 0.e0 
    1218             DO jj = njs0, njs1 
    1219                DO ji = nis0, nis1 
    1220                   DO jk = 1, jpkm1 
    1221                      ubtsdta(ji,nt_x) = ubtsdta(ji,nt_x) + usdta(ji,jk,nt_x)*fse3u(ji,jj,jk) 
    1222                      vbtsdta(ji,nt_x) = vbtsdta(ji,nt_x) + vsdta(ji,jk,nt_x)*fse3v(ji,jj,jk) 
    1223                   END DO 
    1224                END DO 
    1225             END DO 
    1226          ENDIF 
    1227  
    1228       END SUBROUTINE obc_depth_average 
    1229  
    1230 #else 
    1231       !!------------------------------------------------------------------------------ 
    1232       !!   default option:           Dummy module          NO Open Boundary Conditions 
    1233       !!------------------------------------------------------------------------------ 
    1234    CONTAINS 
    1235       SUBROUTINE obc_dta( kt )             ! Dummy routine 
    1236          INTEGER, INTENT (in) :: kt 
    1237          WRITE(*,*) 'obc_dta: You should not have seen this print! error?', kt 
    1238       END SUBROUTINE obc_dta 
    1239 #endif 
     482   SUBROUTINE obc_dta_init()                  ! Empty routine 
     483      WRITE(*,*) 'obc_dta_init: You should not have seen this print! error?' 
     484   END SUBROUTINE obc_dta_init 
     485#endif 
     486 
    1240487   !!============================================================================== 
    1241    END MODULE obcdta 
     488END MODULE obcdta 
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/OBC/obcini.F90

    r2715 r2797  
    1  MODULE obcini 
     1MODULE obcini 
    22   !!====================================================================== 
    33   !!                       ***  MODULE  obcini  *** 
    4    !! OBC initial state :  Open boundary initial state 
     4   !! Unstructured open boundaries : initialisation 
    55   !!====================================================================== 
    6    !! History :  8.0  !  97-07  (J.M. Molines, G. Madec)  Original code 
    7    !!   NEMO     1.0  !  02-11  (C. Talandier, A-M. Treguier) Free surface, F90 
    8    !!            2.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
     6   !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code 
     7   !!             -   !  2007-01  (D. Storkey) Update to use IOM module 
     8   !!             -   !  2007-01  (D. Storkey) Tidal forcing 
     9   !!            3.0  !  2008-04  (NEMO team)  add in the reference version 
     10   !!            3.3  !  2010-09  (E.O'Dea) updates for Shelf configurations 
     11   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions 
     12   !!            3.4  !  2011     (D. Storkey, J. Chanut) OBC-BDY merge 
     13   !!                 !  --- Renamed bdyini.F90 -> obcini.F90 --- 
    914   !!---------------------------------------------------------------------- 
    1015#if defined key_obc 
    1116   !!---------------------------------------------------------------------- 
    12    !!   'key_obc'                                 Open Boundary Conditions 
     17   !!   'key_obc'                     Unstructured Open Boundary Conditions 
    1318   !!---------------------------------------------------------------------- 
    14    !!   obc_init       : initialization for the open boundary condition 
     19   !!   obc_init       : Initialization of unstructured open boundaries 
    1520   !!---------------------------------------------------------------------- 
    1621   USE oce             ! ocean dynamics and tracers variables 
    17    USE dom_oce         ! ocean space and time domain variables 
     22   USE dom_oce         ! ocean space and time domain 
     23   USE obc_oce         ! unstructured open boundary conditions 
     24   USE obctides        ! tides at open boundaries initialization (tide_init routine) 
     25   USE in_out_manager  ! I/O units 
    1826   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    19    USE phycst          ! physical constants 
    20    USE obc_oce         ! open boundary condition: ocean 
    21    USE obcdta          ! open boundary condition: data 
    22    USE in_out_manager  ! I/O units 
    23    USE lib_mpp         ! MPP library 
    24    USE dynspg_oce      ! flag lk_dynspg_flt 
     27   USE lib_mpp         ! for mpp_sum   
     28   USE iom             ! I/O 
    2529 
    2630   IMPLICIT NONE 
     
    2933   PUBLIC   obc_init   ! routine called by opa.F90 
    3034 
    31    !! * Substitutions 
    32 #  include "obc_vectopt_loop_substitute.h90" 
    3335   !!---------------------------------------------------------------------- 
    34    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     36   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    3537   !! $Id$  
    3638   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    4244      !!                 ***  ROUTINE obc_init  *** 
    4345      !!          
    44       !! ** Purpose :   Initialization of the dynamics and tracer fields at  
    45       !!              the open boundaries. 
     46      !! ** Purpose :   Initialization of the dynamics and tracer fields with  
     47      !!              unstructured open boundaries. 
    4648      !! 
    47       !! ** Method  :   initialization of open boundary variables 
    48       !!      (u, v) over 3 time step and 3 rows 
    49       !!      (t, s) over 2 time step and 2 rows 
    50       !!      if ln_rstart = .FALSE. : no restart, fields set to zero 
    51       !!      if ln_rstart = .TRUE.  : restart, fields are read in a file  
    52       !!      if rdpxxx = 0 then lfbc is set true for this boundary. 
     49      !! ** Method  :   Read initialization arrays (mask, indices) to identify  
     50      !!              an unstructured open boundary 
    5351      !! 
    54       !! ** Input   :   restart.obc file, restart file for open boundaries  
     52      !! ** Input   :  obc_init.nc, input file for unstructured open boundaries 
     53      !!----------------------------------------------------------------------       
     54      INTEGER  ::   ib_obc, ii, ij, ik, igrd, ib, ir   ! dummy loop indices 
     55      INTEGER  ::   icount, icountr, ibr_max, ilen1    ! local integers 
     56      INTEGER  ::   iw, ie, is, in, inum, id_dummy     !   -       - 
     57      INTEGER  ::   igrd_start, igrd_end, jpbdta       !   -       - 
     58      INTEGER, POINTER  ::  nbi, nbj, nbr              ! short cuts 
     59      REAL   , POINTER  ::  flagu, flagv               !    -   - 
     60      REAL(wp) ::   zefl, zwfl, znfl, zsfl             ! local scalars 
     61      INTEGER, DIMENSION (2)                ::   kdimsz 
     62      INTEGER, DIMENSION(jpbgrd,jp_obc)       ::   nblendta         ! Length of index arrays  
     63      INTEGER, ALLOCATABLE, DIMENSION(:,:,:)  ::   nbidta, nbjdta   ! Index arrays: i and j indices of obc dta 
     64      INTEGER, ALLOCATABLE, DIMENSION(:,:,:)  ::   nbrdta           ! Discrete distance from rim points 
     65      REAL(wp), DIMENSION(jpidta,jpjdta)    ::   zmask            ! global domain mask 
     66      CHARACTER(LEN=80),DIMENSION(jpbgrd)  ::   clfile 
     67      CHARACTER(LEN=1),DIMENSION(jpbgrd)   ::   cgrid 
     68      !! 
     69      NAMELIST/namobc/ nb_obc, ln_coords_file, cn_coords_file,             & 
     70         &             ln_mask_file, cn_mask_file, nn_dyn2d, nn_dyn3d,     & 
     71         &             nn_tra,                                             & 
     72#if defined key_lim2 
     73         &             nn_ice_lim2,                                        & 
     74#endif 
     75         &             ln_tides, ln_vol, ln_clim, nn_dtactl, nn_volctl,    & 
     76         &             nn_rimwidth, nn_dmp2d_in, nn_dmp2d_out,             & 
     77         &             nn_dmp3d_in, nn_dmp3d_out 
    5578      !!---------------------------------------------------------------------- 
    56       USE obcrst,   ONLY :   obc_rst_read   ! Make obc_rst_read routine available 
    57       !! 
    58       INTEGER  ::   ji, jj, istop , inumfbc 
    59       INTEGER, DIMENSION(4) ::   icorner 
    60       REAL(wp), DIMENSION(2) ::   ztestmask 
    61       !! 
    62       NAMELIST/namobc/ rn_dpein, rn_dpwin, rn_dpnin, rn_dpsin,       & 
    63          &             rn_dpeob, rn_dpwob, rn_dpnob, rn_dpsob,       & 
    64          &             rn_volemp, nn_obcdta, cn_obcdta,    & 
    65          &             ln_obc_clim, ln_vol_cst, ln_obc_fla 
    66       !!---------------------------------------------------------------------- 
    67  
    68       REWIND( numnam )              ! Namelist namobc : open boundaries 
    69       READ  ( numnam, namobc ) 
    70  
    71       ! convert DOCTOR namelist name into the OLD names 
    72       nobc_dta = nn_obcdta 
    73       cffile   = cn_obcdta 
    74       rdpein   = rn_dpein 
    75       rdpwin   = rn_dpwin 
    76       rdpsin   = rn_dpsin 
    77       rdpnin   = rn_dpnin 
    78       rdpeob   = rn_dpeob 
    79       rdpwob   = rn_dpwob 
    80       rdpsob   = rn_dpsob 
    81       rdpnob   = rn_dpnob 
    82       volemp   = rn_volemp 
    83  
    84       !                              ! allocate obc arrays 
    85       IF( obc_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'obc_init : unable to allocate obc_oce arrays' ) 
    86       IF( obc_dta_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'obc_init : unable to allocate obc_dta arrays' ) 
    87  
    88       ! By security we set rdpxin and rdpxob respectively to 1. and 15. if the corresponding OBC is not activated 
    89       IF( .NOT.lp_obc_east  ) THEN   ;   rdpein = 1.   ;   rdpeob = 15.   ;   END IF 
    90       IF( .NOT.lp_obc_west  ) THEN   ;   rdpwin = 1.   ;   rdpwob = 15.   ;   END IF 
    91       IF( .NOT.lp_obc_north ) THEN   ;   rdpnin = 1.   ;   rdpnob = 15.   ;   END IF 
    92       IF( .NOT.lp_obc_south ) THEN   ;   rdpsin = 1.   ;   rdpsob = 15.   ;   END IF 
    93  
    94       ! number of open boudaries and open boundary indicators 
    95       nbobc = 0 
    96       IF( lp_obc_east  )   nbobc = nbobc + 1 
    97       IF( lp_obc_west  )   nbobc = nbobc + 1 
    98       IF( lp_obc_north )   nbobc = nbobc + 1 
    99       IF( lp_obc_south )   nbobc = nbobc + 1 
     79 
     80      IF( obc_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'obc_init : unable to allocate oce arrays' ) 
    10081 
    10182      IF(lwp) WRITE(numout,*) 
    10283      IF(lwp) WRITE(numout,*) 'obc_init : initialization of open boundaries' 
    10384      IF(lwp) WRITE(numout,*) '~~~~~~~~' 
    104       IF(lwp) WRITE(numout,*) '   Number of open boundaries    nbobc = ', nbobc 
    105       IF(lwp) WRITE(numout,*) 
    106  
    107       ! control prints 
    108       IF(lwp) WRITE(numout,*) '   Namelist namobc' 
    109       IF(lwp) WRITE(numout,*) '      data in file (=1) or initial state used (=0)   nn_obcdta   = ', nn_obcdta 
    110       IF(lwp) WRITE(numout,*) '      climatology (true) or not                      ln_obc_clim = ', ln_obc_clim 
    111       IF(lwp) WRITE(numout,*) '      vol_cst (true) or not:                         ln_vol_cst  = ', ln_vol_cst 
    112       IF(lwp) WRITE(numout,*) ' ' 
    113       IF(lwp) WRITE(numout,*) '   WARNING                                                  ' 
    114       IF(lwp) WRITE(numout,*) '      Flather"s algorithm is applied with explicit free surface scheme                 ' 
    115       IF(lwp) WRITE(numout,*) '      or with free surface time-splitting scheme                                       ' 
    116       IF(lwp) WRITE(numout,*) '      Nor radiation neither relaxation is allowed with explicit free surface scheme:   ' 
    117       IF(lwp) WRITE(numout,*) '      Radiation and/or relaxation is allowed with free surface time-splitting scheme ' 
    118       IF(lwp) WRITE(numout,*) '      depending of the choice of rdpXin = rdpXob  = 0. for open boundaries             ' 
    119       IF(lwp) WRITE(numout,*) 
    120       IF(lwp) WRITE(numout,*) '      For the filtered free surface case,                                              ' 
    121       IF(lwp) WRITE(numout,*) '      radiation, relaxation or presciption of data can be applied                      ' 
    122       IF(lwp) WRITE(numout,*) 
    123  
    124       IF( lwp.AND.lp_obc_east ) THEN 
    125          WRITE(numout,*) '      East open boundary :' 
    126          WRITE(numout,*) '         i index                    jpieob   = ', jpieob 
    127          WRITE(numout,*) '         damping time scale (days)  rn_dpeob = ', rn_dpeob 
    128          WRITE(numout,*) '         damping time scale (days)  rn_dpein = ', rn_dpein 
     85      ! 
     86 
     87      IF( jperio /= 0 )   CALL ctl_stop( 'Cyclic or symmetric,',   & 
     88         &                               ' and general open boundary condition are not compatible' ) 
     89 
     90      cgrid= (/'T','U','V'/) 
     91 
     92      ! ----------------------------------------- 
     93      ! Initialise and read namelist parameters 
     94      ! ----------------------------------------- 
     95 
     96      nb_obc            = 0 
     97      ln_coords_file(:) = .false. 
     98      cn_coords_file(:) = '' 
     99      ln_mask_file      = .false. 
     100      cn_mask_file(:)   = '' 
     101      nn_dyn2d(:)       = 0 
     102      nn_dyn3d(:)       = 0 
     103      nn_tra(:)         = 0 
     104#if defined key_lim2 
     105      nn_ice_lim2(:)    = 0 
     106#endif 
     107      ln_tides(:)       = .false. 
     108      ln_vol            = .false. 
     109      ln_clim(:)        = .false. 
     110      nn_dtactl(:)      = -1  ! uninitialised flag 
     111      nn_volctl         = -1  ! uninitialised flag 
     112      nn_rimwidth(:)    = -1  ! uninitialised flag 
     113      nn_dmp2d_in(:)    = -1  ! uninitialised flag 
     114      nn_dmp2d_out(:)   = -1  ! uninitialised flag 
     115      nn_dmp3d_in(:)    = -1  ! uninitialised flag 
     116      nn_dmp3d_out(:)   = -1  ! uninitialised flag 
     117 
     118      REWIND( numnam )                     
     119      READ  ( numnam, namobc ) 
     120 
     121      ! ----------------------------------------- 
     122      ! Check and write out namelist parameters 
     123      ! ----------------------------------------- 
     124 
     125      !                                   ! control prints 
     126      IF(lwp) WRITE(numout,*) '         namobc' 
     127 
     128      IF( nb_obc .eq. 0 ) THEN  
     129        IF(lwp) WRITE(numout,*) 'nb_obc = 0, NO OPEN BOUNDARIES APPLIED.' 
     130      ELSE 
     131        IF(lwp) WRITE(numout,*) 'Number of open boundary sets : ',nb_obc 
    129132      ENDIF 
    130133 
    131       IF( lwp.AND.lp_obc_west ) THEN 
    132          WRITE(numout,*) '      West open boundary :' 
    133          WRITE(numout,*) '         i index                    jpiwob   = ', jpiwob 
    134          WRITE(numout,*) '         damping time scale (days)  rn_dpwob = ', rn_dpwob 
    135          WRITE(numout,*) '         damping time scale (days)  rn_dpwin = ', rn_dpwin 
     134      DO ib_obc = 1,nb_obc 
     135        IF(lwp) WRITE(numout,*) ' '  
     136        IF(lwp) WRITE(numout,*) '------ Open boundary data set ',ib_obc,'------'  
     137 
     138        !                                         ! check type of data used (nn_dtactl value) 
     139        SELECT CASE( nn_dtactl(ib_obc) )                   !  
     140          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for obc data'         
     141          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file' 
     142          CASE DEFAULT   ;   CALL ctl_stop( 'nn_dtactl must be 0 or 1' ) 
     143        END SELECT 
     144        IF(lwp) WRITE(numout,*) 
     145 
     146        IF(lwp) WRITE(numout,*) 'Boundary conditions for barotropic solution:  ' 
     147        SELECT CASE( nn_dyn2d(ib_obc) )                   
     148          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     149          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     150          CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '      Flather radiation condition' 
     151          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_dyn2d' ) 
     152        END SELECT 
     153        IF(lwp) WRITE(numout,*) 
     154 
     155        IF(lwp) WRITE(numout,*) 'Boundary conditions for baroclinic velocities:  ' 
     156        SELECT CASE( nn_dyn3d(ib_obc) )                   
     157          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     158          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     159          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_dyn3d' ) 
     160        END SELECT 
     161        IF(lwp) WRITE(numout,*) 
     162 
     163        IF(lwp) WRITE(numout,*) 'Boundary conditions for temperature and salinity:  ' 
     164        SELECT CASE( nn_tra(ib_obc) )                   
     165          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     166          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     167          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_tra' ) 
     168        END SELECT 
     169        IF(lwp) WRITE(numout,*) 
     170 
     171#if defined key_lim2 
     172        IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  ' 
     173        SELECT CASE( nn_tra(ib_obc) )                   
     174          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     175          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     176          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_tra' ) 
     177        END SELECT 
     178        IF(lwp) WRITE(numout,*) 
     179#endif 
     180 
     181        IF(lwp) WRITE(numout,*) 'Boundary rim width for the FRS nn_rimwidth = ', nn_rimwidth 
     182        IF(lwp) WRITE(numout,*) 
     183 
     184        IF( ln_tides(ib_obc) ) THEN 
     185          IF(lwp) WRITE(numout,*) 'Tidal harmonic forcing at unstructured open boundaries' 
     186          IF(lwp) WRITE(numout,*) 
     187        ENDIF 
     188 
     189!!$        ! Presumably will need to read in a separate namelist for each boundary that includes tides??? 
     190!!$        IF( ln_tides )   CALL tide_init( ib_obc )      ! Read tides namelist  
     191 
     192 
     193      ENDDO 
     194 
     195     IF( ln_vol ) THEN                     ! check volume conservation (nn_volctl value) 
     196       IF(lwp) WRITE(numout,*) 'Volume correction applied at open boundaries' 
     197       IF(lwp) WRITE(numout,*) 
     198       SELECT CASE ( nn_volctl ) 
     199         CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      The total volume will be constant' 
     200         CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      The total volume will vary according to the surface E-P flux' 
     201         CASE DEFAULT   ;   CALL ctl_stop( 'nn_volctl must be 0 or 1' ) 
     202       END SELECT 
     203       IF(lwp) WRITE(numout,*) 
     204     ELSE 
     205       IF(lwp) WRITE(numout,*) 'No volume correction applied at open boundaries' 
     206       IF(lwp) WRITE(numout,*) 
     207     ENDIF 
     208 
     209      ! ------------------------------------------------- 
     210      ! Initialise indices arrays for open boundaries 
     211      ! ------------------------------------------------- 
     212 
     213      ! Work out global dimensions of boundary data 
     214      ! --------------------------------------------- 
     215      DO ib_obc = 1, nb_obc 
     216 
     217         jpbdta = 1 
     218         IF( .NOT. ln_coords_file(ib_obc) ) THEN ! Work out size of global arrays from namelist parameters 
     219  
     220 
     221           !! 1. Read parameters from namelist 
     222           !! 2. Work out global size of boundary data arrays nblendta and jpbdta 
     223 
     224 
     225         ELSE            ! Read size of arrays in boundary coordinates file. 
     226 
     227 
     228            CALL iom_open( cn_coords_file(ib_obc), inum ) 
     229            jpbdta = 1 
     230            DO igrd = 1, jpbgrd 
     231               id_dummy = iom_varid( inum, 'nbi'//cgrid(igrd), kdimsz=kdimsz )   
     232               nblendta(igrd,ib_obc) = kdimsz(1) 
     233               jpbdta = MAX(jpbdta, kdimsz(1)) 
     234            ENDDO 
     235 
     236         ENDIF  
     237 
     238      ENDDO 
     239 
     240      ! Allocate arrays 
     241      !--------------- 
     242      ALLOCATE( nbidta(jpbdta, jpbgrd, nb_obc), nbjdta(jpbdta, jpbgrd, nb_obc),    & 
     243         &      nbrdta(jpbdta, jpbgrd, nb_obc) ) 
     244 
     245      ALLOCATE( dta_global(jpbdta, 1, jpk) ) 
     246 
     247      ! Calculate global boundary index arrays or read in from file 
     248      !------------------------------------------------------------ 
     249      DO ib_obc = 1, nb_obc 
     250 
     251         IF( .NOT. ln_coords_file(ib_obc) ) THEN ! Calculate global index arrays from namelist parameters 
     252 
     253           !! Calculate global index arrays from namelist parameters 
     254 
     255         ELSE            ! Read global index arrays from boundary coordinates file. 
     256 
     257            DO igrd = 1, jpbgrd 
     258               CALL iom_get( inum, jpdom_unknown, 'nbi'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_obc),:,1) ) 
     259               DO ii = 1,nblendta(igrd,ib_obc) 
     260                  nbidta(ii,igrd,ib_obc) = INT( dta_global(ii,1,1) ) 
     261               END DO 
     262               CALL iom_get( inum, jpdom_unknown, 'nbj'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_obc),:,1) ) 
     263               DO ii = 1,nblendta(igrd,ib_obc) 
     264                  nbjdta(ii,igrd,ib_obc) = INT( dta_global(ii,1,1) ) 
     265               END DO 
     266               CALL iom_get( inum, jpdom_unknown, 'nbr'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_obc),:,1) ) 
     267               DO ii = 1,nblendta(igrd,ib_obc) 
     268                  nbrdta(ii,igrd,ib_obc) = INT( dta_global(ii,1,1) ) 
     269               END DO 
     270 
     271               ibr_max = MAXVAL( nbrdta(:,igrd,ib_obc) ) 
     272               IF(lwp) WRITE(numout,*) 
     273               IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max 
     274               IF(lwp) WRITE(numout,*) ' nn_rimwidth from namelist is ', nn_rimwidth(ib_obc) 
     275               IF (ibr_max < nn_rimwidth(ib_obc))   & 
     276                     CALL ctl_stop( 'nn_rimwidth is larger than maximum rimwidth in file',cn_coords_file(ib_obc) ) 
     277 
     278            END DO 
     279            CALL iom_close( inum ) 
     280 
     281         ENDIF  
     282 
     283      ENDDO  
     284 
     285      ! Work out dimensions of boundary data on each processor 
     286      ! ------------------------------------------------------ 
     287      
     288      iw = mig(1) + 1            ! if monotasking and no zoom, iw=2 
     289      ie = mig(1) + nlci-1 - 1   ! if monotasking and no zoom, ie=jpim1 
     290      is = mjg(1) + 1            ! if monotasking and no zoom, is=2 
     291      in = mjg(1) + nlcj-1 - 1   ! if monotasking and no zoom, in=jpjm1 
     292 
     293      DO ib_obc = 1, nb_obc 
     294         DO igrd = 1, jpbgrd 
     295            icount  = 0 
     296            icountr = 0 
     297            idx_obc(ib_obc)%nblen(igrd)    = 0 
     298            idx_obc(ib_obc)%nblenrim(igrd) = 0 
     299            DO ib = 1, nblendta(igrd,ib_obc) 
     300               ! check if point is in local domain 
     301               IF(  nbidta(ib,igrd,ib_obc) >= iw .AND. nbidta(ib,igrd,ib_obc) <= ie .AND.   & 
     302                  & nbjdta(ib,igrd,ib_obc) >= is .AND. nbjdta(ib,igrd,ib_obc) <= in       ) THEN 
     303                  ! 
     304                  icount = icount  + 1 
     305                  ! 
     306                  IF( nbrdta(ib,igrd,ib_obc) == 1 )   icountr = icountr+1 
     307               ENDIF 
     308            ENDDO 
     309            idx_obc(ib_obc)%nblenrim(igrd) = icountr !: length of rim boundary data on each proc 
     310            idx_obc(ib_obc)%nblen   (igrd) = icount  !: length of boundary data on each proc         
     311         ENDDO  ! igrd 
     312 
     313         ! Allocate index arrays for this boundary set 
     314         !-------------------------------------------- 
     315         ilen1 = MAXVAL(idx_obc(ib_obc)%nblen(:)) 
     316         ALLOCATE( idx_obc(ib_obc)%nbi(ilen1,jpbgrd) ) 
     317         ALLOCATE( idx_obc(ib_obc)%nbj(ilen1,jpbgrd) ) 
     318         ALLOCATE( idx_obc(ib_obc)%nbr(ilen1,jpbgrd) ) 
     319         ALLOCATE( idx_obc(ib_obc)%nbmap(ilen1,jpbgrd) ) 
     320         ALLOCATE( idx_obc(ib_obc)%nbw(ilen1,jpbgrd) ) 
     321         ALLOCATE( idx_obc(ib_obc)%flagu(ilen1) ) 
     322         ALLOCATE( idx_obc(ib_obc)%flagv(ilen1) ) 
     323 
     324         ! Dispatch mapping indices and discrete distances on each processor 
     325         ! ----------------------------------------------------------------- 
     326 
     327         DO igrd = 1, jpbgrd 
     328            icount  = 0 
     329            ! Loop on rimwidth to ensure outermost points come first in the local arrays. 
     330            DO ir=1, nn_rimwidth(ib_obc) 
     331               DO ib = 1, nblendta(igrd,ib_obc) 
     332                  ! check if point is in local domain and equals ir 
     333                  IF(  nbidta(ib,igrd,ib_obc) >= iw .AND. nbidta(ib,igrd,ib_obc) <= ie .AND.   & 
     334                     & nbjdta(ib,igrd,ib_obc) >= is .AND. nbjdta(ib,igrd,ib_obc) <= in .AND.   & 
     335                     & nbrdta(ib,igrd,ib_obc) == ir  ) THEN 
     336                     ! 
     337                     icount = icount  + 1 
     338                     idx_obc(ib_obc)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_obc)- mig(1)+1 
     339                     idx_obc(ib_obc)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_obc)- mjg(1)+1 
     340                     idx_obc(ib_obc)%nbr(icount,igrd)   = nbrdta(ib,igrd,ib_obc) 
     341                     idx_obc(ib_obc)%nbmap(icount,igrd) = ib 
     342                  ENDIF 
     343               ENDDO 
     344            ENDDO 
     345         ENDDO  
     346 
     347         ! Compute rim weights 
     348         ! ------------------- 
     349         DO igrd = 1, jpbgrd 
     350            DO ib = 1, idx_obc(ib_obc)%nblen(igrd) 
     351               nbr => idx_obc(ib_obc)%nbr(ib,igrd) 
     352               idx_obc(ib_obc)%nbw(ib,igrd) = 1.- TANH( FLOAT( nbr - 1 ) *0.5 )      ! tanh formulation 
     353!              idx_obc(ib_obc)%nbw(ib,igrd) = (FLOAT(nn_rimwidth+1-nbr)/FLOAT(nn_rimwidth))**2      ! quadratic 
     354!              idx_obc(ib_obc)%nbw(ib,igrd) =  FLOAT(nn_rimwidth+1-nbr)/FLOAT(nn_rimwidth)          ! linear 
     355            END DO 
     356         END DO  
     357 
     358      ENDDO 
     359 
     360      ! ------------------------------------------------------ 
     361      ! Initialise masks and find normal/tangential directions 
     362      ! ------------------------------------------------------ 
     363 
     364      ! Read global 2D mask at T-points: obctmask 
     365      ! ----------------------------------------- 
     366      ! obctmask = 1  on the computational domain AND on open boundaries 
     367      !          = 0  elsewhere    
     368  
     369      IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN          ! EEL configuration at 5km resolution 
     370         zmask(         :                ,:) = 0.e0 
     371         zmask(jpizoom+1:jpizoom+jpiglo-2,:) = 1.e0           
     372      ELSE IF( ln_mask_file ) THEN 
     373         CALL iom_open( cn_mask_file, inum ) 
     374         CALL iom_get ( inum, jpdom_data, 'obc_msk', zmask(:,:) ) 
     375         CALL iom_close( inum ) 
     376      ELSE 
     377         zmask(:,:) = 1.e0 
    136378      ENDIF 
    137379 
    138       IF( lwp.AND.lp_obc_north ) THEN 
    139          WRITE(numout,*) '      North open boundary :' 
    140          WRITE(numout,*) '         j index                    jpjnob   = ', jpjnob 
    141          WRITE(numout,*) '         damping time scale (days)  rn_dpnob = ', rn_dpnob 
    142          WRITE(numout,*) '         damping time scale (days)  rn_dpnin = ', rn_dpnin 
    143       ENDIF 
    144  
    145       IF( lwp.AND.lp_obc_south ) THEN 
    146          WRITE(numout,*) '      South open boundary :' 
    147          WRITE(numout,*) '         j index                    jpjsob   = ', jpjsob 
    148          WRITE(numout,*) '         damping time scale (days)  rn_dpsob = ', rn_dpsob 
    149          WRITE(numout,*) '         damping time scale (days)  rn_dpsin = ', rn_dpsin 
    150          WRITE(numout,*) 
    151       ENDIF 
    152  
    153       IF( nbobc >= 2 .AND. jperio /= 0 )   & 
    154          &   CALL ctl_stop( ' Cyclic or symmetric, and open boundary condition are not compatible' ) 
    155  
    156       ! 1. Initialisation of constants  
    157       ! ------------------------------ 
    158       ! ...                          convert rdp$ob in seconds 
    159       ! Fixed Bdy flag              inbound                outbound 
    160       lfbceast  = .FALSE.   ;   rdpein = rdpein * rday    ;   rdpeob = rdpeob * rday 
    161       lfbcwest  = .FALSE.   ;   rdpwin = rdpwin * rday    ;   rdpwob = rdpwob * rday 
    162       lfbcnorth = .FALSE.   ;   rdpnin = rdpnin * rday    ;   rdpnob = rdpnob * rday 
    163       lfbcsouth = .FALSE.   ;   rdpsin = rdpsin * rday    ;   rdpsob = rdpsob * rday 
    164       inumfbc = 0 
    165       ! ... look for Fixed Boundaries (rdp = 0 ) 
    166       ! ... When specified, lbcxxx flags are set to TRUE and rdpxxx are set to 
    167       ! ...  a small arbitrary value, (to avoid division by zero further on).  
    168       ! ...  rdpxxx is not used anymore. 
    169       IF( lp_obc_east )  THEN 
    170          IF( (rdpein+rdpeob) == 0 )  THEN 
    171             lfbceast = .TRUE.   ;   rdpein = 1e-3   ;   rdpeob = 1e-3 
    172             inumfbc = inumfbc+1 
    173          ELSEIF ( (rdpein*rdpeob) == 0 )  THEN 
    174             CALL ctl_stop( 'obc_init : rn_dpein & rn_dpeob must be both zero or non zero' ) 
    175          END IF 
    176       END IF 
    177  
    178       IF( lp_obc_west )  THEN 
    179          IF( (rdpwin + rdpwob) == 0 )  THEN 
    180             lfbcwest = .TRUE.     ;     rdpwin = 1e-3     ;     rdpwob = 1e-3 
    181             inumfbc = inumfbc+1 
    182          ELSEIF ( (rdpwin*rdpwob) == 0 )  THEN 
    183             CALL ctl_stop( 'obc_init : rn_dpwin & rn_dpwob must be both zero or non zero' ) 
    184          END IF 
    185       END IF 
    186       IF( lp_obc_north )  THEN 
    187          IF( (rdpnin + rdpnob) == 0 )  THEN 
    188             lfbcnorth = .TRUE.     ;     rdpnin = 1e-3     ;     rdpnob = 1e-3 
    189             inumfbc = inumfbc+1 
    190          ELSEIF ( (rdpnin*rdpnob) == 0 )  THEN 
    191             CALL ctl_stop( 'obc_init : rn_dpnin & rn_dpnob must be both zero or non zero' ) 
    192          END IF 
    193       END IF 
    194       IF( lp_obc_south )  THEN 
    195          IF( (rdpsin + rdpsob) == 0 )  THEN 
    196             lfbcsouth = .TRUE.   ;   rdpsin = 1e-3   ;   rdpsob = 1e-3 
    197             inumfbc = inumfbc+1 
    198          ELSEIF ( (rdpsin*rdpsob) == 0 )  THEN 
    199             CALL ctl_stop( 'obc_init : rn_dpsin & rn_dpsob must be both zero or non zero' ) 
    200          END IF 
    201       END IF 
    202  
    203       ! 2.  Clever mpp indices for loops on the open boundaries.  
    204       !     The loops will be performed only on the processors  
    205       !     that contain a given open boundary. 
    206       ! -------------------------------------------------------- 
    207  
    208       IF( lp_obc_east ) THEN 
    209          ! ...   mpp initialization 
    210          nie0   = max( 1, min(jpieob   - nimpp+1, jpi     ) ) 
    211          nie1   = max( 0, min(jpieob   - nimpp+1, jpi - 1 ) ) 
    212          nie0p1 = max( 1, min(jpieob+1 - nimpp+1, jpi     ) ) 
    213          nie1p1 = max( 0, min(jpieob+1 - nimpp+1, jpi - 1 ) ) 
    214          nie0m1 = max( 1, min(jpieob-1 - nimpp+1, jpi     ) ) 
    215          nie1m1 = max( 0, min(jpieob-1 - nimpp+1, jpi - 1 ) ) 
    216          nje0   = max( 2, min(jpjed    - njmpp+1, jpj     ) ) 
    217          nje1   = max( 0, min(jpjef    - njmpp+1, jpj - 1 ) ) 
    218          nje0p1 = max( 1, min(jpjedp1  - njmpp+1, jpj     ) ) 
    219          nje0m1 = max( 1, min(jpjed    - njmpp+1, jpj     ) ) 
    220          nje1m1 = max( 0, min(jpjefm1  - njmpp+1, jpj - 1 ) ) 
    221          nje1m2 = max( 0, min(jpjefm1-1- njmpp+1, jpj - 1 ) ) 
    222          IF(lwp) THEN 
    223             IF( lfbceast ) THEN 
    224                WRITE(numout,*)'     ' 
    225                WRITE(numout,*)'         Specified East Open Boundary' 
     380      DO ij = 1, nlcj      ! Save mask over local domain       
     381         DO ii = 1, nlci 
     382            obctmask(ii,ij) = zmask( mig(ii), mjg(ij) ) 
     383         END DO 
     384      END DO 
     385 
     386      ! Derive mask on U and V grid from mask on T grid 
     387      obcumask(:,:) = 0.e0 
     388      obcvmask(:,:) = 0.e0 
     389      DO ij=1, jpjm1 
     390         DO ii=1, jpim1 
     391            obcumask(ii,ij)=obctmask(ii,ij)*obctmask(ii+1, ij ) 
     392            obcvmask(ii,ij)=obctmask(ii,ij)*obctmask(ii  ,ij+1)   
     393         END DO 
     394      END DO 
     395      CALL lbc_lnk( obcumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( obcvmask(:,:), 'V', 1. )      ! Lateral boundary cond. 
     396 
     397 
     398      ! Mask corrections 
     399      ! ---------------- 
     400      DO ik = 1, jpkm1 
     401         DO ij = 1, jpj 
     402            DO ii = 1, jpi 
     403               tmask(ii,ij,ik) = tmask(ii,ij,ik) * obctmask(ii,ij) 
     404               umask(ii,ij,ik) = umask(ii,ij,ik) * obcumask(ii,ij) 
     405               vmask(ii,ij,ik) = vmask(ii,ij,ik) * obcvmask(ii,ij) 
     406               bmask(ii,ij)    = bmask(ii,ij)    * obctmask(ii,ij) 
     407            END DO       
     408         END DO 
     409      END DO 
     410 
     411      DO ik = 1, jpkm1 
     412         DO ij = 2, jpjm1 
     413            DO ii = 2, jpim1 
     414               fmask(ii,ij,ik) = fmask(ii,ij,ik) * obctmask(ii,ij  ) * obctmask(ii+1,ij  )   & 
     415                  &                              * obctmask(ii,ij+1) * obctmask(ii+1,ij+1) 
     416            END DO       
     417         END DO 
     418      END DO 
     419 
     420      tmask_i (:,:) = tmask(:,:,1) * tmask_i(:,:)              
     421      obctmask(:,:) = tmask(:,:,1) 
     422 
     423      ! obc masks and bmask are now set to zero on boundary points: 
     424      igrd = 1       ! In the free surface case, bmask is at T-points 
     425      DO ib_obc = 1, nb_obc 
     426        DO ib = 1, idx_obc(ib_obc)%nblenrim(igrd)      
     427          bmask(idx_obc(ib_obc)%nbi(ib,igrd), idx_obc(ib_obc)%nbj(ib,igrd)) = 0.e0 
     428        ENDDO 
     429      ENDDO 
     430      ! 
     431      igrd = 1 
     432      DO ib_obc = 1, nb_obc 
     433        DO ib = 1, idx_obc(ib_obc)%nblenrim(igrd)       
     434          obctmask(idx_obc(ib_obc)%nbi(ib,igrd), idx_obc(ib_obc)%nbj(ib,igrd)) = 0.e0 
     435        ENDDO 
     436      ENDDO 
     437      ! 
     438      igrd = 2 
     439      DO ib_obc = 1, nb_obc 
     440        DO ib = 1, idx_obc(ib_obc)%nblenrim(igrd) 
     441          obcumask(idx_obc(ib_obc)%nbi(ib,igrd), idx_obc(ib_obc)%nbj(ib,igrd)) = 0.e0 
     442        ENDDO 
     443      ENDDO 
     444      ! 
     445      igrd = 3 
     446      DO ib_obc = 1, nb_obc 
     447        DO ib = 1, idx_obc(ib_obc)%nblenrim(igrd) 
     448          obcvmask(idx_obc(ib_obc)%nbi(ib,igrd), idx_obc(ib_obc)%nbj(ib,igrd)) = 0.e0 
     449        ENDDO 
     450      ENDDO 
     451 
     452      ! Lateral boundary conditions 
     453      CALL lbc_lnk( fmask        , 'F', 1. )   ;   CALL lbc_lnk( obctmask(:,:), 'T', 1. ) 
     454      CALL lbc_lnk( obcumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( obcvmask(:,:), 'V', 1. ) 
     455 
     456      DO ib_obc = 1, nb_obc       ! Indices and directions of rim velocity components 
     457 
     458         idx_obc(ib_obc)%flagu(:) = 0.e0 
     459         idx_obc(ib_obc)%flagv(:) = 0.e0 
     460         icount = 0  
     461 
     462         !flagu = -1 : u component is normal to the dynamical boundary but its direction is outward 
     463         !flagu =  0 : u is tangential 
     464         !flagu =  1 : u is normal to the boundary and is direction is inward 
     465   
     466         igrd = 2      ! u-component  
     467         DO ib = 1, idx_obc(ib_obc)%nblenrim(igrd)   
     468            nbi => idx_obc(ib_obc)%nbi(ib,igrd) 
     469            nbj => idx_obc(ib_obc)%nbj(ib,igrd) 
     470            zefl = obctmask(nbi  ,nbj) 
     471            zwfl = obctmask(nbi+1,nbj) 
     472            IF( zefl + zwfl == 2 ) THEN 
     473               icount = icount + 1 
    226474            ELSE 
    227                WRITE(numout,*)'     ' 
    228                WRITE(numout,*)'         Radiative East Open Boundary' 
     475               idx_obc(ib_obc)%flagu(ib)=-zefl+zwfl 
     476            ENDIF 
     477         END DO 
     478 
     479         !flagv = -1 : u component is normal to the dynamical boundary but its direction is outward 
     480         !flagv =  0 : u is tangential 
     481         !flagv =  1 : u is normal to the boundary and is direction is inward 
     482 
     483         igrd = 3      ! v-component 
     484         DO ib = 1, idx_obc(ib_obc)%nblenrim(igrd)   
     485            nbi => idx_obc(ib_obc)%nbi(ib,igrd) 
     486            nbj => idx_obc(ib_obc)%nbj(ib,igrd) 
     487            znfl = obctmask(nbi,nbj  ) 
     488            zsfl = obctmask(nbi,nbj+1) 
     489            IF( znfl + zsfl == 2 ) THEN 
     490               icount = icount + 1 
     491            ELSE 
     492               idx_obc(ib_obc)%flagv(ib) = -znfl + zsfl 
    229493            END IF 
    230          END IF 
    231       END IF 
    232  
    233       IF( lp_obc_west ) THEN 
    234          ! ...   mpp initialization 
    235          niw0   = max( 1, min(jpiwob   - nimpp+1, jpi     ) ) 
    236          niw1   = max( 0, min(jpiwob   - nimpp+1, jpi - 1 ) ) 
    237          niw0p1 = max( 1, min(jpiwob+1 - nimpp+1, jpi     ) ) 
    238          niw1p1 = max( 0, min(jpiwob+1 - nimpp+1, jpi - 1 ) ) 
    239          njw0   = max( 2, min(jpjwd    - njmpp+1, jpj     ) ) 
    240          njw1   = max( 0, min(jpjwf    - njmpp+1, jpj - 1 ) ) 
    241          njw0p1 = max( 1, min(jpjwdp1  - njmpp+1, jpj     ) ) 
    242          njw0m1 = max( 1, min(jpjwd    - njmpp+1, jpj     ) ) 
    243          njw1m1 = max( 0, min(jpjwfm1  - njmpp+1, jpj - 1 ) ) 
    244          njw1m2 = max( 0, min(jpjwfm1-1- njmpp+1, jpj - 1 ) ) 
    245          IF(lwp) THEN 
    246             IF( lfbcwest ) THEN 
    247                WRITE(numout,*)'     ' 
    248                WRITE(numout,*)'         Specified West Open Boundary' 
    249             ELSE 
    250                WRITE(numout,*)'     ' 
    251                WRITE(numout,*)'         Radiative West Open Boundary' 
    252             END IF 
    253          END IF 
    254       END IF 
     494         END DO 
    255495  
    256       IF( lp_obc_north ) THEN 
    257          ! ...   mpp initialization 
    258          nin0   = max( 2, min(jpind    - nimpp+1, jpi     ) ) 
    259          nin1   = max( 0, min(jpinf    - nimpp+1, jpi - 1 ) ) 
    260          nin0p1 = max( 1, min(jpindp1  - nimpp+1, jpi     ) ) 
    261          nin0m1 = max( 1, min(jpind    - nimpp+1, jpi     ) ) 
    262          nin1m1 = max( 0, min(jpinfm1  - nimpp+1, jpi - 1 ) ) 
    263          nin1m2 = max( 0, min(jpinfm1-1- nimpp+1, jpi - 1 ) ) 
    264          njn0   = max( 1, min(jpjnob   - njmpp+1, jpj     ) ) 
    265          njn1   = max( 0, min(jpjnob   - njmpp+1, jpj - 1 ) ) 
    266          njn0p1 = max( 1, min(jpjnob+1 - njmpp+1, jpj     ) ) 
    267          njn1p1 = max( 0, min(jpjnob+1 - njmpp+1, jpj - 1 ) ) 
    268          njn0m1 = max( 1, min(jpjnob-1 - njmpp+1, jpj     ) ) 
    269          njn1m1 = max( 0, min(jpjnob-1 - njmpp+1, jpj - 1 ) ) 
    270          IF(lwp) THEN 
    271             IF( lfbcnorth ) THEN 
    272                WRITE(numout,*)'     ' 
    273                WRITE(numout,*)'         Specified North Open Boundary' 
    274             ELSE 
    275                WRITE(numout,*)'     ' 
    276                WRITE(numout,*)'         Radiative North Open Boundary' 
    277             END IF 
    278          END IF 
    279       END IF 
    280  
    281       IF( lp_obc_south ) THEN 
    282          ! ...   mpp initialization 
    283          nis0   = max( 2, min(jpisd    - nimpp+1, jpi     ) ) 
    284          nis1   = max( 0, min(jpisf    - nimpp+1, jpi - 1 ) ) 
    285          nis0p1 = max( 1, min(jpisdp1  - nimpp+1, jpi     ) ) 
    286          nis0m1 = max( 1, min(jpisd    - nimpp+1, jpi     ) ) 
    287          nis1m1 = max( 0, min(jpisfm1  - nimpp+1, jpi - 1 ) ) 
    288          nis1m2 = max( 0, min(jpisfm1-1- nimpp+1, jpi - 1 ) ) 
    289          njs0   = max( 1, min(jpjsob   - njmpp+1, jpj     ) ) 
    290          njs1   = max( 0, min(jpjsob   - njmpp+1, jpj - 1 ) ) 
    291          njs0p1 = max( 1, min(jpjsob+1 - njmpp+1, jpj     ) ) 
    292          njs1p1 = max( 0, min(jpjsob+1 - njmpp+1, jpj - 1 ) ) 
    293          IF(lwp) THEN 
    294             IF( lfbcsouth ) THEN 
    295                WRITE(numout,*)'     ' 
    296                WRITE(numout,*)'         Specified South Open Boundary' 
    297             ELSE 
    298                WRITE(numout,*)'     ' 
    299                WRITE(numout,*)'         Radiative South Open Boundary' 
    300             END IF 
    301          END IF 
    302       END IF 
    303  
    304       ! 3. mask correction for OBCs 
    305       ! --------------------------- 
    306  
    307       IF( lp_obc_east ) THEN 
    308          !... (jpjed,jpjefm1),jpieob 
    309          bmask(nie0p1:nie1p1,nje0:nje1m1) = 0.e0 
    310  
    311          ! ... initilization to zero 
    312          uemsk(:,:) = 0.e0   ;   vemsk(:,:) = 0.e0   ;   temsk(:,:) = 0.e0 
    313  
    314          ! ... set 2D mask on East OBC,  Vopt 
    315          DO ji = fs_nie0, fs_nie1 
    316             DO jj = nje0, nje1 
    317                uemsk(jj,:) = umask(ji,  jj,:) * tmask_i(ji,jj)   * tmask_i(ji+1,jj) 
    318                vemsk(jj,:) = vmask(ji+1,jj,:) * tmask_i(ji+1,jj)  
    319                temsk(jj,:) = tmask(ji+1,jj,:) * tmask_i(ji+1,jj)  
    320             END DO 
    321          END DO 
    322  
    323       END IF 
    324  
    325       IF( lp_obc_west ) THEN 
    326          ! ... (jpjwd,jpjwfm1),jpiwob 
    327          bmask(niw0:niw1,njw0:njw1m1) = 0.e0 
    328  
    329          ! ... initilization to zero 
    330          uwmsk(:,:) = 0.e0   ;   vwmsk(:,:) = 0.e0   ;   twmsk(:,:) = 0.e0   
    331  
    332          ! ... set 2D mask on West OBC,  Vopt 
    333          DO ji = fs_niw0, fs_niw1 
    334             DO jj = njw0, njw1 
    335                uwmsk(jj,:) = umask(ji,jj,:) * tmask_i(ji,jj)   * tmask_i(ji+1,jj) 
    336                vwmsk(jj,:) = vmask(ji,jj,:) * tmask_i(ji,jj)   
    337                twmsk(jj,:) = tmask(ji,jj,:) * tmask_i(ji,jj) 
    338             END DO 
    339          END DO 
    340  
    341       END IF 
    342  
    343       IF( lp_obc_north ) THEN 
    344          ! ... jpjnob,(jpind,jpisfm1) 
    345          bmask(nin0:nin1m1,njn0p1:njn1p1) = 0.e0 
    346  
    347          ! ... initilization to zero 
    348          unmsk(:,:) = 0.e0   ;   vnmsk(:,:) = 0.e0   ;   tnmsk(:,:) = 0.e0 
    349  
    350          ! ... set 2D mask on North OBC,  Vopt 
    351          DO jj = fs_njn0, fs_njn1 
    352             DO ji = nin0, nin1 
    353                unmsk(ji,:) = umask(ji,jj+1,:) * tmask_i(ji,jj+1)  
    354                vnmsk(ji,:) = vmask(ji,jj  ,:) * tmask_i(ji,jj)   * tmask_i(ji,jj+1) 
    355                tnmsk(ji,:) = tmask(ji,jj+1,:) * tmask_i(ji,jj+1) 
    356             END DO 
    357          END DO 
    358  
    359       END IF 
    360  
    361       IF( lp_obc_south ) THEN  
    362          ! ... jpjsob,(jpisd,jpisfm1) 
    363          bmask(nis0:nis1m1,njs0:njs1) = 0.e0 
    364  
    365          ! ... initilization to zero 
    366          usmsk(:,:) = 0.e0   ;   vsmsk(:,:) = 0.e0   ;   tsmsk(:,:) = 0.e0 
    367  
    368          ! ... set 2D mask on South OBC,  Vopt 
    369          DO jj = fs_njs0, fs_njs1  
    370             DO ji = nis0, nis1 
    371                usmsk(ji,:) = umask(ji,jj,:) * tmask_i(ji,jj)  
    372                vsmsk(ji,:) = vmask(ji,jj,:) * tmask_i(ji,jj) * tmask_i(ji,jj+1) 
    373                tsmsk(ji,:) = tmask(ji,jj,:) * tmask_i(ji,jj) 
    374             END DO 
    375          END DO 
    376  
    377       END IF 
    378  
    379       ! ... Initialize obcumask and obcvmask for the Force filtering  
    380       !     boundary condition in dynspg_flt 
    381       obcumask(:,:) = umask(:,:,1) 
    382       obcvmask(:,:) = vmask(:,:,1) 
    383  
    384       ! ... Initialize obctmsk on overlap region and obcs. This mask 
    385       !     is used in obcvol.F90 to calculate cumulate flux E-P.  
    386       !     obc Tracer point are outside the domain ( U/V obc points) ==> masked by obctmsk 
    387       !     - no flux E-P on obcs and overlap region (jpreci = jprecj = 1) 
    388       obctmsk(:,:) = tmask_i(:,:)      
    389  
    390       IF( lp_obc_east ) THEN 
    391          ! ... East obc Force filtering mask for the grad D 
    392          obcumask(nie0  :nie1  ,nje0p1:nje1m1) = 0.e0 
    393          obcvmask(nie0p1:nie1p1,nje0p1:nje1m1) = 0.e0 
    394          ! ... set to 0 on East OBC 
    395          obctmsk(nie0p1:nie1p1,nje0:nje1) = 0.e0 
    396       END IF 
    397  
    398       IF( lp_obc_west ) THEN 
    399          ! ... West obc Force filtering mask for the grad D 
    400          obcumask(niw0:niw1,njw0:njw1) = 0.e0 
    401          obcvmask(niw0:niw1,njw0:njw1) = 0.e0 
    402          ! ... set to 0 on West OBC 
    403          obctmsk(niw0:niw1,njw0:njw1) = 0.e0 
    404       END IF 
    405  
    406       IF( lp_obc_north ) THEN 
    407          ! ... North obc Force filtering mask for the grad D 
    408          obcumask(nin0p1:nin1m1,njn0p1:njn1p1) = 0.e0 
    409          obcvmask(nin0p1:nin1m1,njn0  :njn1  ) = 0.e0 
    410          ! ... set to 0 on North OBC 
    411          obctmsk(nin0:nin1,njn0p1:njn1p1) = 0.e0 
    412       END IF 
    413  
    414       IF( lp_obc_south ) THEN 
    415          ! ... South obc Force filtering mask for the grad D 
    416          obcumask(nis0p1:nis1m1,njs0:njs1) = 0.e0 
    417          obcvmask(nis0p1:nis1m1,njs0:njs1) = 0.e0 
    418          ! ... set to 0 on South OBC 
    419          obctmsk(nis0:nis1,njs0:njs1) = 0.e0 
    420       END IF 
    421  
    422       ! 3.1 Total lateral surface  
    423       ! ------------------------- 
    424       obcsurftot = 0.e0 
    425  
    426       IF( lp_obc_east ) THEN ! ... East open boundary lateral surface 
    427          DO ji = nie0, nie1 
    428             DO jj = 1, jpj  
    429                obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uemsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) ) 
    430             END DO 
    431          END DO 
    432       END IF 
    433  
    434       IF( lp_obc_west ) THEN ! ... West open boundary lateral surface 
    435          DO ji = niw0, niw1 
    436             DO jj = 1, jpj  
    437                obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uwmsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) ) 
    438             END DO 
    439          END DO 
    440       END IF 
    441  
    442       IF( lp_obc_north ) THEN ! ... North open boundary lateral surface 
    443          DO jj = njn0, njn1 
    444             DO ji = 1, jpi 
    445                obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vnmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) ) 
    446             END DO 
    447          END DO 
    448       END IF 
    449  
    450       IF( lp_obc_south ) THEN ! ... South open boundary lateral surface 
    451          DO jj = njs0, njs1 
    452             DO ji = 1, jpi 
    453                obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vsmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) ) 
    454             END DO 
    455          END DO 
    456       END IF 
    457  
    458       IF( lk_mpp )   CALL mpp_sum( obcsurftot )   ! sum over the global domain 
    459  
    460       ! 5. Control print on mask  
    461       !    The extremities of the open boundaries must be in land 
    462       !    or else correspond to an "ocean corner" between two open boundaries.  
    463       !    corner 1 is southwest, 2 is south east, 3 is northeast, 4 is northwest.  
    464       ! -------------------------------------------------------------------------- 
    465  
    466       icorner(:)=0 
    467  
    468       ! ... control of the west boundary 
    469       IF( lp_obc_west ) THEN 
    470          IF( jpiwob < 2 .OR.  jpiwob >= jpiglo-2 ) THEN 
    471             WRITE(ctmp1,*) ' jpiwob exceed ', jpiglo-2, 'or less than 2' 
    472             CALL ctl_stop( ctmp1 ) 
    473          END IF 
    474          ztestmask(:)=0. 
    475          DO ji=niw0,niw1 
    476             IF( (njw0 + njmpp - 1) == jpjwd ) ztestmask(1)=ztestmask(1)+ tmask(ji,njw0,1) 
    477             IF( (njw1 + njmpp - 1) == jpjwf ) ztestmask(2)=ztestmask(2)+ tmask(ji,njw1,1) 
    478          END DO 
    479          IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain 
    480  
    481          IF( ztestmask(1) /= 0. ) icorner(1)=icorner(1)+1 
    482          IF( ztestmask(2) /= 0. ) icorner(4)=icorner(4)+1 
    483       END IF 
    484  
    485       ! ... control of the east boundary 
    486       IF( lp_obc_east ) THEN 
    487          IF( jpieob < 4 .OR.  jpieob >= jpiglo ) THEN 
    488             WRITE(ctmp1,*) ' jpieob exceed ', jpiglo, ' or less than 4' 
    489             CALL ctl_stop( ctmp1 ) 
    490          END IF 
    491          ztestmask(:)=0. 
    492          DO ji=nie0p1,nie1p1 
    493             IF( (nje0 + njmpp - 1) == jpjed ) ztestmask(1)=ztestmask(1)+ tmask(ji,nje0,1) 
    494             IF( (nje1 + njmpp - 1) == jpjef ) ztestmask(2)=ztestmask(2)+ tmask(ji,nje1,1) 
    495          END DO 
    496          IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain 
    497  
    498         IF( ztestmask(1) /= 0. ) icorner(2)=icorner(2)+1 
    499         IF( ztestmask(2) /= 0. ) icorner(3)=icorner(3)+1 
    500       END IF 
    501  
    502       ! ... control of the north boundary 
    503       IF( lp_obc_north ) THEN 
    504          IF( jpjnob < 4 .OR.  jpjnob >= jpjglo ) THEN 
    505             WRITE(ctmp1,*) 'jpjnob exceed ', jpjglo, ' or less than 4' 
    506             CALL ctl_stop( ctmp1 ) 
    507          END IF 
    508          ztestmask(:)=0. 
    509          DO jj=njn0p1,njn1p1 
    510             IF( (nin0 + nimpp - 1) == jpind ) ztestmask(1)=ztestmask(1)+ tmask(nin0,jj,1) 
    511             IF( (nin1 + nimpp - 1) == jpinf ) ztestmask(2)=ztestmask(2)+ tmask(nin1,jj,1) 
    512          END DO 
    513          IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain 
    514  
    515          IF( ztestmask(1) /= 0. ) icorner(4)=icorner(4)+1 
    516          IF( ztestmask(2) /= 0. ) icorner(3)=icorner(3)+1 
    517       END IF 
    518  
    519       ! ... control of the south boundary 
    520       IF( lp_obc_south ) THEN 
    521          IF( jpjsob < 2 .OR.  jpjsob >= jpjglo-2 ) THEN 
    522             WRITE(ctmp1,*) ' jpjsob exceed ', jpjglo-2, ' or less than 2' 
    523             CALL ctl_stop( ctmp1 ) 
    524          END IF 
    525          ztestmask(:)=0. 
    526          DO jj=njs0,njs1 
    527             IF( (nis0 + nimpp - 1) == jpisd ) ztestmask(1)=ztestmask(1)+ tmask(nis0,jj,1) 
    528             IF( (nis1 + nimpp - 1) == jpisf ) ztestmask(2)=ztestmask(2)+ tmask(nis1,jj,1) 
    529          END DO 
    530          IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain 
    531  
    532          IF( ztestmask(1) /= 0. ) icorner(1)=icorner(1)+1 
    533          IF( ztestmask(2) /= 0. ) icorner(2)=icorner(2)+1 
    534       END IF 
    535  
    536       IF( icorner(1) == 2 ) THEN 
    537          IF(lwp) WRITE(numout,*) 
    538          IF(lwp) WRITE(numout,*) ' South West ocean corner, two open boudaries' 
    539          IF(lwp) WRITE(numout,*) ' ========== ' 
    540          IF(lwp) WRITE(numout,*) 
    541          IF( jpisd /= jpiwob.OR.jpjsob /= jpjwd ) & 
    542               &   CALL ctl_stop( ' Open boundaries do not fit, we stop' ) 
    543  
    544       ELSE IF( icorner(1) == 1 ) THEN 
    545          CALL ctl_stop( ' Open boundaries do not fit at SW corner, we stop' ) 
    546       END IF  
    547  
    548       IF( icorner(2) == 2 ) THEN 
    549           IF(lwp) WRITE(numout,*) 
    550           IF(lwp) WRITE(numout,*) ' South East ocean corner, two open boudaries' 
    551           IF(lwp) WRITE(numout,*) ' ========== ' 
    552           IF(lwp) WRITE(numout,*) 
    553           IF( jpisf /= jpieob+1.OR.jpjsob /= jpjed ) & 
    554                &   CALL ctl_stop( ' Open boundaries do not fit, we stop' ) 
    555       ELSE IF( icorner(2) == 1 ) THEN 
    556          CALL ctl_stop( ' Open boundaries do not fit at SE corner, we stop' ) 
    557       END IF  
    558  
    559       IF( icorner(3) == 2 ) THEN 
    560          IF(lwp) WRITE(numout,*) 
    561          IF(lwp) WRITE(numout,*) ' North East ocean corner, two open boudaries' 
    562          IF(lwp) WRITE(numout,*) ' ========== ' 
    563          IF(lwp) WRITE(numout,*) 
    564          IF( jpinf /= jpieob+1 .OR. jpjnob+1 /= jpjef ) & 
    565               &   CALL ctl_stop( ' Open boundaries do not fit, we stop' ) 
    566        ELSE IF( icorner(3) == 1 ) THEN 
    567           CALL ctl_stop( ' Open boundaries do not fit at NE corner, we stop' ) 
    568        END IF  
    569  
    570       IF( icorner(4) == 2 ) THEN 
    571          IF(lwp) WRITE(numout,*) 
    572          IF(lwp) WRITE(numout,*) ' North West ocean corner, two open boudaries' 
    573          IF(lwp) WRITE(numout,*) ' ========== ' 
    574          IF(lwp) WRITE(numout,*) 
    575          IF( jpind /= jpiwob.OR.jpjnob+1 /= jpjwf ) & 
    576               &   CALL ctl_stop( ' Open boundaries do not fit, we stop' ) 
    577        ELSE IF( icorner(4) == 1 ) THEN 
    578           CALL ctl_stop( ' Open boundaries do not fit at NW corner, we stop' ) 
    579        END IF  
    580  
    581       ! 6. Initialization of open boundary variables (u, v, t, s) 
    582       ! -------------------------------------------------------------- 
    583       !   only if at least one boundary is  radiative  
    584       IF ( inumfbc < nbobc .AND.  ln_rstart ) THEN 
    585          !  Restart from restart.obc 
    586          CALL obc_rst_read 
    587       ELSE 
    588  
    589 !         ! ... Initialization to zero of radiation arrays. 
    590 !         !     Those have dimensions of local subdomains 
    591  
    592           uebnd(:,:,:,:) = 0.e0   ;   unbnd(:,:,:,:) = 0.e0 
    593           vebnd(:,:,:,:) = 0.e0   ;   vnbnd(:,:,:,:) = 0.e0 
    594           tebnd(:,:,:,:) = 0.e0   ;   tnbnd(:,:,:,:) = 0.e0 
    595           sebnd(:,:,:,:) = 0.e0   ;   snbnd(:,:,:,:) = 0.e0 
    596  
    597           uwbnd(:,:,:,:) = 0.e0   ;   usbnd(:,:,:,:) = 0.e0 
    598           vwbnd(:,:,:,:) = 0.e0   ;   vsbnd(:,:,:,:) = 0.e0 
    599           twbnd(:,:,:,:) = 0.e0   ;   tsbnd(:,:,:,:) = 0.e0 
    600           swbnd(:,:,:,:) = 0.e0   ;   ssbnd(:,:,:,:) = 0.e0 
    601  
    602       END IF 
    603  
    604       ! 7. Control print 
    605       ! ----------------------------------------------------------------- 
    606  
    607       ! ... control of the east boundary 
    608       IF( lp_obc_east ) THEN 
    609          istop = 0 
    610          IF( jpieob < 4 .OR.  jpieob >= jpiglo ) THEN 
    611             IF(lwp) WRITE(numout,cform_err) 
    612             IF(lwp) WRITE(numout,*) '            jpieob exceed ', jpim1, ' or less than 4' 
    613             istop = istop + 1 
    614          END IF 
    615  
    616          IF( lk_mpp ) THEN 
    617             ! ...  
    618             IF( nimpp > jpieob-5) THEN 
    619                IF(lwp) WRITE(numout,cform_err) 
    620                IF(lwp) WRITE(numout,*) '        A sub-domain is too close to the East OBC' 
    621                IF(lwp) WRITE(numout,*) '        nimpp must be < jpieob-5' 
    622                istop = istop + 1 
    623             ENDIF 
    624          ELSE 
    625  
    626             ! ... stop if  e r r o r (s)   detected 
    627             IF( istop /= 0 ) THEN 
    628                WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop' 
    629                CALL ctl_stop( ctmp1 ) 
    630             ENDIF 
    631          ENDIF 
    632       ENDIF 
    633  
    634       ! ... control of the west boundary 
    635       IF( lp_obc_west ) THEN 
    636          istop = 0 
    637          IF( jpiwob < 2 .OR.  jpiwob >= jpiglo ) THEN 
    638             IF(lwp) WRITE(numout,cform_err) 
    639             IF(lwp) WRITE(numout,*) '            jpiwob exceed ', jpim1, ' or less than 2' 
    640             istop = istop + 1 
    641          END IF 
    642  
    643          IF( lk_mpp ) THEN 
    644             IF( (nimpp < jpiwob+5) .AND. (nimpp > 1) ) THEN 
    645                IF(lwp) WRITE(numout,cform_err) 
    646                IF(lwp) WRITE(numout,*) '        A sub-domain is too close to the West OBC' 
    647                IF(lwp) WRITE(numout,*) '        nimpp must be > jpiwob-5 or =1' 
    648                istop = istop + 1 
    649             ENDIF 
    650          ELSE 
    651     
    652             ! ... stop if  e r r o r (s)   detected 
    653             IF( istop /= 0 ) THEN 
    654                WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop' 
    655                CALL ctl_stop( ctmp1 ) 
    656             ENDIF 
    657          ENDIF 
    658       ENDIF 
    659  
    660       ! control of the north boundary 
    661       IF( lp_obc_north ) THEN 
    662          istop = 0 
    663          IF( jpjnob < 4 .OR.  jpjnob >= jpjglo ) THEN 
    664             IF(lwp) WRITE(numout,cform_err) 
    665             IF(lwp) WRITE(numout,*) '          jpjnob exceed ', jpjm1,' or less than 4' 
    666             istop = istop + 1 
    667          END IF 
    668  
    669          IF( lk_mpp ) THEN 
    670             IF( njmpp > jpjnob-5) THEN 
    671                IF(lwp) WRITE(numout,cform_err) 
    672                IF(lwp) WRITE(numout,*) '        A sub-domain is too close to the North OBC' 
    673                IF(lwp) WRITE(numout,*) '        njmpp must be < jpjnob-5' 
    674                istop = istop + 1 
    675             ENDIF 
    676          ELSE 
    677     
    678             ! ... stop if  e r r o r (s)   detected 
    679             IF( istop /= 0 ) THEN 
    680                 WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop' 
    681                CALL ctl_stop( ctmp1 ) 
    682            ENDIF 
    683          ENDIF 
    684       ENDIF 
    685  
    686       ! control of the south boundary 
    687       IF( lp_obc_south ) THEN 
    688          istop = 0 
    689          IF( jpjsob < 2 .OR. jpjsob >= jpjglo ) THEN 
    690             IF(lwp) WRITE(numout,cform_err) 
    691             IF(lwp) WRITE(numout,*) '          jpjsob exceed ', jpjm1,' or less than 2' 
    692             istop = istop + 1 
    693          END IF 
    694  
    695          IF( lk_mpp ) THEN 
    696             IF( (njmpp < jpjsob+5) .AND. (njmpp > 1) ) THEN 
    697                IF(lwp) WRITE(numout,cform_err) 
    698                IF(lwp) WRITE(numout,*) '        A sub-domain is too close to the South OBC' 
    699                IF(lwp) WRITE(numout,*) '        njmpp must be > jpjsob+5 or =1' 
    700                istop = istop + 1 
    701             ENDIF 
    702          ELSE 
    703     
    704             ! ... stop if  e r r o r (s)   detected 
    705             IF( istop /= 0 ) THEN 
    706                WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop' 
    707                CALL ctl_stop( ctmp1 ) 
    708             ENDIF 
    709          ENDIF 
    710       ENDIF 
     496         IF( icount /= 0 ) THEN 
     497            IF(lwp) WRITE(numout,*) 
     498            IF(lwp) WRITE(numout,*) ' E R R O R : Some data velocity points,',   & 
     499               ' are not boundary points. Check nbi, nbj, indices for boundary set ',ib_obc 
     500            IF(lwp) WRITE(numout,*) ' ========== ' 
     501            IF(lwp) WRITE(numout,*) 
     502            nstop = nstop + 1 
     503         ENDIF  
     504     
     505      ENDDO 
     506 
     507      ! Compute total lateral surface for volume correction: 
     508      ! ---------------------------------------------------- 
     509      obcsurftot = 0.e0  
     510      IF( ln_vol ) THEN   
     511         igrd = 2      ! Lateral surface at U-points 
     512         DO ib_obc = 1, nb_obc 
     513            DO ib = 1, idx_obc(ib_obc)%nblenrim(igrd) 
     514               nbi => idx_obc(ib_obc)%nbi(ib,igrd) 
     515               nbj => idx_obc(ib_obc)%nbi(ib,igrd) 
     516               flagu => idx_obc(ib_obc)%flagu(ib) 
     517               obcsurftot = obcsurftot + hu     (nbi  , nbj)                           & 
     518                  &                    * e2u    (nbi  , nbj) * ABS( flagu ) & 
     519                  &                    * tmask_i(nbi  , nbj)                           & 
     520                  &                    * tmask_i(nbi+1, nbj)                    
     521            ENDDO 
     522         ENDDO 
     523 
     524         igrd=3 ! Add lateral surface at V-points 
     525         DO ib_obc = 1, nb_obc 
     526            DO ib = 1, idx_obc(ib_obc)%nblenrim(igrd) 
     527               nbi => idx_obc(ib_obc)%nbi(ib,igrd) 
     528               nbj => idx_obc(ib_obc)%nbi(ib,igrd) 
     529               flagv => idx_obc(ib_obc)%flagv(ib) 
     530               obcsurftot = obcsurftot + hv     (nbi, nbj  )                           & 
     531                  &                    * e1v    (nbi, nbj  ) * ABS( flagv ) & 
     532                  &                    * tmask_i(nbi, nbj  )                           & 
     533                  &                    * tmask_i(nbi, nbj+1) 
     534            ENDDO 
     535         ENDDO 
     536         ! 
     537         IF( lk_mpp )   CALL mpp_sum( obcsurftot )      ! sum over the global domain 
     538      END IF    
     539 
     540      ! Read in tidal constituents and adjust for model start time 
     541      ! ---------------------------------------------------------- 
     542!!$      IF( ln_tides )   CALL tide_data 
     543      ! 
     544      ! Tidy up 
     545      !-------- 
     546      DEALLOCATE(nbidta, nbjdta, nbrdta) 
    711547 
    712548   END SUBROUTINE obc_init 
     
    714550#else 
    715551   !!--------------------------------------------------------------------------------- 
    716    !!   Dummy module                                                NO open boundaries 
     552   !!   Dummy module                                   NO unstructured open boundaries 
    717553   !!--------------------------------------------------------------------------------- 
    718554CONTAINS 
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/OBC/obcrad.F90

    r2715 r2797  
    55   !!================================================================================= 
    66#if defined key_obc 
    7    !!--------------------------------------------------------------------------------- 
    8    !!   obc_rad        : call the subroutine for each open boundary 
    9    !!   obc_rad_east   : compute the east phase velocities 
    10    !!   obc_rad_west   : compute the west phase velocities 
    11    !!   obc_rad_north  : compute the north phase velocities 
    12    !!   obc_rad_south  : compute the south phase velocities 
    13    !!--------------------------------------------------------------------------------- 
    14    USE oce             ! ocean dynamics and tracers variables 
    15    USE dom_oce         ! ocean space and time domain variables 
    16    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    17    USE phycst          ! physical constants 
    18    USE obc_oce         ! ocean open boundary conditions 
    19    USE lib_mpp         ! for mppobc 
    20    USE in_out_manager  ! I/O units 
    21  
    22    IMPLICIT NONE 
    23    PRIVATE 
    24  
    25    PUBLIC   obc_rad    ! routine called by step.F90 
    26  
    27    INTEGER ::   ji, jj, jk     ! dummy loop indices 
    28  
    29    INTEGER ::      & ! ... boundary space indices  
    30       nib   = 1,   & ! nib   = boundary point 
    31       nibm  = 2,   & ! nibm  = 1st interior point 
    32       nibm2 = 3,   & ! nibm2 = 2nd interior point 
    33                      ! ... boundary time indices  
    34       nit   = 1,   & ! nit    = now 
    35       nitm  = 2,   & ! nitm   = before 
    36       nitm2 = 3      ! nitm2  = before-before 
    37  
    38    !! * Substitutions 
    39 #  include "obc_vectopt_loop_substitute.h90" 
    40    !!--------------------------------------------------------------------------------- 
    41    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    42    !! $Id$  
    43    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    44    !!--------------------------------------------------------------------------------- 
    45  
    46 CONTAINS 
    47  
    48    SUBROUTINE obc_rad ( kt ) 
    49       !!------------------------------------------------------------------------------ 
    50       !!                     SUBROUTINE obc_rad 
    51       !!                    ******************** 
    52       !! ** Purpose : 
    53       !!      Perform swap of arrays to calculate radiative phase speeds at the open  
    54       !!      boundaries and calculate those phase speeds if the open boundaries are  
    55       !!      not fixed. In case of fixed open boundaries does nothing. 
    56       !! 
    57       !!     The logical variable lp_obc_east, and/or lp_obc_west, and/or lp_obc_north, 
    58       !!     and/or lp_obc_south allow the user to determine which boundary is an 
    59       !!     open one (must be done in the param_obc.h90 file). 
    60       !!  
    61       !! ** Reference :  
    62       !!     Marchesiello P., 1995, these de l'universite J. Fourier, Grenoble, France. 
    63       !! 
    64       !!  History : 
    65       !!    8.5  !  02-10  (C. Talandier, A-M. Treguier) Free surface, F90 from the  
    66       !!                                                 J. Molines and G. Madec version 
    67       !!------------------------------------------------------------------------------ 
    68       INTEGER, INTENT( in ) ::   kt 
    69       !!---------------------------------------------------------------------- 
    70  
    71       IF( lp_obc_east  .AND. .NOT.lfbceast  )   CALL obc_rad_east ( kt )   ! East open boundary 
    72  
    73       IF( lp_obc_west  .AND. .NOT.lfbcwest  )   CALL obc_rad_west ( kt )   ! West open boundary 
    74  
    75       IF( lp_obc_north .AND. .NOT.lfbcnorth )   CALL obc_rad_north( kt )   ! North open boundary 
    76  
    77       IF( lp_obc_south .AND. .NOT.lfbcsouth )   CALL obc_rad_south( kt )   ! South open boundary 
    78  
    79    END SUBROUTINE obc_rad 
    80  
    81  
    82    SUBROUTINE obc_rad_east ( kt ) 
    83       !!------------------------------------------------------------------------------ 
    84       !!                     ***  SUBROUTINE obc_rad_east  *** 
    85       !!                    
    86       !! ** Purpose : 
    87       !!      Perform swap of arrays to calculate radiative phase speeds at the open  
    88       !!      east boundary and calculate those phase speeds if this OBC is not fixed. 
    89       !!      In case of fixed OBC, this subrountine is not called. 
    90       !! 
    91       !!  History : 
    92       !!         ! 95-03 (J.-M. Molines) Original from SPEM 
    93       !!         ! 97-07 (G. Madec, J.-M. Molines) additions 
    94       !!         ! 97-12 (M. Imbard) Mpp adaptation 
    95       !!         ! 00-06 (J.-M. Molines)  
    96       !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 
    97       !!------------------------------------------------------------------------------ 
    98       !! * Arguments 
    99       INTEGER, INTENT( in ) ::   kt 
    100  
    101       !! * Local declarations 
    102       INTEGER  ::   ij 
    103       REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy 
    104       REAL(wp) ::   zucb, zucbm, zucbm2 
    105       !!------------------------------------------------------------------------------ 
    106  
    107       ! 1. Swap arrays before calculating radiative velocities 
    108       ! ------------------------------------------------------ 
    109  
    110       ! 1.1  zonal velocity  
    111       ! ------------------- 
    112  
    113       IF( kt > nit000 .OR. ln_rstart ) THEN  
    114  
    115          ! ... advance in time (time filter, array swap)  
    116          DO jk = 1, jpkm1 
    117             DO jj = 1, jpj 
    118                uebnd(jj,jk,nib  ,nitm2) = uebnd(jj,jk,nib  ,nitm)*uemsk(jj,jk) 
    119                uebnd(jj,jk,nibm ,nitm2) = uebnd(jj,jk,nibm ,nitm)*uemsk(jj,jk) 
    120                uebnd(jj,jk,nibm2,nitm2) = uebnd(jj,jk,nibm2,nitm)*uemsk(jj,jk) 
    121             END DO 
    122          END DO 
    123          ! ... fields nitm <== nit  plus time filter at the boundary  
    124          DO ji = fs_nie0, fs_nie1 ! Vector opt. 
    125             DO jk = 1, jpkm1 
    126                DO jj = 1, jpj 
    127                   uebnd(jj,jk,nib  ,nitm) = uebnd(jj,jk,nib,  nit)*uemsk(jj,jk) 
    128                   uebnd(jj,jk,nibm ,nitm) = uebnd(jj,jk,nibm ,nit)*uemsk(jj,jk) 
    129                   uebnd(jj,jk,nibm2,nitm) = uebnd(jj,jk,nibm2,nit)*uemsk(jj,jk) 
    130          ! ... fields nit <== now (kt+1)  
    131          ! ... Total or baroclinic velocity at b, bm and bm2 
    132                   zucb   = un(ji,jj,jk) 
    133                   zucbm  = un(ji-1,jj,jk) 
    134                   zucbm2 = un(ji-2,jj,jk) 
    135                   uebnd(jj,jk,nib  ,nit) = zucb   *uemsk(jj,jk) 
    136                   uebnd(jj,jk,nibm ,nit) = zucbm  *uemsk(jj,jk)  
    137                   uebnd(jj,jk,nibm2,nit) = zucbm2 *uemsk(jj,jk)  
    138                END DO 
    139             END DO 
    140          END DO 
    141          IF( lk_mpp )   CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj, numout ) 
    142  
    143          ! ... extremeties nie0, nie1 
    144          ij = jpjed +1 - njmpp 
    145          IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
    146             DO jk = 1,jpkm1 
    147                uebnd(ij,jk,nibm,nitm) = uebnd(ij+1 ,jk,nibm,nitm) 
    148             END DO 
    149          END IF 
    150          ij = jpjef +1 - njmpp 
    151          IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
    152             DO jk = 1,jpkm1 
    153                uebnd(ij,jk,nibm,nitm) = uebnd(ij-1 ,jk,nibm,nitm) 
    154             END DO 
    155          END IF 
    156  
    157          ! 1.2 tangential velocity 
    158          ! ----------------------- 
    159  
    160          ! ... advance in time (time filter, array swap) 
    161          DO jk = 1, jpkm1 
    162             DO jj = 1, jpj 
    163          ! ... fields nitm2 <== nitm 
    164                vebnd(jj,jk,nib  ,nitm2) = vebnd(jj,jk,nib  ,nitm)*vemsk(jj,jk) 
    165                vebnd(jj,jk,nibm ,nitm2) = vebnd(jj,jk,nibm ,nitm)*vemsk(jj,jk) 
    166                vebnd(jj,jk,nibm2,nitm2) = vebnd(jj,jk,nibm2,nitm)*vemsk(jj,jk) 
    167             END DO 
    168          END DO 
    169  
    170          DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt. 
    171             DO jk = 1, jpkm1 
    172                DO jj = 1, jpj 
    173                   vebnd(jj,jk,nib  ,nitm) = vebnd(jj,jk,nib,  nit)*vemsk(jj,jk) 
    174                   vebnd(jj,jk,nibm ,nitm) = vebnd(jj,jk,nibm ,nit)*vemsk(jj,jk) 
    175                   vebnd(jj,jk,nibm2,nitm) = vebnd(jj,jk,nibm2,nit)*vemsk(jj,jk) 
    176          ! ... fields nit <== now (kt+1) 
    177                   vebnd(jj,jk,nib  ,nit) = vn(ji  ,jj,jk)*vemsk(jj,jk) 
    178                   vebnd(jj,jk,nibm ,nit) = vn(ji-1,jj,jk)*vemsk(jj,jk) 
    179                   vebnd(jj,jk,nibm2,nit) = vn(ji-2,jj,jk)*vemsk(jj,jk) 
    180                END DO 
    181             END DO 
    182          END DO 
    183          IF( lk_mpp )   CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj, numout ) 
    184  
    185          !... extremeties nie0, nie1 
    186          ij = jpjed +1 - njmpp 
    187          IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
    188             DO jk = 1,jpkm1 
    189                vebnd(ij,jk,nibm,nitm) = vebnd(ij+1 ,jk,nibm,nitm) 
    190             END DO  
    191          END IF  
    192          ij = jpjef +1 - njmpp  
    193          IF( ij >= 2 .AND. ij < jpjm1 ) THEN  
    194             DO jk = 1,jpkm1  
    195                vebnd(ij,jk,nibm,nitm) = vebnd(ij-1 ,jk,nibm,nitm) 
    196             END DO  
    197          END IF  
    198  
    199          ! 1.3 Temperature and salinity 
    200          ! ---------------------------- 
    201  
    202          ! ... advance in time (time filter, array swap) 
    203          DO jk = 1, jpkm1 
    204             DO jj = 1, jpj 
    205          ! ... fields nitm <== nit  plus time filter at the boundary 
    206                tebnd(jj,jk,nib,nitm) = tebnd(jj,jk,nib,nit)*temsk(jj,jk) 
    207                sebnd(jj,jk,nib,nitm) = sebnd(jj,jk,nib,nit)*temsk(jj,jk) 
    208             END DO 
    209          END DO 
    210  
    211          DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt. 
    212             DO jk = 1, jpkm1 
    213                DO jj = 1, jpj 
    214                   tebnd(jj,jk,nibm,nitm) = tebnd(jj,jk,nibm,nit)*temsk(jj,jk) 
    215                   sebnd(jj,jk,nibm,nitm) = sebnd(jj,jk,nibm,nit)*temsk(jj,jk) 
    216          ! ... fields nit <== now (kt+1) 
    217                   tebnd(jj,jk,nib  ,nit) = tn(ji  ,jj,jk)*temsk(jj,jk) 
    218                   tebnd(jj,jk,nibm ,nit) = tn(ji-1,jj,jk)*temsk(jj,jk) 
    219                   sebnd(jj,jk,nib  ,nit) = sn(ji  ,jj,jk)*temsk(jj,jk) 
    220                   sebnd(jj,jk,nibm ,nit) = sn(ji-1,jj,jk)*temsk(jj,jk) 
    221                END DO 
    222             END DO 
    223          END DO 
    224          IF( lk_mpp )   CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout ) 
    225          IF( lk_mpp )   CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout ) 
    226  
    227          ! ... extremeties nie0, nie1 
    228          ij = jpjed +1 - njmpp 
    229          IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
    230             DO jk = 1,jpkm1 
    231                tebnd(ij,jk,nibm,nitm) = tebnd(ij+1 ,jk,nibm,nitm) 
    232                sebnd(ij,jk,nibm,nitm) = sebnd(ij+1 ,jk,nibm,nitm) 
    233             END DO 
    234          END IF 
    235          ij = jpjef +1 - njmpp 
    236          IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
    237             DO jk = 1,jpkm1 
    238                tebnd(ij,jk,nibm,nitm) = tebnd(ij-1 ,jk,nibm,nitm) 
    239                sebnd(ij,jk,nibm,nitm) = sebnd(ij-1 ,jk,nibm,nitm) 
    240             END DO 
    241          END IF 
    242  
    243       END IF     ! End of array swap 
    244  
    245       ! 2 - Calculation of radiation velocities 
    246       ! --------------------------------------- 
    247  
    248       IF( kt >= nit000 +3 .OR. ln_rstart ) THEN 
    249  
    250          ! 2.1  Calculate the normal velocity U based on phase velocity u_cxebnd 
    251          ! --------------------------------------------------------------------- 
    252          ! 
    253          !          nibm2      nibm      nib 
    254          !            |  nibm   |   nib   |/// 
    255          !            |    |    |    |    |/// 
    256          !  jj-line --f----v----f----v----f--- 
    257          !            |    |    |    |    |/// 
    258          !            |         |         |/// 
    259          !  jj-line   u    T    u    T    u/// 
    260          !            |         |         |/// 
    261          !            |    |    |    |    |/// 
    262          !          jpieob-2   jpieob-1   jpieob 
    263          !                 |         |         
    264          !              jpieob-1    jpieob       
    265          ! 
    266          ! ... (jpjedp1, jpjefm1),jpieob 
    267          DO ji = fs_nie0, fs_nie1 ! Vector opt. 
    268             DO jk = 1, jpkm1 
    269                DO jj = 2, jpjm1 
    270          ! ... 2* gradi(u) (T-point i=nibm, time mean) 
    271                   z2dx = ( uebnd(jj,jk,nibm ,nit) + uebnd(jj,jk,nibm ,nitm2) & 
    272                            - 2.*uebnd(jj,jk,nibm2,nitm) ) / e1t(ji-1,jj) 
    273          ! ... 2* gradj(u) (u-point i=nibm, time nitm) 
    274                   z2dy = ( uebnd(jj+1,jk,nibm,nitm) - uebnd(jj-1,jk,nibm,nitm) ) / e2u(ji-1,jj) 
    275          ! ... square of the norm of grad(u) 
    276                   z4nor2 = z2dx * z2dx + z2dy * z2dy 
    277          ! ... minus time derivative (leap-frog) at nibm, without / 2 dt 
    278                   zdt = uebnd(jj,jk,nibm,nitm2) - uebnd(jj,jk,nibm,nit) 
    279          ! ... i-phase speed ratio (bounded by 1)                
    280                   IF( z4nor2 == 0. ) THEN 
    281                      z4nor2=.00001 
    282                   END IF 
    283                   z05cx = zdt * z2dx / z4nor2 
    284                   u_cxebnd(jj,jk) = z05cx*uemsk(jj,jk) 
    285                END DO 
    286             END DO 
    287          END DO 
    288  
    289          ! 2.2  Calculate the tangential velocity based on phase velocity v_cxebnd 
    290          ! ----------------------------------------------------------------------- 
    291          ! 
    292          !          nibm2      nibm      nib 
    293          !            |   nibm  |   nib///|/// 
    294          !            |    |    |    |////|/// 
    295          !  jj-line --v----f----v----f----v--- 
    296          !            |    |    |    |////|/// 
    297          !            |    |    |    |////|/// 
    298          !            | jpieob-1| jpieob /|/// 
    299          !            |         |         |    
    300          !         jpieob-1    jpieob     jpieob+1 
    301          ! 
    302          ! ... (jpjedp1, jpjefm1), jpieob+1 
    303          DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt. 
    304             DO jk = 1, jpkm1 
    305                DO jj = 2, jpjm1 
    306          ! ... 2* i-gradient of v (f-point i=nibm, time mean) 
    307                   z2dx = ( vebnd(jj,jk,nibm ,nit) + vebnd(jj,jk,nibm ,nitm2) & 
    308                           - 2.*vebnd(jj,jk,nibm2,nitm) ) / e1f(ji-2,jj) 
    309          ! ... 2* j-gradient of v (v-point i=nibm, time nitm) 
    310                   z2dy = ( vebnd(jj+1,jk,nibm,nitm) -  vebnd(jj-1,jk,nibm,nitm) ) / e2v(ji-1,jj) 
    311          ! ... square of the norm of grad(v) 
    312                   z4nor2 = z2dx * z2dx + z2dy * z2dy 
    313          ! ... minus time derivative (leap-frog) at nibm, without / 2 dt 
    314                   zdt = vebnd(jj,jk,nibm,nitm2) - vebnd(jj,jk,nibm,nit) 
    315          ! ... i-phase speed ratio (bounded by 1) and save the unbounded phase 
    316          !     velocity ratio no divided by e1f for the tracer radiation 
    317                   IF( z4nor2 == 0. ) THEN 
    318                      z4nor2=.000001 
    319                   END IF 
    320                   z05cx = zdt * z2dx / z4nor2 
    321                   v_cxebnd(jj,jk) = z05cx*vemsk(jj,jk) 
    322                END DO 
    323             END DO 
    324          END DO 
    325          IF( lk_mpp )   CALL mppobc(v_cxebnd,jpjed,jpjef,jpieob+1,jpk,2,jpj, numout ) 
    326  
    327          ! ... extremeties nie0, nie1 
    328          ij = jpjed +1 - njmpp 
    329          IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
    330             DO jk = 1,jpkm1 
    331                v_cxebnd(ij,jk) = v_cxebnd(ij+1 ,jk) 
    332             END DO 
    333          END IF 
    334          ij = jpjef +1 - njmpp 
    335          IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
    336             DO jk = 1,jpkm1 
    337                v_cxebnd(ij,jk) = v_cxebnd(ij-1 ,jk) 
    338             END DO 
    339          END IF 
    340  
    341       END IF 
    342  
    343    END SUBROUTINE obc_rad_east 
    344  
    345  
    346    SUBROUTINE obc_rad_west ( kt ) 
    347       !!------------------------------------------------------------------------------ 
    348       !!                  ***  SUBROUTINE obc_rad_west  *** 
    349       !!                     
    350       !! ** Purpose : 
    351       !!      Perform swap of arrays to calculate radiative phase speeds at the open  
    352       !!      west boundary and calculate those phase speeds if this OBC is not fixed. 
    353       !!      In case of fixed OBC, this subrountine is not called. 
    354       !! 
    355       !!  History : 
    356       !!         ! 95-03 (J.-M. Molines) Original from SPEM 
    357       !!         ! 97-07 (G. Madec, J.-M. Molines) additions 
    358       !!         ! 97-12 (M. Imbard) Mpp adaptation 
    359       !!         ! 00-06 (J.-M. Molines)  
    360       !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 
    361       !!------------------------------------------------------------------------------ 
    362       !! * Arguments 
    363       INTEGER, INTENT( in ) ::   kt 
    364  
    365       !! * Local declarations 
    366       INTEGER ::   ij 
    367       REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy 
    368       REAL(wp) ::   zucb, zucbm, zucbm2 
    369       !!------------------------------------------------------------------------------ 
    370  
    371       ! 1. Swap arrays before calculating radiative velocities 
    372       ! ------------------------------------------------------ 
    373  
    374       ! 1.1  zonal velocity  
    375       ! ------------------- 
    376  
    377       IF( kt > nit000 .OR. ln_rstart ) THEN 
    378  
    379          ! ... advance in time (time filter, array swap)  
    380          DO jk = 1, jpkm1 
    381             DO jj = 1, jpj  
    382                uwbnd(jj,jk,nib  ,nitm2) = uwbnd(jj,jk,nib  ,nitm)*uwmsk(jj,jk) 
    383                uwbnd(jj,jk,nibm ,nitm2) = uwbnd(jj,jk,nibm ,nitm)*uwmsk(jj,jk) 
    384                uwbnd(jj,jk,nibm2,nitm2) = uwbnd(jj,jk,nibm2,nitm)*uwmsk(jj,jk) 
    385             END DO 
    386          END DO 
    387  
    388          ! ... fields nitm <== nit  plus time filter at the boundary  
    389          DO ji = fs_niw0, fs_niw1 ! Vector opt. 
    390             DO jk = 1, jpkm1 
    391                DO jj = 1, jpj 
    392                   uwbnd(jj,jk,nib  ,nitm) = uwbnd(jj,jk,nib  ,nit)*uwmsk(jj,jk) 
    393                   uwbnd(jj,jk,nibm ,nitm) = uwbnd(jj,jk,nibm ,nit)*uwmsk(jj,jk) 
    394                   uwbnd(jj,jk,nibm2,nitm) = uwbnd(jj,jk,nibm2,nit)*uwmsk(jj,jk) 
    395          ! ... total or baroclinic velocity at b, bm and bm2 
    396                   zucb   = un (ji,jj,jk) 
    397                   zucbm  = un (ji+1,jj,jk) 
    398                   zucbm2 = un (ji+2,jj,jk) 
    399  
    400          ! ... fields nit <== now (kt+1)  
    401                   uwbnd(jj,jk,nib  ,nit) = zucb  *uwmsk(jj,jk) 
    402                   uwbnd(jj,jk,nibm ,nit) = zucbm *uwmsk(jj,jk) 
    403                   uwbnd(jj,jk,nibm2,nit) = zucbm2*uwmsk(jj,jk) 
    404                END DO 
    405             END DO 
    406          END DO 
    407          IF( lk_mpp )   CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout ) 
    408  
    409          ! ... extremeties niw0, niw1 
    410          ij = jpjwd +1 - njmpp 
    411          IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
    412             DO jk = 1,jpkm1 
    413                uwbnd(ij,jk,nibm,nitm) = uwbnd(ij+1 ,jk,nibm,nitm) 
    414             END DO 
    415          END IF 
    416          ij = jpjwf +1 - njmpp 
    417          IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
    418             DO jk = 1,jpkm1 
    419                uwbnd(ij,jk,nibm,nitm) = uwbnd(ij-1 ,jk,nibm,nitm) 
    420             END DO 
    421          END IF 
    422  
    423          ! 1.2 tangential velocity 
    424          ! ----------------------- 
    425  
    426          ! ... advance in time (time filter, array swap) 
    427          DO jk = 1, jpkm1 
    428             DO jj = 1, jpj  
    429          ! ... fields nitm2 <== nitm 
    430                   vwbnd(jj,jk,nib  ,nitm2) = vwbnd(jj,jk,nib  ,nitm)*vwmsk(jj,jk) 
    431                   vwbnd(jj,jk,nibm ,nitm2) = vwbnd(jj,jk,nibm ,nitm)*vwmsk(jj,jk) 
    432                   vwbnd(jj,jk,nibm2,nitm2) = vwbnd(jj,jk,nibm2,nitm)*vwmsk(jj,jk) 
    433             END DO 
    434          END DO 
    435  
    436          DO ji = fs_niw0, fs_niw1 ! Vector opt. 
    437             DO jk = 1, jpkm1 
    438                DO jj = 1, jpj 
    439                   vwbnd(jj,jk,nib  ,nitm) = vwbnd(jj,jk,nib,  nit)*vwmsk(jj,jk) 
    440                   vwbnd(jj,jk,nibm ,nitm) = vwbnd(jj,jk,nibm ,nit)*vwmsk(jj,jk) 
    441                   vwbnd(jj,jk,nibm2,nitm) = vwbnd(jj,jk,nibm2,nit)*vwmsk(jj,jk) 
    442          ! ... fields nit <== now (kt+1) 
    443                   vwbnd(jj,jk,nib  ,nit) = vn(ji  ,jj,jk)*vwmsk(jj,jk) 
    444                   vwbnd(jj,jk,nibm ,nit) = vn(ji+1,jj,jk)*vwmsk(jj,jk) 
    445                   vwbnd(jj,jk,nibm2,nit) = vn(ji+2,jj,jk)*vwmsk(jj,jk) 
    446                END DO 
    447             END DO 
    448          END DO 
    449          IF( lk_mpp )   CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout ) 
    450  
    451          ! ... extremeties niw0, niw1  
    452          ij = jpjwd +1 - njmpp  
    453          IF( ij >= 2 .AND. ij < jpjm1 ) THEN  
    454             DO jk = 1,jpkm1  
    455                vwbnd(ij,jk,nibm,nitm) = vwbnd(ij+1 ,jk,nibm,nitm) 
    456             END DO  
    457          END IF 
    458          ij = jpjwf +1 - njmpp  
    459          IF( ij >= 2 .AND. ij < jpjm1 ) THEN  
    460             DO jk = 1,jpkm1  
    461                vwbnd(ij,jk,nibm,nitm) = vwbnd(ij-1 ,jk,nibm,nitm) 
    462             END DO  
    463          END IF  
    464   
    465          ! 1.3 Temperature and salinity 
    466          ! ---------------------------- 
    467   
    468          ! ... advance in time (time filter, array swap) 
    469          DO jk = 1, jpkm1 
    470             DO jj = 1, jpj 
    471          ! ... fields nitm <== nit  plus time filter at the boundary 
    472                twbnd(jj,jk,nib,nitm) = twbnd(jj,jk,nib,nit)*twmsk(jj,jk) 
    473                swbnd(jj,jk,nib,nitm) = swbnd(jj,jk,nib,nit)*twmsk(jj,jk) 
    474             END DO 
    475          END DO 
    476   
    477          DO ji = fs_niw0, fs_niw1 ! Vector opt. 
    478             DO jk = 1, jpkm1 
    479                DO jj = 1, jpj 
    480                   twbnd(jj,jk,nibm ,nitm) = twbnd(jj,jk,nibm ,nit)*twmsk(jj,jk) 
    481                   swbnd(jj,jk,nibm ,nitm) = swbnd(jj,jk,nibm ,nit)*twmsk(jj,jk) 
    482          ! ... fields nit <== now (kt+1) 
    483                   twbnd(jj,jk,nib  ,nit) = tn(ji   ,jj,jk)*twmsk(jj,jk) 
    484                   twbnd(jj,jk,nibm ,nit) = tn(ji+1 ,jj,jk)*twmsk(jj,jk) 
    485                   swbnd(jj,jk,nib  ,nit) = sn(ji   ,jj,jk)*twmsk(jj,jk) 
    486                   swbnd(jj,jk,nibm ,nit) = sn(ji+1 ,jj,jk)*twmsk(jj,jk) 
    487                END DO 
    488             END DO 
    489          END DO 
    490          IF( lk_mpp )   CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout ) 
    491          IF( lk_mpp )   CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout ) 
    492  
    493          ! ... extremeties niw0, niw1 
    494          ij = jpjwd +1 - njmpp 
    495          IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
    496             DO jk = 1,jpkm1 
    497                twbnd(ij,jk,nibm,nitm) = twbnd(ij+1 ,jk,nibm,nitm) 
    498                swbnd(ij,jk,nibm,nitm) = swbnd(ij+1 ,jk,nibm,nitm) 
    499             END DO 
    500          END IF 
    501          ij = jpjwf +1 - njmpp 
    502          IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
    503             DO jk = 1,jpkm1 
    504                twbnd(ij,jk,nibm,nitm) = twbnd(ij-1 ,jk,nibm,nitm) 
    505                swbnd(ij,jk,nibm,nitm) = swbnd(ij-1 ,jk,nibm,nitm) 
    506             END DO 
    507          END IF 
    508   
    509       END IF     ! End of array swap 
    510  
    511       ! 2 - Calculation of radiation velocities 
    512       ! --------------------------------------- 
    513     
    514       IF( kt >= nit000 +3 .OR. ln_rstart ) THEN 
    515    
    516          ! 2.1  Calculate the normal velocity U based on phase velocity u_cxwbnd 
    517          ! ---------------------------------------------------------------------- 
    518          ! 
    519          !          nib       nibm      nibm2 
    520          !        ///|   nib   |   nibm  | 
    521          !        ///|    |    |    |    | 
    522          !        ---f----v----f----v----f-- jj-line 
    523          !        ///|    |    |    |    | 
    524          !        ///|         |         | 
    525          !        ///u    T    u    T    u   jj-line 
    526          !        ///|         |         | 
    527          !        ///|    |    |    |    | 
    528          !         jpiwob    jpiwob+1    jpiwob+2 
    529          !                |         |         
    530          !              jpiwob+1    jpiwob+2      
    531          ! 
    532          ! ... If free surface formulation: 
    533          ! ... radiative conditions on the total part + relaxation toward climatology 
    534          ! ... (jpjwdp1, jpjwfm1), jpiwob 
    535          DO ji = fs_niw0, fs_niw1 ! Vector opt. 
    536             DO jk = 1, jpkm1 
    537                DO jj = 2, jpjm1 
    538          ! ... 2* gradi(u) (T-point i=nibm, time mean) 
    539                   z2dx = ( - uwbnd(jj,jk,nibm ,nit) -  uwbnd(jj,jk,nibm ,nitm2) & 
    540                            + 2.*uwbnd(jj,jk,nibm2,nitm) ) / e1t(ji+2,jj) 
    541          ! ... 2* gradj(u) (u-point i=nibm, time nitm) 
    542                   z2dy = ( uwbnd(jj+1,jk,nibm,nitm) - uwbnd(jj-1,jk,nibm,nitm) ) / e2u(ji+1,jj) 
    543          ! ... square of the norm of grad(u) 
    544                   z4nor2 = z2dx * z2dx + z2dy * z2dy 
    545          ! ... minus time derivative (leap-frog) at nibm, without / 2 dt 
    546                   zdt = uwbnd(jj,jk,nibm,nitm2) - uwbnd(jj,jk,nibm,nit) 
    547          ! ... i-phase speed ratio (bounded by -1) 
    548                   IF( z4nor2 == 0. ) THEN 
    549                      z4nor2=0.00001 
    550                   END IF 
    551                   z05cx = zdt * z2dx / z4nor2 
    552                   u_cxwbnd(jj,jk)=z05cx*uwmsk(jj,jk) 
    553                END DO 
    554             END DO 
    555          END DO 
    556  
    557          ! 2.2  Calculate the tangential velocity based on phase velocity v_cxwbnd 
    558          ! ----------------------------------------------------------------------- 
    559          ! 
    560          !      nib       nibm     nibm2 
    561          !    ///|///nib   |   nibm  |  nibm2 
    562          !    ///|////|    |    |    |    |    | 
    563          !    ---v----f----v----f----v----f----v-- jj-line 
    564          !    ///|////|    |    |    |    |    | 
    565          !    ///|////|    |    |    |    |    | 
    566          !   jpiwob     jpiwob+1    jpiwob+2 
    567          !            |         |         |    
    568          !          jpiwob   jpiwob+1   jpiwob+2     
    569          ! 
    570          ! ... radiative condition plus Raymond-Kuo 
    571          ! ... (jpjwdp1, jpjwfm1),jpiwob 
    572          DO ji = fs_niw0, fs_niw1 ! Vector opt. 
    573             DO jk = 1, jpkm1 
    574                DO jj = 2, jpjm1 
    575          ! ... 2* i-gradient of v (f-point i=nibm, time mean) 
    576                   z2dx = ( - vwbnd(jj,jk,nibm ,nit) - vwbnd(jj,jk,nibm ,nitm2) & 
    577                            + 2.*vwbnd(jj,jk,nibm2,nitm) ) / e1f(ji+1,jj) 
    578          ! ... 2* j-gradient of v (v-point i=nibm, time nitm) 
    579                   z2dy = ( vwbnd(jj+1,jk,nibm,nitm) - vwbnd(jj-1,jk,nibm,nitm) ) / e2v(ji+1,jj) 
    580          ! ... square of the norm of grad(v) 
    581                   z4nor2 = z2dx * z2dx + z2dy * z2dy 
    582          ! ... minus time derivative (leap-frog) at nibm, without / 2 dt 
    583                   zdt = vwbnd(jj,jk,nibm,nitm2) - vwbnd(jj,jk,nibm,nit) 
    584          ! ... i-phase speed ratio (bounded by -1) and save the unbounded phase 
    585          !     velocity ratio no divided by e1f for the tracer radiation 
    586                   IF( z4nor2 == 0) THEN 
    587                      z4nor2=0.000001 
    588                   endif 
    589                   z05cx = zdt * z2dx / z4nor2 
    590                   v_cxwbnd(jj,jk) = z05cx*vwmsk(jj,jk) 
    591                END DO 
    592             END DO 
    593          END DO 
    594          IF( lk_mpp )   CALL mppobc(v_cxwbnd,jpjwd,jpjwf,jpiwob,jpk,2,jpj, numout ) 
    595  
    596          ! ... extremeties niw0, niw1 
    597          ij = jpjwd +1 - njmpp 
    598          IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
    599             DO jk = 1,jpkm1 
    600                v_cxwbnd(ij,jk) = v_cxwbnd(ij+1 ,jk) 
    601             END DO 
    602          END IF 
    603          ij = jpjwf +1 - njmpp 
    604          IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
    605             DO jk = 1,jpkm1 
    606                v_cxwbnd(ij,jk) = v_cxwbnd(ij-1 ,jk) 
    607             END DO 
    608          END IF 
    609  
    610       END IF 
    611  
    612    END SUBROUTINE obc_rad_west 
    613  
    614  
    615    SUBROUTINE obc_rad_north ( kt ) 
    616       !!------------------------------------------------------------------------------ 
    617       !!                  ***  SUBROUTINE obc_rad_north  *** 
    618       !!            
    619       !! ** Purpose : 
    620       !!      Perform swap of arrays to calculate radiative phase speeds at the open  
    621       !!      north boundary and calculate those phase speeds if this OBC is not fixed. 
    622       !!      In case of fixed OBC, this subrountine is not called. 
    623       !! 
    624       !!  History : 
    625       !!         ! 95-03 (J.-M. Molines) Original from SPEM 
    626       !!         ! 97-07 (G. Madec, J.-M. Molines) additions 
    627       !!         ! 97-12 (M. Imbard) Mpp adaptation 
    628       !!         ! 00-06 (J.-M. Molines)  
    629       !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 
    630       !!------------------------------------------------------------------------------ 
    631       !! * Arguments 
    632       INTEGER, INTENT( in ) ::   kt 
    633  
    634       !! * Local declarations 
    635       INTEGER  ::   ii 
    636       REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy 
    637       REAL(wp) ::   zvcb, zvcbm, zvcbm2 
    638       !!------------------------------------------------------------------------------ 
    639  
    640       ! 1. Swap arrays before calculating radiative velocities 
    641       ! ------------------------------------------------------ 
    642  
    643       ! 1.1  zonal velocity  
    644       ! ------------------- 
    645  
    646       IF( kt > nit000 .OR. ln_rstart ) THEN  
    647  
    648          ! ... advance in time (time filter, array swap) 
    649          DO jk = 1, jpkm1 
    650             DO ji = 1, jpi 
    651          ! ... fields nitm2 <== nitm 
    652                unbnd(ji,jk,nib  ,nitm2) = unbnd(ji,jk,nib  ,nitm)*unmsk(ji,jk) 
    653                unbnd(ji,jk,nibm ,nitm2) = unbnd(ji,jk,nibm ,nitm)*unmsk(ji,jk) 
    654                unbnd(ji,jk,nibm2,nitm2) = unbnd(ji,jk,nibm2,nitm)*unmsk(ji,jk) 
    655             END DO 
    656          END DO 
    657  
    658          DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt. 
    659             DO jk = 1, jpkm1 
    660                DO ji = 1, jpi 
    661                   unbnd(ji,jk,nib  ,nitm) = unbnd(ji,jk,nib,  nit)*unmsk(ji,jk) 
    662                   unbnd(ji,jk,nibm ,nitm) = unbnd(ji,jk,nibm ,nit)*unmsk(ji,jk) 
    663                   unbnd(ji,jk,nibm2,nitm) = unbnd(ji,jk,nibm2,nit)*unmsk(ji,jk) 
    664          ! ... fields nit <== now (kt+1) 
    665                   unbnd(ji,jk,nib  ,nit) = un(ji,jj,  jk)*unmsk(ji,jk) 
    666                   unbnd(ji,jk,nibm ,nit) = un(ji,jj-1,jk)*unmsk(ji,jk) 
    667                   unbnd(ji,jk,nibm2,nit) = un(ji,jj-2,jk)*unmsk(ji,jk) 
    668                END DO 
    669             END DO 
    670          END DO 
    671          IF( lk_mpp )   CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi, numout ) 
    672  
    673          ! ... extremeties njn0,njn1  
    674          ii = jpind + 1 - nimpp  
    675          IF( ii >= 2 .AND. ii < jpim1 ) THEN  
    676             DO jk = 1, jpkm1 
    677                 unbnd(ii,jk,nibm,nitm) = unbnd(ii+1,jk,nibm,nitm) 
    678             END DO 
    679          END IF  
    680          ii = jpinf + 1 - nimpp  
    681          IF( ii >= 2 .AND. ii < jpim1 ) THEN 
    682             DO jk = 1, jpkm1 
    683                unbnd(ii,jk,nibm,nitm) = unbnd(ii-1,jk,nibm,nitm) 
    684             END DO 
    685          END IF 
    686   
    687          ! 1.2. normal velocity  
    688          ! -------------------- 
    689  
    690          ! ... advance in time (time filter, array swap)  
    691          DO jk = 1, jpkm1 
    692             DO ji = 1, jpi 
    693          ! ... fields nitm2 <== nitm  
    694                vnbnd(ji,jk,nib  ,nitm2) = vnbnd(ji,jk,nib  ,nitm)*vnmsk(ji,jk) 
    695                vnbnd(ji,jk,nibm ,nitm2) = vnbnd(ji,jk,nibm ,nitm)*vnmsk(ji,jk) 
    696                vnbnd(ji,jk,nibm2,nitm2) = vnbnd(ji,jk,nibm2,nitm)*vnmsk(ji,jk) 
    697             END DO 
    698          END DO 
    699  
    700          DO jj = fs_njn0, fs_njn1  ! Vector opt. 
    701             DO jk = 1, jpkm1 
    702                DO ji = 1, jpi 
    703                   vnbnd(ji,jk,nib  ,nitm) = vnbnd(ji,jk,nib,  nit)*vnmsk(ji,jk) 
    704                   vnbnd(ji,jk,nibm ,nitm) = vnbnd(ji,jk,nibm ,nit)*vnmsk(ji,jk) 
    705                   vnbnd(ji,jk,nibm2,nitm) = vnbnd(ji,jk,nibm2,nit)*vnmsk(ji,jk) 
    706          ! ... fields nit <== now (kt+1) 
    707          ! ... total or baroclinic velocity at b, bm and bm2 
    708                   zvcb   = vn (ji,jj,jk) 
    709                   zvcbm  = vn (ji,jj-1,jk) 
    710                   zvcbm2 = vn (ji,jj-2,jk) 
    711          ! ... fields nit <== now (kt+1)  
    712                   vnbnd(ji,jk,nib  ,nit) = zvcb  *vnmsk(ji,jk) 
    713                   vnbnd(ji,jk,nibm ,nit) = zvcbm *vnmsk(ji,jk) 
    714                   vnbnd(ji,jk,nibm2,nit) = zvcbm2*vnmsk(ji,jk) 
    715                END DO 
    716             END DO 
    717          END DO 
    718          IF( lk_mpp )   CALL mppobc(vnbnd,jpind,jpinf,jpjnob,jpk*3*3,1,jpi, numout ) 
    719  
    720          ! ... extremeties njn0,njn1 
    721          ii = jpind + 1 - nimpp 
    722          IF( ii >= 2 .AND. ii < jpim1 ) THEN 
    723             DO jk = 1, jpkm1 
    724                vnbnd(ii,jk,nibm,nitm) = vnbnd(ii+1,jk,nibm,nitm) 
    725             END DO 
    726          END IF 
    727          ii = jpinf + 1 - nimpp 
    728          IF( ii >= 2 .AND. ii < jpim1 ) THEN 
    729             DO jk = 1, jpkm1 
    730                vnbnd(ii,jk,nibm,nitm) = vnbnd(ii-1,jk,nibm,nitm) 
    731             END DO 
    732          END IF 
    733  
    734          ! 1.3 Temperature and salinity 
    735          ! ---------------------------- 
    736  
    737          ! ... advance in time (time filter, array swap) 
    738          DO jk = 1, jpkm1 
    739             DO ji = 1, jpi 
    740          ! ... fields nitm <== nit  plus time filter at the boundary 
    741                tnbnd(ji,jk,nib ,nitm) = tnbnd(ji,jk,nib,nit)*tnmsk(ji,jk) 
    742                snbnd(ji,jk,nib ,nitm) = snbnd(ji,jk,nib,nit)*tnmsk(ji,jk) 
    743             END DO 
    744          END DO 
    745  
    746          DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt. 
    747             DO jk = 1, jpkm1 
    748                DO ji = 1, jpi 
    749                   tnbnd(ji,jk,nibm ,nitm) = tnbnd(ji,jk,nibm ,nit)*tnmsk(ji,jk) 
    750                   snbnd(ji,jk,nibm ,nitm) = snbnd(ji,jk,nibm ,nit)*tnmsk(ji,jk) 
    751          ! ... fields nit <== now (kt+1) 
    752                   tnbnd(ji,jk,nib  ,nit) = tn(ji,jj,  jk)*tnmsk(ji,jk) 
    753                   tnbnd(ji,jk,nibm ,nit) = tn(ji,jj-1,jk)*tnmsk(ji,jk) 
    754                   snbnd(ji,jk,nib  ,nit) = sn(ji,jj,  jk)*tnmsk(ji,jk) 
    755                   snbnd(ji,jk,nibm ,nit) = sn(ji,jj-1,jk)*tnmsk(ji,jk) 
    756                END DO 
    757             END DO 
    758          END DO 
    759          IF( lk_mpp )   CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout ) 
    760          IF( lk_mpp )   CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout ) 
    761  
    762          ! ... extremeties  njn0,njn1 
    763          ii = jpind + 1 - nimpp 
    764          IF( ii >= 2 .AND. ii < jpim1 ) THEN 
    765             DO jk = 1, jpkm1 
    766                tnbnd(ii,jk,nibm,nitm) = tnbnd(ii+1,jk,nibm,nitm) 
    767                snbnd(ii,jk,nibm,nitm) = snbnd(ii+1,jk,nibm,nitm) 
    768             END DO 
    769          END IF 
    770          ii = jpinf + 1 - nimpp 
    771          IF( ii >= 2 .AND. ii < jpim1 ) THEN 
    772             DO jk = 1, jpkm1 
    773                tnbnd(ii,jk,nibm,nitm) = tnbnd(ii-1,jk,nibm,nitm) 
    774                snbnd(ii,jk,nibm,nitm) = snbnd(ii-1,jk,nibm,nitm) 
    775             END DO 
    776          END IF 
    777  
    778       END IF     ! End of array swap 
    779  
    780       ! 2 - Calculation of radiation velocities 
    781       ! --------------------------------------- 
    782  
    783       IF( kt >= nit000 +3 .OR. ln_rstart ) THEN 
    784  
    785          ! 2.1  Calculate the normal velocity based on phase velocity u_cynbnd 
    786          ! ------------------------------------------------------------------- 
    787          ! 
    788          !           ji-row 
    789          !             | 
    790          !     nib -///u//////  jpjnob + 1 
    791          !        /////|////// 
    792          !   nib  -----f-----   jpjnob 
    793          !             |     
    794          !     nibm--  u   ---- jpjnob 
    795          !             |         
    796          !  nibm  -----f-----   jpjnob-1 
    797          !             |         
    798          !    nibm2--  u   ---- jpjnob-1 
    799          !             |         
    800          !  nibm2 -----f-----   jpjnob-2 
    801          !             | 
    802          ! ... radiative condition 
    803          ! ... jpjnob+1,(jpindp1, jpinfm1) 
    804          DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt. 
    805             DO jk = 1, jpkm1 
    806                DO ji = 2, jpim1 
    807          ! ... 2* j-gradient of u (f-point i=nibm, time mean) 
    808                   z2dx = ( unbnd(ji,jk,nibm ,nit) + unbnd(ji,jk,nibm ,nitm2) & 
    809                         - 2.*unbnd(ji,jk,nibm2,nitm)) / e2f(ji,jj-2) 
    810          ! ... 2* i-gradient of u (u-point i=nibm, time nitm) 
    811                   z2dy = ( unbnd(ji+1,jk,nibm,nitm) - unbnd(ji-1,jk,nibm,nitm) ) / e1u(ji,jj-1) 
    812          ! ... square of the norm of grad(v) 
    813                   z4nor2 = z2dx * z2dx + z2dy * z2dy 
    814          ! ... minus time derivative (leap-frog) at nibm, without / 2 dt 
    815                   zdt = unbnd(ji,jk,nibm,nitm2) - unbnd(ji,jk,nibm,nit) 
    816          ! ... i-phase speed ratio (bounded by 1) and save the unbounded phase 
    817          !     velocity ratio no divided by e1f for the tracer radiation 
    818                   IF( z4nor2 == 0.) THEN 
    819                      z4nor2=.000001 
    820                   END IF 
    821                   z05cx = zdt * z2dx / z4nor2 
    822                   u_cynbnd(ji,jk) = z05cx *unmsk(ji,jk) 
    823                END DO 
    824             END DO 
    825          END DO 
    826          IF( lk_mpp )   CALL mppobc(u_cynbnd,jpind,jpinf,jpjnob+1,jpk,1,jpi, numout ) 
    827  
    828          ! ... extremeties  njn0,njn1 
    829          ii = jpind + 1 - nimpp 
    830          IF( ii >= 2 .AND. ii < jpim1 ) THEN 
    831             DO jk = 1, jpkm1 
    832                u_cynbnd(ii,jk) = u_cynbnd(ii+1,jk) 
    833             END DO 
    834          END IF 
    835          ii = jpinf + 1 - nimpp 
    836          IF( ii >= 2 .AND. ii < jpim1 ) THEN 
    837             DO jk = 1, jpkm1 
    838                u_cynbnd(ii,jk) = u_cynbnd(ii-1,jk) 
    839             END DO 
    840          END IF 
    841  
    842          ! 2.2 Calculate the normal velocity based on phase velocity v_cynbnd  
    843          ! ------------------------------------------------------------------ 
    844          ! 
    845          !                ji-row  ji-row 
    846          !                     | 
    847          !        /////|///////////////// 
    848          !   nib  -----f----v----f----  jpjnob 
    849          !             |         | 
    850          !     nib  -  u -- T -- u ---- jpjnob 
    851          !             |         | 
    852          !  nibm  -----f----v----f----  jpjnob-1 
    853          !             |         | 
    854          !    nibm --  u -- T -- u ---  jpjnob-1 
    855          !             |         | 
    856          !  nibm2 -----f----v----f----  jpjnob-2 
    857          !             |         | 
    858          ! ... Free surface formulation: 
    859          ! ... radiative conditions on the total part + relaxation toward climatology  
    860          ! ... jpjnob,(jpindp1, jpinfm1) 
    861          DO jj = fs_njn0, fs_njn1  ! Vector opt. 
    862             DO jk = 1, jpkm1 
    863                DO ji = 2, jpim1 
    864          ! ... 2* gradj(v) (T-point i=nibm, time mean) 
    865                   ii = ji -1 + nimpp 
    866                   z2dx = ( vnbnd(ji,jk,nibm ,nit) + vnbnd(ji,jk,nibm ,nitm2) & 
    867                           - 2.*vnbnd(ji,jk,nibm2,nitm)) / e2t(ji,jj-1) 
    868          ! ... 2* gradi(v) (v-point i=nibm, time nitm) 
    869                   z2dy = ( vnbnd(ji+1,jk,nibm,nitm) - vnbnd(ji-1,jk,nibm,nitm) ) / e1v(ji,jj-1) 
    870          ! ... square of the norm of grad(u) 
    871                   z4nor2 = z2dx * z2dx + z2dy * z2dy 
    872          ! ... minus time derivative (leap-frog) at nibm, without / 2 dt 
    873                   zdt = vnbnd(ji,jk,nibm,nitm2) - vnbnd(ji,jk,nibm,nit) 
    874          ! ... j-phase speed ratio (bounded by 1) 
    875                   IF( z4nor2 == 0. ) THEN 
    876                      z4nor2=.00001 
    877                   END IF 
    878                   z05cx = zdt * z2dx / z4nor2 
    879                   v_cynbnd(ji,jk)=z05cx *vnmsk(ji,jk) 
    880                END DO 
    881             END DO 
    882          END DO 
    883  
    884       END IF 
    885  
    886    END SUBROUTINE obc_rad_north 
    887  
    888  
    889    SUBROUTINE obc_rad_south ( kt ) 
    890       !!------------------------------------------------------------------------------ 
    891       !!                  ***  SUBROUTINE obc_rad_south  *** 
    892       !!            
    893       !! ** Purpose : 
    894       !!      Perform swap of arrays to calculate radiative phase speeds at the open  
    895       !!      south boundary and calculate those phase speeds if this OBC is not fixed. 
    896       !!      In case of fixed OBC, this subrountine is not called. 
    897       !! 
    898       !!  History : 
    899       !!         ! 95-03 (J.-M. Molines) Original from SPEM 
    900       !!         ! 97-07 (G. Madec, J.-M. Molines) additions 
    901       !!         ! 97-12 (M. Imbard) Mpp adaptation 
    902       !!         ! 00-06 (J.-M. Molines)  
    903       !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 
    904       !!------------------------------------------------------------------------------ 
    905       !! * Arguments 
    906       INTEGER, INTENT( in ) ::   kt 
    907  
    908       !! * Local declarations 
    909       INTEGER ::   ii 
    910       REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy 
    911       REAL(wp) ::   zvcb, zvcbm, zvcbm2 
    912       !!------------------------------------------------------------------------------ 
    913  
    914       ! 1. Swap arrays before calculating radiative velocities 
    915       ! ------------------------------------------------------ 
    916  
    917       ! 1.1  zonal velocity  
    918       ! -------------------- 
    919    
    920       IF( kt > nit000 .OR. ln_rstart ) THEN  
    921  
    922          ! ... advance in time (time filter, array swap) 
    923          DO jk = 1, jpkm1 
    924             DO ji = 1, jpi 
    925          ! ... fields nitm2 <== nitm 
    926                   usbnd(ji,jk,nib  ,nitm2) = usbnd(ji,jk,nib  ,nitm)*usmsk(ji,jk) 
    927                   usbnd(ji,jk,nibm ,nitm2) = usbnd(ji,jk,nibm ,nitm)*usmsk(ji,jk) 
    928                   usbnd(ji,jk,nibm2,nitm2) = usbnd(ji,jk,nibm2,nitm)*usmsk(ji,jk) 
    929             END DO 
    930          END DO 
    931   
    932          DO jj = fs_njs0, fs_njs1  ! Vector opt. 
    933             DO jk = 1, jpkm1 
    934                DO ji = 1, jpi 
    935                   usbnd(ji,jk,nib  ,nitm) = usbnd(ji,jk,nib,  nit)*usmsk(ji,jk) 
    936                   usbnd(ji,jk,nibm ,nitm) = usbnd(ji,jk,nibm ,nit)*usmsk(ji,jk) 
    937                   usbnd(ji,jk,nibm2,nitm) = usbnd(ji,jk,nibm2,nit)*usmsk(ji,jk) 
    938          ! ... fields nit <== now (kt+1) 
    939                   usbnd(ji,jk,nib  ,nit) = un(ji,jj  ,jk)*usmsk(ji,jk) 
    940                   usbnd(ji,jk,nibm ,nit) = un(ji,jj+1,jk)*usmsk(ji,jk) 
    941                   usbnd(ji,jk,nibm2,nit) = un(ji,jj+2,jk)*usmsk(ji,jk) 
    942                END DO 
    943             END DO 
    944          END DO 
    945          IF( lk_mpp )   CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout ) 
    946  
    947          ! ... extremeties njs0,njs1 
    948          ii = jpisd + 1 - nimpp 
    949          IF( ii >= 2 .AND. ii < jpim1 ) THEN 
    950             DO jk = 1, jpkm1 
    951                usbnd(ii,jk,nibm,nitm) = usbnd(ii+1,jk,nibm,nitm) 
    952             END DO 
    953          END IF 
    954          ii = jpisf + 1 - nimpp 
    955          IF( ii >= 2 .AND. ii < jpim1 ) THEN 
    956             DO jk = 1, jpkm1 
    957                usbnd(ii,jk,nibm,nitm) = usbnd(ii-1,jk,nibm,nitm) 
    958             END DO 
    959          END IF 
    960   
    961          ! 1.2 normal velocity 
    962          ! ------------------- 
    963   
    964          !.. advance in time (time filter, array swap)  
    965          DO jk = 1, jpkm1 
    966             DO ji = 1, jpi 
    967          ! ... fields nitm2 <== nitm  
    968                vsbnd(ji,jk,nib  ,nitm2) = vsbnd(ji,jk,nib  ,nitm)*vsmsk(ji,jk) 
    969                vsbnd(ji,jk,nibm ,nitm2) = vsbnd(ji,jk,nibm ,nitm)*vsmsk(ji,jk) 
    970             END DO 
    971          END DO 
    972  
    973          DO jj = fs_njs0, fs_njs1  ! Vector opt. 
    974             DO jk = 1, jpkm1 
    975                DO ji = 1, jpi 
    976                   vsbnd(ji,jk,nib  ,nitm) = vsbnd(ji,jk,nib,  nit)*vsmsk(ji,jk) 
    977                   vsbnd(ji,jk,nibm ,nitm) = vsbnd(ji,jk,nibm ,nit)*vsmsk(ji,jk) 
    978                   vsbnd(ji,jk,nibm2,nitm) = vsbnd(ji,jk,nibm2,nit)*vsmsk(ji,jk) 
    979          ! ... total or baroclinic velocity at b, bm and bm2 
    980                   zvcb   = vn (ji,jj,jk) 
    981                   zvcbm  = vn (ji,jj+1,jk) 
    982                   zvcbm2 = vn (ji,jj+2,jk) 
    983          ! ... fields nit <== now (kt+1)  
    984                   vsbnd(ji,jk,nib  ,nit) = zvcb   *vsmsk(ji,jk) 
    985                   vsbnd(ji,jk,nibm ,nit) = zvcbm  *vsmsk(ji,jk) 
    986                   vsbnd(ji,jk,nibm2,nit) = zvcbm2 *vsmsk(ji,jk) 
    987                END DO 
    988             END DO 
    989          END DO 
    990          IF( lk_mpp )   CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout ) 
    991  
    992          ! ... extremeties njs0,njs1 
    993          ii = jpisd + 1 - nimpp 
    994          IF( ii >= 2 .AND. ii < jpim1 ) THEN 
    995             DO jk = 1, jpkm1 
    996                vsbnd(ii,jk,nibm,nitm) = vsbnd(ii+1,jk,nibm,nitm) 
    997             END DO 
    998          END IF 
    999          ii = jpisf + 1 - nimpp 
    1000          IF( ii >= 2 .AND. ii < jpim1 ) THEN 
    1001             DO jk = 1, jpkm1 
    1002                vsbnd(ii,jk,nibm,nitm) = vsbnd(ii-1,jk,nibm,nitm) 
    1003             END DO 
    1004          END IF 
    1005  
    1006          ! 1.3 Temperature and salinity 
    1007          ! ---------------------------- 
    1008  
    1009          ! ... advance in time (time filter, array swap) 
    1010          DO jk = 1, jpkm1 
    1011             DO ji = 1, jpi 
    1012          ! ... fields nitm <== nit  plus time filter at the boundary 
    1013                tsbnd(ji,jk,nib,nitm) = tsbnd(ji,jk,nib,nit)*tsmsk(ji,jk) 
    1014                ssbnd(ji,jk,nib,nitm) = ssbnd(ji,jk,nib,nit)*tsmsk(ji,jk) 
    1015             END DO 
    1016          END DO 
    1017  
    1018          DO jj = fs_njs0, fs_njs1  ! Vector opt. 
    1019             DO jk = 1, jpkm1 
    1020                DO ji = 1, jpi 
    1021                   tsbnd(ji,jk,nibm ,nitm) = tsbnd(ji,jk,nibm ,nit)*tsmsk(ji,jk) 
    1022                   ssbnd(ji,jk,nibm ,nitm) = ssbnd(ji,jk,nibm ,nit)*tsmsk(ji,jk) 
    1023          ! ... fields nit <== now (kt+1) 
    1024                   tsbnd(ji,jk,nib  ,nit) = tn(ji,jj   ,jk)*tsmsk(ji,jk) 
    1025                   tsbnd(ji,jk,nibm ,nit) = tn(ji,jj+1 ,jk)*tsmsk(ji,jk) 
    1026                   ssbnd(ji,jk,nib  ,nit) = sn(ji,jj   ,jk)*tsmsk(ji,jk) 
    1027                   ssbnd(ji,jk,nibm ,nit) = sn(ji,jj+1 ,jk)*tsmsk(ji,jk) 
    1028                END DO 
    1029             END DO 
    1030          END DO 
    1031          IF( lk_mpp )   CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout ) 
    1032          IF( lk_mpp )   CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout ) 
    1033  
    1034          ! ... extremeties  njs0,njs1 
    1035          ii = jpisd + 1 - nimpp 
    1036          IF( ii >= 2 .AND. ii < jpim1 ) THEN 
    1037             DO jk = 1, jpkm1 
    1038                tsbnd(ii,jk,nibm,nitm) = tsbnd(ii+1,jk,nibm,nitm) 
    1039                ssbnd(ii,jk,nibm,nitm) = ssbnd(ii+1,jk,nibm,nitm) 
    1040             END DO 
    1041          END IF 
    1042          ii = jpisf + 1 - nimpp 
    1043          IF( ii >= 2 .AND. ii < jpim1 ) THEN 
    1044             DO jk = 1, jpkm1 
    1045                tsbnd(ii,jk,nibm,nitm) = tsbnd(ii-1,jk,nibm,nitm) 
    1046