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/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/TOP/PISCES/P4Z – NEMO

source: NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/TOP/PISCES/P4Z/p4zopt.F90 @ 14385

Last change on this file since 14385 was 14385, checked in by cetlod, 4 years ago

dev_r11708_aumont_PISCES_QUOTA : merge with the trunk
  • Property svn:keywords set to Id
File size: 21.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         !  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   !! * Substitutions
41#  include "do_loop_substitute.h90"
42#  include "domzgr_substitute.h90"
43   !!----------------------------------------------------------------------
44   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
45   !! $Id$
46   !! Software governed by the CeCILL license (see ./LICENSE)
47   !!----------------------------------------------------------------------
48CONTAINS
49
50   SUBROUTINE p4z_opt( kt, knt, Kbb, Kmm )
51      !!---------------------------------------------------------------------
52      !!                     ***  ROUTINE p4z_opt  ***
53      !!
54      !! ** Purpose :   Compute the light availability in the water column
55      !!              depending on the depth and the chlorophyll concentration
56      !!
57      !! ** Method  : - ???
58      !!---------------------------------------------------------------------
59      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step
60      INTEGER, INTENT(in) ::   Kbb, Kmm  ! time level indices
61      !
62      INTEGER  ::   ji, jj, jk
63      INTEGER  ::   irgb
64      REAL(wp) ::   zchl
65      REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep
66      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zetmp5
67      REAL(wp), DIMENSION(jpi,jpj    ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4
68      REAL(wp), DIMENSION(jpi,jpj    ) :: zqsr100, zqsr_corr
69      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpar, ze0, ze1, ze2, ze3, zchl3d
70      !!---------------------------------------------------------------------
71      !
72      IF( ln_timing )   CALL timing_start('p4z_opt')
73
74      IF( knt == 1 .AND. ln_varpar )   CALL p4z_opt_sbc( kt )
75
76      !     Initialisation of variables used to compute PAR
77      !     -----------------------------------------------
78      ze1(:,:,:) = 0._wp
79      ze2(:,:,:) = 0._wp
80      ze3(:,:,:) = 0._wp
81      !
82      ! Attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue)
83      ! Thus the light penetration scheme is based on a decomposition of PAR
84      ! into three wave length domains. This was first officially published
85      ! in Lengaigne et al. (2007).
86      ! --------------------------------------------------------
87                     zchl3d(:,:,:) = tr(:,:,:,jpnch,Kbb) + tr(:,:,:,jpdch,Kbb)
88      IF( ln_p5z )   zchl3d(:,:,:) = zchl3d(:,:,:)       + tr(:,:,:,jppch,Kbb)
89      !
90      ! Computation of the light attenuation parameters based on a
91      ! look-up table
92      DO_3D( 1, 1, 1, 1, 1, jpkm1 )
93         zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6
94         zchl = MIN(  10. , MAX( 0.05, zchl )  )
95         irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn )
96         !                                                         
97         ekb(ji,jj,jk) = rkrgb(1,irgb) * e3t(ji,jj,jk,Kmm)
98         ekg(ji,jj,jk) = rkrgb(2,irgb) * e3t(ji,jj,jk,Kmm)
99         ekr(ji,jj,jk) = rkrgb(3,irgb) * e3t(ji,jj,jk,Kmm)
100      END_3D
101
102      ! Photosynthetically Available Radiation (PAR)
103      ! Two cases are considered in the following :
104      ! (1) An explicit diunal cycle is activated. In that case, mean
105      ! QSR is used as PISCES in its current state has not been parameterized
106      ! for an explicit diurnal cycle
107      ! (2) no diurnal cycle of SW is active and in that case, QSR is used.
108      ! --------------------------------------------
109      IF( l_trcdm2dc ) THEN                     !  diurnal cycle
110         !
111          !
112         ! SW over the ice free zone of the grid cell. This assumes that
113         ! SW is zero below sea ice which is a very crude assumption that is
114         ! not fully correct with LIM3 and SI3 but no information is
115         ! currently available to do a better job. SHould be improved in the
116         ! (near) future.
117         zqsr_corr(:,:) = qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn )
118         !
119         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 
120         !
121         ! Used PAR is computed for each phytoplankton species
122         ! etot_ndcy is PAR at level jk averaged over 24h.
123         ! Due to their size, they have different light absorption characteristics
124         DO jk = 1, nksr     
125            etot_ndcy(:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk)
126            enano    (:,:,jk) =  1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk)
127            ediat    (:,:,jk) =  1.62 * ze1(:,:,jk) + 0.74 * ze2(:,:,jk) + 0.63 * ze3(:,:,jk)
128         END DO
129         IF( ln_p5z ) THEN
130            DO jk = 1, nksr     
131              epico  (:,:,jk) =  1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
132            END DO
133         ENDIF
134         !
135         ! SW over the ice free zone of the grid cell. This assumes that
136         ! SW is zero below sea ice which is a very crude assumption that is
137         ! not fully correct with LIM3 and SI3 but no information is
138         ! currently available to do a better job. SHould be improved in the
139         ! (near) future.
140
141         zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn )
142         !
143         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3 ) 
144         !
145         ! Total PAR computation at level jk that includes the diurnal cycle
146         DO jk = 1, nksr     
147            etot(:,:,jk) =  ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
148         END DO
149         !
150      ELSE   ! no diurnal cycle
151         !
152         !
153         ! SW over the ice free zone of the grid cell. This assumes that
154         ! SW is zero below sea ice which is a very crude assumption that is
155         ! not fully correct with LIM3 and SI3 but no information is
156         ! currently available to do a better job. SHould be improved in the
157         ! (near) future.
158         zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn )
159         !
160         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100  ) 
161         !
162
163         ! Used PAR is computed for each phytoplankton species
164         ! Due to their size, they have different light absorption characteristics
165         DO jk = 1, nksr     
166            etot (:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk)    ! Total PAR
167            enano(:,:,jk) =  1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk)  ! Nanophytoplankton
168            ediat(:,:,jk) =  1.62 * ze1(:,:,jk) + 0.74 * ze2(:,:,jk) + 0.63 * ze3(:,:,jk)  ! Diatoms
169         END DO
170         IF( ln_p5z ) THEN
171            DO jk = 1, nksr     
172              epico(:,:,jk) =  1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)  ! Picophytoplankton (PISCES-QUOTA)
173            END DO
174         ENDIF
175         etot_ndcy(:,:,:) =  etot(:,:,:) 
176      ENDIF
177
178
179      ! Biophysical feedback part (computation of vertical penetration of SW)
180      IF( ln_qsr_bio ) THEN                    !* heat flux accros w-level (used in the dynamics)
181         !                                     !  ------------------------
182         CALL p4z_opt_par( kt, Kmm, qsr, ze1, ze2, ze3, pe0=ze0 )
183         !
184         etot3(:,:,1) =  qsr(:,:) * tmask(:,:,1)
185         DO jk = 2, nksr + 1
186            etot3(:,:,jk) =  ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk)
187         END DO
188         !                                     !  ------------------------
189      ENDIF
190     
191      ! Euphotic depth and level
192      ! Two definitions of the euphotic zone are used here.
193      ! (1) The classical definition based on the relative threshold value
194      ! (2) An alternative definition based on a absolute threshold value.
195      ! -------------------------------------------------------------------
196      neln(:,:) = 1
197      heup   (:,:) = gdepw(:,:,2,Kmm)
198      heup_01(:,:) = gdepw(:,:,2,Kmm)
199
200      DO_3D( 1, 1, 1, 1, 2, nksr )
201        IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >=  zqsr100(ji,jj) )  THEN
202           neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer
203           !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint
204           heup(ji,jj) = gdepw(ji,jj,jk+1,Kmm)     ! Euphotic layer depth
205        ENDIF
206        IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.10 )  THEN
207           heup_01(ji,jj) = gdepw(ji,jj,jk+1,Kmm)  ! Euphotic layer depth (light level definition)
208        ENDIF
209      END_3D
210      !
211      ! The euphotic depth can not exceed 300 meters.
212      heup   (:,:) = MIN( 300., heup   (:,:) )
213      heup_01(:,:) = MIN( 300., heup_01(:,:) )
214     
215      ! Mean PAR over the mixed layer
216      ! -----------------------------
217      zdepmoy(:,:)   = 0.e0             
218      zetmp1 (:,:)   = 0.e0
219      zetmp2 (:,:)   = 0.e0
220
221      DO_3D( 1, 1, 1, 1, 1, nksr )
222         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
223            zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! Actual PAR for remineralisation
224            zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! Par averaged over 24h for production
225            zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t(ji,jj,jk,Kmm)
226         ENDIF
227      END_3D
228      !
229      emoy(:,:,:) = etot(:,:,:)       ! remineralisation
230      zpar(:,:,:) = etot_ndcy(:,:,:)  ! diagnostic : PAR with no diurnal cycle
231      !
232      DO_3D( 1, 1, 1, 1, 1, nksr )
233         IF( gdepw(ji,jj,jk+1,Kmm) <= 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         ENDIF
238      END_3D
239
240      ! Computation of the mean usable light for the different phytoplankton
241      ! groups based on their absorption characteristics.
242      zdepmoy(:,:)   = 0.e0
243      zetmp3 (:,:)   = 0.e0
244      zetmp4 (:,:)   = 0.e0
245      !
246      DO_3D( 1, 1, 1, 1, 1, nksr )
247         IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN
248            zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! Nanophytoplankton
249            zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! Diatoms
250            zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t(ji,jj,jk,Kmm)
251         ENDIF
252      END_3D
253      enanom(:,:,:) = enano(:,:,:)
254      ediatm(:,:,:) = ediat(:,:,:)
255      !
256      DO_3D( 1, 1, 1, 1, 1, nksr )
257         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
258            z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
259            enanom(ji,jj,jk) = zetmp3(ji,jj) * z1_dep
260            ediatm(ji,jj,jk) = zetmp4(ji,jj) * z1_dep
261         ENDIF
262      END_3D
263      !
264      IF( ln_p5z ) THEN
265         ! Picophytoplankton when using PISCES-QUOTA
266         ALLOCATE( zetmp5(jpi,jpj) )  ;   zetmp5 (:,:) = 0.e0
267         DO_3D( 1, 1, 1, 1, 1, nksr )
268            IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN
269               zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm)
270            ENDIF
271         END_3D
272         !
273         epicom(:,:,:) = epico(:,:,:)
274         !
275         DO_3D( 1, 1, 1, 1, 1, nksr )
276            IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
277               z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
278               epicom(ji,jj,jk) = zetmp5(ji,jj) * z1_dep
279            ENDIF
280         END_3D
281         DEALLOCATE( zetmp5 )
282      ENDIF
283      !
284      IF( lk_iomput .AND.  knt == nrdttrc ) THEN
285         CALL iom_put( "Heup" , heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht
286         IF( iom_use( "PAR" ) ) THEN
287            zpar(:,:,1) = zpar(:,:,1) * ( 1._wp - fr_i(:,:) )
288            CALL iom_put( "PAR", zpar(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
289         ENDIF
290      ENDIF
291      !
292      IF( ln_timing )   CALL timing_stop('p4z_opt')
293      !
294   END SUBROUTINE p4z_opt
295
296
297   SUBROUTINE p4z_opt_par( kt, Kmm, pqsr, pe1, pe2, pe3, pe0, pqsr100 ) 
298      !!----------------------------------------------------------------------
299      !!                  ***  routine p4z_opt_par  ***
300      !!
301      !! ** purpose :   compute PAR of each wavelength (Red-Green-Blue)
302      !!                for a given shortwave radiation
303      !!
304      !!----------------------------------------------------------------------
305      INTEGER                         , INTENT(in)              ::   kt                ! ocean time-step
306      INTEGER                         , INTENT(in)              ::   Kmm               ! ocean time-index
307      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   )           ::   pqsr              ! shortwave
308      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pe1 , pe2 , pe3   ! PAR ( R-G-B)
309      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL ::   pe0               !
310      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(  out), OPTIONAL ::   pqsr100           !
311      !
312      INTEGER    ::   ji, jj, jk     ! dummy loop indices
313      REAL(wp), DIMENSION(jpi,jpj) ::  zqsr   ! shortwave
314      !!----------------------------------------------------------------------
315
316      !  Real shortwave
317      IF( ln_varpar ) THEN  ;  zqsr(:,:) = par_varsw(:,:) * pqsr(:,:)
318      ELSE                  ;  zqsr(:,:) = xparsw         * pqsr(:,:)
319      ENDIF
320     
321      !  Light at the euphotic depth
322      IF( PRESENT( pqsr100 ) )   pqsr100(:,:) = 0.01 * 3. * zqsr(:,:)
323
324      IF( PRESENT( pe0 ) ) THEN     !  W-level
325         !
326         pe0(:,:,1) = pqsr(:,:) - 3. * zqsr(:,:)    !   ( 1 - 3 * alpha ) * q
327         pe1(:,:,1) = zqsr(:,:)         
328         pe2(:,:,1) = zqsr(:,:)
329         pe3(:,:,1) = zqsr(:,:)
330         !
331         DO jk = 2, nksr + 1
332            DO jj = 1, jpj
333               DO ji = 1, jpi
334                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * xsi0r )
335                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb  (ji,jj,jk-1 )        )
336                  pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg  (ji,jj,jk-1 )        )
337                  pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr  (ji,jj,jk-1 )        )
338               END DO
339              !
340            END DO
341            !
342         END DO
343        !
344      ELSE   ! T- level
345        !
346        pe1(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekb(:,:,1) )
347        pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) )
348        pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) )
349        !
350        DO_3D( 1, 1, 1, 1, 2, nksr )
351           pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) )
352           pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) )
353           pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) )
354        END_3D
355        !
356      ENDIF
357      !
358   END SUBROUTINE p4z_opt_par
359
360
361   SUBROUTINE p4z_opt_sbc( kt )
362      !!----------------------------------------------------------------------
363      !!                  ***  routine p4z_opt_sbc  ***
364      !!
365      !! ** purpose :   read and interpolate the variable PAR fraction
366      !!                of shortwave radiation
367      !!
368      !! ** method  :   read the files and interpolate the appropriate variables
369      !!
370      !! ** input   :   external netcdf files
371      !!
372      !!----------------------------------------------------------------------
373      INTEGER, INTENT(in) ::   kt   ! ocean time step
374      !
375      INTEGER  :: ji,jj
376      REAL(wp) :: zcoef
377      !!---------------------------------------------------------------------
378      !
379      IF( ln_timing )  CALL timing_start('p4z_optsbc')
380      !
381      ! Compute par_varsw at nit000 or only if there is more than 1 time record in par coefficient file
382      IF( ln_varpar ) THEN
383         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_par > 1 ) ) THEN
384            CALL fld_read( kt, 1, sf_par )
385            par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0
386         ENDIF
387      ENDIF
388      !
389      IF( ln_timing )  CALL timing_stop('p4z_optsbc')
390      !
391   END SUBROUTINE p4z_opt_sbc
392
393
394   SUBROUTINE p4z_opt_init
395      !!----------------------------------------------------------------------
396      !!                  ***  ROUTINE p4z_opt_init  ***
397      !!
398      !! ** Purpose :   Initialization of tabulated attenuation coef
399      !!                and of the percentage of PAR in Shortwave
400      !!
401      !! ** Input   :   external ascii and netcdf files
402      !!----------------------------------------------------------------------
403      INTEGER :: numpar, ierr, ios   ! Local integer
404      !
405      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
406      TYPE(FLD_N) ::   sn_par                ! informations about the fields to be read
407      !
408      NAMELIST/nampisopt/cn_dir, sn_par, ln_varpar, parlux
409      !!----------------------------------------------------------------------
410      IF(lwp) THEN
411         WRITE(numout,*)
412         WRITE(numout,*) 'p4z_opt_init : '
413         WRITE(numout,*) '~~~~~~~~~~~~ '
414      ENDIF
415      READ  ( numnatp_ref, nampisopt, IOSTAT = ios, ERR = 901)
416901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisopt in reference namelist' )
417      READ  ( numnatp_cfg, nampisopt, IOSTAT = ios, ERR = 902 )
418902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisopt in configuration namelist' )
419      IF(lwm) WRITE ( numonp, nampisopt )
420
421      IF(lwp) THEN
422         WRITE(numout,*) '   Namelist : nampisopt '
423         WRITE(numout,*) '      PAR as a variable fraction of SW     ln_varpar      = ', ln_varpar
424         WRITE(numout,*) '      Default value for the PAR fraction   parlux         = ', parlux
425      ENDIF
426      !
427      xparsw = parlux / 3.0
428      xsi0r  = 1.e0 / rn_si0
429      !
430      ! Variable PAR at the surface of the ocean
431      ! ----------------------------------------
432      IF( ln_varpar ) THEN
433         IF(lwp) WRITE(numout,*)
434         IF(lwp) WRITE(numout,*) '   ==>>>   initialize variable par fraction (ln_varpar=T)'
435         !
436         ALLOCATE( par_varsw(jpi,jpj) )
437         !
438         ALLOCATE( sf_par(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst
439         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_opt_init: unable to allocate sf_par structure' )
440         !
441         CALL fld_fill( sf_par, (/ sn_par /), cn_dir, 'p4z_opt_init', 'Variable PAR fraction ', 'nampisopt' )
442                                   ALLOCATE( sf_par(1)%fnow(jpi,jpj,1)   )
443         IF( sn_par%ln_tint )      ALLOCATE( sf_par(1)%fdta(jpi,jpj,1,2) )
444
445         CALL iom_open (  TRIM( sn_par%clname ) , numpar )
446         ntimes_par = iom_getszuld( numpar )   ! get number of record in file
447      ENDIF
448      !
449                         ekr      (:,:,:) = 0._wp
450                         ekb      (:,:,:) = 0._wp
451                         ekg      (:,:,:) = 0._wp
452                         etot     (:,:,:) = 0._wp
453                         etot_ndcy(:,:,:) = 0._wp
454                         enano    (:,:,:) = 0._wp
455                         ediat    (:,:,:) = 0._wp
456      IF( ln_p5z     )   epico    (:,:,:) = 0._wp
457      IF( ln_qsr_bio )   etot3    (:,:,:) = 0._wp
458      !
459   END SUBROUTINE p4z_opt_init
460
461
462   INTEGER FUNCTION p4z_opt_alloc()
463      !!----------------------------------------------------------------------
464      !!                     ***  ROUTINE p4z_opt_alloc  ***
465      !!----------------------------------------------------------------------
466      !
467      ALLOCATE( ekb(jpi,jpj,jpk), ekr(jpi,jpj,jpk),  &
468                ekg(jpi,jpj,jpk), STAT= p4z_opt_alloc  ) 
469      !
470      IF( p4z_opt_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_opt_alloc : failed to allocate arrays.' )
471      !
472   END FUNCTION p4z_opt_alloc
473
474   !!======================================================================
475END MODULE p4zopt
Note: See TracBrowser for help on using the repository browser.