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.
tradmp.F90 in branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

source: branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90 @ 5870

Last change on this file since 5870 was 5870, checked in by acc, 8 years ago

Branch 2015/dev_r5803_NOC_WAD. Merge in trunk changes from 5803 to 5869 in preparation for merge. Also tidied and reorganised some wetting and drying code. Renamed wadlmt.F90 to wetdry.F90. Wetting drying code changes restricted to domzgr.F90, domvvl.F90 nemogcm.F90 sshwzv.F90, dynspg_ts.F90, wetdry.F90 and dynhpg.F90. Code passes full SETTE tests with ln_wd=.false.. Still awaiting test case for checking with ln_wd=.false.
  • Property svn:keywords set to Id
File size: 11.2 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   USE in_out_manager ! I/O manager
34   USE lib_mpp        ! MPP library
35   USE prtctl         ! Print control
36   USE wrk_nemo       ! Memory allocation
37   USE timing         ! Timing
38   USE iom
39
40   IMPLICIT NONE
41   PRIVATE
42
43   PUBLIC   tra_dmp      ! routine called by step.F90
44   PUBLIC   tra_dmp_init ! routine 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 "domzgr_substitute.h90"
55#  include "vectopt_loop_substitute.h90"
56   !!----------------------------------------------------------------------
57   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
58   !! $Id$
59   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
60   !!----------------------------------------------------------------------
61CONTAINS
62
63   INTEGER FUNCTION tra_dmp_alloc()
64      !!----------------------------------------------------------------------
65      !!                ***  FUNCTION tra_dmp_alloc  ***
66      !!----------------------------------------------------------------------
67      ALLOCATE( resto(jpi,jpj,jpk), STAT= tra_dmp_alloc )
68      !
69      IF( lk_mpp            )   CALL mpp_sum ( tra_dmp_alloc )
70      IF( tra_dmp_alloc > 0 )   CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed')
71      !
72   END FUNCTION tra_dmp_alloc
73
74
75   SUBROUTINE tra_dmp( kt )
76      !!----------------------------------------------------------------------
77      !!                   ***  ROUTINE tra_dmp  ***
78      !!                 
79      !! ** Purpose :   Compute the tracer trend due to a newtonian damping
80      !!      of the tracer field towards given data field and add it to the
81      !!      general tracer trends.
82      !!
83      !! ** Method  :   Newtonian damping towards t_dta and s_dta computed
84      !!      and add to the general tracer trends:
85      !!                     ta = ta + resto * (t_dta - tb)
86      !!                     sa = sa + resto * (s_dta - sb)
87      !!         The trend is computed either throughout the water column
88      !!      (nlmdmp=0) or in area of weak vertical mixing (nlmdmp=1) or
89      !!      below the well mixed layer (nlmdmp=2)
90      !!
91      !! ** Action  : - (ta,sa)   tracer trends updated with the damping trend
92      !!----------------------------------------------------------------------
93      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
94      !
95      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
96      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dta, ztrdts
97      !!----------------------------------------------------------------------
98      !
99      IF( nn_timing == 1 )   CALL timing_start('tra_dmp')
100      !
101      CALL wrk_alloc( jpi,jpj,jpk,jpts,   zts_dta )
102      !
103      IF( l_trdtra )   THEN                    !* Save ta and sa trends
104         CALL wrk_alloc( jpi,jpj,jpk,jpts,   ztrdts ) 
105         ztrdts(:,:,:,:) = tsa(:,:,:,:) 
106      ENDIF
107      !                           !==  input T-S data at kt  ==!
108      CALL dta_tsd( kt, zts_dta )            ! read and interpolates T-S data at kt
109      !
110      SELECT CASE ( nn_zdmp )     !==  type of damping  ==!
111      !
112      CASE( 0 )                        !*  newtonian damping throughout the water column  *!
113         DO jn = 1, jpts
114            DO jk = 1, jpkm1
115               DO jj = 2, jpjm1
116                  DO ji = fs_2, fs_jpim1   ! vector opt.
117                     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) )
118                  END DO
119               END DO
120            END DO
121         END DO
122         !
123      CASE ( 1 )                       !*  no damping in the turbocline (avt > 5 cm2/s)  *!
124         DO jk = 1, jpkm1
125            DO jj = 2, jpjm1
126               DO ji = fs_2, fs_jpim1   ! vector opt.
127                  IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN
128                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
129                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
130                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
131                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
132                  ENDIF
133               END DO
134            END DO
135         END DO
136         !
137      CASE ( 2 )                       !*  no damping in the mixed layer   *!
138         DO jk = 1, jpkm1
139            DO jj = 2, jpjm1
140               DO ji = fs_2, fs_jpim1   ! vector opt.
141                  IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
142                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
143                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
144                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
145                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
146                  ENDIF
147               END DO
148            END DO
149         END DO
150         !
151      END SELECT
152      !
153      IF( l_trdtra )   THEN       ! trend diagnostic
154         ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:)
155         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) )
156         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) )
157         CALL wrk_dealloc( jpi,jpj,jpk,jpts,   ztrdts ) 
158      ENDIF
159      !                           ! Control print
160      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' dmp  - Ta: ', mask1=tmask,   &
161         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
162      !
163      CALL wrk_dealloc( jpi,jpj,jpk,jpts,   zts_dta )
164      !
165      IF( nn_timing == 1 )   CALL timing_stop('tra_dmp')
166      !
167   END SUBROUTINE tra_dmp
168
169
170   SUBROUTINE tra_dmp_init
171      !!----------------------------------------------------------------------
172      !!                  ***  ROUTINE tra_dmp_init  ***
173      !!
174      !! ** Purpose :   Initialization for the newtonian damping
175      !!
176      !! ** Method  :   read the namtra_dmp namelist and check the parameters
177      !!----------------------------------------------------------------------
178      INTEGER ::   ios, imask   ! local integers
179      !!
180      NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
181      !!----------------------------------------------------------------------
182      !
183      REWIND( numnam_ref )   ! Namelist namtra_dmp in reference namelist : T & S relaxation
184      READ  ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901)
185901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist', lwp )
186      !
187      REWIND( numnam_cfg )   ! Namelist namtra_dmp in configuration namelist : T & S relaxation
188      READ  ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 )
189902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp )
190      IF(lwm) WRITE ( numond, namtra_dmp )
191      !
192      IF(lwp) THEN                  ! Namelist print
193         WRITE(numout,*)
194         WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
195         WRITE(numout,*) '~~~~~~~~~~~'
196         WRITE(numout,*) '   Namelist namtra_dmp : set relaxation parameters'
197         WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp = ', ln_tradmp
198         WRITE(numout,*) '      mixed layer damping option      nn_zdmp   = ', nn_zdmp
199         WRITE(numout,*) '      Damping file name               cn_resto  = ', cn_resto
200         WRITE(numout,*)
201      ENDIF
202      !
203      IF( ln_tradmp) THEN
204         !                          ! Allocate arrays
205         IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
206         !
207         SELECT CASE (nn_zdmp)      ! Check values of nn_zdmp
208         CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping as specified by mask'
209         CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixing layer (kz > 5 cm2/s)'
210         CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed  layer'
211         CASE DEFAULT
212            CALL ctl_stop('tra_dmp_init : wrong value of nn_zdmp')
213         END SELECT
214         !
215         !!TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
216         !    so can damp to something other than intitial conditions files?
217         !!gm: In principle yes. Nevertheless, we can't anticipate demands that have never been formulated.
218         IF( .NOT.ln_tsd_tradmp ) THEN
219            IF(lwp) WRITE(numout,*)
220            IF(lwp) WRITE(numout, *)  '   read T-S data not initialized, we force ln_tsd_tradmp=T'
221            CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data
222         ENDIF
223         !                          ! Read in mask from file
224         CALL iom_open ( cn_resto, imask)
225         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto )
226         CALL iom_close( imask )
227      ENDIF
228      !
229   END SUBROUTINE tra_dmp_init
230
231END MODULE tradmp
Note: See TracBrowser for help on using the repository browser.