Context Navigation

p4zopt.F90 @ 8003

Last change on this file since 8003 was 8003, checked in by aumont, 7 years ago
modification in the code to remove unnecessary parts such as kriest and non iomput options
File size: 20.9 KB

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

Note: See TracBrowser for help on using the repository browser.

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90 @ 8003

Download in other formats: