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/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90 @ 11101

Last change on this file since 11101 was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.

File size: 11.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   !!                 ! 1996-01  (G. Madec)  statement function for e3
9   !!                 ! 1997-05  (G. Madec)  macro-tasked on jk-slab
10   !!                 ! 1998-07  (M. Imbard, G. Madec) ORCA version
11   !!            7.0  ! 2001-02  (M. Imbard)  cofdis, Original code
12   !!            8.1  ! 2001-02  (G. Madec, E. Durand)  cleaning
13   !!  NEMO      1.0  ! 2002-08  (G. Madec, E. Durand)  free form + modules
14   !!            3.2  ! 2009-08  (G. Madec, C. Talandier)  DOCTOR norm for namelist parameter
15   !!            3.3  ! 2010-06  (C. Ethe, G. Madec) merge TRA-TRC
16   !!            3.4  ! 2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys
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 opa.F90
45
46   !                               !!* Namelist namtra_dmp : T & S newtonian damping *
47   ! nn_zdmp and cn_resto are public as they are used by C1D/dyndmp.F90
48   LOGICAL , PUBLIC ::   ln_tradmp   !: internal damping flag
49   INTEGER , PUBLIC ::   nn_zdmp     ! = 0/1/2 flag for damping in the mixed layer
50   CHARACTER(LEN=200) , PUBLIC :: cn_resto      ! name of netcdf file containing restoration coefficient field
51   !
52
53
54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   strdmp   !: damping salinity trend (psu/s)
55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ttrdmp   !: damping temperature trend (Celcius/s)
56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   resto    !: restoring coeff. on T and S (s-1)
57
58   !! * Substitutions
59#  include "domzgr_substitute.h90"
60#  include "vectopt_loop_substitute.h90"
61   !!----------------------------------------------------------------------
62   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
63   !! $Id$
64   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
65   !!----------------------------------------------------------------------
66CONTAINS
67
68   INTEGER FUNCTION tra_dmp_alloc()
69      !!----------------------------------------------------------------------
70      !!                ***  FUNCTION tra_dmp_alloc  ***
71      !!----------------------------------------------------------------------
72      ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk), resto(jpi,jpj,jpk), STAT= tra_dmp_alloc )
73      !
74      IF( lk_mpp            )   CALL mpp_sum ( tra_dmp_alloc )
75      IF( tra_dmp_alloc > 0 )   CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed')
76      !
77   END FUNCTION tra_dmp_alloc
78
79
80   SUBROUTINE tra_dmp( kt )
81      !!----------------------------------------------------------------------
82      !!                   ***  ROUTINE tra_dmp  ***
83      !!                 
84      !! ** Purpose :   Compute the tracer trend due to a newtonian damping
85      !!      of the tracer field towards given data field and add it to the
86      !!      general tracer trends.
87      !!
88      !! ** Method  :   Newtonian damping towards t_dta and s_dta computed
89      !!      and add to the general tracer trends:
90      !!                     ta = ta + resto * (t_dta - tb)
91      !!                     sa = sa + resto * (s_dta - sb)
92      !!         The trend is computed either throughout the water column
93      !!      (nlmdmp=0) or in area of weak vertical mixing (nlmdmp=1) or
94      !!      below the well mixed layer (nlmdmp=2)
95      !!
96      !! ** Action  : - (ta,sa)   tracer trends updated with the damping trend
97      !!----------------------------------------------------------------------
98      !
99      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
100      !!
101      INTEGER  ::   ji, jj, jk   ! dummy loop indices
102      REAL(wp) ::   zta, zsa             ! local scalars
103      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dta 
104      !!----------------------------------------------------------------------
105      !
106      IF( nn_timing == 1 )  CALL timing_start( 'tra_dmp')
107      !
108      CALL wrk_alloc( jpi, jpj, jpk, jpts,  zts_dta )
109      !
110      !                           !==   input T-S data at kt   ==!
111      CALL dta_tsd( kt, zts_dta )            ! read and interpolates T-S data at kt
112      !
113      SELECT CASE ( nn_zdmp )     !==    type of damping   ==!
114      !
115      CASE( 0 )                   !==  newtonian damping throughout the water column  ==!
116         DO jk = 1, jpkm1
117            DO jj = 2, jpjm1
118               DO ji = fs_2, fs_jpim1   ! vector opt.
119                  zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
120                  zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
121                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
122                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
123                  strdmp(ji,jj,jk) = zsa           ! save the trend (used in asmtrj)
124                  ttrdmp(ji,jj,jk) = zta     
125               END DO
126            END DO
127         END DO
128         !
129      CASE ( 1 )                  !==  no damping in the turbocline (avt > 5 cm2/s)  ==!
130         DO jk = 1, jpkm1
131            DO jj = 2, jpjm1
132               DO ji = fs_2, fs_jpim1   ! vector opt.
133                  IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN
134                     zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
135                     zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
136                  ELSE
137                     zta = 0._wp
138                     zsa = 0._wp 
139                  ENDIF
140                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
141                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
142                  strdmp(ji,jj,jk) = zsa           ! save the salinity trend (used in asmtrj)
143                  ttrdmp(ji,jj,jk) = zta
144               END DO
145            END DO
146         END DO
147         !
148      CASE ( 2 )                  !==  no damping in the mixed layer   ==!
149         DO jk = 1, jpkm1
150            DO jj = 2, jpjm1
151               DO ji = fs_2, fs_jpim1   ! vector opt.
152                  IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
153                     zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
154                     zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
155                  ELSE
156                     zta = 0._wp
157                     zsa = 0._wp 
158                  ENDIF
159                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
160                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
161                  strdmp(ji,jj,jk) = zsa           ! save the salinity trend (used in asmtrj)
162                  ttrdmp(ji,jj,jk) = zta
163               END DO
164            END DO
165         END DO
166         !
167      END SELECT
168      !
169      IF( l_trdtra )   THEN       ! trend diagnostic
170         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ttrdmp )
171         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, strdmp )
172      ENDIF
173      !                           ! Control print
174      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' dmp  - Ta: ', mask1=tmask,   &
175         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
176      !
177      CALL wrk_dealloc( jpi, jpj, jpk, jpts,  zts_dta )
178      !
179      IF( nn_timing == 1 )  CALL timing_stop( 'tra_dmp')
180      !
181   END SUBROUTINE tra_dmp
182
183
184   SUBROUTINE tra_dmp_init
185      !!----------------------------------------------------------------------
186      !!                  ***  ROUTINE tra_dmp_init  ***
187      !!
188      !! ** Purpose :   Initialization for the newtonian damping
189      !!
190      !! ** Method  :   read the namtra_dmp namelist and check the parameters
191      !!----------------------------------------------------------------------
192      NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
193      INTEGER ::  ios         ! Local integer for output status of namelist read
194      INTEGER :: imask        ! File handle
195      !!
196      !!----------------------------------------------------------------------
197      !
198      REWIND( numnam_ref )   ! Namelist namtra_dmp in reference namelist : T & S relaxation
199      READ  ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901)
200901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist', lwp )
201      !
202      REWIND( numnam_cfg )   ! Namelist namtra_dmp in configuration namelist : T & S relaxation
203      READ  ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 )
204902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp )
205      IF(lwm .AND. nprint > 2) WRITE ( numond, namtra_dmp )
206
207      IF(lwp) THEN                 !Namelist print
208         WRITE(numout,*)
209         WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
210         WRITE(numout,*) '~~~~~~~'
211         WRITE(numout,*) '   Namelist namtra_dmp : set relaxation parameters'
212         WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp = ', ln_tradmp
213         WRITE(numout,*) '      mixed layer damping option      nn_zdmp   = ', nn_zdmp
214         WRITE(numout,*) '      Damping file name               cn_resto  = ', cn_resto
215         WRITE(numout,*)
216         IF(lflush) CALL flush(numout)
217      ENDIF
218
219      IF( ln_tradmp) THEN
220         !
221         !Allocate arrays
222         IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
223
224         !Check values of nn_zdmp
225         SELECT CASE (nn_zdmp)
226         CASE ( 0 )  ; IF(lwp) WRITE(numout,*) '   tracer damping as specified by mask'
227         CASE ( 1 )  ; IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline'
228         CASE ( 2 )  ; IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer'
229         END SELECT
230         IF(lwp .AND. lflush) CALL flush(numout)
231
232         !TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
233         !so can damp to something other than intitial conditions files?
234         IF( .NOT.ln_tsd_tradmp ) THEN
235            CALL ctl_warn( 'tra_dmp_init: read T-S data not initialized, we force ln_tsd_tradmp=T' )
236            CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data
237         ENDIF
238
239         !initialise arrays - Are these actually used anywhere else?
240         strdmp(:,:,:) = 0._wp
241         ttrdmp(:,:,:) = 0._wp
242
243         !Read in mask from file
244         CALL iom_open ( cn_resto, imask)
245         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto)
246         CALL iom_close( imask )
247       ENDIF
248
249   END SUBROUTINE tra_dmp_init
250
251END MODULE tradmp
Note: See TracBrowser for help on using the repository browser.