flash2.F90 coverage: 63.16 %func 39.81 %block
1) module Flash2_module
2)
3) use Flash2_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 = 1.D-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) ! PetscReal, allocatable, save :: Resold_AR(:,:), Resold_FL(:,:), delx(:,:)
47)
48) public Flash2Residual,Flash2Jacobian, &
49) Flash2UpdateFixedAccumulation,Flash2TimeCut,&
50) Flash2Setup,Flash2UpdateReason,&
51) Flash2MaxChange, Flash2UpdateSolution, &
52) Flash2GetTecplotHeader, Flash2InitializeTimestep, &
53) Flash2UpdateAuxVars, Flash2ComputeMassBalance, Flash2Destroy
54)
55) contains
56)
57) ! ************************************************************************** !
58)
59) subroutine Flash2TimeCut(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 Flash2TimeCut
85)
86) ! ************************************************************************** !
87)
88) subroutine Flash2Setup(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 span_wagner_module
98) ! use co2_sw_module
99) ! use 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 Flash2SetupPatch(realization)
111) cur_patch => cur_patch%next
112) enddo
113)
114) list => realization%output_option%output_snap_variable_list
115) call Flash2SetPlotVariables(list)
116) list => realization%output_option%output_obs_variable_list
117) call Flash2SetPlotVariables(list)
118)
119) end subroutine Flash2Setup
120)
121) ! ************************************************************************** !
122)
123) subroutine Flash2SetupPatch(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)
147) PetscInt :: ghosted_id, iconn, sum_connection, ipara
148) type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
149)
150) option => realization%option
151) patch => realization%patch
152) grid => patch%grid
153) !print *,' Flash2 setup get patch'
154) patch%aux%Flash2 => Flash2AuxCreate()
155)
156) ! option%io_buffer = 'Before Flash2 can be run, the thc_parameter object ' // &
157) ! 'must be initialized with the proper variables ' // &
158) ! 'Flash2AuxCreate() is called anyhwere.'
159) ! call printErrMsg(option)
160) !print *,' Flash2 setup get Aux', option%nphase, size(patch%saturation_function_array)
161) ! Flash2_parameters create *********************************************
162) ! Sir
163) allocate(patch%aux%Flash2%Flash2_parameter%sir(option%nphase, &
164) size(patch%saturation_function_array)))
165) !print *,' Flash2 setup get patch: sir, allocated'
166) do ipara = 1, size(patch%saturation_function_array)
167) patch%aux%Flash2%Flash2_parameter%sir(:,patch% &
168) saturation_function_array(ipara)%ptr%id) = &
169) patch%saturation_function_array(ipara)%ptr%Sr(:)
170) enddo
171) !print *,' Flash2 setup get patch: sir'
172) ! dencpr
173) allocate(patch%aux%Flash2%Flash2_parameter%dencpr(size(patch%material_property_array)))
174) do ipara = 1, size(patch%material_property_array)
175) patch%aux%Flash2%Flash2_parameter%dencpr(iabs(patch% &
176) material_property_array(ipara)%ptr%internal_id)) = &
177) patch%material_property_array(ipara)%ptr%rock_density*option%scale*&
178) patch%material_property_array(ipara)%ptr%specific_heat
179) enddo
180) ! ckwet
181) allocate(patch%aux%Flash2%Flash2_parameter%ckwet(size(patch%material_property_array)))
182) do ipara = 1, size(patch%material_property_array)
183) patch%aux%Flash2%Flash2_parameter%ckwet(iabs(patch% &
184) material_property_array(ipara)%ptr%internal_id)) = &
185) patch%material_property_array(ipara)%ptr%thermal_conductivity_wet*option%scale
186) enddo
187) ! Flash2_parameters create_end *****************************************
188)
189) ! allocate auxvar data structures for all grid cells
190) allocate(auxvars(grid%ngmax))
191) !print *,' Flash2 setup get Aux alloc', grid%ngmax
192) do ghosted_id = 1, grid%ngmax
193) call Flash2AuxVarInit(auxvars(ghosted_id),option)
194) enddo
195) patch%aux%Flash2%auxvars => auxvars
196) patch%aux%Flash2%num_aux = grid%ngmax
197) !print *,' Flash2 setup get Aux init'
198)
199) ! allocate(delx(option%nflowdof, grid%ngmax))
200) ! allocate(Resold_AR(grid%nlmax,option%nflowdof))
201) ! allocate(Resold_FL(ConnectionGetNumberInList(patch%grid%&
202) ! internal_connection_set_list),option%nflowdof))
203)
204) !print *,' Flash2 setup allocate app array'
205) ! count the number of boundary connections and allocate
206) ! auxvar data structures for them
207) boundary_condition => patch%boundary_condition_list%first
208) sum_connection = 0
209) do
210) if (.not.associated(boundary_condition)) exit
211) sum_connection = sum_connection + &
212) boundary_condition%connection_set%num_connections
213) boundary_condition => boundary_condition%next
214) enddo
215) allocate(auxvars_bc(sum_connection))
216) !print *,' Flash2 setup get AuxBc alloc', sum_connection
217) do iconn = 1, sum_connection
218) call Flash2AuxVarInit(auxvars_bc(iconn),option)
219) enddo
220) patch%aux%Flash2%auxvars_bc => auxvars_bc
221) patch%aux%Flash2%num_aux_bc = sum_connection
222) option%flow%numerical_derivatives = PETSC_TRUE
223)
224) allocate(patch%aux%Flash2%delx(option%nflowdof, grid%ngmax))
225) allocate(patch%aux%Flash2%Resold_AR(grid%nlmax,option%nflowdof))
226) allocate(patch%aux%Flash2%Resold_BC(grid%nlmax,option%nflowdof))
227) ! should be allocated by the number of BC connections, just for debug now
228) allocate(patch%aux%Flash2%Resold_FL(ConnectionGetNumberInList(patch%grid%&
229) internal_connection_set_list),option%nflowdof))
230)
231) end subroutine Flash2SetupPatch
232)
233) ! ************************************************************************** !
234)
235) subroutine Flash2ComputeMassBalance(realization,mass_balance,mass_trapped)
236) !
237) ! Author: Glenn Hammond
238) ! Date: 02/22/08
239) !
240)
241) use Realization_Subsurface_class
242) use Patch_module
243)
244) type(realization_subsurface_type) :: realization
245) PetscReal :: mass_balance(realization%option%nflowspec,realization%option%nphase)
246) PetscReal :: mass_trapped(realization%option%nphase)
247)
248) type(patch_type), pointer :: cur_patch
249)
250) mass_balance = 0.d0
251) mass_trapped = 0.d0
252)
253) cur_patch => realization%patch_list%first
254) do
255) if (.not.associated(cur_patch)) exit
256) realization%patch => cur_patch
257) call Flash2ComputeMassBalancePatch(realization,mass_balance,mass_trapped)
258) cur_patch => cur_patch%next
259) enddo
260)
261) end subroutine Flash2ComputeMassBalance
262)
263) ! ************************************************************************** !
264)
265) subroutine Flash2ComputeMassBalancePatch(realization,mass_balance,mass_trapped)
266) !
267) ! Initializes mass balance
268) !
269) ! Author: Glenn Hammond
270) ! Date: 12/19/08
271) !
272)
273) use Realization_Subsurface_class
274) use Option_module
275) use Patch_module
276) use Field_module
277) use Grid_module
278) use Material_Aux_class
279) ! use Saturation_Function_module
280) ! use Flash2_pckr_module
281)
282) implicit none
283)
284) type(realization_subsurface_type) :: realization
285) ! type(saturation_function_type) :: saturation_function_type
286)
287) PetscReal :: mass_balance(realization%option%nflowspec,realization%option%nphase)
288) PetscReal :: mass_trapped(realization%option%nphase)
289)
290) type(option_type), pointer :: option
291) type(patch_type), pointer :: patch
292) type(field_type), pointer :: field
293) type(grid_type), pointer :: grid
294) type(Flash2_auxvar_type), pointer :: Flash2_auxvars(:)
295) class(material_auxvar_type), pointer :: material_auxvars(:)
296) PetscReal, pointer :: icap_loc_p(:)
297)
298) PetscErrorCode :: ierr
299) PetscInt :: local_id
300) PetscInt :: ghosted_id
301) PetscInt :: iphase
302) PetscInt :: ispec_start, ispec_end, ispec
303) PetscReal :: pckr_sir(realization%option%nphase)
304)
305) option => realization%option
306) patch => realization%patch
307) grid => patch%grid
308) field => realization%field
309)
310) Flash2_auxvars => patch%aux%Flash2%auxvars
311) material_auxvars => patch%aux%Material%auxvars
312)
313) call VecGetArrayF90(field%icap_loc,icap_loc_p, ierr);CHKERRQ(ierr)
314)
315) do local_id = 1, grid%nlmax
316) ghosted_id = grid%nL2G(local_id)
317)
318) !geh - Ignore inactive cells with inactive materials
319) if (associated(patch%imat)) then
320) if (patch%imat(ghosted_id) <= 0) cycle
321) endif
322)
323) ! mass = volume * saturation * density * mole fraction
324) do iphase = 1, option%nphase
325) do ispec = 1, option%nflowspec
326) mass_balance(ispec,iphase) = mass_balance(ispec,iphase) + &
327) Flash2_auxvars(ghosted_id)%auxvar_elem(0)%xmol(ispec+(iphase-1)*option%nflowspec)* &
328) Flash2_auxvars(ghosted_id)%auxvar_elem(0)%den(iphase)* &
329) Flash2_auxvars(ghosted_id)%auxvar_elem(0)%sat(iphase)* &
330) material_auxvars(ghosted_id)%porosity*material_auxvars(ghosted_id)%volume
331) enddo
332)
333) pckr_sir(iphase) = &
334) patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr%sr(iphase)
335)
336) if (iphase == 1 .and. &
337) Flash2_auxvars(ghosted_id)%auxvar_elem(0)%sat(iphase) <= pckr_sir(iphase)) then
338) ispec = 1
339) mass_trapped(iphase) = mass_trapped(iphase) + &
340) Flash2_auxvars(ghosted_id)%auxvar_elem(0)%xmol(ispec+(iphase-1)*option%nflowspec)* &
341) Flash2_auxvars(ghosted_id)%auxvar_elem(0)%den(iphase)* &
342) Flash2_auxvars(ghosted_id)%auxvar_elem(0)%sat(iphase)* &
343) material_auxvars(ghosted_id)%porosity*material_auxvars(ghosted_id)%volume
344) endif
345)
346) if (iphase == 2 .and. &
347) Flash2_auxvars(ghosted_id)%auxvar_elem(0)%sat(iphase) <= pckr_sir(iphase)) then
348) ispec = 2
349) mass_trapped(iphase) = mass_trapped(iphase) + &
350) Flash2_auxvars(ghosted_id)%auxvar_elem(0)%xmol(ispec+(iphase-1)*option%nflowspec)* &
351) Flash2_auxvars(ghosted_id)%auxvar_elem(0)%den(iphase)* &
352) Flash2_auxvars(ghosted_id)%auxvar_elem(0)%sat(iphase)* &
353) material_auxvars(ghosted_id)%porosity*material_auxvars(ghosted_id)%volume
354) endif
355) enddo
356) enddo
357)
358) call VecRestoreArrayF90(field%icap_loc,icap_loc_p, ierr);CHKERRQ(ierr)
359)
360) end subroutine Flash2ComputeMassBalancePatch
361)
362) ! ************************************************************************** !
363)
364) subroutine FLASH2ZeroMassBalDeltaPatch(realization)
365) !
366) ! Zeros mass balance delta array
367) !
368) ! Author: Glenn Hammond
369) ! Date: 12/19/08
370) !
371)
372) use Realization_Subsurface_class
373) use Option_module
374) use Patch_module
375) use Grid_module
376)
377) implicit none
378)
379) type(realization_subsurface_type) :: realization
380)
381) type(option_type), pointer :: option
382) type(patch_type), pointer :: patch
383) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
384) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
385)
386) PetscInt :: iconn
387)
388) option => realization%option
389) patch => realization%patch
390)
391) global_auxvars_bc => patch%aux%Global%auxvars_bc
392) global_auxvars_ss => patch%aux%Global%auxvars_ss
393)
394) #ifdef COMPUTE_INTERNAL_MASS_FLUX
395) do iconn = 1, patch%aux%FLASH2%num_aux
396) patch%aux%Global%auxvars(iconn)%mass_balance_delta = 0.d0
397) enddo
398) #endif
399)
400) ! Intel 10.1 on Chinook reports a SEGV if this conditional is not
401) ! placed around the internal do loop - geh
402) if (patch%aux%Flash2%num_aux_bc > 0) then
403) do iconn = 1, patch%aux%FLASH2%num_aux_bc
404) global_auxvars_bc(iconn)%mass_balance_delta = 0.d0
405) enddo
406) endif
407)
408) if (patch%aux%FLASH2%num_aux_ss > 0) then
409) do iconn = 1, patch%aux%FLASH2%num_aux_ss
410) global_auxvars_ss(iconn)%mass_balance_delta = 0.d0
411) enddo
412) endif
413)
414) end subroutine FLASH2ZeroMassBalDeltaPatch
415)
416) ! ************************************************************************** !
417)
418) subroutine FLASH2UpdateMassBalancePatch(realization)
419) !
420) ! Updates mass balance
421) !
422) ! Author: Glenn Hammond
423) ! Date: 12/19/08
424) !
425)
426) use Realization_Subsurface_class
427) use Option_module
428) use Patch_module
429) use Grid_module
430)
431) implicit none
432)
433) type(realization_subsurface_type) :: realization
434)
435) type(option_type), pointer :: option
436) type(patch_type), pointer :: patch
437) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
438) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
439)
440) PetscInt :: iconn
441)
442) option => realization%option
443) patch => realization%patch
444)
445) global_auxvars_bc => patch%aux%Global%auxvars_bc
446) global_auxvars_ss => patch%aux%Global%auxvars_ss
447)
448) #ifdef COMPUTE_INTERNAL_MASS_FLUX
449) do iconn = 1, patch%aux%Flash2%num_aux
450) patch%aux%Global%auxvars(iconn)%mass_balance = &
451) patch%aux%Global%auxvars(iconn)%mass_balance + &
452) patch%aux%Global%auxvars(iconn)%mass_balance_delta* &
453) option%flow_dt
454) enddo
455) #endif
456)
457) ! Intel 10.1 on Chinook reports a SEGV if this conditional is not
458) ! placed around the internal do loop - geh
459) if (patch%aux%FLASH2%num_aux_bc > 0) then
460) do iconn = 1, patch%aux%Flash2%num_aux_bc
461) global_auxvars_bc(iconn)%mass_balance = &
462) global_auxvars_bc(iconn)%mass_balance + &
463) global_auxvars_bc(iconn)%mass_balance_delta*option%flow_dt
464) enddo
465) endif
466)
467) if (patch%aux%FLASH2%num_aux_ss > 0) then
468) do iconn = 1, patch%aux%Flash2%num_aux_ss
469) global_auxvars_ss(iconn)%mass_balance = &
470) global_auxvars_ss(iconn)%mass_balance + &
471) global_auxvars_ss(iconn)%mass_balance_delta*option%flow_dt
472) enddo
473) endif
474)
475) end subroutine FLASH2UpdateMassBalancePatch
476)
477) ! ************************************************************************** !
478)
479) function Flash2InitGuessCheck(realization)
480) !
481) ! Flash2initguesscheckpatch:
482) !
483) ! Author: Chuan Lu
484) ! Date: 12/10/07
485) !
486)
487) use Realization_Subsurface_class
488) use Patch_module
489) use Option_module
490)
491) PetscInt :: Flash2InitGuessCheck
492) type(realization_subsurface_type) :: realization
493) type(option_type), pointer :: option
494) type(patch_type), pointer :: cur_patch
495) PetscInt :: ipass, ipass0
496) PetscErrorCode :: ierr
497)
498) option => realization%option
499) ipass = 1
500) cur_patch => realization%patch_list%first
501) do
502) if (.not.associated(cur_patch)) exit
503) realization%patch => cur_patch
504) ipass= Flash2InitGuessCheckPatch(realization)
505) if (ipass<=0)then
506) exit
507) endif
508) cur_patch => cur_patch%next
509) enddo
510)
511) call MPI_Barrier(option%mycomm,ierr)
512) if (option%mycommsize >1)then
513) call MPI_Allreduce(ipass,ipass0,ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM, &
514) option%mycomm,ierr)
515) if (ipass0 < option%mycommsize) ipass=-1
516) endif
517) Flash2InitGuessCheck =ipass
518) end function Flash2InitGuessCheck
519)
520) ! ************************************************************************** !
521)
522) subroutine Flash2UpdateReasonPatch(reason,realization)
523) !
524) ! Flash2initguesscheckpatch:
525) !
526) ! Author: Chuan Lu
527) ! Date: 10/10/08
528) !
529)
530) use Realization_Subsurface_class
531) use Patch_module
532) use Field_module
533) use Option_module
534) use Grid_module
535)
536) implicit none
537)
538)
539) PetscInt, intent(out) :: reason
540) type(realization_subsurface_type) :: realization
541) type(patch_type),pointer :: patch
542) type(grid_type), pointer :: grid
543) type(field_type), pointer :: field
544) type(option_type), pointer :: option
545) PetscReal, pointer :: xx_p(:), yy_p(:)
546) PetscInt :: n,n0,re
547) PetscInt :: re0, iipha
548) PetscErrorCode :: ierr
549)
550) option => realization%option
551) field => realization%field
552) patch => realization%patch
553) grid => patch%grid
554)
555) re=1
556)
557) if (re > 0) then
558) call VecGetArrayReadF90(field%flow_xx, xx_p, ierr);CHKERRQ(ierr)
559) call VecGetArrayF90(field%flow_yy, yy_p, ierr);CHKERRQ(ierr)
560)
561) do n = 1,grid%nlmax
562) !**** clu-Ignore inactive cells with inactive materials **************
563) if (associated(patch%imat)) then
564) if (patch%imat(grid%nL2G(n)) <= 0) cycle
565) endif
566) n0=(n-1)* option%nflowdof
567)
568) ! ******** Too huge change in pressure ****************
569) !geh: I don't believe that this code is being used. Therefore, I will add an
570) ! error message and let someone sort the use of option%dpmxe later
571) option%io_buffer = 'option%dpmxe and option%dtmpmxe needs to be ' // &
572) 'refactored in Flash2UpdateReasonPatch'
573) call printErrMsg(option)
574) !geh if (dabs(xx_p(n0 + 1) - yy_p(n0 + 1)) > (10.0D0 * option%dpmxe)) then
575) re=0; print *,'huge change in p', xx_p(n0 + 1), yy_p(n0 + 1)
576) exit
577) !geh endif
578)
579) ! ******** Too huge change in temperature ****************
580) !geh if (dabs(xx_p(n0 + 2) - yy_p(n0 + 2)) > (10.0D0 * option%dtmpmxe)) then
581) re=0; print *,'huge change in T', xx_p(n0 + 2), yy_p(n0 + 2)
582) exit
583) !geh endif
584)
585) ! ******* Check 0<=total mass fraction <=1 **************************
586) if (xx_p(n0 + 3) > 1.D0) then
587) re=0; exit
588) endif
589) if (xx_p(n0 + 3) < 0.d0) then
590) re=0; exit
591) endif
592) enddo
593)
594) !if (re<=0) print *,'Sat out of Region at: ',n,iipha,xx_p(n0+1:n0+3)
595) call VecRestoreArrayReadF90(field%flow_xx, xx_p, ierr);CHKERRQ(ierr)
596) call VecRestoreArrayF90(field%flow_yy, yy_p, ierr);CHKERRQ(ierr)
597)
598) endif
599) ! reason = re!; print *,'reason:',reason
600) end subroutine Flash2UpdateReasonPatch
601)
602) ! ************************************************************************** !
603)
604) subroutine Flash2UpdateReason(reason, realization)
605) !
606) ! Flash2UpdateAuxVars: Updates the auxiliary variables associated with
607) ! the Richards problem
608) !
609) ! Author: Chuan Lu
610) ! Date: 10/10/08
611) !
612)
613) use Realization_Subsurface_class
614) use Patch_module
615) implicit none
616)
617) type(realization_subsurface_type) :: realization
618)
619) type(patch_type), pointer :: cur_patch
620) PetscInt :: reason
621)
622) PetscInt :: re, re0
623) PetscErrorCode :: ierr
624)
625) re = 1
626) cur_patch => realization%patch_list%first
627) do
628) if (.not.associated(cur_patch)) exit
629) realization%patch => cur_patch
630) call Flash2UpdateReasonPatch(re, realization)
631) if (re<=0) then
632) exit
633) endif
634) cur_patch => cur_patch%next
635) enddo
636)
637) call MPI_Barrier(realization%option%mycomm,ierr)
638) ! print *, 'flash reason ', re
639) if (realization%option%mycommsize >1)then
640) call MPI_Allreduce(re,re0,ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM, &
641) realization%option%mycomm,ierr)
642) if (re0<realization%option%mycommsize) re=0
643) endif
644) reason=re
645)
646) if (reason<=0 .and. realization%option%myrank ==0) print *,'Sat or Con out of Region', re
647) end subroutine Flash2UpdateReason
648)
649) ! ************************************************************************** !
650)
651) function Flash2InitGuessCheckPatch(realization)
652) !
653) ! Author: Chuan Lu
654) ! Date: 10/10/08
655) !
656)
657) use co2_span_wagner_module
658)
659) use Realization_Subsurface_class
660) use Patch_module
661) use Field_module
662) use Grid_module
663) use Option_module
664) implicit none
665)
666) PetscInt :: Flash2InitGuessCheckPatch
667) type(realization_subsurface_type) :: realization
668) type(grid_type), pointer :: grid
669) type(patch_type), pointer :: patch
670) type(option_type), pointer :: option
671) type(field_type), pointer :: field
672)
673) PetscInt :: local_id, ghosted_id, ipass
674) PetscErrorCode :: ierr
675) PetscReal, pointer :: xx_p(:)
676)
677)
678) patch => realization%patch
679) grid => patch%grid
680) option => realization%option
681) field => realization%field
682)
683) call VecGetArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
684)
685) ipass=1
686) do local_id = 1, grid%nlmax
687) ghosted_id = grid%nL2G(local_id)
688) !geh - Ignore inactive cells with inactive materials
689) if (associated(patch%imat)) then
690) if (patch%imat(ghosted_id) <= 0) cycle
691) endif
692)
693) ! insure zero liquid sat not passed to ptran (no effect on pflow)
694) if (xx_p((local_id-1)*option%nflowdof+3) < 0.D0) &
695) xx_p((local_id-1)*option%nflowdof+3) = zerocut
696) if (xx_p((local_id-1)*option%nflowdof+3) > 1.D0) &
697) xx_p((local_id-1)*option%nflowdof+3) = 1.D0 - zerocut
698)
699) ! check if p,T within range of table
700) if (xx_p((local_id-1)*option%nflowdof+1) < p0_tab*1D6 &
701) .or. xx_p((local_id-1)*option%nflowdof+1) > &
702) (ntab_p*dp_tab + p0_tab)*1D6) then
703) ipass=-1; exit
704) endif
705) if (xx_p((local_id-1)*option%nflowdof+2) < t0_tab -273.15D0 &
706) .or. xx_p((local_id-1)*option%nflowdof+2) > &
707) ntab_t*dt_tab + t0_tab-273.15D0) then
708) ipass=-1; exit
709) endif
710) enddo
711)
712) call VecRestoreArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
713) Flash2InitGuessCheckPatch = ipass
714) end function Flash2InitGuessCheckPatch
715)
716) ! ************************************************************************** !
717)
718) subroutine Flash2UpdateAuxVars(realization)
719) !
720) ! Updates the auxiliary variables associated with
721) ! the Flash2 problem
722) !
723) ! Author: Chuan Lu
724) ! Date: 10/10/08
725) !
726)
727) use Realization_Subsurface_class
728) use Patch_module
729)
730) type(realization_subsurface_type) :: realization
731)
732) type(patch_type), pointer :: cur_patch
733)
734) cur_patch => realization%patch_list%first
735) do
736) if (.not.associated(cur_patch)) exit
737) realization%patch => cur_patch
738) call Flash2UpdateAuxVarsPatch(realization)
739) cur_patch => cur_patch%next
740) enddo
741)
742) end subroutine Flash2UpdateAuxVars
743)
744) ! ************************************************************************** !
745)
746) subroutine Flash2UpdateAuxVarsPatch(realization)
747) !
748) ! Updates the auxiliary variables associated with
749) ! the Flash2 problem
750) !
751) ! Author: Chuan Lu
752) ! Date: 12/10/07
753) !
754)
755) use Realization_Subsurface_class
756) use Patch_module
757) use Field_module
758) use Option_module
759) use Grid_module
760) use Coupler_module
761) use Connection_module
762) use Material_module
763)
764) implicit none
765)
766) type(realization_subsurface_type) :: realization
767)
768) type(option_type), pointer :: option
769) type(patch_type), pointer :: patch
770) type(grid_type), pointer :: grid
771) type(field_type), pointer :: field
772) type(coupler_type), pointer :: boundary_condition
773) type(connection_set_type), pointer :: cur_connection_set
774) type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
775) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
776)
777) PetscInt :: ghosted_id, local_id, istart, iend, sum_connection, idof, iconn
778) PetscInt :: iphasebc, iphase
779) PetscReal, pointer :: xx_loc_p(:), icap_loc_p(:), iphase_loc_p(:)
780) PetscReal :: xxbc(realization%option%nflowdof)
781) PetscReal :: mnacl, ynacl, xphi
782) PetscErrorCode :: ierr
783)
784) option => realization%option
785) patch => realization%patch
786) grid => patch%grid
787) field => realization%field
788)
789) auxvars => patch%aux%Flash2%auxvars
790) auxvars_bc => patch%aux%Flash2%auxvars_bc
791) global_auxvars => patch%aux%Global%auxvars
792) global_auxvars_bc => patch%aux%Global%auxvars_bc
793)
794)
795) call VecGetArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
796) call VecGetArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
797)
798) do ghosted_id = 1, grid%ngmax
799) if (grid%nG2L(ghosted_id) < 0) cycle ! bypass ghosted corner cells
800) !geh - Ignore inactive cells with inactive materials
801) if (associated(patch%imat)) then
802) if (patch%imat(ghosted_id) <= 0) cycle
803) endif
804) iend = ghosted_id*option%nflowdof
805) istart = iend-option%nflowdof+1
806) if (.not. associated(patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr))then
807) print*, 'error!!! saturation function not allocated', ghosted_id,icap_loc_p(ghosted_id)
808) endif
809)
810) call Flash2AuxVarCompute_NINC(xx_loc_p(istart:iend), &
811) auxvars(ghosted_id)%auxvar_elem(0), &
812) global_auxvars(ghosted_id), &
813) patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr, &
814) realization%fluid_properties,option)
815)
816) ! update global variables
817) if ( associated(global_auxvars))then
818)
819) global_auxvars(ghosted_id)%pres(:) = auxvars(ghosted_id)%auxvar_elem(0)%pres -&
820) auxvars(ghosted_id)%auxvar_elem(0)%pc(:)
821) global_auxvars(ghosted_id)%temp = auxvars(ghosted_id)%auxvar_elem(0)%temp
822) global_auxvars(ghosted_id)%sat(:)=auxvars(ghosted_id)%auxvar_elem(0)%sat(:)
823) ! global_auxvars(ghosted_id)%fugacoeff(1) = xphi
824) global_auxvars(ghosted_id)%den(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:)
825) global_auxvars(ghosted_id)%den_kg(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:) &
826) * auxvars(ghosted_id)%auxvar_elem(0)%avgmw(:)
827) mnacl= global_auxvars(ghosted_id)%m_nacl(1)
828) if (global_auxvars(ghosted_id)%m_nacl(2) > mnacl) mnacl = global_auxvars(ghosted_id)%m_nacl(2)
829) ynacl = mnacl/(1.d3/FMWH2O + mnacl)
830) global_auxvars(ghosted_id)%xmass(1) = (1.d0-ynacl)&
831) *auxvars(ghosted_id)%auxvar_elem(0)%xmol(1) * FMWH2O&
832) /((1.d0-ynacl)*auxvars(ghosted_id)%auxvar_elem(0)%xmol(1) * FMWH2O &
833) +auxvars(ghosted_id)%auxvar_elem(0)%xmol(2) * FMWCO2 &
834) +ynacl*auxvars(ghosted_id)%auxvar_elem(0)%xmol(1)*FMWNACL)
835) global_auxvars(ghosted_id)%xmass(2)=auxvars(ghosted_id)%auxvar_elem(0)%xmol(3) * FMWH2O&
836) /(auxvars(ghosted_id)%auxvar_elem(0)%xmol(3) * FMWH2O&
837) +auxvars(ghosted_id)%auxvar_elem(0)%xmol(4) * FMWCO2)
838) global_auxvars(ghosted_id)%reaction_rate_store(:) = global_auxvars(ghosted_id)%reaction_rate(:)
839) global_auxvars(ghosted_id)%reaction_rate(:) = 0.D0
840) else
841) print *,'Not associated global for FLASH2'
842) endif
843)
844)
845) enddo
846) ! print *,'Flash2UpdateAuxVarsPatch: end internal'
847) boundary_condition => patch%boundary_condition_list%first
848) sum_connection = 0
849) do
850) if (.not.associated(boundary_condition)) exit
851) cur_connection_set => boundary_condition%connection_set
852) do iconn = 1, cur_connection_set%num_connections
853) sum_connection = sum_connection + 1
854) local_id = cur_connection_set%id_dn(iconn)
855) ghosted_id = grid%nL2G(local_id)
856) if (associated(patch%imat)) then
857) if (patch%imat(ghosted_id) <= 0) cycle
858) endif
859) do idof=1,option%nflowdof
860) select case(boundary_condition%flow_condition%itype(idof))
861) case(DIRICHLET_BC)
862) xxbc(:) = boundary_condition%flow_aux_real_var(:,iconn)
863) case(HYDROSTATIC_BC)
864) xxbc(1) = boundary_condition%flow_aux_real_var(1,iconn)
865) xxbc(2:option%nflowdof) = &
866) xx_loc_p((ghosted_id-1)*option%nflowdof+2:ghosted_id*option%nflowdof)
867) case(NEUMANN_BC,ZERO_GRADIENT_BC)
868) xxbc(:) = xx_loc_p((ghosted_id-1)*option%nflowdof+1:ghosted_id*option%nflowdof)
869) end select
870) enddo
871)
872) call Flash2AuxVarCompute_NINC(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0), &
873) global_auxvars_bc(sum_connection), &
874) patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr, &
875) realization%fluid_properties, option, xphi)
876)
877) if (associated(global_auxvars_bc)) then
878) global_auxvars_bc(sum_connection)%pres(:)= auxvars_bc(sum_connection)%auxvar_elem(0)%pres -&
879) auxvars(ghosted_id)%auxvar_elem(0)%pc(:)
880) global_auxvars_bc(sum_connection)%temp=auxvars_bc(sum_connection)%auxvar_elem(0)%temp
881) global_auxvars_bc(sum_connection)%sat(:)=auxvars_bc(sum_connection)%auxvar_elem(0)%sat(:)
882) ! global_auxvars(ghosted_id)%sat_store =
883) global_auxvars_bc(sum_connection)%fugacoeff(1)=xphi
884) global_auxvars_bc(sum_connection)%den(:)=auxvars_bc(sum_connection)%auxvar_elem(0)%den(:)
885) global_auxvars_bc(sum_connection)%den_kg = auxvars_bc(sum_connection)%auxvar_elem(0)%den(:) &
886) * auxvars_bc(sum_connection)%auxvar_elem(0)%avgmw(:)
887) mnacl= global_auxvars_bc(sum_connection)%m_nacl(1)
888) if (global_auxvars_bc(sum_connection)%m_nacl(2)>mnacl) mnacl= global_auxvars_bc(sum_connection)%m_nacl(2)
889) ynacl = mnacl/(1.d3/FMWH2O + mnacl)
890) global_auxvars_bc(sum_connection)%xmass(1) = (1.d0-ynacl)&
891) *auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(1) * FMWH2O&
892) /((1.d0-ynacl)*auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(1) * FMWH2O &
893) +auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(2) * FMWCO2 &
894) +ynacl*auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(1)*FMWNACL)
895) global_auxvars_bc(sum_connection)%xmass(2) = auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(3) * FMWH2O&
896) /(auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(3) * FMWH2O&
897) +auxvars_bc(sum_connection)%auxvar_elem(0)%xmol(4) * FMWCO2)
898)
899)
900) ! global_auxvars(ghosted_id)%den_kg_store
901) endif
902) enddo
903) boundary_condition => boundary_condition%next
904) enddo
905)
906) call VecRestoreArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
907) call VecRestoreArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
908)
909) patch%aux%Flash2%auxvars_up_to_date = PETSC_TRUE
910)
911) end subroutine Flash2UpdateAuxVarsPatch
912)
913) ! ************************************************************************** !
914)
915) subroutine Flash2InitializeTimestep(realization)
916) !
917) ! Update data in module prior to time step
918) !
919) ! Author: Chuan Lu
920) ! Date: 10/12/08
921) !
922)
923) use Realization_Subsurface_class
924)
925) implicit none
926)
927) type(realization_subsurface_type) :: realization
928)
929) call Flash2UpdateFixedAccumulation(realization)
930)
931) end subroutine Flash2InitializeTimestep
932)
933) ! ************************************************************************** !
934)
935) subroutine Flash2UpdateSolution(realization)
936) !
937) ! Updates data in module after a successful time step
938) !
939) ! Author: Chuan Lu
940) ! Date: 10/13/08
941) !
942)
943) use Realization_Subsurface_class
944)
945) implicit none
946)
947) type(realization_subsurface_type) :: realization
948)
949) PetscErrorCode :: ierr
950)
951) ! make room for hysteric s-Pc-kr
952)
953) if (realization%option%compute_mass_balance_new) then
954) call Flash2UpdateMassBalancePatch(realization)
955) endif
956)
957) end subroutine Flash2UpdateSolution
958)
959) ! ************************************************************************** !
960)
961) subroutine Flash2UpdateFixedAccumulation(realization)
962) !
963) ! Updates the fixed portion of the
964) ! accumulation term
965) !
966) ! Author: Chuan Lu
967) ! Date: 10/12/08
968) !
969)
970) use Realization_Subsurface_class
971) use Patch_module
972)
973) type(realization_subsurface_type) :: realization
974)
975) type(patch_type), pointer :: cur_patch
976)
977) cur_patch => realization%patch_list%first
978) do
979) if (.not.associated(cur_patch)) exit
980) realization%patch => cur_patch
981) call Flash2UpdateFixedAccumPatch(realization)
982) cur_patch => cur_patch%next
983) enddo
984)
985) end subroutine Flash2UpdateFixedAccumulation
986)
987) ! ************************************************************************** !
988)
989) subroutine Flash2UpdateFixedAccumPatch(realization)
990) !
991) ! Updates the fixed portion of the
992) ! accumulation term
993) !
994) ! Author: Chuan Lu
995) ! Date: 10/12/08
996) !
997)
998) use Realization_Subsurface_class
999) use Patch_module
1000) use Option_module
1001) use Field_module
1002) use Grid_module
1003) use Material_Aux_class
1004)
1005) implicit none
1006)
1007) type(realization_subsurface_type) :: realization
1008)
1009) type(option_type), pointer :: option
1010) type(patch_type), pointer :: patch
1011) type(grid_type), pointer :: grid
1012) type(field_type), pointer :: field
1013) type(Flash2_parameter_type), pointer :: Flash2_parameter
1014) type(Flash2_auxvar_type), pointer :: auxvars(:)
1015) type(global_auxvar_type), pointer :: global_auxvars(:)
1016) class(material_auxvar_type), pointer :: material_auxvars(:)
1017)
1018) PetscInt :: ghosted_id, local_id, istart, iend, iphase
1019) PetscReal, pointer :: xx_p(:), icap_loc_p(:), iphase_loc_p(:)
1020) PetscReal, pointer :: ithrm_loc_p(:), accum_p(:)
1021)
1022) PetscErrorCode :: ierr
1023)
1024) call Flash2UpdateAuxVarsPatch(realization)
1025) option => realization%option
1026) field => realization%field
1027) patch => realization%patch
1028) grid => patch%grid
1029)
1030) global_auxvars => patch%aux%Global%auxvars
1031) Flash2_parameter => patch%aux%Flash2%Flash2_parameter
1032) auxvars => patch%aux%Flash2%auxvars
1033) material_auxvars => patch%aux%Material%auxvars
1034)
1035) call VecGetArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
1036) call VecGetArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
1037) call VecGetArrayF90(field%ithrm_loc,ithrm_loc_p,ierr);CHKERRQ(ierr)
1038)
1039) call VecGetArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
1040)
1041) do local_id = 1, grid%nlmax
1042) ghosted_id = grid%nL2G(local_id)
1043) !geh - Ignore inactive cells with inactive materials
1044) if (associated(patch%imat)) then
1045) if (patch%imat(ghosted_id) <= 0) cycle
1046) endif
1047) iend = local_id*option%nflowdof
1048) istart = iend-option%nflowdof+1
1049)
1050) call Flash2Accumulation(auxvars(ghosted_id)%auxvar_elem(0), &
1051) global_auxvars(ghosted_id), &
1052) material_auxvars(ghosted_id)%porosity, &
1053) material_auxvars(ghosted_id)%volume, &
1054) Flash2_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
1055) option,ZERO_INTEGER, accum_p(istart:iend))
1056) enddo
1057)
1058) call VecRestoreArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
1059) call VecRestoreArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
1060) call VecRestoreArrayF90(field%ithrm_loc,ithrm_loc_p,ierr);CHKERRQ(ierr)
1061)
1062) call VecRestoreArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
1063)
1064) #if 0
1065) ! call Flash2NumericalJacobianTest(field%flow_xx,realization)
1066) #endif
1067)
1068) end subroutine Flash2UpdateFixedAccumPatch
1069)
1070) ! ************************************************************************** !
1071)
1072) subroutine Flash2Accumulation(auxvar,global_auxvar,por,vol,rock_dencpr,option,iireac,Res)
1073) !
1074) ! Computes the non-fixed portion of the accumulation
1075) ! term for the residual
1076) !
1077) ! Author: Chuan Lu
1078) ! Date: 10/12/08
1079) !
1080)
1081) use Option_module
1082)
1083) implicit none
1084)
1085) type(Flash2_auxvar_elem_type) :: auxvar
1086) type(option_type) :: option
1087) type(global_auxvar_type) :: global_auxvar
1088) PetscReal Res(1:option%nflowdof)
1089) PetscReal vol,por,rock_dencpr
1090)
1091) PetscInt :: ispec, np, iireac
1092) PetscReal :: porXvol, mol(option%nflowspec), eng
1093)
1094) ! if (present(ireac)) iireac=ireac
1095)
1096) porXvol = por*vol
1097) mol=0.d0; eng=0.d0
1098) do np = 1, option%nphase
1099) do ispec = 1, option%nflowspec
1100) mol(ispec) = mol(ispec) + auxvar%sat(np) * &
1101) auxvar%den(np) * &
1102) auxvar%xmol(ispec + (np-1)*option%nflowspec)
1103) enddo
1104) ! if (option%use_isothermal == PETSC_FALSE) &
1105) eng = eng + auxvar%sat(np) * auxvar%den(np) * auxvar%u(np)
1106) enddo
1107) mol = mol * porXvol
1108) ! if (option%use_isothermal == PETSC_FALSE) &
1109) eng = eng * porXvol + (1.d0 - por)* vol * rock_dencpr * auxvar%temp
1110)
1111) ! Reaction terms here
1112) ! Note if iireac > 0, then it is the node global index
1113) if (option%ntrandof > 0) then
1114) if (iireac > 0) then
1115) ! H2O
1116) mol(1) = mol(1) + vol * global_auxvar%reaction_rate_store(1) &
1117) *option%flow_dt*1.D-3
1118) ! CO2
1119) mol(2) = mol(2) + vol * global_auxvar%reaction_rate_store(2) &
1120) *option%flow_dt*1.D-3
1121) endif
1122) endif
1123) ! if (option%use_isothermal) then
1124) ! Res(1:option%nflowdof) = mol(:)
1125) ! else
1126) Res(1:option%nflowdof-1) = mol(:)
1127) Res(option%nflowdof) = eng
1128) ! endif
1129) end subroutine Flash2Accumulation
1130)
1131) ! ************************************************************************** !
1132)
1133) subroutine Flash2SourceSink(mmsrc,nsrcpara,psrc,tsrc,hsrc,csrc,auxvar,isrctype,Res,&
1134) qsrc_phase,energy_flag, option)
1135) !
1136) ! Flash2Accumulation: Computes the non-fixed portion of the accumulation
1137) ! term for the residual
1138) !
1139) ! Author: Chuan Lu
1140) ! Date: 10/12/08
1141) !
1142)
1143) use Option_module
1144)
1145) use EOS_Water_module
1146) ! use Gas_EOS_module
1147) use co2eos_module
1148) use co2_span_wagner_spline_module, only: sw_prop
1149) use co2_sw_module, only: co2_sw_interp
1150) use co2_span_wagner_module
1151)
1152) implicit none
1153)
1154) type(Flash2_auxvar_elem_type) :: auxvar
1155) type(option_type) :: option
1156) PetscReal Res(1:option%nflowdof)
1157) PetscReal, pointer :: mmsrc(:)
1158) PetscReal psrc(option%nphase),tsrc,hsrc, csrc
1159) PetscInt isrctype, nsrcpara
1160) PetscBool :: energy_flag
1161) PetscReal :: qsrc_phase(:)
1162)
1163) PetscReal, pointer :: msrc(:)
1164) PetscReal dw_kg, dw_mol,dddt,dddp
1165) PetscReal :: enth_src_h2o, enth_src_co2
1166) PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
1167) PetscReal :: ukvr, v_darcy, dq, dphi
1168) PetscReal :: well_status, well_diameter
1169) PetscReal :: pressure_bh, well_factor, pressure_max, pressure_min
1170) PetscReal :: well_inj_water, well_inj_co2
1171) PetscInt :: np
1172) PetscInt :: iflag
1173) PetscErrorCode :: ierr
1174)
1175) Res=0D0
1176) allocate(msrc(nsrcpara))
1177) msrc = mmsrc(1:nsrcpara)
1178) qsrc_phase = 0.d0
1179) ! if (present(ireac)) iireac=ireac
1180) ! if (energy_flag) then
1181) ! Res(option%nflowdof) = Res(option%nflowdof) + hsrc * option%flow_dt
1182) ! endif
1183)
1184) select case(isrctype)
1185) case(MASS_RATE_SS)
1186) msrc(1) = msrc(1) / FMWH2O
1187) msrc(2) = msrc(2) / FMWCO2
1188) if (msrc(1) /= 0.d0) then ! H2O injection
1189) call EOSWaterDensity(tsrc,auxvar%pres,dw_kg,dw_mol,ierr)
1190) call EOSWaterEnthalpy(tsrc,auxvar%pres,enth_src_h2o,ierr)
1191) enth_src_h2o = enth_src_h2o*option%scale ! J/kmol -> whatever units
1192)
1193) ! units: dw_mol [mol/dm^3]; dw_kg [kg/m^3]
1194) ! qqsrc = qsrc1/dw_mol ! [kmol/s (mol/dm^3 = kmol/m^3)]
1195) Res(jh2o) = Res(jh2o) + msrc(1)*(1.d0-csrc)*option%flow_dt
1196) Res(jco2) = Res(jco2) + msrc(1)*csrc*option%flow_dt
1197) if (energy_flag) &
1198) Res(option%nflowdof) = Res(option%nflowdof) + msrc(1)*enth_src_h2o*option%flow_dt
1199) qsrc_phase(1) = msrc(1)/dw_mol
1200)
1201) endif
1202)
1203) if (msrc(2) > 0.d0) then ! CO2 injection
1204) ! call printErrMsg(option,"concentration source not yet implemented in Flash2")
1205) if (option%co2eos == EOS_SPAN_WAGNER) then
1206) ! span-wagner
1207) rho = auxvar%den(jco2)*FMWCO2
1208) select case(option%itable)
1209) case(0,1,2,4,5)
1210) if (option%itable >= 4) then
1211) call co2_sw_interp(auxvar%pres*1.D-6,&
1212) tsrc,rho,dddt,dddp,fg,dfgdp,dfgdt, &
1213) eng,enth_src_co2,dhdt,dhdp,visc,dvdt,dvdp,option%itable)
1214) else
1215) iflag = 1
1216) call co2_span_wagner(auxvar%pres*1.D-6,&
1217) tsrc+273.15D0,rho,dddt,dddp,fg,dfgdp,dfgdt, &
1218) eng,enth_src_co2,dhdt,dhdp,visc,dvdt,dvdp,iflag,option%itable)
1219) endif
1220) case(3)
1221) call sw_prop(tsrc,auxvar%pres*1.D-6,rho, &
1222) enth_src_co2, eng, fg)
1223) end select
1224)
1225) ! units: rho [kg/m^3]; csrc1 [kmol/s]
1226) enth_src_co2 = enth_src_co2 * FMWCO2
1227) qsrc_phase(2) = msrc(2)/auxvar%den(jco2)
1228)
1229) else if (option%co2eos == EOS_MRK)then
1230) ! MRK eos [modified version from Kerrick and Jacobs (1981) and Weir et al. (1996).]
1231) call CO2(tsrc,auxvar%pres, rho,fg, xphi,enth_src_co2)
1232) enth_src_co2 = enth_src_co2*FMWCO2*option%scale
1233) qsrc_phase(2) = msrc(2)/auxvar%den(jco2)
1234) else
1235) call printErrMsg(option,'pflow Flash2 ERROR: Need specify CO2 EOS')
1236) endif
1237)
1238) Res(jco2) = Res(jco2) + msrc(2)*option%flow_dt
1239) if (energy_flag) &
1240) Res(option%nflowdof) = Res(option%nflowdof)+ msrc(2) * enth_src_co2 *option%flow_dt
1241) endif
1242) ! End of mass rate inplementation
1243) case(WELL_SS) ! production well
1244) !if node pessure is lower than the given extraction pressure, shut it down
1245) ! Flow term
1246) ! well parameter explaination
1247) ! 1. well status. 1 injection; -1 production; 0 shut in
1248) ! 2 rate controled injection (same as rate_ss, with max pressure control, not completed yet)
1249) ! -2 rate controled production(not implemented for now)
1250) !
1251) ! 2. well factor [m^3], the effective permeability [m^2/s]
1252) ! 3. bottomhole pressure: [Pa]
1253) ! 4. max pressure: [Pa]
1254) ! 5. min pressure: [Pa]
1255) ! 6. preferred mass flux of water [kg/s]
1256) ! 7. preferred mass flux of CO2 [kg/s]
1257) ! 8. well diameter, not used now
1258) ! 9. skin factor, not used now
1259)
1260) well_status = msrc(1)
1261) well_factor = msrc(2)
1262) pressure_bh = msrc(3)
1263) pressure_max = msrc(4)
1264) pressure_min = msrc(5)
1265) well_inj_water = msrc(6)
1266) well_inj_co2 = msrc(7)
1267)
1268) ! if (pressure_min < 0D0) pressure_min = 0D0 !not limited by pressure lower bound
1269)
1270) ! production well (well status = -1)
1271) if (dabs(well_status + 1D0) < 1D-1) then
1272) if (auxvar%pres > pressure_min) then
1273) Dq = well_factor
1274) do np = 1, option%nphase
1275) dphi = auxvar%pres - auxvar%pc(np) - pressure_bh
1276) if (dphi >= 0.D0) then ! outflow only
1277) ukvr = auxvar%kvr(np)
1278) if (ukvr < 1e-20) ukvr=0D0
1279) v_darcy = 0D0
1280) if (ukvr*Dq > floweps) then
1281) v_darcy = Dq * ukvr * dphi
1282) ! store volumetric rate for ss_fluid_fluxes()
1283) qsrc_phase(1) = -1.d0*v_darcy
1284) Res(1) = Res(1) - v_darcy* auxvar%den(np)* &
1285) auxvar%xmol((np-1)*option%nflowspec+1)*option%flow_dt
1286) Res(2) = Res(2) - v_darcy* auxvar%den(np)* &
1287) auxvar%xmol((np-1)*option%nflowspec+2)*option%flow_dt
1288) if (energy_flag) Res(3) = Res(3) - v_darcy * auxvar%den(np)* &
1289) auxvar%h(np)*option%flow_dt
1290) ! print *,'produce: ',np,v_darcy
1291) endif
1292) endif
1293) enddo
1294) endif
1295) endif
1296) !print *,'well-prod: ', auxvar%pres,psrc(1), res
1297) ! injection well (well status = 2)
1298) if (dabs(well_status - 2D0) < 1D-1) then
1299)
1300) call EOSWaterDensity(tsrc,auxvar%pres,dw_kg,dw_mol,ierr)
1301) call EOSWaterEnthalpy(tsrc,auxvar%pres,enth_src_h2o,ierr)
1302) enth_src_h2o = enth_src_h2o * option%scale ! J/kmol -> whatever units
1303) Dq = msrc(2) ! well parameter, read in input file
1304) ! Take the place of 2nd parameter
1305) ! Flow term
1306) if (auxvar%pres < pressure_max) then
1307) do np = 1, option%nphase
1308) dphi = pressure_bh - auxvar%pres + auxvar%pc(np)
1309) if (dphi >= 0.D0) then ! outflow only
1310) ukvr = auxvar%kvr(np)
1311) v_darcy=0.D0
1312) if (ukvr*Dq > floweps) then
1313) v_darcy = Dq * ukvr * dphi
1314) ! store volumetric rate for ss_fluid_fluxes()
1315) qsrc_phase(1) = v_darcy
1316) Res(1) = Res(1) + v_darcy* auxvar%den(np)* &
1317) ! auxvar%xmol((np-1)*option%nflowspec+1) * option%flow_dt
1318) (1.d0-csrc) * option%flow_dt
1319) Res(2) = Res(2) + v_darcy* auxvar%den(np)* &
1320) ! auxvar%xmol((np-1)*option%nflowspec+2) * option%flow_dt
1321) csrc * option%flow_dt
1322) ! if (energy_flag) Res(3) = Res(3) + v_darcy*auxvar%den(np)*auxvar%h(np)*option%flow_dt
1323) if (energy_flag) Res(3) = Res(3) + v_darcy*auxvar%den(np)* &
1324) enth_src_h2o*option%flow_dt
1325)
1326) ! print *,'inject: ',np,v_darcy
1327) endif
1328) endif
1329) enddo
1330) endif
1331) endif
1332) case default
1333) print *,'Unrecognized Source/Sink condition: ', isrctype
1334) end select
1335) ! deallocate(msrc)
1336)
1337) end subroutine Flash2SourceSink
1338)
1339) ! ************************************************************************** !
1340)
1341) subroutine Flash2Flux(auxvar_up,por_up,tor_up,sir_up,dd_up,perm_up,Dk_up, &
1342) auxvar_dn,por_dn,tor_dn,sir_dn,dd_dn,perm_dn,Dk_dn, &
1343) area,dist_gravity,upweight, &
1344) option,vv_darcy,Res)
1345) !
1346) ! Computes the internal flux terms for the residual
1347) !
1348) ! Author: Chuan Lu
1349) ! Date: 10/12/08
1350) !
1351) use Option_module
1352)
1353) implicit none
1354)
1355) type(Flash2_auxvar_elem_type) :: auxvar_up, auxvar_dn
1356) type(option_type) :: option
1357) PetscReal :: sir_up(:), sir_dn(:)
1358) PetscReal :: por_up, por_dn
1359) PetscReal :: tor_up, tor_dn
1360) PetscReal :: dd_up, dd_dn
1361) PetscReal :: perm_up, perm_dn
1362) PetscReal :: Dk_up, Dk_dn
1363) PetscReal :: vv_darcy(:),area
1364) PetscReal :: Res(1:option%nflowdof)
1365) PetscReal :: dist_gravity ! distance along gravity vector
1366)
1367) PetscInt :: ispec, np, ind
1368) PetscReal :: fluxm(option%nflowspec),fluxe,q, v_darcy
1369) PetscReal :: uh,uxmol(1:option%nflowspec),ukvr,difff,diffdp, DK,Dq
1370) PetscReal :: upweight,density_ave,cond,gravity,dphi
1371)
1372) Dq = (perm_up * perm_dn)/(dd_up*perm_dn + dd_dn*perm_up)
1373) diffdp = (por_up *tor_up * por_dn*tor_dn) / (dd_dn*por_up*tor_up + dd_up*por_dn*tor_dn)*area
1374)
1375) fluxm = 0.D0
1376) fluxe = 0.D0
1377) vv_darcy =0.D0
1378)
1379) ! Flow term
1380) do np = 1, option%nphase
1381) ! if (auxvar_up%sat(np) > sir_up(np) .or. auxvar_dn%sat(np) > sir_dn(np)) then
1382) if ((auxvar_up%kvr(np) + auxvar_dn%kvr(np)) > eps) then
1383) upweight= dd_dn/(dd_up+dd_dn)
1384) if (auxvar_up%sat(np) < eps) then
1385) upweight=0.d0
1386) else if (auxvar_dn%sat(np) < eps) then
1387) upweight=1.d0
1388) endif
1389) density_ave = upweight*auxvar_up%den(np) + (1.D0-upweight)*auxvar_dn%den(np)
1390)
1391) gravity = (upweight*auxvar_up%den(np) * auxvar_up%avgmw(np) + &
1392) (1.D0-upweight)*auxvar_dn%den(np) * auxvar_dn%avgmw(np)) &
1393) * dist_gravity
1394)
1395) dphi = auxvar_up%pres - auxvar_dn%pres &
1396) - auxvar_up%pc(np) + auxvar_dn%pc(np) &
1397) + gravity
1398)
1399) v_darcy = 0.D0
1400) ukvr = 0.D0
1401) uh = 0.D0
1402) uxmol = 0.D0
1403)
1404) ! note uxmol only contains one phase xmol
1405) if (dphi >= 0.D0) then
1406) ukvr = auxvar_up%kvr(np)
1407) uxmol(:)=auxvar_up%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
1408) ! if (option%use_isothermal == PETSC_FALSE)&
1409) uh = auxvar_up%h(np)
1410) else
1411) ukvr = auxvar_dn%kvr(np)
1412) uxmol(:)=auxvar_dn%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
1413) ! if (option%use_isothermal == PETSC_FALSE)&
1414) uh = auxvar_dn%h(np)
1415) endif
1416)
1417)
1418) if (ukvr>floweps) then
1419) v_darcy= Dq * ukvr * dphi
1420) vv_darcy(np) = v_darcy
1421) q = v_darcy * area
1422) do ispec = 1, option%nflowspec
1423) fluxm(ispec) = fluxm(ispec) + q * density_ave * uxmol(ispec)
1424) enddo
1425) ! if (option%use_isothermal == PETSC_FALSE) &
1426) fluxe = fluxe + q*density_ave*uh
1427) endif
1428) endif
1429)
1430) #if 1
1431) ! Diffusion term
1432) ! Note : average rule may not be correct
1433) if ((auxvar_up%sat(np) > eps) .and. (auxvar_dn%sat(np) > eps)) then
1434) difff = diffdp * 0.25D0*(auxvar_up%sat(np) + auxvar_dn%sat(np))* &
1435) (auxvar_up%den(np) + auxvar_dn%den(np))
1436) do ispec=1, option%nflowspec
1437) ind = ispec + (np-1)*option%nflowspec
1438) fluxm(ispec) = fluxm(ispec) + difff * .5D0 * &
1439) (auxvar_up%diff(ind) + auxvar_dn%diff(ind))* &
1440) (auxvar_up%xmol(ind) - auxvar_dn%xmol(ind))
1441) enddo
1442) endif
1443) #endif
1444) enddo
1445)
1446) ! conduction term
1447) !if (option%use_isothermal == PETSC_FALSE) then
1448) Dk = (Dk_up * Dk_dn) / (dd_dn*Dk_up + dd_up*Dk_dn)
1449) cond = Dk*area*(auxvar_up%temp-auxvar_dn%temp)
1450) fluxe=fluxe + cond
1451) ! end if
1452)
1453) !if (option%use_isothermal)then
1454) ! Res(1:option%nflowdof) = fluxm(:) * option%flow_dt
1455) ! else
1456) Res(1:option%nflowspec) = fluxm(:) * option%flow_dt
1457) ! if (option%use_isothermal == PETSC_FALSE)&
1458) Res(option%nflowdof) = fluxe * option%flow_dt
1459) ! end if
1460) ! note: Res is the flux contribution, for node 1 R = R + Res_FL
1461) ! 2 R = R - Res_FL
1462)
1463) end subroutine Flash2Flux
1464)
1465) ! ************************************************************************** !
1466)
1467) subroutine Flash2FluxAdv(auxvar_up,por_up,tor_up,sir_up,dd_up,perm_up,Dk_up, &
1468) auxvar_dn,por_dn,tor_dn,sir_dn,dd_dn,perm_dn,Dk_dn, &
1469) area,dist_gravity,upweight, &
1470) option,vv_darcy,Res)
1471) !
1472) ! Flash2Flux: Computes the internal flux terms for the residual
1473) !
1474) ! Author: Chuan Lu
1475) ! Date: 05/04/10
1476) !
1477) use Option_module
1478)
1479) implicit none
1480)
1481) type(Flash2_auxvar_elem_type) :: auxvar_up, auxvar_dn
1482) type(option_type) :: option
1483) PetscReal :: sir_up(:), sir_dn(:)
1484) PetscReal :: por_up, por_dn
1485) PetscReal :: tor_up, tor_dn
1486) PetscReal :: dd_up, dd_dn
1487) PetscReal :: perm_up, perm_dn
1488) PetscReal :: Dk_up, Dk_dn
1489) PetscReal :: vv_darcy(:),area
1490) PetscReal :: Res(1:option%nflowdof)
1491) PetscReal :: dist_gravity ! distance along gravity vector
1492)
1493) PetscInt :: ispec, np, ind
1494) PetscReal :: fluxm(option%nflowspec),fluxe,q, v_darcy
1495) PetscReal :: uh,uxmol(1:option%nflowspec),ukvr,difff,diffdp, DK,Dq
1496) PetscReal :: upweight,density_ave,cond,gravity,dphi
1497)
1498) Dq = (perm_up * perm_dn)/(dd_up*perm_dn + dd_dn*perm_up)
1499) ! diffdp = (por_up *tor_up * por_dn*tor_dn) / (dd_dn*por_up*tor_up + dd_up*por_dn*tor_dn)*area
1500)
1501) fluxm = 0.D0
1502) fluxe = 0.D0
1503) vv_darcy =0.D0
1504)
1505) ! Flow term
1506) do np = 1, option%nphase
1507) if (auxvar_up%sat(np) > sir_up(np) .or. auxvar_dn%sat(np) > sir_dn(np)) then
1508) upweight= dd_dn/(dd_up+dd_dn)
1509) if (auxvar_up%sat(np) <eps) then
1510) upweight=0.d0
1511) else if (auxvar_dn%sat(np) <eps) then
1512) upweight=1.d0
1513) endif
1514) density_ave = upweight*auxvar_up%den(np) + (1.D0-upweight)*auxvar_dn%den(np)
1515)
1516) gravity = (upweight*auxvar_up%den(np) * auxvar_up%avgmw(np) + &
1517) (1.D0-upweight)*auxvar_dn%den(np) * auxvar_dn%avgmw(np)) &
1518) * dist_gravity
1519)
1520) dphi = auxvar_up%pres - auxvar_dn%pres &
1521) - auxvar_up%pc(np) + auxvar_dn%pc(np) &
1522) + gravity
1523)
1524) v_darcy = 0.D0
1525) ukvr=0.D0
1526) uh=0.D0
1527) uxmol=0.D0
1528)
1529) ! note uxmol only contains one phase xmol
1530) if (dphi >= 0.D0) then
1531) ukvr = auxvar_up%kvr(np)
1532) uxmol(:)=auxvar_up%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
1533) ! if (option%use_isothermal == PETSC_FALSE)&
1534) uh = auxvar_up%h(np)
1535) else
1536) ukvr = auxvar_dn%kvr(np)
1537) uxmol(:)=auxvar_dn%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
1538) ! if (option%use_isothermal == PETSC_FALSE)&
1539) uh = auxvar_dn%h(np)
1540) endif
1541)
1542)
1543) if (ukvr>floweps) then
1544) v_darcy= Dq * ukvr * dphi
1545) vv_darcy(np)=v_darcy
1546) q = v_darcy * area
1547) do ispec =1, option%nflowspec
1548) fluxm(ispec)=fluxm(ispec) + q * density_ave * uxmol(ispec)
1549) enddo
1550) ! if (option%use_isothermal == PETSC_FALSE)&
1551) fluxe = fluxe + q*density_ave*uh
1552) endif
1553) endif
1554) end do
1555)
1556) Res(1:option%nflowspec) = fluxm(:) * option%flow_dt
1557) ! if (option%use_isothermal == PETSC_FALSE)&
1558) Res(option%nflowdof) = fluxe * option%flow_dt
1559) ! end if
1560) ! note: Res is the flux contribution, for node 1 R = R + Res_FL
1561) ! 2 R = R - Res_FL
1562)
1563) end subroutine Flash2FluxAdv
1564)
1565) ! ************************************************************************** !
1566)
1567) subroutine Flash2FluxDiffusion(auxvar_up,por_up,tor_up,sir_up,dd_up,perm_up,Dk_up, &
1568) auxvar_dn,por_dn,tor_dn,sir_dn,dd_dn,perm_dn,Dk_dn, &
1569) area,dist_gravity,upweight, &
1570) option,vv_darcy,Res)
1571) !
1572) ! Flash2Flux: Computes the internal flux terms for the residual
1573) !
1574) ! Author: Chuan Lu
1575) ! Date: 10/12/08
1576) !
1577) use Option_module
1578)
1579) implicit none
1580)
1581) type(Flash2_auxvar_elem_type) :: auxvar_up, auxvar_dn
1582) type(option_type) :: option
1583) PetscReal :: sir_up(:), sir_dn(:)
1584) PetscReal :: por_up, por_dn
1585) PetscReal :: tor_up, tor_dn
1586) PetscReal :: dd_up, dd_dn
1587) PetscReal :: perm_up, perm_dn
1588) PetscReal :: Dk_up, Dk_dn
1589) PetscReal :: vv_darcy(:),area
1590) PetscReal :: Res(1:option%nflowdof)
1591) PetscReal :: dist_gravity ! distance along gravity vector
1592)
1593) PetscInt :: ispec, np, ind
1594) PetscReal :: fluxm(option%nflowspec),fluxe,q, v_darcy
1595) PetscReal :: uh,uxmol(1:option%nflowspec),ukvr,difff,diffdp, DK,Dq
1596) PetscReal :: upweight,density_ave,cond,gravity,dphi
1597)
1598)
1599) diffdp = (por_up *tor_up * por_dn*tor_dn) / (dd_dn*por_up*tor_up + dd_up*por_dn*tor_dn)*area
1600)
1601) fluxm = 0.D0
1602) fluxe = 0.D0
1603) vv_darcy =0.D0
1604)
1605) ! Flow term
1606) do np = 1, option%nphase
1607)
1608) ! Diffusion term
1609) ! Note : average rule may not be correct
1610) if ((auxvar_up%sat(np) > eps) .and. (auxvar_dn%sat(np) > eps)) then
1611) difff = diffdp * 0.25D0*(auxvar_up%sat(np) + auxvar_dn%sat(np))* &
1612) (auxvar_up%den(np) + auxvar_dn%den(np))
1613) do ispec=1, option%nflowspec
1614) ind = ispec + (np-1)*option%nflowspec
1615) fluxm(ispec) = fluxm(ispec) + difff * .5D0 * &
1616) (auxvar_up%diff(ind) + auxvar_dn%diff(ind))* &
1617) (auxvar_up%xmol(ind) - auxvar_dn%xmol(ind))
1618) enddo
1619) endif
1620) enddo
1621)
1622) ! conduction term
1623) !if (option%use_isothermal == PETSC_FALSE) then
1624) Dk = (Dk_up * Dk_dn) / (dd_dn*Dk_up + dd_up*Dk_dn)
1625) cond = Dk*area*(auxvar_up%temp-auxvar_dn%temp)
1626) fluxe=fluxe + cond
1627) ! end if
1628)
1629) !if (option%use_isothermal)then
1630) ! Res(1:option%nflowdof) = fluxm(:) * option%flow_dt
1631) ! else
1632) Res(1:option%nflowspec) = fluxm(:) * option%flow_dt
1633) ! if (option%use_isothermal)
1634) Res(option%nflowdof) = fluxe * option%flow_dt
1635) ! end if
1636) ! note: Res is the flux contribution, for node 1 R = R + Res_FL
1637) ! 2 R = R - Res_FL
1638)
1639) end subroutine Flash2FluxDiffusion
1640)
1641) ! ************************************************************************** !
1642)
1643) subroutine Flash2BCFlux(ibndtype,auxvars,auxvar_up,auxvar_dn, &
1644) por_dn,tor_dn,sir_dn,dd_up,perm_dn,Dk_dn, &
1645) area,dist_gravity,option,vv_darcy,Res)
1646) !
1647) ! Computes the boundary flux terms for the residual
1648) !
1649) ! Author: Chuan Lu
1650) ! Date: 10/12/08
1651) !
1652) use Option_module
1653)
1654) implicit none
1655)
1656) PetscInt :: ibndtype(:)
1657) type(Flash2_auxvar_elem_type) :: auxvar_up, auxvar_dn
1658) type(option_type) :: option
1659) PetscReal :: dd_up, sir_dn(:)
1660) PetscReal :: auxvars(:) ! from aux_real_var array
1661) PetscReal :: por_dn,perm_dn,Dk_dn,tor_dn
1662) PetscReal :: vv_darcy(:), area
1663) PetscReal :: Res(1:option%nflowdof)
1664)
1665) PetscReal :: dist_gravity ! distance along gravity vector
1666)
1667) PetscInt :: ispec, np
1668) PetscReal :: fluxm(option%nflowspec),fluxe,q,density_ave, v_darcy
1669) PetscReal :: uh,uxmol(1:option%nflowspec),ukvr,diff,diffdp,DK,Dq
1670) PetscReal :: upweight,cond,gravity,dphi
1671)
1672) fluxm = 0.d0
1673) fluxe = 0.d0
1674) v_darcy = 0.d0
1675) density_ave = 0.d0
1676) q = 0.d0
1677)
1678) ! Flow
1679) diffdp = por_dn*tor_dn/dd_up*area
1680) do np = 1, option%nphase
1681) select case(ibndtype(1))
1682) ! figure out the direction of flow
1683) case(DIRICHLET_BC,HYDROSTATIC_BC,SEEPAGE_BC)
1684) Dq = perm_dn / dd_up
1685) ! Flow term
1686) ukvr=0.D0
1687) v_darcy=0.D0
1688) ! if (auxvar_up%sat(np) > sir_dn(np) .or. auxvar_dn%sat(np) > sir_dn(np)) then
1689) if ((auxvar_up%kvr(np) + auxvar_dn%kvr(np)) > eps) then
1690) upweight=1.D0
1691) if (auxvar_up%sat(np) < eps) then
1692) upweight=0.d0
1693) else if (auxvar_dn%sat(np) < eps) then
1694) upweight=1.d0
1695) endif
1696) density_ave = upweight*auxvar_up%den(np) + (1.D0-upweight)*auxvar_dn%den(np)
1697) ! print *,'flbc den:', upweight, auxvar_up%den(np), auxvar_dn%den(np)
1698) gravity = (upweight*auxvar_up%den(np) * auxvar_up%avgmw(np) + &
1699) (1.D0-upweight)*auxvar_dn%den(np) * auxvar_dn%avgmw(np)) &
1700) * dist_gravity
1701)
1702) dphi = auxvar_up%pres - auxvar_dn%pres &
1703) - auxvar_up%pc(np) + auxvar_dn%pc(np) &
1704) + gravity
1705)
1706) if (dphi >= 0.D0) then
1707) ukvr = auxvar_up%kvr(np)
1708) else
1709) ukvr = auxvar_dn%kvr(np)
1710) endif
1711)
1712) if (ukvr*Dq>floweps) then
1713) v_darcy = Dq * ukvr * dphi
1714) endif
1715) endif
1716)
1717) case(NEUMANN_BC) !may not work
1718) v_darcy = 0.D0
1719) if (dabs(auxvars(1)) > floweps) then
1720) v_darcy = auxvars(MPH_PRESSURE_DOF)
1721) if (v_darcy > 0.d0) then
1722) density_ave = auxvar_up%den(np)
1723) else
1724) density_ave = auxvar_dn%den(np)
1725) endif
1726) endif
1727)
1728) end select
1729)
1730) q = v_darcy * area
1731) vv_darcy(np) = v_darcy
1732) uh=0.D0
1733) uxmol=0.D0
1734)
1735) if (v_darcy >= 0.D0) then
1736) !if (option%use_isothermal == PETSC_FALSE)&
1737) uh = auxvar_up%h(np)
1738) uxmol(:)=auxvar_up%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
1739) else
1740) !if (option%use_isothermal == PETSC_FALSE)&
1741) uh = auxvar_dn%h(np)
1742) uxmol(:)=auxvar_dn%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
1743) endif
1744) do ispec=1, option%nflowspec
1745) fluxm(ispec) = fluxm(ispec) + q*density_ave * uxmol(ispec)
1746) end do
1747) !if (option%use_isothermal == PETSC_FALSE) &
1748) fluxe = fluxe + q*density_ave*uh
1749) ! print *,'FLBC', ibndtype(1),np, ukvr, v_darcy, uh, uxmol, density_ave
1750) enddo
1751)
1752) #if 1
1753) ! Diffusion term
1754) select case(ibndtype(3))
1755) case(DIRICHLET_BC)
1756) !if (auxvar_up%sat > eps .and. auxvar_dn%sat > eps) then
1757) ! diff = diffdp * 0.25D0*(auxvar_up%sat+auxvar_dn%sat)* &
1758) ! (auxvar_up%den+auxvar_dn%den)
1759) do np = 1, option%nphase
1760) if (auxvar_up%sat(np)>eps .and. auxvar_dn%sat(np)>eps) then
1761) diff = diffdp * 0.25D0*(auxvar_up%sat(np)+auxvar_dn%sat(np))* &
1762) (auxvar_up%den(np)+auxvar_up%den(np))
1763) do ispec = 1, option%nflowspec
1764) fluxm(ispec) = fluxm(ispec) + diff * &
1765) auxvar_dn%diff((np-1)* option%nflowspec+ispec)* &
1766) (auxvar_up%xmol((np-1)* option%nflowspec+ispec) &
1767) -auxvar_dn%xmol((np-1)* option%nflowspec+ispec))
1768) enddo
1769) endif
1770) enddo
1771) end select
1772) #endif
1773) ! Conduction term
1774) ! if (option%use_isothermal == PETSC_FALSE) then
1775) select case(ibndtype(2))
1776) case(DIRICHLET_BC)
1777) Dk = Dk_dn / dd_up
1778) cond = Dk*area*(auxvar_up%temp - auxvar_dn%temp)
1779) fluxe = fluxe + cond
1780) case(NEUMANN_BC)
1781) fluxe = fluxe + auxvars(2)*area*option%scale
1782) case(ZERO_GRADIENT_BC)
1783) ! No change in fluxe
1784) end select
1785) ! end if
1786)
1787) Res(1:option%nflowspec)=fluxm(:)* option%flow_dt
1788) Res(option%nflowdof)=fluxe * option%flow_dt
1789)
1790) end subroutine Flash2BCFlux
1791)
1792) ! ************************************************************************** !
1793)
1794) subroutine Flash2BCFluxAdv(ibndtype,auxvars,auxvar_up,auxvar_dn, &
1795) por_dn,tor_dn,sir_dn,dd_up,perm_dn,Dk_dn, &
1796) area,dist_gravity,option,vv_darcy,Res)
1797) !
1798) ! Computes the boundary flux terms for the residual
1799) !
1800) ! Author: Chuan Lu
1801) ! Date: 10/12/08
1802) !
1803) use Option_module
1804)
1805) implicit none
1806)
1807) PetscInt :: ibndtype(:)
1808) type(Flash2_auxvar_elem_type) :: auxvar_up, auxvar_dn
1809) type(option_type) :: option
1810) PetscReal :: dd_up, sir_dn(:)
1811) PetscReal :: auxvars(:) ! from aux_real_var array
1812) PetscReal :: por_dn,perm_dn,Dk_dn,tor_dn
1813) PetscReal :: vv_darcy(:), area
1814) PetscReal :: Res(1:option%nflowdof)
1815)
1816) PetscReal :: dist_gravity ! distance along gravity vector
1817)
1818) PetscInt :: ispec, np
1819) PetscReal :: fluxm(option%nflowspec),fluxe,q,density_ave, v_darcy
1820) PetscReal :: uh,uxmol(1:option%nflowspec),ukvr,diff,diffdp,DK,Dq
1821) PetscReal :: upweight,cond,gravity,dphi
1822)
1823) fluxm = 0.d0
1824) fluxe = 0.d0
1825) v_darcy = 0.d0
1826) density_ave = 0.d0
1827) q = 0.d0
1828)
1829) ! Flow
1830) ! diffdp = por_dn*tor_dn/dd_up*area
1831) do np = 1, option%nphase
1832) select case(ibndtype(1))
1833) ! figure out the direction of flow
1834) case(DIRICHLET_BC,HYDROSTATIC_BC,SEEPAGE_BC)
1835) Dq = perm_dn / dd_up
1836) ! Flow term
1837) ukvr = 0.D0
1838) v_darcy = 0.D0
1839) if (auxvar_up%sat(np) > sir_dn(np) .or. auxvar_dn%sat(np) > sir_dn(np)) then
1840) upweight = 1.D0
1841) if (auxvar_up%sat(np) < eps) then
1842) upweight = 0.d0
1843) else if (auxvar_dn%sat(np) < eps) then
1844) upweight = 1.d0
1845) endif
1846) density_ave = upweight*auxvar_up%den(np) + (1.D0-upweight)*auxvar_dn%den(np)
1847)
1848) gravity = (upweight*auxvar_up%den(np) * auxvar_up%avgmw(np) + &
1849) (1.D0-upweight)*auxvar_dn%den(np) * auxvar_dn%avgmw(np)) &
1850) * dist_gravity
1851)
1852) dphi = auxvar_up%pres - auxvar_dn%pres &
1853) - auxvar_up%pc(np) + auxvar_dn%pc(np) &
1854) + gravity
1855)
1856) if (dphi >= 0.D0) then
1857) ukvr = auxvar_up%kvr(np)
1858) else
1859) ukvr = auxvar_dn%kvr(np)
1860) endif
1861)
1862) if (ukvr*Dq > floweps) then
1863) v_darcy = Dq * ukvr * dphi
1864) endif
1865) endif
1866)
1867) case(NEUMANN_BC)
1868) v_darcy = 0.D0
1869) if (dabs(auxvars(1)) > floweps) then
1870) v_darcy = auxvars(MPH_PRESSURE_DOF)
1871) if (v_darcy > 0.d0) then
1872) density_ave = auxvar_up%den(np)
1873) else
1874) density_ave = auxvar_dn%den(np)
1875) endif
1876) endif
1877)
1878) end select
1879)
1880) q = v_darcy * area
1881) vv_darcy(np) = v_darcy
1882) uh=0.D0
1883) uxmol=0.D0
1884)
1885) if (v_darcy >= 0.D0) then
1886) !if (option%use_isothermal == PETSC_FALSE)&
1887) uh = auxvar_up%h(np)
1888) uxmol(:)=auxvar_up%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
1889) else
1890) !if (option%use_isothermal == PETSC_FALSE)&
1891) uh = auxvar_dn%h(np)
1892) uxmol(:)=auxvar_dn%xmol((np-1)*option%nflowspec+1 : np * option%nflowspec)
1893) endif
1894) do ispec=1, option%nflowspec
1895) fluxm(ispec) = fluxm(ispec) + q*density_ave * uxmol(ispec)
1896) end do
1897)
1898) !if (option%use_isothermal == PETSC_FALSE) &
1899) fluxe = fluxe + q*density_ave*uh
1900) !print *,'FLBC', ibndtype(1),np, ukvr, v_darcy, uh, uxmol
1901) enddo
1902)
1903) Res(1:option%nflowspec)=fluxm(:)* option%flow_dt
1904) Res(option%nflowdof)=fluxe * option%flow_dt
1905)
1906) end subroutine Flash2BCFluxAdv
1907)
1908) ! ************************************************************************** !
1909)
1910) subroutine Flash2BCFluxDiffusion(ibndtype,auxvars,auxvar_up,auxvar_dn, &
1911) por_dn,tor_dn,sir_dn,dd_up,perm_dn,Dk_dn, &
1912) area,dist_gravity,option,vv_darcy,Res)
1913) !
1914) ! Computes the boundary flux terms for the residual
1915) !
1916) ! Author: Chuan Lu
1917) ! Date: 10/12/08
1918) !
1919) use Option_module
1920)
1921) implicit none
1922)
1923) PetscInt :: ibndtype(:)
1924) type(Flash2_auxvar_elem_type) :: auxvar_up, auxvar_dn
1925) type(option_type) :: option
1926) PetscReal :: dd_up, sir_dn(:)
1927) PetscReal :: auxvars(:) ! from aux_real_var array
1928) PetscReal :: por_dn,perm_dn,Dk_dn,tor_dn
1929) PetscReal :: vv_darcy(:), area
1930) PetscReal :: Res(1:option%nflowdof)
1931)
1932) PetscReal :: dist_gravity ! distance along gravity vector
1933)
1934) PetscInt :: ispec, np
1935) PetscReal :: fluxm(option%nflowspec),fluxe,q,density_ave, v_darcy
1936) PetscReal :: uh,uxmol(1:option%nflowspec),ukvr,diff,diffdp,DK,Dq
1937) PetscReal :: upweight,cond,gravity,dphi
1938)
1939) fluxm = 0.d0
1940) fluxe = 0.d0
1941) v_darcy = 0.d0
1942) density_ave = 0.d0
1943) q = 0.d0
1944)
1945) ! Diffusion term
1946) diffdp = por_dn*tor_dn/dd_up*area
1947) select case(ibndtype(3))
1948) case(DIRICHLET_BC)
1949) ! if (auxvar_up%sat > eps .and. auxvar_dn%sat > eps) then
1950) ! diff = diffdp * 0.25D0*(auxvar_up%sat+auxvar_dn%sat)*(auxvar_up%den+auxvar_dn%den)
1951) do np = 1, option%nphase
1952) if (auxvar_up%sat(np)>eps .and. auxvar_dn%sat(np) > eps) then
1953) diff =diffdp * 0.25D0*(auxvar_up%sat(np)+auxvar_dn%sat(np))*&
1954) (auxvar_up%den(np)+auxvar_up%den(np))
1955) do ispec = 1, option%nflowspec
1956) fluxm(ispec) = fluxm(ispec) + diff * auxvar_dn%diff((np-1)* option%nflowspec+ispec)* &
1957) (auxvar_up%xmol((np-1)* option%nflowspec+ispec) &
1958) -auxvar_dn%xmol((np-1)* option%nflowspec+ispec))
1959) enddo
1960) endif
1961) enddo
1962)
1963) end select
1964) ! Conduction term
1965) ! if (option%use_isothermal == PETSC_FALSE) then
1966) select case(ibndtype(2))
1967) case(DIRICHLET_BC, 4)
1968) Dk = Dk_dn / dd_up
1969) cond = Dk*area*(auxvar_up%temp - auxvar_dn%temp)
1970) fluxe = fluxe + cond
1971) end select
1972) ! end if
1973)
1974) Res(1:option%nflowspec)=fluxm(:)* option%flow_dt
1975) Res(option%nflowdof)=fluxe * option%flow_dt
1976)
1977) end subroutine Flash2BCFluxDiffusion
1978)
1979) ! ************************************************************************** !
1980)
1981) subroutine Flash2Residual(snes,xx,r,realization,ierr)
1982) !
1983) ! Computes the residual equation
1984) !
1985) ! Author: Chuan Lu
1986) ! Date: 10/10/08
1987) !
1988)
1989) use Realization_Subsurface_class
1990) use Patch_module
1991) use Discretization_module
1992) use Field_module
1993) use Option_module
1994) use Grid_module
1995) use Logging_module
1996) use Material_module
1997) use Variables_module, only : PERMEABILITY_X, PERMEABILITY_Y, PERMEABILITY_Z
1998) use Debug_module
1999)
2000) implicit none
2001)
2002) SNES :: snes
2003) Vec :: xx
2004) Vec :: r
2005) type(realization_subsurface_type) :: realization
2006) PetscViewer :: viewer
2007) PetscErrorCode :: ierr
2008)
2009) type(discretization_type), pointer :: discretization
2010) type(option_type), pointer :: option
2011) type(grid_type), pointer :: grid
2012) type(field_type), pointer :: field
2013) type(patch_type), pointer :: patch
2014) PetscInt :: ichange
2015) character(len=MAXSTRINGLENGTH) :: string
2016)
2017) field => realization%field
2018) grid => realization%patch%grid
2019) option => realization%option
2020) discretization => realization%discretization
2021) patch => realization%patch
2022)
2023) call PetscLogEventBegin(logging%event_r_residual,ierr);CHKERRQ(ierr)
2024)
2025) call DiscretizationGlobalToLocal(discretization,xx,field%flow_xx_loc,NFLOWDOF)
2026)
2027) ! check initial guess -----------------------------------------------
2028) ierr = Flash2InitGuessCheck(realization)
2029) if (ierr<0)then
2030) !ierr = PETSC_ERR_ARG_OUTOFRANGE
2031) if (option%myrank==0) print *,'table out of range: ',ierr
2032) call SNESSetFunctionDomainError(snes,ierr);CHKERRQ(ierr)
2033) return
2034) endif
2035) ! end check ---------------------------------------------------------
2036)
2037) ! Communication -----------------------------------------
2038) ! These 3 must be called before Flash2UpdateAuxVars()
2039) ! call DiscretizationGlobalToLocal(discretization,xx,field%flow_xx_loc,NFLOWDOF)
2040) call DiscretizationLocalToLocal(discretization,field%icap_loc,field%icap_loc,ONEDOF)
2041)
2042) call MaterialGetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
2043) PERMEABILITY_X,ZERO_INTEGER)
2044) call DiscretizationLocalToLocal(discretization,field%work_loc, &
2045) field%work_loc,ONEDOF)
2046) call MaterialSetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
2047) PERMEABILITY_X,ZERO_INTEGER)
2048) call MaterialGetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
2049) PERMEABILITY_Y,ZERO_INTEGER)
2050) call DiscretizationLocalToLocal(discretization,field%work_loc, &
2051) field%work_loc,ONEDOF)
2052) call MaterialSetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
2053) PERMEABILITY_Y,ZERO_INTEGER)
2054) call MaterialGetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
2055) PERMEABILITY_Z,ZERO_INTEGER)
2056) call DiscretizationLocalToLocal(discretization,field%work_loc, &
2057) field%work_loc,ONEDOF)
2058) call MaterialSetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
2059) PERMEABILITY_Z,ZERO_INTEGER)
2060)
2061) call DiscretizationLocalToLocal(discretization,field%ithrm_loc,field%ithrm_loc,ONEDOF)
2062)
2063) ! pass #0 prepare numerical increment
2064) call Flash2ResidualPatch0(snes,xx,r,realization,ierr)
2065)
2066) ! pass #1 internal and boundary flux terms
2067) call Flash2ResidualPatch1(snes,xx,r,realization,ierr)
2068)
2069) ! pass #2 for everything else
2070) call Flash2ResidualPatch2(snes,xx,r,realization,ierr)
2071)
2072) if (realization%debug%vecview_residual) then
2073) string = 'Fresidual'
2074) call DebugCreateViewer(realization%debug,string,option,viewer)
2075) call VecView(r,viewer,ierr);CHKERRQ(ierr)
2076) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2077) endif
2078) if (realization%debug%vecview_solution) then
2079) string = 'Fxx'
2080) call DebugCreateViewer(realization%debug,string,option,viewer)
2081) call VecView(xx,viewer,ierr);CHKERRQ(ierr)
2082) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2083) endif
2084)
2085) call PetscLogEventEnd(logging%event_r_residual,ierr);CHKERRQ(ierr)
2086)
2087) end subroutine Flash2Residual
2088)
2089) ! ************************************************************************** !
2090)
2091) subroutine Flash2ResidualPatch(snes,xx,r,realization,ierr)
2092) !
2093) ! Computes the residual equation at patch level
2094) ! original version (not used)
2095) !
2096) ! Author: Chuan Lu
2097) ! Date: 10/10/08
2098) !
2099)
2100) use Connection_module
2101) use Realization_Subsurface_class
2102) use Patch_module
2103) use Grid_module
2104) use Option_module
2105) use Coupler_module
2106) use Field_module
2107) use Debug_module
2108) use Material_Aux_class
2109)
2110) implicit none
2111)
2112) SNES, intent(in) :: snes
2113) Vec, intent(inout) :: xx
2114) Vec, intent(out) :: r
2115) type(realization_subsurface_type) :: realization
2116)
2117) PetscErrorCode :: ierr
2118) PetscInt :: i, jn
2119) PetscInt :: ip1, ip2
2120) PetscInt :: local_id, ghosted_id, local_id_up, local_id_dn, ghosted_id_up, ghosted_id_dn
2121)
2122) PetscReal, pointer ::accum_p(:)
2123)
2124) PetscReal, pointer :: r_p(:), xx_loc_p(:), xx_p(:), yy_p(:)
2125)
2126)
2127) PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
2128)
2129) PetscInt :: iphase
2130) PetscInt :: icap_up, icap_dn, ithrm_up, ithrm_dn
2131) PetscReal :: dd_up, dd_dn
2132) PetscReal :: dd, f_up, f_dn, ff
2133) PetscReal :: perm_up, perm_dn
2134) PetscReal :: D_up, D_dn ! "Diffusion" constants at upstream, downstream faces.
2135) PetscReal :: dw_kg, dw_mol,dddt,dddp
2136) PetscReal :: tsrc1, qsrc1, csrc1, enth_src_h2o, enth_src_co2 , hsrc1
2137) PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
2138) PetscReal :: upweight
2139) PetscReal :: Res(realization%option%nflowdof), v_darcy(realization%option%nphase)
2140) PetscReal :: xxbc(realization%option%nflowdof)
2141) PetscReal :: psrc(1:realization%option%nphase)
2142) PetscViewer :: viewer
2143) PetscInt :: nsrcpara
2144) PetscReal, pointer :: msrc(:)
2145)
2146)
2147) type(grid_type), pointer :: grid
2148) type(patch_type), pointer :: patch
2149) type(option_type), pointer :: option
2150) type(field_type), pointer :: field
2151) type(Flash2_parameter_type), pointer :: Flash2_parameter
2152) type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
2153) type(coupler_type), pointer :: boundary_condition, source_sink
2154) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
2155) type(connection_set_list_type), pointer :: connection_set_list
2156) type(connection_set_type), pointer :: cur_connection_set
2157) class(material_auxvar_type), pointer :: material_auxvars(:)
2158) PetscBool :: enthalpy_flag
2159) PetscInt :: ng
2160) PetscInt :: iconn, idof, istart, iend
2161) PetscInt :: sum_connection
2162) PetscReal :: distance, fraction_upwind
2163) PetscReal :: distance_gravity
2164) PetscReal, pointer :: Resold_AR(:), Resold_FL(:), delx(:)
2165) PetscReal :: ss_flow_vol_flux(realization%option%nphase)
2166) character(len=MAXSTRINGLENGTH) :: string
2167)
2168) patch => realization%patch
2169) grid => patch%grid
2170) option => realization%option
2171) field => realization%field
2172)
2173) Flash2_parameter => patch%aux%Flash2%Flash2_parameter
2174) auxvars => patch%aux%Flash2%auxvars
2175) auxvars_bc => patch%aux%Flash2%auxvars_bc
2176) global_auxvars => patch%aux%Global%auxvars
2177) global_auxvars_bc => patch%aux%Global%auxvars_bc
2178) material_auxvars => patch%aux%Material%auxvars
2179)
2180) ! call Flash2UpdateAuxVarsPatchNinc(realization)
2181) ! override flags since they will soon be out of date
2182) ! patch%Flash2Aux%auxvars_up_to_date = PETSC_FALSE
2183)
2184) ! now assign access pointer to local variables
2185) call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
2186) call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
2187) call VecGetArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
2188)
2189) call VecGetArrayF90(field%flow_yy,yy_p,ierr);CHKERRQ(ierr)
2190) call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
2191) call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
2192) ! call VecGetArrayF90(field%iphas_loc, iphase_loc_p, ierr)
2193) allocate(Resold_AR(option%nflowdof), Resold_FL(option%nflowdof), delx(option%nflowdof))
2194)
2195) ! Multiphase flash calculation is more expensive, so calculate once per iteration
2196) #if 1
2197) ! Pertubations for aux terms --------------------------------
2198) do ng = 1, grid%ngmax
2199) if (grid%nG2L(ng) < 0)cycle
2200) if (associated(patch%imat)) then
2201) if (patch%imat(ng) <= 0) cycle
2202) endif
2203) ghosted_id = ng
2204) istart = (ng-1) * option%nflowdof +1 ; iend = istart -1 + option%nflowdof
2205) ! iphase =int(iphase_loc_p(ng))
2206) call Flash2AuxVarCompute_Ninc(xx_loc_p(istart:iend),auxvars(ng)%auxvar_elem(0),&
2207) global_auxvars(ng),&
2208) patch%saturation_function_array(int(icap_loc_p(ng)))%ptr,&
2209) realization%fluid_properties,option, xphi)
2210) ! print *,'flash ', xx_loc_p(istart:iend),auxvars(ng)%auxvar_elem(0)%den
2211) #if 1
2212) if (associated(global_auxvars)) then
2213) global_auxvars(ghosted_id)%pres(:)= auxvars(ghosted_id)%auxvar_elem(0)%pres -&
2214) auxvars(ghosted_id)%auxvar_elem(0)%pc(:)
2215) global_auxvars(ghosted_id)%temp=auxvars(ghosted_id)%auxvar_elem(0)%temp
2216) global_auxvars(ghosted_id)%sat(:)=auxvars(ghosted_id)%auxvar_elem(0)%sat(:)
2217) ! global_auxvars(ghosted_id)%sat_store =
2218) global_auxvars(ghosted_id)%fugacoeff(1)=xphi
2219) global_auxvars(ghosted_id)%den(:)=auxvars(ghosted_id)%auxvar_elem(0)%den(:)
2220) global_auxvars(ghosted_id)%den_kg(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:) &
2221) * auxvars(ghosted_id)%auxvar_elem(0)%avgmw(:)
2222) ! global_auxvars(ghosted_id)%reaction_rate(:)=0D0
2223) ! global_auxvars(ghosted_id)%pres(:)
2224) else
2225) print *,'Not associated global for Flash2'
2226) endif
2227) #endif
2228)
2229) if (option%flow%numerical_derivatives) then
2230) delx(1) = xx_loc_p((ng-1)*option%nflowdof+1)*dfac * 1.D-3
2231) delx(2) = xx_loc_p((ng-1)*option%nflowdof+2)*dfac
2232)
2233) if (xx_loc_p((ng-1)*option%nflowdof+3) <= 0.9) then
2234) delx(3) = dfac*xx_loc_p((ng-1)*option%nflowdof+3)*1D1
2235) else
2236) delx(3) = -dfac*xx_loc_p((ng-1)*option%nflowdof+3)*1D1
2237) endif
2238) if (delx(3) < 1D-8 .and. delx(3) >= 0.D0) delx(3) = 1D-8
2239) if (delx(3) >-1D-8 .and. delx(3) < 0.D0) delx(3) = -1D-8
2240)
2241)
2242) if ((delx(3)+xx_loc_p((ng-1)*option%nflowdof+3))>1.D0) then
2243) delx(3) = (1.D0-xx_loc_p((ng-1)*option%nflowdof+3))*1D-4
2244) endif
2245) if ((delx(3)+xx_loc_p((ng-1)*option%nflowdof+3))<0.D0) then
2246) delx(3) = xx_loc_p((ng-1)*option%nflowdof+3)*1D-4
2247) endif
2248)
2249) patch%aux%Flash2%delx(:,ng)=delx(:)
2250) call Flash2AuxVarCompute_Winc(xx_loc_p(istart:iend),delx(:),&
2251) auxvars(ng)%auxvar_elem(1:option%nflowdof),global_auxvars(ng),&
2252) patch%saturation_function_array(int(icap_loc_p(ng)))%ptr,&
2253) realization%fluid_properties,option)
2254) ! if (auxvars(ng)%auxvar_elem(option%nflowdof)%sat(2)>1D-8 .and. &
2255) ! auxvars(ng)%auxvar_elem(0)%sat(2)<1D-12)then
2256) ! print *, 'Flash winc', delx(3,ng)
2257) ! endif
2258) endif
2259) enddo
2260) #endif
2261)
2262) Resold_AR=0.D0; ResOld_FL=0.D0; r_p = 0.d0
2263) patch%aux%Flash2%Resold_AR=0.D0
2264) patch%aux%Flash2%Resold_BC=0.D0
2265) patch%aux%Flash2%ResOld_FL=0.D0
2266)
2267) #if 1
2268) ! Accumulation terms ------------------------------------
2269) r_p = - accum_p
2270)
2271) do local_id = 1, grid%nlmax ! For each local node do...
2272) ghosted_id = grid%nL2G(local_id)
2273) !geh - Ignore inactive cells with inactive materials
2274) if (associated(patch%imat)) then
2275) if (patch%imat(ghosted_id) <= 0) cycle
2276) endif
2277) iend = local_id*option%nflowdof
2278) istart = iend-option%nflowdof+1
2279) call Flash2Accumulation(auxvars(ghosted_id)%auxvar_elem(0),&
2280) global_auxvars(ghosted_id), &
2281) material_auxvars(ghosted_id)%porosity, &
2282) material_auxvars(ghosted_id)%volume, &
2283) Flash2_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
2284) option,ONE_INTEGER,Res)
2285) r_p(istart:iend) = r_p(istart:iend) + Res(1:option%nflowdof)
2286) !print *,'REs, acm: ', res
2287) patch%aux%Flash2%Resold_AR(local_id, :)= Res(1:option%nflowdof)
2288) enddo
2289) #endif
2290) #if 1
2291) ! Source/sink terms -------------------------------------
2292) source_sink => patch%source_sink_list%first
2293) sum_connection = 0
2294) do
2295) if (.not.associated(source_sink)) exit
2296) !print *, 'RES s/s begin'
2297) ! check whether enthalpy dof is included
2298) ! if (source_sink%flow_condition%num_sub_conditions > 3) then
2299) enthalpy_flag = PETSC_TRUE
2300) ! else
2301) ! enthalpy_flag = PETSC_FALSE
2302) ! endif
2303) if (associated(source_sink%flow_condition%pressure)) then
2304) psrc(:) = source_sink%flow_condition%pressure%dataset%rarray(:)
2305) endif
2306) ! qsrc1 = source_sink%flow_condition%pressure%dataset%rarray(1)
2307) tsrc1 = source_sink%flow_condition%temperature%dataset%rarray(1)
2308) csrc1 = source_sink%flow_condition%concentration%dataset%rarray(1)
2309) if (enthalpy_flag) hsrc1 = source_sink%flow_condition%enthalpy%dataset%rarray(1)
2310) ! hsrc1=0D0
2311) ! qsrc1 = qsrc1 / FMWH2O ! [kg/s -> kmol/s; fmw -> g/mol = kg/kmol]
2312) ! csrc1 = csrc1 / FMWCO2
2313) ! msrc(1)=qsrc1; msrc(2) =csrc1
2314) ! msrc(:)= psrc(:)
2315)
2316) select case(source_sink%flow_condition%itype(1))
2317) case(MASS_RATE_SS)
2318) msrc => source_sink%flow_condition%rate%dataset%rarray
2319) nsrcpara= 2
2320) case(WELL_SS)
2321) msrc => source_sink%flow_condition%well%dataset%rarray
2322) nsrcpara = 7 + option%nflowspec
2323) case default
2324) print *, 'Flash mode does not support source/sink type: ', source_sink%flow_condition%itype(1)
2325) stop
2326) end select
2327)
2328) cur_connection_set => source_sink%connection_set
2329)
2330) do iconn = 1, cur_connection_set%num_connections
2331) local_id = cur_connection_set%id_dn(iconn)
2332) ghosted_id = grid%nL2G(local_id)
2333) if (associated(patch%imat)) then
2334) if (patch%imat(ghosted_id) <= 0) cycle
2335) endif
2336) call Flash2SourceSink(msrc,nsrcpara,psrc,tsrc1,hsrc1,csrc1,auxvars(ghosted_id)%auxvar_elem(0),&
2337) source_sink%flow_condition%itype(1),Res, &
2338) ss_flow_vol_flux, &
2339) enthalpy_flag, option)
2340) if (associated(patch%ss_flow_fluxes)) then
2341) patch%ss_flow_fluxes(:,sum_connection) = Res(:)/option%flow_dt
2342) endif
2343) if (associated(patch%ss_flow_vol_fluxes)) then
2344) patch%ss_flow_vol_fluxes(:,sum_connection) = ss_flow_vol_flux(:)/option%flow_dt
2345) endif
2346) r_p((local_id-1)*option%nflowdof + jh2o) = r_p((local_id-1)*option%nflowdof + jh2o)-Res(jh2o)
2347) r_p((local_id-1)*option%nflowdof + jco2) = r_p((local_id-1)*option%nflowdof + jco2)-Res(jco2)
2348) patch%aux%Flash2%Resold_AR(local_id,jh2o)= patch%aux%Flash2%Resold_AR(local_id,jh2o) - Res(jh2o)
2349) patch%aux%Flash2%Resold_AR(local_id,jco2)= patch%aux%Flash2%Resold_AR(local_id,jco2) - Res(jco2)
2350) if (enthalpy_flag) then
2351) r_p( local_id*option%nflowdof) = r_p(local_id*option%nflowdof) - Res(option%nflowdof)
2352) patch%aux%Flash2%Resold_AR(local_id,option%nflowdof)=&
2353) patch%aux%Flash2%Resold_AR(local_id,option%nflowdof) - Res(option%nflowdof)
2354) endif
2355) ! else if (qsrc1 < 0.d0) then ! withdrawal
2356) ! endif
2357) enddo
2358) source_sink => source_sink%next
2359) enddo
2360) #endif
2361) #if 1
2362) ! Boundary Flux Terms -----------------------------------
2363) boundary_condition => patch%boundary_condition_list%first
2364) sum_connection = 0
2365) do
2366) if (.not.associated(boundary_condition)) exit
2367)
2368) cur_connection_set => boundary_condition%connection_set
2369)
2370) do iconn = 1, cur_connection_set%num_connections
2371) sum_connection = sum_connection + 1
2372)
2373) local_id = cur_connection_set%id_dn(iconn)
2374) ghosted_id = grid%nL2G(local_id)
2375)
2376) if (associated(patch%imat)) then
2377) if (patch%imat(ghosted_id) <= 0) cycle
2378) endif
2379)
2380) if (ghosted_id<=0) then
2381) print *, "Wrong boundary node index... STOP!!!"
2382) stop
2383) endif
2384)
2385) ithrm_dn = int(ithrm_loc_p(ghosted_id))
2386) D_dn = Flash2_parameter%ckwet(ithrm_dn)
2387)
2388) ! for now, just assume diagonal tensor
2389) call material_auxvars(ghosted_id)%PermeabilityTensorToScalar( &
2390) cur_connection_set%dist(:,iconn),perm_dn)
2391) ! dist(0,iconn) = scalar - magnitude of distance
2392) ! gravity = vector(3)
2393) ! dist(1:3,iconn) = vector(3) - unit vector
2394) distance_gravity = cur_connection_set%dist(0,iconn) * &
2395) dot_product(option%gravity, &
2396) cur_connection_set%dist(1:3,iconn))
2397)
2398) icap_dn = int(icap_loc_p(ghosted_id))
2399) ! Then need fill up increments for BCs
2400) do idof =1, option%nflowdof
2401) select case(boundary_condition%flow_condition%itype(idof))
2402) case(DIRICHLET_BC)
2403) xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
2404) case(HYDROSTATIC_BC)
2405) xxbc(1) = boundary_condition%flow_aux_real_var(1,iconn)
2406) if (idof >= 2) then
2407) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
2408) endif
2409) case(NEUMANN_BC, ZERO_GRADIENT_BC)
2410) ! solve for pb from Darcy's law given qb /= 0
2411) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
2412) ! iphase = int(iphase_loc_p(ghosted_id))
2413) end select
2414) enddo
2415)
2416)
2417) call Flash2AuxVarCompute_Ninc(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0),&
2418) global_auxvars_bc(sum_connection),&
2419) patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr,&
2420) realization%fluid_properties, option)
2421) #if 1
2422) if (associated(global_auxvars_bc)) then
2423) global_auxvars_bc(sum_connection)%pres(:)= auxvars_bc(sum_connection)%auxvar_elem(0)%pres -&
2424) auxvars(ghosted_id)%auxvar_elem(0)%pc(:)
2425) global_auxvars_bc(sum_connection)%temp=auxvars_bc(sum_connection)%auxvar_elem(0)%temp
2426) global_auxvars_bc(sum_connection)%sat(:)=auxvars_bc(sum_connection)%auxvar_elem(0)%sat(:)
2427) ! global_auxvars(ghosted_id)%sat_store =
2428) global_auxvars_bc(sum_connection)%fugacoeff(1)=xphi
2429) global_auxvars_bc(sum_connection)%den(:)=auxvars_bc(sum_connection)%auxvar_elem(0)%den(:)
2430) global_auxvars_bc(sum_connection)%den_kg = auxvars_bc(sum_connection)%auxvar_elem(0)%den(:) &
2431) * auxvars_bc(sum_connection)%auxvar_elem(0)%avgmw(:)
2432) ! global_auxvars(ghosted_id)%den_kg_store
2433) endif
2434) #endif
2435)
2436) call Flash2BCFlux(boundary_condition%flow_condition%itype, &
2437) boundary_condition%flow_aux_real_var(:,iconn), &
2438) auxvars_bc(sum_connection)%auxvar_elem(0), &
2439) auxvars(ghosted_id)%auxvar_elem(0), &
2440) material_auxvars(ghosted_id)%porosity, &
2441) material_auxvars(ghosted_id)%tortuosity, &
2442) Flash2_parameter%sir(:,icap_dn), &
2443) cur_connection_set%dist(0,iconn),perm_dn,D_dn, &
2444) cur_connection_set%area(iconn), &
2445) distance_gravity,option, &
2446) v_darcy,Res)
2447) patch%boundary_velocities(:,sum_connection) = v_darcy(:)
2448) iend = local_id*option%nflowdof
2449) istart = iend-option%nflowdof+1
2450) r_p(istart:iend)= r_p(istart:iend) - Res(1:option%nflowdof)
2451) patch%aux%Flash2%Resold_AR(local_id,1:option%nflowdof) = &
2452) patch%aux%Flash2%ResOld_AR(local_id,1:option%nflowdof) - Res(1:option%nflowdof)
2453) if (associated(patch%boundary_flow_fluxes)) then
2454) patch%boundary_flow_fluxes(:,sum_connection) = Res(:)/option%flow_dt
2455) endif
2456) enddo
2457) boundary_condition => boundary_condition%next
2458) enddo
2459) #endif
2460) #if 1
2461) ! Interior Flux Terms -----------------------------------
2462) connection_set_list => grid%internal_connection_set_list
2463) cur_connection_set => connection_set_list%first
2464) sum_connection = 0
2465) do
2466) if (.not.associated(cur_connection_set)) exit
2467) do iconn = 1, cur_connection_set%num_connections
2468) sum_connection = sum_connection + 1
2469)
2470) ghosted_id_up = cur_connection_set%id_up(iconn)
2471) ghosted_id_dn = cur_connection_set%id_dn(iconn)
2472)
2473) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
2474) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
2475)
2476) if (associated(patch%imat)) then
2477) if (patch%imat(ghosted_id_up) <= 0 .or. &
2478) patch%imat(ghosted_id_dn) <= 0) cycle
2479) endif
2480)
2481) fraction_upwind = cur_connection_set%dist(-1,iconn)
2482) distance = cur_connection_set%dist(0,iconn)
2483) ! distance = scalar - magnitude of distance
2484) ! gravity = vector(3)
2485) ! dist(1:3,iconn) = vector(3) - unit vector
2486) distance_gravity = distance * &
2487) dot_product(option%gravity, &
2488) cur_connection_set%dist(1:3,iconn))
2489) dd_up = distance*fraction_upwind
2490) dd_dn = distance-dd_up ! should avoid truncation error
2491) ! upweight could be calculated as 1.d0-fraction_upwind
2492) ! however, this introduces ever so slight error causing pflow-overhaul not
2493) ! to match pflow-orig. This can be changed to 1.d0-fraction_upwind
2494) upweight = dd_dn/(dd_up+dd_dn)
2495)
2496) ! for now, just assume diagonal tensor
2497) call material_auxvars(ghosted_id_up)%PermeabilityTensorToScalar( &
2498) cur_connection_set%dist(:,iconn),perm_up)
2499) call material_auxvars(ghosted_id_dn)%PermeabilityTensorToScalar( &
2500) cur_connection_set%dist(:,iconn),perm_dn)
2501)
2502) ithrm_up = int(ithrm_loc_p(ghosted_id_up))
2503) ithrm_dn = int(ithrm_loc_p(ghosted_id_dn))
2504) icap_up = int(icap_loc_p(ghosted_id_up))
2505) icap_dn = int(icap_loc_p(ghosted_id_dn))
2506)
2507) D_up = Flash2_parameter%ckwet(ithrm_up)
2508) D_dn = Flash2_parameter%ckwet(ithrm_dn)
2509)
2510) call Flash2Flux(auxvars(ghosted_id_up)%auxvar_elem(0), &
2511) material_auxvars(ghosted_id_up)%porosity, &
2512) material_auxvars(ghosted_id_up)%tortuosity, &
2513) Flash2_parameter%sir(:,icap_up), &
2514) dd_up,perm_up,D_up, &
2515) auxvars(ghosted_id_dn)%auxvar_elem(0), &
2516) material_auxvars(ghosted_id_dn)%porosity, &
2517) material_auxvars(ghosted_id_dn)%tortuosity, &
2518) Flash2_parameter%sir(:,icap_dn), &
2519) dd_dn,perm_dn,D_dn, &
2520) cur_connection_set%area(iconn),distance_gravity, &
2521) upweight,option,v_darcy,Res)
2522)
2523) patch%internal_velocities(:,sum_connection) = v_darcy(:)
2524) patch%aux%Flash2%Resold_FL(sum_connection,1:option%nflowdof)= Res(1:option%nflowdof)
2525)
2526) if (local_id_up > 0) then
2527) iend = local_id_up*option%nflowdof
2528) istart = iend-option%nflowdof+1
2529) r_p(istart:iend) = r_p(istart:iend) + Res(1:option%nflowdof)
2530) endif
2531)
2532) if (local_id_dn>0) then
2533) iend = local_id_dn*option%nflowdof
2534) istart = iend-option%nflowdof+1
2535) r_p(istart:iend) = r_p(istart:iend) - Res(1:option%nflowdof)
2536) endif
2537)
2538) if (associated(patch%internal_flow_fluxes)) then
2539) patch%internal_flow_fluxes(:,sum_connection) = Res(:)/option%flow_dt
2540) endif
2541)
2542) enddo
2543) cur_connection_set => cur_connection_set%next
2544) enddo
2545) #endif
2546)
2547) ! adjust residual to R/dt
2548) select case (option%idt_switch)
2549) case(1)
2550) r_p(:) = r_p(:)/option%flow_dt
2551) case(-1)
2552) if (option%flow_dt>1.D0) r_p(:) = r_p(:)/option%flow_dt
2553) end select
2554)
2555) do local_id = 1, grid%nlmax
2556) if (associated(patch%imat)) then
2557) if (patch%imat(grid%nL2G(local_id)) <= 0) cycle
2558) endif
2559) ghosted_id = grid%nL2G(local_id)
2560) istart = 1 + (local_id-1)*option%nflowdof
2561) if (material_auxvars(ghosted_id)%volume>1.D0) then
2562) r_p (istart:istart+2)=r_p(istart:istart+2) / &
2563) material_auxvars(ghosted_id)%volume
2564) endif
2565) if (r_p(istart) >1E20 .or. r_p(istart) <-1E20) print *, r_p (istart:istart+2)
2566) ! print *,'flash res', local_id, r_p (istart:istart+2)
2567) enddo
2568)
2569) ! print *,'finished rp vol scale'
2570) if (option%use_isothermal) then
2571) do local_id = 1, grid%nlmax ! For each local node do...
2572) ghosted_id = grid%nL2G(local_id) ! corresponding ghost index
2573) if (associated(patch%imat)) then
2574) if (patch%imat(ghosted_id) <= 0) cycle
2575) endif
2576) istart = 3 + (local_id-1)*option%nflowdof
2577) r_p(istart) = 0.D0 ! xx_loc_p(2 + (ng-1)*option%nflowdof) - yy_p(p1-1)
2578) enddo
2579) endif
2580)
2581)
2582) if (patch%aux%Flash2%inactive_cells_exist) then
2583) do i=1,patch%aux%Flash2%n_zero_rows
2584) r_p(patch%aux%Flash2%zero_rows_local(i)) = 0.d0
2585) enddo
2586) endif
2587)
2588) call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
2589) call VecRestoreArrayF90(field%flow_yy, yy_p, ierr);CHKERRQ(ierr)
2590) call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
2591) call VecRestoreArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
2592) call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
2593) call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
2594) ! call VecRestoreArrayF90(field%iphas_loc, iphase_loc_p, ierr)
2595) deallocate(Resold_AR, Resold_FL, delx)
2596)
2597) if (realization%debug%vecview_residual) then
2598) string = 'Fresidual'
2599) call DebugCreateViewer(realization%debug,string,option,viewer)
2600) call VecView(r,viewer,ierr);CHKERRQ(ierr)
2601) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2602) endif
2603) if (realization%debug%vecview_solution) then
2604) string = 'Fxx'
2605) call DebugCreateViewer(realization%debug,string,option,viewer)
2606) call VecView(xx,viewer,ierr);CHKERRQ(ierr)
2607) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2608) endif
2609) end subroutine Flash2ResidualPatch
2610)
2611) ! ************************************************************************** !
2612)
2613) subroutine Flash2ResidualPatch1(snes,xx,r,realization,ierr)
2614) !
2615) ! Flash2Jacobian: Computes the Residual by Flux
2616) !
2617) ! Author: Chuan Lu
2618) ! Date: 10/10/08
2619) !
2620)
2621) use Connection_module
2622) use Realization_Subsurface_class
2623) use Patch_module
2624) use Grid_module
2625) use Option_module
2626) use Coupler_module
2627) use Field_module
2628) use Debug_module
2629) use Material_Aux_class
2630)
2631) implicit none
2632)
2633) type :: flux_ptrs
2634) PetscReal, dimension(:), pointer :: flux_p
2635) end type
2636)
2637) type (flux_ptrs), dimension(0:2) :: fluxes
2638) SNES, intent(in) :: snes
2639) Vec, intent(inout) :: xx
2640) Vec, intent(out) :: r
2641) type(realization_subsurface_type) :: realization
2642)
2643) PetscErrorCode :: ierr
2644) PetscInt :: i, jn
2645) PetscInt :: ip1, ip2
2646) PetscInt :: local_id, ghosted_id, local_id_up, local_id_dn, ghosted_id_up, ghosted_id_dn
2647)
2648) PetscReal, pointer ::accum_p(:)
2649)
2650) PetscReal, pointer :: r_p(:), xx_loc_p(:)
2651)
2652) PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
2653)
2654) PetscInt :: iphase
2655) PetscInt :: icap_up, icap_dn, ithrm_up, ithrm_dn
2656) PetscReal :: dd_up, dd_dn
2657) PetscReal :: dd, f_up, f_dn, ff
2658) PetscReal :: perm_up, perm_dn
2659) PetscReal :: D_up, D_dn ! "Diffusion" constants at upstream, downstream faces.
2660) PetscReal :: dw_kg, dw_mol,dddt,dddp
2661) PetscReal :: tsrc1, qsrc1, csrc1, enth_src_h2o, enth_src_co2 , hsrc1
2662) PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
2663) PetscReal :: upweight
2664) PetscReal :: Res(realization%option%nflowdof), v_darcy(realization%option%nphase)
2665) PetscReal :: xxbc(realization%option%nflowdof)
2666) PetscViewer :: viewer
2667)
2668)
2669) type(grid_type), pointer :: grid
2670) type(patch_type), pointer :: patch
2671) type(option_type), pointer :: option
2672) type(field_type), pointer :: field
2673) type(Flash2_parameter_type), pointer :: Flash2_parameter
2674) type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
2675) type(coupler_type), pointer :: boundary_condition, source_sink
2676) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
2677) class(material_auxvar_type), pointer :: material_auxvars(:)
2678) type(connection_set_list_type), pointer :: connection_set_list
2679) type(connection_set_type), pointer :: cur_connection_set
2680) PetscBool :: enthalpy_flag
2681) PetscInt :: ng
2682) PetscInt :: axis, side, nlx, nly, nlz, ngx, ngxy, pstart, pend, flux_id
2683) PetscInt :: direction, max_x_conn, max_y_conn
2684) PetscInt :: iconn, idof, istart, iend
2685) PetscInt :: sum_connection
2686) PetscReal :: distance, fraction_upwind
2687) PetscReal :: distance_gravity
2688)
2689) patch => realization%patch
2690) grid => patch%grid
2691) option => realization%option
2692) field => realization%field
2693)
2694) Flash2_parameter => patch%aux%Flash2%Flash2_parameter
2695) auxvars => patch%aux%Flash2%auxvars
2696) auxvars_bc => patch%aux%Flash2%auxvars_bc
2697) global_auxvars => patch%aux%Global%auxvars
2698) global_auxvars_bc => patch%aux%Global%auxvars_bc
2699) material_auxvars => patch%aux%Material%auxvars
2700)
2701) ! call Flash2UpdateAuxVarsPatchNinc(realization)
2702) ! override flags since they will soon be out of date
2703) ! patch%Flash2Aux%auxvars_up_to_date = PETSC_FALSE
2704)
2705) ! now assign access pointer to local variables
2706) call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
2707) call VecGetArrayF90( r, r_p, ierr);CHKERRQ(ierr)
2708) call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
2709) call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
2710)
2711) r_p = 0.d0
2712)
2713) ! Boundary Flux Terms -----------------------------------
2714) boundary_condition => patch%boundary_condition_list%first
2715) sum_connection = 0
2716) do
2717) if (.not.associated(boundary_condition)) exit
2718)
2719) cur_connection_set => boundary_condition%connection_set
2720)
2721) do iconn = 1, cur_connection_set%num_connections
2722) sum_connection = sum_connection + 1
2723)
2724) local_id = cur_connection_set%id_dn(iconn)
2725) ghosted_id = grid%nL2G(local_id)
2726)
2727) if (associated(patch%imat)) then
2728) if (patch%imat(ghosted_id) <= 0) cycle
2729) endif
2730)
2731) if (ghosted_id<=0) then
2732) print *, "Wrong boundary node index... STOP!!!"
2733) stop
2734) endif
2735)
2736) ithrm_dn = int(ithrm_loc_p(ghosted_id))
2737) D_dn = Flash2_parameter%ckwet(ithrm_dn)
2738)
2739) ! for now, just assume diagonal tensor
2740) call material_auxvars(ghosted_id)%PermeabilityTensorToScalar( &
2741) cur_connection_set%dist(:,iconn),perm_dn)
2742) ! dist(0,iconn) = scalar - magnitude of distance
2743) ! gravity = vector(3)
2744) ! dist(1:3,iconn) = vector(3) - unit vector
2745) distance_gravity = cur_connection_set%dist(0,iconn) * &
2746) dot_product(option%gravity, &
2747) cur_connection_set%dist(1:3,iconn))
2748)
2749) icap_dn = int(icap_loc_p(ghosted_id))
2750) ! Then need fill up increments for BCs
2751) do idof = 1, option%nflowdof
2752) select case(boundary_condition%flow_condition%itype(idof))
2753) case(DIRICHLET_BC)
2754) xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
2755) case(HYDROSTATIC_BC)
2756) xxbc(1) = boundary_condition%flow_aux_real_var(1,iconn)
2757) if (idof >= 2) then
2758) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
2759) endif
2760) case(NEUMANN_BC, ZERO_GRADIENT_BC)
2761) ! solve for pb from Darcy's law given qb /= 0
2762) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
2763) ! iphase = int(iphase_loc_p(ghosted_id))
2764) end select
2765) enddo
2766)
2767)
2768) call Flash2AuxVarCompute_Ninc(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0),&
2769) global_auxvars_bc(sum_connection),&
2770) patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr,&
2771) realization%fluid_properties, option,xphi)
2772)
2773) if (associated(global_auxvars_bc)) then
2774) global_auxvars_bc(sum_connection)%pres(:)= auxvars_bc(sum_connection)%auxvar_elem(0)%pres -&
2775) auxvars(ghosted_id)%auxvar_elem(0)%pc(:)
2776) global_auxvars_bc(sum_connection)%temp=auxvars_bc(sum_connection)%auxvar_elem(0)%temp
2777) global_auxvars_bc(sum_connection)%sat(:)=auxvars_bc(sum_connection)%auxvar_elem(0)%sat(:)
2778) ! global_auxvars(ghosted_id)%sat_store =
2779) global_auxvars_bc(sum_connection)%fugacoeff(1)=xphi
2780) global_auxvars_bc(sum_connection)%den(:)=auxvars_bc(sum_connection)%auxvar_elem(0)%den(:)
2781) global_auxvars_bc(sum_connection)%den_kg = auxvars_bc(sum_connection)%auxvar_elem(0)%den(:) &
2782) * auxvars_bc(sum_connection)%auxvar_elem(0)%avgmw(:)
2783) ! global_auxvars(ghosted_id)%den_kg_store
2784) endif
2785)
2786) call Flash2BCFlux(boundary_condition%flow_condition%itype, &
2787) boundary_condition%flow_aux_real_var(:,iconn), &
2788) auxvars_bc(sum_connection)%auxvar_elem(0), &
2789) auxvars(ghosted_id)%auxvar_elem(0), &
2790) material_auxvars(ghosted_id)%porosity, &
2791) material_auxvars(ghosted_id)%tortuosity, &
2792) Flash2_parameter%sir(:,icap_dn), &
2793) cur_connection_set%dist(0,iconn),perm_dn,D_dn, &
2794) cur_connection_set%area(iconn), &
2795) distance_gravity,option, &
2796) v_darcy,Res)
2797) patch%boundary_velocities(:,sum_connection) = v_darcy(:)
2798) patch%aux%Flash2%Resold_BC(local_id,1:option%nflowdof) = &
2799) patch%aux%Flash2%ResOld_BC(local_id,1:option%nflowdof) - Res(1:option%nflowdof)
2800)
2801) iend = local_id*option%nflowdof
2802) istart = iend-option%nflowdof+1
2803) r_p(istart:iend)= r_p(istart:iend) - Res(1:option%nflowdof)
2804) enddo
2805) boundary_condition => boundary_condition%next
2806) enddo
2807)
2808) #if 1
2809)
2810) ! Interior Flux Terms -----------------------------------
2811) connection_set_list => grid%internal_connection_set_list
2812) cur_connection_set => connection_set_list%first
2813) sum_connection = 0
2814) do
2815) if (.not.associated(cur_connection_set)) exit
2816) do iconn = 1, cur_connection_set%num_connections
2817) sum_connection = sum_connection + 1
2818)
2819) ghosted_id_up = cur_connection_set%id_up(iconn)
2820) ghosted_id_dn = cur_connection_set%id_dn(iconn)
2821)
2822) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
2823) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
2824)
2825) if (associated(patch%imat)) then
2826) if (patch%imat(ghosted_id_up) <= 0 .or. &
2827) patch%imat(ghosted_id_dn) <= 0) cycle
2828) endif
2829)
2830) fraction_upwind = cur_connection_set%dist(-1,iconn)
2831) distance = cur_connection_set%dist(0,iconn)
2832) ! distance = scalar - magnitude of distance
2833) ! gravity = vector(3)
2834) ! dist(1:3,iconn) = vector(3) - unit vector
2835) distance_gravity = distance * &
2836) dot_product(option%gravity, &
2837) cur_connection_set%dist(1:3,iconn))
2838) dd_up = distance*fraction_upwind
2839) dd_dn = distance-dd_up ! should avoid truncation error
2840) ! upweight could be calculated as 1.d0-fraction_upwind
2841) ! however, this introduces ever so slight error causing pflow-overhaul not
2842) ! to match pflow-orig. This can be changed to 1.d0-fraction_upwind
2843) upweight = dd_dn/(dd_up+dd_dn)
2844)
2845) ! for now, just assume diagonal tensor
2846) call material_auxvars(ghosted_id_up)%PermeabilityTensorToScalar( &
2847) cur_connection_set%dist(:,iconn),perm_up)
2848) call material_auxvars(ghosted_id_dn)%PermeabilityTensorToScalar( &
2849) cur_connection_set%dist(:,iconn),perm_dn)
2850)
2851) ithrm_up = int(ithrm_loc_p(ghosted_id_up))
2852) ithrm_dn = int(ithrm_loc_p(ghosted_id_dn))
2853) icap_up = int(icap_loc_p(ghosted_id_up))
2854) icap_dn = int(icap_loc_p(ghosted_id_dn))
2855)
2856) D_up = Flash2_parameter%ckwet(ithrm_up)
2857) D_dn = Flash2_parameter%ckwet(ithrm_dn)
2858)
2859) call Flash2Flux(auxvars(ghosted_id_up)%auxvar_elem(0), &
2860) material_auxvars(ghosted_id_up)%porosity, &
2861) material_auxvars(ghosted_id_up)%tortuosity, &
2862) Flash2_parameter%sir(:,icap_up), &
2863) dd_up,perm_up,D_up, &
2864) auxvars(ghosted_id_dn)%auxvar_elem(0), &
2865) material_auxvars(ghosted_id_dn)%porosity, &
2866) material_auxvars(ghosted_id_dn)%tortuosity, &
2867) Flash2_parameter%sir(:,icap_dn), &
2868) dd_dn,perm_dn,D_dn, &
2869) cur_connection_set%area(iconn),distance_gravity, &
2870) upweight,option,v_darcy,Res)
2871)
2872) patch%internal_velocities(:,sum_connection) = v_darcy(:)
2873) patch%aux%Flash2%Resold_FL(sum_connection,1:option%nflowdof)= Res(1:option%nflowdof)
2874)
2875) if (local_id_up>0) then
2876) iend = local_id_up*option%nflowdof
2877) istart = iend-option%nflowdof+1
2878) r_p(istart:iend) = r_p(istart:iend) + Res(1:option%nflowdof)
2879) endif
2880)
2881) if (local_id_dn>0) then
2882) iend = local_id_dn*option%nflowdof
2883) istart = iend-option%nflowdof+1
2884) r_p(istart:iend) = r_p(istart:iend) - Res(1:option%nflowdof)
2885) endif
2886) enddo
2887) cur_connection_set => cur_connection_set%next
2888) enddo
2889) #endif
2890)
2891) call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
2892) call VecRestoreArrayF90( r, r_p, ierr);CHKERRQ(ierr)
2893) call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
2894) call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
2895)
2896) end subroutine Flash2ResidualPatch1
2897)
2898) ! ************************************************************************** !
2899)
2900) subroutine Flash2ResidualPatch0(snes,xx,r,realization,ierr)
2901) !
2902) ! Flash2Jacobian: Computes the Residual Aux vars for numerical Jacobin
2903) !
2904) ! Author: Chuan Lu
2905) ! Date: 10/10/08
2906) !
2907)
2908) use Connection_module
2909) use Realization_Subsurface_class
2910) use Patch_module
2911) use Grid_module
2912) use Option_module
2913) use Coupler_module
2914) use Field_module
2915) use Debug_module
2916)
2917) implicit none
2918)
2919) SNES, intent(in) :: snes
2920) Vec, intent(inout) :: xx
2921) Vec, intent(out) :: r
2922) type(realization_subsurface_type) :: realization
2923)
2924) PetscErrorCode :: ierr
2925) PetscInt :: i, jn
2926) PetscInt :: ip1, ip2
2927) PetscInt :: local_id, ghosted_id, local_id_up, local_id_dn, ghosted_id_up, ghosted_id_dn
2928)
2929) PetscReal, pointer ::accum_p(:)
2930)
2931) PetscReal, pointer :: r_p(:), xx_loc_p(:), xx_p(:), yy_p(:)
2932) PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:)
2933)
2934) PetscReal :: dw_kg, dw_mol,dddt,dddp
2935) PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
2936) PetscReal :: upweight
2937) PetscReal :: Res(realization%option%nflowdof)
2938)
2939)
2940) type(grid_type), pointer :: grid
2941) type(patch_type), pointer :: patch
2942) type(option_type), pointer :: option
2943) type(field_type), pointer :: field
2944) type(Flash2_parameter_type), pointer :: Flash2_parameter
2945) type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
2946) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
2947) PetscBool :: enthalpy_flag
2948) PetscInt :: ng
2949) PetscInt :: iconn, idof, istart, iend
2950) PetscReal, pointer :: delx(:)
2951)
2952)
2953) patch => realization%patch
2954) grid => patch%grid
2955) option => realization%option
2956) field => realization%field
2957)
2958) Flash2_parameter => patch%aux%Flash2%Flash2_parameter
2959) auxvars => patch%aux%Flash2%auxvars
2960) auxvars_bc => patch%aux%Flash2%auxvars_bc
2961) global_auxvars => patch%aux%Global%auxvars
2962) global_auxvars_bc => patch%aux%Global%auxvars_bc
2963)
2964) ! call Flash2UpdateAuxVarsPatchNinc(realization)
2965) ! override flags since they will soon be out of date
2966) ! patch%Flash2Aux%auxvars_up_to_date = PETSC_FALSE
2967)
2968) if (option%compute_mass_balance_new) then
2969) call Flash2ZeroMassBalDeltaPatch(realization)
2970) endif
2971)
2972) ! now assign access pointer to local variables
2973) call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
2974) call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
2975)
2976) allocate(delx(option%nflowdof))
2977)
2978) patch%aux%Flash2%Resold_AR=0.D0
2979) patch%aux%Flash2%Resold_BC=0.D0
2980) patch%aux%Flash2%ResOld_FL=0.D0
2981)
2982) ! Multiphase flash calculation is more expensive, so calculate once per iteration
2983) #if 1
2984) ! Pertubations for aux terms --------------------------------
2985) do ng = 1, grid%ngmax
2986) if (grid%nG2L(ng)<0)cycle
2987) if (associated(patch%imat)) then
2988) if (patch%imat(ng) <= 0) cycle
2989) endif
2990) ghosted_id = ng
2991) istart = (ng-1) * option%nflowdof +1 ; iend = istart -1 + option%nflowdof
2992) ! iphase =int(iphase_loc_p(ng))
2993) call Flash2AuxVarCompute_Ninc(xx_loc_p(istart:iend),auxvars(ng)%auxvar_elem(0),&
2994) global_auxvars(ng),&
2995) patch%saturation_function_array(int(icap_loc_p(ng)))%ptr,&
2996) realization%fluid_properties,option, xphi)
2997) ! print *,'flash ', xx_loc_p(istart:iend),auxvars(ng)%auxvar_elem(0)%den
2998) #if 1
2999) if (associated(global_auxvars)) then
3000) global_auxvars(ghosted_id)%pres(:)= auxvars(ghosted_id)%auxvar_elem(0)%pres -&
3001) auxvars(ghosted_id)%auxvar_elem(0)%pc(:)
3002) global_auxvars(ghosted_id)%temp=auxvars(ghosted_id)%auxvar_elem(0)%temp
3003) global_auxvars(ghosted_id)%sat(:)=auxvars(ghosted_id)%auxvar_elem(0)%sat(:)
3004) ! global_auxvars(ghosted_id)%sat_store =
3005) global_auxvars(ghosted_id)%fugacoeff(1)=xphi
3006) global_auxvars(ghosted_id)%den(:)=auxvars(ghosted_id)%auxvar_elem(0)%den(:)
3007) global_auxvars(ghosted_id)%den_kg(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:) &
3008) * auxvars(ghosted_id)%auxvar_elem(0)%avgmw(:)
3009) ! global_auxvars(ghosted_id)%reaction_rate(:)=0D0
3010) ! global_auxvars(ghosted_id)%pres(:)
3011) else
3012) print *,'Not associated global for Flash2'
3013) endif
3014) #endif
3015)
3016) if (option%flow%numerical_derivatives) then
3017) delx(1) = xx_loc_p((ng-1)*option%nflowdof+1)*dfac * 1.D-3
3018) delx(2) = xx_loc_p((ng-1)*option%nflowdof+2)*dfac
3019)
3020) if (xx_loc_p((ng-1)*option%nflowdof+3) <=0.9) then
3021) delx(3) = dfac*xx_loc_p((ng-1)*option%nflowdof+3)*1D1
3022) else
3023) delx(3) = -dfac*xx_loc_p((ng-1)*option%nflowdof+3)*1D1
3024) endif
3025) if (delx(3) < 1D-8 .and. delx(3)>=0.D0) delx(3) = 1D-8
3026) if (delx(3) >-1D-8 .and. delx(3)<0.D0) delx(3) =-1D-8
3027)
3028)
3029) if ((delx(3)+xx_loc_p((ng-1)*option%nflowdof+3))>1.D0) then
3030) delx(3) = (1.D0-xx_loc_p((ng-1)*option%nflowdof+3))*1D-4
3031) endif
3032) if ((delx(3)+xx_loc_p((ng-1)*option%nflowdof+3))<0.D0) then
3033) delx(3) = xx_loc_p((ng-1)*option%nflowdof+3)*1D-4
3034) endif
3035)
3036) patch%aux%Flash2%delx(:,ng)=delx(:)
3037) call Flash2AuxVarCompute_Winc(xx_loc_p(istart:iend),delx(:),&
3038) auxvars(ng)%auxvar_elem(1:option%nflowdof),global_auxvars(ng),&
3039) patch%saturation_function_array(int(icap_loc_p(ng)))%ptr,&
3040) realization%fluid_properties,option)
3041) ! if (auxvars(ng)%auxvar_elem(option%nflowdof)%sat(2)>1D-8 .and. &
3042) ! auxvars(ng)%auxvar_elem(0)%sat(2)<1D-12)then
3043) ! print *, 'Flash winc', delx(3,ng)
3044) ! endif
3045) endif
3046) enddo
3047) #endif
3048) deallocate(delx)
3049) call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
3050) call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
3051)
3052) end subroutine Flash2ResidualPatch0
3053)
3054) ! ************************************************************************** !
3055)
3056) subroutine Flash2ResidualPatch2(snes,xx,r,realization,ierr)
3057) !
3058) ! Computes other terms in Residual
3059) ! (accumulation, source/sink, reaction)
3060) !
3061) ! Author: Chuan Lu
3062) ! Date: 10/10/08
3063) !
3064)
3065) use Connection_module
3066) use Realization_Subsurface_class
3067) use Patch_module
3068) use Grid_module
3069) use Option_module
3070) use Coupler_module
3071) use Field_module
3072) use Debug_module
3073) use Material_Aux_class
3074)
3075) implicit none
3076)
3077) SNES, intent(in) :: snes
3078) Vec, intent(inout) :: xx
3079) Vec, intent(out) :: r
3080) type(realization_subsurface_type) :: realization
3081)
3082) PetscErrorCode :: ierr
3083) PetscInt :: i, jn
3084) PetscInt :: ip1, ip2
3085) PetscInt :: local_id, ghosted_id
3086)
3087) PetscReal, pointer ::accum_p(:)
3088)
3089) PetscReal, pointer :: r_p(:)
3090)
3091) PetscReal, pointer :: ithrm_loc_p(:)
3092)
3093) PetscReal :: dw_kg, dw_mol,dddt,dddp
3094) PetscReal :: tsrc1, qsrc1, csrc1, enth_src_h2o, enth_src_co2 , hsrc1
3095) PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
3096) PetscReal :: Res(realization%option%nflowdof), v_darcy(realization%option%nphase)
3097) PetscReal :: xxbc(realization%option%nflowdof)
3098) PetscReal :: psrc(1:realization%option%nphase)
3099) PetscViewer :: viewer
3100) PetscInt :: nsrcpara
3101) PetscReal, pointer :: msrc(:)
3102)
3103) type(grid_type), pointer :: grid
3104) type(patch_type), pointer :: patch
3105) type(option_type), pointer :: option
3106) type(field_type), pointer :: field
3107) type(Flash2_parameter_type), pointer :: Flash2_parameter
3108) type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
3109) type(coupler_type), pointer :: boundary_condition, source_sink
3110) type(global_auxvar_type), pointer :: global_auxvars(:)
3111) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
3112) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
3113) class(material_auxvar_type), pointer :: material_auxvars(:)
3114) type(connection_set_list_type), pointer :: connection_set_list
3115) type(connection_set_type), pointer :: cur_connection_set
3116) PetscBool :: enthalpy_flag
3117) PetscInt :: ng
3118) PetscInt :: iconn, idof, istart, iend
3119) PetscInt :: sum_connection
3120) PetscReal :: distance, fraction_upwind
3121) PetscReal :: distance_gravity
3122) PetscReal :: ss_flow_vol_flux(realization%option%nphase)
3123)
3124) patch => realization%patch
3125) grid => patch%grid
3126) option => realization%option
3127) field => realization%field
3128)
3129) Flash2_parameter => patch%aux%Flash2%Flash2_parameter
3130) auxvars => patch%aux%Flash2%auxvars
3131) auxvars_bc => patch%aux%Flash2%auxvars_bc
3132) global_auxvars => patch%aux%Global%auxvars
3133) global_auxvars_bc => patch%aux%Global%auxvars_bc
3134) global_auxvars_ss => patch%aux%Global%auxvars_ss
3135) material_auxvars => patch%aux%Material%auxvars
3136)
3137) ! call Flash2UpdateAuxVarsPatchNinc(realization)
3138) ! override flags since they will soon be out of date
3139) ! patch%Flash2Aux%auxvars_up_to_date = PETSC_FALSE
3140)
3141) ! now assign access pointer to local variables
3142) call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
3143) call VecGetArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
3144) call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
3145)
3146) ! Accumulation terms (include reaction------------------------------------
3147) if (.not.option%steady_state) then
3148) #if 1
3149) r_p = r_p - accum_p
3150)
3151) do local_id = 1, grid%nlmax ! For each local node do...
3152) ghosted_id = grid%nL2G(local_id)
3153) !geh - Ignore inactive cells with inactive materials
3154) if (associated(patch%imat)) then
3155) if (patch%imat(ghosted_id) <= 0) cycle
3156) endif
3157) iend = local_id*option%nflowdof
3158) istart = iend-option%nflowdof+1
3159) call Flash2Accumulation(auxvars(ghosted_id)%auxvar_elem(0),&
3160) global_auxvars(ghosted_id), &
3161) material_auxvars(ghosted_id)%porosity, &
3162) material_auxvars(ghosted_id)%volume, &
3163) Flash2_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
3164) option,ONE_INTEGER,Res)
3165) r_p(istart:iend) = r_p(istart:iend) + Res(1:option%nflowdof)
3166) !print *,'REs, acm: ', res
3167) patch%aux%Flash2%Resold_AR(local_id, :)= &
3168) patch%aux%Flash2%Resold_AR(local_id, :)+ Res(1:option%nflowdof)
3169) enddo
3170) #endif
3171) endif
3172)
3173) #if 1
3174) ! Source/sink terms -------------------------------------
3175) source_sink => patch%source_sink_list%first
3176) sum_connection = 0
3177) do
3178) if (.not.associated(source_sink)) exit
3179) !print *, 'RES s/s begin'
3180) ! check whether enthalpy dof is included
3181) ! if (source_sink%flow_condition%num_sub_conditions > 3) then
3182) enthalpy_flag = PETSC_TRUE
3183) ! else
3184) ! enthalpy_flag = PETSC_FALSE
3185) ! endif
3186)
3187) if (associated(source_sink%flow_condition%pressure)) then
3188) psrc(:) = source_sink%flow_condition%pressure%dataset%rarray(:)
3189) endif
3190) ! qsrc1 = source_sink%flow_condition%pressure%dataset%rarray(1)
3191) tsrc1 = source_sink%flow_condition%temperature%dataset%rarray(1)
3192) csrc1 = source_sink%flow_condition%concentration%dataset%rarray(1)
3193) if (enthalpy_flag) hsrc1 = source_sink%flow_condition%enthalpy%dataset%rarray(1)
3194) ! hsrc1=0D0
3195) ! qsrc1 = qsrc1 / FMWH2O ! [kg/s -> kmol/s; fmw -> g/mol = kg/kmol]
3196) ! csrc1 = csrc1 / FMWCO2
3197) ! msrc(1)=qsrc1; msrc(2) =csrc1
3198) select case(source_sink%flow_condition%itype(1))
3199) case(MASS_RATE_SS)
3200) msrc => source_sink%flow_condition%rate%dataset%rarray
3201) nsrcpara= 2
3202) case(WELL_SS)
3203) msrc => source_sink%flow_condition%well%dataset%rarray
3204) nsrcpara = 7 + option%nflowspec
3205) case default
3206) print *, 'Flash mode does not support source/sink type: ', source_sink%flow_condition%itype(1)
3207) stop
3208) end select
3209)
3210) cur_connection_set => source_sink%connection_set
3211)
3212) do iconn = 1, cur_connection_set%num_connections
3213) sum_connection = sum_connection + 1
3214) local_id = cur_connection_set%id_dn(iconn)
3215) ghosted_id = grid%nL2G(local_id)
3216) if (associated(patch%imat)) then
3217) if (patch%imat(ghosted_id) <= 0) cycle
3218) endif
3219)
3220) call Flash2SourceSink(msrc,nsrcpara, psrc,tsrc1,hsrc1,csrc1,auxvars(ghosted_id)%auxvar_elem(0),&
3221) source_sink%flow_condition%itype(1),Res, &
3222) ss_flow_vol_flux, &
3223) enthalpy_flag, option)
3224) if (option%compute_mass_balance_new) then
3225) global_auxvars_ss(sum_connection)%mass_balance_delta(:,1) = &
3226) global_auxvars_ss(sum_connection)%mass_balance_delta(:,1) - &
3227) Res(:)/option%flow_dt
3228) endif
3229) if (associated(patch%ss_flow_fluxes)) then
3230) patch%ss_flow_fluxes(:,sum_connection) = Res/option%flow_dt
3231) endif
3232) if (associated(patch%ss_flow_vol_fluxes)) then
3233) patch%ss_flow_vol_fluxes(:,sum_connection) = ss_flow_vol_flux/option%flow_dt
3234) endif
3235) r_p((local_id-1)*option%nflowdof + jh2o) = r_p((local_id-1)*option%nflowdof + jh2o)-Res(jh2o)
3236) r_p((local_id-1)*option%nflowdof + jco2) = r_p((local_id-1)*option%nflowdof + jco2)-Res(jco2)
3237) patch%aux%Flash2%Resold_AR(local_id,jh2o)= patch%aux%Flash2%Resold_AR(local_id,jh2o) - Res(jh2o)
3238) patch%aux%Flash2%Resold_AR(local_id,jco2)= patch%aux%Flash2%Resold_AR(local_id,jco2) - Res(jco2)
3239) if (enthalpy_flag)then
3240) r_p( local_id*option%nflowdof) = r_p(local_id*option%nflowdof) - Res(option%nflowdof)
3241) patch%aux%Flash2%Resold_AR(local_id,option%nflowdof)=&
3242) patch%aux%Flash2%Resold_AR(local_id,option%nflowdof) - Res(option%nflowdof)
3243) endif
3244) ! else if (qsrc1 < 0.d0) then ! withdrawal
3245) ! endif
3246) enddo
3247) source_sink => source_sink%next
3248) enddo
3249) #endif
3250)
3251)
3252) ! adjust residual to R/dt
3253) select case (option%idt_switch)
3254) case(1)
3255) r_p(:) = r_p(:)/option%flow_dt
3256) case(-1)
3257) if (option%flow_dt>1.D0) r_p(:) = r_p(:)/option%flow_dt
3258) end select
3259)
3260) do local_id = 1, grid%nlmax
3261) if (associated(patch%imat)) then
3262) if (patch%imat(grid%nL2G(local_id)) <= 0) cycle
3263) endif
3264) ghosted_id = grid%nL2G(local_id)
3265) istart = 1 + (local_id-1)*option%nflowdof
3266) if (material_auxvars(ghosted_id)%volume>1.D0) then
3267) r_p (istart:istart+2)=r_p(istart:istart+2) / &
3268) material_auxvars(ghosted_id)%volume
3269) endif
3270) if (r_p(istart) >1E20 .or. r_p(istart) <-1E20) print *, r_p (istart:istart+2)
3271) ! print *,'flash res', local_id, r_p (istart:istart+2)
3272) enddo
3273)
3274) ! print *,'finished rp vol scale'
3275) if (option%use_isothermal) then
3276) do local_id = 1, grid%nlmax ! For each local node do...
3277) ghosted_id = grid%nL2G(local_id) ! corresponding ghost index
3278) if (associated(patch%imat)) then
3279) if (patch%imat(ghosted_id) <= 0) cycle
3280) endif
3281) istart = 3 + (local_id-1)*option%nflowdof
3282) r_p(istart) = 0.D0 ! xx_loc_p(2 + (ng-1)*option%nflowdof) - yy_p(p1-1)
3283) enddo
3284) endif
3285)
3286) if (patch%aux%Flash2%inactive_cells_exist) then
3287) do i=1,patch%aux%Flash2%n_zero_rows
3288) r_p(patch%aux%Flash2%zero_rows_local(i)) = 0.d0
3289) enddo
3290) endif
3291)
3292) call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
3293) call VecRestoreArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
3294) call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
3295)
3296) end subroutine Flash2ResidualPatch2
3297)
3298) ! ************************************************************************** !
3299)
3300) subroutine Flash2Jacobian(snes,xx,A,B,realization,ierr)
3301) !
3302) ! Computes the Jacobian
3303) !
3304) ! Author: Chuan Lu
3305) ! Date: 10/10/08
3306) !
3307)
3308) use Realization_Subsurface_class
3309) use Patch_module
3310) use Grid_module
3311) use Option_module
3312) use Logging_module
3313) use Debug_module
3314)
3315) implicit none
3316)
3317) SNES :: snes
3318) Vec :: xx
3319) Mat :: A, B, J
3320) MatType :: mat_type
3321) type(realization_subsurface_type) :: realization
3322) PetscErrorCode :: ierr
3323) PetscViewer :: viewer
3324) type(patch_type), pointer :: cur_patch
3325) type(grid_type), pointer :: grid
3326) character(len=MAXSTRINGLENGTH) :: string
3327)
3328) call PetscLogEventBegin(logging%event_r_jacobian,ierr);CHKERRQ(ierr)
3329)
3330) call MatGetType(A,mat_type,ierr);CHKERRQ(ierr)
3331) if (mat_type == MATMFFD) then
3332) J = B
3333) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3334) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3335) else
3336) J = A
3337) endif
3338)
3339)
3340) call MatZeroEntries(J,ierr);CHKERRQ(ierr)
3341)
3342) ! pass #1 for internal and boundary flux terms
3343) cur_patch => realization%patch_list%first
3344) do
3345) if (.not.associated(cur_patch)) exit
3346) realization%patch => cur_patch
3347) call Flash2JacobianPatch1(snes,xx,J,J,realization,ierr)
3348) cur_patch => cur_patch%next
3349) enddo
3350)
3351) ! pass #2 for everything else
3352) cur_patch => realization%patch_list%first
3353) do
3354) if (.not.associated(cur_patch)) exit
3355) realization%patch => cur_patch
3356) call Flash2JacobianPatch2(snes,xx,J,J,realization,ierr)
3357) cur_patch => cur_patch%next
3358) enddo
3359)
3360) if (realization%debug%matview_Jacobian) then
3361) string = 'Fjacobian'
3362) call DebugCreateViewer(realization%debug,string,realization%option,viewer)
3363) call MatView(J,viewer,ierr);CHKERRQ(ierr)
3364) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3365) endif
3366)
3367) #if 0
3368) if (realization%debug%norm_Jacobian) then
3369) option => realization%option
3370) call MatNorm(J,NORM_1,norm,ierr);CHKERRQ(ierr)
3371) write(option%io_buffer,'("1 norm: ",es11.4)') norm
3372) call printMsg(option)
3373) call MatNorm(J,NORM_FROBENIUS,norm,ierr);CHKERRQ(ierr)
3374) write(option%io_buffer,'("2 norm: ",es11.4)') norm
3375) call printMsg(option)
3376) call MatNorm(J,NORM_INFINITY,norm,ierr);CHKERRQ(ierr)
3377) write(option%io_buffer,'("inf norm: ",es11.4)') norm
3378) call printMsg(option)
3379) endif
3380) #endif
3381)
3382) call PetscLogEventEnd(logging%event_r_jacobian,ierr);CHKERRQ(ierr)
3383)
3384) end subroutine Flash2Jacobian
3385)
3386) ! ************************************************************************** !
3387)
3388) subroutine Flash2JacobianPatch(snes,xx,A,B,realization,ierr)
3389) !
3390) ! Computes the Jacobian
3391) !
3392) ! Author: Chuan Lu
3393) ! Date: 10/13/08
3394) !
3395)
3396) use Connection_module
3397) use Option_module
3398) use Grid_module
3399) use Realization_Subsurface_class
3400) use Patch_module
3401) use Coupler_module
3402) use Field_module
3403) use Debug_module
3404) use Material_Aux_class
3405)
3406) implicit none
3407)
3408) SNES :: snes
3409) Vec :: xx
3410) Mat :: A, B
3411) type(realization_subsurface_type) :: realization
3412)
3413) PetscErrorCode :: ierr
3414) PetscInt :: nvar,neq,nr
3415) PetscInt :: ithrm_up, ithrm_dn, i
3416) PetscInt :: ip1, ip2
3417)
3418) PetscReal, pointer :: xx_loc_p(:), tortuosity_loc_p(:)
3419) PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
3420) PetscInt :: icap,iphas,iphas_up,iphas_dn,icap_up,icap_dn
3421) PetscInt :: ii, jj
3422) PetscReal :: dw_kg,dw_mol,enth_src_co2,enth_src_h2o,rho
3423) PetscReal :: tsrc1,qsrc1,csrc1,hsrc1
3424) PetscReal :: dd_up, dd_dn, dd, f_up, f_dn
3425) PetscReal :: perm_up, perm_dn
3426) PetscReal :: dw_dp,dw_dt,hw_dp,hw_dt,dresT_dp,dresT_dt
3427) PetscReal :: D_up, D_dn ! "Diffusion" constants upstream and downstream of a face.
3428) PetscReal :: zero, norm
3429) PetscReal :: upweight
3430) PetscReal :: max_dev
3431) PetscInt :: local_id, ghosted_id
3432) PetscInt :: local_id_up, local_id_dn
3433) PetscInt :: ghosted_id_up, ghosted_id_dn
3434) PetscInt :: natural_id_up,natural_id_dn
3435)
3436) PetscReal :: Jup(1:realization%option%nflowdof,1:realization%option%nflowdof), &
3437) Jdn(1:realization%option%nflowdof,1:realization%option%nflowdof)
3438)
3439) PetscInt :: istart, iend
3440)
3441) type(coupler_type), pointer :: boundary_condition, source_sink
3442) type(connection_set_list_type), pointer :: connection_set_list
3443) type(connection_set_type), pointer :: cur_connection_set
3444) PetscBool :: enthalpy_flag
3445) PetscInt :: iconn, idof
3446) PetscInt :: sum_connection
3447) PetscReal :: distance, fraction_upwind
3448) PetscReal :: distance_gravity
3449) PetscReal :: Res(realization%option%nflowdof)
3450) PetscReal :: xxbc(1:realization%option%nflowdof), delxbc(1:realization%option%nflowdof)
3451) PetscReal :: ResInc(realization%patch%grid%nlmax,realization%option%nflowdof, &
3452) realization%option%nflowdof)
3453) type(grid_type), pointer :: grid
3454) type(patch_type), pointer :: patch
3455) type(option_type), pointer :: option
3456) type(field_type), pointer :: field
3457) type(Flash2_parameter_type), pointer :: Flash2_parameter
3458) type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
3459) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
3460) class(material_auxvar_type), pointer :: material_auxvars(:)
3461)
3462) PetscReal :: vv_darcy(realization%option%nphase), voltemp
3463) PetscReal :: ra(1:realization%option%nflowdof,1:realization%option%nflowdof*2)
3464) PetscInt nsrcpara
3465) PetscReal, pointer :: msrc(:)
3466) PetscReal :: psrc(1:realization%option%nphase), ss_flow(1:realization%option%nphase)
3467) PetscReal :: dddt, dddp, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt,&
3468) dvdp, xphi
3469) PetscInt :: iphasebc
3470)
3471) PetscViewer :: viewer
3472) Vec :: debug_vec
3473) character(len=MAXSTRINGLENGTH) :: string
3474)
3475) !-----------------------------------------------------------------------
3476) ! R stand for residual
3477) ! ra 1 2 3 4 5 6 7 8
3478) ! 1: p dR/dpi dR/dTi dR/dci dR/dsi dR/dpim dR/dTim
3479) ! 2: T
3480) ! 3: c
3481) ! 4 s
3482) !-----------------------------------------------------------------------
3483)
3484) patch => realization%patch
3485) grid => patch%grid
3486) option => realization%option
3487) field => realization%field
3488)
3489) Flash2_parameter => patch%aux%Flash2%Flash2_parameter
3490) auxvars => patch%aux%Flash2%auxvars
3491) auxvars_bc => patch%aux%Flash2%auxvars_bc
3492) global_auxvars => patch%aux%Global%auxvars
3493) global_auxvars_bc => patch%aux%Global%auxvars_bc
3494) material_auxvars => patch%aux%Material%auxvars
3495)
3496) ! dropped derivatives:
3497) ! 1.D0 gas phase viscocity to all p,t,c,s
3498) ! 2. Average molecular weights to p,t,s
3499)
3500) #if 0
3501) ! call Flash2NumericalJacobianTest(xx,realization)
3502) #endif
3503)
3504) ! print *,'*********** In Jacobian ********************** '
3505) call MatZeroEntries(A,ierr);CHKERRQ(ierr)
3506)
3507) call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
3508)
3509) call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
3510) call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
3511) ! call VecGetArrayF90(field%iphas_loc, iphase_loc_p, ierr)
3512)
3513) ResInc = 0.D0
3514) #if 1
3515) ! Accumulation terms ------------------------------------
3516) do local_id = 1, grid%nlmax ! For each local node do...
3517) ghosted_id = grid%nL2G(local_id)
3518) !geh - Ignore inactive cells with inactive materials
3519) if (associated(patch%imat)) then
3520) if (patch%imat(ghosted_id) <= 0) cycle
3521) endif
3522) iend = local_id*option%nflowdof
3523) istart = iend-option%nflowdof+1
3524) icap = int(icap_loc_p(ghosted_id))
3525)
3526) do nvar =1, option%nflowdof
3527) call Flash2Accumulation(auxvars(ghosted_id)%auxvar_elem(nvar), &
3528) global_auxvars(ghosted_id),&
3529) material_auxvars(ghosted_id)%porosity, &
3530) material_auxvars(ghosted_id)%volume, &
3531) Flash2_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
3532) option,ONE_INTEGER, res)
3533) ResInc( local_id,:,nvar) = ResInc(local_id,:,nvar) + Res(:)
3534) enddo
3535) enddo
3536) #endif
3537) #if 1
3538) ! Source/sink terms -------------------------------------
3539) source_sink => patch%source_sink_list%first
3540) sum_connection = 0
3541) do
3542) if (.not.associated(source_sink)) exit
3543)
3544) ! check whether enthalpy dof is included
3545) ! if (source_sink%flow_condition%num_sub_conditions > 3) then
3546) enthalpy_flag = PETSC_TRUE
3547) ! else
3548) ! enthalpy_flag = PETSC_FALSE
3549) ! endif
3550) if (associated(source_sink%flow_condition%pressure)) then
3551) psrc(:) = source_sink%flow_condition%pressure%dataset%rarray(:)
3552) endif
3553) tsrc1 = source_sink%flow_condition%temperature%dataset%rarray(1)
3554) csrc1 = source_sink%flow_condition%concentration%dataset%rarray(1)
3555) ! hsrc1=0.D0
3556) if (enthalpy_flag) hsrc1 = source_sink%flow_condition%enthalpy%dataset%rarray(1)
3557)
3558) ! qsrc1 = qsrc1 / FMWH2O ! [kg/s -> kmol/s; fmw -> g/mol = kg/kmol]
3559) ! csrc1 = csrc1 / FMWCO2
3560) select case(source_sink%flow_condition%itype(1))
3561) case(MASS_RATE_SS)
3562) msrc => source_sink%flow_condition%rate%dataset%rarray
3563) nsrcpara= 2
3564) case(WELL_SS)
3565) msrc => source_sink%flow_condition%well%dataset%rarray
3566) nsrcpara = 7 + option%nflowspec
3567) case default
3568) print *, 'Flash mode does not support source/sink type: ', source_sink%flow_condition%itype(1)
3569) stop
3570) end select
3571)
3572) cur_connection_set => source_sink%connection_set
3573)
3574) do iconn = 1, cur_connection_set%num_connections
3575) sum_connection = sum_connection + 1
3576) local_id = cur_connection_set%id_dn(iconn)
3577) ghosted_id = grid%nL2G(local_id)
3578)
3579) if (associated(patch%imat)) then
3580) if (patch%imat(ghosted_id) <= 0) cycle
3581) endif
3582) ! if (enthalpy_flag) then
3583) ! r_p(local_id*option%nflowdof) = r_p(local_id*option%nflowdof) - hsrc1 * option%flow_dt
3584) ! endif
3585) do nvar =1, option%nflowdof
3586) call Flash2SourceSink(msrc,nsrcpara,psrc,tsrc1,hsrc1,csrc1, auxvars(ghosted_id)%auxvar_elem(nvar),&
3587) source_sink%flow_condition%itype(1), Res,&
3588) ss_flow, &
3589) enthalpy_flag, option)
3590)
3591) ResInc(local_id,jh2o,nvar)= ResInc(local_id,jh2o,nvar) - Res(jh2o)
3592) ResInc(local_id,jco2,nvar)= ResInc(local_id,jco2,nvar) - Res(jco2)
3593) if (enthalpy_flag) &
3594) ResInc(local_id,option%nflowdof,nvar)=&
3595) ResInc(local_id,option%nflowdof,nvar)- Res(option%nflowdof)
3596)
3597) enddo
3598) enddo
3599) source_sink => source_sink%next
3600) enddo
3601) #endif
3602) ! Boundary conditions
3603) #if 1
3604) ! Boundary Flux Terms -----------------------------------
3605) boundary_condition => patch%boundary_condition_list%first
3606) sum_connection = 0
3607) do
3608) if (.not.associated(boundary_condition)) exit
3609)
3610) cur_connection_set => boundary_condition%connection_set
3611)
3612) do iconn = 1, cur_connection_set%num_connections
3613) sum_connection = sum_connection + 1
3614)
3615) local_id = cur_connection_set%id_dn(iconn)
3616) ghosted_id = grid%nL2G(local_id)
3617)
3618) if (associated(patch%imat)) then
3619) if (patch%imat(ghosted_id) <= 0) cycle
3620) endif
3621)
3622) if (ghosted_id<=0) then
3623) print *, "Wrong boundary node index... STOP!!!"
3624) stop
3625) endif
3626)
3627) ithrm_dn = int(ithrm_loc_p(ghosted_id))
3628) D_dn = Flash2_parameter%ckwet(ithrm_dn)
3629)
3630) ! for now, just assume diagonal tensor
3631) call material_auxvars(ghosted_id)%PermeabilityTensorToScalar( &
3632) cur_connection_set%dist(:,iconn),perm_dn)
3633) ! dist(0,iconn) = scalar - magnitude of distance
3634) ! gravity = vector(3)
3635) ! dist(1:3,iconn) = vector(3) - unit vector
3636) distance_gravity = cur_connection_set%dist(0,iconn) * &
3637) dot_product(option%gravity, &
3638) cur_connection_set%dist(1:3,iconn))
3639) icap_dn = int(icap_loc_p(ghosted_id))
3640)
3641) ! Then need fill up increments for BCs
3642) delxbc = 0.D0;
3643) do idof = 1, option%nflowdof
3644) select case(boundary_condition%flow_condition%itype(idof))
3645) case(DIRICHLET_BC)
3646) xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
3647) delxbc(idof)=0.D0
3648) case(HYDROSTATIC_BC)
3649) xxbc(1) = boundary_condition%flow_aux_real_var(1,iconn)
3650) if (idof >= 2) then
3651) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
3652) delxbc(idof)=patch%aux%Flash2%delx(idof,ghosted_id)
3653) endif
3654) case(NEUMANN_BC, ZERO_GRADIENT_BC)
3655) ! solve for pb from Darcy's law given qb /= 0
3656) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
3657) !iphasebc = int(iphase_loc_p(ghosted_id))
3658) delxbc(idof)=patch%aux%Flash2%delx(idof,ghosted_id)
3659) end select
3660) enddo
3661) !print *,'BC:',boundary_condition%flow_condition%itype, xxbc, delxbc
3662)
3663)
3664) call Flash2AuxVarCompute_Ninc(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0),&
3665) global_auxvars_bc(sum_connection),&
3666) patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr,&
3667) realization%fluid_properties, option)
3668) call Flash2AuxVarCompute_Winc(xxbc,delxbc,&
3669) auxvars_bc(sum_connection)%auxvar_elem(1:option%nflowdof),&
3670) global_auxvars_bc(sum_connection),&
3671) patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr,&
3672) realization%fluid_properties,option)
3673)
3674) do nvar=1,option%nflowdof
3675) call Flash2BCFlux(boundary_condition%flow_condition%itype, &
3676) boundary_condition%flow_aux_real_var(:,iconn), &
3677) auxvars_bc(sum_connection)%auxvar_elem(nvar), &
3678) auxvars(ghosted_id)%auxvar_elem(nvar), &
3679) material_auxvars(ghosted_id)%porosity, &
3680) material_auxvars(ghosted_id)%tortuosity, &
3681) Flash2_parameter%sir(:,icap_dn), &
3682) cur_connection_set%dist(0,iconn),perm_dn,D_dn, &
3683) cur_connection_set%area(iconn), &
3684) distance_gravity,option, &
3685) vv_darcy,Res)
3686) ResInc(local_id,1:option%nflowdof,nvar) = &
3687) ResInc(local_id,1:option%nflowdof,nvar) - Res(1:option%nflowdof)
3688) enddo
3689) enddo
3690) boundary_condition => boundary_condition%next
3691) enddo
3692) #endif
3693) ! Set matrix values related to single node terms: Accumulation, Source/Sink, BC
3694) do local_id = 1, grid%nlmax ! For each local node do...
3695) ghosted_id = grid%nL2G(local_id)
3696) !geh - Ignore inactive cells with inactive materials
3697) if (associated(patch%imat)) then
3698) if (patch%imat(ghosted_id) <= 0) cycle
3699) endif
3700)
3701) ra=0.D0
3702) max_dev=0.D0
3703) do neq=1, option%nflowdof
3704) do nvar=1, option%nflowdof
3705) ra(neq,nvar)=(ResInc(local_id,neq,nvar)-patch%aux%Flash2%ResOld_AR(local_id,neq))&
3706) /patch%aux%Flash2%delx(nvar,ghosted_id)
3707) if (max_dev < dabs(ra(3,nvar))) max_dev = dabs(ra(3,nvar))
3708) enddo
3709) enddo
3710)
3711) select case(option%idt_switch)
3712) case(1)
3713) ra(1:option%nflowdof,1:option%nflowdof) = &
3714) ra(1:option%nflowdof,1:option%nflowdof) /option%flow_dt
3715) case(-1)
3716) if (option%flow_dt>1) ra(1:option%nflowdof,1:option%nflowdof) = &
3717) ra(1:option%nflowdof,1:option%nflowdof) /option%flow_dt
3718) end select
3719)
3720) Jup = ra(1:option%nflowdof,1:option%nflowdof)
3721) if (material_auxvars(ghosted_id)%volume > 1.D0) Jup=Jup / material_auxvars(ghosted_id)%volume
3722)
3723) ! if (local_id==1) print *, 'flash jac', volume_p(local_id), ra
3724) call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup,ADD_VALUES, &
3725) ierr);CHKERRQ(ierr)
3726) end do
3727)
3728) if (realization%debug%matview_Jacobian_detailed) then
3729) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3730) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3731) string = 'jacobian_srcsink'
3732) call DebugCreateViewer(realization%debug,string,option,viewer)
3733) call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
3734) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3735) endif
3736) #if 1
3737) ! Interior Flux Terms -----------------------------------
3738) connection_set_list => grid%internal_connection_set_list
3739) cur_connection_set => connection_set_list%first
3740) sum_connection = 0
3741) ResInc = 0.D0
3742) do
3743) if (.not.associated(cur_connection_set)) exit
3744) do iconn = 1, cur_connection_set%num_connections
3745) sum_connection = sum_connection + 1
3746)
3747) ghosted_id_up = cur_connection_set%id_up(iconn)
3748) ghosted_id_dn = cur_connection_set%id_dn(iconn)
3749)
3750) if (associated(patch%imat)) then
3751) if (patch%imat(ghosted_id_up) <= 0 .or. &
3752) patch%imat(ghosted_id_dn) <= 0) cycle
3753) endif
3754)
3755) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
3756) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
3757) ! natural_id_up = grid%nG2N(ghosted_id_up)
3758) ! natural_id_dn = grid%nG2N(ghosted_id_dn)
3759)
3760) fraction_upwind = cur_connection_set%dist(-1,iconn)
3761) distance = cur_connection_set%dist(0,iconn)
3762) ! distance = scalar - magnitude of distance
3763) ! gravity = vector(3)
3764) ! dist(1:3,iconn) = vector(3) - unit vector
3765) distance_gravity = distance * &
3766) dot_product(option%gravity, &
3767) cur_connection_set%dist(1:3,iconn))
3768) dd_up = distance*fraction_upwind
3769) dd_dn = distance-dd_up ! should avoid truncation error
3770) ! upweight could be calculated as 1.d0-fraction_upwind
3771) ! however, this introduces ever so slight error causing pflow-overhaul not
3772) ! to match pflow-orig. This can be changed to 1.d0-fraction_upwind
3773) upweight = dd_dn/(dd_up+dd_dn)
3774)
3775) ! for now, just assume diagonal tensor
3776) call material_auxvars(ghosted_id_up)%PermeabilityTensorToScalar( &
3777) cur_connection_set%dist(:,iconn),perm_up)
3778) call material_auxvars(ghosted_id_dn)%PermeabilityTensorToScalar( &
3779) cur_connection_set%dist(:,iconn),perm_dn)
3780)
3781) ithrm_up = int(ithrm_loc_p(ghosted_id_up))
3782) ithrm_dn = int(ithrm_loc_p(ghosted_id_dn))
3783) D_up = Flash2_parameter%ckwet(ithrm_up)
3784) D_dn = Flash2_parameter%ckwet(ithrm_dn)
3785)
3786) icap_up = int(icap_loc_p(ghosted_id_up))
3787) icap_dn = int(icap_loc_p(ghosted_id_dn))
3788)
3789) do nvar = 1, option%nflowdof
3790) call Flash2Flux(auxvars(ghosted_id_up)%auxvar_elem(nvar), &
3791) material_auxvars(ghosted_id_up)%porosity, &
3792) material_auxvars(ghosted_id_up)%tortuosity, &
3793) Flash2_parameter%sir(:,icap_up), &
3794) dd_up,perm_up,D_up, &
3795) auxvars(ghosted_id_dn)%auxvar_elem(0), &
3796) material_auxvars(ghosted_id_dn)%porosity, &
3797) material_auxvars(ghosted_id_dn)%tortuosity, &
3798) Flash2_parameter%sir(:,icap_dn), &
3799) dd_dn,perm_dn,D_dn, &
3800) cur_connection_set%area(iconn),distance_gravity, &
3801) upweight, option, vv_darcy, Res)
3802) ra(:,nvar)= (Res(:)-patch%aux%Flash2%ResOld_FL(iconn,:))&
3803) /patch%aux%Flash2%delx(nvar,ghosted_id_up)
3804) call Flash2Flux(auxvars(ghosted_id_up)%auxvar_elem(0), &
3805) material_auxvars(ghosted_id_up)%porosity, &
3806) material_auxvars(ghosted_id_up)%tortuosity, &
3807) Flash2_parameter%sir(:,icap_up), &
3808) dd_up,perm_up,D_up, &
3809) auxvars(ghosted_id_dn)%auxvar_elem(nvar), &
3810) material_auxvars(ghosted_id_dn)%porosity, &
3811) material_auxvars(ghosted_id_dn)%tortuosity, &
3812) Flash2_parameter%sir(:,icap_dn), &
3813) dd_dn,perm_dn,D_dn, &
3814) cur_connection_set%area(iconn),distance_gravity, &
3815) upweight, option, vv_darcy, Res)
3816) ra(:,nvar+option%nflowdof)= (Res(:)-patch%aux%Flash2%ResOld_FL(iconn,:))&
3817) /patch%aux%Flash2%delx(nvar,ghosted_id_dn)
3818) enddo
3819)
3820) select case(option%idt_switch)
3821) case(1)
3822) ra = ra / option%flow_dt
3823) case(-1)
3824) if (option%flow_dt > 1) ra = ra / option%flow_dt
3825) end select
3826)
3827) if (local_id_up > 0) then
3828) voltemp=1.D0
3829) if (material_auxvars(ghosted_id_up)%volume > 1.D0) then
3830) voltemp = 1.D0/material_auxvars(ghosted_id_up)%volume
3831) endif
3832) Jup(:,1:option%nflowdof)= ra(:,1:option%nflowdof)*voltemp !11
3833) jdn(:,1:option%nflowdof)= ra(:, 1 + option%nflowdof:2 * option%nflowdof)*voltemp !12
3834)
3835) call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_up-1, &
3836) Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
3837) call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_dn-1, &
3838) Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
3839) endif
3840) if (local_id_dn > 0) then
3841) voltemp=1.D0
3842) if (material_auxvars(ghosted_id_dn)%volume > 1.D0) then
3843) voltemp = 1.D0/material_auxvars(ghosted_id_dn)%volume
3844) endif
3845) Jup(:,1:option%nflowdof)= -ra(:,1:option%nflowdof)*voltemp !21
3846) jdn(:,1:option%nflowdof)= -ra(:, 1 + option%nflowdof:2 * option%nflowdof)*voltemp !22
3847)
3848)
3849) call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_dn-1, &
3850) Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
3851) call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_up-1, &
3852) Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
3853) endif
3854) enddo
3855) cur_connection_set => cur_connection_set%next
3856) enddo
3857) #endif
3858) if (realization%debug%matview_Jacobian_detailed) then
3859) ! print *,'end inter flux'
3860) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3861) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3862) string = 'jacobian_flux'
3863) call DebugCreateViewer(realization%debug,string,option,viewer)
3864) call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
3865) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3866) endif
3867) #if 0
3868) if (realization%debug%matview_Jacobian_detailed) then
3869) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3870) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3871) call PetscViewerASCIIOpen(option%mycomm,'jacobian_bcflux.out',viewer, &
3872) ierr);CHKERRQ(ierr)
3873) call MatView(A,viewer,ierr);CHKERRQ(ierr)
3874) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3875) endif
3876) #endif
3877)
3878) call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
3879) call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
3880) call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
3881) ! call VecRestoreArrayF90(field%iphas_loc, iphase_loc_p, ierr)
3882) ! print *,'end jac'
3883) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3884) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3885) ! call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr)
3886) #if 0
3887) ! zero out isothermal and inactive cells
3888) #ifdef ISOTHERMAL
3889) zero = 0.d0
3890) call MatZeroRowsLocal(A,n_zero_rows,zero_rows_local_ghosted,zero, &
3891) PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
3892) ierr);CHKERRQ(ierr)
3893) do i=1, n_zero_rows
3894) ii = mod(zero_rows_local(i),option%nflowdof)
3895) ip1 = zero_rows_local_ghosted(i)
3896) if (ii == 0) then
3897) ip2 = ip1-1
3898) elseif (ii == option%nflowdof-1) then
3899) ip2 = ip1+1
3900) else
3901) ip2 = ip1
3902) endif
3903) call MatSetValuesLocal(A,1,ip1,1,ip2,1.d0,INSERT_VALUES, &
3904) ierr);CHKERRQ(ierr)
3905) enddo
3906)
3907) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3908) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3909) #else
3910) #endif
3911) #endif
3912)
3913) if (patch%aux%Flash2%inactive_cells_exist) then
3914) f_up = 1.d0
3915) call MatZeroRowsLocal(A,patch%aux%Flash2%n_zero_rows, &
3916) patch%aux%Flash2%zero_rows_local_ghosted,f_up, &
3917) PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
3918) ierr);CHKERRQ(ierr)
3919) endif
3920)
3921) if (realization%debug%matview_Jacobian) then
3922) string = 'Fjacobian'
3923) call DebugCreateViewer(realization%debug,string,option,viewer)
3924) call MatView(A,viewer,ierr);CHKERRQ(ierr)
3925) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3926) endif
3927) if (realization%debug%norm_Jacobian) then
3928) call MatNorm(A,NORM_1,norm,ierr);CHKERRQ(ierr)
3929) write(option%io_buffer,'("1 norm: ",es11.4)') norm
3930) call printMsg(option)
3931) call MatNorm(A,NORM_FROBENIUS,norm,ierr);CHKERRQ(ierr)
3932) write(option%io_buffer,'("2 norm: ",es11.4)') norm
3933) call printMsg(option)
3934) call MatNorm(A,NORM_INFINITY,norm,ierr);CHKERRQ(ierr)
3935) write(option%io_buffer,'("inf norm: ",es11.4)') norm
3936) call printMsg(option)
3937) ! call GridCreateVector(grid,ONEDOF,debug_vec,GLOBAL)
3938) ! call MatGetRowMaxAbs(A,debug_vec,PETSC_NULL_INTEGER,ierr)
3939) ! call VecMax(debug_vec,i,norm,ierr)
3940) ! call VecDestroy(debug_vec,ierr)
3941) endif
3942) end subroutine Flash2JacobianPatch
3943)
3944) ! ************************************************************************** !
3945)
3946) subroutine Flash2JacobianPatch1(snes,xx,A,B,realization,ierr)
3947) !
3948) ! Flash2JacobianPatch: Computes the Jacobian: Flux term
3949) !
3950) ! Author: Chuan Lu
3951) ! Date: 10/13/08
3952) !
3953)
3954) use Connection_module
3955) use Option_module
3956) use Grid_module
3957) use Realization_Subsurface_class
3958) use Patch_module
3959) use Coupler_module
3960) use Field_module
3961) use Debug_module
3962) use Material_Aux_class
3963)
3964) implicit none
3965)
3966) SNES :: snes
3967) Vec :: xx
3968) Mat :: A, B
3969) type(realization_subsurface_type) :: realization
3970)
3971) PetscErrorCode :: ierr
3972) PetscInt :: nvar,neq,nr
3973) PetscInt :: ithrm_up, ithrm_dn, i
3974) PetscInt :: ip1, ip2
3975)
3976) PetscReal, pointer :: xx_loc_p(:), tortuosity_loc_p(:)
3977) PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
3978) PetscInt :: icap,iphas,iphas_up,iphas_dn,icap_up,icap_dn
3979) PetscInt :: ii, jj
3980) PetscReal :: dw_kg,dw_mol,enth_src_co2,enth_src_h2o,rho
3981) PetscReal :: tsrc1,qsrc1,csrc1,hsrc1
3982) PetscReal :: dd_up, dd_dn, dd, f_up, f_dn
3983) PetscReal :: perm_up, perm_dn
3984) PetscReal :: dw_dp,dw_dt,hw_dp,hw_dt,dresT_dp,dresT_dt
3985) PetscReal :: D_up, D_dn ! "Diffusion" constants upstream and downstream of a face.
3986) PetscReal :: zero, norm
3987) PetscReal :: upweight
3988) PetscReal :: max_dev
3989) PetscInt :: local_id, ghosted_id
3990) PetscInt :: local_id_up, local_id_dn
3991) PetscInt :: ghosted_id_up, ghosted_id_dn
3992) PetscInt :: natural_id_up,natural_id_dn
3993)
3994) PetscReal :: Jup(1:realization%option%nflowdof,1:realization%option%nflowdof), &
3995) Jdn(1:realization%option%nflowdof,1:realization%option%nflowdof)
3996)
3997) PetscInt :: istart, iend
3998)
3999) type(coupler_type), pointer :: boundary_condition, source_sink
4000) type(connection_set_list_type), pointer :: connection_set_list
4001) type(connection_set_type), pointer :: cur_connection_set
4002) PetscBool :: enthalpy_flag
4003) PetscInt :: iconn, idof
4004) PetscInt :: sum_connection
4005) PetscReal :: distance, fraction_upwind
4006) PetscReal :: distance_gravity
4007) PetscReal :: Res(realization%option%nflowdof)
4008) PetscReal :: xxbc(1:realization%option%nflowdof), delxbc(1:realization%option%nflowdof)
4009) PetscReal :: ResInc(realization%patch%grid%nlmax,realization%option%nflowdof,&
4010) realization%option%nflowdof)
4011) type(grid_type), pointer :: grid
4012) type(patch_type), pointer :: patch
4013) type(option_type), pointer :: option
4014) type(field_type), pointer :: field
4015) type(Flash2_parameter_type), pointer :: Flash2_parameter
4016) type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
4017) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
4018) class(material_auxvar_type), pointer :: material_auxvars(:)
4019)
4020) PetscReal :: vv_darcy(realization%option%nphase), voltemp
4021) PetscReal :: ra(1:realization%option%nflowdof,1:realization%option%nflowdof*2)
4022) PetscReal :: msrc(1:realization%option%nflowspec)
4023) PetscReal :: psrc(1:realization%option%nphase)
4024) PetscReal :: dddt, dddp, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt,&
4025) dvdp, xphi
4026) PetscInt :: iphasebc
4027)
4028) PetscViewer :: viewer
4029) Vec :: debug_vec
4030) character(len=MAXSTRINGLENGTH) :: string
4031)
4032) !-----------------------------------------------------------------------
4033) ! R stand for residual
4034) ! ra 1 2 3 4 5 6 7 8
4035) ! 1: p dR/dpi dR/dTi dR/dci dR/dsi dR/dpim dR/dTim
4036) ! 2: T
4037) ! 3: c
4038) ! 4 s
4039) !-----------------------------------------------------------------------
4040)
4041) patch => realization%patch
4042) grid => patch%grid
4043) option => realization%option
4044) field => realization%field
4045)
4046) Flash2_parameter => patch%aux%Flash2%Flash2_parameter
4047) auxvars => patch%aux%Flash2%auxvars
4048) auxvars_bc => patch%aux%Flash2%auxvars_bc
4049) global_auxvars => patch%aux%Global%auxvars
4050) global_auxvars_bc => patch%aux%Global%auxvars_bc
4051) material_auxvars => patch%aux%Material%auxvars
4052) ! dropped derivatives:
4053) ! 1.D0 gas phase viscocity to all p,t,c,s
4054) ! 2. Average molecular weights to p,t,s
4055)
4056) #if 0
4057) ! call Flash2NumericalJacobianTest(xx,realization)
4058) #endif
4059)
4060) ! print *,'*********** In Jacobian ********************** '
4061) ! MatzeroEntries has been called in Flash2Jacobin ! clu removed on 11/04/2010
4062) ! call MatZeroEntries(A,ierr)
4063)
4064) call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
4065) call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
4066) call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
4067) ! call VecGetArrayF90(field%iphas_loc, iphase_loc_p, ierr)
4068)
4069) ResInc = 0.D0
4070)
4071) ! Boundary conditions
4072) #if 1
4073) ! Boundary Flux Terms -----------------------------------
4074) boundary_condition => patch%boundary_condition_list%first
4075) sum_connection = 0
4076) do
4077) if (.not.associated(boundary_condition)) exit
4078)
4079) cur_connection_set => boundary_condition%connection_set
4080)
4081) do iconn = 1, cur_connection_set%num_connections
4082) sum_connection = sum_connection + 1
4083)
4084) local_id = cur_connection_set%id_dn(iconn)
4085) ghosted_id = grid%nL2G(local_id)
4086)
4087) if (associated(patch%imat)) then
4088) if (patch%imat(ghosted_id) <= 0) cycle
4089) endif
4090)
4091) if (ghosted_id<=0) then
4092) print *, "Wrong boundary node index... STOP!!!"
4093) stop
4094) endif
4095)
4096) ithrm_dn = int(ithrm_loc_p(ghosted_id))
4097) D_dn = Flash2_parameter%ckwet(ithrm_dn)
4098)
4099) ! for now, just assume diagonal tensor
4100) call material_auxvars(ghosted_id)%PermeabilityTensorToScalar( &
4101) cur_connection_set%dist(:,iconn),perm_dn)
4102) ! dist(0,iconn) = scalar - magnitude of distance
4103) ! gravity = vector(3)
4104) ! dist(1:3,iconn) = vector(3) - unit vector
4105) distance_gravity = cur_connection_set%dist(0,iconn) * &
4106) dot_product(option%gravity, &
4107) cur_connection_set%dist(1:3,iconn))
4108) icap_dn = int(icap_loc_p(ghosted_id))
4109)
4110) ! Then need fill up increments for BCs
4111) delxbc = 0.D0;
4112) do idof = 1, option%nflowdof
4113) select case(boundary_condition%flow_condition%itype(idof))
4114) case(DIRICHLET_BC)
4115) xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
4116) delxbc(idof)=0.D0
4117) case(HYDROSTATIC_BC)
4118) xxbc(1) = boundary_condition%flow_aux_real_var(1,iconn)
4119) if (idof>=2)then
4120) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
4121) delxbc(idof)=patch%aux%Flash2%delx(idof,ghosted_id)
4122) endif
4123) case(NEUMANN_BC, ZERO_GRADIENT_BC)
4124) ! solve for pb from Darcy's law given qb /= 0
4125) xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
4126) !iphasebc = int(iphase_loc_p(ghosted_id))
4127) delxbc(idof)=patch%aux%Flash2%delx(idof,ghosted_id)
4128) end select
4129) enddo
4130) !print *,'BC:',boundary_condition%flow_condition%itype, xxbc, delxbc
4131)
4132)
4133) call Flash2AuxVarCompute_Ninc(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0),&
4134) global_auxvars_bc(sum_connection),&
4135) patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr,&
4136) realization%fluid_properties, option)
4137) call Flash2AuxVarCompute_Winc(xxbc,delxbc,&
4138) auxvars_bc(sum_connection)%auxvar_elem(1:option%nflowdof),&
4139) global_auxvars_bc(sum_connection),&
4140) patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr,&
4141) realization%fluid_properties,option)
4142)
4143) do nvar=1,option%nflowdof
4144) call Flash2BCFlux(boundary_condition%flow_condition%itype, &
4145) boundary_condition%flow_aux_real_var(:,iconn), &
4146) auxvars_bc(sum_connection)%auxvar_elem(nvar), &
4147) auxvars(ghosted_id)%auxvar_elem(nvar), &
4148) material_auxvars(ghosted_id)%porosity, &
4149) material_auxvars(ghosted_id)%tortuosity, &
4150) Flash2_parameter%sir(:,icap_dn), &
4151) cur_connection_set%dist(0,iconn),perm_dn,D_dn, &
4152) cur_connection_set%area(iconn), &
4153) distance_gravity,option, &
4154) vv_darcy,Res)
4155) ResInc(local_id,1:option%nflowdof,nvar) = ResInc(local_id,1:option%nflowdof,nvar) - Res(1:option%nflowdof)
4156) enddo
4157) enddo
4158) boundary_condition => boundary_condition%next
4159) enddo
4160) #endif
4161) ! Set matrix values related to single node terms: Accumulation, Source/Sink, BC
4162) do local_id = 1, grid%nlmax ! For each local node do...
4163) ghosted_id = grid%nL2G(local_id)
4164) !geh - Ignore inactive cells with inactive materials
4165) if (associated(patch%imat)) then
4166) if (patch%imat(ghosted_id) <= 0) cycle
4167) endif
4168)
4169) ra=0.D0
4170) max_dev=0.D0
4171) do neq=1, option%nflowdof
4172) do nvar=1, option%nflowdof
4173) ra(neq,nvar)=(ResInc(local_id,neq,nvar)-patch%aux%Flash2%ResOld_BC(local_id,neq))&
4174) /patch%aux%Flash2%delx(nvar,ghosted_id)
4175) if (max_dev < dabs(ra(3,nvar))) max_dev = dabs(ra(3,nvar))
4176) enddo
4177) enddo
4178)
4179) select case(option%idt_switch)
4180) case(1)
4181) ra(1:option%nflowdof,1:option%nflowdof) = &
4182) ra(1:option%nflowdof,1:option%nflowdof) /option%flow_dt
4183) case(-1)
4184) if (option%flow_dt>1) ra(1:option%nflowdof,1:option%nflowdof) = &
4185) ra(1:option%nflowdof,1:option%nflowdof) /option%flow_dt
4186) end select
4187)
4188) Jup=ra(1:option%nflowdof,1:option%nflowdof)
4189) if (material_auxvars(ghosted_id)%volume>1.D0 ) Jup=Jup / material_auxvars(ghosted_id)%volume
4190)
4191) ! if (local_id==1) print *, 'flash jac', volume_p(local_id), ra
4192) call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup,ADD_VALUES, &
4193) ierr);CHKERRQ(ierr)
4194) end do
4195)
4196) if (realization%debug%matview_Jacobian_detailed) then
4197) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
4198) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
4199) string = 'jacobian_bcflux'
4200) call DebugCreateViewer(realization%debug,string,option,viewer)
4201) call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
4202) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
4203) endif
4204)
4205) #if 1
4206) ! Interior Flux Terms -----------------------------------
4207) connection_set_list => grid%internal_connection_set_list
4208) cur_connection_set => connection_set_list%first
4209) sum_connection = 0
4210) ResInc = 0.D0
4211) do
4212) if (.not.associated(cur_connection_set)) exit
4213) do iconn = 1, cur_connection_set%num_connections
4214) sum_connection = sum_connection + 1
4215)
4216) ghosted_id_up = cur_connection_set%id_up(iconn)
4217) ghosted_id_dn = cur_connection_set%id_dn(iconn)
4218)
4219) if (associated(patch%imat)) then
4220) if (patch%imat(ghosted_id_up) <= 0 .or. &
4221) patch%imat(ghosted_id_dn) <= 0) cycle
4222) endif
4223)
4224) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
4225) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
4226) ! natural_id_up = grid%nG2N(ghosted_id_up)
4227) ! natural_id_dn = grid%nG2N(ghosted_id_dn)
4228)
4229) fraction_upwind = cur_connection_set%dist(-1,iconn)
4230) distance = cur_connection_set%dist(0,iconn)
4231) ! distance = scalar - magnitude of distance
4232) ! gravity = vector(3)
4233) ! dist(1:3,iconn) = vector(3) - unit vector
4234) distance_gravity = distance * &
4235) dot_product(option%gravity, &
4236) cur_connection_set%dist(1:3,iconn))
4237) dd_up = distance*fraction_upwind
4238) dd_dn = distance-dd_up ! should avoid truncation error
4239) ! upweight could be calculated as 1.d0-fraction_upwind
4240) ! however, this introduces ever so slight error causing pflow-overhaul not
4241) ! to match pflow-orig. This can be changed to 1.d0-fraction_upwind
4242) upweight = dd_dn/(dd_up+dd_dn)
4243)
4244) ! for now, just assume diagonal tensor
4245) call material_auxvars(ghosted_id_up)%PermeabilityTensorToScalar( &
4246) cur_connection_set%dist(:,iconn),perm_up)
4247) call material_auxvars(ghosted_id_dn)%PermeabilityTensorToScalar( &
4248) cur_connection_set%dist(:,iconn),perm_dn)
4249)
4250) ! iphas_up = iphase_loc_p(ghosted_id_up)
4251) ! iphas_dn = iphase_loc_p(ghosted_id_dn)
4252)
4253) ithrm_up = int(ithrm_loc_p(ghosted_id_up))
4254) ithrm_dn = int(ithrm_loc_p(ghosted_id_dn))
4255) D_up = Flash2_parameter%ckwet(ithrm_up)
4256) D_dn = Flash2_parameter%ckwet(ithrm_dn)
4257)
4258) icap_up = int(icap_loc_p(ghosted_id_up))
4259) icap_dn = int(icap_loc_p(ghosted_id_dn))
4260)
4261) do nvar = 1, option%nflowdof
4262) call Flash2Flux(auxvars(ghosted_id_up)%auxvar_elem(nvar), &
4263) material_auxvars(ghosted_id_up)%porosity, &
4264) material_auxvars(ghosted_id_up)%tortuosity, &
4265) Flash2_parameter%sir(:,icap_up), &
4266) dd_up,perm_up,D_up, &
4267) auxvars(ghosted_id_dn)%auxvar_elem(0), &
4268) material_auxvars(ghosted_id_dn)%porosity, &
4269) material_auxvars(ghosted_id_dn)%tortuosity, &
4270) Flash2_parameter%sir(:,icap_dn), &
4271) dd_dn,perm_dn,D_dn, &
4272) cur_connection_set%area(iconn),distance_gravity, &
4273) upweight, option, vv_darcy, Res)
4274) ra(:,nvar) = (Res(:)-patch%aux%Flash2%ResOld_FL(iconn,:))&
4275) /patch%aux%Flash2%delx(nvar,ghosted_id_up)
4276) call Flash2Flux(auxvars(ghosted_id_up)%auxvar_elem(0), &
4277) material_auxvars(ghosted_id_up)%porosity, &
4278) material_auxvars(ghosted_id_up)%tortuosity, &
4279) Flash2_parameter%sir(:,icap_up), &
4280) dd_up,perm_up,D_up, &
4281) auxvars(ghosted_id_dn)%auxvar_elem(nvar), &
4282) material_auxvars(ghosted_id_dn)%porosity, &
4283) material_auxvars(ghosted_id_dn)%tortuosity, &
4284) Flash2_parameter%sir(:,icap_dn), &
4285) dd_dn,perm_dn,D_dn, &
4286) cur_connection_set%area(iconn),distance_gravity, &
4287) upweight, option, vv_darcy, Res)
4288) ra(:,nvar+option%nflowdof)= (Res(:)-patch%aux%Flash2%ResOld_FL(iconn,:))&
4289) /patch%aux%Flash2%delx(nvar,ghosted_id_dn)
4290) enddo
4291)
4292) select case(option%idt_switch)
4293) case(1)
4294) ra = ra / option%flow_dt
4295) case(-1)
4296) if (option%flow_dt>1) ra =ra / option%flow_dt
4297) end select
4298)
4299) if (local_id_up > 0) then
4300) voltemp=1.D0
4301) if (material_auxvars(ghosted_id_up)%volume > 1.D0)then
4302) voltemp = 1.D0/material_auxvars(ghosted_id_up)%volume
4303) endif
4304) Jup(:,1:option%nflowdof) = ra(:,1:option%nflowdof)*voltemp !11
4305) jdn(:,1:option%nflowdof) = ra(:, 1 + option%nflowdof:2 * option%nflowdof)*voltemp !12
4306)
4307) call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_up-1, &
4308) Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
4309) call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_dn-1, &
4310) Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
4311) endif
4312) if (local_id_dn > 0) then
4313) voltemp = 1.D0
4314) if (material_auxvars(ghosted_id_dn)%volume>1.D0) then
4315) voltemp = 1.D0/material_auxvars(ghosted_id_dn)%volume
4316) endif
4317) Jup(:,1:option%nflowdof) = -ra(:,1:option%nflowdof)*voltemp !21
4318) jdn(:,1:option%nflowdof) = -ra(:, 1 + option%nflowdof:2 * option%nflowdof)*voltemp !22
4319)
4320)
4321) call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_dn-1, &
4322) Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
4323) call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_up-1, &
4324) Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
4325) endif
4326) enddo
4327) cur_connection_set => cur_connection_set%next
4328) enddo
4329) #endif
4330) if (realization%debug%matview_Jacobian_detailed) then
4331) ! print *,'end inter flux'
4332) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
4333) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
4334) string = 'jacobian_flux'
4335) call DebugCreateViewer(realization%debug,string,option,viewer)
4336) call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
4337) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
4338) endif
4339)
4340) call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
4341) call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
4342) call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
4343)
4344) end subroutine Flash2JacobianPatch1
4345)
4346) ! ************************************************************************** !
4347)
4348) subroutine Flash2JacobianPatch2(snes,xx,A,B,realization,ierr)
4349) !
4350) ! Flash2JacobianPatch: Computes the Jacobian: Accum, source, reaction
4351) !
4352) ! Author: Chuan Lu
4353) ! Date: 10/13/08
4354) !
4355)
4356) use Connection_module
4357) use Option_module
4358) use Grid_module
4359) use Realization_Subsurface_class
4360) use Patch_module
4361) use Coupler_module
4362) use Field_module
4363) use Debug_module
4364) use Material_Aux_class
4365)
4366) implicit none
4367)
4368) SNES :: snes
4369) Vec :: xx
4370) Mat :: A, B
4371) type(realization_subsurface_type) :: realization
4372)
4373) PetscErrorCode :: ierr
4374) PetscInt :: nvar,neq,nr
4375) PetscInt :: ithrm_up, ithrm_dn, i
4376) PetscInt :: ip1, ip2
4377)
4378) PetscReal, pointer :: xx_loc_p(:), tortuosity_loc_p(:)
4379) PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
4380) PetscInt :: icap,iphas,iphas_up,iphas_dn,icap_up,icap_dn
4381) PetscInt :: ii, jj
4382) PetscReal :: dw_kg,dw_mol,enth_src_co2,enth_src_h2o,rho
4383) PetscReal :: tsrc1,qsrc1,csrc1,hsrc1
4384) PetscReal :: dd_up, dd_dn, dd, f_up, f_dn
4385) PetscReal :: perm_up, perm_dn
4386) PetscReal :: dw_dp,dw_dt,hw_dp,hw_dt,dresT_dp,dresT_dt
4387) PetscReal :: D_up, D_dn ! "Diffusion" constants upstream and downstream of a face.
4388) PetscReal :: zero, norm
4389) PetscReal :: upweight
4390) PetscReal :: max_dev
4391) PetscInt :: local_id, ghosted_id
4392) PetscInt :: local_id_up, local_id_dn
4393) PetscInt :: ghosted_id_up, ghosted_id_dn
4394) PetscInt :: natural_id_up,natural_id_dn
4395)
4396) PetscReal :: Jup(1:realization%option%nflowdof,1:realization%option%nflowdof), &
4397) Jdn(1:realization%option%nflowdof,1:realization%option%nflowdof)
4398)
4399) PetscInt :: istart, iend
4400)
4401) type(coupler_type), pointer :: boundary_condition, source_sink
4402) type(connection_set_list_type), pointer :: connection_set_list
4403) type(connection_set_type), pointer :: cur_connection_set
4404) PetscBool :: enthalpy_flag
4405) PetscInt :: iconn, idof
4406) PetscInt :: sum_connection
4407) PetscReal :: distance, fraction_upwind
4408) PetscReal :: distance_gravity
4409) PetscReal :: Res(realization%option%nflowdof)
4410) PetscReal :: xxbc(1:realization%option%nflowdof), delxbc(1:realization%option%nflowdof)
4411) PetscReal :: ResInc(realization%patch%grid%nlmax,realization%option%nflowdof,&
4412) realization%option%nflowdof)
4413) type(grid_type), pointer :: grid
4414) type(patch_type), pointer :: patch
4415) type(option_type), pointer :: option
4416) type(field_type), pointer :: field
4417) type(Flash2_parameter_type), pointer :: Flash2_parameter
4418) type(Flash2_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
4419) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
4420) class(material_auxvar_type), pointer :: material_auxvars(:)
4421)
4422) PetscReal :: vv_darcy(realization%option%nphase), voltemp
4423) PetscReal :: ra(1:realization%option%nflowdof,1:realization%option%nflowdof*2)
4424) PetscReal, pointer :: msrc(:)
4425) PetscReal :: psrc(1:realization%option%nphase), ss_flow(1:realization%option%nphase)
4426) PetscReal :: dddt, dddp, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt,&
4427) dvdp, xphi
4428) PetscInt :: nsrcpara, flow_pc
4429)
4430) PetscViewer :: viewer
4431) Vec :: debug_vec
4432) character(len=MAXSTRINGLENGTH) :: string
4433)
4434) !-----------------------------------------------------------------------
4435) ! R stand for residual
4436) ! ra 1 2 3 4 5 6 7 8
4437) ! 1: p dR/dpi dR/dTi dR/dci dR/dsi dR/dpim dR/dTim
4438) ! 2: T
4439) ! 3: c
4440) ! 4 s
4441) !-----------------------------------------------------------------------
4442)
4443) patch => realization%patch
4444) grid => patch%grid
4445) option => realization%option
4446) field => realization%field
4447)
4448) Flash2_parameter => patch%aux%Flash2%Flash2_parameter
4449) auxvars => patch%aux%Flash2%auxvars
4450) auxvars_bc => patch%aux%Flash2%auxvars_bc
4451) global_auxvars => patch%aux%Global%auxvars
4452) global_auxvars_bc => patch%aux%Global%auxvars_bc
4453) material_auxvars => patch%aux%Material%auxvars
4454)
4455) ! dropped derivatives:
4456) ! 1.D0 gas phase viscocity to all p,t,c,s
4457) ! 2. Average molecular weights to p,t,s
4458) ! flag = SAME_NONZERO_PATTERN
4459)
4460) #if 0
4461) ! call Flash2NumericalJacobianTest(xx,realization)
4462) #endif
4463)
4464) ! print *,'*********** In Jacobian ********************** '
4465) ! call MatZeroEntries(A,ierr)
4466)
4467) call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
4468) call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
4469) ! call VecGetArrayF90(field%iphas_loc, iphase_loc_p, ierr)
4470)
4471) ResInc = 0.D0
4472) #if 1
4473) ! Accumulation terms ------------------------------------
4474) do local_id = 1, grid%nlmax ! For each local node do...
4475) ghosted_id = grid%nL2G(local_id)
4476) !geh - Ignore inactive cells with inactive materials
4477) if (associated(patch%imat)) then
4478) if (patch%imat(ghosted_id) <= 0) cycle
4479) endif
4480) iend = local_id*option%nflowdof
4481) istart = iend-option%nflowdof+1
4482) icap = int(icap_loc_p(ghosted_id))
4483)
4484) do nvar =1, option%nflowdof
4485) call Flash2Accumulation(auxvars(ghosted_id)%auxvar_elem(nvar), &
4486) global_auxvars(ghosted_id),&
4487) material_auxvars(ghosted_id)%porosity, &
4488) material_auxvars(ghosted_id)%volume, &
4489) Flash2_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
4490) option,ONE_INTEGER, res)
4491) ResInc( local_id,:,nvar) = ResInc(local_id,:,nvar) + Res(:)
4492) enddo
4493) enddo
4494) #endif
4495) #if 1
4496) ! Source/sink terms -------------------------------------
4497) source_sink => patch%source_sink_list%first
4498) sum_connection = 0
4499) do
4500) if (.not.associated(source_sink)) exit
4501)
4502) ! check whether enthalpy dof is included
4503) ! if (source_sink%flow_condition%num_sub_conditions > 3) then
4504) enthalpy_flag = PETSC_TRUE
4505) ! else
4506) ! enthalpy_flag = PETSC_FALSE
4507) ! endif
4508)
4509) if (associated(source_sink%flow_condition%pressure)) then
4510) psrc(:) = source_sink%flow_condition%pressure%dataset%rarray(:)
4511) endif
4512) tsrc1 = source_sink%flow_condition%temperature%dataset%rarray(1)
4513) csrc1 = source_sink%flow_condition%concentration%dataset%rarray(1)
4514) ! hsrc1=0.D0
4515) if (enthalpy_flag) hsrc1 = source_sink%flow_condition%enthalpy%dataset%rarray(1)
4516)
4517) ! qsrc1 = qsrc1 / FMWH2O ! [kg/s -> kmol/s; fmw -> g/mol = kg/kmol]
4518) ! csrc1 = csrc1 / FMWCO2
4519) select case(source_sink%flow_condition%itype(1))
4520) case(MASS_RATE_SS)
4521) msrc => source_sink%flow_condition%rate%dataset%rarray
4522) nsrcpara= 2
4523) case(WELL_SS)
4524) msrc => source_sink%flow_condition%well%dataset%rarray
4525) nsrcpara = 7 + option%nflowspec
4526) case default
4527) print *, 'Flash mode does not support source/sink type: ', source_sink%flow_condition%itype(1)
4528) stop
4529) end select
4530) cur_connection_set => source_sink%connection_set
4531)
4532) do iconn = 1, cur_connection_set%num_connections
4533) local_id = cur_connection_set%id_dn(iconn)
4534) ghosted_id = grid%nL2G(local_id)
4535)
4536) if (associated(patch%imat)) then
4537) if (patch%imat(ghosted_id) <= 0) cycle
4538) endif
4539) ! if (enthalpy_flag) then
4540) ! r_p(local_id*option%nflowdof) = r_p(local_id*option%nflowdof) - hsrc1 * option%flow_dt
4541) ! endif
4542) do nvar =1, option%nflowdof
4543) call Flash2SourceSink(msrc,nsrcpara,psrc,tsrc1,hsrc1,csrc1, auxvars(ghosted_id)%auxvar_elem(nvar),&
4544) source_sink%flow_condition%itype(1), Res,&
4545) ss_flow, &
4546) enthalpy_flag, option)
4547)
4548) ResInc(local_id,jh2o,nvar)= ResInc(local_id,jh2o,nvar) - Res(jh2o)
4549) ResInc(local_id,jco2,nvar)= ResInc(local_id,jco2,nvar) - Res(jco2)
4550) if (enthalpy_flag) &
4551) ResInc(local_id,option%nflowdof,nvar)=&
4552) ResInc(local_id,option%nflowdof,nvar)- Res(option%nflowdof)
4553)
4554) enddo
4555) enddo
4556) source_sink => source_sink%next
4557) enddo
4558) #endif
4559)
4560) ! Set matrix values related to single node terms: Accumulation, Source/Sink, BC
4561) do local_id = 1, grid%nlmax ! For each local node do...
4562) ghosted_id = grid%nL2G(local_id)
4563) !geh - Ignore inactive cells with inactive materials
4564) if (associated(patch%imat)) then
4565) if (patch%imat(ghosted_id) <= 0) cycle
4566) endif
4567)
4568) ra=0.D0
4569) max_dev=0.D0
4570) do neq=1, option%nflowdof
4571) do nvar=1, option%nflowdof
4572) ra(neq,nvar)=(ResInc(local_id,neq,nvar)-patch%aux%Flash2%ResOld_AR(local_id,neq))&
4573) /patch%aux%Flash2%delx(nvar,ghosted_id)
4574) if (max_dev < dabs(ra(3,nvar))) max_dev = dabs(ra(3,nvar))
4575) enddo
4576) enddo
4577)
4578) select case(option%idt_switch)
4579) case(1)
4580) ra(1:option%nflowdof,1:option%nflowdof) = &
4581) ra(1:option%nflowdof,1:option%nflowdof) /option%flow_dt
4582) case(-1)
4583) if (option%flow_dt>1) ra(1:option%nflowdof,1:option%nflowdof) = &
4584) ra(1:option%nflowdof,1:option%nflowdof) /option%flow_dt
4585) end select
4586)
4587) Jup=ra(1:option%nflowdof,1:option%nflowdof)
4588) if (material_auxvars(ghosted_id)%volume > 1.D0) &
4589) Jup=Jup / material_auxvars(ghosted_id)%volume
4590)
4591) ! if (local_id==1) print *, 'flash jac', volume_p(local_id), ra
4592) call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup,ADD_VALUES, &
4593) ierr);CHKERRQ(ierr)
4594) end do
4595)
4596) if (realization%debug%matview_Jacobian_detailed) then
4597) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
4598) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
4599) string = 'jacobian_srcsink'
4600) call DebugCreateViewer(realization%debug,string,option,viewer)
4601) call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
4602) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
4603) endif
4604)
4605) call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
4606) call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
4607) ! call VecRestoreArrayF90(field%iphas_loc, iphase_loc_p, ierr)
4608) ! print *,'end jac'
4609) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
4610) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
4611) ! call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr)
4612) #if 0
4613) ! zero out isothermal and inactive cells
4614) #ifdef ISOTHERMAL
4615) zero = 0.d0
4616) call MatZeroRowsLocal(A,n_zero_rows,zero_rows_local_ghosted,zero, &
4617) PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
4618) ierr);CHKERRQ(ierr)
4619) do i=1, n_zero_rows
4620) ii = mod(zero_rows_local(i),option%nflowdof)
4621) ip1 = zero_rows_local_ghosted(i)
4622) if (ii == 0) then
4623) ip2 = ip1-1
4624) elseif (ii == option%nflowdof-1) then
4625) ip2 = ip1+1
4626) else
4627) ip2 = ip1
4628) endif
4629) call MatSetValuesLocal(A,1,ip1,1,ip2,1.d0,INSERT_VALUES, &
4630) ierr);CHKERRQ(ierr)
4631) enddo
4632)
4633) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
4634) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
4635) #else
4636) #endif
4637) #endif
4638)
4639) if (patch%aux%Flash2%inactive_cells_exist) then
4640) f_up = 1.d0
4641) call MatZeroRowsLocal(A,patch%aux%Flash2%n_zero_rows, &
4642) patch%aux%Flash2%zero_rows_local_ghosted,f_up, &
4643) PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
4644) ierr);CHKERRQ(ierr)
4645) endif
4646)
4647) if (realization%debug%matview_Jacobian) then
4648) string = 'Fjacobian'
4649) call DebugCreateViewer(realization%debug,string,option,viewer)
4650) call MatView(A,viewer,ierr);CHKERRQ(ierr)
4651) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
4652) endif
4653) if (realization%debug%norm_Jacobian) then
4654) call MatNorm(A,NORM_1,norm,ierr);CHKERRQ(ierr)
4655) write(option%io_buffer,'("1 norm: ",es11.4)') norm
4656) call printMsg(option)
4657) call MatNorm(A,NORM_FROBENIUS,norm,ierr);CHKERRQ(ierr)
4658) write(option%io_buffer,'("2 norm: ",es11.4)') norm
4659) call printMsg(option)
4660) call MatNorm(A,NORM_INFINITY,norm,ierr);CHKERRQ(ierr)
4661) write(option%io_buffer,'("inf norm: ",es11.4)') norm
4662) call printMsg(option)
4663) ! call GridCreateVector(grid,ONEDOF,debug_vec,GLOBAL)
4664) ! call MatGetRowMaxAbs(A,debug_vec,PETSC_NULL_INTEGER,ierr)
4665) ! call VecMax(debug_vec,i,norm,ierr)
4666) ! call VecDestroy(debug_vec,ierr)
4667) endif
4668)
4669) end subroutine Flash2JacobianPatch2
4670)
4671) ! ************************************************************************** !
4672)
4673) subroutine Flash2MaxChange(realization,dpmax,dtmpmax,dsmax)
4674) !
4675) ! Computes the maximum change in the solution vector
4676) !
4677) ! Author: Chuan Lu
4678) ! Date: 01/15/08
4679) !
4680)
4681) use Realization_Subsurface_class
4682) use Field_module
4683) use Option_module
4684) use Field_module
4685)
4686) implicit none
4687)
4688) type(realization_subsurface_type) :: realization
4689)
4690) type(option_type), pointer :: option
4691) type(field_type), pointer :: field
4692) PetscErrorCode :: ierr
4693)
4694) PetscReal :: dpmax, dtmpmax, dsmax
4695)
4696) option => realization%option
4697) field => realization%field
4698)
4699) dpmax = 0.d0
4700) dtmpmax = 0.d0
4701) dsmax = 0.d0
4702)
4703) call VecWAXPY(field%flow_dxx,-1.d0,field%flow_xx,field%flow_yy, &
4704) ierr);CHKERRQ(ierr)
4705) call VecStrideNorm(field%flow_dxx,ZERO_INTEGER,NORM_INFINITY,dpmax, &
4706) ierr);CHKERRQ(ierr)
4707) call VecStrideNorm(field%flow_dxx,ONE_INTEGER,NORM_INFINITY,dtmpmax, &
4708) ierr);CHKERRQ(ierr)
4709) call VecStrideNorm(field%flow_dxx,TWO_INTEGER,NORM_INFINITY,dsmax, &
4710) ierr);CHKERRQ(ierr)
4711)
4712) end subroutine Flash2MaxChange
4713)
4714) ! ************************************************************************** !
4715)
4716) function Flash2GetTecplotHeader(realization, icolumn)
4717) !
4718) ! Returns Richards contribution to
4719) ! Tecplot file header
4720) !
4721) ! Author: Chuan Lu
4722) ! Date: 10/13/08
4723) !
4724)
4725) use Realization_Subsurface_class
4726) use Option_module
4727) use Field_module
4728)
4729) implicit none
4730)
4731) character(len=MAXSTRINGLENGTH) :: Flash2GetTecplotHeader
4732) type(realization_subsurface_type) :: realization
4733) PetscInt :: icolumn
4734)
4735) character(len=MAXSTRINGLENGTH) :: string, string2
4736) type(option_type), pointer :: option
4737) type(field_type), pointer :: field
4738) PetscInt :: i
4739)
4740) option => realization%option
4741) field => realization%field
4742)
4743) string = ''
4744)
4745) if (icolumn > -1) then
4746) icolumn = icolumn + 1
4747) write(string2,'('',"'',i2,''-T [C]"'')') icolumn
4748) else
4749) write(string2,'('',"T [C]"'')')
4750) endif
4751) string = trim(string) // trim(string2)
4752)
4753) if (icolumn > -1) then
4754) icolumn = icolumn + 1
4755) write(string2,'('',"'',i2,''-P [Pa]"'')') icolumn
4756) else
4757) write(string2,'('',"P [Pa]"'')')
4758) endif
4759) string = trim(string) // trim(string2)
4760)
4761) if (icolumn > -1) then
4762) icolumn = icolumn + 1
4763) write(string2,'('',"'',i2,''-PHASE"'')') icolumn
4764) else
4765) write(string2,'('',"PHASE"'')')
4766) endif
4767) string = trim(string) // trim(string2)
4768)
4769) if (icolumn > -1) then
4770) icolumn = icolumn + 1
4771) write(string2,'('',"'',i2,''-S(l)"'')') icolumn
4772) else
4773) write(string2,'('',"S(l)"'')')
4774) endif
4775) string = trim(string) // trim(string2)
4776)
4777) if (icolumn > -1) then
4778) icolumn = icolumn + 1
4779) write(string2,'('',"'',i2,''-S(g)"'')') icolumn
4780) else
4781) write(string2,'('',"S(g)"'')')
4782) endif
4783) string = trim(string) // trim(string2)
4784)
4785) if (icolumn > -1) then
4786) icolumn = icolumn + 1
4787) write(string2,'('',"'',i2,''-d(l)"'')') icolumn
4788) else
4789) write(string2,'('',"d(l)"'')')
4790) endif
4791) string = trim(string) // trim(string2)
4792)
4793) if (icolumn > -1) then
4794) icolumn = icolumn + 1
4795) write(string2,'('',"'',i2,''-d(g)"'')') icolumn
4796) else
4797) write(string2,'('',"d(g)"'')')
4798) endif
4799) string = trim(string) // trim(string2)
4800)
4801) if (icolumn > -1) then
4802) icolumn = icolumn + 1
4803) write(string2,'('',"'',i2,''-vis(l)"'')') icolumn
4804) else
4805) write(string2,'('',"vis(l)"'')')
4806) endif
4807) string = trim(string) // trim(string2)
4808)
4809) if (icolumn > -1) then
4810) icolumn = icolumn + 1
4811) write(string2,'('',"'',i2,''-vis(g)"'')') icolumn
4812) else
4813) write(string2,'('',"vis(g)"'')')
4814) endif
4815) string = trim(string) // trim(string2)
4816)
4817) if (icolumn > -1) then
4818) icolumn = icolumn + 1
4819) write(string2,'('',"'',i2,''-kvr(l)"'')') icolumn
4820) else
4821) write(string2,'('',"kvr(l)"'')')
4822) endif
4823) string = trim(string) // trim(string2)
4824)
4825) if (icolumn > -1) then
4826) icolumn = icolumn + 1
4827) write(string2,'('',"'',i2,''-kvr(g)"'')') icolumn
4828) else
4829) write(string2,'('',"kvr(g)"'')')
4830) endif
4831) string = trim(string) // trim(string2)
4832)
4833) if (icolumn > -1) then
4834) icolumn = icolumn + 1
4835) write(string2,'('',"'',i2,''-u(l)"'')') icolumn
4836) else
4837) write(string2,'('',"u(l)"'')')
4838) endif
4839) string = trim(string) // trim(string2)
4840)
4841) if (icolumn > -1) then
4842) icolumn = icolumn + 1
4843) write(string2,'('',"'',i2,''-u(g)"'')') icolumn
4844) else
4845) write(string2,'('',"u(g)"'')')
4846) endif
4847) string = trim(string) // trim(string2)
4848) do i=1,option%nflowspec
4849) if (icolumn > -1) then
4850) icolumn = icolumn + 1
4851) write(string2,'('',"'',i2,''-Xl('',i2,'')"'')') icolumn, i
4852) else
4853) write(string2,'('',"Xl('',i2,'')"'')') i
4854) endif
4855) string = trim(string) // trim(string2)
4856) enddo
4857)
4858) do i=1,option%nflowspec
4859) if (icolumn > -1) then
4860) icolumn = icolumn + 1
4861) write(string2,'('',"'',i2,''-Xg('',i2,'')"'')') icolumn, i
4862) else
4863) write(string2,'('',"Xg('',i2,'')"'')') i
4864) endif
4865) string = trim(string) // trim(string2)
4866) enddo
4867)
4868) Flash2GetTecplotHeader = string
4869)
4870) end function Flash2GetTecplotHeader
4871)
4872) ! ************************************************************************** !
4873)
4874) subroutine Flash2SetPlotVariables(list)
4875) !
4876) ! Adds variables to be printed to list
4877) !
4878) ! Author: Glenn Hammond
4879) ! Date: 10/15/12
4880) !
4881)
4882) use Output_Aux_module
4883) use Variables_module
4884)
4885) implicit none
4886)
4887) type(output_variable_list_type), pointer :: list
4888)
4889) type(output_variable_type) :: output_variable
4890) character(len=MAXWORDLENGTH) :: name, units
4891)
4892) if (associated(list%first)) then
4893) return
4894) endif
4895)
4896) name = 'Temperature'
4897) units = 'C'
4898) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4899) TEMPERATURE)
4900)
4901) name = 'Liquid Pressure'
4902) units = 'Pa'
4903) call OutputVariableAddToList(list,name,OUTPUT_PRESSURE,units, &
4904) LIQUID_PRESSURE)
4905)
4906) name = 'Gas Pressure'
4907) units = 'Pa'
4908) call OutputVariableAddToList(list,name,OUTPUT_PRESSURE,units, &
4909) GAS_PRESSURE)
4910)
4911) name = 'Liquid Saturation'
4912) units = ''
4913) call OutputVariableAddToList(list,name,OUTPUT_SATURATION,units, &
4914) LIQUID_SATURATION)
4915)
4916) name = 'Gas Saturation'
4917) units = ''
4918) call OutputVariableAddToList(list,name,OUTPUT_SATURATION,units, &
4919) GAS_SATURATION)
4920)
4921) name = 'Liquid Density'
4922) units = 'kg/m^3'
4923) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4924) LIQUID_DENSITY)
4925)
4926) name = 'Gas Density'
4927) units = 'kg/m^3'
4928) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4929) GAS_DENSITY)
4930)
4931) name = 'Liquid Energy'
4932) units = 'kJ/mol'
4933) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4934) LIQUID_ENERGY)
4935)
4936) name = 'Gas Energy'
4937) units = 'kJ/mol'
4938) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4939) GAS_ENERGY)
4940)
4941) name = 'Liquid Viscosity'
4942) units = 'Pa.s'
4943) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4944) LIQUID_VISCOSITY)
4945)
4946) name = 'Gas Viscosity'
4947) units = 'Pa.s'
4948) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4949) GAS_VISCOSITY)
4950)
4951) name = 'Liquid Mobility'
4952) units = '1/Pa.s'
4953) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4954) LIQUID_MOBILITY)
4955)
4956) name = 'Gas Mobility'
4957) units = '1/Pa.s'
4958) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4959) GAS_MOBILITY)
4960)
4961) name = 'Liquid Mole Fraction H2O'
4962) units = ''
4963) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4964) LIQUID_MOLE_FRACTION,ONE_INTEGER)
4965)
4966) name = 'Liquid Mole Fraction CO2'
4967) units = ''
4968) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4969) LIQUID_MOLE_FRACTION,TWO_INTEGER)
4970)
4971) name = 'Gas Mole Fraction H2O'
4972) units = ''
4973) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4974) GAS_MOLE_FRACTION,ONE_INTEGER)
4975)
4976) name = 'Gas Mole Fraction CO2'
4977) units = ''
4978) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4979) GAS_MOLE_FRACTION,TWO_INTEGER)
4980)
4981) name = 'Phase'
4982) units = ''
4983) output_variable%iformat = 1 ! integer
4984) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
4985) PHASE)
4986)
4987) end subroutine Flash2SetPlotVariables
4988)
4989) ! ************************************************************************** !
4990)
4991) subroutine Flash2Destroy(realization)
4992) !
4993) ! Deallocates variables associated with Flash2
4994) !
4995) ! Author: Chuan Lu
4996) ! Date: 10/14/08
4997) !
4998)
4999) use Realization_Subsurface_class
5000)
5001) implicit none
5002)
5003) type(realization_subsurface_type) :: realization
5004)
5005) ! need to free array in aux vars
5006) !call Flash2AuxDestroy(patch%aux%Flash2)
5007)
5008) end subroutine Flash2Destroy
5009)
5010)
5011) #if 0
5012)
5013) ! ************************************************************************** !
5014)
5015) subroutine Flash2CheckpointWrite(discretization, viewer)
5016) !
5017) ! Writes vecs to checkpoint file
5018) ! date:
5019) !
5020) ! Author: Chuan Lu
5021) !
5022)
5023) use Discretization_module
5024)
5025) implicit none
5026)
5027) type(discretization_type) :: discretization
5028) PetscViewer :: viewer
5029)
5030) Vec :: global_var
5031) PetscErrorCode :: ierr
5032)
5033) call VecView(global_var,viewer,ierr);CHKERRQ(ierr)
5034) call VecDestroy(global_var,ierr);CHKERRQ(ierr)
5035)
5036)
5037) end subroutine Flash2CheckpointWrite
5038)
5039) ! ************************************************************************** !
5040)
5041) subroutine Flash2CheckpointRead(discretization,viewer)
5042) !
5043) ! Reads vecs from checkpoint file
5044) ! date:
5045) !
5046) ! Author: Chuan Lu
5047) !
5048)
5049) use Discretization_module
5050)
5051) implicit none
5052)
5053) type(discretization_type) :: discretization
5054) PetscViewer :: viewer
5055)
5056) Vec :: global_var
5057) PetscErrorCode :: ierr
5058)
5059) call VecLoad(global_var, viewer, ierr);CHKERRQ(ierr)
5060) call VecDestroy(global_var,ierr);CHKERRQ(ierr)
5061)
5062) end subroutine Flash2CheckpointRead
5063)
5064) #endif
5065)
5066) end module Flash2_module