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/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP – NEMO

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcdmp.F90 @ 10966

Last change on this file since 10966 was 10966, checked in by acc, 5 years ago

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