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.

asmlogchlbal_medusa.F90 in branches/UKMO/dev_r5518_GO6_package_asm_3d_bgc/NEMOGCM/NEMO/OPA_SRC/ASM – NEMO

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package_asm_3d_bgc/NEMOGCM/NEMO/OPA_SRC/ASM/asmlogchlbal_medusa.F90 @ 9292

Last change on this file since 9292 was 9292, checked in by dford, 6 years ago
Merge in changes from dev_r5518_GO6_package_asm_surf_bgc_v2.
File size: 24.2 KB

Line
1	MODULE asmlogchlbal_medusa
2	!!======================================================================
3	!! * MODULE asmlogchlbal_medusa *
4	!! Calculate increments to MEDUSA based on surface logchl increments
5	!!
6	!! IMPORTANT NOTE: This calls the bioanalysis routine of Hemmings et al.
7	!! For licensing reasons this is kept in its own internal Met Office
8	!! branch (dev/frdf/vn3.6_nitrogen_balancing) rather than in the Paris
9	!! repository, and must be merged in when building.
10	!!
11	!!======================================================================
12	!! History : 3.6 ! 2017-08 (D. Ford) Adapted from asmlogchlbal_hadocc
13	!!----------------------------------------------------------------------
14	#if defined key_asminc && defined key_medusa && defined key_foam_medusa
15	!!----------------------------------------------------------------------
16	!! 'key_asminc' : assimilation increment interface
17	!! 'key_medusa' : MEDUSA model
18	!! 'key_foam_medusa' : MEDUSA extras for FOAM OBS and ASM
19	!!----------------------------------------------------------------------
20	!! asm_logchl_bal_medusa : routine to calculate increments to MEDUSA
21	!!----------------------------------------------------------------------
22	USE par_kind, ONLY: wp ! kind parameters
23	USE par_oce, ONLY: jpi, jpj, jpk ! domain array sizes
24	USE dom_oce, ONLY: gdepw_n ! domain information
25	USE zdfmxl ! mixed layer depth
26	USE zdftmx, ONLY: ln_tmx_itf, & ! Indonesian Throughflow
27	& mask_itf ! tidal mixing mask
28	USE iom ! i/o
29	USE sms_medusa ! MEDUSA parameters
30	USE par_medusa ! MEDUSA parameters
31	USE par_trc, ONLY: jptra ! Tracer parameters
32	USE bioanalysis ! Nitrogen balancing
33
34	IMPLICIT NONE
35	PRIVATE
36
37	PUBLIC asm_logchl_bal_medusa
38
39	! Default values for biological assimilation parameters
40	! Should match Hemmings et al. (2008)
41	REAL(wp), PARAMETER :: balnutext = 0.6 !: Default nutrient balancing factor
42	REAL(wp), PARAMETER :: balnutmin = 0.1 !: Fraction of phytoplankton loss to nutrient
43	REAL(wp), PARAMETER :: r = 1 !: Reliability of model specific growth rate
44	REAL(wp), PARAMETER :: beta_g = 0.05 !: Low rate bias correction for growth rate estimator
45	REAL(wp), PARAMETER :: beta_l = 0.05 !: Low rate bias correction for primary loss rate estimator
46	REAL(wp), PARAMETER :: beta_m = 0.05 !: Low rate bias correction for secondary loss rate estimator
47	REAL(wp), PARAMETER :: a_g = 0.2 !: Error s.d. for log10 of growth rate estimator
48	REAL(wp), PARAMETER :: a_l = 0.4 !: Error s.d. for log10 of primary loss rate estimator
49	REAL(wp), PARAMETER :: a_m = 0.7 !: Error s.d. for log10 of secondary loss rate estimator
50	REAL(wp), PARAMETER :: zfracb0 = 0.7 !: Base zooplankton fraction of loss to Z & D
51	REAL(wp), PARAMETER :: zfracb1 = 0 !: Phytoplankton sensitivity of zooplankton fraction
52	REAL(wp), PARAMETER :: qrfmax = 1.1 !: Maximum nutrient limitation reduction factor
53	REAL(wp), PARAMETER :: qafmax = 1.1 !: Maximum nutrient limitation amplification factor
54	REAL(wp), PARAMETER :: zrfmax = 2 !: Maximum zooplankton reduction factor
55	REAL(wp), PARAMETER :: zafmax = 2 !: Maximum zooplankton amplification factor
56	REAL(wp), PARAMETER :: prfmax = 10 !: Maximum phytoplankton reduction factor (secondary)
57	REAL(wp), PARAMETER :: incphymin = 0.0001 !: Minimum size of non-zero phytoplankton increment
58	REAL(wp), PARAMETER :: integnstep = 20 !: Number of steps for p.d.f. integral evaluation
59	REAL(wp), PARAMETER :: pthreshold = 0.01 !: Fractional threshold level for setting p.d.f.
60	!
61	LOGICAL, PARAMETER :: diag_active = .TRUE. !: Depth-independent diagnostics
62	LOGICAL, PARAMETER :: diag_fulldepth_active = .TRUE. !: Full-depth diagnostics
63	LOGICAL, PARAMETER :: gl_active = .TRUE. !: Growth/loss-based balancing
64	LOGICAL, PARAMETER :: nbal_active = .TRUE. !: Nitrogen balancing
65	LOGICAL, PARAMETER :: subsurf_active = .TRUE. !: Increments below MLD
66	LOGICAL, PARAMETER :: deepneg_active = .FALSE. !: Negative primary increments below MLD
67	LOGICAL, PARAMETER :: deeppos_active = .FALSE. !: Positive primary increments below MLD
68	LOGICAL, PARAMETER :: nutprof_active = .TRUE. !: Secondary increments
69
70	CONTAINS
71
72	SUBROUTINE asm_logchl_bal_medusa( logchl_bkginc, aincper, mld_choice_bgc, &
73	& k_maxchlinc, ld_logchlbal, ld_asmdin, &
74	& pgrow_avg_bkg, ploss_avg_bkg, &
75	& phyt_avg_bkg, mld_max_bkg, &
76	& tracer_bkg, logchl_balinc )
77	!!---------------------------------------------------------------------------
78	!! * ROUTINE asm_logchl_bal_medusa *
79	!!
80	!! ** Purpose : calculate increments to MEDUSA from logchl increments
81	!!
82	!! ** Method : convert logchl increments to chl increments
83	!! average up MEDUSA to look like HadOCC
84	!! call nitrogen balancing scheme
85	!! separate back out to MEDUSA
86	!!
87	!! ** Action : populate logchl_balinc
88	!!
89	!! References : Hemmings et al., 2008, J. Mar. Res.
90	!! Ford et al., 2012, Ocean Sci.
91	!!---------------------------------------------------------------------------
92	!!
93	REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: logchl_bkginc ! logchl increments
94	REAL(wp), INTENT(in ) :: aincper ! Assimilation period
95	INTEGER, INTENT(in ) :: mld_choice_bgc ! MLD criterion
96	REAL(wp), INTENT(in ) :: k_maxchlinc ! Max chl increment
97	LOGICAL, INTENT(in ) :: ld_logchlbal ! Balancing y/n
98	LOGICAL, INTENT(in ) :: ld_asmdin ! Direct initialisation y/n
99	REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: pgrow_avg_bkg ! Avg phyto growth
100	REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: ploss_avg_bkg ! Avg phyto loss
101	REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: phyt_avg_bkg ! Avg phyto
102	REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: mld_max_bkg ! Max MLD
103	REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk,jptra) :: tracer_bkg ! State variables
104	REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk,jptra) :: logchl_balinc ! Balancing increments
105	!!
106	INTEGER :: ji, jj, jk, jn ! Loop counters
107	INTEGER :: jkmax ! Loop index
108	INTEGER, DIMENSION(6) :: i_tracer ! Tracer indices
109	REAL(wp) :: n2be_p ! N:biomass for total phy
110	REAL(wp) :: n2be_z ! N:biomass for total zoo
111	REAL(wp) :: n2be_d ! N:biomass for detritus
112	REAL(wp) :: zfrac_chn ! Fraction of jpchn
113	REAL(wp) :: zfrac_chd ! Fraction of jpchd
114	REAL(wp) :: zfrac_phn ! Fraction of jpphn
115	REAL(wp) :: zfrac_phd ! Fraction of jpphd
116	REAL(wp) :: zfrac_zmi ! Fraction of jpzmi
117	REAL(wp) :: zfrac_zme ! Fraction of jpzme
118	REAL(wp) :: zrat_pds_phd ! Ratio of jppds:jpphd
119	REAL(wp) :: zrat_chd_phd ! Ratio of jpchd:jpphd
120	REAL(wp) :: zrat_chn_phn ! Ratio of jpchn:jpphn
121	REAL(wp) :: zrat_dtc_det ! Ratio of jpdtc:jpdet
122	REAL(wp), DIMENSION(jpi,jpj) :: chl_inc ! Chlorophyll increments
123	REAL(wp), DIMENSION(jpi,jpj) :: medusa_chl ! MEDUSA total chlorophyll
124	REAL(wp), DIMENSION(jpi,jpj) :: cchl_p ! C:Chl for total phy
125	REAL(wp), DIMENSION(jpi,jpj) :: zmld ! Mixed layer depth
126	REAL(wp), DIMENSION(16) :: modparm ! Model parameters
127	REAL(wp), DIMENSION(20) :: assimparm ! Assimilation parameters
128	REAL(wp), DIMENSION(jpi,jpj,jpk,6) :: bstate ! Background state
129	REAL(wp), DIMENSION(jpi,jpj,jpk,6) :: outincs ! Balancing increments
130	REAL(wp), DIMENSION(jpi,jpj,22) :: diag ! Depth-indep diagnostics
131	REAL(wp), DIMENSION(jpi,jpj,jpk,22) :: diag_fulldepth ! Full-depth diagnostics
132	!!---------------------------------------------------------------------------
133
134	! Convert log10(chlorophyll) increment back to a chlorophyll increment
135	! In order to transform logchl incs to chl incs, need to account for model
136	! background, cannot simply do 10^logchl_bkginc. Need to:
137	! 1) Add logchl inc to log10(background) to get log10(analysis)
138	! 2) Take 10^log10(analysis) to get analysis
139	! 3) Subtract background from analysis to get chl incs
140	! If k_maxchlinc > 0 then cap total absolute chlorophyll increment at that value
141	medusa_chl(:,:) = tracer_bkg(:,:,1,jpchn) + tracer_bkg(:,:,1,jpchd)
142	DO jj = 1, jpj
143	DO ji = 1, jpi
144	IF ( medusa_chl(ji,jj) > 0.0 ) THEN
145	chl_inc(ji,jj) = 10**( LOG10( medusa_chl(ji,jj) ) + logchl_bkginc(ji,jj) ) - medusa_chl(ji,jj)
146	IF ( k_maxchlinc > 0.0 ) THEN
147	chl_inc(ji,jj) = MAX( -1.0 * k_maxchlinc, MIN( chl_inc(ji,jj), k_maxchlinc ) )
148	ENDIF
149	ELSE
150	chl_inc(ji,jj) = 0.0
151	ENDIF
152	END DO
153	END DO
154
155	! Select mixed layer
156	IF ( ld_asmdin ) THEN
157	CALL ctl_warn( ' Doing direct initialisation of MEDUSA with chlorophyll assimilation', &
158	& ' Mixed layer depth taken to be background maximum mld_max_bkg' )
159	zmld(:,:) = mld_max_bkg(:,:)
160	ELSE
161	SELECT CASE( mld_choice_bgc )
162	CASE ( 1 ) ! Turbocline/mixing depth [W points]
163	zmld(:,:) = hmld(:,:)
164	CASE ( 2 ) ! Density criterion (0.01 kg/m^3 change from 10m) [W points]
165	zmld(:,:) = hmlp(:,:)
166	CASE ( 3 ) ! Kara MLD [Interpolated]
167	#if defined key_karaml
168	IF ( ln_kara ) THEN
169	zmld(:,:) = hmld_kara(:,:)
170	ELSE
171	CALL ctl_stop( ' Kara mixed layer requested for LogChl assimilation,', &
172	& ' but ln_kara=.false.' )
173	ENDIF
174	#else
175	CALL ctl_stop( ' Kara mixed layer requested for LogChl assimilation,', &
176	& ' but is not defined' )
177	#endif
178	CASE ( 4 ) ! Temperature criterion (0.2 K change from surface) [T points]
179	!zmld(:,:) = hmld_tref(:,:)
180	CALL ctl_stop( ' hmld_tref mixed layer requested for LogChl assimilation,', &
181	& ' but is not available in this version' )
182	CASE ( 5 ) ! Density criterion (0.01 kg/m^3 change from 10m) [T points]
183	zmld(:,:) = hmlpt(:,:)
184	END SELECT
185	ENDIF
186
187	IF ( ld_logchlbal ) THEN ! Nitrogen balancing
188
189	! Set up model parameters to be passed into Hemmings balancing routine.
190	! For now these are hardwired to the standard HadOCC parameter values
191	! (except C:N ratios) as this is what the scheme was developed for.
192	! Obviously, HadOCC and MEDUSA are rather different models, so this
193	! isn't ideal, but there's not always direct analogues between the two
194	! parameter sets, so it's the easiest way to get something running.
195	! In the longer term, some serious MarMOT-based development is required.
196	modparm(1) = 0.1 ! grow_sat
197	modparm(2) = 2.0 ! psmax
198	modparm(3) = 0.845 ! par
199	modparm(4) = 0.02 ! alpha
200	modparm(5) = 0.05 ! resp_rate
201	modparm(6) = 0.05 ! pmort_rate
202	modparm(7) = 0.01 ! phyto_min
203	modparm(8) = 0.05 ! z_mort_1
204	modparm(9) = 1.0 ! z_mort_2
205	modparm(10) = ( xthetapn + xthetapd ) / 2.0 ! c2n_p
206	modparm(11) = ( xthetazmi + xthetazme ) / 2.0 ! c2n_z
207	modparm(12) = xthetad ! c2n_d
208	modparm(13) = 0.01 ! graze_threshold
209	modparm(14) = 2.0 ! holling_coef
210	modparm(15) = 0.5 ! graze_sat
211	modparm(16) = 2.0 ! graze_max
212
213	! Set up assimilation parameters to be passed into balancing routine
214	! Not sure what assimparm(1) is meant to be, but it doesn't get used
215	assimparm(2) = balnutext
216	assimparm(3) = balnutmin
217	assimparm(4) = r
218	assimparm(5) = beta_g
219	assimparm(6) = beta_l
220	assimparm(7) = beta_m
221	assimparm(8) = a_g
222	assimparm(9) = a_l
223	assimparm(10) = a_m
224	assimparm(11) = zfracb0
225	assimparm(12) = zfracb1
226	assimparm(13) = qrfmax
227	assimparm(14) = qafmax
228	assimparm(15) = zrfmax
229	assimparm(16) = zafmax
230	assimparm(17) = prfmax
231	assimparm(18) = incphymin
232	assimparm(19) = integnstep
233	assimparm(20) = pthreshold
234
235	! Set up external tracer indices array bstate
236	i_tracer(1) = 1 ! nutrient
237	i_tracer(2) = 2 ! phytoplankton
238	i_tracer(3) = 3 ! zooplankton
239	i_tracer(4) = 4 ! detritus
240	i_tracer(5) = 5 ! DIC
241	i_tracer(6) = 6 ! Alkalinity
242
243	! Set background state
244	bstate(:,:,:,i_tracer(1)) = tracer_bkg(:,:,:,jpdin)
245	bstate(:,:,:,i_tracer(2)) = tracer_bkg(:,:,:,jpphn) + tracer_bkg(:,:,:,jpphd)
246	bstate(:,:,:,i_tracer(3)) = tracer_bkg(:,:,:,jpzmi) + tracer_bkg(:,:,:,jpzme)
247	bstate(:,:,:,i_tracer(4)) = tracer_bkg(:,:,:,jpdet)
248	bstate(:,:,:,i_tracer(5)) = tracer_bkg(:,:,:,jpdic)
249	bstate(:,:,:,i_tracer(6)) = tracer_bkg(:,:,:,jpalk)
250
251	! Calculate carbon to chlorophyll ratio for combined phytoplankton
252	! and nitrogen to biomass equivalent for PZD
253	! Hardwire nitrogen mass to 14.01 for now as it doesn't seem to be set in MEDUSA
254	cchl_p(:,:) = 0.0
255	DO jj = 1, jpj
256	DO ji = 1, jpi
257	IF ( ( tracer_bkg(ji,jj,1,jpchn) + tracer_bkg(ji,jj,1,jpchd ) ) .GT. 0.0 ) THEN
258	cchl_p(ji,jj) = xmassc * ( ( tracer_bkg(ji,jj,1,jpphn) * xthetapn ) + &
259	& ( tracer_bkg(ji,jj,1,jpphd) * xthetapd ) ) / &
260	& ( tracer_bkg(ji,jj,1,jpchn) + tracer_bkg(ji,jj,1,jpchd ) )
261	ENDIF
262	END DO
263	END DO
264	n2be_p = 14.01 + ( xmassc * ( ( xthetapn + xthetapd ) / 2.0 ) )
265	n2be_z = 14.01 + ( xmassc * ( ( xthetazmi + xthetazme ) / 2.0 ) )
266	n2be_d = 14.01 + ( xmassc * xthetad )
267
268	! Call nitrogen balancing routine
269	CALL bio_analysis( jpi, jpj, jpk, gdepw_n(:,:,2:jpk), i_tracer, modparm, &
270	& n2be_p, n2be_z, n2be_d, assimparm, &
271	& INT(aincper), 1, INT(SUM(tmask,3)), tmask(:,:,:), &
272	& zmld(:,:), mld_max_bkg(:,:), chl_inc(:,:), cchl_p(:,:), &
273	& nbal_active, phyt_avg_bkg(:,:), &
274	& gl_active, pgrow_avg_bkg(:,:), ploss_avg_bkg(:,:), &
275	& subsurf_active, deepneg_active, &
276	& deeppos_active, nutprof_active, &
277	& bstate, outincs, &
278	& diag_active, diag, &
279	& diag_fulldepth_active, diag_fulldepth )
280
281	! Loop over each grid point partioning the increments
282	logchl_balinc(:,:,:,:) = 0.0
283	DO jk = 1, jpk
284	DO jj = 1, jpj
285	DO ji = 1, jpi
286
287	IF ( ( tracer_bkg(ji,jj,jk,jpphn) > 0.0 ) .AND. ( tracer_bkg(ji,jj,jk,jpphd) > 0.0 ) ) THEN
288	! Phytoplankton nitrogen and silicate split up based on existing ratios
289	zfrac_phn = tracer_bkg(ji,jj,jk,jpphn) / (tracer_bkg(ji,jj,jk,jpphn) + tracer_bkg(ji,jj,jk,jpphd))
290	zfrac_phd = 1.0 - zfrac_phn
291	zrat_pds_phd = tracer_bkg(ji,jj,jk,jppds) / tracer_bkg(ji,jj,jk,jpphd)
292	logchl_balinc(ji,jj,jk,jpphn) = outincs(ji,jj,jk,i_tracer(2)) * zfrac_phn
293	logchl_balinc(ji,jj,jk,jpphd) = outincs(ji,jj,jk,i_tracer(2)) * zfrac_phd
294	logchl_balinc(ji,jj,jk,jppds) = logchl_balinc(ji,jj,jk,jpphd) * zrat_pds_phd
295
296	! Chlorophyll split up based on existing ratios to phytoplankton nitrogen
297	! Not using chl_inc directly as it's only 2D
298	! This method should give same results at surface as splitting chl_inc would
299	zrat_chn_phn = tracer_bkg(ji,jj,jk,jpchn) / tracer_bkg(ji,jj,jk,jpphn)
300	zrat_chd_phd = tracer_bkg(ji,jj,jk,jpchd) / tracer_bkg(ji,jj,jk,jpphd)
301	logchl_balinc(ji,jj,jk,jpchn) = logchl_balinc(ji,jj,jk,jpphn) * zrat_chn_phn
302	logchl_balinc(ji,jj,jk,jpchd) = logchl_balinc(ji,jj,jk,jpphd) * zrat_chd_phd
303	ENDIF
304
305	IF ( ( tracer_bkg(ji,jj,jk,jpzmi) > 0.0 ) .AND. ( tracer_bkg(ji,jj,jk,jpzme) > 0.0 ) ) THEN
306	! Zooplankton nitrogen split up based on existing ratios
307	zfrac_zmi = tracer_bkg(ji,jj,jk,jpzmi) / (tracer_bkg(ji,jj,jk,jpzmi) + tracer_bkg(ji,jj,jk,jpzme))
308	zfrac_zme = 1.0 - zfrac_zmi
309	logchl_balinc(ji,jj,jk,jpzmi) = outincs(ji,jj,jk,i_tracer(3)) * zfrac_zmi
310	logchl_balinc(ji,jj,jk,jpzme) = outincs(ji,jj,jk,i_tracer(3)) * zfrac_zme
311	ENDIF
312
313	! Nitrogen nutrient straight from balancing scheme
314	logchl_balinc(ji,jj,jk,jpdin) = outincs(ji,jj,jk,i_tracer(1))
315
316	! Nitrogen detritus straight from balancing scheme
317	logchl_balinc(ji,jj,jk,jpdet) = outincs(ji,jj,jk,i_tracer(4))
318
319	! DIC straight from balancing scheme
320	logchl_balinc(ji,jj,jk,jpdic) = outincs(ji,jj,jk,i_tracer(5))
321
322	! Alkalinity straight from balancing scheme
323	logchl_balinc(ji,jj,jk,jpalk) = outincs(ji,jj,jk,i_tracer(6))
324
325	! Remove diatom silicate increment from nutrient silicate to conserve mass
326	IF ( ( tracer_bkg(ji,jj,jk,jpsil) - logchl_balinc(ji,jj,jk,jppds) ) > 0.0 ) THEN
327	logchl_balinc(ji,jj,jk,jpsil) = logchl_balinc(ji,jj,jk,jppds) * (-1.0)
328	ENDIF
329
330	IF ( ( tracer_bkg(ji,jj,jk,jpdet) > 0.0 ) .AND. ( tracer_bkg(ji,jj,jk,jpdtc) > 0.0 ) ) THEN
331	! Carbon detritus based on existing ratios
332	zrat_dtc_det = tracer_bkg(ji,jj,jk,jpdtc) / tracer_bkg(ji,jj,jk,jpdet)
333	logchl_balinc(ji,jj,jk,jpdtc) = logchl_balinc(ji,jj,jk,jpdet) * zrat_dtc_det
334	ENDIF
335
336	! Do nothing with iron or oxygen for the time being
337	logchl_balinc(ji,jj,jk,jpfer) = 0.0
338	logchl_balinc(ji,jj,jk,jpoxy) = 0.0
339
340	END DO
341	END DO
342	END DO
343
344	ELSE ! No nitrogen balancing
345
346	! Initialise individual chlorophyll increments to zero
347	logchl_balinc(:,:,:,jpchn) = 0.0
348	logchl_balinc(:,:,:,jpchd) = 0.0
349
350	! Split up total surface chlorophyll increments
351	DO jj = 1, jpj
352	DO ji = 1, jpi
353	IF ( medusa_chl(ji,jj) > 0.0 ) THEN
354	zfrac_chn = tracer_bkg(ji,jj,1,jpchn) / medusa_chl(ji,jj)
355	zfrac_chd = 1.0 - zfrac_chn
356	logchl_balinc(ji,jj,1,jpchn) = chl_inc(ji,jj) * zfrac_chn
357	logchl_balinc(ji,jj,1,jpchd) = chl_inc(ji,jj) * zfrac_chd
358	ENDIF
359	END DO
360	END DO
361
362	! Propagate through mixed layer
363	DO jj = 1, jpj
364	DO ji = 1, jpi
365	!
366	jkmax = jpk-1
367	DO jk = jpk-1, 1, -1
368	IF ( ( zmld(ji,jj) > gdepw_n(ji,jj,jk) ) .AND. &
369	& ( zmld(ji,jj) <= gdepw_n(ji,jj,jk+1) ) ) THEN
370	zmld(ji,jj) = gdepw_n(ji,jj,jk+1)
371	jkmax = jk
372	ENDIF
373	END DO
374	!
375	DO jk = 2, jkmax
376	logchl_balinc(ji,jj,jk,jpchn) = logchl_balinc(ji,jj,1,jpchn)
377	logchl_balinc(ji,jj,jk,jpchd) = logchl_balinc(ji,jj,1,jpchd)
378	END DO
379	!
380	END DO
381	END DO
382
383	! Set other balancing increments to zero
384	logchl_balinc(:,:,:,jpphn) = 0.0
385	logchl_balinc(:,:,:,jpphd) = 0.0
386	logchl_balinc(:,:,:,jppds) = 0.0
387	logchl_balinc(:,:,:,jpzmi) = 0.0
388	logchl_balinc(:,:,:,jpzme) = 0.0
389	logchl_balinc(:,:,:,jpdin) = 0.0
390	logchl_balinc(:,:,:,jpsil) = 0.0
391	logchl_balinc(:,:,:,jpfer) = 0.0
392	logchl_balinc(:,:,:,jpdet) = 0.0
393	logchl_balinc(:,:,:,jpdtc) = 0.0
394	logchl_balinc(:,:,:,jpdic) = 0.0
395	logchl_balinc(:,:,:,jpalk) = 0.0
396	logchl_balinc(:,:,:,jpoxy) = 0.0
397
398	ENDIF
399
400	! If performing extra tidal mixing in the Indonesian Throughflow,
401	! increments have been found to make the carbon cycle unstable
402	! Therefore, mask these out
403	IF ( ln_tmx_itf ) THEN
404	DO jn = 1, jptra
405	DO jk = 1, jpk
406	logchl_balinc(:,:,jk,jn) = logchl_balinc(:,:,jk,jn) * ( 1.0 - mask_itf(:,:) )
407	END DO
408	END DO
409	ENDIF
410
411	END SUBROUTINE asm_logchl_bal_medusa
412
413	#else
414	!!----------------------------------------------------------------------
415	!! Default option : Empty routine
416	!!----------------------------------------------------------------------
417	CONTAINS
418	SUBROUTINE asm_logchl_bal_medusa( logchl_bkginc, aincper, mld_choice_bgc, &
419	& k_maxchlinc, ld_logchlbal, &
420	& pgrow_avg_bkg, ploss_avg_bkg, &
421	& phyt_avg_bkg, mld_max_bkg, &
422	& tracer_bkg, logchl_balinc )
423	REAL :: logchl_bkginc(:,:)
424	REAL :: aincper
425	INTEGER :: mld_choice_bgc
426	REAL :: k_maxchlinc
427	LOGICAL :: ld_logchlbal
428	REAL :: pgrow_avg_bkg(:,:)
429	REAL :: ploss_avg_bkg(:,:)
430	REAL :: phyt_avg_bkg(:,:)
431	REAL :: mld_max_bkg(:,:)
432	REAL :: tracer_bkg(:,:,:,:)
433	REAL :: logchl_balinc(:,:,:,:)
434	WRITE(,) 'asm_logchl_bal_medusa: You should not have seen this print! error?'
435	END SUBROUTINE asm_logchl_bal_medusa
436	#endif
437
438	!!======================================================================
439	END MODULE asmlogchlbal_medusa

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

Download in other formats: