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

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zopt.F90 @ 12340

Last change on this file since 12340 was 12340, checked in by acc, 4 years ago

Branch 2019/dev_r11943_MERGE_2019. This commit introduces basic do loop macro
substitution to the 2019 option 1, merge branch. These changes have been SETTE
tested. The only addition is the do_loop_substitute.h90 file in the OCE directory but
the macros defined therein are used throughout the code to replace identifiable, 2D-
and 3D- nested loop opening and closing statements with single-line alternatives. Code
indents are also adjusted accordingly.

The following explanation is taken from comments in the new header file:

This header file contains preprocessor definitions and macros used in the do-loop
substitutions introduced between version 4.0 and 4.2. The primary aim of these macros
is to assist in future applications of tiling to improve performance. This is expected
to be achieved by alternative versions of these macros in selected locations. The
initial introduction of these macros simply replaces all identifiable nested 2D- and
3D-loops with single line statements (and adjusts indenting accordingly). Do loops
are identifiable if they comform to either:

DO jk = ....

DO jj = .... DO jj = ...

DO ji = .... DO ji = ...
. OR .
. .

END DO END DO

END DO END DO

END DO

and white-space variants thereof.

Additionally, only loops with recognised jj and ji loops limits are treated; these are:
Lower limits of 1, 2 or fs_2
Upper limits of jpi, jpim1 or fs_jpim1 (for ji) or jpj, jpjm1 or fs_jpjm1 (for jj)

The macro naming convention takes the form: DO_2D_BT_LR where:

B is the Bottom offset from the PE's inner domain;
T is the Top offset from the PE's inner domain;
L is the Left offset from the PE's inner domain;
R is the Right offset from the PE's inner domain

So, given an inner domain of 2,jpim1 and 2,jpjm1, a typical example would replace:

DO jj = 2, jpj

DO ji = 1, jpim1
.
.

END DO

END DO

with:

DO_2D_01_10
.
.
END_2D

similar conventions apply to the 3D loops macros. jk loop limits are retained
through macro arguments and are not restricted. This includes the possibility of
strides for which an extra set of DO_3DS macros are defined.

In the example definition below the inner PE domain is defined by start indices of
(kIs, kJs) and end indices of (kIe, KJe)

#define DO_2D_00_00 DO jj = kJs, kJe ; DO ji = kIs, kIe
#define END_2D END DO ; END DO

TO DO:

Only conventional nested loops have been identified and replaced by this step. There are constructs such as:

DO jk = 2, jpkm1

z2d(:,:) = z2d(:,:) + e3w(:,:,jk,Kmm) * z3d(:,:,jk) * wmask(:,:,jk)

END DO

which may need to be considered.
  • 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 )     ! 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.