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 5568 for branches/UKMO/dev_r5107_hadgem3_mct/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90 – NEMO

Ignore:
Timestamp:
2015-07-08T17:13:59+02:00 (9 years ago)
Author:
davestorkey
Message:

Upgrade UKMO/dev_r5107_hadgem3_mct branch to trunk revision 5518
( = branching point for NEMO 3.6_stable).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5107_hadgem3_mct/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90

    r5279 r5568  
    88   !!             -   !  2004-03  (C. Ethe)  adapted for passive tracers 
    99   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA  
     10   !!            3.6  !  2014-11  (P. Mathiot) Add zps_hde_isf (needed to open a cavity) 
    1011   !!====================================================================== 
    1112    
     
    2728   PRIVATE 
    2829 
    29    PUBLIC   zps_hde    ! routine called by step.F90 
     30   PUBLIC   zps_hde     ! routine called by step.F90 
     31   PUBLIC   zps_hde_isf ! routine called by step.F90 
    3032 
    3133   !! * Substitutions 
     
    4042 
    4143   SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv,   & 
     44      &                          prd, pgru, pgrv    ) 
     45      !!---------------------------------------------------------------------- 
     46      !!                     ***  ROUTINE zps_hde  *** 
     47      !!                     
     48      !! ** Purpose :   Compute the horizontal derivative of T, S and rho 
     49      !!      at u- and v-points with a linear interpolation for z-coordinate 
     50      !!      with partial steps. 
     51      !! 
     52      !! ** Method  :   In z-coord with partial steps, scale factors on last  
     53      !!      levels are different for each grid point, so that T, S and rd  
     54      !!      points are not at the same depth as in z-coord. To have horizontal 
     55      !!      gradients again, we interpolate T and S at the good depth :  
     56      !!      Linear interpolation of T, S    
     57      !!         Computation of di(tb) and dj(tb) by vertical interpolation: 
     58      !!          di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~ 
     59      !!          dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~ 
     60      !!         This formulation computes the two cases: 
     61      !!                 CASE 1                   CASE 2   
     62      !!         k-1  ___ ___________   k-1   ___ ___________ 
     63      !!                    Ti  T~                  T~  Ti+1 
     64      !!                  _____                        _____ 
     65      !!         k        |   |Ti+1     k           Ti |   | 
     66      !!                  |   |____                ____|   | 
     67      !!              ___ |   |   |           ___  |   |   | 
     68      !!                   
     69      !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then 
     70      !!          t~ = t(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1) 
     71      !!        ( t~ = t(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1)  ) 
     72      !!          or 
     73      !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then 
     74      !!          t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i ) 
     75      !!        ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) ) 
     76      !!          Idem for di(s) and dj(s)           
     77      !! 
     78      !!      For rho, we call eos which will compute rd~(t~,s~) at the right 
     79      !!      depth zh from interpolated T and S for the different formulations 
     80      !!      of the equation of state (eos). 
     81      !!      Gradient formulation for rho : 
     82      !!          di(rho) = rd~ - rd(i,j,k)   or   rd(i+1,j,k) - rd~ 
     83      !! 
     84      !! ** Action  : compute for top interfaces 
     85      !!              - pgtu, pgtv: horizontal gradient of tracer at u- & v-points 
     86      !!              - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points 
     87      !!---------------------------------------------------------------------- 
     88      INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index 
     89      INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers 
     90      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields 
     91      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts  
     92      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields 
     93      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom) 
     94      ! 
     95      INTEGER  ::   ji, jj, jn      ! Dummy loop indices 
     96      INTEGER  ::   iku, ikv, ikum1, ikvm1   ! partial step level (ocean bottom level) at u- and v-points 
     97      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv  ! temporary scalars 
     98      REAL(wp), DIMENSION(jpi,jpj)      ::  zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos 
     99      REAL(wp), DIMENSION(jpi,jpj,kjpt) ::  zti, ztj             !  
     100      !!---------------------------------------------------------------------- 
     101      ! 
     102      IF( nn_timing == 1 )  CALL timing_start( 'zps_hde') 
     103      ! 
     104      pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ; 
     105      zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ; 
     106      zhi (:,:  )=0.0_wp ; zhj (:,:  )=0.0_wp ; 
     107      ! 
     108      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
     109         ! 
     110         DO jj = 1, jpjm1 
     111            DO ji = 1, jpim1 
     112               iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
     113               ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1 
     114               ze3wu = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku) 
     115               ze3wv = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv) 
     116               ! 
     117               ! i- direction 
     118               IF( ze3wu >= 0._wp ) THEN      ! case 1 
     119                  zmaxu =  ze3wu / fse3w(ji+1,jj,iku) 
     120                  ! interpolated values of tracers 
     121                  zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 
     122                  ! gradient of  tracers 
     123                  pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
     124               ELSE                           ! case 2 
     125                  zmaxu = -ze3wu / fse3w(ji,jj,iku) 
     126                  ! interpolated values of tracers 
     127                  zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 
     128                  ! gradient of tracers 
     129                  pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
     130               ENDIF 
     131               ! 
     132               ! j- direction 
     133               IF( ze3wv >= 0._wp ) THEN      ! case 1 
     134                  zmaxv =  ze3wv / fse3w(ji,jj+1,ikv) 
     135                  ! interpolated values of tracers 
     136                  ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 
     137                  ! gradient of tracers 
     138                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
     139               ELSE                           ! case 2 
     140                  zmaxv =  -ze3wv / fse3w(ji,jj,ikv) 
     141                  ! interpolated values of tracers 
     142                  ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 
     143                  ! gradient of tracers 
     144                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
     145               ENDIF 
     146            END DO 
     147         END DO 
     148         CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond. 
     149         ! 
     150      END DO 
     151 
     152      ! horizontal derivative of density anomalies (rd) 
     153      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level 
     154         pgru(:,:)=0.0_wp   ; pgrv(:,:)=0.0_wp ;  
     155         DO jj = 1, jpjm1 
     156            DO ji = 1, jpim1 
     157               iku = mbku(ji,jj) 
     158               ikv = mbkv(ji,jj) 
     159               ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku) 
     160               ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv) 
     161               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = fsdept(ji  ,jj,iku)     ! i-direction: case 1 
     162               ELSE                        ;   zhi(ji,jj) = fsdept(ji+1,jj,iku)     ! -     -      case 2 
     163               ENDIF 
     164               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = fsdept(ji,jj  ,ikv)     ! j-direction: case 1 
     165               ELSE                        ;   zhj(ji,jj) = fsdept(ji,jj+1,ikv)     ! -     -      case 2 
     166               ENDIF 
     167            END DO 
     168         END DO 
     169 
     170         ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 
     171         ! step and store it in  zri, zrj for each  case 
     172         CALL eos( zti, zhi, zri )   
     173         CALL eos( ztj, zhj, zrj ) 
     174 
     175         ! Gradient of density at the last level  
     176         DO jj = 1, jpjm1 
     177            DO ji = 1, jpim1 
     178               iku = mbku(ji,jj) 
     179               ikv = mbkv(ji,jj) 
     180               ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku) 
     181               ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv) 
     182               IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1 
     183               ELSE                        ;   pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2 
     184               ENDIF 
     185               IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1 
     186               ELSE                        ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2 
     187               ENDIF 
     188            END DO 
     189         END DO 
     190         CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. )   ! Lateral boundary conditions 
     191         ! 
     192      END IF 
     193      ! 
     194      IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde') 
     195      ! 
     196   END SUBROUTINE zps_hde 
     197   ! 
     198   SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv,   & 
    42199      &                          prd, pgru, pgrv, pmru, pmrv, pgzu, pgzv, pge3ru, pge3rv,  & 
    43       &                   sgtu, sgtv, sgru, sgrv, smru, smrv, sgzu, sgzv, sge3ru, sge3rv ) 
     200      &                   pgtui, pgtvi, pgrui, pgrvi, pmrui, pmrvi, pgzui, pgzvi, pge3rui, pge3rvi ) 
    44201      !!---------------------------------------------------------------------- 
    45202      !!                     ***  ROUTINE zps_hde  *** 
     
    82239      !! 
    83240      !! ** Action  : compute for top and bottom interfaces 
    84       !!              - pgtu, pgtv, sgtu, sgtv: horizontal gradient of tracer at u- & v-points 
    85       !!              - pgru, pgrv, sgru, sgtv: horizontal gradient of rho (if present) at u- & v-points 
    86       !!              - pmru, pmrv, smru, smrv: horizontal sum of rho at u- & v- point (used in dynhpg with vvl) 
    87       !!              - pgzu, pgzv, sgzu, sgzv: horizontal gradient of z at u- and v- point (used in dynhpg with vvl) 
    88       !!              - pge3ru, pge3rv, sge3ru, sge3rv: horizontal gradient of rho weighted by local e3w at u- & v-points  
     241      !!              - pgtu, pgtv, pgtui, pgtvi: horizontal gradient of tracer at u- & v-points 
     242      !!              - pgru, pgrv, pgrui, pgtvi: horizontal gradient of rho (if present) at u- & v-points 
     243      !!              - pmru, pmrv, pmrui, pmrvi: horizontal sum of rho at u- & v- point (used in dynhpg with vvl) 
     244      !!              - pgzu, pgzv, pgzui, pgzvi: horizontal gradient of z at u- and v- point (used in dynhpg with vvl) 
     245      !!              - pge3ru, pge3rv, pge3rui, pge3rvi: horizontal gradient of rho weighted by local e3w at u- & v-points  
    89246      !!---------------------------------------------------------------------- 
    90247      INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index 
     
    92249      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields 
    93250      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts  
    94       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  sgtu, sgtv  ! hor. grad. of stra at u- & v-pts (ISF) 
     251      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtui, pgtvi  ! hor. grad. of stra at u- & v-pts (ISF) 
    95252      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields 
    96253      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv      ! hor. grad of prd at u- & v-pts (bottom) 
     
    98255      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgzu, pgzv      ! hor. grad of z   at u- & v-pts (bottom) 
    99256      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pge3ru, pge3rv  ! hor. grad of prd weighted by local e3w at u- & v-pts (bottom) 
    100       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  sgru, sgrv      ! hor. grad of prd at u- & v-pts (top) 
    101       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  smru, smrv      ! hor. sum  of prd at u- & v-pts (top) 
    102       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  sgzu, sgzv      ! hor. grad of z   at u- & v-pts (top) 
    103       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  sge3ru, sge3rv  ! hor. grad of prd weighted by local e3w at u- & v-pts (top) 
     257      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgrui, pgrvi      ! hor. grad of prd at u- & v-pts (top) 
     258      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pmrui, pmrvi      ! hor. sum  of prd at u- & v-pts (top) 
     259      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgzui, pgzvi      ! hor. grad of z   at u- & v-pts (top) 
     260      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pge3rui, pge3rvi  ! hor. grad of prd weighted by local e3w at u- & v-pts (top) 
    104261      ! 
    105262      INTEGER  ::   ji, jj, jn      ! Dummy loop indices 
     
    110267      !!---------------------------------------------------------------------- 
    111268      ! 
    112       IF( nn_timing == 1 )  CALL timing_start( 'zps_hde') 
     269      IF( nn_timing == 1 )  CALL timing_start( 'zps_hde_isf') 
    113270      ! 
    114271      pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ; 
    115       sgtu(:,:,:)=0.0_wp ; sgtv(:,:,:)=0.0_wp ; 
     272      pgtui(:,:,:)=0.0_wp ; pgtvi(:,:,:)=0.0_wp ; 
    116273      zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ; 
    117274      zhi (:,:  )=0.0_wp ; zhj (:,:  )=0.0_wp ; 
     
    256413                  zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,iku+1,jn) - pta(ji+1,jj,iku,jn) ) 
    257414                  ! gradient of tracers 
    258                   sgtu(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
     415                  pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
    259416               ELSE                           ! case 2 
    260417                  zmaxu = - ze3wu / fse3w(ji,jj,iku+1) 
     
    262419                  zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,iku+1,jn) - pta(ji,jj,iku,jn) ) 
    263420                  ! gradient of  tracers 
    264                   sgtu(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
     421                  pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
    265422               ENDIF 
    266423               ! 
     
    271428                  ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikv+1,jn) - pta(ji,jj+1,ikv,jn) ) 
    272429                  ! gradient of tracers 
    273                   sgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
     430                  pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
    274431               ELSE                           ! case 2 
    275432                  zmaxv =  - ze3wv / fse3w(ji,jj,ikv+1) 
     
    277434                  ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikv+1,jn) - pta(ji,jj,ikv,jn) ) 
    278435                  ! gradient of tracers 
    279                   sgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
     436                  pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
    280437               ENDIF 
    281438            END DO!! 
    282439         END DO!! 
    283          CALL lbc_lnk( sgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( sgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond. 
     440         CALL lbc_lnk( pgtui(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtvi(:,:,jn), 'V', -1. )   ! Lateral boundary cond. 
    284441         ! 
    285442      END DO 
     
    287444      ! horizontal derivative of density anomalies (rd) 
    288445      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level 
    289          sgru(:,:)  =0.0_wp ; sgrv(:,:)  =0.0_wp ; 
    290          sgzu(:,:)  =0.0_wp ; sgzv(:,:)  =0.0_wp ; 
    291          smru(:,:)  =0.0_wp ; smru(:,:)  =0.0_wp ; 
    292          sge3ru(:,:)=0.0_wp ; sge3rv(:,:)=0.0_wp ; 
     446         pgrui(:,:)  =0.0_wp ; pgrvi(:,:)  =0.0_wp ; 
     447         pgzui(:,:)  =0.0_wp ; pgzvi(:,:)  =0.0_wp ; 
     448         pmrui(:,:)  =0.0_wp ; pmrui(:,:)  =0.0_wp ; 
     449         pge3rui(:,:)=0.0_wp ; pge3rvi(:,:)=0.0_wp ; 
    293450 
    294451         DO jj = 1, jpjm1 
     
    321478               ze3wv  = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv)) 
    322479               IF( ze3wu >= 0._wp ) THEN 
    323                  sgzu  (ji,jj) = (fsde3w(ji+1,jj,iku) + ze3wu) - fsde3w(ji,jj,iku) 
    324                  sgru  (ji,jj) = umask(ji,jj,iku)   * ( zri(ji,jj) - prd(ji,jj,iku) )          ! i: 1 
    325                  smru  (ji,jj) = umask(ji,jj,iku)   * ( zri(ji,jj) + prd(ji,jj,iku) )          ! i: 1  
    326                  sge3ru(ji,jj) = umask(ji,jj,iku+1)                                                                  & 
     480                 pgzui  (ji,jj) = (fsde3w(ji+1,jj,iku) + ze3wu) - fsde3w(ji,jj,iku) 
     481                 pgrui  (ji,jj) = umask(ji,jj,iku)   * ( zri(ji,jj) - prd(ji,jj,iku) )          ! i: 1 
     482                 pmrui  (ji,jj) = umask(ji,jj,iku)   * ( zri(ji,jj) + prd(ji,jj,iku) )          ! i: 1  
     483                 pge3rui(ji,jj) = umask(ji,jj,iku+1)                                                                  & 
    327484                                * ( (fse3w(ji+1,jj,iku+1) - ze3wu) * (zri(ji,jj    ) + prd(ji+1,jj,iku+1) + 2._wp)   & 
    328485                                   - fse3w(ji  ,jj,iku+1)          * (prd(ji,jj,iku) + prd(ji  ,jj,iku+1) + 2._wp)   ) ! i: 1 
    329486               ELSE 
    330                  sgzu  (ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu) 
    331                  sgru  (ji,jj) = umask(ji,jj,iku)   * ( prd(ji+1,jj,iku) - zri(ji,jj) )      ! i: 2 
    332                  smru  (ji,jj) = umask(ji,jj,iku)   * ( prd(ji+1,jj,iku) + zri(ji,jj) )      ! i: 2 
    333                  sge3ru(ji,jj) = umask(ji,jj,iku+1)                                                                   & 
     487                 pgzui  (ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu) 
     488                 pgrui  (ji,jj) = umask(ji,jj,iku)   * ( prd(ji+1,jj,iku) - zri(ji,jj) )      ! i: 2 
     489                 pmrui  (ji,jj) = umask(ji,jj,iku)   * ( prd(ji+1,jj,iku) + zri(ji,jj) )      ! i: 2 
     490                 pge3rui(ji,jj) = umask(ji,jj,iku+1)                                                                   & 
    334491                                * (  fse3w(ji+1,jj,iku+1)          * (prd(ji+1,jj,iku) + prd(ji+1,jj,iku+1) + 2._wp)  & 
    335492                                   -(fse3w(ji  ,jj,iku+1) + ze3wu) * (zri(ji,jj      ) + prd(ji  ,jj,iku+1) + 2._wp)  )     ! i: 2 
    336493               ENDIF 
    337494               IF( ze3wv >= 0._wp ) THEN 
    338                  sgzv  (ji,jj) = (fsde3w(ji,jj+1,ikv) + ze3wv) - fsde3w(ji,jj,ikv)  
    339                  sgrv  (ji,jj) = vmask(ji,jj,ikv)   * ( zrj(ji,jj  ) - prd(ji,jj,ikv) )        ! j: 1 
    340                  smrv  (ji,jj) = vmask(ji,jj,ikv)   * ( zrj(ji,jj  ) + prd(ji,jj,ikv) )        ! j: 1 
    341                  sge3rv(ji,jj) = vmask(ji,jj,ikv+1)                                                                  &  
     495                 pgzvi  (ji,jj) = (fsde3w(ji,jj+1,ikv) + ze3wv) - fsde3w(ji,jj,ikv)  
     496                 pgrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( zrj(ji,jj  ) - prd(ji,jj,ikv) )        ! j: 1 
     497                 pmrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( zrj(ji,jj  ) + prd(ji,jj,ikv) )        ! j: 1 
     498                 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1)                                                                  &  
    342499                                * ( (fse3w(ji,jj+1,ikv+1) - ze3wv) * ( zrj(ji,jj    ) + prd(ji,jj+1,ikv+1) + 2._wp)  & 
    343500                                   - fse3w(ji,jj  ,ikv+1)          * ( prd(ji,jj,ikv) + prd(ji,jj  ,ikv+1) + 2._wp)  ) ! j: 1 
    344501                                  ! + 2 due to the formulation in density and not in anomalie in hpg sco 
    345502               ELSE 
    346                  sgzv  (ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) - ze3wv) 
    347                  sgrv  (ji,jj) = vmask(ji,jj,ikv)   * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )     ! j: 2 
    348                  smrv  (ji,jj) = vmask(ji,jj,ikv)   * ( prd(ji,jj+1,ikv) + zrj(ji,jj) )     ! j: 2 
    349                  sge3rv(ji,jj) = vmask(ji,jj,ikv+1)                                                                   & 
     503                 pgzvi  (ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) - ze3wv) 
     504                 pgrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )     ! j: 2 
     505                 pmrvi  (ji,jj) = vmask(ji,jj,ikv)   * ( prd(ji,jj+1,ikv) + zrj(ji,jj) )     ! j: 2 
     506                 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1)                                                                   & 
    350507                                * (  fse3w(ji,jj+1,ikv+1)          * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikv+1) + 2._wp) & 
    351508                                   -(fse3w(ji,jj  ,ikv+1) + ze3wv) * ( zrj(ji,jj      ) + prd(ji,jj  ,ikv+1) + 2._wp) )  ! j: 2 
     
    353510            END DO 
    354511         END DO 
    355          CALL lbc_lnk( sgru   , 'U', -1. )   ;   CALL lbc_lnk( sgrv   , 'V', -1. )   ! Lateral boundary conditions 
    356          CALL lbc_lnk( smru   , 'U',  1. )   ;   CALL lbc_lnk( smrv   , 'V',  1. )   ! Lateral boundary conditions 
    357          CALL lbc_lnk( sgzu   , 'U', -1. )   ;   CALL lbc_lnk( sgzv   , 'V', -1. )   ! Lateral boundary conditions 
    358          CALL lbc_lnk( sge3ru , 'U', -1. )   ;   CALL lbc_lnk( sge3rv , 'V', -1. )   ! Lateral boundary conditions 
     512         CALL lbc_lnk( pgrui   , 'U', -1. )   ;   CALL lbc_lnk( pgrvi   , 'V', -1. )   ! Lateral boundary conditions 
     513         CALL lbc_lnk( pmrui   , 'U',  1. )   ;   CALL lbc_lnk( pmrvi   , 'V',  1. )   ! Lateral boundary conditions 
     514         CALL lbc_lnk( pgzui   , 'U', -1. )   ;   CALL lbc_lnk( pgzvi   , 'V', -1. )   ! Lateral boundary conditions 
     515         CALL lbc_lnk( pge3rui , 'U', -1. )   ;   CALL lbc_lnk( pge3rvi , 'V', -1. )   ! Lateral boundary conditions 
    359516         ! 
    360517      END IF   
    361518      ! 
    362       IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde') 
    363       ! 
    364    END SUBROUTINE zps_hde 
    365  
     519      IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde_isf') 
     520      ! 
     521   END SUBROUTINE zps_hde_isf 
    366522   !!====================================================================== 
    367523END MODULE zpshde 
Note: See TracChangeset for help on using the changeset viewer.