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

source: branches/UKMO/test_moci_test_suite_namelist_read/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90 @ 9383

Last change on this file since 9383 was 9383, checked in by andmirek, 6 years ago

#2050 fixes and changes

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