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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 6060 for branches/2015/dev_merge_2015/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90 – NEMO

Ignore:
Timestamp:
2015-12-16T10:25:22+01:00 (8 years ago)
Author:
timgraham
Message:

Merged dev_r5836_noc2_VVL_BY_DEFAULT into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r5930 r6060  
    2222   USE oce 
    2323   USE dom_oce       
     24   USE zdf_oce 
    2425   USE agrif_oce 
    2526   USE phycst 
     27   ! 
    2628   USE in_out_manager 
    2729   USE agrif_opa_sponge 
    2830   USE lib_mpp 
    2931   USE wrk_nemo 
    30    USE zdf_oce 
    3132  
    3233   IMPLICIT NONE 
    3334   PRIVATE 
    34  
    35    INTEGER :: bdy_tinterp = 0 
    3635 
    3736   PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 
     
    4443# endif 
    4544 
    46 #  include "domzgr_substitute.h90"   
     45   INTEGER ::   bdy_tinterp = 0 
     46 
    4747#  include "vectopt_loop_substitute.h90" 
    4848   !!---------------------------------------------------------------------- 
    49    !! NEMO/NST 3.6 , NEMO Consortium (2010) 
     49   !! NEMO/NST 3.7 , NEMO Consortium (2015) 
    5050   !! $Id$ 
    5151   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5252   !!---------------------------------------------------------------------- 
    53  
    5453CONTAINS 
    5554 
     
    6059      ! 
    6160      IF( Agrif_Root() )   RETURN 
    62  
    63       Agrif_SpecialValue    = 0.e0 
     61      ! 
     62      Agrif_SpecialValue    = 0._wp 
    6463      Agrif_UseSpecialValue = .TRUE. 
    65  
     64      ! 
    6665      CALL Agrif_Bc_variable( tsn_id, procname=interptsn ) 
     66      ! 
    6767      Agrif_UseSpecialValue = .FALSE. 
    6868      ! 
     
    7474      !!                  ***  ROUTINE Agrif_DYN  *** 
    7575      !!----------------------------------------------------------------------   
    76       !!  
    7776      INTEGER, INTENT(in) ::   kt 
    78       !! 
    79       INTEGER :: ji,jj,jk, j1,j2, i1,i2 
    80       REAL(wp), POINTER, DIMENSION(:,:) :: zub, zvb 
    81       !!----------------------------------------------------------------------   
    82  
     77      ! 
     78      INTEGER ::   ji, jj, jk       ! dummy loop indices 
     79      INTEGER ::   j1, j2, i1, i2 
     80      REAL(wp), POINTER, DIMENSION(:,:) ::   zub, zvb 
     81      !!----------------------------------------------------------------------   
     82      ! 
    8383      IF( Agrif_Root() )   RETURN 
    84  
    85       CALL wrk_alloc( jpi, jpj, zub, zvb ) 
    86  
    87       Agrif_SpecialValue=0. 
     84      ! 
     85      CALL wrk_alloc( jpi,jpj,  zub, zvb ) 
     86      ! 
     87      Agrif_SpecialValue    = 0._wp 
    8888      Agrif_UseSpecialValue = ln_spc_dyn 
    89  
    90       CALL Agrif_Bc_variable(un_interp_id,procname=interpun) 
    91       CALL Agrif_Bc_variable(vn_interp_id,procname=interpvn) 
    92  
     89      ! 
     90      CALL Agrif_Bc_variable( un_interp_id, procname=interpun ) 
     91      CALL Agrif_Bc_variable( vn_interp_id, procname=interpvn ) 
     92      ! 
    9393      Agrif_UseSpecialValue = .FALSE. 
    94   
     94      ! 
    9595      ! prevent smoothing in ghost cells 
    96       i1=1 
    97       i2=jpi 
    98       j1=1 
    99       j2=jpj 
    100       IF((nbondj == -1).OR.(nbondj == 2)) j1 = 3 
    101       IF((nbondj == +1).OR.(nbondj == 2)) j2 = nlcj-2 
    102       IF((nbondi == -1).OR.(nbondi == 2)) i1 = 3 
    103       IF((nbondi == +1).OR.(nbondi == 2)) i2 = nlci-2 
    104  
    105  
    106       IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    107  
     96      i1 =  1   ;   i2 = jpi 
     97      j1 =  1   ;   j2 = jpj 
     98      IF( nbondj == -1 .OR. nbondj == 2 )   j1 = 3 
     99      IF( nbondj == +1 .OR. nbondj == 2 )   j2 = nlcj-2 
     100      IF( nbondi == -1 .OR. nbondi == 2 )   i1 = 3 
     101      IF( nbondi == +1 .OR. nbondi == 2 )   i2 = nlci-2 
     102 
     103      IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
     104         ! 
    108105         ! Smoothing 
    109106         ! --------- 
    110          IF ( .NOT.ln_dynspg_ts ) THEN ! Store transport 
    111             ua_b(2,:)=0._wp 
    112             DO jk=1,jpkm1 
    113                DO jj=1,jpj 
    114                   ua_b(2,jj) = ua_b(2,jj) + fse3u_a(2,jj,jk) * ua(2,jj,jk) 
    115                END DO 
    116             END DO 
    117             DO jj=1,jpj 
    118                ua_b(2,jj) = ua_b(2,jj) * hur_a(2,jj)             
    119             END DO 
    120          ENDIF 
    121  
     107         IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 
     108            ua_b(2,:) = 0._wp 
     109            DO jk = 1, jpkm1 
     110               DO jj = 1, jpj 
     111                  ua_b(2,jj) = ua_b(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 
     112               END DO 
     113            END DO 
     114            DO jj = 1, jpj 
     115               ua_b(2,jj) = ua_b(2,jj) * r1_hu_a(2,jj)             
     116            END DO 
     117         ENDIF 
     118         ! 
    122119         DO jk=1,jpkm1                 ! Smooth 
    123120            DO jj=j1,j2 
     
    126123            END DO 
    127124         END DO 
    128  
    129          zub(2,:)=0._wp                ! Correct transport 
    130          DO jk=1,jpkm1 
    131             DO jj=1,jpj 
    132                zub(2,jj) = zub(2,jj) + fse3u_a(2,jj,jk) * ua(2,jj,jk) 
     125         ! 
     126         zub(2,:) = 0._wp              ! Correct transport 
     127         DO jk = 1, jpkm1 
     128            DO jj = 1, jpj 
     129               zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 
    133130            END DO 
    134131         END DO 
    135132         DO jj=1,jpj 
    136             zub(2,jj) = zub(2,jj) * hur_a(2,jj) 
     133            zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj) 
    137134         END DO 
    138135 
     
    145142         ! Set tangential velocities to time splitting estimate 
    146143         !----------------------------------------------------- 
    147          IF ( ln_dynspg_ts) THEN 
    148             zvb(2,:)=0._wp 
     144         IF( ln_dynspg_ts ) THEN 
     145            zvb(2,:) = 0._wp 
     146            DO jk = 1, jpkm1 
     147               DO jj = 1, jpj 
     148                  zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk) 
     149               END DO 
     150            END DO 
     151            DO jj = 1, jpj 
     152               zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj) 
     153            END DO 
     154            DO jk = 1, jpkm1 
     155               DO jj = 1, jpj 
     156                  va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk) 
     157               END DO 
     158            END DO 
     159         ENDIF 
     160         ! 
     161         ! Mask domain edges: 
     162         !------------------- 
     163         DO jk = 1, jpkm1 
     164            DO jj = 1, jpj 
     165               ua(1,jj,jk) = 0._wp 
     166               va(1,jj,jk) = 0._wp 
     167            END DO 
     168         END DO          
     169         ! 
     170      ENDIF 
     171 
     172      IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
     173 
     174         ! Smoothing 
     175         ! --------- 
     176         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     177            ua_b(nlci-2,:) = 0._wp 
    149178            DO jk=1,jpkm1 
    150179               DO jj=1,jpj 
    151                   zvb(2,jj) = zvb(2,jj) + fse3v_a(2,jj,jk) * va(2,jj,jk) 
     180                  ua_b(nlci-2,jj) = ua_b(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 
    152181               END DO 
    153182            END DO 
    154183            DO jj=1,jpj 
    155                zvb(2,jj) = zvb(2,jj) * hvr_a(2,jj) 
    156             END DO 
    157             DO jk=1,jpkm1 
    158                DO jj=1,jpj 
    159                   va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj))*vmask(2,jj,jk) 
    160                END DO 
    161             END DO 
    162          ENDIF 
    163  
     184               ua_b(nlci-2,jj) = ua_b(nlci-2,jj) * r1_hu_a(nlci-2,jj)             
     185            END DO 
     186         ENDIF 
     187 
     188         DO jk = 1, jpkm1              ! Smooth 
     189            DO jj = j1, j2 
     190               ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk)      & 
     191                  &             * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 
     192            END DO 
     193         END DO 
     194 
     195         zub(nlci-2,:) = 0._wp        ! Correct transport 
     196         DO jk = 1, jpkm1 
     197            DO jj = 1, jpj 
     198               zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 
     199            END DO 
     200         END DO 
     201         DO jj = 1, jpj 
     202            zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 
     203         END DO 
     204 
     205         DO jk = 1, jpkm1 
     206            DO jj = 1, jpj 
     207               ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 
     208            END DO 
     209         END DO 
     210         ! 
     211         ! Set tangential velocities to time splitting estimate 
     212         !----------------------------------------------------- 
     213         IF( ln_dynspg_ts ) THEN 
     214            zvb(nlci-1,:) = 0._wp 
     215            DO jk = 1, jpkm1 
     216               DO jj = 1, jpj 
     217                  zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 
     218               END DO 
     219            END DO 
     220            DO jj=1,jpj 
     221               zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj) 
     222            END DO 
     223            DO jk = 1, jpkm1 
     224               DO jj = 1, jpj 
     225                  va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk) 
     226               END DO 
     227            END DO 
     228         ENDIF 
     229         ! 
    164230         ! Mask domain edges: 
    165231         !------------------- 
    166          DO jk=1,jpkm1 
    167             DO jj=1,jpj 
    168                ua(1,jj,jk) = 0._wp 
    169                va(1,jj,jk) = 0._wp 
    170             END DO 
    171          END DO          
    172  
    173       ENDIF 
    174  
    175       IF((nbondi == 1).OR.(nbondi == 2)) THEN 
     232         DO jk = 1, jpkm1 
     233            DO jj = 1, jpj 
     234               ua(nlci-1,jj,jk) = 0._wp 
     235               va(nlci  ,jj,jk) = 0._wp 
     236            END DO 
     237         END DO  
     238         ! 
     239      ENDIF 
     240 
     241      IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
    176242 
    177243         ! Smoothing 
    178244         ! --------- 
    179          IF ( .NOT.ln_dynspg_ts ) THEN ! Store transport 
    180             ua_b(nlci-2,:)=0._wp 
    181             DO jk=1,jpkm1 
    182                DO jj=1,jpj 
    183                   ua_b(nlci-2,jj) = ua_b(nlci-2,jj) + fse3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 
    184                END DO 
    185             END DO 
    186             DO jj=1,jpj 
    187                ua_b(nlci-2,jj) = ua_b(nlci-2,jj) * hur_a(nlci-2,jj)             
    188             END DO 
    189          ENDIF 
    190  
    191          DO jk=1,jpkm1                 ! Smooth 
    192             DO jj=j1,j2 
    193                ua(nlci-2,jj,jk) = 0.25_wp*(ua(nlci-3,jj,jk)+2._wp*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk)) 
    194                ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk) 
    195             END DO 
    196          END DO 
    197  
    198          zub(nlci-2,:)=0._wp           ! Correct transport 
     245         IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 
     246            va_b(:,2) = 0._wp 
     247            DO jk = 1, jpkm1 
     248               DO ji = 1, jpi 
     249                  va_b(ji,2) = va_b(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) 
     250               END DO 
     251            END DO 
     252            DO ji=1,jpi 
     253               va_b(ji,2) = va_b(ji,2) * r1_hv_a(ji,2)             
     254            END DO 
     255         ENDIF 
     256         ! 
     257         DO jk = 1, jpkm1              ! Smooth 
     258            DO ji = i1, i2 
     259               va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk)    & 
     260                  &        * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 
     261            END DO 
     262         END DO 
     263         ! 
     264         zvb(:,2) = 0._wp              ! Correct transport 
    199265         DO jk=1,jpkm1 
    200             DO jj=1,jpj 
    201                zub(nlci-2,jj) = zub(nlci-2,jj) + fse3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 
    202             END DO 
    203          END DO 
    204          DO jj=1,jpj 
    205             zub(nlci-2,jj) = zub(nlci-2,jj) * hur_a(nlci-2,jj) 
    206          END DO 
    207  
    208          DO jk=1,jpkm1 
    209             DO jj=1,jpj 
    210                ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)+ua_b(nlci-2,jj)-zub(nlci-2,jj))*umask(nlci-2,jj,jk) 
     266            DO ji=1,jpi 
     267               zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 
     268            END DO 
     269         END DO 
     270         DO ji = 1, jpi 
     271            zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2) 
     272         END DO 
     273         DO jk = 1, jpkm1 
     274            DO ji = 1, jpi 
     275               va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk) 
    211276            END DO 
    212277         END DO 
     
    214279         ! Set tangential velocities to time splitting estimate 
    215280         !----------------------------------------------------- 
    216          IF ( ln_dynspg_ts) THEN 
    217             zvb(nlci-1,:)=0._wp 
    218             DO jk=1,jpkm1 
    219                DO jj=1,jpj 
    220                   zvb(nlci-1,jj) = zvb(nlci-1,jj) + fse3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 
    221                END DO 
    222             END DO 
    223             DO jj=1,jpj 
    224                zvb(nlci-1,jj) = zvb(nlci-1,jj) * hvr_a(nlci-1,jj) 
    225             END DO 
    226             DO jk=1,jpkm1 
    227                DO jj=1,jpj 
    228                   va(nlci-1,jj,jk) = (va(nlci-1,jj,jk)+va_b(nlci-1,jj)-zvb(nlci-1,jj))*vmask(nlci-1,jj,jk) 
     281         IF( ln_dynspg_ts ) THEN 
     282            zub(:,2) = 0._wp 
     283            DO jk = 1, jpkm1 
     284               DO ji = 1, jpi 
     285                  zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 
     286               END DO 
     287            END DO 
     288            DO ji = 1, jpi 
     289               zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 
     290            END DO 
     291 
     292            DO jk = 1, jpkm1 
     293               DO ji = 1, jpi 
     294                  ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk) 
    229295               END DO 
    230296            END DO 
     
    233299         ! Mask domain edges: 
    234300         !------------------- 
    235          DO jk=1,jpkm1 
    236             DO jj=1,jpj 
    237                ua(nlci-1,jj,jk) = 0._wp 
    238                va(nlci  ,jj,jk) = 0._wp 
     301         DO jk = 1, jpkm1 
     302            DO ji = 1, jpi 
     303               ua(ji,1,jk) = 0._wp 
     304               va(ji,1,jk) = 0._wp 
    239305            END DO 
    240306         END DO  
     
    242308      ENDIF 
    243309 
    244       IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    245  
     310      IF( nbondj == 1 .OR. nbondj == 2 ) THEN 
     311         ! 
    246312         ! Smoothing 
    247313         ! --------- 
    248          IF ( .NOT.ln_dynspg_ts ) THEN ! Store transport 
    249             va_b(:,2)=0._wp 
    250             DO jk=1,jpkm1 
    251                DO ji=1,jpi 
    252                   va_b(ji,2) = va_b(ji,2) + fse3v_a(ji,2,jk) * va(ji,2,jk) 
    253                END DO 
    254             END DO 
    255             DO ji=1,jpi 
    256                va_b(ji,2) = va_b(ji,2) * hvr_a(ji,2)             
    257             END DO 
    258          ENDIF 
    259  
    260          DO jk=1,jpkm1                 ! Smooth 
    261             DO ji=i1,i2 
    262                va(ji,2,jk)=0.25_wp*(va(ji,1,jk)+2._wp*va(ji,2,jk)+va(ji,3,jk)) 
    263                va(ji,2,jk)=va(ji,2,jk)*vmask(ji,2,jk) 
    264             END DO 
    265          END DO 
    266  
    267          zvb(:,2)=0._wp                ! Correct transport 
    268          DO jk=1,jpkm1 
    269             DO ji=1,jpi 
    270                zvb(ji,2) = zvb(ji,2) + fse3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 
    271             END DO 
    272          END DO 
    273          DO ji=1,jpi 
    274             zvb(ji,2) = zvb(ji,2) * hvr_a(ji,2) 
    275          END DO 
    276          DO jk=1,jpkm1 
    277             DO ji=1,jpi 
    278                va(ji,2,jk) = (va(ji,2,jk)+va_b(ji,2)-zvb(ji,2))*vmask(ji,2,jk) 
    279             END DO 
    280          END DO 
    281  
     314         IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 
     315            va_b(:,nlcj-2) = 0._wp 
     316            DO jk = 1, jpkm1 
     317               DO ji = 1, jpi 
     318                  va_b(ji,nlcj-2) = va_b(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) 
     319               END DO 
     320            END DO 
     321            DO ji = 1, jpi 
     322               va_b(ji,nlcj-2) = va_b(ji,nlcj-2) * r1_hv_a(ji,nlcj-2)             
     323            END DO 
     324         ENDIF 
     325         ! 
     326         DO jk = 1, jpkm1              ! Smooth 
     327            DO ji = i1, i2 
     328               va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk)   & 
     329                  &             * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 
     330            END DO 
     331         END DO 
     332         ! 
     333         zvb(:,nlcj-2) = 0._wp         ! Correct transport 
     334         DO jk = 1, jpkm1 
     335            DO ji = 1, jpi 
     336               zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 
     337            END DO 
     338         END DO 
     339         DO ji = 1, jpi 
     340            zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 
     341         END DO 
     342         DO jk = 1, jpkm1 
     343            DO ji = 1, jpi 
     344               va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk) 
     345            END DO 
     346         END DO 
     347         ! 
    282348         ! Set tangential velocities to time splitting estimate 
    283349         !----------------------------------------------------- 
    284          IF ( ln_dynspg_ts ) THEN 
    285             zub(:,2)=0._wp 
    286             DO jk=1,jpkm1 
    287                DO ji=1,jpi 
    288                   zub(ji,2) = zub(ji,2) + fse3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 
    289                END DO 
    290             END DO 
    291             DO ji=1,jpi 
    292                zub(ji,2) = zub(ji,2) * hur_a(ji,2) 
    293             END DO 
    294  
    295             DO jk=1,jpkm1 
    296                DO ji=1,jpi 
    297                   ua(ji,2,jk) = (ua(ji,2,jk)+ua_b(ji,2)-zub(ji,2))*umask(ji,2,jk) 
    298                END DO 
    299             END DO 
    300          ENDIF 
    301  
     350         IF( ln_dynspg_ts ) THEN 
     351            zub(:,nlcj-1) = 0._wp 
     352            DO jk = 1, jpkm1 
     353               DO ji = 1, jpi 
     354                  zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 
     355               END DO 
     356            END DO 
     357            DO ji = 1, jpi 
     358               zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1) 
     359            END DO 
     360            ! 
     361            DO jk = 1, jpkm1 
     362               DO ji = 1, jpi 
     363                  ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk) 
     364               END DO 
     365            END DO 
     366         ENDIF 
     367         ! 
    302368         ! Mask domain edges: 
    303369         !------------------- 
    304          DO jk=1,jpkm1 
    305             DO ji=1,jpi 
    306                ua(ji,1,jk) = 0._wp 
    307                va(ji,1,jk) = 0._wp 
    308             END DO 
    309          END DO  
    310  
    311       ENDIF 
    312  
    313       IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    314          ! Smoothing 
    315          ! --------- 
    316          IF ( .NOT.ln_dynspg_ts ) THEN ! Store transport 
    317             va_b(:,nlcj-2)=0._wp 
    318             DO jk=1,jpkm1 
    319                DO ji=1,jpi 
    320                   va_b(ji,nlcj-2) = va_b(ji,nlcj-2) + fse3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) 
    321                END DO 
    322             END DO 
    323             DO ji=1,jpi 
    324                va_b(ji,nlcj-2) = va_b(ji,nlcj-2) * hvr_a(ji,nlcj-2)             
    325             END DO 
    326          ENDIF 
    327  
    328          DO jk=1,jpkm1                 ! Smooth 
    329             DO ji=i1,i2 
    330                va(ji,nlcj-2,jk)=0.25_wp*(va(ji,nlcj-3,jk)+2._wp*va(ji,nlcj-2,jk)+va(ji,nlcj-1,jk)) 
    331                va(ji,nlcj-2,jk)=va(ji,nlcj-2,jk)*vmask(ji,nlcj-2,jk) 
    332             END DO 
    333          END DO 
    334  
    335          zvb(:,nlcj-2)=0._wp           ! Correct transport 
    336          DO jk=1,jpkm1 
    337             DO ji=1,jpi 
    338                zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + fse3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 
    339             END DO 
    340          END DO 
    341          DO ji=1,jpi 
    342             zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * hvr_a(ji,nlcj-2) 
    343          END DO 
    344          DO jk=1,jpkm1 
    345             DO ji=1,jpi 
    346                va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)+va_b(ji,nlcj-2)-zvb(ji,nlcj-2))*vmask(ji,nlcj-2,jk) 
    347             END DO 
    348          END DO 
    349  
    350          ! Set tangential velocities to time splitting estimate 
    351          !----------------------------------------------------- 
    352          IF ( ln_dynspg_ts ) THEN 
    353             zub(:,nlcj-1)=0._wp 
    354             DO jk=1,jpkm1 
    355                DO ji=1,jpi 
    356                   zub(ji,nlcj-1) = zub(ji,nlcj-1) + fse3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 
    357                END DO 
    358             END DO 
    359             DO ji=1,jpi 
    360                zub(ji,nlcj-1) = zub(ji,nlcj-1) * hur_a(ji,nlcj-1) 
    361             END DO 
    362  
    363             DO jk=1,jpkm1 
    364                DO ji=1,jpi 
    365                   ua(ji,nlcj-1,jk) = (ua(ji,nlcj-1,jk)+ua_b(ji,nlcj-1)-zub(ji,nlcj-1))*umask(ji,nlcj-1,jk) 
    366                END DO 
    367             END DO 
    368          ENDIF 
    369  
    370          ! Mask domain edges: 
    371          !------------------- 
    372          DO jk=1,jpkm1 
    373             DO ji=1,jpi 
     370         DO jk = 1, jpkm1 
     371            DO ji = 1, jpi 
    374372               ua(ji,nlcj  ,jk) = 0._wp 
    375373               va(ji,nlcj-1,jk) = 0._wp 
    376374            END DO 
    377375         END DO  
    378  
    379       ENDIF 
    380       ! 
    381       CALL wrk_dealloc( jpi, jpj, zub, zvb ) 
     376         ! 
     377      ENDIF 
     378      ! 
     379      CALL wrk_dealloc( jpi,jpj,  zub, zvb ) 
    382380      ! 
    383381   END SUBROUTINE Agrif_dyn 
     382 
    384383 
    385384   SUBROUTINE Agrif_dyn_ts( jn ) 
     
    392391      INTEGER :: ji, jj 
    393392      !!----------------------------------------------------------------------   
    394  
     393      ! 
    395394      IF( Agrif_Root() )   RETURN 
    396  
     395      ! 
    397396      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    398397         DO jj=1,jpj 
     
    405404         END DO 
    406405      ENDIF 
    407  
     406      ! 
    408407      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    409408         DO jj=1,jpj 
     
    416415         END DO 
    417416      ENDIF 
    418  
     417      ! 
    419418      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    420419         DO ji=1,jpi 
     
    427426         END DO 
    428427      ENDIF 
    429  
     428      ! 
    430429      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    431430         DO ji=1,jpi 
     
    441440   END SUBROUTINE Agrif_dyn_ts 
    442441 
     442 
    443443   SUBROUTINE Agrif_dta_ts( kt ) 
    444444      !!---------------------------------------------------------------------- 
     
    452452      REAL(wp) :: zrhot, zt 
    453453      !!----------------------------------------------------------------------   
    454  
     454      ! 
    455455      IF( Agrif_Root() )   RETURN 
    456  
    457       ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in 
    458       ! the forward case only 
    459  
     456      ! 
     457      ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in the forward case only 
     458      ! 
    460459      zrhot = Agrif_rhot() 
    461  
     460      ! 
    462461      ! "Central" time index for interpolation: 
    463       IF (ln_bt_fw) THEN 
    464          zt = REAL(Agrif_NbStepint()+0.5_wp,wp) / zrhot 
     462      IF( ln_bt_fw ) THEN 
     463         zt = REAL( Agrif_NbStepint()+0.5_wp, wp ) / zrhot 
    465464      ELSE 
    466          zt = REAL(Agrif_NbStepint(),wp) / zrhot 
    467       ENDIF 
    468  
     465         zt = REAL( Agrif_NbStepint()       , wp ) / zrhot 
     466      ENDIF 
     467      ! 
    469468      ! Linear interpolation of sea level 
    470       Agrif_SpecialValue    = 0.e0 
     469      Agrif_SpecialValue    = 0._wp 
    471470      Agrif_UseSpecialValue = .TRUE. 
    472       CALL Agrif_Bc_variable(sshn_id,calledweight=zt, procname=interpsshn ) 
     471      CALL Agrif_Bc_variable( sshn_id, calledweight=zt, procname=interpsshn ) 
    473472      Agrif_UseSpecialValue = .FALSE. 
    474  
     473      ! 
    475474      ! Interpolate barotropic fluxes 
    476475      Agrif_SpecialValue=0. 
    477476      Agrif_UseSpecialValue = ln_spc_dyn 
    478  
    479       IF (ll_int_cons) THEN ! Conservative interpolation 
     477      ! 
     478      IF( ll_int_cons ) THEN ! Conservative interpolation 
    480479         ! orders matters here !!!!!! 
    481          CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1._wp, procname=interpub2b) ! Time integrated 
    482          CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1._wp, procname=interpvb2b) 
     480         CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated 
     481         CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) 
    483482         bdy_tinterp = 1 
    484          CALL Agrif_Bc_variable(unb_id ,calledweight=1._wp, procname=interpunb) ! After 
    485          CALL Agrif_Bc_variable(vnb_id ,calledweight=1._wp, procname=interpvnb) 
     483         CALL Agrif_Bc_variable( unb_id        , calledweight=1._wp, procname=interpunb  ) ! After 
     484         CALL Agrif_Bc_variable( vnb_id        , calledweight=1._wp, procname=interpvnb  ) 
    486485         bdy_tinterp = 2 
    487          CALL Agrif_Bc_variable(unb_id ,calledweight=0._wp, procname=interpunb) ! Before 
    488          CALL Agrif_Bc_variable(vnb_id ,calledweight=0._wp, procname=interpvnb)          
     486         CALL Agrif_Bc_variable( unb_id        , calledweight=0._wp, procname=interpunb  ) ! Before 
     487         CALL Agrif_Bc_variable( vnb_id        , calledweight=0._wp, procname=interpvnb  )          
    489488      ELSE ! Linear interpolation 
    490489         bdy_tinterp = 0 
    491          ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0  
    492          ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0  
    493          ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0  
    494          ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0  
    495          CALL Agrif_Bc_variable(unb_id,calledweight=zt, procname=interpunb) 
    496          CALL Agrif_Bc_variable(vnb_id,calledweight=zt, procname=interpvnb) 
     490         ubdy_w(:) = 0._wp   ;   vbdy_w(:) = 0._wp  
     491         ubdy_e(:) = 0._wp   ;   vbdy_e(:) = 0._wp  
     492         ubdy_n(:) = 0._wp   ;   vbdy_n(:) = 0._wp  
     493         ubdy_s(:) = 0._wp   ;   vbdy_s(:) = 0._wp 
     494         CALL Agrif_Bc_variable( unb_id, calledweight=zt, procname=interpunb ) 
     495         CALL Agrif_Bc_variable( vnb_id, calledweight=zt, procname=interpvnb ) 
    497496      ENDIF 
    498497      Agrif_UseSpecialValue = .FALSE. 
     
    500499   END SUBROUTINE Agrif_dta_ts 
    501500 
     501 
    502502   SUBROUTINE Agrif_ssh( kt ) 
    503503      !!---------------------------------------------------------------------- 
     
    507507      !! 
    508508      !!----------------------------------------------------------------------   
    509  
     509      ! 
    510510      IF( Agrif_Root() )   RETURN 
    511  
     511      ! 
    512512      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    513513         ssha(2,:)=ssha(3,:) 
    514514         sshn(2,:)=sshn(3,:) 
    515515      ENDIF 
    516  
     516      ! 
    517517      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    518518         ssha(nlci-1,:)=ssha(nlci-2,:) 
    519519         sshn(nlci-1,:)=sshn(nlci-2,:) 
    520520      ENDIF 
    521  
     521      ! 
    522522      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    523523         ssha(:,2)=ssha(:,3) 
    524524         sshn(:,2)=sshn(:,3) 
    525525      ENDIF 
    526  
     526      ! 
    527527      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    528528         ssha(:,nlcj-1)=ssha(:,nlcj-2) 
    529529         sshn(:,nlcj-1)=sshn(:,nlcj-2) 
    530530      ENDIF 
    531  
     531      ! 
    532532   END SUBROUTINE Agrif_ssh 
     533 
    533534 
    534535   SUBROUTINE Agrif_ssh_ts( jn ) 
     
    540541      INTEGER :: ji,jj 
    541542      !!----------------------------------------------------------------------   
    542  
     543      ! 
    543544      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    544          DO jj=1,jpj 
     545         DO jj = 1, jpj 
    545546            ssha_e(2,jj) = hbdy_w(jj) 
    546547         END DO 
    547548      ENDIF 
    548  
     549      ! 
    549550      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    550          DO jj=1,jpj 
     551         DO jj = 1, jpj 
    551552            ssha_e(nlci-1,jj) = hbdy_e(jj) 
    552553         END DO 
    553554      ENDIF 
    554  
     555      ! 
    555556      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    556          DO ji=1,jpi 
     557         DO ji = 1, jpi 
    557558            ssha_e(ji,2) = hbdy_s(ji) 
    558559         END DO 
    559560      ENDIF 
    560  
     561      ! 
    561562      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    562          DO ji=1,jpi 
     563         DO ji = 1, jpi 
    563564            ssha_e(ji,nlcj-1) = hbdy_n(ji) 
    564565         END DO 
    565566      ENDIF 
    566  
     567      ! 
    567568   END SUBROUTINE Agrif_ssh_ts 
    568569 
    569570# if defined key_zdftke 
     571 
    570572   SUBROUTINE Agrif_tke 
    571573      !!---------------------------------------------------------------------- 
     
    573575      !!----------------------------------------------------------------------   
    574576      REAL(wp) ::   zalpha 
     577      !!----------------------------------------------------------------------   
    575578      ! 
    576579      zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp ) 
    577580      IF( zalpha > 1. )   zalpha = 1. 
    578        
     581      ! 
    579582      Agrif_SpecialValue    = 0.e0 
    580583      Agrif_UseSpecialValue = .TRUE. 
    581        
     584      ! 
    582585      CALL Agrif_Bc_variable(avm_id ,calledweight=zalpha, procname=interpavm)        
    583                
     586      ! 
    584587      Agrif_UseSpecialValue = .FALSE. 
    585588      ! 
    586589   END SUBROUTINE Agrif_tke 
     590    
    587591# endif 
    588592 
    589    SUBROUTINE interptsn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir) 
    590       !!--------------------------------------------- 
     593   SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 
     594      !!---------------------------------------------------------------------- 
    591595      !!   *** ROUTINE interptsn *** 
    592       !!--------------------------------------------- 
    593       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 
    594       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    595       LOGICAL, INTENT(in) :: before 
    596       INTEGER, INTENT(in) :: nb , ndir 
     596      !!---------------------------------------------------------------------- 
     597      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   ptab 
     598      INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2 
     599      LOGICAL                                     , INTENT(in   ) ::  before 
     600      INTEGER                                     , INTENT(in   ) ::  nb , ndir 
    597601      ! 
    598602      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    599       INTEGER :: imin, imax, jmin, jmax 
     603      INTEGER  ::  imin, imax, jmin, jmax 
    600604      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3 
    601605      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7 
    602       LOGICAL :: western_side, eastern_side,northern_side,southern_side 
    603  
     606      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     607      !!---------------------------------------------------------------------- 
     608      ! 
    604609      IF (before) THEN          
    605610         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 
     
    634639         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2         
    635640         ! 
    636          IF( eastern_side) THEN 
     641         IF( eastern_side ) THEN 
    637642            DO jn = 1, jpts 
    638643               tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 
    639644               DO jk = 1, jpkm1 
    640645                  DO jj = jmin,jmax 
    641                      IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
     646                     IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 
    642647                        tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
    643648                     ELSE 
    644649                        tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
    645                         IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
     650                        IF( un(nlci-2,jj,jk) > 0._wp ) THEN 
    646651                           tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) &  
    647652                                 + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     
    651656               END DO 
    652657               tsa(nlci,j1:j2,k1:k2,jn) = 0._wp 
    653             ENDDO 
     658            END DO 
    654659         ENDIF 
    655660         !  
     
    659664               DO jk = 1, jpkm1 
    660665                  DO ji = imin,imax 
    661                      IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
     666                     IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN 
    662667                        tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
    663668                     ELSE 
    664669                        tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
    665                         IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
     670                        IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN 
    666671                           tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn)  & 
    667672                                 + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
     
    671676               END DO 
    672677               tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp 
    673             ENDDO 
    674          ENDIF 
    675          ! 
    676          IF( western_side) THEN             
     678            END DO 
     679         ENDIF 
     680         ! 
     681         IF( western_side ) THEN             
    677682            DO jn = 1, jpts 
    678683               tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn) 
    679684               DO jk = 1, jpkm1 
    680685                  DO jj = jmin,jmax 
    681                      IF( umask(2,jj,jk) == 0.e0 ) THEN 
     686                     IF( umask(2,jj,jk) == 0._wp ) THEN 
    682687                        tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 
    683688                     ELSE 
    684689                        tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)         
    685                         IF( un(2,jj,jk) < 0.e0 ) THEN 
     690                        IF( un(2,jj,jk) < 0._wp ) THEN 
    686691                           tsa(2,jj,jk,jn)=(zalpha6*tsa(3,jj,jk,jn)+zalpha5*tsa(1,jj,jk,jn)+zalpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 
    687692                        ENDIF 
     
    696701            DO jn = 1, jpts 
    697702               tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn) 
    698                DO jk=1,jpk       
     703               DO jk = 1, jpk       
    699704                  DO ji=imin,imax 
    700                      IF( vmask(ji,2,jk) == 0.e0 ) THEN 
     705                     IF( vmask(ji,2,jk) == 0._wp ) THEN 
    701706                        tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 
    702707                     ELSE 
    703708                        tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 
    704                         IF( vn(ji,2,jk) < 0.e0 ) THEN 
     709                        IF( vn(ji,2,jk) < 0._wp ) THEN 
    705710                           tsa(ji,2,jk,jn)=(zalpha6*tsa(ji,3,jk,jn)+zalpha5*tsa(ji,1,jk,jn)+zalpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 
    706711                        ENDIF 
     
    709714               END DO 
    710715               tsa(i1:i2,1,k1:k2,jn) = 0._wp 
    711             ENDDO 
     716            END DO 
    712717         ENDIF 
    713718         ! 
     
    735740   END SUBROUTINE interptsn 
    736741 
    737    SUBROUTINE interpsshn(ptab,i1,i2,j1,j2,before,nb,ndir) 
     742 
     743   SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before, nb, ndir ) 
    738744      !!---------------------------------------------------------------------- 
    739745      !!                  ***  ROUTINE interpsshn  *** 
    740746      !!----------------------------------------------------------------------   
    741       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    742       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
    743       LOGICAL, INTENT(in) :: before 
    744       INTEGER, INTENT(in) :: nb , ndir 
     747      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     748      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     749      LOGICAL                         , INTENT(in   ) ::   before 
     750      INTEGER                         , INTENT(in   ) ::   nb , ndir 
     751      ! 
    745752      LOGICAL :: western_side, eastern_side,northern_side,southern_side 
    746753      !!----------------------------------------------------------------------   
     
    761768   END SUBROUTINE interpsshn 
    762769 
    763    SUBROUTINE interpun(ptab,i1,i2,j1,j2,k1,k2, before) 
    764       !!--------------------------------------------- 
     770 
     771   SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, before ) 
     772      !!---------------------------------------------------------------------- 
    765773      !!   *** ROUTINE interpun *** 
    766       !!---------------------------------------------     
    767       !! 
    768       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    769       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    770       LOGICAL, INTENT(in) :: before 
    771       !! 
    772       INTEGER :: ji,jj,jk 
    773       REAL(wp) :: zrhoy  
    774       !!---------------------------------------------     
    775       ! 
    776       IF (before) THEN  
    777          DO jk=1,jpk 
    778             DO jj=j1,j2 
    779                DO ji=i1,i2 
    780                   ptab(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 
    781                   ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3u(ji,jj,jk) 
    782                END DO 
    783             END DO 
     774      !!---------------------------------------------------------------------- 
     775      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     776      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     777      LOGICAL                               , INTENT(in   ) ::   before 
     778      ! 
     779      INTEGER  ::   ji, jj, jk 
     780      REAL(wp) ::   zrhoy   
     781      !!---------------------------------------------------------------------- 
     782      ! 
     783      IF( before ) THEN  
     784         DO jk = k1, jpk 
     785            ptab(i1:i2,j1:j2,jk) = e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk) 
    784786         END DO 
    785787      ELSE 
    786788         zrhoy = Agrif_Rhoy() 
    787          DO jk=1,jpkm1 
     789         DO jk = 1, jpkm1 
    788790            DO jj=j1,j2 
    789                ua(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhoy*e2u(i1:i2,jj))) 
    790                ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / fse3u(i1:i2,jj,jk) 
     791               ua(i1:i2,jj,jk) = ptab(i1:i2,jj,jk) / ( zrhoy * e2u(i1:i2,jj) * e3u_n(i1:i2,jj,jk) ) 
    791792            END DO 
    792793         END DO 
     
    795796   END SUBROUTINE interpun 
    796797 
    797    SUBROUTINE interpvn(ptab,i1,i2,j1,j2,k1,k2, before) 
    798       !!--------------------------------------------- 
     798 
     799   SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, before ) 
     800      !!---------------------------------------------------------------------- 
    799801      !!   *** ROUTINE interpvn *** 
    800       !!---------------------------------------------     
    801       ! 
    802       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    803       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    804       LOGICAL, INTENT(in) :: before 
    805       ! 
    806       INTEGER :: ji,jj,jk 
    807       REAL(wp) :: zrhox  
    808       !!---------------------------------------------     
     802      !!---------------------------------------------------------------------- 
     803      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     804      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     805      LOGICAL                               , INTENT(in   ) ::   before 
     806      ! 
     807      INTEGER  ::   ji, jj, jk 
     808      REAL(wp) ::   zrhox   
     809      !!---------------------------------------------------------------------- 
    809810      !       
    810       IF (before) THEN           
    811          !interpv entre 1 et k2 et interpv2d en jpkp1 
    812          DO jk=k1,jpk 
    813             DO jj=j1,j2 
    814                DO ji=i1,i2 
    815                   ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 
    816                   ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3v(ji,jj,jk) 
    817                END DO 
    818             END DO 
     811      IF( before ) THEN       !interpv entre 1 et k2 et interpv2d en jpkp1 
     812         DO jk = k1, jpk 
     813            ptab(i1:i2,j1:j2,jk) = e1v(i1:i2,j1:j2) * e3v_n(i1:i2,j1:j2,jk) * vn(i1:i2,j1:j2,jk) 
    819814         END DO 
    820815      ELSE           
    821816         zrhox= Agrif_Rhox() 
    822          DO jk=1,jpkm1 
    823             DO jj=j1,j2 
    824                va(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhox*e1v(i1:i2,jj))) 
    825                va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / fse3v(i1:i2,jj,jk) 
    826             END DO 
     817         DO jk = 1, jpkm1 
     818            va(i1:i2,j1:j2,jk) = ptab(i1:i2,j1:j2,jk) / ( zrhox * e1v(i1:i2,j1:j2) * e3v_n(i1:i2,j1:j2,jk) ) 
    827819         END DO 
    828820      ENDIF 
    829821      !         
    830822   END SUBROUTINE interpvn 
    831  
    832    SUBROUTINE interpunb(ptab,i1,i2,j1,j2,before,nb,ndir) 
     823    
     824 
     825   SUBROUTINE interpunb( ptab, i1, i2, j1, j2, before, nb, ndir ) 
    833826      !!---------------------------------------------------------------------- 
    834827      !!                  ***  ROUTINE interpunb  *** 
    835828      !!----------------------------------------------------------------------   
    836       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    837       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
    838       LOGICAL, INTENT(in) :: before 
    839       INTEGER, INTENT(in) :: nb , ndir 
    840       !! 
    841       INTEGER :: ji,jj 
    842       REAL(wp) :: zrhoy, zrhot, zt0, zt1, ztcoeff 
    843       LOGICAL :: western_side, eastern_side,northern_side,southern_side 
    844       !!----------------------------------------------------------------------   
    845       ! 
    846       IF (before) THEN  
    847          DO jj=j1,j2 
    848             DO ji=i1,i2 
    849                ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu(ji,jj)  
    850             END DO 
    851          END DO 
     829      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     830      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     831      LOGICAL                         , INTENT(in   ) ::   before 
     832      INTEGER                         , INTENT(in   ) ::   nb , ndir 
     833      ! 
     834      INTEGER  ::   ji, jj 
     835      REAL(wp) ::   zrhoy, zrhot, zt0, zt1, ztcoeff 
     836      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     837      !!----------------------------------------------------------------------   
     838      ! 
     839      IF( before ) THEN  
     840         ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * hu_n(i1:i2,j1:j2) * un_b(i1:i2,j1:j2) 
    852841      ELSE 
    853842         western_side  = (nb == 1).AND.(ndir == 1) 
     
    863852         IF( bdy_tinterp == 1 ) THEN 
    864853            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
    865                   &      - zt0**2._wp * (       zt0 - 1._wp)        ) 
     854               &               - zt0**2._wp * (       zt0 - 1._wp)        ) 
    866855         ELSEIF( bdy_tinterp == 2 ) THEN 
    867856            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
    868                   &      - zt0        * (       zt0 - 1._wp)**2._wp )  
     857               &               - zt0        * (       zt0 - 1._wp)**2._wp )  
    869858 
    870859         ELSE 
     
    887876         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
    888877            IF(western_side) THEN 
    889                ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2))   & 
    890                      &                                  * umask(i1,j1:j2,1) 
     878               ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 
    891879            ENDIF 
    892880            IF(eastern_side) THEN 
    893                ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2))   & 
    894                      &                                  * umask(i1,j1:j2,1) 
     881               ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 
    895882            ENDIF 
    896883            IF(southern_side) THEN 
    897                ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1))   & 
    898                      &                                  * umask(i1:i2,j1,1) 
     884               ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 
    899885            ENDIF 
    900886            IF(northern_side) THEN 
    901                ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1))   & 
    902                      &                                  * umask(i1:i2,j1,1) 
     887               ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 
    903888            ENDIF 
    904889         ENDIF 
     
    907892   END SUBROUTINE interpunb 
    908893 
    909    SUBROUTINE interpvnb(ptab,i1,i2,j1,j2,before,nb,ndir) 
     894 
     895   SUBROUTINE interpvnb( ptab, i1, i2, j1, j2, before, nb, ndir ) 
    910896      !!---------------------------------------------------------------------- 
    911897      !!                  ***  ROUTINE interpvnb  *** 
    912898      !!----------------------------------------------------------------------   
    913       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    914       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
    915       LOGICAL, INTENT(in) :: before 
    916       INTEGER, INTENT(in) :: nb , ndir 
    917       !! 
    918       INTEGER :: ji,jj 
    919       REAL(wp) :: zrhox, zrhot, zt0, zt1, ztcoeff    
    920       LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     899      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     900      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     901      LOGICAL                         , INTENT(in   ) ::  before 
     902      INTEGER                         , INTENT(in   ) ::  nb , ndir 
     903      ! 
     904      INTEGER  ::  ji,jj 
     905      REAL(wp) ::   zrhox, zrhot, zt0, zt1, ztcoeff    
     906      LOGICAL  ::  western_side, eastern_side,northern_side,southern_side 
    921907      !!----------------------------------------------------------------------   
    922908      !  
    923       IF (before) THEN  
    924          DO jj=j1,j2 
    925             DO ji=i1,i2 
    926                ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv(ji,jj)  
    927             END DO 
    928          END DO 
     909      IF( before ) THEN  
     910         ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * hv_n(i1:i2,j1:j2) * vn_b(i1:i2,j1:j2) 
    929911      ELSE 
    930912         western_side  = (nb == 1).AND.(ndir == 1) 
     
    939921         IF( bdy_tinterp == 1 ) THEN 
    940922            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
    941                   &      - zt0**2._wp * (       zt0 - 1._wp)        ) 
     923               &               - zt0**2._wp * (       zt0 - 1._wp)        ) 
    942924         ELSEIF( bdy_tinterp == 2 ) THEN 
    943925            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
    944                   &      - zt0        * (       zt0 - 1._wp)**2._wp )  
    945  
     926               &               - zt0        * (       zt0 - 1._wp)**2._wp )  
    946927         ELSE 
    947928            ztcoeff = 1 
     
    983964   END SUBROUTINE interpvnb 
    984965 
    985    SUBROUTINE interpub2b(ptab,i1,i2,j1,j2,before,nb,ndir) 
     966 
     967   SUBROUTINE interpub2b( ptab, i1, i2, j1, j2, before, nb, ndir ) 
    986968      !!---------------------------------------------------------------------- 
    987969      !!                  ***  ROUTINE interpub2b  *** 
    988970      !!----------------------------------------------------------------------   
    989       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    990       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
    991       LOGICAL, INTENT(in) :: before 
    992       INTEGER, INTENT(in) :: nb , ndir 
    993       !! 
    994       INTEGER :: ji,jj 
    995       REAL(wp) :: zrhot, zt0, zt1,zat 
    996       LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     971      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     972      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     973      LOGICAL                         , INTENT(in   ) ::  before 
     974      INTEGER                         , INTENT(in   ) ::  nb , ndir 
     975      ! 
     976      INTEGER  ::  ji,jj 
     977      REAL(wp) ::   zrhot, zt0, zt1,zat 
     978      LOGICAL  ::  western_side, eastern_side,northern_side,southern_side 
    997979      !!----------------------------------------------------------------------   
    998980      IF( before ) THEN 
    999          DO jj=j1,j2 
    1000             DO ji=i1,i2 
    1001                ptab(ji,jj) = ub2_b(ji,jj) * e2u(ji,jj) 
    1002             END DO 
    1003          END DO 
     981         ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2) 
    1004982      ELSE 
    1005983         western_side  = (nb == 1).AND.(ndir == 1) 
     
    1012990         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 
    1013991         ! Polynomial interpolation coefficients: 
    1014          zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)        & 
    1015                &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        )  
     992         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)    & 
     993            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
    1016994         !  
    1017995         IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
     
    10221000      !  
    10231001   END SUBROUTINE interpub2b 
    1024  
    1025    SUBROUTINE interpvb2b(ptab,i1,i2,j1,j2,before,nb,ndir) 
     1002    
     1003 
     1004   SUBROUTINE interpvb2b( ptab, i1, i2, j1, j2, before, nb, ndir ) 
    10261005      !!---------------------------------------------------------------------- 
    10271006      !!                  ***  ROUTINE interpvb2b  *** 
    10281007      !!----------------------------------------------------------------------   
    1029       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    1030       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
    1031       LOGICAL, INTENT(in) :: before 
    1032       INTEGER, INTENT(in) :: nb , ndir 
    1033       !! 
    1034       INTEGER :: ji,jj 
    1035       REAL(wp) :: zrhot, zt0, zt1,zat 
    1036       LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     1008      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     1009      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     1010      LOGICAL                         , INTENT(in   ) ::  before 
     1011      INTEGER                         , INTENT(in   ) ::  nb , ndir 
     1012      ! 
     1013      INTEGER ::   ji,jj 
     1014      REAL(wp) ::   zrhot, zt0, zt1,zat 
     1015      LOGICAL ::   western_side, eastern_side,northern_side,southern_side 
    10371016      !!----------------------------------------------------------------------   
    10381017      ! 
    10391018      IF( before ) THEN 
    1040          DO jj=j1,j2 
    1041             DO ji=i1,i2 
    1042                ptab(ji,jj) = vb2_b(ji,jj) * e1v(ji,jj) 
    1043             END DO 
    1044          END DO 
     1019         ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2) 
    10451020      ELSE       
    10461021         western_side  = (nb == 1).AND.(ndir == 1) 
     
    10531028         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 
    10541029         ! Polynomial interpolation coefficients: 
    1055          zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)        & 
    1056                &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        )  
    1057          ! 
    1058          IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
    1059          IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)   
    1060          IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j1)  
    1061          IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
     1030         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)    & 
     1031            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
     1032         ! 
     1033         IF(western_side )   vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
     1034         IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)   
     1035         IF(southern_side)   vbdy_s(i1:i2) = zat * ptab(i1:i2,j1)  
     1036         IF(northern_side)   vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
    10621037      ENDIF 
    10631038      !       
    10641039   END SUBROUTINE interpvb2b 
    10651040 
    1066    SUBROUTINE interpe3t(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 
     1041 
     1042   SUBROUTINE interpe3t( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
    10671043      !!---------------------------------------------------------------------- 
    10681044      !!                  ***  ROUTINE interpe3t  *** 
    10691045      !!----------------------------------------------------------------------   
    1070       !  
    1071       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
     1046      INTEGER                              , INTENT(in   ) :: i1, i2, j1, j2, k1, k2 
    10721047      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    1073       LOGICAL :: before 
    1074       INTEGER, INTENT(in) :: nb , ndir 
     1048      LOGICAL                              , INTENT(in   ) :: before 
     1049      INTEGER                              , INTENT(in   ) :: nb , ndir 
    10751050      ! 
    10761051      INTEGER :: ji, jj, jk 
     
    10791054      !!----------------------------------------------------------------------   
    10801055      !     
    1081       IF (before) THEN 
    1082          DO jk=k1,k2 
    1083             DO jj=j1,j2 
    1084                DO ji=i1,i2 
    1085                   ptab(ji,jj,jk) = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 
    1086                END DO 
    1087             END DO 
    1088          END DO 
     1056      IF( before ) THEN 
     1057         ptab(i1:i2,j1:j2,k1:k2) = tmask(i1:i2,j1:j2,k1:k2) * e3t_0(i1:i2,j1:j2,k1:k2) 
    10891058      ELSE 
    10901059         western_side  = (nb == 1).AND.(ndir == 1) 
     
    10931062         northern_side = (nb == 2).AND.(ndir == 2) 
    10941063 
    1095          DO jk=k1,k2 
    1096             DO jj=j1,j2 
    1097                DO ji=i1,i2 
     1064         DO jk = k1, k2 
     1065            DO jj = j1, j2 
     1066               DO ji = i1, i2 
    10981067                  ! Get velocity mask at boundary edge points: 
    1099                   IF (western_side)  ztmpmsk = umask(ji    ,jj    ,1) 
    1100                   IF (eastern_side)  ztmpmsk = umask(nlci-2,jj    ,1) 
    1101                   IF (northern_side) ztmpmsk = vmask(ji    ,nlcj-2,1) 
    1102                   IF (southern_side) ztmpmsk = vmask(ji    ,2     ,1) 
    1103  
    1104                   IF (ABS(ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk))*ztmpmsk > 1.D-2) THEN 
     1068                  IF( western_side )   ztmpmsk = umask(ji    ,jj    ,1) 
     1069                  IF( eastern_side )   ztmpmsk = umask(nlci-2,jj    ,1) 
     1070                  IF( northern_side)  ztmpmsk = vmask(ji    ,nlcj-2,1) 
     1071                  IF( southern_side)  ztmpmsk = vmask(ji    ,2     ,1) 
     1072                  ! 
     1073                  IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) )*ztmpmsk > 1.D-2) THEN 
    11051074                     IF (western_side) THEN 
    11061075                        WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
     
    11121081                        WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 
    11131082                     ENDIF 
    1114                      WRITE(numout,*) '      ptab(ji,jj,jk), fse3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk) 
     1083                     WRITE(numout,*) '      ptab(ji,jj,jk), e3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk) 
    11151084                     kindic_agr = kindic_agr + 1 
    11161085                  ENDIF 
     
    11181087            END DO 
    11191088         END DO 
    1120  
     1089         ! 
    11211090      ENDIF 
    11221091      !  
    11231092   END SUBROUTINE interpe3t 
    11241093 
    1125    SUBROUTINE interpumsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 
     1094 
     1095   SUBROUTINE interpumsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
    11261096      !!---------------------------------------------------------------------- 
    11271097      !!                  ***  ROUTINE interpumsk  *** 
    11281098      !!----------------------------------------------------------------------   
    1129       !  
    1130       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    1131       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    1132       LOGICAL :: before 
    1133       INTEGER, INTENT(in) :: nb , ndir 
    1134       ! 
    1135       INTEGER :: ji, jj, jk 
    1136       LOGICAL :: western_side, eastern_side    
     1099      INTEGER                              , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     1100      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     1101      LOGICAL                              , INTENT(in   ) ::   before 
     1102      INTEGER                              , INTENT(in   ) ::   nb , ndir 
     1103      ! 
     1104      INTEGER ::   ji, jj, jk 
     1105      LOGICAL ::   western_side, eastern_side    
    11371106      !!----------------------------------------------------------------------   
    11381107      !     
    1139       IF (before) THEN 
    1140          DO jk=k1,k2 
    1141             DO jj=j1,j2 
    1142                DO ji=i1,i2 
    1143                   ptab(ji,jj,jk) = umask(ji,jj,jk) 
    1144                END DO 
    1145             END DO 
    1146          END DO 
     1108      IF( before ) THEN 
     1109         ptab(i1:i2,j1:j2,k1:k2) = umask(i1:i2,j1:j2,k1:k2) 
    11471110      ELSE 
    1148  
    1149          western_side  = (nb == 1).AND.(ndir == 1) 
    1150          eastern_side  = (nb == 1).AND.(ndir == 2) 
    1151          DO jk=k1,k2 
    1152             DO jj=j1,j2 
    1153                DO ji=i1,i2 
     1111         western_side = (nb == 1).AND.(ndir == 1) 
     1112         eastern_side = (nb == 1).AND.(ndir == 2) 
     1113         DO jk = k1, k2 
     1114            DO jj = j1, j2 
     1115               DO ji = i1, i2 
    11541116                   ! Velocity mask at boundary edge points: 
    11551117                  IF (ABS(ptab(ji,jj,jk) - umask(ji,jj,jk)) > 1.D-2) THEN 
     
    11671129            END DO 
    11681130         END DO 
    1169  
     1131         ! 
    11701132      ENDIF 
    11711133      !  
    11721134   END SUBROUTINE interpumsk 
    11731135 
    1174    SUBROUTINE interpvmsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 
     1136 
     1137   SUBROUTINE interpvmsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
    11751138      !!---------------------------------------------------------------------- 
    11761139      !!                  ***  ROUTINE interpvmsk  *** 
    11771140      !!----------------------------------------------------------------------   
    1178       !  
    1179       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    1180       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    1181       LOGICAL :: before 
    1182       INTEGER, INTENT(in) :: nb , ndir 
    1183       ! 
    1184       INTEGER :: ji, jj, jk 
    1185       LOGICAL :: northern_side, southern_side      
     1141      INTEGER                              , INTENT(in   ) ::   i1,i2,j1,j2,k1,k2 
     1142      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     1143      LOGICAL                              , INTENT(in   ) ::   before 
     1144      INTEGER                              , INTENT(in   ) :: nb , ndir 
     1145      ! 
     1146      INTEGER ::   ji, jj, jk 
     1147      LOGICAL ::   northern_side, southern_side      
    11861148      !!----------------------------------------------------------------------   
    11871149      !     
    1188       IF (before) THEN 
    1189          DO jk=k1,k2 
    1190             DO jj=j1,j2 
    1191                DO ji=i1,i2 
    1192                   ptab(ji,jj,jk) = vmask(ji,jj,jk) 
    1193                END DO 
    1194             END DO 
    1195          END DO 
     1150      IF( before ) THEN 
     1151         ptab(i1:i2,j1:j2,k1:k2) = vmask(i1:i2,j1:j2,k1:k2) 
    11961152      ELSE 
    1197  
    11981153         southern_side = (nb == 2).AND.(ndir == 1) 
    11991154         northern_side = (nb == 2).AND.(ndir == 2) 
    1200          DO jk=k1,k2 
    1201             DO jj=j1,j2 
    1202                DO ji=i1,i2 
     1155         DO jk = k1, k2 
     1156            DO jj = j1, j2 
     1157               DO ji = i1, i2 
    12031158                   ! Velocity mask at boundary edge points: 
    12041159                  IF (ABS(ptab(ji,jj,jk) - vmask(ji,jj,jk)) > 1.D-2) THEN 
     
    12161171            END DO 
    12171172         END DO 
    1218  
     1173         ! 
    12191174      ENDIF 
    12201175      !  
     
    12231178# if defined key_zdftke 
    12241179 
    1225    SUBROUTINE interpavm(ptab,i1,i2,j1,j2,k1,k2,before) 
     1180   SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, before ) 
    12261181      !!---------------------------------------------------------------------- 
    12271182      !!                  ***  ROUTINE interavm  *** 
    12281183      !!----------------------------------------------------------------------   
    1229       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    1230       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    1231       LOGICAL, INTENT(in) :: before 
     1184      INTEGER                              , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     1185      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     1186      LOGICAL                              , INTENT(in   ) ::  before 
    12321187      !!----------------------------------------------------------------------   
    12331188      !       
    1234       IF( before) THEN 
     1189      IF( before ) THEN 
    12351190         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 
    12361191      ELSE 
Note: See TracChangeset for help on using the changeset viewer.