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/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA – NEMO

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/tradmp.F90 @ 10946

Last change on this file since 10946 was 10946, checked in by acc, 5 years ago

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Convert STO, TRD and USR modules and all knock on effects of these conversions. Note change to USR module may have implications for the TEST CASES (not tested yet). Standard SETTE tested only

  • Property svn:keywords set to Id
File size: 11.1 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
54#  include "vectopt_loop_substitute.h90"
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
[10946]74   SUBROUTINE tra_dmp( kt, Kmm, 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      !!----------------------------------------------------------------------
[10874]92      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
[10946]93      INTEGER, INTENT(in) ::   Kmm, Krhs  ! time level indices
[3294]94      !
[5836]95      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
[9019]96      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)     ::  zts_dta
97      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdts
[3]98      !!----------------------------------------------------------------------
[503]99      !
[9019]100      IF( ln_timing )   CALL timing_start('tra_dmp')
[3294]101      !
[5836]102      IF( l_trdtra )   THEN                    !* Save ta and sa trends
[9019]103         ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) ) 
[10874]104         ztrdts(:,:,:,:) = tsa(:,:,:,:) 
[5836]105      ENDIF
106      !                           !==  input T-S data at kt  ==!
[3294]107      CALL dta_tsd( kt, zts_dta )            ! read and interpolates T-S data at kt
108      !
[5836]109      SELECT CASE ( nn_zdmp )     !==  type of damping  ==!
[2528]110      !
[5836]111      CASE( 0 )                        !*  newtonian damping throughout the water column  *!
112         DO jn = 1, jpts
113            DO jk = 1, jpkm1
114               DO jj = 2, jpjm1
115                  DO ji = fs_2, fs_jpim1   ! vector opt.
[10874]116                     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) )
[5836]117                  END DO
[3]118               END DO
119            END DO
120         END DO
[503]121         !
[5836]122      CASE ( 1 )                       !*  no damping in the turbocline (avt > 5 cm2/s)  *!
[3]123         DO jk = 1, jpkm1
124            DO jj = 2, jpjm1
125               DO ji = fs_2, fs_jpim1   ! vector opt.
[10351]126                  IF( avt(ji,jj,jk) <= avt_c ) THEN
[10874]127                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
128                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
129                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
130                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
[3]131                  ENDIF
132               END DO
133            END DO
134         END DO
[503]135         !
[5836]136      CASE ( 2 )                       !*  no damping in the mixed layer   *!
[3]137         DO jk = 1, jpkm1
138            DO jj = 2, jpjm1
139               DO ji = fs_2, fs_jpim1   ! vector opt.
[10874]140                  IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN
141                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
142                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
143                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
144                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
[3]145                  ENDIF
146               END DO
147            END DO
148         END DO
[503]149         !
[3]150      END SELECT
[2528]151      !
[1601]152      IF( l_trdtra )   THEN       ! trend diagnostic
[10874]153         ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:)
[10946]154         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) )
155         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) )
[9019]156         DEALLOCATE( ztrdts ) 
[216]157      ENDIF
[1601]158      !                           ! Control print
[2528]159      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' dmp  - Ta: ', mask1=tmask,   &
160         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
[503]161      !
[9019]162      IF( ln_timing )   CALL timing_stop('tra_dmp')
[3294]163      !
[3]164   END SUBROUTINE tra_dmp
165
166
167   SUBROUTINE tra_dmp_init
168      !!----------------------------------------------------------------------
169      !!                  ***  ROUTINE tra_dmp_init  ***
170      !!
171      !! ** Purpose :   Initialization for the newtonian damping
172      !!
[4245]173      !! ** Method  :   read the namtra_dmp namelist and check the parameters
[3]174      !!----------------------------------------------------------------------
[5836]175      INTEGER ::   ios, imask   ! local integers
[6140]176      !
[5102]177      NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
[541]178      !!----------------------------------------------------------------------
[4990]179      !
[5102]180      REWIND( numnam_ref )   ! Namelist namtra_dmp in reference namelist : T & S relaxation
[4147]181      READ  ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901)
[9168]182901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_dmp in reference namelist', lwp )
[4990]183      !
[5102]184      REWIND( numnam_cfg )   ! Namelist namtra_dmp in configuration namelist : T & S relaxation
[4147]185      READ  ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 )
[9168]186902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp )
[4624]187      IF(lwm) WRITE ( numond, namtra_dmp )
[5836]188      !
189      IF(lwp) THEN                  ! Namelist print
[3]190         WRITE(numout,*)
[5102]191         WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
[7646]192         WRITE(numout,*) '~~~~~~~~~~~~'
[5102]193         WRITE(numout,*) '   Namelist namtra_dmp : set relaxation parameters'
[9168]194         WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp   = ', ln_tradmp
195         WRITE(numout,*) '         mixed layer damping option      nn_zdmp  = ', nn_zdmp
196         WRITE(numout,*) '         Damping file name               cn_resto = ', cn_resto
[3294]197         WRITE(numout,*)
[3]198      ENDIF
[5836]199      !
[9490]200      IF( ln_tradmp ) THEN
[5836]201         !                          ! Allocate arrays
202         IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
[3294]203         !
[5836]204         SELECT CASE (nn_zdmp)      ! Check values of nn_zdmp
205         CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping as specified by mask'
206         CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixing layer (kz > 5 cm2/s)'
207         CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed  layer'
208         CASE DEFAULT
209            CALL ctl_stop('tra_dmp_init : wrong value of nn_zdmp')
[3294]210         END SELECT
[5836]211         !
212         !!TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
213         !    so can damp to something other than intitial conditions files?
214         !!gm: In principle yes. Nevertheless, we can't anticipate demands that have never been formulated.
[9490]215         IF( .NOT.ln_tsd_dmp ) THEN
[5836]216            IF(lwp) WRITE(numout,*)
[9490]217            IF(lwp) WRITE(numout, *)  '   read T-S data not initialized, we force ln_tsd_dmp=T'
[3294]218            CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data
219         ENDIF
[5836]220         !                          ! Read in mask from file
[5102]221         CALL iom_open ( cn_resto, imask)
[5836]222         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto )
[5102]223         CALL iom_close( imask )
[5836]224      ENDIF
225      !
[5102]226   END SUBROUTINE tra_dmp_init
[3]227
[6140]228   !!======================================================================
[3]229END MODULE tradmp
Note: See TracBrowser for help on using the repository browser.