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.
traldf_lap_blp.F90 in trunk/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

source: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90 @ 7646

Last change on this file since 7646 was 7646, checked in by timgraham, 7 years ago

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

  • Property svn:keywords set to Id
File size: 14.8 KB
Line 
1MODULE traldf_lap_blp
2   !!==============================================================================
3   !!                       ***  MODULE  traldf_lap_blp  ***
4   !! Ocean tracers:  lateral diffusivity trend  (laplacian and bilaplacian)
5   !!==============================================================================
6   !! History :  3.7  ! 2014-01  (G. Madec, S. Masson)  Original code, re-entrant laplacian
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   tra_ldf_lap   : tracer trend update with iso-level laplacian diffusive operator
11   !!   tra_ldf_blp   : tracer trend update with iso-level or iso-neutral bilaplacian operator
12   !!----------------------------------------------------------------------
13   USE oce            ! ocean dynamics and active tracers
14   USE dom_oce        ! ocean space and time domain
15   USE ldftra         ! lateral physics: eddy diffusivity
16   USE traldf_iso     ! iso-neutral lateral diffusion (standard operator)     (tra_ldf_iso   routine)
17   USE traldf_triad   ! iso-neutral lateral diffusion (triad    operator)     (tra_ldf_triad routine)
18   USE diaptr         ! poleward transport diagnostics
19   USE diaar5         ! AR5 diagnostics
20   USE trc_oce        ! share passive tracers/Ocean variables
21   USE zpshde         ! partial step: hor. derivative     (zps_hde routine)
22   !
23   USE in_out_manager ! I/O manager
24   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
25   USE lib_mpp        ! distribued memory computing library
26   USE timing         ! Timing
27   USE wrk_nemo       ! Memory allocation
28   USE iom
29
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC   tra_ldf_lap   ! called by traldf.F90
34   PUBLIC   tra_ldf_blp   ! called by traldf.F90
35
36   !                      ! Flag to control the type of lateral diffusive operator
37   INTEGER, PARAMETER, PUBLIC ::   np_ERROR  =-10   ! error in specification of lateral diffusion
38   INTEGER, PARAMETER, PUBLIC ::   np_no_ldf = 00   ! without operator (i.e. no lateral diffusive trend)
39   !                          !!      laplacian     !    bilaplacian    !
40   INTEGER, PARAMETER, PUBLIC ::   np_lap    = 10   ,   np_blp    = 20  ! iso-level operator
41   INTEGER, PARAMETER, PUBLIC ::   np_lap_i  = 11   ,   np_blp_i  = 21  ! standard iso-neutral or geopotential operator
42   INTEGER, PARAMETER, PUBLIC ::   np_lap_it = 12   ,   np_blp_it = 22  ! triad    iso-neutral or geopotential operator
43
44   LOGICAL  ::   l_ptr   ! flag to compute poleward transport
45   LOGICAL  ::   l_hst   ! flag to compute heat transport
46
47   !! * Substitutions
48#  include "vectopt_loop_substitute.h90"
49   !!----------------------------------------------------------------------
50   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
51   !! $Id$
52   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
53   !!----------------------------------------------------------------------
54CONTAINS
55
56   SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
57      &                                                    pgui, pgvi,   &
58      &                                        ptb , pta , kjpt, kpass ) 
59      !!----------------------------------------------------------------------
60      !!                  ***  ROUTINE tra_ldf_lap  ***
61      !!                   
62      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive
63      !!      trend and add it to the general trend of tracer equation.
64      !!
65      !! ** Method  :   Second order diffusive operator evaluated using before
66      !!      fields (forward time scheme). The horizontal diffusive trends of
67      !!      the tracer is given by:
68      !!          difft = 1/(e1e2t*e3t) {  di-1[ pahu e2u*e3u/e1u di(tb) ]
69      !!                                 + dj-1[ pahv e1v*e3v/e2v dj(tb) ] }
70      !!      Add this trend to the general tracer trend pta :
71      !!          pta = pta + difft
72      !!
73      !! ** Action  : - Update pta arrays with the before iso-level
74      !!                harmonic mixing trend.
75      !!----------------------------------------------------------------------
76      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
77      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index
78      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
79      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
80      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
81      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
82      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
83      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels
84      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
85      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
86      !
87      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
88      REAL(wp) ::   zsign            ! local scalars
89      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztu, ztv, zaheeu, zaheev
90      !!----------------------------------------------------------------------
91      !
92      IF( nn_timing == 1 )   CALL timing_start('tra_ldf_lap')
93      !
94      IF( kt == nit000 .AND. lwp )  THEN
95         WRITE(numout,*)
96         WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass
97         WRITE(numout,*) '~~~~~~~~~~~ '
98      ENDIF
99      !
100      CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev ) 
101      !
102      l_hst = .FALSE.
103      l_ptr = .FALSE.
104      IF( cdtype == 'TRA' .AND. ln_diaptr )                                                l_ptr = .TRUE. 
105      IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
106         &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE.
107      !
108      !                                !==  Initialization of metric arrays used for all tracers  ==!
109      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
110      ELSE                    ;   zsign = -1._wp
111      ENDIF
112      DO jk = 1, jpkm1
113         DO jj = 1, jpjm1
114            DO ji = 1, fs_jpim1   ! vector opt.
115               zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk)   !!gm   * umask(ji,jj,jk) pah masked!
116               zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk)   !!gm   * vmask(ji,jj,jk)
117            END DO
118         END DO
119      END DO
120      !
121      !                             ! =========== !
122      DO jn = 1, kjpt               ! tracer loop !
123         !                          ! =========== !   
124         !                               
125         DO jk = 1, jpkm1              !== First derivative (gradient)  ==!
126            DO jj = 1, jpjm1
127               DO ji = 1, fs_jpim1
128                  ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
129                  ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
130               END DO
131            END DO
132         END DO 
133         IF( ln_zps ) THEN                ! set gradient at bottom/top ocean level
134            DO jj = 1, jpjm1                    ! bottom
135               DO ji = 1, fs_jpim1
136                  ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn)
137                  ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn)
138               END DO
139            END DO 
140            IF( ln_isfcav ) THEN                ! top in ocean cavities only
141               DO jj = 1, jpjm1
142                  DO ji = 1, fs_jpim1   ! vector opt.
143                     IF( miku(ji,jj) > 1 )   ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn) 
144                     IF( mikv(ji,jj) > 1 )   ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn) 
145                  END DO
146               END DO
147            ENDIF
148         ENDIF
149         !
150         DO jk = 1, jpkm1              !== Second derivative (divergence) added to the general tracer trends  ==!
151            DO jj = 2, jpjm1
152               DO ji = fs_2, fs_jpim1
153                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     &
154                     &                                   + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   &
155                     &                                / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) )
156               END DO
157            END DO
158         END DO 
159         !
160         !                             !== "Poleward" diffusive heat or salt transports  ==!
161         IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR.  &     !==  first pass only (  laplacian)  ==!
162             ( kpass == 2 .AND.      ln_traldf_blp ) ) THEN      !==  2nd   pass only (bilaplacian)  ==!
163
164            IF( l_ptr )  CALL dia_ptr_hst( jn, 'ldf', -ztv(:,:,:)  )
165            IF( l_hst )  CALL dia_ar5_hst( jn, 'ldf', -ztu(:,:,:), -ztv(:,:,:) )
166         ENDIF
167         !                          ! ==================
168      END DO                        ! end of tracer loop
169      !                             ! ==================
170      !
171      CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev ) 
172      !
173      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_lap')
174      !
175   END SUBROUTINE tra_ldf_lap
176   
177
178   SUBROUTINE tra_ldf_blp( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
179      &                                                    pgui, pgvi,   &
180      &                                                    ptb , pta , kjpt, kldf )
181      !!----------------------------------------------------------------------
182      !!                 ***  ROUTINE tra_ldf_blp  ***
183      !!                   
184      !! ** Purpose :   Compute the before lateral tracer diffusive
185      !!      trend and add it to the general trend of tracer equation.
186      !!
187      !! ** Method  :   The lateral diffusive trends is provided by a bilaplacian
188      !!      operator applied to before field (forward in time).
189      !!      It is computed by two successive calls to laplacian routine
190      !!
191      !! ** Action :   pta   updated with the before rotated bilaplacian diffusion
192      !!----------------------------------------------------------------------
193      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
194      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index
195      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
196      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
197      INTEGER                              , INTENT(in   ) ::   kldf       ! type of operator used
198      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
199      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
200      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top levels
201      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
202      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
203      !
204      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
205      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zlap         ! laplacian at t-point
206      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zglu, zglv   ! bottom GRADh of the laplacian (u- and v-points)
207      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zgui, zgvi   ! top    GRADh of the laplacian (u- and v-points)
208      !!---------------------------------------------------------------------
209      !
210      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_blp')
211      !
212      CALL wrk_alloc( jpi,jpj,jpk,kjpt,   zlap ) 
213      CALL wrk_alloc( jpi,jpj,    kjpt,   zglu, zglv, zgui, zgvi ) 
214      !
215      IF( kt == kit000 .AND. lwp )  THEN
216         WRITE(numout,*)
217         SELECT CASE ( kldf )
218         CASE ( np_blp    )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-level   bilaplacian operator on ', cdtype
219         CASE ( np_blp_i  )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (Standard)'
220         CASE ( np_blp_it )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (triad)'
221         END SELECT
222         WRITE(numout,*) '~~~~~~~~~~~'
223      ENDIF
224
225      zlap(:,:,:,:) = 0._wp
226      !
227      SELECT CASE ( kldf )       !==  1st laplacian applied to ptb (output in zlap)  ==!
228      !
229      CASE ( np_blp    )               ! iso-level bilaplacian
230         CALL tra_ldf_lap  ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb,      zlap, kjpt, 1 )
231      CASE ( np_blp_i  )               ! rotated   bilaplacian : standard operator (Madec)
232         CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 )
233      CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies)
234         CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 )
235      END SELECT
236      !
237      DO jn = 1, kjpt
238         CALL lbc_lnk( zlap(:,:,:,jn) , 'T', 1. )     ! Lateral boundary conditions (unchanged sign)
239      END DO
240      !                                               ! Partial top/bottom cell: GRADh( zlap ) 
241      IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom
242      ELSEIF(             ln_zps ) THEN   ;   CALL zps_hde    ( kt, kjpt, zlap, zglu, zglv )              ! only bottom
243      ENDIF
244      !
245      SELECT CASE ( kldf )       !==  2nd laplacian applied to zlap (output in pta)  ==!
246      !
247      CASE ( np_blp    )               ! iso-level bilaplacian
248         CALL tra_ldf_lap  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pta,      kjpt, 2 )
249      CASE ( np_blp_i  )               ! rotated   bilaplacian : standard operator (Madec)
250         CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 )
251      CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies)
252         CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 )
253      END SELECT
254      !
255      CALL wrk_dealloc( jpi,jpj,jpk,kjpt,   zlap ) 
256      CALL wrk_dealloc( jpi,jpj    ,kjpt,   zglu, zglv, zgui, zgvi ) 
257      !
258      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_blp')
259      !
260   END SUBROUTINE tra_ldf_blp
261
262   !!==============================================================================
263END MODULE traldf_lap_blp
Note: See TracBrowser for help on using the repository browser.