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

source: branches/UKMO/r5936_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90 @ 7166

Last change on this file since 7166 was 7166, checked in by jcastill, 7 years ago

Remove svn keys
File size: 11.2 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
33   USE in_out_manager ! I/O manager
34   USE lib_mpp        ! MPP library
35   USE prtctl         ! Print control
[3294]36   USE wrk_nemo       ! Memory allocation
37   USE timing         ! Timing
[5102]38   USE iom
[3]39
40   IMPLICIT NONE
41   PRIVATE
42
[2528]43   PUBLIC   tra_dmp      ! routine called by step.F90
[5836]44   PUBLIC   tra_dmp_init ! routine 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
54#  include "domzgr_substitute.h90"
55#  include "vectopt_loop_substitute.h90"
56   !!----------------------------------------------------------------------
[2528]57   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[7166]58   !! $Id$
[2528]59   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[3]60   !!----------------------------------------------------------------------
61CONTAINS
62
[2715]63   INTEGER FUNCTION tra_dmp_alloc()
64      !!----------------------------------------------------------------------
[3294]65      !!                ***  FUNCTION tra_dmp_alloc  ***
[2715]66      !!----------------------------------------------------------------------
[5836]67      ALLOCATE( resto(jpi,jpj,jpk), STAT= tra_dmp_alloc )
[2715]68      !
69      IF( lk_mpp            )   CALL mpp_sum ( tra_dmp_alloc )
70      IF( tra_dmp_alloc > 0 )   CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed')
[3294]71      !
[2715]72   END FUNCTION tra_dmp_alloc
73
74
[3]75   SUBROUTINE tra_dmp( kt )
76      !!----------------------------------------------------------------------
77      !!                   ***  ROUTINE tra_dmp  ***
78      !!                 
79      !! ** Purpose :   Compute the tracer trend due to a newtonian damping
80      !!      of the tracer field towards given data field and add it to the
81      !!      general tracer trends.
82      !!
83      !! ** Method  :   Newtonian damping towards t_dta and s_dta computed
84      !!      and add to the general tracer trends:
85      !!                     ta = ta + resto * (t_dta - tb)
86      !!                     sa = sa + resto * (s_dta - sb)
87      !!         The trend is computed either throughout the water column
88      !!      (nlmdmp=0) or in area of weak vertical mixing (nlmdmp=1) or
89      !!      below the well mixed layer (nlmdmp=2)
90      !!
[1601]91      !! ** Action  : - (ta,sa)   tracer trends updated with the damping trend
[503]92      !!----------------------------------------------------------------------
[5836]93      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
[3294]94      !
[5836]95      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
96      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dta, ztrdts
[3]97      !!----------------------------------------------------------------------
[503]98      !
[5836]99      IF( nn_timing == 1 )   CALL timing_start('tra_dmp')
[3294]100      !
[5836]101      CALL wrk_alloc( jpi,jpj,jpk,jpts,   zts_dta )
[4990]102      !
[5836]103      IF( l_trdtra )   THEN                    !* Save ta and sa trends
104         CALL wrk_alloc( jpi,jpj,jpk,jpts,   ztrdts ) 
105         ztrdts(:,:,:,:) = tsa(:,:,:,:) 
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
114            DO jk = 1, jpkm1
115               DO jj = 2, jpjm1
116                  DO ji = fs_2, fs_jpim1   ! vector opt.
117                     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) )
118                  END DO
[3]119               END DO
120            END DO
121         END DO
[503]122         !
[5836]123      CASE ( 1 )                       !*  no damping in the turbocline (avt > 5 cm2/s)  *!
[3]124         DO jk = 1, jpkm1
125            DO jj = 2, jpjm1
126               DO ji = fs_2, fs_jpim1   ! vector opt.
[2528]127                  IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN
[5836]128                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
129                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
130                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
131                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
[3]132                  ENDIF
133               END DO
134            END DO
135         END DO
[503]136         !
[5836]137      CASE ( 2 )                       !*  no damping in the mixed layer   *!
[3]138         DO jk = 1, jpkm1
139            DO jj = 2, jpjm1
140               DO ji = fs_2, fs_jpim1   ! vector opt.
141                  IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
[5836]142                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
143                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
144                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
145                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
[3]146                  ENDIF
147               END DO
148            END DO
149         END DO
[503]150         !
[3]151      END SELECT
[2528]152      !
[1601]153      IF( l_trdtra )   THEN       ! trend diagnostic
[5836]154         ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:)
155         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) )
156         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) )
157         CALL wrk_dealloc( jpi,jpj,jpk,jpts,   ztrdts ) 
[216]158      ENDIF
[1601]159      !                           ! Control print
[2528]160      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' dmp  - Ta: ', mask1=tmask,   &
161         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
[503]162      !
[5836]163      CALL wrk_dealloc( jpi,jpj,jpk,jpts,   zts_dta )
[3294]164      !
[5836]165      IF( nn_timing == 1 )   CALL timing_stop('tra_dmp')
[3294]166      !
[3]167   END SUBROUTINE tra_dmp
168
169
170   SUBROUTINE tra_dmp_init
171      !!----------------------------------------------------------------------
172      !!                  ***  ROUTINE tra_dmp_init  ***
173      !!
174      !! ** Purpose :   Initialization for the newtonian damping
175      !!
[4245]176      !! ** Method  :   read the namtra_dmp namelist and check the parameters
[3]177      !!----------------------------------------------------------------------
[5836]178      INTEGER ::   ios, imask   ! local integers
179      !!
[5102]180      NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
[541]181      !!----------------------------------------------------------------------
[4990]182      !
[5102]183      REWIND( numnam_ref )   ! Namelist namtra_dmp in reference namelist : T & S relaxation
[4147]184      READ  ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901)
185901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist', lwp )
[4990]186      !
[5102]187      REWIND( numnam_cfg )   ! Namelist namtra_dmp in configuration namelist : T & S relaxation
[4147]188      READ  ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 )
189902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp )
[4624]190      IF(lwm) WRITE ( numond, namtra_dmp )
[5836]191      !
192      IF(lwp) THEN                  ! Namelist print
[3]193         WRITE(numout,*)
[5102]194         WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
[5836]195         WRITE(numout,*) '~~~~~~~~~~~'
[5102]196         WRITE(numout,*) '   Namelist namtra_dmp : set relaxation parameters'
197         WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp = ', ln_tradmp
198         WRITE(numout,*) '      mixed layer damping option      nn_zdmp   = ', nn_zdmp
199         WRITE(numout,*) '      Damping file name               cn_resto  = ', cn_resto
[3294]200         WRITE(numout,*)
[3]201      ENDIF
[5836]202      !
[5102]203      IF( ln_tradmp) THEN
[5836]204         !                          ! Allocate arrays
205         IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
[3294]206         !
[5836]207         SELECT CASE (nn_zdmp)      ! Check values of nn_zdmp
208         CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping as specified by mask'
209         CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixing layer (kz > 5 cm2/s)'
210         CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed  layer'
211         CASE DEFAULT
212            CALL ctl_stop('tra_dmp_init : wrong value of nn_zdmp')
[3294]213         END SELECT
[5836]214         !
215         !!TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
216         !    so can damp to something other than intitial conditions files?
217         !!gm: In principle yes. Nevertheless, we can't anticipate demands that have never been formulated.
[3294]218         IF( .NOT.ln_tsd_tradmp ) THEN
[5836]219            IF(lwp) WRITE(numout,*)
220            IF(lwp) WRITE(numout, *)  '   read T-S data not initialized, we force ln_tsd_tradmp=T'
[3294]221            CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data
222         ENDIF
[5836]223         !                          ! Read in mask from file
[5102]224         CALL iom_open ( cn_resto, imask)
[5836]225         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto )
[5102]226         CALL iom_close( imask )
[5836]227      ENDIF
228      !
[5102]229   END SUBROUTINE tra_dmp_init
[3]230
231END MODULE tradmp
Note: See TracBrowser for help on using the repository browser.