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