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

Last change on this file since 719 was 719, checked in by ctlod, 17 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: 6.6 KB
Line 
1
2CCC $Header$ 
3CCC  TOP 1.0 , LOCEAN-IPSL (2005) 
4C This software is governed by CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
5C ---------------------------------------------------------------------------
6CDIR$ LIST
7      SUBROUTINE p4zopt
8#if defined key_passivetrc && defined key_trc_pisces
9CCC---------------------------------------------------------------------
10CCC
11CCC             ROUTINE p4zopt : PISCES MODEL
12CCC             *****************************
13CCC
14CCC  PURPOSE :
15CCC  ---------
16CCC         Compute the light availability in the water column
17CCC         depending on the depth and the chlorophyll concentration
18CCC
19CC   INPUT :
20CC   -----
21CC      argument
22CC              None
23CC      common
24CC              all the common defined in opa
25CC
26CC
27CC   OUTPUT :                   : no
28CC   ------
29CC
30CC   MODIFICATIONS:
31CC   --------------
32CC      original  : O. Aumont (2004)
33CC----------------------------------------------------------------------
34CC parameters and commons
35CC ======================
36CDIR$ NOLIST
37      USE oce_trc
38      USE trp_trc
39      USE sms
40      IMPLICIT NONE
41#include "domzgr_substitute.h90"
42CDIR$ LIST
43CC----------------------------------------------------------------------
44CC local declarations
45CC ==================
46      INTEGER ji, jj, jk, mrgb
47      REAL xchl,ekg(jpi,jpj,jpk),ekr(jpi,jpj,jpk),ekb(jpi,jpj,jpk)
48      REAL parlux,e1(jpi,jpj,jpk),e2(jpi,jpj,jpk),e3(jpi,jpj,jpk)
49      REAL zdepmoy(jpi,jpj),etmp(jpi,jpj)
50      REAL zrlight,zblight,zglight
51      REAL zrlight1,zblight1,zglight1
52      REAL e3lum(jpi,jpj,jpk),e4lum(jpi,jpj,jpk)
53      REAL e5lum(jpi,jpj,jpk),e6lum(jpi,jpj,jpk)
54C
55C     Initialisation of variables used to compute PAR
56C     -----------------------------------------------
57C
58        e1     = 0.
59        e2     = 0.
60        e3     = 0.
61        etot   = 0.
62        parlux = 0.43/3.
63
64        IF (ln_qsr_sms) THEN
65C
66C    IF activated, computation of the qsr for the dynamics
67C    -----------------------------------------------------
68C
69          e3lum=0.
70          e4lum=0.
71          e5lum=0.
72          e6lum=0.
73        ENDIF
74
75        DO jk=1,jpkm1
76          DO jj=1,jpj
77            DO ji=1,jpi
78C
79C     Separation in three light bands: red, green, blue
80C     -------------------------------------------------
81C
82        xchl=(trn(ji,jj,jk,jpnch)+trn(ji,jj,jk,jpdch)+rtrn)*1.E6
83        xchl=max(0.03,xchl)
84        xchl=min(10.,xchl)
85                                                                               
86        mrgb = int(41+20.*log10(xchl)+rtrn)
87                                                                               
88        ekb(ji,jj,jk)=xkrgb(1,mrgb)
89        ekg(ji,jj,jk)=xkrgb(2,mrgb)
90        ekr(ji,jj,jk)=xkrgb(3,mrgb)
91C
92            END DO
93          END DO
94        END DO
95C
96          DO jj = 1,jpj
97            DO ji = 1,jpi
98C
99C     Separation in three light bands: red, green, blue
100C     -------------------------------------------------
101C
102        zblight=0.5*ekb(ji,jj,1)*fse3t(ji,jj,1)
103        zglight=0.5*ekg(ji,jj,1)*fse3t(ji,jj,1)
104        zrlight=0.5*ekr(ji,jj,1)*fse3t(ji,jj,1)
105C
106        e1(ji,jj,1) = parlux*qsr(ji,jj)*exp(-zblight)
107        e2(ji,jj,1) = parlux*qsr(ji,jj)*exp(-zglight)
108        e3(ji,jj,1) = parlux*qsr(ji,jj)*exp(-zrlight)
109C
110            END DO
111          END DO
112
113        DO jk = 2,jpkm1
114          DO jj = 1,jpj
115            DO ji = 1,jpi
116C
117C     Separation in three light bands: red, green, blue
118C     -------------------------------------------------
119C
120        zblight=0.5*(ekb(ji,jj,jk-1)*fse3t(ji,jj,jk-1)
121     &    +ekb(ji,jj,jk)*fse3t(ji,jj,jk))
122        zglight=0.5*(ekg(ji,jj,jk-1)*fse3t(ji,jj,jk-1)
123     &    +ekg(ji,jj,jk)*fse3t(ji,jj,jk))
124        zrlight=0.5*(ekr(ji,jj,jk-1)*fse3t(ji,jj,jk-1)
125     &    +ekr(ji,jj,jk)*fse3t(ji,jj,jk))
126C
127        e1(ji,jj,jk) = e1(ji,jj,jk-1)*exp(-zblight)
128        e2(ji,jj,jk) = e2(ji,jj,jk-1)*exp(-zglight)
129        e3(ji,jj,jk) = e3(ji,jj,jk-1)*exp(-zrlight)
130C
131            END DO
132          END DO
133        END DO
134C
135        etot(:,:,:) = e1(:,:,:)+e2(:,:,:)+e3(:,:,:)
136
137        IF (ln_qsr_sms) THEN
138C
139C   In the following, the vertical attenuation of qsr for the 
140C   dynamics is computed
141C   ---------------------------------------------------------
142C
143          DO jj = 1,jpj
144            DO ji = 1,jpi
145C
146C     Separation in three light bands: red, green, blue
147C     -------------------------------------------------
148C
149        zblight=0.5*ekb(ji,jj,1)*fse3t(ji,jj,1)
150        zglight=0.5*ekg(ji,jj,1)*fse3t(ji,jj,1)
151        zrlight=0.5*ekr(ji,jj,1)*fse3t(ji,jj,1)
152C
153        e3lum(ji,jj,1) = parlux*qsr(ji,jj)
154        e4lum(ji,jj,1) = parlux*qsr(ji,jj)
155        e5lum(ji,jj,1) = parlux*qsr(ji,jj)
156        e6lum(ji,jj,1) = (1.-3.*parlux)*qsr(ji,jj)
157C
158            END DO
159          END DO
160
161        DO jk = 2,jpkm1
162          DO jj = 1,jpj
163            DO ji = 1,jpi
164C
165C     Separation in three light bands: red, green, blue
166C     -------------------------------------------------
167C
168        zblight1=ekb(ji,jj,jk-1)*fse3t(ji,jj,jk-1)
169        zglight1=ekg(ji,jj,jk-1)*fse3t(ji,jj,jk-1)
170        zrlight1=ekr(ji,jj,jk-1)*fse3t(ji,jj,jk-1)
171
172        e3lum(ji,jj,jk) = e3lum(ji,jj,jk-1)*exp(-zblight)
173        e4lum(ji,jj,jk) = e4lum(ji,jj,jk-1)*exp(-zglight)
174        e5lum(ji,jj,jk) = e5lum(ji,jj,jk-1)*exp(-zrlight)
175        e6lum(ji,jj,jk) = e6lum(ji,jj,jk-1)
176     &    *exp(-fse3t(ji,jj,jk-1)/xsi1)
177C
178            END DO
179          END DO
180        END DO
181
182        etot3(:,:,:)=e3lum(:,:,:)+e4lum(:,:,:)+e5lum(:,:,:)
183     &    +e6lum(:,:,:)
184
185        ENDIF
186C   
187C     Computation of the euphotic depth
188C     ---------------------------------
189C   
190        zmeu(:,:) = 300.
191
192        DO jk = 2,jpkm1
193          DO jj = 1,jpj
194            DO ji = 1,jpi
195        IF (etot(ji,jj,jk).GE.0.0043*qsr(ji,jj)) THEN
196           zmeu(ji,jj) = fsdepw(ji,jj,jk+1)
197        ENDIF
198            END DO
199          END DO
200        END DO
201C
202        zmeu(:,:)=min(300.,zmeu(:,:))
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         if (fsdepw(ji,jj,jk+1).le.hmld(ji,jj)) then
215       etmp(ji,jj) = etmp(ji,jj)+etot(ji,jj,jk)*fse3t(ji,jj,jk)
216       zdepmoy(ji,jj)=zdepmoy(ji,jj)+fse3t(ji,jj,jk)
217         endif
218            END DO
219          END DO
220        END DO
221
222        emoy(:,:,:) = etot(:,:,:)
223
224        DO jk = 1,jpkm1
225          DO jj = 1,jpj
226            DO ji = 1,jpi
227        IF (fsdepw(ji,jj,jk+1).LE.hmld(ji,jj)) THEN
228          emoy(ji,jj,jk) = etmp(ji,jj)/(zdepmoy(ji,jj)+rtrn)
229        ENDIF
230            END DO
231          END DO
232        END DO
233
234#   if defined key_trc_diaadd
235        trc2d(:,:,11) = zmeu(:,:)
236#    endif
237C
238#endif
239      RETURN
240      END
Note: See TracBrowser for help on using the repository browser.