miscible.F90 coverage: 0.00 %func 0.00 %block
1) module Miscible_module
2)
3) use Miscible_Aux_module
4) use Global_Aux_module
5)
6) use PFLOTRAN_Constants_module
7)
8) implicit none
9)
10) private
11)
12) #include "petsc/finclude/petscsys.h"
13)
14) !#include "include/petscf90.h"
15) #include "petsc/finclude/petscvec.h"
16) #include "petsc/finclude/petscvec.h90"
17) ! It is VERY IMPORTANT to make sure that the above .h90 file gets included.
18) ! Otherwise some very strange things will happen and PETSc will give no
19) ! indication of what the problem is.
20) #include "petsc/finclude/petscmat.h"
21) #include "petsc/finclude/petscmat.h90"
22) #include "petsc/finclude/petscdm.h"
23) #include "petsc/finclude/petscdm.h90"
24) !#ifdef USE_PETSC216
25) !#include "petsc/finclude/petscsles.h"
26) !#endif
27) #include "petsc/finclude/petscsnes.h"
28) #include "petsc/finclude/petscviewer.h"
29) #include "petsc/finclude/petscsysdef.h"
30) #include "petsc/finclude/petscis.h"
31) #include "petsc/finclude/petscis.h90"
32) #include "petsc/finclude/petsclog.h"
33) #include "petsc/finclude/petscerror.h"
34)
35) ! Cutoff parameters
36) PetscReal, parameter :: formeps = 1.D-4
37) PetscReal, parameter :: eps = 1.D-5
38) PetscReal, parameter :: dfac = 1D-8
39) PetscReal, parameter :: floweps = 1.D-24
40) PetscReal, parameter :: zerocut =0.D0
41)
42) PetscInt, parameter :: jh2o=1, jglyc=2
43)
44) public MiscibleResidual,MiscibleJacobian, &
45) MiscibleUpdateFixedAccumulation,MiscibleTimeCut, &
46) MiscibleSetup, &
47) MiscibleMaxChange, MiscibleUpdateSolution, &
48) MiscibleGetTecplotHeader, MiscibleInitializeTimestep, &
49) MiscibleUpdateAuxVars,MiscibleComputeMassBalance, &
50) MiscibleDestroy
51)
52) contains
53)
54) ! ************************************************************************** !
55)
56) subroutine MiscibleTimeCut(realization)
57) !
58) ! Resets arrays for time step cut
59) !
60) ! Author: Chuan Lu
61) ! Date: 9/13/08
62) !
63)
64) use Realization_Subsurface_class
65) use Option_module
66) use Field_module
67)
68) implicit none
69)
70) type(realization_subsurface_type) :: realization
71) type(option_type), pointer :: option
72) type(field_type), pointer :: field
73)
74) PetscReal, pointer :: xx_p(:),yy_p(:)
75) PetscErrorCode :: ierr
76) PetscInt :: local_id
77)
78) option => realization%option
79) field => realization%field
80)
81) end subroutine MiscibleTimeCut
82)
83) ! ************************************************************************** !
84)
85) subroutine MiscibleSetup(realization)
86) !
87) ! Author: Chuan Lu
88) ! Date: 9/13/08
89) !
90)
91) use Realization_Subsurface_class
92) use Patch_module
93) use Output_Aux_module
94)
95) type(realization_subsurface_type) :: realization
96)
97) type(output_variable_list_type), pointer :: list
98) type(patch_type), pointer :: cur_patch
99)
100) cur_patch => realization%patch_list%first
101) do
102) if (.not.associated(cur_patch)) exit
103) realization%patch => cur_patch
104) call MiscibleSetupPatch(realization)
105) cur_patch => cur_patch%next
106) enddo
107)
108) list => realization%output_option%output_snap_variable_list
109) call MiscibleSetPlotVariables(list)
110) list => realization%output_option%output_obs_variable_list
111) call MiscibleSetPlotVariables(list)
112)
113) end subroutine MiscibleSetup
114)
115) ! ************************************************************************** !
116)
117) subroutine MiscibleSetupPatch(realization)
118) !
119) ! Creates arrays for auxiliary variables
120) !
121) ! Author: Chuan Lu
122) ! Date: 10/1/08
123) !
124)
125) use Realization_Subsurface_class
126) use Patch_module
127) use Option_module
128) use Coupler_module
129) use Connection_module
130) use Grid_module
131)
132) implicit none
133)
134) type(realization_subsurface_type) :: realization
135)
136) type(option_type), pointer :: option
137) type(patch_type),pointer :: patch
138) type(grid_type), pointer :: grid
139) type(coupler_type), pointer :: boundary_condition
140)
141) PetscInt :: ghosted_id, iconn, sum_connection, ipara
142) type(Miscible_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
143)
144) option => realization%option
145) patch => realization%patch
146) grid => patch%grid
147) patch%aux%Miscible => MiscibleAuxCreate()
148)
149) ! option%io_buffer = 'Before Miscible can be run, the Miscible_parameter object ' // &
150) ! 'must be initialized with the proper variables ' // &
151) ! 'MiscibleAuxCreate() is called anyhwere.'
152) ! call printErrMsg(option)
153)
154) ! Miscible_parameters create *********************************************
155) allocate(patch%aux%Miscible%Miscible_parameter%sir(option%nphase, &
156) size(patch%saturation_function_array)))
157) do ipara = 1, size(patch%saturation_function_array)
158) patch%aux%Miscible%Miscible_parameter%sir(:,patch% &
159) saturation_function_array(ipara)%ptr%id) = &
160) patch%saturation_function_array(ipara)%ptr%Sr(:)
161) enddo
162)
163) ! dencpr
164) allocate(patch%aux%Miscible%Miscible_parameter%dencpr(size(patch%material_property_array)))
165) do ipara = 1, size(patch%material_property_array)
166) patch%aux%Miscible%Miscible_parameter%dencpr(iabs(patch% &
167) material_property_array(ipara)%ptr%internal_id)) = &
168) patch%material_property_array(ipara)%ptr%rock_density*option%scale*&
169) patch%material_property_array(ipara)%ptr%specific_heat
170) enddo
171)
172) ! ckwet
173) allocate(patch%aux%Miscible%Miscible_parameter%ckwet(size(patch%material_property_array)))
174) do ipara = 1, size(patch%material_property_array)
175) patch%aux%Miscible%Miscible_parameter%ckwet(iabs(patch% &
176) material_property_array(ipara)%ptr%internal_id)) = &
177) patch%material_property_array(ipara)%ptr%thermal_conductivity_wet*option%scale
178) enddo
179) ! Miscible_parameters create_end *****************************************
180)
181) ! allocate auxvar data structures for all grid cells
182) allocate(auxvars(grid%ngmax))
183) do ghosted_id = 1, grid%ngmax
184) call MiscibleAuxVarInit(auxvars(ghosted_id),option)
185) enddo
186) patch%aux%Miscible%auxvars => auxvars
187) patch%aux%Miscible%num_aux = grid%ngmax
188)
189) ! count the number of boundary connections and allocate
190) ! auxvar data structures for them
191) boundary_condition => patch%boundary_condition_list%first
192) sum_connection = 0
193) do
194) if (.not.associated(boundary_condition)) exit
195) sum_connection = sum_connection + &
196) boundary_condition%connection_set%num_connections
197) boundary_condition => boundary_condition%next
198) enddo
199) allocate(auxvars_bc(sum_connection))
200) do iconn = 1, sum_connection
201) call MiscibleAuxVarInit(auxvars_bc(iconn),option)
202) enddo
203) patch%aux%Miscible%auxvars_bc => auxvars_bc
204) patch%aux%Miscible%num_aux_bc = sum_connection
205) option%flow%numerical_derivatives = PETSC_TRUE
206)
207) allocate(patch%aux%Miscible%delx(option%nflowdof, grid%ngmax))
208) allocate(patch%aux%Miscible%Resold_AR(grid%nlmax,option%nflowdof))
209) allocate(patch%aux%Miscible%Resold_BC(grid%nlmax,option%nflowdof))
210) ! should be allocated by the number of BC connections, just for debug now
211) allocate(patch%aux%Miscible%Resold_FL(ConnectionGetNumberInList(patch%grid%&
212) internal_connection_set_list),option%nflowdof))
213)
214) end subroutine MiscibleSetupPatch
215)
216) ! ************************************************************************** !
217)
218) subroutine MiscibleComputeMassBalance(realization,mass_balance)
219) !
220) ! Adapted from RichardsComputeMassBalance: need to be checked
221) !
222) ! Author: Jitendra Kumar
223) ! Date: 07/21/2010
224) !
225)
226) use Realization_Subsurface_class
227) use Patch_module
228)
229) type(realization_subsurface_type) :: realization
230) PetscReal :: mass_balance(realization%option%nflowspec,1)
231)
232) type(patch_type), pointer :: cur_patch
233)
234) mass_balance = 0.d0
235)
236) cur_patch => realization%patch_list%first
237) do
238) if (.not.associated(cur_patch)) exit
239) realization%patch => cur_patch
240) call MiscibleComputeMassBalancePatch(realization,mass_balance)
241) cur_patch => cur_patch%next
242) enddo
243)
244) end subroutine MiscibleComputeMassBalance
245)
246) ! ************************************************************************** !
247)
248) subroutine MiscibleComputeMassBalancePatch(realization,mass_balance)
249) !
250) ! Adapted from RichardsComputeMassBalancePatch: need to be checked
251) !
252) ! Author: Jitendra Kumar
253) ! Date: 07/21/2010
254) !
255)
256) use Realization_Subsurface_class
257) use Option_module
258) use Patch_module
259) use Field_module
260) use Grid_module
261)
262) implicit none
263)
264) type(realization_subsurface_type) :: realization
265) PetscReal :: mass_balance(realization%option%nflowspec,1)
266)
267) type(option_type), pointer :: option
268) type(patch_type), pointer :: patch
269) type(field_type), pointer :: field
270) type(grid_type), pointer :: grid
271) type(miscible_auxvar_type), pointer :: miscible_auxvars(:)
272) type(global_auxvar_type), pointer :: global_auxvars(:)
273) PetscReal, pointer :: volume_p(:), porosity_loc_p(:)
274)
275) PetscErrorCode :: ierr
276) PetscInt :: local_id
277) PetscInt :: ghosted_id
278) PetscInt :: ispec
279) PetscInt :: jh2o=1,jglyc=2
280)
281) option => realization%option
282) patch => realization%patch
283) grid => patch%grid
284) field => realization%field
285)
286) global_auxvars => patch%aux%Global%auxvars
287) miscible_auxvars => patch%aux%Miscible%auxvars
288)
289) !geh refactor call VecGetArrayF90(field%volume,volume_p,ierr)
290) !geh refactor call VecGetArrayF90(field%porosity_loc,porosity_loc_p,ierr)
291)
292) do local_id = 1, grid%nlmax
293) ghosted_id = grid%nL2G(local_id)
294) !geh - Ignore inactive cells with inactive materials
295) if (associated(patch%imat)) then
296) if (patch%imat(ghosted_id) <= 0) cycle
297) endif
298) ! mass = saturation * density * mole fraction * volume
299) do ispec = 1,option%nflowspec
300) mass_balance(ispec,1) = mass_balance(ispec,1) + &
301) miscible_auxvars(ghosted_id)%auxvar_elem(0)%xmol(ispec)* &
302) global_auxvars(ghosted_id)%den(1)* &
303) porosity_loc_p(ghosted_id)*volume_p(local_id)
304) enddo
305) enddo
306) mass_balance(jh2o,1) = mass_balance(jh2o,1)*FMWH2O
307) mass_balance(jglyc,1) = mass_balance(jglyc,1)*FMWGLYC
308)
309) !geh refactor call VecRestoreArrayF90(field%volume,volume_p,ierr)
310) !geh refactor call VecRestoreArrayF90(field%porosity_loc,porosity_loc_p,ierr)
311)
312) end subroutine MiscibleComputeMassBalancePatch
313)
314) ! ************************************************************************** !
315)
316) subroutine MiscibleZeroMassBalDeltaPatch(realization)
317) !
318) ! Zeros mass balance delta array
319) !
320) ! Author: Satish Karra, LANL
321) ! Date: 12/13/11
322) !
323)
324) use Realization_Subsurface_class
325) use Option_module
326) use Patch_module
327) use Grid_module
328)
329) implicit none
330)
331) type(realization_subsurface_type) :: realization
332)
333) type(option_type), pointer :: option
334) type(patch_type), pointer :: patch
335) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
336) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
337)
338) PetscInt :: iconn
339)
340) option => realization%option
341) patch => realization%patch
342)
343) global_auxvars_bc => patch%aux%Global%auxvars_bc
344) global_auxvars_ss => patch%aux%Global%auxvars_ss
345)
346) #ifdef COMPUTE_INTERNAL_MASS_FLUX
347) do iconn = 1, patch%aux%Miscible%num_aux
348) patch%aux%Global%auxvars(iconn)%mass_balance_delta = 0.d0
349) enddo
350) #endif
351)
352) ! Intel 10.1 on Chinook reports a SEGV if this conditional is not
353) ! placed around the internal do loop - geh
354) if (patch%aux%Miscible%num_aux_bc > 0) then
355) do iconn = 1, patch%aux%Miscible%num_aux_bc
356) global_auxvars_bc(iconn)%mass_balance_delta = 0.d0
357) enddo
358) endif
359) if (patch%aux%Miscible%num_aux_ss > 0) then
360) do iconn = 1, patch%aux%Miscible%num_aux_ss
361) global_auxvars_ss(iconn)%mass_balance_delta = 0.d0
362) enddo
363) endif
364)
365) end subroutine MiscibleZeroMassBalDeltaPatch
366)
367) ! ************************************************************************** !
368)
369) subroutine MiscibleUpdateMassBalancePatch(realization)
370) !
371) ! Updates mass balance
372) !
373) ! Author: Glenn Hammond
374) ! Date: 12/13/11
375) !
376)
377) use Realization_Subsurface_class
378) use Option_module
379) use Patch_module
380) use Grid_module
381)
382) implicit none
383)
384) type(realization_subsurface_type) :: realization
385)
386) type(option_type), pointer :: option
387) type(patch_type), pointer :: patch
388) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
389) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
390)
391) PetscInt :: iconn
392)
393) option => realization%option
394) patch => realization%patch
395)
396) global_auxvars_bc => patch%aux%Global%auxvars_bc
397) global_auxvars_ss => patch%aux%Global%auxvars_ss
398)
399) #ifdef COMPUTE_INTERNAL_MASS_FLUX
400) do iconn = 1, patch%aux%Miscible%num_aux
401) patch%aux%Global%auxvars(iconn)%mass_balance = &
402) patch%aux%Global%auxvars(iconn)%mass_balance + &
403) patch%aux%Global%auxvars(iconn)%mass_balance_delta* &
404) option%flow_dt
405) enddo
406) #endif
407)
408) if (patch%aux%Miscible%num_aux_bc > 0) then
409) do iconn = 1, patch%aux%Miscible%num_aux_bc
410) global_auxvars_bc(iconn)%mass_balance = &
411) global_auxvars_bc(iconn)%mass_balance + &
412) global_auxvars_bc(iconn)%mass_balance_delta*option%flow_dt
413) enddo
414) endif
415)
416) if (patch%aux%Miscible%num_aux_ss > 0) then
417) do iconn = 1, patch%aux%Miscible%num_aux_ss
418) global_auxvars_bc(iconn)%mass_balance = &
419) global_auxvars_bc(iconn)%mass_balance + &
420) global_auxvars_bc(iconn)%mass_balance_delta*option%flow_dt
421) enddo
422) endif
423)
424)
425) end subroutine MiscibleUpdateMassBalancePatch
426)
427) ! ************************************************************************** !
428)
429) function MiscibleInitGuessCheck(realization)
430) !
431) ! MiscibleInitGuessCheckPatch:
432) !
433) ! Author: Chuan Lu
434) ! Date: 12/10/07
435) !
436)
437) use Realization_Subsurface_class
438) use Patch_module
439) use Option_module
440)
441) PetscInt :: MiscibleInitGuessCheck
442) type(realization_subsurface_type) :: realization
443) type(option_type), pointer :: option
444) type(patch_type), pointer :: cur_patch
445) PetscInt :: ipass, ipass0
446) PetscErrorCode :: ierr
447)
448) option => realization%option
449) ipass = 1
450) cur_patch => realization%patch_list%first
451) do
452) if (.not.associated(cur_patch)) exit
453) realization%patch => cur_patch
454) ipass= MiscibleInitGuessCheckPatch(realization)
455) if (ipass<=0)then
456) exit
457) endif
458) cur_patch => cur_patch%next
459) enddo
460)
461) call MPI_Barrier(option%mycomm,ierr)
462) if (option%mycommsize >1)then
463) call MPI_Allreduce(ipass,ipass0,ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM, &
464) option%mycomm,ierr)
465) if (ipass0 < option%mycommsize) ipass=-1
466) endif
467) MiscibleInitGuessCheck =ipass
468)
469) end function MiscibleInitGuessCheck
470)
471) ! ************************************************************************** !
472)
473) function MiscibleInitGuessCheckPatch(realization)
474) !
475) ! Author: Chuan Lu
476) ! Date: 10/10/08
477) !
478)
479) use co2_span_wagner_module
480)
481) use Realization_Subsurface_class
482) use Patch_module
483) use Field_module
484) use Grid_module
485) use Option_module
486) implicit none
487)
488) PetscInt :: MiscibleInitGuessCheckPatch
489) type(realization_subsurface_type) :: realization
490) type(grid_type), pointer :: grid
491) type(patch_type), pointer :: patch
492) type(option_type), pointer :: option
493) type(field_type), pointer :: field
494)
495) PetscInt :: local_id, ghosted_id, ipass
496) PetscErrorCode :: ierr
497) PetscReal, pointer :: xx_p(:)
498)
499) patch => realization%patch
500) grid => patch%grid
501) option => realization%option
502) field => realization%field
503)
504) !geh: not sure why this is here, therefore, commenting out.
505) ! call VecGetArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
506)
507) ipass=1
508) MiscibleInitGuessCheckPatch = ipass
509) end function MiscibleInitGuessCheckPatch
510)
511) ! ************************************************************************** !
512)
513) subroutine MiscibleUpdateAuxVars(realization)
514) !
515) ! Updates the auxiliary variables associated with
516) ! the Miscible problem
517) !
518) ! Author: Chuan Lu
519) ! Date: 10/10/08
520) !
521)
522) use Realization_Subsurface_class
523) use Patch_module
524)
525) type(realization_subsurface_type) :: realization
526)
527) type(patch_type), pointer :: cur_patch
528)
529) cur_patch => realization%patch_list%first
530) do
531) if (.not.associated(cur_patch)) exit
532) realization%patch => cur_patch
533) call MiscibleUpdateAuxVarsPatch(realization)
534) cur_patch => cur_patch%next
535) enddo
536)
537) end subroutine MiscibleUpdateAuxVars
538)
539) ! ************************************************************************** !
540)
541) subroutine MiscibleUpdateAuxVarsPatch(realization)
542) !
543) ! Updates the auxiliary variables associated with
544) ! the Miscible problem
545) !
546) ! Author: Chuan Lu
547) ! Date: 12/10/07
548) !
549)
550) use Realization_Subsurface_class
551) use Patch_module
552) use Field_module
553) use Option_module
554) use Grid_module
555) use Coupler_module
556) use Connection_module
557) use Material_module
558)
559) implicit none
560)
561) type(realization_subsurface_type) :: realization
562)
563) type(option_type), pointer :: option
564) type(patch_type), pointer :: patch
565) type(grid_type), pointer :: grid
566) type(field_type), pointer :: field
567) type(coupler_type), pointer :: boundary_condition
568) type(connection_set_type), pointer :: cur_connection_set
569) type(Miscible_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
570) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
571)
572) PetscInt :: ghosted_id, local_id, istart, iend, sum_connection, idof, iconn
573) PetscInt :: iphasebc, iphase
574) PetscReal, pointer :: xx_loc_p(:), icap_loc_p(:), iphase_loc_p(:)
575) PetscReal :: xxbc(realization%option%nflowdof)
576) PetscReal :: mnacl, ynacl, xphi
577) PetscErrorCode :: ierr
578)
579) option => realization%option
580) patch => realization%patch
581) grid => patch%grid
582) field => realization%field
583)
584) auxvars => patch%aux%Miscible%auxvars
585) auxvars_bc => patch%aux%Miscible%auxvars_bc
586) global_auxvars => patch%aux%Global%auxvars
587) global_auxvars_bc => patch%aux%Global%auxvars_bc
588)
589)
590) call VecGetArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
591) call VecGetArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
592)
593) do ghosted_id = 1, grid%ngmax
594) if (grid%nG2L(ghosted_id) < 0) cycle ! bypass ghosted corner cells
595) !geh - Ignore inactive cells with inactive materials
596) if (associated(patch%imat)) then
597) if (patch%imat(ghosted_id) <= 0) cycle
598) endif
599) iend = ghosted_id*option%nflowdof
600) istart = iend-option%nflowdof+1
601) if (.not. associated(patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr))then
602) print*, 'error!!! saturation function not allocated', ghosted_id,icap_loc_p(ghosted_id)
603) endif
604)
605) call MiscibleAuxVarCompute_NINC(xx_loc_p(istart:iend), &
606) auxvars(ghosted_id)%auxvar_elem(0), &
607) global_auxvars(ghosted_id), &
608) realization%fluid_properties,option)
609)
610) ! update global variables
611) if ( associated(global_auxvars))then
612) global_auxvars(ghosted_id)%pres = auxvars(ghosted_id)%auxvar_elem(0)%pres
613) global_auxvars(ghosted_id)%sat(:) = 1D0
614) global_auxvars(ghosted_id)%den(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:)
615) global_auxvars(ghosted_id)%den_kg(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:) &
616) *auxvars(ghosted_id)%auxvar_elem(0)%avgmw(:)
617) else
618) print *,'Not associated global for Miscible'
619) endif
620)
621) enddo
622)
623) boundary_condition => patch%boundary_condition_list%first
624) sum_connection = 0
625) do
626) if (.not.associated(boundary_condition)) exit
627) cur_connection_set => boundary_condition%connection_set
628) do iconn = 1, cur_connection_set%num_connections
629) sum_connection = sum_connection + 1
630) local_id = cur_connection_set%id_dn(iconn)
631) ghosted_id = grid%nL2G(local_id)
632) if (associated(patch%imat)) then
633) if (patch%imat(ghosted_id) <= 0) cycle
634) endif
635) do idof=1,option%nflowdof
636) select case(boundary_condition%flow_condition%itype(idof))
637) case(DIRICHLET_BC,HYDROSTATIC_BC)
638) xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
639) case(NEUMANN_BC,ZERO_GRADIENT_BC)
640) xxbc(:) = xx_loc_p((ghosted_id-1)*option%nflowdof+1:ghosted_id*option%nflowdof)
641) end select
642) enddo
643)
644) call MiscibleAuxVarCompute_NINC(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0), &
645) global_auxvars_bc(sum_connection), &
646) realization%fluid_properties, option)
647)
648) if (associated(global_auxvars_bc)) then
649) global_auxvars_bc(sum_connection)%pres(:)= auxvars_bc(sum_connection)%auxvar_elem(0)%pres
650) global_auxvars_bc(sum_connection)%sat(:)=1.D0
651) global_auxvars_bc(sum_connection)%den(:)=auxvars_bc(sum_connection)%auxvar_elem(0)%den(:)
652) global_auxvars_bc(sum_connection)%den_kg = auxvars_bc(sum_connection)%auxvar_elem(0)%den(:) &
653) * auxvars_bc(sum_connection)%auxvar_elem(0)%avgmw(:)
654) endif
655)
656) enddo
657) boundary_condition => boundary_condition%next
658) enddo
659)
660) call VecRestoreArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
661) call VecRestoreArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
662)
663) patch%aux%Miscible%auxvars_up_to_date = PETSC_TRUE
664)
665) end subroutine MiscibleUpdateAuxVarsPatch
666)
667) ! ************************************************************************** !
668)
669) subroutine MiscibleInitializeTimestep(realization)
670) !
671) ! Update data in module prior to time step
672) !
673) ! Author: Chuan Lu
674) ! Date: 10/12/08
675) !
676)
677) use Realization_Subsurface_class
678)
679) implicit none
680)
681) type(realization_subsurface_type) :: realization
682)
683) call MiscibleUpdateFixedAccumulation(realization)
684)
685) end subroutine MiscibleInitializeTimestep
686)
687) ! ************************************************************************** !
688)
689) subroutine MiscibleUpdateSolution(realization)
690) !
691) ! Updates data in module after a successful time step
692) !
693) ! Author: Chuan Lu
694) ! Date: 10/13/08
695) !
696)
697) use Realization_Subsurface_class
698) use Field_module
699) use Patch_module
700)
701) implicit none
702)
703) type(realization_subsurface_type) :: realization
704)
705) type(field_type), pointer :: field
706) type(patch_type), pointer :: cur_patch
707)
708) PetscErrorCode :: ierr
709)
710) field => realization%field
711)
712) cur_patch => realization%patch_list%first
713) do
714) if (.not.associated(cur_patch)) exit
715) realization%patch => cur_patch
716) call MiscibleUpdateSolutionPatch(realization)
717) cur_patch => cur_patch%next
718) enddo
719)
720) end subroutine MiscibleUpdateSolution
721)
722) ! ************************************************************************** !
723)
724) subroutine MiscibleUpdateSolutionPatch(realization)
725) !
726) ! Updates data in module after a successful time
727) ! step
728) ! written based on RichardsUpdateSolutionPatch
729) !
730) ! Author: Satish Karra, LANL
731) ! Date: 08/23/11
732) !
733)
734) use Realization_Subsurface_class
735)
736) implicit none
737)
738) type(realization_subsurface_type) :: realization
739)
740) if (realization%option%compute_mass_balance_new) then
741) call MiscibleUpdateMassBalancePatch(realization)
742) endif
743)
744) end subroutine MiscibleUpdateSolutionPatch
745)
746) ! ************************************************************************** !
747)
748) subroutine MiscibleUpdateFixedAccumulation(realization)
749) !
750) ! Updates the fixed portion of the
751) ! accumulation term
752) !
753) ! Author: Chuan Lu
754) ! Date: 10/12/08
755) !
756)
757) use Realization_Subsurface_class
758) use Patch_module
759)
760) type(realization_subsurface_type) :: realization
761)
762) type(patch_type), pointer :: cur_patch
763)
764) cur_patch => realization%patch_list%first
765) do
766) if (.not.associated(cur_patch)) exit
767) realization%patch => cur_patch
768) call MiscibleUpdateFixedAccumPatch(realization)
769) cur_patch => cur_patch%next
770) enddo
771)
772) end subroutine MiscibleUpdateFixedAccumulation
773)
774) ! ************************************************************************** !
775)
776) subroutine MiscibleUpdateFixedAccumPatch(realization)
777) !
778) ! Updates the fixed portion of the
779) ! accumulation term
780) !
781) ! Author: Chuan Lu
782) ! Date: 10/12/08
783) !
784)
785) use Realization_Subsurface_class
786) use Patch_module
787) use Option_module
788) use Field_module
789) use Grid_module
790)
791) implicit none
792)
793) type(realization_subsurface_type) :: realization
794)
795) type(option_type), pointer :: option
796) type(patch_type), pointer :: patch
797) type(grid_type), pointer :: grid
798) type(field_type), pointer :: field
799) type(Miscible_parameter_type), pointer :: Miscible_parameter
800) type(Miscible_auxvar_type), pointer :: auxvars(:)
801) type(global_auxvar_type), pointer :: global_auxvars(:)
802)
803) PetscInt :: ghosted_id, local_id, istart, iend, iphase
804) PetscReal, pointer :: xx_p(:), icap_loc_p(:), iphase_loc_p(:)
805) PetscReal, pointer :: porosity_loc_p(:), tortuosity_loc_p(:), volume_p(:), &
806) ithrm_loc_p(:), accum_p(:)
807)
808) PetscErrorCode :: ierr
809)
810) call MiscibleUpdateAuxVarsPatch(realization)
811) option => realization%option
812) field => realization%field
813) patch => realization%patch
814) grid => patch%grid
815)
816) global_auxvars => patch%aux%Global%auxvars
817) Miscible_parameter => patch%aux%Miscible%Miscible_parameter
818) auxvars => patch%aux%Miscible%auxvars
819)
820) call VecGetArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
821) call VecGetArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
822) !geh refactor call VecGetArrayF90(field%porosity_loc,porosity_loc_p,ierr)
823) !geh refactor call VecGetArrayF90(field%tortuosity_loc,tortuosity_loc_p,ierr)
824) !geh refactor call VecGetArrayF90(field%volume,volume_p,ierr)
825) call VecGetArrayF90(field%ithrm_loc,ithrm_loc_p,ierr);CHKERRQ(ierr)
826) call VecGetArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
827)
828) do local_id = 1, grid%nlmax
829) ghosted_id = grid%nL2G(local_id)
830) !geh - Ignore inactive cells with inactive materials
831) if (associated(patch%imat)) then
832) if (patch%imat(ghosted_id) <= 0) cycle
833) endif
834) iend = local_id*option%nflowdof
835) istart = iend-option%nflowdof+1
836)
837) call MiscibleAccumulation(auxvars(ghosted_id)%auxvar_elem(0), &
838) global_auxvars(ghosted_id), &
839) porosity_loc_p(ghosted_id), &
840) volume_p(local_id), &
841) Miscible_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
842) option,accum_p(istart:iend))
843) enddo
844)
845) call VecRestoreArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
846) call VecRestoreArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
847) !geh refactor call VecRestoreArrayF90(field%porosity_loc,porosity_loc_p,ierr)
848) !geh refactor call VecRestoreArrayF90(field%tortuosity_loc,tortuosity_loc_p,ierr)
849) !geh refactor call VecRestoreArrayF90(field%volume,volume_p,ierr)
850) call VecRestoreArrayF90(field%ithrm_loc,ithrm_loc_p,ierr);CHKERRQ(ierr)
851)
852) call VecRestoreArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
853)
854) end subroutine MiscibleUpdateFixedAccumPatch
855)
856) ! ************************************************************************** !
857)
858) subroutine MiscibleAccumulation(auxvar,global_auxvar,por,vol,rock_dencpr,option,Res)
859) !
860) ! Computes the non-fixed portion of the accumulation
861) ! term for the residual
862) !
863) ! Author: Chuan Lu
864) ! Date: 10/12/08
865) !
866)
867) use Option_module
868)
869) implicit none
870)
871) type(Miscible_auxvar_elem_type) :: auxvar
872) type(option_type) :: option
873) type(global_auxvar_type) :: global_auxvar
874) PetscReal :: Res(1:option%nflowdof)
875) PetscReal :: vol,por,rock_dencpr
876)
877) PetscInt :: ispec, np
878) PetscReal :: porXvol, mol(option%nflowspec)
879)
880) porXvol = por*vol
881) mol=0.d0
882) do np = 1, option%nphase
883) do ispec = 1, option%nflowspec
884) mol(ispec) = mol(ispec) + &
885) auxvar%den(np) * auxvar%xmol(ispec + (np-1)*option%nflowspec)
886) enddo
887) enddo
888) mol = mol*porXvol
889) Res(1:option%nflowspec) = mol(:)
890)
891) end subroutine MiscibleAccumulation
892)
893) ! ************************************************************************** !
894)
895) subroutine MiscibleAccumulation_Xp(auxvar,global_auxvar,por,vol,rock_dencpr,option,Res)
896) !
897) ! MiscibleAccumulation: Computes the non-fixed portion of the accumulation
898) ! term for the residual
899) !
900) ! Author: Chuan Lu
901) ! Date: 10/12/08
902) !
903)
904) use Option_module
905)
906) implicit none
907)
908) type(Miscible_auxvar_elem_type) :: auxvar
909) type(option_type) :: option
910) type(global_auxvar_type) :: global_auxvar
911) PetscReal :: Res(1:option%nflowdof)
912) PetscReal :: vol,por,rock_dencpr
913)
914) PetscInt :: ispec, np
915) PetscReal :: porXvol, mol(option%nflowspec)
916)
917) porXvol = por*vol
918) mol = 0.d0
919) np = 1
920)
921) ! pressure equation
922) ispec = 1
923) mol(ispec) = mol(ispec) + auxvar%den(np)
924)
925) !PPG
926) ispec = 2
927) mol(ispec) = mol(ispec) + &
928) auxvar%den(np) * auxvar%xmol(ispec + (np-1)*option%nflowspec)
929)
930) mol = mol*porXvol
931) Res(1:option%nflowspec) = mol(:)
932)
933) end subroutine MiscibleAccumulation_Xp
934)
935) ! ************************************************************************** !
936)
937) subroutine MiscibleSourceSink(mmsrc,nsrcpara,psrc,tsrc,hsrc,csrc,auxvar,isrctype,Res,&
938) qsrc_vol,energy_flag, option)
939) !
940) ! Computes the non-fixed portion of the accumulation
941) ! term for the residual
942) !
943) ! Author: Chuan Lu
944) ! Date: 10/12/08
945) !
946)
947) use Option_module
948)
949)
950) use EOS_Water_module
951) use co2eos_module
952) use co2_span_wagner_spline_module, only: sw_prop
953) use co2_sw_module, only: co2_sw_interp
954) use co2_span_wagner_module
955)
956) implicit none
957)
958) type(Miscible_auxvar_elem_type) :: auxvar
959) type(option_type) :: option
960) PetscReal Res(1:option%nflowdof)
961) PetscReal, pointer :: mmsrc(:)
962) PetscReal psrc(option%nphase),tsrc,hsrc, csrc
963) PetscInt isrctype, nsrcpara
964) PetscBool :: energy_flag
965) PetscReal :: qsrc_vol(option%nphase)
966)
967) PetscReal, pointer :: msrc(:)
968) PetscReal dw_kg, dw_mol,dddt,dddp
969) PetscReal :: enth_src_h2o, enth_src_co2
970) PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
971) PetscReal :: ukvr, v_darcy, dq, dphi
972) PetscReal :: well_status, well_diameter
973) PetscReal :: pressure_bh, well_factor, pressure_max, pressure_min
974) PetscReal :: well_inj_water, well_inj_co2
975) PetscInt :: np
976) PetscInt :: iflag
977) PetscErrorCode :: ierr
978)
979) Res=0D0
980) allocate(msrc(nsrcpara))
981) msrc = mmsrc(1:nsrcpara)
982) qsrc_vol(:) = 0.d0
983) ! if (present(ireac)) iireac=ireac
984) ! if (energy_flag) then
985) ! Res(option%nflowdof) = Res(option%nflowdof) + hsrc * option%flow_dt
986) ! endif
987)
988) select case(isrctype)
989) case(MASS_RATE_SS)
990) msrc(1) = msrc(1) / FMWH2O
991) msrc(2) = msrc(2) / FMWGLYC
992) if (msrc(1) /= 0.d0 .or. msrc(2) /= 0.d0) then ! H2O injection
993) ! call EOSWaterDensityEnthalpy(tsrc,auxvar%pres,dw_kg,dw_mol,enth_src_h2o,ierr)
994) ! J/kmol -> whatever units
995) !enth_src_h2o = enth_src_h2o * option%scale
996) ! units: dw_mol [mol/dm^3]; dw_kg [kg/m^3]
997) ! qqsrc = qsrc1/dw_mol ! [kmol/s (mol/dm^3 = kmol/m^3)]
998) Res(jh2o) = Res(jh2o) + msrc(1)*option%flow_dt
999) Res(jglyc) = Res(jglyc) + msrc(2)*option%flow_dt
1000) endif
1001) #if 0
1002) ! End of mass rate inplementation
1003) case(WELL_SS) ! production well
1004) !if node pessure is lower than the given extraction pressure, shut it down
1005) ! Flow term
1006) ! well parameter explaination
1007) ! 1. well status. 1 injection; -1 production; 0 shut in
1008) ! 2 rate controled injection (same as rate_ss, with max pressure control, not completed yet)
1009) ! -2 rate controled production(not implemented for now)
1010) !
1011) ! 2. well factor [m^3], the effective permeability [m^2/s]
1012) ! 3. bottomhole pressure: [Pa]
1013) ! 4. max pressure: [Pa]
1014) ! 5. min pressure: [Pa]
1015) ! 6. preferred mass flux of water [kg/s]
1016) ! 7. preferred mass flux of CO2 [kg/s]
1017) ! 8. well diameter, not used now
1018) ! 9. skin factor, not used now
1019)
1020) well_status = msrc(1)
1021) well_factor = msrc(2)
1022) pressure_bh = msrc(3)
1023) pressure_max = msrc(4)
1024) pressure_min = msrc(5)
1025) well_inj_water = msrc(6)
1026) well_inj_co2 = msrc(7)
1027)
1028) ! if (pressure_min < 0D0) pressure_min = 0D0 !not limited by pressure lower bound
1029)
1030) ! production well (well status = -1)
1031) if (dabs(well_status + 1D0) < 1D-1) then
1032) if (auxvar%pres > pressure_min) then
1033) Dq = well_factor
1034) do np = 1, option%nphase
1035) dphi = auxvar%pres - auxvar%pc(np) - pressure_bh
1036) if (dphi>=0.D0) then ! outflow only
1037) ukvr = auxvar%kvr(np)
1038) if (ukvr<1e-20) ukvr=0D0
1039) v_darcy=0D0
1040) if (ukvr*Dq>floweps) then
1041) v_darcy = Dq * ukvr * dphi
1042) ! store volumetric rate for ss_fluid_fluxes()
1043) qsrc_liq(1) = -1.d0*v_darcy
1044) Res(1) = Res(1) - v_darcy* auxvar%den(np)* &
1045) auxvar%xmol((np-1)*option%nflowspec+1)*option%flow_dt
1046) Res(2) = Res(2) - v_darcy* auxvar%den(np)* &
1047) auxvar%xmol((np-1)*option%nflowspec+2)*option%flow_dt
1048) if (energy_flag) Res(3) = Res(3) - v_darcy * auxvar%den(np)* &
1049) auxvar%h(np)*option%flow_dt
1050) ! print *,'produce: ',np,v_darcy
1051) endif
1052) endif
1053) enddo
1054) endif
1055) endif
1056) !print *,'well-prod: ', auxvar%pres,psrc(1), res
1057) ! injection well (well status = 2)
1058) if (dabs(well_status - 2D0) < 1D-1) then
1059)
1060) call EOSWaterDensity(tsrc,auxvar%pres,dw_kg,dw_mol,ierr)
1061) call EOSWaterEnthalpy(tsrc,auxvar%pres,enth_src_h2o,ierr)
1062) ! J/kmol -> whatever units
1063) enth_src_h2o = enth_src_h2o * option%scale
1064)
1065) Dq = msrc(2) ! well parameter, read in input file
1066) ! Take the place of 2nd parameter
1067) ! Flow term
1068) if (auxvar%pres < pressure_max) then
1069) do np = 1, option%nphase
1070) dphi = pressure_bh - auxvar%pres + auxvar%pc(np)
1071) if (dphi>=0.D0) then ! outflow only
1072) ukvr = auxvar%kvr(np)
1073) v_darcy=0.D0
1074) if (ukvr*Dq>floweps) then
1075) v_darcy = Dq * ukvr * dphi
1076) ! store volumetric rate for ss_fluid_fluxes()
1077) qsrc_liq(1) = v_darcy
1078) Res(1) = Res(1) + v_darcy* auxvar%den(np)* &
1079) ! auxvar%xmol((np-1)*option%nflowspec+1) * option%flow_dt
1080) (1.d0-csrc) * option%flow_dt
1081) Res(2) = Res(2) + v_darcy* auxvar%den(np)* &
1082) ! auxvar%xmol((np-1)*option%nflowspec+2) * option%flow_dt
1083) csrc * option%flow_dt
1084) ! if (energy_flag) Res(3) = Res(3) + v_darcy*auxvar%den(np)*auxvar%h(np)*option%flow_dt
1085) if (energy_flag) Res(3) = Res(3) + v_darcy*auxvar%den(np)* &
1086) enth_src_h2o*option%flow_dt
1087)
1088) ! print *,'inject: ',np,v_darcy
1089) endif
1090) endif
1091) enddo
1092) endif
1093) endif
1094) #endif
1095) case default
1096) print *,'Unrecognized Source/Sink condition: ', isrctype
1097) end select
1098) ! deallocate(msrc)
1099)
1100) end subroutine MiscibleSourceSink
1101)
1102) ! ************************************************************************** !
1103)
1104) subroutine MiscibleFlux(auxvar_up,por_up,tor_up,dd_up,perm_up, &
1105) auxvar_dn,por_dn,tor_dn,dd_dn,perm_dn, &
1106) area,dist_gravity,upweight, &
1107) option,vv_darcy,Res)
1108) !
1109) ! Computes the internal flux terms for the residual
1110) !
1111) ! Author: Chuan Lu
1112) ! Date: 10/12/08
1113) !
1114) use Option_module
1115)
1116) implicit none
1117)
1118) type(Miscible_auxvar_elem_type) :: auxvar_up, auxvar_dn
1119) type(option_type) :: option
1120) PetscReal :: por_up, por_dn
1121) PetscReal :: tor_up, tor_dn
1122) PetscReal :: dd_up, dd_dn
1123) PetscReal :: perm_up, perm_dn
1124) PetscReal :: vv_darcy(:),area
1125) PetscReal :: Res(1:option%nflowdof)
1126) PetscReal :: dist_gravity ! distance along gravity vector
1127)
1128) PetscInt :: ispec, np, ind
1129) PetscReal :: fluxm(option%nflowspec),q,v_darcy
1130) PetscReal :: uxmol(1:option%nflowspec),ukvr,Dq
1131) PetscReal :: upweight,density_ave,gravity,dphi
1132) PetscReal :: portor_up,portor_dn,dendif_up,dendif_dn,dif_harmonic
1133)
1134) Dq = (perm_up*perm_dn)/(dd_up*perm_dn + dd_dn*perm_up)
1135)
1136) ! harmonic average porosity and tortuosity
1137) portor_up = por_up*tor_up
1138) portor_dn = por_dn*tor_dn
1139)
1140) fluxm = 0.D0
1141) vv_darcy = 0.D0
1142)
1143) do np = 1, option%nphase
1144)
1145) ! Flow term
1146)
1147) density_ave = upweight*auxvar_up%den(np) + (1.D0-upweight)*auxvar_dn%den(np)
1148)
1149) gravity = (upweight*auxvar_up%den(np)*auxvar_up%avgmw(np) + &
1150) (1.D0-upweight)*auxvar_dn%den(np)*auxvar_dn%avgmw(np)) &
1151) *dist_gravity
1152)
1153) dphi = auxvar_up%pres - auxvar_dn%pres + gravity
1154)
1155) v_darcy = 0.D0
1156) ukvr = 0.D0
1157) uxmol = 0.D0
1158)
1159) ! note uxmol only contains one phase xmol
1160) if (dphi >= 0.D0) then
1161) ukvr = auxvar_up%kvr(np)
1162) uxmol(:) = auxvar_up%xmol((np-1)*option%nflowspec+1:np*option%nflowspec)
1163) else
1164) ukvr = auxvar_dn%kvr(np)
1165) uxmol(:) = auxvar_dn%xmol((np-1)*option%nflowspec+1:np*option%nflowspec)
1166) endif
1167)
1168) v_darcy = Dq * ukvr * dphi
1169) vv_darcy(np) = v_darcy
1170) q = v_darcy * area
1171) do ispec = 1, option%nflowspec
1172) fluxm(ispec) = fluxm(ispec) + q*density_ave*uxmol(ispec)
1173) enddo
1174)
1175) ! Diffusion term
1176) ! Note : use harmonic average rule for diffusion
1177) do ispec=1, option%nflowspec
1178) ind = ispec + (np-1)*option%nflowspec
1179) dendif_up = auxvar_up%den(1)*auxvar_up%diff(ispec)
1180) dendif_dn = auxvar_dn%den(1)*auxvar_dn%diff(ispec)
1181) dif_harmonic = (portor_up*portor_dn*dendif_up*dendif_dn) &
1182) /(dd_dn*portor_up*dendif_up + dd_up*portor_dn*dendif_dn)*area
1183) fluxm(ispec) = fluxm(ispec) + dif_harmonic* &
1184) (auxvar_up%xmol(ind) - auxvar_dn%xmol(ind))
1185) enddo
1186) enddo
1187)
1188) ! note: Res is the flux contribution, for node 1 R = R + Res_FL
1189) ! 2 R = R - Res_FL
1190) Res(1:option%nflowspec) = fluxm(:)*option%flow_dt
1191)
1192) end subroutine MiscibleFlux
1193)
1194) ! ************************************************************************** !
1195)
1196) subroutine MiscibleBCFlux(ibndtype,auxvars,auxvar_up,auxvar_dn, &
1197) por_dn,tor_dn,dd_up,perm_dn, &
1198) area,dist_gravity,option,vv_darcy,Res)
1199) !
1200) ! Computes the boundary flux terms for the residual
1201) !
1202) ! Author: Chuan Lu
1203) ! Date: 10/12/08
1204) !
1205) use Option_module
1206)
1207) implicit none
1208)
1209) PetscInt :: ibndtype(:)
1210) type(Miscible_auxvar_elem_type) :: auxvar_up, auxvar_dn
1211) type(option_type) :: option
1212) PetscReal :: dd_up
1213) PetscReal :: auxvars(:) ! from aux_real_var array
1214) PetscReal :: por_dn,perm_dn,tor_dn
1215) PetscReal :: vv_darcy(:), area
1216) PetscReal :: Res(1:option%nflowdof)
1217)
1218) PetscReal :: dist_gravity ! distance along gravity vector
1219)
1220) PetscInt :: ispec, np
1221) PetscReal :: fluxm(option%nflowspec),q,density_ave, v_darcy
1222) PetscReal :: uxmol(1:option%nflowspec),ukvr,diff,portor,Dq
1223) PetscReal :: gravity,dphi
1224)
1225) fluxm = 0.d0
1226) v_darcy = 0.d0
1227) density_ave = 0.d0
1228) q = 0.d0
1229)
1230) portor = por_dn*tor_dn/dd_up*area
1231)
1232) ! Flow
1233) do np = 1, option%nphase ! note: nphase = 1
1234) select case(ibndtype(1))
1235) case(DIRICHLET_BC,HYDROSTATIC_BC,SEEPAGE_BC)
1236) Dq = perm_dn / dd_up
1237) ! Flow term
1238) ukvr=0.D0
1239) v_darcy=0.D0
1240)
1241) density_ave = auxvar_up%den(np)
1242)
1243) gravity = auxvar_up%den(np)*auxvar_up%avgmw(np)*dist_gravity
1244)
1245) dphi = auxvar_up%pres - auxvar_dn%pres &
1246) - auxvar_up%pc(np) + auxvar_dn%pc(np) &
1247) + gravity
1248)
1249) ! figure out the direction of flow
1250) if (dphi >= 0.D0) then
1251) ukvr = auxvar_up%kvr(np)
1252) else
1253) ukvr = auxvar_dn%kvr(np)
1254) endif
1255)
1256) if (ukvr*Dq > floweps) then
1257) v_darcy = Dq * ukvr * dphi
1258) endif
1259)
1260) case(NEUMANN_BC) !may not work
1261) v_darcy = 0.D0
1262) if (dabs(auxvars(1)) > floweps) then
1263) v_darcy = auxvars(MIS_PRESSURE_DOF)
1264) if (v_darcy > 0.d0) then
1265) density_ave = auxvar_up%den(np)
1266) else
1267) density_ave = auxvar_dn%den(np)
1268) endif
1269) endif
1270) end select
1271)
1272) q = v_darcy*area
1273) vv_darcy(np) = v_darcy
1274) uxmol = 0.D0
1275)
1276) if (v_darcy >= 0.D0) then
1277) uxmol(:) = auxvar_up%xmol((np-1)*option%nflowspec+1:np*option%nflowspec)
1278) else
1279) uxmol(:) = auxvar_dn%xmol((np-1)*option%nflowspec+1:np*option%nflowspec)
1280) endif
1281)
1282) do ispec=1, option%nflowspec
1283) fluxm(ispec) = fluxm(ispec) + q*density_ave*uxmol(ispec)
1284) end do
1285) enddo
1286)
1287) ! Diffusion term
1288) select case(ibndtype(2))
1289) case(DIRICHLET_BC)
1290) do np = 1, option%nphase ! note: nphase = 1
1291) diff = portor*auxvar_up%den(np)
1292) do ispec = 1, option%nflowspec
1293) fluxm(ispec) = fluxm(ispec) + diff* &
1294) auxvar_dn%diff((np-1)*option%nflowspec+ispec)* &
1295) (auxvar_up%xmol((np-1)*option%nflowspec+ispec) &
1296) -auxvar_dn%xmol((np-1)*option%nflowspec+ispec))
1297) enddo
1298) enddo
1299) end select
1300)
1301) Res(1:option%nflowspec) = fluxm(:)*option%flow_dt
1302)
1303) end subroutine MiscibleBCFlux
1304)
1305) ! ************************************************************************** !
1306)
1307) subroutine MiscibleResidual(snes,xx,r,realization,ierr)
1308) !
1309) ! Computes the residual equation
1310) !
1311) ! Author: Chuan Lu
1312) ! Date: 10/10/08
1313) !
1314)
1315) use Realization_Subsurface_class
1316) use Patch_module
1317) use Discretization_module
1318) use Field_module
1319) use Option_module
1320) use Grid_module
1321) use Logging_module
1322) use Debug_module
1323)
1324) implicit none
1325)
1326) SNES :: snes
1327) Vec :: xx
1328) Vec :: r
1329) type(realization_subsurface_type) :: realization
1330) PetscViewer :: viewer
1331) PetscErrorCode :: ierr
1332)
1333) type(discretization_type), pointer :: discretization
1334) type(option_type), pointer :: option
1335) type(grid_type), pointer :: grid
1336) type(field_type), pointer :: field
1337) type(patch_type), pointer :: cur_patch
1338) PetscInt :: ichange
1339) character(len=MAXSTRINGLENGTH) :: string
1340)
1341) field => realization%field
1342) grid => realization%patch%grid
1343) option => realization%option
1344) discretization => realization%discretization
1345)
1346) call PetscLogEventBegin(logging%event_r_residual,ierr);CHKERRQ(ierr)
1347)
1348) call DiscretizationGlobalToLocal(discretization,xx,field%flow_xx_loc,NFLOWDOF)
1349)
1350) ! check initial guess -----------------------------------------------
1351) ierr = MiscibleInitGuessCheck(realization)
1352) if (ierr<0)then
1353) !ierr = PETSC_ERR_ARG_OUTOFRANGE
1354) if (option%myrank==0) print *,'table out of range: ',ierr
1355) call SNESSetFunctionDomainError(snes,ierr);CHKERRQ(ierr)
1356) return
1357) endif
1358) ! end check ---------------------------------------------------------
1359)
1360) ! Communication -----------------------------------------
1361) ! These 3 must be called before MiscibleUpdateAuxVars()
1362) ! call DiscretizationGlobalToLocal(discretization,xx,field%flow_xx_loc,NFLOWDOF)
1363) call DiscretizationLocalToLocal(discretization,field%icap_loc,field%icap_loc,ONEDOF)
1364)
1365) !geh refactor call DiscretizationLocalToLocal(discretization,field%perm_xx_loc,field%perm_xx_loc,ONEDOF)
1366) !geh refactor call DiscretizationLocalToLocal(discretization,field%perm_yy_loc,field%perm_yy_loc,ONEDOF)
1367) !geh refactor call DiscretizationLocalToLocal(discretization,field%perm_zz_loc,field%perm_zz_loc,ONEDOF)
1368) call DiscretizationLocalToLocal(discretization,field%ithrm_loc,field%ithrm_loc,ONEDOF)
1369)
1370) ! call DiscretizationLocalToLocal(discretization,field%iphas_loc,field%iphas_loc,ONEDOF)
1371)
1372)
1373) ! pass #0 prepare numerical increment
1374) cur_patch => realization%patch_list%first
1375) do
1376) if (.not.associated(cur_patch)) exit
1377) realization%patch => cur_patch
1378) call MiscibleResidualPatch0(snes,xx,r,realization,ierr)
1379) cur_patch => cur_patch%next
1380) enddo
1381)
1382) ! pass #1 internal and boundary flux terms
1383) cur_patch => realization%patch_list%first
1384) do
1385) if (.not.associated(cur_patch)) exit
1386) realization%patch => cur_patch
1387) call MiscibleResidualPatch1(snes,xx,r,realization,ierr)
1388) cur_patch => cur_patch%next
1389) enddo
1390)
1391) ! pass #2 for everything else
1392) cur_patch => realization%patch_list%first
1393) do
1394) if (.not.associated(cur_patch)) exit
1395) realization%patch => cur_patch
1396) call MiscibleResidualPatch2(snes,xx,r,realization,ierr)
1397) cur_patch => cur_patch%next
1398) enddo
1399)
1400) if (realization%debug%vecview_residual) then
1401) string = 'MISresidual'
1402) call DebugCreateViewer(realization%debug,string,option,viewer)
1403) call VecView(r,viewer,ierr);CHKERRQ(ierr)
1404) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
1405) endif
1406) if (realization%debug%vecview_solution) then
1407) string = 'MISxx'
1408) call DebugCreateViewer(realization%debug,string,option,viewer)
1409) call VecView(xx,viewer,ierr);CHKERRQ(ierr)
1410) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
1411) endif
1412)
1413) call PetscLogEventEnd(logging%event_r_residual,ierr);CHKERRQ(ierr)
1414)
1415) end subroutine MiscibleResidual
1416)
1417) ! ************************************************************************** !
1418)
1419) subroutine MiscibleResidualPatch1(snes,xx,r,realization,ierr)
1420) !
1421) ! Computes the Residual by Flux
1422) !
1423) ! Author: Chuan Lu
1424) ! Date: 10/10/08
1425) !
1426)
1427) use Connection_module
1428) use Realization_Subsurface_class
1429) use Patch_module
1430) use Grid_module
1431) use Option_module
1432) use Coupler_module
1433) use Field_module
1434) use Debug_module
1435)
1436) implicit none
1437)
1438) type :: flux_ptrs
1439) PetscReal, dimension(:), pointer :: flux_p
1440) end type
1441)
1442) type (flux_ptrs), dimension(0:2) :: fluxes
1443) SNES, intent(in) :: snes
1444) Vec, intent(inout) :: xx
1445) Vec, intent(out) :: r
1446) type(realization_subsurface_type) :: realization
1447)
1448) PetscErrorCode :: ierr
1449) PetscInt :: i, jn
1450) PetscInt :: ip1, ip2
1451) PetscInt :: local_id, ghosted_id, local_id_up, local_id_dn, ghosted_id_up, ghosted_id_dn
1452)
1453) PetscReal, pointer ::accum_p(:)
1454)
1455) PetscReal, pointer :: r_p(:), porosity_loc_p(:), volume_p(:), &
1456) xx_loc_p(:), tortuosity_loc_p(:),&
1457) perm_xx_loc_p(:), perm_yy_loc_p(:), perm_zz_loc_p(:)
1458)
1459)
1460) PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
1461)
1462) PetscInt :: iphase
1463) PetscInt :: icap_up, icap_dn, ithrm_up, ithrm_dn
1464) PetscReal :: dd_up, dd_dn
1465) PetscReal :: dd, f_up, f_dn, ff
1466) PetscReal :: perm_up, perm_dn
1467) PetscReal :: D_up, D_dn ! "Diffusion" constants at upstream, downstream faces.
1468) PetscReal :: dw_kg, dw_mol,dddt,dddp
1469) PetscReal :: tsrc1, qsrc1, csrc1, enth_src_h2o, enth_src_co2 , hsrc1
1470) PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
1471) PetscReal :: upweight
1472) PetscReal :: Res(realization%option%nflowdof), v_darcy(realization%option%nphase)
1473) PetscReal :: xxbc(realization%option%nflowdof)
1474) PetscViewer :: viewer
1475)
1476)
1477) type(grid_type), pointer :: grid
1478) type(patch_type), pointer :: patch
1479) type(option_type), pointer :: option
1480) type(field_type), pointer :: field
1481) type(Miscible_parameter_type), pointer :: Miscible_parameter
1482) type(Miscible_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
1483) type(coupler_type), pointer :: boundary_condition, source_sink
1484) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
1485) type(connection_set_list_type), pointer :: connection_set_list
1486) type(connection_set_type), pointer :: cur_connection_set
1487) PetscBool :: enthalpy_flag
1488) PetscInt :: ng
1489) PetscInt :: axis, side, nlx, nly, nlz, ngx, ngxy, pstart, pend, flux_id
1490) PetscInt :: direction, max_x_conn, max_y_conn
1491) PetscInt :: iconn, idof, istart, iend
1492) PetscInt :: sum_connection
1493) PetscReal :: distance, fraction_upwind
1494) PetscReal :: distance_gravity
1495)
1496)
1497) patch => realization%patch
1498) grid => patch%grid
1499) option => realization%option
1500) field => realization%field
1501)
1502) Miscible_parameter => patch%aux%Miscible%Miscible_parameter
1503) auxvars => patch%aux%Miscible%auxvars
1504) auxvars_bc => patch%aux%Miscible%auxvars_bc
1505) global_auxvars => patch%aux%Global%auxvars
1506) global_auxvars_bc => patch%aux%Global%auxvars_bc
1507)
1508) ! call MiscibleUpdateAuxVarsPatchNinc(realization)
1509) ! override flags since they will soon be out of date
1510) ! patch%MiscibleAux%auxvars_up_to_date = PETSC_FALSE
1511)
1512) if (option%compute_mass_balance_new) then
1513) call MiscibleZeroMassBalDeltaPatch(realization)
1514) endif
1515)
1516) ! now assign access pointer to local variables
1517) call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
1518) call VecGetArrayF90( r, r_p, ierr);CHKERRQ(ierr)
1519) !geh refactor call VecGetArrayF90(field%porosity_loc, porosity_loc_p, ierr)
1520) !geh refactor call VecGetArrayF90(field%tortuosity_loc, tortuosity_loc_p, ierr)
1521) !geh refactor call VecGetArrayF90(field%perm_xx_loc, perm_xx_loc_p, ierr)
1522) !geh refactor call VecGetArrayF90(field%perm_yy_loc, perm_yy_loc_p, ierr)
1523) !geh refactor call VecGetArrayF90(field%perm_zz_loc, perm_zz_loc_p, ierr)
1524) !geh refactor call VecGetArrayF90(field%volume, volume_p, ierr)
1525) call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
1526) call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
1527)
1528) r_p = 0.d0
1529)
1530) ! Boundary Flux Terms -----------------------------------
1531) boundary_condition => patch%boundary_condition_list%first
1532) sum_connection = 0
1533) do
1534) if (.not.associated(boundary_condition)) exit
1535)
1536) cur_connection_set => boundary_condition%connection_set
1537)
1538) do iconn = 1, cur_connection_set%num_connections
1539) sum_connection = sum_connection + 1
1540)
1541) local_id = cur_connection_set%id_dn(iconn)
1542) ghosted_id = grid%nL2G(local_id)
1543)
1544) if (associated(patch%imat)) then
1545) if (patch%imat(ghosted_id) <= 0) cycle
1546) endif
1547)
1548) if (ghosted_id<=0) then
1549) print *, "Wrong boundary node index... STOP!!!"
1550) stop
1551) endif
1552)
1553) ithrm_dn = int(ithrm_loc_p(ghosted_id))
1554) D_dn = Miscible_parameter%ckwet(ithrm_dn)
1555)
1556) ! for now, just assume diagonal tensor
1557) perm_dn = perm_xx_loc_p(ghosted_id)*abs(cur_connection_set%dist(1,iconn))+ &
1558) perm_yy_loc_p(ghosted_id)*abs(cur_connection_set%dist(2,iconn))+ &
1559) perm_zz_loc_p(ghosted_id)*abs(cur_connection_set%dist(3,iconn))
1560) ! dist(0,iconn) = scalar - magnitude of distance
1561) ! gravity = vector(3)
1562) ! dist(1:3,iconn) = vector(3) - unit vector
1563) distance_gravity = cur_connection_set%dist(0,iconn) * &
1564) dot_product(option%gravity, &
1565) cur_connection_set%dist(1:3,iconn))
1566)
1567) icap_dn = int(icap_loc_p(ghosted_id))
1568) ! Then need fill up increments for BCs
1569) do idof =1, option%nflowdof
1570) select case(boundary_condition%flow_condition%itype(idof))
1571) case(DIRICHLET_BC)
1572) xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
1573) case(HYDROSTATIC_BC)
1574) xxbc(1) = boundary_condition%flow_aux_real_var(1,iconn)
1575) if (idof >= 2) then
1576) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
1577) endif
1578) case(NEUMANN_BC, ZERO_GRADIENT_BC)
1579) ! solve for pb from Darcy's law given qb /= 0
1580) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
1581) end select
1582) enddo
1583)
1584)
1585) call MiscibleAuxVarCompute_Ninc(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0),&
1586) global_auxvars_bc(sum_connection),&
1587) realization%fluid_properties, option)
1588)
1589) if ( associated(global_auxvars_bc))then
1590) global_auxvars_bc(sum_connection)%pres(:) = auxvars_bc(sum_connection)%auxvar_elem(0)%pres - &
1591) auxvars(ghosted_id)%auxvar_elem(0)%pc(:)
1592) global_auxvars_bc(sum_connection)%sat(:) = 1.D0
1593) global_auxvars_bc(sum_connection)%den(:) = auxvars_bc(sum_connection)%auxvar_elem(0)%den(:)
1594) global_auxvars_bc(sum_connection)%den_kg = auxvars_bc(sum_connection)%auxvar_elem(0)%den(:) &
1595) * auxvars_bc(sum_connection)%auxvar_elem(0)%avgmw(:)
1596) ! global_auxvars(ghosted_id)%den_kg_store
1597) endif
1598)
1599) call MiscibleBCFlux(boundary_condition%flow_condition%itype, &
1600) boundary_condition%flow_aux_real_var(:,iconn), &
1601) auxvars_bc(sum_connection)%auxvar_elem(0), &
1602) auxvars(ghosted_id)%auxvar_elem(0), &
1603) porosity_loc_p(ghosted_id), &
1604) tortuosity_loc_p(ghosted_id), &
1605) cur_connection_set%dist(0,iconn),perm_dn, &
1606) cur_connection_set%area(iconn), &
1607) distance_gravity,option, &
1608) v_darcy,Res)
1609) patch%boundary_velocities(:,sum_connection) = v_darcy(:)
1610) patch%aux%Miscible%Resold_BC(local_id,1:option%nflowdof) = &
1611) patch%aux%Miscible%ResOld_BC(local_id,1:option%nflowdof) - Res(1:option%nflowdof)
1612)
1613) if (option%compute_mass_balance_new) then
1614) ! contribution to boundary
1615) global_auxvars_bc(sum_connection)%mass_balance_delta(:,1) = &
1616) global_auxvars_bc(sum_connection)%mass_balance_delta(:,1) &
1617) - Res(:)/option%flow_dt
1618) endif
1619)
1620) iend = local_id*option%nflowdof
1621) istart = iend-option%nflowdof+1
1622) r_p(istart:iend)= r_p(istart:iend) - Res(1:option%nflowdof)
1623) enddo
1624) boundary_condition => boundary_condition%next
1625) enddo
1626)
1627) ! Interior Flux Terms -----------------------------------
1628) connection_set_list => grid%internal_connection_set_list
1629) cur_connection_set => connection_set_list%first
1630) sum_connection = 0
1631) do
1632) if (.not.associated(cur_connection_set)) exit
1633) do iconn = 1, cur_connection_set%num_connections
1634) sum_connection = sum_connection + 1
1635)
1636) ghosted_id_up = cur_connection_set%id_up(iconn)
1637) ghosted_id_dn = cur_connection_set%id_dn(iconn)
1638)
1639) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
1640) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
1641)
1642) if (associated(patch%imat)) then
1643) if (patch%imat(ghosted_id_up) <= 0 .or. &
1644) patch%imat(ghosted_id_dn) <= 0) cycle
1645) endif
1646)
1647) fraction_upwind = cur_connection_set%dist(-1,iconn)
1648) distance = cur_connection_set%dist(0,iconn)
1649) ! distance = scalar - magnitude of distance
1650) ! gravity = vector(3)
1651) ! dist(1:3,iconn) = vector(3) - unit vector
1652) distance_gravity = distance * &
1653) dot_product(option%gravity, &
1654) cur_connection_set%dist(1:3,iconn))
1655) dd_up = distance*fraction_upwind
1656) dd_dn = distance-dd_up ! should avoid truncation error
1657) ! upweight could be calculated as 1.d0-fraction_upwind
1658) ! however, this introduces ever so slight error causing pflow-overhaul not
1659) ! to match pflow-orig. This can be changed to 1.d0-fraction_upwind
1660) upweight = dd_dn/(dd_up+dd_dn)
1661)
1662) ! for now, just assume diagonal tensor
1663) perm_up = perm_xx_loc_p(ghosted_id_up)*abs(cur_connection_set%dist(1,iconn))+ &
1664) perm_yy_loc_p(ghosted_id_up)*abs(cur_connection_set%dist(2,iconn))+ &
1665) perm_zz_loc_p(ghosted_id_up)*abs(cur_connection_set%dist(3,iconn))
1666)
1667) perm_dn = perm_xx_loc_p(ghosted_id_dn)*abs(cur_connection_set%dist(1,iconn))+ &
1668) perm_yy_loc_p(ghosted_id_dn)*abs(cur_connection_set%dist(2,iconn))+ &
1669) perm_zz_loc_p(ghosted_id_dn)*abs(cur_connection_set%dist(3,iconn))
1670)
1671) call MiscibleFlux(auxvars(ghosted_id_up)%auxvar_elem(0),porosity_loc_p(ghosted_id_up), &
1672) tortuosity_loc_p(ghosted_id_up), &
1673) dd_up,perm_up, &
1674) auxvars(ghosted_id_dn)%auxvar_elem(0),porosity_loc_p(ghosted_id_dn), &
1675) tortuosity_loc_p(ghosted_id_dn), &
1676) dd_dn,perm_dn, &
1677) cur_connection_set%area(iconn),distance_gravity, &
1678) upweight,option,v_darcy,Res)
1679)
1680) patch%internal_velocities(:,sum_connection) = v_darcy(:)
1681) patch%aux%Miscible%Resold_FL(sum_connection,1:option%nflowdof)= Res(1:option%nflowdof)
1682)
1683) if (local_id_up > 0) then
1684) iend = local_id_up*option%nflowdof
1685) istart = iend-option%nflowdof+1
1686) r_p(istart:iend) = r_p(istart:iend) + Res(1:option%nflowdof)
1687) endif
1688)
1689) if (local_id_dn > 0) then
1690) iend = local_id_dn*option%nflowdof
1691) istart = iend-option%nflowdof+1
1692) r_p(istart:iend) = r_p(istart:iend) - Res(1:option%nflowdof)
1693) endif
1694) enddo
1695) cur_connection_set => cur_connection_set%next
1696) enddo
1697)
1698) call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
1699) call VecRestoreArrayF90( r, r_p, ierr);CHKERRQ(ierr)
1700) !geh refactor call VecRestoreArrayF90(field%porosity_loc, porosity_loc_p, ierr)
1701) !geh refactor call VecRestoreArrayF90(field%tortuosity_loc, tortuosity_loc_p, ierr)
1702) !geh refactor call VecRestoreArrayF90(field%perm_xx_loc, perm_xx_loc_p, ierr)
1703) !geh refactor call VecRestoreArrayF90(field%perm_yy_loc, perm_yy_loc_p, ierr)
1704) !geh refactor call VecRestoreArrayF90(field%perm_zz_loc, perm_zz_loc_p, ierr)
1705) !geh refactor call VecRestoreArrayF90(field%volume, volume_p, ierr)
1706) call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
1707) call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
1708)
1709) end subroutine MiscibleResidualPatch1
1710)
1711) ! ************************************************************************** !
1712)
1713) subroutine MiscibleResidualPatch0(snes,xx,r,realization,ierr)
1714) !
1715) ! MiscibleJacobianPatch0: Computes the Residual Aux vars for numerical Jacobin
1716) !
1717) ! Author: Chuan Lu
1718) ! Date: 10/10/08
1719) !
1720)
1721) use Connection_module
1722) use Realization_Subsurface_class
1723) use Patch_module
1724) use Grid_module
1725) use Option_module
1726) use Coupler_module
1727) use Field_module
1728) use Debug_module
1729)
1730) implicit none
1731)
1732) SNES, intent(in) :: snes
1733) Vec, intent(inout) :: xx
1734) Vec, intent(out) :: r
1735) type(realization_subsurface_type) :: realization
1736)
1737) PetscErrorCode :: ierr
1738) PetscInt :: i, jn
1739) PetscInt :: ip1, ip2
1740) PetscInt :: local_id, ghosted_id, local_id_up, local_id_dn, ghosted_id_up, ghosted_id_dn
1741)
1742) PetscReal, pointer ::accum_p(:)
1743)
1744) PetscReal, pointer :: r_p(:), porosity_loc_p(:), volume_p(:), &
1745) xx_loc_p(:), xx_p(:), yy_p(:),&
1746) tortuosity_loc_p(:),&
1747) perm_xx_loc_p(:), perm_yy_loc_p(:), perm_zz_loc_p(:)
1748)
1749)
1750) PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:)
1751)
1752) PetscReal :: dw_kg, dw_mol,dddt,dddp
1753) PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
1754) PetscReal :: upweight
1755) PetscReal :: Res(realization%option%nflowdof)
1756)
1757)
1758) type(grid_type), pointer :: grid
1759) type(patch_type), pointer :: patch
1760) type(option_type), pointer :: option
1761) type(field_type), pointer :: field
1762) type(Miscible_parameter_type), pointer :: Miscible_parameter
1763) type(Miscible_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
1764) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
1765) PetscBool :: enthalpy_flag
1766) PetscInt :: ng
1767) PetscInt :: iconn, idof, istart, iend
1768) PetscReal, pointer :: delx(:)
1769) PetscReal :: logx2
1770)
1771) patch => realization%patch
1772) grid => patch%grid
1773) option => realization%option
1774) field => realization%field
1775)
1776) Miscible_parameter => patch%aux%Miscible%Miscible_parameter
1777) auxvars => patch%aux%Miscible%auxvars
1778) auxvars_bc => patch%aux%Miscible%auxvars_bc
1779) global_auxvars => patch%aux%Global%auxvars
1780) global_auxvars_bc => patch%aux%Global%auxvars_bc
1781)
1782) ! call MiscibleUpdateAuxVarsPatchNinc(realization)
1783) ! override flags since they will soon be out of date
1784) ! patch%MiscibleAux%auxvars_up_to_date = PETSC_FALSE
1785)
1786) ! now assign access pointer to local variables
1787) call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
1788) call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
1789)
1790) allocate(delx(option%nflowdof))
1791)
1792) patch%aux%Miscible%Resold_AR=0.D0
1793) patch%aux%Miscible%Resold_BC=0.D0
1794) patch%aux%Miscible%ResOld_FL=0.D0
1795)
1796) ! Multiphase flash calculation is more expensive, so calculate once per iteration
1797)
1798) ! Pertubations for aux terms --------------------------------
1799) do ng = 1, grid%ngmax
1800) if (grid%nG2L(ng)<0) cycle
1801) if (associated(patch%imat)) then
1802) if (patch%imat(ng) <= 0) cycle
1803) endif
1804) ghosted_id = ng
1805) istart = (ng-1) * option%nflowdof + 1; iend = istart - 1 + option%nflowdof
1806) ! iphase =int(iphase_loc_p(ng))
1807) call MiscibleAuxVarCompute_Ninc(xx_loc_p(istart:iend),auxvars(ng)%auxvar_elem(0),&
1808) global_auxvars(ng),&
1809) realization%fluid_properties,option)
1810) ! print *,'mis: Respatch0 ', xx_loc_p(istart:iend),auxvars(ng)%auxvar_elem(0)%den
1811)
1812) if (associated(global_auxvars)) then
1813) global_auxvars(ghosted_id)%pres(:) = auxvars(ghosted_id)%auxvar_elem(0)%pres
1814) global_auxvars(ghosted_id)%sat(:) = 1D0
1815) global_auxvars(ghosted_id)%den(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:)
1816) global_auxvars(ghosted_id)%den_kg(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:) &
1817) * auxvars(ghosted_id)%auxvar_elem(0)%avgmw(:)
1818) else
1819) print *,'Not associated global for Miscible'
1820) endif
1821)
1822) if (option%flow%numerical_derivatives) then
1823) delx(1) = xx_loc_p((ng-1)*option%nflowdof+1)*dfac * 1.D-3
1824)
1825) ! print *,'mis_res_p: ',delx(1),xx_loc_p((ng-1)*option%nflowdof+1)
1826)
1827) ! linear formulation
1828) #if 0
1829) do idof = 2, option%nflowdof
1830) if (xx_loc_p((ng-1)*option%nflowdof+idof) <= 0.9) then
1831) delx(idof) = dfac*xx_loc_p((ng-1)*option%nflowdof+idof)*1.d1
1832) else
1833) delx(idof) = -dfac*xx_loc_p((ng-1)*option%nflowdof+idof)*1D1
1834) endif
1835)
1836) if (delx(idof) < 1D-8 .and. delx(idof) >= 0.D0) delx(idof) = 1D-8
1837) if (delx(idof) > -1D-8 .and. delx(idof) < 0.D0) delx(idof) =-1D-8
1838)
1839) if ((delx(idof)+xx_loc_p((ng-1)*option%nflowdof+idof)) > 1.D0) then
1840) delx(idof) = (1.D0-xx_loc_p((ng-1)*option%nflowdof+idof))*1D-4
1841) endif
1842) if ((delx(idof)+xx_loc_p((ng-1)*option%nflowdof+idof)) < 0.D0) then
1843) delx(idof) = xx_loc_p((ng-1)*option%nflowdof+idof)*1D-4
1844) endif
1845)
1846) ! print *,'mis_res_x: ',delx(idof),xx_loc_p((ng-1)*option%nflowdof+idof)
1847) enddo
1848) #endif
1849)
1850) ! log formulation
1851) !#if 0
1852) do idof = 2, option%nflowdof
1853) logx2 = xx_loc_p((ng-1)*option%nflowdof+idof)
1854) ! x2 = exp(logx2)
1855) if (logx2 <= 0.d0) then
1856) delx(idof) = 1.d-6
1857) else
1858) delx(idof) = -1.d-6
1859) endif
1860)
1861) ! print *,'mis_res_x: ',delx(idof),xx_loc_p((ng-1)*option%nflowdof+idof)
1862) enddo
1863) !#endif
1864)
1865) ! store increments
1866) patch%aux%Miscible%delx(:,ng) = delx(:)
1867)
1868) call MiscibleAuxVarCompute_Winc(xx_loc_p(istart:iend),delx(:),&
1869) auxvars(ng)%auxvar_elem(1:option%nflowdof),global_auxvars(ng),&
1870) realization%fluid_properties,option)
1871) endif
1872) enddo
1873)
1874) deallocate(delx)
1875) call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
1876) call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
1877)
1878) end subroutine MiscibleResidualPatch0
1879)
1880) ! ************************************************************************** !
1881)
1882) subroutine MiscibleResidualPatch2(snes,xx,r,realization,ierr)
1883) !
1884) ! Computes other terms in Residual
1885) ! (accumulation, source/sink, reaction)
1886) !
1887) ! Author: Chuan Lu
1888) ! Date: 10/10/08
1889) !
1890)
1891) use Connection_module
1892) use Realization_Subsurface_class
1893) use Patch_module
1894) use Grid_module
1895) use Option_module
1896) use Coupler_module
1897) use Field_module
1898) use Debug_module
1899)
1900) implicit none
1901)
1902) SNES, intent(in) :: snes
1903) Vec, intent(inout) :: xx
1904) Vec, intent(out) :: r
1905) type(realization_subsurface_type) :: realization
1906)
1907) PetscErrorCode :: ierr
1908) PetscInt :: i, jn
1909) PetscInt :: ip1, ip2
1910) PetscInt :: local_id, ghosted_id
1911)
1912) PetscReal, pointer ::accum_p(:)
1913)
1914) PetscReal, pointer :: r_p(:), porosity_loc_p(:), volume_p(:)
1915)
1916) PetscReal, pointer :: ithrm_loc_p(:)
1917)
1918) PetscReal :: dw_kg, dw_mol,dddt,dddp
1919) PetscReal :: tsrc1, qsrc1, csrc1, enth_src_h2o, enth_src_co2 , hsrc1
1920) PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
1921) PetscReal :: Res(realization%option%nflowdof), v_darcy(realization%option%nphase)
1922) PetscReal :: xxbc(realization%option%nflowdof)
1923) PetscReal :: psrc(1:realization%option%nphase)
1924) PetscViewer :: viewer
1925) PetscInt :: nsrcpara
1926) PetscReal, pointer :: msrc(:)
1927)
1928) type(grid_type), pointer :: grid
1929) type(patch_type), pointer :: patch
1930) type(option_type), pointer :: option
1931) type(field_type), pointer :: field
1932) type(Miscible_parameter_type), pointer :: Miscible_parameter
1933) type(Miscible_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
1934) type(coupler_type), pointer :: boundary_condition, source_sink
1935) type(global_auxvar_type), pointer :: global_auxvars(:)
1936) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
1937) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
1938) type(connection_set_list_type), pointer :: connection_set_list
1939) type(connection_set_type), pointer :: cur_connection_set
1940) PetscReal :: ss_flow_vol_flux(realization%option%nphase)
1941) PetscBool :: enthalpy_flag
1942) PetscInt :: ng
1943) PetscInt :: iconn, idof, istart, iend
1944) PetscInt :: sum_connection
1945) PetscReal :: distance, fraction_upwind
1946) PetscReal :: distance_gravity
1947)
1948) ! PetscReal, pointer :: iphase_loc_p(:)
1949)
1950) patch => realization%patch
1951) grid => patch%grid
1952) option => realization%option
1953) field => realization%field
1954)
1955) Miscible_parameter => patch%aux%Miscible%Miscible_parameter
1956) auxvars => patch%aux%Miscible%auxvars
1957) auxvars_bc => patch%aux%Miscible%auxvars_bc
1958) global_auxvars => patch%aux%Global%auxvars
1959) global_auxvars_bc => patch%aux%Global%auxvars_bc
1960) global_auxvars_ss => patch%aux%Global%auxvars_ss
1961)
1962) ! call MiscibleUpdateAuxVarsPatchNinc(realization)
1963) ! override flags since they will soon be out of date
1964) ! patch%MiscibleAux%auxvars_up_to_date = PETSC_FALSE
1965)
1966) ! now assign access pointer to local variables
1967) call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
1968) call VecGetArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
1969) !geh refactor call VecGetArrayF90(field%porosity_loc, porosity_loc_p, ierr)
1970) !geh refactor call VecGetArrayF90(field%volume, volume_p, ierr)
1971) call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
1972)
1973) ! call VecGetArrayF90(field%iphas_loc, iphase_loc_p, ierr);
1974)
1975) ! Accumulation terms (include reaction------------------------------------
1976) if (.not.option%steady_state) then
1977)
1978) r_p = r_p - accum_p
1979)
1980) do local_id = 1, grid%nlmax ! For each local node do...
1981)
1982) ghosted_id = grid%nL2G(local_id)
1983) !geh - Ignore inactive cells with inactive materials
1984) if (associated(patch%imat)) then
1985) if (patch%imat(ghosted_id) <= 0) cycle
1986) endif
1987) iend = local_id*option%nflowdof
1988) istart = iend-option%nflowdof+1
1989)
1990) call MiscibleAccumulation(auxvars(ghosted_id)%auxvar_elem(0),&
1991) global_auxvars(ghosted_id), &
1992) porosity_loc_p(ghosted_id), &
1993) volume_p(local_id), &
1994) Miscible_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
1995) option,Res)
1996) r_p(istart:iend) = r_p(istart:iend) + Res(1:option%nflowdof)
1997)
1998) patch%aux%Miscible%Resold_AR(local_id, :) = &
1999) patch%aux%Miscible%Resold_AR(local_id, :)+ Res(1:option%nflowdof)
2000) enddo
2001) endif
2002)
2003) ! call VecRestoreArrayF90(field%iphas_loc, iphase_loc_p, ierr);
2004)
2005) ! Source/sink terms -------------------------------------
2006) source_sink => patch%source_sink_list%first
2007) sum_connection = 0
2008) do
2009) if (.not.associated(source_sink)) exit
2010) !print *, 'RES s/s begin'
2011) ! check whether enthalpy dof is included
2012) ! if (source_sink%flow_condition%num_sub_conditions > 3) then
2013) enthalpy_flag = PETSC_TRUE
2014) ! else
2015) ! enthalpy_flag = PETSC_FALSE
2016) ! endif
2017)
2018) if (associated(source_sink%flow_condition%pressure)) then
2019) psrc(:) = source_sink%flow_condition%pressure%dataset%rarray(:)
2020) endif
2021) ! qsrc1 = source_sink%flow_condition%pressure%dataset%rarray(1)
2022) tsrc1 = source_sink%flow_condition%temperature%dataset%rarray(1)
2023) csrc1 = source_sink%flow_condition%concentration%dataset%rarray(1)
2024) if (enthalpy_flag) hsrc1 = source_sink%flow_condition%enthalpy%dataset%rarray(1)
2025) ! hsrc1=0D0
2026) ! qsrc1 = qsrc1 / FMWH2O ! [kg/s -> kmol/s; fmw -> g/mol = kg/kmol]
2027) ! csrc1 = csrc1 / FMWCO2
2028) ! msrc(1)=qsrc1; msrc(2) =csrc1
2029) select case(source_sink%flow_condition%itype(1))
2030) case(MASS_RATE_SS)
2031) msrc => source_sink%flow_condition%rate%dataset%rarray
2032) nsrcpara= 2
2033) case(WELL_SS)
2034) msrc => source_sink%flow_condition%well%dataset%rarray
2035) nsrcpara = 7 + option%nflowspec
2036) case default
2037) print *, 'Flash mode does not support source/sink type: ', source_sink%flow_condition%itype(1)
2038) stop
2039) end select
2040)
2041) cur_connection_set => source_sink%connection_set
2042)
2043) do iconn = 1, cur_connection_set%num_connections
2044) sum_connection = sum_connection + 1
2045) local_id = cur_connection_set%id_dn(iconn)
2046) ghosted_id = grid%nL2G(local_id)
2047) if (associated(patch%imat)) then
2048) if (patch%imat(ghosted_id) <= 0) cycle
2049) endif
2050)
2051) call MiscibleSourceSink(msrc,nsrcpara,psrc,tsrc1,hsrc1,csrc1, &
2052) auxvars(ghosted_id)%auxvar_elem(0), &
2053) source_sink%flow_condition%itype(1),Res, &
2054) ss_flow_vol_flux, &
2055) enthalpy_flag,option)
2056) if (associated(patch%ss_flow_vol_fluxes)) then
2057) patch%ss_flow_vol_fluxes(:,sum_connection) = ss_flow_vol_flux/ &
2058) option%flow_dt
2059) endif
2060) if (associated(patch%ss_flow_fluxes)) then
2061) patch%ss_flow_fluxes(:,sum_connection) = Res(:)/option%flow_dt
2062) endif
2063) if (option%compute_mass_balance_new) then
2064) global_auxvars_ss(sum_connection)%mass_balance_delta(:,1) = &
2065) global_auxvars_ss(sum_connection)%mass_balance_delta(:,1) - &
2066) Res(:)/option%flow_dt
2067) endif
2068) r_p((local_id-1)*option%nflowdof + jh2o) = r_p((local_id-1)*option%nflowdof + jh2o) - Res(jh2o)
2069) r_p((local_id-1)*option%nflowdof + jglyc) = r_p((local_id-1)*option%nflowdof + jglyc) - Res(jglyc)
2070) patch%aux%Miscible%Resold_AR(local_id,jh2o) = patch%aux%Miscible%Resold_AR(local_id,jh2o) - Res(jh2o)
2071) patch%aux%Miscible%Resold_AR(local_id,jglyc) = patch%aux%Miscible%Resold_AR(local_id,jglyc) - Res(jglyc)
2072) if (enthalpy_flag)then
2073) r_p( local_id*option%nflowdof) = r_p(local_id*option%nflowdof) - Res(option%nflowdof)
2074) patch%aux%Miscible%Resold_AR(local_id,option%nflowdof)=&
2075) patch%aux%Miscible%Resold_AR(local_id,option%nflowdof) - Res(option%nflowdof)
2076) endif
2077) ! else if (qsrc1 < 0.d0) then ! withdrawal
2078) ! endif
2079) enddo
2080) source_sink => source_sink%next
2081) enddo
2082)
2083) ! adjust residual to R/dt
2084) select case (option%idt_switch)
2085) case(1)
2086) r_p(:) = r_p(:)/option%flow_dt
2087) case(-1)
2088) if (option%flow_dt > 1.D0) r_p(:) = r_p(:)/option%flow_dt
2089) end select
2090)
2091) do local_id = 1, grid%nlmax
2092) if (associated(patch%imat)) then
2093) if (patch%imat(grid%nL2G(local_id)) <= 0) cycle
2094) endif
2095)
2096) ! scale residual by grid cell volume
2097) istart = 1 + (local_id-1)*option%nflowdof
2098) ! if (volume_p(local_id) > 1.D0) r_p(istart:istart+2) = &
2099) ! r_p(istart:istart+2)/volume_p(local_id)
2100) if (volume_p(local_id) > 1.D0) r_p(istart:istart+1) = &
2101) r_p(istart:istart+1)/volume_p(local_id)
2102) ! r_p(istart:istart+1) = r_p(istart:istart+1)/volume_p(local_id)
2103) if (r_p(istart) > 1.E10 .or. r_p(istart) < -1.E10) then
2104) ghosted_id = grid%nL2G(local_id)
2105) print *, 'overflow in res: ', &
2106) local_id,ghosted_id,istart,r_p (istart:istart+1), &
2107) auxvars(ghosted_id)%auxvar_elem(0)%pres, &
2108) auxvars(ghosted_id)%auxvar_elem(0)%xmol(1), &
2109) auxvars(ghosted_id)%auxvar_elem(0)%xmol(2)
2110) endif
2111) enddo
2112)
2113) ! if (option%use_isothermal) then
2114) ! do local_id = 1, grid%nlmax ! For each local node do...
2115) ! ghosted_id = grid%nL2G(local_id) ! corresponding ghost index
2116) ! if (associated(patch%imat)) then
2117) ! if (patch%imat(ghosted_id) <= 0) cycle
2118) ! endif
2119) ! istart = 3 + (local_id-1)*option%nflowdof
2120) ! r_p(istart) = 0.D0 ! xx_loc_p(2 + (ng-1)*option%nflowdof) - yy_p(p1-1)
2121) ! enddo
2122) ! endif
2123)
2124) if (patch%aux%Miscible%inactive_cells_exist) then
2125) do i=1,patch%aux%Miscible%n_zero_rows
2126) r_p(patch%aux%Miscible%zero_rows_local(i)) = 0.d0
2127) enddo
2128) endif
2129)
2130) call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
2131) call VecRestoreArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
2132) !geh refactor call VecRestoreArrayF90(field%porosity_loc, porosity_loc_p, ierr)
2133) !geh refactor call VecRestoreArrayF90(field%volume, volume_p, ierr)
2134) call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
2135)
2136) end subroutine MiscibleResidualPatch2
2137)
2138) ! ************************************************************************** !
2139)
2140) subroutine MiscibleJacobian(snes,xx,A,B,realization,ierr)
2141) !
2142) ! Computes the Jacobian
2143) !
2144) ! Author: Chuan Lu
2145) ! Date: 10/10/08
2146) !
2147)
2148) use Realization_Subsurface_class
2149) use Patch_module
2150) use Grid_module
2151) use Option_module
2152) use Logging_module
2153) use Debug_module
2154)
2155) implicit none
2156)
2157) SNES :: snes
2158) Vec :: xx
2159) Mat :: A, B, J
2160) MatType :: mat_type
2161) type(realization_subsurface_type) :: realization
2162) PetscErrorCode :: ierr
2163) PetscViewer :: viewer
2164) type(patch_type), pointer :: cur_patch
2165) type(grid_type), pointer :: grid
2166) character(len=MAXSTRINGLENGTH) :: string
2167)
2168) call PetscLogEventBegin(logging%event_r_jacobian,ierr);CHKERRQ(ierr)
2169)
2170) call MatGetType(A,mat_type,ierr);CHKERRQ(ierr)
2171) if (mat_type == MATMFFD) then
2172) J = B
2173) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2174) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2175) else
2176) J = A
2177) endif
2178)
2179)
2180) call MatZeroEntries(J,ierr);CHKERRQ(ierr)
2181)
2182) ! pass #1 for internal and boundary flux terms
2183) cur_patch => realization%patch_list%first
2184) do
2185) if (.not.associated(cur_patch)) exit
2186) realization%patch => cur_patch
2187) call MiscibleJacobianPatch1(snes,xx,J,J,realization,ierr)
2188) cur_patch => cur_patch%next
2189) enddo
2190)
2191) ! pass #2 for everything else
2192) cur_patch => realization%patch_list%first
2193) do
2194) if (.not.associated(cur_patch)) exit
2195) realization%patch => cur_patch
2196) call MiscibleJacobianPatch2(snes,xx,J,J,realization,ierr)
2197) cur_patch => cur_patch%next
2198) enddo
2199)
2200)
2201) if (realization%debug%matview_Jacobian) then
2202) string = 'MISjacobian'
2203) call DebugCreateViewer(realization%debug,string,realization%option,viewer)
2204) call MatView(J,viewer,ierr);CHKERRQ(ierr)
2205) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2206) endif
2207)
2208) #if 0
2209) if (realization%debug%norm_Jacobian) then
2210) option => realization%option
2211) call MatNorm(J,NORM_1,norm,ierr);CHKERRQ(ierr)
2212) write(option%io_buffer,'("1 norm: ",es11.4)') norm
2213) call printMsg(option)
2214) call MatNorm(J,NORM_FROBENIUS,norm,ierr);CHKERRQ(ierr)
2215) write(option%io_buffer,'("2 norm: ",es11.4)') norm
2216) call printMsg(option)
2217) call MatNorm(J,NORM_INFINITY,norm,ierr);CHKERRQ(ierr)
2218) write(option%io_buffer,'("inf norm: ",es11.4)') norm
2219) call printMsg(option)
2220) endif
2221) #endif
2222)
2223) call PetscLogEventEnd(logging%event_r_jacobian,ierr);CHKERRQ(ierr)
2224)
2225) end subroutine MiscibleJacobian
2226)
2227) ! ************************************************************************** !
2228)
2229) subroutine MiscibleJacobianPatch1(snes,xx,A,B,realization,ierr)
2230) !
2231) ! Computes the Jacobian: Flux term
2232) !
2233) ! Author: Chuan Lu
2234) ! Date: 10/13/08
2235) !
2236)
2237) use Connection_module
2238) use Option_module
2239) use Grid_module
2240) use Realization_Subsurface_class
2241) use Patch_module
2242) use Coupler_module
2243) use Field_module
2244) use Debug_module
2245)
2246) implicit none
2247)
2248) SNES :: snes
2249) Vec :: xx
2250) Mat :: A, B
2251) type(realization_subsurface_type) :: realization
2252)
2253) PetscErrorCode :: ierr
2254) PetscInt :: nvar,neq,nr
2255) PetscInt :: ithrm_up, ithrm_dn, i
2256) PetscInt :: ip1, ip2
2257)
2258) PetscReal, pointer :: porosity_loc_p(:), volume_p(:), &
2259) xx_loc_p(:), tortuosity_loc_p(:),&
2260) perm_xx_loc_p(:), perm_yy_loc_p(:), perm_zz_loc_p(:)
2261) PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
2262) PetscInt :: icap,iphas,iphas_up,iphas_dn,icap_up,icap_dn
2263) PetscInt :: ii, jj
2264) PetscReal :: dw_kg,dw_mol,enth_src_co2,enth_src_h2o,rho
2265) PetscReal :: tsrc1,qsrc1,csrc1,hsrc1
2266) PetscReal :: dd_up, dd_dn, dd, f_up, f_dn
2267) PetscReal :: perm_up, perm_dn
2268) PetscReal :: dw_dp,dw_dt,hw_dp,hw_dt,dresT_dp,dresT_dt
2269) PetscReal :: D_up, D_dn ! "Diffusion" constants upstream and downstream of a face.
2270) PetscReal :: zero, norm
2271) PetscReal :: upweight
2272) PetscReal :: max_dev
2273) PetscInt :: local_id, ghosted_id
2274) PetscInt :: local_id_up, local_id_dn
2275) PetscInt :: ghosted_id_up, ghosted_id_dn
2276) PetscInt :: natural_id_up, natural_id_dn
2277)
2278) PetscReal :: Jup(1:realization%option%nflowdof,1:realization%option%nflowdof), &
2279) Jdn(1:realization%option%nflowdof,1:realization%option%nflowdof)
2280)
2281) PetscInt :: istart, iend
2282)
2283) type(coupler_type), pointer :: boundary_condition, source_sink
2284) type(connection_set_list_type), pointer :: connection_set_list
2285) type(connection_set_type), pointer :: cur_connection_set
2286) PetscBool :: enthalpy_flag
2287) PetscInt :: iconn, idof
2288) PetscInt :: sum_connection
2289) PetscReal :: distance, fraction_upwind
2290) PetscReal :: distance_gravity
2291) PetscReal :: Res(realization%option%nflowdof)
2292) PetscReal :: xxbc(1:realization%option%nflowdof), delxbc(1:realization%option%nflowdof)
2293) PetscReal :: ResInc(realization%patch%grid%nlmax,realization%option%nflowdof,&
2294) realization%option%nflowdof)
2295) type(grid_type), pointer :: grid
2296) type(patch_type), pointer :: patch
2297) type(option_type), pointer :: option
2298) type(field_type), pointer :: field
2299) type(Miscible_parameter_type), pointer :: Miscible_parameter
2300) type(Miscible_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
2301) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
2302)
2303) PetscReal :: vv_darcy(realization%option%nphase), voltemp
2304) PetscReal :: ra(1:realization%option%nflowdof,1:realization%option%nflowdof*2)
2305) PetscReal :: msrc(1:realization%option%nflowspec)
2306) PetscReal :: psrc(1:realization%option%nphase)
2307) PetscReal :: dddt, dddp, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt,&
2308) dvdp, xphi
2309) PetscInt :: iphasebc
2310)
2311) PetscViewer :: viewer
2312) Vec :: debug_vec
2313) character(len=MAXSTRINGLENGTH) :: string
2314)
2315) !-----------------------------------------------------------------------
2316) ! R stand for residual
2317) ! ra 1 2 3 4 5 6 7 8
2318) ! 1: p dR/dpi dR/dTi dR/dci dR/dsi dR/dpim dR/dTim
2319) ! 2: T
2320) ! 3: c
2321) ! 4 s
2322) !-----------------------------------------------------------------------
2323)
2324) patch => realization%patch
2325) grid => patch%grid
2326) option => realization%option
2327) field => realization%field
2328)
2329) Miscible_parameter => patch%aux%Miscible%Miscible_parameter
2330) auxvars => patch%aux%Miscible%auxvars
2331) auxvars_bc => patch%aux%Miscible%auxvars_bc
2332) global_auxvars => patch%aux%Global%auxvars
2333) global_auxvars_bc => patch%aux%Global%auxvars_bc
2334)
2335) ! dropped derivatives:
2336) ! 1.D0 gas phase viscocity to all p,t,c,s
2337) ! 2. Average molecular weights to p,t,s
2338) ! flag = SAME_NONZERO_PATTERN
2339)
2340) #if 0
2341) ! call MiscibleNumericalJacobianTest(xx,realization)
2342) #endif
2343)
2344) ! print *,'*********** In Jacobian ********************** '
2345) ! MatzeroEntries has been called in MiscibleJacobin ! clu removed on 11/04/2010
2346) ! call MatZeroEntries(A,ierr)
2347)
2348) call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
2349) !geh refactor call VecGetArrayF90(field%porosity_loc, porosity_loc_p, ierr)
2350) !geh refactor call VecGetArrayF90(field%tortuosity_loc, tortuosity_loc_p, ierr)
2351) !geh refactor call VecGetArrayF90(field%perm_xx_loc, perm_xx_loc_p, ierr)
2352) !geh refactor call VecGetArrayF90(field%perm_yy_loc, perm_yy_loc_p, ierr)
2353) !geh refactor call VecGetArrayF90(field%perm_zz_loc, perm_zz_loc_p, ierr)
2354) !geh refactor call VecGetArrayF90(field%volume, volume_p, ierr)
2355)
2356) call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
2357) call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
2358) ! call VecGetArrayF90(field%iphas_loc, iphase_loc_p, ierr)
2359)
2360) ResInc = 0.D0
2361)
2362) ! Boundary conditions
2363)
2364) ! Boundary Flux Terms -----------------------------------
2365) boundary_condition => patch%boundary_condition_list%first
2366) sum_connection = 0
2367) do
2368) if (.not.associated(boundary_condition)) exit
2369)
2370) cur_connection_set => boundary_condition%connection_set
2371)
2372) do iconn = 1, cur_connection_set%num_connections
2373) sum_connection = sum_connection + 1
2374)
2375) local_id = cur_connection_set%id_dn(iconn)
2376) ghosted_id = grid%nL2G(local_id)
2377)
2378) if (associated(patch%imat)) then
2379) if (patch%imat(ghosted_id) <= 0) cycle
2380) endif
2381)
2382) if (ghosted_id<=0) then
2383) print *, "Wrong boundary node index... STOP!!!"
2384) stop
2385) endif
2386)
2387) ithrm_dn = int(ithrm_loc_p(ghosted_id))
2388) D_dn = Miscible_parameter%ckwet(ithrm_dn)
2389)
2390) ! for now, just assume diagonal tensor
2391) perm_dn = perm_xx_loc_p(ghosted_id)*abs(cur_connection_set%dist(1,iconn))+ &
2392) perm_yy_loc_p(ghosted_id)*abs(cur_connection_set%dist(2,iconn))+ &
2393) perm_zz_loc_p(ghosted_id)*abs(cur_connection_set%dist(3,iconn))
2394) ! dist(0,iconn) = scalar - magnitude of distance
2395) ! gravity = vector(3)
2396) ! dist(1:3,iconn) = vector(3) - unit vector
2397) distance_gravity = cur_connection_set%dist(0,iconn) * &
2398) dot_product(option%gravity, &
2399) cur_connection_set%dist(1:3,iconn))
2400) icap_dn = int(icap_loc_p(ghosted_id))
2401)
2402) ! Then need fill up increments for BCs
2403) delxbc=0.D0;
2404) do idof =1, option%nflowdof
2405) select case(boundary_condition%flow_condition%itype(idof))
2406) case(DIRICHLET_BC)
2407) xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
2408) delxbc(idof)=0.D0
2409) case(HYDROSTATIC_BC)
2410) xxbc(1) = boundary_condition%flow_aux_real_var(1,iconn)
2411) if (idof >= 2)then
2412) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
2413) delxbc(idof)=patch%aux%Miscible%delx(idof,ghosted_id)
2414) endif
2415) case(NEUMANN_BC, ZERO_GRADIENT_BC)
2416) ! solve for pb from Darcy's law given qb /= 0
2417) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
2418) delxbc(idof)=patch%aux%Miscible%delx(idof,ghosted_id)
2419) end select
2420) enddo
2421)
2422) call MiscibleAuxVarCompute_Ninc(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0),&
2423) global_auxvars_bc(sum_connection),&
2424) realization%fluid_properties, option)
2425) call MiscibleAuxVarCompute_Winc(xxbc,delxbc,&
2426) auxvars_bc(sum_connection)%auxvar_elem(1:option%nflowdof),&
2427) global_auxvars_bc(sum_connection),&
2428) realization%fluid_properties,option)
2429)
2430) do nvar=1,option%nflowdof
2431) call MiscibleBCFlux(boundary_condition%flow_condition%itype, &
2432) boundary_condition%flow_aux_real_var(:,iconn), &
2433) auxvars_bc(sum_connection)%auxvar_elem(nvar), &
2434) auxvars(ghosted_id)%auxvar_elem(nvar), &
2435) porosity_loc_p(ghosted_id), &
2436) tortuosity_loc_p(ghosted_id), &
2437) cur_connection_set%dist(0,iconn),perm_dn, &
2438) cur_connection_set%area(iconn), &
2439) distance_gravity,option, &
2440) vv_darcy,Res)
2441) ResInc(local_id,1:option%nflowdof,nvar) = ResInc(local_id,1:option%nflowdof,nvar) - Res(1:option%nflowdof)
2442) enddo
2443) enddo
2444) boundary_condition => boundary_condition%next
2445) enddo
2446)
2447) ! Set matrix values related to single node terms: Accumulation, Source/Sink, BC
2448) do local_id = 1, grid%nlmax ! For each local node do...
2449) ghosted_id = grid%nL2G(local_id)
2450) !geh - Ignore inactive cells with inactive materials
2451) if (associated(patch%imat)) then
2452) if (patch%imat(ghosted_id) <= 0) cycle
2453) endif
2454)
2455) ra=0.D0
2456) do neq=1, option%nflowdof
2457) do nvar=1, option%nflowdof
2458) ra(neq,nvar) = (ResInc(local_id,neq,nvar) - patch%aux%Miscible%ResOld_BC(local_id,neq))&
2459) /patch%aux%Miscible%delx(nvar,ghosted_id)
2460)
2461) ! print *,'jacobian: ',neq,nvar,local_id,ghosted_id,grid%nlmax,ra(neq,nvar),ResInc(local_id,neq,nvar), &
2462) ! patch%aux%Miscible%ResOld_BC(local_id,neq),patch%aux%Miscible%delx(nvar,ghosted_id)
2463) enddo
2464) enddo
2465)
2466) select case(option%idt_switch)
2467) case(1)
2468) ra(1:option%nflowdof,1:option%nflowdof) = ra(1:option%nflowdof,1:option%nflowdof) / option%flow_dt
2469) case(-1)
2470) if (option%flow_dt > 1) ra(1:option%nflowdof,1:option%nflowdof) = ra(1:option%nflowdof,1:option%nflowdof) / option%flow_dt
2471) end select
2472)
2473) Jup = ra(1:option%nflowdof,1:option%nflowdof)
2474) if (volume_p(local_id) > 1.D0) Jup = Jup / volume_p(local_id)
2475) ! Jup = Jup / volume_p(local_id)
2476)
2477) call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup,ADD_VALUES, &
2478) ierr);CHKERRQ(ierr)
2479) end do
2480)
2481) if (realization%debug%matview_Jacobian_detailed) then
2482) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2483) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2484) string = 'jacobian_bcflux'
2485) call DebugCreateViewer(realization%debug,string,option,viewer)
2486) call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
2487) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2488) endif
2489)
2490) ! Interior Flux Terms -----------------------------------
2491) connection_set_list => grid%internal_connection_set_list
2492) cur_connection_set => connection_set_list%first
2493) sum_connection = 0
2494) ResInc = 0.D0
2495) do
2496) if (.not.associated(cur_connection_set)) exit
2497) do iconn = 1, cur_connection_set%num_connections
2498) sum_connection = sum_connection + 1
2499)
2500) ghosted_id_up = cur_connection_set%id_up(iconn)
2501) ghosted_id_dn = cur_connection_set%id_dn(iconn)
2502)
2503) if (associated(patch%imat)) then
2504) if (patch%imat(ghosted_id_up) <= 0 .or. &
2505) patch%imat(ghosted_id_dn) <= 0) cycle
2506) endif
2507)
2508) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
2509) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
2510)
2511) fraction_upwind = cur_connection_set%dist(-1,iconn)
2512) distance = cur_connection_set%dist(0,iconn)
2513) ! distance = scalar - magnitude of distance
2514) ! gravity = vector(3)
2515) ! dist(1:3,iconn) = vector(3) - unit vector
2516) distance_gravity = distance * &
2517) dot_product(option%gravity, &
2518) cur_connection_set%dist(1:3,iconn))
2519) dd_up = distance*fraction_upwind
2520) dd_dn = distance-dd_up ! should avoid truncation error
2521) ! upweight could be calculated as 1.d0-fraction_upwind
2522) ! however, this introduces ever so slight error causing pflow-overhaul not
2523) ! to match pflow-orig. This can be changed to 1.d0-fraction_upwind
2524) upweight = dd_dn/(dd_up+dd_dn)
2525)
2526) ! for now, just assume diagonal tensor
2527) perm_up = perm_xx_loc_p(ghosted_id_up)*abs(cur_connection_set%dist(1,iconn))+ &
2528) perm_yy_loc_p(ghosted_id_up)*abs(cur_connection_set%dist(2,iconn))+ &
2529) perm_zz_loc_p(ghosted_id_up)*abs(cur_connection_set%dist(3,iconn))
2530)
2531) perm_dn = perm_xx_loc_p(ghosted_id_dn)*abs(cur_connection_set%dist(1,iconn))+ &
2532) perm_yy_loc_p(ghosted_id_dn)*abs(cur_connection_set%dist(2,iconn))+ &
2533) perm_zz_loc_p(ghosted_id_dn)*abs(cur_connection_set%dist(3,iconn))
2534)
2535) ithrm_up = int(ithrm_loc_p(ghosted_id_up))
2536) ithrm_dn = int(ithrm_loc_p(ghosted_id_dn))
2537) D_up = Miscible_parameter%ckwet(ithrm_up)
2538) D_dn = Miscible_parameter%ckwet(ithrm_dn)
2539)
2540) icap_up = int(icap_loc_p(ghosted_id_up))
2541) icap_dn = int(icap_loc_p(ghosted_id_dn))
2542)
2543) do nvar = 1, option%nflowdof
2544) call MiscibleFlux(auxvars(ghosted_id_up)%auxvar_elem(nvar),porosity_loc_p(ghosted_id_up), &
2545) tortuosity_loc_p(ghosted_id_up), &
2546) dd_up,perm_up, &
2547) auxvars(ghosted_id_dn)%auxvar_elem(0),porosity_loc_p(ghosted_id_dn), &
2548) tortuosity_loc_p(ghosted_id_dn), &
2549) dd_dn,perm_dn, &
2550) cur_connection_set%area(iconn),distance_gravity, &
2551) upweight, option, vv_darcy, Res)
2552) ra(:,nvar) = (Res(:)-patch%aux%Miscible%ResOld_FL(iconn,:)) &
2553) /patch%aux%Miscible%delx(nvar,ghosted_id_up)
2554) call MiscibleFlux(auxvars(ghosted_id_up)%auxvar_elem(0),porosity_loc_p(ghosted_id_up), &
2555) tortuosity_loc_p(ghosted_id_up), &
2556) dd_up,perm_up, &
2557) auxvars(ghosted_id_dn)%auxvar_elem(nvar),porosity_loc_p(ghosted_id_dn),&
2558) tortuosity_loc_p(ghosted_id_dn), &
2559) dd_dn,perm_dn, &
2560) cur_connection_set%area(iconn),distance_gravity, &
2561) upweight, option, vv_darcy, Res)
2562) ra(:,nvar+option%nflowdof) = (Res(:)-patch%aux%Miscible%ResOld_FL(iconn,:))&
2563) /patch%aux%Miscible%delx(nvar,ghosted_id_dn)
2564) enddo
2565)
2566) select case(option%idt_switch)
2567) case(1)
2568) ra = ra / option%flow_dt
2569) case(-1)
2570) if (option%flow_dt > 1.d0) ra = ra / option%flow_dt
2571) end select
2572)
2573) if (local_id_up > 0) then
2574) voltemp = 1.D0
2575) if (volume_p(local_id_up) > 1.D0) voltemp = 1.D0/volume_p(local_id_up)
2576) Jup(:,1:option%nflowdof) = ra(:,1:option%nflowdof)*voltemp !11
2577) jdn(:,1:option%nflowdof) = ra(:,1 + option%nflowdof:2*option%nflowdof)*voltemp !12
2578)
2579) call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_up-1, &
2580) Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
2581) call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_dn-1, &
2582) Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
2583) endif
2584) if (local_id_dn > 0) then
2585) voltemp = 1.D0
2586) if (volume_p(local_id_dn) > 1.D0) voltemp = 1.D0/volume_p(local_id_dn)
2587) Jup(:,1:option%nflowdof)= -ra(:,1:option%nflowdof)*voltemp !21
2588) jdn(:,1:option%nflowdof)= -ra(:,1 + option%nflowdof:2*option%nflowdof)*voltemp !22
2589)
2590) call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_dn-1, &
2591) Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
2592) call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_up-1, &
2593) Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
2594) endif
2595) enddo
2596) cur_connection_set => cur_connection_set%next
2597) enddo
2598)
2599) if (realization%debug%matview_Jacobian_detailed) then
2600) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2601) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2602) string = 'jacobian_flux'
2603) call DebugCreateViewer(realization%debug,string,option,viewer)
2604) call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
2605) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2606) endif
2607)
2608) call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
2609) !geh refactor call VecRestoreArrayF90(field%porosity_loc, porosity_loc_p, ierr)
2610) !geh refactor call VecRestoreArrayF90(field%tortuosity_loc, tortuosity_loc_p, ierr)
2611) !geh refactor call VecRestoreArrayF90(field%perm_xx_loc, perm_xx_loc_p, ierr)
2612) !geh refactor call VecRestoreArrayF90(field%perm_yy_loc, perm_yy_loc_p, ierr)
2613) !geh refactor call VecRestoreArrayF90(field%perm_zz_loc, perm_zz_loc_p, ierr)
2614) !geh refactor call VecRestoreArrayF90(field%volume, volume_p, ierr)
2615)
2616)
2617) call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
2618) call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
2619)
2620) end subroutine MiscibleJacobianPatch1
2621)
2622) ! ************************************************************************** !
2623)
2624) subroutine MiscibleJacobianPatch2(snes,xx,A,B,realization,ierr)
2625) !
2626) ! Computes the Jacobian: Accum, source, reaction
2627) !
2628) ! Author: Chuan Lu
2629) ! Date: 10/13/08
2630) !
2631)
2632) use Connection_module
2633) use Option_module
2634) use Grid_module
2635) use Realization_Subsurface_class
2636) use Patch_module
2637) use Coupler_module
2638) use Field_module
2639) use Debug_module
2640)
2641) implicit none
2642)
2643) SNES :: snes
2644) Vec :: xx
2645) Mat :: A, B
2646) type(realization_subsurface_type) :: realization
2647)
2648) PetscErrorCode :: ierr
2649) PetscInt :: nvar,neq,nr
2650) PetscInt :: ithrm_up, ithrm_dn, i
2651) PetscInt :: ip1, ip2
2652)
2653) PetscReal, pointer :: porosity_loc_p(:), volume_p(:), &
2654) xx_loc_p(:), tortuosity_loc_p(:),&
2655) perm_xx_loc_p(:), perm_yy_loc_p(:), perm_zz_loc_p(:)
2656) PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
2657) PetscInt :: icap,iphas,iphas_up,iphas_dn,icap_up,icap_dn
2658) PetscInt :: ii, jj
2659) PetscReal :: dw_kg,dw_mol,enth_src_co2,enth_src_h2o,rho
2660) PetscReal :: tsrc1,qsrc1,csrc1,hsrc1
2661) PetscReal :: dd_up, dd_dn, dd, f_up, f_dn
2662) PetscReal :: perm_up, perm_dn
2663) PetscReal :: dw_dp,dw_dt,hw_dp,hw_dt,dresT_dp,dresT_dt
2664) PetscReal :: D_up, D_dn ! "Diffusion" constants upstream and downstream of a face.
2665) PetscReal :: zero, norm
2666) PetscReal :: upweight
2667) PetscReal :: max_dev
2668) PetscInt :: local_id, ghosted_id
2669) PetscInt :: local_id_up, local_id_dn
2670) PetscInt :: ghosted_id_up, ghosted_id_dn
2671) PetscInt :: natural_id_up,natural_id_dn
2672)
2673) PetscReal :: Jup(1:realization%option%nflowdof,1:realization%option%nflowdof), &
2674) Jdn(1:realization%option%nflowdof,1:realization%option%nflowdof)
2675)
2676) PetscInt :: istart, iend
2677)
2678) type(coupler_type), pointer :: boundary_condition, source_sink
2679) type(connection_set_list_type), pointer :: connection_set_list
2680) type(connection_set_type), pointer :: cur_connection_set
2681) PetscBool :: enthalpy_flag
2682) PetscInt :: iconn, idof
2683) PetscInt :: sum_connection
2684) PetscReal :: distance, fraction_upwind
2685) PetscReal :: distance_gravity
2686) PetscReal :: Res(realization%option%nflowdof)
2687) PetscReal :: xxbc(1:realization%option%nflowdof), delxbc(1:realization%option%nflowdof)
2688) PetscReal :: ResInc(realization%patch%grid%nlmax,realization%option%nflowdof,&
2689) realization%option%nflowdof)
2690) type(grid_type), pointer :: grid
2691) type(patch_type), pointer :: patch
2692) type(option_type), pointer :: option
2693) type(field_type), pointer :: field
2694) type(Miscible_parameter_type), pointer :: Miscible_parameter
2695) type(Miscible_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
2696) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
2697)
2698) PetscReal :: vv_darcy(realization%option%nphase), voltemp
2699) PetscReal :: ra(1:realization%option%nflowdof,1:realization%option%nflowdof*2)
2700) PetscReal, pointer :: msrc(:)
2701) PetscReal :: psrc(1:realization%option%nphase)
2702) PetscReal :: dddt, dddp, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt,&
2703) dvdp, xphi
2704) PetscReal :: dummy_real(realization%option%nphase)
2705) PetscInt :: nsrcpara, flow_pc
2706)
2707) PetscViewer :: viewer
2708) Vec :: debug_vec
2709) character(len=MAXSTRINGLENGTH) :: string
2710)
2711) !-----------------------------------------------------------------------
2712) ! R stand for residual
2713) ! ra 1 2 3 4 5 6 7 8
2714) ! 1: p dR/dpi dR/dTi dR/dci dR/dsi dR/dpim dR/dTim
2715) ! 2: T
2716) ! 3: c
2717) ! 4 s
2718) !-----------------------------------------------------------------------
2719)
2720) patch => realization%patch
2721) grid => patch%grid
2722) option => realization%option
2723) field => realization%field
2724)
2725) Miscible_parameter => patch%aux%Miscible%Miscible_parameter
2726) auxvars => patch%aux%Miscible%auxvars
2727) auxvars_bc => patch%aux%Miscible%auxvars_bc
2728) global_auxvars => patch%aux%Global%auxvars
2729) global_auxvars_bc => patch%aux%Global%auxvars_bc
2730)
2731) ! dropped derivatives:
2732) ! 1.D0 gas phase viscocity to all p,t,c,s
2733) ! 2. Average molecular weights to p,t,s
2734) ! flag = SAME_NONZERO_PATTERN
2735)
2736) #if 0
2737) ! call MiscibleNumericalJacobianTest(xx,realization)
2738) #endif
2739)
2740) ! print *,'*********** In Jacobian ********************** '
2741) ! call MatZeroEntries(A,ierr)
2742)
2743) !geh refactor call VecGetArrayF90(field%porosity_loc, porosity_loc_p, ierr)
2744) !geh refactor call VecGetArrayF90(field%volume, volume_p, ierr)
2745) call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
2746) call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
2747) ! call VecGetArrayF90(field%iphas_loc, iphase_loc_p, ierr)
2748)
2749) ResInc = 0.D0
2750) #if 1
2751) ! Accumulation terms ------------------------------------
2752) do local_id = 1, grid%nlmax ! For each local node do...
2753) ghosted_id = grid%nL2G(local_id)
2754) !geh - Ignore inactive cells with inactive materials
2755) if (associated(patch%imat)) then
2756) if (patch%imat(ghosted_id) <= 0) cycle
2757) endif
2758) iend = local_id*option%nflowdof
2759) istart = iend-option%nflowdof+1
2760) icap = int(icap_loc_p(ghosted_id))
2761)
2762) do nvar =1, option%nflowdof
2763) call MiscibleAccumulation(auxvars(ghosted_id)%auxvar_elem(nvar), &
2764) global_auxvars(ghosted_id),&
2765) porosity_loc_p(ghosted_id), &
2766) volume_p(local_id), &
2767) Miscible_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
2768) option,res)
2769) ResInc( local_id,:,nvar) = ResInc(local_id,:,nvar) + Res(:)
2770) enddo
2771) enddo
2772) #endif
2773) #if 1
2774) ! Source/sink terms -------------------------------------
2775) source_sink => patch%source_sink_list%first
2776) sum_connection = 0
2777) do
2778) if (.not.associated(source_sink)) exit
2779)
2780) ! check whether enthalpy dof is included
2781) ! if (source_sink%flow_condition%num_sub_conditions > 3) then
2782) enthalpy_flag = PETSC_TRUE
2783) ! else
2784) ! enthalpy_flag = PETSC_FALSE
2785) ! endif
2786)
2787) if (associated(source_sink%flow_condition%pressure)) then
2788) psrc(:) = source_sink%flow_condition%pressure%dataset%rarray(:)
2789) endif
2790) tsrc1 = source_sink%flow_condition%temperature%dataset%rarray(1)
2791) csrc1 = source_sink%flow_condition%concentration%dataset%rarray(1)
2792) ! hsrc1=0.D0
2793) if (enthalpy_flag) hsrc1 = source_sink%flow_condition%enthalpy%dataset%rarray(1)
2794)
2795) ! qsrc1 = qsrc1 / FMWH2O ! [kg/s -> kmol/s; fmw -> g/mol = kg/kmol]
2796) ! csrc1 = csrc1 / FMWCO2
2797) select case(source_sink%flow_condition%itype(1))
2798) case(MASS_RATE_SS)
2799) msrc => source_sink%flow_condition%rate%dataset%rarray
2800) nsrcpara= 2
2801) case(WELL_SS)
2802) msrc => source_sink%flow_condition%well%dataset%rarray
2803) nsrcpara = 7 + option%nflowspec
2804) case default
2805) print *, 'Flash mode does not support source/sink type: ', source_sink%flow_condition%itype(1)
2806) stop
2807) end select
2808) cur_connection_set => source_sink%connection_set
2809)
2810) do iconn = 1, cur_connection_set%num_connections
2811) local_id = cur_connection_set%id_dn(iconn)
2812) ghosted_id = grid%nL2G(local_id)
2813)
2814) if (associated(patch%imat)) then
2815) if (patch%imat(ghosted_id) <= 0) cycle
2816) endif
2817) ! if (enthalpy_flag) then
2818) ! r_p(local_id*option%nflowdof) = r_p(local_id*option%nflowdof) - hsrc1 * option%flow_dt
2819) ! endif
2820) do nvar =1, option%nflowdof
2821) call MiscibleSourceSink(msrc,nsrcpara,psrc,tsrc1,hsrc1,csrc1, &
2822) auxvars(ghosted_id)%auxvar_elem(nvar),&
2823) source_sink%flow_condition%itype(1), Res,&
2824) dummy_real, &
2825) enthalpy_flag, option)
2826)
2827) ResInc(local_id,jh2o,nvar)= ResInc(local_id,jh2o,nvar) - Res(jh2o)
2828) ResInc(local_id,jglyc,nvar)= ResInc(local_id,jglyc,nvar) - Res(jglyc)
2829) if (enthalpy_flag) &
2830) ResInc(local_id,option%nflowdof,nvar) = &
2831) ResInc(local_id,option%nflowdof,nvar) - Res(option%nflowdof)
2832) enddo
2833) enddo
2834) source_sink => source_sink%next
2835) enddo
2836) #endif
2837)
2838) ! Set matrix values related to single node terms: Accumulation, Source/Sink, BC
2839) do local_id = 1, grid%nlmax ! For each local node do...
2840) ghosted_id = grid%nL2G(local_id)
2841) !geh - Ignore inactive cells with inactive materials
2842) if (associated(patch%imat)) then
2843) if (patch%imat(ghosted_id) <= 0) cycle
2844) endif
2845)
2846) ra=0.D0
2847) max_dev=0.D0
2848) do neq=1, option%nflowdof
2849) do nvar=1, option%nflowdof
2850) ra(neq,nvar)=(ResInc(local_id,neq,nvar)-patch%aux%Miscible%ResOld_AR(local_id,neq))&
2851) /patch%aux%Miscible%delx(nvar,ghosted_id)
2852) enddo
2853) enddo
2854)
2855) select case(option%idt_switch)
2856) case(1)
2857) ra(1:option%nflowdof,1:option%nflowdof) = &
2858) ra(1:option%nflowdof,1:option%nflowdof) / option%flow_dt
2859) case(-1)
2860) if (option%flow_dt > 1.d0) ra(1:option%nflowdof,1:option%nflowdof) = &
2861) ra(1:option%nflowdof,1:option%nflowdof) / option%flow_dt
2862) end select
2863)
2864) Jup = ra(1:option%nflowdof,1:option%nflowdof)
2865) if (volume_p(local_id) > 1.D0) Jup = Jup / volume_p(local_id)
2866) ! Jup = Jup / volume_p(local_id)
2867) call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup,ADD_VALUES, &
2868) ierr);CHKERRQ(ierr)
2869) end do
2870)
2871) if (realization%debug%matview_Jacobian_detailed) then
2872) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2873) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2874) string = 'jacobian_srcsink'
2875) call DebugCreateViewer(realization%debug,string,option,viewer)
2876) call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
2877) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2878) endif
2879)
2880) !geh refactor call VecRestoreArrayF90(field%porosity_loc, porosity_loc_p, ierr)
2881) !geh refactor call VecRestoreArrayF90(field%volume, volume_p, ierr)
2882) call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
2883) call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
2884) ! call VecRestoreArrayF90(field%iphas_loc, iphase_loc_p, ierr)
2885)
2886) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2887) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2888) ! call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr)
2889) #if 0
2890) ! zero out isothermal and inactive cells
2891) #ifdef ISOTHERMAL
2892) zero = 0.d0
2893) call MatZeroRowsLocal(A,n_zero_rows,zero_rows_local_ghosted,zero, &
2894) PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
2895) ierr);CHKERRQ(ierr)
2896) do i=1, n_zero_rows
2897) ii = mod(zero_rows_local(i),option%nflowdof)
2898) ip1 = zero_rows_local_ghosted(i)
2899) if (ii == 0) then
2900) ip2 = ip1-1
2901) elseif (ii == option%nflowdof-1) then
2902) ip2 = ip1+1
2903) else
2904) ip2 = ip1
2905) endif
2906) call MatSetValuesLocal(A,1,ip1,1,ip2,1.d0,INSERT_VALUES, &
2907) ierr);CHKERRQ(ierr)
2908) enddo
2909)
2910) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2911) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2912) #else
2913) #endif
2914) #endif
2915)
2916) if (patch%aux%Miscible%inactive_cells_exist) then
2917) f_up = 1.d0
2918) call MatZeroRowsLocal(A,patch%aux%Miscible%n_zero_rows, &
2919) patch%aux%Miscible%zero_rows_local_ghosted,f_up, &
2920) PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
2921) ierr);CHKERRQ(ierr)
2922) endif
2923)
2924) if (realization%debug%matview_Jacobian) then
2925) string = 'MISjacobian'
2926) call DebugCreateViewer(realization%debug,string,option,viewer)
2927) call MatView(A,viewer,ierr);CHKERRQ(ierr)
2928) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2929) endif
2930) if (realization%debug%norm_Jacobian) then
2931) call MatNorm(A,NORM_1,norm,ierr);CHKERRQ(ierr)
2932) write(option%io_buffer,'("1 norm: ",es11.4)') norm
2933) call printMsg(option)
2934) call MatNorm(A,NORM_FROBENIUS,norm,ierr);CHKERRQ(ierr)
2935) write(option%io_buffer,'("2 norm: ",es11.4)') norm
2936) call printMsg(option)
2937) call MatNorm(A,NORM_INFINITY,norm,ierr);CHKERRQ(ierr)
2938) write(option%io_buffer,'("inf norm: ",es11.4)') norm
2939) call printMsg(option)
2940) ! call GridCreateVector(grid,ONEDOF,debug_vec,GLOBAL)
2941) ! call MatGetRowMaxAbs(A,debug_vec,PETSC_NULL_INTEGER,ierr)
2942) ! call VecMax(debug_vec,i,norm,ierr)
2943) ! call VecDestroy(debug_vec,ierr)
2944) endif
2945)
2946) end subroutine MiscibleJacobianPatch2
2947)
2948) ! ************************************************************************** !
2949)
2950) subroutine MiscibleMaxChange(realization,dpmax,dcmax)
2951) !
2952) ! Computes the maximum change in the solution vector
2953) !
2954) ! Author: Chuan Lu
2955) ! Date: 01/15/08
2956) !
2957)
2958) use Realization_Subsurface_class
2959) use Field_module
2960) use Option_module
2961) use Field_module
2962)
2963) implicit none
2964)
2965) type(realization_subsurface_type) :: realization
2966)
2967) type(option_type), pointer :: option
2968) type(field_type), pointer :: field
2969) PetscReal :: dpmax, dcmax
2970) PetscReal :: temp
2971) PetscInt :: idof
2972) PetscErrorCode :: ierr
2973)
2974) option => realization%option
2975) field => realization%field
2976)
2977) dpmax = 0.d0
2978) dcmax = 0.d0
2979)
2980) call VecWAXPY(field%flow_dxx,-1.d0,field%flow_xx,field%flow_yy, &
2981) ierr);CHKERRQ(ierr)
2982) call VecStrideNorm(field%flow_dxx,ZERO_INTEGER,NORM_INFINITY,dpmax, &
2983) ierr);CHKERRQ(ierr)
2984)
2985) do idof = 1,option%nflowdof-1
2986) call VecStrideNorm(field%flow_dxx,idof,NORM_INFINITY,temp, &
2987) ierr);CHKERRQ(ierr)
2988) dcmax = max(dcmax,temp)
2989) enddo
2990)
2991) end subroutine MiscibleMaxChange
2992)
2993) ! ************************************************************************** !
2994)
2995) function MiscibleGetTecplotHeader(realization, icolumn)
2996) !
2997) ! Returns Richards contribution to
2998) ! Tecplot file header
2999) !
3000) ! Author: Chuan Lu
3001) ! Date: 10/13/08
3002) !
3003)
3004) use Realization_Subsurface_class
3005) use Option_module
3006) use Field_module
3007)
3008) implicit none
3009)
3010) character(len=MAXSTRINGLENGTH) :: MiscibleGetTecplotHeader
3011) type(realization_subsurface_type) :: realization
3012) PetscInt :: icolumn
3013)
3014) character(len=MAXSTRINGLENGTH) :: string, string2
3015) type(option_type), pointer :: option
3016) type(field_type), pointer :: field
3017) PetscInt :: i
3018)
3019) option => realization%option
3020) field => realization%field
3021)
3022) string = ''
3023)
3024) if (icolumn > -1) then
3025) icolumn = icolumn + 1
3026) write(string2,'('',"'',i2,''-P [Pa]"'')') icolumn
3027) else
3028) write(string2,'('',"P [Pa]"'')')
3029) endif
3030) string = trim(string) // trim(string2)
3031)
3032) if (icolumn > -1) then
3033) icolumn = icolumn + 1
3034) write(string2,'('',"'',i2,''-d(l)"'')') icolumn
3035) else
3036) write(string2,'('',"d(l)"'')')
3037) endif
3038) string = trim(string) // trim(string2)
3039)
3040)
3041) if (icolumn > -1) then
3042) icolumn = icolumn + 1
3043) write(string2,'('',"'',i2,''-vis(l)"'')') icolumn
3044) else
3045) write(string2,'('',"vis(l)"'')')
3046) endif
3047) string = trim(string) // trim(string2)
3048)
3049) do i=1,option%nflowspec
3050) if (icolumn > -1) then
3051) icolumn = icolumn + 1
3052) write(string2,'('',"'',i2,''-Xl('',i2,'')"'')') icolumn, i
3053) else
3054) write(string2,'('',"Xl('',i2,'')"'')') i
3055) endif
3056) string = trim(string) // trim(string2)
3057) enddo
3058)
3059)
3060) MiscibleGetTecplotHeader = string
3061)
3062) end function MiscibleGetTecplotHeader
3063)
3064) ! ************************************************************************** !
3065)
3066) subroutine MiscibleSetPlotVariables(list)
3067) !
3068) ! Adds variables to be printed to list
3069) !
3070) ! Author: Glenn Hammond
3071) ! Date: 10/15/12
3072) !
3073)
3074) use Output_Aux_module
3075) use Variables_module
3076)
3077) implicit none
3078)
3079) type(output_variable_list_type), pointer :: list
3080) character(len=MAXWORDLENGTH) :: name, units
3081)
3082) if (associated(list%first)) then
3083) return
3084) endif
3085)
3086) name = 'Temperature'
3087) units = 'C'
3088) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
3089) TEMPERATURE)
3090)
3091) name = 'Liquid Pressure'
3092) units = 'Pa'
3093) call OutputVariableAddToList(list,name,OUTPUT_PRESSURE,units, &
3094) LIQUID_PRESSURE)
3095)
3096) name = 'Liquid Density'
3097) units = ''
3098) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
3099) LIQUID_DENSITY)
3100)
3101) name = 'Liquid Viscosity'
3102) units = ''
3103) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
3104) LIQUID_VISCOSITY)
3105)
3106) name = 'Liquid Mole Fraction H2O'
3107) units = ''
3108) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
3109) LIQUID_MOLE_FRACTION,ONE_INTEGER)
3110)
3111) name = 'Liquid Mole Fraction CO2'
3112) units = ''
3113) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
3114) LIQUID_MOLE_FRACTION,TWO_INTEGER)
3115)
3116) end subroutine MiscibleSetPlotVariables
3117)
3118) ! ************************************************************************** !
3119)
3120) subroutine MiscibleDestroy(realization)
3121) !
3122) ! MphaseDestroy: Deallocates variables associated with Miscible
3123) !
3124) ! Author: Gautam Bisht
3125) ! Date: 11/27/13
3126) !
3127)
3128) use Realization_Subsurface_class
3129)
3130) implicit none
3131)
3132) type(realization_subsurface_type) :: realization
3133)
3134) ! need to free array in aux vars
3135) !call MiscibleAuxDestroy(patch%aux%miscible)
3136)
3137) end subroutine MiscibleDestroy
3138)
3139) end module Miscible_module