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.

p4zsbc.F90 in NEMO/trunk/src/TOP/PISCES/P4Z – NEMO

Context Navigation

source: NEMO/trunk/src/TOP/PISCES/P4Z/p4zsbc.F90 @ 10522

Last change on this file since 10522 was 10522, checked in by smasson, 5 years ago
trunk: replace iom_gettime by iom_getszuld, see #2212
Property svn:keywords set to `Id`
File size: 26.4 KB

Rev	Line
[3443]	1	MODULE p4zsbc
	2	!!======================================================================
	3	!! * MODULE p4sbc *
	4	!! TOP : PISCES surface boundary conditions of external inputs of nutrients
	5	!!======================================================================
	6	!! History : 3.5 ! 2012-07 (O. Aumont, C. Ethe) Original code
	7	!!----------------------------------------------------------------------
	8	!! p4z_sbc : Read and interpolate time-varying nutrients fluxes
	9	!! p4z_sbc_init : Initialization of p4z_sbc
	10	!!----------------------------------------------------------------------
	11	USE oce_trc ! shared variables between ocean and passive tracers
	12	USE trc ! passive tracers common variables
	13	USE sms_pisces ! PISCES Source Minus Sink variables
	14	USE iom ! I/O manager
	15	USE fldread ! time interpolation
	16
	17	IMPLICIT NONE
	18	PRIVATE
	19
	20	PUBLIC p4z_sbc
	21	PUBLIC p4z_sbc_init
	22
[9169]	23	LOGICAL , PUBLIC :: ln_dust !: boolean for dust input from the atmosphere
	24	LOGICAL , PUBLIC :: ln_solub !: boolean for variable solubility of atmospheric iron
	25	LOGICAL , PUBLIC :: ln_river !: boolean for river input of nutrients
	26	LOGICAL , PUBLIC :: ln_ndepo !: boolean for atmospheric deposition of N
	27	LOGICAL , PUBLIC :: ln_ironsed !: boolean for Fe input from sediments
	28	LOGICAL , PUBLIC :: ln_hydrofe !: boolean for Fe input from hydrothermal vents
	29	LOGICAL , PUBLIC :: ln_ironice !: boolean for Fe input from sea ice
	30	REAL(wp), PUBLIC :: sedfeinput !: Coastal release of Iron
	31	REAL(wp), PUBLIC :: dustsolub !: Solubility of the dust
	32	REAL(wp), PUBLIC :: mfrac !: Mineral Content of the dust
	33	REAL(wp), PUBLIC :: icefeinput !: Iron concentration in sea ice
	34	REAL(wp), PUBLIC :: wdust !: Sinking speed of the dust
	35	REAL(wp), PUBLIC :: nitrfix !: Nitrogen fixation rate
	36	REAL(wp), PUBLIC :: diazolight !: Nitrogen fixation sensitivty to light
	37	REAL(wp), PUBLIC :: concfediaz !: Fe half-saturation Cste for diazotrophs
	38	REAL(wp) :: hratio !: Fe:3He ratio assumed for vent iron supply
[10111]	39	REAL(wp) :: distcoast !: Distance off the coast for Iron from sediments
[9169]	40	REAL(wp), PUBLIC :: lgw_rath !: Weak ligand ratio from hydro sources
[3443]	41
[9169]	42	LOGICAL , PUBLIC :: ll_sbc
	43	LOGICAL :: ll_solub
[7646]	44
[3443]	45	INTEGER , PARAMETER :: jpriv = 7 !: Maximum number of river input fields
	46	INTEGER , PARAMETER :: jr_dic = 1 !: index of dissolved inorganic carbon
	47	INTEGER , PARAMETER :: jr_doc = 2 !: index of dissolved organic carbon
	48	INTEGER , PARAMETER :: jr_din = 3 !: index of dissolved inorganic nitrogen
	49	INTEGER , PARAMETER :: jr_don = 4 !: index of dissolved organic nitrogen
	50	INTEGER , PARAMETER :: jr_dip = 5 !: index of dissolved inorganic phosporus
	51	INTEGER , PARAMETER :: jr_dop = 6 !: index of dissolved organic phosphorus
	52	INTEGER , PARAMETER :: jr_dsi = 7 !: index of dissolved silicate
	53
	54	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_dust ! structure of input dust
[9169]	55	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_solub ! structure of input dust
	56	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_river ! structure of input riverdic
[3443]	57	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ndepo ! structure of input nitrogen deposition
	58	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ironsed ! structure of input iron from sediment
	59	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_hydrofe ! structure of input iron from hydrothermal vents
	60
[9169]	61	INTEGER , PARAMETER :: nbtimes = 365 ! maximum number of times record in a file
	62	INTEGER :: ntimes_dust, ntimes_riv, ntimes_ndep ! number of time steps in a file
	63	INTEGER :: ntimes_solub, ntimes_hydro ! number of time steps in a file
[3443]	64
[9169]	65	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dust , solub !: dust fields
	66	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdic, rivalk !: river input fields
	67	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdin, rivdip !: river input fields
	68	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdon, rivdop !: river input fields
	69	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdoc !: river input fields
	70	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivdsi !: river input fields
	71	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nitdep !: atmospheric N deposition
	72	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ironsed !: Coastal supply of iron
	73	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hydrofe !: Hydrothermal vent supply of iron
[3443]	74
[10127]	75	REAL(wp), PUBLIC :: sedsilfrac, sedcalfrac
	76	REAL(wp), PUBLIC :: rivalkinput, rivdicinput
	77	REAL(wp), PUBLIC :: rivdininput, rivdipinput, rivdsiinput
[3443]	78
[5836]	79	!! * Substitutions
	80	# include "vectopt_loop_substitute.h90"
[3443]	81	!!----------------------------------------------------------------------
[10067]	82	!! NEMO/TOP 4.0 , NEMO Consortium (2018)
[5215]	83	!! $Id$
[10068]	84	!! Software governed by the CeCILL license (see ./LICENSE)
[3443]	85	!!----------------------------------------------------------------------
	86	CONTAINS
	87
	88	SUBROUTINE p4z_sbc( kt )
	89	!!----------------------------------------------------------------------
	90	!! * routine p4z_sbc *
	91	!!
	92	!! ** purpose : read and interpolate the external sources of nutrients
	93	!!
	94	!! ** method : read the files and interpolate the appropriate variables
	95	!!
	96	!! ** input : external netcdf files
	97	!!
	98	!!----------------------------------------------------------------------
[9169]	99	INTEGER, INTENT(in) :: kt ! ocean time step
	100	!
	101	INTEGER :: ji, jj
	102	REAL(wp) :: zcoef, zyyss
[3443]	103	!!---------------------------------------------------------------------
	104	!
[9169]	105	IF( ln_timing ) CALL timing_start('p4z_sbc')
[3443]	106	!
	107	! Compute dust at nit000 or only if there is more than 1 time record in dust file
	108	IF( ln_dust ) THEN
	109	IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN
	110	CALL fld_read( kt, 1, sf_dust )
[10127]	111	IF( nn_ice_tr == -1 .AND. .NOT.ln_ironice ) THEN ; dust(:,:) = MAX( rtrn, sf_dust(1)%fnow(:,:,1) )
	112	ELSE ; dust(:,:) = MAX( rtrn, sf_dust(1)%fnow(:,:,1) * ( 1.-fr_i(:,:) ) )
[5507]	113	ENDIF
[3443]	114	ENDIF
	115	ENDIF
[9169]	116	!
[3443]	117	IF( ll_solub ) THEN
	118	IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_solub > 1 ) ) THEN
	119	CALL fld_read( kt, 1, sf_solub )
[7753]	120	solub(:,:) = sf_solub(1)%fnow(:,:,1)
[3443]	121	ENDIF
	122	ENDIF
	123
	124	! N/P and Si releases due to coastal rivers
	125	! Compute river at nit000 or only if there is more than 1 time record in river file
	126	! -----------------------------------------
	127	IF( ln_river ) THEN
	128	IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_riv > 1 ) ) THEN
	129	CALL fld_read( kt, 1, sf_river )
[7646]	130	IF( ln_p4z ) THEN
	131	DO jj = 1, jpj
	132	DO ji = 1, jpi
	133	zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj)
[10362]	134	rivalk(ji,jj) = sf_river(jr_dic)%fnow(ji,jj,1) &
[7646]	135	& * 1.E3 / ( 12. * zcoef + rtrn )
[10362]	136	rivdic(ji,jj) = sf_river(jr_dic)%fnow(ji,jj,1) &
[7646]	137	& * 1.E3 / ( 12. * zcoef + rtrn )
[10362]	138	rivdin(ji,jj) = sf_river(jr_din)%fnow(ji,jj,1) &
[7646]	139	& * 1.E3 / rno3 / ( 14. * zcoef + rtrn )
[10362]	140	rivdip(ji,jj) = sf_river(jr_dip)%fnow(ji,jj,1) &
[7646]	141	& * 1.E3 / po4r / ( 31. * zcoef + rtrn )
[10362]	142	rivdsi(ji,jj) = sf_river(jr_dsi)%fnow(ji,jj,1) &
[7646]	143	& * 1.E3 / ( 28.1 * zcoef + rtrn )
[10362]	144	rivdoc(ji,jj) = sf_river(jr_doc)%fnow(ji,jj,1) &
	145	& * 1.E3 / ( 12. * zcoef + rtrn )
[7646]	146	END DO
[3443]	147	END DO
[7646]	148	ELSE ! ln_p5z
	149	DO jj = 1, jpj
	150	DO ji = 1, jpi
	151	zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj)
	152	rivalk(ji,jj) = sf_river(jr_dic)%fnow(ji,jj,1) &
	153	& * 1.E3 / ( 12. * zcoef + rtrn )
	154	rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) ) &
	155	& * 1.E3 / ( 12. * zcoef + rtrn ) * tmask(ji,jj,1)
	156	rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) ) &
	157	& * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1)
	158	rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) ) &
	159	& * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1)
	160	rivdon(ji,jj) = ( sf_river(jr_don)%fnow(ji,jj,1) ) &
	161	& * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1)
	162	rivdop(ji,jj) = ( sf_river(jr_dop)%fnow(ji,jj,1) ) &
	163	& * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1)
[10362]	164	rivdsi(ji,jj) = sf_river(jr_dsi)%fnow(ji,jj,1) &
	165	& * 1.E3 / ( 28.1 * zcoef + rtrn )
	166	rivdoc(ji,jj) = sf_river(jr_doc)%fnow(ji,jj,1) &
	167	& * 1.E3 / ( 12. * zcoef + rtrn )
[7646]	168	END DO
	169	END DO
	170	ENDIF
[3443]	171	ENDIF
	172	ENDIF
	173
	174	! Compute N deposition at nit000 or only if there is more than 1 time record in N deposition file
	175	IF( ln_ndepo ) THEN
	176	IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_ndep > 1 ) ) THEN
[7753]	177	zcoef = rno3 * 14E6 * ryyss
	178	CALL fld_read( kt, 1, sf_ndepo )
[10127]	179	nitdep(:,:) = MAX( rtrn, sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) )
[3443]	180	ENDIF
[6962]	181	IF( .NOT.ln_linssh ) THEN
[7753]	182	zcoef = rno3 * 14E6 * ryyss
[10127]	183	nitdep(:,:) = MAX( rtrn, sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) )
[6945]	184	ENDIF
[3443]	185	ENDIF
	186	!
[9124]	187	IF( ln_timing ) CALL timing_stop('p4z_sbc')
[3443]	188	!
	189	END SUBROUTINE p4z_sbc
	190
[9124]	191
[3443]	192	SUBROUTINE p4z_sbc_init
	193	!!----------------------------------------------------------------------
	194	!! * routine p4z_sbc_init *
	195	!!
	196	!! ** purpose : initialization of the external sources of nutrients
	197	!!
	198	!! ** method : read the files and compute the budget
	199	!! called at the first timestep (nittrc000)
	200	!!
	201	!! ** input : external netcdf files
	202	!!
	203	!!----------------------------------------------------------------------
	204	INTEGER :: ji, jj, jk, jm, ifpr
[3446]	205	INTEGER :: ii0, ii1, ij0, ij1
[3443]	206	INTEGER :: numdust, numsolub, numriv, numiron, numdepo, numhydro
	207	INTEGER :: ierr, ierr1, ierr2, ierr3
[4147]	208	INTEGER :: ios ! Local integer output status for namelist read
[5385]	209	INTEGER :: ik50 ! last level where depth less than 50 m
	210	INTEGER :: isrow ! index for ORCA1 starting row
[10111]	211	REAL(wp) :: zexpide, zdenitide, zmaskt, zsurfc, zsurfp,ze3t, ze3t2, zcslp
[3443]	212	REAL(wp) :: ztimes_dust, ztimes_riv, ztimes_ndep
	213	REAL(wp), DIMENSION(:), ALLOCATABLE :: rivinput
[10127]	214	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zriver, zcmask
[3443]	215	!
	216	CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files
	217	TYPE(FLD_N), DIMENSION(jpriv) :: slf_river ! array of namelist informations on the fields to read
	218	TYPE(FLD_N) :: sn_dust, sn_solub, sn_ndepo, sn_ironsed, sn_hydrofe ! informations about the fields to be read
	219	TYPE(FLD_N) :: sn_riverdoc, sn_riverdic, sn_riverdsi ! informations about the fields to be read
	220	TYPE(FLD_N) :: sn_riverdin, sn_riverdon, sn_riverdip, sn_riverdop
[9169]	221	!!
[3443]	222	NAMELIST/nampissbc/cn_dir, sn_dust, sn_solub, sn_riverdic, sn_riverdoc, sn_riverdin, sn_riverdon, &
	223	& sn_riverdip, sn_riverdop, sn_riverdsi, sn_ndepo, sn_ironsed, sn_hydrofe, &
	224	& ln_dust, ln_solub, ln_river, ln_ndepo, ln_ironsed, ln_ironice, ln_hydrofe, &
[10111]	225	& sedfeinput, distcoast, dustsolub, icefeinput, wdust, mfrac, nitrfix, diazolight, concfediaz, &
[10416]	226	& hratio, lgw_rath
[3443]	227	!!----------------------------------------------------------------------
	228	!
[9169]	229	IF(lwp) THEN
	230	WRITE(numout,*)
	231	WRITE(numout,*) 'p4z_sbc_init : initialization of the external sources of nutrients '
	232	WRITE(numout,*) '~~~~~~~~~~~~ '
	233	ENDIF
[3443]	234	! !* set file information
[4147]	235	REWIND( numnatp_ref ) ! Namelist nampissbc in reference namelist : Pisces external sources of nutrients
	236	READ ( numnatp_ref, nampissbc, IOSTAT = ios, ERR = 901)
[9169]	237	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampissbc in reference namelist', lwp )
[4147]	238	REWIND( numnatp_cfg ) ! Namelist nampissbc in configuration namelist : Pisces external sources of nutrients
	239	READ ( numnatp_cfg, nampissbc, IOSTAT = ios, ERR = 902 )
[9169]	240	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampissbc in configuration namelist', lwp )
[4624]	241	IF(lwm) WRITE ( numonp, nampissbc )
[4147]	242
[3443]	243	IF(lwp) THEN
[9169]	244	WRITE(numout,*) ' Namelist : nampissbc '
	245	WRITE(numout,*) ' dust input from the atmosphere ln_dust = ', ln_dust
	246	WRITE(numout,*) ' Variable solubility of iron input ln_solub = ', ln_solub
	247	WRITE(numout,*) ' river input of nutrients ln_river = ', ln_river
	248	WRITE(numout,*) ' atmospheric deposition of n ln_ndepo = ', ln_ndepo
	249	WRITE(numout,*) ' Fe input from sediments ln_ironsed = ', ln_ironsed
	250	WRITE(numout,*) ' Fe input from seaice ln_ironice = ', ln_ironice
	251	WRITE(numout,*) ' fe input from hydrothermal vents ln_hydrofe = ', ln_hydrofe
	252	WRITE(numout,*) ' coastal release of iron sedfeinput = ', sedfeinput
[10111]	253	WRITE(numout,*) ' distance off the coast distcoast = ', distcoast
[9169]	254	WRITE(numout,*) ' solubility of the dust dustsolub = ', dustsolub
	255	WRITE(numout,*) ' Mineral Fe content of the dust mfrac = ', mfrac
	256	WRITE(numout,*) ' Iron concentration in sea ice icefeinput = ', icefeinput
	257	WRITE(numout,*) ' sinking speed of the dust wdust = ', wdust
	258	WRITE(numout,*) ' nitrogen fixation rate nitrfix = ', nitrfix
	259	WRITE(numout,*) ' nitrogen fixation sensitivty to light diazolight = ', diazolight
	260	WRITE(numout,*) ' Fe half-saturation cste for diazotrophs concfediaz = ', concfediaz
	261	WRITE(numout,*) ' Fe to 3He ratio assumed for vent iron supply hratio = ', hratio
[7646]	262	IF( ln_ligand ) THEN
[9169]	263	WRITE(numout,*) ' Weak ligand ratio from sed hydro sources lgw_rath = ', lgw_rath
[7646]	264	ENDIF
[3443]	265	END IF
	266
[9169]	267	IF( nn_ice_tr >= 0 .AND. ln_ironice ) THEN
	268	IF(lwp) THEN
	269	WRITE(numout,*) ' ==>>> ln_ironice incompatible with nn_ice_tr = ', nn_ice_tr
	270	WRITE(numout,*) ' Specify your sea ice iron concentration in nampisice instead '
	271	WRITE(numout,*) ' ln_ironice is forced to .FALSE. '
	272	ENDIF
	273	ln_ironice = .FALSE.
[3443]	274	ENDIF
	275
[9169]	276	IF( ln_dust .OR. ln_river .OR. ln_ndepo ) THEN ; ll_sbc = .TRUE.
	277	ELSE ; ll_sbc = .FALSE.
[3443]	278	ENDIF
	279
[9169]	280	IF( ln_dust .AND. ln_solub ) THEN ; ll_solub = .TRUE.
	281	ELSE ; ll_solub = .FALSE.
	282	ENDIF
	283
[5385]	284	! set the number of level over which river runoffs are applied
	285	! online configuration : computed in sbcrnf
[7646]	286	IF( l_offline ) THEN
[7753]	287	nk_rnf(:,:) = 1
	288	h_rnf (:,:) = gdept_n(:,:,1)
[5385]	289	ENDIF
	290
[3443]	291	! dust input from the atmosphere
	292	! ------------------------------
	293	IF( ln_dust ) THEN
	294	!
	295	IF(lwp) WRITE(numout,*) ' initialize dust input from atmosphere '
	296	IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
	297	!
	298	ALLOCATE( dust(jpi,jpj) ) ! allocation
	299	!
	300	ALLOCATE( sf_dust(1), STAT=ierr ) !* allocate and fill sf_sst (forcing structure) with sn_sst
	301	IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_dust structure' )
	302	!
	303	CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'p4z_sed_init', 'Atmospheric dust deposition', 'nampissed' )
	304	ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1) )
	305	IF( sn_dust%ln_tint ) ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) )
	306	!
[3557]	307	IF( Agrif_Root() ) THEN ! Only on the master grid
	308	! Get total input dust ; need to compute total atmospheric supply of Si in a year
	309	CALL iom_open ( TRIM( sn_dust%clname ) , numdust )
[10522]	310	ntimes_dust = iom_getszuld( numdust ) ! get number of record in file
[10127]	311	END IF
[3443]	312	END IF
	313
	314	! Solubility of dust deposition of iron
	315	! Only if ln_dust and ln_solubility set to true (ll_solub = .true.)
	316	! -----------------------------------------------------------------
	317	IF( ll_solub ) THEN
	318	!
[9169]	319	IF(lwp) WRITE(numout,*)
	320	IF(lwp) WRITE(numout,*) ' ==>>> ll_solub=T , initialize variable solubility of Fe '
[3443]	321	!
	322	ALLOCATE( solub(jpi,jpj) ) ! allocation
	323	!
	324	ALLOCATE( sf_solub(1), STAT=ierr ) !* allocate and fill sf_sst (forcing structure) with sn_sst
	325	IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_solub structure' )
	326	!
	327	CALL fld_fill( sf_solub, (/ sn_solub /), cn_dir, 'p4z_sed_init', 'Solubility of atm. iron ', 'nampissed' )
	328	ALLOCATE( sf_solub(1)%fnow(jpi,jpj,1) )
	329	IF( sn_solub%ln_tint ) ALLOCATE( sf_solub(1)%fdta(jpi,jpj,1,2) )
	330	! get number of record in file
	331	CALL iom_open ( TRIM( sn_solub%clname ) , numsolub )
[10522]	332	ntimes_solub = iom_getszuld( numsolub ) ! get number of record in file
[3443]	333	CALL iom_close( numsolub )
	334	ENDIF
	335
	336	! nutrient input from rivers
	337	! --------------------------
	338	IF( ln_river ) THEN
	339	!
[9169]	340	slf_river(jr_dic) = sn_riverdic ; slf_river(jr_doc) = sn_riverdoc ; slf_river(jr_din) = sn_riverdin
	341	slf_river(jr_don) = sn_riverdon ; slf_river(jr_dip) = sn_riverdip ; slf_river(jr_dop) = sn_riverdop
[3443]	342	slf_river(jr_dsi) = sn_riverdsi
	343	!
[10362]	344	ALLOCATE( rivdic(jpi,jpj), rivalk(jpi,jpj), rivdin(jpi,jpj), rivdip(jpi,jpj), rivdsi(jpi,jpj), rivdoc(jpi,jpj) )
	345	IF( ln_p5z ) ALLOCATE( rivdon(jpi,jpj), rivdop(jpi,jpj) )
[3443]	346	!
[9169]	347	ALLOCATE( sf_river(jpriv), rivinput(jpriv), STAT=ierr1 ) !* allocate and fill sf_river (forcing structure) with sn_river_
	348	rivinput(:) = 0._wp
[3443]	349
	350	IF( ierr1 > 0 ) CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_irver structure' )
	351	!
	352	CALL fld_fill( sf_river, slf_river, cn_dir, 'p4z_sed_init', 'Input from river ', 'nampissed' )
	353	DO ifpr = 1, jpriv
	354	ALLOCATE( sf_river(ifpr)%fnow(jpi,jpj,1 ) )
	355	IF( slf_river(ifpr)%ln_tint ) ALLOCATE( sf_river(ifpr)%fdta(jpi,jpj,1,2) )
	356	END DO
[3557]	357	IF( Agrif_Root() ) THEN ! Only on the master grid
	358	! Get total input rivers ; need to compute total river supply in a year
	359	DO ifpr = 1, jpriv
	360	CALL iom_open ( TRIM( slf_river(ifpr)%clname ), numriv )
[10522]	361	ntimes_riv = iom_getszuld( numriv )
[3557]	362	ALLOCATE( zriver(jpi,jpj,ntimes_riv) )
	363	DO jm = 1, ntimes_riv
	364	CALL iom_get( numriv, jpdom_data, TRIM( slf_river(ifpr)%clvar ), zriver(:,:,jm), jm )
	365	END DO
	366	CALL iom_close( numriv )
[7646]	367	ztimes_riv = 1._wp / REAL(ntimes_riv, wp)
[3557]	368	DO jm = 1, ntimes_riv
[10425]	369	rivinput(ifpr) = rivinput(ifpr) + glob_sum( 'p4zsbc', zriver(:,:,jm) * tmask(:,:,1) * ztimes_riv )
[3557]	370	END DO
	371	DEALLOCATE( zriver)
[3443]	372	END DO
[3557]	373	! N/P and Si releases due to coastal rivers
	374	! -----------------------------------------
	375	rivdicinput = (rivinput(jr_dic) + rivinput(jr_doc) ) * 1E3 / 12._wp
	376	rivdininput = (rivinput(jr_din) + rivinput(jr_don) ) * 1E3 / rno3 / 14._wp
	377	rivdipinput = (rivinput(jr_dip) + rivinput(jr_dop) ) * 1E3 / po4r / 31._wp
	378	rivdsiinput = rivinput(jr_dsi) * 1E3 / 28.1_wp
	379	rivalkinput = rivinput(jr_dic) * 1E3 / 12._wp
	380	!
	381	ENDIF
[3443]	382	ELSE
	383	rivdicinput = 0._wp
	384	rivdininput = 0._wp
	385	rivdipinput = 0._wp
	386	rivdsiinput = 0._wp
	387	rivalkinput = 0._wp
	388	END IF
	389	! nutrient input from dust
	390	! ------------------------
	391	IF( ln_ndepo ) THEN
	392	!
[9169]	393	IF(lwp) WRITE(numout,*)
	394	IF(lwp) WRITE(numout,*) ' ==>>> ln_ndepo=T , initialize the nutrient input by dust from NetCDF file'
[3443]	395	!
	396	ALLOCATE( nitdep(jpi,jpj) ) ! allocation
	397	!
	398	ALLOCATE( sf_ndepo(1), STAT=ierr3 ) !* allocate and fill sf_sst (forcing structure) with sn_sst
	399	IF( ierr3 > 0 ) CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_ndepo structure' )
	400	!
	401	CALL fld_fill( sf_ndepo, (/ sn_ndepo /), cn_dir, 'p4z_sed_init', 'Nutrient atmospheric depositon ', 'nampissed' )
	402	ALLOCATE( sf_ndepo(1)%fnow(jpi,jpj,1) )
	403	IF( sn_ndepo%ln_tint ) ALLOCATE( sf_ndepo(1)%fdta(jpi,jpj,1,2) )
	404	!
[3557]	405	IF( Agrif_Root() ) THEN ! Only on the master grid
	406	! Get total input dust ; need to compute total atmospheric supply of N in a year
	407	CALL iom_open ( TRIM( sn_ndepo%clname ), numdepo )
[10522]	408	ntimes_ndep = iom_getszuld( numdepo )
[3557]	409	ENDIF
[3443]	410	ENDIF
	411
	412	! coastal and island masks
	413	! ------------------------
	414	IF( ln_ironsed ) THEN
	415	!
[9169]	416	IF(lwp) WRITE(numout,*)
	417	IF(lwp) WRITE(numout,*) ' ==>>> ln_ironsed=T , computation of an island mask to enhance coastal supply of iron'
[3443]	418	!
	419	ALLOCATE( ironsed(jpi,jpj,jpk) ) ! allocation
	420	!
	421	CALL iom_open ( TRIM( sn_ironsed%clname ), numiron )
	422	ALLOCATE( zcmask(jpi,jpj,jpk) )
	423	CALL iom_get ( numiron, jpdom_data, TRIM( sn_ironsed%clvar ), zcmask(:,:,:), 1 )
	424	CALL iom_close( numiron )
	425	!
[5385]	426	ik50 = 5 ! last level where depth less than 50 m
	427	DO jk = jpkm1, 1, -1
[9169]	428	IF( gdept_1d(jk) > 50. ) ik50 = jk - 1
[5385]	429	END DO
[9169]	430	IF(lwp) WRITE(numout,*)
	431	IF(lwp) WRITE(numout,*) ' Level corresponding to 50m depth ', ik50,' ', gdept_1d(ik50+1)
[5385]	432	DO jk = 1, ik50
[3443]	433	DO jj = 2, jpjm1
	434	DO ji = fs_2, fs_jpim1
[10111]	435	ze3t = e3t_0(ji,jj,jk)
	436	zsurfc = e1u(ji,jj) * ( 1. - umask(ji ,jj ,jk) ) &
	437	+ e1u(ji,jj) * ( 1. - umask(ji-1,jj ,jk) ) &
	438	+ e2v(ji,jj) * ( 1. - vmask(ji ,jj ,jk) ) &
	439	+ e2v(ji,jj) * ( 1. - vmask(ji ,jj-1,jk) )
	440	zsurfp = zsurfc * ze3t / e1e2t(ji,jj)
	441	! estimation of the coastal slope : 5 km off the coast
	442	ze3t2 = ze3t * ze3t
	443	zcslp = SQRT( ( distcoast*distcoast + ze3t2 ) / ze3t2 )
	444	!
	445	zcmask(ji,jj,jk) = zcmask(ji,jj,jk) + zcslp * zsurfp
[3443]	446	END DO
	447	END DO
	448	END DO
[5385]	449	!
[10425]	450	CALL lbc_lnk( 'p4zsbc', zcmask , 'T', 1. ) ! lateral boundary conditions on cmask (sign unchanged)
[5385]	451	!
[3443]	452	DO jk = 1, jpk
	453	DO jj = 1, jpj
	454	DO ji = 1, jpi
[6140]	455	zexpide = MIN( 8.,( gdept_n(ji,jj,jk) / 500. )**(-1.5) )
[3443]	456	zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2
	457	zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 )
	458	END DO
	459	END DO
	460	END DO
	461	! Coastal supply of iron
	462	! -------------------------
[7753]	463	ironsed(:,:,jpk) = 0._wp
[3443]	464	DO jk = 1, jpkm1
[7753]	465	ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_0(:,:,jk) * rday )
[3443]	466	END DO
	467	DEALLOCATE( zcmask)
	468	ENDIF
	469	!
	470	! Iron from Hydrothermal vents
	471	! ------------------------
	472	IF( ln_hydrofe ) THEN
	473	!
[9169]	474	IF(lwp) WRITE(numout,*)
	475	IF(lwp) WRITE(numout,*) ' ==>>> ln_hydrofe=T , Input of iron from hydrothermal vents'
[3443]	476	!
	477	ALLOCATE( hydrofe(jpi,jpj,jpk) ) ! allocation
	478	!
	479	CALL iom_open ( TRIM( sn_hydrofe%clname ), numhydro )
	480	CALL iom_get ( numhydro, jpdom_data, TRIM( sn_hydrofe%clvar ), hydrofe(:,:,:), 1 )
	481	CALL iom_close( numhydro )
	482	!
[6945]	483	DO jk = 1, jpk
	484	hydrofe(:,:,jk) = ( hydrofe(:,:,jk) * hratio ) / ( e1e2t(:,:) * e3t_0(:,:,jk) * ryyss + rtrn ) / 1000._wp
	485	ENDDO
[3451]	486	!
[3443]	487	ENDIF
	488	!
	489	IF( ll_sbc ) CALL p4z_sbc( nit000 )
	490	!
	491	IF(lwp) THEN
	492	WRITE(numout,*)
	493	WRITE(numout,*) ' Total input of elements from river supply'
	494	WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
	495	WRITE(numout,) ' N Supply : ', rivdininputrno31E3/1E1214.,' TgN/yr'
[9169]	496	WRITE(numout,) ' Si Supply : ', rivdsiinput1E3/1E12*28.1 ,' TgSi/yr'
[3443]	497	WRITE(numout,) ' P Supply : ', rivdipinput1E3po4r/1E1231.,' TgP/yr'
[9169]	498	WRITE(numout,) ' Alk Supply : ', rivalkinput1E3/1E12 ,' Teq/yr'
	499	WRITE(numout,) ' DIC Supply : ', rivdicinput1E3*12./1E12 ,' TgC/yr'
[3443]	500	WRITE(numout,*)
	501	ENDIF
	502	!
[10127]	503	sedsilfrac = 0.03 ! percentage of silica loss in the sediments
	504	sedcalfrac = 0.6 ! percentage of calcite loss in the sediments
	505	!
[3443]	506	END SUBROUTINE p4z_sbc_init
	507
	508	!!======================================================================
[5656]	509	END MODULE p4zsbc

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

Download in other formats: