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 @ 2598

Last change on this file since 2598 was 2590, checked in by trackstand2, 13 years ago

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