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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/TRA/zpshde.F90 – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/TRA/zpshde.F90

    r10425 r13463  
    3131 
    3232   !! * Substitutions 
    33 #  include "vectopt_loop_substitute.h90" 
     33#  include "do_loop_substitute.h90" 
     34#  include "domzgr_substitute.h90" 
    3435   !!---------------------------------------------------------------------- 
    3536   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    3940CONTAINS 
    4041 
    41    SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv,   & 
     42   SUBROUTINE zps_hde( kt, Kmm, kjpt, pta, pgtu, pgtv,   & 
    4243      &                          prd, pgru, pgrv    ) 
    4344      !!---------------------------------------------------------------------- 
    … …  
    6566      !!              ___ |   |   |           ___  |   |   | 
    6667      !!                   
    67       !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then 
    68       !!          t~ = t(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1) 
    69       !!        ( t~ = t(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1)  ) 
     68      !!      case 1->   e3w(i+1,:,:,Kmm) >= e3w(i,:,:,Kmm) ( and e3w(:,j+1,:,Kmm) >= e3w(:,j,:,Kmm) ) then 
     69      !!          t~ = t(i+1,j  ,k) + (e3w(i+1,j,k,Kmm) - e3w(i,j,k,Kmm)) * dk(Ti+1)/e3w(i+1,j,k,Kmm) 
     70      !!        ( t~ = t(i  ,j+1,k) + (e3w(i,j+1,k,Kmm) - e3w(i,j,k,Kmm)) * dk(Tj+1)/e3w(i,j+1,k,Kmm)  ) 
    7071      !!          or 
    71       !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then 
    72       !!          t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i ) 
    73       !!        ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) ) 
     72      !!      case 2->   e3w(i+1,:,:,Kmm) <= e3w(i,:,:,Kmm) ( and e3w(:,j+1,:,Kmm) <= e3w(:,j,:,Kmm) ) then 
     73      !!          t~ = t(i,j,k) + (e3w(i,j,k,Kmm) - e3w(i+1,j,k,Kmm)) * dk(Ti)/e3w(i,j,k,Kmm) 
     74      !!        ( t~ = t(i,j,k) + (e3w(i,j,k,Kmm) - e3w(i,j+1,k,Kmm)) * dk(Tj)/e3w(i,j,k,Kmm) ) 
    7475      !!          Idem for di(s) and dj(s)           
    7576      !! 
    … …  
    8586      !!---------------------------------------------------------------------- 
    8687      INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index 
     88      INTEGER                              , INTENT(in   )           ::  Kmm         ! ocean time level index 
    8789      INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers 
    8890      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields 
    … …  
    105107      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    106108         ! 
    107          DO jj = 1, jpjm1 
    108             DO ji = 1, jpim1 
    109                iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    110                ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1 
    111 !!gm BUG ? when applied to before fields, e3w_b should be used.... 
    112                ze3wu = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku) 
    113                ze3wv = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv) 
    114                ! 
    115                ! i- direction 
    116                IF( ze3wu >= 0._wp ) THEN      ! case 1 
    117                   zmaxu =  ze3wu / e3w_n(ji+1,jj,iku) 
    118                   ! interpolated values of tracers 
    119                   zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 
    120                   ! gradient of  tracers 
    121                   pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
    122                ELSE                           ! case 2 
    123                   zmaxu = -ze3wu / e3w_n(ji,jj,iku) 
    124                   ! interpolated values of tracers 
    125                   zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 
    126                   ! gradient of tracers 
    127                   pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
    128                ENDIF 
    129                ! 
    130                ! j- direction 
    131                IF( ze3wv >= 0._wp ) THEN      ! case 1 
    132                   zmaxv =  ze3wv / e3w_n(ji,jj+1,ikv) 
    133                   ! interpolated values of tracers 
    134                   ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 
    135                   ! gradient of tracers 
    136                   pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
    137                ELSE                           ! case 2 
    138                   zmaxv =  -ze3wv / e3w_n(ji,jj,ikv) 
    139                   ! interpolated values of tracers 
    140                   ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 
    141                   ! gradient of tracers 
    142                   pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
    143                ENDIF 
    144             END DO 
    145          END DO 
     109         DO_2D( 1, 0, 1, 0 ) 
     110            iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
     111            ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1 
     112!!gm BUG ? when applied to before fields, e3w(:,:,k,Kbb) should be used.... 
     113            ze3wu = e3w(ji+1,jj  ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 
     114            ze3wv = e3w(ji  ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 
     115            ! 
     116            ! i- direction 
     117            IF( ze3wu >= 0._wp ) THEN      ! case 1 
     118               zmaxu =  ze3wu / e3w(ji+1,jj,iku,Kmm) 
     119               ! interpolated values of tracers 
     120               zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 
     121               ! gradient of  tracers 
     122               pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
     123            ELSE                           ! case 2 
     124               zmaxu = -ze3wu / e3w(ji,jj,iku,Kmm) 
     125               ! interpolated values of tracers 
     126               zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 
     127               ! gradient of tracers 
     128               pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
     129            ENDIF 
     130            ! 
     131            ! j- direction 
     132            IF( ze3wv >= 0._wp ) THEN      ! case 1 
     133               zmaxv =  ze3wv / e3w(ji,jj+1,ikv,Kmm) 
     134               ! interpolated values of tracers 
     135               ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 
     136               ! gradient of tracers 
     137               pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
     138            ELSE                           ! case 2 
     139               zmaxv =  -ze3wv / e3w(ji,jj,ikv,Kmm) 
     140               ! interpolated values of tracers 
     141               ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 
     142               ! gradient of tracers 
     143               pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
     144            ENDIF 
     145         END_2D 
    146146      END DO 
    147147      ! 
    148       CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1. , pgtv(:,:,:), 'V', -1. )   ! Lateral boundary cond. 
     148      CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    149149      !                 
    150150      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
    151151         pgru(:,:) = 0._wp 
    152152         pgrv(:,:) = 0._wp                ! depth of the partial step level 
    153          DO jj = 1, jpjm1 
    154             DO ji = 1, jpim1 
    155                iku = mbku(ji,jj) 
    156                ikv = mbkv(ji,jj) 
    157                ze3wu  = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku) 
    158                ze3wv  = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv) 
    159                IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku)     ! i-direction: case 1 
    160                ELSE                        ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku)     ! -     -      case 2 
    161                ENDIF 
    162                IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv)     ! j-direction: case 1 
    163                ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv)     ! -     -      case 2 
    164                ENDIF 
    165             END DO 
    166          END DO 
     153         DO_2D( 1, 0, 1, 0 ) 
     154            iku = mbku(ji,jj) 
     155            ikv = mbkv(ji,jj) 
     156            ze3wu  = e3w(ji+1,jj  ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 
     157            ze3wv  = e3w(ji  ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 
     158            IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept(ji  ,jj,iku,Kmm)     ! i-direction: case 1 
     159            ELSE                        ;   zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm)     ! -     -      case 2 
     160            ENDIF 
     161            IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept(ji,jj  ,ikv,Kmm)     ! j-direction: case 1 
     162            ELSE                        ;   zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm)     ! -     -      case 2 
     163            ENDIF 
     164         END_2D 
    167165         ! 
    168166         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj  
    169167         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj  
    170168         ! 
    171          DO jj = 1, jpjm1                 ! Gradient of density at the last level  
    172             DO ji = 1, jpim1 
    173                iku = mbku(ji,jj) 
    174                ikv = mbkv(ji,jj) 
    175                ze3wu  = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku) 
    176                ze3wv  = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv) 
    177                IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1 
    178                ELSE                        ;   pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2 
    179                ENDIF 
    180                IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1 
    181                ELSE                        ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2 
    182                ENDIF 
    183             END DO 
    184          END DO 
    185          CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1. , pgrv , 'V', -1. )   ! Lateral boundary conditions 
     169         DO_2D( 1, 0, 1, 0 ) 
     170            iku = mbku(ji,jj) 
     171            ikv = mbkv(ji,jj) 
     172            ze3wu  = e3w(ji+1,jj  ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 
     173            ze3wv  = e3w(ji  ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 
     174            IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1 
     175            ELSE                        ;   pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2 
     176            ENDIF 
     177            IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1 
     178            ELSE                        ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2 
     179            ENDIF 
     180         END_2D 
     181         CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
    186182         ! 
    187183      END IF 
    … …  
    192188 
    193189 
    194    SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv, pgtui, pgtvi,  & 
     190   SUBROUTINE zps_hde_isf( kt, Kmm, kjpt, pta, pgtu, pgtv, pgtui, pgtvi,  & 
    195191      &                          prd, pgru, pgrv, pgrui, pgrvi ) 
    196192      !!---------------------------------------------------------------------- 
    … …  
    219215      !!              ___ |   |   |           ___  |   |   | 
    220216      !!                   
    221       !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then 
    222       !!          t~ = t(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1) 
    223       !!        ( t~ = t(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1)  ) 
     217      !!      case 1->   e3w(i+1,j,k,Kmm) >= e3w(i,j,k,Kmm) ( and e3w(i,j+1,k,Kmm) >= e3w(i,j,k,Kmm) ) then 
     218      !!          t~ = t(i+1,j  ,k) + (e3w(i+1,j  ,k,Kmm) - e3w(i,j,k,Kmm)) * dk(Ti+1)/e3w(i+1,j  ,k,Kmm) 
     219      !!        ( t~ = t(i  ,j+1,k) + (e3w(i  ,j+1,k,Kmm) - e3w(i,j,k,Kmm)) * dk(Tj+1)/e3w(i  ,j+1,k,Kmm)  ) 
    224220      !!          or 
    225       !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then 
    226       !!          t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i ) 
    227       !!        ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) ) 
     221      !!      case 2->   e3w(i+1,j,k,Kmm) <= e3w(i,j,k,Kmm) ( and e3w(i,j+1,k,Kmm) <= e3w(i,j,k,Kmm) ) then 
     222      !!          t~ = t(i,j,k) + (e3w(i,j,k,Kmm) - e3w(i+1,j  ,k,Kmm)) * dk(Ti)/e3w(i,j,k,Kmm) 
     223      !!        ( t~ = t(i,j,k) + (e3w(i,j,k,Kmm) - e3w(i  ,j+1,k,Kmm)) * dk(Tj)/e3w(i,j,k,Kmm) ) 
    228224      !!          Idem for di(s) and dj(s)           
    229225      !! 
    … …  
    241237      !!---------------------------------------------------------------------- 
    242238      INTEGER                              , INTENT(in   )           ::  kt           ! ocean time-step index 
     239      INTEGER                              , INTENT(in   )           ::  Kmm          ! ocean time level index 
    243240      INTEGER                              , INTENT(in   )           ::  kjpt         ! number of tracers 
    244241      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta          ! 4D tracers fields 
    … …  
    265262      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    266263         ! 
    267          DO jj = 1, jpjm1 
    268             DO ji = 1, jpim1 
    269  
    270                iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    271                ikv = mbkv(ji,jj); ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1 
    272                ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku) 
    273                ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv) 
    274                ! 
    275                ! i- direction 
    276                IF( ze3wu >= 0._wp ) THEN      ! case 1 
    277                   zmaxu =  ze3wu / e3w_n(ji+1,jj,iku) 
    278                   ! interpolated values of tracers 
    279                   zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 
    280                   ! gradient of  tracers 
    281                   pgtu(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
    282                ELSE                           ! case 2 
    283                   zmaxu = -ze3wu / e3w_n(ji,jj,iku) 
    284                   ! interpolated values of tracers 
    285                   zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 
    286                   ! gradient of tracers 
    287                   pgtu(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
    288                ENDIF 
    289                ! 
    290                ! j- direction 
    291                IF( ze3wv >= 0._wp ) THEN      ! case 1 
    292                   zmaxv =  ze3wv / e3w_n(ji,jj+1,ikv) 
    293                   ! interpolated values of tracers 
    294                   ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 
    295                   ! gradient of tracers 
    296                   pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
    297                ELSE                           ! case 2 
    298                   zmaxv =  -ze3wv / e3w_n(ji,jj,ikv) 
    299                   ! interpolated values of tracers 
    300                   ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 
    301                   ! gradient of tracers 
    302                   pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
    303                ENDIF 
    304  
    305             END DO 
    306          END DO 
     264         DO_2D( 1, 0, 1, 0 ) 
     265 
     266            iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
     267            ikv = mbkv(ji,jj); ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1 
     268            ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 
     269            ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 
     270            ! 
     271            ! i- direction 
     272            IF( ze3wu >= 0._wp ) THEN      ! case 1 
     273               zmaxu =  ze3wu / e3w(ji+1,jj,iku,Kmm) 
     274               ! interpolated values of tracers 
     275               zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 
     276               ! gradient of  tracers 
     277               pgtu(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
     278            ELSE                           ! case 2 
     279               zmaxu = -ze3wu / e3w(ji,jj,iku,Kmm) 
     280               ! interpolated values of tracers 
     281               zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 
     282               ! gradient of tracers 
     283               pgtu(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
     284            ENDIF 
     285            ! 
     286            ! j- direction 
     287            IF( ze3wv >= 0._wp ) THEN      ! case 1 
     288               zmaxv =  ze3wv / e3w(ji,jj+1,ikv,Kmm) 
     289               ! interpolated values of tracers 
     290               ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 
     291               ! gradient of tracers 
     292               pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
     293            ELSE                           ! case 2 
     294               zmaxv =  -ze3wv / e3w(ji,jj,ikv,Kmm) 
     295               ! interpolated values of tracers 
     296               ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 
     297               ! gradient of tracers 
     298               pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
     299            ENDIF 
     300 
     301         END_2D 
    307302      END DO 
    308303      ! 
    309       CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1. , pgtv(:,:,:), 'V', -1. )   ! Lateral boundary cond. 
     304      CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    310305 
    311306      ! horizontal derivative of density anomalies (rd) 
    … …  
    313308         pgru(:,:)=0.0_wp   ; pgrv(:,:)=0.0_wp ;  
    314309         ! 
    315          DO jj = 1, jpjm1 
    316             DO ji = 1, jpim1 
    317  
    318                iku = mbku(ji,jj) 
    319                ikv = mbkv(ji,jj) 
    320                ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku) 
    321                ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv) 
    322                ! 
    323                IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku)    ! i-direction: case 1 
    324                ELSE                        ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku)    ! -     -      case 2 
    325                ENDIF 
    326                IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv)    ! j-direction: case 1 
    327                ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv)    ! -     -      case 2 
    328                ENDIF 
    329  
    330             END DO 
    331          END DO 
     310         DO_2D( 1, 0, 1, 0 ) 
     311 
     312            iku = mbku(ji,jj) 
     313            ikv = mbkv(ji,jj) 
     314            ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 
     315            ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 
     316            ! 
     317            IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept(ji  ,jj,iku,Kmm)    ! i-direction: case 1 
     318            ELSE                        ;   zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm)    ! -     -      case 2 
     319            ENDIF 
     320            IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept(ji,jj  ,ikv,Kmm)    ! j-direction: case 1 
     321            ELSE                        ;   zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm)    ! -     -      case 2 
     322            ENDIF 
     323 
     324         END_2D 
    332325 
    333326         ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 
    … …  
    336329         CALL eos( ztj, zhj, zrj ) 
    337330 
    338          DO jj = 1, jpjm1                 ! Gradient of density at the last level  
    339             DO ji = 1, jpim1 
    340                iku = mbku(ji,jj) 
    341                ikv = mbkv(ji,jj) 
    342                ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku) 
    343                ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv) 
    344  
    345                IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1 
    346                ELSE                        ;   pgru(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2 
    347                ENDIF 
    348                IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1 
    349                ELSE                        ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2 
    350                ENDIF 
    351  
    352             END DO 
    353          END DO 
    354  
    355          CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1. , pgrv , 'V', -1. )   ! Lateral boundary conditions 
     331         DO_2D( 1, 0, 1, 0 ) 
     332            iku = mbku(ji,jj) 
     333            ikv = mbkv(ji,jj) 
     334            ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 
     335            ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 
     336 
     337            IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1 
     338            ELSE                        ;   pgru(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2 
     339            ENDIF 
     340            IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1 
     341            ELSE                        ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2 
     342            ENDIF 
     343 
     344         END_2D 
     345 
     346         CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
    356347         ! 
    357348      END IF 
    … …  
    360351      ! 
    361352      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!            ! 
    362          DO jj = 1, jpjm1 
    363             DO ji = 1, jpim1 
    364                iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 
    365                ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1 
    366                ! 
    367                ! (ISF) case partial step top and bottom in adjacent cell in vertical 
    368                ! cannot used e3w because if 2 cell water column, we have ps at top and bottom 
    369                ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj 
    370                ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0 
    371                ze3wu  =  gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku) 
    372                ze3wv  =  gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv)  
    373  
    374                ! i- direction 
    375                IF( ze3wu >= 0._wp ) THEN      ! case 1 
    376                   zmaxu = ze3wu / e3w_n(ji+1,jj,ikup1) 
    377                   ! interpolated values of tracers 
    378                   zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikup1,jn) - pta(ji+1,jj,iku,jn) ) 
    379                   ! gradient of tracers 
    380                   pgtui(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
    381                ELSE                           ! case 2 
    382                   zmaxu = - ze3wu / e3w_n(ji,jj,ikup1) 
    383                   ! interpolated values of tracers 
    384                   zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikup1,jn) - pta(ji,jj,iku,jn) ) 
    385                   ! gradient of  tracers 
    386                   pgtui(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
    387                ENDIF 
    388                ! 
    389                ! j- direction 
    390                IF( ze3wv >= 0._wp ) THEN      ! case 1 
    391                   zmaxv =  ze3wv / e3w_n(ji,jj+1,ikvp1) 
    392                   ! interpolated values of tracers 
    393                   ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvp1,jn) - pta(ji,jj+1,ikv,jn) ) 
    394                   ! gradient of tracers 
    395                   pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
    396                ELSE                           ! case 2 
    397                   zmaxv =  - ze3wv / e3w_n(ji,jj,ikvp1) 
    398                   ! interpolated values of tracers 
    399                   ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvp1,jn) - pta(ji,jj,ikv,jn) ) 
    400                   ! gradient of tracers 
    401                   pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
    402                ENDIF 
    403  
    404             END DO 
    405          END DO 
     353         DO_2D( 1, 0, 1, 0 ) 
     354            iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 
     355            ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1 
     356            ! 
     357            ! (ISF) case partial step top and bottom in adjacent cell in vertical 
     358            ! cannot used e3w because if 2 cell water column, we have ps at top and bottom 
     359            ! in this case e3w(i,j,k,Kmm) - e3w(i,j+1,k,Kmm) is not the distance between Tj~ and Tj 
     360            ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0 
     361            ze3wu  =  gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 
     362            ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm)  
     363 
     364            ! i- direction 
     365            IF( ze3wu >= 0._wp ) THEN      ! case 1 
     366               zmaxu = ze3wu / e3w(ji+1,jj,ikup1,Kmm) 
     367               ! interpolated values of tracers 
     368               zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikup1,jn) - pta(ji+1,jj,iku,jn) ) 
     369               ! gradient of tracers 
     370               pgtui(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
     371            ELSE                           ! case 2 
     372               zmaxu = - ze3wu / e3w(ji,jj,ikup1,Kmm) 
     373               ! interpolated values of tracers 
     374               zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikup1,jn) - pta(ji,jj,iku,jn) ) 
     375               ! gradient of  tracers 
     376               pgtui(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
     377            ENDIF 
     378            ! 
     379            ! j- direction 
     380            IF( ze3wv >= 0._wp ) THEN      ! case 1 
     381               zmaxv =  ze3wv / e3w(ji,jj+1,ikvp1,Kmm) 
     382               ! interpolated values of tracers 
     383               ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvp1,jn) - pta(ji,jj+1,ikv,jn) ) 
     384               ! gradient of tracers 
     385               pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
     386            ELSE                           ! case 2 
     387               zmaxv =  - ze3wv / e3w(ji,jj,ikvp1,Kmm) 
     388               ! interpolated values of tracers 
     389               ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvp1,jn) - pta(ji,jj,ikv,jn) ) 
     390               ! gradient of tracers 
     391               pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
     392            ENDIF 
     393 
     394         END_2D 
    406395         ! 
    407396      END DO 
    408       CALL lbc_lnk_multi( 'zpshde', pgtui(:,:,:), 'U', -1. , pgtvi(:,:,:), 'V', -1. )   ! Lateral boundary cond. 
     397      CALL lbc_lnk_multi( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    409398 
    410399      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
    411400         ! 
    412401         pgrui(:,:)  =0.0_wp; pgrvi(:,:)  =0.0_wp; 
    413          DO jj = 1, jpjm1 
    414             DO ji = 1, jpim1 
    415  
    416                iku = miku(ji,jj) 
    417                ikv = mikv(ji,jj) 
    418                ze3wu  =  gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku) 
    419                ze3wv  =  gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv)  
    420                ! 
    421                IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku)    ! i-direction: case 1 
    422                ELSE                        ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku)    ! -     -      case 2 
    423                ENDIF 
    424  
    425                IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv)    ! j-direction: case 1 
    426                ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv)    ! -     -      case 2 
    427                ENDIF 
    428  
    429             END DO 
    430          END DO 
     402         DO_2D( 1, 0, 1, 0 ) 
     403 
     404            iku = miku(ji,jj) 
     405            ikv = mikv(ji,jj) 
     406            ze3wu  =  gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 
     407            ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm)  
     408            ! 
     409            IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept(ji  ,jj,iku,Kmm)    ! i-direction: case 1 
     410            ELSE                        ;   zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm)    ! -     -      case 2 
     411            ENDIF 
     412 
     413            IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept(ji,jj  ,ikv,Kmm)    ! j-direction: case 1 
     414            ELSE                        ;   zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm)    ! -     -      case 2 
     415            ENDIF 
     416 
     417         END_2D 
    431418         ! 
    432419         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj  
    433420         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj  
    434421         ! 
    435          DO jj = 1, jpjm1                 ! Gradient of density at the last level  
    436             DO ji = 1, jpim1 
    437                iku = miku(ji,jj)  
    438                ikv = mikv(ji,jj)  
    439                ze3wu  =  gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku) 
    440                ze3wv  =  gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv)  
    441  
    442                IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj      ) - prd(ji,jj,iku) ) ! i: 1 
    443                ELSE                      ; pgrui(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj  ,iku) - zri(ji,jj    ) ) ! i: 2 
    444                ENDIF 
    445                IF( ze3wv >= 0._wp ) THEN ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( zrj(ji  ,jj      ) - prd(ji,jj,ikv) ) ! j: 1 
    446                ELSE                      ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( prd(ji  ,jj+1,ikv) - zrj(ji,jj    ) ) ! j: 2 
    447                ENDIF 
    448  
    449             END DO 
    450          END DO 
    451          CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1. , pgrvi, 'V', -1. )   ! Lateral boundary conditions 
     422         DO_2D( 1, 0, 1, 0 ) 
     423            iku = miku(ji,jj)  
     424            ikv = mikv(ji,jj)  
     425            ze3wu  =  gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 
     426            ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm)  
     427 
     428            IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj      ) - prd(ji,jj,iku) ) ! i: 1 
     429            ELSE                      ; pgrui(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj  ,iku) - zri(ji,jj    ) ) ! i: 2 
     430            ENDIF 
     431            IF( ze3wv >= 0._wp ) THEN ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( zrj(ji  ,jj      ) - prd(ji,jj,ikv) ) ! j: 1 
     432            ELSE                      ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( prd(ji  ,jj+1,ikv) - zrj(ji,jj    ) ) ! j: 2 
     433            ENDIF 
     434 
     435         END_2D 
     436         CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp )   ! Lateral boundary conditions 
    452437         ! 
    453438      END IF   
Note: See TracChangeset for help on using the changeset viewer.