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/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zopt.F90 @ 13247

Last change on this file since 13247 was 13247, checked in by francesca, 4 years ago
dev_r12558_HPC-08_epico_Extra_Halo: merge with trunk@13227, see #2366
Property svn:keywords set to `Id`
File size: 19.0 KB

Rev	Line
[3443]	1	MODULE p4zopt
	2	!!======================================================================
	3	!! * MODULE p4zopt *
	4	!! TOP - PISCES : Compute the light availability in the water column
	5	!!======================================================================
[9169]	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
[3443]	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
[9169]	17	USE fldread ! time interpolation
[13176]	18	USE prtctl ! print control for debugging
[3443]	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
[9169]	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
[3443]	33
	34	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_par ! structure of input par
[7970]	35	INTEGER , PARAMETER :: nbtimes = 366 !: maximum number of times record in a file
[3443]	36	INTEGER :: ntimes_par ! number of time steps in a file
[9169]	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)
[3443]	39
	40	INTEGER :: nksrp ! levels below which the light cannot penetrate ( depth larger than 391 m)
	41
[9169]	42	REAL(wp), DIMENSION(3,61) :: xkrgb ! tabulated attenuation coefficients for RGB absorption
[3443]	43
[12377]	44	!! * Substitutions
	45	# include "do_loop_substitute.h90"
[3443]	46	!!----------------------------------------------------------------------
[10067]	47	!! NEMO/TOP 4.0 , NEMO Consortium (2018)
[10069]	48	!! $Id$
[10068]	49	!! Software governed by the CeCILL license (see ./LICENSE)
[3443]	50	!!----------------------------------------------------------------------
	51	CONTAINS
	52
[12377]	53	SUBROUTINE p4z_opt( kt, knt, Kbb, Kmm )
[3443]	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	!!---------------------------------------------------------------------
[5385]	62	INTEGER, INTENT(in) :: kt, knt ! ocean time step
[12377]	63	INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices
[3443]	64	!
	65	INTEGER :: ji, jj, jk
	66	INTEGER :: irgb
[5385]	67	REAL(wp) :: zchl
[3443]	68	REAL(wp) :: zc0 , zc1 , zc2, zc3, z1_dep
[9125]	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
[3443]	73	!!---------------------------------------------------------------------
	74	!
[9169]	75	IF( ln_timing ) CALL timing_start('p4z_opt')
[3443]	76
[9169]	77	IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt )
[3443]	78
	79	! Initialisation of variables used to compute PAR
	80	! -----------------------------------------------
[7753]	81	ze1(:,:,:) = 0._wp
	82	ze2(:,:,:) = 0._wp
	83	ze3(:,:,:) = 0._wp
[7646]	84	!
[3443]	85	! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue)
[9169]	86	! ! --------------------------------------------------------
[12377]	87	zchl3d(:,:,:) = tr(:,:,:,jpnch,Kbb) + tr(:,:,:,jpdch,Kbb)
	88	IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + tr(:,:,:,jppch,Kbb)
[7646]	89	!
[12377]	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
[3443]	99	! !* Photosynthetically Available Radiation (PAR)
	100	! ! --------------------------------------
[5385]	101	IF( l_trcdm2dc ) THEN ! diurnal cycle
	102	!
[9169]	103	zqsr_corr(:,:) = qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn )
[5385]	104	!
[12377]	105	CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )
[6628]	106	!
[5385]	107	DO jk = 1, nksrp
[7753]	108	etot_ndcy(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
[10362]	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)
[5385]	111	END DO
[7646]	112	IF( ln_p5z ) THEN
	113	DO jk = 1, nksrp
[10362]	114	epico (:,:,jk) = 1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
[7646]	115	END DO
	116	ENDIF
[5385]	117	!
[9169]	118	zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn )
[5385]	119	!
[12377]	120	CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3 )
[6628]	121	!
[5385]	122	DO jk = 1, nksrp
[7753]	123	etot(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
[5385]	124	END DO
	125	!
[3443]	126	ELSE
[5385]	127	!
[9169]	128	zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn )
[5385]	129	!
[12377]	130	CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )
[6628]	131	!
[7753]	132	DO jk = 1, nksrp
[12377]	133	etot (:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
[10362]	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)
[5385]	136	END DO
[7646]	137	IF( ln_p5z ) THEN
[7753]	138	DO jk = 1, nksrp
[10362]	139	epico(:,:,jk) = 1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
[7646]	140	END DO
	141	ENDIF
[7753]	142	etot_ndcy(:,:,:) = etot(:,:,:)
[3443]	143	ENDIF
	144
	145
	146	IF( ln_qsr_bio ) THEN !* heat flux accros w-level (used in the dynamics)
	147	! ! ------------------------
[12377]	148	CALL p4z_opt_par( kt, Kmm, qsr, ze1, ze2, ze3, pe0=ze0 )
[3443]	149	!
[7753]	150	etot3(:,:,1) = qsr(:,:) * tmask(:,:,1)
[3443]	151	DO jk = 2, nksrp + 1
[7753]	152	etot3(:,:,jk) = ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk)
[5385]	153	END DO
	154	! ! ------------------------
[3443]	155	ENDIF
	156	! !* Euphotic depth and level
[7753]	157	neln (:,:) = 1 ! ------------------------
[12377]	158	heup (:,:) = gdepw(:,:,2,Kmm)
	159	heup_01(:,:) = gdepw(:,:,2,Kmm)
[3443]	160
[12377]	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
[5385]	171	!
[7753]	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
[3443]	178
[12377]	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
[3443]	186	!
[7753]	187	emoy(:,:,:) = etot(:,:,:) ! remineralisation
	188	zpar(:,:,:) = etot_ndcy(:,:,:) ! diagnostic : PAR with no diurnal cycle
[3443]	189	!
[12377]	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
[5385]	197	!
[10362]	198	zdepmoy(:,:) = 0.e0
	199	zetmp3 (:,:) = 0.e0
	200	zetmp4 (:,:) = 0.e0
	201	!
[12377]	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
[10362]	209	enanom(:,:,:) = enano(:,:,:)
	210	ediatm(:,:,:) = ediat(:,:,:)
	211	!
[12377]	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
[10362]	219	!
[7646]	220	IF( ln_p5z ) THEN
[12276]	221	ALLOCATE( zetmp5(jpi,jpj) ) ; zetmp5 (:,:) = 0.e0
[12377]	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
[10362]	227	!
	228	epicom(:,:,:) = epico(:,:,:)
	229	!
[12377]	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
[12276]	236	DEALLOCATE( zetmp5 )
[7646]	237	ENDIF
[12276]	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
[3443]	243	ENDIF
	244	!
[9169]	245	IF( ln_timing ) CALL timing_stop('p4z_opt')
[3443]	246	!
	247	END SUBROUTINE p4z_opt
	248
[9124]	249
[12377]	250	SUBROUTINE p4z_opt_par( kt, Kmm, pqsr, pe1, pe2, pe3, pe0, pqsr100 )
[3443]	251	!!----------------------------------------------------------------------
[5385]	252	!! * routine p4z_opt_par *
[3443]	253	!!
[5385]	254	!! ** purpose : compute PAR of each wavelength (Red-Green-Blue)
	255	!! for a given shortwave radiation
	256	!!
	257	!!----------------------------------------------------------------------
[9169]	258	INTEGER , INTENT(in) :: kt ! ocean time-step
[12377]	259	INTEGER , INTENT(in) :: Kmm ! ocean time-index
[9169]	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	!
[5385]	265	INTEGER :: ji, jj, jk ! dummy loop indices
[9169]	266	REAL(wp), DIMENSION(jpi,jpj) :: zqsr ! shortwave
[5385]	267	!!----------------------------------------------------------------------
	268
	269	! Real shortwave
[7753]	270	IF( ln_varpar ) THEN ; zqsr(:,:) = par_varsw(:,:) * pqsr(:,:)
	271	ELSE ; zqsr(:,:) = xparsw * pqsr(:,:)
[5385]	272	ENDIF
[6945]	273
	274	! Light at the euphotic depth
[9169]	275	IF( PRESENT( pqsr100 ) ) pqsr100(:,:) = 0.01 * 3. * zqsr(:,:)
[6945]	276
[5385]	277	IF( PRESENT( pe0 ) ) THEN ! W-level
	278	!
[7753]	279	pe0(:,:,1) = pqsr(:,:) - 3. * zqsr(:,:) ! ( 1 - 3 * alpha ) * q
	280	pe1(:,:,1) = zqsr(:,:)
	281	pe2(:,:,1) = zqsr(:,:)
	282	pe3(:,:,1) = zqsr(:,:)
[5385]	283	!
	284	DO jk = 2, nksrp + 1
	285	DO jj = 1, jpj
	286	DO ji = 1, jpi
[12377]	287	pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * xsi0r )
[9169]	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 ) )
[5385]	291	END DO
	292	!
	293	END DO
	294	!
	295	END DO
	296	!
	297	ELSE ! T- level
	298	!
[7753]	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) )
[5385]	302	!
[12377]	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
[5385]	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	!!
[3443]	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	!!----------------------------------------------------------------------
[9169]	326	INTEGER, INTENT(in) :: kt ! ocean time step
[9124]	327	!
[3443]	328	INTEGER :: ji,jj
	329	REAL(wp) :: zcoef
	330	!!---------------------------------------------------------------------
	331	!
[9124]	332	IF( ln_timing ) CALL timing_start('p4z_optsbc')
[3443]	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 )
[5385]	338	par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0
[3443]	339	ENDIF
	340	ENDIF
	341	!
[9124]	342	IF( ln_timing ) CALL timing_stop('p4z_optsbc')
[3443]	343	!
[5385]	344	END SUBROUTINE p4z_opt_sbc
[3443]	345
[9124]	346
[3443]	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	!!----------------------------------------------------------------------
[9169]	356	INTEGER :: numpar, ierr, ios ! Local integer
[3443]	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	!!----------------------------------------------------------------------
[9169]	363	IF(lwp) THEN
	364	WRITE(numout,*)
	365	WRITE(numout,*) 'p4z_opt_init : '
	366	WRITE(numout,*) '~~~~~~~~~~~~ '
	367	ENDIF
[4147]	368	READ ( numnatp_ref, nampisopt, IOSTAT = ios, ERR = 901)
[11536]	369	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisopt in reference namelist' )
[4147]	370	READ ( numnatp_cfg, nampisopt, IOSTAT = ios, ERR = 902 )
[11536]	371	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisopt in configuration namelist' )
[4624]	372	IF(lwm) WRITE ( numonp, nampisopt )
[3443]	373
	374	IF(lwp) THEN
[9169]	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
[3443]	378	ENDIF
	379	!
	380	xparsw = parlux / 3.0
[5385]	381	xsi0r = 1.e0 / rn_si0
[3443]	382	!
	383	! Variable PAR at the surface of the ocean
	384	! ----------------------------------------
	385	IF( ln_varpar ) THEN
[9169]	386	IF(lwp) WRITE(numout,*)
	387	IF(lwp) WRITE(numout,*) ' ==>>> initialize variable par fraction (ln_varpar=T)'
[3443]	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 )
[10522]	399	ntimes_par = iom_getszuld( numpar ) ! get number of record in file
[3443]	400	ENDIF
	401	!
	402	CALL trc_oce_rgb( xkrgb ) ! tabulated attenuation coefficients
[13247]	403	nksrp = trc_oce_ext_lev( r_si2, 0.33e2_wp ) ! max level of light extinction (Blue Chl=0.01)
[3443]	404	!
[4292]	405	IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m'
[3443]	406	!
[7753]	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
[3443]	416	!
	417	END SUBROUTINE p4z_opt_init
	418
	419
	420	INTEGER FUNCTION p4z_opt_alloc()
	421	!!----------------------------------------------------------------------
	422	!! * ROUTINE p4z_opt_alloc *
	423	!!----------------------------------------------------------------------
[7646]	424	!
	425	ALLOCATE( ekb(jpi,jpj,jpk), ekr(jpi,jpj,jpk), &
	426	ekg(jpi,jpj,jpk), STAT= p4z_opt_alloc )
	427	!
[10425]	428	IF( p4z_opt_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_opt_alloc : failed to allocate arrays.' )
[3443]	429	!
	430	END FUNCTION p4z_opt_alloc
	431
	432	!!======================================================================
[5656]	433	END MODULE p4zopt

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

Download in other formats: