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 branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z – NEMO

source: branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90 @ 9125

Last change on this file since 9125 was 9125, checked in by timgraham, 7 years ago

Removed wrk_arrays from whole code. No change in SETTE results from this.
File size: 19.3 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 3.3 , NEMO Consortium (2010)
46   !! $Id: p4zopt.F90 3160 2011-11-20 14:27:18Z cetlod $
47   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
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      !
74      ! Allocate temporary workspace
75      IF( ln_p5z ) ALLOCATE( zetmp5(jpi,jpj) )
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(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch)
88      IF( ln_p5z )  zchl3d(:,:,:) = zchl3d(:,:,:) + trb(:,:,:,jppch)
89      !
90      DO jk = 1, jpkm1   
91         DO jj = 1, jpj
92            DO ji = 1, jpi
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) = xkrgb(1,irgb) * e3t_n(ji,jj,jk)
98               ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t_n(ji,jj,jk)
99               ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t_n(ji,jj,jk)
100            END DO
101         END DO
102      END DO
103      !                                        !* Photosynthetically Available Radiation (PAR)
104      !                                        !  --------------------------------------
105      IF( l_trcdm2dc ) THEN                     !  diurnal cycle
106         !
107         zqsr_corr(:,:) = qsr_mean(:,:) / ( 1. - fr_i(:,:) + rtrn )
108         !
109         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 
110         !
111         DO jk = 1, nksrp     
112            etot_ndcy(:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk)
113            enano    (:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
114            ediat    (:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk)
115         END DO
116         IF( ln_p5z ) THEN
117            DO jk = 1, nksrp     
118              epico  (:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
119            END DO
120         ENDIF
121         !
122         zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn )
123         !
124         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 ) 
125         !
126         DO jk = 1, nksrp     
127            etot(:,:,jk) =  ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
128         END DO
129         !
130      ELSE
131         !
132         zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn )
133         !
134         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100  ) 
135         !
136         DO jk = 1, nksrp     
137            etot (:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk)
138            enano(:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
139            ediat(:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk)
140         END DO
141         IF( ln_p5z ) THEN
142            DO jk = 1, nksrp     
143              epico(:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
144            END DO
145         ENDIF
146         etot_ndcy(:,:,:) =  etot(:,:,:) 
147      ENDIF
148
149
150      IF( ln_qsr_bio ) THEN                    !* heat flux accros w-level (used in the dynamics)
151         !                                     !  ------------------------
152         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 )
153         !
154         etot3(:,:,1) =  qsr(:,:) * tmask(:,:,1)
155         DO jk = 2, nksrp + 1
156            etot3(:,:,jk) =  ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk)
157         END DO
158         !                                     !  ------------------------
159      ENDIF
160      !                                        !* Euphotic depth and level
161      neln   (:,:) = 1                            !  ------------------------
162      heup   (:,:) = gdepw_n(:,:,2)
163      heup_01(:,:) = gdepw_n(:,:,2)
164
165      DO jk = 2, nksrp
166         DO jj = 1, jpj
167           DO ji = 1, jpi
168              IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >=  zqsr100(ji,jj) )  THEN
169                 neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer
170                 !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint
171                 heup(ji,jj) = gdepw_n(ji,jj,jk+1)     ! Euphotic layer depth
172              ENDIF
173              IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 )  THEN
174                 heup_01(ji,jj) = gdepw_n(ji,jj,jk+1)  ! Euphotic layer depth (light level definition)
175              ENDIF
176           END DO
177        END DO
178      END DO
179      !
180      heup   (:,:) = MIN( 300., heup   (:,:) )
181      heup_01(:,:) = MIN( 300., heup_01(:,:) )
182      !                                        !* mean light over the mixed layer
183      zdepmoy(:,:)   = 0.e0                    !  -------------------------------
184      zetmp1 (:,:)   = 0.e0
185      zetmp2 (:,:)   = 0.e0
186      zetmp3 (:,:)   = 0.e0
187      zetmp4 (:,:)   = 0.e0
188
189      DO jk = 1, nksrp
190         DO jj = 1, jpj
191            DO ji = 1, jpi
192               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
193                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t_n(ji,jj,jk) ! remineralisation
194                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t_n(ji,jj,jk) ! production
195                  zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production
196                  zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production
197                  zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t_n(ji,jj,jk)
198               ENDIF
199            END DO
200         END DO
201      END DO
202      !
203      emoy(:,:,:) = etot(:,:,:)       ! remineralisation
204      zpar(:,:,:) = etot_ndcy(:,:,:)  ! diagnostic : PAR with no diurnal cycle
205      !
206      DO jk = 1, nksrp
207         DO jj = 1, jpj
208            DO ji = 1, jpi
209               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
210                  z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
211                  emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep
212                  zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep
213                  enano(ji,jj,jk) = zetmp3(ji,jj) * z1_dep
214                  ediat(ji,jj,jk) = zetmp4(ji,jj) * z1_dep
215               ENDIF
216            END DO
217         END DO
218      END DO
219      !
220      IF( ln_p5z ) THEN
221         zetmp5 (:,:) = 0.e0
222         DO jk = 1, nksrp
223            DO jj = 1, jpj
224               DO ji = 1, jpi
225                  IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
226                     z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
227                     zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t_n(ji,jj,jk) ! production
228                     epico(ji,jj,jk) = zetmp5(ji,jj) * z1_dep
229                  ENDIF
230               END DO
231            END DO
232         END DO
233      ENDIF
234      IF( lk_iomput ) THEN
235        IF( knt == nrdttrc ) THEN
236           IF( iom_use( "Heup"  ) ) CALL iom_put( "Heup" , heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht
237           IF( iom_use( "PARDM" ) ) CALL iom_put( "PARDM", zpar(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
238           IF( iom_use( "PAR"   ) ) CALL iom_put( "PAR"  , emoy(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
239        ENDIF
240      ENDIF
241      !
242      IF( ln_p5z ) DEALLOCATE( zetmp5 )
243      !
244      IF( ln_timing )  CALL timing_stop('p4z_opt')
245      !
246   END SUBROUTINE p4z_opt
247
248
249   SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0, pqsr100 ) 
250      !!----------------------------------------------------------------------
251      !!                  ***  routine p4z_opt_par  ***
252      !!
253      !! ** purpose :   compute PAR of each wavelength (Red-Green-Blue)
254      !!                for a given shortwave radiation
255      !!
256      !!----------------------------------------------------------------------
257      !! * arguments
258      INTEGER, INTENT(in)                                       ::  kt            !   ocean time-step
259      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in)              ::  pqsr          !   shortwave
260      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::  pe1 , pe2 , pe3   !  PAR ( R-G-B)
261      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL ::  pe0 
262      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(out)  , OPTIONAL  ::  pqsr100 
263      !! * local variables
264      INTEGER    ::   ji, jj, jk     ! dummy loop indices
265      REAL(wp), DIMENSION(jpi,jpj)     ::  zqsr          !   shortwave
266      !!----------------------------------------------------------------------
267
268      !  Real shortwave
269      IF( ln_varpar ) THEN  ;  zqsr(:,:) = par_varsw(:,:) * pqsr(:,:)
270      ELSE                  ;  zqsr(:,:) = xparsw         * pqsr(:,:)
271      ENDIF
272     
273      !  Light at the euphotic depth
274      IF( PRESENT( pqsr100 ) )  pqsr100(:,:) = 0.01 * 3. * zqsr(:,:)
275
276      IF( PRESENT( pe0 ) ) THEN     !  W-level
277         !
278         pe0(:,:,1) = pqsr(:,:) - 3. * zqsr(:,:)    !   ( 1 - 3 * alpha ) * q
279         pe1(:,:,1) = zqsr(:,:)         
280         pe2(:,:,1) = zqsr(:,:)
281         pe3(:,:,1) = zqsr(:,:)
282         !
283         DO jk = 2, nksrp + 1
284            DO jj = 1, jpj
285               DO ji = 1, jpi
286                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t_n(ji,jj,jk-1) * xsi0r )
287                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb(ji,jj,jk-1 ) )
288                  pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg(ji,jj,jk-1 ) )
289                  pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr(ji,jj,jk-1 ) )
290               END DO
291              !
292            END DO
293            !
294         END DO
295        !
296      ELSE   ! T- level
297        !
298        pe1(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekb(:,:,1) )
299        pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) )
300        pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) )
301        !
302        DO jk = 2, nksrp     
303           DO jj = 1, jpj
304              DO ji = 1, jpi
305                 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) )
306                 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) )
307                 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) )
308              END DO
309           END DO
310        END DO   
311        !
312      ENDIF
313      !
314   END SUBROUTINE p4z_opt_par
315
316
317   SUBROUTINE p4z_opt_sbc( kt )
318      !!----------------------------------------------------------------------
319      !!                  ***  routine p4z_opt_sbc  ***
320      !!
321      !! ** purpose :   read and interpolate the variable PAR fraction
322      !!                of shortwave radiation
323      !!
324      !! ** method  :   read the files and interpolate the appropriate variables
325      !!
326      !! ** input   :   external netcdf files
327      !!
328      !!----------------------------------------------------------------------
329      INTEGER ,                INTENT(in) ::   kt     ! ocean time step
330      !
331      INTEGER  :: ji,jj
332      REAL(wp) :: zcoef
333      !!---------------------------------------------------------------------
334      !
335      IF( ln_timing )  CALL timing_start('p4z_optsbc')
336      !
337      ! Compute par_varsw at nit000 or only if there is more than 1 time record in par coefficient file
338      IF( ln_varpar ) THEN
339         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_par > 1 ) ) THEN
340            CALL fld_read( kt, 1, sf_par )
341            par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0
342         ENDIF
343      ENDIF
344      !
345      IF( ln_timing )  CALL timing_stop('p4z_optsbc')
346      !
347   END SUBROUTINE p4z_opt_sbc
348
349
350   SUBROUTINE p4z_opt_init
351      !!----------------------------------------------------------------------
352      !!                  ***  ROUTINE p4z_opt_init  ***
353      !!
354      !! ** Purpose :   Initialization of tabulated attenuation coef
355      !!                and of the percentage of PAR in Shortwave
356      !!
357      !! ** Input   :   external ascii and netcdf files
358      !!----------------------------------------------------------------------
359      INTEGER :: numpar
360      INTEGER :: ierr
361      INTEGER :: ios                 ! Local integer output status for namelist read
362      REAL(wp), DIMENSION(nbtimes) :: zsteps                 ! times records
363      !
364      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
365      TYPE(FLD_N) ::   sn_par                ! informations about the fields to be read
366      !
367      NAMELIST/nampisopt/cn_dir, sn_par, ln_varpar, parlux
368      !!----------------------------------------------------------------------
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_p5z     )   epico    (:,:,:) = 0._wp
422      IF( ln_qsr_bio )   etot3    (:,:,:) = 0._wp
423      !
424   END SUBROUTINE p4z_opt_init
425
426
427   INTEGER FUNCTION p4z_opt_alloc()
428      !!----------------------------------------------------------------------
429      !!                     ***  ROUTINE p4z_opt_alloc  ***
430      !!----------------------------------------------------------------------
431      !
432      ALLOCATE( ekb(jpi,jpj,jpk), ekr(jpi,jpj,jpk),  &
433                ekg(jpi,jpj,jpk), STAT= p4z_opt_alloc  ) 
434      !
435      IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.')
436      !
437   END FUNCTION p4z_opt_alloc
438
439   !!======================================================================
440END MODULE p4zopt
Note: See TracBrowser for help on using the repository browser.