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

Last change on this file since 719 was 719, checked in by ctlod, 14 years ago

get back to the nemo_v2_3 version for trunk

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