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

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

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