pm_rt.F90 coverage: 79.31 %func 77.16 %block
1) module PM_RT_class
2)
3) use PM_Base_class
4) !geh: using Reactive_Transport_module here fails with gfortran (internal
5) ! compiler error)
6) ! use Reactive_Transport_module
7) use Realization_Subsurface_class
8) use Communicator_Base_module
9) use Option_module
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)
25) type, public, extends(pm_base_type) :: pm_rt_type
26) class(realization_subsurface_type), pointer :: realization
27) class(communicator_type), pointer :: comm1
28) class(communicator_type), pointer :: commN
29) ! local variables
30) PetscBool :: steady_flow
31) PetscReal :: tran_weight_t0
32) PetscReal :: tran_weight_t1
33) PetscBool :: check_post_convergence
34) ! these govern the size of subsequent time steps
35) PetscReal :: max_concentration_change
36) PetscReal :: max_volfrac_change
37) PetscReal :: volfrac_change_governor
38) ! for transport only
39) PetscBool :: transient_porosity
40) contains
41) procedure, public :: Setup => PMRTSetup
42) procedure, public :: Read => PMRTRead
43) procedure, public :: PMRTSetRealization
44) procedure, public :: InitializeRun => PMRTInitializeRun
45) procedure, public :: FinalizeRun => PMRTFinalizeRun
46) procedure, public :: InitializeTimestep => PMRTInitializeTimestep
47) procedure, public :: FinalizeTimestep => PMRTFinalizeTimestep
48) procedure, public :: Residual => PMRTResidual
49) procedure, public :: Jacobian => PMRTJacobian
50) procedure, public :: UpdateTimestep => PMRTUpdateTimestep
51) procedure, public :: PreSolve => PMRTPreSolve
52) procedure, public :: PostSolve => PMRTPostSolve
53) procedure, public :: AcceptSolution => PMRTAcceptSolution
54) procedure, public :: CheckUpdatePre => PMRTCheckUpdatePre
55) procedure, public :: CheckUpdatePost => PMRTCheckUpdatePost
56) procedure, public :: TimeCut => PMRTTimeCut
57) procedure, public :: UpdateSolution => PMRTUpdateSolution1
58) procedure, public :: UpdateAuxVars => PMRTUpdateAuxVars
59) procedure, public :: MaxChange => PMRTMaxChange
60) procedure, public :: ComputeMassBalance => PMRTComputeMassBalance
61) procedure, public :: SetTranWeights => SetTranWeights
62) procedure, public :: CheckpointBinary => PMRTCheckpointBinary
63) procedure, public :: CheckpointHDF5 => PMRTCheckpointHDF5
64) procedure, public :: RestartBinary => PMRTRestartBinary
65) procedure, public :: RestartHDF5 => PMRTRestartHDF5
66) procedure, public :: InputRecord => PMRTInputRecord
67) procedure, public :: Destroy => PMRTDestroy
68) end type pm_rt_type
69)
70) type, public, extends(pm_base_header_type) :: pm_rt_header_type
71) PetscInt :: checkpoint_activity_coefs
72) end type pm_rt_header_type
73)
74) public :: PMRTCreate
75)
76) contains
77)
78) ! ************************************************************************** !
79)
80) function PMRTCreate()
81) !
82) ! Creates reactive transport process models shell
83) !
84) ! Author: Glenn Hammond
85) ! Date: 03/14/13
86) !
87)
88) implicit none
89)
90) class(pm_rt_type), pointer :: PMRTCreate
91)
92) class(pm_rt_type), pointer :: rt_pm
93)
94) #ifdef PM_RT_DEBUG
95) print *, 'PMRTCreate()'
96) #endif
97)
98) allocate(rt_pm)
99) nullify(rt_pm%option)
100) nullify(rt_pm%output_option)
101) nullify(rt_pm%realization)
102) nullify(rt_pm%comm1)
103) nullify(rt_pm%commN)
104)
105) ! local variables
106) rt_pm%steady_flow = PETSC_FALSE
107) rt_pm%tran_weight_t0 = 0.d0
108) rt_pm%tran_weight_t1 = 0.d0
109) rt_pm%check_post_convergence = PETSC_FALSE
110) rt_pm%max_concentration_change = 0.d0
111) rt_pm%max_volfrac_change = 0.d0
112) rt_pm%volfrac_change_governor = 1.d0
113) ! these flags can only be true for transport only
114) rt_pm%transient_porosity = PETSC_FALSE
115)
116) call PMBaseInit(rt_pm)
117) rt_pm%name = 'PMRT'
118)
119) PMRTCreate => rt_pm
120)
121) end function PMRTCreate
122)
123) ! ************************************************************************** !
124)
125) subroutine PMRTRead(this,input)
126) !
127) ! Reads input file parameters associated with the reactive transport
128) ! process model
129) !
130) ! Author: Glenn Hammond
131) ! Date: 01/25/16
132) !
133) use Input_Aux_module
134) use String_module
135) use Option_module
136) use Reactive_Transport_Aux_module
137)
138) implicit none
139)
140) class(pm_rt_type) :: this
141) type(input_type), pointer :: input
142)
143) character(len=MAXWORDLENGTH) :: word
144) character(len=MAXSTRINGLENGTH) :: error_string
145) type(option_type), pointer :: option
146)
147) option => this%option
148)
149) error_string = 'Reactive Transport Options'
150)
151) input%ierr = 0
152) do
153)
154) call InputReadPflotranString(input,option)
155) if (InputError(input)) exit
156) if (InputCheckExit(input,option)) exit
157)
158) call InputReadWord(input,option,word,PETSC_TRUE)
159) call InputErrorMsg(input,option,'keyword',error_string)
160) call StringToUpper(word)
161)
162) select case(trim(word))
163) case('GLOBAL_IMPLICIT','OPERATOR_SPLIT','OPERATOR_SPLITTING')
164) case('MAX_VOLUME_FRACTION_CHANGE')
165) call InputReadDouble(input,option,this%volfrac_change_governor)
166) call InputDefaultMsg(input,option,'maximum volume fraction change')
167) case('ITOL_RELATIVE_UPDATE')
168) call InputReadDouble(input,option,rt_itol_rel_update)
169) call InputDefaultMsg(input,option,'rt_itol_rel_update')
170) this%check_post_convergence = PETSC_TRUE
171) case('NUMERICAL_JACOBIAN')
172) option%transport%numerical_derivatives = PETSC_TRUE
173) case default
174) call InputKeywordUnrecognized(word,error_string,option)
175) end select
176) enddo
177)
178) end subroutine PMRTRead
179)
180) ! ************************************************************************** !
181)
182) subroutine PMRTSetup(this)
183) !
184) ! Initializes variables associated with reactive transport
185) !
186) ! Author: Glenn Hammond
187) ! Date: 03/14/13
188) !
189)
190) #ifndef SIMPLIFY
191) use Discretization_module
192) use Communicator_Structured_class
193) use Communicator_Unstructured_class
194) use Grid_module
195) #endif
196)
197) implicit none
198)
199) class(pm_rt_type) :: this
200)
201) #ifdef PM_RT_DEBUG
202) call printMsg(this%option,'PMRT%Setup()')
203) #endif
204)
205) #ifndef SIMPLIFY
206) ! set up communicator
207) select case(this%realization%discretization%itype)
208) case(STRUCTURED_GRID)
209) this%commN => StructuredCommunicatorCreate()
210) case(UNSTRUCTURED_GRID)
211) this%commN => UnstructuredCommunicatorCreate()
212) end select
213) call this%commN%SetDM(this%realization%discretization%dm_ntrandof)
214) #endif
215)
216) ! set the communicator
217) this%comm1 => this%realization%comm1
218)
219) ! only set these flags if transport only
220) if (this%option%nflowdof == 0) then
221) if (associated(this%realization%reaction)) then
222) if (this%realization%reaction%update_porosity & !.or. &
223) ! this%realization%reaction%update_tortuosity .or. &
224) ! this%realization%reaction%update_mnrl_surf_with_porosity &
225) ) then
226) this%transient_porosity = PETSC_TRUE
227) endif
228) endif
229) endif
230)
231) end subroutine PMRTSetup
232)
233) ! ************************************************************************** !
234)
235) subroutine PMRTSetRealization(this,realization)
236) !
237) ! Author: Glenn Hammond
238) ! Date: 03/14/13
239) !
240)
241) use Realization_Subsurface_class
242)
243) implicit none
244)
245) class(pm_rt_type) :: this
246) class(realization_subsurface_type), pointer :: realization
247)
248) #ifdef PM_RT_DEBUG
249) call printMsg(this%option,'PMRT%SetRealization()')
250) #endif
251)
252) this%realization => realization
253) this%realization_base => realization
254)
255) if (realization%reaction%use_log_formulation) then
256) this%solution_vec = realization%field%tran_log_xx
257) else
258) this%solution_vec = realization%field%tran_xx
259) endif
260) this%residual_vec = realization%field%tran_r
261)
262) end subroutine PMRTSetRealization
263)
264) ! ************************************************************************** !
265)
266) recursive subroutine PMRTInitializeRun(this)
267) !
268) ! Initializes the time stepping
269) !
270) ! Author: Glenn Hammond
271) ! Date: 03/18/13
272) !
273)
274) use Reactive_Transport_module, only : RTUpdateEquilibriumState, &
275) RTJumpStartKineticSorption
276) use Condition_Control_module
277) use Reaction_Aux_module, only : ACT_COEF_FREQUENCY_OFF
278) use Reactive_Transport_module, only : RTUpdateAuxVars, &
279) RTClearActivityCoefficients
280) use Variables_module, only : POROSITY
281) use Material_Aux_class, only : POROSITY_MINERAL
282) use Material_module, only : MaterialGetAuxVarVecLoc
283)
284) implicit none
285)
286) class(pm_rt_type) :: this
287) PetscErrorCode :: ierr
288)
289) #ifdef PM_RT_DEBUG
290) call printMsg(this%option,'PMRT%InitializeRun()')
291) #endif
292)
293) ! check for uninitialized flow variables
294) call RealizUnInitializedVarsTran(this%realization)
295)
296) if (this%transient_porosity) then
297) call RealizationCalcMineralPorosity(this%realization)
298) call MaterialGetAuxVarVecLoc(this%realization%patch%aux%Material, &
299) this%realization%field%work_loc, &
300) POROSITY,POROSITY_MINERAL)
301) call this%comm1%LocalToGlobal(this%realization%field%work_loc, &
302) this%realization%field%porosity0)
303) call VecCopy(this%realization%field%porosity0, &
304) this%realization%field%porosity_t,ierr);CHKERRQ(ierr)
305) call VecCopy(this%realization%field%porosity0, &
306) this%realization%field%porosity_tpdt,ierr);CHKERRQ(ierr)
307) endif
308)
309) ! restart
310) if (this%option%restart_flag .and. &
311) this%option%overwrite_restart_transport) then
312) call RTClearActivityCoefficients(this%realization)
313) call CondControlAssignTranInitCond(this%realization)
314) endif
315)
316) ! pass PETSC_FALSE to turn off update of kinetic state variables
317) call PMRTUpdateSolution2(this,PETSC_FALSE)
318)
319) #if 0
320) if (this%option%jumpstart_kinetic_sorption .and. &
321) this%option%time < 1.d-40) then
322) ! only user jumpstart for a restarted simulation
323) if (.not. this%option%restart_flag) then
324) this%option%io_buffer = 'Only use JUMPSTART_KINETIC_SORPTION on a ' // &
325) 'restarted simulation. ReactionEquilibrateConstraint() will ' // &
326) 'appropriately set sorbed initial concentrations for a normal ' // &
327) '(non-restarted) simulation.'
328) call printErrMsg(this%option)
329) endif
330) call RTJumpStartKineticSorption(this%realization)
331) endif
332) ! check on MAX_STEPS < 0 to quit after initialization.
333) #endif
334)
335) end subroutine PMRTInitializeRun
336)
337) ! ************************************************************************** !
338)
339) subroutine PMRTInitializeTimestep(this)
340) !
341) ! Author: Glenn Hammond
342) ! Date: 03/14/13
343) !
344)
345) use Reactive_Transport_module, only : RTInitializeTimestep, &
346) RTUpdateTransportCoefs
347) use Global_module
348) use Material_module
349)
350) implicit none
351)
352) class(pm_rt_type) :: this
353) PetscReal :: time
354)
355) #ifdef PM_RT_DEBUG
356) call printMsg(this%option,'PMRT%InitializeTimestep()')
357) #endif
358)
359) this%option%tran_dt = this%option%dt
360)
361) if (this%option%print_screen_flag) then
362) write(*,'(/,2("=")," REACTIVE TRANSPORT ",58("="))')
363) endif
364)
365) ! interpolate flow parameters/data
366) ! this must remain here as these weighted values are used by both
367) ! RTInitializeTimestep and RTTimeCut (which calls RTInitializeTimestep)
368) if (this%option%nflowdof > 0 .and. .not. this%steady_flow) then
369) call this%SetTranWeights()
370) if (this%option%flow%transient_porosity) then
371) ! weight material properties (e.g. porosity)
372) call MaterialWeightAuxVars(this%realization%patch%aux%Material, &
373) this%tran_weight_t0, &
374) this%realization%field,this%comm1)
375) endif
376) ! set densities and saturations to t
377) call GlobalWeightAuxVars(this%realization,this%tran_weight_t0)
378) else if (this%transient_porosity) then
379) this%tran_weight_t0 = 0.d0
380) call MaterialWeightAuxVars(this%realization%patch%aux%Material, &
381) this%tran_weight_t0, &
382) this%realization%field,this%comm1)
383) endif
384)
385) call RTInitializeTimestep(this%realization)
386)
387) !geh: this is a bug and should be moved to PreSolve()
388) #if 0
389) ! set densities and saturations to t+dt
390) if (this%option%nflowdof > 0 .and. .not. this%steady_flow) then
391) if (this%option%flow%transient_porosity) then
392) ! weight material properties (e.g. porosity)
393) call MaterialWeightAuxVars(this%realization%patch%aux%Material, &
394) this%tran_weight_t1, &
395) this%realization%field,this%comm1)
396) endif
397) call GlobalWeightAuxVars(this%realization,this%tran_weight_t1)
398) else if (this%transient_porosity) then
399) this%tran_weight_t1 = 1.d0
400) call MaterialWeightAuxVars(this%realization%patch%aux%Material, &
401) this%tran_weight_t1, &
402) this%realization%field,this%comm1)
403) endif
404)
405) call RTUpdateTransportCoefs(this%realization)
406) #endif
407)
408) end subroutine PMRTInitializeTimestep
409)
410) ! ************************************************************************** !
411)
412) subroutine PMRTPreSolve(this)
413) !
414) ! Author: Glenn Hammond
415) ! Date: 03/14/13
416) !
417)
418) use Reactive_Transport_module, only : RTUpdateTransportCoefs, &
419) RTUpdateAuxVars
420) use Reaction_Aux_module, only : ACT_COEF_FREQUENCY_OFF
421) use Global_module
422) use Material_module
423) use Data_Mediator_module
424)
425) implicit none
426)
427) class(pm_rt_type) :: this
428)
429) PetscErrorCode :: ierr
430)
431) #ifdef PM_RT_DEBUG
432) call printMsg(this%option,'PMRT%UpdatePreSolve()')
433) #endif
434)
435) #if 1
436) call RTUpdateTransportCoefs(this%realization)
437) ! set densities and saturations to t+dt
438) if (this%option%nflowdof > 0 .and. .not. this%steady_flow) then
439) if (this%option%flow%transient_porosity) then
440) ! weight material properties (e.g. porosity)
441) call MaterialWeightAuxVars(this%realization%patch%aux%Material, &
442) this%tran_weight_t1, &
443) this%realization%field,this%comm1)
444) endif
445) call GlobalWeightAuxVars(this%realization,this%tran_weight_t1)
446) else if (this%transient_porosity) then
447) this%tran_weight_t1 = 1.d0
448) call MaterialWeightAuxVars(this%realization%patch%aux%Material, &
449) this%tran_weight_t1, &
450) this%realization%field,this%comm1)
451) endif
452)
453) call RTUpdateTransportCoefs(this%realization)
454) #endif
455)
456) if (this%realization%reaction%act_coef_update_frequency /= &
457) ACT_COEF_FREQUENCY_OFF) then
458) call RTUpdateAuxVars(this%realization,PETSC_TRUE,PETSC_TRUE,PETSC_TRUE)
459) ! The below is set within RTUpdateAuxVarsPatch() when
460) ! PETSC_TRUE,PETSC_TRUE,* are passed
461) ! patch%aux%RT%auxvars_up_to_date = PETSC_TRUE
462) endif
463) if (this%realization%reaction%use_log_formulation) then
464) call VecCopy(this%realization%field%tran_xx, &
465) this%realization%field%tran_log_xx,ierr);CHKERRQ(ierr)
466) call VecLog(this%realization%field%tran_log_xx,ierr);CHKERRQ(ierr)
467) endif
468)
469) call DataMediatorUpdate(this%realization%tran_data_mediator_list, &
470) this%realization%field%tran_mass_transfer, &
471) this%realization%option)
472)
473) end subroutine PMRTPreSolve
474)
475) ! ************************************************************************** !
476)
477) subroutine PMRTPostSolve(this)
478) !
479) ! Author: Glenn Hammond
480) ! Date: 03/14/13
481) !
482)
483) implicit none
484)
485) class(pm_rt_type) :: this
486)
487) #ifdef PM_RT_DEBUG
488) call printMsg(this%option,'PMRT%PostSolve()')
489) #endif
490)
491) end subroutine PMRTPostSolve
492)
493) ! ************************************************************************** !
494)
495) subroutine PMRTFinalizeTimestep(this)
496) !
497) ! Author: Glenn Hammond
498) ! Date: 04/03/13
499) !
500)
501) use Reactive_Transport_module, only : RTMaxChange
502) use Variables_module, only : POROSITY
503) use Material_module, only : MaterialGetAuxVarVecLoc
504) use Material_Aux_class, only : POROSITY_MINERAL
505) use Global_module
506)
507) implicit none
508)
509) class(pm_rt_type) :: this
510) PetscReal :: time
511) PetscErrorCode :: ierr
512)
513) if (this%transient_porosity) then
514) call VecCopy(this%realization%field%porosity_tpdt, &
515) this%realization%field%porosity_t,ierr);CHKERRQ(ierr)
516) call RealizationUpdatePropertiesTS(this%realization)
517) call MaterialGetAuxVarVecLoc(this%realization%patch%aux%Material, &
518) this%realization%field%work_loc, &
519) POROSITY,POROSITY_MINERAL)
520) call this%comm1%LocalToGlobal(this%realization%field%work_loc, &
521) this%realization%field%porosity_tpdt)
522) endif
523)
524) call RTMaxChange(this%realization,this%max_concentration_change, &
525) this%max_volfrac_change)
526) if (this%option%print_screen_flag) then
527) write(*,'(" --> max chng: dcmx= ",1pe12.4," dc/dt= ",1pe12.4, &
528) &" [mol/s]")') &
529) this%max_concentration_change, &
530) this%max_concentration_change/this%option%tran_dt
531) if (this%realization%reaction%mineral%nkinmnrl > 0) then
532) write(*,'(" dvfmx= ",1pe12.4," dvf/dt= ",1pe12.4, &
533) &" [1/s]")') &
534) this%max_volfrac_change, this%max_volfrac_change/this%option%tran_dt
535) endif
536) endif
537) if (this%option%print_file_flag) then
538) write(this%option%fid_out,&
539) '(" --> max chng: dcmx= ",1pe12.4," dc/dt= ",1pe12.4, &
540) &" [mol/s]")') &
541) this%max_concentration_change, &
542) this%max_concentration_change/this%option%tran_dt
543) if (this%realization%reaction%mineral%nkinmnrl > 0) then
544) write(this%option%fid_out, &
545) '(" dvfmx= ",1pe12.4," dvf/dt= ",1pe12.4," [1/s]")') &
546) this%max_volfrac_change, this%max_volfrac_change/this%option%tran_dt
547) endif
548) endif
549)
550) end subroutine PMRTFinalizeTimestep
551)
552) ! ************************************************************************** !
553)
554) function PMRTAcceptSolution(this)
555) !
556) ! PMRichardsAcceptSolution:
557) !
558) ! Author: Glenn Hammond
559) ! Date: 03/14/13
560) !
561)
562) implicit none
563)
564) class(pm_rt_type) :: this
565)
566) PetscBool :: PMRTAcceptSolution
567)
568) #ifdef PM_RT_DEBUG
569) call printMsg(this%option,'PMRT%AcceptSolution()')
570) #endif
571) ! do nothing
572) PMRTAcceptSolution = PETSC_TRUE
573)
574) end function PMRTAcceptSolution
575)
576) ! ************************************************************************** !
577)
578) subroutine PMRTUpdateTimestep(this,dt,dt_min,dt_max,iacceleration, &
579) num_newton_iterations,tfac)
580) !
581) ! Author: Glenn Hammond
582) ! Date: 03/14/13
583) !
584)
585) implicit none
586)
587) class(pm_rt_type) :: this
588) PetscReal :: dt
589) PetscReal :: dt_min,dt_max
590) PetscInt :: iacceleration
591) PetscInt :: num_newton_iterations
592) PetscReal :: tfac(:)
593)
594) PetscReal :: dtt, uvf, dt_vf, dt_tfac, fac
595) PetscInt :: ifac
596) PetscReal, parameter :: pert = 1.d-20
597)
598) #ifdef PM_RT_DEBUG
599) call printMsg(this%option,'PMRT%UpdateTimestep()')
600) #endif
601)
602) if (this%volfrac_change_governor < 1.d0) then
603) ! with volume fraction potentially scaling the time step.
604) if (iacceleration > 0) then
605) fac = 0.5d0
606) if (num_newton_iterations >= iacceleration) then
607) fac = 0.33d0
608) uvf = 0.d0
609) else
610) uvf = this%volfrac_change_governor/(this%max_volfrac_change+pert)
611) endif
612) dtt = fac * dt * (1.d0 + uvf)
613) else
614) ifac = max(min(num_newton_iterations,size(tfac)),1)
615) dt_tfac = tfac(ifac) * dt
616)
617) fac = 0.5d0
618) uvf= this%volfrac_change_governor/(this%max_volfrac_change+pert)
619) dt_vf = fac * dt * (1.d0 + uvf)
620)
621) dtt = min(dt_tfac,dt_vf)
622) endif
623) else
624) ! original implementation
625) dtt = dt
626) if (num_newton_iterations <= iacceleration) then
627) if (num_newton_iterations <= size(tfac)) then
628) dtt = tfac(num_newton_iterations) * dt
629) else
630) dtt = 0.5d0 * dt
631) endif
632) else
633) dtt = 0.5d0 * dt
634) endif
635) endif
636)
637) if (dtt > 2.d0 * dt) dtt = 2.d0 * dt
638) if (dtt > dt_max) dtt = dt_max
639) ! geh: see comment above under flow stepper
640) dtt = max(dtt,dt_min)
641) dt = dtt
642)
643) end subroutine PMRTUpdateTimestep
644)
645) ! ************************************************************************** !
646)
647) recursive subroutine PMRTFinalizeRun(this)
648) !
649) ! Finalizes the time stepping
650) !
651) ! Author: Glenn Hammond
652) ! Date: 03/18/13
653) !
654)
655) implicit none
656)
657) class(pm_rt_type) :: this
658)
659) #ifdef PM_RT_DEBUG
660) call printMsg(this%option,'PMRT%PMRTFinalizeRun()')
661) #endif
662)
663) ! do something here
664)
665) if (associated(this%next)) then
666) call this%next%FinalizeRun()
667) endif
668)
669) end subroutine PMRTFinalizeRun
670)
671) ! ************************************************************************** !
672)
673) subroutine PMRTResidual(this,snes,xx,r,ierr)
674) !
675) ! Author: Glenn Hammond
676) ! Date: 03/14/13
677) !
678)
679) use Reactive_Transport_module, only : RTResidual
680)
681) implicit none
682)
683) class(pm_rt_type) :: this
684) SNES :: snes
685) Vec :: xx
686) Vec :: r
687) PetscErrorCode :: ierr
688)
689) #ifdef PM_RT_DEBUG
690) call printMsg(this%option,'PMRT%Residual()')
691) #endif
692)
693) call RTResidual(snes,xx,r,this%realization,ierr)
694)
695) end subroutine PMRTResidual
696)
697) ! ************************************************************************** !
698)
699) subroutine PMRTJacobian(this,snes,xx,A,B,ierr)
700) !
701) ! Author: Glenn Hammond
702) ! Date: 03/14/13
703) !
704)
705) use Reactive_Transport_module, only : RTJacobian
706)
707) implicit none
708)
709) class(pm_rt_type) :: this
710) SNES :: snes
711) Vec :: xx
712) Mat :: A, B
713) PetscErrorCode :: ierr
714)
715) #ifdef PM_RT_DEBUG
716) call printMsg(this%option,'PMRT%Jacobian()')
717) #endif
718)
719) call RTJacobian(snes,xx,A,B,this%realization,ierr)
720)
721) end subroutine PMRTJacobian
722)
723) ! ************************************************************************** !
724)
725) subroutine PMRTCheckUpdatePre(this,line_search,X,dX,changed,ierr)
726) !
727) ! In the case of the log formulation, ensures that the update
728) ! vector does not exceed a prescribed tolerance
729) !
730) ! Author: Glenn Hammond
731) ! Date: 03/16/09
732) !
733)
734) use Realization_Subsurface_class
735) use Grid_module
736) use Option_module
737) use Reaction_Aux_module
738)
739) implicit none
740)
741) class(pm_rt_type) :: this
742) SNESLineSearch :: line_search
743) Vec :: X
744) Vec :: dX
745) PetscBool :: changed
746) PetscErrorCode :: ierr
747)
748) PetscReal, pointer :: C_p(:)
749) PetscReal, pointer :: dC_p(:)
750) type(grid_type), pointer :: grid
751) type(reaction_type), pointer :: reaction
752) PetscReal :: ratio, min_ratio
753) PetscReal, parameter :: min_allowable_scale = 1.d-10
754) character(len=MAXSTRINGLENGTH) :: string
755) PetscInt :: i, n
756)
757) grid => this%realization%patch%grid
758) reaction => this%realization%reaction
759)
760) call VecGetArrayF90(dX,dC_p,ierr);CHKERRQ(ierr)
761)
762) if (reaction%use_log_formulation) then
763) ! C and dC are actually lnC and dlnC
764) dC_p = dsign(1.d0,dC_p)*min(dabs(dC_p),reaction%max_dlnC)
765) ! at this point, it does not matter whether "changed" is set to true,
766) ! since it is not checkied in PETSc. Thus, I don't want to spend
767) ! time checking for changes and performing an allreduce for log
768) ! formulation.
769) if (Initialized(reaction%truncated_concentration)) then
770) call VecGetArrayReadF90(X,C_p,ierr);CHKERRQ(ierr)
771) dC_p = min(C_p-log(reaction%truncated_concentration),dC_p)
772) call VecRestoreArrayReadF90(X,C_p,ierr);CHKERRQ(ierr)
773) endif
774) else
775) call VecGetLocalSize(X,n,ierr);CHKERRQ(ierr)
776) call VecGetArrayReadF90(X,C_p,ierr);CHKERRQ(ierr)
777)
778) if (Initialized(reaction%truncated_concentration)) then
779) dC_p = min(dC_p,C_p-reaction%truncated_concentration)
780) else
781) ! C^p+1 = C^p - dC^p
782) ! if dC is positive and abs(dC) larger than C
783) ! we need to scale the update
784)
785) ! compute smallest ratio of C to dC
786) #if 0
787) min_ratio = 1.d0/maxval(dC_p/C_p)
788) #else
789) min_ratio = 1.d20 ! large number
790) do i = 1, n
791) if (C_p(i) <= dC_p(i)) then
792) ratio = abs(C_p(i)/dC_p(i))
793) if (ratio < min_ratio) min_ratio = ratio
794) endif
795) enddo
796) #endif
797) ratio = min_ratio
798)
799) ! get global minimum
800) call MPI_Allreduce(ratio,min_ratio,ONE_INTEGER_MPI,MPI_DOUBLE_PRECISION, &
801) MPI_MIN,this%realization%option%mycomm,ierr)
802)
803) ! scale if necessary
804) if (min_ratio < 1.d0) then
805) if (min_ratio < this%realization%option%min_allowable_scale) then
806) write(string,'(es10.3)') min_ratio
807) string = 'The update of primary species concentration is being ' // &
808) 'scaled by a very small value (i.e. ' // &
809) trim(adjustl(string)) // &
810) ') to prevent negative concentrations. This value is too ' // &
811) 'small and will likely cause the solver to mistakenly ' // &
812) 'converge based on the infinity norm of the update vector. ' // &
813) 'In this case, it is recommended that you use the ' // &
814) 'LOG_FORMULATION for chemistry or truncate concentrations ' // &
815) '(TRUNCATE_CONCENTRATION <float> in CHEMISTRY block). ' // &
816) 'If that does not work, please send your input deck to ' // &
817) 'pflotran-dev@googlegroups.com.'
818) this%realization%option%io_buffer = string
819) call printErrMsg(this%realization%option)
820) endif
821) ! scale by 0.99 to make the update slightly smaller than the min_ratio
822) dC_p = dC_p*min_ratio*0.99d0
823) changed = PETSC_TRUE
824) endif
825) endif
826) call VecRestoreArrayReadF90(X,C_p,ierr);CHKERRQ(ierr)
827) endif
828)
829) call VecRestoreArrayF90(dX,dC_p,ierr);CHKERRQ(ierr)
830)
831) end subroutine PMRTCheckUpdatePre
832)
833) ! ************************************************************************** !
834)
835) subroutine PMRTCheckUpdatePost(this,line_search,X0,dX,X1,dX_changed, &
836) X1_changed,ierr)
837) !
838) ! Checks convergence after to update
839) !
840) ! Author: Glenn Hammond
841) ! Date: 03/04/14
842) !
843) use Realization_Subsurface_class
844) use Grid_module
845) use Field_module
846) use Patch_module
847) use Option_module
848) use Secondary_Continuum_module, only : SecondaryRTUpdateIterate
849) use Output_EKG_module
850) use Reactive_Transport_Aux_module
851)
852) implicit none
853)
854) class(pm_rt_type) :: this
855) SNESLineSearch :: line_search
856) Vec :: X0
857) Vec :: dX
858) Vec :: X1
859) PetscBool :: dX_changed
860) PetscBool :: X1_changed
861) PetscErrorCode :: ierr
862)
863) type(grid_type), pointer :: grid
864) type(option_type), pointer :: option
865) type(field_type), pointer :: field
866) type(patch_type), pointer :: patch
867) PetscReal, pointer :: C0_p(:)
868) PetscReal, pointer :: dC_p(:)
869) PetscReal, pointer :: r_p(:)
870) PetscReal, pointer :: accum_p(:)
871) PetscBool :: converged_due_to_rel_update
872) PetscBool :: converged_due_to_residual
873) PetscReal :: max_relative_change
874) PetscReal :: max_scaled_residual
875) PetscInt :: converged_flag
876) PetscInt :: temp_int
877) PetscReal :: max_relative_change_by_dof(this%option%ntrandof)
878) PetscReal :: global_max_rel_change_by_dof(this%option%ntrandof)
879) PetscMPIInt :: mpi_int
880) PetscInt :: local_id, offset, idof, index
881) PetscReal :: tempreal
882)
883) grid => this%realization%patch%grid
884) option => this%realization%option
885) field => this%realization%field
886) patch => this%realization%patch
887)
888) dX_changed = PETSC_FALSE
889) X1_changed = PETSC_FALSE
890)
891) converged_flag = 0
892) if (this%check_post_convergence) then
893) converged_due_to_rel_update = PETSC_FALSE
894) converged_due_to_residual = PETSC_FALSE
895) call VecGetArrayReadF90(dX,dC_p,ierr);CHKERRQ(ierr)
896) call VecGetArrayReadF90(X0,C0_p,ierr);CHKERRQ(ierr)
897) max_relative_change = maxval(dabs(dC_p(:)/C0_p(:)))
898) call VecRestoreArrayReadF90(dX,dC_p,ierr);CHKERRQ(ierr)
899) call VecRestoreArrayReadF90(X0,C0_p,ierr);CHKERRQ(ierr)
900) call VecGetArrayReadF90(field%tran_r,r_p,ierr);CHKERRQ(ierr)
901) call VecGetArrayReadF90(field%tran_accum,accum_p,ierr);CHKERRQ(ierr)
902) max_scaled_residual = maxval(dabs(r_p(:)/accum_p(:)))
903) call VecRestoreArrayReadF90(field%tran_r,r_p,ierr);CHKERRQ(ierr)
904) call VecRestoreArrayReadF90(field%tran_accum,accum_p,ierr);CHKERRQ(ierr)
905) converged_due_to_rel_update = (Initialized(rt_itol_rel_update) .and. &
906) max_relative_change < rt_itol_rel_update)
907) converged_due_to_residual = (Initialized(rt_itol_scaled_res) .and. &
908) max_scaled_residual < rt_itol_scaled_res)
909) if (converged_due_to_rel_update .or. converged_due_to_residual) then
910) converged_flag = 1
911) endif
912) endif
913)
914) ! get global minimum
915) call MPI_Allreduce(converged_flag,temp_int,ONE_INTEGER_MPI,MPI_INTEGER, &
916) MPI_MIN,this%realization%option%mycomm,ierr)
917)
918) option%converged = PETSC_FALSE
919) if (temp_int == 1) then
920) option%converged = PETSC_TRUE
921) endif
922)
923) if (option%use_mc) then
924) call SecondaryRTUpdateIterate(line_search,X0,dX,X1,dX_changed, &
925) X1_changed,this%realization,ierr)
926) endif
927)
928) if (this%print_ekg) then
929) call VecGetArrayReadF90(dX,dC_p,ierr);CHKERRQ(ierr)
930) call VecGetArrayReadF90(X0,C0_p,ierr);CHKERRQ(ierr)
931) max_relative_change_by_dof = -1.d20
932) do local_id = 1, grid%nlmax
933) offset = (local_id-1)*option%ntrandof
934) do idof = 1, option%ntrandof
935) index = idof + offset
936) tempreal = dabs(dC_p(index)/C0_p(index))
937) max_relative_change_by_dof(idof) = &
938) max(max_relative_change_by_dof(idof),tempreal)
939) enddo
940) enddo
941) call VecRestoreArrayReadF90(dX,dC_p,ierr);CHKERRQ(ierr)
942) call VecRestoreArrayReadF90(X0,C0_p,ierr);CHKERRQ(ierr)
943) mpi_int = option%ntrandof
944) call MPI_Allreduce(MPI_IN_PLACE,max_relative_change_by_dof,mpi_int, &
945) MPI_DOUBLE_PRECISION,MPI_MAX,this%option%mycomm,ierr)
946) if (OptionPrintToFile(option)) then
947) 100 format("REACTIVE TRANSPORT NEWTON_ITERATION ",30es16.8)
948) write(IUNIT_EKG,100) max_relative_change_by_dof(:)
949) endif
950) endif
951)
952) end subroutine PMRTCheckUpdatePost
953)
954) ! ************************************************************************** !
955)
956) subroutine PMRTTimeCut(this)
957) !
958) ! Author: Glenn Hammond
959) ! Date: 03/14/13
960) !
961)
962) use Reactive_Transport_module, only : RTTimeCut
963)
964) implicit none
965)
966) class(pm_rt_type) :: this
967)
968) #ifdef PM_RT_DEBUG
969) call printMsg(this%option,'PMRT%TimeCut()')
970) #endif
971)
972) this%option%tran_dt = this%option%dt
973) if (this%option%nflowdof > 0 .and. .not. this%steady_flow) then
974) call this%SetTranWeights()
975) endif
976) call RTTimeCut(this%realization)
977)
978) end subroutine PMRTTimeCut
979)
980) ! ************************************************************************** !
981)
982) subroutine PMRTUpdateSolution1(this)
983) !
984) ! Author: Glenn Hammond
985) ! Date: 03/14/13
986) !
987)
988) use Reactive_Transport_module
989) use Condition_module
990)
991) implicit none
992)
993) class(pm_rt_type) :: this
994) ! update kinetics
995) call PMRTUpdateSolution2(this,PETSC_TRUE)
996)
997) end subroutine PMRTUpdateSolution1
998)
999) ! ************************************************************************** !
1000)
1001) subroutine PMRTUpdateSolution2(this, update_kinetics)
1002) !
1003) ! Author: Glenn Hammond
1004) ! Date: 03/14/13
1005) !
1006)
1007) use Reactive_Transport_module
1008) use Condition_module
1009) use Integral_Flux_module
1010)
1011) implicit none
1012)
1013) class(pm_rt_type) :: this
1014) PetscBool :: update_kinetics
1015)
1016) #ifdef PM_RT_DEBUG
1017) call printMsg(this%option,'PMRT%UpdateSolution()')
1018) #endif
1019)
1020) ! begin from RealizationUpdate()
1021) call TranConditionUpdate(this%realization%transport_conditions, &
1022) this%realization%option, &
1023) this%realization%option%time)
1024) if (associated(this%realization%uniform_velocity_dataset)) then
1025) call RealizUpdateUniformVelocity(this%realization)
1026) endif
1027) ! end from RealizationUpdate()
1028) ! The update of status must be in this order!
1029) call RTUpdateEquilibriumState(this%realization)
1030) if (update_kinetics) &
1031) call RTUpdateKineticState(this%realization)
1032)
1033) !TODO(geh): MassTransfer
1034) !geh - moved to RTPreSolve()
1035) ! call MassTransferUpdate(this%realization%rt_data_mediator_list, &
1036) ! this%realization%patch%grid, &
1037) ! this%realization%option)
1038)
1039) if (this%realization%option%compute_mass_balance_new) then
1040) call RTUpdateMassBalance(this%realization)
1041) endif
1042) if (this%option%transport%store_fluxes) then
1043) call IntegralFluxUpdate(this%realization%patch%integral_flux_list, &
1044) this%realization%patch%internal_tran_fluxes, &
1045) this%realization%patch%boundary_tran_fluxes, &
1046) INTEGRATE_TRANSPORT,this%option)
1047) endif
1048)
1049) end subroutine PMRTUpdateSolution2
1050)
1051) ! ************************************************************************** !
1052)
1053) subroutine PMRTUpdateAuxVars(this)
1054) !
1055) ! Author: Glenn Hammond
1056) ! Date: 04/21/14
1057)
1058) use Reactive_Transport_module, only : RTUpdateAuxVars
1059)
1060) implicit none
1061)
1062) class(pm_rt_type) :: this
1063) ! cells bcs act. coefs.
1064) call RTUpdateAuxVars(this%realization,PETSC_TRUE,PETSC_FALSE,PETSC_FALSE)
1065)
1066) end subroutine PMRTUpdateAuxVars
1067)
1068) ! ************************************************************************** !
1069)
1070) subroutine PMRTMaxChange(this)
1071) !
1072) ! Author: Glenn Hammond
1073) ! Date: 03/14/13
1074) !
1075)
1076) use Reactive_Transport_module, only : RTMaxChange
1077)
1078) implicit none
1079)
1080) class(pm_rt_type) :: this
1081)
1082) #ifdef PM_RT_DEBUG
1083) call printMsg(this%option,'PMRT%MaxChange()')
1084) #endif
1085)
1086) print *, 'PMRTMaxChange not implemented'
1087) stop
1088) ! call RTMaxChange(this%realization)
1089)
1090) end subroutine PMRTMaxChange
1091)
1092) ! ************************************************************************** !
1093)
1094) subroutine PMRTComputeMassBalance(this,mass_balance_array)
1095) !
1096) ! Author: Glenn Hammond
1097) ! Date: 03/14/13
1098) !
1099)
1100) use Reactive_Transport_module, only : RTComputeMassBalance
1101)
1102) implicit none
1103)
1104) class(pm_rt_type) :: this
1105) PetscReal :: mass_balance_array(:)
1106)
1107) #ifdef PM_RT_DEBUG
1108) call printMsg(this%option,'PMRT%MassBalance()')
1109) #endif
1110)
1111) #ifndef SIMPLIFY
1112) call RTComputeMassBalance(this%realization,mass_balance_array)
1113) #endif
1114)
1115) end subroutine PMRTComputeMassBalance
1116)
1117) ! ************************************************************************** !
1118)
1119) subroutine SetTranWeights(this)
1120) !
1121) ! Sets the weights at t0 or t1 for transport
1122) !
1123) ! Author: Glenn Hammond
1124) ! Date: 01/17/11; 04/03/13
1125) !
1126)
1127) use Option_module
1128)
1129) implicit none
1130)
1131) class(pm_rt_type) :: this
1132)
1133) PetscReal :: flow_dt
1134) PetscReal :: flow_t0
1135) PetscReal :: flow_t1
1136)
1137) ! option%tran_time is the time at beginning of transport step
1138) flow_t0 = this%realization%patch%aux%Global%time_t
1139) flow_t1 = this%realization%patch%aux%Global%time_tpdt
1140) flow_dt = flow_t1-flow_t0
1141) this%tran_weight_t0 = max(0.d0,(this%option%time-flow_t0)/flow_dt)
1142) this%tran_weight_t1 = min(1.d0, &
1143) (this%option%time+this%option%tran_dt-flow_t0)/ &
1144) flow_dt)
1145)
1146) end subroutine SetTranWeights
1147)
1148) ! ************************************************************************** !
1149)
1150) subroutine PMRTCheckpointBinary(this,viewer)
1151) !
1152) ! Checkpoints flow reactive transport process model
1153) !
1154) ! Author: Glenn Hammond
1155) ! Date: 07/29/13
1156) !
1157)
1158) use Option_module
1159) use Realization_Subsurface_class
1160) use Realization_Base_class
1161) use Field_module
1162) use Discretization_module
1163) use Grid_module
1164) use Reactive_Transport_module, only : RTCheckpointKineticSorptionBinary
1165) use Reaction_Aux_module, only : ACT_COEF_FREQUENCY_OFF
1166) use Variables_module, only : PRIMARY_ACTIVITY_COEF, &
1167) SECONDARY_ACTIVITY_COEF, &
1168) MINERAL_VOLUME_FRACTION
1169)
1170) implicit none
1171)
1172) #include "petsc/finclude/petscviewer.h"
1173) #include "petsc/finclude/petscvec.h"
1174) #include "petsc/finclude/petscvec.h90"
1175) #include "petsc/finclude/petscbag.h"
1176)
1177) interface PetscBagGetData
1178)
1179) ! ************************************************************************** !
1180)
1181) subroutine PetscBagGetData(bag,header,ierr)
1182) import :: pm_rt_header_type
1183) implicit none
1184) #include "petsc/finclude/petscbag.h"
1185) PetscBag :: bag
1186) class(pm_rt_header_type), pointer :: header
1187) PetscErrorCode :: ierr
1188) end subroutine
1189) end interface PetscBagGetData
1190)
1191) PetscViewer :: viewer
1192) class(pm_rt_type) :: this
1193) PetscErrorCode :: ierr
1194)
1195) class(realization_subsurface_type), pointer :: realization
1196) type(option_type), pointer :: option
1197) type(field_type), pointer :: field
1198) type(discretization_type), pointer :: discretization
1199) type(grid_type), pointer :: grid
1200) Vec :: global_vec
1201) PetscInt :: i
1202)
1203) class(pm_rt_header_type), pointer :: header
1204) type(pm_rt_header_type) :: dummy_header
1205) character(len=1),pointer :: dummy_char(:)
1206) PetscBag :: bag
1207) PetscSizeT :: bagsize
1208)
1209) realization => this%realization
1210) option => realization%option
1211) field => realization%field
1212) discretization => realization%discretization
1213) grid => realization%patch%grid
1214)
1215) global_vec = 0
1216)
1217) bagsize = size(transfer(dummy_header,dummy_char))
1218)
1219) call PetscBagCreate(option%mycomm,bagsize,bag,ierr);CHKERRQ(ierr)
1220) call PetscBagGetData(bag,header,ierr);CHKERRQ(ierr)
1221) call PetscBagRegisterInt(bag,header%checkpoint_activity_coefs,0, &
1222) "checkpoint_activity_coefs","",ierr);CHKERRQ(ierr)
1223) call PetscBagRegisterInt(bag,header%ndof,0, &
1224) "ndof","",ierr);CHKERRQ(ierr)
1225) if (associated(realization%reaction)) then
1226) if (realization%reaction%checkpoint_activity_coefs .and. &
1227) realization%reaction%act_coef_update_frequency /= &
1228) ACT_COEF_FREQUENCY_OFF) then
1229) header%checkpoint_activity_coefs = ONE_INTEGER
1230) else
1231) header%checkpoint_activity_coefs = ZERO_INTEGER
1232) endif
1233) else
1234) header%checkpoint_activity_coefs = ZERO_INTEGER
1235) endif
1236) !geh: %ndof should be pushed down to the base class, but this is not possible
1237) ! as long as option%ntrandof is used.
1238) header%ndof = option%ntrandof
1239) call PetscBagView(bag,viewer,ierr);CHKERRQ(ierr)
1240) call PetscBagDestroy(bag,ierr);CHKERRQ(ierr)
1241)
1242) if (option%ntrandof > 0) then
1243) call VecView(field%tran_xx, viewer, ierr);CHKERRQ(ierr)
1244) ! create a global vec for writing below
1245) if (global_vec == 0) then
1246) call DiscretizationCreateVector(realization%discretization,ONEDOF, &
1247) global_vec,GLOBAL,option)
1248) endif
1249) if (realization%reaction%checkpoint_activity_coefs .and. &
1250) realization%reaction%act_coef_update_frequency /= &
1251) ACT_COEF_FREQUENCY_OFF) then
1252) ! allocated vector
1253) do i = 1, realization%reaction%naqcomp
1254) call RealizationGetVariable(realization,global_vec, &
1255) PRIMARY_ACTIVITY_COEF,i)
1256) call VecView(global_vec,viewer,ierr);CHKERRQ(ierr)
1257) enddo
1258) do i = 1, realization%reaction%neqcplx
1259) call RealizationGetVariable(realization,global_vec, &
1260) SECONDARY_ACTIVITY_COEF,i)
1261) call VecView(global_vec,viewer,ierr);CHKERRQ(ierr)
1262) enddo
1263) endif
1264) ! mineral volume fractions for kinetic minerals
1265) if (realization%reaction%mineral%nkinmnrl > 0) then
1266) do i = 1, realization%reaction%mineral%nkinmnrl
1267) call RealizationGetVariable(realization,global_vec, &
1268) MINERAL_VOLUME_FRACTION,i)
1269) call VecView(global_vec,viewer,ierr);CHKERRQ(ierr)
1270) enddo
1271) endif
1272) ! sorbed concentrations for multirate kinetic sorption
1273) if (realization%reaction%surface_complexation%nkinmrsrfcplxrxn > 0 .and. &
1274) .not.option%transport%no_checkpoint_kinetic_sorption) then
1275) ! PETSC_TRUE flag indicates write to file
1276) call RTCheckpointKineticSorptionBinary(realization,viewer,PETSC_TRUE)
1277) endif
1278) endif
1279)
1280) if (global_vec /= 0) then
1281) call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
1282) endif
1283)
1284) end subroutine PMRTCheckpointBinary
1285)
1286) ! ************************************************************************** !
1287)
1288) subroutine PMRTRestartBinary(this,viewer)
1289) !
1290) ! Restarts flow reactive transport process model
1291) !
1292) ! Author: Glenn Hammond
1293) ! Date: 07/29/13
1294) !
1295)
1296) use Option_module
1297) use Realization_Subsurface_class
1298) use Realization_Base_class
1299) use Field_module
1300) use Discretization_module
1301) use Grid_module
1302) use Reactive_Transport_module, only : RTCheckpointKineticSorptionBinary, &
1303) RTUpdateAuxVars
1304) use Reaction_Aux_module, only : ACT_COEF_FREQUENCY_OFF
1305) use Variables_module, only : PRIMARY_ACTIVITY_COEF, &
1306) SECONDARY_ACTIVITY_COEF, &
1307) MINERAL_VOLUME_FRACTION
1308)
1309) implicit none
1310)
1311) #include "petsc/finclude/petscviewer.h"
1312) #include "petsc/finclude/petscvec.h"
1313) #include "petsc/finclude/petscvec.h90"
1314) #include "petsc/finclude/petscbag.h"
1315)
1316) interface PetscBagGetData
1317)
1318) ! ************************************************************************** !
1319)
1320) subroutine PetscBagGetData(bag,header,ierr)
1321) import :: pm_rt_header_type
1322) implicit none
1323) #include "petsc/finclude/petscbag.h"
1324) PetscBag :: bag
1325) class(pm_rt_header_type), pointer :: header
1326) PetscErrorCode :: ierr
1327) end subroutine
1328) end interface PetscBagGetData
1329)
1330) PetscViewer :: viewer
1331) class(pm_rt_type) :: this
1332) PetscErrorCode :: ierr
1333)
1334) class(realization_subsurface_type), pointer :: realization
1335) type(option_type), pointer :: option
1336) type(field_type), pointer :: field
1337) type(discretization_type), pointer :: discretization
1338) type(grid_type), pointer :: grid
1339) Vec :: global_vec, local_vec
1340) PetscInt :: i
1341)
1342) class(pm_rt_header_type), pointer :: header
1343) type(pm_rt_header_type) :: dummy_header
1344) character(len=1),pointer :: dummy_char(:)
1345) PetscBag :: bag
1346) PetscSizeT :: bagsize
1347)
1348) realization => this%realization
1349) option => realization%option
1350) field => realization%field
1351) discretization => realization%discretization
1352) grid => realization%patch%grid
1353)
1354) global_vec = 0
1355) local_vec = 0
1356)
1357) bagsize = size(transfer(dummy_header,dummy_char))
1358)
1359) call PetscBagCreate(this%option%mycomm, bagsize, bag, ierr);CHKERRQ(ierr)
1360) call PetscBagGetData(bag, header, ierr);CHKERRQ(ierr)
1361) call PetscBagRegisterInt(bag,header%checkpoint_activity_coefs,0, &
1362) "checkpoint_activity_coefs","",ierr);CHKERRQ(ierr)
1363) call PetscBagRegisterInt(bag,header%ndof,0, &
1364) "ndof","",ierr);CHKERRQ(ierr)
1365) call PetscBagLoad(viewer, bag, ierr);CHKERRQ(ierr)
1366) option%ntrandof = header%ndof
1367)
1368) call VecLoad(field%tran_xx,viewer,ierr);CHKERRQ(ierr)
1369) call DiscretizationGlobalToLocal(discretization,field%tran_xx, &
1370) field%tran_xx_loc,NTRANDOF)
1371) call VecCopy(field%tran_xx,field%tran_yy,ierr);CHKERRQ(ierr)
1372)
1373) if (global_vec == 0) then
1374) call DiscretizationCreateVector(realization%discretization,ONEDOF, &
1375) global_vec,GLOBAL,option)
1376) endif
1377) if (header%checkpoint_activity_coefs == ONE_INTEGER) then
1378) call DiscretizationCreateVector(discretization,ONEDOF,local_vec, &
1379) LOCAL,option)
1380) do i = 1, realization%reaction%naqcomp
1381) call VecLoad(global_vec,viewer,ierr);CHKERRQ(ierr)
1382) call DiscretizationGlobalToLocal(discretization,global_vec, &
1383) local_vec,ONEDOF)
1384) call RealizationSetVariable(realization,local_vec,LOCAL, &
1385) PRIMARY_ACTIVITY_COEF,i)
1386) enddo
1387) do i = 1, realization%reaction%neqcplx
1388) call VecLoad(global_vec,viewer,ierr);CHKERRQ(ierr)
1389) call DiscretizationGlobalToLocal(discretization,global_vec, &
1390) local_vec,ONEDOF)
1391) call RealizationSetVariable(realization,local_vec,LOCAL, &
1392) SECONDARY_ACTIVITY_COEF,i)
1393) enddo
1394) endif
1395) ! mineral volume fractions for kinetic minerals
1396) if (realization%reaction%mineral%nkinmnrl > 0) then
1397) do i = 1, realization%reaction%mineral%nkinmnrl
1398) ! have to load the vecs no matter what
1399) call VecLoad(global_vec,viewer,ierr);CHKERRQ(ierr)
1400) if (.not.option%transport%no_restart_mineral_vol_frac) then
1401) call RealizationSetVariable(realization,global_vec,GLOBAL, &
1402) MINERAL_VOLUME_FRACTION,i)
1403) endif
1404) enddo
1405) endif
1406) ! sorbed concentrations for multirate kinetic sorption
1407) if (realization%reaction%surface_complexation%nkinmrsrfcplxrxn > 0 .and. &
1408) .not.option%transport%no_checkpoint_kinetic_sorption .and. &
1409) ! we need to fix this. We need something to skip over the reading
1410) ! of sorbed concentrations altogether if they do not exist in the
1411) ! checkpoint file
1412) .not.option%transport%no_restart_kinetic_sorption) then
1413) ! PETSC_FALSE flag indicates read from file
1414) call RTCheckpointKineticSorptionBinary(realization,viewer,PETSC_FALSE)
1415) endif
1416)
1417) ! We are finished, so clean up.
1418) if (global_vec /= 0) then
1419) call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
1420) endif
1421) if (local_vec /= 0) then
1422) call VecDestroy(local_vec,ierr);CHKERRQ(ierr)
1423) endif
1424)
1425) call PetscBagDestroy(bag,ierr);CHKERRQ(ierr)
1426)
1427) if (realization%reaction%use_full_geochemistry) then
1428) ! cells bcs act coefs.
1429) call RTUpdateAuxVars(realization,PETSC_FALSE,PETSC_TRUE,PETSC_FALSE)
1430) endif
1431) ! do not update kinetics.
1432) call PMRTUpdateSolution2(this,PETSC_FALSE)
1433)
1434) end subroutine PMRTRestartBinary
1435)
1436) ! ************************************************************************** !
1437)
1438) subroutine PMRTCheckpointHDF5(this, pm_grp_id)
1439) !
1440) ! Checkpoints flow reactive transport process model
1441) !
1442) ! Author: Gautam Bisht
1443) ! Date: 07/30/15
1444) !
1445)
1446) #if !defined(PETSC_HAVE_HDF5)
1447) implicit none
1448) class(pm_rt_type) :: this
1449) integer :: pm_grp_id
1450) type(option_type) :: option
1451) print *, 'PFLOTRAN must be compiled with HDF5 to ' // &
1452) 'write HDF5 formatted checkpoint file. Darn.'
1453) stop
1454) #else
1455)
1456) use Option_module
1457) use Realization_Subsurface_class
1458) use Realization_Base_class
1459) use Field_module
1460) use Discretization_module
1461) use Grid_module
1462) use Reactive_Transport_module, only : RTCheckpointKineticSorptionHDF5
1463) use Reaction_Aux_module, only : ACT_COEF_FREQUENCY_OFF
1464) use Variables_module, only : PRIMARY_ACTIVITY_COEF, &
1465) SECONDARY_ACTIVITY_COEF, &
1466) MINERAL_VOLUME_FRACTION
1467) use hdf5
1468) use Checkpoint_module, only: CheckPointWriteIntDatasetHDF5
1469) use HDF5_module, only : HDF5WriteDataSetFromVec
1470)
1471) implicit none
1472)
1473) #include "petsc/finclude/petscvec.h"
1474) #include "petsc/finclude/petscvec.h90"
1475)
1476) class(pm_rt_type) :: this
1477) #if defined(SCORPIO_WRITE)
1478) integer :: pm_grp_id
1479) #else
1480) integer(HID_T) :: pm_grp_id
1481) #endif
1482)
1483) #if defined(SCORPIO_WRITE)
1484) integer, pointer :: dims(:)
1485) integer, pointer :: start(:)
1486) integer, pointer :: stride(:)
1487) integer, pointer :: length(:)
1488) #else
1489) integer(HSIZE_T), pointer :: dims(:)
1490) integer(HSIZE_T), pointer :: start(:)
1491) integer(HSIZE_T), pointer :: stride(:)
1492) integer(HSIZE_T), pointer :: length(:)
1493) #endif
1494)
1495) PetscMPIInt :: dataset_rank
1496) character(len=MAXSTRINGLENGTH) :: dataset_name
1497) PetscInt, pointer :: int_array(:)
1498)
1499) class(realization_subsurface_type), pointer :: realization
1500) type(option_type), pointer :: option
1501) type(field_type), pointer :: field
1502) type(discretization_type), pointer :: discretization
1503) type(grid_type), pointer :: grid
1504) Vec :: global_vec
1505) Vec :: natural_vec
1506) PetscInt :: i
1507) PetscErrorCode :: ierr
1508)
1509) realization => this%realization
1510) option => realization%option
1511) field => realization%field
1512) discretization => realization%discretization
1513) grid => realization%patch%grid
1514)
1515) allocate(start(1))
1516) allocate(dims(1))
1517) allocate(length(1))
1518) allocate(stride(1))
1519) allocate(int_array(1))
1520)
1521) dataset_rank = 1
1522) dims(1) = ONE_INTEGER
1523) start(1) = 0
1524) length(1) = ONE_INTEGER
1525) stride(1) = ONE_INTEGER
1526)
1527) if (associated(realization%reaction)) then
1528) if (realization%reaction%checkpoint_activity_coefs .and. &
1529) realization%reaction%act_coef_update_frequency /= &
1530) ACT_COEF_FREQUENCY_OFF) then
1531) int_array(1) = ONE_INTEGER
1532) else
1533) int_array(1) = ZERO_INTEGER
1534) endif
1535) else
1536) int_array(1) = ZERO_INTEGER
1537) endif
1538)
1539) dataset_name = "Checkpoint_Activity_Coefs" // CHAR(0)
1540) call CheckPointWriteIntDatasetHDF5(pm_grp_id, dataset_name, dataset_rank, &
1541) dims, start, length, stride, int_array, option)
1542)
1543) dataset_name = "NDOF" // CHAR(0)
1544) int_array(1) = option%ntrandof
1545) call CheckPointWriteIntDatasetHDF5(pm_grp_id, dataset_name, dataset_rank, &
1546) dims, start, length, stride, int_array, option)
1547)
1548) !geh: %ndof should be pushed down to the base class, but this is not possible
1549) ! as long as option%ntrandof is used.
1550)
1551) if (option%ntrandof > 0) then
1552)
1553) call DiscretizationCreateVector(realization%discretization, NTRANDOF, &
1554) natural_vec, NATURAL, option)
1555) call DiscretizationGlobalToNatural(realization%discretization, field%tran_xx, &
1556) natural_vec, NTRANDOF)
1557) dataset_name = "Primary_Variable" // CHAR(0)
1558) call HDF5WriteDataSetFromVec(dataset_name, option, natural_vec, &
1559) pm_grp_id, H5T_NATIVE_DOUBLE)
1560) call VecDestroy(natural_vec, ierr); CHKERRQ(ierr)
1561)
1562) ! create a global vec for writing below
1563) call DiscretizationCreateVector(realization%discretization,ONEDOF, &
1564) global_vec,GLOBAL,option)
1565) call DiscretizationCreateVector(realization%discretization, ONEDOF, &
1566) natural_vec, NATURAL, option)
1567)
1568) if (realization%reaction%checkpoint_activity_coefs .and. &
1569) realization%reaction%act_coef_update_frequency /= &
1570) ACT_COEF_FREQUENCY_OFF) then
1571)
1572) do i = 1, realization%reaction%naqcomp
1573) call RealizationGetVariable(realization,global_vec, &
1574) PRIMARY_ACTIVITY_COEF,i)
1575) call DiscretizationGlobalToNatural(realization%discretization, global_vec, &
1576) natural_vec, ONEDOF)
1577) write(dataset_name,*) i
1578) dataset_name = 'Aq_comp_' // trim(adjustl(dataset_name))
1579) call HDF5WriteDataSetFromVec(dataset_name, option, natural_vec, &
1580) pm_grp_id, H5T_NATIVE_DOUBLE)
1581) enddo
1582)
1583) do i = 1, realization%reaction%neqcplx
1584) call RealizationGetVariable(realization,global_vec, &
1585) SECONDARY_ACTIVITY_COEF,i)
1586) call DiscretizationGlobalToNatural(realization%discretization, global_vec, &
1587) natural_vec, ONEDOF)
1588) write(dataset_name,*) i
1589) dataset_name = 'Eq_cplx_' // trim(adjustl(dataset_name))
1590) call HDF5WriteDataSetFromVec(dataset_name, option, natural_vec, &
1591) pm_grp_id, H5T_NATIVE_DOUBLE)
1592) enddo
1593) endif
1594)
1595) ! mineral volume fractions for kinetic minerals
1596) if (realization%reaction%mineral%nkinmnrl > 0) then
1597) do i = 1, realization%reaction%mineral%nkinmnrl
1598) call RealizationGetVariable(realization,global_vec, &
1599) MINERAL_VOLUME_FRACTION,i)
1600) call DiscretizationGlobalToNatural(realization%discretization, global_vec, &
1601) natural_vec, ONEDOF)
1602) write(dataset_name,*) i
1603) dataset_name = 'Kinetic_mineral_' // trim(adjustl(dataset_name))
1604) call HDF5WriteDataSetFromVec(dataset_name, option, natural_vec, &
1605) pm_grp_id, H5T_NATIVE_DOUBLE)
1606) enddo
1607) endif
1608)
1609) if (realization%reaction%surface_complexation%nkinmrsrfcplxrxn > 0 .and. &
1610) .not.option%transport%no_checkpoint_kinetic_sorption) then
1611) ! PETSC_TRUE flag indicates write to file
1612) call RTCheckpointKineticSorptionHDF5(realization, pm_grp_id, PETSC_TRUE)
1613) endif
1614)
1615) call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
1616) call VecDestroy(natural_vec,ierr);CHKERRQ(ierr)
1617)
1618) endif
1619) #endif
1620)
1621) end subroutine PMRTCheckpointHDF5
1622)
1623) ! ************************************************************************** !
1624)
1625) subroutine PMRTRestartHDF5(this, pm_grp_id)
1626) !
1627) ! Checkpoints flow reactive transport process model
1628) !
1629) ! Author: Gautam Bisht
1630) ! Date: 07/30/15
1631) !
1632)
1633) #if !defined(PETSC_HAVE_HDF5)
1634) implicit none
1635) class(pm_rt_type) :: this
1636) integer :: pm_grp_id
1637) type(option_type) :: option
1638) print *, 'PFLOTRAN must be compiled with HDF5 to ' // &
1639) 'write HDF5 formatted checkpoint file. Darn.'
1640) stop
1641) #else
1642)
1643) use Option_module
1644) use Realization_Subsurface_class
1645) use Realization_Base_class
1646) use Field_module
1647) use Discretization_module
1648) use Grid_module
1649) use Reactive_Transport_module, only : RTCheckpointKineticSorptionHDF5, &
1650) RTUpdateAuxVars
1651) use Reaction_Aux_module, only : ACT_COEF_FREQUENCY_OFF
1652) use Variables_module, only : PRIMARY_ACTIVITY_COEF, &
1653) SECONDARY_ACTIVITY_COEF, &
1654) MINERAL_VOLUME_FRACTION
1655) use hdf5
1656) use Checkpoint_module, only: CheckPointReadIntDatasetHDF5
1657) use HDF5_module, only : HDF5ReadDataSetInVec
1658)
1659) implicit none
1660)
1661) #include "petsc/finclude/petscvec.h"
1662) #include "petsc/finclude/petscvec.h90"
1663)
1664) class(pm_rt_type) :: this
1665) #if defined(SCORPIO_WRITE)
1666) integer :: pm_grp_id
1667) #else
1668) integer(HID_T) :: pm_grp_id
1669) #endif
1670)
1671) #if defined(SCORPIO_WRITE)
1672) integer, pointer :: dims(:)
1673) integer, pointer :: start(:)
1674) integer, pointer :: stride(:)
1675) integer, pointer :: length(:)
1676) #else
1677) integer(HSIZE_T), pointer :: dims(:)
1678) integer(HSIZE_T), pointer :: start(:)
1679) integer(HSIZE_T), pointer :: stride(:)
1680) integer(HSIZE_T), pointer :: length(:)
1681) #endif
1682)
1683) PetscMPIInt :: dataset_rank
1684) character(len=MAXSTRINGLENGTH) :: dataset_name
1685) PetscInt, pointer :: int_array(:)
1686)
1687) class(realization_subsurface_type), pointer :: realization
1688) type(option_type), pointer :: option
1689) type(field_type), pointer :: field
1690) type(discretization_type), pointer :: discretization
1691) type(grid_type), pointer :: grid
1692) Vec :: local_vec
1693) Vec :: global_vec
1694) Vec :: natural_vec
1695) PetscInt :: i
1696) PetscInt :: checkpoint_activity_coefs
1697) PetscErrorCode :: ierr
1698)
1699) realization => this%realization
1700) option => realization%option
1701) field => realization%field
1702) discretization => realization%discretization
1703) grid => realization%patch%grid
1704)
1705) allocate(start(1))
1706) allocate(dims(1))
1707) allocate(length(1))
1708) allocate(stride(1))
1709) allocate(int_array(1))
1710)
1711) dataset_rank = 1
1712) dims(1) = ONE_INTEGER
1713) start(1) = 0
1714) length(1) = ONE_INTEGER
1715) stride(1) = ONE_INTEGER
1716)
1717) dataset_name = "Checkpoint_Activity_Coefs" // CHAR(0)
1718) call CheckPointReadIntDatasetHDF5(pm_grp_id, dataset_name, dataset_rank, &
1719) dims, start, length, stride, int_array, option)
1720) checkpoint_activity_coefs = int_array(1)
1721)
1722) dataset_name = "NDOF" // CHAR(0)
1723) int_array(1) = option%ntrandof
1724) call CheckPointReadIntDatasetHDF5(pm_grp_id, dataset_name, dataset_rank, &
1725) dims, start, length, stride, int_array, option)
1726) option%ntrandof = int_array(1)
1727)
1728) !geh: %ndof should be pushed down to the base class, but this is not possible
1729) ! as long as option%ntrandof is used.
1730)
1731) if (option%ntrandof > 0) then
1732)
1733) call DiscretizationCreateVector(discretization, NTRANDOF, &
1734) natural_vec, NATURAL, option)
1735) dataset_name = "Primary_Variable" // CHAR(0)
1736) call HDF5ReadDataSetInVec(dataset_name, option, natural_vec, &
1737) pm_grp_id, H5T_NATIVE_DOUBLE)
1738) call DiscretizationNaturalToGlobal(discretization, natural_vec, field%tran_xx, &
1739) NTRANDOF)
1740) call DiscretizationGlobalToLocal(discretization,field%tran_xx, &
1741) field%tran_xx_loc,NTRANDOF)
1742) call VecCopy(field%tran_xx,field%tran_yy,ierr);CHKERRQ(ierr)
1743) call VecDestroy(natural_vec, ierr); CHKERRQ(ierr)
1744)
1745) ! create a global vec for reading
1746) call DiscretizationCreateVector(discretization,ONEDOF, &
1747) global_vec,GLOBAL,option)
1748) call DiscretizationCreateVector(discretization, ONEDOF, &
1749) natural_vec, NATURAL, option)
1750) call DiscretizationCreateVector(discretization,ONEDOF,local_vec, &
1751) LOCAL,option)
1752)
1753) if (checkpoint_activity_coefs == ONE_INTEGER) then
1754)
1755) do i = 1, realization%reaction%naqcomp
1756) write(dataset_name,*) i
1757) dataset_name = 'Aq_comp_' // trim(adjustl(dataset_name))
1758) call HDF5ReadDataSetInVec(dataset_name, option, natural_vec, &
1759) pm_grp_id, H5T_NATIVE_DOUBLE)
1760)
1761) call DiscretizationNaturalToGlobal(discretization, natural_vec, &
1762) global_vec, ONEDOF)
1763) call DiscretizationGlobalToLocal(discretization, global_vec, &
1764) local_vec, ONEDOF)
1765) call RealizationSetVariable(realization, local_vec, LOCAL, &
1766) PRIMARY_ACTIVITY_COEF,i)
1767) enddo
1768)
1769) do i = 1, realization%reaction%neqcplx
1770) write(dataset_name,*) i
1771) dataset_name = 'Eq_cplx_' // trim(adjustl(dataset_name))
1772) call HDF5ReadDataSetInVec(dataset_name, option, natural_vec, &
1773) pm_grp_id, H5T_NATIVE_DOUBLE)
1774)
1775) call DiscretizationNaturalToGlobal(discretization, natural_vec, &
1776) global_vec, ONEDOF)
1777) call DiscretizationGlobalToLocal(discretization, global_vec, &
1778) local_vec, ONEDOF)
1779) call RealizationSetVariable(realization, local_vec, LOCAL, &
1780) SECONDARY_ACTIVITY_COEF, i)
1781) enddo
1782) endif
1783)
1784) ! mineral volume fractions for kinetic minerals
1785) if (realization%reaction%mineral%nkinmnrl > 0) then
1786) do i = 1, realization%reaction%mineral%nkinmnrl
1787) write(dataset_name,*) i
1788) dataset_name = 'Kinetic_mineral_' // trim(adjustl(dataset_name))
1789) call HDF5ReadDataSetInVec(dataset_name, option, natural_vec, &
1790) pm_grp_id, H5T_NATIVE_DOUBLE)
1791)
1792) call DiscretizationNaturalToGlobal(discretization, natural_vec, &
1793) global_vec, ONEDOF)
1794) call DiscretizationGlobalToLocal(discretization, global_vec, &
1795) local_vec, ONEDOF)
1796) call RealizationSetVariable(realization, local_vec, LOCAL, &
1797) MINERAL_VOLUME_FRACTION,i)
1798) enddo
1799) endif
1800)
1801) if (realization%reaction%surface_complexation%nkinmrsrfcplxrxn > 0 .and. &
1802) .not.option%transport%no_checkpoint_kinetic_sorption) then
1803) ! PETSC_TRUE flag indicates write to file
1804) call RTCheckpointKineticSorptionHDF5(realization, pm_grp_id, PETSC_TRUE)
1805) endif
1806)
1807) call VecDestroy(global_vec,ierr);CHKERRQ(ierr)
1808) call VecDestroy(natural_vec,ierr);CHKERRQ(ierr)
1809)
1810) endif
1811)
1812) if (realization%reaction%use_full_geochemistry) then
1813) ! cells bcs act coefs.
1814) call RTUpdateAuxVars(realization,PETSC_FALSE,PETSC_TRUE,PETSC_FALSE)
1815) endif
1816) ! do not update kinetics.
1817) call PMRTUpdateSolution2(this,PETSC_FALSE)
1818)
1819) deallocate(start)
1820) deallocate(dims)
1821) deallocate(length)
1822) deallocate(stride)
1823) deallocate(int_array)
1824)
1825) #endif
1826)
1827) end subroutine PMRTRestartHDF5
1828)
1829) ! ************************************************************************** !
1830)
1831) subroutine PMRTInputRecord(this)
1832) !
1833) ! Writes ingested information to the input record file.
1834) !
1835) ! Author: Jenn Frederick, SNL
1836) ! Date: 03/21/2016
1837) !
1838)
1839) implicit none
1840)
1841) class(pm_rt_type) :: this
1842)
1843) character(len=MAXWORDLENGTH) :: word
1844) PetscInt :: id
1845)
1846) id = INPUT_RECORD_UNIT
1847)
1848) write(id,'(a29)',advance='no') 'pm: '
1849) write(id,'(a)') this%name
1850)
1851) end subroutine PMRTInputRecord
1852)
1853) ! ************************************************************************** !
1854)
1855) subroutine PMRTDestroy(this)
1856) !
1857) ! Destroys RT process model
1858) !
1859) ! Author: Glenn Hammond
1860) ! Date: 03/14/13
1861) !
1862)
1863) use Reactive_Transport_module, only : RTDestroy
1864)
1865) implicit none
1866)
1867) class(pm_rt_type) :: this
1868)
1869) call RTDestroy(this%realization)
1870) ! destroyed in realization
1871) nullify(this%comm1)
1872) nullify(this%option)
1873) nullify(this%output_option)
1874) call this%commN%Destroy()
1875) if (associated(this%commN)) deallocate(this%commN)
1876) nullify(this%commN)
1877)
1878) end subroutine PMRTDestroy
1879)
1880) end module PM_RT_class