source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90 @ 6793

Last change on this file since 6793 was 6793, checked in by davestorkey, 4 years ago

Merge in changes r6482:6692 from the nemo_v3_6_STABLE branch. Only part that changes results for GO6 configurations is a bug fix for the TVD advection scheme put in at r6692.
Custom merge into /branches/UKMO/dev_r5518_GO6_package/NEMOGCM: r6692 cf. r6688 of /branches/2015/nemo_v3_6_STABLE/NEMOGCM@6791

Custom merge into /branches/UKMO/dev_r5518_GO6_package/NEMOGCM: r6688 cf. r6482 of /branches/2015/nemo_v3_6_STABLE/NEMOGCM@6791

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