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 NEMO/trunk/src/TOP/PISCES/P4Z – NEMO

source: NEMO/trunk/src/TOP/PISCES/P4Z/p4zopt.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

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