general.F90 coverage: 81.48 %func 56.52 %block
1) module General_module
2)
3) use General_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) #include "petsc/finclude/petscvec.h"
14) #include "petsc/finclude/petscvec.h90"
15) #include "petsc/finclude/petscmat.h"
16) #include "petsc/finclude/petscmat.h90"
17) #include "petsc/finclude/petscsnes.h"
18) #include "petsc/finclude/petscviewer.h"
19) #include "petsc/finclude/petsclog.h"
20)
21) #define CONVECTION
22) #define DIFFUSION
23) #define LIQUID_DIFFUSION
24) #define CONDUCTION
25)
26) !#define DEBUG_GENERAL_FILEOUTPUT
27) !#define DEBUG_FLUXES
28)
29) ! Cutoff parameters
30) PetscReal, parameter :: eps = 1.d-8
31) PetscReal, parameter :: floweps = 1.d-24
32)
33) #ifdef DEBUG_GENERAL_FILEOUTPUT
34) PetscInt, parameter :: debug_unit = 87
35) PetscInt, parameter :: debug_info_unit = 86
36) character(len=MAXWORDLENGTH) :: debug_filename
37) PetscInt :: debug_flag = 0
38) PetscInt :: debug_iteration_count
39) PetscInt :: debug_timestep_cut_count
40) PetscInt :: debug_timestep_count
41) #endif
42)
43) public :: GeneralSetup, &
44) GeneralInitializeTimestep, &
45) GeneralUpdateSolution, &
46) GeneralTimeCut,&
47) GeneralUpdateAuxVars, &
48) GeneralUpdateFixedAccum, &
49) GeneralComputeMassBalance, &
50) GeneralResidual, &
51) GeneralJacobian, &
52) GeneralGetTecplotHeader, &
53) GeneralSetPlotVariables, &
54) GeneralMapBCAuxVarsToGlobal, &
55) GeneralDestroy
56)
57) contains
58)
59) ! ************************************************************************** !
60)
61) subroutine GeneralSetup(realization)
62) !
63) ! Creates arrays for auxiliary variables
64) !
65) ! Author: Glenn Hammond
66) ! Date: 03/10/11
67) !
68)
69) use Realization_Subsurface_class
70) use Patch_module
71) use Option_module
72) use Coupler_module
73) use Connection_module
74) use Grid_module
75) use Fluid_module
76) use Material_Aux_class
77) use Output_Aux_module
78)
79) implicit none
80)
81) type(realization_subsurface_type) :: realization
82)
83) type(option_type), pointer :: option
84) type(patch_type),pointer :: patch
85) type(grid_type), pointer :: grid
86) type(output_variable_list_type), pointer :: list
87) type(coupler_type), pointer :: boundary_condition
88) type(material_parameter_type), pointer :: material_parameter
89)
90) PetscInt :: ghosted_id, iconn, sum_connection, local_id
91) PetscInt :: i, idof, count
92) PetscBool :: error_found
93) PetscInt :: flag(10)
94) ! extra index for derivatives
95) type(general_auxvar_type), pointer :: gen_auxvars(:,:)
96) type(general_auxvar_type), pointer :: gen_auxvars_bc(:)
97) type(general_auxvar_type), pointer :: gen_auxvars_ss(:)
98) class(material_auxvar_type), pointer :: material_auxvars(:)
99) type(fluid_property_type), pointer :: cur_fluid_property
100)
101) option => realization%option
102) patch => realization%patch
103) grid => patch%grid
104)
105) patch%aux%General => GeneralAuxCreate(option)
106)
107) ! ensure that material properties specific to this module are properly
108) ! initialized
109) material_parameter => patch%aux%Material%material_parameter
110) error_found = PETSC_FALSE
111) if (minval(material_parameter%soil_residual_saturation(:,:)) < 0.d0) then
112) option%io_buffer = 'Non-initialized soil residual saturation.'
113) call printMsg(option)
114) error_found = PETSC_TRUE
115) endif
116) if (minval(material_parameter%soil_heat_capacity(:)) < 0.d0) then
117) option%io_buffer = 'Non-initialized soil heat capacity.'
118) call printMsg(option)
119) error_found = PETSC_TRUE
120) endif
121) if (minval(material_parameter%soil_thermal_conductivity(:,:)) < 0.d0) then
122) option%io_buffer = 'Non-initialized soil thermal conductivity.'
123) call printMsg(option)
124) error_found = PETSC_TRUE
125) endif
126)
127) material_auxvars => patch%aux%Material%auxvars
128) flag = 0
129) !TODO(geh): change to looping over ghosted ids once the legacy code is
130) ! history and the communicator can be passed down.
131) do local_id = 1, grid%nlmax
132) ghosted_id = grid%nL2G(local_id)
133) if (patch%imat(ghosted_id) <= 0) cycle
134) if (material_auxvars(ghosted_id)%volume < 0.d0 .and. flag(1) == 0) then
135) flag(1) = 1
136) option%io_buffer = 'Non-initialized cell volume.'
137) call printMsg(option)
138) endif
139) if (material_auxvars(ghosted_id)%porosity < 0.d0 .and. flag(2) == 0) then
140) flag(2) = 1
141) option%io_buffer = 'Non-initialized porosity.'
142) call printMsg(option)
143) endif
144) if (material_auxvars(ghosted_id)%tortuosity < 0.d0 .and. flag(3) == 0) then
145) flag(3) = 1
146) option%io_buffer = 'Non-initialized tortuosity.'
147) call printMsg(option)
148) endif
149) if (material_auxvars(ghosted_id)%soil_particle_density < 0.d0 .and. &
150) flag(4) == 0) then
151) flag(4) = 1
152) option%io_buffer = 'Non-initialized soil particle density.'
153) call printMsg(option)
154) endif
155) if (minval(material_auxvars(ghosted_id)%permeability) < 0.d0 .and. &
156) flag(5) == 0) then
157) option%io_buffer = 'Non-initialized permeability.'
158) call printMsg(option)
159) flag(5) = 1
160) endif
161) enddo
162)
163) if (error_found .or. maxval(flag) > 0) then
164) option%io_buffer = 'Material property errors found in GeneralSetup.'
165) call printErrMsg(option)
166) endif
167)
168) ! allocate auxvar data structures for all grid cells
169) allocate(gen_auxvars(0:option%nflowdof,grid%ngmax))
170) do ghosted_id = 1, grid%ngmax
171) do idof = 0, option%nflowdof
172) call GeneralAuxVarInit(gen_auxvars(idof,ghosted_id), &
173) (general_analytical_derivatives .and. idof==0), &
174) option)
175) enddo
176) enddo
177) patch%aux%General%auxvars => gen_auxvars
178) patch%aux%General%num_aux = grid%ngmax
179)
180) ! count the number of boundary connections and allocate
181) ! auxvar data structures for them
182) sum_connection = CouplerGetNumConnectionsInList(patch%boundary_condition_list)
183) if (sum_connection > 0) then
184) allocate(gen_auxvars_bc(sum_connection))
185) do iconn = 1, sum_connection
186) call GeneralAuxVarInit(gen_auxvars_bc(iconn),PETSC_FALSE,option)
187) enddo
188) patch%aux%General%auxvars_bc => gen_auxvars_bc
189) endif
190) patch%aux%General%num_aux_bc = sum_connection
191)
192) ! count the number of source/sink connections and allocate
193) ! auxvar data structures for them
194) sum_connection = CouplerGetNumConnectionsInList(patch%source_sink_list)
195) if (sum_connection > 0) then
196) allocate(gen_auxvars_ss(sum_connection))
197) do iconn = 1, sum_connection
198) call GeneralAuxVarInit(gen_auxvars_ss(iconn),PETSC_FALSE,option)
199) enddo
200) patch%aux%General%auxvars_ss => gen_auxvars_ss
201) endif
202) patch%aux%General%num_aux_ss = sum_connection
203)
204) ! create array for zeroing Jacobian entries if isothermal and/or no air
205) allocate(patch%aux%General%row_zeroing_array(grid%nlmax))
206) patch%aux%General%row_zeroing_array = 0
207)
208) ! initialize parameters
209) cur_fluid_property => realization%fluid_properties
210) do
211) if (.not.associated(cur_fluid_property)) exit
212) patch%aux%General%general_parameter% &
213) diffusion_coefficient(cur_fluid_property%phase_id) = &
214) cur_fluid_property%diffusion_coefficient
215) cur_fluid_property => cur_fluid_property%next
216) enddo
217) ! check whether diffusion coefficients are initialized.
218) if (Uninitialized(patch%aux%General%general_parameter% &
219) diffusion_coefficient(LIQUID_PHASE))) then
220) option%io_buffer = &
221) UninitializedMessage('Liquid phase diffusion coefficient','')
222) call printErrMsg(option)
223) endif
224) if (Uninitialized(patch%aux%General%general_parameter% &
225) diffusion_coefficient(GAS_PHASE))) then
226) option%io_buffer = &
227) UninitializedMessage('Gas phase diffusion coefficient','')
228) call printErrMsg(option)
229) endif
230)
231) list => realization%output_option%output_snap_variable_list
232) call GeneralSetPlotVariables(realization,list)
233) list => realization%output_option%output_obs_variable_list
234) call GeneralSetPlotVariables(realization,list)
235)
236) #ifdef DEBUG_GENERAL_FILEOUTPUT
237) debug_flag = 0
238) debug_iteration_count = 0
239) debug_timestep_cut_count = 0
240) debug_timestep_count = 0
241) ! create new file
242) open(debug_info_unit, file='debug_info.txt', action="write", &
243) status="unknown")
244) write(debug_info_unit,*) 'type timestep cut iteration'
245) close(debug_info_unit)
246) #endif
247)
248) end subroutine GeneralSetup
249)
250) ! ************************************************************************** !
251)
252) subroutine GeneralInitializeTimestep(realization)
253) !
254) ! Update data in module prior to time step
255) !
256) ! Author: Glenn Hammond
257) ! Date: 03/10/11
258) !
259)
260) use Realization_Subsurface_class
261)
262) implicit none
263)
264) type(realization_subsurface_type) :: realization
265)
266) call GeneralUpdateFixedAccum(realization)
267)
268) #ifdef DEBUG_GENERAL_FILEOUTPUT
269) debug_flag = 0
270) ! if (realization%option%time >= 35.6d0*3600d0*24.d0*365.d0 - 1.d-40) then
271) ! if (.false.) then
272) if (.true.) then
273) debug_iteration_count = 0
274) debug_flag = 1
275) endif
276) debug_iteration_count = 0
277) #endif
278)
279) end subroutine GeneralInitializeTimestep
280)
281) ! ************************************************************************** !
282)
283) subroutine GeneralUpdateSolution(realization)
284) !
285) ! Updates data in module after a successful time
286) ! step
287) !
288) ! Author: Glenn Hammond
289) ! Date: 03/10/11
290) !
291)
292) use Realization_Subsurface_class
293) use Field_module
294) use Patch_module
295) use Discretization_module
296) use Option_module
297) use Grid_module
298)
299) implicit none
300)
301) type(realization_subsurface_type) :: realization
302)
303) type(option_type), pointer :: option
304) type(patch_type), pointer :: patch
305) type(grid_type), pointer :: grid
306) type(field_type), pointer :: field
307) type(general_auxvar_type), pointer :: gen_auxvars(:,:)
308) type(global_auxvar_type), pointer :: global_auxvars(:)
309) PetscInt :: local_id, ghosted_id
310) PetscErrorCode :: ierr
311)
312) option => realization%option
313) field => realization%field
314) patch => realization%patch
315) grid => patch%grid
316) gen_auxvars => patch%aux%General%auxvars
317) global_auxvars => patch%aux%Global%auxvars
318)
319) if (realization%option%compute_mass_balance_new) then
320) call GeneralUpdateMassBalance(realization)
321) endif
322)
323) ! update stored state
324) do ghosted_id = 1, grid%ngmax
325) gen_auxvars(ZERO_INTEGER,ghosted_id)%istate_store(PREV_TS) = &
326) global_auxvars(ghosted_id)%istate
327) enddo
328)
329) #ifdef DEBUG_GENERAL_FILEOUTPUT
330) debug_iteration_count = 0
331) debug_timestep_cut_count = 0
332) debug_timestep_count = debug_timestep_count + 1
333) #endif
334)
335) end subroutine GeneralUpdateSolution
336)
337) ! ************************************************************************** !
338)
339) subroutine GeneralTimeCut(realization)
340) !
341) ! Resets arrays for time step cut
342) !
343) ! Author: Glenn Hammond
344) ! Date: 03/10/11
345) !
346) use Realization_Subsurface_class
347) use Option_module
348) use Field_module
349) use Patch_module
350) use Discretization_module
351) use Grid_module
352)
353) implicit none
354)
355) type(realization_subsurface_type) :: realization
356) type(option_type), pointer :: option
357) type(patch_type), pointer :: patch
358) type(grid_type), pointer :: grid
359) type(global_auxvar_type), pointer :: global_auxvars(:)
360) type(general_auxvar_type), pointer :: gen_auxvars(:,:)
361)
362) PetscInt :: local_id, ghosted_id
363) PetscErrorCode :: ierr
364)
365) option => realization%option
366) patch => realization%patch
367) grid => patch%grid
368) global_auxvars => patch%aux%Global%auxvars
369) gen_auxvars => patch%aux%General%auxvars
370)
371) ! restore stored state
372) do ghosted_id = 1, grid%ngmax
373) global_auxvars(ghosted_id)%istate = &
374) gen_auxvars(ZERO_INTEGER,ghosted_id)%istate_store(PREV_TS)
375) enddo
376)
377) #ifdef DEBUG_GENERAL_FILEOUTPUT
378) debug_timestep_cut_count = debug_timestep_cut_count + 1
379) #endif
380)
381) call GeneralInitializeTimestep(realization)
382)
383) end subroutine GeneralTimeCut
384)
385) ! ************************************************************************** !
386)
387) subroutine GeneralNumericalJacobianTest(xx,realization,B)
388) !
389) ! Computes the a test numerical jacobian
390) !
391) ! Author: Glenn Hammond
392) ! Date: 03/03/15
393) !
394)
395) use Realization_Subsurface_class
396) use Patch_module
397) use Option_module
398) use Grid_module
399) use Field_module
400)
401) implicit none
402)
403) Vec :: xx
404) type(realization_subsurface_type) :: realization
405) Mat :: B
406)
407) Vec :: xx_pert
408) Vec :: res
409) Vec :: res_pert
410) Mat :: A
411) PetscViewer :: viewer
412) PetscErrorCode :: ierr
413)
414) PetscReal, pointer :: vec_p(:), vec2_p(:)
415)
416) type(grid_type), pointer :: grid
417) type(option_type), pointer :: option
418) type(patch_type), pointer :: patch
419) type(field_type), pointer :: field
420) PetscReal :: derivative, perturbation
421) PetscReal :: perturbation_tolerance = 1.d-6
422) PetscInt, save :: icall = 0
423) character(len=MAXWORDLENGTH) :: word, word2
424)
425) PetscInt :: idof, idof2, icell
426)
427) patch => realization%patch
428) grid => patch%grid
429) option => realization%option
430) field => realization%field
431)
432) icall = icall + 1
433) call VecDuplicate(xx,xx_pert,ierr);CHKERRQ(ierr)
434) call VecDuplicate(xx,res,ierr);CHKERRQ(ierr)
435) call VecDuplicate(xx,res_pert,ierr);CHKERRQ(ierr)
436)
437) call MatCreate(option%mycomm,A,ierr);CHKERRQ(ierr)
438) call MatSetType(A,MATAIJ,ierr);CHKERRQ(ierr)
439) call MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,grid%nlmax*option%nflowdof, &
440) grid%nlmax*option%nflowdof, &
441) ierr);CHKERRQ(ierr)
442) call MatSeqAIJSetPreallocation(A,27,PETSC_NULL_INTEGER,ierr);CHKERRQ(ierr)
443) call MatSetFromOptions(A,ierr);CHKERRQ(ierr)
444) call MatSetOption(A,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE, &
445) ierr);CHKERRQ(ierr)
446)
447) call VecZeroEntries(res,ierr);CHKERRQ(ierr)
448) call GeneralResidual(PETSC_NULL_OBJECT,xx,res,realization,ierr)
449) #if 0
450) word = 'num_0.dat'
451) call PetscViewerASCIIOpen(option%mycomm,word,viewer,ierr);CHKERRQ(ierr)
452) call VecView(res,viewer,ierr);CHKERRQ(ierr)
453) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
454) #endif
455) call VecGetArrayF90(res,vec2_p,ierr);CHKERRQ(ierr)
456) do icell = 1,grid%nlmax
457) if (patch%imat(grid%nL2G(icell)) <= 0) cycle
458) do idof = (icell-1)*option%nflowdof+1,icell*option%nflowdof
459) call VecCopy(xx,xx_pert,ierr);CHKERRQ(ierr)
460) call VecGetArrayF90(xx_pert,vec_p,ierr);CHKERRQ(ierr)
461) perturbation = vec_p(idof)*perturbation_tolerance
462) vec_p(idof) = vec_p(idof)+perturbation
463) call VecRestoreArrayF90(xx_pert,vec_p,ierr);CHKERRQ(ierr)
464) call VecZeroEntries(res_pert,ierr);CHKERRQ(ierr)
465) call GeneralResidual(PETSC_NULL_OBJECT,xx_pert,res_pert,realization,ierr)
466) #if 0
467) write(word,*) idof
468) word = 'num_' // trim(adjustl(word)) // '.dat'
469) call PetscViewerASCIIOpen(option%mycomm,word,viewer,ierr);CHKERRQ(ierr)
470) call VecView(res_pert,viewer,ierr);CHKERRQ(ierr)
471) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
472) #endif
473) call VecGetArrayF90(res_pert,vec_p,ierr);CHKERRQ(ierr)
474) do idof2 = 1, grid%nlmax*option%nflowdof
475) derivative = (vec_p(idof2)-vec2_p(idof2))/perturbation
476) if (dabs(derivative) > 1.d-30) then
477) call MatSetValue(A,idof2-1,idof-1,derivative,INSERT_VALUES, &
478) ierr);CHKERRQ(ierr)
479) endif
480) enddo
481) call VecRestoreArrayF90(res_pert,vec_p,ierr);CHKERRQ(ierr)
482) enddo
483) enddo
484) call VecRestoreArrayF90(res,vec2_p,ierr);CHKERRQ(ierr)
485)
486) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
487) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
488)
489) #if 1
490) write(word,*) icall
491) word = 'numerical_jacobian-' // trim(adjustl(word)) // '.out'
492) call PetscViewerASCIIOpen(option%mycomm,word,viewer,ierr);CHKERRQ(ierr)
493) call MatView(A,viewer,ierr);CHKERRQ(ierr)
494) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
495) #endif
496)
497) !geh: uncomment to overwrite numerical Jacobian
498) ! call MatCopy(A,B,DIFFERENT_NONZERO_PATTERN,ierr)
499) call MatDestroy(A,ierr);CHKERRQ(ierr)
500)
501) call VecDestroy(xx_pert,ierr);CHKERRQ(ierr)
502) call VecDestroy(res,ierr);CHKERRQ(ierr)
503) call VecDestroy(res_pert,ierr);CHKERRQ(ierr)
504)
505) end subroutine GeneralNumericalJacobianTest
506)
507) ! ************************************************************************** !
508)
509) subroutine GeneralComputeMassBalance(realization,mass_balance)
510) !
511) ! Initializes mass balance
512) !
513) ! Author: Glenn Hammond
514) ! Date: 03/10/11
515) !
516)
517) use Realization_Subsurface_class
518) use Option_module
519) use Patch_module
520) use Field_module
521) use Grid_module
522) use Material_Aux_class
523)
524) implicit none
525)
526) type(realization_subsurface_type) :: realization
527) PetscReal :: mass_balance(realization%option%nflowspec, &
528) realization%option%nphase)
529)
530) type(option_type), pointer :: option
531) type(patch_type), pointer :: patch
532) type(field_type), pointer :: field
533) type(grid_type), pointer :: grid
534) type(general_auxvar_type), pointer :: general_auxvars(:,:)
535) class(material_auxvar_type), pointer :: material_auxvars(:)
536)
537) PetscErrorCode :: ierr
538) PetscInt :: local_id
539) PetscInt :: ghosted_id
540) PetscInt :: iphase, icomp
541) PetscReal :: vol_phase
542)
543) option => realization%option
544) patch => realization%patch
545) grid => patch%grid
546) field => realization%field
547)
548) general_auxvars => patch%aux%General%auxvars
549) material_auxvars => patch%aux%Material%auxvars
550)
551) mass_balance = 0.d0
552)
553) do local_id = 1, grid%nlmax
554) ghosted_id = grid%nL2G(local_id)
555) !geh - Ignore inactive cells with inactive materials
556) if (patch%imat(ghosted_id) <= 0) cycle
557) do iphase = 1, option%nphase
558) ! volume_phase = saturation*porosity*volume
559) vol_phase = &
560) general_auxvars(ZERO_INTEGER,ghosted_id)%sat(iphase)* &
561) general_auxvars(ZERO_INTEGER,ghosted_id)%effective_porosity* &
562) material_auxvars(ghosted_id)%volume
563) ! mass = volume_phase*density
564) do icomp = 1, option%nflowspec
565) mass_balance(icomp,iphase) = mass_balance(icomp,iphase) + &
566) general_auxvars(ZERO_INTEGER,ghosted_id)%den(iphase)* &
567) general_auxvars(ZERO_INTEGER,ghosted_id)%xmol(icomp,iphase) * &
568) fmw_comp(icomp)*vol_phase
569) enddo
570) enddo
571) enddo
572)
573) end subroutine GeneralComputeMassBalance
574)
575) ! ************************************************************************** !
576)
577) subroutine GeneralZeroMassBalanceDelta(realization)
578) !
579) ! Zeros mass balance delta array
580) !
581) ! Author: Glenn Hammond
582) ! Date: 03/10/11
583) !
584)
585) use Realization_Subsurface_class
586) use Option_module
587) use Patch_module
588) use Grid_module
589)
590) implicit none
591)
592) type(realization_subsurface_type) :: realization
593)
594) type(option_type), pointer :: option
595) type(patch_type), pointer :: patch
596) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
597) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
598)
599) PetscInt :: iconn
600)
601) option => realization%option
602) patch => realization%patch
603)
604) global_auxvars_bc => patch%aux%Global%auxvars_bc
605) global_auxvars_ss => patch%aux%Global%auxvars_ss
606)
607) do iconn = 1, patch%aux%General%num_aux_bc
608) global_auxvars_bc(iconn)%mass_balance_delta = 0.d0
609) enddo
610) do iconn = 1, patch%aux%General%num_aux_ss
611) global_auxvars_ss(iconn)%mass_balance_delta = 0.d0
612) enddo
613)
614) end subroutine GeneralZeroMassBalanceDelta
615)
616) ! ************************************************************************** !
617)
618) subroutine GeneralUpdateMassBalance(realization)
619) !
620) ! Updates mass balance
621) !
622) ! Author: Glenn Hammond
623) ! Date: 03/10/11
624) !
625)
626) use Realization_Subsurface_class
627) use Option_module
628) use Patch_module
629) use Grid_module
630)
631) implicit none
632)
633) type(realization_subsurface_type) :: realization
634)
635) type(option_type), pointer :: option
636) type(patch_type), pointer :: patch
637) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
638) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
639)
640) PetscInt :: iconn
641) PetscInt :: icomp
642)
643) option => realization%option
644) patch => realization%patch
645)
646) global_auxvars_bc => patch%aux%Global%auxvars_bc
647) global_auxvars_ss => patch%aux%Global%auxvars_ss
648)
649) do iconn = 1, patch%aux%General%num_aux_bc
650) do icomp = 1, option%nflowspec
651) global_auxvars_bc(iconn)%mass_balance(icomp,:) = &
652) global_auxvars_bc(iconn)%mass_balance(icomp,:) + &
653) global_auxvars_bc(iconn)%mass_balance_delta(icomp,:)* &
654) fmw_comp(icomp)*option%flow_dt
655) enddo
656) enddo
657) do iconn = 1, patch%aux%General%num_aux_ss
658) do icomp = 1, option%nflowspec
659) global_auxvars_ss(iconn)%mass_balance(icomp,:) = &
660) global_auxvars_ss(iconn)%mass_balance(icomp,:) + &
661) global_auxvars_ss(iconn)%mass_balance_delta(icomp,:)* &
662) fmw_comp(icomp)*option%flow_dt
663) enddo
664) enddo
665)
666) end subroutine GeneralUpdateMassBalance
667)
668) ! ************************************************************************** !
669)
670) subroutine GeneralUpdateAuxVars(realization,update_state)
671) !
672) ! Updates the auxiliary variables associated with the General problem
673) !
674) ! Author: Glenn Hammond
675) ! Date: 03/10/11
676) !
677)
678) use Realization_Subsurface_class
679) use Patch_module
680) use Option_module
681) use Field_module
682) use Grid_module
683) use Coupler_module
684) use Connection_module
685) use Material_module
686) use Material_Aux_class
687) use EOS_Water_module
688) use Saturation_Function_module
689)
690) implicit none
691)
692) type(realization_subsurface_type) :: realization
693) PetscBool :: update_state
694)
695) type(option_type), pointer :: option
696) type(patch_type), pointer :: patch
697) type(grid_type), pointer :: grid
698) type(field_type), pointer :: field
699) type(coupler_type), pointer :: boundary_condition
700) type(connection_set_type), pointer :: cur_connection_set
701) type(general_auxvar_type), pointer :: gen_auxvars(:,:), gen_auxvars_bc(:)
702) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
703) class(material_auxvar_type), pointer :: material_auxvars(:)
704)
705) PetscInt :: ghosted_id, local_id, sum_connection, idof, iconn, natural_id
706) PetscInt :: ghosted_start, ghosted_end
707) PetscInt :: iphasebc, iphase
708) PetscInt :: offset
709) PetscInt :: istate
710) PetscReal :: gas_pressure, capillary_pressure, liquid_saturation
711) PetscReal :: saturation_pressure, temperature
712) PetscInt :: real_index, variable
713) PetscReal, pointer :: xx_loc_p(:)
714) PetscReal :: xxbc(realization%option%nflowdof)
715) !#define DEBUG_AUXVARS
716) #ifdef DEBUG_AUXVARS
717) character(len=MAXWORDLENGTH) :: word
718) PetscInt, save :: icall = 0
719) #endif
720) PetscErrorCode :: ierr
721)
722) option => realization%option
723) patch => realization%patch
724) grid => patch%grid
725) field => realization%field
726)
727) gen_auxvars => patch%aux%General%auxvars
728) gen_auxvars_bc => patch%aux%General%auxvars_bc
729) global_auxvars => patch%aux%Global%auxvars
730) global_auxvars_bc => patch%aux%Global%auxvars_bc
731) material_auxvars => patch%aux%Material%auxvars
732)
733) call VecGetArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
734)
735) #ifdef DEBUG_AUXVARS
736) icall = icall + 1
737) write(word,*) icall
738) word = 'genaux' // trim(adjustl(word))
739) #endif
740) do ghosted_id = 1, grid%ngmax
741) if (grid%nG2L(ghosted_id) < 0) cycle ! bypass ghosted corner cells
742)
743) !geh - Ignore inactive cells with inactive materials
744) if (patch%imat(ghosted_id) <= 0) cycle
745) ghosted_end = ghosted_id*option%nflowdof
746) ghosted_start = ghosted_end - option%nflowdof + 1
747) ! GENERAL_UPDATE_FOR_ACCUM indicates call from non-perturbation
748) option%iflag = GENERAL_UPDATE_FOR_ACCUM
749) natural_id = grid%nG2A(ghosted_id)
750) if (grid%nG2L(ghosted_id) == 0) natural_id = -natural_id
751) call GeneralAuxVarCompute(xx_loc_p(ghosted_start:ghosted_end), &
752) gen_auxvars(ZERO_INTEGER,ghosted_id), &
753) global_auxvars(ghosted_id), &
754) material_auxvars(ghosted_id), &
755) patch%characteristic_curves_array( &
756) patch%sat_func_id(ghosted_id))%ptr, &
757) natural_id, &
758) option)
759) if (update_state) then
760) call GeneralAuxVarUpdateState(xx_loc_p(ghosted_start:ghosted_end), &
761) gen_auxvars(ZERO_INTEGER,ghosted_id), &
762) global_auxvars(ghosted_id), &
763) material_auxvars(ghosted_id), &
764) patch%characteristic_curves_array( &
765) patch%sat_func_id(ghosted_id))%ptr, &
766) natural_id, & ! for debugging
767) option)
768) endif
769) #ifdef DEBUG_AUXVARS
770) !geh: for debugging
771) call GeneralOutputAuxVars(gen_auxvars(0,ghosted_id), &
772) global_auxvars(ghosted_id),natural_id,word, &
773) PETSC_TRUE,option)
774) #endif
775) #ifdef DEBUG_GENERAL_FILEOUTPUT
776) if (debug_flag > 0) then
777) write(debug_unit,'(a,i5,i3,7es24.15)') 'auxvar:', natural_id, &
778) global_auxvars(ghosted_id)%istate, &
779) xx_loc_p(ghosted_start:ghosted_end)
780) endif
781) #endif
782) enddo
783)
784) boundary_condition => patch%boundary_condition_list%first
785) sum_connection = 0
786) do
787) if (.not.associated(boundary_condition)) exit
788) cur_connection_set => boundary_condition%connection_set
789) do iconn = 1, cur_connection_set%num_connections
790) sum_connection = sum_connection + 1
791) local_id = cur_connection_set%id_dn(iconn)
792) ghosted_id = grid%nL2G(local_id)
793) !geh: negate to indicate boundary connection, not actual cell
794) natural_id = -grid%nG2A(ghosted_id)
795) offset = (ghosted_id-1)*option%nflowdof
796) if (patch%imat(ghosted_id) <= 0) cycle
797)
798) xxbc(:) = xx_loc_p(offset+1:offset+option%nflowdof)
799) istate = boundary_condition%flow_aux_int_var(GENERAL_STATE_INDEX,iconn)
800) if (istate == ANY_STATE) then
801) istate = global_auxvars(ghosted_id)%istate
802) select case(istate)
803) case(LIQUID_STATE,GAS_STATE)
804) do idof = 1, option%nflowdof
805) select case(boundary_condition%flow_bc_type(idof))
806) case(DIRICHLET_BC,HYDROSTATIC_BC)
807) real_index = boundary_condition%flow_aux_mapping(dof_to_primary_variable(idof,istate))
808) xxbc(idof) = boundary_condition%flow_aux_real_var(real_index,iconn)
809) end select
810) enddo
811) case(TWO_PHASE_STATE)
812) do idof = 1, option%nflowdof
813) select case(boundary_condition%flow_bc_type(idof))
814) case(HYDROSTATIC_BC)
815) real_index = boundary_condition%flow_aux_mapping(dof_to_primary_variable(idof,istate))
816) xxbc(idof) = boundary_condition%flow_aux_real_var(real_index,iconn)
817) case(DIRICHLET_BC)
818) variable = dof_to_primary_variable(idof,istate)
819) select case(variable)
820) ! for gas pressure dof
821) case(GENERAL_GAS_PRESSURE_INDEX)
822) real_index = boundary_condition%flow_aux_mapping(variable)
823) if (real_index /= 0) then
824) xxbc(idof) = boundary_condition%flow_aux_real_var(real_index,iconn)
825) else
826) option%io_buffer = 'Mixed FLOW_CONDITION "' // &
827) trim(boundary_condition%flow_condition%name) // &
828) '" needs gas pressure defined.'
829) call printErrMsg(option)
830) endif
831) ! for air pressure dof
832) case(GENERAL_AIR_PRESSURE_INDEX)
833) real_index = boundary_condition%flow_aux_mapping(variable)
834) if (real_index == 0) then ! air pressure not found
835) ! if air pressure is not available, let's try temperature
836) real_index = boundary_condition%flow_aux_mapping(GENERAL_TEMPERATURE_INDEX)
837) if (real_index /= 0) then
838) temperature = boundary_condition%flow_aux_real_var(real_index,iconn)
839) call EOSWaterSaturationPressure(temperature,saturation_pressure,ierr)
840) ! now verify whether gas pressure is provided through BC
841) if (boundary_condition%flow_bc_type(ONE_INTEGER) == NEUMANN_BC) then
842) gas_pressure = xxbc(ONE_INTEGER)
843) else
844) real_index = boundary_condition%flow_aux_mapping(GENERAL_GAS_PRESSURE_INDEX)
845) if (real_index /= 0) then
846) gas_pressure = boundary_condition%flow_aux_real_var(real_index,iconn)
847) else
848) option%io_buffer = 'Mixed FLOW_CONDITION "' // &
849) trim(boundary_condition%flow_condition%name) // &
850) '" needs gas pressure defined to calculate air ' // &
851) 'pressure from temperature.'
852) call printErrMsg(option)
853) endif
854) endif
855) xxbc(idof) = gas_pressure - saturation_pressure
856) else
857) option%io_buffer = 'Cannot find boundary constraint for air pressure.'
858) call printErrMsg(option)
859) endif
860) else
861) xxbc(idof) = boundary_condition%flow_aux_real_var(real_index,iconn)
862) endif
863) ! for gas saturation dof
864) case(GENERAL_GAS_SATURATION_INDEX)
865) real_index = boundary_condition%flow_aux_mapping(variable)
866) if (real_index /= 0) then
867) xxbc(idof) = boundary_condition%flow_aux_real_var(real_index,iconn)
868) else
869) !geh: should be able to use the saturation within the cell
870) ! option%io_buffer = 'Mixed FLOW_CONDITION "' // &
871) ! trim(boundary_condition%flow_condition%name) // &
872) ! '" needs saturation defined.'
873) ! call printErrMsg(option)
874) endif
875) case(GENERAL_TEMPERATURE_INDEX)
876) real_index = boundary_condition%flow_aux_mapping(variable)
877) if (real_index /= 0) then
878) xxbc(idof) = boundary_condition%flow_aux_real_var(real_index,iconn)
879) else
880) option%io_buffer = 'Mixed FLOW_CONDITION "' // &
881) trim(boundary_condition%flow_condition%name) // &
882) '" needs temperature defined.'
883) call printErrMsg(option)
884) endif
885) end select
886) case(NEUMANN_BC)
887) case default
888) option%io_buffer = 'Unknown BC type in GeneralUpdateAuxVars().'
889) call printErrMsg(option)
890) end select
891) enddo
892) end select
893) else
894) ! we do this for all BCs; Neumann bcs will be set later
895) do idof = 1, option%nflowdof
896) real_index = boundary_condition%flow_aux_mapping(dof_to_primary_variable(idof,istate))
897) if (real_index > 0) then
898) xxbc(idof) = boundary_condition%flow_aux_real_var(real_index,iconn)
899) else
900) option%io_buffer = 'Error setting up boundary condition in GeneralUpdateAuxVars'
901) call printErrMsg(option)
902) endif
903) enddo
904) endif
905)
906) ! set this based on data given
907) global_auxvars_bc(sum_connection)%istate = istate
908) ! GENERAL_UPDATE_FOR_BOUNDARY indicates call from non-perturbation
909) option%iflag = GENERAL_UPDATE_FOR_BOUNDARY
910) call GeneralAuxVarCompute(xxbc,gen_auxvars_bc(sum_connection), &
911) global_auxvars_bc(sum_connection), &
912) material_auxvars(ghosted_id), &
913) patch%characteristic_curves_array( &
914) patch%sat_func_id(ghosted_id))%ptr, &
915) natural_id, &
916) option)
917) ! update state and update aux var; this could result in two update to
918) ! the aux var as update state updates if the state changes
919) call GeneralAuxVarUpdateState(xxbc,gen_auxvars_bc(sum_connection), &
920) global_auxvars_bc(sum_connection), &
921) material_auxvars(ghosted_id), &
922) patch%characteristic_curves_array( &
923) patch%sat_func_id(ghosted_id))%ptr, &
924) natural_id,option)
925) #ifdef DEBUG_GENERAL_FILEOUTPUT
926) if (debug_flag > 0) then
927) write(debug_unit,'(a,i5,i3,7es24.15)') 'bc_auxvar:', natural_id, &
928) global_auxvars_bc(ghosted_id)%istate, &
929) xxbc(:)
930) endif
931) #endif
932) enddo
933) boundary_condition => boundary_condition%next
934) enddo
935)
936) call VecRestoreArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
937)
938) patch%aux%General%auxvars_up_to_date = PETSC_TRUE
939)
940) end subroutine GeneralUpdateAuxVars
941)
942) ! ************************************************************************** !
943)
944) subroutine GeneralUpdateFixedAccum(realization)
945) !
946) ! Updates the fixed portion of the
947) ! accumulation term
948) !
949) ! Author: Glenn Hammond
950) ! Date: 03/10/11
951) !
952)
953) use Realization_Subsurface_class
954) use Patch_module
955) use Option_module
956) use Field_module
957) use Grid_module
958) use Material_Aux_class
959)
960) implicit none
961)
962) type(realization_subsurface_type) :: realization
963)
964) type(option_type), pointer :: option
965) type(patch_type), pointer :: patch
966) type(grid_type), pointer :: grid
967) type(field_type), pointer :: field
968) type(general_auxvar_type), pointer :: gen_auxvars(:,:)
969) type(global_auxvar_type), pointer :: global_auxvars(:)
970) class(material_auxvar_type), pointer :: material_auxvars(:)
971) type(material_parameter_type), pointer :: material_parameter
972)
973) PetscInt :: ghosted_id, local_id, local_start, local_end, natural_id
974) PetscInt :: imat
975) PetscReal, pointer :: xx_p(:), iphase_loc_p(:)
976) PetscReal, pointer :: accum_p(:), accum_p2(:)
977) PetscReal :: Jac_dummy(realization%option%nflowdof, &
978) realization%option%nflowdof)
979)
980) PetscErrorCode :: ierr
981)
982) option => realization%option
983) field => realization%field
984) patch => realization%patch
985) grid => patch%grid
986)
987) gen_auxvars => patch%aux%General%auxvars
988) global_auxvars => patch%aux%Global%auxvars
989) material_auxvars => patch%aux%Material%auxvars
990) material_parameter => patch%aux%Material%material_parameter
991)
992) call VecGetArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
993)
994) call VecGetArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
995)
996) !Heeho initialize dynamic accumulation term for every p iteration step
997) if (general_tough2_conv_criteria) then
998) call VecGetArrayF90(field%flow_accum2, accum_p2, ierr);CHKERRQ(ierr)
999) endif
1000)
1001) do local_id = 1, grid%nlmax
1002) ghosted_id = grid%nL2G(local_id)
1003) !geh - Ignore inactive cells with inactive materials
1004) imat = patch%imat(ghosted_id)
1005) if (imat <= 0) cycle
1006) natural_id = grid%nG2A(ghosted_id)
1007) local_end = local_id*option%nflowdof
1008) local_start = local_end - option%nflowdof + 1
1009) ! GENERAL_UPDATE_FOR_FIXED_ACCUM indicates call from non-perturbation
1010) option%iflag = GENERAL_UPDATE_FOR_FIXED_ACCUM
1011) call GeneralAuxVarCompute(xx_p(local_start:local_end), &
1012) gen_auxvars(ZERO_INTEGER,ghosted_id), &
1013) global_auxvars(ghosted_id), &
1014) material_auxvars(ghosted_id), &
1015) patch%characteristic_curves_array( &
1016) patch%sat_func_id(ghosted_id))%ptr, &
1017) natural_id, &
1018) option)
1019) call GeneralAccumulation(gen_auxvars(ZERO_INTEGER,ghosted_id), &
1020) global_auxvars(ghosted_id), &
1021) material_auxvars(ghosted_id), &
1022) material_parameter%soil_heat_capacity(imat), &
1023) option,accum_p(local_start:local_end), &
1024) Jac_dummy,PETSC_FALSE, &
1025) local_id == general_debug_cell_id)
1026) enddo
1027)
1028) if (general_tough2_conv_criteria) then
1029) accum_p2 = accum_p
1030) endif
1031)
1032) call VecRestoreArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
1033)
1034) call VecRestoreArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
1035)
1036) !Heeho initialize dynamic accumulation term for every p iteration step
1037) if (general_tough2_conv_criteria) then
1038) call VecRestoreArrayF90(field%flow_accum2, accum_p2, ierr);CHKERRQ(ierr)
1039) endif
1040)
1041) end subroutine GeneralUpdateFixedAccum
1042)
1043) ! ************************************************************************** !
1044)
1045) subroutine GeneralAccumulation(gen_auxvar,global_auxvar,material_auxvar, &
1046) soil_heat_capacity,option,Res,Jac, &
1047) analytical_derivatives,debug_cell)
1048) !
1049) ! Computes the non-fixed portion of the accumulation
1050) ! term for the residual
1051) !
1052) ! Author: Glenn Hammond
1053) ! Date: 03/09/11
1054) !
1055)
1056) use Option_module
1057) use Material_module
1058) use Material_Aux_class
1059)
1060) implicit none
1061)
1062) type(general_auxvar_type) :: gen_auxvar
1063) type(global_auxvar_type) :: global_auxvar
1064) class(material_auxvar_type) :: material_auxvar
1065) PetscReal :: soil_heat_capacity
1066) type(option_type) :: option
1067) PetscReal :: Res(option%nflowdof)
1068) PetscReal :: Jac(option%nflowdof,option%nflowdof)
1069) PetscBool :: analytical_derivatives
1070) PetscBool :: debug_cell
1071)
1072) PetscInt :: wat_comp_id, air_comp_id, energy_id
1073) PetscInt :: icomp, iphase
1074)
1075) PetscReal :: porosity
1076) PetscReal :: v_over_t
1077)
1078) wat_comp_id = option%water_id
1079) air_comp_id = option%air_id
1080) energy_id = option%energy_id
1081)
1082) ! v_over_t[m^3 bulk/sec] = vol[m^3 bulk] / dt[sec]
1083) v_over_t = material_auxvar%volume / option%flow_dt
1084) ! must use gen_auxvar%effective porosity here as it enables numerical
1085) ! derivatives to be employed
1086) porosity = gen_auxvar%effective_porosity
1087)
1088) ! accumulation term units = kmol/s
1089) Res = 0.d0
1090) do iphase = 1, option%nphase
1091) ! Res[kmol comp/m^3 void] = sat[m^3 phase/m^3 void] *
1092) ! den[kmol phase/m^3 phase] *
1093) ! xmol[kmol comp/kmol phase]
1094) do icomp = 1, option%nflowspec
1095) #ifdef DEBUG_GENERAL
1096) ! for debug version, aux var entries are initialized to NaNs. even if
1097) ! saturation is zero, density may be a NaN. So the conditional prevents
1098) ! this calculation. For non-debug, aux var entries are initialized to
1099) ! 0.d0
1100) if (gen_auxvar%sat(iphase) > 0.d0) then
1101) #endif
1102) Res(icomp) = Res(icomp) + gen_auxvar%sat(iphase) * &
1103) gen_auxvar%den(iphase) * &
1104) gen_auxvar%xmol(icomp,iphase)
1105) #ifdef DEBUG_GENERAL
1106) endif
1107) #endif
1108) enddo
1109) enddo
1110)
1111) ! scale by porosity * volume / dt
1112) ! Res[kmol/sec] = Res[kmol/m^3 void] * por[m^3 void/m^3 bulk] *
1113) ! vol[m^3 bulk] / dt[sec]
1114) Res(1:option%nflowspec) = Res(1:option%nflowspec) * &
1115) porosity * v_over_t
1116)
1117) do iphase = 1, option%nphase
1118) ! Res[MJ/m^3 void] = sat[m^3 phase/m^3 void] *
1119) ! den[kmol phase/m^3 phase] * U[MJ/kmol phase]
1120) #ifdef DEBUG_GENERAL
1121) ! for debug version, aux var entries are initialized to NaNs. even if
1122) ! saturation is zero, density may be a NaN. So the conditional prevents
1123) ! this calculation. For non-debug, aux var entries are initialized to
1124) ! 0.d0
1125) if (gen_auxvar%sat(iphase) > 0.d0) then
1126) #endif
1127) Res(energy_id) = Res(energy_id) + gen_auxvar%sat(iphase) * &
1128) gen_auxvar%den(iphase) * &
1129) gen_auxvar%U(iphase)
1130) #ifdef DEBUG_GENERAL
1131) endif
1132) #endif
1133) enddo
1134) ! Res[MJ/sec] = (Res[MJ/m^3 void] * por[m^3 void/m^3 bulk] +
1135) ! (1-por)[m^3 rock/m^3 bulk] *
1136) ! dencpr[kg rock/m^3 rock * MJ/kg rock-K] * T[C]) &
1137) ! vol[m^3 bulk] / dt[sec]
1138) Res(energy_id) = (Res(energy_id) * porosity + &
1139) (1.d0 - porosity) * &
1140) material_auxvar%soil_particle_density * &
1141) soil_heat_capacity * gen_auxvar%temp) * v_over_t
1142)
1143) if (analytical_derivatives) then
1144) Jac = 0.d0
1145) select case(global_auxvar%istate)
1146) case(LIQUID_STATE)
1147) ! satl = 1
1148) ! ----------
1149) ! Water Equation
1150) ! por * satl * denl * Xwl
1151) ! ---
1152) ! w/respect to liquid pressure
1153) ! dpor_dpl * denl * Xwl +
1154) ! por * ddenl_dpl * Xwl
1155) Jac(1,1) = &
1156) gen_auxvar%d%por_pl * gen_auxvar%den(1) * gen_auxvar%xmol(1,1) + &
1157) porosity * gen_auxvar%d%denl_pl * gen_auxvar%xmol(1,1)
1158) ! w/respect to air mole fraction
1159) ! liquid phase density is indepenent of air mole fraction
1160) ! por * denl * dXwl_dXal
1161) ! Xwl = 1. - Xal
1162) ! dXwl_dXal = -1.
1163) Jac(1,2) = porosity * gen_auxvar%den(1) * (-1.d0)
1164) ! w/repect to temperature
1165) ! por * ddenl_dT * Xwl
1166) Jac(1,3) = porosity * gen_auxvar%d%denl_T * gen_auxvar%xmol(1,1)
1167) ! ----------
1168) ! Air Equation
1169) ! por * satl * denl * Xal
1170) ! w/respect to liquid pressure
1171) ! dpor_dpl * denl * Xal +
1172) ! por * ddenl_dpl * Xal
1173) Jac(2,1) = &
1174) gen_auxvar%d%por_pl * gen_auxvar%den(1) * gen_auxvar%xmol(2,1) + &
1175) porosity * gen_auxvar%d%denl_pl * gen_auxvar%xmol(2,1)
1176) ! w/respect to air mole fraction
1177) Jac(2,2) = porosity * gen_auxvar%den(1)
1178) ! w/repect to temperature
1179) ! por * ddenl_dT * Xwl
1180) Jac(2,3) = porosity * gen_auxvar%d%denl_T * gen_auxvar%xmol(2,1)
1181) ! ----------
1182) ! Energy Equation
1183) ! por * satl * denl * Ul + (1-por) * dens * Cp * T
1184) ! w/respect to liquid pressure
1185) ! dpor_dpl * denl * Ul +
1186) ! por * ddenl_dpl * Ul +
1187) ! por * denl * dUl_dpl +
1188) ! -dpor_dpl * dens * Cp * T
1189) Jac(3,1) = &
1190) gen_auxvar%d%por_pl * gen_auxvar%den(1) * gen_auxvar%U(1) + &
1191) porosity * gen_auxvar%d%denl_pl * gen_auxvar%U(1) + &
1192) porosity * gen_auxvar%den(1) * gen_auxvar%d%Ul_pl + &
1193) (-1.d0) * gen_auxvar%d%por_pl * &
1194) material_auxvar%soil_particle_density * &
1195) soil_heat_capacity * gen_auxvar%temp
1196) ! w/respect to air mole fraction
1197) Jac(3,2) = 0.d0
1198) ! w/respect to temperature
1199) Jac(3,3) = &
1200) porosity * gen_auxvar%den(1) * gen_auxvar%d%Ul_T + &
1201) (1.d0 - porosity) * material_auxvar%soil_particle_density * &
1202) soil_heat_capacity
1203) case(GAS_STATE)
1204) case(TWO_PHASE_STATE)
1205) ! if (general_2ph_energy_dof == GENERAL_TEMPERATURE_INDEX) then
1206) end select
1207) Jac = Jac * v_over_t
1208) endif
1209)
1210) #ifdef DEBUG_GENERAL_FILEOUTPUT
1211) if (debug_flag > 0) then
1212) write(debug_unit,'(a,7es24.15)') 'accum:', Res
1213) endif
1214) #endif
1215)
1216) end subroutine GeneralAccumulation
1217)
1218) ! ************************************************************************** !
1219)
1220) subroutine GeneralFlux(gen_auxvar_up,global_auxvar_up, &
1221) material_auxvar_up, &
1222) sir_up, &
1223) thermal_conductivity_up, &
1224) gen_auxvar_dn,global_auxvar_dn, &
1225) material_auxvar_dn, &
1226) sir_dn, &
1227) thermal_conductivity_dn, &
1228) area, dist, general_parameter, &
1229) option,v_darcy,Res,Jup,Jdn, &
1230) analytical_derivatives, &
1231) debug_connection)
1232) !
1233) ! Computes the internal flux terms for the residual
1234) !
1235) ! Author: Glenn Hammond
1236) ! Date: 03/09/11
1237) !
1238) use Option_module
1239) use Material_Aux_class
1240) use Connection_module
1241) use Fracture_module
1242) use Klinkenberg_module
1243)
1244) implicit none
1245)
1246) type(general_auxvar_type) :: gen_auxvar_up, gen_auxvar_dn
1247) type(global_auxvar_type) :: global_auxvar_up, global_auxvar_dn
1248) class(material_auxvar_type) :: material_auxvar_up, material_auxvar_dn
1249) type(option_type) :: option
1250) PetscReal :: sir_up(:), sir_dn(:)
1251) PetscReal :: v_darcy(option%nphase)
1252) PetscReal :: area
1253) PetscReal :: dist(-1:3)
1254) type(general_parameter_type) :: general_parameter
1255) PetscReal :: thermal_conductivity_dn(2)
1256) PetscReal :: thermal_conductivity_up(2)
1257) PetscReal :: Res(option%nflowdof)
1258) PetscReal :: Jup(option%nflowdof,option%nflowdof)
1259) PetscReal :: Jdn(option%nflowdof,option%nflowdof)
1260) PetscBool :: analytical_derivatives
1261) PetscBool :: debug_connection
1262)
1263) PetscReal :: dist_gravity ! distance along gravity vector
1264) PetscReal :: dist_up, dist_dn
1265) PetscReal :: upweight
1266) PetscInt :: wat_comp_id, air_comp_id, energy_id
1267) PetscInt :: icomp, iphase
1268)
1269) PetscReal :: xmol(option%nflowspec)
1270) PetscReal :: density_ave, density_kg_ave
1271) PetscReal :: uH
1272) PetscReal :: H_ave
1273) PetscReal :: perm_ave_over_dist(option%nphase)
1274) PetscReal :: perm_up, perm_dn
1275) PetscReal :: delta_pressure, delta_xmol, delta_temp
1276) PetscReal :: xmol_air_up, xmol_air_dn
1277) PetscReal :: xmass_air_up, xmass_air_dn, delta_xmass
1278) PetscReal :: delta_X_whatever
1279) PetscReal :: pressure_ave
1280) PetscReal :: gravity_term
1281) PetscReal :: mobility, mole_flux, q
1282) PetscReal :: stpd_up, stpd_dn
1283) PetscReal :: sat_up, sat_dn, den_up, den_dn
1284) PetscReal :: temp_ave, stpd_ave_over_dist, tempreal
1285) PetscReal :: k_eff_up, k_eff_dn, k_eff_ave, heat_flux
1286) PetscReal :: adv_flux(3,2), diff_flux(2,2)
1287) PetscReal :: debug_flux(3,3), debug_dphi(2)
1288)
1289) PetscReal :: dummy_dperm_up, dummy_dperm_dn
1290) PetscReal :: temp_perm_up, temp_perm_dn
1291)
1292) PetscReal :: dden_up, dden_dn
1293) PetscReal :: dden_dden_kg_up, dden_dden_kg_dn
1294) PetscReal :: ddelta_pressure_dpup, ddelta_pressure_dpdn
1295) PetscReal :: ddelta_pressure_dTup, ddelta_pressure_dTdn
1296) PetscReal :: dmobility_dpup, dmobility_dpdn
1297) PetscReal :: dmobility_dsatup, dmobility_dsatdn
1298) PetscReal :: dmobility_dTup, dmobility_dTdn
1299) PetscReal :: dmole_flux_dpup, dmole_flux_dpdn
1300) PetscReal :: dmole_flux_dTup, dmole_flux_dTdn
1301) PetscReal :: dv_darcy_dpup, dv_darcy_dpdn
1302) PetscReal :: dv_darcy_dTup, dv_darcy_dTdn
1303) PetscReal :: duH_dpup, duH_dpdn
1304) PetscReal :: duH_dTup, duH_dTdn
1305) PetscReal :: dxmol_up, dxmol_dn
1306)
1307) wat_comp_id = option%water_id
1308) air_comp_id = option%air_id
1309) energy_id = option%energy_id
1310)
1311) call ConnectionCalculateDistances(dist,option%gravity,dist_up,dist_dn, &
1312) dist_gravity,upweight)
1313) call material_auxvar_up%PermeabilityTensorToScalar(dist,perm_up)
1314) call material_auxvar_dn%PermeabilityTensorToScalar(dist,perm_dn)
1315)
1316) ! Fracture permeability change only available for structured grid (Heeho)
1317) if (associated(material_auxvar_up%fracture)) then
1318) call FracturePermEvaluate(material_auxvar_up,perm_up,temp_perm_up, &
1319) dummy_dperm_up,dist)
1320) perm_up = temp_perm_up
1321) endif
1322) if (associated(material_auxvar_dn%fracture)) then
1323) call FracturePermEvaluate(material_auxvar_dn,perm_dn,temp_perm_dn, &
1324) dummy_dperm_dn,dist)
1325) perm_dn = temp_perm_dn
1326) endif
1327)
1328) if (associated(klinkenberg)) then
1329) perm_ave_over_dist(1) = (perm_up * perm_dn) / &
1330) (dist_up*perm_dn + dist_dn*perm_up)
1331) temp_perm_up = klinkenberg%Evaluate(perm_up, &
1332) gen_auxvar_up%pres(option%gas_phase))
1333) temp_perm_dn = klinkenberg%Evaluate(perm_dn, &
1334) gen_auxvar_dn%pres(option%gas_phase))
1335) perm_ave_over_dist(2) = (temp_perm_up * temp_perm_dn) / &
1336) (dist_up*temp_perm_dn + dist_dn*temp_perm_up)
1337) else
1338) perm_ave_over_dist(:) = (perm_up * perm_dn) / &
1339) (dist_up*perm_dn + dist_dn*perm_up)
1340) endif
1341)
1342) Res = 0.d0
1343)
1344) v_darcy = 0.d0
1345) #ifdef DEBUG_FLUXES
1346) adv_flux = 0.d0
1347) diff_flux = 0.d0
1348) #endif
1349) #ifdef DEBUG_GENERAL_FILEOUTPUT
1350) debug_flux = 0.d0
1351) debug_dphi = 0.d0
1352) #endif
1353)
1354) #ifdef CONVECTION
1355) do iphase = 1, option%nphase
1356)
1357) if (gen_auxvar_up%mobility(iphase) + &
1358) gen_auxvar_dn%mobility(iphase) < eps) then
1359) cycle
1360) endif
1361)
1362) density_kg_ave = GeneralAverageDensity(iphase, &
1363) global_auxvar_up%istate, &
1364) global_auxvar_dn%istate, &
1365) gen_auxvar_up%den_kg, &
1366) gen_auxvar_dn%den_kg, &
1367) dden_up,dden_dn)
1368) gravity_term = density_kg_ave * dist_gravity
1369) delta_pressure = gen_auxvar_up%pres(iphase) - &
1370) gen_auxvar_dn%pres(iphase) + &
1371) gravity_term
1372)
1373) #ifdef DEBUG_GENERAL_FILEOUTPUT
1374) debug_dphi(iphase) = delta_pressure
1375) #endif
1376)
1377) if (delta_pressure >= 0.D0) then
1378) mobility = gen_auxvar_up%mobility(iphase)
1379) xmol(:) = gen_auxvar_up%xmol(:,iphase)
1380) H_ave = gen_auxvar_up%H(iphase)
1381) uH = H_ave
1382) else
1383) mobility = gen_auxvar_dn%mobility(iphase)
1384) xmol(:) = gen_auxvar_dn%xmol(:,iphase)
1385) H_ave = gen_auxvar_dn%H(iphase)
1386) uH = H_ave
1387) endif
1388)
1389) if (mobility > floweps) then
1390) ! v_darcy[m/sec] = perm[m^2] / dist[m] * kr[-] / mu[Pa-sec]
1391) ! dP[Pa]]
1392) v_darcy(iphase) = perm_ave_over_dist(iphase) * mobility * delta_pressure
1393) density_ave = GeneralAverageDensity(iphase, &
1394) global_auxvar_up%istate, &
1395) global_auxvar_dn%istate, &
1396) gen_auxvar_up%den, &
1397) gen_auxvar_dn%den, &
1398) dden_up,dden_dn)
1399) ! q[m^3 phase/sec] = v_darcy[m/sec] * area[m^2]
1400) q = v_darcy(iphase) * area
1401) ! mole_flux[kmol phase/sec] = q[m^3 phase/sec] *
1402) ! density_ave[kmol phase/m^3 phase]
1403) mole_flux = q*density_ave
1404) ! Res[kmol total/sec]
1405) do icomp = 1, option%nflowspec
1406) ! Res[kmol comp/sec] = mole_flux[kmol phase/sec] *
1407) ! xmol[kmol comp/kmol phase]
1408) Res(icomp) = Res(icomp) + mole_flux * xmol(icomp)
1409) enddo
1410) #ifdef DEBUG_FLUXES
1411) do icomp = 1, option%nflowspec
1412) adv_flux(icomp) = adv_flux(icomp) + mole_flux * xmol(icomp)
1413) enddo ! Res[MJ/sec] = mole_flux[kmol comp/sec] * H_ave[MJ/kmol comp]
1414) #endif
1415) #ifdef DEBUG_GENERAL_FILEOUTPUT
1416) do icomp = 1, option%nflowspec
1417) debug_flux(icomp,iphase) = debug_flux(icomp,iphase) + mole_flux * xmol(icomp)
1418) enddo ! Res[MJ/sec] = mole_flux[kmol comp/sec] * H_ave[MJ/kmol comp]
1419) #endif
1420) Res(energy_id) = Res(energy_id) + mole_flux * uH
1421) #ifdef DEBUG_FLUXES
1422) adv_flux(energy_id) = adv_flux(energy_id) + mole_flux * uH
1423) #endif
1424) #ifdef DEBUG_GENERAL_FILEOUTPUT
1425) debug_dphi(iphase) = delta_pressure
1426) debug_flux(energy_id,iphase) = debug_flux(energy_id,iphase) + mole_flux * uH
1427) #endif
1428) endif
1429)
1430) enddo
1431) ! CONVECTION
1432) #endif
1433)
1434) #ifdef DEBUG_GENERAL_FILEOUTPUT
1435) if (debug_flag > 0) then
1436) write(debug_unit,'(a,7es24.15)') 'delta pressure :', debug_dphi(:)
1437) write(debug_unit,'(a,7es24.15)') 'adv flux (liquid):', debug_flux(:,1)
1438) write(debug_unit,'(a,7es24.15)') 'adv flux (gas):', debug_flux(:,2)
1439) endif
1440) debug_flux = 0.d0
1441) #endif
1442)
1443) #ifdef DIFFUSION
1444) ! add in gas component diffusion in gas and liquid phases
1445) do iphase = 1, option%nphase
1446)
1447) #ifndef LIQUID_DIFFUSION
1448) if (iphase == LIQUID_PHASE) cycle
1449) #endif
1450)
1451) sat_up = gen_auxvar_up%sat(iphase)
1452) sat_dn = gen_auxvar_dn%sat(iphase)
1453) !geh: changed to .and. -> .or.
1454) if (sqrt(sat_up*sat_dn) < eps) cycle
1455) if (sat_up > eps .or. sat_dn > eps) then
1456) ! for now, if liquid state neighboring gas, we allow for minute
1457) ! diffusion in liquid phase.
1458) if (iphase == option%liquid_phase) then
1459) if ((sat_up > eps .or. sat_dn > eps)) then
1460) sat_up = max(sat_up,eps)
1461) sat_dn = max(sat_dn,eps)
1462) endif
1463) endif
1464) if (general_harmonic_diff_density) then
1465) den_up = gen_auxvar_up%den(iphase)
1466) den_dn = gen_auxvar_dn%den(iphase)
1467) else
1468) ! we use upstream weighting when iphase is not equal, otherwise
1469) ! arithmetic with 50/50 weighting
1470) den_up = GeneralAverageDensity(iphase, &
1471) global_auxvar_up%istate, &
1472) global_auxvar_dn%istate, &
1473) gen_auxvar_up%den, &
1474) gen_auxvar_dn%den, &
1475) dden_up,dden_dn)
1476) ! by setting both equal, we avoid the harmonic weighting below
1477) den_dn = den_up
1478) endif
1479) stpd_up = sat_up*material_auxvar_up%tortuosity* &
1480) gen_auxvar_up%effective_porosity*den_up
1481) stpd_dn = sat_dn*material_auxvar_dn%tortuosity* &
1482) gen_auxvar_dn%effective_porosity*den_dn
1483) if (general_diffuse_xmol) then
1484) delta_xmol = gen_auxvar_up%xmol(air_comp_id,iphase) - &
1485) gen_auxvar_dn%xmol(air_comp_id,iphase)
1486) delta_X_whatever = delta_xmol
1487) else
1488) xmol_air_up = gen_auxvar_up%xmol(air_comp_id,iphase)
1489) xmol_air_dn = gen_auxvar_dn%xmol(air_comp_id,iphase)
1490) xmass_air_up = xmol_air_up*fmw_comp(2) / &
1491) (xmol_air_up*fmw_comp(2) + (1.d0-xmol_air_up)*fmw_comp(1))
1492) xmass_air_dn = xmol_air_dn*fmw_comp(2) / &
1493) (xmol_air_dn*fmw_comp(2) + (1.d0-xmol_air_dn)*fmw_comp(1))
1494) delta_xmass = xmass_air_up - xmass_air_dn
1495) delta_X_whatever = delta_xmass
1496) endif
1497) ! units = [mole/m^4 bulk]
1498) stpd_ave_over_dist = (stpd_up*stpd_dn)/(stpd_up*dist_dn+stpd_dn*dist_up)
1499) ! need to account for multiple phases
1500) tempreal = 1.d0
1501) ! Eq. 1.9b. The gas density is added below
1502) if (general_temp_dep_gas_air_diff .and. &
1503) iphase == option%gas_phase) then
1504) temp_ave = 0.5d0*(gen_auxvar_up%temp+gen_auxvar_dn%temp)
1505) pressure_ave = 0.5d0*(gen_auxvar_up%pres(iphase)+ &
1506) gen_auxvar_dn%pres(iphase))
1507) tempreal = ((temp_ave+273.15d0)/273.15d0)**1.8d0 * &
1508) 101325.d0 / pressure_ave
1509) endif
1510) ! units = mole/sec
1511) mole_flux = stpd_ave_over_dist * tempreal * &
1512) general_parameter%diffusion_coefficient(iphase) * &
1513) delta_X_whatever * area
1514) Res(wat_comp_id) = Res(wat_comp_id) - mole_flux
1515) Res(air_comp_id) = Res(air_comp_id) + mole_flux
1516) #ifdef DEBUG_FLUXES
1517) diff_flux(wat_comp_id) = diff_flux(wat_comp_id) - mole_flux
1518) diff_flux(air_comp_id) = diff_flux(air_comp_id) + mole_flux
1519) #endif
1520) #ifdef DEBUG_GENERAL_FILEOUTPUT
1521) debug_flux(wat_comp_id,iphase) = debug_flux(wat_comp_id,iphase) - mole_flux
1522) debug_flux(air_comp_id,iphase) = debug_flux(air_comp_id,iphase) + mole_flux
1523) #endif
1524) endif
1525) enddo
1526) ! DIFFUSION
1527) #endif
1528)
1529) #ifdef CONDUCTION
1530) ! add heat conduction flux
1531) ! based on Somerton et al., 1974:
1532) ! k_eff = k_dry + sqrt(s_l)*(k_sat-k_dry)
1533) k_eff_up = thermal_conductivity_up(1) + &
1534) sqrt(gen_auxvar_up%sat(option%liquid_phase)) * &
1535) (thermal_conductivity_up(2) - thermal_conductivity_up(1))
1536) k_eff_dn = thermal_conductivity_dn(1) + &
1537) sqrt(gen_auxvar_dn%sat(option%liquid_phase)) * &
1538) (thermal_conductivity_dn(2) - thermal_conductivity_dn(1))
1539) if (k_eff_up > 0.d0 .or. k_eff_up > 0.d0) then
1540) k_eff_ave = (k_eff_up*k_eff_dn)/(k_eff_up*dist_dn+k_eff_dn*dist_up)
1541) else
1542) k_eff_ave = 0.d0
1543) endif
1544) ! units:
1545) ! k_eff = W/K-m = J/s/K-m
1546) ! delta_temp = K
1547) ! area = m^2
1548) ! heat_flux = k_eff * delta_temp * area = J/s
1549) delta_temp = gen_auxvar_up%temp - gen_auxvar_dn%temp
1550) heat_flux = k_eff_ave * delta_temp * area * 1.d-6 ! J/s -> MJ/s
1551) ! MJ/s
1552) Res(energy_id) = Res(energy_id) + heat_flux
1553) ! CONDUCTION
1554) #endif
1555)
1556) if (analytical_derivatives) then
1557) Jup = 0.d0
1558) Jdn = 0.d0
1559)
1560) do iphase = 1, option%nphase
1561)
1562) if (gen_auxvar_up%mobility(iphase) + &
1563) gen_auxvar_dn%mobility(iphase) < eps) then
1564) cycle
1565) endif
1566)
1567) density_kg_ave = GeneralAverageDensity(iphase, &
1568) global_auxvar_up%istate, &
1569) global_auxvar_dn%istate, &
1570) gen_auxvar_up%den_kg, &
1571) gen_auxvar_dn%den_kg, &
1572) dden_dden_kg_up,dden_dden_kg_dn)
1573) gravity_term = density_kg_ave * dist_gravity
1574) delta_pressure = gen_auxvar_up%pres(iphase) - &
1575) gen_auxvar_dn%pres(iphase) + &
1576) gravity_term
1577)
1578) ddelta_pressure_dpup = 1.d0 + dist_gravity * &
1579) (dden_dden_kg_up * gen_auxvar_up%d%denl_pl*FMWH2O + &
1580) dden_dden_kg_dn * gen_auxvar_dn%d%denl_pl*FMWH2O)
1581) ddelta_pressure_dpdn = -1.d0 + dist_gravity * &
1582) (dden_dden_kg_up * gen_auxvar_up%d%denl_pl*FMWH2O + &
1583) dden_dden_kg_dn * gen_auxvar_dn%d%denl_pl*FMWH2O)
1584) ddelta_pressure_dTup = dist_gravity * &
1585) (dden_dden_kg_up * gen_auxvar_up%d%denl_T*FMWH2O + &
1586) dden_dden_kg_dn * gen_auxvar_dn%d%denl_T*FMWH2O)
1587) ddelta_pressure_dTdn = dist_gravity * &
1588) (dden_dden_kg_up * gen_auxvar_up%d%denl_T*FMWH2O + &
1589) dden_dden_kg_dn * gen_auxvar_dn%d%denl_T*FMWH2O)
1590)
1591) if (delta_pressure >= 0.D0) then
1592) mobility = gen_auxvar_up%mobility(iphase)
1593) xmol(:) = gen_auxvar_up%xmol(:,iphase)
1594) H_ave = gen_auxvar_up%H(iphase)
1595) uH = H_ave
1596)
1597) duH_dpup = gen_auxvar_up%d%Hl_pl
1598) duH_dpdn = 0.d0
1599) duH_dTup = gen_auxvar_up%d%Hl_T
1600) duH_dTdn = 0.d0
1601) dxmol_up = 1.d0
1602) dxmol_dn = 0.d0
1603) dmobility_dpup = gen_auxvar_up%d%mobilityl_pl
1604) dmobility_dsatup = gen_auxvar_up%d%mobilityl_sat
1605) dmobility_dTup = gen_auxvar_up%d%mobilityl_T
1606) dmobility_dpdn = 0.d0
1607) dmobility_dsatdn = 0.d0
1608) dmobility_dTdn = 0.d0
1609) else
1610) mobility = gen_auxvar_dn%mobility(iphase)
1611) xmol(:) = gen_auxvar_dn%xmol(:,iphase)
1612) H_ave = gen_auxvar_dn%H(iphase)
1613) uH = H_ave
1614)
1615) duH_dpup = 0.d0
1616) duH_dTup = 0.d0
1617) duH_dTdn = gen_auxvar_dn%d%Hl_T
1618) dxmol_up = 0.d0
1619) dxmol_dn = 1.d0
1620) dmobility_dpup = 0.d0
1621) dmobility_dsatup = 0.d0
1622) dmobility_dTup = 0.d0
1623) dmobility_dpdn = gen_auxvar_dn%d%mobilityl_pl
1624) dmobility_dsatdn = gen_auxvar_dn%d%mobilityl_sat
1625) dmobility_dTdn = gen_auxvar_dn%d%mobilityl_T
1626) endif
1627)
1628) if (mobility > floweps) then
1629) ! v_darcy[m/sec] = perm[m^2] / dist[m] * kr[-] / mu[Pa-sec]
1630) ! dP[Pa]]
1631) v_darcy(iphase) = perm_ave_over_dist(iphase) * mobility * delta_pressure
1632)
1633) tempreal = perm_ave_over_dist(iphase)
1634) dv_darcy_dpup = tempreal * &
1635) (dmobility_dpup * delta_pressure + mobility * ddelta_pressure_dpup)
1636) dv_darcy_dTup = tempreal * &
1637) (dmobility_dTup * delta_pressure + mobility * ddelta_pressure_dTup)
1638) dv_darcy_dpdn = tempreal * &
1639) (dmobility_dpdn * delta_pressure + mobility * ddelta_pressure_dpdn)
1640) dv_darcy_dTdn = tempreal * &
1641) (dmobility_dTdn * delta_pressure + mobility * ddelta_pressure_dTdn)
1642)
1643) density_ave = GeneralAverageDensity(iphase, &
1644) global_auxvar_up%istate, &
1645) global_auxvar_dn%istate, &
1646) gen_auxvar_up%den, &
1647) gen_auxvar_dn%den, &
1648) dden_up,dden_dn)
1649) ! q[m^3 phase/sec] = v_darcy[m/sec] * area[m^2]
1650) q = v_darcy(iphase) * area
1651) ! mole_flux[kmol phase/sec] = q[m^3 phase/sec] *
1652) ! density_ave[kmol phase/m^3 phase]
1653) mole_flux = q*density_ave
1654) ! Res[kmol total/sec]
1655) ! do icomp = 1, option%nflowspec
1656) ! ! Res[kmol comp/sec] = mole_flux[kmol phase/sec] *
1657) ! ! xmol[kmol comp/kmol phase]
1658) ! Res(icomp) = Res(icomp) + mole_flux * xmol(icomp)
1659) ! enddo
1660) ! Res(energy_id) = Res(energy_id) + mole_flux * uH
1661)
1662) select case(global_auxvar_up%istate)
1663) case(LIQUID_STATE)
1664) dmole_flux_dpup = &
1665) (dv_darcy_dpup * density_ave + &
1666) v_darcy(iphase) * &
1667) (dden_up * gen_auxvar_up%d%denl_pl + &
1668) dden_dn * gen_auxvar_dn%d%denl_pl))
1669) dmole_flux_dTup = &
1670) (dv_darcy_dTup * density_ave + &
1671) v_darcy(iphase) * &
1672) (dden_up * gen_auxvar_up%d%denl_T + &
1673) dden_dn * gen_auxvar_dn%d%denl_T))
1674) do icomp = 1, option%nflowspec
1675) Jup(icomp,1) = Jup(icomp,1) + dmole_flux_dpup * xmol(icomp)
1676) Jup(icomp,2) = Jup(icomp,2) + mole_flux * dxmol_up
1677) Jup(icomp,3) = Jup(icomp,3) + dmole_flux_dTup * xmol(icomp)
1678) enddo
1679) Jup(energy_id,1) = Jup(energy_id,1) + &
1680) (dmole_flux_dpup * uH + mole_flux * duH_dpup)
1681) Jup(energy_id,3) = Jup(energy_id,3) + &
1682) (dmole_flux_dTup * uH + mole_flux * duH_dTup)
1683) case(GAS_STATE)
1684) case(TWO_PHASE_STATE)
1685) end select
1686) select case(global_auxvar_dn%istate)
1687) case(LIQUID_STATE)
1688) dmole_flux_dpdn = &
1689) (dv_darcy_dpdn * density_ave + &
1690) v_darcy(iphase) * &
1691) (dden_up * gen_auxvar_up%d%denl_pl + &
1692) dden_dn * gen_auxvar_dn%d%denl_pl))
1693) dmole_flux_dTdn = &
1694) (dv_darcy_dTdn * density_ave + &
1695) v_darcy(iphase) * &
1696) (dden_up * gen_auxvar_up%d%denl_T + &
1697) dden_dn * gen_auxvar_dn%d%denl_T))
1698) do icomp = 1, option%nflowspec
1699) Jdn(icomp,1) = Jdn(icomp,1) + dmole_flux_dpdn * xmol(icomp)
1700) Jdn(icomp,2) = Jdn(icomp,2) + mole_flux * dxmol_dn
1701) Jdn(icomp,3) = Jdn(icomp,3) + dmole_flux_dTdn * xmol(icomp)
1702) enddo
1703) Jdn(energy_id,1) = Jdn(energy_id,1) + &
1704) (dmole_flux_dpdn * uH + mole_flux * duH_dpdn)
1705) Jdn(energy_id,3) = Jdn(energy_id,3) + &
1706) (dmole_flux_dTdn * uH + mole_flux * duH_dTdn)
1707) case(GAS_STATE)
1708) case(TWO_PHASE_STATE)
1709) end select
1710) endif
1711) enddo
1712) Jup = Jup * area
1713) Jdn = Jdn * area
1714)
1715) ! add in gas component diffusion in gas and liquid phases
1716) do iphase = 1, option%nphase
1717)
1718) if (iphase == LIQUID_PHASE) cycle
1719)
1720) sat_up = gen_auxvar_up%sat(iphase)
1721) sat_dn = gen_auxvar_dn%sat(iphase)
1722) !geh: changed to .and. -> .or.
1723) if (sqrt(sat_up*sat_dn) < eps) cycle
1724) if (sat_up > eps .or. sat_dn > eps) then
1725) ! for now, if liquid state neighboring gas, we allow for minute
1726) ! diffusion in liquid phase.
1727) if (iphase == option%liquid_phase) then
1728) if ((sat_up > eps .or. sat_dn > eps)) then
1729) sat_up = max(sat_up,eps)
1730) sat_dn = max(sat_dn,eps)
1731) endif
1732) endif
1733) if (general_harmonic_diff_density) then
1734) den_up = gen_auxvar_up%den(iphase)
1735) den_dn = gen_auxvar_dn%den(iphase)
1736) else
1737) ! we use upstream weighting when iphase is not equal, otherwise
1738) ! arithmetic with 50/50 weighting
1739) den_up = GeneralAverageDensity(iphase, &
1740) global_auxvar_up%istate, &
1741) global_auxvar_dn%istate, &
1742) gen_auxvar_up%den, &
1743) gen_auxvar_dn%den, &
1744) dden_up,dden_dn)
1745) ! by setting both equal, we avoid the harmonic weighting below
1746) den_dn = den_up
1747) endif
1748) stpd_up = sat_up*material_auxvar_up%tortuosity* &
1749) gen_auxvar_up%effective_porosity*den_up
1750) stpd_dn = sat_dn*material_auxvar_dn%tortuosity* &
1751) gen_auxvar_dn%effective_porosity*den_dn
1752) if (general_diffuse_xmol) then
1753) delta_xmol = gen_auxvar_up%xmol(air_comp_id,iphase) - &
1754) gen_auxvar_dn%xmol(air_comp_id,iphase)
1755) delta_X_whatever = delta_xmol
1756) else
1757) xmol_air_up = gen_auxvar_up%xmol(air_comp_id,iphase)
1758) xmol_air_dn = gen_auxvar_dn%xmol(air_comp_id,iphase)
1759) xmass_air_up = xmol_air_up*fmw_comp(2) / &
1760) (xmol_air_up*fmw_comp(2) + (1.d0-xmol_air_up)*fmw_comp(1))
1761) xmass_air_dn = xmol_air_dn*fmw_comp(2) / &
1762) (xmol_air_dn*fmw_comp(2) + (1.d0-xmol_air_dn)*fmw_comp(1))
1763) delta_xmass = xmass_air_up - xmass_air_dn
1764) delta_X_whatever = delta_xmass
1765) endif
1766) ! units = [mole/m^4 bulk]
1767) stpd_ave_over_dist = (stpd_up*stpd_dn)/(stpd_up*dist_dn+stpd_dn*dist_up)
1768) ! need to account for multiple phases
1769) tempreal = 1.d0
1770) ! Eq. 1.9b. The gas density is added below
1771) if (general_temp_dep_gas_air_diff .and. &
1772) iphase == option%gas_phase) then
1773) temp_ave = 0.5d0*(gen_auxvar_up%temp+gen_auxvar_dn%temp)
1774) pressure_ave = 0.5d0*(gen_auxvar_up%pres(iphase)+ &
1775) gen_auxvar_dn%pres(iphase))
1776) tempreal = ((temp_ave+273.15d0)/273.15d0)**1.8d0 * &
1777) 101325.d0 / pressure_ave
1778) endif
1779) ! units = mole/sec
1780) mole_flux = stpd_ave_over_dist * tempreal * &
1781) general_parameter%diffusion_coefficient(iphase) * &
1782) delta_X_whatever * area
1783) Res(wat_comp_id) = Res(wat_comp_id) - mole_flux
1784) Res(air_comp_id) = Res(air_comp_id) + mole_flux
1785) endif
1786) enddo
1787) ! DIFFUSION
1788) endif
1789)
1790) #ifdef DEBUG_FLUXES
1791) if (debug_connection) then
1792) ! write(*,'(a,7es12.4)') 'in: ', adv_flux(:)*dist(1), diff_flux(:)*dist(1)
1793) write(*,'('' phase: gas'')')
1794) write(*,'('' pressure :'',2es12.4)') gen_auxvar_up%pres(2), gen_auxvar_dn%pres(2)
1795) write(*,'('' saturation :'',2es12.4)') gen_auxvar_up%sat(2), gen_auxvar_dn%sat(2)
1796) write(*,'('' water --'')')
1797) write(*,'('' darcy flux:'',es12.4)') adv_flux(1,2)
1798) write(*,'('' xmol :'',2es12.4)') gen_auxvar_up%xmol(1,2), gen_auxvar_dn%xmol(1,2)
1799) write(*,'('' diff flux :'',es12.4)') diff_flux(1,2)
1800) write(*,'('' air --'')')
1801) write(*,'('' darcy flux:'',es12.4)') adv_flux(2,2)
1802) write(*,'('' xmol :'',2es12.4)') gen_auxvar_up%xmol(2,2), gen_auxvar_dn%xmol(2,2)
1803) write(*,'('' diff flux :'',es12.4)') diff_flux(2,2)
1804) write(*,'('' heat flux :'',es12.4)') (adv_flux(3,2) + heat_flux)*1.d6
1805) write(*,'('' phase: liquid'')')
1806) write(*,'('' pressure :'',2es12.4)') gen_auxvar_up%pres(1), gen_auxvar_dn%pres(1)
1807) write(*,'('' saturation :'',2es12.4)') gen_auxvar_up%sat(1), gen_auxvar_dn%sat(1)
1808) write(*,'('' water --'')')
1809) write(*,'('' darcy flux:'',es12.4)') adv_flux(1,1)
1810) write(*,'('' xmol :'',2es12.4)') gen_auxvar_up%xmol(1,1), gen_auxvar_dn%xmol(1,1)
1811) write(*,'('' diff flux :'',es12.4)') diff_flux(1,1)
1812) write(*,'('' air --'')')
1813) write(*,'('' darcy flux:'',es12.4)') adv_flux(2,1)
1814) write(*,'('' xmol :'',2es12.4)') gen_auxvar_up%xmol(2,1), gen_auxvar_dn%xmol(2,1)
1815) write(*,'('' diff flux :'',es12.4)') diff_flux(2,1)
1816) write(*,'('' heat flux :'',es12.4)') (adv_flux(3,1) + heat_flux)*1.d6
1817) endif
1818) #endif
1819)
1820) #ifdef DEBUG_GENERAL_FILEOUTPUT
1821) debug_flux(energy_id,1) = debug_flux(energy_id,1) + heat_flux
1822) if (debug_flag > 0) then
1823) write(debug_unit,'(a,7es24.15)') 'dif flux (liquid):', debug_flux(:,1)
1824) write(debug_unit,'(a,7es24.15)') 'dif flux (gas):', debug_flux(:,2)
1825) endif
1826) #endif
1827)
1828) end subroutine GeneralFlux
1829)
1830) ! ************************************************************************** !
1831)
1832) subroutine GeneralBCFlux(ibndtype,auxvar_mapping,auxvars, &
1833) gen_auxvar_up,global_auxvar_up, &
1834) gen_auxvar_dn,global_auxvar_dn, &
1835) material_auxvar_dn, &
1836) sir_dn, &
1837) thermal_conductivity_dn, &
1838) area,dist,general_parameter, &
1839) option,v_darcy,Res,debug_connection)
1840) !
1841) ! Computes the boundary flux terms for the residual
1842) !
1843) ! Author: Glenn Hammond
1844) ! Date: 03/09/11
1845) !
1846) use Option_module
1847) use Material_Aux_class
1848) use Fracture_module
1849) use Klinkenberg_module
1850)
1851) implicit none
1852)
1853) type(general_auxvar_type) :: gen_auxvar_up, gen_auxvar_dn
1854) type(global_auxvar_type) :: global_auxvar_up, global_auxvar_dn
1855) class(material_auxvar_type) :: material_auxvar_dn
1856) type(option_type) :: option
1857) PetscReal :: sir_dn(:)
1858) PetscReal :: auxvars(:) ! from aux_real_var array
1859) PetscReal :: v_darcy(option%nphase), area
1860) type(general_parameter_type) :: general_parameter
1861) PetscReal :: dist(-1:3)
1862) PetscReal :: Res(1:option%nflowdof)
1863) PetscInt :: ibndtype(1:option%nflowdof)
1864) PetscInt :: auxvar_mapping(GENERAL_MAX_INDEX)
1865) PetscReal :: thermal_conductivity_dn(2)
1866) PetscBool :: debug_connection
1867)
1868) PetscInt :: wat_comp_id, air_comp_id, energy_id
1869) PetscInt :: icomp, iphase
1870) PetscInt :: bc_type
1871) PetscReal :: xmol(option%nflowspec)
1872) PetscReal :: density_ave, density_kg_ave
1873) PetscReal :: H_ave, uH
1874) PetscReal :: perm_dn_adj(option%nphase)
1875) PetscReal :: perm_ave_over_dist
1876) PetscReal :: dist_gravity
1877) PetscReal :: delta_pressure, delta_xmol, delta_temp
1878) PetscReal :: gravity_term
1879) PetscReal :: mobility, mole_flux, q
1880) PetscReal :: sat_dn, perm_dn, den_dn
1881) PetscReal :: temp_ave, stpd_ave_over_dist, pres_ave
1882) PetscReal :: k_eff_up, k_eff_dn, k_eff_ave, heat_flux
1883) PetscReal :: adv_flux(3,2), diff_flux(2,2)
1884) PetscReal :: debug_flux(3,3), debug_dphi(2)
1885) PetscReal :: boundary_pressure
1886) PetscReal :: xmass_air_up, xmass_air_dn, delta_xmass
1887) PetscReal :: xmol_air_up, xmol_air_dn
1888) PetscReal :: tempreal
1889) PetscReal :: delta_X_whatever
1890)
1891) PetscReal :: dden_dn, dden_up
1892)
1893) PetscInt :: idof
1894) PetscBool :: neumann_bc_present
1895)
1896) PetscReal :: temp_perm_dn
1897) PetscReal :: dummy_dperm_dn
1898)
1899) wat_comp_id = option%water_id
1900) air_comp_id = option%air_id
1901) energy_id = option%energy_id
1902)
1903) Res = 0.d0
1904) v_darcy = 0.d0
1905) #ifdef DEBUG_FLUXES
1906) adv_flux = 0.d0
1907) diff_flux = 0.d0
1908) #endif
1909) #ifdef DEBUG_GENERAL_FILEOUTPUT
1910) debug_flux = 0.d0
1911) debug_dphi = 0.d0
1912) #endif
1913)
1914) neumann_bc_present = PETSC_FALSE
1915)
1916) call material_auxvar_dn%PermeabilityTensorToScalar(dist,perm_dn)
1917)
1918) ! Fracture permeability change only available for structured grid (Heeho)
1919) if (associated(material_auxvar_dn%fracture)) then
1920) call FracturePermEvaluate(material_auxvar_dn,perm_dn,temp_perm_dn, &
1921) dummy_dperm_dn,dist)
1922) perm_dn = temp_perm_dn
1923) endif
1924)
1925) if (associated(klinkenberg)) then
1926) perm_dn_adj(1) = perm_dn
1927)
1928) perm_dn_adj(2) = klinkenberg%Evaluate(perm_dn, &
1929) gen_auxvar_dn%pres(option%gas_phase))
1930) else
1931) perm_dn_adj(:) = perm_dn
1932) endif
1933)
1934) #ifdef CONVECTION
1935) do iphase = 1, option%nphase
1936)
1937) bc_type = ibndtype(iphase)
1938) select case(bc_type)
1939) ! figure out the direction of flow
1940) case(DIRICHLET_BC,HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
1941)
1942) ! dist(0) = scalar - magnitude of distance
1943) ! gravity = vector(3)
1944) ! dist(1:3) = vector(3) - unit vector
1945) dist_gravity = dist(0) * dot_product(option%gravity,dist(1:3))
1946)
1947) if (bc_type == CONDUCTANCE_BC) then
1948) select case(iphase)
1949) case(LIQUID_PHASE)
1950) idof = auxvar_mapping(GENERAL_LIQUID_CONDUCTANCE_INDEX)
1951) case(GAS_PHASE)
1952) idof = auxvar_mapping(GENERAL_GAS_CONDUCTANCE_INDEX)
1953) end select
1954) perm_ave_over_dist = auxvars(idof)
1955) else
1956) perm_ave_over_dist = perm_dn_adj(iphase) / dist(0)
1957) endif
1958)
1959)
1960) ! using residual saturation cannot be correct! - geh
1961) ! reusing sir_dn for bounary auxvar
1962) #define BAD_MOVE1 ! this works
1963) #ifndef BAD_MOVE1
1964) if (gen_auxvar_up%sat(iphase) > sir_dn(iphase) .or. &
1965) gen_auxvar_dn%sat(iphase) > sir_dn(iphase)) then
1966) #endif
1967) boundary_pressure = gen_auxvar_up%pres(iphase)
1968) if (iphase == LIQUID_PHASE .and. &
1969) global_auxvar_up%istate == GAS_STATE) then
1970) ! the idea here is to accommodate a free surface boundary
1971) ! face. this will not work for an interior grid cell as
1972) ! there should be capillary pressure in force.
1973) boundary_pressure = gen_auxvar_up%pres(option%gas_phase)
1974) endif
1975) density_kg_ave = GeneralAverageDensity(iphase, &
1976) global_auxvar_up%istate, &
1977) global_auxvar_dn%istate, &
1978) gen_auxvar_up%den_kg, &
1979) gen_auxvar_dn%den_kg, &
1980) dden_up, dden_dn)
1981) gravity_term = density_kg_ave * dist_gravity
1982) delta_pressure = boundary_pressure - &
1983) gen_auxvar_dn%pres(iphase) + &
1984) gravity_term
1985)
1986) #ifdef DEBUG_GENERAL_FILEOUTPUT
1987) debug_dphi(iphase) = delta_pressure
1988) #endif
1989)
1990) if (bc_type == SEEPAGE_BC .or. &
1991) bc_type == CONDUCTANCE_BC) then
1992) ! flow in ! boundary cell is <= pref
1993) if (delta_pressure > 0.d0 .and. &
1994) gen_auxvar_up%pres(iphase) - &
1995) option%reference_pressure < eps) then
1996) delta_pressure = 0.d0
1997) endif
1998) endif
1999)
2000) if (delta_pressure >= 0.D0) then
2001) mobility = gen_auxvar_up%mobility(iphase)
2002) xmol(:) = gen_auxvar_up%xmol(:,iphase)
2003) uH = gen_auxvar_up%H(iphase)
2004) else
2005) mobility = gen_auxvar_dn%mobility(iphase)
2006) xmol(:) = gen_auxvar_dn%xmol(:,iphase)
2007) uH = gen_auxvar_dn%H(iphase)
2008) endif
2009)
2010) if (mobility > floweps) then
2011) ! v_darcy[m/sec] = perm[m^2] / dist[m] * kr[-] / mu[Pa-sec]
2012) ! dP[Pa]]
2013) v_darcy(iphase) = perm_ave_over_dist * mobility * delta_pressure
2014) ! only need average density if velocity > 0.
2015) density_ave = GeneralAverageDensity(iphase, &
2016) global_auxvar_up%istate, &
2017) global_auxvar_dn%istate, &
2018) gen_auxvar_up%den, &
2019) gen_auxvar_dn%den, &
2020) dden_up,dden_dn)
2021) endif
2022) #ifndef BAD_MOVE1
2023) endif ! sat > eps
2024) #endif
2025)
2026) case(NEUMANN_BC)
2027) select case(iphase)
2028) case(LIQUID_PHASE)
2029) idof = auxvar_mapping(GENERAL_LIQUID_FLUX_INDEX)
2030) case(GAS_PHASE)
2031) idof = auxvar_mapping(GENERAL_GAS_FLUX_INDEX)
2032) end select
2033)
2034) neumann_bc_present = PETSC_TRUE
2035) xmol = 0.d0
2036) xmol(iphase) = 1.d0
2037) if (dabs(auxvars(idof)) > floweps) then
2038) v_darcy(iphase) = auxvars(idof)
2039) if (v_darcy(iphase) > 0.d0) then
2040) density_ave = gen_auxvar_up%den(iphase)
2041) uH = gen_auxvar_up%H(iphase)
2042) else
2043) density_ave = gen_auxvar_dn%den(iphase)
2044) uH = gen_auxvar_dn%H(iphase)
2045) endif
2046) endif
2047) case default
2048) option%io_buffer = &
2049) 'Boundary condition type not recognized in GeneralBCFlux phase loop.'
2050) call printErrMsg(option)
2051) end select
2052)
2053) if (dabs(v_darcy(iphase)) > 0.d0) then
2054) ! q[m^3 phase/sec] = v_darcy[m/sec] * area[m^2]
2055) q = v_darcy(iphase) * area
2056) ! mole_flux[kmol phase/sec] = q[m^3 phase/sec] *
2057) ! density_ave[kmol phase/m^3 phase]
2058) mole_flux = q*density_ave
2059) ! Res[kmol total/sec]
2060) do icomp = 1, option%nflowspec
2061) ! Res[kmol comp/sec] = mole_flux[kmol phase/sec] *
2062) ! xmol[kmol comp/mol phase]
2063) Res(icomp) = Res(icomp) + mole_flux * xmol(icomp)
2064) enddo
2065) #ifdef DEBUG_FLUXES
2066) do icomp = 1, option%nflowspec
2067) adv_flux(icomp,iphase) = adv_flux(icomp,iphase) + mole_flux * xmol(icomp)
2068) enddo
2069) #endif
2070) #ifdef DEBUG_GENERAL_FILEOUTPUT
2071) do icomp = 1, option%nflowspec
2072) debug_flux(icomp,iphase) = debug_flux(icomp,iphase) + mole_flux * xmol(icomp)
2073) enddo
2074) #endif
2075) ! Res[MJ/sec] = mole_flux[kmol comp/sec] * H_ave[MJ/kmol comp]
2076) Res(energy_id) = Res(energy_id) + mole_flux * uH ! H_ave
2077) #ifdef DEBUG_FLUXES
2078) adv_flux(energy_id,iphase) = adv_flux(energy_id,iphase) + mole_flux * uH
2079) #endif
2080) #ifdef DEBUG_GENERAL_FILEOUTPUT
2081) debug_flux(energy_id,iphase) = debug_flux(energy_id,iphase) + mole_flux * uH
2082) #endif
2083) endif
2084) enddo
2085) ! CONVECTION
2086) #endif
2087)
2088) #ifdef DEBUG_GENERAL_FILEOUTPUT
2089) if (debug_flag > 0) then
2090) write(debug_unit,'(a,7es24.15)') 'bc delta pressure :', debug_dphi(:)
2091) write(debug_unit,'(a,7es24.15)') 'bc adv flux (liquid):', debug_flux(:,1)
2092) write(debug_unit,'(a,7es24.15)') 'bc adv flux (gas):', debug_flux(:,2)
2093) endif
2094) debug_flux = 0.d0
2095) #endif
2096)
2097) #ifdef DIFFUSION
2098) ! add in gas component diffusion in gas and liquid phases
2099) do iphase = 1, option%nphase
2100)
2101) #ifdef LIQUID_DIFFUSION
2102) ! if (neumann_bc_present) cycle
2103) if (ibndtype(iphase) == NEUMANN_BC) cycle
2104) #else
2105) if (iphase == LIQUID_PHASE) cycle
2106) #endif
2107)
2108) ! diffusion all depends upon the downwind cell. phase diffusion only
2109) ! occurs if a phase exists in both auxvars (boundary and internal) or
2110) ! a liquid phase exists in the internal cell. so, one could say that
2111) ! liquid diffusion always exists as the internal cell has a liquid phase,
2112) ! but gas phase diffusion only occurs if the internal cell has a gas
2113) ! phase.
2114) if (gen_auxvar_dn%sat(iphase) > eps) then
2115) sat_dn = gen_auxvar_dn%sat(iphase)
2116) if (general_harmonic_diff_density) then
2117) den_dn = gen_auxvar_dn%den(iphase)
2118) else
2119) ! we use upstream weighting when iphase is not equal, otherwise
2120) ! arithmetic with 50/50 weighting
2121) den_dn = GeneralAverageDensity(iphase, &
2122) global_auxvar_up%istate, &
2123) global_auxvar_dn%istate, &
2124) gen_auxvar_up%den, &
2125) gen_auxvar_dn%den, &
2126) dden_up,dden_dn)
2127) endif
2128) ! units = [mole/m^4 bulk]
2129) stpd_ave_over_dist = sat_dn*material_auxvar_dn%tortuosity * &
2130) gen_auxvar_dn%effective_porosity * &
2131) den_dn / dist(0)
2132) if (general_diffuse_xmol) then
2133) delta_xmol = gen_auxvar_up%xmol(air_comp_id,iphase) - &
2134) gen_auxvar_dn%xmol(air_comp_id,iphase)
2135) delta_X_whatever = delta_xmol
2136) else
2137) xmol_air_up = gen_auxvar_up%xmol(air_comp_id,iphase)
2138) xmol_air_dn = gen_auxvar_dn%xmol(air_comp_id,iphase)
2139) xmass_air_up = xmol_air_up*fmw_comp(2) / &
2140) (xmol_air_up*fmw_comp(2) + (1.d0-xmol_air_up)*fmw_comp(1))
2141) xmass_air_dn = xmol_air_dn*fmw_comp(2) / &
2142) (xmol_air_dn*fmw_comp(2) + (1.d0-xmol_air_dn)*fmw_comp(1))
2143) delta_xmass = xmass_air_up - xmass_air_dn
2144) delta_X_whatever = delta_xmass
2145) endif
2146) ! need to account for multiple phases
2147) ! units = (m^3 water/m^4 bulk)*(m^2 bulk/sec) = m^3 water/m^2 bulk/sec
2148) tempreal = 1.d0
2149) ! Eq. 1.9b. The gas density is added below
2150) if (general_temp_dep_gas_air_diff .and. &
2151) iphase == option%gas_phase) then
2152) temp_ave = 0.5d0*(gen_auxvar_up%temp+gen_auxvar_dn%temp)
2153) pres_ave = 0.5d0*(gen_auxvar_up%pres(iphase)+ &
2154) gen_auxvar_dn%pres(iphase))
2155) tempreal = ((temp_ave+273.15d0)/273.15d0)**1.8d0 * &
2156) 101325.d0 / pres_ave
2157) endif
2158) ! units = mole/sec
2159) mole_flux = stpd_ave_over_dist * tempreal * &
2160) general_parameter%diffusion_coefficient(iphase) * &
2161) delta_X_whatever * area
2162) Res(wat_comp_id) = Res(wat_comp_id) - mole_flux
2163) Res(air_comp_id) = Res(air_comp_id) + mole_flux
2164) #ifdef DEBUG_FLUXES
2165) ! equal but opposite
2166) diff_flux(wat_comp_id,iphase) = diff_flux(wat_comp_id,iphase) - mole_flux
2167) diff_flux(air_comp_id,iphase) = diff_flux(air_comp_id,iphase) + mole_flux
2168) #endif
2169) #ifdef DEBUG_GENERAL_FILEOUTPUT
2170) debug_flux(wat_comp_id,iphase) = debug_flux(wat_comp_id,iphase) - mole_flux
2171) debug_flux(air_comp_id,iphase) = debug_flux(air_comp_id,iphase) + mole_flux
2172) #endif
2173) endif
2174) enddo
2175) ! DIFFUSION
2176) #endif
2177)
2178) #ifdef CONDUCTION
2179) ! add heat conduction flux
2180) heat_flux = 0.d0
2181) select case (ibndtype(GENERAL_ENERGY_EQUATION_INDEX))
2182) case (DIRICHLET_BC)
2183) ! based on Somerton et al., 1974:
2184) ! k_eff = k_dry + sqrt(s_l)*(k_sat-k_dry)
2185) k_eff_dn = thermal_conductivity_dn(1) + &
2186) sqrt(gen_auxvar_dn%sat(option%liquid_phase)) * &
2187) (thermal_conductivity_dn(2) - thermal_conductivity_dn(1))
2188) ! units:
2189) ! k_eff = W/K/m/m = J/s/K/m/m
2190) ! delta_temp = K
2191) ! area = m^2
2192) ! heat_flux = J/s
2193) k_eff_ave = k_eff_dn / dist(0)
2194) delta_temp = gen_auxvar_up%temp - gen_auxvar_dn%temp
2195) heat_flux = k_eff_ave * delta_temp * area * 1.d-6 ! convert W -> MW
2196) case(NEUMANN_BC)
2197) ! flux prescribed as MW/m^2
2198) heat_flux = auxvars(auxvar_mapping(GENERAL_ENERGY_FLUX_INDEX)) * area
2199)
2200) case default
2201) option%io_buffer = 'Boundary condition type not recognized in ' // &
2202) 'GeneralBCFlux heat conduction loop.'
2203) call printErrMsg(option)
2204) end select
2205) Res(energy_id) = Res(energy_id) + heat_flux ! MW
2206) ! CONDUCTION
2207) #endif
2208)
2209) #ifdef DEBUG_FLUXES
2210) if (debug_connection) then
2211) ! write(*,'(a,7es12.4)') 'in: ', adv_flux(:)*dist(1), diff_flux(:)*dist(1)
2212) write(*,'('' phase: gas'')')
2213) write(*,'('' pressure :'',2es12.4)') gen_auxvar_up%pres(2), gen_auxvar_dn%pres(2)
2214) write(*,'('' saturation :'',2es12.4)') gen_auxvar_up%sat(2), gen_auxvar_dn%sat(2)
2215) write(*,'('' water --'')')
2216) write(*,'('' darcy flux:'',es12.4)') adv_flux(1,2)
2217) write(*,'('' xmol :'',2es12.4)') gen_auxvar_up%xmol(1,2), gen_auxvar_dn%xmol(1,2)
2218) write(*,'('' diff flux :'',es12.4)') diff_flux(1,2)
2219) write(*,'('' air --'')')
2220) write(*,'('' darcy flux:'',es12.4)') adv_flux(2,2)
2221) write(*,'('' xmol :'',2es12.4)') gen_auxvar_up%xmol(2,2), gen_auxvar_dn%xmol(2,2)
2222) write(*,'('' diff flux :'',es12.4)') diff_flux(2,2)
2223) write(*,'('' heat flux :'',es12.4)') (adv_flux(3,2) + heat_flux)*1.d6
2224) write(*,'('' phase: liquid'')')
2225) write(*,'('' pressure :'',2es12.4)') gen_auxvar_up%pres(1), gen_auxvar_dn%pres(1)
2226) write(*,'('' saturation :'',2es12.4)') gen_auxvar_up%sat(1), gen_auxvar_dn%sat(1)
2227) write(*,'('' water --'')')
2228) write(*,'('' darcy flux:'',es12.4)') adv_flux(1,1)
2229) write(*,'('' xmol :'',2es12.4)') gen_auxvar_up%xmol(1,1), gen_auxvar_dn%xmol(1,1)
2230) write(*,'('' diff flux :'',es12.4)') diff_flux(1,1)
2231) write(*,'('' air --'')')
2232) write(*,'('' darcy flux:'',es12.4)') adv_flux(2,1)
2233) write(*,'('' xmol :'',2es12.4)') gen_auxvar_up%xmol(2,1), gen_auxvar_dn%xmol(2,1)
2234) write(*,'('' diff flux :'',es12.4)') diff_flux(2,1)
2235) write(*,'('' heat flux :'',es12.4)') (adv_flux(3,1) + heat_flux)*1.d6
2236) endif
2237) #endif
2238)
2239) #ifdef DEBUG_GENERAL_FILEOUTPUT
2240) debug_flux(energy_id,1) = debug_flux(energy_id,1) + heat_flux
2241) if (debug_flag > 0) then
2242) write(debug_unit,'(a,7es24.15)') 'bc dif flux (liquid):', debug_flux(:,1)*dist(3)
2243) write(debug_unit,'(a,7es24.15)') 'bc dif flux (gas):', debug_flux(:,2)*dist(3)
2244) endif
2245) #endif
2246)
2247) end subroutine GeneralBCFlux
2248)
2249) ! ************************************************************************** !
2250)
2251) subroutine GeneralSrcSink(option,qsrc,flow_src_sink_type, &
2252) gen_auxvar,global_auxvar,ss_flow_vol_flux, &
2253) scale,Res,debug_cell)
2254) !
2255) ! Computes the source/sink terms for the residual
2256) !
2257) ! Author: Glenn Hammond
2258) ! Date: 03/09/11
2259) !
2260)
2261) use Option_module
2262)
2263) use EOS_Water_module
2264) use EOS_Gas_module
2265)
2266) implicit none
2267)
2268) type(option_type) :: option
2269) PetscReal :: qsrc(:)
2270) PetscInt :: flow_src_sink_type
2271) type(general_auxvar_type) :: gen_auxvar
2272) type(global_auxvar_type) :: global_auxvar
2273) PetscReal :: ss_flow_vol_flux(option%nphase)
2274) PetscReal :: scale
2275) PetscReal :: Res(option%nflowdof)
2276) PetscBool :: debug_cell
2277)
2278) PetscReal :: qsrc_mol
2279) PetscReal :: enthalpy, internal_energy
2280) PetscReal :: cell_pressure, dummy_pressure
2281) PetscInt :: icomp
2282) PetscErrorCode :: ierr
2283)
2284) Res = 0.d0
2285) do icomp = 1, option%nflowspec
2286) qsrc_mol = 0.d0
2287) select case(flow_src_sink_type)
2288) case(MASS_RATE_SS)
2289) qsrc_mol = qsrc(icomp)/fmw_comp(icomp) ! kg/sec -> kmol/sec
2290) case(SCALED_MASS_RATE_SS) ! kg/sec -> kmol/sec
2291) qsrc_mol = qsrc(icomp)/fmw_comp(icomp)*scale
2292) case(VOLUMETRIC_RATE_SS) ! assume local density for now
2293) ! qsrc1 = m^3/sec
2294) qsrc_mol = qsrc(icomp)*gen_auxvar%den(icomp) ! den = kmol/m^3
2295) case(SCALED_VOLUMETRIC_RATE_SS) ! assume local density for now
2296) ! qsrc1 = m^3/sec ! den = kmol/m^3
2297) qsrc_mol = qsrc(icomp)*gen_auxvar%den(icomp)*scale
2298) end select
2299) ! icomp here is really iphase
2300) ss_flow_vol_flux(icomp) = qsrc_mol/gen_auxvar%den(icomp)
2301) Res(icomp) = qsrc_mol
2302) enddo
2303) if (dabs(qsrc(TWO_INTEGER)) < 1.d-40 .and. &
2304) qsrc(ONE_INTEGER) < 0.d0) then ! extraction only
2305) ! Res(1) holds qsrc_mol for water. If the src/sink value for air is zero,
2306) ! remove/add the equivalent mole fraction of air in the liquid phase.
2307) qsrc_mol = Res(ONE_INTEGER)*gen_auxvar%xmol(TWO_INTEGER,ONE_INTEGER)
2308) Res(TWO_INTEGER) = qsrc_mol
2309) ss_flow_vol_flux(TWO_INTEGER) = qsrc_mol/gen_auxvar%den(TWO_INTEGER)
2310) endif
2311) ! energy units: MJ/sec
2312) if (size(qsrc) == THREE_INTEGER) then
2313) if (dabs(qsrc(THREE_INTEGER)) < 1.d-40) then
2314) cell_pressure = &
2315) maxval(gen_auxvar%pres(option%liquid_phase:option%gas_phase))
2316) if (dabs(qsrc(ONE_INTEGER)) > 0.d0) then
2317) call EOSWaterEnthalpy(gen_auxvar%temp,cell_pressure,enthalpy,ierr)
2318) enthalpy = enthalpy * 1.d-6 ! J/kmol -> whatever units
2319) ! enthalpy units: MJ/kmol ! water component mass
2320) Res(option%energy_id) = Res(option%energy_id) + Res(ONE_INTEGER) * &
2321) enthalpy
2322) endif
2323) if (dabs(qsrc(TWO_INTEGER)) > 0.d0) then
2324) ! this is pure air, we use the enthalpy of air, NOT the air/water
2325) ! mixture in gas
2326) ! air enthalpy is only a function of temperature and the
2327) dummy_pressure = 0.d0
2328) call EOSGasEnergy(gen_auxvar%temp,dummy_pressure, &
2329) enthalpy,internal_energy,ierr)
2330) enthalpy = enthalpy * 1.d-6 ! J/kmol -> MJ/kmol
2331) ! enthalpy units: MJ/kmol ! air component mass
2332) Res(option%energy_id) = Res(option%energy_id) + Res(TWO_INTEGER) * &
2333) enthalpy
2334) endif
2335) else
2336) Res(option%energy_id) = qsrc(THREE_INTEGER)*scale ! MJ/s
2337) endif
2338) endif
2339)
2340) #ifdef DEBUG_GENERAL_FILEOUTPUT
2341) if (debug_flag > 0) then
2342) write(debug_unit,'(a,7es24.15)') 'src/sink:', Res(1)-Res(2),Res(12:3)
2343) endif
2344) #endif
2345)
2346) end subroutine GeneralSrcSink
2347)
2348) ! ************************************************************************** !
2349)
2350) subroutine GeneralAccumDerivative(gen_auxvar,global_auxvar,material_auxvar, &
2351) soil_heat_capacity,option,J)
2352) !
2353) ! Computes derivatives of the accumulation
2354) ! term for the Jacobian
2355) !
2356) ! Author: Glenn Hammond
2357) ! Date: 03/09/11
2358) !
2359)
2360) use Option_module
2361) use Saturation_Function_module
2362) use Material_Aux_class
2363)
2364) implicit none
2365)
2366) type(general_auxvar_type) :: gen_auxvar(0:)
2367) type(global_auxvar_type) :: global_auxvar
2368) class(material_auxvar_type) :: material_auxvar
2369) type(option_type) :: option
2370) PetscReal :: soil_heat_capacity
2371) PetscReal :: J(option%nflowdof,option%nflowdof)
2372)
2373) PetscReal :: res(option%nflowdof), res_pert(option%nflowdof)
2374) PetscReal :: jac(option%nflowdof,option%nflowdof)
2375) PetscReal :: jac_pert(option%nflowdof,option%nflowdof)
2376) PetscInt :: idof, irow
2377)
2378) !geh:print *, 'GeneralAccumDerivative'
2379)
2380) call GeneralAccumulation(gen_auxvar(ZERO_INTEGER), &
2381) global_auxvar, &
2382) material_auxvar,soil_heat_capacity,option, &
2383) res,jac,general_analytical_derivatives, &
2384) PETSC_FALSE)
2385)
2386) do idof = 1, option%nflowdof
2387) call GeneralAccumulation(gen_auxvar(idof), &
2388) global_auxvar, &
2389) material_auxvar,soil_heat_capacity, &
2390) option,res_pert,jac_pert,PETSC_FALSE,PETSC_FALSE)
2391) do irow = 1, option%nflowdof
2392) J(irow,idof) = (res_pert(irow)-res(irow))/gen_auxvar(idof)%pert
2393) !geh:print *, irow, idof, J(irow,idof), gen_auxvar(idof)%pert
2394) enddo !irow
2395) enddo ! idof
2396)
2397) if (general_analytical_derivatives) then
2398) J = jac
2399) endif
2400)
2401) if (general_isothermal) then
2402) J(GENERAL_ENERGY_EQUATION_INDEX,:) = 0.d0
2403) J(:,GENERAL_ENERGY_EQUATION_INDEX) = 0.d0
2404) endif
2405)
2406) if (general_no_air) then
2407) J(GENERAL_GAS_EQUATION_INDEX,:) = 0.d0
2408) J(:,GENERAL_GAS_EQUATION_INDEX) = 0.d0
2409) endif
2410)
2411) #ifdef DEBUG_GENERAL_FILEOUTPUT
2412) if (debug_flag > 0) then
2413) write(debug_unit,'(a,10es24.15)') 'accum deriv:', J
2414) endif
2415) #endif
2416)
2417) end subroutine GeneralAccumDerivative
2418)
2419) ! ************************************************************************** !
2420)
2421) subroutine GeneralFluxDerivative(gen_auxvar_up,global_auxvar_up, &
2422) material_auxvar_up, &
2423) sir_up, &
2424) thermal_conductivity_up, &
2425) gen_auxvar_dn,global_auxvar_dn, &
2426) material_auxvar_dn, &
2427) sir_dn, &
2428) thermal_conductivity_dn, &
2429) area, dist, &
2430) general_parameter, &
2431) option,Jup,Jdn)
2432) !
2433) ! Computes the derivatives of the internal flux terms
2434) ! for the Jacobian
2435) !
2436) ! Author: Glenn Hammond
2437) ! Date: 03/09/11
2438) !
2439) use Option_module
2440) use Material_Aux_class
2441)
2442) implicit none
2443)
2444) type(general_auxvar_type) :: gen_auxvar_up(0:), gen_auxvar_dn(0:)
2445) type(global_auxvar_type) :: global_auxvar_up, global_auxvar_dn
2446) class(material_auxvar_type) :: material_auxvar_up, material_auxvar_dn
2447) type(option_type) :: option
2448) PetscReal :: sir_up(:), sir_dn(:)
2449) PetscReal :: thermal_conductivity_dn(2)
2450) PetscReal :: thermal_conductivity_up(2)
2451) PetscReal :: area
2452) PetscReal :: dist(-1:3)
2453) type(general_parameter_type) :: general_parameter
2454) PetscReal :: Jup(option%nflowdof,option%nflowdof)
2455) PetscReal :: Jdn(option%nflowdof,option%nflowdof)
2456) PetscReal :: Janal_up(option%nflowdof,option%nflowdof)
2457) PetscReal :: Janal_dn(option%nflowdof,option%nflowdof)
2458) PetscReal :: Jdummy(option%nflowdof,option%nflowdof)
2459)
2460) PetscReal :: v_darcy(option%nphase)
2461) PetscReal :: res(option%nflowdof), res_pert(option%nflowdof)
2462) PetscInt :: idof, irow
2463)
2464) Jup = 0.d0
2465) Jdn = 0.d0
2466)
2467) !geh:print *, 'GeneralFluxDerivative'
2468) option%iflag = -2
2469) call GeneralFlux(gen_auxvar_up(ZERO_INTEGER),global_auxvar_up, &
2470) material_auxvar_up,sir_up, &
2471) thermal_conductivity_up, &
2472) gen_auxvar_dn(ZERO_INTEGER),global_auxvar_dn, &
2473) material_auxvar_dn,sir_dn, &
2474) thermal_conductivity_dn, &
2475) area,dist,general_parameter, &
2476) option,v_darcy,res,Janal_up,Janal_dn,&
2477) general_analytical_derivatives,PETSC_FALSE)
2478)
2479) ! upgradient derivatives
2480) do idof = 1, option%nflowdof
2481) call GeneralFlux(gen_auxvar_up(idof),global_auxvar_up, &
2482) material_auxvar_up,sir_up, &
2483) thermal_conductivity_up, &
2484) gen_auxvar_dn(ZERO_INTEGER),global_auxvar_dn, &
2485) material_auxvar_dn,sir_dn, &
2486) thermal_conductivity_dn, &
2487) area,dist,general_parameter, &
2488) option,v_darcy,res_pert,Jdummy,Jdummy, &
2489) PETSC_FALSE,PETSC_FALSE)
2490) do irow = 1, option%nflowdof
2491) Jup(irow,idof) = (res_pert(irow)-res(irow))/gen_auxvar_up(idof)%pert
2492) !geh:print *, 'up: ', irow, idof, Jup(irow,idof), gen_auxvar_up(idof)%pert
2493) enddo !irow
2494) enddo ! idof
2495)
2496) ! downgradient derivatives
2497) do idof = 1, option%nflowdof
2498) call GeneralFlux(gen_auxvar_up(ZERO_INTEGER),global_auxvar_up, &
2499) material_auxvar_up,sir_up, &
2500) thermal_conductivity_up, &
2501) gen_auxvar_dn(idof),global_auxvar_dn, &
2502) material_auxvar_dn,sir_dn, &
2503) thermal_conductivity_dn, &
2504) area,dist,general_parameter, &
2505) option,v_darcy,res_pert,Jdummy,Jdummy, &
2506) PETSC_FALSE,PETSC_FALSE)
2507) do irow = 1, option%nflowdof
2508) Jdn(irow,idof) = (res_pert(irow)-res(irow))/gen_auxvar_dn(idof)%pert
2509) !geh:print *, 'dn: ', irow, idof, Jdn(irow,idof), gen_auxvar_dn(idof)%pert
2510) enddo !irow
2511) enddo ! idof
2512)
2513) if (general_isothermal) then
2514) Jup(GENERAL_ENERGY_EQUATION_INDEX,:) = 0.d0
2515) Jup(:,GENERAL_ENERGY_EQUATION_INDEX) = 0.d0
2516) Jdn(GENERAL_ENERGY_EQUATION_INDEX,:) = 0.d0
2517) Jdn(:,GENERAL_ENERGY_EQUATION_INDEX) = 0.d0
2518) endif
2519)
2520) if (general_no_air) then
2521) Jup(GENERAL_GAS_EQUATION_INDEX,:) = 0.d0
2522) Jup(:,GENERAL_GAS_EQUATION_INDEX) = 0.d0
2523) Jdn(GENERAL_GAS_EQUATION_INDEX,:) = 0.d0
2524) Jdn(:,GENERAL_GAS_EQUATION_INDEX) = 0.d0
2525) endif
2526)
2527) #ifdef DEBUG_GENERAL_FILEOUTPUT
2528) if (debug_flag > 0) then
2529) write(debug_unit,'(a,20es24.15)') 'flux deriv:', Jup, Jdn
2530) endif
2531) #endif
2532)
2533) end subroutine GeneralFluxDerivative
2534)
2535) ! ************************************************************************** !
2536)
2537) subroutine GeneralBCFluxDerivative(ibndtype,auxvar_mapping,auxvars, &
2538) gen_auxvar_up, &
2539) global_auxvar_up, &
2540) gen_auxvar_dn,global_auxvar_dn, &
2541) material_auxvar_dn, &
2542) sir_dn, &
2543) thermal_conductivity_dn, &
2544) area,dist,general_parameter, &
2545) option,Jdn)
2546) !
2547) ! Computes the derivatives of the boundary flux terms
2548) ! for the Jacobian
2549) !
2550) ! Author: Glenn Hammond
2551) ! Date: 03/09/11
2552) !
2553)
2554) use Option_module
2555) use Material_Aux_class
2556)
2557) implicit none
2558)
2559) PetscReal :: auxvars(:) ! from aux_real_var array
2560) type(general_auxvar_type) :: gen_auxvar_up, gen_auxvar_dn(0:)
2561) type(global_auxvar_type) :: global_auxvar_up, global_auxvar_dn
2562) class(material_auxvar_type) :: material_auxvar_dn
2563) type(option_type) :: option
2564) PetscReal :: sir_dn(:)
2565) PetscReal :: area
2566) PetscReal :: dist(-1:3)
2567) type(general_parameter_type) :: general_parameter
2568) PetscReal :: Jdn(option%nflowdof,option%nflowdof)
2569) PetscInt :: ibndtype(1:option%nflowdof)
2570) PetscInt :: auxvar_mapping(GENERAL_MAX_INDEX)
2571) PetscReal :: thermal_conductivity_dn(2)
2572)
2573) PetscReal :: v_darcy(option%nphase)
2574) PetscReal :: res(option%nflowdof), res_pert(option%nflowdof)
2575) PetscInt :: idof, irow
2576)
2577) Jdn = 0.d0
2578) !geh:print *, 'GeneralBCFluxDerivative'
2579)
2580) option%iflag = -2
2581) call GeneralBCFlux(ibndtype,auxvar_mapping,auxvars, &
2582) gen_auxvar_up,global_auxvar_up, &
2583) gen_auxvar_dn(ZERO_INTEGER),global_auxvar_dn, &
2584) material_auxvar_dn, &
2585) sir_dn, &
2586) thermal_conductivity_dn, &
2587) area,dist,general_parameter, &
2588) option,v_darcy,res,PETSC_FALSE)
2589) ! downgradient derivatives
2590) do idof = 1, option%nflowdof
2591) call GeneralBCFlux(ibndtype,auxvar_mapping,auxvars, &
2592) gen_auxvar_up,global_auxvar_up, &
2593) gen_auxvar_dn(idof),global_auxvar_dn, &
2594) material_auxvar_dn, &
2595) sir_dn, &
2596) thermal_conductivity_dn, &
2597) area,dist,general_parameter, &
2598) option,v_darcy,res_pert,PETSC_FALSE)
2599) do irow = 1, option%nflowdof
2600) Jdn(irow,idof) = (res_pert(irow)-res(irow))/gen_auxvar_dn(idof)%pert
2601) !print *, 'bc: ', irow, idof, Jdn(irow,idof), gen_auxvar_dn(idof)%pert
2602) enddo !irow
2603) enddo ! idof
2604)
2605) if (general_isothermal) then
2606) Jdn(GENERAL_ENERGY_EQUATION_INDEX,:) = 0.d0
2607) Jdn(:,GENERAL_ENERGY_EQUATION_INDEX) = 0.d0
2608) endif
2609)
2610) if (general_no_air) then
2611) Jdn(GENERAL_GAS_EQUATION_INDEX,:) = 0.d0
2612) Jdn(:,GENERAL_GAS_EQUATION_INDEX) = 0.d0
2613) endif
2614)
2615) #ifdef DEBUG_GENERAL_FILEOUTPUT
2616) if (debug_flag > 0) then
2617) write(debug_unit,'(a,10es24.15)') 'bc flux deriv:', Jdn
2618) endif
2619) #endif
2620)
2621) end subroutine GeneralBCFluxDerivative
2622)
2623) ! ************************************************************************** !
2624)
2625) subroutine GeneralSrcSinkDerivative(option,qsrc,flow_src_sink_type, &
2626) gen_auxvars,global_auxvar,scale,Jac)
2627) !
2628) ! Computes the source/sink terms for the residual
2629) !
2630) ! Author: Glenn Hammond
2631) ! Date: 03/09/11
2632) !
2633)
2634) use Option_module
2635)
2636) implicit none
2637)
2638) type(option_type) :: option
2639) PetscReal :: qsrc(:)
2640) PetscInt :: flow_src_sink_type
2641) type(general_auxvar_type) :: gen_auxvars(0:)
2642) type(global_auxvar_type) :: global_auxvar
2643) PetscReal :: scale
2644) PetscReal :: Jac(option%nflowdof,option%nflowdof)
2645)
2646) PetscReal :: res(option%nflowdof), res_pert(option%nflowdof)
2647) PetscReal :: dummy_real(option%nphase)
2648) PetscInt :: idof, irow
2649)
2650) option%iflag = -3
2651) call GeneralSrcSink(option,qsrc,flow_src_sink_type, &
2652) gen_auxvars(ZERO_INTEGER),global_auxvar,dummy_real, &
2653) scale,res,PETSC_FALSE)
2654) ! downgradient derivatives
2655) do idof = 1, option%nflowdof
2656) call GeneralSrcSink(option,qsrc,flow_src_sink_type, &
2657) gen_auxvars(idof),global_auxvar,dummy_real, &
2658) scale,res_pert,PETSC_FALSE)
2659) do irow = 1, option%nflowdof
2660) Jac(irow,idof) = (res_pert(irow)-res(irow))/gen_auxvars(idof)%pert
2661) enddo !irow
2662) enddo ! idof
2663)
2664) if (general_isothermal) then
2665) Jac(GENERAL_ENERGY_EQUATION_INDEX,:) = 0.d0
2666) Jac(:,GENERAL_ENERGY_EQUATION_INDEX) = 0.d0
2667) endif
2668)
2669) if (general_no_air) then
2670) Jac(GENERAL_GAS_EQUATION_INDEX,:) = 0.d0
2671) Jac(:,GENERAL_GAS_EQUATION_INDEX) = 0.d0
2672) endif
2673)
2674) #ifdef DEBUG_GENERAL_FILEOUTPUT
2675) if (debug_flag > 0) then
2676) write(debug_unit,'(a,20es24.15)') 'src/sink deriv:', Jac
2677) endif
2678) #endif
2679)
2680) end subroutine GeneralSrcSinkDerivative
2681)
2682) ! ************************************************************************** !
2683)
2684) subroutine GeneralResidual(snes,xx,r,realization,ierr)
2685) !
2686) ! Computes the residual equation
2687) !
2688) ! Author: Glenn Hammond
2689) ! Date: 03/09/11
2690) !
2691)
2692) use Realization_Subsurface_class
2693) use Field_module
2694) use Patch_module
2695) use Discretization_module
2696) use Option_module
2697)
2698) use Connection_module
2699) use Grid_module
2700) use Coupler_module
2701) use Debug_module
2702) use Material_Aux_class
2703)
2704) !#define DEBUG_WITH_TECPLOT
2705) #ifdef DEBUG_WITH_TECPLOT
2706) use Output_Tecplot_module
2707) #endif
2708)
2709) implicit none
2710)
2711) SNES :: snes
2712) Vec :: xx
2713) Vec :: r
2714) type(realization_subsurface_type) :: realization
2715) PetscViewer :: viewer
2716) PetscErrorCode :: ierr
2717)
2718) Mat, parameter :: null_mat = 0
2719) type(discretization_type), pointer :: discretization
2720) type(grid_type), pointer :: grid
2721) type(patch_type), pointer :: patch
2722) type(option_type), pointer :: option
2723) type(field_type), pointer :: field
2724) type(coupler_type), pointer :: boundary_condition
2725) type(coupler_type), pointer :: source_sink
2726) type(material_parameter_type), pointer :: material_parameter
2727) type(general_parameter_type), pointer :: general_parameter
2728) type(general_auxvar_type), pointer :: gen_auxvars(:,:), gen_auxvars_bc(:)
2729) type(global_auxvar_type), pointer :: global_auxvars(:)
2730) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
2731) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
2732) class(material_auxvar_type), pointer :: material_auxvars(:)
2733) type(connection_set_list_type), pointer :: connection_set_list
2734) type(connection_set_type), pointer :: cur_connection_set
2735)
2736) PetscInt :: iconn
2737) PetscInt :: iphase
2738) PetscReal :: scale
2739) PetscReal :: ss_flow_vol_flux(realization%option%nphase)
2740) PetscInt :: sum_connection
2741) PetscInt :: local_start, local_end
2742) PetscInt :: local_id, ghosted_id
2743) PetscInt :: local_id_up, local_id_dn, ghosted_id_up, ghosted_id_dn
2744) PetscInt :: i, imat, imat_up, imat_dn
2745) PetscInt, save :: iplot = 0
2746)
2747) PetscReal, pointer :: r_p(:)
2748) PetscReal, pointer :: accum_p(:), accum_p2(:)
2749)
2750) character(len=MAXSTRINGLENGTH) :: string
2751) character(len=MAXWORDLENGTH) :: word
2752)
2753) PetscInt :: icap_up, icap_dn
2754) PetscReal :: Res(realization%option%nflowdof)
2755) PetscReal :: Jac_dummy(realization%option%nflowdof, &
2756) realization%option%nflowdof)
2757) PetscReal :: v_darcy(realization%option%nphase)
2758)
2759) discretization => realization%discretization
2760) option => realization%option
2761) patch => realization%patch
2762) grid => patch%grid
2763) field => realization%field
2764) material_parameter => patch%aux%Material%material_parameter
2765) gen_auxvars => patch%aux%General%auxvars
2766) gen_auxvars_bc => patch%aux%General%auxvars_bc
2767) general_parameter => patch%aux%General%general_parameter
2768) global_auxvars => patch%aux%Global%auxvars
2769) global_auxvars_bc => patch%aux%Global%auxvars_bc
2770) global_auxvars_ss => patch%aux%Global%auxvars_ss
2771) material_auxvars => patch%aux%Material%auxvars
2772)
2773) #ifdef DEBUG_GENERAL_FILEOUTPUT
2774) if (debug_flag > 0) then
2775) debug_iteration_count = debug_iteration_count + 1
2776) write(word,*) debug_timestep_count
2777) string = 'residual_debug_data_' // trim(adjustl(word))
2778) write(word,*) debug_timestep_cut_count
2779) string = trim(string) // '_' // trim(adjustl(word))
2780) write(word,*) debug_iteration_count
2781) debug_filename = trim(string) // '_' // trim(adjustl(word)) // '.txt'
2782) open(debug_unit, file=debug_filename, action="write", status="unknown")
2783) open(debug_info_unit, file='debug_info.txt', action="write", &
2784) position="append", status="unknown")
2785) write(debug_info_unit,*) 'residual ', debug_timestep_count, &
2786) debug_timestep_cut_count, debug_iteration_count
2787) close(debug_info_unit)
2788) endif
2789) #endif
2790)
2791) ! Communication -----------------------------------------
2792) ! These 3 must be called before GeneralUpdateAuxVars()
2793) call DiscretizationGlobalToLocal(discretization,xx,field%flow_xx_loc,NFLOWDOF)
2794)
2795) ! do update state
2796) call GeneralUpdateAuxVars(realization,PETSC_TRUE)
2797)
2798) ! for debugging a single grid cell
2799) ! i = 6
2800) ! call GeneralOutputAuxVars(gen_auxvars(0,i),global_auxvars(i),i,'genaux', &
2801) ! PETSC_TRUE,option)
2802) #ifdef DEBUG_WITH_TECPLOT
2803) ! for debugging entire solution over a single SNES solve
2804) write(word,*) iplot
2805) iplot = iplot + 1
2806) realization%output_option%plot_name = 'general-ni-' // trim(adjustl(word))
2807) call OutputTecplotPoint(realization)
2808) #endif
2809)
2810) ! override flags since they will soon be out of date
2811) patch%aux%General%auxvars_up_to_date = PETSC_FALSE
2812)
2813) ! always assume variables have been swapped; therefore, must copy back
2814) call VecLockPop(xx,ierr); CHKERRQ(ierr)
2815) call DiscretizationLocalToGlobal(discretization,field%flow_xx_loc,xx, &
2816) NFLOWDOF)
2817) call VecLockPush(xx,ierr); CHKERRQ(ierr)
2818)
2819) if (option%compute_mass_balance_new) then
2820) call GeneralZeroMassBalanceDelta(realization)
2821) endif
2822)
2823) option%iflag = 1
2824) ! now assign access pointer to local variables
2825) call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
2826)
2827) ! Accumulation terms ------------------------------------
2828) ! accumulation at t(k) (doesn't change during Newton iteration)
2829) call VecGetArrayReadF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
2830) r_p = -accum_p
2831)
2832)
2833) !Heeho dynamically update p+1 accumulation term
2834) if (general_tough2_conv_criteria) then
2835) call VecGetArrayReadF90(field%flow_accum2, accum_p2, ierr);CHKERRQ(ierr)
2836) endif
2837)
2838) ! accumulation at t(k+1)
2839) do local_id = 1, grid%nlmax ! For each local node do...
2840) ghosted_id = grid%nL2G(local_id)
2841) !geh - Ignore inactive cells with inactive materials
2842) imat = patch%imat(ghosted_id)
2843) if (imat <= 0) cycle
2844) local_end = local_id * option%nflowdof
2845) local_start = local_end - option%nflowdof + 1
2846) call GeneralAccumulation(gen_auxvars(ZERO_INTEGER,ghosted_id), &
2847) global_auxvars(ghosted_id), &
2848) material_auxvars(ghosted_id), &
2849) material_parameter%soil_heat_capacity(imat), &
2850) option,Res,Jac_dummy, &
2851) general_analytical_derivatives, &
2852) local_id == general_debug_cell_id)
2853) r_p(local_start:local_end) = r_p(local_start:local_end) + Res(:)
2854)
2855) !Heeho dynamically update p+1 accumulation term
2856) if (general_tough2_conv_criteria) then
2857) accum_p2(local_start:local_end) = Res(:)
2858) endif
2859)
2860) enddo
2861)
2862) call VecRestoreArrayReadF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
2863) !Heeho dynamically update p+1 accumulation term
2864) if (general_tough2_conv_criteria) then
2865) call VecRestoreArrayReadF90(field%flow_accum2, accum_p2, ierr);CHKERRQ(ierr)
2866) endif
2867)
2868) ! Interior Flux Terms -----------------------------------
2869) connection_set_list => grid%internal_connection_set_list
2870) cur_connection_set => connection_set_list%first
2871) sum_connection = 0
2872) do
2873) if (.not.associated(cur_connection_set)) exit
2874) do iconn = 1, cur_connection_set%num_connections
2875) sum_connection = sum_connection + 1
2876)
2877) ghosted_id_up = cur_connection_set%id_up(iconn)
2878) ghosted_id_dn = cur_connection_set%id_dn(iconn)
2879)
2880) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
2881) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
2882)
2883) imat_up = patch%imat(ghosted_id_up)
2884) imat_dn = patch%imat(ghosted_id_dn)
2885) if (imat_up <= 0 .or. imat_dn <= 0) cycle
2886)
2887) icap_up = patch%sat_func_id(ghosted_id_up)
2888) icap_dn = patch%sat_func_id(ghosted_id_dn)
2889)
2890) call GeneralFlux(gen_auxvars(ZERO_INTEGER,ghosted_id_up), &
2891) global_auxvars(ghosted_id_up), &
2892) material_auxvars(ghosted_id_up), &
2893) material_parameter%soil_residual_saturation(:,icap_up), &
2894) material_parameter%soil_thermal_conductivity(:,imat_up), &
2895) gen_auxvars(ZERO_INTEGER,ghosted_id_dn), &
2896) global_auxvars(ghosted_id_dn), &
2897) material_auxvars(ghosted_id_dn), &
2898) material_parameter%soil_residual_saturation(:,icap_dn), &
2899) material_parameter%soil_thermal_conductivity(:,imat_dn), &
2900) cur_connection_set%area(iconn), &
2901) cur_connection_set%dist(:,iconn), &
2902) general_parameter,option,v_darcy,Res, &
2903) Jac_dummy,Jac_dummy, &
2904) general_analytical_derivatives, &
2905) (local_id_up == general_debug_cell_id .or. &
2906) local_id_dn == general_debug_cell_id))
2907)
2908) patch%internal_velocities(:,sum_connection) = v_darcy
2909) if (associated(patch%internal_flow_fluxes)) then
2910) patch%internal_flow_fluxes(:,sum_connection) = Res(:)
2911) endif
2912)
2913) if (local_id_up > 0) then
2914) local_end = local_id_up * option%nflowdof
2915) local_start = local_end - option%nflowdof + 1
2916) r_p(local_start:local_end) = r_p(local_start:local_end) + Res(:)
2917) endif
2918)
2919) if (local_id_dn > 0) then
2920) local_end = local_id_dn * option%nflowdof
2921) local_start = local_end - option%nflowdof + 1
2922) r_p(local_start:local_end) = r_p(local_start:local_end) - Res(:)
2923) endif
2924) enddo
2925)
2926) cur_connection_set => cur_connection_set%next
2927) enddo
2928)
2929) ! Boundary Flux Terms -----------------------------------
2930) boundary_condition => patch%boundary_condition_list%first
2931) sum_connection = 0
2932) do
2933) if (.not.associated(boundary_condition)) exit
2934)
2935) cur_connection_set => boundary_condition%connection_set
2936)
2937) do iconn = 1, cur_connection_set%num_connections
2938) sum_connection = sum_connection + 1
2939)
2940) local_id = cur_connection_set%id_dn(iconn)
2941) ghosted_id = grid%nL2G(local_id)
2942)
2943) imat_dn = patch%imat(ghosted_id)
2944) if (imat_dn <= 0) cycle
2945)
2946) if (ghosted_id<=0) then
2947) print *, "Wrong boundary node index... STOP!!!"
2948) stop
2949) endif
2950)
2951) icap_dn = patch%sat_func_id(ghosted_id)
2952)
2953) call GeneralBCFlux(boundary_condition%flow_bc_type, &
2954) boundary_condition%flow_aux_mapping, &
2955) boundary_condition%flow_aux_real_var(:,iconn), &
2956) gen_auxvars_bc(sum_connection), &
2957) global_auxvars_bc(sum_connection), &
2958) gen_auxvars(ZERO_INTEGER,ghosted_id), &
2959) global_auxvars(ghosted_id), &
2960) material_auxvars(ghosted_id), &
2961) material_parameter%soil_residual_saturation(:,icap_dn), &
2962) material_parameter%soil_thermal_conductivity(:,imat_dn), &
2963) cur_connection_set%area(iconn), &
2964) cur_connection_set%dist(:,iconn), &
2965) general_parameter,option, &
2966) v_darcy,Res, &
2967) local_id == general_debug_cell_id)
2968) patch%boundary_velocities(:,sum_connection) = v_darcy
2969) if (associated(patch%boundary_flow_fluxes)) then
2970) patch%boundary_flow_fluxes(:,sum_connection) = Res(:)
2971) endif
2972) if (option%compute_mass_balance_new) then
2973) ! contribution to boundary
2974) global_auxvars_bc(sum_connection)%mass_balance_delta(1:2,1) = &
2975) global_auxvars_bc(sum_connection)%mass_balance_delta(1:2,1) - &
2976) Res(1:2)
2977) endif
2978)
2979) local_end = local_id * option%nflowdof
2980) local_start = local_end - option%nflowdof + 1
2981) r_p(local_start:local_end)= r_p(local_start:local_end) - Res(:)
2982)
2983) enddo
2984) boundary_condition => boundary_condition%next
2985) enddo
2986)
2987) ! Source/sink terms -------------------------------------
2988) source_sink => patch%source_sink_list%first
2989) sum_connection = 0
2990) do
2991) if (.not.associated(source_sink)) exit
2992)
2993) cur_connection_set => source_sink%connection_set
2994)
2995) do iconn = 1, cur_connection_set%num_connections
2996) sum_connection = sum_connection + 1
2997) local_id = cur_connection_set%id_dn(iconn)
2998) ghosted_id = grid%nL2G(local_id)
2999) if (patch%imat(ghosted_id) <= 0) cycle
3000)
3001) local_end = local_id * option%nflowdof
3002) local_start = local_end - option%nflowdof + 1
3003)
3004) if (associated(source_sink%flow_aux_real_var)) then
3005) scale = source_sink%flow_aux_real_var(ONE_INTEGER,iconn)
3006) else
3007) scale = 1.d0
3008) endif
3009)
3010) call GeneralSrcSink(option,source_sink%flow_condition%general%rate% &
3011) dataset%rarray(:), &
3012) source_sink%flow_condition%general%rate%itype, &
3013) gen_auxvars(ZERO_INTEGER,ghosted_id), &
3014) global_auxvars(ghosted_id), &
3015) ss_flow_vol_flux, &
3016) scale,Res, &
3017) local_id == general_debug_cell_id)
3018)
3019) r_p(local_start:local_end) = r_p(local_start:local_end) - Res(:)
3020)
3021) if (associated(patch%ss_flow_vol_fluxes)) then
3022) patch%ss_flow_vol_fluxes(:,sum_connection) = ss_flow_vol_flux
3023) endif
3024) if (associated(patch%ss_flow_fluxes)) then
3025) patch%ss_flow_fluxes(:,sum_connection) = Res(:)
3026) endif
3027) if (option%compute_mass_balance_new) then
3028) ! contribution to boundary
3029) global_auxvars_ss(sum_connection)%mass_balance_delta(1:2,1) = &
3030) global_auxvars_ss(sum_connection)%mass_balance_delta(1:2,1) - &
3031) Res(1:2)
3032) endif
3033)
3034) enddo
3035) source_sink => source_sink%next
3036) enddo
3037)
3038) if (patch%aux%General%inactive_cells_exist) then
3039) do i=1,patch%aux%General%n_inactive_rows
3040) r_p(patch%aux%General%inactive_rows_local(i)) = 0.d0
3041) enddo
3042) endif
3043)
3044) call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
3045)
3046) call GeneralSSSandbox(r,null_mat,PETSC_FALSE,grid,material_auxvars, &
3047) gen_auxvars,option)
3048)
3049) if (Initialized(general_debug_cell_id)) then
3050) call VecGetArrayReadF90(r, r_p, ierr);CHKERRQ(ierr)
3051) do local_id = general_debug_cell_id-1, general_debug_cell_id+1
3052) write(*,'('' residual : '',i2,10es12.4)') local_id, &
3053) r_p((local_id-1)*option%nflowdof+1:(local_id-1)*option%nflowdof+2), &
3054) r_p(local_id*option%nflowdof)*1.d6
3055) enddo
3056) call VecRestoreArrayReadF90(r, r_p, ierr);CHKERRQ(ierr)
3057) endif
3058)
3059) if (general_isothermal) then
3060) call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
3061) ! zero energy residual
3062) do local_id = 1, grid%nlmax
3063) r_p((local_id-1)*option%nflowdof+GENERAL_ENERGY_EQUATION_INDEX) = 0.d0
3064) enddo
3065) call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
3066) endif
3067) if (general_no_air) then
3068) call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
3069) ! zero energy residual
3070) do local_id = 1, grid%nlmax
3071) r_p((local_id-1)*option%nflowdof+GENERAL_GAS_EQUATION_INDEX) = 0.d0
3072) enddo
3073) call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
3074) endif
3075)
3076) #ifdef DEBUG_GENERAL_FILEOUTPUT
3077) call VecGetArrayReadF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
3078) do local_id = 1, grid%nlmax
3079) write(debug_unit,'(a,i5,7es24.15)') 'fixed residual:', local_id, &
3080) accum_p((local_id-1)*option%nflowdof+1:local_id*option%nflowdof)
3081) enddo
3082) call VecRestoreArrayReadF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
3083) call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
3084) do local_id = 1, grid%nlmax
3085) write(debug_unit,'(a,i5,7es24.15)') 'residual:', local_id, &
3086) r_p((local_id-1)*option%nflowdof+1:local_id*option%nflowdof)
3087) enddo
3088) call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
3089) #endif
3090)
3091)
3092) if (realization%debug%vecview_residual) then
3093) string = 'Gresidual'
3094) call DebugCreateViewer(realization%debug,string,option,viewer)
3095) call VecView(r,viewer,ierr);CHKERRQ(ierr)
3096) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3097) endif
3098) if (realization%debug%vecview_solution) then
3099) string = 'Gxx'
3100) call DebugCreateViewer(realization%debug,string,option,viewer)
3101) call VecView(xx,viewer,ierr);CHKERRQ(ierr)
3102) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3103) endif
3104)
3105) #ifdef DEBUG_GENERAL_FILEOUTPUT
3106) if (debug_flag > 0) then
3107) close(debug_unit)
3108) endif
3109) #endif
3110)
3111) end subroutine GeneralResidual
3112)
3113) ! ************************************************************************** !
3114)
3115) subroutine GeneralJacobian(snes,xx,A,B,realization,ierr)
3116) !
3117) ! Computes the Jacobian
3118) !
3119) ! Author: Glenn Hammond
3120) ! Date: 03/09/11
3121) !
3122)
3123) use Realization_Subsurface_class
3124) use Patch_module
3125) use Grid_module
3126) use Option_module
3127) use Connection_module
3128) use Coupler_module
3129) use Field_module
3130) use Debug_module
3131) use Material_Aux_class
3132)
3133) implicit none
3134)
3135) SNES :: snes
3136) Vec :: xx
3137) Mat :: A, B
3138) type(realization_subsurface_type) :: realization
3139) PetscErrorCode :: ierr
3140)
3141) Mat :: J
3142) MatType :: mat_type
3143) PetscReal :: norm
3144) PetscViewer :: viewer
3145)
3146) PetscInt :: icap_up,icap_dn
3147) PetscReal :: qsrc, scale
3148) PetscInt :: imat, imat_up, imat_dn
3149) PetscInt :: local_id, ghosted_id, natural_id
3150) PetscInt :: irow
3151) PetscInt :: local_id_up, local_id_dn
3152) PetscInt :: ghosted_id_up, ghosted_id_dn
3153) Vec, parameter :: null_vec = 0
3154)
3155) PetscReal :: Jup(realization%option%nflowdof,realization%option%nflowdof), &
3156) Jdn(realization%option%nflowdof,realization%option%nflowdof)
3157)
3158) type(coupler_type), pointer :: boundary_condition, source_sink
3159) type(connection_set_list_type), pointer :: connection_set_list
3160) type(connection_set_type), pointer :: cur_connection_set
3161) PetscInt :: iconn
3162) PetscInt :: sum_connection
3163) PetscReal :: distance, fraction_upwind
3164) PetscReal :: distance_gravity
3165) PetscInt, pointer :: zeros(:)
3166) type(grid_type), pointer :: grid
3167) type(patch_type), pointer :: patch
3168) type(option_type), pointer :: option
3169) type(field_type), pointer :: field
3170) type(material_parameter_type), pointer :: material_parameter
3171) type(general_parameter_type), pointer :: general_parameter
3172) type(general_auxvar_type), pointer :: gen_auxvars(:,:), gen_auxvars_bc(:)
3173) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
3174) class(material_auxvar_type), pointer :: material_auxvars(:)
3175)
3176) character(len=MAXSTRINGLENGTH) :: string
3177) character(len=MAXWORDLENGTH) :: word
3178)
3179) patch => realization%patch
3180) grid => patch%grid
3181) option => realization%option
3182) field => realization%field
3183) material_parameter => patch%aux%Material%material_parameter
3184) gen_auxvars => patch%aux%General%auxvars
3185) gen_auxvars_bc => patch%aux%General%auxvars_bc
3186) general_parameter => patch%aux%General%general_parameter
3187) global_auxvars => patch%aux%Global%auxvars
3188) global_auxvars_bc => patch%aux%Global%auxvars_bc
3189) material_auxvars => patch%aux%Material%auxvars
3190)
3191) call MatGetType(A,mat_type,ierr);CHKERRQ(ierr)
3192) if (mat_type == MATMFFD) then
3193) J = B
3194) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3195) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3196) else
3197) J = A
3198) endif
3199)
3200) call MatZeroEntries(J,ierr);CHKERRQ(ierr)
3201)
3202) #ifdef DEBUG_GENERAL_FILEOUTPUT
3203) if (debug_flag > 0) then
3204) write(word,*) debug_timestep_count
3205) string = 'jacobian_debug_data_' // trim(adjustl(word))
3206) write(word,*) debug_timestep_cut_count
3207) string = trim(string) // '_' // trim(adjustl(word))
3208) write(word,*) debug_iteration_count
3209) debug_filename = trim(string) // '_' // trim(adjustl(word)) // '.txt'
3210) open(debug_unit, file=debug_filename, action="write", status="unknown")
3211) open(debug_info_unit, file='debug_info.txt', action="write", &
3212) position="append", status="unknown")
3213) write(debug_info_unit,*) 'jacobian ', debug_timestep_count, &
3214) debug_timestep_cut_count, debug_iteration_count
3215) close(debug_info_unit)
3216) endif
3217) #endif
3218)
3219) ! Perturb aux vars
3220) do ghosted_id = 1, grid%ngmax ! For each local node do...
3221) if (patch%imat(ghosted_id) <= 0) cycle
3222) natural_id = grid%nG2A(ghosted_id)
3223) call GeneralAuxVarPerturb(gen_auxvars(:,ghosted_id), &
3224) global_auxvars(ghosted_id), &
3225) material_auxvars(ghosted_id), &
3226) patch%characteristic_curves_array( &
3227) patch%sat_func_id(ghosted_id))%ptr, &
3228) natural_id,option)
3229) enddo
3230)
3231) #ifdef DEBUG_GENERAL_LOCAL
3232) call GeneralOutputAuxVars(gen_auxvars,global_auxvars,option)
3233) #endif
3234)
3235) ! Accumulation terms ------------------------------------
3236) do local_id = 1, grid%nlmax ! For each local node do...
3237) ghosted_id = grid%nL2G(local_id)
3238) !geh - Ignore inactive cells with inactive materials
3239) imat = patch%imat(ghosted_id)
3240) if (imat <= 0) cycle
3241) call GeneralAccumDerivative(gen_auxvars(:,ghosted_id), &
3242) global_auxvars(ghosted_id), &
3243) material_auxvars(ghosted_id), &
3244) material_parameter%soil_heat_capacity(imat), &
3245) option, &
3246) Jup)
3247) call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup, &
3248) ADD_VALUES,ierr);CHKERRQ(ierr)
3249) enddo
3250)
3251) if (realization%debug%matview_Jacobian_detailed) then
3252) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3253) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3254) string = 'jacobian_accum'
3255) call DebugCreateViewer(realization%debug,string,option,viewer)
3256) call MatView(A,viewer,ierr);CHKERRQ(ierr)
3257) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3258) endif
3259)
3260)
3261) ! Interior Flux Terms -----------------------------------
3262) connection_set_list => grid%internal_connection_set_list
3263) cur_connection_set => connection_set_list%first
3264) sum_connection = 0
3265) do
3266) if (.not.associated(cur_connection_set)) exit
3267) do iconn = 1, cur_connection_set%num_connections
3268) sum_connection = sum_connection + 1
3269)
3270) ghosted_id_up = cur_connection_set%id_up(iconn)
3271) ghosted_id_dn = cur_connection_set%id_dn(iconn)
3272)
3273) imat_up = patch%imat(ghosted_id_up)
3274) imat_dn = patch%imat(ghosted_id_dn)
3275) if (imat_up <= 0 .or. imat_dn <= 0) cycle
3276)
3277) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
3278) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
3279)
3280) icap_up = patch%sat_func_id(ghosted_id_up)
3281) icap_dn = patch%sat_func_id(ghosted_id_dn)
3282)
3283) call GeneralFluxDerivative(gen_auxvars(:,ghosted_id_up), &
3284) global_auxvars(ghosted_id_up), &
3285) material_auxvars(ghosted_id_up), &
3286) material_parameter%soil_residual_saturation(:,icap_up), &
3287) material_parameter%soil_thermal_conductivity(:,imat_up), &
3288) gen_auxvars(:,ghosted_id_dn), &
3289) global_auxvars(ghosted_id_dn), &
3290) material_auxvars(ghosted_id_dn), &
3291) material_parameter%soil_residual_saturation(:,icap_dn), &
3292) material_parameter%soil_thermal_conductivity(:,imat_dn), &
3293) cur_connection_set%area(iconn), &
3294) cur_connection_set%dist(:,iconn), &
3295) general_parameter,option,&
3296) Jup,Jdn)
3297) if (local_id_up > 0) then
3298) call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_up-1, &
3299) Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
3300) call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_dn-1, &
3301) Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
3302) endif
3303) if (local_id_dn > 0) then
3304) Jup = -Jup
3305) Jdn = -Jdn
3306) call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_dn-1, &
3307) Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
3308) call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_up-1, &
3309) Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
3310) endif
3311) enddo
3312) cur_connection_set => cur_connection_set%next
3313) enddo
3314)
3315) if (realization%debug%matview_Jacobian_detailed) then
3316) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3317) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3318) string = 'jacobian_flux'
3319) call DebugCreateViewer(realization%debug,string,option,viewer)
3320) call MatView(A,viewer,ierr);CHKERRQ(ierr)
3321) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3322) endif
3323)
3324) ! Boundary Flux Terms -----------------------------------
3325) boundary_condition => patch%boundary_condition_list%first
3326) sum_connection = 0
3327) do
3328) if (.not.associated(boundary_condition)) exit
3329)
3330) cur_connection_set => boundary_condition%connection_set
3331)
3332) do iconn = 1, cur_connection_set%num_connections
3333) sum_connection = sum_connection + 1
3334)
3335) local_id = cur_connection_set%id_dn(iconn)
3336) ghosted_id = grid%nL2G(local_id)
3337)
3338) imat_dn = patch%imat(ghosted_id)
3339) if (imat_dn <= 0) cycle
3340)
3341) if (ghosted_id<=0) then
3342) print *, "Wrong boundary node index... STOP!!!"
3343) stop
3344) endif
3345)
3346) icap_dn = patch%sat_func_id(ghosted_id)
3347)
3348) call GeneralBCFluxDerivative(boundary_condition%flow_bc_type, &
3349) boundary_condition%flow_aux_mapping, &
3350) boundary_condition%flow_aux_real_var(:,iconn), &
3351) gen_auxvars_bc(sum_connection), &
3352) global_auxvars_bc(sum_connection), &
3353) gen_auxvars(:,ghosted_id), &
3354) global_auxvars(ghosted_id), &
3355) material_auxvars(ghosted_id), &
3356) material_parameter%soil_residual_saturation(:,icap_dn), &
3357) material_parameter%soil_thermal_conductivity(:,imat_dn), &
3358) cur_connection_set%area(iconn), &
3359) cur_connection_set%dist(:,iconn), &
3360) general_parameter,option, &
3361) Jdn)
3362)
3363) Jdn = -Jdn
3364) call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jdn, &
3365) ADD_VALUES,ierr);CHKERRQ(ierr)
3366) enddo
3367) boundary_condition => boundary_condition%next
3368) enddo
3369)
3370) if (realization%debug%matview_Jacobian_detailed) then
3371) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3372) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3373) string = 'jacobian_bcflux'
3374) call DebugCreateViewer(realization%debug,string,option,viewer)
3375) call MatView(A,viewer,ierr);CHKERRQ(ierr)
3376) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3377) endif
3378)
3379) ! Source/sinks
3380) source_sink => patch%source_sink_list%first
3381) do
3382) if (.not.associated(source_sink)) exit
3383)
3384) cur_connection_set => source_sink%connection_set
3385)
3386) do iconn = 1, cur_connection_set%num_connections
3387) local_id = cur_connection_set%id_dn(iconn)
3388) ghosted_id = grid%nL2G(local_id)
3389) if (patch%imat(ghosted_id) <= 0) cycle
3390)
3391) if (associated(source_sink%flow_aux_real_var)) then
3392) scale = source_sink%flow_aux_real_var(ONE_INTEGER,iconn)
3393) else
3394) scale = 1.d0
3395) endif
3396)
3397) Jup = 0.d0
3398) call GeneralSrcSinkDerivative(option, &
3399) source_sink%flow_condition%general%rate% &
3400) dataset%rarray(:), &
3401) source_sink%flow_condition%general%rate%itype, &
3402) gen_auxvars(:,ghosted_id), &
3403) global_auxvars(ghosted_id), &
3404) scale,Jup)
3405)
3406) call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup, &
3407) ADD_VALUES,ierr);CHKERRQ(ierr)
3408)
3409) enddo
3410) source_sink => source_sink%next
3411) enddo
3412)
3413) call GeneralSSSandbox(null_vec,A,PETSC_TRUE,grid,material_auxvars, &
3414) gen_auxvars,option)
3415)
3416) if (realization%debug%matview_Jacobian_detailed) then
3417) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3418) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3419) string = 'jacobian_srcsink'
3420) call DebugCreateViewer(realization%debug,string,option,viewer)
3421) call MatView(A,viewer,ierr);CHKERRQ(ierr)
3422) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3423) endif
3424)
3425) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3426) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3427)
3428) ! zero out isothermal and inactive cells
3429) if (patch%aux%General%inactive_cells_exist) then
3430) qsrc = 1.d0 ! solely a temporary variable in this conditional
3431) call MatZeroRowsLocal(A,patch%aux%General%n_inactive_rows, &
3432) patch%aux%General%inactive_rows_local_ghosted, &
3433) qsrc,PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
3434) ierr);CHKERRQ(ierr)
3435) endif
3436)
3437) if (general_isothermal) then
3438) qsrc = 1.d0 ! solely a temporary variable in this conditional
3439) zeros => patch%aux%General%row_zeroing_array
3440) ! zero energy residual
3441) do local_id = 1, grid%nlmax
3442) ghosted_id = grid%nL2G(local_id)
3443) zeros(local_id) = (ghosted_id-1)*option%nflowdof+ &
3444) GENERAL_ENERGY_EQUATION_INDEX - 1 ! zero-based
3445) enddo
3446) call MatZeroRowsLocal(A,grid%nlmax,zeros,qsrc,PETSC_NULL_OBJECT, &
3447) PETSC_NULL_OBJECT,ierr);CHKERRQ(ierr)
3448) endif
3449)
3450) if (general_no_air) then
3451) qsrc = 1.d0 ! solely a temporary variable in this conditional
3452) zeros => patch%aux%General%row_zeroing_array
3453) ! zero gas component mass balance residual
3454) do local_id = 1, grid%nlmax
3455) ghosted_id = grid%nL2G(local_id)
3456) zeros(local_id) = (ghosted_id-1)*option%nflowdof+ &
3457) GENERAL_GAS_EQUATION_INDEX - 1 ! zero-based
3458) enddo
3459) call MatZeroRowsLocal(A,grid%nlmax,zeros,qsrc,PETSC_NULL_OBJECT, &
3460) PETSC_NULL_OBJECT,ierr);CHKERRQ(ierr)
3461) endif
3462)
3463) if (realization%debug%matview_Jacobian) then
3464) string = 'Gjacobian'
3465) call DebugCreateViewer(realization%debug,string,option,viewer)
3466) call MatView(J,viewer,ierr);CHKERRQ(ierr)
3467) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3468) endif
3469) if (realization%debug%norm_Jacobian) then
3470) option => realization%option
3471) call MatNorm(J,NORM_1,norm,ierr);CHKERRQ(ierr)
3472) write(option%io_buffer,'("1 norm: ",es11.4)') norm
3473) call printMsg(option)
3474) call MatNorm(J,NORM_FROBENIUS,norm,ierr);CHKERRQ(ierr)
3475) write(option%io_buffer,'("2 norm: ",es11.4)') norm
3476) call printMsg(option)
3477) call MatNorm(J,NORM_INFINITY,norm,ierr);CHKERRQ(ierr)
3478) write(option%io_buffer,'("inf norm: ",es11.4)') norm
3479) call printMsg(option)
3480) endif
3481)
3482) ! call MatView(J,PETSC_VIEWER_STDOUT_WORLD,ierr)
3483)
3484) #if 0
3485) imat = 1
3486) if (imat == 1) then
3487) call GeneralNumericalJacobianTest(xx,realization,J)
3488) endif
3489) #endif
3490)
3491) #ifdef DEBUG_GENERAL_FILEOUTPUT
3492) if (debug_flag > 0) then
3493) write(word,*) debug_timestep_count
3494) string = 'jacobian_' // trim(adjustl(word))
3495) write(word,*) debug_timestep_cut_count
3496) string = trim(string) // '_' // trim(adjustl(word))
3497) write(word,*) debug_iteration_count
3498) string = trim(string) // '_' // trim(adjustl(word)) // '.out'
3499) call PetscViewerASCIIOpen(realization%option%mycomm,trim(string), &
3500) viewer,ierr);CHKERRQ(ierr)
3501) call MatView(J,viewer,ierr);CHKERRQ(ierr)
3502) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3503) close(debug_unit)
3504) endif
3505) #endif
3506)
3507) end subroutine GeneralJacobian
3508)
3509) ! ************************************************************************** !
3510)
3511) function GeneralGetTecplotHeader(realization,icolumn)
3512) !
3513) ! Returns General Lite contribution to
3514) ! Tecplot file header
3515) !
3516) ! Author: Glenn Hammond
3517) ! Date: 03/09/11
3518) !
3519)
3520) use Realization_Subsurface_class
3521) use Option_module
3522) use Field_module
3523)
3524) implicit none
3525)
3526) character(len=MAXSTRINGLENGTH) :: GeneralGetTecplotHeader
3527) type(realization_subsurface_type) :: realization
3528) PetscInt :: icolumn
3529)
3530) character(len=MAXSTRINGLENGTH) :: string, string2
3531) type(option_type), pointer :: option
3532) type(field_type), pointer :: field
3533) PetscInt :: i
3534)
3535) option => realization%option
3536) field => realization%field
3537)
3538) string = ''
3539)
3540) if (icolumn > -1) then
3541) icolumn = icolumn + 1
3542) write(string2,'('',"'',i2,''-T [C]"'')') icolumn
3543) else
3544) write(string2,'('',"T [C]"'')')
3545) endif
3546) string = trim(string) // trim(string2)
3547)
3548) if (icolumn > -1) then
3549) icolumn = icolumn + 1
3550) write(string2,'('',"'',i2,''-P [Pa]"'')') icolumn
3551) else
3552) write(string2,'('',"P [Pa]"'')')
3553) endif
3554) string = trim(string) // trim(string2)
3555)
3556) if (icolumn > -1) then
3557) icolumn = icolumn + 1
3558) write(string2,'('',"'',i2,''-State"'')') icolumn
3559) else
3560) write(string2,'('',"State"'')')
3561) endif
3562) string = trim(string) // trim(string2)
3563)
3564) if (icolumn > -1) then
3565) icolumn = icolumn + 1
3566) write(string2,'('',"'',i2,''-Sat(l)"'')') icolumn
3567) else
3568) write(string2,'('',"Sat(l)"'')')
3569) endif
3570) string = trim(string) // trim(string2)
3571)
3572) if (icolumn > -1) then
3573) icolumn = icolumn + 1
3574) write(string2,'('',"'',i2,''-Sat(g)"'')') icolumn
3575) else
3576) write(string2,'('',"Sat(g)"'')')
3577) endif
3578) string = trim(string) // trim(string2)
3579)
3580) if (icolumn > -1) then
3581) icolumn = icolumn + 1
3582) write(string2,'('',"'',i2,''-Rho(l)"'')') icolumn
3583) else
3584) write(string2,'('',"Rho(l)"'')')
3585) endif
3586) string = trim(string) // trim(string2)
3587)
3588) if (icolumn > -1) then
3589) icolumn = icolumn + 1
3590) write(string2,'('',"'',i2,''-Rho(g)"'')') icolumn
3591) else
3592) write(string2,'('',"Rho(g)"'')')
3593) endif
3594) string = trim(string) // trim(string2)
3595)
3596) if (icolumn > -1) then
3597) icolumn = icolumn + 1
3598) write(string2,'('',"'',i2,''-U(l)"'')') icolumn
3599) else
3600) write(string2,'('',"U(l)"'')')
3601) endif
3602) string = trim(string) // trim(string2)
3603)
3604) if (icolumn > -1) then
3605) icolumn = icolumn + 1
3606) write(string2,'('',"'',i2,''-U(g)"'')') icolumn
3607) else
3608) write(string2,'('',"U(g)"'')')
3609) endif
3610) string = trim(string) // trim(string2)
3611)
3612) do i=1,option%nflowspec
3613) if (icolumn > -1) then
3614) icolumn = icolumn + 1
3615) write(string2,'('',"'',i2,''-Xl('',i2,'')"'')') icolumn, i
3616) else
3617) write(string2,'('',"Xl('',i2,'')"'')') i
3618) endif
3619) string = trim(string) // trim(string2)
3620) enddo
3621)
3622) do i=1,option%nflowspec
3623) if (icolumn > -1) then
3624) icolumn = icolumn + 1
3625) write(string2,'('',"'',i2,''-Xg('',i2,'')"'')') icolumn, i
3626) else
3627) write(string2,'('',"Xg('',i2,'')"'')') i
3628) endif
3629) string = trim(string) // trim(string2)
3630) enddo
3631)
3632) GeneralGetTecplotHeader = string
3633)
3634) end function GeneralGetTecplotHeader
3635)
3636) ! ************************************************************************** !
3637)
3638) subroutine GeneralSetPlotVariables(realization,list)
3639) !
3640) ! Adds variables to be printed to list
3641) !
3642) ! Author: Glenn Hammond
3643) ! Date: 02/15/13
3644) !
3645)
3646) use Realization_Subsurface_class
3647) use Output_Aux_module
3648) use Variables_module
3649)
3650) implicit none
3651)
3652) type(realization_subsurface_type) :: realization
3653) type(output_variable_list_type), pointer :: list
3654)
3655) character(len=MAXWORDLENGTH) :: name, units
3656) type(output_variable_type), pointer :: output_variable
3657)
3658) if (associated(list%first)) then
3659) return
3660) endif
3661)
3662) name = 'Temperature'
3663) units = 'C'
3664) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
3665) TEMPERATURE)
3666)
3667) name = 'Liquid Pressure'
3668) units = 'Pa'
3669) call OutputVariableAddToList(list,name,OUTPUT_PRESSURE,units, &
3670) LIQUID_PRESSURE)
3671)
3672) name = 'Gas Pressure'
3673) units = 'Pa'
3674) call OutputVariableAddToList(list,name,OUTPUT_PRESSURE,units, &
3675) GAS_PRESSURE)
3676)
3677) name = 'Liquid Saturation'
3678) units = ''
3679) call OutputVariableAddToList(list,name,OUTPUT_SATURATION,units, &
3680) LIQUID_SATURATION)
3681)
3682) name = 'Gas Saturation'
3683) units = ''
3684) call OutputVariableAddToList(list,name,OUTPUT_SATURATION,units, &
3685) GAS_SATURATION)
3686)
3687) name = 'Liquid Density'
3688) units = 'kg/m^3'
3689) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
3690) LIQUID_DENSITY)
3691)
3692) name = 'Gas Density'
3693) units = 'kg/m^3'
3694) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
3695) GAS_DENSITY)
3696)
3697) name = 'X_g^l'
3698) units = ''
3699) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
3700) LIQUID_MOLE_FRACTION, &
3701) realization%option%air_id)
3702)
3703) name = 'X_l^l'
3704) units = ''
3705) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
3706) LIQUID_MOLE_FRACTION, &
3707) realization%option%water_id)
3708)
3709) name = 'X_g^g'
3710) units = ''
3711) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
3712) GAS_MOLE_FRACTION, &
3713) realization%option%air_id)
3714)
3715) name = 'X_l^g'
3716) units = ''
3717) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
3718) GAS_MOLE_FRACTION, &
3719) realization%option%water_id)
3720)
3721) name = 'Liquid Energy'
3722) units = 'MJ/kmol'
3723) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
3724) LIQUID_ENERGY)
3725)
3726) name = 'Gas Energy'
3727) units = 'MJ/kmol'
3728) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
3729) GAS_ENERGY)
3730)
3731) name = 'Thermodynamic State'
3732) units = ''
3733) output_variable => OutputVariableCreate(name,OUTPUT_DISCRETE,units,STATE)
3734) output_variable%plot_only = PETSC_TRUE ! toggle output off for observation
3735) output_variable%iformat = 1 ! integer
3736) call OutputVariableAddToList(list,output_variable)
3737)
3738) end subroutine GeneralSetPlotVariables
3739)
3740) ! ************************************************************************** !
3741)
3742) function GeneralAverageDensity(iphase,istate_up,istate_dn, &
3743) density_up,density_dn,dden_up,dden_dn)
3744) !
3745) ! Averages density, using opposite cell density if phase non-existent
3746) !
3747) ! Author: Glenn Hammond
3748) ! Date: 03/07/14
3749) !
3750)
3751) implicit none
3752)
3753) PetscInt :: iphase
3754) PetscInt :: istate_up, istate_dn
3755) PetscReal :: density_up(:), density_dn(:)
3756) PetscReal :: dden_up, dden_dn
3757)
3758) PetscReal :: GeneralAverageDensity
3759)
3760) dden_up = 0.d0
3761) dden_dn = 0.d0
3762) if (iphase == LIQUID_PHASE) then
3763) if (istate_up == GAS_STATE) then
3764) GeneralAverageDensity = density_dn(iphase)
3765) dden_dn = 1.d0
3766) else if (istate_dn == GAS_STATE) then
3767) GeneralAverageDensity = density_up(iphase)
3768) dden_up = 1.d0
3769) else
3770) GeneralAverageDensity = 0.5d0*(density_up(iphase)+density_dn(iphase))
3771) dden_up = 0.5d0
3772) dden_dn = 0.5d0
3773) endif
3774) else if (iphase == GAS_PHASE) then
3775) if (istate_up == LIQUID_STATE) then
3776) GeneralAverageDensity = density_dn(iphase)
3777) dden_dn = 1.d0
3778) else if (istate_dn == LIQUID_STATE) then
3779) GeneralAverageDensity = density_up(iphase)
3780) dden_up = 1.d0
3781) else
3782) GeneralAverageDensity = 0.5d0*(density_up(iphase)+density_dn(iphase))
3783) dden_up = 0.5d0
3784) dden_dn = 0.5d0
3785) endif
3786) endif
3787)
3788) end function GeneralAverageDensity
3789)
3790) ! ************************************************************************** !
3791)
3792) subroutine GeneralSSSandbox(residual,Jacobian,compute_derivative, &
3793) grid,material_auxvars,general_auxvars,option)
3794) !
3795) ! Evaluates source/sink term storing residual and/or Jacobian
3796) !
3797) ! Author: Glenn Hammond
3798) ! Date: 04/11/14
3799) !
3800)
3801) use Option_module
3802) use Grid_module
3803) use Material_Aux_class, only: material_auxvar_type
3804) use SrcSink_Sandbox_module
3805) use SrcSink_Sandbox_Base_class
3806)
3807) implicit none
3808)
3809) #include "petsc/finclude/petscvec.h"
3810) #include "petsc/finclude/petscvec.h90"
3811) #include "petsc/finclude/petscmat.h"
3812) #include "petsc/finclude/petscmat.h90"
3813)
3814) PetscBool :: compute_derivative
3815) Vec :: residual
3816) Mat :: Jacobian
3817) class(material_auxvar_type), pointer :: material_auxvars(:)
3818) type(general_auxvar_type), pointer :: general_auxvars(:,:)
3819)
3820) type(grid_type) :: grid
3821) type(option_type) :: option
3822)
3823) PetscReal, pointer :: r_p(:)
3824) PetscReal :: res(option%nflowdof)
3825) PetscReal :: Jac(option%nflowdof,option%nflowdof)
3826) class(srcsink_sandbox_base_type), pointer :: cur_srcsink
3827) PetscInt :: local_id, ghosted_id, istart, iend, irow, idof
3828) PetscReal :: res_pert(option%nflowdof)
3829) PetscReal :: aux_real(10)
3830) PetscErrorCode :: ierr
3831)
3832) if (.not.compute_derivative) then
3833) call VecGetArrayF90(residual,r_p,ierr);CHKERRQ(ierr)
3834) endif
3835)
3836) cur_srcsink => ss_sandbox_list
3837) do
3838) if (.not.associated(cur_srcsink)) exit
3839) aux_real = 0.d0
3840) local_id = cur_srcsink%local_cell_id
3841) ghosted_id = grid%nL2G(local_id)
3842) res = 0.d0
3843) Jac = 0.d0
3844) call GeneralSSSandboxLoadAuxReal(cur_srcsink,aux_real, &
3845) general_auxvars(ZERO_INTEGER,ghosted_id),option)
3846) call cur_srcsink%Evaluate(res,Jac,PETSC_FALSE, &
3847) material_auxvars(ghosted_id), &
3848) aux_real,option)
3849) if (compute_derivative) then
3850) do idof = 1, option%nflowdof
3851) res_pert = 0.d0
3852) call GeneralSSSandboxLoadAuxReal(cur_srcsink,aux_real, &
3853) general_auxvars(idof,ghosted_id),option)
3854) call cur_srcsink%Evaluate(res_pert,Jac,PETSC_FALSE, &
3855) material_auxvars(ghosted_id), &
3856) aux_real,option)
3857) do irow = 1, option%nflowdof
3858) Jac(irow,idof) = (res_pert(irow)-res(irow)) / &
3859) general_auxvars(idof,ghosted_id)%pert
3860) enddo
3861) enddo
3862) if (general_isothermal) then
3863) Jac(GENERAL_ENERGY_EQUATION_INDEX,:) = 0.d0
3864) Jac(:,GENERAL_ENERGY_EQUATION_INDEX) = 0.d0
3865) endif
3866) if (general_no_air) then
3867) Jac(GENERAL_GAS_EQUATION_INDEX,:) = 0.d0
3868) Jac(:,GENERAL_GAS_EQUATION_INDEX) = 0.d0
3869) endif
3870) call MatSetValuesBlockedLocal(Jacobian,1,ghosted_id-1,1, &
3871) ghosted_id-1,Jac,ADD_VALUES, &
3872) ierr);CHKERRQ(ierr)
3873) else
3874) iend = local_id*option%nflowdof
3875) istart = iend - option%nflowdof + 1
3876) r_p(istart:iend) = r_p(istart:iend) - res
3877) endif
3878) cur_srcsink => cur_srcsink%next
3879) enddo
3880)
3881) if (.not.compute_derivative) then
3882) call VecRestoreArrayF90(residual,r_p,ierr);CHKERRQ(ierr)
3883) endif
3884)
3885) end subroutine GeneralSSSandbox
3886)
3887) ! ************************************************************************** !
3888)
3889) subroutine GeneralSSSandboxLoadAuxReal(srcsink,aux_real,gen_auxvar,option)
3890)
3891) use Option_module
3892) use SrcSink_Sandbox_Base_class
3893) use SrcSink_Sandbox_WIPP_Gas_class
3894) use SrcSink_Sandbox_WIPP_Well_class
3895)
3896) implicit none
3897)
3898) class(srcsink_sandbox_base_type) :: srcsink
3899) PetscReal :: aux_real(:)
3900) type(general_auxvar_type) gen_auxvar
3901) type(option_type) :: option
3902)
3903) aux_real = 0.d0
3904) select type(srcsink)
3905) class is(srcsink_sandbox_wipp_gas_type)
3906) aux_real(WIPP_GAS_WATER_SATURATION_INDEX) = &
3907) gen_auxvar%sat(option%liquid_phase)
3908) aux_real(WIPP_GAS_TEMPERATURE_INDEX) = &
3909) gen_auxvar%temp
3910) class is(srcsink_sandbox_wipp_well_type)
3911) aux_real(WIPP_WELL_LIQUID_MOBILITY) = &
3912) gen_auxvar%mobility(option%liquid_phase)
3913) aux_real(WIPP_WELL_GAS_MOBILITY) = &
3914) gen_auxvar%mobility(option%gas_phase)
3915) aux_real(WIPP_WELL_LIQUID_PRESSURE) = &
3916) gen_auxvar%pres(option%liquid_phase)
3917) aux_real(WIPP_WELL_GAS_PRESSURE) = &
3918) gen_auxvar%pres(option%gas_phase)
3919) aux_real(WIPP_WELL_LIQUID_ENTHALPY) = &
3920) gen_auxvar%H(option%liquid_phase)
3921) aux_real(WIPP_WELL_GAS_ENTHALPY) = &
3922) gen_auxvar%H(option%gas_phase)
3923) aux_real(WIPP_WELL_XMOL_AIR_IN_LIQUID) = &
3924) gen_auxvar%xmol(option%air_id,option%liquid_phase)
3925) aux_real(WIPP_WELL_XMOL_WATER_IN_GAS) = &
3926) gen_auxvar%xmol(option%water_id,option%gas_phase)
3927) aux_real(WIPP_WELL_LIQUID_DENSITY) = &
3928) gen_auxvar%den(option%liquid_phase)
3929) aux_real(WIPP_WELL_GAS_DENSITY) = &
3930) gen_auxvar%den(option%gas_phase)
3931) end select
3932)
3933) end subroutine GeneralSSSandboxLoadAuxReal
3934)
3935) ! ************************************************************************** !
3936)
3937) subroutine GeneralMapBCAuxVarsToGlobal(realization)
3938) !
3939) ! Deallocates variables associated with Richard
3940) !
3941) ! Author: Glenn Hammond
3942) ! Date: 03/09/11
3943) !
3944)
3945) use Realization_Subsurface_class
3946) use Option_module
3947) use Patch_module
3948) use Coupler_module
3949) use Connection_module
3950)
3951) implicit none
3952)
3953) type(realization_subsurface_type) :: realization
3954)
3955) type(option_type), pointer :: option
3956) type(patch_type), pointer :: patch
3957) type(coupler_type), pointer :: boundary_condition
3958) type(connection_set_type), pointer :: cur_connection_set
3959) type(general_auxvar_type), pointer :: gen_auxvars_bc(:)
3960) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
3961)
3962) PetscInt :: sum_connection, iconn
3963)
3964) option => realization%option
3965) patch => realization%patch
3966)
3967) if (option%ntrandof == 0) return ! no need to update
3968)
3969) gen_auxvars_bc => patch%aux%General%auxvars_bc
3970) global_auxvars_bc => patch%aux%Global%auxvars_bc
3971)
3972) boundary_condition => patch%boundary_condition_list%first
3973) sum_connection = 0
3974) do
3975) if (.not.associated(boundary_condition)) exit
3976) cur_connection_set => boundary_condition%connection_set
3977) do iconn = 1, cur_connection_set%num_connections
3978) sum_connection = sum_connection + 1
3979) global_auxvars_bc(sum_connection)%sat = &
3980) gen_auxvars_bc(sum_connection)%sat
3981) global_auxvars_bc(sum_connection)%den_kg = &
3982) gen_auxvars_bc(sum_connection)%den_kg
3983) global_auxvars_bc(sum_connection)%temp = &
3984) gen_auxvars_bc(sum_connection)%temp
3985) enddo
3986) boundary_condition => boundary_condition%next
3987) enddo
3988)
3989) end subroutine GeneralMapBCAuxVarsToGlobal
3990)
3991) ! ************************************************************************** !
3992)
3993) subroutine GeneralDestroy(realization)
3994) !
3995) ! Deallocates variables associated with Richard
3996) !
3997) ! Author: Glenn Hammond
3998) ! Date: 03/09/11
3999) !
4000)
4001) use Realization_Subsurface_class
4002)
4003) implicit none
4004)
4005) type(realization_subsurface_type) :: realization
4006)
4007) ! place anything that needs to be freed here.
4008) ! auxvars are deallocated in auxiliary.F90.
4009)
4010) end subroutine GeneralDestroy
4011)
4012) end module General_module