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 NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/TRA – NEMO

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/TRA/tradmp.F90 @ 11954

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

Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Final, non-substantive changes to complete this branch. These changes remove all REWIND statements on the old namelist fortran units (now character variables for internal files). These changes have been left until last since they are easily repeated via a script and it may be preferable to use the previous revision for merge purposes and reapply these last changes separately. This branch has been fully SETTE tested.
  • Property svn:keywords set to Id
File size: 10.8 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 )
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      !
94      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
95      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)     ::  zts_dta
96      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdts
97      !!----------------------------------------------------------------------
98      !
99      IF( ln_timing )   CALL timing_start('tra_dmp')
100      !
101      IF( l_trdtra )   THEN                    !* Save ta and sa trends
102         ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) ) 
103         ztrdts(:,:,:,:) = tsa(:,:,:,:) 
104      ENDIF
105      !                           !==  input T-S data at kt  ==!
106      CALL dta_tsd( kt, zts_dta )            ! read and interpolates T-S data at kt
107      !
108      SELECT CASE ( nn_zdmp )     !==  type of damping  ==!
109      !
110      CASE( 0 )                        !*  newtonian damping throughout the water column  *!
111         DO jn = 1, jpts
112            DO jk = 1, jpkm1
113               DO jj = 2, jpjm1
114                  DO ji = fs_2, fs_jpim1   ! vector opt.
115                     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) )
116                  END DO
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                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
127                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
128                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
129                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
130                  ENDIF
131               END DO
132            END DO
133         END DO
134         !
135      CASE ( 2 )                       !*  no damping in the mixed layer   *!
136         DO jk = 1, jpkm1
137            DO jj = 2, jpjm1
138               DO ji = fs_2, fs_jpim1   ! vector opt.
139                  IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN
140                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
141                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
142                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
143                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
144                  ENDIF
145               END DO
146            END DO
147         END DO
148         !
149      END SELECT
150      !
151      IF( l_trdtra )   THEN       ! trend diagnostic
152         ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:)
153         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) )
154         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) )
155         DEALLOCATE( ztrdts ) 
156      ENDIF
157      !                           ! Control print
158      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' dmp  - Ta: ', mask1=tmask,   &
159         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
160      !
161      IF( ln_timing )   CALL timing_stop('tra_dmp')
162      !
163   END SUBROUTINE tra_dmp
164
165
166   SUBROUTINE tra_dmp_init
167      !!----------------------------------------------------------------------
168      !!                  ***  ROUTINE tra_dmp_init  ***
169      !!
170      !! ** Purpose :   Initialization for the newtonian damping
171      !!
172      !! ** Method  :   read the namtra_dmp namelist and check the parameters
173      !!----------------------------------------------------------------------
174      INTEGER ::   ios, imask   ! local integers
175      !
176      NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
177      !!----------------------------------------------------------------------
178      !
179      READ  ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901)
180901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_dmp in reference namelist' )
181      !
182      READ  ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 )
183902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist' )
184      IF(lwm) WRITE ( numond, namtra_dmp )
185      !
186      IF(lwp) THEN                  ! Namelist print
187         WRITE(numout,*)
188         WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
189         WRITE(numout,*) '~~~~~~~~~~~~'
190         WRITE(numout,*) '   Namelist namtra_dmp : set relaxation parameters'
191         WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp   = ', ln_tradmp
192         WRITE(numout,*) '         mixed layer damping option      nn_zdmp  = ', nn_zdmp
193         WRITE(numout,*) '         Damping file name               cn_resto = ', cn_resto
194         WRITE(numout,*)
195      ENDIF
196      !
197      IF( ln_tradmp ) THEN
198         !                          ! Allocate arrays
199         IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
200         !
201         SELECT CASE (nn_zdmp)      ! Check values of nn_zdmp
202         CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping as specified by mask'
203         CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixing layer (kz > 5 cm2/s)'
204         CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed  layer'
205         CASE DEFAULT
206            CALL ctl_stop('tra_dmp_init : wrong value of nn_zdmp')
207         END SELECT
208         !
209         !!TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
210         !    so can damp to something other than intitial conditions files?
211         !!gm: In principle yes. Nevertheless, we can't anticipate demands that have never been formulated.
212         IF( .NOT.ln_tsd_dmp ) THEN
213            IF(lwp) WRITE(numout,*)
214            IF(lwp) WRITE(numout, *)  '   read T-S data not initialized, we force ln_tsd_dmp=T'
215            CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data
216         ENDIF
217         !                          ! Read in mask from file
218         CALL iom_open ( cn_resto, imask)
219         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto )
220         CALL iom_close( imask )
221      ENDIF
222      !
223   END SUBROUTINE tra_dmp_init
224
225   !!======================================================================
226END MODULE tradmp
Note: See TracBrowser for help on using the repository browser.