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_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p4zopt.F90 @ 14644

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

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

Download in other formats: