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

Context Navigation

source: NEMO/trunk/src/TOP/PISCES/P4Z/p4zopt.F90 @ 13295

Last change on this file since 13295 was 13295, checked in by acc, 4 years ago
Replace do-loop macros in the trunk with alternative forms with greater flexibility for extra halo applications. This alters a lot of routines but does not change any behaviour or results. do_loop_substitute.h90 is greatly simplified by this change. SETTE results are identical to those with the previous revision
Property svn:keywords set to `Id`
File size: 19.1 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
[13286]	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"
[13237]	46	# include "domzgr_substitute.h90"
[3443]	47	!!----------------------------------------------------------------------
[10067]	48	!! NEMO/TOP 4.0 , NEMO Consortium (2018)
[10069]	49	!! $Id$
[10068]	50	!! Software governed by the CeCILL license (see ./LICENSE)
[3443]	51	!!----------------------------------------------------------------------
	52	CONTAINS
	53
[12377]	54	SUBROUTINE p4z_opt( kt, knt, Kbb, Kmm )
[3443]	55	!!---------------------------------------------------------------------
	56	!! * ROUTINE p4z_opt *
	57	!!
	58	!! ** Purpose : Compute the light availability in the water column
	59	!! depending on the depth and the chlorophyll concentration
	60	!!
	61	!! ** Method : - ???
	62	!!---------------------------------------------------------------------
[5385]	63	INTEGER, INTENT(in) :: kt, knt ! ocean time step
[12377]	64	INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices
[3443]	65	!
	66	INTEGER :: ji, jj, jk
	67	INTEGER :: irgb
[5385]	68	REAL(wp) :: zchl
[3443]	69	REAL(wp) :: zc0 , zc1 , zc2, zc3, z1_dep
[9125]	70	REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zetmp5
	71	REAL(wp), DIMENSION(jpi,jpj ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4
	72	REAL(wp), DIMENSION(jpi,jpj ) :: zqsr100, zqsr_corr
	73	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpar, ze0, ze1, ze2, ze3, zchl3d
[3443]	74	!!---------------------------------------------------------------------
	75	!
[9169]	76	IF( ln_timing ) CALL timing_start('p4z_opt')
[3443]	77
[9169]	78	IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt )
[3443]	79
	80	! Initialisation of variables used to compute PAR
	81	! -----------------------------------------------
[7753]	82	ze1(:,:,:) = 0._wp
	83	ze2(:,:,:) = 0._wp
	84	ze3(:,:,:) = 0._wp
[7646]	85	!
[3443]	86	! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue)
[9169]	87	! ! --------------------------------------------------------
[12377]	88	zchl3d(:,:,:) = tr(:,:,:,jpnch,Kbb) + tr(:,:,:,jpdch,Kbb)
	89	IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + tr(:,:,:,jppch,Kbb)
[7646]	90	!
[13295]	91	DO_3D( 1, 1, 1, 1, 1, jpkm1 )
[12377]	92	zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6
	93	zchl = MIN( 10. , MAX( 0.05, zchl ) )
	94	irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn )
	95	!
	96	ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t(ji,jj,jk,Kmm)
	97	ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t(ji,jj,jk,Kmm)
	98	ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t(ji,jj,jk,Kmm)
	99	END_3D
[3443]	100	! !* Photosynthetically Available Radiation (PAR)
	101	! ! --------------------------------------
[5385]	102	IF( l_trcdm2dc ) THEN ! diurnal cycle
	103	!
[9169]	104	zqsr_corr(:,:) = qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn )
[5385]	105	!
[12377]	106	CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )
[6628]	107	!
[5385]	108	DO jk = 1, nksrp
[7753]	109	etot_ndcy(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
[10362]	110	enano (:,:,jk) = 1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk)
	111	ediat (:,:,jk) = 1.62 * ze1(:,:,jk) + 0.74 * ze2(:,:,jk) + 0.63 * ze3(:,:,jk)
[5385]	112	END DO
[7646]	113	IF( ln_p5z ) THEN
	114	DO jk = 1, nksrp
[10362]	115	epico (:,:,jk) = 1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
[7646]	116	END DO
	117	ENDIF
[5385]	118	!
[9169]	119	zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn )
[5385]	120	!
[12377]	121	CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3 )
[6628]	122	!
[5385]	123	DO jk = 1, nksrp
[7753]	124	etot(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
[5385]	125	END DO
	126	!
[3443]	127	ELSE
[5385]	128	!
[9169]	129	zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn )
[5385]	130	!
[12377]	131	CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )
[6628]	132	!
[7753]	133	DO jk = 1, nksrp
[12377]	134	etot (:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
[10362]	135	enano(:,:,jk) = 1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk)
	136	ediat(:,:,jk) = 1.62 * ze1(:,:,jk) + 0.74 * ze2(:,:,jk) + 0.63 * ze3(:,:,jk)
[5385]	137	END DO
[7646]	138	IF( ln_p5z ) THEN
[7753]	139	DO jk = 1, nksrp
[10362]	140	epico(:,:,jk) = 1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
[7646]	141	END DO
	142	ENDIF
[7753]	143	etot_ndcy(:,:,:) = etot(:,:,:)
[3443]	144	ENDIF
	145
	146
	147	IF( ln_qsr_bio ) THEN !* heat flux accros w-level (used in the dynamics)
	148	! ! ------------------------
[12377]	149	CALL p4z_opt_par( kt, Kmm, qsr, ze1, ze2, ze3, pe0=ze0 )
[3443]	150	!
[7753]	151	etot3(:,:,1) = qsr(:,:) * tmask(:,:,1)
[3443]	152	DO jk = 2, nksrp + 1
[7753]	153	etot3(:,:,jk) = ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk)
[5385]	154	END DO
	155	! ! ------------------------
[3443]	156	ENDIF
	157	! !* Euphotic depth and level
[7753]	158	neln (:,:) = 1 ! ------------------------
[12377]	159	heup (:,:) = gdepw(:,:,2,Kmm)
	160	heup_01(:,:) = gdepw(:,:,2,Kmm)
[3443]	161
[13295]	162	DO_3D( 1, 1, 1, 1, 2, nksrp )
[12377]	163	IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) ) THEN
	164	neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer
	165	! ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint
	166	heup(ji,jj) = gdepw(ji,jj,jk+1,Kmm) ! Euphotic layer depth
	167	ENDIF
	168	IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 ) THEN
	169	heup_01(ji,jj) = gdepw(ji,jj,jk+1,Kmm) ! Euphotic layer depth (light level definition)
	170	ENDIF
	171	END_3D
[5385]	172	!
[7753]	173	heup (:,:) = MIN( 300., heup (:,:) )
	174	heup_01(:,:) = MIN( 300., heup_01(:,:) )
	175	! !* mean light over the mixed layer
	176	zdepmoy(:,:) = 0.e0 ! -------------------------------
	177	zetmp1 (:,:) = 0.e0
	178	zetmp2 (:,:) = 0.e0
[3443]	179
[13295]	180	DO_3D( 1, 1, 1, 1, 1, nksrp )
[12377]	181	IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
	182	zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! remineralisation
	183	zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production
	184	zdepmoy(ji,jj) = zdepmoy(ji,jj) + e3t(ji,jj,jk,Kmm)
	185	ENDIF
	186	END_3D
[3443]	187	!
[7753]	188	emoy(:,:,:) = etot(:,:,:) ! remineralisation
	189	zpar(:,:,:) = etot_ndcy(:,:,:) ! diagnostic : PAR with no diurnal cycle
[3443]	190	!
[13295]	191	DO_3D( 1, 1, 1, 1, 1, nksrp )
[12377]	192	IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
	193	z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
	194	emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep
	195	zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep
	196	ENDIF
	197	END_3D
[5385]	198	!
[10362]	199	zdepmoy(:,:) = 0.e0
	200	zetmp3 (:,:) = 0.e0
	201	zetmp4 (:,:) = 0.e0
	202	!
[13295]	203	DO_3D( 1, 1, 1, 1, 1, nksrp )
[12377]	204	IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN
	205	zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production
	206	zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production
	207	zdepmoy(ji,jj) = zdepmoy(ji,jj) + e3t(ji,jj,jk,Kmm)
	208	ENDIF
	209	END_3D
[10362]	210	enanom(:,:,:) = enano(:,:,:)
	211	ediatm(:,:,:) = ediat(:,:,:)
	212	!
[13295]	213	DO_3D( 1, 1, 1, 1, 1, nksrp )
[12377]	214	IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
	215	z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
	216	enanom(ji,jj,jk) = zetmp3(ji,jj) * z1_dep
	217	ediatm(ji,jj,jk) = zetmp4(ji,jj) * z1_dep
	218	ENDIF
	219	END_3D
[10362]	220	!
[7646]	221	IF( ln_p5z ) THEN
[12276]	222	ALLOCATE( zetmp5(jpi,jpj) ) ; zetmp5 (:,:) = 0.e0
[13295]	223	DO_3D( 1, 1, 1, 1, 1, nksrp )
[12377]	224	IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN
	225	zetmp5(ji,jj) = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production
	226	ENDIF
	227	END_3D
[10362]	228	!
	229	epicom(:,:,:) = epico(:,:,:)
	230	!
[13295]	231	DO_3D( 1, 1, 1, 1, 1, nksrp )
[12377]	232	IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
	233	z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
	234	epicom(ji,jj,jk) = zetmp5(ji,jj) * z1_dep
	235	ENDIF
	236	END_3D
[12276]	237	DEALLOCATE( zetmp5 )
[7646]	238	ENDIF
[12276]	239	!
	240	IF( lk_iomput .AND. knt == nrdttrc ) THEN
	241	CALL iom_put( "Heup" , heup(:,: ) * tmask(:,:,1) ) ! euphotic layer deptht
	242	CALL iom_put( "PARDM", zpar(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation
	243	CALL iom_put( "PAR" , emoy(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation
[3443]	244	ENDIF
	245	!
[9169]	246	IF( ln_timing ) CALL timing_stop('p4z_opt')
[3443]	247	!
	248	END SUBROUTINE p4z_opt
	249
[9124]	250
[12377]	251	SUBROUTINE p4z_opt_par( kt, Kmm, pqsr, pe1, pe2, pe3, pe0, pqsr100 )
[3443]	252	!!----------------------------------------------------------------------
[5385]	253	!! * routine p4z_opt_par *
[3443]	254	!!
[5385]	255	!! ** purpose : compute PAR of each wavelength (Red-Green-Blue)
	256	!! for a given shortwave radiation
	257	!!
	258	!!----------------------------------------------------------------------
[9169]	259	INTEGER , INTENT(in) :: kt ! ocean time-step
[12377]	260	INTEGER , INTENT(in) :: Kmm ! ocean time-index
[9169]	261	REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pqsr ! shortwave
	262	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe1 , pe2 , pe3 ! PAR ( R-G-B)
	263	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL :: pe0 !
	264	REAL(wp), DIMENSION(jpi,jpj) , INTENT( out), OPTIONAL :: pqsr100 !
	265	!
[5385]	266	INTEGER :: ji, jj, jk ! dummy loop indices
[9169]	267	REAL(wp), DIMENSION(jpi,jpj) :: zqsr ! shortwave
[5385]	268	!!----------------------------------------------------------------------
	269
	270	! Real shortwave
[7753]	271	IF( ln_varpar ) THEN ; zqsr(:,:) = par_varsw(:,:) * pqsr(:,:)
	272	ELSE ; zqsr(:,:) = xparsw * pqsr(:,:)
[5385]	273	ENDIF
[6945]	274
	275	! Light at the euphotic depth
[9169]	276	IF( PRESENT( pqsr100 ) ) pqsr100(:,:) = 0.01 * 3. * zqsr(:,:)
[6945]	277
[5385]	278	IF( PRESENT( pe0 ) ) THEN ! W-level
	279	!
[7753]	280	pe0(:,:,1) = pqsr(:,:) - 3. * zqsr(:,:) ! ( 1 - 3 * alpha ) * q
	281	pe1(:,:,1) = zqsr(:,:)
	282	pe2(:,:,1) = zqsr(:,:)
	283	pe3(:,:,1) = zqsr(:,:)
[5385]	284	!
	285	DO jk = 2, nksrp + 1
	286	DO jj = 1, jpj
	287	DO ji = 1, jpi
[12377]	288	pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * xsi0r )
[9169]	289	pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb (ji,jj,jk-1 ) )
	290	pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg (ji,jj,jk-1 ) )
	291	pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr (ji,jj,jk-1 ) )
[5385]	292	END DO
	293	!
	294	END DO
	295	!
	296	END DO
	297	!
	298	ELSE ! T- level
	299	!
[7753]	300	pe1(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekb(:,:,1) )
	301	pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) )
	302	pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) )
[5385]	303	!
[13295]	304	DO_3D( 1, 1, 1, 1, 2, nksrp )
[12377]	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_3D
[5385]	309	!
	310	ENDIF
	311	!
	312	END SUBROUTINE p4z_opt_par
	313
	314
	315	SUBROUTINE p4z_opt_sbc( kt )
	316	!!----------------------------------------------------------------------
	317	!! * routine p4z_opt_sbc *
	318	!!
[3443]	319	!! ** purpose : read and interpolate the variable PAR fraction
	320	!! of shortwave radiation
	321	!!
	322	!! ** method : read the files and interpolate the appropriate variables
	323	!!
	324	!! ** input : external netcdf files
	325	!!
	326	!!----------------------------------------------------------------------
[9169]	327	INTEGER, INTENT(in) :: kt ! ocean time step
[9124]	328	!
[3443]	329	INTEGER :: ji,jj
	330	REAL(wp) :: zcoef
	331	!!---------------------------------------------------------------------
	332	!
[9124]	333	IF( ln_timing ) CALL timing_start('p4z_optsbc')
[3443]	334	!
	335	! Compute par_varsw at nit000 or only if there is more than 1 time record in par coefficient file
	336	IF( ln_varpar ) THEN
	337	IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_par > 1 ) ) THEN
	338	CALL fld_read( kt, 1, sf_par )
[5385]	339	par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0
[3443]	340	ENDIF
	341	ENDIF
	342	!
[9124]	343	IF( ln_timing ) CALL timing_stop('p4z_optsbc')
[3443]	344	!
[5385]	345	END SUBROUTINE p4z_opt_sbc
[3443]	346
[9124]	347
[3443]	348	SUBROUTINE p4z_opt_init
	349	!!----------------------------------------------------------------------
	350	!! * ROUTINE p4z_opt_init *
	351	!!
	352	!! ** Purpose : Initialization of tabulated attenuation coef
	353	!! and of the percentage of PAR in Shortwave
	354	!!
	355	!! ** Input : external ascii and netcdf files
	356	!!----------------------------------------------------------------------
[9169]	357	INTEGER :: numpar, ierr, ios ! Local integer
[3443]	358	!
	359	CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files
	360	TYPE(FLD_N) :: sn_par ! informations about the fields to be read
	361	!
	362	NAMELIST/nampisopt/cn_dir, sn_par, ln_varpar, parlux
	363	!!----------------------------------------------------------------------
[9169]	364	IF(lwp) THEN
	365	WRITE(numout,*)
	366	WRITE(numout,*) 'p4z_opt_init : '
	367	WRITE(numout,*) '~~~~~~~~~~~~ '
	368	ENDIF
[4147]	369	READ ( numnatp_ref, nampisopt, IOSTAT = ios, ERR = 901)
[11536]	370	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisopt in reference namelist' )
[4147]	371	READ ( numnatp_cfg, nampisopt, IOSTAT = ios, ERR = 902 )
[11536]	372	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisopt in configuration namelist' )
[4624]	373	IF(lwm) WRITE ( numonp, nampisopt )
[3443]	374
	375	IF(lwp) THEN
[9169]	376	WRITE(numout,*) ' Namelist : nampisopt '
	377	WRITE(numout,*) ' PAR as a variable fraction of SW ln_varpar = ', ln_varpar
	378	WRITE(numout,*) ' Default value for the PAR fraction parlux = ', parlux
[3443]	379	ENDIF
	380	!
	381	xparsw = parlux / 3.0
[5385]	382	xsi0r = 1.e0 / rn_si0
[3443]	383	!
	384	! Variable PAR at the surface of the ocean
	385	! ----------------------------------------
	386	IF( ln_varpar ) THEN
[9169]	387	IF(lwp) WRITE(numout,*)
	388	IF(lwp) WRITE(numout,*) ' ==>>> initialize variable par fraction (ln_varpar=T)'
[3443]	389	!
	390	ALLOCATE( par_varsw(jpi,jpj) )
	391	!
	392	ALLOCATE( sf_par(1), STAT=ierr ) !* allocate and fill sf_sst (forcing structure) with sn_sst
	393	IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'p4z_opt_init: unable to allocate sf_par structure' )
	394	!
	395	CALL fld_fill( sf_par, (/ sn_par /), cn_dir, 'p4z_opt_init', 'Variable PAR fraction ', 'nampisopt' )
	396	ALLOCATE( sf_par(1)%fnow(jpi,jpj,1) )
	397	IF( sn_par%ln_tint ) ALLOCATE( sf_par(1)%fdta(jpi,jpj,1,2) )
	398
	399	CALL iom_open ( TRIM( sn_par%clname ) , numpar )
[10522]	400	ntimes_par = iom_getszuld( numpar ) ! get number of record in file
[3443]	401	ENDIF
	402	!
	403	CALL trc_oce_rgb( xkrgb ) ! tabulated attenuation coefficients
[13226]	404	nksrp = trc_oce_ext_lev( r_si2, 0.33e2_wp ) ! max level of light extinction (Blue Chl=0.01)
[3443]	405	!
[4292]	406	IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m'
[3443]	407	!
[7753]	408	ekr (:,:,:) = 0._wp
	409	ekb (:,:,:) = 0._wp
	410	ekg (:,:,:) = 0._wp
	411	etot (:,:,:) = 0._wp
	412	etot_ndcy(:,:,:) = 0._wp
	413	enano (:,:,:) = 0._wp
	414	ediat (:,:,:) = 0._wp
	415	IF( ln_p5z ) epico (:,:,:) = 0._wp
	416	IF( ln_qsr_bio ) etot3 (:,:,:) = 0._wp
[3443]	417	!
	418	END SUBROUTINE p4z_opt_init
	419
	420
	421	INTEGER FUNCTION p4z_opt_alloc()
	422	!!----------------------------------------------------------------------
	423	!! * ROUTINE p4z_opt_alloc *
	424	!!----------------------------------------------------------------------
[7646]	425	!
	426	ALLOCATE( ekb(jpi,jpj,jpk), ekr(jpi,jpj,jpk), &
	427	ekg(jpi,jpj,jpk), STAT= p4z_opt_alloc )
	428	!
[10425]	429	IF( p4z_opt_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_opt_alloc : failed to allocate arrays.' )
[3443]	430	!
	431	END FUNCTION p4z_opt_alloc
	432
	433	!!======================================================================
[5656]	434	END MODULE p4zopt

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

Download in other formats: