source: CONFIG/UNIFORM/v6/IPSLCM6/SOURCES/NEMO/trcdmp.F90 @ 2865

Last change on this file since 2865 was 2865, checked in by cetlod, 5 years ago

Bugfix on passive tracers restoring in closed seas, before new NEMO revision

File size: 17.8 KB
Line 
1MODULE trcdmp
2   !!======================================================================
3   !!                       ***  MODULE  trcdmp  ***
4   !! Ocean physics: internal restoring trend on passive tracers
5   !!======================================================================
6   !! History :  OPA  !  1991-03  (O. Marti, G. Madec)  Original code
7   !!                 !  1996-01  (G. Madec) statement function for e3
8   !!                 !  1997-05  (H. Loukos)  adapted for passive tracers
9   !!    NEMO    9.0  !  2004-03  (C. Ethe)    free form + modules
10   !!            3.2  !  2007-02  (C. Deltel)  Diagnose ML trends for passive tracers
11   !!            3.3  !  2010-06  (C. Ethe, G. Madec) merge TRA-TRC
12   !!----------------------------------------------------------------------
13#if  defined key_top 
14   !!----------------------------------------------------------------------
15   !!   trc_dmp      : update the tracer trend with the internal damping
16   !!   trc_dmp_init : initialization, namlist read, parameters control
17   !!----------------------------------------------------------------------
18   USE oce_trc         ! ocean dynamics and tracers variables
19   USE trc             ! ocean passive tracers variables
20   USE trcnam_trp      ! passive tracers transport namelist variables
21   USE trcdta
22   USE tradmp
23   USE prtctl_trc      ! Print control for debbuging
24   USE trdtra
25   USE trd_oce
26   USE iom
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC trc_dmp            ! routine called by step.F90
32   PUBLIC trc_dmp_clo        ! routine called by step.F90
33   PUBLIC trc_dmp_alloc      ! routine called by nemogcm.F90
34
35   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   restotr   ! restoring coeff. on tracers (s-1)
36
37   INTEGER, PARAMETER           ::   npncts   = 8        ! number of closed sea
38   INTEGER, DIMENSION(npncts)   ::   nctsi1, nctsj1      ! south-west closed sea limits (i,j)
39   INTEGER, DIMENSION(npncts)   ::   nctsi2, nctsj2      ! north-east closed sea limits (i,j)
40
41   !! * Substitutions
42#  include "top_substitute.h90"
43   !!----------------------------------------------------------------------
44   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
45   !! $Id: trcdmp.F90 6308 2016-02-12 11:32:54Z cetlod $
46   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
47   !!----------------------------------------------------------------------
48CONTAINS
49
50   INTEGER FUNCTION trc_dmp_alloc()
51      !!----------------------------------------------------------------------
52      !!                   ***  ROUTINE trc_dmp_alloc  ***
53      !!----------------------------------------------------------------------
54      ALLOCATE( restotr(jpi,jpj,jpk) , STAT=trc_dmp_alloc )
55      !
56      IF( trc_dmp_alloc /= 0 )   CALL ctl_warn('trc_dmp_alloc: failed to allocate array')
57      !
58   END FUNCTION trc_dmp_alloc
59
60
61   SUBROUTINE trc_dmp( kt )
62      !!----------------------------------------------------------------------
63      !!                   ***  ROUTINE trc_dmp  ***
64      !!                 
65      !! ** Purpose :   Compute the passive tracer trend due to a newtonian damping
66      !!      of the tracer field towards given data field and add it to the
67      !!      general tracer trends.
68      !!
69      !! ** Method  :   Newtonian damping towards trdta computed
70      !!      and add to the general tracer trends:
71      !!                     trn = tra + restotr * (trdta - trb)
72      !!         The trend is computed either throughout the water column
73      !!      (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or
74      !!      below the well mixed layer (nlmdmptr=2)
75      !!
76      !! ** Action  : - update the tracer trends tra with the newtonian
77      !!                damping trends.
78      !!              - save the trends ('key_trdmxl_trc')
79      !!----------------------------------------------------------------------
80      !!
81      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
82      !!
83      INTEGER  ::   ji, jj, jk, jn, jl       ! dummy loop indices
84      REAL(wp) ::   ztra                 ! temporary scalars
85      CHARACTER (len=22) :: charout
86      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrd
87      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrcdta   ! 3D  workspace
88      !!----------------------------------------------------------------------
89      !
90      IF( nn_timing == 1 )  CALL timing_start('trc_dmp')
91      !
92      ! 0. Initialization (first time-step only)
93      !    --------------
94      IF( kt == nittrc000 ) CALL trc_dmp_init
95
96      IF( l_trdtrc )   CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )   ! temporary save of trends
97      !
98      IF( nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping
99         !
100         CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )    ! Memory allocation
101         CALL trc_dta( kt, ztrcdta )   ! read tracer data at nit000
102         !                                                          ! ===========
103         DO jn = 1, jptra                                           ! tracer loop
104            !                                                       ! ===========
105            IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)    ! save trends
106            !
107            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
108               jl = n_trc_index(jn) 
109               SELECT CASE ( nn_zdmp_tr )
110               !
111               CASE( 0 )                !==  newtonian damping throughout the water column  ==!
112                  DO jk = 1, jpkm1
113                     DO jj = 2, jpjm1
114                        DO ji = fs_2, fs_jpim1   ! vector opt.
115                           ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk,jl) * rf_trfac(jl) - trb(ji,jj,jk,jn) )
116                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
117                        END DO
118                     END DO
119                  END DO
120               !
121               CASE ( 1 )                !==  no damping in the turbocline (avt > 5 cm2/s)  ==!
122                  DO jk = 1, jpkm1
123                     DO jj = 2, jpjm1
124                        DO ji = fs_2, fs_jpim1   ! vector opt.
125                           IF( avt(ji,jj,jk) <= 5.e-4_wp )  THEN
126                              ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk,jl) * rf_trfac(jl) - trb(ji,jj,jk,jn) )
127                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
128                           ENDIF
129                        END DO
130                     END DO
131                  END DO
132               !
133               CASE ( 2 )               !==  no damping in the mixed layer   ==!
134                  DO jk = 1, jpkm1
135                     DO jj = 2, jpjm1
136                        DO ji = fs_2, fs_jpim1   ! vector opt.
137                           IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
138                              ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk,jl) * rf_trfac(jl) - trb(ji,jj,jk,jn) )
139                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
140                           END IF
141                        END DO
142                     END DO
143                  END DO
144               
145               END SELECT
146               !
147            ENDIF
148            !
149            IF( l_trdtrc ) THEN
150               ztrtrd(:,:,:) = tra(:,:,:,jn) -  ztrtrd(:,:,:)
151               CALL trd_tra( kt, 'TRC', jn, jptra_dmp, ztrtrd )
152            END IF
153            !                                                       ! ===========
154         END DO                                                     ! tracer loop
155         !                                                          ! ===========
156         CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )
157      ENDIF
158      !
159      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd )
160      !                                          ! print mean trends (used for debugging)
161      IF( ln_ctl )   THEN
162         WRITE(charout, FMT="('dmp ')") ;  CALL prt_ctl_trc_info(charout)
163                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
164      ENDIF
165      !
166      IF( nn_timing == 1 )  CALL timing_stop('trc_dmp')
167      !
168   END SUBROUTINE trc_dmp
169
170   SUBROUTINE trc_dmp_clo( kt )
171      !!---------------------------------------------------------------------
172      !!                  ***  ROUTINE trc_dmp_clo  ***
173      !!
174      !! ** Purpose :   Closed sea domain initialization
175      !!
176      !! ** Method  :   if a closed sea is located only in a model grid point
177      !!                we restore to initial data
178      !!
179      !! ** Action  :   nctsi1(), nctsj1() : south-west closed sea limits (i,j)
180      !!                nctsi2(), nctsj2() : north-east Closed sea limits (i,j)
181      !!----------------------------------------------------------------------
182      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
183      !
184      INTEGER :: ji , jj, jk, jn, jl, jc                     ! dummy loop indicesa
185      INTEGER :: isrow                                      ! local index
186      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrcdta   ! 3D  workspace
187
188      !!----------------------------------------------------------------------
189
190      IF( kt == nit000 ) THEN
191         ! initial values
192         nctsi1(:) = 1  ;  nctsi2(:) = 1
193         nctsj1(:) = 1  ;  nctsj2(:) = 1
194
195         ! set the closed seas (in data domain indices)
196         ! -------------------
197
198         IF( cp_cfg == "orca" ) THEN
199            !
200            SELECT CASE ( jp_cfg )
201            !                                           ! =======================
202            CASE ( 1 )                                  ! eORCA_R1 configuration
203            !                                           ! =======================
204            isrow = 332 - jpjglo
205            !
206                                                        ! Caspian Sea
207            nctsi1(1)   = 333  ; nctsj1(1)   = 243 - isrow
208            nctsi2(1)   = 342  ; nctsj2(1)   = 274 - isrow
209            !                                           ! Lake Superior
210            nctsi1(2)   = 198  ; nctsj1(2)   = 258 - isrow
211            nctsi2(2)   = 204  ; nctsj2(2)   = 262 - isrow
212            !                                           ! Lake Michigan
213            nctsi1(3)   = 201  ; nctsj1(3)   = 250 - isrow
214            nctsi2(3)   = 203  ; nctsj2(3)   = 256 - isrow
215            !                                           ! Lake Huron
216            nctsi1(4)   = 204  ; nctsj1(4)   = 252 - isrow
217            nctsi2(4)   = 209  ; nctsj2(4)   = 256 - isrow
218            !                                           ! Lake Erie
219            nctsi1(5)   = 206  ; nctsj1(5)   = 249 - isrow
220            nctsi2(5)   = 209  ; nctsj2(5)   = 251 - isrow
221            !                                           ! Lake Ontario
222            nctsi1(6)   = 210  ; nctsj1(6)   = 252 - isrow
223            nctsi2(6)   = 212  ; nctsj2(6)   = 252 - isrow
224            !                                           ! Victoria Lake
225            nctsi1(7)   = 321  ; nctsj1(7)   = 180 - isrow
226            nctsi2(7)   = 322  ; nctsj2(7)   = 189 - isrow
227            !                                           ! Baltic Sea
228            nctsi1(8)   = 297  ; nctsj1(8)   = 270 - isrow
229            nctsi2(8)   = 308  ; nctsj2(8)   = 293 - isrow
230                               
231            !                                           ! =======================
232            CASE ( 2 )                                  !  ORCA_R2 configuration
233               !                                        ! =======================
234               !                                            ! Caspian Sea
235               nctsi1(1)   =  11  ;  nctsj1(1)   = 103
236               nctsi2(1)   =  17  ;  nctsj2(1)   = 112
237               !                                            ! Great North American Lakes
238               nctsi1(2)   =  97  ;  nctsj1(2)   = 107
239               nctsi2(2)   = 103  ;  nctsj2(2)   = 111
240               !                                            ! Black Sea 1 : west part of the Black Sea
241               nctsi1(3)   = 174  ;  nctsj1(3)   = 107
242               nctsi2(3)   = 181  ;  nctsj2(3)   = 112
243              !                                            ! Black Sea 2 : est part of the Black Sea
244               nctsi1(4)   =   2  ;  nctsj1(4)   = 107
245               nctsi2(4)   =   6  ;  nctsj2(4)   = 112
246               !                                            ! Baltic Sea
247               nctsi1(5)   =  145 ;  nctsj1(5)   = 116
248               nctsi2(5)   =  150 ;  nctsj2(5)   = 126
249               !                                        ! =======================
250            CASE ( 4 )                                  !  ORCA_R4 configuration
251               !                                        ! =======================
252               !                                            ! Caspian Sea
253               nctsi1(1)   =  4  ;  nctsj1(1)   = 53
254               nctsi2(1)   =  4  ;  nctsj2(1)   = 56
255               !                                            ! Great North American Lakes
256               nctsi1(2)   = 49  ;  nctsj1(2)   = 55
257               nctsi2(2)   = 51  ;  nctsj2(2)   = 56
258               !                                            ! Black Sea
259               nctsi1(3)   = 88  ;  nctsj1(3)   = 55
260               nctsi2(3)   = 91  ;  nctsj2(3)   = 56
261               !                                            ! Baltic Sea
262               nctsi1(4)   = 75  ;  nctsj1(4)   = 59
263               nctsi2(4)   = 76  ;  nctsj2(4)   = 61
264               !                                        ! =======================
265            CASE ( 025 )                                ! ORCA_R025 configuration
266               !                                        ! =======================
267                                                     ! Caspian + Aral sea
268               nctsi1(1)   = 1330 ; nctsj1(1)   = 645
269               nctsi2(1)   = 1400 ; nctsj2(1)   = 795
270               !                                        ! Azov Sea
271               nctsi1(2)   = 1284 ; nctsj1(2)   = 722
272               nctsi2(2)   = 1304 ; nctsj2(2)   = 747
273               !
274            END SELECT
275            !
276         ENDIF
277         !
278
279         ! convert the position in local domain indices
280         ! --------------------------------------------
281         DO jc = 1, npncts
282            nctsi1(jc)   = mi0( nctsi1(jc) )
283            nctsj1(jc)   = mj0( nctsj1(jc) )
284
285            nctsi2(jc)   = mi1( nctsi2(jc) )
286            nctsj2(jc)   = mj1( nctsj2(jc) )
287         END DO
288         !
289      ENDIF
290
291      ! Restore close seas values to initial data
292      IF( ln_trcdta .AND. nb_trcdta > 0 )  THEN   ! Initialisation of tracer from a file that may also be used for damping
293         !
294         IF(lwp)  WRITE(numout,*)
295         IF(lwp)  WRITE(numout,*) ' trc_dmp_clo : Restoring of nutrients on close seas at time-step kt = ', kt
296         IF(lwp)  WRITE(numout,*)
297         !
298         CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )    ! Memory allocation
299         CALL trc_dta( kt, ztrcdta )   ! read tracer data at nit000
300         !
301         DO jn = 1, jptra
302            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
303                jl = n_trc_index(jn)
304                IF(lwp)  WRITE(numout,*)
305                DO jc = 1, npncts
306                   DO jk = 1, jpkm1
307                      DO jj = nctsj1(jc), nctsj2(jc)
308                         DO ji = nctsi1(jc), nctsi2(jc)
309                            trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk,jl) * rf_trfac(jl)
310                            trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
311                         ENDDO
312                      ENDDO
313                   ENDDO
314                ENDDO
315             ENDIF
316          ENDDO
317          CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )    ! Memory allocation
318          !
319      ENDIF
320      !
321   END SUBROUTINE trc_dmp_clo
322
323
324   SUBROUTINE trc_dmp_init
325      !!----------------------------------------------------------------------
326      !!                  ***  ROUTINE trc_dmp_init  ***
327      !!
328      !! ** Purpose :   Initialization for the newtonian damping
329      !!
330      !! ** Method  :   read the nammbf namelist and check the parameters
331      !!              called by trc_dmp at the first timestep (nittrc000)
332      !!----------------------------------------------------------------------
333      !
334      INTEGER :: imask  !local file handle
335
336      IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init')
337      !
338
339      IF( lzoom )   nn_zdmp_tr = 0           ! restoring to climatology at closed north or south boundaries
340      SELECT CASE ( nn_zdmp_tr )
341      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column'
342      CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)'
343      CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer'
344      CASE DEFAULT
345         WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr
346         CALL ctl_stop(ctmp1)
347      END SELECT
348
349      IF( .NOT. ln_tradmp )   &
350         &   CALL ctl_stop( 'passive trace damping need key_tradmp to compute damping coef.' )
351      !
352      !                          ! Read damping coefficients from file
353      !Read in mask from file
354      CALL iom_open ( cn_resto_tr, imask)
355      CALL iom_get  ( imask, jpdom_autoglo, 'resto', restotr)
356      CALL iom_close( imask )
357      !
358      IF( nn_timing == 1 )  CALL timing_stop('trc_dmp_init')
359      !
360   END SUBROUTINE trc_dmp_init
361
362#else
363   !!----------------------------------------------------------------------
364   !!  Dummy module :                                     No passive tracer
365   !!----------------------------------------------------------------------
366CONTAINS
367   SUBROUTINE trc_dmp( kt )        ! Empty routine
368      INTEGER, INTENT(in) :: kt
369      WRITE(*,*) 'trc_dmp: You should not have seen this print! error?', kt
370   END SUBROUTINE trc_dmp
371#endif
372
373
374   !!======================================================================
375END MODULE trcdmp
Note: See TracBrowser for help on using the repository browser.