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/trunk/src/OCE/TRA – NEMO

source: NEMO/trunk/src/OCE/TRA/tradmp.F90 @ 12489

Last change on this file since 12489 was 12377, checked in by acc, 4 years 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
RevLine 
[3]1MODULE tradmp
2   !!======================================================================
3   !!                       ***  MODULE  tradmp  ***
4   !! Ocean physics: internal restoring trend on active tracers (T and S)
5   !!======================================================================
[1601]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
[5836]9   !!            7.0  ! 2001-02  (M. Imbard)  add distance to coast, Original code
[1601]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
[2528]13   !!            3.3  ! 2010-06  (C. Ethe, G. Madec) merge TRA-TRC
[3294]14   !!            3.4  ! 2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys
[5836]15   !!            3.6  ! 2015-06  (T. Graham)  read restoring coefficient in a file
16   !!            3.7  ! 2015-10  (G. Madec)  remove useless trends arrays
[503]17   !!----------------------------------------------------------------------
[3294]18
[3]19   !!----------------------------------------------------------------------
[2715]20   !!   tra_dmp_alloc : allocate tradmp arrays
[2528]21   !!   tra_dmp       : update the tracer trend with the internal damping
22   !!   tra_dmp_init  : initialization, namlist read, parameters control
[3]23   !!----------------------------------------------------------------------
[2528]24   USE oce            ! ocean: variables
25   USE dom_oce        ! ocean: domain variables
[4245]26   USE c1d            ! 1D vertical configuration
[4990]27   USE trd_oce        ! trends: ocean variables
28   USE trdtra         ! trends manager: tracers
[2528]29   USE zdf_oce        ! ocean: vertical physics
30   USE phycst         ! physical constants
[3294]31   USE dtatsd         ! data: temperature & salinity
[2528]32   USE zdfmxl         ! vertical physics: mixed layer depth
[6140]33   !
[2528]34   USE in_out_manager ! I/O manager
[9019]35   USE iom            ! XIOS
[2528]36   USE lib_mpp        ! MPP library
37   USE prtctl         ! Print control
[3294]38   USE timing         ! Timing
[3]39
40   IMPLICIT NONE
41   PRIVATE
42
[6140]43   PUBLIC   tra_dmp        ! called by step.F90
44   PUBLIC   tra_dmp_init   ! called by nemogcm.F90
[3]45
[5836]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
[5102]50   !
[2715]51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   resto    !: restoring coeff. on T and S (s-1)
[3]52
53   !! * Substitutions
[12377]54#  include "do_loop_substitute.h90"
[3]55   !!----------------------------------------------------------------------
[9598]56   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[1152]57   !! $Id$
[10068]58   !! Software governed by the CeCILL license (see ./LICENSE)
[3]59   !!----------------------------------------------------------------------
60CONTAINS
61
[2715]62   INTEGER FUNCTION tra_dmp_alloc()
63      !!----------------------------------------------------------------------
[3294]64      !!                ***  FUNCTION tra_dmp_alloc  ***
[2715]65      !!----------------------------------------------------------------------
[5836]66      ALLOCATE( resto(jpi,jpj,jpk), STAT= tra_dmp_alloc )
[2715]67      !
[10425]68      CALL mpp_sum ( 'tradmp', tra_dmp_alloc )
[2715]69      IF( tra_dmp_alloc > 0 )   CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed')
[3294]70      !
[2715]71   END FUNCTION tra_dmp_alloc
72
73
[12377]74   SUBROUTINE tra_dmp( kt, Kbb, Kmm, pts, Krhs )
[3]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      !!
[6140]90      !! ** Action  : - tsa: tracer trends updated with the damping trend
[503]91      !!----------------------------------------------------------------------
[12377]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
[3294]95      !
[5836]96      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
[9019]97      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)     ::  zts_dta
98      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdts
[3]99      !!----------------------------------------------------------------------
[503]100      !
[9019]101      IF( ln_timing )   CALL timing_start('tra_dmp')
[3294]102      !
[5836]103      IF( l_trdtra )   THEN                    !* Save ta and sa trends
[9019]104         ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) ) 
[12377]105         ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs) 
[5836]106      ENDIF
107      !                           !==  input T-S data at kt  ==!
[3294]108      CALL dta_tsd( kt, zts_dta )            ! read and interpolates T-S data at kt
109      !
[5836]110      SELECT CASE ( nn_zdmp )     !==  type of damping  ==!
[2528]111      !
[5836]112      CASE( 0 )                        !*  newtonian damping throughout the water column  *!
113         DO jn = 1, jpts
[12377]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
[3]118         END DO
[503]119         !
[5836]120      CASE ( 1 )                       !*  no damping in the turbocline (avt > 5 cm2/s)  *!
[12377]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
[503]129         !
[5836]130      CASE ( 2 )                       !*  no damping in the mixed layer   *!
[12377]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
[503]139         !
[3]140      END SELECT
[2528]141      !
[1601]142      IF( l_trdtra )   THEN       ! trend diagnostic
[12377]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) )
[9019]146         DEALLOCATE( ztrdts ) 
[216]147      ENDIF
[1601]148      !                           ! Control print
[12377]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' )
[503]151      !
[9019]152      IF( ln_timing )   CALL timing_stop('tra_dmp')
[3294]153      !
[3]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      !!
[4245]163      !! ** Method  :   read the namtra_dmp namelist and check the parameters
[3]164      !!----------------------------------------------------------------------
[5836]165      INTEGER ::   ios, imask   ! local integers
[6140]166      !
[5102]167      NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
[541]168      !!----------------------------------------------------------------------
[4990]169      !
[4147]170      READ  ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901)
[11536]171901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_dmp in reference namelist' )
[4990]172      !
[4147]173      READ  ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 )
[11536]174902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist' )
[4624]175      IF(lwm) WRITE ( numond, namtra_dmp )
[5836]176      !
177      IF(lwp) THEN                  ! Namelist print
[3]178         WRITE(numout,*)
[5102]179         WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
[7646]180         WRITE(numout,*) '~~~~~~~~~~~~'
[5102]181         WRITE(numout,*) '   Namelist namtra_dmp : set relaxation parameters'
[9168]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
[3294]185         WRITE(numout,*)
[3]186      ENDIF
[5836]187      !
[9490]188      IF( ln_tradmp ) THEN
[5836]189         !                          ! Allocate arrays
190         IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
[3294]191         !
[5836]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')
[3294]198         END SELECT
[5836]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.
[9490]203         IF( .NOT.ln_tsd_dmp ) THEN
[5836]204            IF(lwp) WRITE(numout,*)
[9490]205            IF(lwp) WRITE(numout, *)  '   read T-S data not initialized, we force ln_tsd_dmp=T'
[3294]206            CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data
207         ENDIF
[5836]208         !                          ! Read in mask from file
[5102]209         CALL iom_open ( cn_resto, imask)
[5836]210         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto )
[5102]211         CALL iom_close( imask )
[5836]212      ENDIF
213      !
[5102]214   END SUBROUTINE tra_dmp_init
[3]215
[6140]216   !!======================================================================
[3]217END MODULE tradmp
Note: See TracBrowser for help on using the repository browser.