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/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z – NEMO

source: branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90 @ 6966

Last change on this file since 6966 was 6966, checked in by aumont, 7 years ago

various bug fixes and updates on carbon chemistry

File size: 21.1 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   !!             3.2  !  2009-04  (C. Ethe, G. Madec)  optimisation
9   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improve light availability of nano & diat
10   !!----------------------------------------------------------------------
11#if defined  key_pisces || defined key_pisces_quota
12   !!----------------------------------------------------------------------
13   !!   'key_pisces*'                                      PISCES bio-model
14   !!----------------------------------------------------------------------
15   !!   p4z_opt       : light availability in the water column
16   !!----------------------------------------------------------------------
17   USE trc            ! tracer variables
18   USE oce_trc        ! tracer-ocean share variables
19   USE sms_pisces     ! Source Minus Sink of PISCES
20   USE iom            ! I/O manager
21   USE fldread         !  time interpolation
22   USE prtctl_trc      !  print control for debugging
23
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   p4z_opt        ! called in p4zbio.F90 module
29   PUBLIC   p4z_opt_init   ! called in trcsms_pisces.F90 module
30   PUBLIC   p4z_opt_alloc
31
32   !! * Shared module variables
33
34   LOGICAL  :: ln_varpar   !: boolean for variable PAR fraction
35   REAL(wp) :: parlux      !: Fraction of shortwave as PAR
36   REAL(wp) :: xparsw                 !: parlux/3
37   REAL(wp) :: xsi0r                 !:  1. /rn_si0
38
39   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_par      ! structure of input par
40   INTEGER , PARAMETER :: nbtimes = 365  !: maximum number of times record in a file
41   INTEGER  :: ntimes_par                ! number of time steps in a file
42   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: par_varsw    !: PAR fraction of shortwave
43
44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: enano, ediat   !: PAR for phyto, nano and diat
45#if defined key_pisces_quota
46   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: epico          !: PAR for pico
47#endif
48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot_ndcy      !: PAR over 24h in case of diurnal cycle
49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy           !: averaged PAR in the mixed layer
50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr  !: wavelength (Red-Green-Blue)
51
52   INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m)
53
54   REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption
55   
56   !!* Substitution
57#  include "top_substitute.h90"
58   !!----------------------------------------------------------------------
59   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
60   !! $Id: p4zopt.F90 3160 2011-11-20 14:27:18Z cetlod $
61   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
62   !!----------------------------------------------------------------------
63CONTAINS
64
65   SUBROUTINE p4z_opt( kt, knt )
66      !!---------------------------------------------------------------------
67      !!                     ***  ROUTINE p4z_opt  ***
68      !!
69      !! ** Purpose :   Compute the light availability in the water column
70      !!              depending on the depth and the chlorophyll concentration
71      !!
72      !! ** Method  : - ???
73      !!---------------------------------------------------------------------
74      !
75      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step
76      !
77      INTEGER  ::   ji, jj, jk
78      INTEGER  ::   irgb
79      REAL(wp) ::   zchl
80      REAL(wp) ::   z1_dep
81      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4, zqsr100, zqsr_corr
82#if defined key_pisces_quota
83      REAL(wp), POINTER, DIMENSION(:,:  ) :: zetmp5
84#endif
85      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3
86      !!---------------------------------------------------------------------
87      !
88      IF( nn_timing == 1 )  CALL timing_start('p4z_opt')
89      !
90      ! Allocate temporary workspace
91      CALL wrk_alloc( jpi, jpj,      zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4, zqsr_corr )
92      CALL wrk_alloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 )
93#if defined key_pisces_quota
94      CALL wrk_alloc( jpi, jpj,      zetmp5 )
95#endif
96
97      IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt )
98
99      !     Initialisation of variables used to compute PAR
100      !     -----------------------------------------------
101      ze1(:,:,:) = 0._wp
102      ze2(:,:,:) = 0._wp
103      ze3(:,:,:) = 0._wp
104      !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue)
105      DO jk = 1, jpkm1                         !  --------------------------------------------------------
106!CDIR NOVERRCHK
107         DO jj = 1, jpj
108!CDIR NOVERRCHK
109            DO ji = 1, jpi
110#if defined key_pisces_quota
111               zchl = ( trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) + trb(ji,jj,jk,jppch) + rtrn ) * 1.e6
112#else
113               zchl = ( trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) + rtrn ) * 1.e6
114#endif
115               zchl = MIN(  10. , MAX( 0.05, zchl )  )
116               irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn )
117               !                                                         
118               ekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk)
119               ekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk)
120               ekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk)
121            END DO
122         END DO
123      END DO
124      !                                        !* Photosynthetically Available Radiation (PAR)
125      !                                        !  --------------------------------------
126      IF( l_trcdm2dc ) THEN                     !  diurnal cycle
127         !
128         zqsr_corr(:,:) = qsr_mean(:,:) / ( 1. - fr_i(:,:) + rtrn )
129         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pe100 = zqsr100 )
130         !
131         DO jk = 1, nksrp     
132            etot_ndcy(:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk)
133            enano    (:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
134            ediat    (:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk)
135#if defined key_pisces_quota
136            epico    (:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
137#endif
138         END DO
139         !
140         zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn )
141         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )
142         !
143         DO jk = 1, nksrp     
144            etot(:,:,jk) =  ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
145         END DO
146         !
147      ELSE
148         !
149         zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn )
150         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pe100 = zqsr100 )
151         !
152         DO jk = 1, nksrp     
153            etot (:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk)
154            enano(:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
155            ediat(:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk)
156#if defined key_pisces_quota
157            epico(:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
158#endif
159         END DO
160         etot_ndcy(:,:,:) =  etot(:,:,:) 
161      ENDIF
162
163
164      IF( ln_qsr_bio ) THEN                    !* heat flux accros w-level (used in the dynamics)
165         !                                     !  ------------------------
166         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 )
167         !
168         etot3(:,:,1) =  qsr(:,:) * tmask(:,:,1)
169         DO jk = 2, nksrp + 1
170            etot3(:,:,jk) =  ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk)
171         END DO
172         !                                     !  ------------------------
173      ENDIF
174      !                                        !* Euphotic depth and level
175      neln(:,:)    = 1                            !  ------------------------
176      heup(:,:)    = fsdepw(:,:,2)
177      heup_01(:,:) = fsdepw(:,:,2)
178
179      DO jk = 2, nksrp
180         DO jj = 1, jpj
181           DO ji = 1, jpi
182              IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) )  THEN
183                 neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer
184                 !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint
185                 heup(ji,jj) = fsdepw(ji,jj,jk+1)      ! Euphotic layer depth
186              ENDIF
187              IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 )  THEN
188                 heup_01(ji,jj) = fsdepw(ji,jj,jk+1)      ! Euphotic layer depth (light level definition)
189              ENDIF
190           END DO
191        END DO
192      END DO
193      !
194      heup(:,:)    = MIN( 300., heup (:,:)   )
195      heup_01(:,:) = MIN( 300., heup_01(:,:) )
196      !                                        !* mean light over the mixed layer
197      zdepmoy(:,:)   = 0.e0                    !  -------------------------------
198      zetmp1 (:,:)   = 0.e0
199      zetmp2 (:,:)   = 0.e0
200      zetmp3 (:,:)   = 0.e0
201      zetmp4 (:,:)   = 0.e0
202#if defined key_pisces_quota
203      zetmp5 (:,:)   = 0.e0
204#endif
205
206      DO jk = 1, nksrp
207!CDIR NOVERRCHK
208         DO jj = 1, jpj
209!CDIR NOVERRCHK
210            DO ji = 1, jpi
211               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
212                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * fse3t(ji,jj,jk) ! remineralisation
213                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * fse3t(ji,jj,jk) ! production
214                  zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * fse3t(ji,jj,jk) ! production
215                  zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * fse3t(ji,jj,jk) ! production
216#if defined key_pisces_quota
217                  zetmp5 (ji,jj) = zetmp5 (ji,jj) + epico    (ji,jj,jk) * fse3t(ji,jj,jk) ! production
218#endif
219                  zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk)
220               ENDIF
221            END DO
222         END DO
223      END DO
224      !
225      emoy(:,:,:) = etot(:,:,:)       ! remineralisation
226      zpar(:,:,:) = etot_ndcy(:,:,:)  ! diagnostic : PAR with no diurnal cycle
227      !
228      DO jk = 1, nksrp
229!CDIR NOVERRCHK
230         DO jj = 1, jpj
231!CDIR NOVERRCHK
232            DO ji = 1, jpi
233               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
234                  z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
235                  emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep
236                  zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep
237                  enano(ji,jj,jk) = zetmp3(ji,jj) * z1_dep
238                  ediat(ji,jj,jk) = zetmp4(ji,jj) * z1_dep
239#if defined key_pisces_quota
240                  epico(ji,jj,jk) = zetmp5(ji,jj) * z1_dep
241#endif
242               ENDIF
243            END DO
244         END DO
245      END DO
246      !
247      IF( lk_iomput ) THEN
248        IF( knt == nrdttrc ) THEN
249           IF( iom_use( "Heup"  ) ) CALL iom_put( "Heup" , heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht
250           IF( iom_use( "PARDM" ) ) CALL iom_put( "PARDM", zpar(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
251           IF( iom_use( "PAR"   ) ) CALL iom_put( "PAR"  , emoy(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
252        ENDIF
253      ELSE
254         IF( ln_diatrc ) THEN        ! save output diagnostics
255            trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1)
256            trc3d(:,:,:,jp_pcs0_3d + 3)  = etot(:,:,:) * tmask(:,:,:)
257         ENDIF
258      ENDIF
259      !
260      CALL wrk_dealloc( jpi, jpj,      zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4, zqsr_corr )
261      CALL wrk_dealloc( jpi, jpj, jpk, zpar,  ze0, ze1, ze2, ze3 )
262#if defined key_pisces_quota
263      CALL wrk_dealloc( jpi, jpj,      zetmp5 )
264#endif
265      !
266      IF( nn_timing == 1 )  CALL timing_stop('p4z_opt')
267      !
268   END SUBROUTINE p4z_opt
269
270   SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0, pe100 ) 
271      !!----------------------------------------------------------------------
272      !!                  ***  routine p4z_opt_par  ***
273      !!
274      !! ** purpose :   compute PAR of each wavelength (Red-Green-Blue)
275      !!                for a given shortwave radiation
276      !!
277      !!----------------------------------------------------------------------
278      !! * arguments
279      INTEGER, INTENT(in)                                       ::  kt            !   ocean time-step
280      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in)              ::  pqsr          !   shortwave
281      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::  pe1 , pe2 , pe3   !  PAR ( R-G-B)
282      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL ::  pe0
283      REAL(wp), DIMENSION(jpi,jpj),     INTENT(inout), OPTIONAL ::  pe100
284      !! * local variables
285      INTEGER    ::   ji, jj, jk     ! dummy loop indices
286      REAL(wp), DIMENSION(jpi,jpj)     ::  zqsr          !   shortwave
287      !!----------------------------------------------------------------------
288
289      !  Real shortwave
290      IF( ln_varpar ) THEN  ;  zqsr(:,:) = par_varsw(:,:) * pqsr(:,:)
291      ELSE                  ;  zqsr(:,:) = xparsw         * pqsr(:,:)
292      ENDIF
293      !
294      IF( PRESENT( pe100 ) ) THEN
295         pe100(:,:) = 3. * 0.01 * zqsr(:,:)
296      ENDIF
297      !
298      IF( PRESENT( pe0 ) ) THEN     !  W-level
299         !
300         pe0(:,:,1) = pqsr(:,:) - 3. * zqsr(:,:)    !   ( 1 - 3 * alpha ) * q
301         pe1(:,:,1) = zqsr(:,:)         
302         pe2(:,:,1) = zqsr(:,:)
303         pe3(:,:,1) = zqsr(:,:)
304         !
305         DO jk = 2, nksrp + 1
306!CDIR NOVERRCHK
307            DO jj = 1, jpj
308!CDIR NOVERRCHK
309               DO ji = 1, jpi
310                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * xsi0r )
311                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb(ji,jj,jk-1 ) )
312                  pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg(ji,jj,jk-1 ) )
313                  pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr(ji,jj,jk-1 ) )
314               END DO
315              !
316            END DO
317            !
318         END DO
319        !
320      ELSE   ! T- level
321        !
322        pe1(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekb(:,:,1) )
323        pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) )
324        pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) )
325        !
326        DO jk = 2, nksrp     
327!CDIR NOVERRCHK
328           DO jj = 1, jpj
329!CDIR NOVERRCHK
330              DO ji = 1, jpi
331                 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) )
332                 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) )
333                 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) )
334              END DO
335           END DO
336        END DO   
337        !
338      ENDIF
339      !
340   END SUBROUTINE p4z_opt_par
341
342
343   SUBROUTINE p4z_opt_sbc( kt )
344      !!----------------------------------------------------------------------
345      !!                  ***  routine p4z_opt_sbc  ***
346      !!
347      !! ** purpose :   read and interpolate the variable PAR fraction
348      !!                of shortwave radiation
349      !!
350      !! ** method  :   read the files and interpolate the appropriate variables
351      !!
352      !! ** input   :   external netcdf files
353      !!
354      !!----------------------------------------------------------------------
355      !! * arguments
356      INTEGER ,                INTENT(in) ::   kt     ! ocean time step
357
358      !! * local declarations
359      INTEGER  :: ji,jj
360      !!---------------------------------------------------------------------
361      !
362      IF( nn_timing == 1 )  CALL timing_start('p4z_optsbc')
363      !
364      ! Compute par_varsw at nit000 or only if there is more than 1 time record in par coefficient file
365      IF( ln_varpar ) THEN
366         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_par > 1 ) ) THEN
367            CALL fld_read( kt, 1, sf_par )
368            par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0
369         ENDIF
370      ENDIF
371      !
372      IF( nn_timing == 1 )  CALL timing_stop('p4z_optsbc')
373      !
374   END SUBROUTINE p4z_opt_sbc
375
376   SUBROUTINE p4z_opt_init
377      !!----------------------------------------------------------------------
378      !!                  ***  ROUTINE p4z_opt_init  ***
379      !!
380      !! ** Purpose :   Initialization of tabulated attenuation coef
381      !!                and of the percentage of PAR in Shortwave
382      !!
383      !! ** Input   :   external ascii and netcdf files
384      !!----------------------------------------------------------------------
385      !
386      INTEGER :: numpar
387      INTEGER :: ierr
388      INTEGER :: ios                 ! Local integer output status for namelist read
389      REAL(wp), DIMENSION(nbtimes) :: zsteps                 ! times records
390      !
391      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
392      TYPE(FLD_N) ::   sn_par                ! informations about the fields to be read
393      !
394      NAMELIST/nampisopt/cn_dir, sn_par, ln_varpar, parlux
395
396      !!----------------------------------------------------------------------
397
398      IF( nn_timing == 1 )  CALL timing_start('p4z_opt_init')
399
400      REWIND( numnatp_ref )              ! Namelist nampisopt in reference namelist : Pisces attenuation coef. and PAR
401      READ  ( numnatp_ref, nampisopt, IOSTAT = ios, ERR = 901)
402901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisopt in reference namelist', lwp )
403
404      REWIND( numnatp_cfg )              ! Namelist nampisopt in configuration namelist : Pisces attenuation coef. and PAR
405      READ  ( numnatp_cfg, nampisopt, IOSTAT = ios, ERR = 902 )
406902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisopt in configuration namelist', lwp )
407      IF(lwm) WRITE ( numonp, nampisopt )
408
409      IF(lwp) THEN
410         WRITE(numout,*) ' '
411         WRITE(numout,*) ' namelist : nampisopt '
412         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ '
413         WRITE(numout,*) '    PAR as a variable fraction of SW     ln_varpar      = ', ln_varpar
414         WRITE(numout,*) '    Default value for the PAR fraction   parlux         = ', parlux
415      ENDIF
416      !
417      xparsw = parlux / 3.0
418      xsi0r  = 1.e0 / rn_si0
419      !
420      ! Variable PAR at the surface of the ocean
421      ! ----------------------------------------
422      IF( ln_varpar ) THEN
423         IF(lwp) WRITE(numout,*) '    initialize variable par fraction '
424         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
425         !
426         ALLOCATE( par_varsw(jpi,jpj) )
427         !
428         ALLOCATE( sf_par(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst
429         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_opt_init: unable to allocate sf_par structure' )
430         !
431         CALL fld_fill( sf_par, (/ sn_par /), cn_dir, 'p4z_opt_init', 'Variable PAR fraction ', 'nampisopt' )
432                                   ALLOCATE( sf_par(1)%fnow(jpi,jpj,1)   )
433         IF( sn_par%ln_tint )      ALLOCATE( sf_par(1)%fdta(jpi,jpj,1,2) )
434
435         CALL iom_open (  TRIM( sn_par%clname ) , numpar )
436         CALL iom_gettime( numpar, zsteps, kntime=ntimes_par)  ! get number of record in file
437      ENDIF
438      !
439      CALL trc_oce_rgb( xkrgb )                  ! tabulated attenuation coefficients
440      nksrp = trc_oce_ext_lev( r_si2, 0.33e2 )     ! max level of light extinction (Blue Chl=0.01)
441      !
442      IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m'
443      !
444                         ekr      (:,:,:) = 0._wp
445                         ekb      (:,:,:) = 0._wp
446                         ekg      (:,:,:) = 0._wp
447                         etot     (:,:,:) = 0._wp
448                         etot_ndcy(:,:,:) = 0._wp
449                         enano    (:,:,:) = 0._wp
450                         ediat    (:,:,:) = 0._wp
451#if defined key_pisces_quota
452                         epico    (:,:,:) = 0._wp
453#endif
454      IF( ln_qsr_bio )   etot3    (:,:,:) = 0._wp
455      !
456      IF( nn_timing == 1 )  CALL timing_stop('p4z_opt_init')
457      !
458   END SUBROUTINE p4z_opt_init
459
460
461   INTEGER FUNCTION p4z_opt_alloc()
462      !!----------------------------------------------------------------------
463      !!                     ***  ROUTINE p4z_opt_alloc  ***
464      !!----------------------------------------------------------------------
465      ALLOCATE( ekb(jpi,jpj,jpk)      , ekr(jpi,jpj,jpk), ekg(jpi,jpj,jpk),   &
466        &       enano(jpi,jpj,jpk)    , ediat(jpi,jpj,jpk), &
467#if defined key_pisces_quota
468        &       epico(jpi,jpj,jpk)    ,                     &
469#endif
470        &       etot_ndcy(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc ) 
471         !
472      IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.')
473      !
474   END FUNCTION p4z_opt_alloc
475
476#else
477   !!----------------------------------------------------------------------
478   !!  Dummy module :                                   No PISCES bio-model
479   !!----------------------------------------------------------------------
480CONTAINS
481   SUBROUTINE p4z_opt                   ! Empty routine
482   END SUBROUTINE p4z_opt
483#endif 
484
485   !!======================================================================
486END MODULE p4zopt
Note: See TracBrowser for help on using the repository browser.