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

source: NEMO/branches/2019/dev_r11708_aumont_PISCES_QUOTA/src/TOP/PISCES/P4Z/p4zopt.F90 @ 13233

Last change on this file since 13233 was 13233, checked in by aumont, 4 years ago

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