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/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z – NEMO

Context Navigation

source: branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90 @ 7508

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

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

Download in other formats: