source: branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90 @ 4148

Last change on this file since 4148 was 4148, checked in by cetlod, 8 years ago

merge in trunk changes between r3853 and r3940 and commit the changes, see ticket #1169

  • Property svn:keywords set to Id
File size: 16.2 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 trdmod_oce
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC trc_dmp            ! routine called by step.F90
31   PUBLIC trc_dmp_clo        ! routine called by step.F90
32   PUBLIC trc_dmp_alloc      ! routine called by nemogcm.F90
33
34   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   restotr   ! restoring coeff. on tracers (s-1)
35
36   INTEGER, PARAMETER           ::   npncts   = 5        ! number of closed sea
37   INTEGER, DIMENSION(npncts)   ::   nctsi1, nctsj1      ! south-west closed sea limits (i,j)
38   INTEGER, DIMENSION(npncts)   ::   nctsi2, nctsj2      ! north-east closed sea limits (i,j)
39
40   !! * Substitutions
41#  include "top_substitute.h90"
42   !!----------------------------------------------------------------------
43   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
44   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcdmp.F90,v 1.11 2006/09/01 14:03:49 opalod Exp $
45   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
46   !!----------------------------------------------------------------------
47CONTAINS
48
49   INTEGER FUNCTION trc_dmp_alloc()
50      !!----------------------------------------------------------------------
51      !!                   ***  ROUTINE trc_dmp_alloc  ***
52      !!----------------------------------------------------------------------
53      ALLOCATE( restotr(jpi,jpj,jpk) , STAT=trc_dmp_alloc )
54      !
55      IF( trc_dmp_alloc /= 0 )   CALL ctl_warn('trc_dmp_alloc: failed to allocate array')
56      !
57   END FUNCTION trc_dmp_alloc
58
59
60   SUBROUTINE trc_dmp( kt )
61      !!----------------------------------------------------------------------
62      !!                   ***  ROUTINE trc_dmp  ***
63      !!                 
64      !! ** Purpose :   Compute the passive tracer trend due to a newtonian damping
65      !!      of the tracer field towards given data field and add it to the
66      !!      general tracer trends.
67      !!
68      !! ** Method  :   Newtonian damping towards trdta computed
69      !!      and add to the general tracer trends:
70      !!                     trn = tra + restotr * (trdta - trb)
71      !!         The trend is computed either throughout the water column
72      !!      (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or
73      !!      below the well mixed layer (nlmdmptr=2)
74      !!
75      !! ** Action  : - update the tracer trends tra with the newtonian
76      !!                damping trends.
77      !!              - save the trends ('key_trdmld_trc')
78      !!----------------------------------------------------------------------
79      !!
80      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
81      !!
82      INTEGER  ::   ji, jj, jk, jn, jl       ! dummy loop indices
83      REAL(wp) ::   ztra                 ! temporary scalars
84      CHARACTER (len=22) :: charout
85      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrd
86      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrcdta   ! 4D  workspace
87      !!----------------------------------------------------------------------
88      !
89      IF( nn_timing == 1 )  CALL timing_start('trc_dmp')
90      !
91      ! 0. Initialization (first time-step only)
92      !    --------------
93      IF( kt == nittrc000 ) CALL trc_dmp_init
94
95      IF( l_trdtrc )   CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )   ! temporary save of trends
96      !
97      IF( nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping
98         !
99         CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )    ! Memory allocation
100         CALL trc_dta( kt, ztrcdta )   ! read tracer data at nit000
101         !                                                          ! ===========
102         DO jn = 1, jptra                                           ! tracer loop
103            !                                                       ! ===========
104            IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)    ! save trends
105            !
106            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
107               
108               jl = n_trc_index(jn) 
109
110               SELECT CASE ( nn_zdmp_tr )
111               !
112               CASE( 0 )                !==  newtonian damping throughout the water column  ==!
113                  DO jk = 1, jpkm1
114                     DO jj = 2, jpjm1
115                        DO ji = fs_2, fs_jpim1   ! vector opt.
116                           ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk,jl) - trb(ji,jj,jk,jn) )
117                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
118                        END DO
119                     END DO
120                  END DO
121               !
122               CASE ( 1 )                !==  no damping in the turbocline (avt > 5 cm2/s)  ==!
123                  DO jk = 1, jpkm1
124                     DO jj = 2, jpjm1
125                        DO ji = fs_2, fs_jpim1   ! vector opt.
126                           IF( avt(ji,jj,jk) <= 5.e-4 )  THEN
127                              ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk,jl) - trb(ji,jj,jk,jn) )
128                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
129                           ENDIF
130                        END DO
131                     END DO
132                  END DO
133               !
134               CASE ( 2 )               !==  no damping in the mixed layer   ==!
135                  DO jk = 1, jpkm1
136                     DO jj = 2, jpjm1
137                        DO ji = fs_2, fs_jpim1   ! vector opt.
138                           IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
139                              ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk,jl) - trb(ji,jj,jk,jn) )
140                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
141                           END IF
142                        END DO
143                     END DO
144                  END DO
145               
146               END SELECT
147               !
148            ENDIF
149            !
150            IF( l_trdtrc ) THEN
151               ztrtrd(:,:,:) = tra(:,:,:,jn) -  ztrtrd(:,:,:)
152               CALL trd_tra( kt, 'TRC', jn, jptra_trd_dmp, ztrtrd )
153            END IF
154            !                                                       ! ===========
155         END DO                                                     ! tracer loop
156         !                                                          ! ===========
157         CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )
158      ENDIF
159      !
160      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd )
161      !                                          ! print mean trends (used for debugging)
162      IF( ln_ctl )   THEN
163         WRITE(charout, FMT="('dmp ')") ;  CALL prt_ctl_trc_info(charout)
164                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
165      ENDIF
166      !
167      IF( nn_timing == 1 )  CALL timing_stop('trc_dmp')
168      !
169   END SUBROUTINE trc_dmp
170
171   SUBROUTINE trc_dmp_clo( kt )
172      !!---------------------------------------------------------------------
173      !!                  ***  ROUTINE trc_dmp_clo  ***
174      !!
175      !! ** Purpose :   Closed sea domain initialization
176      !!
177      !! ** Method  :   if a closed sea is located only in a model grid point
178      !!                we restore to initial data
179      !!
180      !! ** Action  :   nctsi1(), nctsj1() : south-west closed sea limits (i,j)
181      !!                nctsi2(), nctsj2() : north-east Closed sea limits (i,j)
182      !!----------------------------------------------------------------------
183      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
184      !
185      INTEGER :: ji, jj, jk, jn, jl, jc                     ! dummy loop indicesa
186      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrcdta     ! 4D  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 ( 2 )                                  !  ORCA_R2 configuration
203               !                                        ! =======================
204               !                                            ! Caspian Sea
205               nctsi1(1)   =  11  ;  nctsj1(1)   = 103
206               nctsi2(1)   =  17  ;  nctsj2(1)   = 112
207               !                                            ! Great North American Lakes
208               nctsi1(2)   =  97  ;  nctsj1(2)   = 107
209               nctsi2(2)   = 103  ;  nctsj2(2)   = 111
210               !                                            ! Black Sea 1 : west part of the Black Sea
211               nctsi1(3)   = 174  ;  nctsj1(3)   = 107
212               nctsi2(3)   = 181  ;  nctsj2(3)   = 112
213              !                                            ! Black Sea 2 : est part of the Black Sea
214               nctsi1(4)   =   2  ;  nctsj1(4)   = 107
215               nctsi2(4)   =   6  ;  nctsj2(4)   = 112
216               !                                            ! Baltic Sea
217               nctsi1(5)   =  145 ;  nctsj1(5)   = 116
218               nctsi2(5)   =  150 ;  nctsj2(5)   = 126
219               !                                        ! =======================
220            CASE ( 4 )                                  !  ORCA_R4 configuration
221               !                                        ! =======================
222               !                                            ! Caspian Sea
223               nctsi1(1)   =  4  ;  nctsj1(1)   = 53
224               nctsi2(1)   =  4  ;  nctsj2(1)   = 56
225               !                                            ! Great North American Lakes
226               nctsi1(2)   = 49  ;  nctsj1(2)   = 55
227               nctsi2(2)   = 51  ;  nctsj2(2)   = 56
228               !                                            ! Black Sea
229               nctsi1(3)   = 88  ;  nctsj1(3)   = 55
230               nctsi2(3)   = 91  ;  nctsj2(3)   = 56
231               !                                            ! Baltic Sea
232               nctsi1(4)   = 75  ;  nctsj1(4)   = 59
233               nctsi2(4)   = 76  ;  nctsj2(4)   = 61
234               !                                        ! =======================
235            CASE ( 025 )                                ! ORCA_R025 configuration
236               !                                        ! =======================
237                                                     ! Caspian + Aral sea
238               nctsi1(1)   = 1330 ; nctsj1(1)   = 645
239               nctsi2(1)   = 1400 ; nctsj2(1)   = 795
240               !                                        ! Azov Sea
241               nctsi1(2)   = 1284 ; nctsj1(2)   = 722
242               nctsi2(2)   = 1304 ; nctsj2(2)   = 747
243               !
244            END SELECT
245            !
246         ENDIF
247         !
248
249         ! convert the position in local domain indices
250         ! --------------------------------------------
251         DO jc = 1, npncts
252            nctsi1(jc)   = mi0( nctsi1(jc) )
253            nctsj1(jc)   = mj0( nctsj1(jc) )
254
255            nctsi2(jc)   = mi1( nctsi2(jc) )
256            nctsj2(jc)   = mj1( nctsj2(jc) )
257         END DO
258         !
259      ENDIF
260
261      ! Restore close seas values to initial data
262      IF( ln_trcdta .AND. nb_trcdta > 0 )  THEN   ! Initialisation of tracer from a file that may also be used for damping
263         !
264         IF(lwp)  WRITE(numout,*)
265         IF(lwp)  WRITE(numout,*) ' trc_dmp_clo : Restoring of nutrients on close seas at time-step kt = ', kt
266         IF(lwp)  WRITE(numout,*)
267         !
268         CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )   ! Memory allocation
269         !
270         CALL trc_dta( kt , ztrcdta )   ! read tracer data at nittrc000
271         !
272         DO jn = 1, jptra
273            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
274                jl = n_trc_index(jn)
275                DO jc = 1, npncts
276                   DO jk = 1, jpkm1
277                      DO jj = nctsj1(jc), nctsj2(jc)
278                         DO ji = nctsi1(jc), nctsi2(jc)
279                            trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk,jl) * tmask(ji,jj,jk)
280                            trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
281                         ENDDO
282                      ENDDO
283                   ENDDO
284                ENDDO
285             ENDIF
286          ENDDO
287          CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )
288      ENDIF
289      !
290   END SUBROUTINE trc_dmp_clo
291
292
293   SUBROUTINE trc_dmp_init
294      !!----------------------------------------------------------------------
295      !!                  ***  ROUTINE trc_dmp_init  ***
296      !!
297      !! ** Purpose :   Initialization for the newtonian damping
298      !!
299      !! ** Method  :   read the nammbf namelist and check the parameters
300      !!              called by trc_dmp at the first timestep (nittrc000)
301      !!----------------------------------------------------------------------
302      !
303      IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init')
304      !
305      SELECT CASE ( nn_hdmp_tr )
306      CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only'
307      CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping poleward of', nn_hdmp_tr, ' degrees'
308      CASE DEFAULT
309         WRITE(ctmp1,*) '          bad flag value for nn_hdmp_tr = ', nn_hdmp_tr
310         CALL ctl_stop(ctmp1)
311      END SELECT
312
313      SELECT CASE ( nn_zdmp_tr )
314      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column'
315      CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)'
316      CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer'
317      CASE DEFAULT
318         WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr
319         CALL ctl_stop(ctmp1)
320      END SELECT
321
322      IF( .NOT. ln_tradmp )   &
323         &   CALL ctl_stop( 'passive trace damping need key_tradmp to compute damping coef.' )
324      !
325      !                          ! Damping coefficients initialization
326      IF( lzoom ) THEN   ;   CALL dtacof_zoom( restotr )
327      ELSE               ;   CALL dtacof( nn_hdmp_tr, rn_surf_tr, rn_bot_tr, rn_dep_tr,  &
328                             &            nn_file_tr, 'TRC'     , restotr                )
329      ENDIF
330      !
331      IF( nn_timing == 1 )  CALL timing_stop('trc_dmp_init')
332      !
333   END SUBROUTINE trc_dmp_init
334
335#else
336   !!----------------------------------------------------------------------
337   !!  Dummy module :                                     No passive tracer
338   !!----------------------------------------------------------------------
339CONTAINS
340   SUBROUTINE trc_dmp( kt )        ! Empty routine
341      INTEGER, INTENT(in) :: kt
342      WRITE(*,*) 'trc_dmp: You should not have seen this print! error?', kt
343   END SUBROUTINE trc_dmp
344#endif
345
346
347   !!======================================================================
348END MODULE trcdmp
Note: See TracBrowser for help on using the repository browser.