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.F90 in branches/dev_001_GM/NEMO/TOP_SRC/PISCES_SMS – NEMO

source: branches/dev_001_GM/NEMO/TOP_SRC/PISCES_SMS/p4zopt.F90 @ 775

Last change on this file since 775 was 775, checked in by gm, 16 years ago

dev_001_GM - PISCES in F90 : encapsulation of all p4z...F files in module F90 + doctor norme for local variables - compilation OK
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 8.4 KB
Line 
1MODULE p4zopt
2   !!======================================================================
3   !!                         ***  MODULE p4zopt  ***
4   !! TOP :   PISCES Compute the light availability in the water column
5   !!======================================================================
6   !! History :   1.0  !  2004     (O. Aumont) Original code
7   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
8   !!----------------------------------------------------------------------
9#if defined key_pisces
10   !!----------------------------------------------------------------------
11   !!   'key_pisces'                                       PISCES bio-model
12   !!----------------------------------------------------------------------
13   !!   p4z_opt        :   Compute the light availability in the water column
14   !!----------------------------------------------------------------------
15   USE oce_trc         !
16   USE trp_trc
17   USE sms
18
19   IMPLICIT NONE
20   PRIVATE
21
22   PUBLIC   p4z_opt   ! called in p4zprg.F90
23
24   !!* Substitution
25#  include "domzgr_substitute.h90"
26   !!----------------------------------------------------------------------
27   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
28   !! $Header:$
29   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
30   !!----------------------------------------------------------------------
31
32CONTAINS
33
34   SUBROUTINE p4z_opt
35      !!---------------------------------------------------------------------
36      !!                     ***  ROUTINE p4z_opt  ***
37      !!
38      !! ** Purpose :   Compute the light availability in the water column
39      !!              depending on the depth and the chlorophyll concentration
40      !!
41      !! ** Method  : - ???
42      !!---------------------------------------------------------------------
43      INTEGER  ::   ji, jj, jk
44      INTEGER  ::   irgb
45      REAL(wp) ::   zchl, zparlux
46      REAL(wp) ::   zrlight , zblight , zglight
47      REAL(wp) ::   zrlight1, zblight1, zglight1
48      REAL(wp), DIMENSION(jpi,jpj)     ::   zdepmoy, zetmp
49      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zekg, zekr, zekb
50      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze1 , ze2 , ze3
51      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3lum, ze4lum
52      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze5lum, ze6lum
53      !!---------------------------------------------------------------------
54
55!     Initialisation of variables used to compute PAR
56!     -----------------------------------------------
57      ze1 (:,:,:) = 0.e0
58      ze2 (:,:,:) = 0.e0
59      ze3 (:,:,:) = 0.e0
60      etot(:,:,:) = 0.e0
61       
62      zparlux = 0.43 / 3.
63
64!    IF activated, computation of the qsr for the dynamics
65!    -----------------------------------------------------
66      IF( ln_qsr_sms ) THEN
67         ze3lum(:,:,:) = 0.e0
68         ze4lum(:,:,:) = 0.e0
69         ze5lum(:,:,:) = 0.e0
70         ze6lum(:,:,:) = 0.e0
71      ENDIF
72
73      DO jk = 1, jpkm1
74         DO jj = 1, jpj
75            DO ji = 1, jpi
76
77!     Separation in three light bands: red, green, blue
78!     -------------------------------------------------
79               zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6
80               zchl = MAX( 0.03, zchl )
81               zchl = MIN( 10. , zchl )
82                                                                               
83               irgb = INT( 41 + 20.* LOG10( zchl ) + rtrn )
84                                                                               
85               zekb(ji,jj,jk) = xkrgb(1,irgb)
86               zekg(ji,jj,jk) = xkrgb(2,irgb)
87               zekr(ji,jj,jk) = xkrgb(3,irgb)
88
89            END DO
90         END DO
91      END DO
92
93      DO jj = 1,jpj
94         DO ji = 1,jpi
95
96!     Separation in three light bands: red, green, blue
97!     -------------------------------------------------
98
99            zblight = 0.5 * zekb(ji,jj,1) * fse3t(ji,jj,1)
100            zglight = 0.5 * zekg(ji,jj,1) * fse3t(ji,jj,1)
101            zrlight = 0.5 * zekr(ji,jj,1) * fse3t(ji,jj,1)
102
103            ze1(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zblight)
104            ze2(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zglight)
105            ze3(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zrlight)
106
107         END DO
108      END DO
109
110      DO jk = 2, jpkm1
111          DO jj = 1, jpj
112            DO ji = 1, jpi
113
114!     Separation in three light bands: red, green, blue
115!     -------------------------------------------------
116
117               zblight = 0.5 * ( zekb(ji,jj,jk-1) * fse3t(ji,jj,jk-1)   &
118                  &            + zekb(ji,jj,jk  ) * fse3t(ji,jj,jk  ) )
119               zglight = 0.5 * ( zekg(ji,jj,jk-1) * fse3t(ji,jj,jk-1)   &
120                  &            + zekg(ji,jj,jk  ) * fse3t(ji,jj,jk  ) )
121               zrlight = 0.5 * ( zekr(ji,jj,jk-1) * fse3t(ji,jj,jk-1)   &
122                  &            + zekr(ji,jj,jk  ) * fse3t(ji,jj,jk  ) )
123
124               ze1(ji,jj,jk) = ze1(ji,jj,jk-1) * EXP(-zblight)
125               ze2(ji,jj,jk) = ze2(ji,jj,jk-1) * EXP(-zglight)
126               ze3(ji,jj,jk) = ze3(ji,jj,jk-1) * EXP(-zrlight)
127
128            END DO
129         END DO
130      END DO
131
132      etot(:,:,:) = ze1(:,:,:) + ze2(:,:,:) + ze3(:,:,:)
133
134      IF( ln_qsr_sms ) THEN
135
136!   In the following, the vertical attenuation of qsr for the dynamics is computed
137!   ------------------------------------------------------------------------------
138
139         DO jj = 1, jpj
140            DO ji = 1, jpi
141
142!     Separation in three light bands: red, green, blue
143!     -------------------------------------------------
144
145               zblight = 0.5 * zekb(ji,jj,1) * fse3t(ji,jj,1)
146               zglight = 0.5 * zekg(ji,jj,1) * fse3t(ji,jj,1)
147               zrlight = 0.5 * zekr(ji,jj,1) * fse3t(ji,jj,1)
148
149               ze3lum(ji,jj,1) = zparlux * qsr(ji,jj)
150               ze4lum(ji,jj,1) = zparlux * qsr(ji,jj)
151               ze5lum(ji,jj,1) = zparlux * qsr(ji,jj)
152               ze6lum(ji,jj,1) = (1.-3. * zparlux) * qsr(ji,jj)
153
154            END DO
155         END DO
156
157         DO jk = 2, jpkm1
158            DO jj = 1, jpj
159               DO ji = 1, jpi
160
161!     Separation in three light bands: red, green, blue
162!     -------------------------------------------------
163
164                  zblight1 = zekb(ji,jj,jk-1) * fse3t(ji,jj,jk-1)
165                  zglight1 = zekg(ji,jj,jk-1) * fse3t(ji,jj,jk-1)
166                  zrlight1 = zekr(ji,jj,jk-1) * fse3t(ji,jj,jk-1)
167
168                  ze3lum(ji,jj,jk) = ze3lum(ji,jj,jk-1) * EXP( -zblight )
169                  ze4lum(ji,jj,jk) = ze4lum(ji,jj,jk-1) * EXP( -zglight )
170                  ze5lum(ji,jj,jk) = ze5lum(ji,jj,jk-1) * EXP( -zrlight )
171                  ze6lum(ji,jj,jk) = ze6lum(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) / xsi1 )
172
173               END DO
174            END DO
175         END DO
176
177         etot3(:,:,:) = ze3lum(:,:,:) + ze4lum(:,:,:) + ze5lum(:,:,:) + ze6lum(:,:,:)
178
179      ENDIF
180
181!     Computation of the euphotic depth
182!     ---------------------------------
183   
184      zmeu(:,:) = 300.e0
185
186      DO jk = 2, jpkm1
187         DO jj = 1, jpj
188            DO ji = 1, jpi
189               IF( etot(ji,jj,jk) >= 0.0043 * qsr(ji,jj) )   zmeu(ji,jj) = fsdepw(ji,jj,jk+1)
190            END DO
191         END DO
192      END DO
193
194      zmeu(:,:) = MIN( 300., zmeu(:,:) )
195
196!    Computation of the mean light over the mixed layer depth
197!    --------------------------------------------------------
198
199      zdepmoy(:,:)   = 0.e0
200      zetmp  (:,:)   = 0.e0
201      emoy   (:,:,:) = 0.e0
202
203      DO jk = 1, jpkm1
204         DO jj = 1, jpj
205            DO ji = 1, jpi
206               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
207                  zetmp  (ji,jj) = zetmp  (ji,jj) + etot(ji,jj,jk) * fse3t(ji,jj,jk)
208                  zdepmoy(ji,jj) = zdepmoy(ji,jj) +                  fse3t(ji,jj,jk)
209               ENDIF
210            END DO
211         END DO
212      END DO
213
214      emoy(:,:,:) = etot(:,:,:)
215
216      DO jk = 1, jpkm1
217         DO jj = 1, jpj
218            DO ji = 1, jpi
219               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
220                  emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn )
221               ENDIF
222            END DO
223         END DO
224      END DO
225
226# if defined key_trc_diaadd
227      trc2d(:,:,11) = zmeu(:,:)
228# endif
229      !
230   END SUBROUTINE p4z_opt
231
232#else
233   !!======================================================================
234   !!  Dummy module :                                   No PISCES bio-model
235   !!======================================================================
236CONTAINS
237   SUBROUTINE p4z_opt                   ! Empty routine
238   END SUBROUTINE p4z_opt
239#endif 
240
241   !!======================================================================
242END MODULE  p4zopt
Note: See TracBrowser for help on using the repository browser.