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.

p4zsed.F90 in trunk/NEMOGCM/NEMO/TOP_SRC/PISCES – NEMO

Context Navigation

source: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90 @ 3221

Last change on this file since 3221 was 2774, checked in by cetlod, 13 years ago
PISCES trunk : Use dynamical allocation for some local arrays, see ticket #830
Property svn:keywords set to `Id`
File size: 22.4 KB

Rev	Line
[935]	1	MODULE p4zsed
	2	!!======================================================================
	3	!! * MODULE p4sed *
	4	!! TOP : PISCES Compute loss of organic matter in the sediments
	5	!!======================================================================
	6	!! History : 1.0 ! 2004-03 (O. Aumont) Original code
	7	!! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90
	8	!!----------------------------------------------------------------------
	9	#if defined key_pisces
	10	!!----------------------------------------------------------------------
	11	!! 'key_pisces' PISCES bio-model
	12	!!----------------------------------------------------------------------
	13	!! p4z_sed : Compute loss of organic matter in the sediments
	14	!! p4z_sbc : Read and interpolate time-varying nutrients fluxes
	15	!! p4z_sed_init : Initialization of p4z_sed
	16	!!----------------------------------------------------------------------
	17	USE trc
	18	USE oce_trc !
[1073]	19	USE sms_pisces
[935]	20	USE prtctl_trc
	21	USE p4zbio
	22	USE p4zint
	23	USE p4zopt
	24	USE p4zsink
	25	USE p4zrem
	26	USE p4zlim
	27	USE iom
	28
	29
	30	IMPLICIT NONE
	31	PRIVATE
	32
[1073]	33	PUBLIC p4z_sed
[2528]	34	PUBLIC p4z_sed_init
[2715]	35	PUBLIC p4z_sed_alloc
[935]	36
	37	!! * Shared module variables
[2715]	38	LOGICAL, PUBLIC :: ln_dustfer = .FALSE. !: boolean for dust input from the atmosphere
	39	LOGICAL, PUBLIC :: ln_river = .FALSE. !: boolean for river input of nutrients
	40	LOGICAL, PUBLIC :: ln_ndepo = .FALSE. !: boolean for atmospheric deposition of N
	41	LOGICAL, PUBLIC :: ln_sedinput = .FALSE. !: boolean for Fe input from sediments
[935]	42
[2715]	43	REAL(wp), PUBLIC :: sedfeinput = 1.E-9_wp !: Coastal release of Iron
	44	REAL(wp), PUBLIC :: dustsolub = 0.014_wp !: Solubility of the dust
[935]	45
	46	!! * Module variables
[2715]	47	REAL(wp) :: ryyss !: number of seconds per year
	48	REAL(wp) :: ryyss1 !: inverse of ryyss
	49	REAL(wp) :: rmtss !: number of seconds per month
	50	REAL(wp) :: rday1 !: inverse of rday
[1735]	51
[2715]	52	INTEGER , PARAMETER :: jpmth = 12 !: number of months per year
	53	INTEGER , PARAMETER :: jpyr = 1 !: one year
	54
	55	INTEGER :: numdust !: logical unit for surface fluxes data
	56	INTEGER :: nflx1 , nflx2 !: first and second record used
	57	INTEGER :: nflx11, nflx12
	58
	59	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dustmo !: set of dust fields
	60	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: dust !: dust fields
	61	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivinp, cotdep !: river input fields
	62	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nitdep !: atmospheric N deposition
	63	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ironsed !: Coastal supply of iron
	64
[935]	65	REAL(wp) :: sumdepsi, rivalkinput, rivpo4input, nitdepinput
	66
	67	!!* Substitution
[1503]	68	# include "top_substitute.h90"
[935]	69	!!----------------------------------------------------------------------
[2528]	70	!! NEMO/TOP 3.3 , NEMO Consortium (2010)
[1180]	71	!! $Header:$
[2528]	72	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[935]	73	!!----------------------------------------------------------------------
	74
	75	CONTAINS
	76
[2715]	77
[2528]	78	SUBROUTINE p4z_sed( kt, jnt )
[935]	79	!!---------------------------------------------------------------------
	80	!! * ROUTINE p4z_sed *
	81	!!
	82	!! ** Purpose : Compute loss of organic matter in the sediments. This
	83	!! is by no way a sediment model. The loss is simply
	84	!! computed to balance the inout from rivers and dust
	85	!!
	86	!! ** Method : - ???
	87	!!---------------------------------------------------------------------
[2715]	88	USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
	89	USE wrk_nemo, ONLY: zsidep => wrk_2d_1, zwork => wrk_2d_2, zwork1 => wrk_2d_3
	90	USE wrk_nemo, ONLY: znitrpot => wrk_3d_2, zirondep => wrk_3d_3
	91	!
[935]	92	INTEGER, INTENT(in) :: kt, jnt ! ocean time step
[2528]	93	INTEGER :: ji, jj, jk, ikt
[1180]	94	#if ! defined key_sed
[935]	95	REAL(wp) :: zsumsedsi, zsumsedpo4, zsumsedcal
[2528]	96	REAL(wp) :: zrivalk, zrivsil, zrivpo4
[1180]	97	#endif
[2528]	98	REAL(wp) :: zdenitot, znitrpottot, zlim, zfact
	99	REAL(wp) :: zwsbio3, zwsbio4, zwscal
[935]	100	CHARACTER (len=25) :: charout
	101	!!---------------------------------------------------------------------
	102
[2715]	103	IF( ( wrk_in_use(2, 1,2,3) ) .OR. ( wrk_in_use(3, 2,3) ) ) THEN
	104	CALL ctl_stop('p4z_sed: requested workspace arrays unavailable') ; RETURN
	105	END IF
	106
[2528]	107	IF( jnt == 1 .AND. ln_dustfer ) CALL p4z_sbc( kt )
[935]	108
	109	! Iron and Si deposition at the surface
	110	! -------------------------------------
	111
	112	DO jj = 1, jpj
	113	DO ji = 1, jpi
[2528]	114	zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 * ryyss1 ) &
[935]	115	& * rfact2 / fse3t(ji,jj,1)
[1735]	116	zsidep (ji,jj) = 8.8 * 0.075 * dust(ji,jj) * rfact2 / ( fse3t(ji,jj,1) * 28.1 * rmtss )
[935]	117	END DO
	118	END DO
	119
	120	! Iron solubilization of particles in the water column
	121	! ----------------------------------------------------
	122
	123	DO jk = 2, jpkm1
[1735]	124	zirondep(:,:,jk) = dust(:,:) / ( 10. * 55.85 * rmtss ) * rfact2 * 1.e-4
[935]	125	END DO
	126
	127	! Add the external input of nutrients, carbon and alkalinity
	128	! ----------------------------------------------------------
	129
	130	trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + rivinp(:,:) * rfact2
	131	trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + (rivinp(:,:) + nitdep(:,:)) * rfact2
	132	trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + rivinp(:,:) * 3.e-5 * rfact2
	133	trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + zsidep (:,:) + cotdep(:,:) * rfact2 / 6.
	134	trn(:,:,1,jpdic) = trn(:,:,1,jpdic) + rivinp(:,:) * 2.631 * rfact2
	135	trn(:,:,1,jptal) = trn(:,:,1,jptal) + (cotdep(:,:) - rno3(rivinp(:,:) + nitdep(:,:) ) ) rfact2
	136
	137
	138	! Add the external input of iron which is 3D distributed
	139	! (dust, river and sediment mobilization)
	140	! ------------------------------------------------------
	141
	142	DO jk = 1, jpkm1
[1457]	143	trn(:,:,jk,jpfer) = trn(:,:,jk,jpfer) + zirondep(:,:,jk) + ironsed(:,:,jk) * rfact2
[935]	144	END DO
	145
[1180]	146
	147	#if ! defined key_sed
[935]	148	! Loss of biogenic silicon, Caco3 organic carbon in the sediments.
	149	! First, the total loss is computed.
	150	! The factor for calcite comes from the alkalinity effect
	151	! -------------------------------------------------------------
	152	DO jj = 1, jpj
	153	DO ji = 1, jpi
[2528]	154	ikt = mbkt(ji,jj)
[935]	155	# if defined key_kriest
[2528]	156	zwork (ji,jj) = trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt)
	157	zwork1(ji,jj) = trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt)
[935]	158	# else
[2528]	159	zwork (ji,jj) = trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt)
	160	zwork1(ji,jj) = trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt) + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt)
[935]	161	# endif
	162	END DO
	163	END DO
[2528]	164	zsumsedsi = glob_sum( zwork (:,:) * e1e2t(:,:) ) * rday1
	165	zsumsedpo4 = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * rday1
	166	DO jj = 1, jpj
	167	DO ji = 1, jpi
	168	ikt = mbkt(ji,jj)
	169	zwork (ji,jj) = trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt)
	170	END DO
	171	END DO
	172	zsumsedcal = glob_sum( zwork (:,:) * e1e2t(:,:) ) * 2.0 * rday1
[1180]	173	#endif
	174
[935]	175	! Then this loss is scaled at each bottom grid cell for
	176	! equilibrating the total budget of silica in the ocean.
	177	! Thus, the amount of silica lost in the sediments equal
	178	! the supply at the surface (dust+rivers)
	179	! ------------------------------------------------------
	180
	181	DO jj = 1, jpj
	182	DO ji = 1, jpi
[2528]	183	ikt = mbkt(ji,jj)
	184	zfact = xstep / fse3t(ji,jj,ikt)
	185	zwsbio3 = 1._wp - zfact * wsbio3(ji,jj,ikt)
	186	zwsbio4 = 1._wp - zfact * wsbio4(ji,jj,ikt)
	187	zwscal = 1._wp - zfact * wscal (ji,jj,ikt)
	188	!
	189	# if defined key_kriest
	190	trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwsbio4
	191	trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) * zwsbio4
	192	trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3
	193	trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3
[935]	194	# else
[2528]	195	trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwscal
	196	trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) * zwsbio4
	197	trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3
	198	trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) * zwsbio4
	199	trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3
[935]	200	# endif
[2528]	201	trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) * zwscal
[935]	202	END DO
	203	END DO
	204
[1180]	205	#if ! defined key_sed
[2528]	206	zrivsil = 1._wp - ( sumdepsi + rivalkinput * ryyss1 / 6. ) / zsumsedsi
	207	zrivalk = 1._wp - ( rivalkinput * ryyss1 ) / zsumsedcal
	208	zrivpo4 = 1._wp - ( rivpo4input * ryyss1 ) / zsumsedpo4
[935]	209	DO jj = 1, jpj
	210	DO ji = 1, jpi
[2528]	211	ikt = mbkt(ji,jj)
	212	zfact = xstep / fse3t(ji,jj,ikt)
	213	zwsbio3 = zfact * wsbio3(ji,jj,ikt)
	214	zwsbio4 = zfact * wsbio4(ji,jj,ikt)
	215	zwscal = zfact * wscal (ji,jj,ikt)
	216	trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + trn(ji,jj,ikt,jpcal) * zwscal * zrivalk * 2.0
	217	trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + trn(ji,jj,ikt,jpcal) * zwscal * zrivalk
	218	# if defined key_kriest
	219	trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwsbio4 * zrivsil
	220	trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) + trn(ji,jj,ikt,jppoc) * zwsbio3 * zrivpo4
[935]	221	# else
[2528]	222	trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwscal * zrivsil
	223	trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) &
	224	& + ( trn(ji,jj,ikt,jppoc) * zwsbio3 + trn(ji,jj,ikt,jpgoc) * zwsbio4 ) * zrivpo4
[935]	225	# endif
	226	END DO
	227	END DO
[2528]	228	# endif
[935]	229
	230	! Nitrogen fixation (simple parameterization). The total gain
	231	! from nitrogen fixation is scaled to balance the loss by
	232	! denitrification
	233	! -------------------------------------------------------------
	234
[2528]	235	zdenitot = glob_sum( denitr(:,:,:) * cvol(:,:,:) * xnegtr(:,:,:) ) * rdenit
[935]	236
[1678]	237	! Potential nitrogen fixation dependant on temperature and iron
[935]	238	! -------------------------------------------------------------
	239
	240	!CDIR NOVERRCHK
	241	DO jk = 1, jpk
	242	!CDIR NOVERRCHK
	243	DO jj = 1, jpj
	244	!CDIR NOVERRCHK
	245	DO ji = 1, jpi
	246	zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) )
	247	IF( zlim <= 0.2 ) zlim = 0.01
[2528]	248	znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * rday1 ) &
	249	# if defined key_degrad
[935]	250	& * facvol(ji,jj,jk) &
	251	# endif
	252	& * zlim * rfact2 * trn(ji,jj,jk,jpfer) &
	253	& / ( conc3 + trn(ji,jj,jk,jpfer) ) * ( 1.- EXP( -etot(ji,jj,jk) / 50.) )
	254	END DO
	255	END DO
	256	END DO
	257
[2528]	258	znitrpottot = glob_sum( znitrpot(:,:,:) * cvol(:,:,:) )
[935]	259
	260	! Nitrogen change due to nitrogen fixation
	261	! ----------------------------------------
	262
	263	DO jk = 1, jpk
	264	DO jj = 1, jpj
	265	DO ji = 1, jpi
	266	zfact = znitrpot(ji,jj,jk) * 1.e-7
	267	trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) + zfact
	268	trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + zfact * o2nit
	269	trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + 30./ 46.* zfact
	270	END DO
	271	END DO
	272	END DO
	273
[2528]	274	#if defined key_diatrc
	275	zfact = 1.e+3 * rfact2r
[1457]	276	# if ! defined key_iomput
[2528]	277	trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * zfact * fse3t(:,:,1) * tmask(:,:,1)
	278	trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * zfact * fse3t(:,:,1) * tmask(:,:,1)
	279	# else
	280	zwork (:,:) = ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zfact * fse3t(:,:,1) * tmask(:,:,1)
	281	zwork1(:,:) = znitrpot(:,:,1) * 1.e-7 * zfact * fse3t(:,:,1) * tmask(:,:,1)
	282	IF( jnt == nrdttrc ) THEN
	283	CALL iom_put( "Irondep", zwork ) ! surface downward net flux of iron
	284	CALL iom_put( "Nfix" , zwork1 ) ! nitrogen fixation at surface
	285	ENDIF
	286	# endif
	287	#endif
[935]	288	!
	289	IF(ln_ctl) THEN ! print mean trends (used for debugging)
	290	WRITE(charout, FMT="('sed ')")
	291	CALL prt_ctl_trc_info(charout)
	292	CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
	293	ENDIF
	294
[2715]	295	IF( ( wrk_not_released(2, 1,2,3) ) .OR. ( wrk_not_released(3, 2,3) ) ) &
	296	& CALL ctl_stop('p4z_sed: failed to release workspace arrays')
	297
[935]	298	END SUBROUTINE p4z_sed
	299
[2528]	300	SUBROUTINE p4z_sbc( kt )
[935]	301
	302	!!----------------------------------------------------------------------
	303	!! * ROUTINE p4z_sbc *
	304	!!
	305	!! ** Purpose : Read and interpolate the external sources of
	306	!! nutrients
	307	!!
	308	!! ** Method : Read the files and interpolate the appropriate variables
	309	!!
	310	!! ** input : external netcdf files
	311	!!
	312	!!----------------------------------------------------------------------
	313	!! * arguments
	314	INTEGER, INTENT( in ) :: kt ! ocean time step
	315
	316	!! * Local declarations
[2528]	317	INTEGER :: imois, i15, iman
	318	REAL(wp) :: zxy
[935]	319
	320	!!---------------------------------------------------------------------
	321
	322	! Initialization
	323	! --------------
	324
[1147]	325	i15 = nday / 16
[935]	326	iman = INT( raamo )
	327	imois = nmonth + i15 - 1
	328	IF( imois == 0 ) imois = iman
	329
[2528]	330	! Calendar computation
[935]	331	IF( kt == nit000 .OR. imois /= nflx1 ) THEN
	332
[2528]	333	IF( kt == nit000 ) nflx1 = 0
[935]	334
	335	! nflx1 number of the first file record used in the simulation
	336	! nflx2 number of the last file record
	337
	338	nflx1 = imois
[2528]	339	nflx2 = nflx1 + 1
[935]	340	nflx1 = MOD( nflx1, iman )
	341	nflx2 = MOD( nflx2, iman )
	342	IF( nflx1 == 0 ) nflx1 = iman
	343	IF( nflx2 == 0 ) nflx2 = iman
[2528]	344	IF(lwp) WRITE(numout,*)
	345	IF(lwp) WRITE(numout,*) ' p4z_sbc : first record file used nflx1 ',nflx1
	346	IF(lwp) WRITE(numout,*) ' p4z_sbc : last record file used nflx2 ',nflx2
[935]	347
	348	ENDIF
	349
[2528]	350	! 3. at every time step interpolation of fluxes
[935]	351	! ---------------------------------------------
	352
[1147]	353	zxy = FLOAT( nday + 15 - 30 * i15 ) / 30
[2528]	354	dust(:,:) = ( (1.-zxy) * dustmo(:,:,nflx1) + zxy * dustmo(:,:,nflx2) )
[935]	355
	356	END SUBROUTINE p4z_sbc
	357
	358
	359	SUBROUTINE p4z_sed_init
	360
	361	!!----------------------------------------------------------------------
	362	!! * ROUTINE p4z_sed_init *
	363	!!
	364	!! ** Purpose : Initialization of the external sources of nutrients
	365	!!
	366	!! ** Method : Read the files and compute the budget
[2528]	367	!! called at the first timestep (nit000)
[935]	368	!!
	369	!! ** input : external netcdf files
	370	!!
	371	!!----------------------------------------------------------------------
[2774]	372	USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
	373	USE wrk_nemo, ONLY: zriverdoc => wrk_2d_1, zriver => wrk_2d_2, zndepo => wrk_2d_3
	374	USE wrk_nemo, ONLY: zcmask => wrk_3d_2
	375	!
[2528]	376	INTEGER :: ji, jj, jk, jm
[935]	377	INTEGER :: numriv, numbath, numdep
	378	REAL(wp) :: zcoef
	379	REAL(wp) :: expide, denitide,zmaskt
[2774]	380	!
[1511]	381	NAMELIST/nampissed/ ln_dustfer, ln_river, ln_ndepo, ln_sedinput, sedfeinput, dustsolub
[2774]	382	!!----------------------------------------------------------------------
[935]	383
[2774]	384	IF( ( wrk_in_use(2, 1,2,3) ) .OR. ( wrk_in_use(3, 2) ) ) THEN
	385	CALL ctl_stop('p4z_sed_init: requested workspace arrays unavailable') ; RETURN
	386	END IF
	387	!
[935]	388	REWIND( numnat ) ! read numnat
[1119]	389	READ ( numnat, nampissed )
[935]	390
	391	IF(lwp) THEN
	392	WRITE(numout,*) ' '
[1119]	393	WRITE(numout,*) ' Namelist : nampissed '
[935]	394	WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ '
[1511]	395	WRITE(numout,*) ' Dust input from the atmosphere ln_dustfer = ', ln_dustfer
	396	WRITE(numout,*) ' River input of nutrients ln_river = ', ln_river
	397	WRITE(numout,*) ' Atmospheric deposition of N ln_ndepo = ', ln_ndepo
	398	WRITE(numout,*) ' Fe input from sediments ln_sedinput = ', ln_sedinput
	399	WRITE(numout,*) ' Coastal release of Iron sedfeinput =', sedfeinput
	400	WRITE(numout,*) ' Solubility of the dust dustsolub =', dustsolub
[935]	401	ENDIF
	402
	403	! Dust input from the atmosphere
	404	! ------------------------------
[1511]	405	IF( ln_dustfer ) THEN
[935]	406	IF(lwp) WRITE(numout,*) ' Initialize dust input from atmosphere '
	407	IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
	408	CALL iom_open ( 'dust.orca.nc', numdust )
[2528]	409	DO jm = 1, jpmth
	410	CALL iom_get( numdust, jpdom_data, 'dust', dustmo(:,:,jm), jm )
[935]	411	END DO
	412	CALL iom_close( numdust )
	413	ELSE
[2528]	414	dustmo(:,:,:) = 0.e0
[935]	415	dust(:,:) = 0.0
	416	ENDIF
	417
	418	! Nutrient input from rivers
	419	! --------------------------
[1511]	420	IF( ln_river ) THEN
[935]	421	IF(lwp) WRITE(numout,*) ' Initialize the nutrient input by rivers from river.orca.nc file'
	422	IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
	423	CALL iom_open ( 'river.orca.nc', numriv )
[2774]	424	CALL iom_get ( numriv, jpdom_data, 'riverdic', zriver (:,:), jpyr )
	425	CALL iom_get ( numriv, jpdom_data, 'riverdoc', zriverdoc(:,:), jpyr )
[935]	426	CALL iom_close( numriv )
	427	ELSE
[2774]	428	zriver (:,:) = 0.e0
	429	zriverdoc(:,:) = 0.e0
[935]	430	endif
	431
	432	! Nutrient input from dust
	433	! ------------------------
[1511]	434	IF( ln_ndepo ) THEN
[935]	435	IF(lwp) WRITE(numout,*) ' Initialize the nutrient input by dust from ndeposition.orca.nc'
	436	IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
	437	CALL iom_open ( 'ndeposition.orca.nc', numdep )
[2774]	438	CALL iom_get ( numdep, jpdom_data, 'ndep', zndepo(:,:), jpyr )
[935]	439	CALL iom_close( numdep )
	440	ELSE
[2774]	441	zndepo(:,:) = 0.e0
[935]	442	ENDIF
	443
	444	! Coastal and island masks
	445	! ------------------------
[1511]	446	IF( ln_sedinput ) THEN
[935]	447	IF(lwp) WRITE(numout,*) ' Computation of an island mask to enhance coastal supply of iron'
	448	IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
	449	IF(lwp) WRITE(numout,*) ' from bathy.orca.nc file '
	450	CALL iom_open ( 'bathy.orca.nc', numbath )
[2774]	451	CALL iom_get ( numbath, jpdom_data, 'bathy', zcmask(:,:,:), jpyr )
[935]	452	CALL iom_close( numbath )
	453	!
	454	DO jk = 1, 5
	455	DO jj = 2, jpjm1
[1503]	456	DO ji = fs_2, fs_jpim1
[935]	457	IF( tmask(ji,jj,jk) /= 0. ) THEN
	458	zmaskt = tmask(ji+1,jj,jk) * tmask(ji-1,jj,jk) * tmask(ji,jj+1,jk) &
	459	& * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1)
[2774]	460	IF( zmaskt == 0. ) zcmask(ji,jj,jk ) = MAX( 0.1, zcmask(ji,jj,jk) )
[935]	461	ENDIF
	462	END DO
	463	END DO
	464	END DO
	465	DO jk = 1, jpk
	466	DO jj = 1, jpj
	467	DO ji = 1, jpi
	468	expide = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) )
	469	denitide = -0.9543 + 0.7662 * LOG( expide ) - 0.235 * LOG( expide )**2
[2774]	470	zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( denitide ) / 0.5 )
[935]	471	END DO
	472	END DO
	473	END DO
	474	ELSE
[2774]	475	zcmask(:,:,:) = 0.e0
[935]	476	ENDIF
	477
[2774]	478	CALL lbc_lnk( zcmask , 'T', 1. ) ! Lateral boundary conditions on zcmask (sign unchanged)
[935]	479
	480
[2528]	481	! ! Number of seconds per year and per month
	482	ryyss = nyear_len(1) * rday
	483	rmtss = ryyss / raamo
	484	rday1 = 1. / rday
	485	ryyss1 = 1. / ryyss
	486	! ! ocean surface cell
[1735]	487
[935]	488	! total atmospheric supply of Si
	489	! ------------------------------
	490	sumdepsi = 0.e0
[2528]	491	DO jm = 1, jpmth
	492	zcoef = 1. / ( 12. * rmtss ) * 8.8 * 0.075 / 28.1
	493	sumdepsi = sumdepsi + glob_sum( dustmo(:,:,jm) * e1e2t(:,:) ) * zcoef
	494	ENDDO
[935]	495
	496	! N/P and Si releases due to coastal rivers
	497	! -----------------------------------------
	498	DO jj = 1, jpj
	499	DO ji = 1, jpi
[2528]	500	zcoef = ryyss * e1e2t(ji,jj) * fse3t(ji,jj,1) * tmask(ji,jj,1)
[2774]	501	cotdep(ji,jj) = zriver(ji,jj) 1E9 / ( 12. zcoef + rtrn )
	502	rivinp(ji,jj) = (zriver(ji,jj)+zriverdoc(ji,jj)) 1E9 / ( 31.6 zcoef + rtrn )
	503	nitdep(ji,jj) = 7.6 * zndepo(ji,jj) / ( 14E6ryyssfse3t(ji,jj,1) + rtrn )
[935]	504	END DO
	505	END DO
	506	! Lateral boundary conditions on ( cotdep, rivinp, nitdep ) (sign unchanged)
	507	CALL lbc_lnk( cotdep , 'T', 1. ) ; CALL lbc_lnk( rivinp , 'T', 1. ) ; CALL lbc_lnk( nitdep , 'T', 1. )
	508
[2528]	509	rivpo4input = glob_sum( rivinp(:,:) * cvol(:,:,1) ) * ryyss
	510	rivalkinput = glob_sum( cotdep(:,:) * cvol(:,:,1) ) * ryyss
	511	nitdepinput = glob_sum( nitdep(:,:) * cvol(:,:,1) ) * ryyss
[935]	512
	513
	514	! Coastal supply of iron
	515	! -------------------------
	516	DO jk = 1, jpkm1
[2774]	517	ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday )
[935]	518	END DO
	519	CALL lbc_lnk( ironsed , 'T', 1. ) ! Lateral boundary conditions on ( ironsed ) (sign unchanged)
	520
[2774]	521	IF( ( wrk_not_released(2, 1,2,3) ) .OR. ( wrk_not_released(3, 2) ) ) &
	522	& CALL ctl_stop('p4z_sed_init: failed to release workspace arrays')
[935]	523
	524	END SUBROUTINE p4z_sed_init
	525
[2715]	526	INTEGER FUNCTION p4z_sed_alloc()
	527	!!----------------------------------------------------------------------
	528	!! * ROUTINE p4z_sed_alloc *
	529	!!----------------------------------------------------------------------
	530
	531	ALLOCATE( dustmo(jpi,jpj,jpmth), dust(jpi,jpj) , &
	532	& rivinp(jpi,jpj) , cotdep(jpi,jpj) , &
	533	& nitdep(jpi,jpj) , ironsed(jpi,jpj,jpk), STAT=p4z_sed_alloc )
	534
	535	IF( p4z_sed_alloc /= 0 ) CALL ctl_warn('p4z_sed_alloc : failed to allocate arrays.')
	536
	537	END FUNCTION p4z_sed_alloc
[935]	538	#else
	539	!!======================================================================
	540	!! Dummy module : No PISCES bio-model
	541	!!======================================================================
	542	CONTAINS
	543	SUBROUTINE p4z_sed ! Empty routine
	544	END SUBROUTINE p4z_sed
	545	#endif
	546
	547	!!======================================================================
	548	END MODULE p4zsed

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

Download in other formats: