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.
p4zopt.F in trunk/NEMO/TOP_SRC/SMS – NEMO

source: trunk/NEMO/TOP_SRC/SMS/p4zopt.F @ 336

Last change on this file since 336 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.0 KB
Line 
1CCC$Header$
2CCC  TOP 1.0 , LOCEAN-IPSL (2005)
3C This software is governed by CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
4C ---------------------------------------------------------------------------
5CDIR$ LIST
6      SUBROUTINE p4zopt
7#if defined key_passivetrc && defined key_trc_pisces
8CCC---------------------------------------------------------------------
9CCC
10CCC                       ROUTINE p4zopt
11CCC                     *****************
12CCC
13CCC  PURPOSE :
14CCC  ---------
15CCC         Compute the light availability in the water column
16CCC         depending on the depth and the chlorophyll concentration
17CCC
18CC   METHOD :
19CC   -------
20CC     
21CC
22CC   INPUT :
23CC   -----
24CC      argument
25CC              None
26CC      common
27CC              all the common defined in opa
28CC
29CC
30CC   OUTPUT :                   : no
31CC   ------
32CC
33CC   WORKSPACE :
34CC   ---------
35CC
36CC   EXTERNAL :
37CC   --------
38CC
39CC   MODIFICATIONS:
40CC   --------------
41CC      original  : O. Aumont (2002)
42CC----------------------------------------------------------------------
43CC parameters and commons
44CC ======================
45      USE oce_trc
46      USE trp_trc
47      USE sms
48#include "domzgr_substitute.h90"
49CC----------------------------------------------------------------------
50CC local declarations
51CC ==================
52      INTEGER ji, jj, jk, mrgb
53      REAL xchl,ekg,ekr,ekb,xlim1,xlim2,xlim3,xlim4
54      REAL parlux,e1(jpi,jpj,jpk),e2(jpi,jpj,jpk),e3(jpi,jpj,jpk)
55      REAL zdepmoy(jpi,jpj)
56      REAL e3lum(jpi,jpj,jpk),e4lum(jpi,jpj,jpk)
57      REAL e5lum(jpi,jpj,jpk),etmp(jpi,jpj)
58      REAL e6lum(jpi,jpj,jpk)
59
60C     Initialisation of variables used to compute PAR
61C     -----------------------------------------------
62C
63        e1     = 0.
64        e2     = 0.
65        e3     = 0.
66        e3lum  = 0.
67        e4lum  = 0.
68        e5lum  = 0.
69        e6lum  = 0.
70        etot   = 0.
71        etot3  = 0.
72        parlux = 0.43/3.
73C
74        DO jj = 1,jpj
75          DO ji = 1,jpi
76C
77C  Computation of a variable par fraction
78C
79        e1(ji,jj,1)=parlux*qsr(ji,jj)
80        e2(ji,jj,1)=parlux*qsr(ji,jj)
81        e3(ji,jj,1)=parlux*qsr(ji,jj)
82        e3lum(ji,jj,1)=parlux*qsr(ji,jj)
83        e4lum(ji,jj,1)=parlux*qsr(ji,jj)
84        e5lum(ji,jj,1)=parlux*qsr(ji,jj)
85        e6lum(ji,jj,1)=1.-3.*parlux*qsr(ji,jj)
86C
87          END DO
88        END DO
89
90C
91C  Tuning of the iron concentration to a minimum
92C  level that is set to the detection limit
93C  -------------------------------------
94C
95        trn(:,:,:,jpfer)=max(trn(:,:,:,jpfer),1.E-11)
96C
97        DO jk = 1,jpkm1
98          DO jj = 1,jpj
99            DO ji = 1,jpi
100C
101C     Separation in two light bands: red and green
102C     --------------------------------------------
103C   
104        xchl=(trn(ji,jj,jk,jpnch)+trn(ji,jj,jk,jpdch)+rtrn)*1.E6
105        xchl=max(0.01,xchl)
106        xchl=min(10.,xchl)
107
108        mrgb = int(41+20.*log10(xchl)+rtrn)
109
110        ekb=xkrgb(1,mrgb)
111        ekg=xkrgb(2,mrgb)
112        ekr=xkrgb(3,mrgb)
113
114        e1(ji,jj,jk+1) = e1(ji,jj,jk)*exp(-ekb*fse3t(ji,jj,jk)/2.)
115        e2(ji,jj,jk+1) = e2(ji,jj,jk)*exp(-ekg*fse3t(ji,jj,jk)/2.)
116        e3(ji,jj,jk+1) = e3(ji,jj,jk)*exp(-ekr*fse3t(ji,jj,jk)/2.)
117
118
119        etot(ji,jj,jk) = e1(ji,jj,jk+1)+e2(ji,jj,jk+1)+e3(ji,jj,jk+1)
120C   
121C     Computation of irradiance below level T
122C     ---------------------------------------
123C   
124        e1(ji,jj,jk+1) = e1(ji,jj,jk+1)*exp(-ekb*fse3t(ji,jj,jk)/2.)
125        e2(ji,jj,jk+1) = e2(ji,jj,jk+1)*exp(-ekg*fse3t(ji,jj,jk)/2.)
126        e3(ji,jj,jk+1) = e3(ji,jj,jk+1)*exp(-ekr*fse3t(ji,jj,jk)/2.)
127
128        e3lum(ji,jj,jk+1)=e3lum(ji,jj,jk)*exp(-ekb*fse3t(ji,jj,jk))
129        e4lum(ji,jj,jk+1)=e4lum(ji,jj,jk)*exp(-ekg*fse3t(ji,jj,jk))
130        e5lum(ji,jj,jk+1)=e5lum(ji,jj,jk)*exp(-ekr*fse3t(ji,jj,jk))
131        e6lum(ji,jj,jk+1)=e6lum(ji,jj,jk)*exp(-fse3t(ji,jj,jk)/xsi1)
132C
133            END DO
134          END DO
135        END DO
136
137C
138C  modif pour le couplage avec la physique
139C
140        etot3=e3lum+e4lum+e5lum+e6lum
141C
142        DO jk = 1,jpkm1
143          DO jj = 1,jpj
144            DO ji = 1,jpi
145C   
146C      Michaelis-Menten Limitation term for nutrients
147C      Small flagellates
148C      -----------------------------------------------
149C
150        xnanono3(ji,jj,jk)=trn(ji,jj,jk,jpno3)*concnnh4
151     &      /(conc0*concnnh4+concnnh4*trn(ji,jj,jk,jpno3)+
152     &        conc0*trn(ji,jj,jk,jpnh4))
153        xnanonh4(ji,jj,jk)=trn(ji,jj,jk,jpnh4)*conc0
154     &      /(conc0*concnnh4+concnnh4*trn(ji,jj,jk,jpno3)+
155     &        conc0*trn(ji,jj,jk,jpnh4))
156        xlim1=xnanono3(ji,jj,jk)+xnanonh4(ji,jj,jk)
157        xlim2=trn(ji,jj,jk,jppo4)/(trn(ji,jj,jk,jppo4)+conc0)
158        xlim3=trn(ji,jj,jk,jpfer)/(trn(ji,jj,jk,jpfer)+conc2)
159        xlimphy(ji,jj,jk)=min(xlim1,xlim2,xlim3)
160        xlim4=trn(ji,jj,jk,jpdoc)/(trn(ji,jj,jk,jpdoc)+xkdoc2)
161        xlimbac(ji,jj,jk)=min(xlim1,xlim2,xlim3,xlim4)
162C
163            END DO
164          END DO
165        END DO
166C
167        DO jk = 1,jpkm1
168          DO jj = 1,jpj
169            DO ji = 1,jpi
170C     Diatoms
171C     -------
172        xdiatno3(ji,jj,jk)=trn(ji,jj,jk,jpno3)*concdnh4
173     &      /(conc1*concdnh4+concdnh4*trn(ji,jj,jk,jpno3)+
174     &        conc1*trn(ji,jj,jk,jpnh4))
175        xdiatnh4(ji,jj,jk)=trn(ji,jj,jk,jpnh4)*conc1
176     &      /(conc1*concdnh4+concdnh4*trn(ji,jj,jk,jpno3)+
177     &        conc1*trn(ji,jj,jk,jpnh4))
178
179        xlim1=xdiatno3(ji,jj,jk)+xdiatnh4(ji,jj,jk)
180        xlim2=trn(ji,jj,jk,jppo4)/(trn(ji,jj,jk,jppo4)+conc1)
181        xlim3=trn(ji,jj,jk,jpsil)/(trn(ji,jj,jk,jpsil)+xksi(ji,jj))
182        xlim4=trn(ji,jj,jk,jpfer)/(trn(ji,jj,jk,jpfer)+conc3)
183        xlimdia(ji,jj,jk)=min(xlim1,xlim2,xlim3,xlim4)
184C
185            END DO
186          END DO
187        END DO
188C   
189C     Initialisation of the euphotic depth
190C     ------------------------------------
191C   
192        zmeu(:,:)=fsdept(:,:,jkopt+1)
193C   
194C     Computation of the euphotic depth
195C     ---------------------------------
196C   
197        DO jk = 2,jkopt
198          DO jj = 1,jpj
199            DO ji = 1,jpi
200        IF (etot(ji,jj,jk).GE.0.0043*qsr(ji,jj)) THEN
201           zmeu(ji,jj) = fsdepw(ji,jj,jk+1)
202        ENDIF
203            END DO
204          END DO
205        END DO
206C
207C    Computation of the mean light over the mixed layer depth
208C    --------------------------------------------------------
209C
210        zdepmoy  = 0
211        etmp  = 0.
212        emoy  = 0.
213
214        DO jk = 1,jpkm1
215          DO jj = 1,jpj
216            DO ji = 1,jpi
217          etmp(ji,jj) = etmp(ji,jj)+etot(ji,jj,jk)
218     $            *fse3t(ji,jj,jk)*
219     $            (0.5+sign(0.5,(hmld(ji,jj)
220     $            -fsdept(ji,jj,jk))))
221          zdepmoy(ji,jj)=zdepmoy(ji,jj)+
222     $        fse3t(ji,jj,jk)*
223     $        (0.5+sign(0.5,(hmld(ji,jj)
224     $        -fsdept(ji,jj,jk))))
225            END DO
226          END DO
227        END DO
228
229        emoy=etot
230
231        DO jk=1,jpkm1
232          DO jj = 1,jpj
233            DO ji = 1,jpi
234        IF (fsdept(ji,jj,jk).LE.hmld(ji,jj)) THEN
235          emoy(ji,jj,jk) = etmp(ji,jj)/(zdepmoy(ji,jj)+rtrn)
236        ENDIF
237            END DO
238          END DO
239        END DO
240
241#   if defined key_trc_diaadd
242        trc2d(:,:,11) = zmeu(:,:)
243#    endif
244C
245#endif
246      RETURN
247      END
Note: See TracBrowser for help on using the repository browser.