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.
zpshde.F90 in NEMO/branches/UKMO/BPC_miniapp/OpenACC_managed – NEMO

source: NEMO/branches/UKMO/BPC_miniapp/OpenACC_managed/zpshde.F90 @ 10838

Last change on this file since 10838 was 10838, checked in by wayne_gaudin, 5 years ago

Ticket #2197 - extracted versions added
File size: 10.9 KB
Line 
1MODULE zpshde
2   !!======================================================================
3   !!                       ***  MODULE zpshde   ***
4   !! z-coordinate + partial step : Horizontal Derivative at ocean bottom level
5   !!======================================================================
6   !! History :  OPA  !  2002-04  (A. Bozec)  Original code
7   !!   NEMO     1.0  !  2002-08  (G. Madec E. Durand)  Optimization and Free form
8   !!             -   !  2004-03  (C. Ethe)  adapted for passive tracers
9   !!            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)
11   !!======================================================================
12   
13   !!----------------------------------------------------------------------
14   !!   zps_hde      :  Horizontal DErivative of T, S and rd at the last
15   !!                   ocean level (Z-coord. with Partial Steps)
16   !!----------------------------------------------------------------------
17   USE len_oce         ! ocean lengths
18   USE phycst          ! physical constants
19   USE in_out_manager  ! I/O manager
20   USE eosinsitu
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   zps_hde     ! routine called by step.F90
26
27   !! * Substitutions
28   !!----------------------------------------------------------------------
29   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
30   !! $Id$
31   !! Software governed by the CeCILL licence     (./LICENSE)
32   !!----------------------------------------------------------------------
33CONTAINS
34
35   SUBROUTINE zps_hde( kt, kjpt, pta,  mbku, mbkv, e3w_n, gdept_n, tmask, umask, vmask,  &
36      &                          pgtu, pgtv, prd,  pgru,  pgrv,                          &
37      &                          zti, zhi, zri, ztj, zhj, zrj)
38      !!----------------------------------------------------------------------
39      !!                     ***  ROUTINE zps_hde  ***
40      !!                   
41      !! ** Purpose :   Compute the horizontal derivative of T, S and rho
42      !!      at u- and v-points with a linear interpolation for z-coordinate
43      !!      with partial steps.
44      !!
45      !! ** Method  :   In z-coord with partial steps, scale factors on last
46      !!      levels are different for each grid point, so that T, S and rd
47      !!      points are not at the same depth as in z-coord. To have horizontal
48      !!      gradients again, we interpolate T and S at the good depth :
49      !!      Linear interpolation of T, S   
50      !!         Computation of di(tb) and dj(tb) by vertical interpolation:
51      !!          di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~
52      !!          dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~
53      !!         This formulation computes the two cases:
54      !!                 CASE 1                   CASE 2 
55      !!         k-1  ___ ___________   k-1   ___ ___________
56      !!                    Ti  T~                  T~  Ti+1
57      !!                  _____                        _____
58      !!         k        |   |Ti+1     k           Ti |   |
59      !!                  |   |____                ____|   |
60      !!              ___ |   |   |           ___  |   |   |
61      !!                 
62      !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then
63      !!          t~ = t(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1)
64      !!        ( t~ = t(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1)  )
65      !!          or
66      !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then
67      !!          t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i )
68      !!        ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) )
69      !!          Idem for di(s) and dj(s)         
70      !!
71      !!      For rho, we call eos which will compute rd~(t~,s~) at the right
72      !!      depth zh from interpolated T and S for the different formulations
73      !!      of the equation of state (eos).
74      !!      Gradient formulation for rho :
75      !!          di(rho) = rd~ - rd(i,j,k)   or   rd(i+1,j,k) - rd~
76      !!
77      !! ** Action  : compute for top interfaces
78      !!              - pgtu, pgtv: horizontal gradient of tracer at u- & v-points
79      !!              - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points
80      !!----------------------------------------------------------------------
81      INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index
82      INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers
83      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields
84      INTEGER,  DIMENSION(jpi,jpj)         , INTENT(in   )           ::  mbku, mbkv
85      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   )           ::  e3w_n, gdept_n
86      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   )           ::  tmask, umask, vmask
87      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts
88      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields
89      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom)
90      REAL(wp), DIMENSION(jpi,jpj         ) ,INTENT(inout)           ::  zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos
91      REAL(wp), DIMENSION(jpi,jpj,kjpt    ) ,INTENT(inout)           ::  zti, ztj             !
92      !
93      INTEGER  ::   ji, jj, jn                  ! Dummy loop indices
94      INTEGER  ::   iku, ikv, ikum1, ikvm1      ! partial step level (ocean bottom level) at u- and v-points
95      REAL(wp) ::   ze3wu, ze3wv, zmaxu, zmaxv  ! local scalars
96      REAL(wp) :: et
97      !!----------------------------------------------------------------------
98      et = TIMER()
99      !
100      !
101
102!$ACC KERNELS
103      pgtu(:,:,:) = 0._wp   ;   zti (:,:,:) = 0._wp   ;   zhi (:,:) = 0._wp
104      pgtv(:,:,:) = 0._wp   ;   ztj (:,:,:) = 0._wp   ;   zhj (:,:) = 0._wp
105      !
106      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
107         !
108         DO jj = 1, jpjm1
109            DO ji = 1, jpim1
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_b should be used....
113               ze3wu = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku)
114               ze3wv = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv)
115               !
116               ! i- direction
117               IF( ze3wu >= 0._wp ) THEN      ! case 1
118                  zmaxu =  ze3wu / e3w_n(ji+1,jj,iku)
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_n(ji,jj,iku)
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_n(ji,jj+1,ikv)
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_n(ji,jj,ikv)
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 DO
146         END DO
147! MJB        CALL lbc_lnk_multi( pgtu(:,:,jn), 'U', -1. , pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
148         !
149      END DO
150!$ACC END KERNELS
151      !               
152      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part)
153!$ACC KERNELS
154
155         pgru(:,:) = 0._wp
156         pgrv(:,:) = 0._wp                ! depth of the partial step level
157         DO jj = 1, jpjm1
158            DO ji = 1, jpim1
159               iku = mbku(ji,jj)
160               ikv = mbkv(ji,jj)
161               ze3wu  = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku)
162               ze3wv  = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv)
163               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku)     ! i-direction: case 1
164               ELSE                        ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku)     ! -     -      case 2
165               ENDIF
166               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv)     ! j-direction: case 1
167               ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv)     ! -     -      case 2
168               ENDIF
169            END DO
170         END DO
171         !
172!$ACC END KERNELS
173! _2d re-instated here to make it easier to read !
174         CALL eos_insitu_2d( zti, zhi, zri )        ! interpolated density from zti, ztj
175         CALL eos_insitu_2d( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj
176
177         !
178!$ACC KERNELS
179         DO jj = 1, jpjm1                 ! Gradient of density at the last level
180            DO ji = 1, jpim1
181               iku = mbku(ji,jj)
182               ikv = mbkv(ji,jj)
183               ze3wu  = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku)
184               ze3wv  = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv)
185               IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1
186               ELSE                        ;   pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2
187               ENDIF
188               IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1
189               ELSE                        ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2
190               ENDIF
191            END DO
192         END DO
193!$ACC END KERNELS
194! MJB         CALL lbc_lnk_multi( pgru , 'U', -1. , pgrv , 'V', -1. )   ! Lateral boundary conditions
195         !
196      END IF
197      !      !
198      !zps_hde_time = zps_hde_time + (TIMER() - et) ! Timer moved up call tree
199   END SUBROUTINE zps_hde
200
201   !!======================================================================
202END MODULE zpshde
Note: See TracBrowser for help on using the repository browser.