reactive_transport.F90 coverage: 51.43 %func 37.16 %block
1) module Reactive_Transport_module
2)
3) use Transport_module
4) use Reaction_module
5)
6) use Reactive_Transport_Aux_module
7) use Reaction_Aux_module
8) use Global_Aux_module
9) use Material_Aux_class
10)
11) use PFLOTRAN_Constants_module
12)
13) implicit none
14)
15) private
16)
17) #include "petsc/finclude/petscsys.h"
18)
19) #include "petsc/finclude/petscvec.h"
20) #include "petsc/finclude/petscvec.h90"
21) #include "petsc/finclude/petscmat.h"
22) #include "petsc/finclude/petscmat.h90"
23) #include "petsc/finclude/petscsnes.h"
24) #include "petsc/finclude/petscviewer.h"
25) #include "petsc/finclude/petsclog.h"
26)
27) PetscReal, parameter :: perturbation_tolerance = 1.d-5
28)
29) public :: RTTimeCut, &
30) RTSetup, &
31) RTMaxChange, &
32) RTUpdateEquilibriumState, &
33) RTUpdateKineticState, &
34) RTUpdateMassBalance, &
35) RTResidual, &
36) RTJacobian, &
37) RTInitializeTimestep, &
38) RTUpdateAuxVars, &
39) RTComputeMassBalance, &
40) RTDestroy, &
41) RTUpdateTransportCoefs, &
42) RTUpdateRHSCoefs, &
43) RTCalculateRHS_t0, &
44) RTCalculateRHS_t1, &
45) RTCalculateTransportMatrix, &
46) RTReact, &
47) RTJumpStartKineticSorption, &
48) RTCheckpointKineticSorptionBinary, &
49) RTCheckpointKineticSorptionHDF5, &
50) RTExplicitAdvection, &
51) RTClearActivityCoefficients
52)
53) contains
54)
55) ! ************************************************************************** !
56)
57) subroutine RTTimeCut(realization)
58) !
59) ! Resets arrays for time step cut
60) !
61) ! Author: Glenn Hammond
62) ! Date: 02/15/08
63) !
64)
65) use Realization_Subsurface_class
66) use Option_module
67) use Field_module
68) use Global_module
69) use Secondary_Continuum_module, only : SecondaryRTTimeCut
70)
71) implicit none
72)
73) type(realization_subsurface_type) :: realization
74) type(field_type), pointer :: field
75) type(option_type), pointer :: option
76)
77) PetscErrorCode :: ierr
78)
79) field => realization%field
80) option => realization%option
81)
82) ! copy previous solution back to current solution
83) call VecCopy(field%tran_yy,field%tran_xx,ierr);CHKERRQ(ierr)
84)
85) ! set densities and saturations to t
86) if (realization%option%nflowdof > 0) then
87) call GlobalWeightAuxVars(realization, &
88) realization%option%transport%tran_weight_t0)
89) endif
90)
91) call RTInitializeTimestep(realization)
92) ! note: RTUpdateTransportCoefs() is called within RTInitializeTimestep()
93) ! geh - not any longer, tran coefs should always be evaluated at time k+1
94)
95) ! set densities and saturations to t+dt
96) if (realization%option%nflowdof > 0) then
97) call GlobalWeightAuxVars(realization, &
98) realization%option%transport%tran_weight_t1)
99) endif
100)
101) call RTUpdateTransportCoefs(realization)
102)
103) if (option%use_mc) then
104) call SecondaryRTTimeCut(realization)
105) endif
106)
107) end subroutine RTTimeCut
108)
109) ! ************************************************************************** !
110)
111) subroutine RTSetup(realization)
112) !
113) ! Author: Glenn Hammond
114) ! Date: 02/22/08
115) !
116)
117) use Realization_Subsurface_class
118) use Patch_module
119) use Option_module
120) use Grid_module
121) use Region_module
122) use Coupler_module
123) use Condition_module
124) use Connection_module
125) use Transport_Constraint_module
126) use Fluid_module
127) use Material_module
128) use Material_Aux_class
129) use Reaction_Surface_Complexation_Aux_module
130) !geh: please leave the "only" clauses for Secondary_Continuum_XXX as this
131) ! resolves a bug in the Intel Visual Fortran compiler.
132) use Secondary_Continuum_Aux_module, only : sec_transport_type, &
133) SecondaryAuxRTCreate
134) use Secondary_Continuum_module, only : SecondaryRTAuxVarInit
135) use Output_Aux_module
136)
137) implicit none
138)
139) type(realization_subsurface_type) :: realization
140)
141) type(patch_type), pointer :: patch
142) type(option_type), pointer :: option
143) type(grid_type), pointer :: grid
144) type(output_variable_list_type), pointer :: list
145) type(reaction_type), pointer :: reaction
146) type(coupler_type), pointer :: boundary_condition
147) type(coupler_type), pointer :: source_sink
148) type(fluid_property_type), pointer :: cur_fluid_property
149) type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
150) type(coupler_type), pointer :: initial_condition
151) type(tran_constraint_type), pointer :: sec_tran_constraint
152) class(material_auxvar_type), pointer :: material_auxvars(:)
153)
154) PetscInt :: ghosted_id, iconn, sum_connection
155) PetscInt :: iphase, local_id, i
156) PetscBool :: error_found
157) PetscInt :: flag(10)
158)
159) option => realization%option
160) patch => realization%patch
161) grid => patch%grid
162) reaction => realization%reaction
163) sec_tran_constraint => realization%sec_transport_constraint
164)
165) patch%aux%RT => RTAuxCreate(option)
166) patch%aux%RT%rt_parameter%ncomp = reaction%ncomp
167) patch%aux%RT%rt_parameter%naqcomp = reaction%naqcomp
168) patch%aux%RT%rt_parameter%offset_aqueous = reaction%offset_aqueous
169) patch%aux%RT%rt_parameter%nimcomp = reaction%nimcomp
170) patch%aux%RT%rt_parameter%offset_immobile = reaction%offset_immobile
171) if (reaction%ncollcomp > 0) then
172) patch%aux%RT%rt_parameter%ncoll = reaction%ncoll
173) patch%aux%RT%rt_parameter%offset_colloid = reaction%offset_colloid
174) patch%aux%RT%rt_parameter%ncollcomp = reaction%ncollcomp
175) patch%aux%RT%rt_parameter%offset_collcomp = reaction%offset_collcomp
176) allocate(patch%aux%RT%rt_parameter%pri_spec_to_coll_spec(reaction%naqcomp))
177) patch%aux%RT%rt_parameter%pri_spec_to_coll_spec = &
178) reaction%pri_spec_to_coll_spec
179) allocate(patch%aux%RT%rt_parameter%coll_spec_to_pri_spec(reaction%ncollcomp))
180) patch%aux%RT%rt_parameter%coll_spec_to_pri_spec = &
181) reaction%coll_spec_to_pri_spec
182) endif
183) if (reaction%nimcomp > 0) then
184) patch%aux%RT%rt_parameter%nimcomp = reaction%nimcomp
185) patch%aux%RT%rt_parameter%offset_immobile = reaction%offset_immobile
186) endif
187)
188) material_auxvars => patch%aux%Material%auxvars
189) flag = 0
190) !TODO(geh): change to looping over ghosted ids once the legacy code is
191) ! history and the communicator can be passed down.
192) do local_id = 1, grid%nlmax
193) ghosted_id = grid%nL2G(local_id)
194)
195) ! Ignore inactive cells with inactive materials
196) if (patch%imat(ghosted_id) <= 0) cycle
197)
198) if (material_auxvars(ghosted_id)%volume < 0.d0 .and. flag(1) == 0) then
199) flag(1) = 1
200) option%io_buffer = 'Non-initialized cell volume.'
201) call printMsg(option)
202) endif
203) if (material_auxvars(ghosted_id)%porosity < 0.d0 .and. flag(2) == 0) then
204) flag(2) = 1
205) option%io_buffer = 'Non-initialized porosity.'
206) call printMsg(option)
207) endif
208) if (material_auxvars(ghosted_id)%tortuosity < 0.d0 .and. flag(3) == 0) then
209) flag(3) = 1
210) option%io_buffer = 'Non-initialized tortuosity.'
211) call printMsg(option)
212) endif
213) if (reaction%neqkdrxn > 0) then
214) if (material_auxvars(ghosted_id)%soil_particle_density < 0.d0 .and. &
215) flag(4) == 0) then
216) flag(4) = 1
217) option%io_buffer = 'Non-initialized soil particle density.'
218) call printMsg(option)
219) endif
220) endif
221) if (associated(reaction%surface_complexation)) then
222) if (associated(reaction%surface_complexation%srfcplxrxn_surf_type)) then
223) do i = 1, size(reaction%surface_complexation%srfcplxrxn_surf_type)
224) if (reaction%surface_complexation%srfcplxrxn_surf_type(i) == &
225) ROCK_SURFACE .and. &
226) material_auxvars(ghosted_id)%soil_particle_density < 0.d0 .and. &
227) flag(4) == 0) then
228) flag(4) = 1
229) option%io_buffer = 'Non-initialized soil particle density.'
230) call printMsg(option)
231) endif
232) enddo
233) endif
234) endif
235) enddo
236)
237) if (maxval(flag) > 0) then
238) option%io_buffer = &
239) 'Material property errors found in RTSetup (reactive transport).'
240) call printErrMsg(option)
241) endif
242)
243) !============== Create secondary continuum variables - SK 2/5/13 ===============
244)
245)
246) if (option%use_mc) then
247) patch%aux%SC_RT => SecondaryAuxRTCreate(option)
248) initial_condition => patch%initial_condition_list%first
249) allocate(rt_sec_transport_vars(grid%nlmax))
250) do local_id = 1, grid%nlmax
251) ! Assuming the same secondary continuum type for all regions
252) call SecondaryRTAuxVarInit(patch%material_property_array(1)%ptr, &
253) rt_sec_transport_vars(local_id), &
254) reaction,initial_condition, &
255) sec_tran_constraint,option)
256) enddo
257) patch%aux%SC_RT%sec_transport_vars => rt_sec_transport_vars
258) endif
259)
260) !===============================================================================
261)
262)
263) ! allocate auxvar data structures for all grid cells
264) #ifdef COMPUTE_INTERNAL_MASS_FLUX
265) option%iflag = 1 ! allocate mass_balance array
266) #else
267) option%iflag = 0 ! be sure not to allocate mass_balance array
268) #endif
269) allocate(patch%aux%RT%auxvars(grid%ngmax))
270) do ghosted_id = 1, grid%ngmax
271) call RTAuxVarInit(patch%aux%RT%auxvars(ghosted_id),reaction,option)
272) enddo
273) patch%aux%RT%num_aux = grid%ngmax
274)
275) ! count the number of boundary connections and allocate
276) ! auxvar data structures for them
277) sum_connection = CouplerGetNumConnectionsInList(patch%boundary_condition_list)
278) if (sum_connection > 0) then
279) option%iflag = 1 ! enable allocation of mass_balance array
280) allocate(patch%aux%RT%auxvars_bc(sum_connection))
281) do iconn = 1, sum_connection
282) call RTAuxVarInit(patch%aux%RT%auxvars_bc(iconn),reaction,option)
283) enddo
284) endif
285) patch%aux%RT%num_aux_bc = sum_connection
286)
287) ! count the number of boundary connections and allocate
288) ! auxvar data structures for them
289) sum_connection = CouplerGetNumConnectionsInList(patch%source_sink_list)
290) if (sum_connection > 0) then
291) option%iflag = 1 ! enable allocation of mass_balance array
292) allocate(patch%aux%RT%auxvars_ss(sum_connection))
293) do iconn = 1, sum_connection
294) call RTAuxVarInit(patch%aux%RT%auxvars_ss(iconn),reaction,option)
295) enddo
296) endif
297) patch%aux%RT%num_aux_ss = sum_connection
298) option%iflag = 0
299)
300) ! initialize parameters
301) cur_fluid_property => realization%fluid_properties
302) do
303) if (.not.associated(cur_fluid_property)) exit
304) iphase = cur_fluid_property%phase_id
305) patch%aux%RT%rt_parameter%diffusion_coefficient(iphase) = &
306) cur_fluid_property%diffusion_coefficient
307) patch%aux%RT%rt_parameter%diffusion_activation_energy(iphase) = &
308) cur_fluid_property%diffusion_activation_energy
309) cur_fluid_property => cur_fluid_property%next
310) enddo
311)
312) list => realization%output_option%output_snap_variable_list
313) call RTSetPlotVariables(realization,list)
314) if (.not.associated(realization%output_option%output_snap_variable_list, &
315) realization%output_option%output_obs_variable_list)) then
316) list => realization%output_option%output_obs_variable_list
317) call RTSetPlotVariables(realization,list)
318) endif
319)
320) end subroutine RTSetup
321)
322) ! ************************************************************************** !
323)
324) subroutine RTComputeMassBalance(realization,mass_balance)
325) !
326) ! Author: Glenn Hammond
327) ! Date: 12/23/08
328) !
329)
330) use Realization_Subsurface_class
331) use Option_module
332) use Patch_module
333) use Field_module
334) use Grid_module
335)
336) type(realization_subsurface_type) :: realization
337) PetscReal :: mass_balance(realization%option%ntrandof, &
338) realization%option%nphase)
339) type(option_type), pointer :: option
340) type(patch_type), pointer :: patch
341) type(field_type), pointer :: field
342) type(grid_type), pointer :: grid
343) type(global_auxvar_type), pointer :: global_auxvars(:)
344) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
345) class(material_auxvar_type), pointer :: material_auxvars(:)
346) type(reaction_type), pointer :: reaction
347)
348) PetscErrorCode :: ierr
349) PetscInt :: local_id
350) PetscInt :: ghosted_id
351) PetscInt :: iphase
352) PetscInt :: i, icomp, imnrl, ncomp, irate, irxn, naqcomp
353)
354) iphase = 1
355) option => realization%option
356) patch => realization%patch
357) grid => patch%grid
358) field => realization%field
359)
360) reaction => realization%reaction
361)
362) rt_auxvars => patch%aux%RT%auxvars
363) global_auxvars => patch%aux%Global%auxvars
364) material_auxvars => patch%aux%Material%auxvars
365)
366) mass_balance = 0.d0
367) naqcomp = reaction%naqcomp
368)
369) do local_id = 1, grid%nlmax
370) ghosted_id = grid%nL2G(local_id)
371) !geh - Ignore inactive cells with inactive materials
372) if (patch%imat(ghosted_id) <= 0) cycle
373) do iphase = 1, option%nphase
374)
375) ! mass_balance(:,iphase) = mass_balance(:,iphase) + &
376) mass_balance(1:naqcomp,1) = &
377) mass_balance(1:naqcomp,1) + &
378) rt_auxvars(ghosted_id)%total(:,iphase) * &
379) global_auxvars(ghosted_id)%sat(iphase) * &
380) material_auxvars(ghosted_id)%porosity * &
381) material_auxvars(ghosted_id)%volume*1000.d0
382)
383) if (iphase == 1) then
384) ! add contribution of equilibrium sorption
385) if (reaction%neqsorb > 0) then
386) mass_balance(1:naqcomp,iphase) = mass_balance(1:naqcomp,iphase) + &
387) rt_auxvars(ghosted_id)%total_sorb_eq(:) * &
388) material_auxvars(ghosted_id)%volume
389) endif
390)
391) ! add contribution of kinetic multirate sorption
392) do irxn = 1, reaction%surface_complexation%nkinmrsrfcplxrxn
393) do irate = 1, reaction%surface_complexation%kinmr_nrate(irxn)
394) mass_balance(1:naqcomp,iphase) = mass_balance(1:naqcomp,iphase) + &
395) rt_auxvars(ghosted_id)%kinmr_total_sorb(:,irate,irxn) * &
396) material_auxvars(ghosted_id)%volume
397) enddo
398) enddo
399)
400) ! add contribution from mineral volume fractions
401) do imnrl = 1, reaction%mineral%nkinmnrl
402) ncomp = reaction%mineral%kinmnrlspecid(0,imnrl)
403) do i = 1, ncomp
404) icomp = reaction%mineral%kinmnrlspecid(i,imnrl)
405) mass_balance(icomp,iphase) = mass_balance(icomp,iphase) &
406) + reaction%mineral%kinmnrlstoich(i,imnrl) &
407) * rt_auxvars(ghosted_id)%mnrl_volfrac(imnrl) &
408) * material_auxvars(ghosted_id)%volume &
409) / reaction%mineral%kinmnrl_molar_vol(imnrl)
410) enddo
411) enddo
412)
413) ! add contribution of immobile mass (still considered aqueous phase)
414) do i = 1, reaction%nimcomp
415) mass_balance(reaction%offset_immobile+i,iphase) = &
416) mass_balance(reaction%offset_immobile+i,iphase) + &
417) rt_auxvars(ghosted_id)%immobile(i) * &
418) material_auxvars(ghosted_id)%volume
419) enddo
420) endif
421) enddo
422) enddo
423)
424) end subroutine RTComputeMassBalance
425)
426) ! ************************************************************************** !
427)
428) subroutine RTZeroMassBalanceDelta(realization)
429) !
430) ! Zeros mass balance delta array
431) !
432) ! Author: Glenn Hammond
433) ! Date: 12/19/08
434) !
435)
436) use Realization_Subsurface_class
437) use Option_module
438) use Patch_module
439) use Grid_module
440)
441) implicit none
442)
443) type(realization_subsurface_type) :: realization
444)
445) type(option_type), pointer :: option
446) type(patch_type), pointer :: patch
447) type(reactive_transport_auxvar_type), pointer :: rt_auxvars_bc(:)
448) type(reactive_transport_auxvar_type), pointer :: rt_auxvars_ss(:)
449)
450) PetscInt :: iconn
451)
452) option => realization%option
453) patch => realization%patch
454)
455) rt_auxvars_bc => patch%aux%RT%auxvars_bc
456) rt_auxvars_ss => patch%aux%RT%auxvars_ss
457)
458) #ifdef COMPUTE_INTERNAL_MASS_FLUX
459) do iconn = 1, patch%aux%RT%num_aux
460) patch%aux%RT%auxvars(iconn)%mass_balance_delta = 0.d0
461) enddo
462) #endif
463)
464) do iconn = 1, patch%aux%RT%num_aux_bc
465) rt_auxvars_bc(iconn)%mass_balance_delta = 0.d0
466) enddo
467)
468) do iconn = 1, patch%aux%RT%num_aux_ss
469) rt_auxvars_ss(iconn)%mass_balance_delta = 0.d0
470) enddo
471)
472) end subroutine RTZeroMassBalanceDelta
473)
474) ! ************************************************************************** !
475)
476) subroutine RTUpdateMassBalance(realization)
477) !
478) ! Updates mass balance
479) !
480) ! Author: Glenn Hammond
481) ! Date: 12/19/08
482) !
483)
484) use Realization_Subsurface_class
485) use Option_module
486) use Patch_module
487) use Grid_module
488)
489) implicit none
490)
491) type(realization_subsurface_type) :: realization
492)
493) type(option_type), pointer :: option
494) type(patch_type), pointer :: patch
495) type(reactive_transport_auxvar_type), pointer :: rt_auxvars_bc(:)
496) type(reactive_transport_auxvar_type), pointer :: rt_auxvars_ss(:)
497)
498) PetscInt :: iconn
499)
500) option => realization%option
501) patch => realization%patch
502)
503) rt_auxvars_bc => patch%aux%RT%auxvars_bc
504) rt_auxvars_ss => patch%aux%RT%auxvars_ss
505)
506) #ifdef COMPUTE_INTERNAL_MASS_FLUX
507) do iconn = 1, patch%aux%RT%num_aux
508) patch%aux%RT%auxvars(iconn)%mass_balance = &
509) patch%aux%RT%auxvars(iconn)%mass_balance + &
510) patch%aux%RT%auxvars(iconn)%mass_balance_delta*option%tran_dt
511) enddo
512) #endif
513)
514) do iconn = 1, patch%aux%RT%num_aux_bc
515) rt_auxvars_bc(iconn)%mass_balance = &
516) rt_auxvars_bc(iconn)%mass_balance + &
517) rt_auxvars_bc(iconn)%mass_balance_delta*option%tran_dt
518) enddo
519)
520) do iconn = 1, patch%aux%RT%num_aux_ss
521) rt_auxvars_ss(iconn)%mass_balance = &
522) rt_auxvars_ss(iconn)%mass_balance + &
523) rt_auxvars_ss(iconn)%mass_balance_delta*option%tran_dt
524) enddo
525)
526) end subroutine RTUpdateMassBalance
527)
528) ! ************************************************************************** !
529)
530) subroutine RTInitializeTimestep(realization)
531) !
532) ! Author: Glenn Hammond
533) ! Date: 02/22/08
534) !
535)
536) use Realization_Subsurface_class
537)
538) type(realization_subsurface_type) :: realization
539)
540) call RTUpdateFixedAccumulation(realization)
541) ! geh: never use transport coefs evaluated at time k
542) ! call RTUpdateTransportCoefs(realization)
543)
544) end subroutine RTInitializeTimestep
545)
546) ! ************************************************************************** !
547)
548) subroutine RTUpdateEquilibriumState(realization)
549) !
550) ! Updates equilibrium state variables after a
551) ! successful time step
552) !
553) ! Author: Glenn Hammond
554) ! Date: 09/04/08
555) !
556)
557) use Realization_Subsurface_class
558) use Discretization_module
559) use Patch_module
560) use Option_module
561) use Grid_module
562) use Reaction_module
563) !geh: please leave the "only" clauses for Secondary_Continuum_XXX as this
564) ! resolves a bug in the Intel Visual Fortran compiler.
565) use Secondary_Continuum_Aux_module, only : sec_transport_type
566) use Secondary_Continuum_module, only : SecondaryRTUpdateEquilState
567)
568) implicit none
569)
570) type(realization_subsurface_type) :: realization
571)
572) type(patch_type), pointer :: patch
573) type(option_type), pointer :: option
574) type(reaction_type), pointer :: reaction
575) type(grid_type), pointer :: grid
576) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
577) type(global_auxvar_type), pointer :: global_auxvars(:)
578) type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
579) PetscInt :: ghosted_id, local_id
580) PetscReal :: conc, max_conc, min_conc
581) PetscErrorCode :: ierr
582)
583) option => realization%option
584) patch => realization%patch
585) reaction => realization%reaction
586) grid => patch%grid
587)
588) call VecCopy(realization%field%tran_xx,realization%field%tran_yy, &
589) ierr);CHKERRQ(ierr)
590) call DiscretizationGlobalToLocal(realization%discretization, &
591) realization%field%tran_xx, &
592) realization%field%tran_xx_loc,NTRANDOF)
593)
594) rt_auxvars => patch%aux%RT%auxvars
595) global_auxvars => patch%aux%Global%auxvars
596)
597) ! update: cells bcs act. coefs.
598) call RTUpdateAuxVars(realization,PETSC_TRUE,PETSC_FALSE,PETSC_FALSE)
599)
600) !geh: for debugging max/min concentrations
601) #if 0
602) max_conc = -1.d20
603) min_conc = 1.d20
604) do local_id = 1, grid%nlmax
605) ghosted_id = grid%nL2G(local_id)
606) conc = rt_auxvars(ghosted_id)%total(1,1)
607) max_conc = max(conc,max_conc)
608) min_conc = min(conc,min_conc)
609) enddo
610) call MPI_Allreduce(max_conc,conc,ONE_INTEGER_MPI, &
611) MPI_DOUBLE_PRECISION,MPI_MAX,option%mycomm,ierr)
612) max_conc = conc
613) call MPI_Allreduce(min_conc,conc,ONE_INTEGER_MPI, &
614) MPI_DOUBLE_PRECISION,MPI_MIN,option%mycomm,ierr)
615) min_conc = conc
616) if (option%print_screen_flag) then
617) write(*,'("Time: ",1pe12.5," Max: ",1pe12.5," Min: ",1pe12.5)') &
618) option%tran_time/realization%output_option%tconv,max_conc, min_conc
619) endif
620) #endif
621)
622) ! update secondary continuum variables
623) if (option%use_mc) then
624) rt_sec_transport_vars => patch%aux%SC_RT%sec_transport_vars
625) do local_id = 1, grid%nlmax
626) ghosted_id = grid%nL2G(local_id)
627) if (patch%imat(ghosted_id) <= 0) cycle
628) call SecondaryRTUpdateEquilState(rt_sec_transport_vars(local_id), &
629) global_auxvars(ghosted_id), &
630) reaction,option)
631) enddo
632) endif
633)
634) end subroutine RTUpdateEquilibriumState
635)
636) ! ************************************************************************** !
637)
638) subroutine RTUpdateKineticState(realization)
639) !
640) ! Updates kinetic state variables for reactive
641) ! transport
642) !
643) ! Author: Glenn Hammond
644) ! Date: 06/27/13
645) !
646)
647) use Realization_Subsurface_class
648) use Discretization_module
649) use Patch_module
650) use Option_module
651) use Grid_module
652) use Reaction_module
653) !geh: please leave the "only" clauses for Secondary_Continuum_XXX as this
654) ! resolves a bug in the Intel Visual Fortran compiler.
655) use Secondary_Continuum_Aux_module, only : sec_transport_type
656) use Secondary_Continuum_module, only : SecondaryRTUpdateKineticState
657)
658) implicit none
659)
660) type(realization_subsurface_type) :: realization
661)
662) type(patch_type), pointer :: patch
663) type(option_type), pointer :: option
664) type(reaction_type), pointer :: reaction
665) type(grid_type), pointer :: grid
666) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
667) type(global_auxvar_type), pointer :: global_auxvars(:)
668) class(material_auxvar_type), pointer :: material_auxvars(:)
669) type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
670) PetscInt :: ghosted_id, local_id
671) PetscReal :: conc, max_conc, min_conc
672) PetscErrorCode :: ierr
673) PetscReal :: sec_porosity
674)
675) option => realization%option
676) patch => realization%patch
677) reaction => realization%reaction
678) grid => patch%grid
679)
680) rt_auxvars => patch%aux%RT%auxvars
681) global_auxvars => patch%aux%Global%auxvars
682) material_auxvars => patch%aux%Material%auxvars
683)
684) ! update mineral volume fractions, multirate sorption concentrations,
685) ! kinetic sorption concentration etc. These updates must take place
686) ! within reaction so that auxiliary variables are updated when only
687) ! run in reaction mode.
688) do local_id = 1, grid%nlmax
689) ghosted_id = grid%nL2G(local_id)
690) if (patch%imat(ghosted_id) <= 0) cycle
691)
692) if (.not.option%use_isothermal) then
693) call RUpdateTempDependentCoefs(global_auxvars(ghosted_id),reaction, &
694) PETSC_FALSE,option)
695) endif
696)
697) call RUpdateKineticState(rt_auxvars(ghosted_id), &
698) global_auxvars(ghosted_id), &
699) material_auxvars(ghosted_id), &
700) reaction,option)
701) enddo
702)
703) ! update secondary continuum variables
704) if (option%use_mc) then
705) rt_sec_transport_vars => patch%aux%SC_RT%sec_transport_vars
706) do local_id = 1, grid%nlmax
707) ghosted_id = grid%nL2G(local_id)
708) if (patch%imat(ghosted_id) <= 0) cycle
709) sec_porosity = patch%material_property_array(1)%ptr% &
710) secondary_continuum_porosity
711)
712) call SecondaryRTUpdateKineticState(rt_sec_transport_vars(local_id), &
713) global_auxvars(ghosted_id), &
714) reaction,sec_porosity,option)
715) enddo
716) endif
717)
718) end subroutine RTUpdateKineticState
719)
720) ! ************************************************************************** !
721)
722) subroutine RTUpdateFixedAccumulation(realization)
723) !
724) ! Computes derivative of accumulation term in
725) ! residual function
726) !
727) ! Author: Glenn Hammond
728) ! Date: 02/15/08
729) !
730)
731) use Realization_Subsurface_class
732) use Patch_module
733) use Reactive_Transport_Aux_module
734) use Option_module
735) use Field_module
736) use Grid_module
737) use Secondary_Continuum_Aux_module
738)
739) implicit none
740)
741) type(realization_subsurface_type) :: realization
742)
743) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
744) type(global_auxvar_type), pointer :: global_auxvars(:)
745) class(material_auxvar_type), pointer :: material_auxvars(:)
746) type(option_type), pointer :: option
747) type(patch_type), pointer :: patch
748) type(grid_type), pointer :: grid
749) type(field_type), pointer :: field
750) type(reaction_type), pointer :: reaction
751) type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
752) PetscReal, pointer :: xx_p(:), accum_p(:)
753) PetscInt :: local_id, ghosted_id
754) PetscInt :: dof_offset, istart, iendaq, iendall
755) PetscInt :: istartim, iendim
756) PetscInt :: istartcoll, iendcoll
757) PetscErrorCode :: ierr
758) PetscReal :: vol_frac_prim
759)
760) option => realization%option
761) field => realization%field
762) patch => realization%patch
763) rt_auxvars => patch%aux%RT%auxvars
764) global_auxvars => patch%aux%Global%auxvars
765) material_auxvars => patch%aux%Material%auxvars
766)
767) grid => patch%grid
768) reaction => realization%reaction
769) if (option%use_mc) then
770) rt_sec_transport_vars => patch%aux%SC_RT%sec_transport_vars
771) endif
772)
773) ! cannot use tran_xx_loc vector here as it has not yet been updated.
774) call VecGetArrayReadF90(field%tran_xx,xx_p, ierr);CHKERRQ(ierr)
775)
776) call VecGetArrayF90(field%tran_accum, accum_p, ierr);CHKERRQ(ierr)
777)
778) vol_frac_prim = 1.d0
779)
780) ! Do not use RTUpdateAuxVars() as it loops over ghosted ids
781)
782) do local_id = 1, grid%nlmax
783) ghosted_id = grid%nL2G(local_id)
784) !geh - Ignore inactive cells with inactive materials
785) if (patch%imat(ghosted_id) <= 0) cycle
786)
787) ! compute offset in solution vector for first dof in grid cell
788) dof_offset = (local_id-1)*reaction%ncomp
789)
790) ! calculate range of aqueous species
791) istart = dof_offset + 1
792) iendaq = dof_offset + reaction%naqcomp
793) iendall = dof_offset + reaction%ncomp
794)
795) ! copy primary aqueous species
796) rt_auxvars(ghosted_id)%pri_molal = xx_p(istart:iendaq)
797)
798) if (reaction%ncoll > 0) then
799) istartcoll = dof_offset + reaction%offset_colloid + 1
800) iendcoll = dof_offset + reaction%offset_colloid + reaction%ncoll
801) rt_auxvars(ghosted_id)%colloid%conc_mob = xx_p(istartcoll:iendcoll)* &
802) global_auxvars(ghosted_id)%den_kg(1)*1.d-3
803) endif
804)
805) if (reaction%nimcomp > 0) then
806) istartim = dof_offset + reaction%offset_immobile + 1
807) iendim = dof_offset + reaction%offset_immobile + reaction%nimcomp
808) rt_auxvars(ghosted_id)%immobile = xx_p(istartim:iendim)
809) endif
810)
811) if (.not.option%use_isothermal) then
812) call RUpdateTempDependentCoefs(global_auxvars(ghosted_id),reaction, &
813) PETSC_FALSE,option)
814) endif
815)
816) ! DO NOT RECOMPUTE THE ACTIVITY COEFFICIENTS BEFORE COMPUTING THE
817) ! FIXED PORTION OF THE ACCUMULATION TERM - geh
818) call RTAuxVarCompute(rt_auxvars(ghosted_id), &
819) global_auxvars(ghosted_id), &
820) material_auxvars(ghosted_id), &
821) reaction,option)
822) call RTAccumulation(rt_auxvars(ghosted_id), &
823) global_auxvars(ghosted_id), &
824) material_auxvars(ghosted_id), &
825) reaction,option, &
826) accum_p(istart:iendall))
827) if (reaction%neqsorb > 0) then
828) call RAccumulationSorb(rt_auxvars(ghosted_id), &
829) global_auxvars(ghosted_id), &
830) material_auxvars(ghosted_id), &
831) reaction,option,accum_p(istart:iendall))
832) endif
833)
834) if (option%use_mc) then
835) vol_frac_prim = rt_sec_transport_vars(local_id)%epsilon
836) accum_p(istart:iendall) = accum_p(istart:iendall)*vol_frac_prim
837) endif
838)
839) enddo
840)
841) call VecRestoreArrayReadF90(field%tran_xx,xx_p, ierr);CHKERRQ(ierr)
842) call VecRestoreArrayF90(field%tran_accum, accum_p, ierr);CHKERRQ(ierr)
843)
844) end subroutine RTUpdateFixedAccumulation
845)
846) ! ************************************************************************** !
847)
848) subroutine RTUpdateTransportCoefs(realization)
849) !
850) ! Calculates coefficients for transport matrix
851) !
852) ! Author: Glenn Hammond
853) ! Date: 02/24/10
854) !
855)
856) use Realization_Subsurface_class
857) use Discretization_module
858) use Patch_module
859) use Connection_module
860) use Coupler_module
861) use Option_module
862) use Field_module
863) use Grid_module
864)
865) implicit none
866)
867) type(realization_subsurface_type) :: realization
868)
869) type(global_auxvar_type), pointer :: global_auxvars(:)
870) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
871) class(material_auxvar_type), pointer :: material_auxvars(:)
872) type(option_type), pointer :: option
873) type(patch_type), pointer :: patch
874) type(grid_type), pointer :: grid
875) type(field_type), pointer :: field
876) type(reactive_transport_param_type), pointer :: rt_parameter
877) PetscInt :: local_id, ghosted_id, ghosted_face_id, id
878)
879) type(coupler_type), pointer :: boundary_condition
880) type(connection_set_list_type), pointer :: connection_set_list
881) type(connection_set_type), pointer :: cur_connection_set
882) PetscInt :: sum_connection, iconn, num_connections
883) PetscInt :: ghosted_id_up, ghosted_id_dn, local_id_up, local_id_dn
884) PetscReal, allocatable :: cell_centered_Darcy_velocities(:,:)
885) PetscReal, allocatable :: cell_centered_Darcy_velocities_ghosted(:,:)
886) PetscReal, pointer :: vec_ptr(:)
887) PetscInt :: i
888) PetscErrorCode :: ierr
889)
890) option => realization%option
891) field => realization%field
892) patch => realization%patch
893) global_auxvars => patch%aux%Global%auxvars
894) global_auxvars_bc => patch%aux%Global%auxvars_bc
895) material_auxvars => patch%aux%Material%auxvars
896) grid => patch%grid
897) rt_parameter => patch%aux%RT%rt_parameter
898)
899) allocate(cell_centered_Darcy_velocities_ghosted(3,patch%grid%ngmax))
900) if (patch%material_property_array(1)%ptr%dispersivity(2) > 0.d0) then
901) allocate(cell_centered_Darcy_velocities(3,patch%grid%nlmax))
902) call PatchGetCellCenteredVelocities(patch,LIQUID_PHASE, &
903) cell_centered_Darcy_velocities)
904) ! at this point, velocities are at local cell centers; we need ghosted too.
905) do i=1,3
906) call VecGetArrayF90(field%work,vec_ptr,ierr);CHKERRQ(ierr)
907) vec_ptr(:) = cell_centered_Darcy_velocities(i,:)
908) call VecRestoreArrayF90(field%work,vec_ptr,ierr);CHKERRQ(ierr)
909) call DiscretizationGlobalToLocal(realization%discretization,field%work, &
910) field%work_loc,ONEDOF)
911) call VecGetArrayF90(field%work_loc,vec_ptr,ierr);CHKERRQ(ierr)
912) cell_centered_Darcy_velocities_ghosted(i,:) = vec_ptr(:)
913) call VecRestoreArrayF90(field%work_loc,vec_ptr,ierr);CHKERRQ(ierr)
914) enddo
915) deallocate(cell_centered_Darcy_velocities)
916) else
917) cell_centered_Darcy_velocities_ghosted = 0.d0
918) endif
919)
920) ! Interior Flux Terms -----------------------------------
921) connection_set_list => grid%internal_connection_set_list
922) cur_connection_set => connection_set_list%first
923) sum_connection = 0
924) do
925) if (.not.associated(cur_connection_set)) exit
926) do iconn = 1, cur_connection_set%num_connections
927) sum_connection = sum_connection + 1
928)
929) ghosted_id_up = cur_connection_set%id_up(iconn)
930) ghosted_id_dn = cur_connection_set%id_dn(iconn)
931)
932) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
933) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
934)
935) if (patch%imat(ghosted_id_up) <= 0 .or. &
936) patch%imat(ghosted_id_dn) <= 0) cycle
937)
938) call TDispersion(global_auxvars(ghosted_id_up), &
939) material_auxvars(ghosted_id_up), &
940) cell_centered_Darcy_velocities_ghosted(:,ghosted_id_up), &
941) patch%material_property_array(patch%imat(ghosted_id_up))% &
942) ptr%dispersivity, &
943) global_auxvars(ghosted_id_dn), &
944) material_auxvars(ghosted_id_dn), &
945) cell_centered_Darcy_velocities_ghosted(:,ghosted_id_dn), &
946) patch%material_property_array(patch%imat(ghosted_id_dn))% &
947) ptr%dispersivity, &
948) cur_connection_set%dist(:,iconn), &
949) rt_parameter,option, &
950) patch%internal_velocities(:,sum_connection), &
951) patch%internal_tran_coefs(:,sum_connection))
952)
953) enddo
954) cur_connection_set => cur_connection_set%next
955) enddo
956)
957) ! Boundary Flux Terms -----------------------------------
958) boundary_condition => patch%boundary_condition_list%first
959) sum_connection = 0
960) do
961) if (.not.associated(boundary_condition)) exit
962)
963) cur_connection_set => boundary_condition%connection_set
964) num_connections = cur_connection_set%num_connections
965) do iconn = 1, num_connections
966) sum_connection = sum_connection + 1
967)
968) local_id = cur_connection_set%id_dn(iconn)
969) ghosted_id = grid%nL2G(local_id)
970) if (patch%imat(ghosted_id) <= 0) cycle
971)
972) call TDispersionBC(boundary_condition%tran_condition%itype, &
973) global_auxvars_bc(sum_connection), &
974) global_auxvars(ghosted_id), &
975) material_auxvars(ghosted_id), &
976) cell_centered_Darcy_velocities_ghosted(:,ghosted_id), &
977) patch%material_property_array(patch%imat(ghosted_id))% &
978) ptr%dispersivity, &
979) cur_connection_set%dist(:,iconn), &
980) rt_parameter,option, &
981) patch%boundary_velocities(:,sum_connection), &
982) patch%boundary_tran_coefs(:,sum_connection))
983) enddo
984) boundary_condition => boundary_condition%next
985) enddo
986)
987) if (allocated(cell_centered_Darcy_velocities_ghosted)) &
988) deallocate(cell_centered_Darcy_velocities_ghosted)
989)
990) end subroutine RTUpdateTransportCoefs
991)
992) ! ************************************************************************** !
993)
994) subroutine RTUpdateRHSCoefs(realization)
995) !
996) ! Updates coefficients for the right hand side of
997) ! linear transport equation
998) !
999) ! Author: Glenn Hammond
1000) ! Date: 04/25/10
1001) !
1002)
1003) use Realization_Subsurface_class
1004) use Patch_module
1005) use Connection_module
1006) use Coupler_module
1007) use Option_module
1008) use Field_module
1009) use Grid_module
1010)
1011) implicit none
1012)
1013) type(realization_subsurface_type) :: realization
1014)
1015) type(global_auxvar_type), pointer :: global_auxvars(:)
1016) class(material_auxvar_type), pointer :: material_auxvars(:)
1017) type(option_type), pointer :: option
1018) type(patch_type), pointer :: patch
1019) type(grid_type), pointer :: grid
1020) type(field_type), pointer :: field
1021) PetscReal, pointer :: rhs_coef_p(:)
1022) PetscInt :: local_id, ghosted_id
1023) PetscInt :: iphase
1024) PetscErrorCode :: ierr
1025)
1026) option => realization%option
1027) field => realization%field
1028) patch => realization%patch
1029) global_auxvars => patch%aux%Global%auxvars
1030) material_auxvars => patch%aux%Material%auxvars
1031) grid => patch%grid
1032)
1033) ! Get vectors
1034) call VecGetArrayF90(field%tran_rhs_coef,rhs_coef_p,ierr);CHKERRQ(ierr)
1035)
1036) iphase = 1
1037) do local_id = 1, grid%nlmax
1038) ghosted_id = grid%nL2G(local_id)
1039) if (patch%imat(ghosted_id) <= 0) cycle
1040) rhs_coef_p(local_id) = material_auxvars(ghosted_id)%porosity* &
1041) global_auxvars(ghosted_id)%sat(iphase)* &
1042) ! total already has den_kg within
1043) ! global_auxvars(ghosted_id)%den_kg(iphase)* &
1044) 1000.d0* &
1045) material_auxvars(ghosted_id)%volume/option%tran_dt
1046) enddo
1047)
1048) ! Restore vectors
1049) call VecRestoreArrayF90(field%tran_rhs_coef,rhs_coef_p,ierr);CHKERRQ(ierr)
1050)
1051) end subroutine RTUpdateRHSCoefs
1052)
1053) ! ************************************************************************** !
1054)
1055) subroutine RTCalculateRHS_t0(realization)
1056) !
1057) ! Calculate porition of RHS of transport system
1058) ! at time t0 or time level k
1059) !
1060) ! Author: Glenn Hammond
1061) ! Date: 04/25/10
1062) !
1063)
1064) use Realization_Subsurface_class
1065) use Patch_module
1066) use Connection_module
1067) use Coupler_module
1068) use Option_module
1069) use Field_module
1070) use Grid_module
1071)
1072) implicit none
1073)
1074) type(realization_subsurface_type) :: realization
1075)
1076) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
1077) type(option_type), pointer :: option
1078) type(patch_type), pointer :: patch
1079) type(grid_type), pointer :: grid
1080) type(field_type), pointer :: field
1081) type(reaction_type), pointer :: reaction
1082) PetscReal, pointer :: rhs_coef_p(:)
1083) PetscReal, pointer :: rhs_p(:)
1084) PetscInt :: local_id, ghosted_id
1085) PetscInt :: iphase
1086) PetscInt :: istartaq, iendaq
1087)
1088) PetscErrorCode :: ierr
1089)
1090) option => realization%option
1091) field => realization%field
1092) patch => realization%patch
1093) rt_auxvars => patch%aux%RT%auxvars
1094) grid => patch%grid
1095) reaction => realization%reaction
1096)
1097) ! Get vectors
1098) call VecGetArrayReadF90(field%tran_rhs_coef,rhs_coef_p,ierr);CHKERRQ(ierr)
1099) call VecGetArrayF90(field%tran_rhs,rhs_p,ierr);CHKERRQ(ierr)
1100)
1101) iphase = 1
1102) do local_id = 1, grid%nlmax
1103) ghosted_id = grid%nL2G(local_id)
1104) if (patch%imat(ghosted_id) <= 0) cycle
1105) iendaq = local_id*reaction%naqcomp
1106) istartaq = iendaq-reaction%naqcomp+1
1107) rhs_p(istartaq:iendaq) = rt_auxvars(ghosted_id)%total(:,iphase)* &
1108) rhs_coef_p(local_id)
1109) enddo
1110)
1111) ! Restore vectors
1112) call VecRestoreArrayReadF90(field%tran_rhs_coef,rhs_coef_p, &
1113) ierr);CHKERRQ(ierr)
1114) call VecRestoreArrayF90(field%tran_rhs,rhs_p,ierr);CHKERRQ(ierr)
1115)
1116) end subroutine RTCalculateRHS_t0
1117)
1118) ! ************************************************************************** !
1119)
1120) subroutine RTCalculateRHS_t1(realization)
1121) !
1122) ! Calculate porition of RHS of transport system
1123) ! at time level k+1
1124) !
1125) ! Author: Glenn Hammond
1126) ! Date: 04/25/10
1127) !
1128)
1129) use Realization_Subsurface_class
1130) use Patch_module
1131) use Connection_module
1132) use Coupler_module
1133) use Option_module
1134) use Field_module
1135) use Grid_module
1136)
1137) implicit none
1138)
1139) type(realization_subsurface_type) :: realization
1140)
1141) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
1142) type(reactive_transport_auxvar_type), pointer :: rt_auxvars_bc(:)
1143) type(global_auxvar_type), pointer :: global_auxvars(:)
1144) type(option_type), pointer :: option
1145) type(patch_type), pointer :: patch
1146) type(grid_type), pointer :: grid
1147) type(field_type), pointer :: field
1148) type(reaction_type), pointer :: reaction
1149) PetscReal, pointer :: rhs_p(:)
1150) PetscInt :: local_id, ghosted_id
1151) PetscInt :: iphase
1152) PetscReal :: coef_up(1), coef_dn(1)
1153) PetscReal :: msrc(2)
1154) PetscReal :: Res(realization%reaction%naqcomp)
1155) PetscInt :: istartaq, iendaq
1156)
1157) type(coupler_type), pointer :: boundary_condition
1158) type(connection_set_list_type), pointer :: connection_set_list
1159) type(connection_set_type), pointer :: cur_connection_set
1160) type(coupler_type), pointer :: source_sink
1161) PetscInt :: sum_connection, iconn
1162) PetscReal :: qsrc
1163) PetscInt :: offset, istartcoll, iendcoll, istartall, iendall, icomp, ieqgas
1164) PetscBool :: volumetric
1165) PetscInt :: flow_src_sink_type
1166) PetscReal :: coef_in, coef_out
1167) PetscErrorCode :: ierr
1168)
1169) option => realization%option
1170) field => realization%field
1171) patch => realization%patch
1172) rt_auxvars => patch%aux%RT%auxvars
1173) rt_auxvars_bc => patch%aux%RT%auxvars_bc
1174) global_auxvars => patch%aux%Global%auxvars
1175) grid => patch%grid
1176) reaction => realization%reaction
1177)
1178) iphase = 1
1179)
1180) !geh - activity coef updates must always be off!!!
1181) !geh ! update: cells bcs act. coefs.
1182) ! call RTUpdateAuxVars(realization,PETSC_FALSE,PETSC_TRUE,PETSC_FALSE)
1183) if (reaction%act_coef_update_frequency /= ACT_COEF_FREQUENCY_OFF) then
1184) call RTUpdateAuxVars(realization,PETSC_FALSE,PETSC_TRUE,PETSC_TRUE)
1185) else
1186) call RTUpdateAuxVars(realization,PETSC_FALSE,PETSC_TRUE,PETSC_FALSE)
1187) endif
1188)
1189) ! Get vectors
1190) call VecGetArrayF90(field%tran_rhs,rhs_p,ierr);CHKERRQ(ierr)
1191)
1192) ! add in inflowing boundary conditions
1193) ! Boundary Flux Terms -----------------------------------
1194) boundary_condition => patch%boundary_condition_list%first
1195) sum_connection = 0
1196) do
1197) if (.not.associated(boundary_condition)) exit
1198)
1199) cur_connection_set => boundary_condition%connection_set
1200)
1201) do iconn = 1, cur_connection_set%num_connections
1202) sum_connection = sum_connection + 1
1203)
1204) local_id = cur_connection_set%id_dn(iconn)
1205) ghosted_id = grid%nL2G(local_id)
1206)
1207) if (patch%imat(ghosted_id) <= 0) cycle
1208)
1209) call TFluxCoef(option,cur_connection_set%area(iconn), &
1210) patch%boundary_velocities(:,sum_connection), &
1211) patch%boundary_tran_coefs(:,sum_connection), &
1212) 0.5d0, & ! fraction upwind (0.d0 upwind, 0.5 central)
1213) coef_up,coef_dn)
1214)
1215) ! coef_dn not needed
1216) iendaq = local_id*reaction%naqcomp
1217) istartaq = iendaq-reaction%naqcomp+1
1218)
1219) rhs_p(istartaq:iendaq) = rhs_p(istartaq:iendaq) + &
1220) coef_up(iphase)*rt_auxvars_bc(sum_connection)%total(:,iphase)
1221)
1222) enddo
1223) boundary_condition => boundary_condition%next
1224) enddo
1225)
1226) ! add in inflowing sources
1227) #if 1
1228) ! Source/sink terms -------------------------------------
1229) source_sink => patch%source_sink_list%first
1230) sum_connection = 0
1231) do
1232) if (.not.associated(source_sink)) exit
1233)
1234) cur_connection_set => source_sink%connection_set
1235)
1236) qsrc = 0.d0
1237) flow_src_sink_type = 0
1238) if (associated(source_sink%flow_condition) .and. &
1239) associated(source_sink%flow_condition%rate)) then
1240) qsrc = source_sink%flow_condition%rate%dataset%rarray(1)
1241) flow_src_sink_type = source_sink%flow_condition%rate%itype
1242) endif
1243)
1244) ! only handle injection on rhs
1245) if (qsrc < 0.d0) then
1246) source_sink => source_sink%next
1247) cycle
1248) endif
1249)
1250) do iconn = 1, cur_connection_set%num_connections
1251) sum_connection = sum_connection + 1
1252) local_id = cur_connection_set%id_dn(iconn)
1253) ghosted_id = grid%nL2G(local_id)
1254)
1255) offset = (local_id-1)*reaction%ncomp
1256)
1257) if (patch%imat(ghosted_id) <= 0) cycle
1258)
1259) istartaq = reaction%offset_aqueous + 1
1260) iendaq = reaction%offset_aqueous + reaction%naqcomp
1261)
1262) if (reaction%ncoll > 0) then
1263) istartcoll = reaction%offset_colloid + 1
1264) iendcoll = reaction%offset_colloid + reaction%ncoll
1265) endif
1266)
1267) qsrc = patch%ss_flow_vol_fluxes(1,sum_connection)
1268) call TSrcSinkCoef(option,qsrc,source_sink%tran_condition%itype, &
1269) coef_in,coef_out)
1270)
1271) Res(istartaq:iendaq) = & !coef_in*rt_auxvars(ghosted_id)%total(:,iphase) + &
1272) coef_out*source_sink%tran_condition%cur_constraint_coupler% &
1273) rt_auxvar%total(:,iphase)
1274) if (reaction%ncoll > 0) then
1275) Res(istartcoll:iendcoll) = & !coef_in*rt_auxvars(ghosted_id)%colloid%conc_mob(:) !+ &
1276) coef_out*source_sink%tran_condition%cur_constraint_coupler% &
1277) rt_auxvar%colloid%conc_mob(:)
1278) endif
1279) istartall = offset + 1
1280) iendall = offset + reaction%ncomp
1281) ! subtract since the contribution is on the rhs
1282) rhs_p(istartall:iendall) = rhs_p(istartall:iendall) - Res(1:reaction%ncomp)
1283) enddo
1284) source_sink => source_sink%next
1285) enddo
1286)
1287) ! CO2-specific
1288) select case(option%iflowmode)
1289) case(MPH_MODE,IMS_MODE,FLASH2_MODE)
1290) source_sink => patch%source_sink_list%first
1291) do
1292) if (.not.associated(source_sink)) exit
1293)
1294) !geh begin change
1295) !geh msrc(:) = source_sink%flow_condition%pressure%dataset%rarray(:)
1296) msrc(:) = source_sink%flow_condition%rate%dataset%rarray(:)
1297) !geh end change
1298) msrc(1) = msrc(1) / FMWH2O*1D3
1299) msrc(2) = msrc(2) / FMWCO2*1D3
1300) ! print *,'RT SC source'
1301) do iconn = 1, cur_connection_set%num_connections
1302) local_id = cur_connection_set%id_dn(iconn)
1303) ghosted_id = grid%nL2G(local_id)
1304) Res=0D0
1305)
1306) if (patch%imat(ghosted_id) <= 0) cycle
1307)
1308) select case(source_sink%flow_condition%itype(1))
1309) case(MASS_RATE_SS)
1310) do ieqgas = 1, reaction%ngas
1311) if (abs(reaction%species_idx%co2_gas_id) == ieqgas) then
1312) icomp = reaction%eqgasspecid(1,ieqgas)
1313) iendall = local_id*reaction%ncomp
1314) istartall = iendall-reaction%ncomp
1315) Res(icomp) = -msrc(2)
1316) rhs_p(istartall+icomp) = rhs_p(istartall+icomp) - Res(icomp)
1317) ! print *,'RT SC source', ieqgas,icomp, res(icomp)
1318) endif
1319) enddo
1320) end select
1321) enddo
1322) source_sink => source_sink%next
1323) enddo
1324) end select
1325) #endif
1326)
1327) ! Restore vectors
1328) call VecRestoreArrayF90(field%tran_rhs,rhs_p,ierr);CHKERRQ(ierr)
1329)
1330) ! Mass Transfer
1331) if (field%tran_mass_transfer /= 0) then
1332) ! scale by -1.d0 for contribution to residual. A negative contribution
1333) ! indicates mass being added to system.
1334) call VecAXPY(field%tran_rhs,-1.d0,field%tran_mass_transfer)
1335) endif
1336)
1337) end subroutine RTCalculateRHS_t1
1338)
1339) ! ************************************************************************** !
1340)
1341) subroutine RTCalculateTransportMatrix(realization,T)
1342) !
1343) ! Calculate transport matrix
1344) !
1345) ! Author: Glenn Hammond
1346) ! Date: 04/25/10
1347) !
1348)
1349) use Realization_Subsurface_class
1350) use Option_module
1351) use Grid_module
1352) use Patch_module
1353) use Field_module
1354) use Coupler_module
1355) use Connection_module
1356) use Debug_module
1357)
1358) implicit none
1359)
1360) type(realization_subsurface_type) :: realization
1361) Mat :: T
1362)
1363) type(global_auxvar_type), pointer :: global_auxvars(:)
1364) class(material_auxvar_type), pointer :: material_auxvars(:)
1365) type(option_type), pointer :: option
1366) type(patch_type), pointer :: patch
1367) type(grid_type), pointer :: grid
1368) type(field_type), pointer :: field
1369) PetscInt :: local_id, ghosted_id
1370) PetscInt :: local_id_up, local_id_dn, ghosted_id_up, ghosted_id_dn
1371) PetscInt :: iphase
1372)
1373) type(coupler_type), pointer :: boundary_condition
1374) type(connection_set_list_type), pointer :: connection_set_list
1375) type(connection_set_type), pointer :: cur_connection_set
1376) type(coupler_type), pointer :: source_sink
1377) PetscInt :: sum_connection, iconn
1378) PetscReal :: coef
1379) PetscReal :: coef_up(1), coef_dn(1)
1380) PetscReal :: qsrc
1381) PetscBool :: volumetric
1382) PetscInt :: flow_pc
1383) PetscInt :: flow_src_sink_type
1384) PetscReal :: coef_in, coef_out
1385) PetscViewer :: viewer
1386) PetscErrorCode :: ierr
1387)
1388) character(len=MAXSTRINGLENGTH) :: string
1389)
1390) option => realization%option
1391) field => realization%field
1392) patch => realization%patch
1393) global_auxvars => patch%aux%Global%auxvars
1394) material_auxvars => patch%aux%Material%auxvars
1395) grid => patch%grid
1396)
1397) call MatZeroEntries(T,ierr);CHKERRQ(ierr)
1398)
1399) ! Get vectors
1400)
1401) ! Interior Flux Terms -----------------------------------
1402) connection_set_list => grid%internal_connection_set_list
1403) cur_connection_set => connection_set_list%first
1404) sum_connection = 0
1405) do
1406) if (.not.associated(cur_connection_set)) exit
1407) do iconn = 1, cur_connection_set%num_connections
1408) sum_connection = sum_connection + 1
1409)
1410) ghosted_id_up = cur_connection_set%id_up(iconn)
1411) ghosted_id_dn = cur_connection_set%id_dn(iconn)
1412)
1413) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
1414) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
1415)
1416) if (patch%imat(ghosted_id_up) <= 0 .or. &
1417) patch%imat(ghosted_id_dn) <= 0) cycle
1418)
1419) call TFluxCoef(option,cur_connection_set%area(iconn), &
1420) patch%internal_velocities(:,sum_connection), &
1421) patch%internal_tran_coefs(:,sum_connection), &
1422) cur_connection_set%dist(-1,iconn), &
1423) coef_up,coef_dn)
1424)
1425) ! coef_up = coef_up*global_auxvars(ghosted_id_up)%den_kg*1.d-3
1426) ! coef_dn = coef_dn*global_auxvars(ghosted_id_dn)%den_kg*1.d-3
1427)
1428) if (local_id_up > 0) then
1429) call MatSetValuesLocal(T,1,ghosted_id_up-1,1,ghosted_id_up-1, &
1430) coef_up,ADD_VALUES,ierr);CHKERRQ(ierr)
1431) call MatSetValuesLocal(T,1,ghosted_id_up-1,1,ghosted_id_dn-1, &
1432) coef_dn,ADD_VALUES,ierr);CHKERRQ(ierr)
1433) endif
1434) if (local_id_dn > 0) then
1435) coef_up = -coef_up
1436) coef_dn = -coef_dn
1437) call MatSetValuesLocal(T,1,ghosted_id_dn-1,1,ghosted_id_dn-1, &
1438) coef_dn,ADD_VALUES,ierr);CHKERRQ(ierr)
1439) call MatSetValuesLocal(T,1,ghosted_id_dn-1,1,ghosted_id_up-1, &
1440) coef_up,ADD_VALUES,ierr);CHKERRQ(ierr)
1441) endif
1442)
1443) enddo
1444) cur_connection_set => cur_connection_set%next
1445) enddo
1446)
1447) ! add in outflowing boundary conditions
1448) ! Boundary Flux Terms -----------------------------------
1449) boundary_condition => patch%boundary_condition_list%first
1450) sum_connection = 0
1451) do
1452) if (.not.associated(boundary_condition)) exit
1453)
1454) cur_connection_set => boundary_condition%connection_set
1455)
1456) do iconn = 1, cur_connection_set%num_connections
1457) sum_connection = sum_connection + 1
1458)
1459) local_id = cur_connection_set%id_dn(iconn)
1460) ghosted_id = grid%nL2G(local_id)
1461)
1462) if (patch%imat(ghosted_id) <= 0) cycle
1463)
1464) call TFluxCoef(option,cur_connection_set%area(iconn), &
1465) patch%boundary_velocities(:,sum_connection), &
1466) patch%boundary_tran_coefs(:,sum_connection), &
1467) 0.5d0, & ! fraction upwind (0.d0 upwind, 0.5 central)
1468) coef_up,coef_dn)
1469)
1470) ! coef_dn = coef_dn*global_auxvars(ghosted_id)%den_kg*1.d-3
1471)
1472) !Jup not needed
1473) coef_dn = -coef_dn
1474) call MatSetValuesLocal(T,1,ghosted_id-1,1,ghosted_id-1,coef_dn, &
1475) ADD_VALUES,ierr);CHKERRQ(ierr)
1476)
1477) enddo
1478) boundary_condition => boundary_condition%next
1479) enddo
1480)
1481) ! Accumulation term
1482) iphase = 1
1483) do local_id = 1, grid%nlmax
1484) ghosted_id = grid%nL2G(local_id)
1485) if (patch%imat(ghosted_id) <= 0) cycle
1486) coef = material_auxvars(ghosted_id)%porosity* &
1487) global_auxvars(ghosted_id)%sat(iphase)* &
1488) !geh global_auxvars(ghosted_id)%den_kg(iphase)* &
1489) 1000.d0* &
1490) material_auxvars(ghosted_id)%volume/option%tran_dt
1491) call MatSetValuesLocal(T,1,ghosted_id-1,1,ghosted_id-1,coef, &
1492) ADD_VALUES,ierr);CHKERRQ(ierr)
1493) enddo
1494)
1495) ! Source/sink terms -------------------------------------
1496) source_sink => patch%source_sink_list%first
1497) sum_connection = 0
1498) do
1499) if (.not.associated(source_sink)) exit
1500)
1501) cur_connection_set => source_sink%connection_set
1502)
1503) qsrc = 0.d0
1504) flow_src_sink_type = 0
1505) if (associated(source_sink%flow_condition) .and. &
1506) associated(source_sink%flow_condition%rate)) then
1507) qsrc = source_sink%flow_condition%rate%dataset%rarray(1)
1508) flow_src_sink_type = source_sink%flow_condition%rate%itype
1509) endif
1510)
1511) ! only handle extraction on lhs
1512) if (qsrc > 0.d0) then
1513) source_sink => source_sink%next
1514) cycle
1515) endif
1516)
1517) do iconn = 1, cur_connection_set%num_connections
1518) sum_connection = sum_connection + 1
1519) local_id = cur_connection_set%id_dn(iconn)
1520) ghosted_id = grid%nL2G(local_id)
1521)
1522) if (patch%imat(ghosted_id) <= 0) cycle
1523)
1524) qsrc = patch%ss_flow_vol_fluxes(1,sum_connection)
1525) call TSrcSinkCoef(option,qsrc,source_sink%tran_condition%itype, &
1526) coef_in,coef_out)
1527)
1528) coef_dn(1) = coef_in
1529) !geh: do not remove this conditional as otherwise MatSetValuesLocal()
1530) ! will be called for injection too (wasted calls)
1531) if (coef_dn(1) > 0.d0) then
1532) call MatSetValuesLocal(T,1,ghosted_id-1,1,ghosted_id-1,coef_dn, &
1533) ADD_VALUES,ierr);CHKERRQ(ierr)
1534) endif
1535)
1536) enddo
1537) source_sink => source_sink%next
1538) enddo
1539)
1540) ! All CO2 source/sinks are handled on the RHS for now
1541)
1542) call MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
1543) call MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
1544)
1545) if (patch%aux%RT%inactive_cells_exist) then
1546) coef = 1.d0
1547) call MatZeroRowsLocal(T,patch%aux%RT%n_zero_rows, &
1548) patch%aux%RT%zero_rows_local_ghosted,coef, &
1549) PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
1550) ierr);CHKERRQ(ierr)
1551) endif
1552)
1553) if (realization%debug%matview_Jacobian) then
1554) string = 'Tmatrix'
1555) call DebugCreateViewer(realization%debug,string,option,viewer)
1556) call MatView(T,viewer,ierr);CHKERRQ(ierr)
1557) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
1558) endif
1559)
1560) end subroutine RTCalculateTransportMatrix
1561)
1562) ! ************************************************************************** !
1563)
1564) subroutine RTReact(realization)
1565) !
1566) ! Calculate reaction
1567) !
1568) ! Author: Glenn Hammond
1569) ! Date: 05/03/10
1570) !
1571)
1572) use Realization_Subsurface_class
1573) use Patch_module
1574) use Connection_module
1575) use Coupler_module
1576) use Option_module
1577) use Field_module
1578) use Grid_module
1579) use Secondary_Continuum_Aux_module
1580) use Logging_module
1581)
1582) !$ use omp_lib
1583)
1584) implicit none
1585)
1586) type(realization_subsurface_type) :: realization
1587)
1588) type(global_auxvar_type), pointer :: global_auxvars(:)
1589) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
1590) class(material_auxvar_type), pointer :: material_auxvars(:)
1591) type(patch_type), pointer :: patch
1592) type(grid_type), pointer :: grid
1593) type(field_type), pointer :: field
1594) type(reaction_type), pointer :: reaction
1595) type(option_type), pointer :: option
1596) type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
1597) PetscInt :: local_id, ghosted_id
1598) PetscInt :: istart, iend, iendaq
1599) PetscInt :: iphase
1600) PetscInt :: ithread, vector_length
1601) PetscReal, pointer :: tran_xx_p(:)
1602) PetscReal, pointer :: mask_p(:)
1603) PetscInt :: num_iterations
1604) #ifdef OS_STATISTICS
1605) PetscInt :: sum_iterations
1606) PetscInt :: max_iterations
1607) #endif
1608) PetscInt :: icount
1609) PetscErrorCode :: ierr
1610)
1611) #ifdef OS_STATISTICS
1612) PetscInt :: call_count
1613) PetscInt :: sum_newton_iterations
1614) PetscReal :: ave_newton_iterations_in_a_cell
1615) PetscInt :: max_newton_iterations_in_a_cell
1616) PetscInt :: max_newton_iterations_on_a_core
1617) PetscInt :: min_newton_iterations_on_a_core
1618) PetscInt :: temp_int_in(3)
1619) PetscInt :: temp_int_out(3)
1620) #endif
1621)
1622) call PetscLogEventBegin(logging%event_rt_react,ierr);CHKERRQ(ierr)
1623)
1624) #ifdef OS_STATISTICS
1625) call_count = 0
1626) sum_newton_iterations = 0
1627) max_newton_iterations_in_a_cell = -99999999
1628) max_newton_iterations_on_a_core = -99999999
1629) min_newton_iterations_on_a_core = 99999999
1630) #endif
1631)
1632) option => realization%option
1633) field => realization%field
1634) patch => realization%patch
1635) global_auxvars => patch%aux%Global%auxvars
1636) rt_auxvars => patch%aux%RT%auxvars
1637) material_auxvars => patch%aux%Material%auxvars
1638) grid => patch%grid
1639) reaction => realization%reaction
1640)
1641) ! need up update aux vars based on current density/saturation,
1642) ! but NOT activity coefficients
1643) call RTUpdateAuxVars(realization,PETSC_TRUE,PETSC_FALSE,PETSC_FALSE)
1644)
1645) ! Get vectors
1646) call VecGetArrayReadF90(field%tran_xx,tran_xx_p,ierr);CHKERRQ(ierr)
1647)
1648) iphase = 1
1649) ithread = 1
1650) #ifdef OS_STATISTICS
1651) sum_iterations = 0
1652) max_iterations = 0
1653) icount = 0
1654) #endif
1655)
1656) do local_id = 1, grid%nlmax
1657) ghosted_id = grid%nL2G(local_id)
1658) if (patch%imat(ghosted_id) <= 0) cycle
1659)
1660) istart = (local_id-1)*reaction%ncomp+1
1661) iend = istart + reaction%ncomp - 1
1662) iendaq = istart + reaction%naqcomp - 1
1663)
1664)
1665) call RReact(rt_auxvars(ghosted_id),global_auxvars(ghosted_id), &
1666) material_auxvars(ghosted_id), &
1667) tran_xx_p(istart:iend), &
1668) num_iterations,reaction,option)
1669) ! set primary dependent var back to free-ion molality
1670) tran_xx_p(istart:iendaq) = rt_auxvars(ghosted_id)%pri_molal
1671) if (reaction%nimcomp > 0) then
1672) tran_xx_p(reaction%offset_immobile: &
1673) reaction%offset_immobile + reaction%nimcomp) = &
1674) rt_auxvars(ghosted_id)%immobile
1675) endif
1676) #ifdef OS_STATISTICS
1677) if (num_iterations > max_iterations) then
1678) max_iterations = num_iterations
1679) endif
1680) sum_iterations = sum_iterations + num_iterations
1681) icount = icount + 1
1682) #endif
1683) enddo
1684)
1685) #ifdef OS_STATISTICS
1686) patch%aux%RT%rt_parameter%newton_call_count = icount
1687) patch%aux%RT%rt_parameter%sum_newton_call_count = &
1688) patch%aux%RT%rt_parameter%sum_newton_call_count + dble(icount)
1689) patch%aux%RT%rt_parameter%newton_iterations = sum_iterations
1690) patch%aux%RT%rt_parameter%sum_newton_iterations = &
1691) patch%aux%RT%rt_parameter%sum_newton_iterations + dble(sum_iterations)
1692) patch%aux%RT%rt_parameter%max_newton_iterations = max_iterations
1693) #endif
1694)
1695) ! Restore vectors
1696) call VecRestoreArrayReadF90(field%tran_xx,tran_xx_p,ierr);CHKERRQ(ierr)
1697)
1698) if (option%compute_mass_balance_new) then
1699) call RTZeroMassBalanceDelta(realization)
1700) call RTComputeBCMassBalanceOS(realization)
1701) endif
1702)
1703) #ifdef OS_STATISTICS
1704) call_count = call_count + cur_patch%aux%RT%rt_parameter%newton_call_count
1705) sum_newton_iterations = sum_newton_iterations + &
1706) cur_patch%aux%RT%rt_parameter%newton_iterations
1707) if (cur_patch%aux%RT%rt_parameter%max_newton_iterations > &
1708) max_newton_iterations_in_a_cell) then
1709) max_newton_iterations_in_a_cell = &
1710) cur_patch%aux%RT%rt_parameter%max_newton_iterations
1711) endif
1712) if (cur_patch%aux%RT%rt_parameter%max_newton_iterations > &
1713) cur_patch%aux%RT%rt_parameter%overall_max_newton_iterations) then
1714) cur_patch%aux%RT%rt_parameter%overall_max_newton_iterations = &
1715) cur_patch%aux%RT%rt_parameter%max_newton_iterations
1716) endif
1717) #endif
1718)
1719) ! Logging must come before statistics since the global reductions
1720) ! will synchonize the cores
1721) call PetscLogEventEnd(logging%event_rt_react,ierr);CHKERRQ(ierr)
1722)
1723) #ifdef OS_STATISTICS
1724) temp_int_in(1) = call_count
1725) temp_int_in(2) = sum_newton_iterations
1726) call MPI_Allreduce(temp_int_in,temp_int_out,TWO_INTEGER_MPI, &
1727) MPIU_INTEGER,MPI_SUM,option%mycomm,ierr)
1728) ave_newton_iterations_in_a_cell = float(temp_int_out(2)) / temp_int_out(1)
1729)
1730) temp_int_in(1) = max_newton_iterations_in_a_cell
1731) temp_int_in(2) = sum_newton_iterations ! to calc max # iteration on a core
1732) temp_int_in(3) = -sum_newton_iterations ! to calc min # iteration on a core
1733) call MPI_Allreduce(temp_int_in,temp_int_out,THREE_INTEGER_MPI, &
1734) MPIU_INTEGER,MPI_MAX,option%mycomm,ierr)
1735) max_newton_iterations_in_a_cell = temp_int_out(1)
1736) max_newton_iterations_on_a_core = temp_int_out(2)
1737) min_newton_iterations_on_a_core = -temp_int_out(3)
1738)
1739) if (option%print_screen_flag) then
1740) write(*, '(" OS Reaction Statistics: ",/, &
1741) & " Ave Newton Its / Cell: ",1pe12.4,/, &
1742) & " Max Newton Its / Cell: ",i4,/, &
1743) & " Max Newton Its / Core: ",i6,/, &
1744) & " Min Newton Its / Core: ",i6)') &
1745) ave_newton_iterations_in_a_cell, &
1746) max_newton_iterations_in_a_cell, &
1747) max_newton_iterations_on_a_core, &
1748) min_newton_iterations_on_a_core
1749) endif
1750)
1751) if (option%print_file_flag) then
1752) write(option%fid_out, '(" OS Reaction Statistics: ",/, &
1753) & " Ave Newton Its / Cell: ",1pe12.4,/, &
1754) & " Max Newton Its / Cell: ",i4,/, &
1755) & " Max Newton Its / Core: ",i6,/, &
1756) & " Min Newton Its / Core: ",i6)') &
1757) ave_newton_iterations_in_a_cell, &
1758) max_newton_iterations_in_a_cell, &
1759) max_newton_iterations_on_a_core, &
1760) min_newton_iterations_on_a_core
1761) endif
1762)
1763) #endif
1764)
1765) end subroutine RTReact
1766)
1767) ! ************************************************************************** !
1768)
1769) subroutine RTComputeBCMassBalanceOS(realization)
1770) !
1771) ! Calculates mass balance at boundary
1772) ! conditions for operator split mode
1773) !
1774) ! Author: Glenn Hammond
1775) ! Date: 05/04/10
1776) !
1777)
1778) use Realization_Subsurface_class
1779) use Patch_module
1780) use Transport_module
1781) use Option_module
1782) use Field_module
1783) use Grid_module
1784) use Connection_module
1785) use Coupler_module
1786) use Debug_module
1787)
1788) implicit none
1789)
1790) type(realization_subsurface_type) :: realization
1791)
1792) PetscInt :: local_id, ghosted_id
1793) PetscInt, parameter :: iphase = 1
1794) type(grid_type), pointer :: grid
1795) type(option_type), pointer :: option
1796) type(field_type), pointer :: field
1797) type(patch_type), pointer :: patch
1798) type(reaction_type), pointer :: reaction
1799) type(reactive_transport_param_type), pointer :: rt_parameter
1800) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
1801) type(reactive_transport_auxvar_type), pointer :: rt_auxvars_bc(:)
1802) type(reactive_transport_auxvar_type), pointer :: rt_auxvars_ss(:)
1803) type(global_auxvar_type), pointer :: global_auxvars(:)
1804) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
1805) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
1806) PetscReal :: Res(realization%reaction%ncomp)
1807)
1808) PetscReal, pointer :: face_fluxes_p(:)
1809)
1810) type(coupler_type), pointer :: boundary_condition
1811) type(coupler_type), pointer :: source_sink
1812) type(connection_set_list_type), pointer :: connection_set_list
1813) type(connection_set_type), pointer :: cur_connection_set
1814) PetscInt :: sum_connection, iconn
1815) PetscInt :: flow_src_sink_type
1816) PetscReal :: qsrc
1817)
1818) PetscReal :: coef_up(realization%option%nphase)
1819) PetscReal :: coef_dn(realization%option%nphase)
1820) PetscReal :: coef_in, coef_out
1821) PetscErrorCode :: ierr
1822)
1823) option => realization%option
1824) field => realization%field
1825) patch => realization%patch
1826) reaction => realization%reaction
1827) grid => patch%grid
1828) rt_parameter => patch%aux%RT%rt_parameter
1829) rt_auxvars => patch%aux%RT%auxvars
1830) rt_auxvars_bc => patch%aux%RT%auxvars_bc
1831) rt_auxvars_ss => patch%aux%RT%auxvars_ss
1832) global_auxvars => patch%aux%Global%auxvars
1833) global_auxvars_bc => patch%aux%Global%auxvars_bc
1834) global_auxvars_ss => patch%aux%Global%auxvars_ss
1835)
1836) ! Boundary Flux Terms -----------------------------------
1837) boundary_condition => patch%boundary_condition_list%first
1838) sum_connection = 0
1839) do
1840) if (.not.associated(boundary_condition)) exit
1841)
1842) cur_connection_set => boundary_condition%connection_set
1843)
1844) do iconn = 1, cur_connection_set%num_connections
1845) sum_connection = sum_connection + 1
1846)
1847) local_id = cur_connection_set%id_dn(iconn)
1848) ghosted_id = grid%nL2G(local_id)
1849)
1850) if (patch%imat(ghosted_id) <= 0) cycle
1851)
1852) ! TFluxCoef accomplishes the same as what TBCCoef would
1853) call TFluxCoef(option,cur_connection_set%area(iconn), &
1854) patch%boundary_velocities(:,sum_connection), &
1855) patch%boundary_tran_coefs(:,sum_connection), &
1856) 0.5d0, &
1857) coef_up,coef_dn)
1858) ! TFlux accomplishes the same as what TBCFlux would
1859) call TFlux(rt_parameter, &
1860) rt_auxvars_bc(sum_connection), &
1861) global_auxvars_bc(sum_connection), &
1862) rt_auxvars(ghosted_id), &
1863) global_auxvars(ghosted_id), &
1864) coef_up,coef_dn,option,Res)
1865)
1866) ! contribution to boundary
1867) rt_auxvars_bc(sum_connection)%mass_balance_delta(:,iphase) = &
1868) rt_auxvars_bc(sum_connection)%mass_balance_delta(:,iphase) - Res
1869) ! ! contribution to internal
1870) ! rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) = &
1871) ! rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) + Res
1872)
1873) enddo
1874) boundary_condition => boundary_condition%next
1875) enddo
1876)
1877) ! Source/sink terms -------------------------------------
1878) source_sink => patch%source_sink_list%first
1879) sum_connection = 0
1880) do
1881) if (.not.associated(source_sink)) exit
1882)
1883) cur_connection_set => source_sink%connection_set
1884)
1885) flow_src_sink_type = 0
1886) if (associated(source_sink%flow_condition) .and. &
1887) associated(source_sink%flow_condition%rate)) then
1888) qsrc = source_sink%flow_condition%rate%dataset%rarray(1)
1889) flow_src_sink_type = source_sink%flow_condition%rate%itype
1890) endif
1891)
1892) do iconn = 1, cur_connection_set%num_connections
1893) sum_connection = sum_connection + 1
1894) local_id = cur_connection_set%id_dn(iconn)
1895) ghosted_id = grid%nL2G(local_id)
1896)
1897) if (patch%imat(ghosted_id) <= 0) cycle
1898)
1899) qsrc = patch%ss_flow_vol_fluxes(1,sum_connection)
1900) call TSrcSinkCoef(option,qsrc,source_sink%tran_condition%itype, &
1901) coef_in,coef_out)
1902)
1903) Res = coef_in*rt_auxvars(ghosted_id)%total(:,iphase) + &
1904) coef_out*source_sink%tran_condition%cur_constraint_coupler% &
1905) rt_auxvar%total(:,iphase)
1906) if (option%compute_mass_balance_new) then
1907) ! contribution to boundary
1908) rt_auxvars_ss(sum_connection)%mass_balance_delta(:,iphase) = &
1909) rt_auxvars_ss(sum_connection)%mass_balance_delta(:,iphase) + Res
1910) ! contribution to internal
1911) ! rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) = &
1912) ! rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) - Res
1913) endif
1914) enddo
1915) source_sink => source_sink%next
1916) enddo
1917)
1918) end subroutine RTComputeBCMassBalanceOS
1919)
1920) ! ************************************************************************** !
1921)
1922) subroutine RTNumericalJacobianTest(realization)
1923) !
1924) ! Computes the a test numerical jacobian
1925) !
1926) ! Author: Glenn Hammond
1927) ! Date: 02/20/08
1928) !
1929)
1930) use Realization_Subsurface_class
1931) use Patch_module
1932) use Option_module
1933) use Grid_module
1934) use Field_module
1935)
1936) implicit none
1937)
1938) Vec :: xx
1939) type(realization_subsurface_type) :: realization
1940)
1941) Vec :: xx_pert
1942) Vec :: res
1943) Vec :: res_pert
1944) Mat :: A
1945) PetscViewer :: viewer
1946) PetscErrorCode :: ierr
1947)
1948) PetscReal :: derivative, perturbation
1949)
1950) PetscReal, pointer :: vec_p(:), vec2_p(:)
1951)
1952) type(grid_type), pointer :: grid
1953) type(option_type), pointer :: option
1954) type(field_type), pointer :: field
1955) type(patch_type), pointer :: patch
1956)
1957) PetscInt :: idof, idof2, icell
1958)
1959) option => realization%option
1960) field => realization%field
1961) patch => realization%patch
1962) grid => patch%grid
1963)
1964) call VecDuplicate(field%tran_xx,xx_pert,ierr);CHKERRQ(ierr)
1965) call VecDuplicate(field%tran_xx,res,ierr);CHKERRQ(ierr)
1966) call VecDuplicate(field%tran_xx,res_pert,ierr);CHKERRQ(ierr)
1967)
1968) call MatCreate(option%mycomm,A,ierr);CHKERRQ(ierr)
1969) call MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE, &
1970) grid%nlmax*option%ntrandof, &
1971) grid%nlmax*option%ntrandof,ierr);CHKERRQ(ierr)
1972) call MatSetType(A,MATAIJ,ierr);CHKERRQ(ierr)
1973) call MatSetFromOptions(A,ierr);CHKERRQ(ierr)
1974)
1975) call RTResidual(PETSC_NULL_OBJECT,field%tran_xx,res,realization,ierr)
1976) call VecGetArrayF90(res,vec2_p,ierr);CHKERRQ(ierr)
1977) do idof = 1,grid%nlmax*option%ntrandof
1978) icell = (idof-1)/option%ntrandof+1
1979) if (patch%imat(grid%nL2G(icell)) <= 0) cycle
1980) call VecCopy(field%tran_xx,xx_pert,ierr);CHKERRQ(ierr)
1981) call VecGetArrayF90(xx_pert,vec_p,ierr);CHKERRQ(ierr)
1982) perturbation = vec_p(idof)*perturbation_tolerance
1983) vec_p(idof) = vec_p(idof)+perturbation
1984) call vecrestorearrayf90(xx_pert,vec_p,ierr);CHKERRQ(ierr)
1985) call RTResidual(PETSC_NULL_OBJECT,xx_pert,res_pert,realization,ierr)
1986) call vecgetarrayf90(res_pert,vec_p,ierr);CHKERRQ(ierr)
1987) do idof2 = 1, grid%nlmax*option%ntrandof
1988) derivative = (vec_p(idof2)-vec2_p(idof2))/perturbation
1989) if (dabs(derivative) > 1.d-30) then
1990) call matsetvalue(a,idof2-1,idof-1,derivative,insert_values, &
1991) ierr);CHKERRQ(ierr)
1992) endif
1993) enddo
1994) call VecRestoreArrayF90(res_pert,vec_p,ierr);CHKERRQ(ierr)
1995) enddo
1996) call VecRestoreArrayF90(res,vec2_p,ierr);CHKERRQ(ierr)
1997)
1998) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
1999) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2000) call PetscViewerASCIIOpen(option%mycomm,'RTnumerical_jacobian.out',viewer, &
2001) ierr);CHKERRQ(ierr)
2002) call MatView(A,viewer,ierr);CHKERRQ(ierr)
2003) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2004)
2005) call MatDestroy(A,ierr);CHKERRQ(ierr)
2006)
2007) call VecDestroy(xx_pert,ierr);CHKERRQ(ierr)
2008) call VecDestroy(res,ierr);CHKERRQ(ierr)
2009) call VecDestroy(res_pert,ierr);CHKERRQ(ierr)
2010)
2011) end subroutine RTNumericalJacobianTest
2012)
2013) ! ************************************************************************** !
2014)
2015) subroutine RTResidual(snes,xx,r,realization,ierr)
2016) !
2017) ! Computes the residual equation
2018) !
2019) ! Author: Glenn Hammond
2020) ! Date: 12/10/07
2021) !
2022)
2023) use Realization_Subsurface_class
2024) use Field_module
2025) use Patch_module
2026) use Discretization_module
2027) use Option_module
2028) use Grid_module
2029) use Logging_module
2030) use Debug_module
2031)
2032) implicit none
2033)
2034) SNES :: snes
2035) Vec :: xx
2036) Vec :: r
2037) type(realization_subsurface_type) :: realization
2038) PetscReal, pointer :: xx_p(:), log_xx_p(:)
2039) PetscErrorCode :: ierr
2040)
2041) type(discretization_type), pointer :: discretization
2042) type(field_type), pointer :: field
2043) type(patch_type), pointer :: patch
2044) type(option_type), pointer :: option
2045) PetscViewer :: viewer
2046)
2047) character(len=MAXSTRINGLENGTH) :: string
2048)
2049) call PetscLogEventBegin(logging%event_rt_residual,ierr);CHKERRQ(ierr)
2050)
2051) patch => realization%patch
2052) field => realization%field
2053) discretization => realization%discretization
2054) option => realization%option
2055)
2056) ! Communication -----------------------------------------
2057) if (realization%reaction%use_log_formulation) then
2058) ! have to convert the log concentration to non-log form
2059) call VecGetArrayF90(field%tran_xx,xx_p,ierr);CHKERRQ(ierr)
2060) call VecGetArrayReadF90(xx,log_xx_p,ierr);CHKERRQ(ierr)
2061) xx_p(:) = exp(log_xx_p(:))
2062) call VecRestoreArrayF90(field%tran_xx,xx_p,ierr);CHKERRQ(ierr)
2063) call VecRestoreArrayReadF90(xx,log_xx_p,ierr);CHKERRQ(ierr)
2064) call DiscretizationGlobalToLocal(discretization,field%tran_xx, &
2065) field%tran_xx_loc,NTRANDOF)
2066) else
2067) call DiscretizationGlobalToLocal(discretization,xx,field%tran_xx_loc, &
2068) NTRANDOF)
2069) endif
2070)
2071) ! pass #1 for internal and boundary flux terms
2072) call RTResidualFlux(snes,xx,r,realization,ierr)
2073)
2074) ! pass #2 for everything else
2075) call RTResidualNonFlux(snes,xx,r,realization,ierr)
2076)
2077) !#if 0
2078) select case(realization%option%iflowmode)
2079) case(MPH_MODE,FLASH2_MODE,IMS_MODE)
2080) call RTResidualEquilibrateCO2(r,realization)
2081) end select
2082) !#endif
2083)
2084) if (realization%debug%vecview_residual) then
2085) string = 'RTresidual'
2086) call DebugCreateViewer(realization%debug,string,option,viewer)
2087) call VecView(r,viewer,ierr);CHKERRQ(ierr)
2088) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2089) endif
2090) if (realization%debug%vecview_solution) then
2091) string = 'RTxx'
2092) call DebugCreateViewer(realization%debug,string,option,viewer)
2093) call VecView(field%tran_xx,viewer,ierr);CHKERRQ(ierr)
2094) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2095) endif
2096)
2097) call PetscLogEventEnd(logging%event_rt_residual,ierr);CHKERRQ(ierr)
2098)
2099) end subroutine RTResidual
2100)
2101) ! ************************************************************************** !
2102)
2103) subroutine RTResidualFlux(snes,xx,r,realization,ierr)
2104) !
2105) ! Computes the flux terms in the residual function for
2106) ! reactive transport
2107) !
2108) ! Author: Glenn Hammond
2109) ! Date: 02/14/08
2110) !
2111)
2112) use Realization_Subsurface_class
2113) use Patch_module
2114) use Transport_module
2115) use Option_module
2116) use Field_module
2117) use Grid_module
2118) use Connection_module
2119) use Coupler_module
2120) use Debug_module
2121) use Secondary_Continuum_Aux_module
2122)
2123) implicit none
2124)
2125) type :: flux_ptrs
2126) PetscReal, dimension(:), pointer :: flux_p
2127) end type
2128)
2129) type (flux_ptrs), dimension(0:2) :: fluxes
2130) SNES, intent(in) :: snes
2131) Vec, intent(inout) :: xx
2132) Vec, intent(out) :: r
2133) type(realization_subsurface_type) :: realization
2134) PetscErrorCode :: ierr
2135)
2136) PetscReal, pointer :: r_p(:)
2137) PetscInt :: local_id, ghosted_id
2138) PetscInt, parameter :: iphase = 1
2139) PetscInt :: i, istart, iend
2140) type(grid_type), pointer :: grid
2141) type(option_type), pointer :: option
2142) type(field_type), pointer :: field
2143) type(patch_type), pointer :: patch
2144) type(reaction_type), pointer :: reaction
2145) type(reactive_transport_param_type), pointer :: rt_parameter
2146) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:), rt_auxvars_bc(:)
2147) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
2148)
2149) PetscReal, pointer :: face_fluxes_p(:)
2150)
2151) type(coupler_type), pointer :: boundary_condition
2152) type(connection_set_list_type), pointer :: connection_set_list
2153) type(connection_set_type), pointer :: cur_connection_set
2154) PetscInt :: sum_connection, iconn
2155) PetscInt :: ghosted_id_up, ghosted_id_dn, local_id_up, local_id_dn
2156) PetscReal :: fraction_upwind, distance, dist_up, dist_dn
2157) PetscInt :: axis, side, nlx, nly, nlz, ngx, ngxy, pstart, pend, flux_id
2158) PetscInt :: direction, max_x_conn, max_y_conn
2159)
2160) type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
2161) PetscReal :: vol_frac_prim
2162)
2163) #ifdef CENTRAL_DIFFERENCE
2164) PetscReal :: T_11(realization%option%nphase)
2165) PetscReal :: T_12(realization%option%nphase)
2166) PetscReal :: T_21(realization%option%nphase)
2167) PetscReal :: T_22(realization%option%nphase)
2168) PetscReal :: Res_1(realization%reaction%ncomp)
2169) PetscReal :: Res_2(realization%reaction%ncomp)
2170) #else
2171) PetscReal :: coef_up(realization%option%nphase)
2172) PetscReal :: coef_dn(realization%option%nphase)
2173) PetscReal :: Res(realization%reaction%ncomp)
2174) #endif
2175)
2176) ! CO2-specific
2177) PetscReal :: msrc(1:realization%option%nflowspec)
2178) PetscInt :: icomp, ieqgas
2179)
2180) option => realization%option
2181) field => realization%field
2182) patch => realization%patch
2183) reaction => realization%reaction
2184) grid => patch%grid
2185) rt_parameter => patch%aux%RT%rt_parameter
2186) rt_auxvars => patch%aux%RT%auxvars
2187) rt_auxvars_bc => patch%aux%RT%auxvars_bc
2188) global_auxvars => patch%aux%Global%auxvars
2189) global_auxvars_bc => patch%aux%Global%auxvars_bc
2190) if (option%use_mc) then
2191) rt_sec_transport_vars => patch%aux%SC_RT%sec_transport_vars
2192) endif
2193)
2194)
2195) if (.not.patch%aux%RT%auxvars_up_to_date) then
2196) if (reaction%act_coef_update_frequency == ACT_COEF_FREQUENCY_NEWTON_ITER) then
2197) ! update: cells bcs act. coefs.
2198) call RTUpdateAuxVars(realization,PETSC_TRUE,PETSC_TRUE,PETSC_TRUE)
2199) else
2200) ! update: cells bcs act. coefs.
2201) call RTUpdateAuxVars(realization,PETSC_TRUE,PETSC_TRUE,PETSC_FALSE)
2202) endif
2203) endif
2204) patch%aux%RT%auxvars_up_to_date = PETSC_FALSE
2205)
2206) if (option%compute_mass_balance_new) then
2207) call RTZeroMassBalanceDelta(realization)
2208) endif
2209)
2210) ! Get pointer to Vector data
2211) call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
2212)
2213) r_p = 0.d0
2214) vol_frac_prim = 1.d0
2215)
2216) ! Interior Flux Terms -----------------------------------
2217) connection_set_list => grid%internal_connection_set_list
2218) cur_connection_set => connection_set_list%first
2219) sum_connection = 0
2220) do
2221) if (.not.associated(cur_connection_set)) exit
2222) do iconn = 1, cur_connection_set%num_connections
2223) sum_connection = sum_connection + 1
2224)
2225) ghosted_id_up = cur_connection_set%id_up(iconn)
2226) ghosted_id_dn = cur_connection_set%id_dn(iconn)
2227)
2228) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
2229) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
2230)
2231) if (patch%imat(ghosted_id_up) <= 0 .or. &
2232) patch%imat(ghosted_id_dn) <= 0) cycle
2233)
2234) ! TFluxCoef will eventually be moved to another routine where it should be
2235) ! called only once per flux interface at the beginning of a transport
2236) ! time step.
2237)
2238) if (option%use_mc) then
2239) vol_frac_prim = rt_sec_transport_vars(local_id_up)%epsilon
2240) endif
2241)
2242)
2243) #ifndef CENTRAL_DIFFERENCE
2244) call TFluxCoef(option,cur_connection_set%area(iconn), &
2245) patch%internal_velocities(:,sum_connection), &
2246) patch%internal_tran_coefs(:,sum_connection)*vol_frac_prim, &
2247) cur_connection_set%dist(-1,iconn), &
2248) coef_up,coef_dn)
2249)
2250) call TFlux(rt_parameter, &
2251) rt_auxvars(ghosted_id_up), &
2252) global_auxvars(ghosted_id_up), &
2253) rt_auxvars(ghosted_id_dn), &
2254) global_auxvars(ghosted_id_dn), &
2255) coef_up,coef_dn,option,Res)
2256)
2257)
2258)
2259) #ifdef COMPUTE_INTERNAL_MASS_FLUX
2260) rt_auxvars(local_id_up)%mass_balance_delta(:,iphase) = &
2261) rt_auxvars(local_id_up)%mass_balance_delta(:,iphase) - Res
2262) #endif
2263)
2264) if (local_id_up>0) then
2265) iend = local_id_up*reaction%ncomp
2266) istart = iend-reaction%ncomp+1
2267) r_p(istart:iend) = r_p(istart:iend) + Res(1:reaction%ncomp)
2268) endif
2269)
2270) if (local_id_dn>0) then
2271) iend = local_id_dn*reaction%ncomp
2272) istart = iend-reaction%ncomp+1
2273) r_p(istart:iend) = r_p(istart:iend) - Res(1:reaction%ncomp)
2274) endif
2275) #else
2276) call TFluxCoef_CD(option,cur_connection_set%area(iconn), &
2277) patch%internal_velocities(:,sum_connection), &
2278) patch%internal_tran_coefs(:,sum_connection)*vol_frac_prim, &
2279) cur_connection_set%dist(-1,iconn), &
2280) T_11,T_12,T_21,T_22)
2281) call TFlux_CD(rt_parameter, &
2282) rt_auxvars(ghosted_id_up), &
2283) global_auxvars(ghosted_id_up), &
2284) rt_auxvars(ghosted_id_dn), &
2285) global_auxvars(ghosted_id_dn), &
2286) T_11,T_12,T_21,T_22,option,Res_1,Res_2)
2287)
2288) if (local_id_up>0) then
2289) iend = local_id_up*reaction%ncomp
2290) istart = iend-reaction%ncomp+1
2291) r_p(istart:iend) = r_p(istart:iend) + Res_1(1:reaction%ncomp)
2292) endif
2293)
2294) if (local_id_dn>0) then
2295) iend = local_id_dn*reaction%ncomp
2296) istart = iend-reaction%ncomp+1
2297) r_p(istart:iend) = r_p(istart:iend) + Res_2(1:reaction%ncomp)
2298) endif
2299) #endif
2300) if (associated(patch%internal_tran_fluxes)) then
2301) patch%internal_tran_fluxes(1:reaction%ncomp,iconn) = &
2302) Res(1:reaction%ncomp)
2303) endif
2304) enddo
2305) cur_connection_set => cur_connection_set%next
2306) enddo
2307)
2308) ! Boundary Flux Terms -----------------------------------
2309) boundary_condition => patch%boundary_condition_list%first
2310) sum_connection = 0
2311) do
2312) if (.not.associated(boundary_condition)) exit
2313)
2314) cur_connection_set => boundary_condition%connection_set
2315)
2316) do iconn = 1, cur_connection_set%num_connections
2317) sum_connection = sum_connection + 1
2318)
2319) local_id = cur_connection_set%id_dn(iconn)
2320) ghosted_id = grid%nL2G(local_id)
2321)
2322) if (patch%imat(ghosted_id) <= 0) cycle
2323)
2324) if (option%use_mc) then
2325) vol_frac_prim = rt_sec_transport_vars(local_id)%epsilon
2326) endif
2327)
2328) #ifndef CENTRAL_DIFFERENCE
2329) ! TFluxCoef accomplishes the same as what TBCCoef would
2330) call TFluxCoef(option,cur_connection_set%area(iconn), &
2331) patch%boundary_velocities(:,sum_connection), &
2332) patch%boundary_tran_coefs(:,sum_connection)*vol_frac_prim, &
2333) 0.5d0, &
2334) coef_up,coef_dn)
2335) ! TFlux accomplishes the same as what TBCFlux would
2336) call TFlux(rt_parameter, &
2337) rt_auxvars_bc(sum_connection), &
2338) global_auxvars_bc(sum_connection), &
2339) rt_auxvars(ghosted_id), &
2340) global_auxvars(ghosted_id), &
2341) coef_up,coef_dn,option,Res)
2342)
2343) iend = local_id*reaction%ncomp
2344) istart = iend-reaction%ncomp+1
2345) r_p(istart:iend)= r_p(istart:iend) - Res(1:reaction%ncomp)
2346)
2347) if (option%compute_mass_balance_new) then
2348) ! contribution to boundary
2349) rt_auxvars_bc(sum_connection)%mass_balance_delta(:,iphase) = &
2350) rt_auxvars_bc(sum_connection)%mass_balance_delta(:,iphase) - Res
2351) ! ! contribution to internal
2352) ! rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) = &
2353) ! rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) + Res
2354) endif
2355)
2356) #else
2357) call TFluxCoef_CD(option,cur_connection_set%area(iconn), &
2358) patch%boundary_velocities(:,sum_connection), &
2359) patch%boundary_tran_coefs(:,sum_connection)*vol_frac_prim, &
2360) 0.5d0, & ! fraction upwind (0.d0 upwind, 0.5 central)
2361) T_11,T_12,T_21,T_22)
2362) call TFlux_CD(rt_parameter, &
2363) rt_auxvars_bc(sum_connection), &
2364) global_auxvars_bc(sum_connection), &
2365) rt_auxvars(ghosted_id), &
2366) global_auxvars(ghosted_id), &
2367) T_11,T_12,T_21,T_22,option,Res_1,Res_2)
2368)
2369) iend = local_id*reaction%ncomp
2370) istart = iend-reaction%ncomp+1
2371) r_p(istart:iend)= r_p(istart:iend) + Res_2(1:reaction%ncomp)
2372)
2373) if (option%compute_mass_balance_new) then
2374) ! contribution to boundary
2375) rt_auxvars_bc(sum_connection)%mass_balance_delta(:,iphase) = &
2376) rt_auxvars_bc(sum_connection)%mass_balance_delta(:,iphase) - Res_2
2377) ! ! contribution to internal
2378) ! rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) = &
2379) ! rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) + Res
2380) endif
2381)
2382) #endif
2383) if (associated(patch%boundary_tran_fluxes)) then
2384) patch%boundary_tran_fluxes(1:reaction%ncomp,sum_connection) = &
2385) -Res(1:reaction%ncomp)
2386) endif
2387) enddo
2388) boundary_condition => boundary_condition%next
2389) enddo
2390)
2391) ! Restore vectors
2392) call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
2393)
2394) end subroutine RTResidualFlux
2395)
2396) ! ************************************************************************** !
2397)
2398) subroutine RTResidualNonFlux(snes,xx,r,realization,ierr)
2399) !
2400) ! Computes the non-flux terms in the residual function for
2401) ! reactive transport
2402) !
2403) ! Author: Glenn Hammond
2404) ! Date: 02/14/08
2405) !
2406)
2407) use Realization_Subsurface_class
2408) use Patch_module
2409) use Transport_module
2410) use Option_module
2411) use Field_module
2412) use Grid_module
2413) use Connection_module
2414) use Coupler_module
2415) use Debug_module
2416) use Logging_module
2417) !geh: please leave the "only" clauses for Secondary_Continuum_XXX as this
2418) ! resolves a bug in the Intel Visual Fortran compiler.
2419) use Secondary_Continuum_Aux_module, only : sec_transport_type
2420) use Secondary_Continuum_module, only : SecondaryRTResJacMulti
2421)
2422) implicit none
2423)
2424) SNES, intent(in) :: snes
2425) Vec, intent(inout) :: xx
2426) Vec, intent(out) :: r
2427) type(realization_subsurface_type) :: realization
2428) PetscErrorCode :: ierr
2429)
2430) PetscReal, pointer :: r_p(:), accum_p(:), vec_p(:)
2431) PetscInt :: local_id, ghosted_id
2432) PetscInt, parameter :: iphase = 1
2433) PetscInt :: i
2434) PetscInt :: istartaq, iendaq
2435) PetscInt :: istartcoll, iendcoll
2436) PetscInt :: istartall, iendall
2437) PetscInt :: idof
2438) PetscInt :: offset
2439) type(grid_type), pointer :: grid
2440) type(option_type), pointer :: option
2441) type(field_type), pointer :: field
2442) type(patch_type), pointer :: patch
2443) type(reaction_type), pointer :: reaction
2444) type(reactive_transport_param_type), pointer :: rt_parameter
2445) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
2446) type(reactive_transport_auxvar_type), pointer :: rt_auxvars_ss(:)
2447) type(global_auxvar_type), pointer :: global_auxvars(:)
2448) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
2449) class(material_auxvar_type), pointer :: material_auxvars(:)
2450) PetscReal :: Res(realization%reaction%ncomp)
2451)
2452) type(coupler_type), pointer :: source_sink
2453) type(connection_set_type), pointer :: cur_connection_set
2454) PetscInt :: iconn
2455) PetscReal :: qsrc, molality
2456) PetscInt :: flow_src_sink_type
2457) PetscReal :: scale, coef_in, coef_out
2458) PetscReal :: Jup(realization%reaction%ncomp,realization%reaction%ncomp)
2459) PetscBool :: volumetric
2460) PetscInt :: sum_connection
2461)
2462) ! CO2-specific
2463) PetscReal :: msrc(1:realization%option%nflowspec)
2464) PetscInt :: icomp, ieqgas
2465)
2466) type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
2467) PetscReal :: vol_frac_prim
2468) PetscReal :: sec_diffusion_coefficient
2469) PetscReal :: sec_porosity
2470) PetscReal :: res_sec_transport(realization%reaction%ncomp)
2471)
2472) option => realization%option
2473) field => realization%field
2474) patch => realization%patch
2475) reaction => realization%reaction
2476) grid => patch%grid
2477) rt_parameter => patch%aux%RT%rt_parameter
2478) rt_auxvars => patch%aux%RT%auxvars
2479) rt_auxvars_ss => patch%aux%RT%auxvars_ss
2480) global_auxvars => patch%aux%Global%auxvars
2481) global_auxvars_ss => patch%aux%Global%auxvars_ss
2482) material_auxvars => patch%aux%Material%auxvars
2483) if (option%use_mc) then
2484) rt_sec_transport_vars => patch%aux%SC_RT%sec_transport_vars
2485) endif
2486)
2487) ! Get pointer to Vector data
2488) call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
2489) call VecGetArrayReadF90(field%tran_accum, accum_p, ierr);CHKERRQ(ierr)
2490)
2491) vol_frac_prim = 1.d0
2492)
2493) if (.not.option%steady_state) then
2494) r_p = r_p - accum_p
2495) #if 1
2496) ! Accumulation terms ------------------------------------
2497) do local_id = 1, grid%nlmax ! For each local node do...
2498) ghosted_id = grid%nL2G(local_id)
2499) !geh - Ignore inactive cells with inactive materials
2500) if (patch%imat(ghosted_id) <= 0) cycle
2501)
2502) offset = (local_id-1)*reaction%ncomp
2503) istartall = offset + 1
2504) iendall = offset + reaction%ncomp
2505)
2506) call RTAccumulation(rt_auxvars(ghosted_id), &
2507) global_auxvars(ghosted_id), &
2508) material_auxvars(ghosted_id), &
2509) reaction,option,Res)
2510) if (reaction%neqsorb > 0) then
2511) call RAccumulationSorb(rt_auxvars(ghosted_id), &
2512) global_auxvars(ghosted_id), &
2513) material_auxvars(ghosted_id), &
2514) reaction,option,Res)
2515) endif
2516)
2517) if (option%use_mc) then
2518) vol_frac_prim = rt_sec_transport_vars(local_id)%epsilon
2519) Res = Res*vol_frac_prim
2520) endif
2521)
2522) r_p(istartall:iendall) = r_p(istartall:iendall) + Res(1:reaction%ncomp)
2523)
2524) ! Secondary continuum formation not implemented for Age equation
2525) if (reaction%calculate_water_age) then
2526) call RAge(rt_auxvars(ghosted_id),global_auxvars(ghosted_id), &
2527) material_auxvars(ghosted_id),option,reaction,Res)
2528) r_p(istartall:iendall) = r_p(istartall:iendall) + Res(1:reaction%ncomp)
2529) endif
2530) if (reaction%calculate_tracer_age) then
2531) call RAge(rt_auxvars(ghosted_id),global_auxvars(ghosted_id), &
2532) material_auxvars(ghosted_id),option,reaction,Res)
2533) r_p(istartall:iendall) = r_p(istartall:iendall) + Res(1:reaction%ncomp)
2534) endif
2535) enddo
2536) endif
2537) #endif
2538) #if 1
2539)
2540) ! ========== Secondary continuum transport source terms -- MULTICOMPONENT ======
2541) if (option%use_mc) then
2542) ! Secondary continuum contribution (SK 1/31/2013)
2543) ! only one secondary continuum for now for each primary continuum node
2544) do local_id = 1, grid%nlmax ! For each local node do...
2545) ghosted_id = grid%nL2G(local_id)
2546) if (patch%imat(ghosted_id) <= 0) cycle
2547)
2548) offset = (local_id-1)*reaction%ncomp
2549) istartall = offset + 1
2550) iendall = offset + reaction%ncomp
2551)
2552) sec_diffusion_coefficient = patch% &
2553) material_property_array(1)%ptr% &
2554) secondary_continuum_diff_coeff
2555) sec_porosity = patch%material_property_array(1)%ptr% &
2556) secondary_continuum_porosity
2557)
2558) call SecondaryRTResJacMulti(rt_sec_transport_vars(local_id), &
2559) rt_auxvars(ghosted_id), &
2560) global_auxvars(ghosted_id), &
2561) material_auxvars(ghosted_id)%volume, &
2562) reaction, &
2563) sec_diffusion_coefficient, &
2564) sec_porosity, &
2565) option,res_sec_transport)
2566)
2567) r_p(istartall:iendall) = r_p(istartall:iendall) - &
2568) res_sec_transport(1:reaction%ncomp) ! in mol/s
2569)
2570) enddo
2571) endif
2572) ! ============== end secondary continuum coupling terms ========================
2573)
2574) ! Source/sink terms -------------------------------------
2575) source_sink => patch%source_sink_list%first
2576) sum_connection = 0
2577) do
2578) if (.not.associated(source_sink)) exit
2579)
2580) cur_connection_set => source_sink%connection_set
2581)
2582) do iconn = 1, cur_connection_set%num_connections
2583) sum_connection = sum_connection + 1
2584) local_id = cur_connection_set%id_dn(iconn)
2585) ghosted_id = grid%nL2G(local_id)
2586)
2587) offset = (local_id-1)*reaction%ncomp
2588)
2589) if (patch%imat(ghosted_id) <= 0) cycle
2590)
2591) istartaq = reaction%offset_aqueous + 1
2592) iendaq = reaction%offset_aqueous + reaction%naqcomp
2593)
2594) if (reaction%ncoll > 0) then
2595) istartcoll = reaction%offset_colloid + 1
2596) iendcoll = reaction%offset_colloid + reaction%ncoll
2597) endif
2598)
2599) qsrc = patch%ss_flow_vol_fluxes(1,sum_connection)
2600) call TSrcSinkCoef(option,qsrc,source_sink%tran_condition%itype, &
2601) coef_in,coef_out)
2602)
2603) Res = 0.d0
2604) Res(istartaq:iendaq) = coef_in*rt_auxvars(ghosted_id)%total(:,iphase) + &
2605) coef_out*source_sink%tran_condition%cur_constraint_coupler% &
2606) rt_auxvar%total(:,iphase)
2607)
2608) if (reaction%ncoll > 0) then
2609) Res(istartcoll:iendcoll) = coef_in*rt_auxvars(ghosted_id)%colloid%conc_mob(:) + &
2610) coef_out*source_sink%tran_condition%cur_constraint_coupler% &
2611) rt_auxvar%colloid%conc_mob(:)
2612) endif
2613) istartall = offset + 1
2614) iendall = offset + reaction%ncomp
2615) r_p(istartall:iendall) = r_p(istartall:iendall) + Res(1:reaction%ncomp)
2616) if (associated(patch%ss_tran_fluxes)) then
2617) patch%ss_tran_fluxes(:,sum_connection) = Res(:)
2618) endif
2619) if (option%compute_mass_balance_new) then
2620) ! contribution to boundary
2621) rt_auxvars_ss(sum_connection)%mass_balance_delta(:,iphase) = &
2622) rt_auxvars_ss(sum_connection)%mass_balance_delta(:,iphase) + Res
2623) ! contribution to internal
2624) ! rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) = &
2625) ! rt_auxvars(ghosted_id)%mass_balance_delta(:,iphase) - Res
2626) endif
2627) enddo
2628) source_sink => source_sink%next
2629) enddo
2630)
2631) ! CO2-specific
2632) select case(option%iflowmode)
2633) case(MPH_MODE,IMS_MODE,FLASH2_MODE)
2634) source_sink => patch%source_sink_list%first
2635) do
2636) if (.not.associated(source_sink)) exit
2637)
2638) select case(source_sink%flow_condition%itype(1))
2639) case(MASS_RATE_SS)
2640) msrc(:) = source_sink%flow_condition%rate%dataset%rarray(:)
2641) case default
2642) msrc(:) = 0.d0
2643) end select
2644)
2645) msrc(1) = msrc(1) / FMWH2O*1D3
2646) msrc(2) = msrc(2) / FMWCO2*1D3
2647) ! print *,'RT SC source'
2648) do iconn = 1, cur_connection_set%num_connections
2649) local_id = cur_connection_set%id_dn(iconn)
2650) ghosted_id = grid%nL2G(local_id)
2651) Res=0D0
2652)
2653) if (patch%imat(ghosted_id) <= 0) cycle
2654)
2655) select case(source_sink%flow_condition%itype(1))
2656) case(MASS_RATE_SS)
2657) do ieqgas = 1, reaction%ngas
2658) if (abs(reaction%species_idx%co2_gas_id) == ieqgas) then
2659) icomp = reaction%eqgasspecid(1,ieqgas)
2660) iendall = local_id*reaction%ncomp
2661) istartall = iendall-reaction%ncomp
2662) Res(icomp) = -msrc(2)
2663) r_p(istartall+icomp) = r_p(istartall+icomp) + Res(icomp)
2664) ! print *,'RT SC source', ieqgas,icomp, res(icomp)
2665) endif
2666) enddo
2667) end select
2668) enddo
2669) source_sink => source_sink%next
2670) enddo
2671) end select
2672) #endif
2673)
2674) #if 1
2675) ! Reactions
2676) if (associated(reaction)) then
2677)
2678) call PetscLogEventBegin(logging%event_rt_res_reaction,ierr);CHKERRQ(ierr)
2679)
2680) do local_id = 1, grid%nlmax ! For each local node do...
2681) ghosted_id = grid%nL2G(local_id)
2682) !geh - Ignore inactive cells with inactive materials
2683) if (patch%imat(ghosted_id) <= 0) cycle
2684) offset = (local_id-1)*reaction%ncomp
2685) istartall = offset + 1
2686) iendall = offset + reaction%ncomp
2687) Res = 0.d0
2688) Jup = 0.d0
2689) if (.not.option%use_isothermal) then
2690) call RUpdateTempDependentCoefs(global_auxvars(ghosted_id),reaction, &
2691) PETSC_FALSE,option)
2692) endif
2693) call RReaction(Res,Jup,PETSC_FALSE,rt_auxvars(ghosted_id), &
2694) global_auxvars(ghosted_id), &
2695) material_auxvars(ghosted_id), &
2696) reaction,option)
2697) if (option%use_mc) then
2698) vol_frac_prim = rt_sec_transport_vars(local_id)%epsilon
2699) Res = Res*vol_frac_prim
2700) endif
2701) r_p(istartall:iendall) = r_p(istartall:iendall) + Res(1:reaction%ncomp)
2702)
2703) enddo
2704)
2705) call PetscLogEventEnd(logging%event_rt_res_reaction,ierr);CHKERRQ(ierr)
2706) endif
2707) #endif
2708)
2709) if (patch%aux%RT%inactive_cells_exist) then
2710) do i=1,patch%aux%RT%n_zero_rows
2711) r_p(patch%aux%RT%zero_rows_local(i)) = 0.d0
2712) enddo
2713) endif
2714)
2715) ! Restore vectors
2716) call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
2717) call VecRestoreArrayReadF90(field%tran_accum, accum_p, ierr);CHKERRQ(ierr)
2718)
2719) ! Mass Transfer
2720) if (field%tran_mass_transfer /= 0) then
2721) ! scale by -1.d0 for contribution to residual. A negative contribution
2722) ! indicates mass being added to system.
2723) call VecGetArrayF90(field%tran_mass_transfer,vec_p,ierr);CHKERRQ(ierr)
2724) call VecRestoreArrayF90(field%tran_mass_transfer,vec_p,ierr);CHKERRQ(ierr)
2725) call VecAXPY(r,-1.d0,field%tran_mass_transfer,ierr);CHKERRQ(ierr)
2726) endif
2727)
2728) end subroutine RTResidualNonFlux
2729)
2730) ! ************************************************************************** !
2731)
2732) subroutine RTResidualEquilibrateCO2(r,realization)
2733) !
2734) ! Adds CO2 saturation constraint to residual for
2735) ! reactive transport
2736) !
2737) ! Author: Glenn Hammond/Peter Lichtner
2738) ! Date: 12/12/14
2739) !
2740)
2741) use Realization_Subsurface_class
2742) use Patch_module
2743) use Option_module
2744) use Field_module
2745) use Grid_module
2746) use EOS_Water_module
2747)
2748) ! CO2-specific
2749) use co2eos_module, only: Henry_duan_sun
2750) use co2_span_wagner_module, only: co2_span_wagner
2751)
2752) implicit none
2753)
2754) Vec :: r
2755) type(realization_subsurface_type) :: realization
2756)
2757) PetscInt :: local_id, ghosted_id
2758) PetscInt :: jco2
2759) PetscReal :: tc, pg, henry, m_na, m_cl
2760) PetscReal :: Qkco2, mco2eq, xphi
2761) PetscReal :: eps = 1.d-6
2762)
2763) ! CO2-specific
2764) PetscReal :: dg,dddt,dddp,fg,dfgdp,dfgdt,eng,hg,dhdt,dhdp,visg,dvdt,dvdp,&
2765) yco2,sat_pressure,lngamco2
2766) PetscInt :: iflag
2767)
2768) type(grid_type), pointer :: grid
2769) type(option_type), pointer :: option
2770) type(field_type), pointer :: field
2771) type(patch_type), pointer :: patch
2772) type(reaction_type), pointer :: reaction
2773) PetscErrorCode :: ierr
2774)
2775) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
2776) type(global_auxvar_type), pointer :: global_auxvars(:)
2777) PetscReal, pointer :: r_p(:)
2778)
2779) option => realization%option
2780) field => realization%field
2781) patch => realization%patch
2782) reaction => realization%reaction
2783) grid => patch%grid
2784) rt_auxvars => patch%aux%RT%auxvars
2785) global_auxvars => patch%aux%Global%auxvars
2786)
2787) ! Get pointer to Vector data
2788) call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
2789)
2790) do local_id = 1, grid%nlmax ! For each local node do...
2791) ghosted_id = grid%nL2G(local_id)
2792) if (patch%imat(ghosted_id) <= 0) cycle
2793) if (global_auxvars(ghosted_id)%sat(GAS_PHASE) > eps .and. &
2794) global_auxvars(ghosted_id)%sat(GAS_PHASE) < 1.d0-eps) then
2795)
2796) jco2 = reaction%species_idx%co2_aq_id
2797)
2798) tc = global_auxvars(ghosted_id)%temp
2799) pg = global_auxvars(ghosted_id)%pres(2)
2800) m_na = 0.d0
2801) m_cl = 0.d0
2802) if (reaction%species_idx%na_ion_id /= 0 .and. &
2803) reaction%species_idx%cl_ion_id /= 0) then
2804) m_na = rt_auxvars(ghosted_id)%pri_molal(reaction%species_idx%na_ion_id)
2805) m_cl = rt_auxvars(ghosted_id)%pri_molal(reaction%species_idx%cl_ion_id)
2806) call Henry_duan_sun(tc,pg*1D-5,henry,lngamco2,m_na,m_cl)
2807) else
2808) call Henry_duan_sun(tc,pg*1D-5,henry,lngamco2,option%m_nacl,option%m_nacl)
2809) endif
2810) ! call Henry_duan_sun(tc,pg*1.D-5,henry,lngamco2,m_na,m_cl)
2811)
2812) ! print *,'check_EOSeq: ',local_id,jco2,reaction%ncomp, &
2813) ! global_auxvars(ghosted_id)%sat(GAS_PHASE), &
2814) ! rt_auxvars(ghosted_id)%pri_molal(jco2), &
2815) ! global_auxvars(ghosted_id)%pres, &
2816) ! global_auxvars(ghosted_id)%temp, &
2817) ! r_p(jco2+(local_id-1)*reaction%ncomp)
2818)
2819) iflag = 1
2820) call co2_span_wagner(pg*1D-6,tc+273.15D0,dg,dddt,dddp,fg, &
2821) dfgdp,dfgdt,eng,hg,dhdt,dhdp,visg,dvdt,dvdp,iflag,option%itable)
2822)
2823) call EOSWaterSaturationPressure(tc, sat_pressure, ierr)
2824)
2825) yco2 = 1.d0-sat_pressure/pg
2826) xphi = fg*1.D6/pg/yco2
2827) Qkco2 = henry*xphi ! QkCO2 = xphi * exp(-mu0) / gamma
2828)
2829) ! sat_pressure = sat_pressure * 1.D5
2830) mco2eq = (pg - sat_pressure)*1.D-5 * Qkco2 ! molality CO2, y * P = P - Psat(T)
2831)
2832) r_p(jco2+(local_id-1)*reaction%ncomp) = &
2833) rt_auxvars(ghosted_id)%pri_molal(jco2) - mco2eq
2834)
2835) ! print *,'check_EOS', local_id,jco2,reaction%ncomp, mco2eq, &
2836) ! rt_auxvars(ghosted_id)%pri_molal(jco2), &
2837) ! sat_pressure, henry, &
2838) ! yco2, fg, xphi,r_p(jco2+(local_id-1)*reaction%ncomp)
2839) endif
2840) enddo
2841)
2842) ! Restore pointer to Vector data
2843) call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
2844)
2845) end subroutine RTResidualEquilibrateCO2
2846)
2847) ! ************************************************************************** !
2848)
2849) subroutine RTJacobian(snes,xx,A,B,realization,ierr)
2850) !
2851) ! Computes the Jacobian
2852) !
2853) ! Author: Glenn Hammond
2854) ! Date: 12/10/07
2855) !
2856)
2857) use Realization_Subsurface_class
2858) use Patch_module
2859) use Grid_module
2860) use Option_module
2861) use Field_module
2862) use Logging_module
2863) use Debug_module
2864)
2865) implicit none
2866)
2867) SNES :: snes
2868) Vec :: xx
2869) Mat :: A, B
2870) type(realization_subsurface_type) :: realization
2871) PetscErrorCode :: ierr
2872)
2873) Mat :: J
2874) MatType :: mat_type
2875) PetscViewer :: viewer
2876) type(grid_type), pointer :: grid
2877) character(len=MAXSTRINGLENGTH) :: string
2878)
2879) call PetscLogEventBegin(logging%event_rt_jacobian,ierr);CHKERRQ(ierr)
2880)
2881) #if 0
2882) call RTNumericalJacobianTest(realization)
2883) #endif
2884)
2885) call MatGetType(A,mat_type,ierr);CHKERRQ(ierr)
2886) if (mat_type == MATMFFD) then
2887) J = B
2888) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2889) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2890) else
2891) J = A
2892) endif
2893)
2894) call MatZeroEntries(J,ierr);CHKERRQ(ierr)
2895)
2896)
2897) call PetscLogEventBegin(logging%event_rt_jacobian1,ierr);CHKERRQ(ierr)
2898)
2899)
2900) ! pass #1 for internal and boundary flux terms
2901) call RTJacobianFlux(snes,xx,J,J,realization,ierr)
2902)
2903) call PetscLogEventEnd(logging%event_rt_jacobian1,ierr);CHKERRQ(ierr)
2904) call PetscLogEventBegin(logging%event_rt_jacobian2,ierr);CHKERRQ(ierr)
2905)
2906) ! pass #2 for everything else
2907) call RTJacobianNonFlux(snes,xx,J,J,realization,ierr)
2908)
2909) !#if 0
2910) select case(realization%option%iflowmode)
2911) case(MPH_MODE,FLASH2_MODE,IMS_MODE)
2912) call RTJacobianEquilibrateCO2(J,realization)
2913) end select
2914) !#endif
2915)
2916) call PetscLogEventEnd(logging%event_rt_jacobian2,ierr);CHKERRQ(ierr)
2917)
2918) if (realization%debug%matview_Jacobian) then
2919) string = 'RTjacobian'
2920) call DebugCreateViewer(realization%debug,string,realization%option,viewer)
2921) call MatView(J,viewer,ierr);CHKERRQ(ierr)
2922) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2923) endif
2924)
2925) if (realization%reaction%use_log_formulation) then
2926) call MatDiagonalScaleLocal(J,realization%field%tran_work_loc, &
2927) ierr);CHKERRQ(ierr)
2928)
2929) if (realization%debug%matview_Jacobian) then
2930) string = 'RTjacobianLog'
2931) call DebugCreateViewer(realization%debug,string,realization%option,viewer)
2932) call MatView(J,viewer,ierr);CHKERRQ(ierr)
2933) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2934) endif
2935)
2936) endif
2937)
2938) call PetscLogEventEnd(logging%event_rt_jacobian,ierr);CHKERRQ(ierr)
2939)
2940) end subroutine RTJacobian
2941)
2942) ! ************************************************************************** !
2943)
2944) subroutine RTJacobianFlux(snes,xx,A,B,realization,ierr)
2945) !
2946) ! Computes the flux term entries in the Jacobian for
2947) ! reactive transport
2948) !
2949) ! Author: Glenn Hammond
2950) ! Date: 02/14/08
2951) !
2952)
2953) use Realization_Subsurface_class
2954) use Patch_module
2955) use Transport_module
2956) use Option_module
2957) use Field_module
2958) use Grid_module
2959) use Connection_module
2960) use Coupler_module
2961) use Debug_module
2962) use Logging_module
2963) use Secondary_Continuum_Aux_module
2964)
2965) implicit none
2966)
2967) SNES :: snes
2968) Vec :: xx
2969) Mat :: A, B
2970) type(realization_subsurface_type) :: realization
2971) PetscErrorCode :: ierr
2972)
2973) PetscReal, pointer :: r_p(:)
2974) PetscInt :: local_id, ghosted_id
2975) PetscInt :: istart, iend
2976) type(grid_type), pointer :: grid
2977) type(option_type), pointer :: option
2978) type(field_type), pointer :: field
2979) type(patch_type), pointer :: patch
2980) type(reactive_transport_param_type), pointer :: rt_parameter
2981) type(reaction_type), pointer :: reaction
2982)
2983) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:), rt_auxvars_bc(:)
2984) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
2985)
2986) type(coupler_type), pointer :: boundary_condition
2987) type(connection_set_list_type), pointer :: connection_set_list
2988) type(connection_set_type), pointer :: cur_connection_set
2989) PetscInt :: sum_connection, iconn
2990) PetscInt :: ghosted_id_up, ghosted_id_dn, local_id_up, local_id_dn
2991) PetscReal :: fraction_upwind, distance, dist_up, dist_dn, rdum
2992)
2993) type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
2994) PetscReal :: vol_frac_prim
2995)
2996) #ifdef CENTRAL_DIFFERENCE
2997) PetscReal :: T_11(realization%option%nphase)
2998) PetscReal :: T_12(realization%option%nphase)
2999) PetscReal :: T_21(realization%option%nphase)
3000) PetscReal :: T_22(realization%option%nphase)
3001) PetscReal :: J_11(realization%reaction%ncomp,realization%reaction%ncomp)
3002) PetscReal :: J_12(realization%reaction%ncomp,realization%reaction%ncomp)
3003) PetscReal :: J_21(realization%reaction%ncomp,realization%reaction%ncomp)
3004) PetscReal :: J_22(realization%reaction%ncomp,realization%reaction%ncomp)
3005) PetscReal :: Res(realization%reaction%ncomp)
3006) #else
3007) PetscReal :: coef_up(realization%option%nphase)
3008) PetscReal :: coef_dn(realization%option%nphase)
3009) PetscReal :: Jup(realization%reaction%ncomp,realization%reaction%ncomp)
3010) PetscReal :: Jdn(realization%reaction%ncomp,realization%reaction%ncomp)
3011) PetscReal :: Res(realization%reaction%ncomp)
3012) #endif
3013)
3014) option => realization%option
3015) field => realization%field
3016) patch => realization%patch
3017) grid => patch%grid
3018) reaction => realization%reaction
3019) rt_parameter => patch%aux%RT%rt_parameter
3020) rt_auxvars => patch%aux%RT%auxvars
3021) rt_auxvars_bc => patch%aux%RT%auxvars_bc
3022) global_auxvars => patch%aux%Global%auxvars
3023) global_auxvars_bc => patch%aux%Global%auxvars_bc
3024) if (option%use_mc) then
3025) rt_sec_transport_vars => patch%aux%SC_RT%sec_transport_vars
3026) endif
3027)
3028)
3029) vol_frac_prim = 1.d0
3030)
3031) ! Interior Flux Terms -----------------------------------
3032) ! must zero out Jacobian blocks
3033)
3034) call PetscLogEventBegin(logging%event_rt_jacobian_flux,ierr);CHKERRQ(ierr)
3035)
3036) connection_set_list => grid%internal_connection_set_list
3037) cur_connection_set => connection_set_list%first
3038) sum_connection = 0
3039) do
3040) if (.not.associated(cur_connection_set)) exit
3041) do iconn = 1, cur_connection_set%num_connections
3042) sum_connection = sum_connection + 1
3043)
3044) ghosted_id_up = cur_connection_set%id_up(iconn)
3045) ghosted_id_dn = cur_connection_set%id_dn(iconn)
3046)
3047) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
3048) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
3049)
3050) if (patch%imat(ghosted_id_up) <= 0 .or. &
3051) patch%imat(ghosted_id_dn) <= 0) cycle
3052)
3053) if (option%use_mc) then
3054) vol_frac_prim = rt_sec_transport_vars(local_id_up)%epsilon
3055) endif
3056)
3057) #ifndef CENTRAL_DIFFERENCE
3058) call TFluxCoef(option,cur_connection_set%area(iconn), &
3059) patch%internal_velocities(:,sum_connection), &
3060) patch%internal_tran_coefs(:,sum_connection)*vol_frac_prim, &
3061) cur_connection_set%dist(-1,iconn), &
3062) coef_up,coef_dn)
3063) call TFluxDerivative(rt_parameter, &
3064) rt_auxvars(ghosted_id_up), &
3065) global_auxvars(ghosted_id_up), &
3066) rt_auxvars(ghosted_id_dn), &
3067) global_auxvars(ghosted_id_dn), &
3068) coef_up,coef_dn,option,Jup,Jdn)
3069) if (local_id_up>0) then
3070) call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_up-1, &
3071) Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
3072) call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_dn-1, &
3073) Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
3074) endif
3075)
3076) if (local_id_dn>0) then
3077) Jup = -Jup
3078) Jdn = -Jdn
3079) call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_dn-1, &
3080) Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
3081) call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_up-1, &
3082) Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
3083) endif
3084)
3085) #else
3086) call TFluxCoef_CD(option,cur_connection_set%area(iconn), &
3087) patch%internal_velocities(:,sum_connection), &
3088) patch%internal_tran_coefs(:,sum_connection)*vol_frac_prim, &
3089) cur_connection_set%dist(-1,iconn), &
3090) T_11,T_12,T_21,T_22)
3091) call TFluxDerivative_CD(rt_parameter, &
3092) rt_auxvars(ghosted_id_up), &
3093) global_auxvars(ghosted_id_up), &
3094) rt_auxvars(ghosted_id_dn), &
3095) global_auxvars(ghosted_id_dn), &
3096) T_11,T_12,T_21,T_22,option, &
3097) J_11,J_12,J_21,J_22)
3098) if (local_id_up>0) then
3099) call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_up-1, &
3100) J_11,ADD_VALUES,ierr);CHKERRQ(ierr)
3101) call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_dn-1, &
3102) J_12,ADD_VALUES,ierr);CHKERRQ(ierr)
3103) endif
3104)
3105) if (local_id_dn>0) then
3106) call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_dn-1, &
3107) J_22,ADD_VALUES,ierr);CHKERRQ(ierr)
3108) call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_up-1, &
3109) J_21,ADD_VALUES,ierr);CHKERRQ(ierr)
3110) endif
3111) #endif
3112)
3113)
3114) enddo
3115) cur_connection_set => cur_connection_set%next
3116) enddo
3117)
3118) call PetscLogEventEnd(logging%event_rt_jacobian_flux,ierr);CHKERRQ(ierr)
3119)
3120) ! Boundary Flux Terms -----------------------------------
3121) ! must zero out Jacobian block
3122)
3123) call PetscLogEventBegin(logging%event_rt_jacobian_fluxbc,ierr);CHKERRQ(ierr)
3124)
3125) boundary_condition => patch%boundary_condition_list%first
3126) sum_connection = 0
3127) do
3128) if (.not.associated(boundary_condition)) exit
3129)
3130) cur_connection_set => boundary_condition%connection_set
3131)
3132) do iconn = 1, cur_connection_set%num_connections
3133) sum_connection = sum_connection + 1
3134)
3135) local_id = cur_connection_set%id_dn(iconn)
3136) ghosted_id = grid%nL2G(local_id)
3137)
3138) if (patch%imat(ghosted_id) <= 0) cycle
3139)
3140) if (option%use_mc) then
3141) vol_frac_prim = rt_sec_transport_vars(local_id)%epsilon
3142) endif
3143)
3144) #ifndef CENTRAL_DIFFERENCE
3145) ! TFluxCoef accomplishes the same as what TBCCoef would
3146) call TFluxCoef(option,cur_connection_set%area(iconn), &
3147) patch%boundary_velocities(:,sum_connection), &
3148) patch%boundary_tran_coefs(:,sum_connection)*vol_frac_prim, &
3149) 0.5d0, & ! fraction upwind (0.d0 upwind, 0.5 central)
3150) coef_up,coef_dn)
3151) ! TFluxDerivative accomplishes the same as what TBCFluxDerivative would
3152) call TFluxDerivative(rt_parameter, &
3153) rt_auxvars_bc(sum_connection), &
3154) global_auxvars_bc(sum_connection), &
3155) rt_auxvars(ghosted_id), &
3156) global_auxvars(ghosted_id), &
3157) coef_up,coef_dn,option,Jup,Jdn)
3158)
3159) !Jup not needed
3160) Jdn = -Jdn
3161)
3162) call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jdn,ADD_VALUES, &
3163) ierr);CHKERRQ(ierr)
3164)
3165) #else
3166) call TFluxCoef_CD(option,cur_connection_set%area(iconn), &
3167) patch%boundary_velocities(:,sum_connection), &
3168) patch%boundary_tran_coefs(:,sum_connection)*vol_frac_prim, &
3169) 0.5d0, & ! fraction upwind (0.d0 upwind, 0.5 central)
3170) T_11,T_12,T_21,T_22)
3171) call TFluxDerivative_CD(rt_parameter, &
3172) rt_auxvars_bc(sum_connection), &
3173) global_auxvars_bc(sum_connection), &
3174) rt_auxvars(ghosted_id), &
3175) global_auxvars(ghosted_id), &
3176) T_11,T_12,T_21,T_22,option, &
3177) J_11,J_12,J_21,J_22)
3178) call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,J_22,ADD_VALUES, &
3179) ierr);CHKERRQ(ierr)
3180) #endif
3181)
3182) enddo
3183) boundary_condition => boundary_condition%next
3184) enddo
3185) call PetscLogEventEnd(logging%event_rt_jacobian_fluxbc,ierr);CHKERRQ(ierr)
3186)
3187) end subroutine RTJacobianFlux
3188)
3189) ! ************************************************************************** !
3190)
3191) subroutine RTJacobianNonFlux(snes,xx,A,B,realization,ierr)
3192) !
3193) ! Computes non-flux term entries in the Jacobian for
3194) ! reactive transport
3195) !
3196) ! Author: Glenn Hammond
3197) ! Date: 02/14/08
3198) !
3199)
3200) use Realization_Subsurface_class
3201) use Patch_module
3202) use Transport_module
3203) use Option_module
3204) use Field_module
3205) use Grid_module
3206) use Connection_module
3207) use Coupler_module
3208) use Debug_module
3209) use Logging_module
3210) use Secondary_Continuum_Aux_module
3211)
3212)
3213) implicit none
3214)
3215) SNES :: snes
3216) Vec :: xx
3217) Mat :: A, B
3218) type(realization_subsurface_type) :: realization
3219) PetscErrorCode :: ierr
3220)
3221) PetscReal, pointer :: r_p(:)
3222) PetscReal, pointer :: work_loc_p(:)
3223) PetscInt :: local_id, ghosted_id
3224) PetscInt :: istartaq, iendaq
3225) PetscInt :: istart, iend
3226) PetscInt :: offset, idof
3227) type(grid_type), pointer :: grid
3228) type(option_type), pointer :: option
3229) type(field_type), pointer :: field
3230) type(patch_type), pointer :: patch
3231) type(reaction_type), pointer :: reaction
3232) type(reactive_transport_param_type), pointer :: rt_parameter
3233) PetscInt :: tran_pc
3234)
3235) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:), rt_auxvars_bc(:)
3236) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
3237) class(material_auxvar_type), pointer :: material_auxvars(:)
3238) PetscReal :: Jup(realization%reaction%ncomp,realization%reaction%ncomp)
3239) PetscReal :: Res(realization%reaction%ncomp)
3240)
3241) type(coupler_type), pointer :: source_sink
3242) type(connection_set_type), pointer :: cur_connection_set
3243) PetscInt :: iconn, sum_connection
3244) PetscReal :: qsrc, rdum
3245) PetscBool :: volumetric
3246) PetscInt :: flow_src_sink_type
3247) PetscReal :: coef_in, coef_out
3248) PetscReal :: scale
3249)
3250) ! secondary continuum variables
3251) type(sec_transport_type), pointer :: rt_sec_transport_vars(:)
3252) PetscReal :: vol_frac_prim
3253) PetscReal :: sec_diffusion_coefficient
3254) PetscReal :: sec_porosity
3255) PetscReal :: jac_transport(realization%reaction%naqcomp,realization%reaction%naqcomp)
3256) PetscInt :: ncomp
3257)
3258)
3259) option => realization%option
3260) field => realization%field
3261) patch => realization%patch
3262) reaction => realization%reaction
3263) grid => patch%grid
3264) rt_parameter => patch%aux%RT%rt_parameter
3265) rt_auxvars => patch%aux%RT%auxvars
3266) rt_auxvars_bc => patch%aux%RT%auxvars_bc
3267) global_auxvars => patch%aux%Global%auxvars
3268) global_auxvars_bc => patch%aux%Global%auxvars_bc
3269) material_auxvars => patch%aux%Material%auxvars
3270) if (option%use_mc) then
3271) rt_sec_transport_vars => patch%aux%SC_RT%sec_transport_vars
3272) endif
3273)
3274) vol_frac_prim = 1.d0
3275)
3276) if (.not.option%steady_state) then
3277) call PetscLogEventBegin(logging%event_rt_jacobian_accum,ierr);CHKERRQ(ierr)
3278) #if 1
3279) do local_id = 1, grid%nlmax ! For each local node do...
3280) ghosted_id = grid%nL2G(local_id)
3281) !geh - Ignore inactive cells with inactive materials
3282) if (patch%imat(ghosted_id) <= 0) cycle
3283)
3284) call RTAccumulationDerivative(rt_auxvars(ghosted_id), &
3285) global_auxvars(ghosted_id), &
3286) material_auxvars(ghosted_id), &
3287) reaction,option,Jup)
3288)
3289) if (reaction%neqsorb > 0) then
3290) call RAccumulationSorbDerivative(rt_auxvars(ghosted_id), &
3291) global_auxvars(ghosted_id), &
3292) material_auxvars(ghosted_id), &
3293) reaction,option,Jup)
3294) endif
3295)
3296) if (option%use_mc) then
3297)
3298) vol_frac_prim = rt_sec_transport_vars(local_id)%epsilon
3299) Jup = Jup*vol_frac_prim
3300)
3301) sec_diffusion_coefficient = patch%material_property_array(1)% &
3302) ptr%secondary_continuum_diff_coeff
3303) sec_porosity = patch%material_property_array(1)%ptr% &
3304) secondary_continuum_porosity
3305)
3306) if (realization%reaction%ncomp /= realization%reaction%naqcomp) then
3307) option%io_buffer = 'Current multicomponent implementation is for '// &
3308) 'aqueous reactions only'
3309) call printErrMsg(option)
3310) endif
3311)
3312) if (rt_sec_transport_vars(local_id)%sec_jac_update) then
3313) jac_transport = rt_sec_transport_vars(local_id)%sec_jac
3314) else
3315) option%io_buffer = 'RT secondary continuum term in primary '// &
3316) 'jacobian not updated'
3317) call printErrMsg(option)
3318) endif
3319)
3320) Jup = Jup - jac_transport
3321)
3322) endif
3323)
3324) call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup,ADD_VALUES, &
3325) ierr);CHKERRQ(ierr)
3326) enddo
3327) #endif
3328) call PetscLogEventEnd(logging%event_rt_jacobian_accum,ierr);CHKERRQ(ierr)
3329) endif
3330) #if 1
3331) ! Source/Sink terms -------------------------------------
3332) call PetscLogEventBegin(logging%event_rt_jacobian_ss,ierr);CHKERRQ(ierr)
3333) source_sink => patch%source_sink_list%first
3334) sum_connection = 0
3335) do
3336) if (.not.associated(source_sink)) exit
3337)
3338) cur_connection_set => source_sink%connection_set
3339)
3340) do iconn = 1, cur_connection_set%num_connections
3341) sum_connection = sum_connection + 1
3342) local_id = cur_connection_set%id_dn(iconn)
3343) ghosted_id = grid%nL2G(local_id)
3344)
3345) if (patch%imat(ghosted_id) <= 0) cycle
3346)
3347) istartaq = reaction%offset_aqueous + 1
3348) iendaq = reaction%offset_aqueous + reaction%naqcomp
3349)
3350) qsrc = patch%ss_flow_vol_fluxes(1,sum_connection)
3351) call TSrcSinkCoef(option,qsrc,source_sink%tran_condition%itype,coef_in,coef_out)
3352)
3353) Jup = 0.d0
3354) ! coef_in is non-zero
3355) if (dabs(coef_in-1.d20) > 0.d0) then
3356) Jup(istartaq:iendaq,istartaq:iendaq) = coef_in* &
3357) rt_auxvars(ghosted_id)%aqueous%dtotal(:,:,option%liquid_phase)
3358) if (reaction%ncoll > 0) then
3359) option%io_buffer = 'Source/sink not yet implemented for colloids'
3360) call printErrMsg(option)
3361) endif
3362) call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup,ADD_VALUES, &
3363) ierr);CHKERRQ(ierr)
3364) endif
3365) enddo
3366) source_sink => source_sink%next
3367) enddo
3368)
3369) call PetscLogEventEnd(logging%event_rt_jacobian_ss,ierr);CHKERRQ(ierr)
3370) #endif
3371)
3372)
3373) #if 1
3374) ! Reactions
3375) if (associated(reaction)) then
3376)
3377) call PetscLogEventBegin(logging%event_rt_jac_reaction,ierr);CHKERRQ(ierr)
3378)
3379) do local_id = 1, grid%nlmax ! For each local node do...
3380) ghosted_id = grid%nL2G(local_id)
3381) !geh - Ignore inactive cells with inactive materials
3382) if (patch%imat(ghosted_id) <= 0) cycle
3383) Res = 0.d0
3384) Jup = 0.d0
3385) if (.not.option%use_isothermal) then
3386) call RUpdateTempDependentCoefs(global_auxvars(ghosted_id),reaction, &
3387) PETSC_FALSE,option)
3388) endif
3389) call RReactionDerivative(Res,Jup,rt_auxvars(ghosted_id), &
3390) global_auxvars(ghosted_id), &
3391) material_auxvars(ghosted_id), &
3392) reaction,option)
3393) if (option%use_mc) then
3394) vol_frac_prim = rt_sec_transport_vars(local_id)%epsilon
3395) Jup = Jup*vol_frac_prim
3396) endif
3397) call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1, &
3398) Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
3399) enddo
3400)
3401) call PetscLogEventEnd(logging%event_rt_jac_reaction,ierr);CHKERRQ(ierr)
3402)
3403) endif
3404) #endif
3405)
3406) ! Mass Transfer - since the current implementation of mass transfer has
3407) ! mass transfer being fixed. Nothing to do here as the contribution to
3408) ! the derivatives is zero.
3409) ! if (field%tran_mass_transfer /= 0) then
3410) ! endif
3411)
3412) if (reaction%use_log_formulation) then
3413) call PetscLogEventBegin(logging%event_rt_jacobian_zero_calc, &
3414) ierr);CHKERRQ(ierr)
3415) call VecGetArrayF90(field%tran_work_loc, work_loc_p, ierr);CHKERRQ(ierr)
3416) do ghosted_id = 1, grid%ngmax ! For each local node do...
3417) offset = (ghosted_id-1)*reaction%ncomp
3418) if (patch%imat(ghosted_id) <= 0) then
3419) istart = offset + 1
3420) iend = offset + reaction%ncomp
3421) work_loc_p(istart:iend) = 1.d0
3422) else
3423) istartaq = offset + reaction%offset_aqueous + 1
3424) iendaq = offset + reaction%offset_aqueous + reaction%naqcomp
3425) work_loc_p(istartaq:iendaq) = rt_auxvars(ghosted_id)%pri_molal(:)
3426) if (reaction%nimcomp > 0) then
3427) istart = offset + reaction%offset_immobile + 1
3428) iend = offset + reaction%offset_immobile + reaction%nimcomp
3429) work_loc_p(istart:iend) = &
3430) rt_auxvars(ghosted_id)%immobile(:)
3431) endif
3432) if (reaction%ncoll > 0) then
3433) istart = offset + reaction%offset_colloid + 1
3434) iend = offset + reaction%offset_colloid + reaction%ncoll
3435) work_loc_p(istart:iend) = &
3436) rt_auxvars(ghosted_id)%colloid%conc_mob(:)
3437) endif
3438) endif
3439) enddo
3440) call VecRestoreArrayF90(field%tran_work_loc, work_loc_p, &
3441) ierr);CHKERRQ(ierr)
3442) call PetscLogEventEnd(logging%event_rt_jacobian_zero_calc, &
3443) ierr);CHKERRQ(ierr)
3444) endif
3445)
3446) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3447) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3448)
3449) if (patch%aux%RT%inactive_cells_exist) then
3450) call PetscLogEventBegin(logging%event_rt_jacobian_zero,ierr);CHKERRQ(ierr)
3451) rdum = 1.d0
3452) call MatZeroRowsLocal(A,patch%aux%RT%n_zero_rows, &
3453) patch%aux%RT%zero_rows_local_ghosted,rdum, &
3454) PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
3455) ierr);CHKERRQ(ierr)
3456) call PetscLogEventEnd(logging%event_rt_jacobian_zero,ierr);CHKERRQ(ierr)
3457) endif
3458)
3459) end subroutine RTJacobianNonFlux
3460)
3461) ! ************************************************************************** !
3462)
3463) subroutine RTJacobianEquilibrateCO2(J,realization)
3464) !
3465) ! Adds CO2 saturation constraint to Jacobian for
3466) ! reactive transport
3467) !
3468) ! Author: Glenn Hammond/Peter Lichtner
3469) ! Date: 12/12/14
3470) !
3471)
3472) use Realization_Subsurface_class
3473) use Patch_module
3474) use Option_module
3475) use Field_module
3476) use Grid_module
3477)
3478) implicit none
3479)
3480) Mat :: J
3481) type(realization_subsurface_type) :: realization
3482)
3483) PetscInt :: local_id, ghosted_id
3484) PetscInt :: idof
3485) type(grid_type), pointer :: grid
3486) type(option_type), pointer :: option
3487) type(field_type), pointer :: field
3488) type(patch_type), pointer :: patch
3489) type(reaction_type), pointer :: reaction
3490) PetscErrorCode :: ierr
3491)
3492) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
3493) type(global_auxvar_type), pointer :: global_auxvars(:)
3494) PetscInt :: zero_rows(realization%patch%grid%nlmax * realization%option%ntrandof)
3495) PetscInt :: ghosted_rows(realization%patch%grid%nlmax)
3496) PetscInt :: zero_count
3497) PetscInt :: i, jco2
3498) PetscReal :: jacobian_entry
3499) PetscReal :: eps = 1.d-6
3500)
3501) option => realization%option
3502) field => realization%field
3503) patch => realization%patch
3504) reaction => realization%reaction
3505) grid => patch%grid
3506) rt_auxvars => patch%aux%RT%auxvars
3507) global_auxvars => patch%aux%Global%auxvars
3508)
3509) ! loop over cells twice. the first time to zero (all rows to be zeroed have
3510) ! to be zeroed in a single call by passing in a list). the second loop to
3511) ! add the equilibration
3512)
3513) jacobian_entry = 1.d0
3514) jco2 = reaction%species_idx%co2_aq_id
3515) zero_count = 0
3516) zero_rows = 0
3517) ghosted_rows = 0
3518) do local_id = 1, grid%nlmax ! For each local node do...
3519) ghosted_id = grid%nL2G(local_id)
3520) if (patch%imat(ghosted_id) <= 0) cycle
3521) if (global_auxvars(ghosted_id)%sat(GAS_PHASE) > eps .and. &
3522) global_auxvars(ghosted_id)%sat(GAS_PHASE) < 1.d0-eps) then
3523) zero_count = zero_count + 1
3524) zero_rows(zero_count) = jco2+(ghosted_id-1)*reaction%ncomp-1
3525) ghosted_rows(zero_count) = ghosted_id
3526) endif
3527) enddo
3528)
3529) call MatZeroRowsLocal(J,zero_count,zero_rows(1:zero_count),jacobian_entry, &
3530) PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
3531) ierr);CHKERRQ(ierr)
3532)
3533) do i = 1, zero_count
3534) ghosted_id = ghosted_rows(i) ! zero indexing back to 1-based
3535) if (patch%imat(ghosted_id) <= 0) cycle
3536) if (reaction%use_log_formulation) then
3537) jacobian_entry = rt_auxvars(ghosted_id)%pri_molal(jco2)
3538) else
3539) jacobian_entry = 1.d0
3540) endif
3541)
3542) idof = (ghosted_id-1)*option%ntrandof + jco2
3543) call MatSetValuesLocal(J,1,idof-1,1,idof-1,jacobian_entry,INSERT_VALUES, &
3544) ierr);CHKERRQ(ierr)
3545) enddo
3546)
3547) call MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3548) call MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3549)
3550) end subroutine RTJacobianEquilibrateCO2
3551)
3552) ! ************************************************************************** !
3553)
3554) subroutine RTUpdateAuxVars(realization,update_cells,update_bcs, &
3555) update_activity_coefs)
3556) !
3557) ! Updates the auxiliary variables associated with
3558) ! reactive transport
3559) !
3560) ! Author: Glenn Hammond
3561) ! Date: 02/15/08
3562) !
3563)
3564) use Realization_Subsurface_class
3565) use Patch_module
3566) use Grid_module
3567) use Coupler_module
3568) use Connection_module
3569) use Option_module
3570) use Field_module
3571) use Logging_module
3572)
3573) #ifdef XINGYUAN_BC
3574) ! use Dataset_module
3575) ! use Dataset_Aux_module
3576) use Output_Tecplot_module
3577) #endif
3578)
3579) implicit none
3580)
3581) type(realization_subsurface_type) :: realization
3582) PetscBool :: update_bcs
3583) PetscBool :: update_cells
3584) PetscBool :: update_activity_coefs
3585)
3586) type(option_type), pointer :: option
3587) type(field_type), pointer :: field
3588) type(grid_type), pointer :: grid
3589) type(patch_type), pointer :: patch
3590) type(reaction_type), pointer :: reaction
3591) type(coupler_type), pointer :: boundary_condition
3592) type(connection_set_type), pointer :: cur_connection_set
3593)
3594) PetscInt :: ghosted_id, local_id, sum_connection, idof, iconn
3595) PetscInt :: istartaq, iendaq
3596) PetscInt :: istartcoll, iendcoll
3597) PetscInt :: istartaq_loc, iendaq_loc
3598) PetscInt :: istartcoll_loc, iendcoll_loc
3599) PetscInt :: istartim, iendim
3600) PetscReal, pointer :: xx_loc_p(:)
3601) PetscReal :: xxbc(realization%reaction%ncomp)
3602) PetscReal, pointer :: basis_molarity_p(:)
3603) PetscReal, pointer :: basis_coll_conc_p(:)
3604) PetscReal :: weight
3605) PetscInt, parameter :: iphase = 1
3606) PetscInt :: offset
3607) PetscErrorCode :: ierr
3608) PetscBool :: skip_equilibrate_constraint
3609) PetscInt, save :: icall
3610)
3611) #ifdef XINGYUAN_BC
3612) character(len=MAXSTRINGLENGTH) :: string
3613) character(len=MAXWORDLENGTH) :: name
3614) PetscInt :: idof_aq_dataset
3615) class(dataset_type), pointer :: dataset
3616) PetscReal :: temp_real
3617) PetscBool, save :: first = PETSC_TRUE
3618) PetscReal, pointer :: work_p(:)
3619) #endif
3620)
3621) data icall/0/
3622)
3623) option => realization%option
3624) patch => realization%patch
3625) grid => patch%grid
3626) field => realization%field
3627) reaction => realization%reaction
3628)
3629) #ifdef XINGYUAN_BC
3630) !geh call VecZeroEntries(field%work,ierr)
3631) !geh call VecGetArrayReadF90(field%work,work_p,ierr)
3632) #endif
3633)
3634) call VecGetArrayReadF90(field%tran_xx_loc,xx_loc_p,ierr);CHKERRQ(ierr)
3635)
3636) if (update_cells) then
3637)
3638) call PetscLogEventBegin(logging%event_rt_auxvars,ierr);CHKERRQ(ierr)
3639)
3640) do ghosted_id = 1, grid%ngmax
3641) if (grid%nG2L(ghosted_id) < 0) cycle ! bypass ghosted corner cells
3642) !geh - Ignore inactive cells with inactive materials
3643)
3644) if (patch%imat(ghosted_id) <= 0) cycle
3645)
3646) offset = (ghosted_id-1)*reaction%ncomp
3647) istartaq = offset + reaction%offset_aqueous + 1
3648) iendaq = offset + reaction%offset_aqueous + reaction%naqcomp
3649)
3650) patch%aux%RT%auxvars(ghosted_id)%pri_molal = xx_loc_p(istartaq:iendaq)
3651) if (reaction%nimcomp > 0) then
3652) istartim = offset + reaction%offset_immobile + 1
3653) iendim = offset + reaction%offset_immobile + reaction%nimcomp
3654) patch%aux%RT%auxvars(ghosted_id)%immobile = xx_loc_p(istartim:iendim)
3655) endif
3656) if (reaction%ncoll > 0) then
3657) istartcoll = offset + reaction%offset_colloid + 1
3658) iendcoll = offset + reaction%offset_colloid + reaction%ncoll
3659) patch%aux%RT%auxvars(ghosted_id)%colloid%conc_mob = &
3660) xx_loc_p(istartcoll:iendcoll)* &
3661) patch%aux%Global%auxvars(ghosted_id)%den_kg(1)*1.d-3
3662) endif
3663) if (.not.option%use_isothermal) then
3664) call RUpdateTempDependentCoefs(patch%aux%Global%auxvars(ghosted_id), &
3665) reaction,PETSC_FALSE, &
3666) option)
3667) endif
3668) if (update_activity_coefs) then
3669) call RActivityCoefficients(patch%aux%RT%auxvars(ghosted_id), &
3670) patch%aux%Global%auxvars(ghosted_id), &
3671) reaction,option)
3672) if (option%iflowmode == MPH_MODE .or. option%iflowmode == FLASH2_MODE) then
3673) call CO2AqActCoeff(patch%aux%RT%auxvars(ghosted_id), &
3674) patch%aux%Global%auxvars(ghosted_id), &
3675) reaction,option)
3676) endif
3677) endif
3678) call RTAuxVarCompute(patch%aux%RT%auxvars(ghosted_id), &
3679) patch%aux%Global%auxvars(ghosted_id), &
3680) patch%aux%Material%auxvars(ghosted_id), &
3681) reaction,option)
3682) #if 0
3683) if (associated(reaction%species_idx) .and. &
3684) associated(patch%aux%Global%auxvars(ghosted_id)%m_nacl)) then
3685) if (reaction%species_idx%na_ion_id /= 0 .and. reaction%species_idx%cl_ion_id /= 0) then
3686) patch%aux%Global%auxvars(ghosted_id)%m_nacl(1) = &
3687) patch%aux%RT%auxvars(ghosted_id)%pri_molal(reaction%species_idx%na_ion_id)
3688) patch%aux%Global%auxvars(ghosted_id)%m_nacl(2) = &
3689) patch%aux%RT%auxvars(ghosted_id)%pri_molal(reaction%species_idx%cl_ion_id)
3690) else
3691) patch%aux%Global%auxvars(ghosted_id)%m_nacl = option%m_nacl
3692) endif
3693) endif
3694) #endif
3695) enddo
3696)
3697) call PetscLogEventEnd(logging%event_rt_auxvars,ierr);CHKERRQ(ierr)
3698) endif
3699)
3700) if (update_bcs) then
3701)
3702) call PetscLogEventBegin(logging%event_rt_auxvars_bc,ierr);CHKERRQ(ierr)
3703)
3704) boundary_condition => patch%boundary_condition_list%first
3705) sum_connection = 0
3706) do
3707) if (.not.associated(boundary_condition)) exit
3708) cur_connection_set => boundary_condition%connection_set
3709)
3710) basis_molarity_p => boundary_condition%tran_condition% &
3711) cur_constraint_coupler%aqueous_species%basis_molarity
3712)
3713) if (reaction%ncoll > 0) then
3714) basis_coll_conc_p => boundary_condition%tran_condition% &
3715) cur_constraint_coupler%colloids%basis_conc_mob
3716) endif
3717)
3718) #ifdef XINGYUAN_BC
3719) idof_aq_dataset = 0
3720) do idof = 1, reaction%naqcomp ! primary aqueous concentrations
3721) if (boundary_condition%tran_condition% &
3722) cur_constraint_coupler%aqueous_species%external_dataset(idof)) then
3723) idof_aq_dataset = idof
3724) string = 'constraint ' // trim(boundary_condition%tran_condition% &
3725) cur_constraint_coupler%constraint_name)
3726) dataset => DatasetGetPointer(realization%datasets, &
3727) boundary_condition%tran_condition% &
3728) cur_constraint_coupler%aqueous_species% &
3729) constraint_aux_string(idof), &
3730) string,option)
3731) call DatasetLoad(dataset,option)
3732) exit
3733) endif
3734) enddo
3735) #endif
3736)
3737) do iconn = 1, cur_connection_set%num_connections
3738) sum_connection = sum_connection + 1
3739) local_id = cur_connection_set%id_dn(iconn)
3740) ghosted_id = grid%nL2G(local_id)
3741)
3742) if (patch%imat(ghosted_id) <= 0) cycle
3743)
3744) offset = (ghosted_id-1)*reaction%ncomp
3745) istartaq_loc = reaction%offset_aqueous + 1
3746) iendaq_loc = reaction%offset_aqueous + reaction%naqcomp
3747) istartaq = offset + istartaq_loc
3748) iendaq = offset + iendaq_loc
3749)
3750) if (reaction%ncoll > 0) then
3751) istartcoll_loc = reaction%offset_colloid + 1
3752) iendcoll_loc = reaction%offset_colloid + reaction%ncoll
3753) istartcoll = offset + istartcoll_loc
3754) iendcoll = offset + iendcoll_loc
3755) endif
3756)
3757) #ifdef XINGYUAN_BC
3758) if (idof_aq_dataset > 0) then
3759) call DatasetInterpolateReal(dataset, &
3760) grid%x(ghosted_id)- &
3761) boundary_condition%connection_set%dist(0,iconn)* &
3762) boundary_condition%connection_set%dist(1,iconn), &
3763) grid%y(ghosted_id)- &
3764) boundary_condition%connection_set%dist(0,iconn)* &
3765) boundary_condition%connection_set%dist(2,iconn), &
3766) 0.d0, & ! z
3767) option%tran_time,temp_real,option)
3768) !geh work_p(local_id) = temp_real
3769) boundary_condition%tran_condition%cur_constraint_coupler% &
3770) aqueous_species%constraint_conc(idof_aq_dataset) = temp_real
3771) if (first) patch%aux%RT%auxvars_bc(sum_connection)%pri_molal = basis_molarity_p
3772) call ReactionEquilibrateConstraint( &
3773) patch%aux%RT%auxvars_bc(sum_connection), &
3774) patch%aux%Global%auxvars_bc(sum_connection),reaction, &
3775) boundary_condition%tran_condition%cur_constraint_coupler%constraint_name, &
3776) boundary_condition%tran_condition%cur_constraint_coupler%aqueous_species, &
3777) boundary_condition%tran_condition%cur_constraint_coupler%free_ion_guess, &
3778) boundary_condition%tran_condition%cur_constraint_coupler%minerals, &
3779) boundary_condition%tran_condition%cur_constraint_coupler%surface_complexes, &
3780) boundary_condition%tran_condition%cur_constraint_coupler%colloids, &
3781) boundary_condition%tran_condition%cur_constraint_coupler%immobile_species, &
3782) patch%aux%Material%auxvars(ghosted_id)%porosity, &
3783) boundary_condition%tran_condition%cur_constraint_coupler%num_iterations, &
3784) PETSC_TRUE,option)
3785) basis_molarity_p => boundary_condition%tran_condition% &
3786) cur_constraint_coupler%aqueous_species%basis_molarity
3787) endif
3788) #endif
3789)
3790) ! if (option%iflowmode /= MPH_MODE .or. icall>1) then
3791) if (option%iflowmode /= MPH_MODE .and. option%iflowmode /= FLASH2_MODE) then
3792) ! Note: the DIRICHLET_BC is not time dependent in this case (icall)
3793) select case(boundary_condition%tran_condition%itype)
3794) case(CONCENTRATION_SS,DIRICHLET_BC,NEUMANN_BC)
3795) ! since basis_molarity is in molarity, must convert to molality
3796) ! by dividing by density of water (mol/L -> mol/kg)
3797) xxbc(istartaq_loc:iendaq_loc) = &
3798) basis_molarity_p(1:reaction%naqcomp) / &
3799) patch%aux%Global%auxvars_bc(sum_connection)%den_kg(iphase) * &
3800) 1000.d0
3801) if (reaction%ncoll > 0) then
3802) xxbc(istartcoll_loc:iendcoll_loc) = &
3803) basis_coll_conc_p(1:reaction%ncoll) / &
3804) patch%aux%Global%auxvars_bc(sum_connection)%den_kg(iphase) * &
3805) 1000.d0
3806) endif
3807) case(DIRICHLET_ZERO_GRADIENT_BC)
3808) !geh do iphase = 1, option%nphase
3809) if (patch%boundary_velocities(iphase,sum_connection) >= 0.d0) then
3810) ! same as dirichlet above
3811) xxbc(istartaq_loc:iendaq_loc) = &
3812) basis_molarity_p(1:reaction%naqcomp) / &
3813) patch%aux%Global%auxvars_bc(sum_connection)%den_kg(iphase) * &
3814) & 1000.d0
3815) if (reaction%ncoll > 0) then
3816) xxbc(istartcoll_loc:iendcoll_loc) = &
3817) basis_coll_conc_p(1:reaction%ncoll) / &
3818) patch%aux%Global%auxvars_bc(sum_connection)%den_kg(iphase) * &
3819) 1000.d0
3820) endif
3821) else
3822) ! same as zero_gradient below
3823) xxbc(istartaq_loc:iendaq_loc) = xx_loc_p(istartaq:iendaq)
3824) if (reaction%ncoll > 0) then
3825) xxbc(istartcoll_loc:iendcoll_loc) = &
3826) basis_coll_conc_p(1:reaction%ncoll) / &
3827) patch%aux%Global%auxvars_bc(sum_connection)%den_kg(iphase) * &
3828) 1000.d0
3829) endif
3830) endif
3831) !geh enddo
3832) case(ZERO_GRADIENT_BC)
3833) xxbc(istartaq_loc:iendaq_loc) = xx_loc_p(istartaq:iendaq)
3834) if (reaction%ncoll > 0) then
3835) xxbc(istartcoll_loc:iendcoll_loc) = &
3836) basis_coll_conc_p(1:reaction%ncoll) / &
3837) patch%aux%Global%auxvars_bc(sum_connection)%den_kg(iphase) * &
3838) 1000.d0
3839) endif
3840) end select
3841) ! no need to update boundary fluid density since it is already set
3842) patch%aux%RT%auxvars_bc(sum_connection)%pri_molal = &
3843) xxbc(istartaq_loc:iendaq_loc)
3844) if (reaction%ncoll > 0) then
3845) patch%aux%RT%auxvars_bc(sum_connection)%colloid%conc_mob = &
3846) xxbc(istartcoll_loc:iendcoll_loc)* &
3847) patch%aux%Global%auxvars_bc(sum_connection)%den_kg(1)*1.d-3
3848) endif
3849) if (.not.option%use_isothermal) then
3850) call RUpdateTempDependentCoefs(patch%aux%Global% &
3851) auxvars_bc(sum_connection), &
3852) reaction,PETSC_FALSE, &
3853) option)
3854) endif
3855) if (update_activity_coefs) then
3856) call RActivityCoefficients(patch%aux%RT%auxvars_bc(sum_connection), &
3857) patch%aux%Global%auxvars_bc(sum_connection), &
3858) reaction,option)
3859) if (option%iflowmode == MPH_MODE .or. option%iflowmode == FLASH2_MODE) then
3860) call CO2AqActCoeff(patch%aux%RT%auxvars_bc(sum_connection), &
3861) patch%aux%Global%auxvars_bc(sum_connection), &
3862) reaction,option)
3863) endif
3864) endif
3865) call RTAuxVarCompute(patch%aux%RT%auxvars_bc(sum_connection), &
3866) patch%aux%Global%auxvars_bc(sum_connection), &
3867) patch%aux%Material%auxvars(ghosted_id), &
3868) reaction,option)
3869) else
3870) skip_equilibrate_constraint = PETSC_FALSE
3871) ! Chuan needs to fill this in.
3872) select case(boundary_condition%tran_condition%itype)
3873) case(CONCENTRATION_SS,DIRICHLET_BC,NEUMANN_BC)
3874) ! don't need to do anything as the constraint below provides all
3875) ! the concentrations, etc.
3876)
3877) !geh: terrible kludge, but should work for now.
3878) !geh: the problem is that ...%pri_molal() on first call is zero and
3879) ! PETSC_TRUE is passed into ReactionEquilibrateConstraint() below
3880) ! for use_prev_soln_as_guess. If the previous solution is zero,
3881) ! the code will crash.
3882) if (patch%aux%RT%auxvars_bc(sum_connection)%pri_molal(1) < 1.d-200) then
3883) ! patch%aux%RT%auxvars_bc(sum_connection)%pri_molal = 1.d-9
3884) patch%aux%RT%auxvars_bc(sum_connection)%pri_molal = &
3885) xx_loc_p(istartaq:iendaq)
3886) endif
3887) case(DIRICHLET_ZERO_GRADIENT_BC)
3888) if (patch%boundary_velocities(iphase,sum_connection) >= 0.d0) then
3889) ! don't need to do anything as the constraint below provides all
3890) ! the concentrations, etc.
3891)
3892) if (patch%aux%RT%auxvars_bc(sum_connection)%pri_molal(1) < 1.d-200) then
3893) ! patch%aux%RT%auxvars_bc(sum_connection)%pri_molal = 1.d-9
3894) patch%aux%RT%auxvars_bc(sum_connection)%pri_molal = &
3895) xx_loc_p(istartaq:iendaq)
3896) endif
3897) else
3898) ! same as zero_gradient below
3899) skip_equilibrate_constraint = PETSC_TRUE
3900) patch%aux%RT%auxvars_bc(sum_connection)%pri_molal = &
3901) xx_loc_p(istartaq:iendaq)
3902) if (reaction%ncoll > 0) then
3903) patch%aux%RT%auxvars_bc(sum_connection)%colloid%conc_mob = &
3904) xx_loc_p(istartcoll:iendcoll)* &
3905) patch%aux%Global%auxvars_bc(sum_connection)%den_kg(1)*1.d-3
3906) endif
3907) endif
3908) case(ZERO_GRADIENT_BC)
3909) skip_equilibrate_constraint = PETSC_TRUE
3910) patch%aux%RT%auxvars_bc(sum_connection)%pri_molal = &
3911) xx_loc_p(istartaq:iendaq)
3912) if (reaction%ncoll > 0) then
3913) patch%aux%RT%auxvars_bc(sum_connection)%colloid%conc_mob = &
3914) xx_loc_p(istartcoll:iendcoll)* &
3915) patch%aux%Global%auxvars_bc(sum_connection)%den_kg(1)*1.d-3
3916) endif
3917) end select
3918) ! no need to update boundary fluid density since it is already set
3919) if (.not.skip_equilibrate_constraint) then
3920) ! print *,'RT redo constrain on BCs: 1: ', sum_connection
3921) call ReactionEquilibrateConstraint(patch%aux%RT%auxvars_bc(sum_connection), &
3922) patch%aux%Global%auxvars_bc(sum_connection), &
3923) patch%aux%Material%auxvars(ghosted_id),reaction, &
3924) boundary_condition%tran_condition%cur_constraint_coupler%constraint_name, &
3925) boundary_condition%tran_condition%cur_constraint_coupler%aqueous_species, &
3926) boundary_condition%tran_condition%cur_constraint_coupler%free_ion_guess, &
3927) boundary_condition%tran_condition%cur_constraint_coupler%minerals, &
3928) boundary_condition%tran_condition%cur_constraint_coupler%surface_complexes, &
3929) boundary_condition%tran_condition%cur_constraint_coupler%colloids, &
3930) boundary_condition%tran_condition%cur_constraint_coupler%immobile_species, &
3931) boundary_condition%tran_condition%cur_constraint_coupler%num_iterations, &
3932) PETSC_TRUE,option)
3933) ! print *,'RT redo constrain on BCs: 2: ', sum_connection
3934) endif
3935) endif
3936) #if 0
3937) if (associated(reaction%species_idx) .and. &
3938) associated(patch%aux%Global%auxvars_bc(sum_connection)%m_nacl)) then
3939) if (reaction%species_idx%na_ion_id /= 0 .and. reaction%species_idx%cl_ion_id /= 0) then
3940) patch%aux%Global%auxvars_bc(sum_connection)%m_nacl(1) = &
3941) patch%aux%RT%auxvars_bc(sum_connection)%pri_molal(reaction%species_idx%na_ion_id)
3942) patch%aux%Global%auxvars_bc(sum_connection)%m_nacl(2) = &
3943) patch%aux%RT%auxvars_bc(sum_connection)%pri_molal(reaction%species_idx%cl_ion_id)
3944) else
3945) patch%aux%Global%auxvars_bc(sum_connection)%m_nacl = option%m_nacl
3946) endif
3947) endif
3948) #endif
3949) enddo ! iconn
3950) boundary_condition => boundary_condition%next
3951) enddo
3952)
3953) call PetscLogEventEnd(logging%event_rt_auxvars_bc,ierr);CHKERRQ(ierr)
3954)
3955) #ifdef XINGYUAN_BC
3956) first = PETSC_FALSE
3957) !call VecRestoreArrayReadF90(field%work,work_p,ierr)
3958) !string = 'xingyuan_bc.tec'
3959) !name = 'xingyuan_bc'
3960) !call OutputVectorTecplot(string,name,realization,field%work)
3961) #endif
3962)
3963) endif
3964)
3965) patch%aux%RT%auxvars_up_to_date = update_cells .and. update_bcs
3966)
3967) call VecRestoreArrayReadF90(field%tran_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
3968) icall = icall+ 1
3969)
3970) end subroutine RTUpdateAuxVars
3971)
3972) ! ************************************************************************** !
3973)
3974) subroutine RTMaxChange(realization,dcmax,dvfmax)
3975) !
3976) ! Computes the maximum change in the solution vector
3977) !
3978) ! Author: Glenn Hammond
3979) ! Date: 02/15/08
3980) !
3981)
3982) use Realization_Subsurface_class
3983) use Option_module
3984) use Field_module
3985) use Patch_module
3986) use Grid_module
3987)
3988) implicit none
3989)
3990) type(realization_subsurface_type) :: realization
3991) PetscReal :: dcmax
3992) PetscReal :: dvfmax
3993)
3994) type(option_type), pointer :: option
3995) type(field_type), pointer :: field
3996) type(reaction_type), pointer :: reaction
3997) type(patch_type), pointer :: patch
3998) type(grid_type), pointer :: grid
3999) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
4000) PetscReal, pointer :: dxx_ptr(:), xx_ptr(:), yy_ptr(:)
4001) PetscInt :: local_id, ghosted_id, imnrl
4002) PetscReal :: delta_volfrac
4003) PetscErrorCode :: ierr
4004)
4005) option => realization%option
4006) field => realization%field
4007) reaction => realization%reaction
4008) patch => realization%patch
4009) grid => patch%grid
4010) rt_auxvars => patch%aux%RT%auxvars
4011)
4012) dcmax = 0.d0
4013) dvfmax = 0.d0
4014)
4015) call VecWAXPY(field%tran_dxx,-1.d0,field%tran_xx,field%tran_yy, &
4016) ierr);CHKERRQ(ierr)
4017)
4018) call VecStrideNorm(field%tran_dxx,ZERO_INTEGER,NORM_INFINITY,dcmax, &
4019) ierr);CHKERRQ(ierr)
4020)
4021) #if 1
4022) ! update mineral volume fractions
4023) if (reaction%mineral%nkinmnrl > 0) then
4024) do local_id = 1, grid%nlmax
4025) ghosted_id = grid%nL2G(local_id)
4026) !geh - Ignore inactive cells with inactive materials
4027) if (patch%imat(ghosted_id) <= 0) cycle
4028) do imnrl = 1, reaction%mineral%nkinmnrl
4029) delta_volfrac = rt_auxvars(ghosted_id)%mnrl_rate(imnrl)* &
4030) reaction%mineral%kinmnrl_molar_vol(imnrl)* &
4031) option%tran_dt
4032) dvfmax = max(dabs(delta_volfrac),dvfmax)
4033) enddo
4034) enddo
4035) endif
4036) #endif
4037)
4038) end subroutine RTMaxChange
4039)
4040) ! ************************************************************************** !
4041)
4042) subroutine RTSetPlotVariables(realization,list)
4043) !
4044) ! Adds variables to be printed to list
4045) !
4046) ! Author: Glenn Hammond
4047) ! Date: 10/15/12
4048) !
4049)
4050) use Realization_Subsurface_class
4051) use Option_module
4052) use Output_Aux_module
4053) use Variables_module
4054)
4055) implicit none
4056)
4057) type(realization_subsurface_type) :: realization
4058) type(output_variable_list_type), pointer :: list
4059)
4060) character(len=MAXWORDLENGTH) :: name, units
4061) character(len=MAXSTRINGLENGTH) string
4062) character(len=2) :: free_mol_char, tot_mol_char, sec_mol_char
4063) type(option_type), pointer :: option
4064) type(reaction_type), pointer :: reaction
4065) PetscInt :: i
4066)
4067) option => realization%option
4068) reaction => realization%reaction
4069)
4070) if (reaction%print_free_conc_type == PRIMARY_MOLALITY) then
4071) free_mol_char = 'm'
4072) else
4073) free_mol_char = 'M'
4074) endif
4075)
4076) if (reaction%print_tot_conc_type == TOTAL_MOLALITY) then
4077) tot_mol_char = 'm'
4078) else
4079) tot_mol_char = 'M'
4080) endif
4081)
4082) if (reaction%print_secondary_conc_type == SECONDARY_MOLALITY) then
4083) sec_mol_char = 'm'
4084) else
4085) sec_mol_char = 'M'
4086) endif
4087)
4088) if (reaction%print_pH .and. associated(reaction%species_idx)) then
4089) if (reaction%species_idx%h_ion_id /= 0) then
4090) name = 'pH'
4091) units = ''
4092) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units,PH, &
4093) reaction%species_idx%h_ion_id)
4094) else
4095) option%io_buffer = 'pH may not be printed when H+ is not ' // &
4096) 'defined as a species.'
4097) call printErrMsg(option)
4098) endif
4099) endif
4100)
4101) if (reaction%print_EH .and. associated(reaction%species_idx)) then
4102) if (reaction%species_idx%o2_gas_id > 0) then
4103) name = 'Eh'
4104) units = 'V'
4105) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units,EH, &
4106) reaction%species_idx%h_ion_id)
4107) else
4108) option%io_buffer = 'Eh may not be printed when O2(g) is not ' // &
4109) 'defined as a species.'
4110) call printErrMsg(option)
4111) endif
4112) endif
4113)
4114) if (reaction%print_pe .and. associated(reaction%species_idx)) then
4115) if (reaction%species_idx%o2_gas_id > 0) then
4116) name = 'pe'
4117) units = ''
4118) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units,PE, &
4119) reaction%species_idx%h_ion_id)
4120) else
4121) option%io_buffer = 'pe may not be printed when O2(g) is not ' // &
4122) 'defined as a species.'
4123) call printErrMsg(option)
4124) endif
4125) endif
4126)
4127) if (reaction%print_O2 .and. associated(reaction%species_idx)) then
4128) if (reaction%species_idx%o2_gas_id > 0) then
4129) name = 'logfO2'
4130) units = 'bars'
4131) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units,O2, &
4132) reaction%species_idx%o2_gas_id)
4133) else
4134) option%io_buffer = 'logfO2 may not be printed when O2(g) is not ' // &
4135) 'defined as a species.'
4136) call printErrMsg(option)
4137) endif
4138) endif
4139)
4140) if (reaction%print_total_component) then
4141) do i=1,reaction%naqcomp
4142) if (reaction%primary_species_print(i)) then
4143) name = 'Total ' // trim(reaction%primary_species_names(i))
4144) units = trim(tot_mol_char)
4145) call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
4146) reaction%print_tot_conc_type,i)
4147) endif
4148) enddo
4149) endif
4150)
4151) if (reaction%print_free_ion) then
4152) do i=1,reaction%naqcomp
4153) if (reaction%primary_species_print(i)) then
4154) name = 'Free ' // trim(reaction%primary_species_names(i))
4155) units = trim(free_mol_char)
4156) call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
4157) reaction%print_free_conc_type,i)
4158) endif
4159) enddo
4160) endif
4161)
4162) if (reaction%print_all_gas_species) then
4163) do i=1,reaction%ngas
4164) name = 'Gas species ' // trim(reaction%gas_species_names(i))
4165) units = trim('mol/m^3')
4166) call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
4167) GAS_CONCENTRATION,i)
4168) enddo
4169) endif
4170)
4171) if (reaction%print_total_bulk) then
4172) do i=1,reaction%naqcomp
4173) if (reaction%primary_species_print(i)) then
4174) name = 'Total Bulk ' // trim(reaction%primary_species_names(i))
4175) units = 'mol/m^3 bulk'
4176) call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
4177) TOTAL_BULK,i)
4178) endif
4179) enddo
4180) endif
4181)
4182) if (reaction%print_act_coefs) then
4183) do i=1,reaction%naqcomp
4184) if (reaction%primary_species_print(i)) then
4185) name = 'Gamma ' // trim(reaction%primary_species_names(i))
4186) units = ''
4187) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4188) PRIMARY_ACTIVITY_COEF,i)
4189) endif
4190) enddo
4191) endif
4192)
4193) do i=1,reaction%neqcplx
4194) if (reaction%secondary_species_print(i)) then
4195) name = trim(reaction%secondary_species_names(i))
4196) units = trim(sec_mol_char)
4197) call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
4198) reaction%print_secondary_conc_type,i)
4199) endif
4200) enddo
4201)
4202) do i=1,reaction%mineral%nkinmnrl
4203) if (reaction%mineral%kinmnrl_print(i)) then
4204) name = trim(reaction%mineral%kinmnrl_names(i)) // ' VF'
4205) units = ''
4206) call OutputVariableAddToList(list,name,OUTPUT_VOLUME_FRACTION,units, &
4207) MINERAL_VOLUME_FRACTION,i)
4208) endif
4209) enddo
4210)
4211) do i=1,reaction%mineral%nkinmnrl
4212) if (reaction%mineral%kinmnrl_print(i)) then
4213) name = trim(reaction%mineral%kinmnrl_names(i)) // ' Rate'
4214) units = 'mol/m^3/sec'
4215) call OutputVariableAddToList(list,name,OUTPUT_RATE,units, &
4216) MINERAL_RATE,i)
4217) endif
4218) enddo
4219)
4220) if (reaction%mineral%print_saturation_index) then
4221) do i=1,reaction%mineral%nmnrl
4222) if (reaction%mineral%mnrl_print(i)) then
4223) name = trim(reaction%mineral%mineral_names(i)) // ' SI'
4224) units = ''
4225) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4226) MINERAL_SATURATION_INDEX,i)
4227) endif
4228) enddo
4229) endif
4230)
4231) do i=1,reaction%immobile%nimmobile
4232) if (reaction%immobile%print_me(i)) then
4233) name = trim(reaction%immobile%names(i))
4234) units = 'mol/m^3'
4235) call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
4236) IMMOBILE_SPECIES,i)
4237) endif
4238) enddo
4239)
4240) do i=1,realization%reaction%surface_complexation%nsrfcplxrxn
4241) if (reaction%surface_complexation%srfcplxrxn_site_density_print(i)) then
4242) name = trim(reaction%surface_complexation%srfcplxrxn_site_names(i)) // &
4243) ' Site Density'
4244) units = 'mol/m^3 bulk'
4245) call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
4246) SURFACE_SITE_DENSITY,i)
4247) endif
4248) enddo
4249)
4250) do i=1,realization%reaction%surface_complexation%nsrfcplxrxn
4251) if (reaction%surface_complexation%srfcplxrxn_site_print(i)) then
4252) name = 'Free ' // &
4253) trim(reaction%surface_complexation%srfcplxrxn_site_names(i))
4254) units = 'mol/m^3 bulk'
4255) call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
4256) SURFACE_CMPLX_FREE,i)
4257) endif
4258) enddo
4259)
4260)
4261) do i=1,realization%reaction%surface_complexation%nsrfcplx
4262) if (reaction%surface_complexation%srfcplx_print(i)) then
4263) name = reaction%surface_complexation%srfcplx_names(i)
4264) units = 'mol/m^3 bulk'
4265) call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
4266) SURFACE_CMPLX,i)
4267) endif
4268) enddo
4269)
4270) do i=1,realization%reaction%surface_complexation%nkinsrfcplxrxn
4271) if (reaction%surface_complexation%srfcplxrxn_site_print(i)) then
4272) option%io_buffer = 'Printing of kinetic surface complexes needs to be fixed'
4273) call printErrMsg(option)
4274) name = 'Free ' // &
4275) trim(reaction%surface_complexation%srfcplxrxn_site_names(i))
4276) units = 'mol/m^3 bulk'
4277) call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
4278) KIN_SURFACE_CMPLX_FREE,i)
4279) endif
4280) enddo
4281)
4282) do i=1,realization%reaction%surface_complexation%nkinsrfcplx
4283) if (reaction%surface_complexation%srfcplx_print(i)) then
4284) option%io_buffer = 'Printing of kinetic surface complexes needs to be fixed'
4285) call printErrMsg(option)
4286) name = reaction%surface_complexation%srfcplx_names(i)
4287) units = 'mol/m^3 bulk'
4288) call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
4289) KIN_SURFACE_CMPLX,i)
4290) endif
4291) enddo
4292)
4293) if (associated(reaction%kd_print)) then
4294) do i=1,reaction%naqcomp
4295) if (reaction%kd_print(i)) then
4296) name = trim(reaction%primary_species_names(i)) // ' KD'
4297) units = '-'
4298) call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
4299) PRIMARY_KD,i)
4300) endif
4301) enddo
4302) endif
4303)
4304) if (associated(reaction%total_sorb_print)) then
4305) do i=1,reaction%naqcomp
4306) if (reaction%total_sorb_print(i)) then
4307) name = 'Total Sorbed ' // trim(reaction%primary_species_names(i))
4308) units = 'mol/m^3'
4309) call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
4310) TOTAL_SORBED,i)
4311) endif
4312) enddo
4313) endif
4314)
4315) if (associated(reaction%total_sorb_mobile_print)) then
4316) do i=1,reaction%ncollcomp
4317) if (reaction%total_sorb_mobile_print(i)) then
4318) name = 'Total Sorbed Mobile ' // &
4319) trim(reaction%colloid_species_names(i))
4320) units = trim(tot_mol_char)
4321) call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
4322) TOTAL_SORBED_MOBILE,i)
4323) endif
4324) enddo
4325) endif
4326)
4327) if (reaction%print_colloid) then
4328) do i=1,reaction%ncoll
4329) if (reaction%colloid_print(i)) then
4330) name = 'Mobile Colloidal ' // trim(reaction%colloid_names(i))
4331) units = trim(tot_mol_char)
4332) call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
4333) COLLOID_MOBILE,i)
4334) endif
4335) enddo
4336) do i=1,reaction%ncoll
4337) if (reaction%colloid_print(i)) then
4338) name = 'Mobile Colloidal ' // trim(reaction%colloid_names(i))
4339) units = trim(tot_mol_char)
4340) call OutputVariableAddToList(list,name,OUTPUT_CONCENTRATION,units, &
4341) COLLOID_IMMOBILE,i)
4342) endif
4343) enddo
4344) endif
4345)
4346) if (reaction%print_age) then
4347) if (reaction%species_idx%tracer_age_id > 0) then
4348) name = 'Tracer Age'
4349) units = 'sec-molar'
4350) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4351) AGE,reaction%species_idx%tracer_age_id, &
4352) reaction%species_idx%tracer_aq_id)
4353) endif
4354) endif
4355)
4356) end subroutine RTSetPlotVariables
4357)
4358) ! ************************************************************************** !
4359)
4360) subroutine RTJumpStartKineticSorption(realization)
4361) !
4362) ! Calculates the concentrations of species sorbing
4363) ! through kinetic sorption processes based
4364) ! on equilibrium with the aqueous phase.
4365) !
4366) ! Author: Glenn Hammond
4367) ! Date: 08/05/09
4368) !
4369)
4370) use Realization_Subsurface_class
4371) use Patch_module
4372) use Grid_module
4373) use Option_module
4374) use Field_module
4375)
4376) implicit none
4377)
4378) type(realization_subsurface_type) :: realization
4379)
4380) type(option_type), pointer :: option
4381) type(field_type), pointer :: field
4382) type(grid_type), pointer :: grid
4383) type(patch_type), pointer :: patch
4384) type(reaction_type), pointer :: reaction
4385)
4386) PetscInt :: ghosted_id
4387) PetscErrorCode :: ierr
4388)
4389) option => realization%option
4390) patch => realization%patch
4391) grid => patch%grid
4392) field => realization%field
4393) reaction => realization%reaction
4394)
4395) ! This subroutine assumes that the auxiliary variables are current!
4396)
4397) if (reaction%surface_complexation%nkinmrsrfcplxrxn > 0) then
4398) do ghosted_id = 1, grid%ngmax
4399) if (grid%nG2L(ghosted_id) < 0) cycle ! bypass ghosted corner cells
4400) !geh - Ignore inactive cells with inactive materials
4401) if (patch%imat(ghosted_id) <= 0) cycle
4402) call RJumpStartKineticSorption(patch%aux%RT%auxvars(ghosted_id), &
4403) patch%aux%Global%auxvars(ghosted_id), &
4404) patch%aux%Material%auxvars(ghosted_id), &
4405) reaction,option)
4406) enddo
4407) endif
4408)
4409) end subroutine RTJumpStartKineticSorption
4410)
4411) ! ************************************************************************** !
4412)
4413) subroutine RTCheckpointKineticSorptionBinary(realization,viewer,checkpoint)
4414) !
4415) ! Checkpoints expliclity stored sorbed
4416) ! concentrations
4417) !
4418) ! Author: Glenn Hammond
4419) ! Date: 08/06/09
4420) !
4421)
4422) use Realization_Subsurface_class
4423) use Patch_module
4424) use Grid_module
4425) use Option_module
4426) use Field_module
4427)
4428) type(realization_subsurface_type) :: realization
4429) PetscViewer :: viewer
4430) PetscBool :: checkpoint
4431)
4432) type(option_type), pointer :: option
4433) type(reaction_type), pointer :: reaction
4434) type(grid_type), pointer :: grid
4435) type(field_type), pointer :: field
4436) type(patch_type), pointer :: patch
4437) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
4438) PetscReal, pointer :: vec_p(:)
4439)
4440) PetscBool :: checkpoint_flag(realization%reaction%naqcomp)
4441) PetscInt :: i, j, irxn, icomp, icplx, ncomp, ncplx, irate, ikinmrrxn
4442) PetscInt :: local_id
4443) PetscErrorCode :: ierr
4444)
4445) option => realization%option
4446) reaction => realization%reaction
4447) field => realization%field
4448) patch => realization%patch
4449)
4450) checkpoint_flag = PETSC_FALSE
4451)
4452) ! Loop over sorption reactions to find the necessary components
4453)
4454) do ikinmrrxn = 1, reaction%surface_complexation%nkinmrsrfcplxrxn
4455) irxn = reaction%surface_complexation%kinmrsrfcplxrxn_to_srfcplxrxn(ikinmrrxn)
4456) ncplx = reaction%surface_complexation%srfcplxrxn_to_complex(0,irxn)
4457) do j = 1, ncplx
4458) icplx = reaction%surface_complexation%srfcplxrxn_to_complex(j,irxn)
4459) ncomp = reaction%surface_complexation%srfcplxspecid(0,icplx)
4460) do i = 1, ncomp
4461) icomp = reaction%surface_complexation%srfcplxspecid(i,icplx)
4462) checkpoint_flag(icomp) = PETSC_TRUE
4463) enddo
4464) enddo
4465) enddo
4466)
4467) rt_auxvars => patch%aux%RT%auxvars
4468) grid => patch%grid
4469) do icomp = 1, reaction%naqcomp
4470) if (checkpoint_flag(icomp)) then
4471) do irxn = 1, reaction%surface_complexation%nkinmrsrfcplxrxn
4472) do irate = 1, reaction%surface_complexation%kinmr_nrate(irxn)
4473) if (checkpoint) then
4474) call VecGetArrayF90(field%work,vec_p,ierr);CHKERRQ(ierr)
4475) do local_id = 1, grid%nlmax
4476) vec_p(local_id) = &
4477) rt_auxvars(grid%nL2G(local_id))% &
4478) kinmr_total_sorb(icomp,irate,irxn)
4479) enddo
4480) call VecRestoreArrayF90(field%work,vec_p,ierr);CHKERRQ(ierr)
4481) call VecView(field%work,viewer,ierr);CHKERRQ(ierr)
4482) else
4483) call VecLoad(field%work,viewer,ierr);CHKERRQ(ierr)
4484) if (.not.option%transport%no_restart_kinetic_sorption) then
4485) call VecGetArrayF90(field%work,vec_p,ierr);CHKERRQ(ierr)
4486) do local_id = 1, grid%nlmax
4487) rt_auxvars(grid%nL2G(local_id))% &
4488) kinmr_total_sorb(icomp,irate,irxn) = &
4489) vec_p(local_id)
4490) enddo
4491) call VecRestoreArrayF90(field%work,vec_p,ierr);CHKERRQ(ierr)
4492) endif
4493) endif
4494) enddo
4495) enddo
4496) endif
4497) enddo
4498)
4499) end subroutine RTCheckpointKineticSorptionBinary
4500)
4501) ! ************************************************************************** !
4502)
4503) subroutine RTCheckpointKineticSorptionHDF5(realization, pm_grp_id, checkpoint)
4504) !
4505) ! Checkpoints expliclity stored sorbed
4506) ! concentrations
4507) !
4508) ! Author: Gautam Bisht, LBNL
4509) ! Date: 07/30/15
4510) !
4511)
4512) #if !defined(PETSC_HAVE_HDF5)
4513) use Realization_Subsurface_class
4514) use Option_module
4515)
4516) implicit none
4517)
4518) type(realization_subsurface_type) :: realization
4519) integer :: pm_grp_id
4520) PetscBool :: checkpoint
4521)
4522) PetscErrorCode :: ierr
4523)
4524) call printMsg(realization%option,'')
4525) write(realization%option%io_buffer, &
4526) '("PFLOTRAN must be compiled with HDF5 to &
4527) &write HDF5 formatted checkpoint file. Darn.")')
4528) call printErrMsg(realization%option)
4529)
4530) #else
4531)
4532) use Realization_Subsurface_class
4533) use Patch_module
4534) use Grid_module
4535) use Option_module
4536) use Field_module
4537) use hdf5
4538) use Discretization_module
4539) use HDF5_module, only : HDF5WriteDataSetFromVec, &
4540) HDF5ReadDataSetInVec
4541)
4542) type(realization_subsurface_type) :: realization
4543) #if defined(SCORPIO_WRITE)
4544) integer :: pm_grp_id
4545) #else
4546) integer(HID_T) :: pm_grp_id
4547) #endif
4548) PetscBool :: checkpoint
4549)
4550) type(option_type), pointer :: option
4551) type(reaction_type), pointer :: reaction
4552) type(grid_type), pointer :: grid
4553) type(field_type), pointer :: field
4554) type(patch_type), pointer :: patch
4555) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
4556) PetscReal, pointer :: vec_p(:)
4557)
4558) Vec :: natural_vec
4559) character(len=MAXSTRINGLENGTH) :: string
4560) character(len=MAXSTRINGLENGTH) :: dataset_name
4561)
4562) PetscBool :: checkpoint_flag(realization%reaction%naqcomp)
4563) PetscInt :: i, j, irxn, icomp, icplx, ncomp, ncplx, irate, ikinmrrxn
4564) PetscInt :: local_id
4565) PetscErrorCode :: ierr
4566)
4567) option => realization%option
4568) reaction => realization%reaction
4569) field => realization%field
4570) patch => realization%patch
4571)
4572) checkpoint_flag = PETSC_FALSE
4573)
4574) call DiscretizationCreateVector(realization%discretization, ONEDOF, &
4575) natural_vec, NATURAL, option)
4576)
4577) ! Loop over sorption reactions to find the necessary components
4578)
4579) do ikinmrrxn = 1, reaction%surface_complexation%nkinmrsrfcplxrxn
4580) irxn = reaction%surface_complexation%kinmrsrfcplxrxn_to_srfcplxrxn(ikinmrrxn)
4581) ncplx = reaction%surface_complexation%srfcplxrxn_to_complex(0,irxn)
4582) do j = 1, ncplx
4583) icplx = reaction%surface_complexation%srfcplxrxn_to_complex(j,irxn)
4584) ncomp = reaction%surface_complexation%srfcplxspecid(0,icplx)
4585) do i = 1, ncomp
4586) icomp = reaction%surface_complexation%srfcplxspecid(i,icplx)
4587) checkpoint_flag(icomp) = PETSC_TRUE
4588) enddo
4589) enddo
4590) enddo
4591)
4592) rt_auxvars => patch%aux%RT%auxvars
4593) grid => patch%grid
4594) do icomp = 1, reaction%naqcomp
4595) if (checkpoint_flag(icomp)) then
4596) do irxn = 1, reaction%surface_complexation%nkinmrsrfcplxrxn
4597) do irate = 1, reaction%surface_complexation%kinmr_nrate(irxn)
4598) if (checkpoint) then
4599)
4600) ! Write in a HDF5
4601) call VecGetArrayF90(field%work,vec_p,ierr);CHKERRQ(ierr)
4602) do local_id = 1, grid%nlmax
4603) vec_p(local_id) = &
4604) rt_auxvars(grid%nL2G(local_id))% &
4605) kinmr_total_sorb(icomp,irate,irxn)
4606) enddo
4607) call VecRestoreArrayF90(field%work,vec_p,ierr);CHKERRQ(ierr)
4608)
4609) call DiscretizationGlobalToNatural(realization%discretization, field%work, &
4610) natural_vec, NTRANDOF)
4611) write(string,*) icomp
4612) dataset_name = 'Kinetic_sorption_' // trim(adjustl(string)) // 'comp_'
4613) write(string,*) irxn
4614) dataset_name = trim(adjustl(dataset_name)) // trim(adjustl(string)) // 'rxn_'
4615) write(string,*) irate
4616) dataset_name = trim(adjustl(dataset_name)) // trim(adjustl(string)) // 'rate'
4617) call HDF5WriteDataSetFromVec(dataset_name, option, natural_vec, &
4618) pm_grp_id, H5T_NATIVE_DOUBLE)
4619)
4620) else
4621)
4622) ! Read from a HDF5
4623) write(string,*) icomp
4624) dataset_name = 'Kinetic_sorption_' // trim(adjustl(string)) // 'comp_'
4625) write(string,*) irxn
4626) dataset_name = trim(adjustl(dataset_name)) // trim(adjustl(string)) // 'rxn_'
4627) write(string,*) irate
4628) dataset_name = trim(adjustl(dataset_name)) // trim(adjustl(string)) // 'rate'
4629)
4630) call HDF5ReadDataSetInVec(dataset_name, option, natural_vec, &
4631) pm_grp_id, H5T_NATIVE_DOUBLE)
4632) call DiscretizationNaturalToGlobal(realization%discretization, natural_vec, &
4633) field%work, ONEDOF)
4634)
4635) if (.not.option%transport%no_restart_kinetic_sorption) then
4636) call VecGetArrayF90(field%work,vec_p,ierr);CHKERRQ(ierr)
4637) do local_id = 1, grid%nlmax
4638) rt_auxvars(grid%nL2G(local_id))% &
4639) kinmr_total_sorb(icomp,irate,irxn) = &
4640) vec_p(local_id)
4641) enddo
4642) call VecRestoreArrayF90(field%work,vec_p,ierr);CHKERRQ(ierr)
4643) endif
4644)
4645) endif
4646) enddo
4647) enddo
4648) endif
4649) enddo
4650) #endif
4651)
4652) end subroutine RTCheckpointKineticSorptionHDF5
4653)
4654) ! ************************************************************************** !
4655)
4656) subroutine RTExplicitAdvection(realization)
4657) !
4658) ! Updates advective transport explicitly
4659) !
4660) ! Author: Glenn Hammond
4661) ! Date: 02/03/12
4662) !
4663)
4664) use Realization_Subsurface_class
4665)
4666) use Discretization_module
4667) use Patch_module
4668) use Option_module
4669) use Field_module
4670) use Grid_module
4671) use Connection_module
4672) use Coupler_module
4673) use Debug_module
4674)
4675) implicit none
4676)
4677) type(realization_subsurface_type) :: realization
4678)
4679) PetscInt :: local_id, ghosted_id
4680) type(grid_type), pointer :: grid
4681) type(option_type), pointer :: option
4682) type(field_type), pointer :: field
4683) type(patch_type), pointer :: patch
4684) type(reaction_type), pointer :: reaction
4685) type(discretization_type), pointer :: discretization
4686) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:), rt_auxvars_bc(:)
4687) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
4688) class(material_auxvar_type), pointer :: material_auxvars(:)
4689)
4690) type(coupler_type), pointer :: boundary_condition, source_sink
4691) type(connection_set_list_type), pointer :: connection_set_list
4692) type(connection_set_type), pointer :: cur_connection_set
4693) PetscInt :: sum_connection, iconn
4694) PetscInt :: ghosted_id_up, ghosted_id_dn, local_id_up, local_id_dn
4695) PetscInt :: iphase
4696) PetscInt :: id_up2, id_dn2
4697) PetscInt :: local_start, local_end, istart, iend
4698) PetscInt :: ntvddof
4699) PetscReal :: qsrc, coef_in, coef_out
4700) PetscReal :: velocity, area, psv_t
4701) PetscReal :: flux(realization%reaction%ncomp)
4702)
4703) PetscReal :: sum_flux(realization%reaction%ncomp,realization%patch%grid%ngmax)
4704)
4705) PetscReal, pointer :: tran_xx_p(:)
4706) PetscReal, pointer :: tvd_ghosts_p(:)
4707) PetscReal, pointer :: rhs_coef_p(:)
4708) PetscReal, pointer :: total_up2(:,:), total_dn2(:,:)
4709) PetscErrorCode :: ierr
4710) PetscViewer :: viewer
4711)
4712) procedure (TFluxLimiterDummy), pointer :: TFluxLimitPtr
4713)
4714) select case(realization%option%transport%tvd_flux_limiter)
4715) case(TVD_LIMITER_UPWIND)
4716) TFluxLimitPtr => TFluxLimitUpwind
4717) case(TVD_LIMITER_MC)
4718) TFluxLimitPtr => TFluxLimitMC
4719) case(TVD_LIMITER_MINMOD)
4720) TFluxLimitPtr => TFluxLimitMinmod
4721) case(TVD_LIMITER_SUPERBEE)
4722) TFluxLimitPtr => TFluxLimitSuperBee
4723) case(TVD_LIMITER_VAN_LEER)
4724) TFluxLimitPtr => TFluxLimitVanLeer
4725) case default
4726) TFluxLimitPtr => TFluxLimiter
4727) end select
4728)
4729) option => realization%option
4730) field => realization%field
4731) patch => realization%patch
4732) discretization => realization%discretization
4733) reaction => realization%reaction
4734) grid => patch%grid
4735) ! rt_parameter => patch%aux%RT%rt_parameter
4736) rt_auxvars => patch%aux%RT%auxvars
4737) rt_auxvars_bc => patch%aux%RT%auxvars_bc
4738) global_auxvars => patch%aux%Global%auxvars
4739) global_auxvars_bc => patch%aux%Global%auxvars_bc
4740) material_auxvars => patch%aux%Material%auxvars
4741)
4742) ntvddof = patch%aux%RT%rt_parameter%naqcomp
4743)
4744) if (realization%option%transport%tvd_flux_limiter /= TVD_LIMITER_UPWIND) then
4745) allocate(total_up2(option%nphase,ntvddof))
4746) allocate(total_dn2(option%nphase,ntvddof))
4747) else
4748) ! these must be nullifed so that the explicit scheme ignores them
4749) nullify(total_up2)
4750) nullify(total_up2)
4751) endif
4752)
4753) ! load total component concentrations into tran_xx_p. it will be used
4754) ! as local storage here and eventually be overwritten upon leaving
4755) ! this routine
4756) call VecGetArrayF90(field%tran_xx,tran_xx_p,ierr);CHKERRQ(ierr)
4757) tran_xx_p = 0.d0
4758) do local_id = 1, grid%nlmax
4759) ghosted_id = grid%nL2G(local_id)
4760) if (patch%imat(ghosted_id) <= 0) cycle
4761) local_end = local_id*ntvddof
4762) local_start = local_end-ntvddof+1
4763) do iphase = 1, option%nphase
4764) tran_xx_p(local_start:local_end) = &
4765) rt_auxvars(ghosted_id)%total(:,iphase)
4766) enddo
4767) enddo
4768) call VecRestoreArrayF90(field%tran_xx,tran_xx_p,ierr);CHKERRQ(ierr)
4769) call VecScatterBegin(discretization%tvd_ghost_scatter,field%tran_xx, &
4770) field%tvd_ghosts,INSERT_VALUES,SCATTER_FORWARD, &
4771) ierr);CHKERRQ(ierr)
4772) call VecScatterEnd(discretization%tvd_ghost_scatter,field%tran_xx, &
4773) field%tvd_ghosts,INSERT_VALUES,SCATTER_FORWARD, &
4774) ierr);CHKERRQ(ierr)
4775)
4776) ! Update Boundary Concentrations------------------------------
4777) call VecGetArrayF90(field%tvd_ghosts,tvd_ghosts_p,ierr);CHKERRQ(ierr)
4778) boundary_condition => patch%boundary_condition_list%first
4779) sum_connection = 0
4780) do
4781) if (.not.associated(boundary_condition)) exit
4782) cur_connection_set => boundary_condition%connection_set
4783) if (associated(cur_connection_set%id_dn2)) then
4784) do iconn = 1, cur_connection_set%num_connections
4785) sum_connection = sum_connection + 1
4786) id_dn2 = cur_connection_set%id_dn2(iconn)
4787) if (id_dn2 < 0) then
4788) iend = abs(id_dn2)*ntvddof
4789) istart = iend-ntvddof+1
4790) tvd_ghosts_p(istart:iend) = rt_auxvars_bc(sum_connection)%total(1,:)
4791) endif
4792) enddo
4793) endif
4794) boundary_condition => boundary_condition%next
4795) enddo
4796) call VecRestoreArrayF90(field%tvd_ghosts,tvd_ghosts_p,ierr);CHKERRQ(ierr)
4797) #if TVD_DEBUG
4798) call PetscViewerASCIIOpen(option%mycomm,'tvd_ghosts.out', &
4799) viewer,ierr);CHKERRQ(ierr)
4800) call VecView(field%tvd_ghosts,viewer,ierr);CHKERRQ(ierr)
4801) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
4802) #endif
4803)
4804) sum_flux = 0.d0
4805)
4806) if (reaction%ncoll > 0) then
4807) option%io_buffer = &
4808) 'Need to add colloidal source/sinks to RTExplicitAdvection()'
4809) call printErrMsg(option)
4810) endif
4811) if (option%nphase > 1) then
4812) option%io_buffer = &
4813) 'Need to add multiphase source/sinks to RTExplicitAdvection()'
4814) call printErrMsg(option)
4815) endif
4816) if (reaction%ncomp /= reaction%naqcomp) then
4817) option%io_buffer = &
4818) 'Need to account for non-aqueous species to RTExplicitAdvection()'
4819) call printErrMsg(option)
4820) endif
4821) if (option%compute_mass_balance_new) then
4822) option%io_buffer = &
4823) 'Mass balance not yet supported in RTExplicitAdvection()'
4824) call printErrMsg(option)
4825) endif
4826)
4827) ! Interior Flux Terms -----------------------------------
4828) call VecGetArrayF90(field%tvd_ghosts,tvd_ghosts_p,ierr);CHKERRQ(ierr)
4829) connection_set_list => grid%internal_connection_set_list
4830) cur_connection_set => connection_set_list%first
4831) sum_connection = 0
4832) do
4833) if (.not.associated(cur_connection_set)) exit
4834) do iconn = 1, cur_connection_set%num_connections
4835) sum_connection = sum_connection + 1
4836)
4837) ghosted_id_up = cur_connection_set%id_up(iconn)
4838) ghosted_id_dn = cur_connection_set%id_dn(iconn)
4839)
4840) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
4841) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
4842)
4843) if (patch%imat(ghosted_id_up) <= 0 .or. &
4844) patch%imat(ghosted_id_dn) <= 0) cycle
4845)
4846) if (associated(cur_connection_set%id_dn2)) then
4847) id_up2 = cur_connection_set%id_up2(iconn)
4848) if (id_up2 > 0) then
4849) total_up2 = rt_auxvars(id_up2)%total
4850) else
4851) iend = abs(id_up2)*ntvddof
4852) istart = iend-ntvddof+1
4853) total_up2(1,:) = tvd_ghosts_p(istart:iend)
4854) endif
4855) id_dn2 = cur_connection_set%id_dn2(iconn)
4856) if (id_dn2 > 0) then
4857) total_dn2 = rt_auxvars(id_dn2)%total
4858) else
4859) iend = abs(id_dn2)*ntvddof
4860) istart = iend-ntvddof+1
4861) total_dn2(1,:) = tvd_ghosts_p(istart:iend)
4862) endif
4863) endif
4864) call TFluxTVD(patch%aux%RT%rt_parameter, &
4865) patch%internal_velocities(:,sum_connection), &
4866) cur_connection_set%area(iconn), &
4867) cur_connection_set%dist(:,iconn), &
4868) total_up2, &
4869) rt_auxvars(ghosted_id_up), &
4870) rt_auxvars(ghosted_id_dn), &
4871) total_dn2, &
4872) TFluxLimitPtr, &
4873) option,flux)
4874)
4875) ! contribution upwind
4876) sum_flux(:,ghosted_id_up) = sum_flux(:,ghosted_id_up) - flux
4877)
4878) ! contribution downwind
4879) sum_flux(:,ghosted_id_dn) = sum_flux(:,ghosted_id_dn) + flux
4880)
4881) enddo ! iconn
4882) cur_connection_set => cur_connection_set%next
4883) enddo
4884) call VecRestoreArrayF90(field%tvd_ghosts,tvd_ghosts_p,ierr);CHKERRQ(ierr)
4885)
4886) ! Boundary Flux Terms -----------------------------------
4887) boundary_condition => patch%boundary_condition_list%first
4888) sum_connection = 0
4889) do
4890) if (.not.associated(boundary_condition)) exit
4891)
4892) cur_connection_set => boundary_condition%connection_set
4893)
4894) do iconn = 1, cur_connection_set%num_connections
4895) sum_connection = sum_connection + 1
4896)
4897) local_id = cur_connection_set%id_dn(iconn)
4898) ghosted_id = grid%nL2G(local_id)
4899)
4900) if (patch%imat(ghosted_id) <= 0) cycle
4901)
4902) if (associated(cur_connection_set%id_dn2)) then
4903) total_up2 = rt_auxvars_bc(sum_connection)%total
4904) id_dn2 = cur_connection_set%id_dn2(iconn)
4905) if (id_dn2 > 0) then
4906) total_dn2 = rt_auxvars(id_dn2)%total
4907) else
4908) iend = abs(id_dn2)*ntvddof
4909) istart = iend-ntvddof+1
4910) total_dn2(1,:) = tvd_ghosts_p(istart:iend)
4911) endif
4912) endif
4913) call TFluxTVD(patch%aux%RT%rt_parameter, &
4914) patch%boundary_velocities(:,sum_connection), &
4915) cur_connection_set%area(iconn), &
4916) cur_connection_set%dist(:,iconn), &
4917) total_up2, &
4918) rt_auxvars_bc(sum_connection), &
4919) rt_auxvars(ghosted_id), &
4920) total_dn2, &
4921) TFluxLimitPtr, &
4922) option,flux)
4923)
4924) ! contribution downwind
4925) sum_flux(:,ghosted_id) = sum_flux(:,ghosted_id) + flux
4926) #if 0
4927)
4928) do iphase = 1, option%nphase
4929) velocity = patch%boundary_velocities(iphase,sum_connection)
4930) area = cur_connection_set%area(iconn)
4931)
4932) if (velocity > 0.d0) then ! inflow
4933) flux = velocity*area* &
4934) rt_auxvars_bc(sum_connection)%total(:,iphase)
4935) else ! outflow
4936) flux = velocity*area* &
4937) rt_auxvars(ghosted_id)%total(:,iphase)
4938) endif
4939)
4940) ! contribution downwind
4941) sum_flux(:,ghosted_id) = sum_flux(:,ghosted_id) + flux
4942)
4943) enddo ! iphase
4944) #endif
4945)
4946) enddo
4947) boundary_condition => boundary_condition%next
4948) enddo
4949)
4950) ! Source/sink terms -------------------------------------
4951) source_sink => patch%source_sink_list%first
4952) sum_connection = 0
4953) do
4954) if (.not.associated(source_sink)) exit
4955) cur_connection_set => source_sink%connection_set
4956) do iconn = 1, cur_connection_set%num_connections
4957) sum_connection = sum_connection + 1
4958) local_id = cur_connection_set%id_dn(iconn)
4959) ghosted_id = grid%nL2G(local_id)
4960)
4961) if (patch%imat(ghosted_id) <= 0) cycle
4962)
4963) do iphase = 1, option%nphase
4964) qsrc = patch%ss_flow_vol_fluxes(iphase,sum_connection)
4965) call TSrcSinkCoef(option,qsrc,source_sink%tran_condition%itype, &
4966) coef_in,coef_out)
4967) flux = coef_in*rt_auxvars(ghosted_id)%total(:,iphase) + &
4968) coef_out*source_sink%tran_condition%cur_constraint_coupler% &
4969) rt_auxvar%total(:,iphase)
4970) !geh: TSrcSinkCoef() unit are in L/s.
4971) sum_flux(:,ghosted_id) = sum_flux(:,ghosted_id) + flux
4972) enddo
4973) enddo
4974) source_sink => source_sink%next
4975) enddo
4976)
4977) call VecGetArrayF90(field%tran_xx,tran_xx_p,ierr);CHKERRQ(ierr)
4978) call VecGetArrayReadF90(field%tran_rhs_coef,rhs_coef_p,ierr);CHKERRQ(ierr)
4979)
4980)
4981) ! update concentration
4982) iphase = 1
4983) do local_id = 1, grid%nlmax
4984) ghosted_id = grid%nL2G(local_id)
4985) if (patch%imat(ghosted_id) <= 0) cycle
4986) local_end = local_id*ntvddof
4987) local_start = local_end-ntvddof+1
4988) ! do iphase = 1, option%nphase
4989) ! psv_t must have same units [mol/sec] and be consistent with rhs_coef_p
4990) ! in RTUpdateRHSCoefs()
4991) psv_t = material_auxvars(ghosted_id)%porosity* &
4992) global_auxvars(ghosted_id)%sat(iphase)* &
4993) 1000.d0* &
4994) material_auxvars(ghosted_id)%volume/option%tran_dt
4995) !geh: clearly dangerous that I reload into total, but I am going to do it!
4996) tran_xx_p(local_start:local_end) = &
4997) ((rhs_coef_p(local_id)*rt_auxvars(ghosted_id)%total(:,iphase)) + &
4998) sum_flux(:,ghosted_id)) / psv_t
4999) ! enddo
5000) enddo
5001)
5002) if (associated(total_up2)) then
5003) deallocate(total_up2)
5004) nullify(total_up2)
5005) deallocate(total_dn2)
5006) nullify(total_dn2)
5007) endif
5008)
5009) ! Restore vectors
5010) call VecRestoreArrayF90(field%tran_xx,tran_xx_p,ierr);CHKERRQ(ierr)
5011) call VecRestoreArrayReadF90(field%tran_rhs_coef,rhs_coef_p, &
5012) ierr);CHKERRQ(ierr)
5013)
5014) end subroutine RTExplicitAdvection
5015)
5016) ! ************************************************************************** !
5017)
5018) subroutine RTWriteToHeader(fid,variable_string,cell_string,icolumn)
5019) !
5020) ! Appends formatted strings to header string
5021) !
5022) ! Author: Glenn Hammond
5023) ! Date: 10/27/11
5024) !
5025)
5026) PetscInt :: fid
5027) character(len=*) :: variable_string
5028) character(len=MAXSTRINGLENGTH) :: cell_string
5029) character(len=MAXSTRINGLENGTH) :: variable_string_adj
5030) character(len=MAXWORDLENGTH) :: column_string
5031) PetscInt :: icolumn
5032)
5033) character(len=MAXSTRINGLENGTH) :: string
5034) PetscInt :: len_cell_string
5035)
5036) variable_string_adj = variable_string
5037) !geh: Shift to left. Cannot perform on same string since len=*
5038) variable_string_adj = adjustl(variable_string_adj)
5039)
5040) if (icolumn > 0) then
5041) icolumn = icolumn + 1
5042) write(column_string,'(i4,''-'')') icolumn
5043) column_string = trim(adjustl(column_string))
5044) else
5045) column_string = ''
5046) endif
5047)
5048) !geh: this is all to remove the lousy spaces
5049) len_cell_string = len_trim(cell_string)
5050)
5051) if (len_cell_string > 0) then
5052) write(string,'('',"'',a,a,'' '',a,''"'')') trim(column_string), &
5053) trim(variable_string_adj), trim(cell_string)
5054) else
5055) write(string,'('',"'',a,a,''"'')') trim(column_string), &
5056) trim(variable_string_adj)
5057) endif
5058) write(fid,'(a)',advance="no") trim(string)
5059)
5060) end subroutine RTWriteToHeader
5061)
5062) ! ************************************************************************** !
5063)
5064) subroutine RTClearActivityCoefficients(realization)
5065) !
5066) ! Sets activity coefficients back to 1.
5067) !
5068) ! Author: Glenn Hammond
5069) ! Date: 08/11/14
5070) !
5071)
5072) use Realization_Subsurface_class
5073) use Reactive_Transport_Aux_module
5074) use Option_module
5075) use Field_module
5076) use Grid_module
5077) use Secondary_Continuum_Aux_module
5078)
5079) implicit none
5080)
5081) type(realization_subsurface_type) :: realization
5082)
5083) type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
5084) PetscInt :: ghosted_id
5085)
5086) rt_auxvars => realization%patch%aux%RT%auxvars
5087)
5088) do ghosted_id = 1, realization%patch%grid%ngmax
5089) rt_auxvars(ghosted_id)%pri_act_coef = 1.d0
5090) if (associated(rt_auxvars(ghosted_id)%sec_act_coef)) then
5091) rt_auxvars(ghosted_id)%sec_act_coef = 1.d0
5092) endif
5093) enddo
5094)
5095) end subroutine RTClearActivityCoefficients
5096)
5097) ! ************************************************************************** !
5098)
5099) subroutine RTDestroy(realization)
5100) !
5101) ! Deallocates variables associated with Reactive Transport
5102) !
5103) ! Author: Glenn Hammond
5104) ! Date: 02/03/09
5105) !
5106)
5107) use Realization_Subsurface_class
5108) use Patch_module
5109) use Option_module
5110)
5111) type(realization_subsurface_type) :: realization
5112)
5113) #ifdef OS_STATISTICS
5114) type(option_type), pointer :: option
5115) PetscErrorCode :: ierr
5116)
5117) PetscReal :: temp_real_in(3), temp_real_out(3)
5118) PetscReal :: call_count
5119) PetscReal :: sum_newton_iterations
5120) PetscReal :: ave_newton_iterations_in_a_cell
5121) PetscInt :: max_newton_iterations_in_a_cell
5122) PetscReal :: max_newton_iterations_on_a_core
5123) PetscReal :: min_newton_iterations_on_a_core
5124)
5125) PetscReal :: sum, ave, var, value
5126) PetscInt :: irank
5127) PetscReal, allocatable :: tot_newton_iterations(:)
5128)
5129) option => realization%option
5130) call_count = 0.d0
5131) sum_newton_iterations = 0.d0
5132) max_newton_iterations_in_a_cell = -99999999
5133) max_newton_iterations_on_a_core = -99999999.d0
5134) min_newton_iterations_on_a_core = 99999999.d0
5135)
5136) #endif
5137)
5138) #ifdef OS_STATISTICS
5139) call_count = call_count + &
5140) cur_patch%aux%RT%rt_parameter%sum_newton_call_count
5141) sum_newton_iterations = sum_newton_iterations + &
5142) cur_patch%aux%RT%rt_parameter%sum_newton_iterations
5143) if (cur_patch%aux%RT%rt_parameter%overall_max_newton_iterations > &
5144) max_newton_iterations_in_a_cell) then
5145) max_newton_iterations_in_a_cell = &
5146) cur_patch%aux%RT%rt_parameter%overall_max_newton_iterations
5147) endif
5148) #endif
5149)
5150) #ifdef OS_STATISTICS
5151) if (option%reactive_transport_coupling == OPERATOR_SPLIT) then
5152) temp_real_in(1) = call_count
5153) temp_real_in(2) = sum_newton_iterations
5154) call MPI_Allreduce(temp_real_in,temp_real_out,TWO_INTEGER_MPI, &
5155) MPI_DOUBLE_PRECISION,MPI_SUM,option%mycomm,ierr)
5156) ave_newton_iterations_in_a_cell = temp_real_out(2)/temp_real_out(1)
5157)
5158) temp_real_in(1) = dble(max_newton_iterations_in_a_cell)
5159) temp_real_in(2) = sum_newton_iterations
5160) temp_real_in(3) = -sum_newton_iterations
5161) call MPI_Allreduce(temp_real_in,temp_real_out,THREE_INTEGER_MPI, &
5162) MPI_DOUBLE_PRECISION,MPI_MAX,option%mycomm,ierr)
5163) max_newton_iterations_in_a_cell = int(temp_real_out(1)+1.d-4)
5164) max_newton_iterations_on_a_core = temp_real_out(2)
5165) min_newton_iterations_on_a_core = -temp_real_out(3)
5166)
5167) ! Now let's compute the variance!
5168) call OptionMeanVariance(sum_newton_iterations,ave,var,PETSC_TRUE,option)
5169)
5170) if (option%print_screen_flag) then
5171) write(*, '(/,/" OS Reaction Statistics (Overall): ",/, &
5172) & " Ave Newton Its / Cell: ",1pe12.4,/, &
5173) & " Max Newton Its / Cell: ",i4,/, &
5174) & " Max Newton Its / Core: ",1pe12.4,/, &
5175) & " Min Newton Its / Core: ",1pe12.4,/, &
5176) & " Ave Newton Its / Core: ",1pe12.4,/, &
5177) & " Std Dev Newton Its / Core: ",1pe12.4,/)') &
5178) ave_newton_iterations_in_a_cell, &
5179) max_newton_iterations_in_a_cell, &
5180) max_newton_iterations_on_a_core, &
5181) min_newton_iterations_on_a_core, &
5182) ave, &
5183) sqrt(var)
5184)
5185) endif
5186)
5187) if (option%print_file_flag) then
5188) write(option%fid_out, '(/,/" OS Reaction Statistics (Overall): ",/, &
5189) & " Ave Newton Its / Cell: ",1pe12.4,/, &
5190) & " Max Newton Its / Cell: ",i4,/, &
5191) & " Max Newton Its / Core: ",1pe12.4,/, &
5192) & " Min Newton Its / Core: ",1pe12.4,/, &
5193) & " Ave Newton Its / Core: ",1pe12.4,/, &
5194) & " Std Dev Newton Its / Core: ",1pe12.4,/)') &
5195) ave_newton_iterations_in_a_cell, &
5196) max_newton_iterations_in_a_cell, &
5197) max_newton_iterations_on_a_core, &
5198) min_newton_iterations_on_a_core, &
5199) ave, &
5200) sqrt(var)
5201) endif
5202) endif
5203)
5204) #endif
5205)
5206)
5207) end subroutine RTDestroy
5208)
5209) end module Reactive_Transport_module