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.
trcdmp.F90 in NEMO/branches/UKMO/r8395_coupling_sequence/NEMOGCM/NEMO/TOP_SRC/TRP – NEMO

source: NEMO/branches/UKMO/r8395_coupling_sequence/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90 @ 10762

Last change on this file since 10762 was 10762, checked in by jcastill, 5 years ago

Revert previous changes as the removal of keywords was not uncoupled of the actual changes

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