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 @ 247

Last change on this file since 247 was 247, checked in by opalod, 19 years ago

CL : Add CVS Header and CeCILL licence information
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 6.5 KB
Line 
1MODULE trcrad
2   !!======================================================================
3   !!                       ***  MODULE  trcrad  ***
4   !! Ocean passive tracers:  correction of negative concentrations
5   !!======================================================================
6#if defined key_passivetrc
7   !!----------------------------------------------------------------------
8   !!   trc_rad    : correction of negative concentrations
9   !!----------------------------------------------------------------------
10   !! * Modules used
11   USE oce_trc             ! ocean dynamics and tracers variables
12   USE trc                 ! ocean passive tracers variables
13
14   IMPLICIT NONE
15   PRIVATE
16
17   !! * Routine accessibility
18   PUBLIC trc_rad        ! routine called by trcstp.F90
19   !! * Substitutions
20#  include "passivetrc_substitute.h90"
21   !!----------------------------------------------------------------------
22   !!   TOP 1.0 , LOCEAN-IPSL (2005)
23   !! $Header$
24   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
25   !!----------------------------------------------------------------------
26CONTAINS
27
28   SUBROUTINE trc_rad( kt )
29      !!----------------------------------------------------------------------
30      !!                  ***  ROUTINE trc_rad  ***
31      !!
32      !! ** Purpose : "crappy" routine to correct artificial negative
33      !!      concentrations due to isopycnal scheme
34      !!
35      !! ** Method  : Set negative concentrations to zero
36      !!              compute the corresponding mass added to the tracers
37      !!              and remove it when possible
38      !!
39      !! History :
40      !!   8.2  !  01-01  (O. Aumont & E. Kestenare)  Original code
41      !!   9.0  !  04-03  (C. Ethe)  free form F90
42      !!----------------------------------------------------------------------
43      !! * Arguments
44      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
45     
46      !! * Local declarations
47      INTEGER ::  ji, jj, jk, jn             ! dummy loop indices
48      REAL(wp) :: ztra
49#if defined key_trc_hamocc3 || defined key_trc_pisces
50      REAL(wp) :: zvolk, trcorb, trmasb ,trcorn, trmasn 
51#endif
52      !!----------------------------------------------------------------------
53
54      IF( kt == nittrc000 ) THEN
55         IF(lwp) WRITE(numout,*)
56         IF(lwp) WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations '
57         IF(lwp) WRITE(numout,*) '~~~~~~~ '
58      ENDIF
59
60#if defined key_trc_hamocc3
61      DO jn = 1, jptra
62         trcorb = 0.
63         trmasb = 0.
64         trcorn = 0.
65         trmasn = 0.
66         DO jk = 1, jpkm1
67            DO jj = 2, jpjm1
68               DO ji = 2, jpim1
69                  zvolk = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) &
70#if defined key_off_degrad
71                  &  * facvol(ji,jj,jk) &
72#endif
73                  &  * tmask(ji,jj,jk) 
74
75                  trcorb = trcorb + MIN( 0., trb(ji,jj,jk,jn) )  * zvolk
76                  trcorn = trcorn + MIN( 0., trn(ji,jj,jk,jn) )  * zvolk
77
78                  trb(ji,jj,jk,jn) = MAX( 0. , trb(ji,jj,jk,jn) )
79                  trn(ji,jj,jk,jn) = MAX( 0. , trn(ji,jj,jk,jn) )
80
81                  trmasb = trmasb + trb(ji,jj,jk,jn) * zvolk
82                  trmasn = trmasn + trn(ji,jj,jk,jn) * zvolk
83               END DO
84            END DO
85         END DO
86         DO jk = 1, jpkm1
87            DO jj = 1, jpj
88               DO ji = 1, jpi
89                  trb(ji,jj,jk,jn) = MAX( 0., trb(ji,jj,jk,jn) )
90                  trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) * ( 1. + trcorb/trmasb ) * tmask(ji,jj,jk)
91                  trn(ji,jj,jk,jn) = MAX( 0., trn(ji,jj,jk,jn) )
92                  trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) * ( 1. + trcorb/trmasb ) * tmask(ji,jj,jk)
93               END DO
94            END DO
95         END DO
96      END DO
97
98#elif defined key_trc_age || defined key_trc_lobster1
99      DO jn = 1, jptra
100         DO jk = 1, jpkm1
101            DO jj = 1, jpj
102               DO ji = 1, jpi
103                  trn(ji,jj,jk,jn) = MAX( 0. , trn(ji,jj,jk,jn) )
104                  trb(ji,jj,jk,jn) = MAX( 0. , trb(ji,jj,jk,jn) )
105               END DO
106            END DO
107         END DO
108      END DO
109     
110#elif defined key_trc_pisces
111      DO jn = 1, jptra
112         trcorb = 0.
113         trmasb = 0.
114         trcorn = 0.
115         trmasn = 0.
116         DO jk = 1, jpkm1
117            DO jj = 1, jpj
118               DO ji = 1, jpi
119                  zvolk = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) &
120#if defined key_off_degrad
121                  &  * facvol(ji,jj,jk) &
122#endif
123                  &  * tmask(ji,jj,jk) 
124
125                  trcorb = trcorb + MIN( 0., trb(ji,jj,jk,jn) )  * zvolk
126                  trcorn = trcorn + MIN( 0., trn(ji,jj,jk,jn) )  * zvolk
127
128                  trb(ji,jj,jk,jn) = MAX( 0. , trb(ji,jj,jk,jn) )
129                  trn(ji,jj,jk,jn) = MAX( 0. , trn(ji,jj,jk,jn) )
130
131                  trmasb = trmasb + trb(ji,jj,jk,jn) * zvolk
132                  trmasn = trmasn + trn(ji,jj,jk,jn) * zvolk
133               END DO
134            END DO
135         END DO
136
137         IF( trcorb /= 0) THEN
138            DO jk = 1, jpkm1
139               DO jj = 1, jpj
140                  DO ji = 1, jpi
141                     trb(ji,jj,jk,jn) = MAX( 0. , trb(ji,jj,jk,jn) )
142                     trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) * ( 1. + trcorb/trmasb ) * tmask(ji,jj,jk)
143                  END DO
144               END DO
145            END DO
146         ENDIF
147
148         IF( trcorn /= 0) THEN
149            DO jk = 1, jpkm1
150               DO jj = 1, jpj
151                  DO ji = 1, jpi
152                     trn(ji,jj,jk,jn) = MAX( 0. , trn(ji,jj,jk,jn) )
153                     trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) * ( 1. + trcorn/trmasn ) * tmask(ji,jj,jk)
154                  END DO
155               END DO
156            END DO
157         ENDIF
158
159      END DO
160     
161#endif
162      DO jn = 1, jptra
163         IF(l_ctl) THEN         ! print mean field (used for debugging)
164            ztra = SUM( trn(2:nictl,2:njctl,1:jpkm1,jn) * tmask(2:nictl,2:njctl,1:jpkm1) ) 
165            WRITE(numout,*) ' trc/rad  - ',ctrcnm(jn),' : ', ztra
166         ENDIF
167      ENDDO
168
169     
170   END SUBROUTINE trc_rad
171
172#else
173   !!----------------------------------------------------------------------
174   !!   Dummy module :                      NO passive tracer
175   !!----------------------------------------------------------------------
176CONTAINS
177   SUBROUTINE trc_rad (kt )              ! Empty routine
178      INTEGER, INTENT(in) :: kt
179      WRITE(*,*) 'trc_rad: You should not have seen this print! error?', kt
180   END SUBROUTINE trc_rad
181#endif
182   
183   !!======================================================================
184END MODULE trcrad
Note: See TracBrowser for help on using the repository browser.