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 trunk/NEMO/TOP_SRC/PISCES – NEMO

source: trunk/NEMO/TOP_SRC/PISCES/p4zopt.F90 @ 1152

Last change on this file since 1152 was 1152, checked in by rblod, 16 years ago

Convert cvs header to svn Id, step II
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 10.5 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 trc
16   USE oce_trc         !
17   USE trc
18   USE sms_pisces
19
20   IMPLICIT NONE
21   PRIVATE
22
23   PUBLIC   p4z_opt 
24
25   !! * Shared module variables
26   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !:
27      etot, enano, ediat,       &  !: PAR for phyto, nano and diat
28      emoy                         !: averaged PAR in the mixed layer
29   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !:
30      heup                         !: Depth of the euphotic zone
31
32   !! * Module variables
33   REAL(wp), DIMENSION(3,61)                ::   &   !:
34      xkrgb                 !: ???
35
36   !!* Substitution
37#  include "domzgr_substitute.h90"
38   !!----------------------------------------------------------------------
39   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
40   !! $Id$
41   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
42   !!----------------------------------------------------------------------
43
44CONTAINS
45
46   SUBROUTINE p4z_opt(kt, jnt)
47      !!---------------------------------------------------------------------
48      !!                     ***  ROUTINE p4z_opt  ***
49      !!
50      !! ** Purpose :   Compute the light availability in the water column
51      !!              depending on the depth and the chlorophyll concentration
52      !!
53      !! ** Method  : - ???
54      !!---------------------------------------------------------------------
55      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
56      INTEGER  ::   ji, jj, jk
57      INTEGER  ::   irgb
58      REAL(wp) ::   zchl, zparlux
59      REAL(wp) ::   zrlight , zblight , zglight
60      REAL(wp), DIMENSION(jpi,jpj)     ::   zdepmoy, zetmp
61      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zekg, zekr, zekb
62      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze1 , ze2 , ze3
63      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3lum, ze4lum
64      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze5lum, ze6lum
65      !!---------------------------------------------------------------------
66
67
68      IF( ( kt * jnt ) == nittrc000  )   CALL p4z_opt_init      ! Initialization (first time-step only)
69
70
71!     Initialisation of variables used to compute PAR
72!     -----------------------------------------------
73      ze1 (:,:,:) = 0.e0
74      ze2 (:,:,:) = 0.e0
75      ze3 (:,:,:) = 0.e0
76      etot(:,:,:) = 0.e0
77       
78      zparlux = 0.43 / 3.
79
80!    IF activated, computation of the qsr for the dynamics
81!    -----------------------------------------------------
82      IF( ln_qsr_sms ) THEN
83         ze3lum(:,:,:) = 0.e0
84         ze4lum(:,:,:) = 0.e0
85         ze5lum(:,:,:) = 0.e0
86         ze6lum(:,:,:) = 0.e0
87      ENDIF
88
89      DO jk = 1, jpkm1
90         DO jj = 1, jpj
91            DO ji = 1, jpi
92
93!     Separation in three light bands: red, green, blue
94!     -------------------------------------------------
95               zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6
96               zchl = MAX( 0.03, zchl )
97               zchl = MIN( 10. , zchl )
98                                                                               
99               irgb = INT( 41 + 20.* LOG10( zchl ) + rtrn )
100                                                                               
101               zekb(ji,jj,jk) = xkrgb(1,irgb)
102               zekg(ji,jj,jk) = xkrgb(2,irgb)
103               zekr(ji,jj,jk) = xkrgb(3,irgb)
104
105            END DO
106         END DO
107      END DO
108
109!CDIR NOVERRCHK
110      DO jj = 1,jpj
111!CDIR NOVERRCHK
112         DO ji = 1,jpi
113
114!     Separation in three light bands: red, green, blue
115!     -------------------------------------------------
116
117            zblight = 0.5 * zekb(ji,jj,1) * fse3t(ji,jj,1)
118            zglight = 0.5 * zekg(ji,jj,1) * fse3t(ji,jj,1)
119            zrlight = 0.5 * zekr(ji,jj,1) * fse3t(ji,jj,1)
120
121            ze1(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zblight)
122            ze2(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zglight)
123            ze3(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zrlight)
124
125         END DO
126      END DO
127
128!CDIR NOVERRCHK
129      DO jk = 2, jpkm1
130!CDIR NOVERRCHK
131          DO jj = 1, jpj
132!CDIR NOVERRCHK
133            DO ji = 1, jpi
134
135!     Separation in three light bands: red, green, blue
136!     -------------------------------------------------
137
138               zblight = 0.5 * ( zekb(ji,jj,jk-1) * fse3t(ji,jj,jk-1)   &
139                  &            + zekb(ji,jj,jk  ) * fse3t(ji,jj,jk  ) )
140               zglight = 0.5 * ( zekg(ji,jj,jk-1) * fse3t(ji,jj,jk-1)   &
141                  &            + zekg(ji,jj,jk  ) * fse3t(ji,jj,jk  ) )
142               zrlight = 0.5 * ( zekr(ji,jj,jk-1) * fse3t(ji,jj,jk-1)   &
143                  &            + zekr(ji,jj,jk  ) * fse3t(ji,jj,jk  ) )
144
145               ze1(ji,jj,jk) = ze1(ji,jj,jk-1) * EXP(-zblight)
146               ze2(ji,jj,jk) = ze2(ji,jj,jk-1) * EXP(-zglight)
147               ze3(ji,jj,jk) = ze3(ji,jj,jk-1) * EXP(-zrlight)
148
149            END DO
150         END DO
151      END DO
152
153      etot(:,:,:) = ze1(:,:,:) + ze2(:,:,:) + ze3(:,:,:)
154      enano(:,:,:) = 2.1 * ze1(:,:,:) + 0.42 * ze2(:,:,:) + 0.4 * ze3(:,:,:)
155      ediat(:,:,:) = 1.6 * ze1(:,:,:) + 0.69 * ze2(:,:,:) + 0.7 * ze3(:,:,:)
156
157
158      IF( ln_qsr_sms ) THEN
159
160!   In the following, the vertical attenuation of qsr for the dynamics is computed
161!   ------------------------------------------------------------------------------
162
163!CDIR NOVERRCHK
164         DO jj = 1, jpj
165!CDIR NOVERRCHK
166            DO ji = 1, jpi
167
168!     Separation in three light bands: red, green, blue
169!     -------------------------------------------------
170
171               zblight = 0.5 * zekb(ji,jj,1) * fse3t(ji,jj,1)
172               zglight = 0.5 * zekg(ji,jj,1) * fse3t(ji,jj,1)
173               zrlight = 0.5 * zekr(ji,jj,1) * fse3t(ji,jj,1)
174
175               ze3lum(ji,jj,1) = zparlux * qsr(ji,jj)
176               ze4lum(ji,jj,1) = zparlux * qsr(ji,jj)
177               ze5lum(ji,jj,1) = zparlux * qsr(ji,jj)
178               ze6lum(ji,jj,1) = (1.-3. * zparlux) * qsr(ji,jj)
179
180            END DO
181         END DO
182
183!CDIR NOVERRCHK
184         DO jk = 2, jpkm1
185!CDIR NOVERRCHK
186            DO jj = 1, jpj
187!CDIR NOVERRCHK
188               DO ji = 1, jpi
189
190!     Separation in three light bands: red, green, blue
191!     -------------------------------------------------
192
193                  zblight = zekb(ji,jj,jk-1) * fse3t(ji,jj,jk-1)
194                  zglight = zekg(ji,jj,jk-1) * fse3t(ji,jj,jk-1)
195                  zrlight = zekr(ji,jj,jk-1) * fse3t(ji,jj,jk-1)
196
197                  ze3lum(ji,jj,jk) = ze3lum(ji,jj,jk-1) * EXP( -zblight )
198                  ze4lum(ji,jj,jk) = ze4lum(ji,jj,jk-1) * EXP( -zglight )
199                  ze5lum(ji,jj,jk) = ze5lum(ji,jj,jk-1) * EXP( -zrlight )
200                  ze6lum(ji,jj,jk) = ze6lum(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) / xsi1 )
201
202               END DO
203            END DO
204         END DO
205
206         etot3(:,:,:) = ze3lum(:,:,:) + ze4lum(:,:,:) + ze5lum(:,:,:) + ze6lum(:,:,:)
207
208      ENDIF
209
210!     Computation of the euphotic depth
211!     ---------------------------------
212   
213      heup(:,:) = 300.e0
214
215      DO jk = 2, jpkm1
216         DO jj = 1, jpj
217            DO ji = 1, jpi
218               IF( etot(ji,jj,jk) >= 0.0043 * qsr(ji,jj) )   heup(ji,jj) = fsdepw(ji,jj,jk+1)
219            END DO
220         END DO
221      END DO
222
223      heup(:,:) = MIN( 300., heup(:,:) )
224
225!    Computation of the mean light over the mixed layer depth
226!    --------------------------------------------------------
227
228      zdepmoy(:,:)   = 0.e0
229      zetmp  (:,:)   = 0.e0
230      emoy   (:,:,:) = 0.e0
231
232      DO jk = 1, jpkm1
233         DO jj = 1, jpj
234            DO ji = 1, jpi
235               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
236                  zetmp  (ji,jj) = zetmp  (ji,jj) + etot(ji,jj,jk) * fse3t(ji,jj,jk)
237                  zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk)
238               ENDIF
239            END DO
240         END DO
241      END DO
242
243      emoy(:,:,:) = etot(:,:,:)
244
245      DO jk = 1, jpkm1
246         DO jj = 1, jpj
247            DO ji = 1, jpi
248               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
249                  emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn )
250               ENDIF
251            END DO
252         END DO
253      END DO
254
255
256# if defined key_trc_diaadd
257      trc2d(:,:,jp_pcs0_2d + 10) = heup(:,:)
258# endif
259      !
260   END SUBROUTINE p4z_opt
261
262   SUBROUTINE p4z_opt_init
263
264      !!----------------------------------------------------------------------
265      !!                  ***  ROUTINE p4z_opt_init  ***
266      !!
267      !! ** Purpose :   Initialization of of the optical scheme
268      !!
269      !! ** Method  :   read the look up table for the optical coefficients
270      !!
271      !! ** input   :   xKRGB61
272      !!
273      !!----------------------------------------------------------------------
274
275      INTEGER :: ichl, iband
276      INTEGER :: numlight
277      REAL(wp) ::   ztoto
278
279      !  FROM THE NEW BIOOPTIC MODEL PROPOSED JM ANDRE, WE READ HERE
280      !  A PRECOMPUTED ARRAY CORRESPONDING TO THE ATTENUATION COEFFICIENT
281
282      CALL ctlopn( numlight, 'kRGB61.txt', 'OLD', 'FORMATTED', 'SEQUENTIAL',   &
283         &           1, numout, .TRUE., 1 )
284
285      DO ichl = 1,61
286         READ(numlight,*) ztoto, ( xkrgb(iband,ichl), iband = 1,3 )
287      END DO
288
289      CLOSE(numlight)
290
291      IF(lwp) THEN                         ! control print
292         WRITE(numout,*) ' '
293         WRITE(numout,*) ' Initialization of the optical look-up table done'
294         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
295      ENDIF
296
297   END SUBROUTINE p4z_opt_init
298
299
300#else
301   !!======================================================================
302   !!  Dummy module :                                   No PISCES bio-model
303   !!======================================================================
304CONTAINS
305   SUBROUTINE p4z_opt                   ! Empty routine
306   END SUBROUTINE p4z_opt
307#endif 
308
309   !!======================================================================
310END MODULE  p4zopt
Note: See TracBrowser for help on using the repository browser.