source: branches/dev_001_GM/NEMO/TOP_SRC/TRP/trcrad.F90 @ 771

Last change on this file since 771 was 771, checked in by gm, 13 years ago

dev_001_GM - small error corrections

  • 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   !! History :   -   !  01-01  (O. Aumont & E. Kestenare)  Original code
7   !!            1.0  !  04-03  (C. Ethe)  free form F90
8   !!----------------------------------------------------------------------
9#if defined key_passivetrc
10   !!----------------------------------------------------------------------
11   !!   'key_passivetrc'                                    Passive tracers
12   !!----------------------------------------------------------------------
13   !!   trc_rad    : correction of negative concentrations
14   !!----------------------------------------------------------------------
15   USE oce_trc             ! ocean dynamics and tracers variables
16   USE trc                 ! ocean passive tracers variables
17   USE lib_mpp
18   USE prtctl_trc          ! Print control for debbuging
19
20   IMPLICIT NONE
21   PRIVATE
22
23   PUBLIC trc_rad        ! routine called by trcstp.F90
24
25   !! * Substitutions
26#  include "passivetrc_substitute.h90"
27   !!----------------------------------------------------------------------
28   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)
29   !! $Id:$
30   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
31   !!----------------------------------------------------------------------
32   
33CONTAINS
34
35   SUBROUTINE trc_rad( kt )
36      !!----------------------------------------------------------------------
37      !!                  ***  ROUTINE trc_rad  ***
38      !!
39      !! ** Purpose :   "crappy" routine to correct artificial negative
40      !!              concentrations due to isopycnal scheme
41      !!
42      !! ** Method  : - PISCES or LOBSTER: Set negative concentrations to zero
43      !!                while computing the corresponding tracer content that
44      !!                is added to the tracers. Then, adjust the tracer
45      !!                concentration using a multiplicative factor so that
46      !!                the total tracer concentration is preserved.
47      !!              - CFC: simply set to zero the negative CFC concentration
48      !!                (the total CFC content is not strictly preserved)
49      !!----------------------------------------------------------------------
50      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index     
51      !!
52      INTEGER  ::  ji, jj, jk, jn     ! dummy loop indices
53      REAL(wp) :: zvolk, ztrcorb, ztrmasb   ! temporary scalars
54      REAL(wp) :: zcoef, ztrcorn, ztrmasn   !    "         "
55      CHARACTER (len=22) :: charout
56      !!----------------------------------------------------------------------
57
58      IF( kt == nittrc000 ) THEN
59         IF(lwp) WRITE(numout,*)
60         IF(lwp) WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations '
61         IF(lwp) WRITE(numout,*) '~~~~~~~ '
62      ENDIF
63
64      IF( lk_trc_cfc ) THEN                             ! CFC model
65         DO jn = 1, jptra
66            DO jk = 1, jpkm1
67               DO jj = 1, jpj
68                  DO ji = 1, jpi
69                     trn(ji,jj,jk,jn) = MAX( 0. , trn(ji,jj,jk,jn) )
70                     trb(ji,jj,jk,jn) = MAX( 0. , trb(ji,jj,jk,jn) )
71                  END DO
72               END DO
73            END DO
74         END DO
75      ENDIF
76
77      IF( lk_trc_pisces .OR. lk_trc_lobster ) THEN      ! PISCES or LOBSTER bio-model
78         DO jn = 1, jptra
79            ztrcorb = 0.e0
80            ztrmasb = 0.e0
81            ztrcorn = 0.e0
82            ztrmasn = 0.e0
83            DO jk = 1, jpkm1
84               DO jj = 1, jpj
85                  DO ji = 1, jpi
86                     zvolk  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)   &
87# if defined key_off_degrad
88                        &   * facvol(ji,jj,jk)   &
89# endif
90                        &   * tmask(ji,jj,jk) * tmask_i(ji,jj)
91
92                     ztrcorb = ztrcorb + MIN( 0., trb(ji,jj,jk,jn) )  * zvolk
93                     ztrcorn = ztrcorn + MIN( 0., trn(ji,jj,jk,jn) )  * zvolk
94
95                     trb(ji,jj,jk,jn) = MAX( 0. , trb(ji,jj,jk,jn) )
96                     trn(ji,jj,jk,jn) = MAX( 0. , trn(ji,jj,jk,jn) )
97
98                     ztrmasb = ztrmasb + trb(ji,jj,jk,jn) * zvolk
99                     ztrmasn = ztrmasn + trn(ji,jj,jk,jn) * zvolk
100                  END DO
101               END DO
102            END DO
103            IF( lk_mpp ) THEN
104               CALL mpp_sum( ztrcorb )      ! sum over the global domain
105               CALL mpp_sum( ztrcorn )      ! sum over the global domain
106               CALL mpp_sum( ztrmasb )      ! sum over the global domain
107               CALL mpp_sum( ztrmasn )      ! sum over the global domain
108            ENDIF
109
110            IF( ztrcorb /= 0 ) THEN
111               zcoef = 1. + ztrcorb / ztrmasb
112               DO jk = 1, jpkm1
113                  DO jj = 1, jpj
114                     DO ji = 1, jpi
115                         trb(ji,jj,jk,jn) = MAX( 0. , trb(ji,jj,jk,jn) )               !!gm bug already done just above
116                        trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) * zcoef * tmask(ji,jj,jk)
117                     END DO
118                  END DO
119               END DO
120            ENDIF
121
122            IF( ztrcorn /= 0 ) THEN
123               zcoef = 1. + ztrcorn / ztrmasn
124               DO jk = 1, jpkm1
125                  DO jj = 1, jpj
126                     DO ji = 1, jpi
127                        trn(ji,jj,jk,jn) = MAX( 0. , trn(ji,jj,jk,jn) )                !!gm bug already done just above
128                        trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) * zcoef * tmask(ji,jj,jk)
129                     END DO
130                  END DO
131               END DO
132            ENDIF
133            !
134         END DO
135         !
136      ENDIF
137      !
138      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
139         WRITE(charout, FMT="('rad')")
140         CALL prt_ctl_trc_info( charout )
141         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
142      ENDIF
143      !
144   END SUBROUTINE trc_rad
145
146#else
147   !!----------------------------------------------------------------------
148   !!   Dummy module :                                         NO TOP model
149   !!----------------------------------------------------------------------
150CONTAINS
151   SUBROUTINE trc_rad( kt )              ! Empty routine
152      INTEGER, INTENT(in) ::   kt
153      WRITE(*,*) 'trc_rad: You should not have seen this print! error?', kt
154   END SUBROUTINE trc_rad
155#endif
156   
157   !!======================================================================
158END MODULE trcrad
Note: See TracBrowser for help on using the repository browser.