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

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

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