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

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90 @ 2696

Last change on this file since 2696 was 2690, checked in by gm, 13 years ago

dynamic mem: #785 ; homogeneization of the coding style associated with dyn allocation

  • Property svn:keywords set to Id
File size: 16.8 KB
Line 
1MODULE traldf
2   !!======================================================================
3   !!                       ***  MODULE  traldf  ***
4   !! Ocean Active tracers : lateral diffusive trends
5   !!=====================================================================
6   !! History :  9.0  ! 2005-11 (G. Madec)  Original code
7   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   tra_ldf      : update the tracer trend with the lateral diffusion
12   !!   tra_ldf_init : initialization, namelist read, and parameters control
13   !!       ldf_ano  : compute lateral diffusion for constant T-S profiles
14   !!----------------------------------------------------------------------
15   USE oce             ! ocean dynamics and tracers
16   USE dom_oce         ! ocean space and time domain
17   USE phycst          ! physical constants
18   USE ldftra_oce      ! ocean tracer   lateral physics
19   USE ldfslp          ! ???
20   USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine)
21   USE traldf_bilap    ! lateral mixing             (tra_ldf_bilap routine)
22   USE traldf_iso      ! lateral mixing               (tra_ldf_iso routine)
23   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine)
24   USE traldf_lap      ! lateral mixing               (tra_ldf_lap routine)
25   USE trdmod_oce      ! ocean space and time domain
26   USE trdtra          ! ocean active tracers trends
27   USE prtctl          ! Print control
28   USE in_out_manager  ! I/O manager
29   USE lib_mpp         ! distribued memory computing library
30   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
31
32   IMPLICIT NONE
33   PRIVATE
34
35   PUBLIC   tra_ldf         ! called by step.F90
36   PUBLIC   tra_ldf_init    ! called by opa.F90
37   !
38   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... namlist logicals)
39
40   REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   t0_ldf, s0_ldf   !: lateral diffusion trends of T & S for a cst profile
41   !                                                               !  (key_traldf_ano only)
42
43   !! * Substitutions
44#  include "domzgr_substitute.h90"
45#  include "vectopt_loop_substitute.h90"
46   !!----------------------------------------------------------------------
47   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
48   !! $Id$
49   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
50   !!----------------------------------------------------------------------
51CONTAINS
52
53   SUBROUTINE tra_ldf( kt )
54      !!----------------------------------------------------------------------
55      !!                  ***  ROUTINE tra_ldf  ***
56      !!
57      !! ** Purpose :   compute the lateral ocean tracer physics.
58      !!----------------------------------------------------------------------
59      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
60      !!
61      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
62      !!----------------------------------------------------------------------
63
64      IF( l_trdtra )   THEN                    !* Save ta and sa trends
65         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
66         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
67      ENDIF
68
69      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
70      CASE ( 0 )   ;   CALL tra_ldf_lap     ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level laplacian
71      CASE ( 1 )                                                                              ! rotated laplacian
72         IF( ln_traldf_grif ) THEN                                                         
73                       CALL tra_ldf_iso_grif( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Griffies operator
74         ELSE                                                                               
75                       CALL tra_ldf_iso     ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Madec operator
76         ENDIF
77      CASE ( 2 )   ;   CALL tra_ldf_bilap   ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level bilaplacian
78      CASE ( 3 )   ;   CALL tra_ldf_bilapg  ( kt, 'TRA',             tsb, tsa, jpts        )  ! s-coord. geopot. bilap.
79         !
80      CASE ( -1 )                                ! esopa: test all possibility with control print
81         CALL tra_ldf_lap   ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        ) 
82         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask,               &
83         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
84         IF( ln_traldf_grif ) THEN
85            CALL tra_ldf_iso_grif( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )
86         ELSE
87            CALL tra_ldf_iso     ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) 
88         ENDIF
89         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask,               &
90         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
91         CALL tra_ldf_bilap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        ) 
92         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf2 - Ta: ', mask1=tmask,               &
93         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
94         CALL tra_ldf_bilapg( kt, 'TRA',             tsb, tsa, jpts        ) 
95         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf3 - Ta: ', mask1=tmask,               &
96         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
97      END SELECT
98
99#if defined key_traldf_ano
100      tsa(:,:,:,jp_tem) = tsa(:,:,:,jp_tem) - t0_ldf(:,:,:)      ! anomaly: substract the reference diffusivity
101      tsa(:,:,:,jp_sal) = tsa(:,:,:,jp_sal) - s0_ldf(:,:,:)
102#endif
103
104      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
105         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
106         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
107         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_ldf, ztrdt )
108         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_ldf, ztrds )
109         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
110      ENDIF
111      !                                          ! print mean trends (used for debugging)
112      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf  - Ta: ', mask1=tmask,               &
113         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
114      !
115   END SUBROUTINE tra_ldf
116
117
118   SUBROUTINE tra_ldf_init
119      !!----------------------------------------------------------------------
120      !!                  ***  ROUTINE tra_ldf_init  ***
121      !!
122      !! ** Purpose :   Choice of the operator for the lateral tracer diffusion
123      !!
124      !! ** Method  :   set nldf from the namtra_ldf logicals
125      !!      nldf == -1   ESOPA test: ALL operators are used
126      !!      nldf ==  0   laplacian operator
127      !!      nldf ==  1   Rotated laplacian operator
128      !!      nldf ==  2   bilaplacian operator
129      !!      nldf ==  3   Rotated bilaplacian
130      !!----------------------------------------------------------------------
131      INTEGER ::   ioptio, ierr         ! temporary integers
132      !!----------------------------------------------------------------------
133
134      !  Define the lateral mixing oparator for tracers
135      ! ===============================================
136   
137      IF(lwp) THEN                    ! Namelist print
138         WRITE(numout,*)
139         WRITE(numout,*) 'tra_ldf_init : lateral tracer diffusive operator'
140         WRITE(numout,*) '~~~~~~~~~~~'
141         WRITE(numout,*) '   Namelist namtra_ldf already read in ldftra module'
142         WRITE(numout,*) '   see ldf_tra_init report for lateral mixing parameters'
143         WRITE(numout,*)
144      ENDIF
145
146      !                               ! control the input
147      ioptio = 0
148      IF( ln_traldf_lap   )   ioptio = ioptio + 1
149      IF( ln_traldf_bilap )   ioptio = ioptio + 1
150      IF( ioptio >  1 )   CALL ctl_stop( '          use ONE or NONE of the 2 lap/bilap operator type on tracer' )
151      IF( ioptio == 0 )   nldf = -2   ! No lateral diffusion
152      ioptio = 0
153      IF( ln_traldf_level )   ioptio = ioptio + 1
154      IF( ln_traldf_hor   )   ioptio = ioptio + 1
155      IF( ln_traldf_iso   )   ioptio = ioptio + 1
156      IF( ioptio /= 1 )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' )
157
158      ! defined the type of lateral diffusion from ln_traldf_... logicals
159      ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully
160      ierr = 0
161      IF( ln_traldf_lap ) THEN       ! laplacian operator
162         IF ( ln_zco ) THEN                ! z-coordinate
163            IF ( ln_traldf_level )   nldf = 0      ! iso-level  (no rotation)
164            IF ( ln_traldf_hor   )   nldf = 0      ! horizontal (no rotation)
165            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation)
166         ENDIF
167         IF ( ln_zps ) THEN             ! z-coordinate
168            IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed
169            IF ( ln_traldf_hor   )   nldf = 0      ! horizontal (no rotation)
170            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation)
171         ENDIF
172         IF ( ln_sco ) THEN             ! z-coordinate
173            IF ( ln_traldf_level )   nldf = 0      ! iso-level  (no rotation)
174            IF ( ln_traldf_hor   )   nldf = 1      ! horizontal (   rotation)
175            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation)
176         ENDIF
177      ENDIF
178
179      IF( ln_traldf_bilap ) THEN      ! bilaplacian operator
180         IF ( ln_zco ) THEN                ! z-coordinate
181            IF ( ln_traldf_level )   nldf = 2      ! iso-level  (no rotation)
182            IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation)
183            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation)
184         ENDIF
185         IF ( ln_zps ) THEN             ! z-coordinate
186            IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed
187            IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation)
188            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation)
189         ENDIF
190         IF ( ln_sco ) THEN             ! z-coordinate
191            IF ( ln_traldf_level )   nldf = 2      ! iso-level  (no rotation)
192            IF ( ln_traldf_hor   )   nldf = 3      ! horizontal (   rotation)
193            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation)
194         ENDIF
195      ENDIF
196
197      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' )
198      IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' )
199      IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso )   &
200           CALL ctl_stop( '          eddy induced velocity on tracers',   &
201           &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' )
202      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation
203         IF( .NOT.lk_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' )
204         l_traldf_rot = .TRUE.                 ! needed for trazdf_imp
205      ENDIF
206
207      IF( lk_esopa ) THEN
208         IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options'
209         nldf = -1
210      ENDIF
211
212      IF(lwp) THEN
213         WRITE(numout,*)
214         IF( nldf == -2 )   WRITE(numout,*) '          NO lateral diffusion'
215         IF( nldf == -1 )   WRITE(numout,*) '          ESOPA test All scheme used'
216         IF( nldf ==  0 )   WRITE(numout,*) '          laplacian operator'
217         IF( nldf ==  1 )   WRITE(numout,*) '          Rotated laplacian operator'
218         IF( nldf ==  2 )   WRITE(numout,*) '          bilaplacian operator'
219         IF( nldf ==  3 )   WRITE(numout,*) '          Rotated bilaplacian'
220      ENDIF
221
222      ! Reference T & S diffusivity (if necessary)
223      ! ===========================
224      CALL ldf_ano
225      !
226   END SUBROUTINE tra_ldf_init
227
228#if defined key_traldf_ano
229   !!----------------------------------------------------------------------
230   !!   'key_traldf_ano'               T & S lateral diffusion on anomalies
231   !!----------------------------------------------------------------------
232
233   SUBROUTINE ldf_ano
234      !!----------------------------------------------------------------------
235      !!                  ***  ROUTINE ldf_ano  ***
236      !!
237      !! ** Purpose :   initializations of
238      !!----------------------------------------------------------------------
239      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
240      USE wrk_nemo, ONLY:   zt_ref => wrk_3d_1, ztb => wrk_3d_2, zavt => wrk_3d_3   ! 3D workspaces
241      USE wrk_nemo, ONLY:   zs_ref => wrk_3d_4, zsb => wrk_3d_5                     ! 3D workspaces
242      !
243      USE zdf_oce         ! vertical mixing
244      USE trazdf          ! vertical mixing: double diffusion
245      USE zdfddm          ! vertical mixing: double diffusion
246      !
247      INTEGER  ::   jk              ! Dummy loop indice
248      INTEGER  ::   ierr            ! local integer
249      LOGICAL  ::   llsave          ! local logical
250      REAL(wp) ::   zt0, zs0, z12   ! local scalar
251      !!----------------------------------------------------------------------
252
253      IF( wrk_in_use(3, 1,2,3,4,5) ) THEN
254         CALL ctl_stop('ldf_ano : requested workspace arrays unavailable')   ;   RETURN
255      ENDIF
256
257      IF(lwp) THEN
258         WRITE(numout,*)
259         WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on anomalies'
260         WRITE(numout,*) '~~~~~~~~~~~'
261      ENDIF
262
263      !                              ! allocate trabbl arrays
264      ALLOCATE( t0_ldf(jpi,jpj,jpk) , s0_ldf(jpi,jpj,jpk) , STAT=ierr )
265      IF( lk_mpp    )   CALL mpp_sum( ierr )
266      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_ano: unable to allocate arrays' )
267
268      ! defined the T & S reference profiles
269      ! ------------------------------------
270      zt0 =10.e0                               ! homogeneous ocean
271      zs0 =35.e0
272      zt_ref(:,:,:) = 10.0 * tmask(:,:,:)
273      zs_ref(:,:,:) = 35.0 * tmask(:,:,:)
274      IF(lwp) WRITE(numout,*) '              homogeneous ocean T = ', zt0, ' S = ',zs0
275
276      !                                        ! T & S profile (to be coded +namelist parameter
277
278      ! prepare the ldf computation
279      ! ---------------------------
280      llsave = l_trdtra
281      l_trdtra = .false.      ! desactivate trend computation
282      t0_ldf(:,:,:) = 0.e0
283      s0_ldf(:,:,:) = 0.e0
284      ztb   (:,:,:) = tsb (:,:,:,jp_tem)
285      zsb   (:,:,:) = tsb (:,:,:,jp_sal)
286      ua    (:,:,:) = tsa (:,:,:,jp_tem)
287      va    (:,:,:) = tsa (:,:,:,jp_sal)
288      zavt  (:,:,:) = avt(:,:,:)
289      IF( lk_zdfddm ) THEN CALL ctl_stop( ' key_traldf_ano with key_zdfddm not implemented' )
290      ! set tb, sb to reference values and avr to zero
291      tsb (:,:,:,jp_tem) = zt_ref(:,:,:)
292      tsb (:,:,:,jp_sal) = zs_ref(:,:,:)
293      tsa (:,:,:,jp_tem) = 0.e0
294      tsa (:,:,:,jp_sal) = 0.e0
295      avt(:,:,:)         = 0.e0
296
297      ! Compute the ldf trends
298      ! ----------------------
299      CALL tra_ldf( nit000+1 )      ! horizontal components (+1: no more init)
300      CALL tra_zdf( nit000   )      ! vertical component (if necessary nit000 to performed the init)
301
302      ! finalise the computation and recover all arrays
303      ! -----------------------------------------------
304      l_trdtra = llsave
305      z12 = 2.e0
306      IF( neuler == 1)   z12 = 1.e0
307      IF( ln_zdfexp ) THEN      ! ta,sa are the trends
308         t0_ldf(:,:,:) = tsa(:,:,:,jp_tem)
309         s0_ldf(:,:,:) = tsa(:,:,:,jp_sal)
310      ELSE
311         DO jk = 1, jpkm1
312            t0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / ( z12 *rdttra(jk) )
313            s0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / ( z12 *rdttra(jk) )
314         END DO
315      ENDIF
316      tsb(:,:,:,jp_tem) = ztb (:,:,:)
317      tsb(:,:,:,jp_sal) = zsb (:,:,:)
318      tsa(:,:,:,jp_tem) = ua  (:,:,:)
319      tsa(:,:,:,jp_sal) = va  (:,:,:)
320      avt(:,:,:)        = zavt(:,:,:)
321      !
322      IF( wrk_not_released(3, 1,2,3,4,5) )   CALL ctl_stop('ldf_ano: failed to release workspace arrays')
323      !
324   END SUBROUTINE ldf_ano
325
326#else
327   !!----------------------------------------------------------------------
328   !!   default option :   Dummy code   NO T & S background profiles
329   !!----------------------------------------------------------------------
330   SUBROUTINE ldf_ano
331      IF(lwp) THEN
332         WRITE(numout,*)
333         WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on the full fields'
334         WRITE(numout,*) '~~~~~~~~~~~'
335      ENDIF
336   END SUBROUTINE ldf_ano
337#endif
338
339   !!======================================================================
340END MODULE traldf
Note: See TracBrowser for help on using the repository browser.