source: NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/TRA/tradmp.F90 @ 12603

Last change on this file since 12603 was 12377, checked in by acc, 10 months ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge —ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The —ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

  • Property svn:keywords set to Id
File size: 10.9 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 "do_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, Kbb, Kmm, pts, 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   ) :: Kbb, Kmm, Krhs  ! time level indices
94      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts             ! active tracers and RHS of tracer equation
95      !
96      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
97      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)     ::  zts_dta
98      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdts
99      !!----------------------------------------------------------------------
100      !
101      IF( ln_timing )   CALL timing_start('tra_dmp')
102      !
103      IF( l_trdtra )   THEN                    !* Save ta and sa trends
104         ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) ) 
105         ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs) 
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_3D_00_00( 1, jpkm1 )
115               pts(ji,jj,jk,jn,Krhs) = pts(ji,jj,jk,jn,Krhs)           &
116                  &                  + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - pts(ji,jj,jk,jn,Kbb) )
117            END_3D
118         END DO
119         !
120      CASE ( 1 )                       !*  no damping in the turbocline (avt > 5 cm2/s)  *!
121         DO_3D_00_00( 1, jpkm1 )
122            IF( avt(ji,jj,jk) <= avt_c ) THEN
123               pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   &
124                  &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) )
125               pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)   &
126                  &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) )
127            ENDIF
128         END_3D
129         !
130      CASE ( 2 )                       !*  no damping in the mixed layer   *!
131         DO_3D_00_00( 1, jpkm1 )
132            IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN
133               pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   &
134                  &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) )
135               pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs)   &
136                  &                      + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) )
137            ENDIF
138         END_3D
139         !
140      END SELECT
141      !
142      IF( l_trdtra )   THEN       ! trend diagnostic
143         ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs) - ztrdts(:,:,:,:)
144         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) )
145         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) )
146         DEALLOCATE( ztrdts ) 
147      ENDIF
148      !                           ! Control print
149      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' dmp  - Ta: ', mask1=tmask,   &
150         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
151      !
152      IF( ln_timing )   CALL timing_stop('tra_dmp')
153      !
154   END SUBROUTINE tra_dmp
155
156
157   SUBROUTINE tra_dmp_init
158      !!----------------------------------------------------------------------
159      !!                  ***  ROUTINE tra_dmp_init  ***
160      !!
161      !! ** Purpose :   Initialization for the newtonian damping
162      !!
163      !! ** Method  :   read the namtra_dmp namelist and check the parameters
164      !!----------------------------------------------------------------------
165      INTEGER ::   ios, imask   ! local integers
166      !
167      NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
168      !!----------------------------------------------------------------------
169      !
170      READ  ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901)
171901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_dmp in reference namelist' )
172      !
173      READ  ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 )
174902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist' )
175      IF(lwm) WRITE ( numond, namtra_dmp )
176      !
177      IF(lwp) THEN                  ! Namelist print
178         WRITE(numout,*)
179         WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
180         WRITE(numout,*) '~~~~~~~~~~~~'
181         WRITE(numout,*) '   Namelist namtra_dmp : set relaxation parameters'
182         WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp   = ', ln_tradmp
183         WRITE(numout,*) '         mixed layer damping option      nn_zdmp  = ', nn_zdmp
184         WRITE(numout,*) '         Damping file name               cn_resto = ', cn_resto
185         WRITE(numout,*)
186      ENDIF
187      !
188      IF( ln_tradmp ) THEN
189         !                          ! Allocate arrays
190         IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
191         !
192         SELECT CASE (nn_zdmp)      ! Check values of nn_zdmp
193         CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping as specified by mask'
194         CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixing layer (kz > 5 cm2/s)'
195         CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed  layer'
196         CASE DEFAULT
197            CALL ctl_stop('tra_dmp_init : wrong value of nn_zdmp')
198         END SELECT
199         !
200         !!TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
201         !    so can damp to something other than intitial conditions files?
202         !!gm: In principle yes. Nevertheless, we can't anticipate demands that have never been formulated.
203         IF( .NOT.ln_tsd_dmp ) THEN
204            IF(lwp) WRITE(numout,*)
205            IF(lwp) WRITE(numout, *)  '   read T-S data not initialized, we force ln_tsd_dmp=T'
206            CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data
207         ENDIF
208         !                          ! Read in mask from file
209         CALL iom_open ( cn_resto, imask)
210         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto )
211         CALL iom_close( imask )
212      ENDIF
213      !
214   END SUBROUTINE tra_dmp_init
215
216   !!======================================================================
217END MODULE tradmp
Note: See TracBrowser for help on using the repository browser.