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.
trcrad.F90 in trunk/NEMO/TOP_SRC/TRP – NEMO

source: trunk/NEMO/TOP_SRC/TRP/trcrad.F90 @ 941

Last change on this file since 941 was 941, checked in by cetlod, 16 years ago

phasing the passive tracer transport module to the new version of NEMO, see ticket 143
  • Property svn:executable set to *
File size: 6.0 KB
RevLine 
[941]1MODULE trcrad
2   !!======================================================================
3   !!                       ***  MODULE  trcrad  ***
4   !! Ocean passive tracers:  correction of negative concentrations
5   !!======================================================================
6   !! History :   -   !  01-01  (O. Aumont & E. Kestenare)  Original code
7   !!            1.0  !  04-03  (C. Ethe)  free form F90
8   !!----------------------------------------------------------------------
9#if defined key_top
10   !!----------------------------------------------------------------------
11   !!   'key_top'                                                TOP models
12   !!----------------------------------------------------------------------
13   !!   trc_rad    : correction of negative concentrations
14   !!----------------------------------------------------------------------
15   USE oce_trc             ! ocean dynamics and tracers variables
16   USE trc                 ! ocean passive tracers variables
17   USE lib_mpp
18   USE prtctl_trc          ! Print control for debbuging
19
20   IMPLICIT NONE
21   PRIVATE
22
23   PUBLIC trc_rad        ! routine called by trcstp.F90
24
25   !! * Substitutions
26#  include "top_substitute.h90"
27   !!----------------------------------------------------------------------
28   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)
29   !! $Id: trcrad.F90 776 2007-12-19 14:10:14Z gm $
30   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
31   !!----------------------------------------------------------------------
32   
33CONTAINS
34
35   SUBROUTINE trc_rad( kt )
36      !!----------------------------------------------------------------------
37      !!                  ***  ROUTINE trc_rad  ***
38      !!
39      !! ** Purpose :   "crappy" routine to correct artificial negative
40      !!              concentrations due to isopycnal scheme
41      !!
42      !! ** Method  : - PISCES or LOBSTER: Set negative concentrations to zero
43      !!                while computing the corresponding tracer content that
44      !!                is added to the tracers. Then, adjust the tracer
45      !!                concentration using a multiplicative factor so that
46      !!                the total tracer concentration is preserved.
47      !!              - CFC: simply set to zero the negative CFC concentration
48      !!                (the total CFC content is not strictly preserved)
49      !!----------------------------------------------------------------------
50      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index     
51      !!
52      INTEGER  ::  ji, jj, jk, jn     ! dummy loop indices
53      REAL(wp) :: zvolk, ztrcorb, ztrmasb   ! temporary scalars
54      REAL(wp) :: zcoef, ztrcorn, ztrmasn   !    "         "
55      CHARACTER (len=22) :: charout
56      !!----------------------------------------------------------------------
57
58      IF( kt == nittrc000 ) THEN
59         IF(lwp) WRITE(numout,*)
60         IF(lwp) WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations '
61         IF(lwp) WRITE(numout,*) '~~~~~~~ '
62      ENDIF
63
64      IF( lk_cfc ) THEN                         ! CFC model
65         DO jn = 1, jptra
66            DO jk = 1, jpkm1
67               DO jj = 1, jpj
68                  DO ji = 1, jpi
69                     trn(ji,jj,jk,jn) = MAX( 0. , trn(ji,jj,jk,jn) )
70                     trb(ji,jj,jk,jn) = MAX( 0. , trb(ji,jj,jk,jn) )
71                  END DO
72               END DO
73            END DO
74         END DO
75      ENDIF
76
77      IF( lk_pisces .OR. lk_lobster ) THEN      ! PISCES or LOBSTER bio-model
78         DO jn = 1, jptra
79            ztrcorb = 0.e0
80            ztrmasb = 0.e0
81            ztrcorn = 0.e0
82            ztrmasn = 0.e0
83            DO jk = 1, jpkm1
84               DO jj = 1, jpj
85                  DO ji = 1, jpi
86                     zvolk  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)   &
87# if defined key_off_degrad
88                        &   * facvol(ji,jj,jk)   &
89# endif
90                        &   * tmask(ji,jj,jk) * tmask_i(ji,jj)
91
92                     ztrcorb = ztrcorb + MIN( 0., trb(ji,jj,jk,jn) )  * zvolk
93                     ztrcorn = ztrcorn + MIN( 0., trn(ji,jj,jk,jn) )  * zvolk
94
95                     trb(ji,jj,jk,jn) = MAX( 0. , trb(ji,jj,jk,jn) )
96                     trn(ji,jj,jk,jn) = MAX( 0. , trn(ji,jj,jk,jn) )
97
98                     ztrmasb = ztrmasb + trb(ji,jj,jk,jn) * zvolk
99                     ztrmasn = ztrmasn + trn(ji,jj,jk,jn) * zvolk
100                  END DO
101               END DO
102            END DO
103            IF( lk_mpp ) THEN
104               CALL mpp_sum( ztrcorb )      ! sum over the global domain
105               CALL mpp_sum( ztrcorn )      ! sum over the global domain
106               CALL mpp_sum( ztrmasb )      ! sum over the global domain
107               CALL mpp_sum( ztrmasn )      ! sum over the global domain
108            ENDIF
109
110            IF( ztrcorb /= 0 ) THEN
111               zcoef = 1. + ztrcorb / ztrmasb
112               DO jk = 1, jpkm1
113                  trb(:,:,jk,jn) = trb(:,:,jk,jn) * zcoef * tmask(:,:,jk)
114               END DO
115            ENDIF
116
117            IF( ztrcorn /= 0 ) THEN
118               zcoef = 1. + ztrcorn / ztrmasn
119               DO jk = 1, jpkm1
120                  trn(:,:,jk,jn) = trn(:,:,jk,jn) * zcoef * tmask(:,:,jk)
121               END DO
122            ENDIF
123            !
124         END DO
125         !
126      ENDIF
127      !
128      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
129         WRITE(charout, FMT="('rad')")
130         CALL prt_ctl_trc_info( charout )
131         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
132      ENDIF
133      !
134   END SUBROUTINE trc_rad
135
136#else
137   !!----------------------------------------------------------------------
138   !!   Dummy module :                                         NO TOP model
139   !!----------------------------------------------------------------------
140CONTAINS
141   SUBROUTINE trc_rad( kt )              ! Empty routine
142      INTEGER, INTENT(in) ::   kt
143      WRITE(*,*) 'trc_rad: You should not have seen this print! error?', kt
144   END SUBROUTINE trc_rad
145#endif
146   
147   !!======================================================================
148END MODULE trcrad
Note: See TracBrowser for help on using the repository browser.