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 tags/nemo_v1_04/NEMO/TOP_SRC/TRP – NEMO

source: tags/nemo_v1_04/NEMO/TOP_SRC/TRP/trcrad.F90 @ 2007

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

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