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

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

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