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

Last change on this file since 1271 was 1271, checked in by rblod, 15 years ago

Addapt AGRIF routines to the new TOP organization, clean some routines and add a sponge layer for passive tracers, see ticket #293
  • 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(:,:)
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.