source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/tradmp.F90 @ 10946

Last change on this file since 10946 was 10946, checked in by acc, 2 years ago

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Convert STO, TRD and USR modules and all knock on effects of these conversions. Note change to USR module may have implications for the TEST CASES (not tested yet). Standard SETTE tested only

  • Property svn:keywords set to Id
File size: 11.1 KB
Line 
1MODULE tradmp
2   !!======================================================================
3   !!                       ***  MODULE  tradmp  ***
4   !! Ocean physics: internal restoring trend on active tracers (T and S)
5   !!======================================================================
6   !! History :  OPA  ! 1991-03  (O. Marti, G. Madec)  Original code
7   !!                 ! 1992-06  (M. Imbard)  doctor norme
8   !!                 ! 1998-07  (M. Imbard, G. Madec) ORCA version
9   !!            7.0  ! 2001-02  (M. Imbard)  add distance to coast, Original code
10   !!            8.1  ! 2001-02  (G. Madec, E. Durand)  cleaning
11   !!  NEMO      1.0  ! 2002-08  (G. Madec, E. Durand)  free form + modules
12   !!            3.2  ! 2009-08  (G. Madec, C. Talandier)  DOCTOR norm for namelist parameter
13   !!            3.3  ! 2010-06  (C. Ethe, G. Madec) merge TRA-TRC
14   !!            3.4  ! 2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys
15   !!            3.6  ! 2015-06  (T. Graham)  read restoring coefficient in a file
16   !!            3.7  ! 2015-10  (G. Madec)  remove useless trends arrays
17   !!----------------------------------------------------------------------
18
19   !!----------------------------------------------------------------------
20   !!   tra_dmp_alloc : allocate tradmp arrays
21   !!   tra_dmp       : update the tracer trend with the internal damping
22   !!   tra_dmp_init  : initialization, namlist read, parameters control
23   !!----------------------------------------------------------------------
24   USE oce            ! ocean: variables
25   USE dom_oce        ! ocean: domain variables
26   USE c1d            ! 1D vertical configuration
27   USE trd_oce        ! trends: ocean variables
28   USE trdtra         ! trends manager: tracers
29   USE zdf_oce        ! ocean: vertical physics
30   USE phycst         ! physical constants
31   USE dtatsd         ! data: temperature & salinity
32   USE zdfmxl         ! vertical physics: mixed layer depth
33   !
34   USE in_out_manager ! I/O manager
35   USE iom            ! XIOS
36   USE lib_mpp        ! MPP library
37   USE prtctl         ! Print control
38   USE timing         ! Timing
39
40   IMPLICIT NONE
41   PRIVATE
42
43   PUBLIC   tra_dmp        ! called by step.F90
44   PUBLIC   tra_dmp_init   ! called by nemogcm.F90
45
46   !                                           !!* Namelist namtra_dmp : T & S newtonian damping *
47   LOGICAL            , PUBLIC ::   ln_tradmp   !: internal damping flag
48   INTEGER            , PUBLIC ::   nn_zdmp     !: = 0/1/2 flag for damping in the mixed layer
49   CHARACTER(LEN=200) , PUBLIC ::   cn_resto    !: name of netcdf file containing restoration coefficient field
50   !
51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   resto    !: restoring coeff. on T and S (s-1)
52
53   !! * Substitutions
54#  include "vectopt_loop_substitute.h90"
55   !!----------------------------------------------------------------------
56   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
57   !! $Id$
58   !! Software governed by the CeCILL license (see ./LICENSE)
59   !!----------------------------------------------------------------------
60CONTAINS
61
62   INTEGER FUNCTION tra_dmp_alloc()
63      !!----------------------------------------------------------------------
64      !!                ***  FUNCTION tra_dmp_alloc  ***
65      !!----------------------------------------------------------------------
66      ALLOCATE( resto(jpi,jpj,jpk), STAT= tra_dmp_alloc )
67      !
68      CALL mpp_sum ( 'tradmp', tra_dmp_alloc )
69      IF( tra_dmp_alloc > 0 )   CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed')
70      !
71   END FUNCTION tra_dmp_alloc
72
73
74   SUBROUTINE tra_dmp( kt, Kmm, Krhs )
75      !!----------------------------------------------------------------------
76      !!                   ***  ROUTINE tra_dmp  ***
77      !!                 
78      !! ** Purpose :   Compute the tracer trend due to a newtonian damping
79      !!      of the tracer field towards given data field and add it to the
80      !!      general tracer trends.
81      !!
82      !! ** Method  :   Newtonian damping towards t_dta and s_dta computed
83      !!      and add to the general tracer trends:
84      !!                     ta = ta + resto * (t_dta - tb)
85      !!                     sa = sa + resto * (s_dta - sb)
86      !!         The trend is computed either throughout the water column
87      !!      (nlmdmp=0) or in area of weak vertical mixing (nlmdmp=1) or
88      !!      below the well mixed layer (nlmdmp=2)
89      !!
90      !! ** Action  : - tsa: tracer trends updated with the damping trend
91      !!----------------------------------------------------------------------
92      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
93      INTEGER, INTENT(in) ::   Kmm, Krhs  ! time level indices
94      !
95      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
96      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)     ::  zts_dta
97      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdts
98      !!----------------------------------------------------------------------
99      !
100      IF( ln_timing )   CALL timing_start('tra_dmp')
101      !
102      IF( l_trdtra )   THEN                    !* Save ta and sa trends
103         ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) ) 
104         ztrdts(:,:,:,:) = tsa(:,:,:,:) 
105      ENDIF
106      !                           !==  input T-S data at kt  ==!
107      CALL dta_tsd( kt, zts_dta )            ! read and interpolates T-S data at kt
108      !
109      SELECT CASE ( nn_zdmp )     !==  type of damping  ==!
110      !
111      CASE( 0 )                        !*  newtonian damping throughout the water column  *!
112         DO jn = 1, jpts
113            DO jk = 1, jpkm1
114               DO jj = 2, jpjm1
115                  DO ji = fs_2, fs_jpim1   ! vector opt.
116                     tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - tsb(ji,jj,jk,jn) )
117                  END DO
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) <= avt_c ) THEN
127                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
128                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
129                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
130                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
131                  ENDIF
132               END DO
133            END DO
134         END DO
135         !
136      CASE ( 2 )                       !*  no damping in the mixed layer   *!
137         DO jk = 1, jpkm1
138            DO jj = 2, jpjm1
139               DO ji = fs_2, fs_jpim1   ! vector opt.
140                  IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN
141                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
142                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
143                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
144                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
145                  ENDIF
146               END DO
147            END DO
148         END DO
149         !
150      END SELECT
151      !
152      IF( l_trdtra )   THEN       ! trend diagnostic
153         ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:)
154         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) )
155         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) )
156         DEALLOCATE( ztrdts ) 
157      ENDIF
158      !                           ! Control print
159      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' dmp  - Ta: ', mask1=tmask,   &
160         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
161      !
162      IF( ln_timing )   CALL timing_stop('tra_dmp')
163      !
164   END SUBROUTINE tra_dmp
165
166
167   SUBROUTINE tra_dmp_init
168      !!----------------------------------------------------------------------
169      !!                  ***  ROUTINE tra_dmp_init  ***
170      !!
171      !! ** Purpose :   Initialization for the newtonian damping
172      !!
173      !! ** Method  :   read the namtra_dmp namelist and check the parameters
174      !!----------------------------------------------------------------------
175      INTEGER ::   ios, imask   ! local integers
176      !
177      NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
178      !!----------------------------------------------------------------------
179      !
180      REWIND( numnam_ref )   ! Namelist namtra_dmp in reference namelist : T & S relaxation
181      READ  ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901)
182901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_dmp in reference namelist', lwp )
183      !
184      REWIND( numnam_cfg )   ! Namelist namtra_dmp in configuration namelist : T & S relaxation
185      READ  ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 )
186902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp )
187      IF(lwm) WRITE ( numond, namtra_dmp )
188      !
189      IF(lwp) THEN                  ! Namelist print
190         WRITE(numout,*)
191         WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
192         WRITE(numout,*) '~~~~~~~~~~~~'
193         WRITE(numout,*) '   Namelist namtra_dmp : set relaxation parameters'
194         WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp   = ', ln_tradmp
195         WRITE(numout,*) '         mixed layer damping option      nn_zdmp  = ', nn_zdmp
196         WRITE(numout,*) '         Damping file name               cn_resto = ', cn_resto
197         WRITE(numout,*)
198      ENDIF
199      !
200      IF( ln_tradmp ) THEN
201         !                          ! Allocate arrays
202         IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
203         !
204         SELECT CASE (nn_zdmp)      ! Check values of nn_zdmp
205         CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping as specified by mask'
206         CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixing layer (kz > 5 cm2/s)'
207         CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed  layer'
208         CASE DEFAULT
209            CALL ctl_stop('tra_dmp_init : wrong value of nn_zdmp')
210         END SELECT
211         !
212         !!TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
213         !    so can damp to something other than intitial conditions files?
214         !!gm: In principle yes. Nevertheless, we can't anticipate demands that have never been formulated.
215         IF( .NOT.ln_tsd_dmp ) THEN
216            IF(lwp) WRITE(numout,*)
217            IF(lwp) WRITE(numout, *)  '   read T-S data not initialized, we force ln_tsd_dmp=T'
218            CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data
219         ENDIF
220         !                          ! Read in mask from file
221         CALL iom_open ( cn_resto, imask)
222         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto )
223         CALL iom_close( imask )
224      ENDIF
225      !
226   END SUBROUTINE tra_dmp_init
227
228   !!======================================================================
229END MODULE tradmp
Note: See TracBrowser for help on using the repository browser.