source: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90 @ 7646

Last change on this file since 7646 was 7646, checked in by timgraham, 5 years ago

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge —reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

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