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

Last change on this file since 13226 was 13226, checked in by orioltp, 3 months ago

Merging dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation into the trunk

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