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

Last change on this file since 1329 was 1329, checked in by cetlod, 15 years ago

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