reaction_clm.F90 coverage: 11.76 %func 1.00 %block
1) module CLM_Rxn_Base_class
2)
3) ! extended from reaction_sandbox_base to implement demand based
4) ! down regulation for use in CLM_Rxn t6g 10/06/2014
5)
6) use PFLOTRAN_Constants_module
7)
8) implicit none
9)
10) private
11)
12) #include "petsc/finclude/petscsys.h"
13)
14) type, abstract, public :: clm_rxn_base_type
15) class(clm_rxn_base_type), pointer :: next
16) contains
17) #if 0
18) procedure(Base_Read), public, deferred :: ReadInput
19) procedure(Base_Setup), public, deferred :: Setup
20) procedure(Base_React), public, deferred :: Evaluate
21) procedure(Base_Destroy), public, deferred :: Destroy
22) #else
23) procedure, public :: ReadInput => Base_Read
24) procedure, public :: Setup => Base_Setup
25) procedure, public :: Evaluate => Base_React
26) procedure, public :: Destroy => Base_Destroy
27) #endif
28) end type clm_rxn_base_type
29)
30) ! for some reason cannot use the interfaces when passing in "this"
31) ! with Intel
32) #if 0
33) abstract interface
34)
35) subroutine Base_Setup(this,reaction,option)
36)
37) use Option_module
38) use Reaction_Aux_module
39)
40) import clm_rxn_base_type
41)
42) implicit none
43)
44) class(clm_rxn_base_type) :: this
45) type(reaction_type) :: reaction
46) type(option_type) :: option
47)
48) end subroutine Base_Setup
49)
50) subroutine Base_Read(this,input,option)
51)
52) use Option_module
53) use Input_Aux_module
54)
55) import clm_rxn_base_type
56)
57) implicit none
58)
59) class(clm_rxn_base_type) :: this
60) type(input_type), pointer :: input
61) type(option_type) :: option
62)
63) end subroutine Base_Read
64)
65) subroutine Base_SkipBlock(this,input,option)
66)
67) use Option_module
68) use Input_Aux_module
69)
70) import clm_rxn_base_type
71)
72) implicit none
73)
74) class(clm_rxn_base_type) :: this
75) type(input_type), pointer :: input
76) type(option_type) :: option
77)
78) end subroutine Base_SkipBlock
79)
80) subroutine Base_React(this,Res,Jac,compute_derivative,rt_auxvar, &
81) global_auxvar,material_auxvar,reaction,option, &
82) RateDemand_nh4,RateSupply_nh4, &
83) JacobianDemand_nh4,JacobianSupply_nh4, &
84) RateDemand_no3,RateSupply_no3, &
85) JacobianDemand_no3,JacobianSupply_no3, &
86) Rate_nh4_to_no3,Jacobian_nh4_to_no3)
87)
88) use Option_module
89) use Reaction_Aux_module
90) use Reactive_Transport_Aux_module
91) use Global_Aux_module
92) use Material_Aux_class
93)
94) import clm_rxn_base_type
95)
96) implicit none
97)
98) class(clm_rxn_base_type) :: this
99) type(option_type) :: option
100) type(reaction_type) :: reaction
101) PetscBool :: compute_derivative
102) PetscReal :: Res(reaction%ncomp)
103) PetscReal :: Jac(reaction%ncomp,reaction%ncomp)
104) PetscReal :: RateDemand_nh4(reaction%ncomp)
105) PetscReal :: RateSupply_nh4(reaction%ncomp)
106) PetscReal :: JacobianDemand_nh4(reaction%ncomp,reaction%ncomp)
107) PetscReal :: JacobianSupply_nh4(reaction%ncomp,reaction%ncomp)
108) PetscReal :: RateDemand_no3(reaction%ncomp)
109) PetscReal :: RateSupply_no3(reaction%ncomp)
110) PetscReal :: JacobianDemand_no3(reaction%ncomp,reaction%ncomp)
111) PetscReal :: JacobianSupply_no3(reaction%ncomp,reaction%ncomp)
112) PetscReal :: Rate_nh4_to_no3
113) PetscReal :: Jacobian_nh4_to_no3(reaction%ncomp)
114) type(reactive_transport_auxvar_type) :: rt_auxvar
115) type(global_auxvar_type) :: global_auxvar
116) class(material_auxvar_type) :: material_auxvar
117)
118) end subroutine
119)
120) subroutine Base_Destroy(this)
121)
122) import clm_rxn_base_type
123)
124) implicit none
125)
126) class(clm_rxn_base_type) :: this
127)
128) end subroutine Base_Destroy
129)
130) end interface
131)
132) #else
133)
134) contains
135)
136) ! ************************************************************************** !
137)
138) subroutine Base_Setup(this,reaction,option)
139)
140) use Option_module
141) use Reaction_Aux_module
142)
143) implicit none
144)
145) class(clm_rxn_base_type) :: this
146) type(reaction_type) :: reaction
147) type(option_type) :: option
148)
149) end subroutine Base_Setup
150)
151) ! ************************************************************************** !
152)
153) subroutine Base_Read(this,input,option)
154)
155) use Option_module
156) use Input_Aux_module
157)
158) implicit none
159)
160) class(clm_rxn_base_type) :: this
161) type(input_type), pointer :: input
162) type(option_type) :: option
163)
164) end subroutine Base_Read
165)
166) ! ************************************************************************** !
167)
168) subroutine Base_SkipBlock(this,input,option)
169)
170) use Option_module
171) use Input_Aux_module
172)
173) implicit none
174)
175) class(clm_rxn_base_type) :: this
176) type(input_type), pointer :: input
177) type(option_type) :: option
178)
179) end subroutine Base_SkipBlock
180)
181) ! ************************************************************************** !
182)
183) subroutine Base_React(this,Residual,Jacobian,compute_derivative,rt_auxvar, &
184) global_auxvar,material_auxvar,reaction,option, &
185) RateDemand_nh4,RateSupply_nh4, &
186) JacobianDemand_nh4,JacobianSupply_nh4, &
187) RateDemand_no3,RateSupply_no3, &
188) JacobianDemand_no3,JacobianSupply_no3, &
189) Rate_nh4_to_no3,Jacobian_nh4_to_no3)
190) use Option_module
191) use Reaction_Aux_module
192) use Reactive_Transport_Aux_module
193) use Global_Aux_module
194) use Material_Aux_class
195)
196) implicit none
197)
198) class(clm_rxn_base_type) :: this
199) type(option_type) :: option
200) type(reaction_type) :: reaction
201) PetscBool :: compute_derivative
202) PetscReal :: Residual(reaction%ncomp)
203) PetscReal :: Jacobian(reaction%ncomp,reaction%ncomp)
204) PetscReal :: RateDemand_nh4(reaction%ncomp)
205) PetscReal :: RateSupply_nh4(reaction%ncomp)
206) PetscReal :: RateDemand_no3(reaction%ncomp)
207) PetscReal :: RateSupply_no3(reaction%ncomp)
208) PetscReal :: JacobianDemand_nh4(reaction%ncomp,reaction%ncomp)
209) PetscReal :: JacobianSupply_nh4(reaction%ncomp,reaction%ncomp)
210) PetscReal :: JacobianDemand_no3(reaction%ncomp,reaction%ncomp)
211) PetscReal :: JacobianSupply_no3(reaction%ncomp,reaction%ncomp)
212) PetscReal :: Rate_nh4_to_no3
213) PetscReal :: Jacobian_nh4_to_no3(reaction%ncomp)
214) type(reactive_transport_auxvar_type) :: rt_auxvar
215) type(global_auxvar_type) :: global_auxvar
216) class(material_auxvar_type) :: material_auxvar
217)
218) end subroutine
219)
220) ! ************************************************************************** !
221)
222) subroutine Base_Destroy(this)
223)
224) implicit none
225)
226) class(clm_rxn_base_type) :: this
227)
228) end subroutine Base_Destroy
229) #endif
230)
231) end module CLM_Rxn_Base_class
232)
233) module CLM_Rxn_Common_module
234)
235) implicit none
236)
237) private
238)
239) #include "petsc/finclude/petscsys.h"
240)
241) public :: CalNLimitFunc
242)
243) contains
244)
245) subroutine CalNLimitFunc(c_n, ac_n, &
246) residual, half_saturation, &
247) cutoff_0, cutoff_1, f_n, d_n)
248)
249) PetscReal c_n, ac_n, residual, half_saturation, cutoff_0, cutoff_1, f_n, d_n
250) PetscReal temp_real, regulator, dregulator, xxx, delta
251)
252) f_n = 1.0d0
253) d_n = 0.0d0
254)
255) if (half_saturation >= 1.0d-20) then
256) temp_real = (c_n - residual) * ac_n + half_saturation
257) f_n = (c_n - residual) * ac_n / temp_real
258) d_n = ac_n * half_saturation / temp_real / temp_real
259) endif
260)
261) if (cutoff_0 > 0.0d0) then
262)
263) ! additional down regulation for N uptake / immobimization
264) if (c_n <= cutoff_0) then
265) regulator = 0.0d0
266) dregulator = 0.0d0
267) elseif (c_n >= cutoff_1 .or. cutoff_1 - cutoff_0 <= 1.0d-20) then
268) regulator = 1.0d0
269) dregulator = 0.0d0
270) else
271) xxx = c_n - cutoff_0
272) delta = cutoff_1 - cutoff_0
273) regulator = 1.0d0 - (1.0d0 - xxx * xxx / delta / delta) ** 2
274) dregulator = 4.0d0 * (1.0d0 - xxx * xxx / delta / delta) * xxx &
275) / delta / delta
276) endif
277)
278) ! rate = rate_orginal * regulator
279) ! drate = drate_original * regulator + rate_orginal * dregulator
280) d_n = d_n * regulator + f_n * dregulator
281)
282) f_n = f_n * regulator
283)
284) endif
285)
286) end subroutine CalNLimitFunc
287)
288) end module CLM_Rxn_Common_module
289)
290) module CLM_Rxn_Decomp_class
291)
292) use CLM_Rxn_Base_class
293) use Global_Aux_module
294) use Reactive_Transport_Aux_module
295) use PFLOTRAN_Constants_module
296)
297) ! ------------------------------------------------------------------------------
298) ! Description
299) ! extended from reaction_sandbox_clmdec to implement demand based down regulation
300) ! for use in CLM_Rxn t6g 10/06/2014
301)
302) ! following is a description for clm_dec
303) ! to be used to implement CLM-CN, and CLM-Microbe decomposition reactions
304) ! extended from clm_rxn_clm_cn
305) ! 1) pools can be either immobile or aqueous species (e.g., DOM, acetate-, )
306) ! 2) separate N into NH3 (or NH4+) and NO3-; Must have NH3 or NH4+, NO3- is used
307) ! if it is specified in the input file
308) ! 3) include flexibilities to have multiple downstream pools, and variable
309) ! respiration fraction as in CLM-Microbe;
310) ! 4) add residual concentrations for upstream pools, NH3, and NO3- to
311) ! keep reactant concentrations above 0 (used if > 0);
312) ! 5) add shut off down regulation for NH3 and NO3- (used when the first > 0)
313) ! 6) include NH3 oxidation in decomposition using Parton et al. 2001 (used when
314) ! N2O(aq) is specified in the input file)
315) ! 7) add optional immobile species to track respiration, N mineralization, and
316) ! immobilization
317) ! Author: Guoping Tang
318) ! Date: 07/08/14
319) ! -----------------------------------------------------------------------------
320)
321) implicit none
322)
323) private
324)
325) #include "petsc/finclude/petscsys.h"
326)
327) PetscInt, parameter :: LITTER_DECOMP_CLMCN = 1
328) PetscInt, parameter :: LITTER_DECOMP_CLMMICROBE = 2
329)
330) ! 14.00674d0 / 12.011d0
331) PetscReal, parameter :: CN_ratio_mass_to_mol = 1.16616d0
332)
333) ! Sinsabaugh et al. 2013 Ecology Letters, 16, 930-939
334) PetscReal, parameter :: CN_ratio_microbe = 9.32928d0 ! 8.0d0
335) PetscReal, parameter :: CUE_max = 0.6d0
336)
337) type, public, &
338) extends(clm_rxn_base_type) :: clm_rxn_clmdec_type
339)
340) PetscInt :: temperature_response_function
341) PetscReal :: Q10
342) PetscInt :: moisture_response_function
343)
344) PetscInt :: litter_decomp_type ! CLM-CN or CLM-Microbe
345)
346) PetscReal :: half_saturation_nh4
347) PetscReal :: half_saturation_no3
348) PetscReal :: inhibition_nh4_no3
349) PetscReal :: n2o_frac_mineralization ! fraction of n2o from net N mineralization
350)
351) PetscReal :: residual_cpool
352) PetscReal :: residual_nh4
353) PetscReal :: residual_no3
354)
355) PetscReal :: cutoff_no3_0 ! shut off
356) PetscReal :: cutoff_no3_1 ! start to decrease from 1
357) PetscReal :: cutoff_nh4_0 ! shut off
358) PetscReal :: cutoff_nh4_1 ! start to decrease from 1
359)
360) PetscReal :: net_n_min_rate_smooth_0 ! start from 0
361) PetscReal :: net_n_min_rate_smooth_1 ! rise to 1
362)
363) PetscReal :: nc_bacteria
364) PetscReal :: nc_fungi
365) PetscReal :: fraction_bacteria
366)
367) PetscInt :: npool ! litter or variable CN ration pools
368) PetscReal, pointer :: pool_nc_ratio(:) ! NC ratio in mole npool
369)
370) PetscInt :: nrxn
371) PetscReal, pointer :: rate_constant(:) ! nrxn
372)
373) PetscBool, pointer :: is_litter_decomp(:) ! nrxn
374) PetscInt, pointer :: upstream_c_id(:) ! nrxn
375) PetscInt, pointer :: upstream_n_id(:) ! nrxn
376) PetscReal, pointer :: upstream_nc(:) ! nrxn
377) PetscBool, pointer :: upstream_is_aqueous(:) ! nrxn
378)
379) PetscInt, pointer :: n_downstream_pools(:) ! maximum # of downstream pools
380) PetscInt, pointer :: downstream_id(:,:) ! nrxn by maximum # of downstream pools
381) PetscBool, pointer :: downstream_is_aqueous(:,:) ! nrxn by maximum # of downstream pools
382) PetscReal, pointer :: downstream_stoich(:,:) ! nrxn by maximum # of downstream pools
383) PetscReal, pointer :: downstream_nc(:,:) ! nrxn by maximum # of downstream pools
384) PetscReal, pointer :: mineral_c_stoich(:) ! nrxn
385) PetscReal, pointer :: mineral_n_stoich(:) ! nrxn
386)
387) PetscInt :: species_id_co2
388) PetscInt :: species_id_nh4
389) PetscInt :: species_id_no3
390) PetscInt :: species_id_n2o
391) PetscInt :: species_id_dom
392) PetscInt :: species_id_bacteria
393) PetscInt :: species_id_fungi
394)
395) PetscInt :: species_id_hrimm
396) PetscInt :: species_id_nmin
397) PetscInt :: species_id_nimm
398) PetscInt :: species_id_ngasmin
399) PetscInt :: species_id_proton
400) PetscBool :: bdebugoutput
401) PetscBool :: bskipn2ojacobian
402) PetscBool :: is_NH4_aqueous
403) PetscBool :: is_NO3_aqueous
404)
405) type(pool_type), pointer :: pools
406) type(clmdec_reaction_type), pointer :: reactions
407) contains
408) procedure, public :: ReadInput => CLMDec_Read
409) procedure, public :: Setup => CLMDec_Setup
410) procedure, public :: Evaluate => CLMDec_React
411) procedure, public :: Destroy => CLMDec_Destroy
412) end type clm_rxn_clmdec_type
413)
414) type :: pool_type
415) character(len=MAXWORDLENGTH) :: name
416) PetscReal :: stoich
417) PetscReal :: nc_ratio
418) type(pool_type), pointer :: next
419) end type pool_type
420)
421) type :: clmdec_reaction_type
422) character(len=MAXWORDLENGTH) :: upstream_pool_name
423) type(pool_type), pointer :: downstream_pools
424) PetscReal :: rate_constant
425) type(clmdec_reaction_type), pointer :: next
426) end type clmdec_reaction_type
427)
428) public :: CLMDec_Create
429)
430) contains
431)
432) ! **************************************************************************** !
433)
434) function CLMDec_Create()
435) ! Allocates CLMDec reaction sandbox object.
436)
437) implicit none
438)
439) type(clm_rxn_clmdec_type), pointer :: CLMDec_Create
440)
441) allocate(CLMDec_Create)
442)
443) CLMDec_Create%Q10 = 1.5d0
444) CLMDec_Create%litter_decomp_type=LITTER_DECOMP_CLMCN
445) CLMDec_Create%half_saturation_nh4 = 1.0d-6
446) CLMDec_Create%half_saturation_no3 = 1.0d-6
447) CLMDec_Create%inhibition_nh4_no3 = -1.0d-15
448) CLMDec_Create%n2o_frac_mineralization = 0.02d0 ! Parton et al. 2001
449)
450) CLMDec_Create%residual_cpool = 1.0d-20
451) CLMDec_Create%residual_nh4 = 1.0d-10
452) CLMDec_Create%residual_no3 = 1.0d-10
453)
454) CLMDec_Create%cutoff_no3_0 = -1.0d-9
455) CLMDec_Create%cutoff_no3_1 = 1.0d-7
456) CLMDec_Create%cutoff_nh4_0 = -1.0d-9
457) CLMDec_Create%cutoff_nh4_1 = 1.0d-7
458)
459) CLMDec_Create%net_n_min_rate_smooth_0 = 0.0d0
460) CLMDec_Create%net_n_min_rate_smooth_1 = 1.0d-20
461)
462) CLMDec_Create%nc_bacteria = 0.17150d0
463)
464) ! CN_ratio_fungi = 17.4924d0 !15.0d0 ! or 10.0
465) CLMDec_Create%nc_fungi = 0.05717d0
466)
467) CLMDec_Create%fraction_bacteria = 0.340927d0
468)
469) CLMDec_Create%npool = 0
470)
471) nullify(CLMDec_Create%pool_nc_ratio)
472)
473) CLMDec_Create%nrxn = 0
474) nullify(CLMDec_Create%rate_constant)
475) nullify(CLMDec_Create%is_litter_decomp)
476) nullify(CLMDec_Create%upstream_c_id)
477) nullify(CLMDec_Create%upstream_n_id)
478) nullify(CLMDec_Create%upstream_nc)
479) nullify(CLMDec_Create%upstream_is_aqueous)
480)
481) nullify(CLMDec_Create%n_downstream_pools)
482) nullify(CLMDec_Create%downstream_id)
483) nullify(CLMDec_Create%downstream_is_aqueous)
484) nullify(CLMDec_Create%downstream_stoich)
485) nullify(CLMDec_Create%mineral_c_stoich)
486) nullify(CLMDec_Create%mineral_n_stoich)
487)
488) CLMDec_Create%species_id_co2 = 0
489) CLMDec_Create%species_id_nh4 = 0
490) CLMDec_Create%species_id_no3 = 0
491) CLMDec_Create%species_id_n2o = 0
492) CLMDec_Create%species_id_dom = 0
493) CLMDec_Create%species_id_proton = 0
494) CLMDec_Create%species_id_bacteria = 0
495) CLMDec_Create%species_id_fungi = 0
496) CLMDec_Create%species_id_hrimm = 0
497) CLMDec_Create%species_id_nmin = 0
498) CLMDec_Create%species_id_nimm = 0
499) CLMDec_Create%species_id_ngasmin = 0
500)
501) CLMDec_Create%is_NH4_aqueous = PETSC_TRUE
502) CLMDec_Create%is_NO3_aqueous = PETSC_TRUE
503) CLMDec_Create%bdebugoutput = PETSC_FALSE
504)
505) nullify(CLMDec_Create%next)
506) nullify(CLMDec_Create%pools)
507) nullify(CLMDec_Create%reactions)
508)
509) end function CLMDec_Create
510)
511) ! **************************************************************************** !
512)
513) subroutine CLMDec_Read(this,input,option)
514) !
515) ! Reads input deck for reaction sandbox parameters
516) !
517)
518) use Option_module
519) use String_module
520) use Input_Aux_module
521) use Utility_module
522) use Units_module, only : UnitsConvertToInternal
523)
524) implicit none
525)
526) class(clm_rxn_clmdec_type) :: this
527) type(input_type), pointer :: input
528) type(option_type) :: option
529)
530) character(len=MAXWORDLENGTH) :: word, internal_units
531)
532) type(pool_type), pointer :: new_pool, prev_pool
533) type(pool_type), pointer :: new_pool_rxn, prev_pool_rxn
534) type(clmdec_reaction_type), pointer :: new_reaction, prev_reaction
535)
536) PetscReal :: rate_constant, turnover_time
537) PetscReal :: temp_real
538)
539) nullify(new_pool)
540) nullify(prev_pool)
541)
542) nullify(new_pool_rxn)
543) nullify(prev_pool_rxn)
544)
545) nullify(new_reaction)
546) nullify(prev_reaction)
547)
548) do
549) call InputReadPflotranString(input,option)
550) if (InputError(input)) exit
551) if (InputCheckExit(input,option)) exit
552)
553) call InputReadWord(input,option,word,PETSC_TRUE)
554) call InputErrorMsg(input,option,'keyword', &
555) 'CHEMISTRY,CLM_RXN,CLMDec')
556) call StringToUpper(word)
557) select case(trim(word))
558)
559) case('CLM-MICROBE-LITTER-DECOMPOSITION')
560) this%litter_decomp_type = LITTER_DECOMP_CLMMICROBE
561)
562) case('RESIDUAL_CPOOL')
563) call InputReadDouble(input,option,this%residual_cpool)
564) call InputErrorMsg(input,option,'residual cpool', &
565) 'CHEMISTRY,CLM_RXN,CLMDec')
566)
567) case('RESIDUAL_NH4')
568) call InputReadDouble(input,option,this%residual_nh4)
569) call InputErrorMsg(input,option,'residual NH4+', &
570) 'CHEMISTRY,CLM_RXN,CLMDec')
571)
572) case('RESIDUAL_NO3')
573) call InputReadDouble(input,option,this%residual_no3)
574) call InputErrorMsg(input,option,'residual NO3-', &
575) 'CHEMISTRY,CLM_RXN,CLMDec')
576)
577) case('HALF_SATURATION_NH4')
578) call InputReadDouble(input,option,this%half_saturation_nh4)
579) call InputErrorMsg(input,option,'NH4 half saturation', &
580) 'CHEMISTRY,CLM_RXN,CLMDec')
581)
582) case('HALF_SATURATION_NO3')
583) call InputReadDouble(input,option,this%half_saturation_no3)
584) call InputErrorMsg(input,option,'NO3 half saturation', &
585) 'CHEMISTRY,CLM_RXN,CLMDec')
586)
587) case('CUTOFF_NH4')
588) call InputReadDouble(input,option,this%cutoff_nh4_0)
589) call InputErrorMsg(input,option,'cutoff_nh4_0', &
590) 'CHEMISTRY,CLM_RXN,CLMDec')
591) call InputReadDouble(input,option,this%cutoff_nh4_1)
592) call InputErrorMsg(input,option,'cutoff_nh4_1', &
593) 'CHEMISTRY,CLM_RXN,CLMDec')
594) if (this%cutoff_nh4_0 > this%cutoff_nh4_1) then
595) option%io_buffer = 'CHEMISTRY,CLM_RXN,CLMDec,' // &
596) 'NH4+ down regulation cut off concentration > concentration ' // &
597) 'where down regulation function = 1.'
598) call printErrMsg(option)
599) endif
600) case('CUTOFF_NO3')
601) call InputReadDouble(input,option,this%cutoff_no3_0)
602) call InputErrorMsg(input,option,'cutoff_no3_0', &
603) 'CHEMISTRY,CLM_RXN,CLMDec,')
604) call InputReadDouble(input,option,this%cutoff_no3_1)
605) call InputErrorMsg(input,option,'cutoff_no3_1', &
606) 'CHEMISTRY,CLM_RXN,CLMDec,')
607) if (this%cutoff_no3_0 > this%cutoff_no3_1) then
608) option%io_buffer = 'CHEMISTRY,CLM_RXN,CLMDec' // &
609) 'NO3- down regulation cut off concentration > concentration ' // &
610) 'where down regulation function = 1.'
611) call printErrMsg(option)
612) endif
613)
614) case('SMOOTH_NET_N_MINERALIZATION')
615) call InputReadDouble(input,option,this%net_n_min_rate_smooth_0)
616) call InputErrorMsg(input,option,'net_n_min_rate_smooth_0', &
617) 'CHEMISTRY,CLM_RXN,CLMDec')
618) call InputReadDouble(input,option,this%net_n_min_rate_smooth_1)
619) call InputErrorMsg(input,option,'net_n_min_rate_smooth_1', &
620) 'CHEMISTRY,CLM_RXN,CLMDec')
621) if (this%net_n_min_rate_smooth_0 > this%net_n_min_rate_smooth_1) then
622) option%io_buffer = 'CHEMISTRY,CLM_RXN,CLMDec,' // &
623) 'Net N mineralization smooth 0 concentration > 1 concentration.'
624) call printErrMsg(option)
625) endif
626)
627) case('DEBUG_OUTPUT')
628) this%bdebugoutput = PETSC_TRUE
629)
630) case('JACOBIAN_N2O_TRACKING_SKIP')
631) this%bskipn2ojacobian = PETSC_TRUE
632)
633) case('NH4_INHIBITION_NO3')
634) call InputReadDouble(input,option,this%inhibition_nh4_no3)
635) call InputErrorMsg(input,option,'NH4 inhibition coefficient', &
636) 'CHEMISTRY,CLM_RXN,CLMDec')
637)
638) case('N2O_FRAC_MINERALIZATION')
639) call InputReadDouble(input,option,this%n2o_frac_mineralization)
640) call InputErrorMsg(input,option,'n2o fraction from mineralization', &
641) 'CHEMISTRY,CLM_RXN,CLMDec')
642)
643) case('POOLS')
644) do
645) call InputReadPflotranString(input,option)
646) if (InputError(input)) exit
647) if (InputCheckExit(input,option)) exit
648)
649) allocate(new_pool)
650) new_pool%name = ''
651) new_pool%nc_ratio = -999.d0
652) nullify(new_pool%next)
653)
654) call InputReadWord(input,option,new_pool%name,PETSC_TRUE)
655) call InputErrorMsg(input,option,'pool name', &
656) 'CHEMISTRY,CLM_RXN,CLMDec,POOLS')
657) call InputReadDouble(input,option,temp_real)
658) if (InputError(input)) then
659) new_pool%nc_ratio = -999.d0
660) else
661) ! convert CN ratio from mass C/mass N to mol C/mol N
662) if (temp_real > 0.0d0 ) then
663) new_pool%nc_ratio = 1.0d0/temp_real/CN_ratio_mass_to_mol
664) endif
665) endif
666)
667) if (associated(this%pools)) then
668) prev_pool%next => new_pool
669) else
670) this%pools => new_pool
671) endif
672) prev_pool => new_pool
673) nullify(new_pool)
674) enddo
675)
676) case('REACTION')
677)
678) allocate(new_reaction)
679) new_reaction%upstream_pool_name = ''
680) new_reaction%rate_constant = -999.d0
681) nullify(new_reaction%downstream_pools)
682) nullify(new_reaction%next)
683)
684) ! need to set these temporarily in order to check that they
685) ! are not both set.
686) turnover_time = 0.d0
687) rate_constant = 0.d0
688)
689) do
690) call InputReadPflotranString(input,option)
691) if (InputError(input)) exit
692) if (InputCheckExit(input,option)) exit
693)
694) call InputReadWord(input,option,word,PETSC_TRUE)
695) call InputErrorMsg(input,option,'keyword', &
696) 'CHEMISTRY,CLM_RXN,CLMDec')
697) call StringToUpper(word)
698)
699) select case(trim(word))
700) case('UPSTREAM_POOL')
701) call InputReadWord(input,option, &
702) new_reaction%upstream_pool_name,PETSC_TRUE)
703) call InputErrorMsg(input,option,'upstream pool name', &
704) 'CHEMISTRY,CLM_RXN,CLMDec')
705) case('DOWNSTREAM_POOL')
706) allocate(new_pool_rxn)
707) new_pool_rxn%name = ''
708) new_pool_rxn%stoich = 0.d0
709) nullify(new_pool_rxn%next)
710)
711) call InputReadWord(input,option, &
712) new_pool_rxn%name,PETSC_TRUE)
713) call InputErrorMsg(input,option,'downstream pool name', &
714) 'CHEMISTRY,CLM_RXN,CLMDec')
715) call InputReadDouble(input,option,new_pool_rxn%stoich)
716) call InputErrorMsg(input,option,'Downstream pool stoich', &
717) 'CHEMISTRY,CLM_RXN,CLMDec' // &
718) 'TEMPERATURE RESPONSE FUNCTION')
719)
720) if (associated(new_reaction%downstream_pools)) then
721) prev_pool_rxn%next => new_pool_rxn
722) else
723) new_reaction%downstream_pools => new_pool_rxn
724) endif
725) prev_pool_rxn => new_pool_rxn
726) nullify(new_pool_rxn)
727)
728) case('RATE_CONSTANT')
729) internal_units = 'mol/L-s|1/s|L/mol-s'
730) call InputReadDouble(input,option,rate_constant)
731) call InputErrorMsg(input,option,'rate constant', &
732) 'CHEMISTRY,CLM_RXN,CLMDec,')
733) call InputReadWord(input,option,word,PETSC_TRUE)
734) if (InputError(input)) then
735) input%err_buf = 'CLMDec RATE CONSTANT UNITS'
736) call InputDefaultMsg(input,option)
737) else
738) rate_constant = rate_constant * &
739) UnitsConvertToInternal(word,internal_units,option)
740) endif
741) case('TURNOVER_TIME')
742) internal_units = 'sec'
743) call InputReadDouble(input,option,turnover_time)
744) call InputErrorMsg(input,option,'turnover time', &
745) 'CHEMISTRY,CLM_RXN,CLMDec')
746) call InputReadWord(input,option,word,PETSC_TRUE)
747) if (InputError(input)) then
748) input%err_buf = 'CLMDec TURNOVER TIME UNITS'
749) call InputDefaultMsg(input,option)
750) else
751) turnover_time = turnover_time * &
752) UnitsConvertToInternal(word,internal_units,option)
753) endif
754) case default
755) call InputKeywordUnrecognized(word, &
756) 'CHEMISTRY,CLM_RXN,CLMDec,REACTION',option)
757) end select
758) enddo
759)
760) ! check to ensure that one of turnover time or rate constant is set.
761) if (turnover_time > 0.d0 .and. rate_constant > 0.d0) then
762) option%io_buffer = 'Only TURNOVER_TIME or RATE_CONSTANT may ' // &
763) 'be included in a CLMDec reaction definition, but not both. ' // &
764) 'See reaction with upstream pool "' // &
765) trim(new_reaction%upstream_pool_name) // '".'
766) call printErrMsg(option)
767) else if (turnover_time > 0.d0) then
768) new_reaction%rate_constant = 1.d0 / turnover_time
769) else
770) new_reaction%rate_constant = rate_constant
771) endif
772) if (associated(this%reactions)) then
773) prev_reaction%next => new_reaction
774) else
775) this%reactions => new_reaction
776) endif
777) prev_reaction => new_reaction
778) nullify(new_reaction)
779) case default
780) call InputKeywordUnrecognized(word,'CHEMISTRY,CLM_RXN,CLMDec',option)
781) end select
782) enddo
783)
784) end subroutine CLMDec_Read
785)
786) ! **************************************************************************** !
787)
788) subroutine CLMDec_Setup(this,reaction,option)
789) !
790) ! Sets up CLMDec reaction after it has been read from input
791) !
792)
793) use Reaction_Aux_module
794) use Option_module
795) use String_module
796) use Reaction_Immobile_Aux_module
797) use Utility_module, only : DeallocateArray
798)
799) implicit none
800)
801) class(clm_rxn_clmdec_type) :: this
802) type(option_type) :: option
803) type(reaction_type) :: reaction
804)
805) character(len=MAXWORDLENGTH), allocatable :: pool_names(:)
806) character(len=MAXWORDLENGTH) :: word
807)
808) PetscInt, pointer :: species_id_pool_c(:)
809) PetscInt, pointer :: species_id_pool_n(:)
810) PetscBool, pointer :: pool_is_aqueous(:)
811)
812) PetscInt :: icount, jcount, max_downstream_pools, ipool
813) PetscReal :: stoich_c, stoich_n
814)
815) type(pool_type), pointer :: cur_pool
816) type(clmdec_reaction_type), pointer :: cur_rxn
817)
818) ! count # pools
819) icount = 0
820) cur_pool => this%pools
821) do
822) if (.not.associated(cur_pool)) exit
823) icount = icount + 1
824) cur_pool => cur_pool%next
825) enddo
826) this%npool = icount
827)
828) ! count # reactions
829) icount = 0
830) cur_rxn => this%reactions
831) do
832) if (.not.associated(cur_rxn)) exit
833) icount = icount + 1
834) cur_rxn => cur_rxn%next
835) enddo
836) this%nrxn = icount
837)
838) allocate(this%n_downstream_pools(this%nrxn))
839)
840) ! count # downstream pools in each reaction
841) max_downstream_pools = -1
842) icount = 0
843) cur_rxn => this%reactions
844) do
845) if (.not.associated(cur_rxn)) exit
846) icount = icount + 1
847)
848) jcount = 0
849) cur_pool => cur_rxn%downstream_pools
850)
851) do
852) if (.not.associated(cur_pool)) exit
853) jcount = jcount + 1
854) cur_pool => cur_pool%next
855) enddo
856)
857) this%n_downstream_pools(icount) = jcount
858)
859) if (max_downstream_pools < jcount) then
860) max_downstream_pools = jcount
861) endif
862)
863) cur_rxn => cur_rxn%next
864) enddo
865)
866) ! allocate and initialize arrays
867) allocate(this%pool_nc_ratio(this%npool))
868)
869) allocate(this%rate_constant(this%nrxn))
870) allocate(this%is_litter_decomp(this%nrxn))
871) allocate(this%upstream_c_id(this%nrxn))
872) allocate(this%upstream_n_id(this%nrxn))
873) allocate(this%upstream_nc(this%nrxn))
874) allocate(this%upstream_is_aqueous(this%nrxn))
875)
876) allocate(this%downstream_id(this%nrxn,max_downstream_pools))
877) allocate(this%downstream_stoich(this%nrxn,max_downstream_pools))
878) allocate(this%downstream_nc(this%nrxn,max_downstream_pools))
879) allocate(this%downstream_is_aqueous(this%nrxn,max_downstream_pools))
880) allocate(this%mineral_c_stoich(this%nrxn))
881) allocate(this%mineral_n_stoich(this%nrxn))
882)
883) this%pool_nc_ratio = 0.d0
884) this%rate_constant = 0.d0
885) this%is_litter_decomp = PETSC_FALSE
886) this%upstream_c_id = 0
887) this%upstream_n_id = 0
888) this%upstream_nc = -999.9
889) this%upstream_is_aqueous = PETSC_FALSE
890)
891) this%downstream_id = 0
892) this%downstream_is_aqueous = PETSC_FALSE
893) this%downstream_stoich = 0.d0
894) this%mineral_c_stoich = 0.d0
895) this%mineral_n_stoich = 0.d0
896)
897) ! temporary array for mapping pools in reactions
898) allocate(pool_names(this%npool))
899) allocate(pool_is_aqueous(this%npool))
900) allocate(species_id_pool_c(this%npool))
901) allocate(species_id_pool_n(this%npool))
902)
903) pool_names = ''
904) pool_is_aqueous = PETSC_FALSE
905) species_id_pool_c = -999
906) species_id_pool_n = -999
907)
908) ! pools
909) icount = 0
910) cur_pool => this%pools
911) do
912) if (.not.associated(cur_pool)) exit
913) icount = icount + 1
914) this%pool_nc_ratio(icount) = cur_pool%nc_ratio
915) pool_names(icount) = cur_pool%name
916)
917) if (cur_pool%nc_ratio < 0.d0) then
918) ! Since no CN ratio provided, must provide two species with the
919) ! same name as the pool with C or N appended.
920) word = trim(cur_pool%name) // 'C'
921) species_id_pool_c(icount) = &
922) GetImmobileSpeciesIDFromName(word,reaction%immobile, &
923) PETSC_FALSE,option)
924) word = trim(cur_pool%name) // 'N'
925) species_id_pool_n(icount) = &
926) GetImmobileSpeciesIDFromName(word,reaction%immobile, &
927) PETSC_FALSE,option)
928) if (species_id_pool_c(icount)<=0 .or. species_id_pool_n(icount)<=0) then
929) option%io_buffer = 'For CLMDec pools with no CN ratio defined, ' // &
930) 'the user must define two immobile species with the same root ' // &
931) 'name as the pool with "C" or "N" appended, respectively.'
932) call printErrMsg(option)
933) endif
934) else ! only one species (e.g. SOMX)
935) species_id_pool_c(icount) = &
936) GetImmobileSpeciesIDFromName(cur_pool%name,reaction%immobile, &
937) PETSC_FALSE,option)
938) if (species_id_pool_c(icount) <= 0) then
939) species_id_pool_c(icount) = GetPrimarySpeciesIDFromName( &
940) cur_pool%name, reaction, PETSC_FALSE,option)
941) if (species_id_pool_c(icount) <= 0) then
942) option%io_buffer = 'CLMDec pool: ' // cur_pool%name // 'is not ' // &
943) 'specified either in the IMMOBILE_SPECIES or PRIMARY_SPECIES!'
944) call printErrMsg(option)
945) else
946) pool_is_aqueous(icount) = PETSC_TRUE
947) endif
948) endif
949)
950) if (StringCompare(cur_pool%name, 'Bacteria')) then
951) this%nc_bacteria = cur_pool%nc_ratio
952) endif
953)
954) if (StringCompare(cur_pool%name, 'Fungi')) then
955) this%nc_fungi = cur_pool%nc_ratio
956) endif
957) endif
958) cur_pool => cur_pool%next
959) enddo
960)
961) ! reactions
962) icount = 0
963) cur_rxn => this%reactions
964) do
965) if (.not.associated(cur_rxn)) exit
966) ! upstream pools
967) icount = icount + 1
968) ipool = StringFindEntryInList(cur_rxn%upstream_pool_name,pool_names)
969) if (ipool == 0) then
970) option%io_buffer = 'Upstream pool ' // &
971) trim(cur_rxn%upstream_pool_name) // &
972) 'in reaction not found in list of pools.'
973) call printErrMsg(option)
974) else
975) this%upstream_c_id(icount) = species_id_pool_c(ipool)
976) this%upstream_n_id(icount) = species_id_pool_n(ipool)
977) this%upstream_nc(icount) = this%pool_nc_ratio(ipool)
978) this%upstream_is_aqueous(icount) = pool_is_aqueous(ipool)
979) if (this%upstream_n_id(icount) > 0) then
980) this%is_litter_decomp(icount) = PETSC_TRUE
981) else
982) if (this%upstream_nc(icount) < 0.0d0) then
983) option%io_buffer = 'SOM decomp. reaction with upstream pool ' // &
984) trim(cur_rxn%upstream_pool_name) // &
985) 'has negative C:N ratio in upstream pool.'
986) call printErrMsg(option)
987) endif
988) endif
989) endif
990)
991) ! downstream pools
992) jcount = 0
993) cur_pool => cur_rxn%downstream_pools
994)
995) do
996) if (.not.associated(cur_pool)) exit
997) jcount = jcount + 1
998)
999) if (len_trim(cur_pool%name) > 0) then
1000) ipool = StringFindEntryInList(cur_pool%name,pool_names)
1001) if (ipool == 0) then
1002) option%io_buffer = 'Downstream pool "' // trim(cur_pool%name) // &
1003) '" in reaction with upstream pool "' // &
1004) trim(cur_rxn%upstream_pool_name) // '" not found in list of pools.'
1005) call printErrMsg(option)
1006) else
1007) this%downstream_id(icount, jcount) = species_id_pool_c(ipool)
1008) this%downstream_stoich(icount, jcount) = cur_pool%stoich
1009) this%downstream_nc(icount, jcount) = this%pool_nc_ratio(ipool)
1010) this%downstream_is_aqueous(icount, jcount) = pool_is_aqueous(ipool)
1011)
1012) if (this%downstream_nc(icount,jcount) < 0.d0) then
1013) option%io_buffer = 'For CLMDec reactions, downstream pools ' // &
1014) 'must have a constant C:N ratio (i.e. C and N are not ' // &
1015) 'tracked individually). Therefore, pool "' // &
1016) trim(cur_pool%name) // &
1017) '" may not be used as a downstream pool.'
1018) call printErrMsg(option)
1019) endif
1020) endif
1021) endif
1022)
1023) cur_pool => cur_pool%next
1024)
1025) enddo
1026)
1027) this%rate_constant(icount) = cur_rxn%rate_constant
1028) cur_rxn => cur_rxn%next
1029) enddo
1030)
1031) deallocate(pool_names)
1032) call DeallocateArray(pool_is_aqueous)
1033) call DeallocateArray(species_id_pool_c)
1034) call DeallocateArray(species_id_pool_n)
1035)
1036) ! set stoichiometric coefficients for som decomposition reactions
1037) ! as they are constant due to fixed CN ratio
1038) do icount = 1, this%nrxn
1039) if (this%is_litter_decomp(icount)) then
1040) cycle
1041) else
1042) ! calculate respiration factor
1043) stoich_c = 1.0d0
1044) stoich_n = this%upstream_nc(icount)
1045)
1046) do jcount = 1, this%n_downstream_pools(icount)
1047) stoich_c = stoich_c - this%downstream_stoich(icount, jcount)
1048) stoich_n = stoich_n - this%downstream_stoich(icount, jcount) * &
1049) this%downstream_nc(icount, jcount)
1050) enddo
1051)
1052) if (stoich_c < -1.0d-10) then
1053) option%io_buffer = 'CLMDec SOM decomposition reaction has negative' // &
1054) ' respiration fraction!'
1055) call printErrMsg(option)
1056) endif
1057)
1058) this%mineral_c_stoich(icount) = stoich_c
1059) this%mineral_n_stoich(icount) = stoich_n
1060)
1061) endif
1062) enddo
1063)
1064) word = 'HCO3-'
1065) this%species_id_co2 = GetPrimarySpeciesIDFromName(word,reaction, &
1066) PETSC_FALSE,option)
1067)
1068) if (this%species_id_co2 < 0) then
1069) word = 'CO2(aq)'
1070) this%species_id_co2 = GetPrimarySpeciesIDFromName(word,reaction, &
1071) PETSC_FALSE,option)
1072) endif
1073)
1074) if (this%species_id_co2 <= 0) then
1075) option%io_buffer = 'Neither HCO3- nor CO2(aq) is specified in the ' // &
1076) 'input file for CLMDec!'
1077) call printErrMsg(option)
1078) endif
1079)
1080) word = 'NH4+'
1081) this%species_id_nh4 = GetPrimarySpeciesIDFromName(word,reaction, &
1082) PETSC_FALSE,option)
1083)
1084) if (this%species_id_nh4 < 0) then
1085) word = 'NH3(aq)'
1086) this%species_id_nh4 = GetPrimarySpeciesIDFromName(word,reaction, &
1087) PETSC_FALSE,option)
1088) endif
1089)
1090) if (this%species_id_nh4 < 0) then
1091) word = 'Ammonium'
1092) this%species_id_nh4 = GetImmobileSpeciesIDFromName( &
1093) word,reaction%immobile,PETSC_FALSE,option)
1094) if (this%species_id_nh4 > 0) then
1095) this%is_NH4_aqueous = PETSC_FALSE
1096) endif
1097) endif
1098)
1099) if (this%species_id_nh4 <= 0) then
1100) option%io_buffer = 'NH4+, NH3(aq) or Ammonium is specified in the input' // &
1101) 'file for CLMDec!'
1102) call printErrMsg(option)
1103) endif
1104)
1105) word = 'NO3-'
1106) this%species_id_no3 = GetPrimarySpeciesIDFromName(word,reaction, &
1107) PETSC_FALSE,option)
1108)
1109) if (this%species_id_no3 < 0) then
1110) word = 'Nitrate'
1111) this%species_id_no3 = GetImmobileSpeciesIDFromName( &
1112) word,reaction%immobile,PETSC_FALSE,option)
1113) if (this%species_id_no3 > 0) then
1114) this%is_NO3_aqueous = PETSC_FALSE
1115) endif
1116) endif
1117)
1118) word = 'N2O(aq)'
1119) this%species_id_n2o = GetPrimarySpeciesIDFromName(word,reaction, &
1120) PETSC_FALSE,option)
1121)
1122) word = 'H+'
1123) this%species_id_proton = GetPrimarySpeciesIDFromName(word,reaction, &
1124) PETSC_FALSE,option)
1125)
1126) word = 'Bacteria'
1127) this%species_id_bacteria = GetImmobileSpeciesIDFromName( &
1128) word,reaction%immobile,PETSC_FALSE,option)
1129)
1130) word = 'Fungi'
1131) this%species_id_fungi = GetImmobileSpeciesIDFromName( &
1132) word,reaction%immobile,PETSC_FALSE,option)
1133)
1134) word = 'HRimm'
1135) this%species_id_hrimm = GetImmobileSpeciesIDFromName( &
1136) word,reaction%immobile,PETSC_FALSE,option)
1137)
1138) word = 'Nmin'
1139) this%species_id_nmin = GetImmobileSpeciesIDFromName( &
1140) word,reaction%immobile,PETSC_FALSE,option)
1141)
1142) word = 'Nimm'
1143) this%species_id_nimm = GetImmobileSpeciesIDFromName( &
1144) word,reaction%immobile,PETSC_FALSE,option)
1145)
1146) word = 'NGASmin'
1147) this%species_id_ngasmin = GetImmobileSpeciesIDFromName( &
1148) word,reaction%immobile,PETSC_FALSE,option)
1149)
1150) if (this%species_id_bacteria > 0 .and. this%species_id_fungi > 0 .and. &
1151) this%nc_bacteria > 0.0d0 .and. this%nc_fungi > 0.0d0 ) then
1152) this%fraction_bacteria = (1.0d0/this%nc_bacteria) ** 0.6d0 / &
1153) ((1.0d0/this%nc_bacteria) ** 0.6d0 + (1.0d0/this%nc_fungi) ** 0.6d0)
1154) endif
1155)
1156) end subroutine CLMDec_Setup
1157)
1158) ! ************************************************************************** !
1159) subroutine CLMDec_React(this,Residual,Jacobian,compute_derivative,rt_auxvar, &
1160) global_auxvar,material_auxvar,reaction,option, &
1161) RateDemand_nh4,RateSupply_nh4, &
1162) JacobianDemand_nh4,JacobianSupply_nh4, &
1163) RateDemand_no3,RateSupply_no3, &
1164) JacobianDemand_no3,JacobianSupply_no3, &
1165) Rate_nh4_to_no3,Jacobian_nh4_to_no3)
1166) !
1167) ! Evaluates reaction storing residual and/or Jacobian
1168) !
1169)
1170) use Option_module
1171) use Reaction_Aux_module
1172) use Material_Aux_class, only : material_auxvar_type
1173) use CLM_Rxn_Common_module, only: CalNLimitFunc
1174)
1175) implicit none
1176)
1177) class(clm_rxn_clmdec_type) :: this
1178) type(option_type) :: option
1179) type(reaction_type) :: reaction
1180) type(reactive_transport_auxvar_type) :: rt_auxvar
1181) type(global_auxvar_type) :: global_auxvar
1182) class(material_auxvar_type) :: material_auxvar
1183)
1184) PetscBool :: compute_derivative
1185) PetscReal :: Residual(reaction%ncomp)
1186) PetscReal :: Jacobian(reaction%ncomp,reaction%ncomp)
1187) PetscReal :: RateDemand_nh4(reaction%ncomp)
1188) PetscReal :: RateSupply_nh4(reaction%ncomp)
1189) PetscReal :: JacobianDemand_nh4(reaction%ncomp,reaction%ncomp)
1190) PetscReal :: JacobianSupply_nh4(reaction%ncomp,reaction%ncomp)
1191) PetscReal :: RateDemand_no3(reaction%ncomp)
1192) PetscReal :: RateSupply_no3(reaction%ncomp)
1193) PetscReal :: JacobianDemand_no3(reaction%ncomp,reaction%ncomp)
1194) PetscReal :: JacobianSupply_no3(reaction%ncomp,reaction%ncomp)
1195) PetscReal :: Rate_nh4_to_no3
1196) PetscReal :: Jacobian_nh4_to_no3(reaction%ncomp)
1197) PetscReal :: porosity
1198) PetscReal :: volume
1199) PetscReal :: saturation
1200) PetscErrorCode :: ierr
1201) PetscInt :: local_id
1202)
1203) PetscReal :: theta
1204) PetscReal :: psi
1205)
1206) PetscReal :: c_nh4 ! concentration (mole/L)
1207) PetscReal :: ac_nh4 ! activity coefficient
1208) PetscReal :: f_nh4 ! nh4 / (half_saturation + nh4)
1209) PetscReal :: d_nh4 ! half_saturation / (half_saturation + nh4)^2
1210) PetscReal :: f_nh4_inhibit ! inhibition_coef/(inhibition_coef + nh4)
1211) PetscReal :: d_nh4_inhibit_dnh4 ! -inhibition_coef/(inhibition_coef + nh4)^2
1212)
1213) PetscReal :: c_no3 ! concentration (mole/L)
1214) PetscReal :: ac_no3 ! activity coefficient
1215) PetscReal :: f_no3 ! no3 / (half_saturation + no3)
1216) PetscReal :: d_no3 ! half_saturation/(no3 + half_saturation)^2
1217) PetscReal :: temp_real
1218)
1219) PetscInt :: irxn
1220) PetscInt :: ipool_up, ipool_down
1221) PetscReal :: CN_ratio_up, CN_ratio_down
1222) PetscBool :: constant_CN_ratio_up
1223) PetscReal :: resp_frac
1224)
1225) PetscReal :: c_uc, c_un ! upstream c pool, n pool concentration
1226) PetscReal :: ac_uc, ac_un ! activity coefficient, if aqueous
1227)
1228) PetscInt :: ispec_uc, ispec_un, ispec_d ! species id for upstream C, N, and downstream
1229) PetscInt :: ires_uc, ires_un, ires_d ! id used for residual and Jacobian
1230) PetscInt :: ires_co2, ires_nh4, ires_n2o, ires_no3
1231) PetscInt :: ires_hrimm, ires_nmin, ires_nimm, ires_ngasmin
1232) PetscReal :: stoich_c, stoich_n
1233)
1234) PetscReal :: scaled_rate_const
1235)
1236) PetscReal :: rate_nh4 ! mole/s
1237) PetscReal :: drate_nh4_duc ! d Rate / d upstream c
1238) PetscReal :: drate_nh4_dnh4 ! d Rate / d nh4 ammonia limitation
1239)
1240) PetscReal :: Rdu_duc, Rdn_duc, Rdc_duc, Rdb_duc, Rdf_duc ! u = Lit1N/Lit1C, c, b, f for CLM-Microbe
1241) PetscReal :: Rdu_dun, Rdn_dun, Rdc_dun, Rdb_dun, Rdf_dun
1242) PetscReal :: Rno3du_duc, Rno3dn_duc, Rno3dc_duc, Rno3db_duc, Rno3df_duc
1243) PetscReal :: Rno3du_dun, Rno3dn_dun, Rno3dc_dun, Rno3db_dun, Rno3df_dun
1244)
1245) ! for N immobilization reactions with NO3 as N source
1246) PetscReal :: rate_no3 ! mole/s
1247) PetscReal :: drate_no3_dno3 ! d Rate_no3 / d no3
1248) PetscReal :: drate_no3_duc ! d Rate_no3 / d uc
1249) PetscReal :: drate_no3_dnh4 ! d Rate_no3 / d nh4
1250)
1251) PetscInt :: i, j
1252) PetscReal :: tc ! temperature in C
1253) PetscReal :: f_t ! temperature response function
1254) PetscReal :: f_w ! moisture response function
1255)
1256) ! save mineral N fraction and decomposition rate for net N mineralization and N2O calculation
1257) PetscReal :: net_n_mineralization_rate
1258) PetscReal :: dnet_n_mineralization_rate_dnh4
1259) PetscReal :: dnet_n_mineralization_rate_dno3
1260) PetscReal :: dnet_n_mineralization_rate_duc(this%nrxn)
1261) PetscReal :: ph, f_ph
1262) PetscReal :: rate_n2o, drate_n2o_dnh4, drate_n2o_dno3, drate_n2o_duc
1263) PetscReal :: f_rate_n2o, df_rate_n2o
1264)
1265) PetscInt :: ires_b, ires_f
1266) PetscReal :: xxx, delta, regulator, dregulator
1267)
1268) porosity = material_auxvar%porosity
1269) volume = material_auxvar%volume
1270) ires_nh4 = -999
1271) ires_no3 = -999
1272)
1273) if (this%is_NH4_aqueous) then
1274) c_nh4 = rt_auxvar%pri_molal(this%species_id_nh4)
1275) ac_nh4 = rt_auxvar%pri_act_coef(this%species_id_nh4)
1276) ires_nh4 = this%species_id_nh4
1277) else
1278) c_nh4 = rt_auxvar%immobile(this%species_id_nh4)
1279) ac_nh4 = 1.0d0
1280) ires_nh4 = this%species_id_nh4 + reaction%offset_immobile
1281) endif
1282)
1283) call CalNLimitFunc(c_nh4, ac_nh4, this%residual_nh4, &
1284) this%half_saturation_nh4, this%cutoff_nh4_0, this%cutoff_nh4_1, &
1285) f_nh4, d_nh4)
1286)
1287) f_nh4_inhibit = 1.0d0
1288) d_nh4_inhibit_dnh4 = 0.0d0
1289)
1290) if (this%species_id_no3 > 0) then
1291) if (this%is_NO3_aqueous) then
1292) c_no3 = rt_auxvar%pri_molal(this%species_id_no3)
1293) ac_no3 = rt_auxvar%pri_act_coef(this%species_id_no3)
1294) ires_no3 = this%species_id_no3
1295) else
1296) c_no3 = rt_auxvar%immobile(this%species_id_no3)
1297) ac_no3 = 1.0d0
1298) ires_no3 = this%species_id_no3 + reaction%offset_immobile
1299) endif
1300)
1301) call CalNLimitFunc(c_no3, ac_no3, this%residual_no3, &
1302) this%half_saturation_no3, this%cutoff_no3_0, this%cutoff_no3_1, &
1303) f_no3, d_no3)
1304)
1305) if (this%inhibition_nh4_no3 > this%residual_nh4) then
1306) temp_real = this%inhibition_nh4_no3 + c_nh4 * ac_nh4
1307) f_nh4_inhibit = this%inhibition_nh4_no3/temp_real
1308) if (compute_derivative) then
1309) d_nh4_inhibit_dnh4 = -1.0d0 * this%inhibition_nh4_no3 * ac_nh4 &
1310) / temp_real / temp_real
1311) endif
1312) endif
1313) endif
1314)
1315) ires_co2 = this%species_id_co2
1316) ires_n2o = this%species_id_n2o
1317)
1318) ires_un = -999
1319) ires_hrimm = -999
1320) ires_nmin = -999
1321) ires_nimm = -999
1322) ires_b = -999
1323) ires_f = -999
1324) ires_ngasmin = -999
1325)
1326) if (this%species_id_hrimm > 0) then
1327) ires_hrimm = this%species_id_hrimm + reaction%offset_immobile
1328) endif
1329)
1330) if (this%species_id_nmin > 0) then
1331) ires_nmin = this%species_id_nmin + reaction%offset_immobile
1332) endif
1333)
1334) if (this%species_id_nimm > 0) then
1335) ires_nimm = this%species_id_nimm + reaction%offset_immobile
1336) endif
1337)
1338) if (this%species_id_ngasmin > 0) then
1339) ires_ngasmin = this%species_id_ngasmin + reaction%offset_immobile
1340) endif
1341)
1342) ! temperature response function
1343) tc = global_auxvar%temp
1344)
1345) f_t = 1.0d0
1346)
1347) saturation = global_auxvar%sat(1)
1348) theta = saturation * porosity
1349) ! if positive, saturated soil's psi is nearly zero
1350) psi = min(global_auxvar%pres(1) - option%reference_pressure, -1.d-20)
1351)
1352) ! moisture response function
1353) f_w = 1.0d0
1354)
1355) if (f_t < 1.0d-20 .or. f_w < 1.0d-20) then
1356) return
1357) endif
1358)
1359) if (this%species_id_n2o > 0) then
1360) net_n_mineralization_rate = 0.0d0
1361) dnet_n_mineralization_rate_dnh4 = 0.0d0
1362) dnet_n_mineralization_rate_dno3 = 0.0d0
1363) do irxn = 1, this%nrxn
1364) dnet_n_mineralization_rate_duc(irxn) = 0.0d0
1365) enddo
1366) endif
1367)
1368) drate_nh4_duc = 0.0d0
1369) rdu_dun = 0.0d0
1370) rdu_duc = 0.0d0
1371) rdn_dun = 0.0d0
1372) rdn_duc = 0.0d0
1373) rdb_dun = 0.0d0
1374) rdb_duc = 0.0d0
1375) rdf_dun = 0.0d0
1376) rdf_duc = 0.0d0
1377) rdc_dun = 0.0d0
1378) rdc_duc = 0.0d0
1379)
1380) rate_no3 = 0.0d0
1381) drate_no3_duc = 0.0d0
1382) drate_no3_dnh4 = 0.0d0
1383) drate_no3_dno3 = 0.0d0
1384) rno3du_dun = 0.0d0
1385) rno3du_duc = 0.0d0
1386) rno3dn_dun = 0.0d0
1387) rno3dn_duc = 0.0d0
1388) rno3db_dun = 0.0d0
1389) rno3db_duc = 0.0d0
1390) rno3df_dun = 0.0d0
1391) rno3df_duc = 0.0d0
1392) rno3dc_dun = 0.0d0
1393) rno3dc_duc = 0.0d0
1394)
1395) resp_frac = 0.0d0
1396)
1397) do irxn = 1, this%nrxn
1398)
1399) ! upstream pool
1400) ispec_uc = this%upstream_c_id(irxn)
1401)
1402) if (this%upstream_is_aqueous(irxn)) then
1403) c_uc = rt_auxvar%pri_molal(ispec_uc)
1404) ac_uc = rt_auxvar%pri_act_coef(ispec_uc)
1405) ires_uc = ispec_uc
1406) else
1407) c_uc = rt_auxvar%immobile(ispec_uc)
1408) ac_uc = 1.0d0
1409) ires_uc = reaction%offset_immobile + ispec_uc
1410) endif
1411)
1412) ! for litter decomposition reactions, stoich needs to be calculated on the fly
1413) if (this%is_litter_decomp(irxn)) then
1414)
1415) ispec_un = this%upstream_n_id(irxn)
1416) if (this%upstream_is_aqueous(irxn)) then
1417) c_un = rt_auxvar%pri_molal(ispec_un)
1418) ac_un = rt_auxvar%pri_act_coef(ispec_un)
1419) ires_un = ispec_un
1420) else
1421) c_un = rt_auxvar%immobile(ispec_un)
1422) ac_un = 1.0d0
1423) ires_un = ispec_un + reaction%offset_immobile
1424) endif
1425) this%upstream_nc(irxn) = c_un / c_uc
1426)
1427) if (this%litter_decomp_type == LITTER_DECOMP_CLMCN) then
1428)
1429) ! calculate respiration factor (CO2 stoichiometry)
1430) stoich_c = 1.0d0
1431)
1432) do j = 1, this%n_downstream_pools(irxn)
1433) stoich_c = stoich_c - this%downstream_stoich(irxn, j)
1434) enddo
1435)
1436) if (stoich_c < 0.0d0) then
1437) option%io_buffer = 'CLMDec litter decomposition reaction has' // &
1438) 'negative respiration fraction!'
1439) call printErrMsg(option)
1440) endif
1441)
1442) this%mineral_c_stoich(irxn) = stoich_c
1443)
1444) ! calculate N stoichiometry
1445) stoich_n = this%upstream_nc(irxn)
1446)
1447) do j = 1, this%n_downstream_pools(irxn)
1448) stoich_n = stoich_n - this%downstream_stoich(irxn, j) * &
1449) this%downstream_nc(irxn, j)
1450) enddo
1451)
1452) this%mineral_n_stoich(irxn) = stoich_n
1453)
1454) elseif (this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
1455)
1456) ! Sinsabaugh et al. 2013 Ecology Letters, 16, 930-939
1457) resp_frac = CN_ratio_microbe * this%upstream_nc(irxn) !c_un/c_uc
1458)
1459) if (resp_frac > CUE_max) then
1460) resp_frac = CUE_max
1461) endif
1462)
1463) ! c pools
1464) this%mineral_c_stoich(irxn) = resp_frac
1465)
1466) if (this%n_downstream_pools(irxn) .ne. 2) then
1467) option%io_buffer = 'CLM_Microbe litter decomposition reaction ' // &
1468) 'more than 2 (bacteria and fungi pools)!'
1469) call printErrMsg(option)
1470) endif
1471)
1472) do i = 1, this%n_downstream_pools(irxn)
1473) if (this%downstream_id(irxn, i) == this%species_id_bacteria) then
1474) this%downstream_stoich(irxn, i) = this%fraction_bacteria * &
1475) (1.0d0 - resp_frac)
1476) else
1477) this%downstream_stoich(irxn, i) = (1.0d0 - this%fraction_bacteria) &
1478) * (1.0d0 - resp_frac)
1479) endif
1480) enddo
1481)
1482) stoich_n = this%upstream_nc(irxn)
1483)
1484) do j = 1, this%n_downstream_pools(irxn)
1485) stoich_n = stoich_n - this%downstream_stoich(irxn, j) * &
1486) this%downstream_nc(irxn, j)
1487) enddo
1488)
1489) this%mineral_n_stoich(irxn) = stoich_n
1490)
1491) endif
1492)
1493) endif
1494)
1495) if (this%upstream_is_aqueous(irxn)) then
1496) ! scaled_rate_const units: (kg water / s) = (1/s) * (kg water)
1497) scaled_rate_const = this%rate_constant(irxn) * volume * f_t * f_w &
1498) * 1000.0d0 * theta
1499) ! will need to replace 1000.0d0 with water density
1500) else
1501) ! scaled_rate_const units: (m^3 bulk / s) = (1/s) * (m^3 bulk)
1502) scaled_rate_const = this%rate_constant(irxn)*volume*f_t*f_w
1503) endif
1504)
1505) ! residual units: (mol/sec) = (kg water/s) * (mol/kg water) or
1506) ! residual units: (mol/sec) = (m^3 bulk/s) * (mol/m^3 bulk)
1507) rate_nh4 = scaled_rate_const * (c_uc - this%residual_cpool) * ac_uc
1508)
1509) if (compute_derivative) then
1510) drate_nh4_duc = scaled_rate_const * ac_uc
1511) endif
1512)
1513) ! NH4 limiting
1514) if (this%mineral_n_stoich(irxn) < 0.0d0) then
1515) if (compute_derivative) then
1516) drate_nh4_dnh4 = rate_nh4 * d_nh4
1517) endif
1518) rate_nh4 = rate_nh4 * f_nh4
1519) if (compute_derivative) then
1520) drate_nh4_duc = drate_nh4_duc * f_nh4
1521) endif
1522) else
1523) drate_nh4_dnh4 = 0.d0
1524) endif
1525)
1526) ! CO2
1527) Residual(ires_co2) = Residual(ires_co2) - &
1528) this%mineral_c_stoich(irxn) * rate_nh4
1529) if (this%species_id_hrimm > 0) then
1530) Residual(ires_hrimm) = Residual(ires_hrimm) - &
1531) this%mineral_c_stoich(irxn) * rate_nh4
1532) endif
1533)
1534) ! NH4
1535) Residual(ires_nh4) = Residual(ires_nh4) - &
1536) this%mineral_n_stoich(irxn) * rate_nh4
1537)
1538) if (this%species_id_nimm > 0 .and. this%mineral_n_stoich(irxn) < 0.0d0) then
1539) Residual(ires_nimm) = Residual(ires_nimm) + &
1540) this%mineral_n_stoich(irxn) * rate_nh4
1541) endif
1542)
1543) if (this%species_id_nmin > 0 .and. this%mineral_n_stoich(irxn) > 0.0d0) then
1544) Residual(ires_nmin) = Residual(ires_nmin) - &
1545) this%mineral_n_stoich(irxn) * rate_nh4
1546) endif
1547)
1548) ! upstream c
1549) Residual(ires_uc) = Residual(ires_uc) - (-1.d0) * rate_nh4
1550)
1551) ! upstream n
1552) if (this%is_litter_decomp(irxn)) then
1553) Residual(ires_un) = Residual(ires_un) - &
1554) (-1.d0) * this%upstream_nc(irxn) * rate_nh4
1555) endif
1556)
1557) ! downstream pools
1558) do j = 1, this%n_downstream_pools(irxn)
1559) ispec_d = this%downstream_id(irxn, j)
1560) if (this%downstream_is_aqueous(irxn, j)) then
1561) ires_d = ispec_d
1562) else
1563) ires_d = reaction%offset_immobile + ispec_d
1564) endif
1565) if (ispec_d > 0) then
1566) Residual(ires_d) = Residual(ires_d) - &
1567) this%downstream_stoich(irxn, j) * rate_nh4
1568) endif
1569) enddo
1570)
1571) ! separate sink and source term for using NH4+ as nutrient
1572) if (this%mineral_n_stoich(irxn) >= 0.0d0 ) then
1573) RateSupply_nh4(ires_co2) = RateSupply_nh4(ires_co2) - &
1574) this%mineral_c_stoich(irxn) * rate_nh4
1575)
1576) if (this%species_id_hrimm > 0) then
1577) RateSupply_nh4(ires_hrimm) = RateSupply_nh4(ires_hrimm) - &
1578) this%mineral_c_stoich(irxn) * rate_nh4
1579) endif
1580)
1581) RateSupply_nh4(ires_nh4) = RateSupply_nh4(ires_nh4) - &
1582) this%mineral_n_stoich(irxn) * rate_nh4
1583)
1584) if (this%species_id_nmin > 0) then
1585) RateSupply_nh4(ires_nmin) = RateSupply_nh4(ires_nmin) - &
1586) this%mineral_n_stoich(irxn) * rate_nh4
1587) endif
1588)
1589) ! upstream c
1590) RateSupply_nh4(ires_uc) = RateSupply_nh4(ires_uc) - (-1.d0) * rate_nh4
1591)
1592) ! upstream n
1593) if (this%is_litter_decomp(irxn)) then
1594) RateSupply_nh4(ires_un) = RateSupply_nh4(ires_un) - &
1595) (-1.d0) * this%upstream_nc(irxn) * rate_nh4
1596) endif
1597)
1598) ! downstream pools
1599) do j = 1, this%n_downstream_pools(irxn)
1600) ispec_d = this%downstream_id(irxn, j)
1601) if (this%downstream_is_aqueous(irxn, j)) then
1602) ires_d = ispec_d
1603) else
1604) ires_d = reaction%offset_immobile + ispec_d
1605) endif
1606) if (ispec_d > 0) then
1607) RateSupply_nh4(ires_d) = RateSupply_nh4(ires_d) - &
1608) this%downstream_stoich(irxn, j) * rate_nh4
1609) endif
1610) enddo
1611)
1612) else
1613) RateDemand_nh4(ires_co2) = RateDemand_nh4(ires_co2) - &
1614) this%mineral_c_stoich(irxn) * rate_nh4
1615)
1616) if (this%species_id_hrimm > 0) then
1617) RateDemand_nh4(ires_hrimm) = RateDemand_nh4(ires_hrimm) - &
1618) this%mineral_c_stoich(irxn) * rate_nh4
1619) endif
1620)
1621) RateDemand_nh4(ires_nh4) = RateDemand_nh4(ires_nh4) - &
1622) this%mineral_n_stoich(irxn) * rate_nh4
1623)
1624) if (this%species_id_nimm > 0) then
1625) RateDemand_nh4(ires_nimm) = RateDemand_nh4(ires_nimm) + &
1626) this%mineral_n_stoich(irxn) * rate_nh4
1627) endif
1628)
1629) ! upstream c
1630) RateDemand_nh4(ires_uc) = RateDemand_nh4(ires_uc) - (-1.d0) * rate_nh4
1631)
1632) ! upstream n
1633) if (this%is_litter_decomp(irxn)) then
1634) RateDemand_nh4(ires_un) = RateDemand_nh4(ires_un) - &
1635) (-1.d0) * this%upstream_nc(irxn) * rate_nh4
1636) endif
1637)
1638) ! downstream pools
1639) do j = 1, this%n_downstream_pools(irxn)
1640) ispec_d = this%downstream_id(irxn, j)
1641) if (this%downstream_is_aqueous(irxn, j)) then
1642) ires_d = ispec_d
1643) else
1644) ires_d = reaction%offset_immobile + ispec_d
1645) endif
1646) if (ispec_d > 0) then
1647) RateDemand_nh4(ires_d) = RateDemand_nh4(ires_d) - &
1648) this%downstream_stoich(irxn, j) * rate_nh4
1649) endif
1650) enddo
1651) endif
1652)
1653) if (this%species_id_n2o > 0) then
1654) net_n_mineralization_rate = net_n_mineralization_rate + &
1655) this%mineral_n_stoich(irxn) * rate_nh4
1656)
1657) if (compute_derivative) then
1658) dnet_n_mineralization_rate_dnh4 = dnet_n_mineralization_rate_dnh4 + &
1659) this%mineral_n_stoich(irxn) * drate_nh4_dnh4
1660) dnet_n_mineralization_rate_duc(irxn) = &
1661) dnet_n_mineralization_rate_duc(irxn) + &
1662) this%mineral_n_stoich(irxn) * drate_nh4_duc
1663) endif
1664) endif
1665)
1666) ! start residual calculation for N immobilization reaction with NO3 uptake
1667) ! if nitrate is available, N immobilization decomposition reactions occurs
1668) ! with rate depending on NH4, with reduced rate if NH4 is abundent
1669) if (this%species_id_no3 > 0 .and. this%mineral_n_stoich(irxn) < 0.d0) then
1670)
1671) rate_no3 = scaled_rate_const * (c_uc - this%residual_cpool) &
1672) * ac_uc * f_no3 * f_nh4_inhibit
1673)
1674) if (compute_derivative) then
1675) drate_no3_duc = scaled_rate_const * ac_uc * f_no3 * f_nh4_inhibit
1676) drate_no3_dno3 = scaled_rate_const * (c_uc - this%residual_cpool) &
1677) * ac_uc * d_no3 * f_nh4_inhibit
1678) drate_no3_dnh4 = scaled_rate_const * (c_uc - this%residual_cpool) &
1679) * ac_uc * f_no3 * d_nh4_inhibit_dnh4
1680) endif
1681)
1682) ! carbon
1683) Residual(ires_co2) = Residual(ires_co2) - &
1684) this%mineral_c_stoich(irxn) * rate_no3
1685) if (this%species_id_hrimm > 0) then
1686) Residual(ires_hrimm) = Residual(ires_hrimm) - &
1687) this%mineral_c_stoich(irxn) * rate_no3
1688) endif
1689)
1690) ! NO3
1691) Residual(ires_no3) = Residual(ires_no3) - &
1692) this%mineral_n_stoich(irxn) * rate_no3
1693)
1694) if (this%species_id_nimm > 0) then
1695) Residual(ires_nimm) = Residual(ires_nimm) + &
1696) this%mineral_n_stoich(irxn) * rate_no3
1697) endif
1698)
1699) ! upstream c
1700) Residual(ires_uc) = Residual(ires_uc) - (-1.d0) * rate_no3
1701)
1702) ! upstream n
1703) if (this%is_litter_decomp(irxn)) then
1704) Residual(ires_un) = Residual(ires_un) + this%upstream_nc(irxn) *rate_no3
1705) endif
1706)
1707) ! downstream pools
1708) do j = 1, this%n_downstream_pools(irxn)
1709) ispec_d = this%downstream_id(irxn, j)
1710) if (this%downstream_is_aqueous(irxn, j)) then
1711) ires_d = ispec_d
1712) else
1713) ires_d = reaction%offset_immobile + ispec_d
1714) endif
1715) if (ispec_d > 0) then
1716) Residual(ires_d) = Residual(ires_d) - &
1717) this%downstream_stoich(irxn, j) * rate_no3
1718) endif
1719) enddo
1720)
1721) ! separate sink and source for using NO3- as nutrient
1722) RateDemand_no3(ires_co2) = RateDemand_no3(ires_co2) - &
1723) this%mineral_c_stoich(irxn) * rate_no3
1724)
1725) if (this%species_id_hrimm > 0) then
1726) RateDemand_no3(ires_hrimm) = RateDemand_no3(ires_hrimm) - &
1727) this%mineral_c_stoich(irxn) * rate_no3
1728) endif
1729)
1730) RateDemand_no3(ires_no3) = RateDemand_no3(ires_no3) - &
1731) this%mineral_n_stoich(irxn) * rate_no3
1732)
1733) if (this%species_id_nimm > 0) then
1734) RateDemand_no3(ires_nimm) = RateDemand_no3(ires_nimm) + &
1735) this%mineral_n_stoich(irxn) * rate_no3
1736) endif
1737)
1738) ! upstream c
1739) RateDemand_no3(ires_uc) = RateDemand_no3(ires_uc) - (-1.d0) * rate_no3
1740)
1741) ! upstream n
1742) if (this%is_litter_decomp(irxn)) then
1743) RateDemand_no3(ires_un) = RateDemand_no3(ires_un) + &
1744) this%upstream_nc(irxn) * rate_no3
1745) endif
1746)
1747) ! downstream pools
1748) do j = 1, this%n_downstream_pools(irxn)
1749) ispec_d = this%downstream_id(irxn, j)
1750) if (this%downstream_is_aqueous(irxn, j)) then
1751) ires_d = ispec_d
1752) else
1753) ires_d = reaction%offset_immobile + ispec_d
1754) endif
1755) if (ispec_d > 0) then
1756) RateDemand_no3(ires_d) = RateDemand_no3(ires_d) - &
1757) this%downstream_stoich(irxn, j) * rate_no3
1758) endif
1759) enddo
1760)
1761) if (this%species_id_n2o > 0) then
1762) net_n_mineralization_rate = net_n_mineralization_rate + &
1763) this%mineral_n_stoich(irxn)*rate_no3
1764) if (compute_derivative) then
1765) dnet_n_mineralization_rate_dnh4 = dnet_n_mineralization_rate_dnh4 + &
1766) this%mineral_n_stoich(irxn) * drate_no3_dnh4
1767) dnet_n_mineralization_rate_dno3 = dnet_n_mineralization_rate_dno3 + &
1768) this%mineral_n_stoich(irxn) * drate_no3_dno3
1769) dnet_n_mineralization_rate_duc(irxn) = &
1770) dnet_n_mineralization_rate_duc(irxn) + &
1771) this%mineral_n_stoich(irxn) * drate_no3_duc
1772) endif
1773) endif
1774) endif
1775)
1776) if (compute_derivative) then
1777)
1778) if (this%is_litter_decomp(irxn)) then
1779) if (this%litter_decomp_type == LITTER_DECOMP_CLMCN) then
1780) ! LitC + u LitN -> di SOMi + (1 - di) CO2 + n N
1781) ! Rdu/duc = R (-1) LitN/LitC^2 = - u R / LitC
1782) Rdu_duc = -1.0d0 * this%upstream_nc(irxn) * drate_nh4_duc
1783)
1784) ! n = u - (1 - di) ni
1785) ! dn/dLitC = du/dLitC
1786) Rdn_duc = Rdu_duc
1787)
1788) ! Rdu/dun = R /LitC
1789) Rdu_dun = drate_nh4_duc
1790)
1791) ! Rdn/dun = Rdu/dLitN = Rdu/dun
1792) Rdn_dun = Rdu_dun
1793)
1794) elseif (this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
1795) ! Lit1C + u Lit1N -> b Bacteria + f Fungi + c CO2 + n N
1796) ! c = min(CUEmax, Lit1N/Lit1C*CN_ratio_microbe)
1797) ! g = CNbacteria^0.6/(CNbacterial^0.6 + CNfungi^0.6)
1798) ! n = u - b nb - f nf
1799) ! b = g (1 - c)
1800) ! f = (1 - g) (1 - c)
1801)
1802) Rdu_duc = -1.0d0 * this%upstream_nc(irxn) * drate_nh4_duc
1803)
1804) if (resp_frac < CUE_max) then
1805) ! Rdc/dLit1C = -RLit1N/Lit1C^2*CN_ratio_microbe
1806) Rdc_duc = -1.0d0 * this%upstream_nc(irxn) * drate_nh4_duc &
1807) * CN_ratio_microbe
1808) else
1809) Rdc_duc = 0.0d0
1810) endif
1811)
1812) ! Rdb/dLitC = -g Rdc/dLitC
1813) Rdb_duc = -1.0d0 * this%fraction_bacteria * Rdc_duc
1814)
1815) ! Rdf/dLitC = -(1 - g) Rdc/dLitC
1816) Rdf_duc = -1.0d0 * (1.0d0 - this%fraction_bacteria) * Rdc_duc
1817)
1818) ! Rdn/dLitC = Rdu/dLitC - nb Rdb/dLitC - nf Rdf/dLitC
1819) Rdn_duc = Rdu_duc - this%nc_bacteria * Rdb_duc &
1820) - this%nc_fungi * Rdf_duc
1821)
1822) ! Rdu/dun = R/LitC = dR/duc
1823) Rdu_dun = drate_nh4_duc
1824)
1825) if (resp_frac < CUE_max) then
1826) ! Rdc/dLitN = R/LitC*CN_ratio_microbe
1827) Rdc_dun = drate_nh4_duc * CN_ratio_microbe
1828) else
1829) Rdc_dun = 0.0d0
1830) endif
1831)
1832) ! Rdb/dLitN = -g Rdc/dLitN
1833) Rdb_dun = -1.0d0 * this%fraction_bacteria * Rdc_dun
1834)
1835) ! Rdf/dLitN = -(1 - g) Rdc/dLitN
1836) Rdf_dun = -1.0d0 * (1.0d0 - this%fraction_bacteria) * Rdc_dun
1837)
1838) ! Rdn/dLitN = Rdu/dLitN - nb Rdb/dLitN - nf Rdf/dLitN
1839) Rdn_dun = Rdu_dun - this%nc_bacteria * Rdb_dun &
1840) - this%nc_fungi * Rdf_dun
1841)
1842) ires_b = reaction%offset_immobile + this%species_id_bacteria
1843) ires_f = reaction%offset_immobile + this%species_id_fungi
1844)
1845) endif
1846)
1847) endif
1848)
1849) ! with respect to upstream C
1850) ! CO2
1851) Jacobian(ires_co2,ires_uc) = Jacobian(ires_co2,ires_uc) - &
1852) this%mineral_c_stoich(irxn) * drate_nh4_duc
1853)
1854) if (this%is_litter_decomp(irxn) .and. &
1855) this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
1856) ! dRco2/dLitC = dcR/dLitC = cdR/dLitC + R dc/dLitC
1857) Jacobian(ires_co2,ires_uc) = Jacobian(ires_co2,ires_uc) - Rdc_duc
1858) endif
1859)
1860) if (this%species_id_hrimm > 0) then
1861) Jacobian(ires_hrimm,ires_uc) = Jacobian(ires_hrimm,ires_uc) - &
1862) this%mineral_c_stoich(irxn) * drate_nh4_duc
1863)
1864) if (this%is_litter_decomp(irxn) .and. &
1865) this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
1866) Jacobian(ires_hrimm,ires_uc) = Jacobian(ires_hrimm,ires_uc) - Rdc_duc
1867) endif
1868) endif
1869)
1870) ! N
1871) ! dR_N/dC_u = d nR/dC_u = dn/dC_u R + n dR/dC_u
1872) ! first, n dR/dC_u
1873) Jacobian(ires_nh4,ires_uc) = Jacobian(ires_nh4,ires_uc) - &
1874) this%mineral_n_stoich(irxn) * drate_nh4_duc
1875)
1876) if (this%species_id_nimm > 0 .and. &
1877) this%mineral_n_stoich(irxn) < 0.0d0) then
1878) Jacobian(ires_nimm,ires_uc) = Jacobian(ires_nimm,ires_uc) + &
1879) this%mineral_n_stoich(irxn) * drate_nh4_duc
1880) endif
1881)
1882) if (this%species_id_nmin > 0 .and. &
1883) this%mineral_n_stoich(irxn) > 0.0d0) then
1884) Jacobian(ires_nmin,ires_uc) = Jacobian(ires_nmin,ires_uc) - &
1885) this%mineral_n_stoich(irxn) * drate_nh4_duc
1886) endif
1887)
1888) if (this%is_litter_decomp(irxn)) then
1889) ! litter pool is immobile
1890) ! second, Rdn/dC_u
1891) Jacobian(ires_nh4,ires_uc) = Jacobian(ires_nh4,ires_uc) - Rdn_duc
1892)
1893) if (this%species_id_nimm > 0 .and. &
1894) this%mineral_n_stoich(irxn) < 0.0d0) then
1895) Jacobian(ires_nimm,ires_uc) = Jacobian(ires_nimm,ires_uc) + Rdn_duc
1896) endif
1897)
1898) if (this%species_id_nmin > 0 .and. &
1899) this%mineral_n_stoich(irxn) > 0.0d0) then
1900) Jacobian(ires_nmin,ires_uc) = Jacobian(ires_nmin,ires_uc) - Rdn_duc
1901) endif
1902)
1903) endif
1904)
1905) ! upstream C pool
1906) Jacobian(ires_uc,ires_uc) = Jacobian(ires_uc,ires_uc) + drate_nh4_duc
1907)
1908) ! upstream N pool
1909) if (this%is_litter_decomp(irxn)) then
1910) ! litter pools are immobile
1911) ! R_Nu = Nu/Cu * R_Cu
1912) ! dR_Nu/dCu = Nu/Cu dR_Cu/dCu + R du/dCu
1913) ! = 0 only when residual_cpool = 0
1914) Jacobian(ires_un,ires_uc) = Jacobian(ires_un,ires_uc) + &
1915) this%upstream_nc(irxn) * drate_nh4_duc + Rdu_duc
1916)
1917) endif
1918)
1919) ! downstream pools
1920) do j = 1, this%n_downstream_pools(irxn)
1921) ispec_d = this%downstream_id(irxn, j)
1922) if (ispec_d < 0) then
1923) option%io_buffer = 'Downstream pool species not specified!'
1924) call printErrMsg(option)
1925) endif
1926)
1927) if (this%downstream_is_aqueous(irxn, j)) then
1928) ires_d = ispec_d
1929) else
1930) ires_d = reaction%offset_immobile + ispec_d
1931) endif
1932)
1933) Jacobian(ires_d,ires_uc) = Jacobian(ires_d,ires_uc) - &
1934) this%downstream_stoich(irxn, j) * drate_nh4_duc
1935)
1936) ! additional term if downstream stoich is variable
1937) if (this%is_litter_decomp(irxn) .and. &
1938) this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
1939) if (ispec_d == this%species_id_bacteria) then
1940) ! dRbacteria/dLit1C = b dR/dLit1C + R db/dLit1C
1941) Jacobian(ires_d,ires_uc) = Jacobian(ires_d,ires_uc) - Rdb_duc
1942) elseif (ispec_d == this%species_id_fungi) then
1943) Jacobian(ires_d,ires_uc) = Jacobian(ires_d,ires_uc) - Rdf_duc
1944) else
1945) option%io_buffer = 'Downstream pool for CLM-Microbe should be' // &
1946) 'either bacteria or fungi!'
1947) call printErrMsg(option)
1948) endif
1949) endif
1950) enddo
1951)
1952) ! with respect to upstream n (due to variable CN ratio)
1953) if (this%is_litter_decomp(irxn)) then
1954) ! upstream n, dR_Nu/dNu = d uR/dNu = R/Cu = dR/dCu
1955) Jacobian(ires_un,ires_un) = Jacobian(ires_un,ires_un) + Rdu_dun
1956)
1957) ! mineral N, dR_N/dNu = d nR/du = Rd (u - (1-f)d)/dNu = dR/dCu
1958) Jacobian(ires_nh4,ires_un) = Jacobian(ires_nh4,ires_un) - Rdn_dun
1959)
1960) if (this%species_id_nimm > 0 .and. &
1961) this%mineral_n_stoich(irxn) < 0.0d0) then
1962) Jacobian(ires_nimm,ires_un) = Jacobian(ires_nimm,ires_un) + Rdn_dun
1963) endif
1964)
1965) if (this%species_id_nmin > 0 .and. &
1966) this%mineral_n_stoich(irxn) > 0.0d0) then
1967) Jacobian(ires_nmin,ires_un) = Jacobian(ires_nmin,ires_un) - Rdn_dun
1968) endif
1969)
1970) if (this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
1971) ! CO2 dR_co2/dNu = d cR/dNu = Rdc/Nu
1972) Jacobian(ires_co2,ires_un) = Jacobian(ires_co2,ires_un) - Rdc_dun
1973)
1974) if (this%species_id_hrimm > 0) then
1975) Jacobian(ires_hrimm,ires_un) = Jacobian(ires_hrimm,ires_un) -Rdc_dun
1976) endif
1977)
1978) ! bacteria dRbacteria/dNu = Rdb/dNu
1979) Jacobian(ires_b,ires_un) = Jacobian(ires_b,ires_un) - Rdb_dun
1980)
1981) ! fungi dRfungi/dNu = Rdf/dNu
1982) Jacobian(ires_f,ires_un) = Jacobian(ires_f,ires_un) - Rdf_dun
1983) endif
1984) endif
1985)
1986) ! with respect to nh4
1987) if (this%mineral_n_stoich(irxn) < 0.0d0) then
1988) ! CO2
1989) Jacobian(ires_co2,ires_nh4) = Jacobian(ires_co2,ires_nh4) - &
1990) this%mineral_c_stoich(irxn) * drate_nh4_dnh4
1991)
1992) if (this%species_id_hrimm > 0) then
1993) Jacobian(ires_hrimm,ires_nh4) = Jacobian(ires_hrimm,ires_nh4) - &
1994) this%mineral_c_stoich(irxn) * drate_nh4_dnh4
1995) endif
1996)
1997) ! N
1998) Jacobian(ires_nh4,ires_nh4) = Jacobian(ires_nh4,ires_nh4) - &
1999) this%mineral_n_stoich(irxn) * drate_nh4_dnh4
2000)
2001) if (this%species_id_nimm > 0) then
2002) Jacobian(ires_nimm,ires_nh4) = Jacobian(ires_nimm,ires_nh4) + &
2003) this%mineral_n_stoich(irxn) * drate_nh4_dnh4
2004) endif
2005)
2006) ! upstream C
2007) Jacobian(ires_uc,ires_nh4) = Jacobian(ires_uc,ires_nh4) - &
2008) (-1.d0) * drate_nh4_dnh4
2009)
2010) ! upstream N pool
2011) if (this%is_litter_decomp(irxn)) then
2012) Jacobian(ires_un,ires_nh4) = Jacobian(ires_un,ires_nh4) - &
2013) (-1.d0) * this%upstream_nc(irxn) * drate_nh4_dnh4
2014) endif
2015)
2016) ! downstream pools
2017) do j = 1, this%n_downstream_pools(irxn)
2018) ispec_d = this%downstream_id(irxn, j)
2019) if (ispec_d < 0) then
2020) option%io_buffer = 'Downstream pool species not specified!'
2021) call printErrMsg(option)
2022) endif
2023) if (this%downstream_is_aqueous(irxn, j)) then
2024) ires_d = ispec_d
2025) else
2026) ires_d = reaction%offset_immobile + ispec_d
2027) endif
2028) Jacobian(ires_d,ires_nh4) = Jacobian(ires_d,ires_nh4) - &
2029) this%downstream_stoich(irxn, j) * drate_nh4_dnh4
2030) enddo
2031)
2032) endif
2033)
2034) ! separate sink and source for using NH4+ as nutrient
2035) if (this%mineral_n_stoich(irxn) >= 0.0d0) then
2036) ! with respect to upstream C
2037) JacobianSupply_nh4(ires_co2,ires_uc) = &
2038) JacobianSupply_nh4(ires_co2,ires_uc) - &
2039) this%mineral_c_stoich(irxn) * drate_nh4_duc
2040)
2041) if (this%is_litter_decomp(irxn) .and. &
2042) this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
2043) ! dRco2/dLitC = dcR/dLitC = cdR/dLitC + R dc/dLitC
2044) JacobianSupply_nh4(ires_co2,ires_uc) = &
2045) JacobianSupply_nh4(ires_co2,ires_uc) - Rdc_duc
2046) endif
2047)
2048) if (this%species_id_hrimm > 0) then
2049) JacobianSupply_nh4(ires_hrimm,ires_uc) = &
2050) JacobianSupply_nh4(ires_hrimm,ires_uc) - &
2051) this%mineral_c_stoich(irxn) * drate_nh4_duc
2052)
2053) if (this%is_litter_decomp(irxn) .and. &
2054) this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
2055) JacobianSupply_nh4(ires_hrimm,ires_uc) = &
2056) JacobianSupply_nh4(ires_hrimm,ires_uc) - Rdc_duc
2057) endif
2058) endif
2059)
2060) ! N
2061) ! dR_N/dC_u = d nR/dC_u = dn/dC_u R + n dR/dC_u
2062) ! first, n dR/dC_u
2063) JacobianSupply_nh4(ires_nh4,ires_uc) = &
2064) JacobianSupply_nh4(ires_nh4,ires_uc) - &
2065) this%mineral_n_stoich(irxn) * drate_nh4_duc
2066)
2067) if (this%species_id_nmin > 0) then
2068) JacobianSupply_nh4(ires_nmin,ires_uc) = &
2069) JacobianSupply_nh4(ires_nmin,ires_uc) - &
2070) this%mineral_n_stoich(irxn) * drate_nh4_duc
2071) endif
2072)
2073) if (this%is_litter_decomp(irxn)) then
2074) ! litter pool is immobile
2075) ! second, Rdn/dC_u
2076) JacobianSupply_nh4(ires_nh4,ires_uc) = &
2077) JacobianSupply_nh4(ires_nh4,ires_uc) - Rdn_duc
2078)
2079) if (this%species_id_nmin > 0) then
2080) JacobianSupply_nh4(ires_nmin,ires_uc) = &
2081) JacobianSupply_nh4(ires_nmin,ires_uc) - Rdn_duc
2082) endif
2083)
2084) endif
2085)
2086) ! upstream C pool
2087) JacobianSupply_nh4(ires_uc,ires_uc) = &
2088) JacobianSupply_nh4(ires_uc,ires_uc) + drate_nh4_duc
2089)
2090) ! upstream N pool
2091) if (this%is_litter_decomp(irxn)) then
2092) ! litter pools are immobile
2093) ! R_Nu = Nu/Cu * R_Cu
2094) ! dR_Nu/dCu = Nu/Cu dR_Cu/dCu + R du/dCu
2095) ! = 0 only when residual_cpool = 0
2096) JacobianSupply_nh4(ires_un,ires_uc) = &
2097) JacobianSupply_nh4(ires_un,ires_uc) + &
2098) this%upstream_nc(irxn) * drate_nh4_duc + Rdu_duc
2099)
2100) endif
2101)
2102) ! downstream pools
2103) do j = 1, this%n_downstream_pools(irxn)
2104) ispec_d = this%downstream_id(irxn, j)
2105) if (ispec_d < 0) then
2106) option%io_buffer = 'Downstream pool species not specified!'
2107) call printErrMsg(option)
2108) endif
2109)
2110) if (this%downstream_is_aqueous(irxn, j)) then
2111) ires_d = ispec_d
2112) else
2113) ires_d = reaction%offset_immobile + ispec_d
2114) endif
2115)
2116) JacobianSupply_nh4(ires_d,ires_uc) = &
2117) JacobianSupply_nh4(ires_d,ires_uc) - &
2118) this%downstream_stoich(irxn, j) * drate_nh4_duc
2119)
2120) ! additional term if downstream stoich is variable
2121) if (this%is_litter_decomp(irxn) .and. &
2122) this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
2123) if (ispec_d == this%species_id_bacteria) then
2124) ! dRbacteria/dLit1C = b dR/dLit1C + R db/dLit1C
2125) JacobianSupply_nh4(ires_d,ires_uc) = &
2126) JacobianSupply_nh4(ires_d,ires_uc) - Rdb_duc
2127) elseif (ispec_d == this%species_id_fungi) then
2128) JacobianSupply_nh4(ires_d,ires_uc) = &
2129) JacobianSupply_nh4(ires_d,ires_uc) - Rdf_duc
2130) else
2131) option%io_buffer ='Downstream pool for CLM-Microbe should be' // &
2132) 'either bacteria or fungi!'
2133) call printErrMsg(option)
2134) endif
2135) endif
2136) enddo
2137)
2138) ! with respect to upstream n (due to variable CN ratio)
2139) if (this%is_litter_decomp(irxn)) then
2140) ! upstream n, dR_Nu/dNu = d uR/dNu = R/Cu = dR/dCu
2141) JacobianSupply_nh4(ires_un,ires_un) = &
2142) JacobianSupply_nh4(ires_un,ires_un) + Rdu_dun
2143)
2144) ! mineral N, dR_N/dNu = d nR/du = Rd (u - (1-f)d)/dNu = dR/dCu
2145) JacobianSupply_nh4(ires_nh4,ires_un) = &
2146) JacobianSupply_nh4(ires_nh4,ires_un) - Rdn_dun
2147)
2148) if (this%species_id_nmin > 0) then
2149) JacobianSupply_nh4(ires_nmin,ires_un) = &
2150) JacobianSupply_nh4(ires_nmin,ires_un) - Rdn_dun
2151) endif
2152)
2153) if (this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
2154) ! CO2 dR_co2/dNu = d cR/dNu = Rdc/Nu
2155) JacobianSupply_nh4(ires_co2,ires_un) = &
2156) JacobianSupply_nh4(ires_co2,ires_un) - Rdc_dun
2157)
2158) if (this%species_id_hrimm > 0) then
2159) JacobianSupply_nh4(ires_hrimm,ires_un) = &
2160) JacobianSupply_nh4(ires_hrimm,ires_un) -Rdc_dun
2161) endif
2162)
2163) ! bacteria dRbacteria/dNu = Rdb/dNu
2164) JacobianSupply_nh4(ires_b,ires_un) = &
2165) JacobianSupply_nh4(ires_b,ires_un) - Rdb_dun
2166)
2167) ! fungi dRfungi/dNu = Rdf/dNu
2168) JacobianSupply_nh4(ires_f,ires_un) = &
2169) JacobianSupply_nh4(ires_f,ires_un) - Rdf_dun
2170) endif
2171) endif
2172)
2173) else
2174) ! with respect to upstream C
2175) JacobianDemand_nh4(ires_co2,ires_uc) = &
2176) JacobianDemand_nh4(ires_co2,ires_uc) - &
2177) this%mineral_c_stoich(irxn) * drate_nh4_duc
2178)
2179) if (this%is_litter_decomp(irxn) .and. &
2180) this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
2181) ! dRco2/dLitC = dcR/dLitC = cdR/dLitC + R dc/dLitC
2182) JacobianDemand_nh4(ires_co2,ires_uc) = &
2183) JacobianDemand_nh4(ires_co2,ires_uc) - Rdc_duc
2184) endif
2185)
2186) if (this%species_id_hrimm > 0) then
2187) JacobianDemand_nh4(ires_hrimm,ires_uc) = &
2188) JacobianDemand_nh4(ires_hrimm,ires_uc) - &
2189) this%mineral_c_stoich(irxn) * drate_nh4_duc
2190)
2191) if (this%is_litter_decomp(irxn) .and. &
2192) this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
2193) JacobianDemand_nh4(ires_hrimm,ires_uc) = &
2194) JacobianDemand_nh4(ires_hrimm,ires_uc) - Rdc_duc
2195) endif
2196) endif
2197)
2198) ! N
2199) ! dR_N/dC_u = d nR/dC_u = dn/dC_u R + n dR/dC_u
2200) ! first, n dR/dC_u
2201) JacobianDemand_nh4(ires_nh4,ires_uc) = &
2202) JacobianDemand_nh4(ires_nh4,ires_uc) - &
2203) this%mineral_n_stoich(irxn) * drate_nh4_duc
2204)
2205) if (this%species_id_nimm > 0) then
2206) JacobianDemand_nh4(ires_nimm,ires_uc) = &
2207) JacobianDemand_nh4(ires_nimm,ires_uc) + &
2208) this%mineral_n_stoich(irxn) * drate_nh4_duc
2209) endif
2210)
2211) if (this%is_litter_decomp(irxn)) then
2212) ! litter pool is immobile
2213) ! second, Rdn/dC_u
2214) JacobianDemand_nh4(ires_nh4,ires_uc) = &
2215) JacobianDemand_nh4(ires_nh4,ires_uc) - Rdn_duc
2216)
2217) if (this%species_id_nimm > 0) then
2218) JacobianDemand_nh4(ires_nimm,ires_uc) = &
2219) JacobianDemand_nh4(ires_nimm,ires_uc) + Rdn_duc
2220) endif
2221)
2222) endif
2223)
2224) ! upstream C pool
2225) JacobianDemand_nh4(ires_uc,ires_uc) = &
2226) JacobianDemand_nh4(ires_uc,ires_uc) + drate_nh4_duc
2227)
2228) ! upstream N pool
2229) if (this%is_litter_decomp(irxn)) then
2230) ! litter pools are immobile
2231) ! R_Nu = Nu/Cu * R_Cu
2232) ! dR_Nu/dCu = Nu/Cu dR_Cu/dCu + R du/dCu
2233) ! = 0 only when residual_cpool = 0
2234) JacobianDemand_nh4(ires_un,ires_uc) = &
2235) JacobianDemand_nh4(ires_un,ires_uc) + &
2236) this%upstream_nc(irxn) * drate_nh4_duc + Rdu_duc
2237)
2238) endif
2239)
2240) ! downstream pools
2241) do j = 1, this%n_downstream_pools(irxn)
2242) ispec_d = this%downstream_id(irxn, j)
2243) if (ispec_d < 0) then
2244) option%io_buffer = 'Downstream pool species not specified!'
2245) call printErrMsg(option)
2246) endif
2247)
2248) if (this%downstream_is_aqueous(irxn, j)) then
2249) ires_d = ispec_d
2250) else
2251) ires_d = reaction%offset_immobile + ispec_d
2252) endif
2253)
2254) JacobianDemand_nh4(ires_d,ires_uc) = &
2255) JacobianDemand_nh4(ires_d,ires_uc) - &
2256) this%downstream_stoich(irxn, j) * drate_nh4_duc
2257)
2258) ! additional term if downstream stoich is variable
2259) if (this%is_litter_decomp(irxn) .and. &
2260) this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
2261) if (ispec_d == this%species_id_bacteria) then
2262) ! dRbacteria/dLit1C = b dR/dLit1C + R db/dLit1C
2263) JacobianDemand_nh4(ires_d,ires_uc) = &
2264) JacobianDemand_nh4(ires_d,ires_uc) - Rdb_duc
2265) elseif (ispec_d == this%species_id_fungi) then
2266) JacobianDemand_nh4(ires_d,ires_uc) = &
2267) JacobianDemand_nh4(ires_d,ires_uc) - Rdf_duc
2268) else
2269) option%io_buffer ='Downstream pool for CLM-Microbe should be' // &
2270) 'either bacteria or fungi!'
2271) call printErrMsg(option)
2272) endif
2273) endif
2274) enddo
2275)
2276) ! with respect to upstream n (due to variable CN ratio)
2277) if (this%is_litter_decomp(irxn)) then
2278) ! upstream n, dR_Nu/dNu = d uR/dNu = R/Cu = dR/dCu
2279) JacobianDemand_nh4(ires_un,ires_un) = &
2280) JacobianDemand_nh4(ires_un,ires_un) + Rdu_dun
2281)
2282) ! mineral N, dR_N/dNu = d nR/du = Rd (u - (1-f)d)/dNu = dR/dCu
2283) JacobianDemand_nh4(ires_nh4,ires_un) = &
2284) JacobianDemand_nh4(ires_nh4,ires_un) - Rdn_dun
2285)
2286) if (this%species_id_nimm > 0) then
2287) JacobianDemand_nh4(ires_nimm,ires_un) = &
2288) JacobianDemand_nh4(ires_nimm,ires_un) + Rdn_dun
2289) endif
2290)
2291) if (this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
2292) ! CO2 dR_co2/dNu = d cR/dNu = Rdc/Nu
2293) JacobianDemand_nh4(ires_co2,ires_un) = &
2294) JacobianDemand_nh4(ires_co2,ires_un) - Rdc_dun
2295)
2296) if (this%species_id_hrimm > 0) then
2297) JacobianDemand_nh4(ires_hrimm,ires_un) = &
2298) JacobianDemand_nh4(ires_hrimm,ires_un) - Rdc_dun
2299) endif
2300)
2301) ! bacteria dRbacteria/dNu = Rdb/dNu
2302) JacobianDemand_nh4(ires_b,ires_un) = &
2303) JacobianDemand_nh4(ires_b,ires_un) - Rdb_dun
2304)
2305) ! fungi dRfungi/dNu = Rdf/dNu
2306) JacobianDemand_nh4(ires_f,ires_un) = &
2307) JacobianDemand_nh4(ires_f,ires_un) - Rdf_dun
2308) endif
2309) endif
2310)
2311) ! with respect to nh4
2312) ! CO2
2313) JacobianDemand_nh4(ires_co2,ires_nh4) = &
2314) JacobianDemand_nh4(ires_co2,ires_nh4) - &
2315) this%mineral_c_stoich(irxn) * drate_nh4_dnh4
2316)
2317) if (this%species_id_hrimm > 0) then
2318) JacobianDemand_nh4(ires_hrimm,ires_nh4) = &
2319) JacobianDemand_nh4(ires_hrimm,ires_nh4) - &
2320) this%mineral_c_stoich(irxn) * drate_nh4_dnh4
2321) endif
2322)
2323) ! N
2324) JacobianDemand_nh4(ires_nh4,ires_nh4) = &
2325) JacobianDemand_nh4(ires_nh4,ires_nh4) - &
2326) this%mineral_n_stoich(irxn) * drate_nh4_dnh4
2327)
2328) if (this%species_id_nimm > 0) then
2329) JacobianDemand_nh4(ires_nimm,ires_nh4) = &
2330) JacobianDemand_nh4(ires_nimm,ires_nh4) + &
2331) this%mineral_n_stoich(irxn) * drate_nh4_dnh4
2332) endif
2333)
2334) ! upstream C
2335) JacobianDemand_nh4(ires_uc,ires_nh4) = &
2336) JacobianDemand_nh4(ires_uc,ires_nh4) - (-1.d0) * drate_nh4_dnh4
2337)
2338) ! upstream N pool
2339) if (this%is_litter_decomp(irxn)) then
2340) JacobianDemand_nh4(ires_un,ires_nh4) = &
2341) JacobianDemand_nh4(ires_un,ires_nh4) - &
2342) (-1.d0) * this%upstream_nc(irxn) * drate_nh4_dnh4
2343) endif
2344)
2345) ! downstream pools
2346) do j = 1, this%n_downstream_pools(irxn)
2347) ispec_d = this%downstream_id(irxn, j)
2348) if (ispec_d < 0) then
2349) option%io_buffer = 'Downstream pool species not specified!'
2350) call printErrMsg(option)
2351) endif
2352) if (this%downstream_is_aqueous(irxn, j)) then
2353) ires_d = ispec_d
2354) else
2355) ires_d = reaction%offset_immobile + ispec_d
2356) endif
2357) JacobianDemand_nh4(ires_d,ires_nh4) = &
2358) JacobianDemand_nh4(ires_d,ires_nh4) - &
2359) this%downstream_stoich(irxn, j) * drate_nh4_dnh4
2360) enddo
2361)
2362) endif
2363)
2364)
2365) if (this%species_id_no3 > 0 .and. this%mineral_n_stoich(irxn) < 0.d0) then
2366)
2367) if (this%is_litter_decomp(irxn)) then
2368) if (this%litter_decomp_type == LITTER_DECOMP_CLMCN) then
2369) ! Lit1C + u Lit1N -> di SOMi + (1 - di) CO2 + n N
2370) ! Rdu/duc = R (-1) Lit1N/Lit1C^2
2371) Rno3du_duc = -1.0d0 * this%upstream_nc(irxn) * drate_no3_duc
2372)
2373) ! n = u - (1 - di) ni
2374) ! dn/dLit1C = du/dLit1C
2375) Rno3dn_duc = Rno3du_duc
2376)
2377) ! Rdu/dun = R /Lit1C
2378) Rno3du_dun = drate_no3_duc
2379)
2380) ! Rdn/dun = du/dLit1C = dR/duc
2381) Rno3dn_dun = Rno3du_dun
2382)
2383) elseif (this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
2384) ! Lit1C + u Lit1N -> b Bacteria + f Fungi + c CO2 + n N
2385) ! c = min(CUEmax, Lit1N/Lit1C*CN_ratio_microbe)
2386) ! g = CNbacteria^0.6/(CNbacterial^0.6 + CNfungi^0.6)
2387) ! n = u - b nb - f nf
2388) ! b = g (1 - c)
2389) ! f = (1 - g) (1 - c)
2390)
2391) Rno3du_duc = -1.0d0 * this%upstream_nc(irxn) * drate_no3_duc
2392)
2393) if (resp_frac < CUE_max) then
2394) ! Rdc/dLit1C = -RLit1N/Lit1C^2*CN_ratio_microbe
2395) Rno3dc_duc = -1.0d0 * this%upstream_nc(irxn) * drate_no3_duc &
2396) * CN_ratio_microbe
2397) else
2398) Rno3dc_duc = 0.0d0
2399) endif
2400)
2401) ! Rdb/dLit1C = -g Rdc/dLit1C
2402) Rno3db_duc = -1.0d0 * this%fraction_bacteria * Rno3dc_duc
2403)
2404) ! Rdf/dLit1C = -(1 - g) Rdc/dLit1C
2405) Rno3df_duc = -1.0d0 * (1.0d0 - this%fraction_bacteria) * Rno3dc_duc
2406)
2407) ! Rdn/dLit1C = Rdu/dLit1C - nb Rdb/dLit1C - nf Rdf/dLit1C
2408) Rno3dn_duc = Rno3du_duc - this%nc_bacteria * Rno3db_duc &
2409) - this%nc_fungi * Rno3df_duc
2410)
2411) ! Rdu/dun = R /Lit1N
2412) Rno3du_dun = drate_no3_duc
2413)
2414) if (resp_frac < CUE_max) then
2415) ! Rdc/dLit1N = R/Lit1C*CN_ratio_microbe = dR/dLit1C*CN_ratio_microbe
2416) Rno3dc_dun = drate_no3_duc * CN_ratio_microbe
2417) else
2418) Rno3dc_dun = 0.0d0
2419) endif
2420)
2421) ! Rdb/dLit1N = -g Rdc/dLit1N
2422) Rno3db_dun = -1.0d0 * this%fraction_bacteria * Rno3dc_dun
2423)
2424) ! Rdf/dLit1N = -(1 - g) Rdc/dLit1N
2425) Rno3df_dun = -1.0d0 * (1.0d0 - this%fraction_bacteria) * Rno3dc_dun
2426)
2427) ! Rdn/dLit1N = Rdu/dLit1N - nb Rdb/dLit1N - nf Rdf/dLit1N
2428) Rno3dn_dun = Rno3du_dun - this%nc_bacteria * Rno3db_dun &
2429) - this%nc_fungi * Rno3df_dun
2430)
2431) endif
2432) endif
2433)
2434) ! with respect to upstream
2435) ! CO2
2436)
2437) Jacobian(ires_co2,ires_uc) = Jacobian(ires_co2,ires_uc) - &
2438) this%mineral_c_stoich(irxn) * drate_no3_duc
2439)
2440) if (this%is_litter_decomp(irxn) .and. &
2441) this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
2442) ! dRco2/dLitC = dcR/dLitC = cdR/dLitC + R dc/dLitC
2443) Jacobian(ires_co2,ires_uc) = Jacobian(ires_co2,ires_uc) - Rno3dc_duc
2444) endif
2445)
2446) if (this%species_id_hrimm > 0) then
2447) Jacobian(ires_hrimm,ires_uc) = Jacobian(ires_hrimm,ires_uc) - &
2448) this%mineral_c_stoich(irxn) * drate_no3_duc
2449)
2450) if (this%is_litter_decomp(irxn) .and. &
2451) this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE ) then
2452) Jacobian(ires_hrimm,ires_uc) = Jacobian(ires_hrimm,ires_uc) &
2453) - Rno3dc_duc
2454) endif
2455) endif
2456)
2457) ! NO3
2458) ! dR_N/dC_u = d nR/dC_u = dn/dC_u R + n dR/dC_u
2459) ! first term: n dR/dC_u
2460) Jacobian(ires_no3,ires_uc) = Jacobian(ires_no3,ires_uc) - &
2461) this%mineral_n_stoich(irxn) * drate_no3_duc
2462)
2463) if (this%species_id_nimm > 0) then
2464) Jacobian(ires_nimm,ires_uc) = Jacobian(ires_nimm,ires_uc) + &
2465) this%mineral_n_stoich(irxn) * drate_no3_duc
2466) endif
2467)
2468) ! second term: R dn/dC_u
2469) if (this%is_litter_decomp(irxn)) then
2470) Jacobian(ires_no3,ires_uc) = Jacobian(ires_no3,ires_uc) - Rno3dn_duc
2471)
2472) if (this%species_id_nimm > 0) then
2473) Jacobian(ires_nimm,ires_uc) = Jacobian(ires_nimm,ires_uc) &
2474) + Rno3dn_duc
2475) endif
2476)
2477) endif
2478)
2479) ! upstream C pool
2480) Jacobian(ires_uc,ires_uc) = Jacobian(ires_uc,ires_uc) + drate_no3_duc
2481)
2482) ! upstream N pool
2483) if (this%is_litter_decomp(irxn)) then
2484) Jacobian(ires_un,ires_uc) = Jacobian(ires_un,ires_uc) + &
2485) this%upstream_nc(irxn) * drate_no3_duc + Rno3du_duc
2486) endif
2487)
2488) ! downstream pools
2489) do j = 1, this%n_downstream_pools(irxn)
2490) ispec_d = this%downstream_id(irxn, j)
2491) if (ispec_d < 0) then
2492) option%io_buffer = 'Downstream pool species not specified!'
2493) call printErrMsg(option)
2494) endif
2495)
2496) if (this%downstream_is_aqueous(irxn, j)) then
2497) ires_d = ispec_d
2498) else
2499) ires_d = reaction%offset_immobile + ispec_d
2500) endif
2501)
2502) Jacobian(ires_d,ires_uc) = Jacobian(ires_d,ires_uc) - &
2503) this%downstream_stoich(irxn, j) * drate_no3_duc
2504)
2505) if (this%is_litter_decomp(irxn) .and. &
2506) this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
2507) if (ispec_d == this%species_id_bacteria) then
2508) Jacobian(ires_d,ires_uc) = Jacobian(ires_d,ires_uc) - Rno3db_duc
2509) elseif (ispec_d == this%species_id_fungi) then
2510) Jacobian(ires_d,ires_uc) = Jacobian(ires_d,ires_uc) - Rno3df_duc
2511) else
2512) option%io_buffer = 'Downstream pool for CLM-Microbe should ' // &
2513) 'be either bacteria or fungi!'
2514) call printErrMsg(option)
2515) endif
2516) endif
2517) enddo
2518)
2519) ! with respect to upstream n (due to variable CN ratio)
2520) if (this%is_litter_decomp(irxn)) then
2521)
2522) Jacobian(ires_un,ires_un) = Jacobian(ires_un,ires_un) + Rno3du_dun
2523)
2524) Jacobian(ires_no3,ires_un) = Jacobian(ires_no3,ires_un) - Rno3dn_dun
2525)
2526) if (this%species_id_nimm > 0) then
2527) Jacobian(ires_nimm,ires_un) = Jacobian(ires_nimm,ires_un) &
2528) + Rno3dn_dun
2529) endif
2530)
2531) if (this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
2532) Jacobian(ires_co2,ires_un) = Jacobian(ires_co2,ires_un) - Rno3dc_dun
2533)
2534) if (this%species_id_hrimm > 0) then
2535) Jacobian(ires_hrimm,ires_un) = Jacobian(ires_hrimm,ires_un) &
2536) - Rno3dc_dun
2537) endif
2538)
2539) Jacobian(ires_b,ires_un) = Jacobian(ires_b,ires_un) - Rno3db_dun
2540)
2541) Jacobian(ires_f,ires_un) = Jacobian(ires_f,ires_un) - Rno3df_dun
2542)
2543) endif
2544) endif
2545)
2546) ! with respect to no3
2547) ! CO2
2548) Jacobian(ires_co2,ires_no3) = Jacobian(ires_co2,ires_no3) - &
2549) this%mineral_c_stoich(irxn) * drate_no3_dno3
2550)
2551) if (this%species_id_hrimm > 0) then
2552) Jacobian(ires_hrimm,ires_no3) = Jacobian(ires_hrimm,ires_no3) - &
2553) this%mineral_c_stoich(irxn) * drate_no3_dno3
2554) endif
2555)
2556) ! N
2557) Jacobian(ires_no3,ires_no3) = Jacobian(ires_no3,ires_no3) - &
2558) this%mineral_n_stoich(irxn) * drate_no3_dno3
2559)
2560) if (this%species_id_nimm > 0) then
2561) Jacobian(ires_nimm,ires_no3) = Jacobian(ires_nimm,ires_no3) + &
2562) this%mineral_n_stoich(irxn) * drate_no3_dno3
2563) endif
2564)
2565) ! upstream C pool
2566) Jacobian(ires_uc,ires_no3) = Jacobian(ires_uc,ires_no3) - &
2567) (-1.d0) * drate_no3_dno3
2568)
2569) ! upstream N pool
2570) if (this%is_litter_decomp(irxn)) then
2571) Jacobian(ires_un,ires_no3) = Jacobian(ires_un,ires_no3) - &
2572) (-1.d0) * this%upstream_nc(irxn) * drate_no3_dno3
2573) endif
2574)
2575) ! downstream pools
2576) do j = 1, this%n_downstream_pools(irxn)
2577)
2578) ispec_d = this%downstream_id(irxn, j)
2579)
2580) if (ispec_d < 0) then
2581) option%io_buffer = 'Downstream pool species not specified!'
2582) call printErrMsg(option)
2583) endif
2584)
2585) if (this%downstream_is_aqueous(irxn, j)) then
2586) ires_d = ispec_d
2587) else
2588) ires_d = reaction%offset_immobile + ispec_d
2589) endif
2590) Jacobian(ires_d,ires_no3) = Jacobian(ires_d,ires_no3) - &
2591) this%downstream_stoich(irxn, j) * drate_no3_dno3
2592) enddo
2593)
2594) ! with respect to nh4 (due to nh4 inhibition on no3 immobilization)
2595) ! CO2
2596) Jacobian(ires_co2,ires_nh4) = Jacobian(ires_co2,ires_nh4) - &
2597) this%mineral_c_stoich(irxn) * drate_no3_dnh4
2598)
2599) if (this%species_id_hrimm > 0) then
2600) Jacobian(ires_hrimm,ires_nh4) = Jacobian(ires_hrimm,ires_nh4) - &
2601) this%mineral_c_stoich(irxn) * drate_no3_dnh4
2602) endif
2603)
2604) ! N
2605) Jacobian(ires_no3,ires_nh4) = Jacobian(ires_no3,ires_nh4) - &
2606) this%mineral_n_stoich(irxn) * drate_no3_dnh4
2607)
2608) if (this%species_id_nimm > 0) then
2609) Jacobian(ires_nimm,ires_nh4) = Jacobian(ires_nimm,ires_nh4) + &
2610) this%mineral_n_stoich(irxn) * drate_no3_dnh4
2611) endif
2612)
2613) ! upstream C pool
2614) Jacobian(ires_uc,ires_nh4) = Jacobian(ires_uc,ires_nh4) - &
2615) (-1.d0) * drate_no3_dnh4
2616)
2617) ! upstream N pool
2618) if (this%is_litter_decomp(irxn)) then
2619) Jacobian(ires_un,ires_nh4) = Jacobian(ires_un,ires_nh4) - &
2620) (-1.d0) * this%upstream_nc(irxn) * drate_no3_dnh4
2621) endif
2622)
2623) ! downstream pools
2624) do j = 1, this%n_downstream_pools(irxn)
2625)
2626) ispec_d = this%downstream_id(irxn, j)
2627)
2628) if (ispec_d < 0) then
2629) option%io_buffer = 'Downstream pool species not specified!'
2630) call printErrMsg(option)
2631) endif
2632)
2633) if (this%downstream_is_aqueous(irxn, j)) then
2634) ires_d = ispec_d
2635) else
2636) ires_d = reaction%offset_immobile + ispec_d
2637) endif
2638) Jacobian(ires_d,ires_nh4) = Jacobian(ires_d,ires_nh4) - &
2639) this%downstream_stoich(irxn, j) * drate_no3_dnh4
2640) enddo
2641)
2642) ! separate sink and source (not exist in this case) term for using NO3-
2643) ! as nutrient
2644) ! with respect to upstream
2645) JacobianDemand_no3(ires_co2,ires_uc) = &
2646) JacobianDemand_no3(ires_co2,ires_uc) - &
2647) this%mineral_c_stoich(irxn) * drate_no3_duc
2648)
2649) if (this%is_litter_decomp(irxn) .and. &
2650) this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
2651) ! dRco2/dLitC = dcR/dLitC = cdR/dLitC + R dc/dLitC
2652) JacobianDemand_no3(ires_co2,ires_uc) = &
2653) JacobianDemand_no3(ires_co2,ires_uc) - Rno3dc_duc
2654) endif
2655)
2656) if (this%species_id_hrimm > 0) then
2657) JacobianDemand_no3(ires_hrimm,ires_uc) = &
2658) JacobianDemand_no3(ires_hrimm,ires_uc) - &
2659) this%mineral_c_stoich(irxn) * drate_no3_duc
2660)
2661) if (this%is_litter_decomp(irxn) .and. &
2662) this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE ) then
2663) JacobianDemand_no3(ires_hrimm,ires_uc) = &
2664) JacobianDemand_no3(ires_hrimm,ires_uc) - Rno3dc_duc
2665) endif
2666) endif
2667)
2668) ! dR_N/dC_u = d nR/dC_u = dn/dC_u R + n dR/dC_u
2669) ! first term: n dR/dC_u
2670) JacobianDemand_no3(ires_no3,ires_uc) = &
2671) JacobianDemand_no3(ires_no3,ires_uc) - &
2672) this%mineral_n_stoich(irxn) * drate_no3_duc
2673)
2674) if (this%species_id_nimm > 0) then
2675) JacobianDemand_no3(ires_nimm,ires_uc) = &
2676) JacobianDemand_no3(ires_nimm,ires_uc) + &
2677) this%mineral_n_stoich(irxn) * drate_no3_duc
2678) endif
2679)
2680) ! second term: R dn/dC_u
2681) if (this%is_litter_decomp(irxn)) then
2682) JacobianDemand_no3(ires_no3,ires_uc) = &
2683) JacobianDemand_no3(ires_no3,ires_uc) - Rno3dn_duc
2684)
2685) if (this%species_id_nimm > 0) then
2686) JacobianDemand_no3(ires_nimm,ires_uc) = &
2687) JacobianDemand_no3(ires_nimm,ires_uc) + Rno3dn_duc
2688) endif
2689)
2690) endif
2691)
2692) ! upstream C pool
2693) JacobianDemand_no3(ires_uc,ires_uc) = &
2694) JacobianDemand_no3(ires_uc,ires_uc) + drate_no3_duc
2695)
2696) ! upstream N pool
2697) if (this%is_litter_decomp(irxn)) then
2698) JacobianDemand_no3(ires_un,ires_uc) = &
2699) JacobianDemand_no3(ires_un,ires_uc) + &
2700) this%upstream_nc(irxn) * drate_no3_duc + Rno3du_duc
2701) endif
2702)
2703) ! downstream pools
2704) do j = 1, this%n_downstream_pools(irxn)
2705) ispec_d = this%downstream_id(irxn, j)
2706) if (ispec_d < 0) then
2707) option%io_buffer = 'Downstream pool species not specified!'
2708) call printErrMsg(option)
2709) endif
2710)
2711) if (this%downstream_is_aqueous(irxn, j)) then
2712) ires_d = ispec_d
2713) else
2714) ires_d = reaction%offset_immobile + ispec_d
2715) endif
2716)
2717) JacobianDemand_no3(ires_d,ires_uc) = &
2718) JacobianDemand_no3(ires_d,ires_uc) - &
2719) this%downstream_stoich(irxn, j) * drate_no3_duc
2720)
2721) if (this%is_litter_decomp(irxn) .and. &
2722) this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
2723) if (ispec_d == this%species_id_bacteria) then
2724) JacobianDemand_no3(ires_d,ires_uc) = &
2725) JacobianDemand_no3(ires_d,ires_uc) - Rno3db_duc
2726) elseif (ispec_d == this%species_id_fungi) then
2727) JacobianDemand_no3(ires_d,ires_uc) = &
2728) JacobianDemand_no3(ires_d,ires_uc) - Rno3df_duc
2729) else
2730) option%io_buffer = 'Downstream pool for CLM-Microbe should ' // &
2731) 'be either bacteria or fungi!'
2732) call printErrMsg(option)
2733) endif
2734) endif
2735) enddo
2736)
2737) ! with respect to upstream n (due to variable CN ratio)
2738) if (this%is_litter_decomp(irxn)) then
2739)
2740) JacobianDemand_no3(ires_un,ires_un) = &
2741) JacobianDemand_no3(ires_un,ires_un) + Rno3du_dun
2742)
2743) JacobianDemand_no3(ires_no3,ires_un) = &
2744) JacobianDemand_no3(ires_no3,ires_un) - Rno3dn_dun
2745)
2746) if (this%species_id_nimm > 0) then
2747) JacobianDemand_no3(ires_nimm,ires_un) = &
2748) JacobianDemand_no3(ires_nimm,ires_un) + Rno3dn_dun
2749) endif
2750)
2751) if (this%litter_decomp_type == LITTER_DECOMP_CLMMICROBE) then
2752) JacobianDemand_no3(ires_co2,ires_un) = &
2753) JacobianDemand_no3(ires_co2,ires_un) - Rno3dc_dun
2754)
2755) if (this%species_id_hrimm > 0) then
2756) JacobianDemand_no3(ires_hrimm,ires_un) = &
2757) JacobianDemand_no3(ires_hrimm,ires_un) - Rno3dc_dun
2758) endif
2759)
2760) JacobianDemand_no3(ires_b,ires_un) = &
2761) JacobianDemand_no3(ires_b,ires_un) - Rno3db_dun
2762)
2763) JacobianDemand_no3(ires_f,ires_un) = &
2764) JacobianDemand_no3(ires_f,ires_un) - Rno3df_dun
2765)
2766) endif
2767) endif
2768)
2769) ! with respect to no3
2770) ! CO2
2771) JacobianDemand_no3(ires_co2,ires_no3) = &
2772) JacobianDemand_no3(ires_co2,ires_no3) - &
2773) this%mineral_c_stoich(irxn) * drate_no3_dno3
2774)
2775) if (this%species_id_hrimm > 0) then
2776) JacobianDemand_no3(ires_hrimm,ires_no3) = &
2777) JacobianDemand_no3(ires_hrimm,ires_no3) - &
2778) this%mineral_c_stoich(irxn) * drate_no3_dno3
2779) endif
2780)
2781) ! N
2782) JacobianDemand_no3(ires_no3,ires_no3) = &
2783) JacobianDemand_no3(ires_no3,ires_no3) - &
2784) this%mineral_n_stoich(irxn) * drate_no3_dno3
2785)
2786) if (this%species_id_nimm > 0) then
2787) JacobianDemand_no3(ires_nimm,ires_no3) = &
2788) JacobianDemand_no3(ires_nimm,ires_no3) + &
2789) this%mineral_n_stoich(irxn) * drate_no3_dno3
2790) endif
2791)
2792) ! upstream C pool
2793) JacobianDemand_no3(ires_uc,ires_no3) = &
2794) JacobianDemand_no3(ires_uc,ires_no3) - (-1.d0) * drate_no3_dno3
2795)
2796) ! upstream N pool
2797) if (this%is_litter_decomp(irxn)) then
2798) JacobianDemand_no3(ires_un,ires_no3) = &
2799) JacobianDemand_no3(ires_un,ires_no3) - &
2800) (-1.d0) * this%upstream_nc(irxn) * drate_no3_dno3
2801) endif
2802)
2803) ! downstream pools
2804) do j = 1, this%n_downstream_pools(irxn)
2805)
2806) ispec_d = this%downstream_id(irxn, j)
2807)
2808) if (ispec_d < 0) then
2809) option%io_buffer = 'Downstream pool species not specified!'
2810) call printErrMsg(option)
2811) endif
2812)
2813) if (this%downstream_is_aqueous(irxn, j)) then
2814) ires_d = ispec_d
2815) else
2816) ires_d = reaction%offset_immobile + ispec_d
2817) endif
2818) JacobianDemand_no3(ires_d,ires_no3) = &
2819) JacobianDemand_no3(ires_d,ires_no3) - &
2820) this%downstream_stoich(irxn, j) * drate_no3_dno3
2821) enddo
2822)
2823) ! with respect to nh4 (due to nh4 inhibition on no3 immobilization)
2824) ! CO2
2825) JacobianDemand_no3(ires_co2,ires_nh4) = &
2826) JacobianDemand_no3(ires_co2,ires_nh4) - &
2827) this%mineral_c_stoich(irxn) * drate_no3_dnh4
2828)
2829) if (this%species_id_hrimm > 0) then
2830) JacobianDemand_no3(ires_hrimm,ires_nh4) = &
2831) JacobianDemand_no3(ires_hrimm,ires_nh4) - &
2832) this%mineral_c_stoich(irxn) * drate_no3_dnh4
2833) endif
2834)
2835) ! N
2836) JacobianDemand_no3(ires_no3,ires_nh4) = &
2837) JacobianDemand_no3(ires_no3,ires_nh4) - &
2838) this%mineral_n_stoich(irxn) * drate_no3_dnh4
2839)
2840) if (this%species_id_nimm > 0) then
2841) JacobianDemand_no3(ires_nimm,ires_nh4) = &
2842) JacobianDemand_no3(ires_nimm,ires_nh4) + &
2843) this%mineral_n_stoich(irxn) * drate_no3_dnh4
2844) endif
2845)
2846) ! upstream C pool
2847) JacobianDemand_no3(ires_uc,ires_nh4) = &
2848) JacobianDemand_no3(ires_uc,ires_nh4) - (-1.d0) * drate_no3_dnh4
2849)
2850) ! upstream N pool
2851) if (this%is_litter_decomp(irxn)) then
2852) JacobianDemand_no3(ires_un,ires_nh4) = &
2853) JacobianDemand_no3(ires_un,ires_nh4) - &
2854) (-1.d0) * this%upstream_nc(irxn) * drate_no3_dnh4
2855) endif
2856)
2857) ! downstream pools
2858) do j = 1, this%n_downstream_pools(irxn)
2859)
2860) ispec_d = this%downstream_id(irxn, j)
2861)
2862) if (ispec_d < 0) then
2863) option%io_buffer = 'Downstream pool species not specified!'
2864) call printErrMsg(option)
2865) endif
2866)
2867) if (this%downstream_is_aqueous(irxn, j)) then
2868) ires_d = ispec_d
2869) else
2870) ires_d = reaction%offset_immobile + ispec_d
2871) endif
2872) JacobianDemand_no3(ires_d,ires_nh4) = &
2873) JacobianDemand_no3(ires_d,ires_nh4) - &
2874) this%downstream_stoich(irxn, j) * drate_no3_dnh4
2875) enddo
2876)
2877) endif
2878)
2879) endif
2880)
2881) enddo
2882)
2883) if (this%species_id_n2o > 0) then
2884)
2885) f_t = 1.0d0
2886) f_w = 1.0d0
2887) f_ph = 1.0d0
2888)
2889) if (f_t > 1.0d-20 .and. f_w > 1.0d-20 .and. f_ph > 1.0d-20) then
2890) temp_real = f_t * f_w * f_ph
2891)
2892) if (temp_real > 1.0d0) then
2893) temp_real = 1.0d0
2894) endif
2895)
2896) temp_real = temp_real * this%n2o_frac_mineralization
2897)
2898) if (net_n_mineralization_rate <= this%net_n_min_rate_smooth_0) then
2899) f_rate_n2o = 0.0d0
2900) df_rate_n2o = 0.0d0
2901) elseif (net_n_mineralization_rate >= this%net_n_min_rate_smooth_1 .or. &
2902) this%net_n_min_rate_smooth_1-this%net_n_min_rate_smooth_1 > 1.d-20) then
2903) f_rate_n2o = 1.0d0
2904) df_rate_n2o = 0.0d0
2905) else
2906) xxx = net_n_mineralization_rate - this%net_n_min_rate_smooth_0
2907) delta = this%net_n_min_rate_smooth_1 - this%net_n_min_rate_smooth_0
2908) f_rate_n2o = 1.0d0 - (1.0d0 - xxx * xxx / delta / delta) ** 2
2909) df_rate_n2o = 4.0d0 * (1.0d0 - xxx * xxx / delta / delta) * xxx &
2910) / delta / delta
2911) endif
2912)
2913) ! residuals
2914) rate_n2o = temp_real * net_n_mineralization_rate * f_nh4 * f_rate_n2o
2915)
2916) Residual(ires_nh4) = Residual(ires_nh4) + rate_n2o
2917)
2918) Residual(ires_n2o) = Residual(ires_n2o) - 0.5d0 * rate_n2o
2919)
2920) if (this%species_id_ngasmin > 0) then
2921) Residual(ires_ngasmin) = Residual(ires_ngasmin) - 0.5d0 * rate_n2o
2922) endif
2923)
2924) RateDemand_nh4(ires_nh4) = RateDemand_nh4(ires_nh4) + rate_n2o
2925)
2926) RateDemand_nh4(ires_n2o) = RateDemand_nh4(ires_n2o) - 0.5d0 * rate_n2o
2927)
2928) if (this%species_id_ngasmin > 0) then
2929) RateDemand_nh4(ires_ngasmin) = RateDemand_nh4(ires_ngasmin) &
2930) - 0.5d0 * rate_n2o
2931) endif
2932)
2933) if (compute_derivative) then
2934) drate_n2o_dnh4 = temp_real * dnet_n_mineralization_rate_dnh4 * f_nh4 &
2935) + temp_real * net_n_mineralization_rate * d_nh4
2936)
2937) drate_n2o_dnh4 = drate_n2o_dnh4 * f_rate_n2o + rate_n2o * df_rate_n2o &
2938) * dnet_n_mineralization_rate_dnh4
2939)
2940) Jacobian(ires_nh4,ires_nh4) = Jacobian(ires_nh4,ires_nh4)+drate_n2o_dnh4
2941) Jacobian(ires_n2o,ires_nh4) = Jacobian(ires_n2o,ires_nh4) &
2942) - 0.5d0 * drate_n2o_dnh4
2943) if (this%species_id_ngasmin > 0 .and. (.not.this%bskipn2ojacobian)) then
2944) Jacobian(ires_ngasmin,ires_nh4) = Jacobian(ires_ngasmin,ires_nh4) &
2945) - 0.5d0 * drate_n2o_dnh4
2946) endif
2947)
2948) JacobianDemand_nh4(ires_nh4,ires_nh4) = &
2949) JacobianDemand_nh4(ires_nh4,ires_nh4) + drate_n2o_dnh4
2950) JacobianDemand_nh4(ires_n2o,ires_nh4) = &
2951) JacobianDemand_nh4(ires_n2o,ires_nh4) - 0.5d0 * drate_n2o_dnh4
2952) if (this%species_id_ngasmin > 0 .and. (.not.this%bskipn2ojacobian)) then
2953) JacobianDemand_nh4(ires_ngasmin,ires_nh4) = &
2954) JacobianDemand_nh4(ires_ngasmin,ires_nh4) - 0.5d0 * drate_n2o_dnh4
2955) endif
2956)
2957) if (this%species_id_no3 > 0) then
2958) drate_n2o_dno3 = temp_real * dnet_n_mineralization_rate_dno3 * f_nh4
2959)
2960) drate_n2o_dno3 = drate_n2o_dno3 *f_rate_n2o + rate_n2o * df_rate_n2o &
2961) * dnet_n_mineralization_rate_dno3
2962)
2963) Jacobian(ires_n2o,ires_no3) = Jacobian(ires_n2o,ires_no3) &
2964) - 0.5d0 * drate_n2o_dno3
2965)
2966) if (this%species_id_ngasmin > 0 .and. (.not.this%bskipn2ojacobian)) then
2967) Jacobian(ires_ngasmin,ires_no3) = Jacobian(ires_ngasmin,ires_no3) &
2968) - 0.5d0 * drate_n2o_dno3
2969) endif
2970)
2971) Jacobian(ires_n2o,ires_no3) = Jacobian(ires_n2o,ires_no3) &
2972) - 0.5d0 * drate_n2o_dno3
2973)
2974) if (this%species_id_ngasmin > 0 .and. (.not.this%bskipn2ojacobian)) then
2975) Jacobian(ires_ngasmin,ires_no3) = Jacobian(ires_ngasmin,ires_no3) &
2976) - 0.5d0 * drate_n2o_dno3
2977) endif
2978)
2979) JacobianDemand_nh4(ires_n2o,ires_no3) = &
2980) JacobianDemand_nh4(ires_n2o,ires_no3) - 0.5d0 * drate_n2o_dno3
2981)
2982) if (this%species_id_ngasmin > 0 .and. (.not.this%bskipn2ojacobian)) then
2983) JacobianDemand_nh4(ires_ngasmin,ires_no3) = &
2984) JacobianDemand_nh4(ires_ngasmin,ires_no3) - 0.5d0 *drate_n2o_dno3
2985) endif
2986)
2987) JacobianDemand_nh4(ires_n2o,ires_no3) = &
2988) JacobianDemand_nh4(ires_n2o,ires_no3) - 0.5d0 * drate_n2o_dno3
2989)
2990) if (this%species_id_ngasmin > 0 .and. (.not.this%bskipn2ojacobian)) then
2991) JacobianDemand_nh4(ires_ngasmin,ires_no3) = &
2992) JacobianDemand_nh4(ires_ngasmin,ires_no3) - 0.5d0 *drate_n2o_dno3
2993) endif
2994) endif
2995)
2996) do irxn = 1, this%nrxn
2997) ispec_uc = this%upstream_c_id(irxn)
2998)
2999) if (this%upstream_is_aqueous(irxn)) then
3000) ires_uc = ispec_uc
3001) else
3002) ires_uc = reaction%offset_immobile + ispec_uc
3003) endif
3004)
3005) drate_n2o_duc = temp_real * dnet_n_mineralization_rate_duc(irxn)*f_nh4
3006)
3007) drate_n2o_duc = drate_n2o_duc * f_rate_n2o + rate_n2o * df_rate_n2o &
3008) * dnet_n_mineralization_rate_duc(irxn)
3009)
3010) Jacobian(ires_n2o,ires_uc) = Jacobian(ires_n2o,ires_uc) &
3011) - 0.5d0 * drate_n2o_duc
3012)
3013) JacobianDemand_nh4(ires_n2o,ires_uc) = &
3014) JacobianDemand_nh4(ires_n2o,ires_uc) - 0.5d0 * drate_n2o_duc
3015) if (this%species_id_ngasmin > 0 .and. (.not.this%bskipn2ojacobian)) then
3016) Jacobian(ires_ngasmin,ires_uc) = Jacobian(ires_ngasmin,ires_uc) &
3017) - 0.5d0 * drate_n2o_duc
3018) JacobianDemand_nh4(ires_ngasmin,ires_uc) = &
3019) JacobianDemand_nh4(ires_ngasmin,ires_uc) - 0.5d0 * drate_n2o_duc
3020) endif
3021)
3022) enddo
3023)
3024) if (this%bdebugoutput) then
3025) write(*, *) 'CLMDEC N2O:', rate_n2o, drate_n2o_dnh4, drate_n2o_dno3
3026) endif
3027) endif
3028)
3029) endif
3030)
3031) endif
3032)
3033) end subroutine CLMDec_React
3034)
3035) ! **************************************************************************** !
3036) !
3037) ! CLMDecDestroy: Destroys allocatable or pointer objects created in this module
3038) !
3039) ! **************************************************************************** !
3040) subroutine CLMDec_Destroy(this)
3041)
3042) use Utility_module, only : DeallocateArray
3043)
3044) implicit none
3045)
3046) class(clm_rxn_clmdec_type) :: this
3047)
3048) type(pool_type), pointer :: cur_pool, prev_pool
3049) type(clmdec_reaction_type), pointer :: cur_reaction, prev_reaction
3050)
3051) cur_pool => this%pools
3052) do
3053) if (.not.associated(cur_pool)) exit
3054) prev_pool => cur_pool
3055) cur_pool => cur_pool%next
3056) deallocate(prev_pool)
3057) nullify(prev_pool)
3058) enddo
3059)
3060) cur_reaction => this%reactions
3061) do
3062) if (.not.associated(cur_reaction)) exit
3063)
3064) cur_pool => cur_reaction%downstream_pools
3065) do
3066) if (.not.associated(cur_pool)) exit
3067) prev_pool => cur_pool
3068) cur_pool => cur_pool%next
3069) deallocate(prev_pool)
3070) nullify(prev_pool)
3071) enddo
3072)
3073) prev_reaction => cur_reaction
3074) cur_reaction => cur_reaction%next
3075)
3076) deallocate(prev_reaction)
3077) nullify(prev_reaction)
3078) enddo
3079)
3080) call DeallocateArray(this%pool_nc_ratio)
3081) call DeallocateArray(this%rate_constant)
3082) call DeallocateArray(this%is_litter_decomp)
3083) call DeallocateArray(this%upstream_c_id)
3084) call DeallocateArray(this%upstream_n_id)
3085) call DeallocateArray(this%upstream_nc)
3086) call DeallocateArray(this%upstream_is_aqueous)
3087) call DeallocateArray(this%downstream_id)
3088) call DeallocateArray(this%downstream_stoich)
3089) call DeallocateArray(this%downstream_is_aqueous)
3090) call DeallocateArray(this%mineral_c_stoich)
3091) call DeallocateArray(this%mineral_n_stoich)
3092)
3093) end subroutine CLMDec_Destroy
3094)
3095) end module CLM_Rxn_Decomp_class
3096)
3097)
3098) module CLM_Rxn_PlantN_class
3099)
3100) use CLM_Rxn_Base_class
3101) use Global_Aux_module
3102) use Reactive_Transport_Aux_module
3103) use PFLOTRAN_Constants_module
3104)
3105) ! ------------------------------------------------------------------------------
3106) ! Description
3107) ! extended from reaction_sandbox_plantn to implement demand based down regulation
3108) ! for use in CLM_Rxn t6g 10/06/2014
3109) ! add NH4+ and NO3- deposition rates as supply
3110)
3111) ! to handle plant N uptake with
3112) ! 1) Monod type downregulation N/(hs + N)
3113) ! 2) Cut off downregulation 1 if N >= N1, 0 if N <= N0, 1 - [1 - (x/d)^2]^2
3114) ! with x = (N - N0)/(N1 - N0)
3115) ! 3) inhibition of NH3 on NO3- uptake (assuming plant take NH3 preferentially)
3116) ! Author: Guoping Tang
3117) ! Date: 07/08/14
3118) ! -----------------------------------------------------------------------------
3119)
3120) implicit none
3121)
3122) private
3123)
3124) #include "petsc/finclude/petscsys.h"
3125)
3126) type, public, &
3127) extends(clm_rxn_base_type) :: clm_rxn_plantn_type
3128) PetscReal :: rate_plantntake
3129) PetscReal :: rate_plantntake_nh4
3130) PetscReal :: rate_plantntake_no3
3131) PetscReal :: rate_deposition_nh4
3132) PetscReal :: rate_deposition_no3
3133) PetscReal :: half_saturation_nh4
3134) PetscReal :: half_saturation_no3
3135) PetscReal :: inhibition_nh4_no3
3136) PetscReal :: residual_nh4
3137) PetscReal :: residual_no3
3138) PetscReal :: cutoff_no3_0
3139) PetscReal :: cutoff_no3_1
3140) PetscReal :: cutoff_nh4_0
3141) PetscReal :: cutoff_nh4_1
3142)
3143) PetscInt :: ispec_nh4
3144) PetscInt :: ispec_no3
3145) PetscInt :: ispec_plantn
3146) PetscInt :: ispec_nh4in
3147) PetscInt :: ispec_no3in
3148) PetscInt :: ispec_plantndemand
3149)
3150) PetscBool :: bdebugoutput
3151) PetscBool :: enable_clm_n_in
3152) PetscBool :: bfixed_clm_n_in
3153) PetscBool :: disable_plantntake
3154) PetscBool :: is_NH4_aqueous
3155) PetscBool :: is_NO3_aqueous
3156) PetscBool :: bskippno3jacobian
3157)
3158) contains
3159) procedure, public :: ReadInput => PlantNRead
3160) procedure, public :: Setup => PlantNSetup
3161) procedure, public :: Evaluate => PlantNReact
3162) procedure, public :: Destroy => PlantNDestroy
3163) end type clm_rxn_plantn_type
3164)
3165) public :: PlantNCreate
3166)
3167) contains
3168)
3169) ! **************************************************************************** !
3170) !
3171) ! PlantNCreate: Allocates plantn reaction sandbox object.
3172) !
3173) ! **************************************************************************** !
3174) function PlantNCreate()
3175)
3176) implicit none
3177)
3178) class(clm_rxn_plantn_type), pointer :: PlantNCreate
3179)
3180) allocate(PlantNCreate)
3181) PlantNCreate%rate_plantntake = 1.d-10
3182) PlantNCreate%rate_plantntake_nh4 = 1.d-10
3183) PlantNCreate%rate_plantntake_no3 = 1.d-10
3184) PlantNCreate%rate_deposition_nh4 = 1.0d-11
3185) PlantNCreate%rate_deposition_no3 = 1.0d-11
3186) PlantNCreate%half_saturation_nh4 = 1.d-6
3187) PlantNCreate%half_saturation_no3 = 1.d-6
3188) PlantNCreate%inhibition_nh4_no3 = -1.d-15
3189) PlantNCreate%residual_nh4 = 1.d-10
3190) PlantNCreate%residual_no3 = 1.d-10
3191) PlantNCreate%cutoff_no3_0 = -1.0d-9
3192) PlantNCreate%cutoff_no3_1 = 1.0d-7
3193) PlantNCreate%cutoff_nh4_0 = -1.0d-9
3194) PlantNCreate%cutoff_nh4_1 = 1.0d-7
3195) PlantNCreate%ispec_nh4 = -1
3196) PlantNCreate%ispec_no3 = -1
3197) PlantNCreate%ispec_plantn = -1
3198) PlantNCreate%ispec_nh4in = -1
3199) PlantNCreate%ispec_no3in = -1
3200) PlantNCreate%ispec_plantndemand = -1
3201)
3202) PlantNCreate%bdebugoutput = PETSC_FALSE
3203) PlantNCreate%enable_clm_n_in = PETSC_TRUE
3204) PlantNCreate%bfixed_clm_n_in = PETSC_FALSE
3205) PlantNCreate%disable_plantntake = PETSC_FALSE
3206)
3207) PlantNCreate%is_NH4_aqueous = PETSC_TRUE
3208) PlantNCreate%is_NO3_aqueous = PETSC_TRUE
3209) PlantNCreate%bskippno3jacobian = PETSC_FALSE
3210)
3211) nullify(PlantNCreate%next)
3212)
3213) end function PlantNCreate
3214)
3215) ! **************************************************************************** !
3216) !
3217) ! PlantNRead: Reads input deck for plantn reaction parameters
3218) !
3219) ! **************************************************************************** !
3220) subroutine PlantNRead(this,input,option)
3221)
3222) use Option_module
3223) use String_module
3224) use Input_Aux_module
3225) use Units_module, only : UnitsConvertToInternal
3226)
3227) implicit none
3228)
3229) class(clm_rxn_plantn_type) :: this
3230) type(input_type), pointer :: input
3231) type(option_type) :: option
3232)
3233) PetscInt :: i
3234) character(len=MAXWORDLENGTH) :: word, internal_units
3235)
3236) do
3237) call InputReadPflotranString(input,option)
3238) if (InputError(input)) exit
3239) if (InputCheckExit(input,option)) exit
3240)
3241) call InputReadWord(input,option,word,PETSC_TRUE)
3242) call InputErrorMsg(input,option,'keyword', &
3243) 'CHEMISTRY,CLM_RXN,PLANTN')
3244) call StringToUpper(word)
3245)
3246) select case(trim(word))
3247) case('RATE_PLANTNTAKE_NH4')
3248) call InputReadDouble(input,option,this%rate_plantntake_nh4)
3249) call InputErrorMsg(input,option,'rate plantntake nh4+', &
3250) 'CHEMISTRY,CLM_RXN,PLANTN')
3251) case('RATE_PLANTNTAKE_NO3')
3252) call InputReadDouble(input,option,this%rate_plantntake_no3)
3253) call InputErrorMsg(input,option,'rate plantntake no3-', &
3254) 'CHEMISTRY,CLM_RXN,PLANTN')
3255) case('RATE_DEPOSITION_NH4')
3256) call InputReadDouble(input,option,this%rate_deposition_nh4)
3257) call InputErrorMsg(input,option,'rate deposition NH4+', &
3258) 'CHEMISTRY,CLM_RXN,PLANTN')
3259) case('RATE_DEPOSITION_NO3')
3260) call InputReadDouble(input,option,this%rate_deposition_no3)
3261) call InputErrorMsg(input,option,'rate deposition NO3-', &
3262) 'CHEMISTRY,CLM_RXN,PLANTN')
3263) case('HALF_SATURATION_NH4')
3264) call InputReadDouble(input,option,this%half_saturation_nh4)
3265) call InputErrorMsg(input,option,'half saturation NH4', &
3266) 'CHEMISTRY,CLM_RXN,PLANTN')
3267) case('HALF_SATURATION_NO3')
3268) call InputReadDouble(input,option,this%half_saturation_no3)
3269) call InputErrorMsg(input,option,'half saturation NO3-', &
3270) 'CHEMISTRY,CLM_RXN,PLANTN')
3271) case('NH4_INHIBITION_NO3')
3272) call InputReadDouble(input,option,this%inhibition_nh4_no3)
3273) call InputErrorMsg(input,option,'NH4 inhibition on NO3-', &
3274) 'CHEMISTRY,CLM_RXN,PLANTN')
3275) case('RESIDUAL_NH4')
3276) call InputReadDouble(input,option,this%residual_nh4)
3277) call InputErrorMsg(input,option,'residual concentration NH4+', &
3278) 'CHEMISTRY,CLM_RXN,PLANTN')
3279) case('RESIDUAL_NO3')
3280) call InputReadDouble(input,option,this%residual_no3)
3281) call InputErrorMsg(input,option,'residual concentration NO3-', &
3282) 'CHEMISTRY,CLM_RXN,PLANTN')
3283) case('CUTOFF_NH4')
3284) call InputReadDouble(input,option,this%cutoff_nh4_0)
3285) call InputErrorMsg(input,option,'cutoff_nh4_0', &
3286) 'CHEMISTRY,CLM_RXN,PLANTN')
3287) call InputReadDouble(input,option,this%cutoff_nh4_1)
3288) call InputErrorMsg(input,option,'cutoff_nh4_1', &
3289) 'CHEMISTRY,CLM_RXN,PLANTN')
3290) if (this%cutoff_nh4_0 > this%cutoff_nh4_1) then
3291) option%io_buffer = 'CHEMISTRY,CLM_RXN,PLANTN,' // &
3292) 'NH4+ cut off concentration > concentration ' // &
3293) 'where down regulation function = 1.'
3294) call printErrMsg(option)
3295) endif
3296) case('CUTOFF_NO3')
3297) call InputReadDouble(input,option,this%cutoff_no3_0)
3298) call InputErrorMsg(input,option,'cutoff_no3_0', &
3299) 'CHEMISTRY,CLM_RXN,PLANTN')
3300) call InputReadDouble(input,option,this%cutoff_no3_1)
3301) call InputErrorMsg(input,option,'cutoff_no3_1', &
3302) 'CHEMISTRY,CLM_RXN,PLANTN')
3303) if (this%cutoff_no3_0 > this%cutoff_no3_1) then
3304) option%io_buffer = 'CHEMISTRY,CLM_RXN,PLANTN,' // &
3305) 'NO3- down regulation cut off concentration > concentration ' // &
3306) 'where down regulation function = 1.'
3307) call printErrMsg(option)
3308) endif
3309) case('DEBUG_OUTPUT')
3310) this%bdebugoutput = PETSC_TRUE
3311) case('DISABLE_CLM_N_INPUT')
3312) this%enable_clm_n_in = PETSC_FALSE
3313) case('FIXED_CLM_N_INPUT')
3314) this%bfixed_clm_n_in = PETSC_TRUE
3315) case('DISABLE_PLANTNTAKE')
3316) this%disable_plantntake = PETSC_TRUE
3317) case('JACOBIAN_PLANT_NO3_SKIP')
3318) this%bskippno3jacobian = PETSC_TRUE
3319) case default
3320) call InputKeywordUnrecognized(word, &
3321) 'CHEMISTRY,CLM_RXN,PLANTN,REACTION',option)
3322) end select
3323) enddo
3324)
3325) end subroutine PlantNRead
3326)
3327) ! **************************************************************************** !
3328) !
3329) ! PlantNSetup: Sets up the plantn reaction with parameters
3330) !
3331) ! **************************************************************************** !
3332) subroutine PlantNSetup(this,reaction,option)
3333)
3334) use Reaction_Aux_module
3335) use Option_module
3336) use Reaction_Immobile_Aux_module
3337)
3338) implicit none
3339)
3340) class(clm_rxn_plantn_type) :: this
3341) type(reaction_type) :: reaction
3342) type(option_type) :: option
3343)
3344) character(len=MAXWORDLENGTH) :: word
3345)
3346) word = 'NH4+'
3347) this%ispec_nh4 = GetPrimarySpeciesIDFromName(word,reaction,PETSC_FALSE,option)
3348)
3349) if (this%ispec_nh4 < 0) then
3350) word = 'NH3(aq)'
3351) this%ispec_nh4 = GetPrimarySpeciesIDFromName(word,reaction,PETSC_FALSE, &
3352) option)
3353) endif
3354)
3355) if (this%ispec_nh4 < 0) then
3356) word = 'Ammonium'
3357) this%ispec_nh4 = GetImmobileSpeciesIDFromName( &
3358) word,reaction%immobile,PETSC_FALSE,option)
3359) if (this%ispec_nh4 > 0) then
3360) this%is_NH4_aqueous = PETSC_FALSE
3361) endif
3362) endif
3363)
3364) if (this%ispec_nh4 < 0) then
3365) option%io_buffer = 'NH4+, NH3(aq) or Ammonium is specified in the input' // &
3366) 'file for PlantN sandbox!'
3367) call printErrMsg(option)
3368) endif
3369)
3370) word = 'NO3-'
3371) this%ispec_no3 = GetPrimarySpeciesIDFromName(word,reaction,PETSC_FALSE,option)
3372)
3373) if (this%ispec_no3 < 0) then
3374) word = 'Nitrate'
3375) this%ispec_no3 = GetImmobileSpeciesIDFromName( &
3376) word,reaction%immobile,PETSC_FALSE,option)
3377) if (this%ispec_no3 > 0) then
3378) this%is_NO3_aqueous = PETSC_FALSE
3379) endif
3380) endif
3381)
3382) word = 'PlantN'
3383) this%ispec_plantn = GetImmobileSpeciesIDFromName(word, reaction%immobile, &
3384) PETSC_FALSE,option)
3385)
3386) if (this%ispec_plantn < 0) then
3387) option%io_buffer = 'PlantN is specified in the input file!'
3388) call printErrMsg(option)
3389) endif
3390)
3391) word = 'Ain'
3392) this%ispec_nh4in = GetImmobileSpeciesIDFromName(word, reaction%immobile, &
3393) PETSC_FALSE,option)
3394)
3395) word = 'Tin'
3396) this%ispec_no3in = GetImmobileSpeciesIDFromName(word, reaction%immobile, &
3397) PETSC_FALSE,option)
3398)
3399) word = 'Plantndemand'
3400) this%ispec_plantndemand = GetImmobileSpeciesIDFromName(word, &
3401) reaction%immobile, PETSC_FALSE,option)
3402)
3403) end subroutine PlantNSetup
3404)
3405) ! **************************************************************************** !
3406) !
3407) ! PlantNReact: Evaluates reaction storing residual and/or Jacobian
3408) !
3409) ! **************************************************************************** !
3410) subroutine PlantNReact(this,Residual,Jacobian,compute_derivative,rt_auxvar, &
3411) global_auxvar,material_auxvar,reaction,option, &
3412) RateDemand_nh4,RateSupply_nh4, &
3413) JacobianDemand_nh4,JacobianSupply_nh4, &
3414) RateDemand_no3,RateSupply_no3, &
3415) JacobianDemand_no3,JacobianSupply_no3, &
3416) Rate_nh4_to_no3,Jacobian_nh4_to_no3)
3417)
3418) use Option_module
3419) use Reaction_Aux_module
3420) use Reaction_Immobile_Aux_module
3421) use Material_Aux_class, only : material_auxvar_type
3422) use CLM_Rxn_Common_module, only: CalNLimitFunc
3423)
3424) implicit none
3425)
3426) class(clm_rxn_plantn_type) :: this
3427) type(option_type) :: option
3428) type(reaction_type) :: reaction
3429) type(reactive_transport_auxvar_type) :: rt_auxvar
3430) type(global_auxvar_type) :: global_auxvar
3431) class(material_auxvar_type) :: material_auxvar
3432) PetscBool :: compute_derivative
3433)
3434) PetscReal :: Residual(reaction%ncomp)
3435) PetscReal :: Jacobian(reaction%ncomp,reaction%ncomp)
3436) PetscReal :: RateDemand_nh4(reaction%ncomp)
3437) PetscReal :: RateSupply_nh4(reaction%ncomp)
3438) PetscReal :: JacobianDemand_nh4(reaction%ncomp,reaction%ncomp)
3439) PetscReal :: JacobianSupply_nh4(reaction%ncomp,reaction%ncomp)
3440) PetscReal :: RateDemand_no3(reaction%ncomp)
3441) PetscReal :: RateSupply_no3(reaction%ncomp)
3442) PetscReal :: JacobianDemand_no3(reaction%ncomp,reaction%ncomp)
3443) PetscReal :: JacobianSupply_no3(reaction%ncomp,reaction%ncomp)
3444) PetscReal :: Rate_nh4_to_no3
3445) PetscReal :: Jacobian_nh4_to_no3(reaction%ncomp)
3446) PetscReal :: volume, porosity
3447) PetscErrorCode :: ierr
3448) PetscInt :: local_id
3449)
3450) character(len=MAXWORDLENGTH) :: word
3451)
3452) PetscInt, parameter :: iphase = 1
3453) PetscInt :: ires_nh4, ires_no3, ires_plantn
3454) PetscInt :: ires_nh4in, ires_no3in
3455) PetscInt :: ires_plantndemand
3456)
3457) PetscReal :: c_nh4 ! concentration (mole/L)
3458) PetscReal :: ac_nh4 ! activity coefficient
3459) PetscReal :: f_nh4 ! nh4 / (half_saturation + nh4)
3460) PetscReal :: d_nh4 ! half_saturation / (half_saturation + nh4)^2
3461) PetscReal :: f_nh4_inhibit ! inhibition_coef/(inhibition_coef + nh4)
3462) PetscReal :: d_nh4_inhibit ! d inhibition_coef/(inhibition_coef + nh4)
3463) PetscReal :: c_no3 ! concentration (mole/L)
3464) PetscReal :: ac_no3 ! activity coefficient
3465) PetscReal :: f_no3 ! no3 / (half_saturation + no3)
3466) PetscReal :: d_no3 ! half_saturation/(no3 + half_saturation)^2
3467) PetscReal :: temp_real
3468)
3469) PetscReal :: rate_plantn
3470) PetscReal :: rate_nh4
3471) PetscReal :: rate_no3
3472) PetscReal :: drate_nh4_dnh4
3473) PetscReal :: drate_no3_dno3
3474) PetscReal :: drate_no3_dnh4
3475) PetscReal :: c_plantn, c_plantno3, c_plantnh4, c_plantndemand
3476) PetscReal :: xxx, delta, regulator, dregulator
3477) PetscReal :: rate_nh4_clm_input, rate_no3_clm_input
3478)
3479) porosity = material_auxvar%porosity
3480) volume = material_auxvar%volume
3481)
3482) ires_nh4 = this%ispec_nh4
3483) ires_no3 = this%ispec_no3
3484) ires_plantn = this%ispec_plantn + reaction%offset_immobile
3485) ires_nh4in = this%ispec_nh4in + reaction%offset_immobile
3486) ires_no3in = this%ispec_no3in + reaction%offset_immobile
3487) ires_plantndemand = this%ispec_plantndemand + reaction%offset_immobile
3488)
3489) if (this%ispec_plantn < 0) then
3490) option%io_buffer = 'PlantN is not specified in the input file!'
3491) call printErrMsg(option)
3492) endif
3493)
3494) ires_nh4 = -999
3495) ires_no3 = -999
3496)
3497) f_nh4 = 1.0d0
3498) d_nh4 = 0.0d0
3499)
3500) if (this%ispec_nh4 > 0) then
3501) if (this%is_NH4_aqueous) then
3502) c_nh4 = rt_auxvar%pri_molal(this%ispec_nh4)
3503) ac_nh4 = rt_auxvar%pri_act_coef(this%ispec_nh4)
3504) ires_nh4 = this%ispec_nh4
3505) else
3506) c_nh4 = rt_auxvar%immobile(this%ispec_nh4)
3507) ac_nh4 = 1.0d0
3508) ires_nh4 = this%ispec_nh4 + reaction%offset_immobile
3509) endif
3510)
3511) call CalNLimitFunc(c_nh4, ac_nh4, this%residual_nh4, &
3512) this%half_saturation_nh4, this%cutoff_nh4_0, this%cutoff_nh4_1, &
3513) f_nh4, d_nh4)
3514) endif
3515)
3516) f_no3 = 1.0d0
3517) d_no3 = 0.0d0
3518)
3519) f_nh4_inhibit = 1.0d0
3520) d_nh4_inhibit = 0.0d0
3521)
3522) if (this%ispec_no3 > 0) then
3523) if (this%is_NO3_aqueous) then
3524) c_no3 = rt_auxvar%pri_molal(this%ispec_no3)
3525) ac_no3 = rt_auxvar%pri_act_coef(this%ispec_no3)
3526) ires_no3 = this%ispec_no3
3527) else
3528) c_no3 = rt_auxvar%immobile(this%ispec_no3)
3529) ac_no3 = 1.0d0
3530) ires_no3 = this%ispec_no3 + reaction%offset_immobile
3531) endif
3532)
3533) call CalNLimitFunc(c_no3, ac_no3, this%residual_no3, &
3534) this%half_saturation_no3, this%cutoff_no3_0, this%cutoff_no3_1, &
3535) f_no3, d_no3)
3536)
3537) if (this%ispec_nh4 > 0 .and. &
3538) this%inhibition_nh4_no3 > this%residual_nh4) then
3539) temp_real = this%inhibition_nh4_no3 + c_nh4 * ac_nh4
3540) f_nh4_inhibit = this%inhibition_nh4_no3/temp_real
3541) d_nh4_inhibit = -1.0d0 * this%inhibition_nh4_no3 * ac_nh4 &
3542) / temp_real / temp_real
3543) endif
3544) endif
3545)
3546) if (this%inhibition_nh4_no3 > this%residual_nh4) then
3547) rate_nh4 = this%rate_plantntake * volume
3548) rate_no3 = this%rate_plantntake * volume
3549) else
3550) rate_nh4 = this%rate_plantntake_nh4 * volume
3551) rate_no3 = this%rate_plantntake_no3 * volume
3552) endif
3553)
3554) rate_nh4_clm_input = this%rate_deposition_nh4 * volume
3555) rate_no3_clm_input = this%rate_deposition_no3 * volume
3556)
3557) if (this%ispec_plantndemand > 0) then
3558) Residual(ires_plantndemand) = Residual(ires_plantndemand) - rate_nh4
3559) endif
3560)
3561) if (this%ispec_nh4 > 0) then
3562)
3563) if (compute_derivative) then
3564) drate_nh4_dnh4 = rate_nh4 * d_nh4
3565) endif
3566) rate_nh4 = rate_nh4 * f_nh4
3567)
3568) Residual(ires_nh4) = Residual(ires_nh4) + rate_nh4
3569) Residual(ires_plantn) = Residual(ires_plantn) - rate_nh4
3570)
3571) if (this%ispec_nh4in > 0) then
3572) Residual(ires_nh4in) = Residual(ires_nh4in) - rate_nh4
3573) endif
3574)
3575) RateDemand_nh4(ires_nh4) = RateDemand_nh4(ires_nh4) + rate_nh4
3576) RateDemand_nh4(ires_plantn) = RateDemand_nh4(ires_plantn) - rate_nh4
3577)
3578) if (this%ispec_nh4in > 0) then
3579) RateDemand_nh4(ires_nh4in) = RateDemand_nh4(ires_nh4in) - rate_nh4
3580) endif
3581)
3582) if (compute_derivative) then
3583) Jacobian(ires_nh4,ires_nh4) = Jacobian(ires_nh4,ires_nh4) + drate_nh4_dnh4
3584)
3585) Jacobian(ires_plantn,ires_nh4) = Jacobian(ires_plantn,ires_nh4) &
3586) - drate_nh4_dnh4
3587)
3588) if (this%ispec_nh4in > 0) then
3589) Jacobian(ires_nh4in,ires_nh4) = Jacobian(ires_nh4in,ires_nh4) &
3590) - drate_nh4_dnh4
3591) endif
3592)
3593) JacobianDemand_nh4(ires_nh4,ires_nh4) = &
3594) JacobianDemand_nh4(ires_nh4,ires_nh4) + drate_nh4_dnh4
3595)
3596) JacobianDemand_nh4(ires_plantn,ires_nh4) = &
3597) JacobianDemand_nh4(ires_plantn,ires_nh4) - drate_nh4_dnh4
3598)
3599) if (this%ispec_nh4in > 0) then
3600) JacobianDemand_nh4(ires_nh4in,ires_nh4) = &
3601) JacobianDemand_nh4(ires_nh4in,ires_nh4) - drate_nh4_dnh4
3602) endif
3603)
3604) endif
3605) endif
3606)
3607) if (this%ispec_no3 > 0) then
3608) if (compute_derivative) then
3609) drate_no3_dno3 = rate_no3 * f_nh4_inhibit * d_no3
3610) drate_no3_dnh4 = rate_no3 * d_nh4_inhibit * f_no3
3611) endif
3612)
3613) rate_no3 = rate_no3 * f_nh4_inhibit * f_no3
3614)
3615) Residual(ires_no3) = Residual(ires_no3) + rate_no3
3616) Residual(ires_plantn) = Residual(ires_plantn) - rate_no3
3617)
3618) if (this%ispec_no3in > 0) then
3619) Residual(ires_no3in) = Residual(ires_no3in) - rate_no3
3620) endif
3621)
3622) RateDemand_no3(ires_no3) = RateDemand_no3(ires_no3) + rate_no3
3623) RateDemand_no3(ires_plantn) = RateDemand_no3(ires_plantn) - rate_no3
3624)
3625) if (this%ispec_no3in > 0) then
3626) RateDemand_no3(ires_no3in) = RateDemand_no3(ires_no3in) - rate_no3
3627) endif
3628)
3629) if (compute_derivative) then
3630) Jacobian(ires_no3,ires_no3) = Jacobian(ires_no3,ires_no3) + drate_no3_dno3
3631)
3632) Jacobian(ires_plantn,ires_no3) = Jacobian(ires_plantn,ires_no3) &
3633) - drate_no3_dno3
3634)
3635) if (this%ispec_no3in > 0 .and. (.not.this%bskippno3jacobian)) then
3636) Jacobian(ires_no3in,ires_no3) = Jacobian(ires_no3in,ires_no3) &
3637) - drate_no3_dno3
3638) endif
3639)
3640) Jacobian(ires_no3,ires_nh4) = Jacobian(ires_no3,ires_nh4) + drate_no3_dnh4
3641)
3642) Jacobian(ires_plantn,ires_nh4) = Jacobian(ires_plantn,ires_nh4) &
3643) - drate_no3_dnh4
3644)
3645) if (this%ispec_no3in > 0 .and. (.not.this%bskippno3jacobian)) then
3646) Jacobian(ires_no3in,ires_nh4) = Jacobian(ires_no3in,ires_nh4) &
3647) - drate_no3_dnh4
3648) endif
3649)
3650) JacobianDemand_no3(ires_no3,ires_no3) = &
3651) JacobianDemand_no3(ires_no3,ires_no3) + drate_no3_dno3
3652)
3653) JacobianDemand_no3(ires_plantn,ires_no3) = &
3654) JacobianDemand_no3(ires_plantn,ires_no3) - drate_no3_dno3
3655)
3656) if (this%ispec_no3in > 0 .and. (.not.this%bskippno3jacobian)) then
3657) JacobianDemand_no3(ires_no3in,ires_no3) = &
3658) JacobianDemand_no3(ires_no3in,ires_no3) - drate_no3_dno3
3659) endif
3660)
3661) JacobianDemand_no3(ires_no3,ires_nh4) = &
3662) JacobianDemand_no3(ires_no3,ires_nh4) + drate_no3_dnh4
3663)
3664) JacobianDemand_no3(ires_plantn,ires_nh4) = &
3665) JacobianDemand_no3(ires_plantn,ires_nh4) - drate_no3_dnh4
3666)
3667) if (this%ispec_no3in > 0 .and. (.not.this%bskippno3jacobian)) then
3668) JacobianDemand_no3(ires_no3in,ires_nh4) = &
3669) JacobianDemand_no3(ires_no3in,ires_nh4) - drate_no3_dnh4
3670) endif
3671)
3672) if (this%bdebugoutput) then
3673) c_plantn = rt_auxvar%immobile(this%ispec_plantn)
3674) write(*, *) c_nh4, c_no3, rate_plantn, rate_nh4_clm_input, &
3675) rate_no3_clm_input, rate_nh4, rate_no3, c_plantn
3676) endif
3677) endif
3678) endif
3679)
3680) end subroutine PlantNReact
3681)
3682) ! **************************************************************************** !
3683) !
3684) ! PlantNDestroy: Destroys allocatable or pointer objects created in this module
3685) !
3686) ! **************************************************************************** !
3687) subroutine PlantNDestroy(this)
3688)
3689) implicit none
3690)
3691) class(clm_rxn_plantn_type) :: this
3692)
3693) end subroutine PlantNDestroy
3694)
3695) end module CLM_Rxn_PlantN_class
3696)
3697)
3698) module CLM_Rxn_Nitr_class
3699)
3700) ! ------------------------------------------------------------------------------
3701) ! Description
3702) ! nitrification function following Dickinson et al. 2002
3703) ! NH4+ -> NO3-
3704) ! rate = kmax ftheta fT NH4+
3705) ! fT = exp(0.08(T - 298))
3706) ! ftheta = s (1 - s) / (0.25 + 1 / NH4+)
3707) ! and Parton et al 1996
3708) ! NH4+ -> 0.5 N2O
3709) ! rate = kmax ftheta fT fpH (1 - exp(-0.0104e6mN rhob/theta NH4+)
3710) ! by t6g 10/06/2014
3711) ! 1/(0.25 + 1 / NH4+) = 4 NH4+ /(NH4+ + 4)
3712) ! simplifies to the general Monod function, add DICKINSON if not
3713) ! 1 - exp(-x) = x + ... (remove high order terms)
3714) ! simplify to first order rate, add PARTON if not
3715) ! by t6g 2/13/2015
3716) ! ------------------------------------------------------------------------------
3717)
3718) use CLM_Rxn_Base_class
3719)
3720) use Global_Aux_module
3721) use Reactive_Transport_Aux_module
3722) use PFLOTRAN_Constants_module
3723)
3724) implicit none
3725)
3726) private
3727)
3728) #include "petsc/finclude/petscsys.h"
3729)
3730) PetscInt, parameter :: TEMPERATURE_RESPONSE_FUNCTION_CLM4 = 1
3731) PetscInt, parameter :: TEMPERATURE_RESPONSE_FUNCTION_Q10 = 2
3732)
3733) type, public, &
3734) extends(clm_rxn_base_type) :: clm_rxn_nitr_type
3735) PetscInt :: ispec_proton
3736) PetscInt :: ispec_nh4
3737) PetscInt :: ispec_nh4sorb
3738) PetscInt :: ispec_no3
3739) PetscInt :: ispec_n2o
3740) PetscInt :: ispec_ngasnit
3741) PetscReal :: k_nitr_max
3742) PetscReal :: k_nitr_n2o
3743) PetscInt :: temperature_response_function
3744) PetscReal :: Q10
3745) PetscReal :: residual_conc
3746) PetscReal :: half_saturation
3747) PetscReal :: cutoff_nh4_0 ! shut off
3748) PetscReal :: cutoff_nh4_1 ! start to decrease from 1
3749) PetscReal :: c_nh4_ugg_0
3750) PetscReal :: c_nh4_ugg_1 ! N2O production from nitr (Parton et al. 1996)
3751) PetscBool :: disable_mrf ! for testing purpose
3752) PetscBool :: bdebugoutput
3753) ! to use 1/(0.25 + 1/NH4+) rather than the simple Monod substrate limiting function
3754) PetscBool :: bDickinson
3755) ! to use (1 - exp(-0.0104e6mN rhob/theta NH4+) rather than first order
3756) PetscBool :: bParton
3757) PetscBool :: is_NH4_aqueous
3758) PetscBool :: is_NO3_aqueous
3759) PetscBool :: bskipnitrjacobian
3760)
3761) contains
3762) procedure, public :: ReadInput => NitrRead
3763) procedure, public :: Setup => NitrSetup
3764) procedure, public :: Evaluate => NitrReact
3765) procedure, public :: Destroy => NitrDestroy
3766) end type clm_rxn_nitr_type
3767)
3768) public :: NitrCreate
3769)
3770) contains
3771)
3772) ! ************************************************************************** !
3773) !
3774) ! NitrCreate: Allocates nitr reaction object.
3775) !
3776) ! ************************************************************************** !
3777) function NitrCreate()
3778)
3779) implicit none
3780)
3781) class(clm_rxn_nitr_type), pointer :: NitrCreate
3782)
3783) allocate(NitrCreate)
3784) NitrCreate%ispec_proton = 0
3785) NitrCreate%ispec_nh4 = 0
3786) NitrCreate%ispec_nh4sorb = 0
3787) NitrCreate%ispec_no3 = 0
3788) NitrCreate%ispec_ngasnit = 0
3789) NitrCreate%k_nitr_max = 1.d-6
3790) NitrCreate%k_nitr_n2o = 3.5d-8
3791) NitrCreate%temperature_response_function = TEMPERATURE_RESPONSE_FUNCTION_CLM4
3792) NitrCreate%Q10 = 1.5d0
3793) NitrCreate%residual_conc = 1.0d-10
3794) NitrCreate%half_saturation = -1.0d-6
3795) NitrCreate%cutoff_nh4_0 =-1.0d-20
3796) NitrCreate%cutoff_nh4_1 = 1.0d-20
3797) NitrCreate%c_nh4_ugg_0 = 2.9d0
3798) NitrCreate%c_nh4_ugg_1 = 3.0d0 ! N2O production from nitr (Parton et al. 1996)
3799) NitrCreate%disable_mrf = PETSC_FALSE
3800) NitrCreate%bdebugoutput = PETSC_FALSE
3801) NitrCreate%bDickinson = PETSC_FALSE
3802) NitrCreate%bParton = PETSC_FALSE
3803) NitrCreate%is_NH4_aqueous = PETSC_TRUE
3804) NitrCreate%is_NO3_aqueous = PETSC_TRUE
3805) NitrCreate%bskipnitrjacobian = PETSC_FALSE
3806) nullify(NitrCreate%next)
3807)
3808) end function NitrCreate
3809)
3810) ! ************************************************************************** !
3811) !
3812) ! NitrRead: Reads input deck for nitr reaction parameters (if any)
3813) !
3814) ! ************************************************************************** !
3815) subroutine NitrRead(this,input,option)
3816)
3817) use Option_module
3818) use String_module
3819) use Input_Aux_module
3820) use Units_module, only : UnitsConvertToInternal
3821)
3822) implicit none
3823)
3824) class(clm_rxn_nitr_type) :: this
3825) type(input_type), pointer :: input
3826) type(option_type) :: option
3827)
3828) PetscInt :: i
3829) character(len=MAXWORDLENGTH) :: word, internal_units
3830)
3831) do
3832) call InputReadPflotranString(input,option)
3833) if (InputError(input)) exit
3834) if (InputCheckExit(input,option)) exit
3835)
3836) call InputReadWord(input,option,word,PETSC_TRUE)
3837) call InputErrorMsg(input,option,'keyword', &
3838) 'CHEMISTRY,CLM_RXN,NITRIFICATION')
3839) call StringToUpper(word)
3840)
3841) select case(trim(word))
3842) case('TEMPERATURE_RESPONSE_FUNCTION')
3843) do
3844) call InputReadPflotranString(input,option)
3845) if (InputError(input)) exit
3846) if (InputCheckExit(input,option)) exit
3847)
3848) call InputReadWord(input,option,word,PETSC_TRUE)
3849) call InputErrorMsg(input,option,'keyword', &
3850) 'CHEMISTRY,CLM_RXN,NITRIFICATION,TEMPERATURE RESPONSE FUNCTION')
3851) call StringToUpper(word)
3852)
3853) select case(trim(word))
3854) case('CLM4')
3855) this%temperature_response_function = &
3856) TEMPERATURE_RESPONSE_FUNCTION_CLM4
3857) case('Q10')
3858) this%temperature_response_function = &
3859) TEMPERATURE_RESPONSE_FUNCTION_Q10
3860) call InputReadDouble(input,option,this%Q10)
3861) call InputErrorMsg(input,option,'Q10', &
3862) 'CHEMISTRY,CLM_RXN_NITRIFICATION,TEMPERATURE RESPONSE FUNCTION')
3863) case default
3864) call InputKeywordUnrecognized(word, &
3865) 'CHEMISTRY,CLM_RXN,NITRIFICATION,TEMPERATURE RESPONSE FUNCTION', &
3866) option)
3867) end select
3868) enddo
3869) case('RATE_CONSTANT_NO3')
3870) call InputReadDouble(input,option,this%k_nitr_max)
3871) call InputErrorMsg(input,option,'nitr rate coefficient', &
3872) 'CHEMISTRY,CLM_RXN,NITRIFICATION,REACTION')
3873) case('RATE_CONSTANT_N2O')
3874) call InputReadDouble(input,option,this%k_nitr_n2o)
3875) call InputErrorMsg(input,option,'N2O rate coefficient', &
3876) 'CHEMISTRY,CLM_RXN,NITRIFICATION,REACTION')
3877) case('RESIDUAL_NH4')
3878) call InputReadDouble(input,option,this%residual_conc)
3879) call InputErrorMsg(input,option,'residual NH4+', &
3880) 'CHEMISTRY,CLM_RXN,NITRIFICATION,REACTION')
3881) case('HALF_SATURATION_NH4')
3882) call InputReadDouble(input,option,this%half_saturation)
3883) call InputErrorMsg(input,option,'half saturation NH4+', &
3884) 'CHEMISTRY,CLM_RXN,NITRIFICATION,REACTION')
3885) case('CUTOFF_NH4')
3886) call InputReadDouble(input,option,this%cutoff_nh4_0)
3887) call InputErrorMsg(input,option,'cutoff_nh4_0', &
3888) 'CHEMISTRY,CLM_RXN,NITRIFICATION,REACTION')
3889) call InputReadDouble(input,option,this%cutoff_nh4_1)
3890) call InputErrorMsg(input,option,'cutoff_nh4_1', &
3891) 'CHEMISTRY,CLM_RXN,NITRIFICATION,REACTION')
3892) if (this%cutoff_nh4_0 > this%cutoff_nh4_1) then
3893) option%io_buffer = 'CHEMISTRY,CLM_RXN,NITRIFICATION,' // &
3894) 'NH4+ cut off concentration > concentration ' // &
3895) 'where down regulation function = 1.'
3896) call printErrMsg(option)
3897) endif
3898) case('SMOOTH_NH4_2_N2O')
3899) call InputReadDouble(input,option,this%c_nh4_ugg_0)
3900) call InputErrorMsg(input,option,'c_nh4_ugg_0', &
3901) 'CHEMISTRY,CLM_RXN,NITRIFICATION,REACTION')
3902) call InputReadDouble(input,option,this%c_nh4_ugg_1)
3903) call InputErrorMsg(input,option,'c_nh4_ugg_1', &
3904) 'CHEMISTRY,CLM_RXN,NITRIFICATION,REACTION')
3905) case('DICKINSON')
3906) this%bDickinson = PETSC_TRUE
3907) case('PARTON')
3908) this%bParton = PETSC_TRUE
3909) case('DISABLE_MRF')
3910) this%disable_mrf = PETSC_TRUE
3911) case('DEBUG_OUTPUT')
3912) this%bdebugoutput = PETSC_TRUE
3913) case('JACOBIAN_NITR_SKIP')
3914) this%bskipnitrjacobian = PETSC_TRUE
3915) case default
3916) call InputKeywordUnrecognized(word, &
3917) 'CHEMISTRY,CLM_RXN,NITRIFICATION,REACTION',option)
3918) end select
3919) enddo
3920)
3921) end subroutine NitrRead
3922)
3923) ! ************************************************************************** !
3924) !
3925) ! NitrSetup: Sets up the nitr reaction either with parameters either
3926) ! read from the input deck or hardwired.
3927) !
3928) ! ************************************************************************** !
3929) subroutine NitrSetup(this,reaction,option)
3930)
3931) use Reaction_Aux_module, only : reaction_type, GetPrimarySpeciesIDFromName
3932) use Option_module
3933) use Reaction_Immobile_Aux_module, only : GetImmobileSpeciesIDFromName
3934)
3935) implicit none
3936)
3937) class(clm_rxn_nitr_type) :: this
3938) type(reaction_type) :: reaction
3939) type(option_type) :: option
3940)
3941) character(len=MAXWORDLENGTH) :: word
3942)
3943) word = 'H+'
3944) this%ispec_proton = GetPrimarySpeciesIDFromName(word,reaction, &
3945) PETSC_FALSE,option)
3946)
3947) word = 'NH3(aq)'
3948) this%ispec_nh4 = GetPrimarySpeciesIDFromName(word,reaction, &
3949) PETSC_FALSE,option)
3950)
3951) if (this%ispec_nh4 < 0) then
3952) word = 'NH4+'
3953) this%ispec_nh4 = GetPrimarySpeciesIDFromName(word,reaction, &
3954) PETSC_FALSE,option)
3955) endif
3956)
3957) if (this%ispec_nh4 < 0) then
3958) word = 'Ammonium'
3959) this%ispec_nh4 = GetImmobileSpeciesIDFromName( &
3960) word,reaction%immobile,PETSC_FALSE,option)
3961) if (this%ispec_nh4 > 0) then
3962) this%is_NH4_aqueous = PETSC_FALSE
3963) endif
3964) endif
3965)
3966) word = 'NO3-'
3967) this%ispec_no3 = GetPrimarySpeciesIDFromName(word,reaction, &
3968) PETSC_FALSE,option)
3969)
3970) if (this%ispec_no3 < 0) then
3971) word = 'Nitrate'
3972) this%ispec_no3 = GetImmobileSpeciesIDFromName( &
3973) word,reaction%immobile,PETSC_FALSE,option)
3974) if (this%ispec_no3 > 0) then
3975) this%is_NO3_aqueous = PETSC_FALSE
3976) endif
3977) endif
3978)
3979) word = 'N2O(aq)'
3980) this%ispec_n2o = GetPrimarySpeciesIDFromName(word,reaction, &
3981) PETSC_FALSE,option)
3982) if (this%ispec_n2o < 0) then
3983) word = 'NO2-'
3984) this%ispec_n2o = GetPrimarySpeciesIDFromName(word,reaction, &
3985) PETSC_FALSE,option)
3986) endif
3987)
3988) if (this%ispec_nh4 < 0) then
3989) option%io_buffer = 'CHEMISTRY,CLM_RXN,NITRIFICATION: ' // &
3990) 'NH3(aq), NH4+, or Ammonium is not specified in the input file.'
3991) call printErrMsg(option)
3992) endif
3993)
3994) if (this%ispec_no3 < 0) then
3995) option%io_buffer = 'CHEMISTRY,CLM_RXN,NITRIFICATION: ' // &
3996) ' NO3- is not specified in the input file.'
3997) call printErrMsg(option)
3998) endif
3999)
4000) ! if (this%ispec_n2o < 0) then
4001) ! option%io_buffer = 'CHEMISTRY,CLM_RXN,NITRIFICATION: ' // &
4002) ! ' N2O(aq) is not specified in the input file.'
4003) ! call printErrMsg(option)
4004) ! endif
4005)
4006) word = 'NGASnitr'
4007) this%ispec_ngasnit = GetImmobileSpeciesIDFromName( &
4008) word,reaction%immobile,PETSC_FALSE,option)
4009)
4010) end subroutine NitrSetup
4011)
4012) ! ************************************************************************** !
4013) !
4014) ! NitrReact: Evaluates reaction storing residual and/or Jacobian
4015) !
4016) ! ************************************************************************** !
4017) subroutine NitrReact(this,Residual,Jacobian,compute_derivative, &
4018) rt_auxvar,global_auxvar,material_auxvar,reaction,option, &
4019) RateDemand_nh4,RateSupply_nh4, &
4020) JacobianDemand_nh4,JacobianSupply_nh4, &
4021) RateDemand_no3,RateSupply_no3, &
4022) JacobianDemand_no3,JacobianSupply_no3, &
4023) Rate_nh4_to_no3,Jacobian_nh4_to_no3)
4024) use Option_module
4025) use Reaction_Aux_module
4026) use Material_Aux_class, only : material_auxvar_type
4027) use CLM_Rxn_Common_module, only: CalNLimitFunc
4028) implicit none
4029)
4030) class(clm_rxn_nitr_type) :: this
4031) type(option_type) :: option
4032) type(reaction_type) :: reaction
4033) type(reactive_transport_auxvar_type) :: rt_auxvar
4034) type(global_auxvar_type) :: global_auxvar
4035) class(material_auxvar_type) :: material_auxvar
4036)
4037) PetscBool :: compute_derivative
4038) PetscReal :: Residual(reaction%ncomp)
4039) PetscReal :: Jacobian(reaction%ncomp,reaction%ncomp)
4040) PetscReal :: RateDemand_nh4(reaction%ncomp)
4041) PetscReal :: RateSupply_nh4(reaction%ncomp)
4042) PetscReal :: JacobianDemand_nh4(reaction%ncomp,reaction%ncomp)
4043) PetscReal :: JacobianSupply_nh4(reaction%ncomp,reaction%ncomp)
4044) PetscReal :: RateDemand_no3(reaction%ncomp)
4045) PetscReal :: RateSupply_no3(reaction%ncomp)
4046) PetscReal :: JacobianDemand_no3(reaction%ncomp,reaction%ncomp)
4047) PetscReal :: JacobianSupply_no3(reaction%ncomp,reaction%ncomp)
4048) PetscReal :: Rate_nh4_to_no3
4049) PetscReal :: Jacobian_nh4_to_no3(reaction%ncomp)
4050) PetscReal :: porosity
4051) PetscReal :: volume
4052) PetscInt :: local_id
4053) PetscErrorCode :: ierr
4054)
4055) PetscInt, parameter :: iphase = 1
4056) PetscReal, parameter :: rpi = 3.14159265358979323846
4057) PetscReal, parameter :: N_molecular_weight = 14.0067d0
4058) PetscReal :: M_2_ug_per_g
4059) PetscReal :: mol_m3_2_ug_per_g
4060)
4061) PetscInt :: ires_nh4, ires_no3, ires_n2o
4062)
4063) PetscScalar, pointer :: bulkdensity(:)
4064) PetscReal :: rho_b
4065) PetscReal :: theta
4066) PetscReal :: c_nh4 ! mole/L
4067) PetscReal :: ac_nh4 ! mole/L
4068) PetscReal :: s_nh4 ! mole/m3
4069) PetscReal :: c_nh4_ugg ! ug ammonia N / g soil
4070) PetscReal :: ph
4071) PetscReal :: rate_n2o, drate_n2o
4072) PetscReal :: rate_nitri, drate_nitri
4073) PetscReal :: f_t, f_w, f_ph
4074) PetscReal :: dfw_dnh4
4075) PetscReal :: saturation
4076) PetscReal :: tc
4077) PetscReal :: kg_water
4078) PetscReal :: h2osoi
4079) PetscInt :: ires_ngasnit
4080) PetscReal :: xxx, delta, regulator, dregulator
4081) PetscReal :: f_nh4, d_nh4 ! for monod substrate limitation
4082) PetscReal :: f_n2o, d_n2o ! for smoothing N2O production
4083) PetscReal :: c_nh4_0, c_nh4_1
4084) PetscReal :: temp_real
4085) PetscReal :: unitconv
4086)
4087) porosity = material_auxvar%porosity
4088) volume = material_auxvar%volume
4089) kg_water = material_auxvar%porosity*global_auxvar%sat(iphase)* &
4090) material_auxvar%volume*global_auxvar%den_kg(iphase)
4091)
4092) unitconv = 1.0d0
4093) M_2_ug_per_g = 1.0d0
4094) mol_m3_2_ug_per_g = 1.0d0
4095) h2osoi = 1.0d0
4096)
4097) local_id = option%iflag
4098) ! indices for C and N species
4099) ires_nh4 = this%ispec_nh4
4100) ires_no3 = this%ispec_no3
4101) ires_n2o = this%ispec_n2o
4102) ires_ngasnit = this%ispec_ngasnit + reaction%offset_immobile
4103)
4104) saturation = global_auxvar%sat(1)
4105) theta = saturation * porosity
4106)
4107) tc = global_auxvar%temp
4108)
4109) if (this%is_NH4_aqueous) then
4110) c_nh4 = rt_auxvar%pri_molal(this%ispec_nh4)
4111) ac_nh4 = rt_auxvar%pri_act_coef(this%ispec_nh4)
4112) ires_nh4 = this%ispec_nh4
4113) else
4114) c_nh4 = rt_auxvar%immobile(this%ispec_nh4)
4115) ac_nh4 = 1.0d0
4116) ires_nh4 = this%ispec_nh4 + reaction%offset_immobile
4117) endif
4118)
4119) call CalNLimitFunc(c_nh4, ac_nh4, this%residual_conc, this%half_saturation, &
4120) this%cutoff_nh4_0, this%cutoff_nh4_1, f_nh4, d_nh4)
4121)
4122) if (associated(rt_auxvar%total_sorb_eq)) then ! original absorption-reactions in PF used
4123) s_nh4 = rt_auxvar%total_sorb_eq(this%ispec_nh4)
4124) else
4125) s_nh4 = 1.d-20
4126) endif
4127)
4128) c_nh4 = (c_nh4 - this%residual_conc) * ac_nh4
4129)
4130) ! nitrification (Dickinson et al. 2002)
4131) if (this%ispec_no3 > 0) then
4132) f_t = exp(0.08d0 * (tc - 298.0d0 + 273.15d0))
4133)
4134) if (tc < 0.0d0) f_t = 0.0d0 ! to be consistent in CLM CNNDynamicsMod.F90 line 839
4135)
4136) if (this%disable_mrf) then
4137) f_w = 1.0d0
4138) else
4139) f_w = saturation * (1.0d0 - saturation)
4140) endif
4141)
4142) if (this%is_NH4_aqueous) then
4143) temp_real = f_t * f_w * this%k_nitr_max * kg_water
4144) else
4145) temp_real = f_t * f_w * this%k_nitr_max * volume
4146) endif
4147)
4148) if (this%bDickinson) then
4149) ! to make is consistent with clm CNNDynamicsMod.F90 line 832
4150) if (this%is_NH4_aqueous) then
4151) unitconv = N_molecular_weight * h2osoi * 1000.0d0 ! from mol/L to g/m^3
4152) else
4153) unitconv = N_molecular_weight ! from mol/m^3 to g/m^3
4154) endif
4155) rate_nitri = temp_real * c_nh4 * c_nh4 / (0.25d0 * c_nh4 + 1.0d0/unitconv)
4156) else
4157) rate_nitri = temp_real * c_nh4
4158) endif
4159)
4160) Residual(ires_nh4) = Residual(ires_nh4) + rate_nitri * f_nh4
4161) Residual(ires_no3) = Residual(ires_no3) - rate_nitri * f_nh4
4162)
4163) RateDemand_nh4(ires_nh4) = RateDemand_nh4(ires_nh4) + rate_nitri * f_nh4
4164) RateDemand_nh4(ires_no3) = RateDemand_nh4(ires_no3) - rate_nitri * f_nh4
4165)
4166) Rate_nh4_to_no3 = Rate_nh4_to_no3 + rate_nitri * f_nh4
4167)
4168) if (compute_derivative) then
4169) if (this%bDickinson) then
4170) ! f = x^2/(x/4+1/u)
4171) ! f' = [2x(x/4+1/u) - x^2/4]/(x/4 + 1/u)^2
4172) ! = (x^2/4 + 2x/u)/(x/4 + 1/u)^2
4173) drate_nitri = temp_real &
4174) * (0.25d0 * c_nh4 * c_nh4 + 2.0d0 * c_nh4 / unitconv) &
4175) / (0.25d0 * c_nh4 + 1.0d0/unitconv) &
4176) / (0.25d0 * c_nh4 + 1.0d0/unitconv) * ac_nh4
4177) else
4178) drate_nitri = temp_real
4179) endif
4180)
4181) drate_nitri = drate_nitri * f_nh4 + rate_nitri * d_nh4
4182)
4183) Jacobian(ires_nh4,ires_nh4) = Jacobian(ires_nh4,ires_nh4) + drate_nitri
4184)
4185) Jacobian(ires_no3,ires_nh4) = Jacobian(ires_no3,ires_nh4) - drate_nitri
4186)
4187) JacobianDemand_nh4(ires_nh4,ires_nh4) = &
4188) JacobianDemand_nh4(ires_nh4,ires_nh4) + drate_nitri
4189)
4190) JacobianDemand_nh4(ires_no3,ires_nh4) = &
4191) JacobianDemand_nh4(ires_no3,ires_nh4) - drate_nitri
4192)
4193) Jacobian_nh4_to_no3(ires_nh4) = Jacobian_nh4_to_no3(ires_nh4) + drate_nitri
4194) endif
4195) endif
4196)
4197) ! N2O production from nitr (Parton et al. 1996)
4198) if (this%ispec_n2o > 0) then
4199)
4200) rho_b = 1.25d0
4201)
4202) if (this%is_NH4_aqueous) then
4203) ! mole/L * 1000 L/m3 * g/mol / kg/m3 = g/kg = mg/g = 1000 ug/g
4204) M_2_ug_per_g = theta *1000.0d0 * N_molecular_weight / rho_b * 1000.0d0
4205) !c_nh4_ugg = (c_nh4 + s_nh4 / theta / 1000.0d0)* M_2_ug_per_g
4206) c_nh4_ugg = c_nh4 * M_2_ug_per_g
4207)
4208) c_nh4_0 = this%c_nh4_ugg_0 / M_2_ug_per_g
4209) c_nh4_1 = this%c_nh4_ugg_1 / M_2_ug_per_g
4210) else
4211) ! mole/m3 * g/mol / kg/m3 = g/kg = mg/g = 1000 ug/g
4212) mol_m3_2_ug_per_g = N_molecular_weight / rho_b * 1000.0d0
4213) !c_nh4_ugg = (c_nh4 + s_nh4 / theta / 1000.0d0)* M_2_ug_per_g
4214) c_nh4_ugg = c_nh4 * mol_m3_2_ug_per_g
4215)
4216) c_nh4_0 = this%c_nh4_ugg_0 / mol_m3_2_ug_per_g
4217) c_nh4_1 = this%c_nh4_ugg_1 / mol_m3_2_ug_per_g
4218)
4219) endif
4220)
4221) if (c_nh4 <= c_nh4_0) then
4222) f_n2o = 0.0d0
4223) d_n2o = 0.0d0
4224) elseif (c_nh4 >= c_nh4_1 .or. &
4225) this%c_nh4_ugg_0 - this%c_nh4_ugg_1 > 1.0d-20) then
4226) f_n2o = 1.0d0
4227) d_n2o = 0.0d0
4228) else
4229) xxx = c_nh4 - c_nh4_0
4230) delta = c_nh4_1 - c_nh4_0
4231) f_n2o = 1.0d0 - (1.0d0 - xxx * xxx / delta / delta) ** 2
4232) d_n2o = 4.0d0 * (1.0d0 - xxx * xxx / delta / delta) * xxx / delta / delta
4233) endif
4234)
4235) ! temperature response function (Parton et al. 1996)
4236) f_t = -0.06d0 + 0.13d0 * exp( 0.07d0 * tc )
4237)
4238) f_w = ((1.27d0 - saturation)/0.67d0)**(3.1777d0) * &
4239) ((saturation - 0.0012d0)/0.5988d0)**2.84d0
4240)
4241) ph = 6.5d0 ! default
4242) if (this%ispec_proton > 0) then
4243) if (reaction%species_idx%h_ion_id > 0) then
4244) ph = &
4245) -log10(rt_auxvar%pri_molal(reaction%species_idx%h_ion_id)* &
4246) rt_auxvar%pri_act_coef(reaction%species_idx%h_ion_id))
4247) else if (reaction%species_idx%h_ion_id < 0) then
4248) ph = &
4249) -log10(rt_auxvar%sec_molal(abs(reaction%species_idx%h_ion_id))* &
4250) rt_auxvar%sec_act_coef(abs(reaction%species_idx%h_ion_id)))
4251) endif
4252) endif
4253) f_ph = 0.56 + atan(rpi * 0.45 * (-5.0 + ph))/rpi
4254)
4255) if (f_t > 0.0d0 .and. f_w > 0.0d0 .and. f_ph > 0.0d0) then
4256) if (f_w > 1.0d0) then
4257) f_w = 1.0d0
4258) endif
4259)
4260) if (f_ph > 1.0d0) then
4261) f_ph = 1.0d0
4262) endif
4263)
4264) if (this%is_NH4_aqueous) then
4265) temp_real = f_t * f_w * f_ph * this%k_nitr_n2o * kg_water
4266) else
4267) temp_real = f_t * f_w * f_ph * this%k_nitr_n2o * volume
4268) endif
4269)
4270)
4271) rate_n2o = 1.0 - exp(-0.0105d0 * c_nh4_ugg) ! need to change units
4272) ! Parton et al. 1996 unit is g N ha^-1 d^-1
4273) rate_n2o = rate_n2o * temp_real
4274) rate_n2o = rate_n2o * f_nh4 * f_n2o
4275)
4276) Residual(ires_nh4) = Residual(ires_nh4) + rate_n2o
4277) Residual(ires_n2o) = Residual(ires_n2o) - 0.5d0 * rate_n2o
4278)
4279) if (this%ispec_ngasnit > 0) then
4280) Residual(ires_ngasnit) = Residual(ires_ngasnit) - 0.5d0 * rate_n2o
4281) endif
4282)
4283) RateDemand_nh4(ires_nh4) = RateDemand_nh4(ires_nh4) + rate_n2o
4284) RateDemand_nh4(ires_n2o) = RateDemand_nh4(ires_n2o) - 0.5d0 * rate_n2o
4285)
4286) if (this%ispec_ngasnit > 0) then
4287) RateDemand_nh4(ires_ngasnit) = RateDemand_nh4(ires_ngasnit) &
4288) - 0.5d0 * rate_n2o
4289) endif
4290)
4291) if (compute_derivative) then
4292) if (this%is_NH4_aqueous) then
4293) drate_n2o = 0.0105d0*exp(-0.0105d0*c_nh4_ugg) &
4294) * M_2_ug_per_g
4295) else
4296) drate_n2o = 0.0105d0*exp(-0.0105d0*c_nh4_ugg) &
4297) * mol_m3_2_ug_per_g
4298) endif
4299)
4300) drate_n2o = drate_n2o * temp_real
4301)
4302) drate_n2o = drate_n2o * f_nh4 + rate_n2o * d_nh4
4303) drate_n2o = drate_n2o * f_n2o + rate_n2o * d_n2o
4304)
4305) Jacobian(ires_nh4,ires_nh4) = Jacobian(ires_nh4,ires_nh4) + drate_n2o
4306)
4307) Jacobian(ires_n2o,ires_nh4) = Jacobian(ires_n2o,ires_nh4) - &
4308) 0.5d0 * drate_n2o
4309)
4310) if (this%ispec_ngasnit > 0 .and. (.not.this%bskipnitrjacobian)) then
4311) Jacobian(ires_ngasnit,ires_nh4)=Jacobian(ires_ngasnit,ires_nh4) - &
4312) 0.5d0 * drate_n2o
4313) endif
4314)
4315) JacobianDemand_nh4(ires_nh4,ires_nh4) = &
4316) JacobianDemand_nh4(ires_nh4,ires_nh4) + drate_n2o
4317)
4318) JacobianDemand_nh4(ires_n2o,ires_nh4) = &
4319) JacobianDemand_nh4(ires_n2o,ires_nh4) - 0.5d0 * drate_n2o
4320)
4321) if (this%ispec_ngasnit > 0 .and. (.not.this%bskipnitrjacobian)) then
4322) JacobianDemand_nh4(ires_ngasnit,ires_nh4) = &
4323) JacobianDemand_nh4(ires_ngasnit,ires_nh4) - 0.5d0 * drate_n2o
4324) endif
4325)
4326) if (this%bdebugoutput) then
4327) write(*, *) 'Nitri: N2O', rate_n2o, drate_n2o
4328) endif
4329)
4330) endif
4331) endif
4332) endif
4333)
4334) ! N2O production from nitr (Parton et al. 1996), simplify 1 - e^(-x) to x
4335) if (this%ispec_n2o > 0 .and. (.not.this%bParton)) then
4336) ! temperature response function (Parton et al. 1996)
4337) f_t = -0.06d0 + 0.13d0 * exp( 0.07d0 * tc )
4338)
4339) f_w = ((1.27d0 - saturation)/0.67d0)**(3.1777d0) * &
4340) ((saturation - 0.0012d0)/0.5988d0)**2.84d0
4341)
4342) f_ph = 1.0d0 ! not ready yet, 0.56 + atan(rpi * 0.45 * (-5.0 + ph))/rpi
4343)
4344) if (f_t > 0.0d0 .and. f_w > 0.0d0 .and. f_ph > 0.0d0) then
4345) if (f_w > 1.0d0) then
4346) f_w = 1.0d0
4347) endif
4348)
4349) if (this%is_NH4_aqueous) then
4350) temp_real = f_t * f_w * f_ph * this%k_nitr_n2o * kg_water
4351) else
4352) temp_real = f_t * f_w * f_ph * this%k_nitr_n2o * volume
4353) endif
4354)
4355) rate_n2o = temp_real * c_nh4 * f_nh4
4356)
4357) Residual(ires_nh4) = Residual(ires_nh4) + rate_n2o
4358) Residual(ires_n2o) = Residual(ires_n2o) - 0.5d0 * rate_n2o
4359)
4360) if (this%ispec_ngasnit > 0) then
4361) Residual(ires_ngasnit) = Residual(ires_ngasnit) - 0.5d0 * rate_n2o
4362) endif
4363)
4364) RateDemand_nh4(ires_nh4) = RateDemand_nh4(ires_nh4) + rate_n2o
4365) RateDemand_nh4(ires_n2o) = RateDemand_nh4(ires_n2o) - 0.5d0 * rate_n2o
4366)
4367) if (this%ispec_ngasnit > 0) then
4368) RateDemand_nh4(ires_ngasnit) = RateDemand_nh4(ires_ngasnit) &
4369) - 0.5d0 * rate_n2o
4370) endif
4371)
4372) if (compute_derivative) then
4373) drate_n2o = temp_real * f_nh4 + temp_real * c_nh4 * d_nh4
4374)
4375) Jacobian(ires_nh4,ires_nh4) = Jacobian(ires_nh4,ires_nh4) + drate_n2o
4376)
4377) Jacobian(ires_n2o,ires_nh4) = Jacobian(ires_n2o,ires_nh4) - &
4378) 0.5d0 * drate_n2o
4379)
4380) if (this%ispec_ngasnit > 0 .and. (.not.this%bskipnitrjacobian)) then
4381) Jacobian(ires_ngasnit,ires_nh4)=Jacobian(ires_ngasnit,ires_nh4) - &
4382) 0.5d0 * drate_n2o
4383) endif
4384)
4385) JacobianDemand_nh4(ires_nh4,ires_nh4) = &
4386) JacobianDemand_nh4(ires_nh4,ires_nh4) + drate_n2o
4387)
4388) JacobianDemand_nh4(ires_n2o,ires_nh4) = &
4389) JacobianDemand_nh4(ires_n2o,ires_nh4) - 0.5d0 * drate_n2o
4390)
4391) if (this%ispec_ngasnit > 0 .and. (.not.this%bskipnitrjacobian)) then
4392) JacobianDemand_nh4(ires_ngasnit,ires_nh4) = &
4393) JacobianDemand_nh4(ires_ngasnit,ires_nh4) - 0.5d0 * drate_n2o
4394) endif
4395)
4396) if (this%bdebugoutput) then
4397) write(*, *) 'Nitri: N2O', rate_n2o, drate_n2o
4398) endif
4399)
4400) endif
4401) endif
4402) endif
4403)
4404) end subroutine NitrReact
4405)
4406) ! ************************************************************************** !
4407) !
4408) ! NitrDestroy: Destroys allocatable or pointer objects created in this
4409) ! module
4410) !
4411) ! ************************************************************************** !
4412) subroutine NitrDestroy(this)
4413)
4414) implicit none
4415)
4416) class(clm_rxn_nitr_type) :: this
4417)
4418) end subroutine NitrDestroy
4419)
4420) end module CLM_Rxn_Nitr_class
4421)
4422)
4423) module CLM_Rxn_Deni_class
4424)
4425) ! ------------------------------------------------------------------------------
4426) ! Description
4427) ! denitrification function following Dickinson et al. 2002
4428) ! NO3- -> 0.5 N2
4429) ! rate = kmax ftheta fT NO3-
4430) ! fT = exp(0.08(T - 298))
4431) ! ftheta = [(s - smin)/(1 - smin)]^b smin = 0.6
4432) ! kmax = 2.5e-5
4433) ! by t6g 10/06/2014
4434) ! ------------------------------------------------------------------------------
4435)
4436) use CLM_Rxn_Base_class
4437) use Global_Aux_module
4438) use Reactive_Transport_Aux_module
4439) use PFLOTRAN_Constants_module
4440)
4441) implicit none
4442)
4443) private
4444)
4445) #include "petsc/finclude/petscsys.h"
4446)
4447) PetscInt, parameter :: TEMPERATURE_RESPONSE_FUNCTION_CLM4 = 1
4448) PetscInt, parameter :: TEMPERATURE_RESPONSE_FUNCTION_Q10 = 2
4449)
4450) type, public, &
4451) extends(clm_rxn_base_type) :: clm_rxn_deni_type
4452) PetscInt :: ispec_no3
4453) PetscInt :: ispec_n2
4454) PetscInt :: ispec_ngasdeni
4455) PetscInt :: temperature_response_function
4456) PetscReal :: Q10
4457) PetscReal :: k_deni_max ! deni rate
4458) PetscReal :: half_saturation
4459) PetscReal :: cutoff_no3_0 ! shut off
4460) PetscReal :: cutoff_no3_1 ! start to decrease from 1
4461) PetscReal :: residual_conc
4462) PetscBool :: bdebugoutput
4463) PetscBool :: is_NH4_aqueous
4464) PetscBool :: is_NO3_aqueous
4465) PetscBool :: bskipdenijacobian
4466)
4467) contains
4468) procedure, public :: ReadInput => DeniRead
4469) procedure, public :: Setup => DeniSetup
4470) procedure, public :: Evaluate => DeniReact
4471) procedure, public :: Destroy => DeniDestroy
4472) end type clm_rxn_deni_type
4473)
4474) public :: DeniCreate
4475)
4476) contains
4477)
4478) ! ************************************************************************** !
4479) !
4480) ! DeniCreate: Allocates deni reaction object.
4481) !
4482) ! ************************************************************************** !
4483) function DeniCreate()
4484)
4485) implicit none
4486)
4487) class(clm_rxn_deni_type), pointer :: DeniCreate
4488)
4489) allocate(DeniCreate)
4490) DeniCreate%ispec_no3 = 0
4491) DeniCreate%ispec_n2 = 0
4492) DeniCreate%ispec_ngasdeni = 0
4493) DeniCreate%temperature_response_function = TEMPERATURE_RESPONSE_FUNCTION_CLM4
4494) DeniCreate%Q10 = 1.5d0
4495) DeniCreate%k_deni_max = 2.5d-6 ! deni rate
4496) DeniCreate%half_saturation = -1.0d-6
4497) DeniCreate%cutoff_no3_0 =-1.0d-20
4498) DeniCreate%cutoff_no3_1 = 1.0d-20
4499) DeniCreate%residual_conc = 1.0d-10
4500) DeniCreate%bdebugoutput = PETSC_FALSE
4501) DeniCreate%is_NH4_aqueous = PETSC_TRUE
4502) DeniCreate%is_NO3_aqueous = PETSC_TRUE
4503) DeniCreate%bskipdenijacobian = PETSC_FALSE
4504)
4505) nullify(DeniCreate%next)
4506)
4507) end function DeniCreate
4508)
4509) ! ************************************************************************** !
4510) !
4511) ! DeniRead: Reads input deck for deni reaction parameters (if any)
4512) !
4513) ! ************************************************************************** !
4514) subroutine DeniRead(this,input,option)
4515)
4516) use Option_module
4517) use String_module
4518) use Input_Aux_module
4519) use Units_module, only : UnitsConvertToInternal
4520)
4521) implicit none
4522)
4523) class(clm_rxn_deni_type) :: this
4524) type(input_type), pointer :: input
4525) type(option_type) :: option
4526)
4527) PetscInt :: i
4528) character(len=MAXWORDLENGTH) :: word, internal_units
4529)
4530) do
4531) call InputReadPflotranString(input,option)
4532) if (InputError(input)) exit
4533) if (InputCheckExit(input,option)) exit
4534)
4535) call InputReadWord(input,option,word,PETSC_TRUE)
4536) call InputErrorMsg(input,option,'keyword', &
4537) 'CHEMISTRY,CLM_RXN,DENITRIFICATION')
4538) call StringToUpper(word)
4539)
4540) select case(trim(word))
4541) case('TEMPERATURE_RESPONSE_FUNCTION')
4542) do
4543) call InputReadPflotranString(input,option)
4544) if (InputError(input)) exit
4545) if (InputCheckExit(input,option)) exit
4546)
4547) call InputReadWord(input,option,word,PETSC_TRUE)
4548) call InputErrorMsg(input,option,'keyword', &
4549) 'CHEMISTRY,CLM_RXN,DENITRIFICATION,TEMPERATURE RESPONSE FUNCTION')
4550) call StringToUpper(word)
4551)
4552) select case(trim(word))
4553) case('CLM4')
4554) this%temperature_response_function = &
4555) TEMPERATURE_RESPONSE_FUNCTION_CLM4
4556) case('Q10')
4557) this%temperature_response_function = &
4558) TEMPERATURE_RESPONSE_FUNCTION_Q10
4559) call InputReadDouble(input,option,this%Q10)
4560) call InputErrorMsg(input,option,'Q10', &
4561) 'CHEMISTRY,CLM_RXN,DENITRI,TEMPERATURE RESPONSE FUNCTION')
4562) case default
4563) call InputKeywordUnrecognized(word, &
4564) 'CHEMISTRY,CLM_RXN,DENITRIFICATION,TEMPERATURE RESPONSE FUNCTION', &
4565) option)
4566) end select
4567) enddo
4568)
4569) case('RATE_CONSTANT')
4570) call InputReadDouble(input,option,this%k_deni_max)
4571) call InputErrorMsg(input,option,'k_deni_max', &
4572) 'CHEMISTRY,CLM_RXN,DENITRIFICATION,REACTION')
4573) case('RESIDUAL_NO3')
4574) call InputReadDouble(input,option,this%residual_conc)
4575) call InputErrorMsg(input,option,'residual_NO3', &
4576) 'CHEMISTRY,CLM_RXN,NITRIFICATION,REACTION')
4577) case('HALF_SATURATION_NO3')
4578) call InputReadDouble(input,option,this%half_saturation)
4579) call InputErrorMsg(input,option,'half saturation no3-', &
4580) 'CHEMISTRY,CLM_RXN,DENITRIFICATION,REACTION')
4581) case('CUTOFF_NO3')
4582) call InputReadDouble(input,option,this%cutoff_no3_0)
4583) call InputErrorMsg(input,option,'cutoff_no3_0', &
4584) 'CHEMISTRY,CLM_RXN,DENITRIFICATION,REACTION')
4585) call InputReadDouble(input,option,this%cutoff_no3_1)
4586) call InputErrorMsg(input,option,'cutoff_no3_1', &
4587) 'CHEMISTRY,CLM_RXN,DENITRIFICATION,REACTION')
4588) if (this%cutoff_no3_0 > this%cutoff_no3_1) then
4589) option%io_buffer = 'CHEMISTRY,CLM_RXN,DENITRIFICATION,' // &
4590) 'NO3- cut off concentration > concentration ' // &
4591) 'where down regulation function = 1.'
4592) call printErrMsg(option)
4593) endif
4594) case('DEBUG_OUTPUT')
4595) this%bdebugoutput = PETSC_TRUE
4596) case('JACOBIAN_DENI_SKIP')
4597) this%bskipdenijacobian = PETSC_TRUE
4598) case default
4599) call InputKeywordUnrecognized(word, &
4600) 'CHEMISTRY,CLM_RXN,DENITRIFICATION,REACTION',option)
4601) end select
4602) enddo
4603)
4604) end subroutine DeniRead
4605)
4606) ! ************************************************************************** !
4607) !
4608) ! DeniSetup: Sets up the deni reaction either with parameters either
4609) ! read from the input deck or hardwired.
4610) !
4611) ! ************************************************************************** !
4612) subroutine DeniSetup(this,reaction,option)
4613)
4614) use Reaction_Aux_module, only : reaction_type, GetPrimarySpeciesIDFromName
4615) use Option_module
4616) use Reaction_Immobile_Aux_module, only : GetImmobileSpeciesIDFromName
4617)
4618) implicit none
4619)
4620) class(clm_rxn_deni_type) :: this
4621) type(reaction_type) :: reaction
4622) type(option_type) :: option
4623)
4624) character(len=MAXWORDLENGTH) :: word
4625)
4626) word = 'NO3-'
4627) this%ispec_no3 = GetPrimarySpeciesIDFromName(word,reaction, &
4628) PETSC_FALSE,option)
4629)
4630) if (this%ispec_no3 < 0) then
4631) word = 'Nitrate'
4632) this%ispec_no3 = GetImmobileSpeciesIDFromName( &
4633) word,reaction%immobile,PETSC_FALSE,option)
4634) if (this%ispec_no3 > 0) then
4635) this%is_NO3_aqueous = PETSC_FALSE
4636) endif
4637) endif
4638)
4639) if (this%ispec_no3 < 0) then
4640) option%io_buffer = 'CHEMISTRY,CLM_RXN,DENITRIFICATION: ' // &
4641) ' NO3- or nitrate is not specified in the input file.'
4642) call printErrMsg(option)
4643) endif
4644)
4645) word = 'N2(aq)'
4646) this%ispec_n2 = GetPrimarySpeciesIDFromName(word,reaction, &
4647) PETSC_FALSE,option)
4648)
4649) if (this%ispec_n2 < 0) then
4650) option%io_buffer = 'CHEMISTRY,CLM_RXN,DENITRIFICATION: ' // &
4651) ' N2(aq) is not specified in the input file.'
4652) call printErrMsg(option)
4653) endif
4654)
4655) word = 'NGASdeni'
4656) this%ispec_ngasdeni = GetImmobileSpeciesIDFromName( &
4657) word,reaction%immobile,PETSC_FALSE,option)
4658)
4659) end subroutine DeniSetup
4660)
4661) ! ************************************************************************** !
4662) subroutine DeniReact(this,Residual,Jacobian,compute_derivative, &
4663) rt_auxvar,global_auxvar,material_auxvar,reaction,option, &
4664) RateDemand_nh4,RateSupply_nh4, &
4665) JacobianDemand_nh4,JacobianSupply_nh4, &
4666) RateDemand_no3,RateSupply_no3, &
4667) JacobianDemand_no3,JacobianSupply_no3, &
4668) Rate_nh4_to_no3,Jacobian_nh4_to_no3)
4669)
4670) use Option_module
4671) use Reaction_Aux_module
4672) use Material_Aux_class, only : material_auxvar_type
4673) use CLM_Rxn_Common_module, only: CalNLimitFunc
4674)
4675) implicit none
4676)
4677) class(clm_rxn_deni_type) :: this
4678) type(option_type) :: option
4679) type(reaction_type) :: reaction
4680) type(reactive_transport_auxvar_type) :: rt_auxvar
4681) type(global_auxvar_type) :: global_auxvar
4682) class(material_auxvar_type) :: material_auxvar
4683)
4684) PetscBool :: compute_derivative
4685) PetscReal :: Residual(reaction%ncomp)
4686) PetscReal :: Jacobian(reaction%ncomp,reaction%ncomp)
4687) PetscReal :: RateDemand_nh4(reaction%ncomp)
4688) PetscReal :: RateSupply_nh4(reaction%ncomp)
4689) PetscReal :: RateDemand_no3(reaction%ncomp)
4690) PetscReal :: RateSupply_no3(reaction%ncomp)
4691) PetscReal :: JacobianDemand_nh4(reaction%ncomp,reaction%ncomp)
4692) PetscReal :: JacobianSupply_nh4(reaction%ncomp,reaction%ncomp)
4693) PetscReal :: JacobianDemand_no3(reaction%ncomp,reaction%ncomp)
4694) PetscReal :: JacobianSupply_no3(reaction%ncomp,reaction%ncomp)
4695) PetscReal :: Rate_nh4_to_no3
4696) PetscReal :: Jacobian_nh4_to_no3(reaction%ncomp)
4697) PetscReal :: porosity
4698) PetscReal :: volume
4699) PetscReal :: kg_water
4700) PetscInt :: local_id
4701) PetscErrorCode :: ierr
4702)
4703) PetscReal :: temp_real
4704)
4705) PetscInt :: ires_no3, ires_n2o, ires_n2
4706) PetscInt :: ires_ngasdeni
4707)
4708) PetscScalar, pointer :: bsw(:)
4709) PetscScalar, pointer :: bulkdensity(:)
4710)
4711) PetscReal :: s_min
4712) PetscReal :: tc
4713) PetscReal :: f_t, f_w
4714)
4715) PetscReal :: c_no3 ! mole/kg
4716) PetscReal :: ac_no3 ! mole/kg
4717) PetscReal :: f_no3 ! no3 / (half_saturation + no3)
4718) PetscReal :: d_no3 ! half_saturation/(no3 + half_saturation)^2
4719) PetscReal :: rate_deni, drate_deni
4720) PetscReal :: saturation
4721) PetscInt, parameter :: iphase = 1
4722)
4723) porosity = material_auxvar%porosity
4724) volume = material_auxvar%volume
4725)
4726) kg_water = material_auxvar%porosity*global_auxvar%sat(iphase)* &
4727) material_auxvar%volume*global_auxvar%den_kg(iphase)
4728)
4729) ! indices for C and N species
4730) ires_no3 = this%ispec_no3
4731) ires_n2 = this%ispec_n2
4732) ires_ngasdeni = this%ispec_ngasdeni + reaction%offset_immobile
4733)
4734) ! denitrification (Dickinson et al. 2002)
4735) if (this%ispec_n2 < 0) return
4736)
4737) temp_real = 1.0d0
4738)
4739) tc = global_auxvar%temp
4740) ! f_t = exp(0.08d0 * (tc - 25.d0))
4741) ! make it consistent with CLM CNNDynamicsMod.F90 line 652
4742) f_t = exp(0.08d0 * (tc + 273.15d0 - 298.0d0))
4743)
4744) saturation = global_auxvar%sat(1)
4745) s_min = 0.6d0
4746) f_w = 0.d0
4747) if (saturation > s_min) then
4748) f_w = (saturation - s_min)/(1.0d0 - s_min)
4749) f_w = f_w ** temp_real
4750) endif
4751)
4752) if (this%is_NO3_aqueous) then
4753) c_no3 = rt_auxvar%pri_molal(this%ispec_no3)
4754) ac_no3 = rt_auxvar%pri_act_coef(this%ispec_no3)
4755) ires_no3 = this%ispec_no3
4756) else
4757) c_no3 = rt_auxvar%immobile(this%ispec_no3)
4758) ac_no3 = 1.0d0
4759) ires_no3 = this%ispec_no3 + reaction%offset_immobile
4760) endif
4761)
4762) call CalNLimitFunc(c_no3, ac_no3, this%residual_conc, this%half_saturation, &
4763) this%cutoff_no3_0, this%cutoff_no3_1, f_no3, d_no3)
4764)
4765) ! add first order rate
4766) d_no3 = (c_no3 - this%residual_conc) * ac_no3 * d_no3 + ac_no3 * f_no3
4767) f_no3 = (c_no3 - this%residual_conc) * ac_no3 * f_no3
4768)
4769) if (f_t > 0.d0 .and. f_w > 0.d0) then
4770) if (this%is_NO3_aqueous) then
4771) rate_deni = this%k_deni_max * f_t * f_w * kg_water * f_no3
4772) else
4773) rate_deni = this%k_deni_max * f_t * f_w * volume * f_no3
4774) endif
4775)
4776) Residual(ires_no3) = Residual(ires_no3) + rate_deni
4777) Residual(ires_n2) = Residual(ires_n2) - 0.5d0 * rate_deni
4778)
4779) if (this%ispec_ngasdeni > 0) then
4780) Residual(ires_ngasdeni) = Residual(ires_ngasdeni) - 0.5d0 * rate_deni
4781) endif
4782)
4783) RateDemand_no3(ires_no3) = RateDemand_no3(ires_no3) + rate_deni
4784) RateDemand_no3(ires_n2) = RateDemand_no3(ires_n2) - 0.5d0 * rate_deni
4785)
4786) if (this%ispec_ngasdeni > 0) then
4787) RateDemand_no3(ires_ngasdeni) = RateDemand_no3(ires_ngasdeni) &
4788) - 0.5d0 * rate_deni
4789) endif
4790)
4791) if (compute_derivative) then
4792)
4793) if (this%is_NO3_aqueous) then
4794) drate_deni = this%k_deni_max * f_t * f_w * kg_water * d_no3
4795) else
4796) drate_deni = this%k_deni_max * f_t * f_w * volume * d_no3
4797) endif
4798)
4799) Jacobian(ires_no3,ires_no3) = Jacobian(ires_no3,ires_no3) + drate_deni
4800)
4801) Jacobian(ires_n2,ires_no3)=Jacobian(ires_n2,ires_no3) - 0.5d0*drate_deni
4802)
4803) if (this%ispec_ngasdeni > 0 .and. (.not.this%bskipdenijacobian)) then
4804) Jacobian(ires_ngasdeni,ires_no3) = Jacobian(ires_ngasdeni,ires_no3) &
4805) - 0.5d0 * drate_deni
4806) endif
4807)
4808) JacobianDemand_no3(ires_no3,ires_no3) = &
4809) JacobianDemand_no3(ires_no3,ires_no3) + drate_deni
4810)
4811) JacobianDemand_no3(ires_n2,ires_no3) = &
4812) JacobianDemand_no3(ires_n2,ires_no3) - 0.5d0 * drate_deni
4813)
4814) if (this%ispec_ngasdeni > 0 .and. (.not.this%bskipdenijacobian)) then
4815) JacobianDemand_no3(ires_ngasdeni,ires_no3) = &
4816) JacobianDemand_no3(ires_ngasdeni,ires_no3) - 0.5d0 * drate_deni
4817) endif
4818)
4819) if (this%bdebugoutput) then
4820) write(*, *) 'Deni:', rate_deni, drate_deni
4821) endif
4822)
4823) endif
4824) endif
4825)
4826) end subroutine DeniReact
4827)
4828) ! ************************************************************************** !
4829) !
4830) ! DeniDestroy: Destroys allocatable or pointer objects created in this
4831) ! module
4832) !
4833) ! ************************************************************************** !
4834) subroutine DeniDestroy(this)
4835)
4836) implicit none
4837)
4838) class(clm_rxn_deni_type) :: this
4839)
4840) end subroutine DeniDestroy
4841)
4842) end module CLM_Rxn_Deni_class
4843)
4844) module CLM_Rxn_module
4845)
4846) ! extended from reaction_sandbox to implement demand based down regulation
4847) ! in RCLMRxn t6g 10/06/2014
4848)
4849) use CLM_Rxn_Base_class
4850) use CLM_Rxn_Decomp_class
4851) use CLM_Rxn_Deni_class
4852) use CLM_Rxn_Nitr_class
4853) use CLM_Rxn_PlantN_class
4854)
4855) use PFLOTRAN_Constants_module
4856)
4857) implicit none
4858)
4859) private
4860)
4861) #include "petsc/finclude/petscsys.h"
4862)
4863) class(clm_rxn_base_type), pointer, public :: clmrxn_list
4864)
4865) PetscBool :: bdownreg
4866) PetscBool :: bdebugoutput
4867) PetscBool :: b_ignore_production
4868) PetscReal :: residual_nh4
4869) PetscReal :: residual_no3
4870) PetscReal :: accelerator
4871) PetscReal :: cutoff_nh4_0
4872) PetscReal :: cutoff_nh4_1
4873) PetscReal :: cutoff_no3_0
4874) PetscReal :: cutoff_no3_1
4875)
4876) interface RCLMRxnRead
4877) module procedure RCLMRxnRead1
4878) module procedure RCLMRxnRead2
4879) end interface
4880)
4881) interface RCLMRxnDestroy
4882) module procedure RCLMRxnDestroy1
4883) module procedure RCLMRxnDestroy2
4884) end interface
4885)
4886) public :: RCLMRxnInit, &
4887) RCLMRxnRead, &
4888) RCLMRxnSkipInput, &
4889) RCLMRxnSetup, &
4890) RCLMRxn, &
4891) RCLMRxnDestroy
4892)
4893) contains
4894)
4895) ! ************************************************************************** !
4896)
4897) subroutine RCLMRxnInit(option)
4898) !
4899) ! Initializes the clmrxn list
4900) !
4901) use Option_module
4902) implicit none
4903) type(option_type) :: option
4904)
4905) if (associated(clmrxn_list)) then
4906) call RCLMRxnDestroy()
4907) endif
4908) nullify(clmrxn_list)
4909) bdownreg = PETSC_FALSE
4910) bdebugoutput = PETSC_FALSE
4911) b_ignore_production = PETSC_FALSE
4912)
4913) residual_nh4 = 1.0d-20
4914) residual_no3 = 1.0d-20
4915) accelerator = 1.0d0
4916) cutoff_nh4_0 = -1.0d-18
4917) cutoff_nh4_1 = 1.0d-18
4918) cutoff_no3_0 = -1.0d-15
4919) cutoff_no3_1 = 1.0d-15
4920)
4921) end subroutine RCLMRxnInit
4922)
4923) ! ************************************************************************** !
4924)
4925) subroutine RCLMRxnSetup(reaction,option)
4926) !
4927) ! Calls all the initialization routines for all reactions in
4928) ! the clmrxn list
4929) !
4930)
4931) use Option_module
4932) use Reaction_Aux_module, only : reaction_type
4933)
4934) implicit none
4935)
4936) type(reaction_type) :: reaction
4937) type(option_type) :: option
4938)
4939) class(clm_rxn_base_type), pointer :: cur_clmrxn
4940)
4941) character(len=MAXWORDLENGTH) :: word
4942)
4943) ! clmrxn reactions
4944) cur_clmrxn => clmrxn_list
4945) do
4946) if (.not.associated(cur_clmrxn)) exit
4947) call cur_clmrxn%Setup(reaction,option)
4948) cur_clmrxn => cur_clmrxn%next
4949) enddo
4950)
4951)
4952) end subroutine RCLMRxnSetup
4953)
4954) ! ************************************************************************** !
4955)
4956) subroutine RCLMRxnRead1(input,option)
4957) !
4958) ! Reads input deck for reaction clmrxn parameters
4959) !
4960)
4961) use Option_module
4962) use String_module
4963) use Input_Aux_module
4964) use Utility_module
4965)
4966) implicit none
4967)
4968) type(input_type), pointer :: input
4969) type(option_type) :: option
4970)
4971) call RCLMRxnRead(clmrxn_list,input,option)
4972)
4973) end subroutine RCLMRxnRead1
4974)
4975) ! ************************************************************************** !
4976)
4977) subroutine RCLMRxnRead2(local_clmrxn_list,input,option)
4978) !
4979) ! RCLMRxnRead: Reads input deck for reaction clmrxn parameters
4980) !
4981)
4982) use Option_module
4983) use String_module
4984) use Input_Aux_module
4985) use Utility_module
4986)
4987) implicit none
4988)
4989) class(clm_rxn_base_type), pointer :: local_clmrxn_list
4990) type(input_type), pointer :: input
4991) type(option_type) :: option
4992)
4993) character(len=MAXSTRINGLENGTH) :: string
4994) character(len=MAXWORDLENGTH) :: word
4995) class(clm_rxn_base_type), pointer :: new_clmrxn, cur_clmrxn
4996)
4997) nullify(new_clmrxn)
4998) do
4999) call InputReadPflotranString(input,option)
5000) if (InputError(input)) exit
5001) if (InputCheckExit(input,option)) exit
5002)
5003) call InputReadWord(input,option,word,PETSC_TRUE)
5004) call InputErrorMsg(input,option,'keyword','CHEMISTRY,CLM_RXN')
5005) call StringToUpper(word)
5006)
5007) select case(trim(word))
5008) case('DECOMPOSITION')
5009) new_clmrxn => CLMDec_Create()
5010) case('DENITRIFICATION')
5011) new_clmrxn => DeniCreate()
5012) case('NITRIFICATION')
5013) new_clmrxn => NitrCreate()
5014) case('PLANTNTAKE')
5015) new_clmrxn => PlantNCreate()
5016) case('ENABLE_DOWNREGULATION')
5017) bdownreg = PETSC_TRUE
5018) case('DEBUG_OUTPUT')
5019) bdebugoutput = PETSC_TRUE
5020) case('IGNORE_PRODUCTION')
5021) b_ignore_production = PETSC_TRUE
5022) case('RESIDUAL_NH4')
5023) call InputReadDouble(input,option,residual_nh4)
5024) call InputErrorMsg(input,option,'residual nh4','CHEMISTRY,CLMRXN')
5025) case('RESIDUAL_NO3')
5026) call InputReadDouble(input,option,residual_no3)
5027) call InputErrorMsg(input,option,'residual no3','CHEMISTRY,CLMRXN')
5028) case('ACCELERATOR')
5029) call InputReadDouble(input,option,accelerator)
5030) call InputErrorMsg(input,option,'accelerator','CHEMISTRY,CLMRXN')
5031) case('CUTOFF_NH4')
5032) call InputReadDouble(input,option,cutoff_nh4_0)
5033) call InputErrorMsg(input,option,'cutoff_nh4_0','CHEMISTRY,CLM_RXN')
5034) call InputReadDouble(input,option,cutoff_nh4_1)
5035) call InputErrorMsg(input,option,'cutoff_nh4_1','CHEMISTRY,CLM_RXN')
5036) if (cutoff_nh4_0 > cutoff_nh4_1) then
5037) option%io_buffer = 'CHEMISTRY,CLM_RXN,' // &
5038) 'NH4+ cut off concentration > concentration ' // &
5039) 'where down regulation function = 1.'
5040) call printErrMsg(option)
5041) endif
5042) case('CUTOFF_NO3')
5043) call InputReadDouble(input,option,cutoff_no3_0)
5044) call InputErrorMsg(input,option,'cutoff_no3_0','CHEMISTRY,CLM_RXN')
5045) call InputReadDouble(input,option,cutoff_no3_1)
5046) call InputErrorMsg(input,option,'cutoff_no3_1','CHEMISTRY,CLM_RXN')
5047) if (cutoff_no3_0 > cutoff_no3_1) then
5048) option%io_buffer = 'CHEMISTRY,CLM_RXN,' // &
5049) 'NO3- down regulation cut off concentration > concentration ' // &
5050) 'where down regulation function = 1.'
5051) call printErrMsg(option)
5052) endif
5053)
5054) case default
5055) call InputKeywordUnrecognized(word,'CHEMISTRY,CLM_RXN',option)
5056) end select
5057)
5058) call new_clmrxn%ReadInput(input,option)
5059)
5060) if (.not.associated(local_clmrxn_list)) then
5061) local_clmrxn_list => new_clmrxn
5062) else
5063) cur_clmrxn => local_clmrxn_list
5064) do
5065) if (.not.associated(cur_clmrxn%next)) exit
5066) cur_clmrxn => cur_clmrxn%next
5067) enddo
5068) cur_clmrxn%next => new_clmrxn
5069) endif
5070) enddo
5071)
5072) end subroutine RCLMRxnRead2
5073)
5074) ! ************************************************************************** !
5075)
5076) subroutine RCLMRxnSkipInput(input,option)
5077) !
5078) ! Intelligently skips over CLM_RXN block
5079) !
5080)
5081) use Option_module
5082) use String_module
5083) use Input_Aux_module
5084) use Utility_module
5085)
5086) implicit none
5087)
5088) type(input_type), pointer :: input
5089) type(option_type) :: option
5090)
5091) class(clm_rxn_base_type), pointer :: dummy_list
5092)
5093) nullify(dummy_list)
5094) call RCLMRxnRead(dummy_list,input,option)
5095) call RCLMRxnDestroy(dummy_list)
5096)
5097) end subroutine RCLMRxnSkipInput
5098)
5099) ! ************************************************************************** !
5100)
5101) subroutine RCLMRxn(Residual,Jacobian,compute_derivative,rt_auxvar, &
5102) global_auxvar,material_auxvar,reaction,option)
5103) !
5104) ! Evaluates reaction storing residual and/or Jacobian
5105) !
5106)
5107) use Option_module
5108) use Reaction_Aux_module
5109) use Reactive_Transport_Aux_module
5110) use Global_Aux_module
5111) use Reaction_Immobile_Aux_module
5112) use Material_Aux_class, only: material_auxvar_type
5113)
5114) implicit none
5115)
5116) type(option_type) :: option
5117) type(reaction_type) :: reaction
5118) type(reactive_transport_auxvar_type) :: rt_auxvar
5119) type(global_auxvar_type) :: global_auxvar
5120) class(material_auxvar_type) :: material_auxvar
5121) class(clm_rxn_base_type), pointer :: cur_reaction
5122) PetscBool :: compute_derivative
5123) PetscReal :: Residual(reaction%ncomp)
5124) PetscReal :: Jacobian(reaction%ncomp,reaction%ncomp)
5125)
5126) PetscReal :: ResidualPre(reaction%ncomp)
5127) PetscReal :: Jacobianpre(reaction%ncomp,reaction%ncomp)
5128)
5129) PetscReal :: RateDemand_nh4(reaction%ncomp)
5130) PetscReal :: RateSupply_nh4(reaction%ncomp)
5131) PetscReal :: RateDemand_no3(reaction%ncomp)
5132) PetscReal :: RateSupply_no3(reaction%ncomp)
5133)
5134) PetscReal :: JacobianDemand_nh4(reaction%ncomp,reaction%ncomp)
5135) PetscReal :: JacobianSupply_nh4(reaction%ncomp,reaction%ncomp)
5136) PetscReal :: JacobianDemand_no3(reaction%ncomp,reaction%ncomp)
5137) PetscReal :: JacobianSupply_no3(reaction%ncomp,reaction%ncomp)
5138)
5139) PetscReal :: ddownscale_nh4(reaction%ncomp)
5140) PetscReal :: ddownscale_no3(reaction%ncomp)
5141)
5142) PetscReal :: Rate_nh4_to_no3
5143) PetscReal :: Jacobian_nh4_to_no3(reaction%ncomp)
5144) PetscReal :: f_supply
5145)
5146) PetscReal :: dt
5147) PetscReal :: kg_water_or_volume
5148) PetscReal :: c_nh4,avail_nh4,davail_nh4
5149) PetscReal :: c_no3,avail_no3,davail_no3
5150) PetscReal :: demand_nh4,supply_nh4,downscale_nh4
5151) PetscReal :: demand_no3,supply_no3,downscale_no3
5152) PetscReal :: regulator,dregulator,xxx,delta
5153)
5154) PetscBool :: b_nh4_downscaled
5155) PetscBool :: b_no3_downscaled
5156) PetscBool :: is_nh4_aqueous, is_no3_aqueous
5157)
5158) PetscInt, parameter :: iphase = 1
5159) PetscInt :: i,j
5160) PetscInt :: ispec_nh4
5161) PetscInt :: ispec_no3
5162) PetscInt :: ires_nh4
5163) PetscInt :: ires_no3
5164)
5165) character(len=MAXWORDLENGTH) :: word
5166)
5167) ResidualPre = Residual
5168) JacobianPre = Jacobian
5169)
5170) RateDemand_nh4 = 0.0d0
5171) RateSupply_nh4 = 0.0d0
5172) JacobianDemand_nh4 = 0.0d0
5173) JacobianSupply_nh4 = 0.0d0
5174)
5175) RateDemand_no3 = 0.0d0
5176) RateSupply_no3 = 0.0d0
5177) JacobianDemand_no3 = 0.0d0
5178) JacobianSupply_no3 = 0.0d0
5179)
5180) Rate_nh4_to_no3 = 0.0d0
5181) Jacobian_nh4_to_no3 = 0.0d0
5182)
5183) ddownscale_no3 = 0.0d0
5184) ddownscale_nh4 = 0.0d0
5185)
5186) cur_reaction => clmrxn_list
5187) do
5188) if (.not.associated(cur_reaction)) exit
5189) call cur_reaction%Evaluate(Residual,Jacobian,compute_derivative, &
5190) rt_auxvar,global_auxvar,material_auxvar, &
5191) reaction,option, &
5192) RateDemand_nh4,RateSupply_nh4, &
5193) JacobianDemand_nh4,JacobianSupply_nh4, &
5194) RateDemand_no3,RateSupply_no3, &
5195) JacobianDemand_no3,JacobianSupply_no3, &
5196) Rate_nh4_to_no3, Jacobian_nh4_to_no3)
5197) cur_reaction => cur_reaction%next
5198) enddo
5199)
5200) if (.not.bdownreg) return
5201)
5202) ! down regulate sink if sink * dt > source * dt + conc
5203)
5204) is_nh4_aqueous = PETSC_TRUE
5205) word = 'NH4+'
5206) ispec_nh4 = GetPrimarySpeciesIDFromName(word,reaction,PETSC_FALSE,option)
5207)
5208) ires_nh4 = -999
5209) if (ispec_nh4 < 0) then
5210) word = 'NH3(aq)'
5211) ispec_nh4 = GetPrimarySpeciesIDFromName(word,reaction,PETSC_FALSE, option)
5212) endif
5213)
5214) if (ispec_nh4 > 0) ires_nh4 = ispec_nh4
5215)
5216) if (ispec_nh4 < 0) then
5217) word = 'Ammonium'
5218) ispec_nh4 = GetImmobileSpeciesIDFromName( &
5219) word,reaction%immobile,PETSC_FALSE,option)
5220) if (ispec_nh4 > 0) then
5221) is_nh4_aqueous = PETSC_FALSE
5222) ires_nh4 = ispec_nh4 + reaction%offset_immobile
5223) endif
5224) endif
5225)
5226) if (ispec_nh4 < 0) then
5227) option%io_buffer = 'NH4+, NH3(aq) or Ammonium is specified in the input' // &
5228) 'file for clm_rxn!'
5229) call printErrMsg(option)
5230) endif
5231)
5232) word = 'NO3-'
5233) ispec_no3 = GetPrimarySpeciesIDFromName(word,reaction,PETSC_FALSE,option)
5234)
5235) ires_no3 = -999
5236) if (ispec_no3 > 0) ires_no3 = ispec_no3
5237)
5238) if (ispec_no3 < 0) then
5239) word = 'Nitrate'
5240) ispec_no3 = GetImmobileSpeciesIDFromName( &
5241) word,reaction%immobile,PETSC_FALSE,option)
5242) if (ispec_no3 > 0) then
5243) is_no3_aqueous = PETSC_FALSE
5244) ires_no3 = ispec_no3 + reaction%offset_immobile
5245) endif
5246) endif
5247)
5248) if (ispec_nh4 > 0 .and. ispec_no3 > 0) then
5249) if ((is_nh4_aqueous .and. (.not.is_no3_aqueous)) .or. &
5250) ((.not.is_nh4_aqueous) .and. is_no3_aqueous)) then
5251) option%io_buffer = 'ERROR: Ammonium and nitrate have different phases: one in aqueous, the other in immobile,' // &
5252) 'please use the same in the input file!'
5253) call printErrMsg(option)
5254) endif
5255) endif
5256)
5257) if (is_nh4_aqueous) then
5258) kg_water_or_volume = material_auxvar%porosity*global_auxvar%sat(iphase)* &
5259) material_auxvar%volume*global_auxvar%den_kg(iphase)
5260) else
5261) kg_water_or_volume = material_auxvar%volume
5262) endif
5263)
5264) b_nh4_downscaled = PETSC_FALSE
5265) b_no3_downscaled = PETSC_FALSE
5266) dt = option%tran_dt
5267)
5268) if (b_ignore_production) then
5269) f_supply = 0.0d0
5270) else
5271) f_supply = 1.0d0
5272) endif
5273)
5274) ! if there is NH4+ demand
5275) if (RateDemand_nh4(ires_nh4) > 0.0d0) then
5276) ! following residual calculation sign, sink/demand is positive,
5277) ! source/production is negative
5278) if (is_nh4_aqueous) then
5279) c_nh4 = rt_auxvar%pri_molal(ispec_nh4)
5280) else
5281) c_nh4 = rt_auxvar%immobile(ispec_nh4)
5282) endif
5283)
5284) if (cutoff_nh4_0 > 0.0d0) then
5285) if (c_nh4 <= cutoff_nh4_0) then
5286) regulator = 0.0d0
5287) dregulator = 0.0d0
5288) elseif (c_nh4 >= cutoff_nh4_1 .or. &
5289) cutoff_nh4_1 - cutoff_nh4_0 <= 1.0d-20) then
5290) regulator = 1.0d0
5291) dregulator = 0.0d0
5292) else
5293) xxx = c_nh4 - cutoff_nh4_0
5294) delta = cutoff_nh4_1 - cutoff_nh4_0
5295) regulator = 1.0d0 - (1.0d0 - xxx * xxx / delta / delta) ** 2
5296) dregulator = 4.0d0 * (1.0d0 - xxx * xxx / delta / delta) * xxx &
5297) / delta / delta
5298) endif
5299) else
5300) regulator = 1.0d0
5301) dregulator = 0.0d0
5302) endif
5303)
5304) avail_nh4 = (c_nh4 - residual_nh4) * regulator
5305) davail_nh4 = regulator + (c_nh4 - residual_nh4) * dregulator
5306)
5307) demand_nh4 = RateDemand_nh4(ires_nh4) * dt
5308)
5309) supply_nh4 = RateSupply_nh4(ires_nh4) * dt * f_supply &
5310) - avail_nh4 * kg_water_or_volume
5311)
5312) ! if no supply, demand reactions will not occur
5313) if (supply_nh4 >= 0.0d0) then
5314) downscale_nh4 = 0.0d0
5315) Residual = ResidualPre + RateSupply_nh4
5316) if (compute_derivative) then
5317) ddownscale_nh4 = 0.0d0
5318) Jacobian = JacobianPre + JacobianSupply_nh4
5319) endif
5320) b_nh4_downscaled = PETSC_TRUE
5321)
5322) elseif (demand_nh4 + supply_nh4 > 0.0d0) then
5323) ! if demand < supply
5324) b_nh4_downscaled = PETSC_TRUE
5325) downscale_nh4 = -1.0d0 * supply_nh4 / demand_nh4
5326) downscale_nh4 = downscale_nh4 * accelerator
5327)
5328) Residual = ResidualPre + RateSupply_nh4 + downscale_nh4 * RateDemand_nh4
5329)
5330)
5331) if (compute_derivative) then
5332)
5333) Jacobian = JacobianPre + JacobianSupply_nh4 &
5334) + downscale_nh4 * JacobianDemand_nh4
5335)
5336) do i = 1, reaction%ncomp
5337) if (i == ires_nh4) then
5338) ddownscale_nh4(i) =-1.0d0 * ( &
5339) (JacobianSupply_nh4(ires_nh4,i) * dt * f_supply - &
5340) davail_nh4 * kg_water_or_volume) * demand_nh4 - &
5341) supply_nh4 * JacobianDemand_nh4(ires_nh4,i) * dt) / &
5342) demand_nh4 / demand_nh4
5343) else
5344) ddownscale_nh4(i) =-1.0d0 * ( &
5345) JacobianSupply_nh4(ires_nh4,i) * dt * f_supply * demand_nh4 - &
5346) supply_nh4 * JacobianDemand_nh4(ires_nh4,i) * dt) / &
5347) demand_nh4 / demand_nh4
5348) endif
5349) enddo
5350) ddownscale_nh4 = ddownscale_nh4 * accelerator
5351)
5352) do i = 1, reaction%ncomp
5353) do j = 1, reaction%ncomp
5354) Jacobian(i,j) = Jacobian(i,j) + RateDemand_nh4(i) *ddownscale_nh4(j)
5355) enddo
5356) enddo
5357)
5358) endif
5359) else
5360) ! no down regulation
5361) downscale_nh4 = 1.0d0
5362) if (compute_derivative) then
5363) ddownscale_nh4 = 0.0d0
5364) endif
5365) endif
5366)
5367) if (bdebugoutput) then
5368) write(*, *) 'Cell id = ', option%iflag, &
5369) 'downscale_nh4 = ', downscale_nh4, &
5370) 'NH4+ = ', rt_auxvar%pri_molal(ires_nh4), &
5371) 'supply = ', supply_nh4, &
5372) 'demand = ', demand_nh4, &
5373) 'residual = ', Residual(ires_nh4)
5374) !write(*, *) 'residual = '
5375) !write(*, *) (Residual(i), i = 1, reaction%ncomp)
5376) if (compute_derivative) then
5377) !write(*, *) 'jacobian = '
5378) !do i = 1, reaction%ncomp
5379) ! write(*, *) (Jacobian(i, j), j = 1, reaction%ncomp)
5380) !enddo
5381) endif
5382) endif
5383) else
5384) ! no demand, no down regulation
5385) downscale_nh4 = 1.0d0
5386) if (compute_derivative) then
5387) ddownscale_nh4 = 0.0d0
5388) endif
5389) endif
5390)
5391) if (ires_no3 > 0) then
5392) ! if there is NO3- demand
5393) if (RateDemand_no3(ires_no3) > 0.0d0) then
5394)
5395) if (is_no3_aqueous) then
5396) c_no3 = rt_auxvar%pri_molal(ispec_no3)
5397) else
5398) c_no3 = rt_auxvar%immobile(ispec_no3)
5399) endif
5400)
5401) if (cutoff_no3_0 > 0.0d0) then
5402) if (c_no3 <= cutoff_no3_0) then
5403) regulator = 0.0d0
5404) dregulator = 0.0d0
5405) elseif (c_no3 >= cutoff_no3_1 .or. &
5406) cutoff_no3_1 - cutoff_no3_0 <= 1.0d-20) then
5407) regulator = 1.0d0
5408) dregulator = 0.0d0
5409) else
5410) xxx = c_no3 - cutoff_no3_0
5411) delta = cutoff_no3_1 - cutoff_no3_0
5412) regulator = 1.0d0 - (1.0d0 - xxx * xxx / delta / delta) ** 2
5413) dregulator = 4.0d0 * (1.0d0 - xxx * xxx / delta / delta) * xxx &
5414) / delta / delta
5415) endif
5416) else
5417) regulator = 1.0d0
5418) dregulator = 0.0d0
5419) endif
5420)
5421) avail_no3 = (c_no3 - residual_no3) * regulator
5422) davail_no3 = regulator + (c_no3 - residual_no3) * dregulator
5423)
5424) demand_no3 = RateDemand_no3(ires_no3) * dt
5425)
5426) supply_no3 = RateSupply_no3(ires_no3) * dt * f_supply - &
5427) avail_no3 * kg_water_or_volume - &
5428) Rate_nh4_to_no3 * downscale_nh4 * dt * f_supply
5429)
5430) if (supply_no3 >= 0.0d0) then
5431) ! if no NO3- supply, demanding reactions won't occur
5432) if (.not. b_nh4_downscaled) then
5433) Residual = ResidualPre + RateSupply_nh4 + RateDemand_nh4
5434) if (compute_derivative) then
5435) Jacobian = JacobianPre + JacobianSupply_nh4 + JacobianDemand_nh4
5436) ddownscale_nh4 =0.0d0
5437) endif
5438) endif
5439)
5440) downscale_no3 = 0.0d0
5441) Residual = Residual + RateSupply_no3
5442)
5443) if (compute_derivative) then
5444) ddownscale_no3 = 0.0d0
5445) Jacobian = Jacobian + JacobianSupply_no3
5446) endif
5447)
5448) b_no3_downscaled = PETSC_TRUE
5449) elseif (demand_no3 + supply_no3 > 0.0d0) then
5450) ! if NO3- demand > supply
5451) ! if NH4+ is not limiting, accumulate rate and jacobian for NH4+
5452) if (.not. b_nh4_downscaled) then
5453) Residual = ResidualPre + RateSupply_nh4 + RateDemand_nh4
5454) if (compute_derivative) then
5455) Jacobian = JacobianPre + JacobianSupply_nh4 + JacobianDemand_nh4
5456) ddownscale_nh4 =0.0d0
5457) endif
5458) endif
5459)
5460) b_no3_downscaled = PETSC_TRUE
5461)
5462) downscale_no3 = -1.0d0 * supply_no3 / demand_no3
5463) downscale_no3 = downscale_no3 * accelerator
5464)
5465) Residual = Residual + RateSupply_no3 + downscale_no3 * RateDemand_no3
5466)
5467) if (compute_derivative) then
5468) Jacobian = Jacobian + JacobianSupply_no3 &
5469) + downscale_no3 * JacobianDemand_no3
5470)
5471) do i = 1, reaction%ncomp
5472) if (i == ires_no3) then
5473) ddownscale_no3(i) =-1.0d0 * ( &
5474) (JacobianSupply_no3(ires_no3,i) * dt * f_supply - &
5475) davail_no3* kg_water_or_volume - &
5476) Jacobian_nh4_to_no3(i) * downscale_nh4 * dt * f_supply - &
5477) Rate_nh4_to_no3 * ddownscale_nh4(i) * dt * f_supply) * demand_no3 - &
5478) supply_no3 * JacobianDemand_no3(ires_no3,i)* dt ) / &
5479) demand_no3 / demand_no3
5480) else
5481) ddownscale_no3(i) =-1.0d0 * ( &
5482) (JacobianSupply_no3(ires_no3,i) * dt * f_supply - &
5483) Jacobian_nh4_to_no3(i) * downscale_nh4 * dt * f_supply - &
5484) Rate_nh4_to_no3 * ddownscale_nh4(i) * dt * f_supply) * &
5485) demand_no3 - &
5486) supply_no3 * JacobianDemand_no3(ires_no3,i) * dt ) / &
5487) demand_no3 / demand_no3
5488) endif
5489) enddo
5490)
5491) ddownscale_no3 = ddownscale_no3 * accelerator
5492)
5493) do i = 1, reaction%ncomp
5494) do j = 1, reaction%ncomp
5495) Jacobian(i,j) = Jacobian(i,j) + RateDemand_no3(i) * ddownscale_no3(j)
5496) enddo
5497) enddo
5498) endif
5499) else
5500) ! no down regulation
5501) downscale_no3 = 1.0d0
5502) if (compute_derivative) then
5503) ddownscale_no3 = 0.0d0
5504) endif
5505) endif
5506)
5507) if (bdebugoutput) then
5508) write(*, *) 'Cell id = ', option%iflag, &
5509) 'downscale_no3 = ', downscale_no3, &
5510) 'NO3- = ', rt_auxvar%pri_molal(ires_no3), &
5511) 'supply = ', supply_no3, &
5512) 'demand = ', demand_no3, &
5513) 'residual = ', Residual(ires_no3)
5514) !write(*, *) 'residual = '
5515) !write(*, *) (Residual(i), i = 1, reaction%ncomp)
5516) if (compute_derivative) then
5517) !write(*, *) 'jacobian = '
5518) !do i = 1, reaction%ncomp
5519) ! write(*, *) (Jacobian(i, j), j = 1, reaction%ncomp)
5520) !enddo
5521) endif
5522) endif
5523)
5524) endif
5525) endif
5526)
5527) if (b_nh4_downscaled .and. (.not.b_no3_downscaled)) then
5528) Residual = Residual + RateSupply_no3 + RateDemand_no3
5529)
5530) if (compute_derivative) then
5531) Jacobian = Jacobian + JacobianSupply_no3 + JacobianDemand_no3
5532) endif
5533) endif
5534)
5535) end subroutine RCLMRxn
5536)
5537) ! ************************************************************************** !
5538)
5539) subroutine RCLMRxnDestroy1()
5540) !
5541) ! Destroys master clmrxn list
5542) !
5543)
5544) implicit none
5545)
5546) call RCLMRxnDestroy(clmrxn_list)
5547)
5548) end subroutine RCLMRxnDestroy1
5549)
5550) ! ************************************************************************** !
5551)
5552) subroutine RCLMRxnDestroy2(local_clmrxn_list)
5553) !
5554) ! Destroys arbitrary clmrxn list
5555) !
5556)
5557) implicit none
5558)
5559) class(clm_rxn_base_type), pointer :: local_clmrxn_list
5560)
5561) class(clm_rxn_base_type), pointer :: cur_clmrxn, prev_clmrxn
5562)
5563) ! clmrxn reactions
5564) cur_clmrxn => local_clmrxn_list
5565) do
5566) if (.not.associated(cur_clmrxn)) exit
5567) prev_clmrxn => cur_clmrxn%next
5568) call cur_clmrxn%Destroy()
5569) deallocate(cur_clmrxn)
5570) cur_clmrxn => prev_clmrxn
5571) enddo
5572)
5573) end subroutine RCLMRxnDestroy2
5574)
5575) end module CLM_Rxn_module
5576)