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/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/TRP – NEMO

source: NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/TRP/trcdmp.F90 @ 14219

Last change on this file since 14219 was 14219, checked in by mcastril, 4 years ago

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