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.
trcdmp.F90 in NEMO/branches/2019/fix_sn_cfctl_ticket2328/src/TOP/TRP – NEMO

source: NEMO/branches/2019/fix_sn_cfctl_ticket2328/src/TOP/TRP/trcdmp.F90 @ 11872

Last change on this file since 11872 was 11872, checked in by acc, 4 years ago

Branch 2019/fix_sn_cfctl_ticket2328. See #2328. Replacement of ln_ctl and activation of full functionality with
sn_cfctl structure. These changes rename structure components l_mppout and l_mpptop as l_prtctl and l_prttrc
and introduce l_glochk to activate former ln_ctl code in stpctl.F90 to perform global location of min and max
checks. Also added is l_allon which can be used to activate all output (much like the former ln_ctl). If l_allon
is .false. then l_config decides whether or not the suboptions are used.

   sn_cfctl%l_glochk = .FALSE.    ! Range sanity checks are local (F) or global (T). Set T for debugging only
   sn_cfctl%l_allon  = .FALSE.    ! IF T activate all options. If F deactivate all unless l_config is T
   sn_cfctl%l_config = .TRUE.     ! IF .true. then control which reports are written with the remaining options

Note, these changes pass SETTE tests but all references to ln_ctl need to be removed from the sette scripts.

  • Property svn:keywords set to Id
File size: 18.5 KB
RevLine 
[941]1MODULE trcdmp
2   !!======================================================================
3   !!                       ***  MODULE  trcdmp  ***
4   !! Ocean physics: internal restoring trend on passive tracers
5   !!======================================================================
[2528]6   !! History :  OPA  !  1991-03  (O. Marti, G. Madec)  Original code
7   !!                 !  1996-01  (G. Madec) statement function for e3
8   !!                 !  1997-05  (H. Loukos)  adapted for passive tracers
9   !!    NEMO    9.0  !  2004-03  (C. Ethe)    free form + modules
10   !!            3.2  !  2007-02  (C. Deltel)  Diagnose ML trends for passive tracers
11   !!            3.3  !  2010-06  (C. Ethe, G. Madec) merge TRA-TRC
[941]12   !!----------------------------------------------------------------------
[4148]13#if  defined key_top 
[941]14   !!----------------------------------------------------------------------
15   !!   trc_dmp      : update the tracer trend with the internal damping
16   !!   trc_dmp_init : initialization, namlist read, parameters control
17   !!----------------------------------------------------------------------
18   USE oce_trc         ! ocean dynamics and tracers variables
[1175]19   USE trc             ! ocean passive tracers variables
[941]20   USE trcdta
[2528]21   USE tradmp
22   USE trdtra
[4990]23   USE trd_oce
[9169]24   !
[5102]25   USE iom
[9169]26   USE prtctl_trc      ! Print control for debbuging
[941]27
28   IMPLICIT NONE
29   PRIVATE
30
[5836]31   PUBLIC trc_dmp     
32   PUBLIC trc_dmp_clo   
33   PUBLIC trc_dmp_alloc 
34   PUBLIC trc_dmp_ini   
[941]35
[9169]36   INTEGER            , PUBLIC ::   nn_zdmp_tr    !: = 0/1/2 flag for damping in the mixed layer
37   CHARACTER(LEN=200) , PUBLIC ::   cn_resto_tr   !: File containing restoration coefficient
[5836]38
[4148]39   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   restotr   ! restoring coeff. on tracers (s-1)
[2715]40
[9169]41   INTEGER, PARAMETER         ::   npncts = 8       ! number of closed sea
42   INTEGER, DIMENSION(npncts) ::   nctsi1, nctsj1   ! south-west closed sea limits (i,j)
43   INTEGER, DIMENSION(npncts) ::   nctsi2, nctsj2   ! north-east closed sea limits (i,j)
[941]44
45   !! * Substitutions
[5836]46#  include "vectopt_loop_substitute.h90"
[941]47   !!----------------------------------------------------------------------
[10067]48   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
[5215]49   !! $Id$
[10068]50   !! Software governed by the CeCILL license (see ./LICENSE)
[941]51   !!----------------------------------------------------------------------
52CONTAINS
53
[2715]54   INTEGER FUNCTION trc_dmp_alloc()
55      !!----------------------------------------------------------------------
56      !!                   ***  ROUTINE trc_dmp_alloc  ***
57      !!----------------------------------------------------------------------
58      ALLOCATE( restotr(jpi,jpj,jpk) , STAT=trc_dmp_alloc )
59      !
60      IF( trc_dmp_alloc /= 0 )   CALL ctl_warn('trc_dmp_alloc: failed to allocate array')
61      !
62   END FUNCTION trc_dmp_alloc
63
64
[941]65   SUBROUTINE trc_dmp( kt )
66      !!----------------------------------------------------------------------
67      !!                   ***  ROUTINE trc_dmp  ***
68      !!                 
69      !! ** Purpose :   Compute the passive tracer trend due to a newtonian damping
70      !!      of the tracer field towards given data field and add it to the
71      !!      general tracer trends.
72      !!
73      !! ** Method  :   Newtonian damping towards trdta computed
74      !!      and add to the general tracer trends:
75      !!                     trn = tra + restotr * (trdta - trb)
76      !!         The trend is computed either throughout the water column
77      !!      (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or
78      !!      below the well mixed layer (nlmdmptr=2)
79      !!
80      !! ** Action  : - update the tracer trends tra with the newtonian
81      !!                damping trends.
[4990]82      !!              - save the trends ('key_trdmxl_trc')
[1175]83      !!----------------------------------------------------------------------
[6140]84      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
85      !
86      INTEGER ::   ji, jj, jk, jn, jl   ! dummy loop indices
87      CHARACTER (len=22) ::   charout
[9125]88      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrtrd
89      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrcdta   ! 3D  workspace
[941]90      !!----------------------------------------------------------------------
[3294]91      !
[9124]92      IF( ln_timing )   CALL timing_start('trc_dmp')
[3294]93      !
[9125]94      IF( l_trdtrc )   ALLOCATE( ztrtrd(jpi,jpj,jpk) )   ! temporary save of trends
[4148]95      !
96      IF( nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping
97         !
[9125]98         ALLOCATE( ztrcdta(jpi,jpj,jpk) )    ! Memory allocation
[4148]99         !                                                          ! ===========
100         DO jn = 1, jptra                                           ! tracer loop
101            !                                                       ! ===========
102            IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)    ! save trends
103            !
104            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
[6140]105               !
[4148]106               jl = n_trc_index(jn) 
[6701]107               CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000
[6140]108               !
[4148]109               SELECT CASE ( nn_zdmp_tr )
110               !
111               CASE( 0 )                !==  newtonian damping throughout the water column  ==!
112                  DO jk = 1, jpkm1
113                     DO jj = 2, jpjm1
114                        DO ji = fs_2, fs_jpim1   ! vector opt.
[6701]115                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
[4148]116                        END DO
[941]117                     END DO
118                  END DO
[6140]119                  !
[4148]120               CASE ( 1 )                !==  no damping in the turbocline (avt > 5 cm2/s)  ==!
121                  DO jk = 1, jpkm1
122                     DO jj = 2, jpjm1
123                        DO ji = fs_2, fs_jpim1   ! vector opt.
[10351]124                           IF( avt(ji,jj,jk) <= avt_c )  THEN
[6701]125                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
[4148]126                           ENDIF
127                        END DO
[941]128                     END DO
129                  END DO
[6140]130                  !
[4148]131               CASE ( 2 )               !==  no damping in the mixed layer   ==!
132                  DO jk = 1, jpkm1
133                     DO jj = 2, jpjm1
134                        DO ji = fs_2, fs_jpim1   ! vector opt.
[6140]135                           IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN
[6701]136                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
[4148]137                           END IF
138                        END DO
[941]139                     END DO
140                  END DO
[6140]141                 
[4148]142               END SELECT
143               !
144            ENDIF
145            !
146            IF( l_trdtrc ) THEN
147               ztrtrd(:,:,:) = tra(:,:,:,jn) -  ztrtrd(:,:,:)
[4990]148               CALL trd_tra( kt, 'TRC', jn, jptra_dmp, ztrtrd )
[4148]149            END IF
150            !                                                       ! ===========
151         END DO                                                     ! tracer loop
152         !                                                          ! ===========
[9125]153         DEALLOCATE( ztrcdta )
[4148]154      ENDIF
155      !
[9125]156      IF( l_trdtrc )  DEALLOCATE( ztrtrd )
[2528]157      !                                          ! print mean trends (used for debugging)
[11872]158      IF( sn_cfctl%l_prttrc ) THEN
[6140]159         WRITE(charout, FMT="('dmp ')")
160         CALL prt_ctl_trc_info(charout)
161         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
[941]162      ENDIF
[2528]163      !
[9124]164      IF( ln_timing )   CALL timing_stop('trc_dmp')
[3294]165      !
[941]166   END SUBROUTINE trc_dmp
167
[6140]168
[5836]169   SUBROUTINE trc_dmp_ini
170      !!----------------------------------------------------------------------
171      !!                  ***  ROUTINE trc_dmp_ini  ***
172      !!
173      !! ** Purpose :   Initialization for the newtonian damping
174      !!
175      !! ** Method  :   read the nammbf namelist and check the parameters
176      !!              called by trc_dmp at the first timestep (nittrc000)
177      !!----------------------------------------------------------------------
[6140]178      INTEGER ::   ios, imask  ! local integers
179      !!
[5836]180      NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr
181      !!----------------------------------------------------------------------
[6140]182      !
[5836]183      REWIND( numnat_ref )              ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping
184      READ  ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909)
[11536]185909   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist' )
[5836]186      REWIND( numnat_cfg )              ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping
187      READ  ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910)
[11536]188910   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist' )
[5836]189      IF(lwm) WRITE ( numont, namtrc_dmp )
190
191      IF(lwp) THEN                       ! Namelist print
192         WRITE(numout,*)
193         WRITE(numout,*) 'trc_dmp : Passive tracers newtonian damping'
194         WRITE(numout,*) '~~~~~~~'
195         WRITE(numout,*) '   Namelist namtrc_dmp : set damping parameter'
[9169]196         WRITE(numout,*) '      mixed layer damping option     nn_zdmp_tr  = ', nn_zdmp_tr, '(zoom: forced to 0)'
197         WRITE(numout,*) '      Restoration coeff file         cn_resto_tr = ', cn_resto_tr
[5836]198      ENDIF
[6701]199      !                          ! Allocate arrays
200      IF( trc_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_dmp_ini: unable to allocate arrays' )
[5836]201      !
202      SELECT CASE ( nn_zdmp_tr )
[9169]203      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '      ===>>   tracer damping throughout the water column'
204      CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '      ===>>   no tracer damping in the turbocline (avt > 5 cm2/s)'
205      CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '      ===>>   no tracer damping in the mixed layer'
[5836]206      CASE DEFAULT
207         WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr
208         CALL ctl_stop(ctmp1)
209      END SELECT
210
211      IF( .NOT.lk_c1d ) THEN
[9169]212         IF( .NOT.ln_tradmp )   &
213            &   CALL ctl_stop( 'passive tracer damping need ln_tradmp to compute damping coef.' )
[5836]214         !
215         !                          ! Read damping coefficients from file
216         !Read in mask from file
217         CALL iom_open ( cn_resto_tr, imask)
218         CALL iom_get  ( imask, jpdom_autoglo, 'resto', restotr)
219         CALL iom_close( imask )
220         !
221      ENDIF
222      !
223   END SUBROUTINE trc_dmp_ini
224
[6140]225
[4148]226   SUBROUTINE trc_dmp_clo( kt )
227      !!---------------------------------------------------------------------
228      !!                  ***  ROUTINE trc_dmp_clo  ***
229      !!
230      !! ** Purpose :   Closed sea domain initialization
231      !!
232      !! ** Method  :   if a closed sea is located only in a model grid point
233      !!                we restore to initial data
234      !!
235      !! ** Action  :   nctsi1(), nctsj1() : south-west closed sea limits (i,j)
236      !!                nctsi2(), nctsj2() : north-east Closed sea limits (i,j)
237      !!----------------------------------------------------------------------
[6607]238      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
[4148]239      !
[6701]240      INTEGER :: ji , jj, jk, jn, jl, jc                    ! dummy loop indicesa
[6607]241      INTEGER :: isrow                                      ! local index
[6701]242      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace
[4148]243      !!----------------------------------------------------------------------
[6607]244
[4148]245      IF( kt == nit000 ) THEN
246         ! initial values
247         nctsi1(:) = 1  ;  nctsi2(:) = 1
248         nctsj1(:) = 1  ;  nctsj2(:) = 1
249
250         ! set the closed seas (in data domain indices)
251         ! -------------------
252
[10213]253         IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA") THEN
[4148]254            !
[7646]255            SELECT CASE ( nn_cfg )
[4148]256            !                                           ! =======================
[5506]257            CASE ( 1 )                                  ! eORCA_R1 configuration
258            !                                           ! =======================
259            isrow = 332 - jpjglo
260            !
[9169]261            nctsi1(1)   = 333  ; nctsj1(1)   = 243 - isrow   ! Caspian Sea
[6607]262            nctsi2(1)   = 342  ; nctsj2(1)   = 274 - isrow
[9169]263            !                                       
264            nctsi1(2)   = 198  ; nctsj1(2)   = 258 - isrow   ! Lake Superior
[6607]265            nctsi2(2)   = 204  ; nctsj2(2)   = 262 - isrow
[9169]266            !                                         
267            nctsi1(3)   = 201  ; nctsj1(3)   = 250 - isrow   ! Lake Michigan
[6607]268            nctsi2(3)   = 203  ; nctsj2(3)   = 256 - isrow
[9169]269            !                                       
270            nctsi1(4)   = 204  ; nctsj1(4)   = 252 - isrow   ! Lake Huron
[6607]271            nctsi2(4)   = 209  ; nctsj2(4)   = 256 - isrow
[9169]272            !                                       
273            nctsi1(5)   = 206  ; nctsj1(5)   = 249 - isrow   ! Lake Erie
[6607]274            nctsi2(5)   = 209  ; nctsj2(5)   = 251 - isrow
[9169]275            !                                       
276            nctsi1(6)   = 210  ; nctsj1(6)   = 252 - isrow   ! Lake Ontario
[6607]277            nctsi2(6)   = 212  ; nctsj2(6)   = 252 - isrow
[9169]278            !                                       
279            nctsi1(7)   = 321  ; nctsj1(7)   = 180 - isrow   ! Victoria Lake
[6607]280            nctsi2(7)   = 322  ; nctsj2(7)   = 189 - isrow
[9169]281            !                                       
282            nctsi1(8)   = 297  ; nctsj1(8)   = 270 - isrow   ! Baltic Sea
[6607]283            nctsi2(8)   = 308  ; nctsj2(8)   = 293 - isrow
[6701]284            !                                       
[5506]285            !                                           ! =======================
[4148]286            CASE ( 2 )                                  !  ORCA_R2 configuration
287               !                                        ! =======================
[9169]288               !                                     
289               nctsi1(1)   =  11  ;  nctsj1(1)   = 103       ! Caspian Sea
[4148]290               nctsi2(1)   =  17  ;  nctsj2(1)   = 112
[9169]291               !                                     
292               nctsi1(2)   =  97  ;  nctsj1(2)   = 107       ! Great North American Lakes
[4148]293               nctsi2(2)   = 103  ;  nctsj2(2)   = 111
[9169]294               !                                     
295               nctsi1(3)   = 174  ;  nctsj1(3)   = 107       ! Black Sea 1 : west part of the Black Sea
[4148]296               nctsi2(3)   = 181  ;  nctsj2(3)   = 112
[9169]297              !                                     
298               nctsi1(4)   =   2  ;  nctsj1(4)   = 107      ! Black Sea 2 : est part of the Black Sea
[4148]299               nctsi2(4)   =   6  ;  nctsj2(4)   = 112
[9169]300               !                                     
301               nctsi1(5)   =  145 ;  nctsj1(5)   = 116       ! Baltic Sea
[4148]302               nctsi2(5)   =  150 ;  nctsj2(5)   = 126
303               !                                        ! =======================
304            CASE ( 4 )                                  !  ORCA_R4 configuration
305               !                                        ! =======================
[9169]306               !                                   
307               nctsi1(1)   =  4  ;  nctsj1(1)   = 53         ! Caspian Sea
[4148]308               nctsi2(1)   =  4  ;  nctsj2(1)   = 56
[9169]309               !                                   
310               nctsi1(2)   = 49  ;  nctsj1(2)   = 55         ! Great North American Lakes
[4148]311               nctsi2(2)   = 51  ;  nctsj2(2)   = 56
[9169]312               !                                   
313               nctsi1(3)   = 88  ;  nctsj1(3)   = 55         ! Black Sea
[4148]314               nctsi2(3)   = 91  ;  nctsj2(3)   = 56
[9169]315               !                                   
316               nctsi1(4)   = 75  ;  nctsj1(4)   = 59         ! Baltic Sea
[4148]317               nctsi2(4)   = 76  ;  nctsj2(4)   = 61
318               !                                        ! =======================
319            CASE ( 025 )                                ! ORCA_R025 configuration
320               !                                        ! =======================
[9169]321               !                                   
322               nctsi1(1)   = 1330 ; nctsj1(1)   = 645        ! Caspian + Aral sea
[4148]323               nctsi2(1)   = 1400 ; nctsj2(1)   = 795
[9169]324               !                                   
325               nctsi1(2)   = 1284 ; nctsj1(2)   = 722        ! Azov Sea
[4148]326               nctsi2(2)   = 1304 ; nctsj2(2)   = 747
327               !
328            END SELECT
329            !
330         ENDIF
331         !
332         ! convert the position in local domain indices
333         ! --------------------------------------------
334         DO jc = 1, npncts
335            nctsi1(jc)   = mi0( nctsi1(jc) )
336            nctsj1(jc)   = mj0( nctsj1(jc) )
[9169]337            !
[4148]338            nctsi2(jc)   = mi1( nctsi2(jc) )
339            nctsj2(jc)   = mj1( nctsj2(jc) )
340         END DO
341         !
342      ENDIF
343
344      ! Restore close seas values to initial data
345      IF( ln_trcdta .AND. nb_trcdta > 0 )  THEN   ! Initialisation of tracer from a file that may also be used for damping
346         !
347         IF(lwp)  WRITE(numout,*)
348         IF(lwp)  WRITE(numout,*) ' trc_dmp_clo : Restoring of nutrients on close seas at time-step kt = ', kt
349         IF(lwp)  WRITE(numout,*)
350         !
[9125]351         ALLOCATE( ztrcdta(jpi,jpj,jpk) )   ! Memory allocation
[6607]352         !
[4148]353         DO jn = 1, jptra
354            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
355                jl = n_trc_index(jn)
[6701]356                CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000
[4148]357                DO jc = 1, npncts
358                   DO jk = 1, jpkm1
359                      DO jj = nctsj1(jc), nctsj2(jc)
360                         DO ji = nctsi1(jc), nctsi2(jc)
[6701]361                            trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk)
[4148]362                            trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
[9169]363                         END DO
364                      END DO
365                   END DO
366                END DO
[4148]367             ENDIF
[9169]368          END DO
[9125]369          DEALLOCATE( ztrcdta )
[4148]370      ENDIF
371      !
372   END SUBROUTINE trc_dmp_clo
[6607]373 
[941]374#else
375   !!----------------------------------------------------------------------
[4148]376   !!  Dummy module :                                     No passive tracer
[941]377   !!----------------------------------------------------------------------
378CONTAINS
379   SUBROUTINE trc_dmp( kt )        ! Empty routine
380      INTEGER, INTENT(in) :: kt
381      WRITE(*,*) 'trc_dmp: You should not have seen this print! error?', kt
382   END SUBROUTINE trc_dmp
383#endif
[4148]384
[941]385   !!======================================================================
386END MODULE trcdmp
Note: See TracBrowser for help on using the repository browser.