toil_ims.F90 coverage: 82.61 %func 57.85 %block
1) module TOilIms_module
2) ! Brief description for the module
3) ! Pimary variables for ToilIms: oil_pressure, oil_saturation, temperature
4)
5) use TOilIms_Aux_module
6) use Global_Aux_module
7)
8) use PFLOTRAN_Constants_module
9)
10) implicit none
11)
12) private
13)
14) #include "petsc/finclude/petscsys.h"
15) #include "petsc/finclude/petscvec.h"
16) #include "petsc/finclude/petscvec.h90"
17) #include "petsc/finclude/petscmat.h"
18) #include "petsc/finclude/petscmat.h90"
19) #include "petsc/finclude/petscsnes.h"
20) #include "petsc/finclude/petscviewer.h"
21) #include "petsc/finclude/petsclog.h"
22)
23) #define TOIL_CONVECTION
24) #define TOIL_CONDUCTION
25)
26) ! Cutoff parameters - no public
27) PetscReal, parameter :: eps = 1.d-8
28) PetscReal, parameter :: floweps = 1.d-24
29)
30) public :: TOilImsSetup, &
31) TOilImsUpdateAuxVars, &
32) TOilImsInitializeTimestep, &
33) TOilImsComputeMassBalance, &
34) TOilImsResidual, &
35) ToilImsJacobian, &
36) TOilImsUpdateSolution, &
37) TOilImsTimeCut, &
38) TOilImsMapBCAuxVarsToGlobal, &
39) !TOilImsCheckUpdatePre, &
40) !TOilImsCheckUpdatePost, &
41) TOilImsDestroy
42)
43) contains
44)
45) ! ************************************************************************** !
46)
47) subroutine TOilImsSetup(realization)
48) !
49) ! Creates arrays for auxiliary variables
50) !
51) ! Author: Paolo Orsini (OGS)
52) ! Date: 10/20/15
53) !
54)
55) use Realization_Subsurface_class
56) use Patch_module
57) use Option_module
58) use Coupler_module
59) use Connection_module
60) use Grid_module
61) !use Fluid_module
62) use Material_Aux_class
63) use Output_Aux_module
64)
65) implicit none
66)
67) type(realization_subsurface_type) :: realization
68)
69) type(option_type), pointer :: option
70) type(patch_type),pointer :: patch
71) type(grid_type), pointer :: grid
72) type(coupler_type), pointer :: boundary_condition
73) type(material_parameter_type), pointer :: material_parameter
74) type(output_variable_list_type), pointer :: list
75)
76) PetscInt :: ghosted_id, iconn, sum_connection, local_id
77) PetscInt :: i, idof, count
78) PetscBool :: error_found
79) PetscInt :: flag(10)
80) ! extra index for derivatives
81) type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:)
82) type(toil_ims_auxvar_type), pointer :: toil_auxvars_bc(:)
83) type(toil_ims_auxvar_type), pointer :: toil_auxvars_ss(:)
84) class(material_auxvar_type), pointer :: material_auxvars(:)
85) !type(fluid_property_type), pointer :: cur_fluid_property
86)
87) option => realization%option
88) patch => realization%patch
89) grid => patch%grid
90)
91) patch%aux%TOil_ims => TOilImsAuxCreate(option)
92)
93) ! ensure that material properties specific to this module are properly
94) ! initialized
95) material_parameter => patch%aux%Material%material_parameter
96) error_found = PETSC_FALSE
97)
98) if (minval(material_parameter%soil_residual_saturation(:,:)) < 0.d0) then
99) option%io_buffer = 'Non-initialized soil residual saturation.'
100) call printMsg(option)
101) error_found = PETSC_TRUE
102) endif
103) if (minval(material_parameter%soil_heat_capacity(:)) < 0.d0) then
104) option%io_buffer = 'Non-initialized soil heat capacity.'
105) call printMsg(option)
106) error_found = PETSC_TRUE
107) endif
108) if (minval(material_parameter%soil_thermal_conductivity(:,:)) < 0.d0) then
109) option%io_buffer = 'Non-initialized soil thermal conductivity.'
110) call printMsg(option)
111) error_found = PETSC_TRUE
112) endif
113)
114) material_auxvars => patch%aux%Material%auxvars
115) flag = 0
116)
117) !TODO(geh): change to looping over ghosted ids once the legacy code is
118) ! history and the communicator can be passed down.
119) do local_id = 1, grid%nlmax
120) ghosted_id = grid%nL2G(local_id)
121) if (patch%imat(ghosted_id) <= 0) cycle
122) if (material_auxvars(ghosted_id)%volume < 0.d0 .and. flag(1) == 0) then
123) flag(1) = 1
124) option%io_buffer = 'Non-initialized cell volume.'
125) call printMsg(option)
126) endif
127) if (material_auxvars(ghosted_id)%porosity < 0.d0 .and. flag(2) == 0) then
128) flag(2) = 1
129) option%io_buffer = 'Non-initialized porosity.'
130) call printMsg(option)
131) endif
132) if (material_auxvars(ghosted_id)%tortuosity < 0.d0 .and. flag(3) == 0) then
133) flag(3) = 1
134) option%io_buffer = 'Non-initialized tortuosity.'
135) call printMsg(option)
136) endif
137) if (material_auxvars(ghosted_id)%soil_particle_density < 0.d0 .and. &
138) flag(4) == 0) then
139) flag(4) = 1
140) option%io_buffer = 'Non-initialized soil particle density.'
141) call printMsg(option)
142) endif
143) if (minval(material_auxvars(ghosted_id)%permeability) < 0.d0 .and. &
144) flag(5) == 0) then
145) option%io_buffer = 'Non-initialized permeability.'
146) call printMsg(option)
147) flag(5) = 1
148) endif
149) enddo
150)
151) if (error_found .or. maxval(flag) > 0) then
152) option%io_buffer = 'Material property errors found in TOilImsSetup.'
153) call printErrMsg(option)
154) endif
155)
156) ! allocate auxvar data structures for all grid cells
157) allocate(toil_auxvars(0:option%nflowdof,grid%ngmax))
158) do ghosted_id = 1, grid%ngmax
159) do idof = 0, option%nflowdof
160) !call GeneralAuxVarInit(gen_auxvars(idof,ghosted_id),option)
161) call TOilImsAuxVarInit(toil_auxvars(idof,ghosted_id),option)
162) enddo
163) enddo
164) patch%aux%TOil_ims%auxvars => toil_auxvars
165) patch%aux%TOil_ims%num_aux = grid%ngmax
166)
167) ! count the number of boundary connections and allocate
168) ! auxvar data structures for them
169) sum_connection = CouplerGetNumConnectionsInList(patch%boundary_condition_list)
170) if (sum_connection > 0) then
171) allocate(toil_auxvars_bc(sum_connection))
172) do iconn = 1, sum_connection
173) call TOilImsAuxVarInit(toil_auxvars_bc(iconn),option)
174) enddo
175) patch%aux%TOil_ims%auxvars_bc => toil_auxvars_bc
176) endif
177) patch%aux%TOil_ims%num_aux_bc = sum_connection
178)
179) ! count the number of source/sink connections and allocate
180) ! auxvar data structures for them
181) sum_connection = CouplerGetNumConnectionsInList(patch%source_sink_list)
182) if (sum_connection > 0) then
183) allocate(toil_auxvars_ss(sum_connection))
184) do iconn = 1, sum_connection
185) call TOilImsAuxVarInit(toil_auxvars_ss(iconn),option)
186) enddo
187) patch%aux%TOil_ims%auxvars_ss => toil_auxvars_ss
188) endif
189) patch%aux%TOil_ims%num_aux_ss = sum_connection
190)
191) ! create array for zeroing Jacobian entries if isothermal
192) allocate(patch%aux%TOil_ims%row_zeroing_array(grid%nlmax))
193) patch%aux%TOil_ims%row_zeroing_array = 0
194)
195) list => realization%output_option%output_snap_variable_list
196) call TOilImsSetPlotVariables(list)
197) list => realization%output_option%output_obs_variable_list
198) call TOilImsSetPlotVariables(list)
199)
200) ! covergence creteria to be chosen (can use TOUGH or general type)
201) !if (general_tough2_conv_criteria .and. &
202) ! Initialized(option%flow%inf_scaled_res_tol)) then
203) ! ! override what was set in OPTION block of GENERAL process model
204) ! general_tough2_itol_scaled_res_e1 = option%flow%inf_scaled_res_tol
205) !endif
206)
207) end subroutine TOilImsSetup
208)
209) ! ************************************************************************** !
210)
211) subroutine TOilImsInitializeTimestep(realization)
212) !
213) ! Update data in module prior to time step
214) !
215) ! Author: Paolo Orsini (OGS)
216) ! Date: 10/20/15
217) !
218)
219) use Realization_Subsurface_class
220)
221) implicit none
222)
223) type(realization_subsurface_type) :: realization
224)
225) call TOilImsUpdateFixedAccum(realization)
226)
227)
228) end subroutine TOilImsInitializeTimestep
229)
230) ! ************************************************************************** !
231) ! this is now defined in pm_toil_ims
232) !subroutine TOilImsCheckUpdatePre(line_search,X,dX,changed,realization,ierr)
233) ! !
234) ! ! Checks update prior to update
235) ! !
236) ! ! Author: Paolo Orsini (OGS)
237) ! ! Date: 10/22/15
238) ! !
239) !
240) ! use Realization_Subsurface_class
241) ! use Grid_module
242) ! use Field_module
243) ! use Option_module
244) ! !use Saturation_Function_module
245) ! use Patch_module
246) !
247) ! implicit none
248) !
249) ! SNESLineSearch :: line_search
250) ! Vec :: X
251) ! Vec :: dX
252) ! PetscBool :: changed
253) ! type(realization_subsurface_type) :: realization
254) ! PetscReal, pointer :: X_p(:)
255) ! PetscReal, pointer :: dX_p(:)
256) ! PetscErrorCode :: ierr
257) !
258) ! type(grid_type), pointer :: grid
259) ! type(option_type), pointer :: option
260) ! type(patch_type), pointer :: patch
261) ! type(field_type), pointer :: field
262) !
263) ! !type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:)
264) ! !type(global_auxvar_type), pointer :: global_auxvars(:)
265) !
266) ! PetscInt :: local_id, ghosted_id
267) ! PetscInt :: offset
268) !
269) ! PetscInt :: pressure_index, saturation_index, temperature_index
270) !
271) ! PetscReal :: pressure0, pressure1, del_pressure
272) ! PetscReal :: temperature0, temperature1, del_temperature
273) ! PetscReal :: saturation0, saturation1, del_saturation
274) !
275) ! PetscReal :: max_saturation_change = 0.125d0
276) ! PetscReal :: max_temperature_change = 10.d0
277) ! PetscReal :: scale, temp_scale, temp_real
278) ! PetscReal, parameter :: tolerance = 0.99d0
279) ! PetscReal, parameter :: initial_scale = 1.d0
280) ! SNES :: snes
281) ! PetscInt :: newton_iteration
282) !
283) !
284) ! grid => realization%patch%grid
285) ! option => realization%option
286) ! field => realization%field
287) ! !toil_auxvars => realization%patch%aux%TOil_ims%auxvars
288) ! !global_auxvars => realization%patch%aux%Global%auxvars
289) !
290) ! patch => realization%patch
291) !
292) ! call SNESLineSearchGetSNES(line_search,snes,ierr)
293) ! call SNESGetIterationNumber(snes,newton_iteration,ierr)
294) !
295) ! call VecGetArrayF90(dX,dX_p,ierr);CHKERRQ(ierr)
296) ! call VecGetArrayReadF90(X,X_p,ierr);CHKERRQ(ierr)
297) !
298) ! changed = PETSC_TRUE
299) !
300) ! scale = initial_scale
301) ! if (toil_ims_max_it_before_damping > 0 .and. &
302) ! newton_iteration > toil_ims_max_it_before_damping) then
303) ! scale = toil_ims_damping_factor
304) ! endif
305) !
306) !#define LIMIT_MAX_PRESSURE_CHANGE
307) !#define LIMIT_MAX_SATURATION_CHANGE
308) !!!#define LIMIT_MAX_TEMPERATURE_CHANGE
309) !!! TRUNCATE_PRESSURE is needed for times when the solve wants
310) !!! to pull them negative.
311) !!!#define TRUNCATE_PRESSURE
312) !
313) ! ! scaling
314) ! do local_id = 1, grid%nlmax
315) ! ghosted_id = grid%nL2G(local_id)
316) ! offset = (local_id-1)*option%nflowdof
317) ! temp_scale = 1.d0
318) !
319) ! pressure_index = offset + TOIL_IMS_PRESSURE_DOF
320) ! saturation_index = offset + TOIL_IMS_SATURATION_DOF
321) ! temperature_index = offset + TOIL_IMS_ENERGY_DOF
322) ! dX_p(pressure_index) = dX_p(pressure_index) * &
323) ! toil_ims_pressure_scale
324) ! temp_scale = 1.d0
325) ! del_pressure = dX_p(pressure_index)
326) ! pressure0 = X_p(pressure_index)
327) ! pressure1 = pressure0 - del_pressure
328) ! del_saturation = dX_p(saturation_index)
329) ! saturation0 = X_p(saturation_index)
330) ! saturation1 = saturation0 - del_saturation
331) !#ifdef LIMIT_MAX_PRESSURE_CHANGE
332) ! if (dabs(del_pressure) > toil_ims_max_pressure_change) then
333) ! temp_real = dabs(toil_ims_max_pressure_change/del_pressure)
334) ! temp_scale = min(temp_scale,temp_real)
335) ! endif
336) !#endif
337) !#ifdef TRUNCATE_PRESSURE
338) ! if (pressure1 <= 0.d0) then
339) ! if (dabs(del_pressure) > 1.d-40) then
340) ! temp_real = tolerance * dabs(pressure0 / del_pressure)
341) ! temp_scale = min(temp_scale,temp_real)
342) ! endif
343) ! endif
344) !#endif !TRUNCATE_PRESSURE
345) !
346) !#ifdef LIMIT_MAX_SATURATION_CHANGE
347) ! if (dabs(del_saturation) > max_saturation_change) then
348) ! temp_real = dabs(max_saturation_change/del_saturation)
349) ! temp_scale = min(temp_scale,temp_real)
350) ! endif
351) !#endif !LIMIT_MAX_SATURATION_CHANGE
352) ! scale = min(scale,temp_scale)
353) ! enddo
354) !
355) ! temp_scale = scale
356) ! call MPI_Allreduce(temp_scale,scale,ONE_INTEGER_MPI, &
357) ! MPI_DOUBLE_PRECISION, &
358) ! MPI_MIN,option%mycomm,ierr)
359) !
360) ! ! it performs an homogenous scaling using the smallest scaling factor
361) ! ! over all subdomains domains
362) ! if (scale < 0.9999d0) then
363) ! dX_p = scale*dX_p
364) ! endif
365) !
366) ! call VecRestoreArrayF90(dX,dX_p,ierr);CHKERRQ(ierr)
367) ! call VecRestoreArrayReadF90(X,X_p,ierr);CHKERRQ(ierr)
368) !
369) !end subroutine TOilImsCheckUpdatePre
370)
371) ! ************************************************************************** !
372) ! this is now defined in pm_toil_ims
373) !subroutine TOilImsCheckUpdatePost(line_search,X0,dX,X1,dX_changed, &
374) ! X1_changed,realization,ierr)
375) ! !
376) ! ! Checks update after to update
377) ! !
378) ! ! Author: Paolo Orsini
379) ! ! Date: 11/07/15
380) ! !
381) !
382) ! use Realization_Subsurface_class
383) ! use Grid_module
384) ! use Field_module
385) ! use Patch_module
386) ! use Option_module
387) ! use Material_Aux_class
388) !
389) ! implicit none
390) !
391) ! SNESLineSearch :: line_search
392) ! Vec :: X0
393) ! Vec :: dX
394) ! Vec :: X1
395) ! type(realization_subsurface_type) :: realization
396) ! ! ignore changed flag for now.
397) ! PetscBool :: dX_changed
398) ! PetscBool :: X1_changed
399) !
400) ! PetscReal, pointer :: X0_p(:)
401) ! PetscReal, pointer :: X1_p(:)
402) ! PetscReal, pointer :: dX_p(:)
403) ! PetscReal, pointer :: r_p(:)
404) ! PetscReal, pointer :: accum_p(:), accum_p2(:)
405) ! type(grid_type), pointer :: grid
406) ! type(option_type), pointer :: option
407) ! type(field_type), pointer :: field
408) ! type(patch_type), pointer :: patch
409) ! class(material_auxvar_type), pointer :: material_auxvars(:)
410) ! PetscInt :: local_id, ghosted_id
411) ! PetscInt :: offset , ival, idof
412) ! PetscReal :: dX_X0, R_A, R
413) !
414) ! PetscReal :: inf_norm_rel_update(3), global_inf_norm_rel_update(3)
415) ! PetscReal :: inf_norm_scaled_residual(3), global_inf_norm_scaled_residual(3)
416) ! PetscReal :: inf_norm_update(3), global_inf_norm_update(3)
417) ! PetscReal :: inf_norm_residual(3), global_inf_norm_residual(3)
418) ! PetscReal :: two_norm_residual(3), global_two_norm_residual(3)
419) ! PetscReal, parameter :: inf_pres_tol = 1.d-1
420) ! PetscReal, parameter :: inf_temp_tol = 1.d-5
421) ! PetscReal, parameter :: inf_sat_tol = 1.d-6
422) ! !geh: note the scaling by 0.d0 several lines down which prevent false
423) ! ! convergence
424) ! ! PO scaling by 0 kill the inf_norm_update convergence criteria
425) ! PetscReal, parameter :: inf_norm_update_tol(3) = &
426) ! reshape([inf_pres_tol,inf_sat_tol,inf_temp_tol], &
427) ! shape(inf_norm_update_tol)) * &
428) ! 0.d0
429) ! PetscReal :: temp(12), global_temp(12)
430) ! PetscMPIInt :: mpi_int
431) ! PetscBool :: converged_abs_update
432) ! PetscBool :: converged_rel_update
433) ! PetscBool :: converged_scaled_residual
434) ! PetscReal :: t_over_v
435) ! PetscErrorCode :: ierr
436) !
437) ! grid => realization%patch%grid
438) ! option => realization%option
439) ! field => realization%field
440) ! patch => realization%patch ! in patch imat for active/inactive cells
441) ! material_auxvars => patch%aux%Material%auxvars
442) !
443) ! ! it indicates that neither dX of the updated solution are modified
444) ! dX_changed = PETSC_FALSE
445) ! X1_changed = PETSC_FALSE
446) !
447) ! option%converged = PETSC_FALSE
448) ! if (option%flow%check_post_convergence) then
449) ! call VecGetArrayReadF90(dX,dX_p,ierr);CHKERRQ(ierr)
450) ! call VecGetArrayReadF90(X0,X0_p,ierr);CHKERRQ(ierr)
451) ! call VecGetArrayReadF90(field%flow_r,r_p,ierr);CHKERRQ(ierr)
452) ! call VecGetArrayReadF90(field%flow_accum,accum_p,ierr);CHKERRQ(ierr)
453) ! call VecGetArrayReadF90(field%flow_accum2,accum_p2,ierr);CHKERRQ(ierr)
454) !
455) ! inf_norm_update(:) = -1.d20
456) ! inf_norm_rel_update(:) = -1.d20
457) ! inf_norm_scaled_residual(:) = -1.d20
458) ! inf_norm_residual(:) = -1.d20
459) ! two_norm_residual(:) = 0.d0
460) ! do local_id = 1, grid%nlmax
461) ! offset = (local_id-1)*option%nflowdof
462) ! ghosted_id = grid%nL2G(local_id)
463) ! if (realization%patch%imat(ghosted_id) <= 0) cycle
464) ! do idof = 1, option%nflowdof
465) ! ival = offset+idof
466) ! R = r_p(ival)
467) ! inf_norm_residual(idof) = max(inf_norm_residual(idof),dabs(R))
468) ! if (toil_ims_tough2_conv_criteria) then
469) ! !geh: scale by t_over_v to match TOUGH2 residual units. see equation
470) ! ! B.5 of TOUGH2 user manual (LBNL-43134)
471) ! t_over_v = option%flow_dt/material_auxvars(ghosted_id)%volume
472) ! if (accum_p2(ival)*t_over_v < toil_ims_tgh2_itol_scld_res_e2) then
473) ! R_A = dabs(R*t_over_v)
474) ! else
475) ! R_A = dabs(R/accum_p2(ival))
476) ! endif
477) ! else
478) ! R_A = dabs(R/accum_p(ival))
479) ! endif
480) ! dX_X0 = dabs(dX_p(ival)/X0_p(ival))
481) ! inf_norm_update(idof) = max(inf_norm_update(idof),dabs(dX_p(ival)))
482) ! if (inf_norm_rel_update(idof) < dX_X0) then
483) ! inf_norm_rel_update(idof) = dX_X0
484) ! endif
485) ! if (inf_norm_scaled_residual(idof) < R_A) then
486) ! inf_norm_scaled_residual(idof) = R_A
487) ! endif
488) ! enddo
489) ! enddo
490) ! temp(1:3) = inf_norm_update(:)
491) ! temp(4:6) = inf_norm_rel_update(:)
492) ! temp(7:9) = inf_norm_scaled_residual(:)
493) ! temp(10:12) = inf_norm_residual(:)
494) ! mpi_int = 12
495) ! call MPI_Allreduce(temp,global_temp,mpi_int, &
496) ! MPI_DOUBLE_PRECISION,MPI_MAX,option%mycomm,ierr)
497) ! global_inf_norm_update(:) = global_temp(1:3)
498) ! global_inf_norm_rel_update(:) = global_temp(4:6)
499) ! global_inf_norm_scaled_residual(:) = global_temp(7:9)
500) ! global_inf_norm_residual(:) = global_temp(10:12)
501) !
502) ! converged_abs_update = PETSC_TRUE
503) ! do idof = 1, option%nflowdof
504) ! ! imposing inf_norm_update <= inf_norm_update_tol for convergence
505) ! if (global_inf_norm_update(idof) > inf_norm_update_tol(idof)) then
506) ! converged_abs_update = PETSC_FALSE
507) ! endif
508) ! enddo
509) ! converged_rel_update = maxval(global_inf_norm_rel_update) < &
510) ! option%flow%inf_rel_update_tol
511) ! if (toil_ims_tough2_conv_criteria) then
512) ! converged_scaled_residual = maxval(global_inf_norm_scaled_residual) < &
513) ! toil_ims_tgh2_itol_scld_res_e1
514) ! else
515) ! converged_scaled_residual = maxval(global_inf_norm_scaled_residual) < &
516) ! option%flow%inf_scaled_res_tol
517) ! endif
518) ! option%converged = PETSC_FALSE
519) ! if (converged_abs_update .or. converged_rel_update .or. &
520) ! converged_scaled_residual) then
521) ! option%converged = PETSC_TRUE
522) ! endif
523) ! call VecRestoreArrayReadF90(dX,dX_p,ierr);CHKERRQ(ierr)
524) ! call VecRestoreArrayReadF90(X0,X0_p,ierr);CHKERRQ(ierr)
525) ! call VecRestoreArrayReadF90(field%flow_r,r_p,ierr);CHKERRQ(ierr)
526) ! call VecRestoreArrayReadF90(field%flow_accum,accum_p,ierr);CHKERRQ(ierr)
527) ! call VecRestoreArrayReadF90(field%flow_accum2,accum_p2,ierr);CHKERRQ(ierr)
528) ! endif
529) !
530) !end subroutine TOilImsCheckUpdatePost
531)
532) ! ************************************************************************** !
533)
534) subroutine TOilImsSetPlotVariables(list)
535) !
536) ! Adds variables to be printed to list
537) !
538) ! Author: Paolo Orsini (OGS)
539) ! Date: 10/20/15
540) !
541)
542) use Output_Aux_module
543) use Variables_module
544)
545) implicit none
546)
547) type(output_variable_list_type), pointer :: list
548)
549) character(len=MAXWORDLENGTH) :: name, units
550) type(output_variable_type), pointer :: output_variable
551)
552) if (associated(list%first)) then
553) return
554) endif
555)
556) name = 'Temperature'
557) units = 'C'
558) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
559) TEMPERATURE)
560)
561) name = 'Liquid Pressure'
562) units = 'Pa'
563) call OutputVariableAddToList(list,name,OUTPUT_PRESSURE,units, &
564) LIQUID_PRESSURE)
565)
566) name = 'Oil Pressure'
567) units = 'Pa'
568) call OutputVariableAddToList(list,name,OUTPUT_PRESSURE,units, &
569) OIL_PRESSURE)
570)
571) name = 'Liquid Saturation'
572) units = ''
573) call OutputVariableAddToList(list,name,OUTPUT_SATURATION,units, &
574) LIQUID_SATURATION)
575)
576) name = 'Oil Saturation'
577) units = ''
578) call OutputVariableAddToList(list,name,OUTPUT_SATURATION,units, &
579) OIL_SATURATION)
580)
581) name = 'Liquid Density'
582) units = 'kg/m^3'
583) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
584) LIQUID_DENSITY)
585)
586) name = 'Oil Density'
587) units = 'kg/m^3'
588) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
589) OIL_DENSITY)
590)
591) name = 'Liquid Energy'
592) units = 'MJ/kmol'
593) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
594) LIQUID_ENERGY)
595)
596) name = 'Oil Energy'
597) units = 'MJ/kmol'
598) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
599) OIL_ENERGY)
600)
601) !name = 'Thermodynamic State'
602) ! units = ''
603) ! output_variable => OutputVariableCreate(name,OUTPUT_DISCRETE,units,STATE)
604) ! output_variable%plot_only = PETSC_TRUE ! toggle output off for observation
605) ! output_variable%iformat = 1 ! integer
606) ! call OutputVariableAddToList(list,output_variable)
607)
608) end subroutine TOilImsSetPlotVariables
609)
610) ! ************************************************************************** !
611)
612) subroutine TOilImsTimeCut(realization)
613) !
614) ! Resets arrays for time step cut
615) !
616) ! Author: Paolo Orsini
617) ! Date: 11/09/15
618) !
619) use Realization_Subsurface_class
620) !use Option_module
621) !use Field_module
622) !use Patch_module
623) !use Discretization_module
624) !use Grid_module
625)
626) implicit none
627)
628) type(realization_subsurface_type) :: realization
629)
630) !type(option_type), pointer :: option
631) !type(patch_type), pointer :: patch
632) !type(grid_type), pointer :: grid
633) !type(global_auxvar_type), pointer :: global_auxvars(:)
634) !type(general_auxvar_type), pointer :: gen_auxvars(:,:)
635)
636) !PetscInt :: local_id, ghosted_id
637) !PetscErrorCode :: ierr
638)
639) !option => realization%option
640) !patch => realization%patch
641) !grid => patch%grid
642) !global_auxvars => patch%aux%Global%auxvars
643) !gen_auxvars => patch%aux%General%auxvars
644)
645) ! restore stored state there is not state in ims modules
646) !do ghosted_id = 1, grid%ngmax
647) ! global_auxvars(ghosted_id)%istate = &
648) ! gen_auxvars(ZERO_INTEGER,ghosted_id)%istate_store(PREV_TS)
649) !enddo
650)
651) !#ifdef DEBUG_GENERAL_FILEOUTPUT
652) ! debug_timestep_cut_count = debug_timestep_cut_count + 1
653) !#endif
654)
655) ! PO
656) ! if anything else to do when specific to cutting time step -
657) ! for TOIL IMS - add here
658)
659) call TOilImsInitializeTimestep(realization)
660)
661) end subroutine TOilImsTimeCut
662)
663) ! ************************************************************************** !
664)
665)
666) ! ************************************************************************** !
667)
668) subroutine TOilImsUpdateAuxVars(realization)
669) !
670) ! Updates the auxiliary variables associated with the TOilIms problem
671) !
672) ! Author: Paolo Orsini
673) ! Date: 10/21/15
674) !
675)
676) use Realization_Subsurface_class
677) use Patch_module
678) use Option_module
679) use Field_module
680) use Grid_module
681) use Coupler_module
682) use Connection_module
683) use Material_module
684) use Material_Aux_class
685) !use EOS_Water_module
686) !use Saturation_Function_module
687)
688) implicit none
689)
690) type(realization_subsurface_type) :: realization
691) PetscBool :: update_state
692)
693) type(option_type), pointer :: option
694) type(patch_type), pointer :: patch
695) type(grid_type), pointer :: grid
696) type(field_type), pointer :: field
697) type(coupler_type), pointer :: boundary_condition
698) type(connection_set_type), pointer :: cur_connection_set
699)
700) type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:), toil_auxvars_bc(:)
701)
702) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
703)
704) class(material_auxvar_type), pointer :: material_auxvars(:)
705)
706) PetscInt :: ghosted_id, local_id, sum_connection, idof, iconn, natural_id
707) PetscInt :: ghosted_start, ghosted_end
708) !PetscInt :: iphasebc, iphase
709) PetscInt :: offset
710) PetscInt :: istate
711)
712) !PetscReal :: gas_pressure, capillary_pressure, liquid_saturation
713) !PetscReal :: saturation_pressure, temperature
714)
715) PetscInt :: real_index, variable
716) PetscReal, pointer :: xx_loc_p(:)
717) PetscReal :: xxbc(realization%option%nflowdof)
718)
719) PetscErrorCode :: ierr
720)
721) option => realization%option
722) patch => realization%patch
723) grid => patch%grid
724) field => realization%field
725)
726) toil_auxvars => patch%aux%TOil_ims%auxvars
727) toil_auxvars_bc => patch%aux%TOil_ims%auxvars_bc
728) global_auxvars => patch%aux%Global%auxvars
729) global_auxvars_bc => patch%aux%Global%auxvars_bc
730) material_auxvars => patch%aux%Material%auxvars
731)
732) call VecGetArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
733)
734) do ghosted_id = 1, grid%ngmax
735) if (grid%nG2L(ghosted_id) < 0) cycle ! bypass ghosted corner cells
736)
737) !Ignore inactive cells with inactive materials
738) if (patch%imat(ghosted_id) <= 0) cycle
739) ghosted_end = ghosted_id*option%nflowdof
740) ghosted_start = ghosted_end - option%nflowdof + 1
741) ! TOIL_IMS_UPDATE_FOR_ACCUM indicates call from non-perturbation
742) option%iflag = TOIL_IMS_UPDATE_FOR_ACCUM
743) natural_id = grid%nG2A(ghosted_id)
744) call TOilImsAuxVarCompute(xx_loc_p(ghosted_start:ghosted_end), &
745) toil_auxvars(ZERO_INTEGER,ghosted_id), &
746) global_auxvars(ghosted_id), &
747) material_auxvars(ghosted_id), &
748) patch%characteristic_curves_array( &
749) patch%sat_func_id(ghosted_id))%ptr, &
750) natural_id, &
751) option)
752)
753) enddo
754)
755) ! compute auxiliary variables for boundary cells
756) boundary_condition => patch%boundary_condition_list%first
757) sum_connection = 0
758) do
759) if (.not.associated(boundary_condition)) exit
760) cur_connection_set => boundary_condition%connection_set
761) do iconn = 1, cur_connection_set%num_connections
762) sum_connection = sum_connection + 1
763) local_id = cur_connection_set%id_dn(iconn)
764) ghosted_id = grid%nL2G(local_id)
765) !negate to indicate boundary connection, not actual cell
766) natural_id = -grid%nG2A(ghosted_id)
767) offset = (ghosted_id-1)*option%nflowdof
768) if (patch%imat(ghosted_id) <= 0) cycle
769)
770) xxbc(:) = xx_loc_p(offset+1:offset+option%nflowdof)
771) !istate = boundary_condition%flow_aux_int_var(GENERAL_STATE_INDEX,iconn)
772)
773) ! we do this for all BCs; Neumann bcs will be set later
774) do idof = 1, option%nflowdof
775) real_index = boundary_condition% &
776) flow_aux_mapping(toil_ims_dof_to_primary_vars(idof))
777) if (real_index > 0) then
778) xxbc(idof) = boundary_condition%flow_aux_real_var(real_index,iconn)
779) else
780) option%io_buffer = 'Error setting up boundary condition' // &
781) ' in TOilImsUpdateAuxVars'
782) call printErrMsg(option)
783) endif
784) enddo
785)
786) ! state not required
787) !toil_auxvars_bc(sum_connection)%istate = istate
788) ! TOIL_IMS_UPDATE_FOR_BOUNDARY indicates call from non-perturbation
789) option%iflag = TOIL_IMS_UPDATE_FOR_BOUNDARY
790) call TOilImsAuxVarCompute(xxbc,toil_auxvars_bc(sum_connection), &
791) global_auxvars_bc(sum_connection), &
792) material_auxvars(ghosted_id), &
793) patch%characteristic_curves_array( &
794) patch%sat_func_id(ghosted_id))%ptr, &
795) natural_id, &
796) option)
797) enddo
798) boundary_condition => boundary_condition%next
799) enddo
800)
801) call VecRestoreArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
802)
803) patch%aux%TOil_ims%auxvars_up_to_date = PETSC_TRUE
804)
805) end subroutine TOilImsUpdateAuxVars
806)
807) ! ************************************************************************** !
808)
809) subroutine TOilImsUpdateFixedAccum(realization)
810) !
811) ! Updates the fixed portion of the
812) ! accumulation term
813) !
814) ! Author: Paolo Orsini
815) ! Date: 10/23/15
816) !
817)
818) use Realization_Subsurface_class
819) use Patch_module
820) use Option_module
821) use Field_module
822) use Grid_module
823) use Material_Aux_class
824)
825) implicit none
826)
827) type(realization_subsurface_type) :: realization
828)
829) type(option_type), pointer :: option
830) type(patch_type), pointer :: patch
831) type(grid_type), pointer :: grid
832) type(field_type), pointer :: field
833) type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:)
834)
835) type(global_auxvar_type), pointer :: global_auxvars(:)
836)
837) class(material_auxvar_type), pointer :: material_auxvars(:)
838) type(material_parameter_type), pointer :: material_parameter
839)
840) PetscInt :: ghosted_id, local_id, local_start, local_end
841) PetscInt :: imat
842) PetscReal, pointer :: xx_p(:), iphase_loc_p(:)
843) PetscReal, pointer :: accum_p(:), accum_p2(:)
844)
845) PetscErrorCode :: ierr
846)
847) option => realization%option
848) field => realization%field
849) patch => realization%patch
850) grid => patch%grid
851)
852) toil_auxvars => patch%aux%TOil_ims%auxvars
853)
854) global_auxvars => patch%aux%Global%auxvars
855)
856) material_auxvars => patch%aux%Material%auxvars
857) material_parameter => patch%aux%Material%material_parameter
858)
859) call VecGetArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
860)
861) call VecGetArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
862)
863) !Tough2 conv. creteria: initialize accumulation term for every iteration
864) if (toil_ims_tough2_conv_criteria) then
865) call VecGetArrayF90(field%flow_accum2, accum_p2, ierr);CHKERRQ(ierr)
866) endif
867)
868) do local_id = 1, grid%nlmax
869) ghosted_id = grid%nL2G(local_id)
870) !geh - Ignore inactive cells with inactive materials
871) imat = patch%imat(ghosted_id)
872) if (imat <= 0) cycle
873) local_end = local_id*option%nflowdof
874) local_start = local_end - option%nflowdof + 1
875) ! TOIL_IMS_UPDATE_FOR_FIXED_ACCUM indicates call from non-perturbation
876) option%iflag = TOIL_IMS_UPDATE_FOR_FIXED_ACCUM ! not currently used
877) call TOilImsAuxVarCompute(xx_p(local_start:local_end), &
878) toil_auxvars(ZERO_INTEGER,ghosted_id), &
879) global_auxvars(ghosted_id), &
880) material_auxvars(ghosted_id), &
881) patch%characteristic_curves_array( &
882) patch%sat_func_id(ghosted_id))%ptr, &
883) ghosted_id, &
884) option)
885) call TOilImsAccumulation(toil_auxvars(ZERO_INTEGER,ghosted_id), &
886) material_auxvars(ghosted_id), &
887) material_parameter%soil_heat_capacity(imat), &
888) option,accum_p(local_start:local_end) )
889) enddo
890)
891) !Tough2 conv. creteria: initialize accumulation term for every iteration
892) if (toil_ims_tough2_conv_criteria) then
893) accum_p2 = accum_p
894) endif
895)
896) call VecRestoreArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
897)
898) call VecRestoreArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
899)
900) !Tough2 conv. creteria: initialize accumulation term for every iteration
901) if (toil_ims_tough2_conv_criteria) then
902) call VecRestoreArrayF90(field%flow_accum2, accum_p2, ierr);CHKERRQ(ierr)
903) endif
904)
905) end subroutine TOilImsUpdateFixedAccum
906)
907) ! ************************************************************************** !
908)
909) subroutine TOilImsUpdateSolution(realization)
910) !
911) ! Updates data in module after a successful time
912) ! step: currently it updates only mass balance
913) !
914) ! Author: Paolo Orsini
915) ! Date: 10/23/15
916) !
917)
918) use Realization_Subsurface_class
919) !use Field_module
920) !use Patch_module
921) !use Discretization_module
922) !use Option_module
923) !use Grid_module
924)
925) implicit none
926)
927) type(realization_subsurface_type) :: realization
928)
929) !type(option_type), pointer :: option
930) !type(patch_type), pointer :: patch
931) !type(grid_type), pointer :: grid
932) !type(field_type), pointer :: field
933) !type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:)
934) !type(global_auxvar_type), pointer :: global_auxvars(:)
935) !PetscInt :: local_id, ghosted_id
936) !PetscErrorCode :: ierr
937)
938) !option => realization%option
939) !field => realization%field
940) !patch => realization%patch
941) !grid => patch%grid
942) !gen_auxvars => patch%aux%General%auxvars
943) !global_auxvars => patch%aux%Global%auxvars
944)
945) if (realization%option%compute_mass_balance_new) then
946) call TOilImsUpdateMassBalance(realization)
947) endif
948)
949)
950)
951) end subroutine TOilImsUpdateSolution
952)
953) ! ************************************************************************** !
954)
955) subroutine TOilImsComputeMassBalance(realization,mass_balance)
956) !
957) ! Initializes mass balance
958) !
959) ! Author: Paolo Orsini
960) ! Date: 11/12/15
961) !
962)
963) use Realization_Subsurface_class
964) use Option_module
965) use Patch_module
966) use Field_module
967) use Grid_module
968) use Material_Aux_class
969)
970) implicit none
971)
972) type(realization_subsurface_type) :: realization
973) PetscReal :: mass_balance(realization%option%nflowspec, &
974) realization%option%nphase)
975)
976) type(option_type), pointer :: option
977) type(patch_type), pointer :: patch
978) type(field_type), pointer :: field
979) type(grid_type), pointer :: grid
980) type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:)
981) class(material_auxvar_type), pointer :: material_auxvars(:)
982)
983) PetscErrorCode :: ierr
984) PetscInt :: local_id
985) PetscInt :: ghosted_id
986) PetscInt :: iphase !, icomp
987) PetscReal :: vol_phase
988)
989) option => realization%option
990) patch => realization%patch
991) grid => patch%grid
992) field => realization%field
993)
994) toil_auxvars => patch%aux%TOil_ims%auxvars
995) material_auxvars => patch%aux%Material%auxvars
996)
997) mass_balance = 0.d0
998) ! note :: only first column of mass_balance(1:2,1) is used
999)
1000) do local_id = 1, grid%nlmax
1001) ghosted_id = grid%nL2G(local_id)
1002) !geh - Ignore inactive cells with inactive materials
1003) if (patch%imat(ghosted_id) <= 0) cycle
1004) do iphase = 1, option%nphase
1005) ! volume_phase = saturation*porosity*volume
1006) vol_phase = &
1007) toil_auxvars(ZERO_INTEGER,ghosted_id)%sat(iphase)* &
1008) toil_auxvars(ZERO_INTEGER,ghosted_id)%effective_porosity* &
1009) material_auxvars(ghosted_id)%volume
1010) ! mass = volume_phase*density
1011)
1012) mass_balance(iphase,1) = mass_balance(iphase,1) + &
1013) toil_auxvars(ZERO_INTEGER,ghosted_id)%den(iphase)* &
1014) toil_ims_fmw_comp(iphase)*vol_phase
1015)
1016) enddo
1017) enddo
1018)
1019) end subroutine TOilImsComputeMassBalance
1020)
1021) ! ************************************************************************** !
1022)
1023) subroutine TOilImsUpdateMassBalance(realization)
1024) !
1025) ! Updates mass balance
1026) ! Using existing data structure for two phase compositional
1027) ! For memory efficiency define new data structure
1028) !
1029) ! Author: Paolo Orsini
1030) ! Date: 10/23/15
1031) !
1032)
1033) use Realization_Subsurface_class
1034) use Option_module
1035) use Patch_module
1036) use Grid_module
1037) use EOS_Oil_module
1038)
1039) implicit none
1040)
1041) type(realization_subsurface_type) :: realization
1042)
1043) type(option_type), pointer :: option
1044) type(patch_type), pointer :: patch
1045) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
1046) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
1047)
1048) PetscInt :: iconn
1049) PetscInt :: icomp
1050)
1051) option => realization%option
1052) patch => realization%patch
1053)
1054) global_auxvars_bc => patch%aux%Global%auxvars_bc
1055) global_auxvars_ss => patch%aux%Global%auxvars_ss
1056)
1057) ! option%nflowspec = 2,
1058) ! two species (H2O,OIL): each present only in its own rich phase
1059)
1060) ! updating with mass balance, assuming molar quantity loaded in:
1061) ! mass_balance and mass_balance_delta
1062)
1063) !write(*,*) "toil fmw", toil_ims_fmw_comp(1), toil_ims_fmw_comp(2)
1064)
1065) do iconn = 1, patch%aux%TOil_ims%num_aux_bc
1066) do icomp = 1, option%nflowspec
1067) global_auxvars_bc(iconn)%mass_balance(icomp,:) = &
1068) global_auxvars_bc(iconn)%mass_balance(icomp,:) + &
1069) global_auxvars_bc(iconn)%mass_balance_delta(icomp,:)* &
1070) toil_ims_fmw_comp(icomp)*option%flow_dt
1071) enddo
1072) enddo
1073) do iconn = 1, patch%aux%TOil_ims%num_aux_ss
1074) do icomp = 1, option%nflowspec
1075) global_auxvars_ss(iconn)%mass_balance(icomp,:) = &
1076) global_auxvars_ss(iconn)%mass_balance(icomp,:) + &
1077) global_auxvars_ss(iconn)%mass_balance_delta(icomp,:)* &
1078) toil_ims_fmw_comp(icomp)*option%flow_dt
1079) enddo
1080) enddo
1081)
1082) end subroutine TOilImsUpdateMassBalance
1083)
1084) ! ************************************************************************** !
1085)
1086) subroutine TOilImsZeroMassBalanceDelta(realization)
1087) !
1088) ! Zeros mass balance delta array
1089) !
1090) ! Author: Paolo Orsini
1091) ! Date: 10/23/15
1092) !
1093)
1094) use Realization_Subsurface_class
1095) use Option_module
1096) use Patch_module
1097) use Grid_module
1098)
1099) implicit none
1100)
1101) type(realization_subsurface_type) :: realization
1102)
1103) type(option_type), pointer :: option
1104) type(patch_type), pointer :: patch
1105) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
1106) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
1107)
1108) PetscInt :: iconn
1109)
1110) option => realization%option
1111) patch => realization%patch
1112)
1113) global_auxvars_bc => patch%aux%Global%auxvars_bc
1114) global_auxvars_ss => patch%aux%Global%auxvars_ss
1115)
1116) do iconn = 1, patch%aux%TOil_Ims%num_aux_bc
1117) global_auxvars_bc(iconn)%mass_balance_delta = 0.d0
1118) enddo
1119) do iconn = 1, patch%aux%TOil_Ims%num_aux_ss
1120) global_auxvars_ss(iconn)%mass_balance_delta = 0.d0
1121) enddo
1122)
1123) end subroutine TOilImsZeroMassBalanceDelta
1124)
1125) ! ************************************************************************** !
1126)
1127) subroutine TOilImsMapBCAuxVarsToGlobal(realization)
1128) !
1129) ! Maps toil_ims BC Auxvars to global auxvars
1130) !
1131) ! Author: Paolo Orsini
1132) ! Date: 10/23/15
1133) !
1134)
1135) use Realization_Subsurface_class
1136) use Option_module
1137) use Patch_module
1138) use Coupler_module
1139) use Connection_module
1140)
1141) implicit none
1142)
1143) type(realization_subsurface_type) :: realization
1144)
1145) type(option_type), pointer :: option
1146) type(patch_type), pointer :: patch
1147) type(coupler_type), pointer :: boundary_condition
1148) type(connection_set_type), pointer :: cur_connection_set
1149) type(toil_ims_auxvar_type), pointer :: toil_auxvars_bc(:)
1150) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
1151)
1152) PetscInt :: sum_connection, iconn
1153)
1154) option => realization%option
1155) patch => realization%patch
1156)
1157) !NOTE: this is called only if cpoupling to RT
1158) if (option%ntrandof == 0) return ! no need to update
1159)
1160) toil_auxvars_bc => patch%aux%TOil_ims%auxvars_bc
1161) global_auxvars_bc => patch%aux%Global%auxvars_bc
1162)
1163) boundary_condition => patch%boundary_condition_list%first
1164) sum_connection = 0
1165) do
1166) if (.not.associated(boundary_condition)) exit
1167) cur_connection_set => boundary_condition%connection_set
1168) do iconn = 1, cur_connection_set%num_connections
1169) sum_connection = sum_connection + 1
1170) global_auxvars_bc(sum_connection)%sat = &
1171) toil_auxvars_bc(sum_connection)%sat
1172) global_auxvars_bc(sum_connection)%den_kg = &
1173) toil_auxvars_bc(sum_connection)%den_kg
1174) global_auxvars_bc(sum_connection)%temp = &
1175) toil_auxvars_bc(sum_connection)%temp
1176) enddo
1177) boundary_condition => boundary_condition%next
1178) enddo
1179)
1180) end subroutine TOilImsMapBCAuxVarsToGlobal
1181)
1182) ! ************************************************************************** !
1183)
1184) subroutine TOilImsAccumulation(toil_auxvar,material_auxvar, &
1185) soil_heat_capacity,option,Res)
1186) !
1187) ! Computes the non-fixed portion of the accumulation
1188) ! term for the residual
1189) !
1190) ! Author: Paolo Orsini
1191) ! Date: 10/23/15
1192) !
1193)
1194) use Option_module
1195) use Material_module
1196) use Material_Aux_class
1197)
1198) implicit none
1199)
1200) type(toil_ims_auxvar_type) :: toil_auxvar
1201) class(material_auxvar_type) :: material_auxvar
1202) PetscReal :: soil_heat_capacity
1203) type(option_type) :: option
1204) PetscReal :: Res(option%nflowdof)
1205) !PetscBool :: debug_cell
1206)
1207) PetscInt :: iphase, energy_id
1208)
1209) PetscReal :: porosity
1210) PetscReal :: v_over_t
1211)
1212) energy_id = option%energy_id
1213)
1214) ! v_over_t[m^3 bulk/sec] = vol[m^3 bulk] / dt[sec]
1215) v_over_t = material_auxvar%volume / option%flow_dt
1216) ! must use toil_auxvar%effective porosity here as it enables numerical
1217) ! derivatives to be employed
1218) porosity = toil_auxvar%effective_porosity
1219)
1220) ! flow accumulation term units = kmol/s
1221) Res = 0.d0
1222) do iphase = 1, option%nphase
1223) ! Res[kmol comp/m^3 void] = sat[m^3 phase/m^3 void] *
1224) ! den[kmol phase/m^3 phase]
1225) ! molar balance formulation (kmol)
1226) Res(iphase) = Res(iphase) + toil_auxvar%sat(iphase) * &
1227) toil_auxvar%den(iphase)
1228) enddo
1229)
1230) ! scale by porosity * volume / dt
1231) ! Res[kmol/sec] = Res[kmol/m^3 void] * por[m^3 void/m^3 bulk] *
1232) ! vol[m^3 bulk] / dt[sec]
1233) Res(1:option%nphase) = Res(1:option%nphase) * &
1234) porosity * v_over_t
1235)
1236) ! energy accumulation term units = MJ/s
1237) do iphase = 1, option%nphase
1238) ! Res[MJ/m^3 void] = sat[m^3 phase/m^3 void] *
1239) ! den[kmol phase/m^3 phase] * U[MJ/kmol phase]
1240) Res(energy_id) = Res(energy_id) + toil_auxvar%sat(iphase) * &
1241) toil_auxvar%den(iphase) * &
1242) toil_auxvar%U(iphase)
1243) enddo
1244) ! Res[MJ/sec] = (Res[MJ/m^3 void] * por[m^3 void/m^3 bulk] +
1245) ! (1-por)[m^3 rock/m^3 bulk] *
1246) ! dencpr[kg rock/m^3 rock * MJ/kg rock-K] * T[C]) &
1247) ! vol[m^3 bulk] / dt[sec]
1248) Res(energy_id) = (Res(energy_id) * porosity + &
1249) (1.d0 - porosity) * &
1250) material_auxvar%soil_particle_density * &
1251) soil_heat_capacity * toil_auxvar%temp) * v_over_t
1252)
1253) end subroutine TOilImsAccumulation
1254)
1255) ! ************************************************************************** !
1256)
1257) ! ************************************************************************** !
1258)
1259) subroutine TOilImsFlux(toil_auxvar_up,global_auxvar_up, &
1260) material_auxvar_up, &
1261) sir_up, &
1262) thermal_conductivity_up, &
1263) toil_auxvar_dn,global_auxvar_dn, &
1264) material_auxvar_dn, &
1265) sir_dn, &
1266) thermal_conductivity_dn, &
1267) area, dist, parameter, &
1268) option,v_darcy,Res)
1269) !
1270) ! Computes the internal flux terms for the residual
1271) !
1272) ! Author: Paolo Orsini
1273) ! Date: 10/27/15
1274) !
1275) use Option_module
1276) use Material_Aux_class
1277) use Connection_module
1278)
1279) ! no fractures considered for now
1280) ! use Fracture_module
1281) !use Klinkenberg_module
1282)
1283) implicit none
1284)
1285) type(toil_ims_auxvar_type) :: toil_auxvar_up, toil_auxvar_dn
1286) type(global_auxvar_type) :: global_auxvar_up, global_auxvar_dn
1287) class(material_auxvar_type) :: material_auxvar_up, material_auxvar_dn
1288) type(option_type) :: option
1289) PetscReal :: sir_up(:), sir_dn(:)
1290) PetscReal :: v_darcy(option%nphase)
1291) PetscReal :: area
1292) PetscReal :: dist(-1:3)
1293) type(toil_ims_parameter_type) :: parameter
1294) PetscReal :: thermal_conductivity_dn(2)
1295) PetscReal :: thermal_conductivity_up(2)
1296) PetscReal :: Res(option%nflowdof)
1297) !PetscBool :: debug_connection
1298)
1299) PetscReal :: dist_gravity ! distance along gravity vector
1300) PetscReal :: dist_up, dist_dn
1301) PetscReal :: upweight
1302)
1303) PetscInt :: energy_id
1304) PetscInt :: iphase
1305)
1306) PetscReal :: density_ave, density_kg_ave
1307) PetscReal :: uH
1308) PetscReal :: H_ave
1309) PetscReal :: perm_ave_over_dist(option%nphase)
1310) PetscReal :: perm_up, perm_dn ! no mole fractions
1311) PetscReal :: delta_pressure, delta_temp !, delta_xmol,
1312)
1313) PetscReal :: pressure_ave
1314) PetscReal :: gravity_term
1315) PetscReal :: mobility, mole_flux, q
1316) PetscReal :: stpd_up, stpd_dn
1317) PetscReal :: sat_up, sat_dn, den_up, den_dn
1318) PetscReal :: temp_ave, stpd_ave_over_dist, tempreal
1319) PetscReal :: k_eff_up, k_eff_dn, k_eff_ave, heat_flux
1320)
1321) ! no diff fluxes - arrays used for debugging only
1322) PetscReal :: adv_flux(3,2), diff_flux(2,2)
1323) PetscReal :: debug_flux(3,3), debug_dphi(2)
1324)
1325) PetscReal :: dummy_perm_up, dummy_perm_dn
1326)
1327) energy_id = option%energy_id
1328)
1329) call ConnectionCalculateDistances(dist,option%gravity,dist_up,dist_dn, &
1330) dist_gravity,upweight)
1331) call material_auxvar_up%PermeabilityTensorToScalar(dist,perm_up)
1332) call material_auxvar_dn%PermeabilityTensorToScalar(dist,perm_dn)
1333)
1334) ! Fracture permeability change only available for structured grid (Heeho)
1335) ! PO nu fractures considered for now
1336) !if (associated(material_auxvar_up%fracture)) then
1337) ! call FracturePermEvaluate(material_auxvar_up,perm_up,perm_up, &
1338) ! dummy_perm_up,dist)
1339) !endif
1340) !if (associated(material_auxvar_dn%fracture)) then
1341) ! call FracturePermEvaluate(material_auxvar_dn,perm_dn,perm_dn, &
1342) ! dummy_perm_dn,dist)
1343) !endif
1344)
1345) !if (associated(klinkenberg)) then
1346) ! perm_ave_over_dist(1) = (perm_up * perm_dn) / &
1347) ! (dist_up*perm_dn + dist_dn*perm_up)
1348) ! dummy_perm_up = klinkenberg%Evaluate(perm_up, &
1349) ! gen_auxvar_up%pres(option%gas_phase))
1350) ! dummy_perm_dn = klinkenberg%Evaluate(perm_dn, &
1351) ! gen_auxvar_dn%pres(option%gas_phase))
1352) ! perm_ave_over_dist(2) = (dummy_perm_up * dummy_perm_dn) / &
1353) ! (dist_up*dummy_perm_dn + dist_dn*dummy_perm_up)
1354) !else
1355) perm_ave_over_dist(:) = (perm_up * perm_dn) / &
1356) (dist_up*perm_dn + dist_dn*perm_up)
1357) !endif
1358)
1359) Res = 0.d0
1360)
1361) v_darcy = 0.d0
1362)
1363) !#ifdef DEBUG_FLUXES
1364) ! adv_flux = 0.d0
1365) ! diff_flux = 0.d0
1366) !#endif
1367) !#ifdef DEBUG_GENERAL_FILEOUTPUT
1368) ! debug_flux = 0.d0
1369) ! debug_dphi = 0.d0
1370) !#endif
1371)
1372) #ifdef TOIL_CONVECTION
1373) do iphase = 1, option%nphase
1374)
1375) if (toil_auxvar_up%mobility(iphase) + &
1376) toil_auxvar_dn%mobility(iphase) < eps) then
1377) cycle
1378) endif
1379)
1380) ! an alternative could be to avergae using oil_sat
1381) !density_kg_ave = 0.5d0* ( toil_auxvar_up%den_kg(iphase) + &
1382) ! toil_auxvar_dn%den_kg(iphase) )
1383) density_kg_ave = TOilImsAverageDensity(toil_auxvar_up%sat(iphase), &
1384) toil_auxvar_dn%sat(iphase), &
1385) toil_auxvar_up%den_kg(iphase), &
1386) toil_auxvar_dn%den_kg(iphase))
1387)
1388) gravity_term = density_kg_ave * dist_gravity
1389) delta_pressure = toil_auxvar_up%pres(iphase) - &
1390) toil_auxvar_dn%pres(iphase) + &
1391) gravity_term
1392)
1393) !#ifdef DEBUG_GENERAL_FILEOUTPUT
1394) ! debug_dphi(iphase) = delta_pressure
1395) !#endif
1396)
1397) ! upwinding the mobilities and enthalpies
1398) if (delta_pressure >= 0.D0) then
1399) mobility = toil_auxvar_up%mobility(iphase)
1400) H_ave = toil_auxvar_up%H(iphase)
1401) uH = H_ave
1402) !density_ave = toil_auxvar_up%den(iphase)
1403) else
1404) mobility = toil_auxvar_dn%mobility(iphase)
1405) H_ave = toil_auxvar_dn%H(iphase)
1406) uH = H_ave
1407) !density_ave = toil_auxvar_dn%den(iphase)
1408) endif
1409)
1410) if (mobility > floweps) then
1411) ! v_darcy[m/sec] = perm[m^2] / dist[m] * kr[-] / mu[Pa-sec]
1412) ! dP[Pa]]
1413) v_darcy(iphase) = perm_ave_over_dist(iphase) * mobility * delta_pressure
1414)
1415) ! if comments below, use upwinding value
1416) !density_ave = 0.5d0*( toil_auxvar_up%den(iphase) + &
1417) ! toil_auxvar_dn%den(iphase))
1418)
1419) density_ave = TOilImsAverageDensity(toil_auxvar_up%sat(iphase), &
1420) toil_auxvar_dn%sat(iphase), &
1421) toil_auxvar_up%den(iphase), &
1422) toil_auxvar_dn%den(iphase))
1423)
1424) ! q[m^3 phase/sec] = v_darcy[m/sec] * area[m^2]
1425) q = v_darcy(iphase) * area
1426) ! mole_flux[kmol phase/sec] = q[m^3 phase/sec] *
1427) ! density_ave[kmol phase/m^3 phase]
1428) mole_flux = q*density_ave
1429) ! Res[kmol total/sec]
1430)
1431) ! Res[kmol phase/sec] = mole_flux[kmol phase/sec]
1432) Res(iphase) = Res(iphase) + mole_flux
1433)
1434) !do icomp = 1, option%nflowspec
1435) ! ! Res[kmol comp/sec] = mole_flux[kmol phase/sec] *
1436) ! ! xmol[kmol comp/kmol phase]
1437) ! Res(icomp) = Res(icomp) + mole_flux * xmol(icomp)
1438) !enddo
1439)
1440) !#ifdef DEBUG_FLUXES
1441) ! do icomp = 1, option%nflowspec
1442) ! adv_flux(icomp) = adv_flux(icomp) + mole_flux * xmol(icomp)
1443) ! enddo ! Res[MJ/sec] = mole_flux[kmol comp/sec] * H_ave[MJ/kmol comp]
1444) !#endif
1445) !#ifdef DEBUG_GENERAL_FILEOUTPUT
1446) ! do icomp = 1, option%nflowspec
1447) ! debug_flux(icomp,iphase) = debug_flux(icomp,iphase) + mole_flux * xmol(icomp)
1448) ! enddo ! Res[MJ/sec] = mole_flux[kmol comp/sec] * H_ave[MJ/kmol comp]
1449) !#endif
1450)
1451) Res(energy_id) = Res(energy_id) + mole_flux * uH
1452)
1453) !#ifdef DEBUG_FLUXES
1454) ! adv_flux(energy_id) = adv_flux(energy_id) + mole_flux * uH
1455) !#endif
1456) !#ifdef DEBUG_GENERAL_FILEOUTPUT
1457) ! debug_dphi(iphase) = delta_pressure
1458) ! debug_flux(energy_id,iphase) = debug_flux(energy_id,iphase) + mole_flux * uH
1459) !#endif
1460)
1461) endif ! if mobility larger than given tolerance
1462)
1463) enddo
1464) #endif
1465) ! TOIL_CONVECTION
1466)
1467) !#ifdef DEBUG_GENERAL_FILEOUTPUT
1468) ! if (debug_flag > 0) then
1469) ! write(debug_unit,'(a,7es24.15)') 'delta pressure :', debug_dphi(:)
1470) ! write(debug_unit,'(a,7es24.15)') 'adv flux (liquid):', debug_flux(:,1)
1471) ! write(debug_unit,'(a,7es24.15)') 'adv flux (gas):', debug_flux(:,2)
1472) ! endif
1473) ! debug_flux = 0.d0
1474) !#endif
1475)
1476) #ifdef TOIL_CONDUCTION
1477) ! model for liquid + gas
1478) ! add heat conduction flux
1479) ! based on Somerton et al., 1974:
1480) ! k_eff = k_dry + sqrt(s_l)*(k_sat-k_dry)
1481) !k_eff_up = thermal_conductivity_up(1) + &
1482) ! sqrt(gen_auxvar_up%sat(option%liquid_phase)) * &
1483) ! (thermal_conductivity_up(2) - thermal_conductivity_up(1))
1484) !k_eff_dn = thermal_conductivity_dn(1) + &
1485) ! sqrt(gen_auxvar_dn%sat(option%liquid_phase)) * &
1486) ! (thermal_conductivity_dn(2) - thermal_conductivity_dn(1))
1487) !if (k_eff_up > 0.d0 .or. k_eff_up > 0.d0) then
1488) ! k_eff_ave = (k_eff_up*k_eff_dn)/(k_eff_up*dist_dn+k_eff_dn*dist_up)
1489) !else
1490) ! k_eff_ave = 0.d0
1491) !endif
1492) ! considered the formation fully saturated in water for heat conduction
1493) k_eff_up = thermal_conductivity_up(1)
1494) k_eff_dn = thermal_conductivity_dn(1)
1495) if (k_eff_up > 0.d0 .or. k_eff_up > 0.d0) then
1496) k_eff_ave = (k_eff_up*k_eff_dn)/(k_eff_up*dist_dn+k_eff_dn*dist_up)
1497) else
1498) k_eff_ave = 0.d0
1499) endif
1500)
1501) ! units:
1502) ! k_eff = W/K-m = J/s/K-m
1503) ! delta_temp = K
1504) ! area = m^2
1505) ! heat_flux = k_eff * delta_temp * area = J/s
1506) delta_temp = toil_auxvar_up%temp - toil_auxvar_dn%temp
1507) heat_flux = k_eff_ave * delta_temp * area * 1.d-6 ! J/s -> MJ/s
1508) ! MJ/s
1509) Res(energy_id) = Res(energy_id) + heat_flux
1510) ! CONDUCTION
1511) #endif
1512)
1513) !#ifdef DEBUG_FLUXES
1514) ! if (debug_connection) then
1515) !! write(*,'(a,7es12.4)') 'in: ', adv_flux(:)*dist(1), diff_flux(:)*dist(1)
1516) ! write(*,'('' phase: gas'')')
1517) ! write(*,'('' pressure :'',2es12.4)') gen_auxvar_up%pres(2), gen_auxvar_dn%pres(2)
1518) ! write(*,'('' saturation :'',2es12.4)') gen_auxvar_up%sat(2), gen_auxvar_dn%sat(2)
1519) ! write(*,'('' water --'')')
1520) ! write(*,'('' darcy flux:'',es12.4)') adv_flux(1,2)
1521) ! write(*,'('' xmol :'',2es12.4)') gen_auxvar_up%xmol(1,2), gen_auxvar_dn%xmol(1,2)
1522) ! write(*,'('' diff flux :'',es12.4)') diff_flux(1,2)
1523) ! write(*,'('' air --'')')
1524) ! write(*,'('' darcy flux:'',es12.4)') adv_flux(2,2)
1525) ! write(*,'('' xmol :'',2es12.4)') gen_auxvar_up%xmol(2,2), gen_auxvar_dn%xmol(2,2)
1526) ! write(*,'('' diff flux :'',es12.4)') diff_flux(2,2)
1527) ! write(*,'('' heat flux :'',es12.4)') (adv_flux(3,2) + heat_flux)*1.d6
1528) ! write(*,'('' phase: liquid'')')
1529) ! write(*,'('' pressure :'',2es12.4)') gen_auxvar_up%pres(1), gen_auxvar_dn%pres(1)
1530) ! write(*,'('' saturation :'',2es12.4)') gen_auxvar_up%sat(1), gen_auxvar_dn%sat(1)
1531) ! write(*,'('' water --'')')
1532) ! write(*,'('' darcy flux:'',es12.4)') adv_flux(1,1)
1533) ! write(*,'('' xmol :'',2es12.4)') gen_auxvar_up%xmol(1,1), gen_auxvar_dn%xmol(1,1)
1534) ! write(*,'('' diff flux :'',es12.4)') diff_flux(1,1)
1535) ! write(*,'('' air --'')')
1536) ! write(*,'('' darcy flux:'',es12.4)') adv_flux(2,1)
1537) ! write(*,'('' xmol :'',2es12.4)') gen_auxvar_up%xmol(2,1), gen_auxvar_dn%xmol(2,1)
1538) ! write(*,'('' diff flux :'',es12.4)') diff_flux(2,1)
1539) ! write(*,'('' heat flux :'',es12.4)') (adv_flux(3,1) + heat_flux)*1.d6
1540) ! endif
1541) !#endif
1542)
1543) !#ifdef DEBUG_GENERAL_FILEOUTPUT
1544) ! debug_flux(energy_id,1) = debug_flux(energy_id,1) + heat_flux
1545) ! if (debug_flag > 0) then
1546) ! write(debug_unit,'(a,7es24.15)') 'dif flux (liquid):', debug_flux(:,1)
1547) ! write(debug_unit,'(a,7es24.15)') 'dif flux (gas):', debug_flux(:,2)
1548) ! endif
1549) !#endif
1550)
1551) end subroutine TOilImsFlux
1552)
1553) ! ************************************************************************** !
1554)
1555) subroutine TOilImsBCFlux(ibndtype,auxvar_mapping,auxvars, &
1556) toil_auxvar_up,global_auxvar_up, &
1557) toil_auxvar_dn,global_auxvar_dn, &
1558) material_auxvar_dn, &
1559) sir_dn, &
1560) thermal_conductivity_dn, &
1561) area,dist,toil_parameter, &
1562) option,v_darcy,Res)
1563) !
1564) ! Computes the boundary flux terms for the residual
1565) !
1566) ! Author: Paolo Orsini
1567) ! Date: 10/27/15
1568) !
1569) use Option_module
1570) use Material_Aux_class
1571) !use Fracture_module
1572) !use Klinkenberg_module
1573)
1574) implicit none
1575)
1576) type(toil_ims_auxvar_type) :: toil_auxvar_up, toil_auxvar_dn
1577) type(global_auxvar_type) :: global_auxvar_up, global_auxvar_dn
1578) class(material_auxvar_type) :: material_auxvar_dn
1579) type(option_type) :: option
1580) PetscReal :: sir_dn(:)
1581) PetscReal :: auxvars(:) ! from aux_real_var array
1582) PetscReal :: v_darcy(option%nphase), area
1583) type(toil_ims_parameter_type) :: toil_parameter
1584) PetscReal :: dist(-1:3)
1585) PetscReal :: Res(1:option%nflowdof)
1586) PetscInt :: ibndtype(1:option%nflowdof)
1587) PetscInt :: auxvar_mapping(TOIL_IMS_MAX_INDEX)
1588) PetscReal :: thermal_conductivity_dn(2)
1589) !PetscBool :: debug_connection
1590)
1591) PetscInt :: energy_id
1592) PetscInt :: iphase
1593) PetscInt :: bc_type
1594) PetscReal :: density_ave, density_kg_ave
1595) PetscReal :: H_ave, uH
1596) PetscReal :: perm_dn_adj(option%nphase)
1597) PetscReal :: perm_ave_over_dist
1598) PetscReal :: dist_gravity
1599) PetscReal :: delta_pressure, delta_temp
1600) PetscReal :: gravity_term
1601) PetscReal :: mobility, mole_flux, q
1602) PetscReal :: sat_dn, perm_dn, den_dn
1603) PetscReal :: temp_ave, stpd_ave_over_dist, pres_ave
1604) PetscReal :: k_eff_up, k_eff_dn, k_eff_ave, heat_flux
1605) ! for debugging only
1606) PetscReal :: adv_flux(3,2), diff_flux(2,2)
1607) PetscReal :: debug_flux(3,3), debug_dphi(2)
1608)
1609) PetscReal :: boundary_pressure
1610) PetscReal :: tempreal
1611)
1612) PetscInt :: idof
1613) PetscBool :: neumann_bc_present
1614)
1615) PetscReal :: dummy_perm_dn
1616)
1617) energy_id = option%energy_id
1618)
1619) Res = 0.d0
1620) v_darcy = 0.d0
1621)
1622) !#ifdef DEBUG_FLUXES
1623) ! adv_flux = 0.d0
1624) ! diff_flux = 0.d0
1625) !#endif
1626) !#ifdef DEBUG_GENERAL_FILEOUTPUT
1627) ! debug_flux = 0.d0
1628) ! debug_dphi = 0.d0
1629) !#endif
1630)
1631) neumann_bc_present = PETSC_FALSE
1632)
1633) call material_auxvar_dn%PermeabilityTensorToScalar(dist,perm_dn)
1634)
1635) ! currently no fractures considered
1636) ! Fracture permeability change only available for structured grid (Heeho)
1637) !if (associated(material_auxvar_dn%fracture)) then
1638) ! call FracturePermEvaluate(material_auxvar_dn,perm_dn,perm_dn, &
1639) ! dummy_perm_dn,dist)
1640) !endif
1641)
1642) !if (associated(klinkenberg)) then
1643) ! perm_dn_adj(1) = perm_dn
1644) !
1645) ! perm_dn_adj(2) = klinkenberg%Evaluate(perm_dn, &
1646) ! gen_auxvar_dn%pres(option%gas_phase))
1647) !else
1648) perm_dn_adj(:) = perm_dn
1649) !endif
1650)
1651) #ifdef TOIL_CONVECTION
1652) do iphase = 1, option%nphase
1653)
1654) bc_type = ibndtype(iphase) ! loop over equations 1.Liq and 2.Oil
1655) select case(bc_type)
1656) ! figure out the direction of flow
1657) case(DIRICHLET_BC,HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
1658)
1659) ! dist(0) = scalar - magnitude of distance
1660) ! gravity = vector(3)
1661) ! dist(1:3) = vector(3) - unit vector
1662) dist_gravity = dist(0) * dot_product(option%gravity,dist(1:3))
1663)
1664) if (bc_type == CONDUCTANCE_BC) then !not implemented yet
1665) select case(iphase)
1666) case(LIQUID_PHASE)
1667) idof = auxvar_mapping(TOIL_IMS_LIQ_CONDUCTANCE_INDEX)
1668) case(TOIL_IMS_OIL_PHASE)
1669) idof = auxvar_mapping(TOIL_IMS_OIL_CONDUCTANCE_INDEX)
1670) end select
1671) perm_ave_over_dist = auxvars(idof)
1672) else
1673) perm_ave_over_dist = perm_dn_adj(iphase) / dist(0)
1674) endif
1675)
1676) ! PO need to check what values of saturations are assigned to the BC ghost cells
1677) ! using residual saturation cannot be correct! - geh
1678) ! reusing sir_dn for bounary auxvar
1679) !#define BAD_MOVE1 ! this works
1680) !#ifndef BAD_MOVE1
1681) if (toil_auxvar_up%sat(iphase) > sir_dn(iphase) .or. &
1682) toil_auxvar_dn%sat(iphase) > sir_dn(iphase)) then
1683) !#endif
1684) boundary_pressure = toil_auxvar_up%pres(iphase)
1685)
1686) ! PO no free surfce boundaries considered
1687) !if (iphase == LIQUID_PHASE .and. &
1688) ! global_auxvar_up%istate == GAS_STATE) then
1689) ! ! the idea here is to accommodate a free surface boundary
1690) ! ! face. this will not work for an interior grid cell as
1691) ! ! there should be capillary pressure in force.
1692) ! boundary_pressure = gen_auxvar_up%pres(option%gas_phase)
1693) !endif
1694)
1695) !density_kg_ave = 0.5d0 * (toil_auxvar_up%den_kg(iphase) + &
1696) ! toil_auxvar_dn%den_kg(iphase) )
1697)
1698) density_kg_ave = TOilImsAverageDensity(toil_auxvar_up%sat(iphase), &
1699) toil_auxvar_dn%sat(iphase), &
1700) toil_auxvar_up%den_kg(iphase), &
1701) toil_auxvar_dn%den_kg(iphase))
1702)
1703) gravity_term = density_kg_ave * dist_gravity
1704) delta_pressure = boundary_pressure - &
1705) toil_auxvar_dn%pres(iphase) + &
1706) gravity_term
1707)
1708) !#ifdef DEBUG_GENERAL_FILEOUTPUT
1709) ! debug_dphi(iphase) = delta_pressure
1710) !#endif
1711) ! PO CONDUCTANCE_BC and SEEPAGE_BC not implemented
1712) if (bc_type == SEEPAGE_BC .or. &
1713) bc_type == CONDUCTANCE_BC) then
1714) ! flow in ! boundary cell is <= pref
1715) if (delta_pressure > 0.d0 .and. &
1716) toil_auxvar_up%pres(iphase) - &
1717) option%reference_pressure < eps) then
1718) delta_pressure = 0.d0
1719) endif
1720) endif
1721)
1722) !upwinding mobilities and enthalpies
1723) if (delta_pressure >= 0.D0) then
1724) mobility = toil_auxvar_up%mobility(iphase)
1725) uH = toil_auxvar_up%H(iphase)
1726) !density_ave = toil_auxvar_up%den(iphase)
1727) else
1728) mobility = toil_auxvar_dn%mobility(iphase)
1729) uH = toil_auxvar_dn%H(iphase)
1730) !density_ave = toil_auxvar_dn%den(iphase)
1731) endif
1732)
1733) if (mobility > floweps) then
1734) ! v_darcy[m/sec] = perm[m^2] / dist[m] * kr[-] / mu[Pa-sec]
1735) ! dP[Pa]]
1736) v_darcy(iphase) = perm_ave_over_dist * mobility * delta_pressure
1737) ! only need average density if velocity > 0.
1738)
1739) ! when this is commented - using upwinding value
1740) !density_ave = 0.5d0 * (toil_auxvar_up%den(iphase) + &
1741) ! toil_auxvar_dn%den(iphase) )
1742) density_ave = TOilImsAverageDensity(toil_auxvar_up%sat(iphase), &
1743) toil_auxvar_dn%sat(iphase), &
1744) toil_auxvar_up%den(iphase), &
1745) toil_auxvar_dn%den(iphase))
1746) endif
1747) !#ifndef BAD_MOVE1
1748) endif ! sat > eps
1749) !#endif
1750)
1751) case(NEUMANN_BC)
1752) select case(iphase)
1753) case(LIQUID_PHASE)
1754) idof = auxvar_mapping(TOIL_IMS_LIQUID_FLUX_INDEX)
1755) case(TOIL_IMS_OIL_PHASE)
1756) idof = auxvar_mapping(TOIL_IMS_OIL_FLUX_INDEX)
1757) end select
1758)
1759) neumann_bc_present = PETSC_TRUE
1760) if (dabs(auxvars(idof)) > floweps) then
1761) v_darcy(iphase) = auxvars(idof)
1762) if (v_darcy(iphase) > 0.d0) then
1763) density_ave = toil_auxvar_up%den(iphase)
1764) uH = toil_auxvar_up%H(iphase)
1765) else
1766) density_ave = toil_auxvar_dn%den(iphase)
1767) uH = toil_auxvar_dn%H(iphase)
1768) endif
1769) endif
1770) case default
1771) option%io_buffer = &
1772) 'Boundary condition type not recognized in GeneralBCFlux phase loop.'
1773) call printErrMsg(option)
1774) end select
1775)
1776) if (dabs(v_darcy(iphase)) > 0.d0) then
1777) ! q[m^3 phase/sec] = v_darcy[m/sec] * area[m^2]
1778) q = v_darcy(iphase) * area
1779) ! mole_flux[kmol phase/sec] = q[m^3 phase/sec] *
1780) ! density_ave[kmol phase/m^3 phase]
1781) mole_flux = q*density_ave
1782)
1783) ! Res[kmol total/sec]
1784) Res(iphase) = Res(iphase) + mole_flux
1785)
1786) ! Res[kmol total/sec]
1787) !do icomp = 1, option%nflowspec
1788) ! ! Res[kmol comp/sec] = mole_flux[kmol phase/sec] *
1789) ! ! xmol[kmol comp/mol phase]
1790) ! Res(icomp) = Res(icomp) + mole_flux * xmol(icomp)
1791) !enddo
1792) !#ifdef DEBUG_FLUXES
1793) ! do icomp = 1, option%nflowspec
1794) ! adv_flux(icomp,iphase) = adv_flux(icomp,iphase) + mole_flux * xmol(icomp)
1795) ! enddo
1796) !#endif
1797) !#ifdef DEBUG_GENERAL_FILEOUTPUT
1798) ! do icomp = 1, option%nflowspec
1799) ! debug_flux(icomp,iphase) = debug_flux(icomp,iphase) + mole_flux * xmol(icomp)
1800) ! enddo
1801) !#endif
1802) ! Res[MJ/sec] = mole_flux[kmol comp/sec] * H_ave[MJ/kmol comp]
1803) Res(energy_id) = Res(energy_id) + mole_flux * uH ! H_ave
1804) !#ifdef DEBUG_FLUXES
1805) ! adv_flux(energy_id,iphase) = adv_flux(energy_id,iphase) + mole_flux * uH
1806) !#endif
1807) !#ifdef DEBUG_GENERAL_FILEOUTPUT
1808) ! debug_flux(energy_id,iphase) = debug_flux(energy_id,iphase) + mole_flux * uH
1809) !#endif
1810) endif
1811) enddo
1812) #endif
1813) ! end of TOIL_CONVECTION
1814)
1815) !#ifdef DEBUG_GENERAL_FILEOUTPUT
1816) ! if (debug_flag > 0) then
1817) ! write(debug_unit,'(a,7es24.15)') 'bc delta pressure :', debug_dphi(:)
1818) ! write(debug_unit,'(a,7es24.15)') 'bc adv flux (liquid):', debug_flux(:,1)
1819) ! write(debug_unit,'(a,7es24.15)') 'bc adv flux (gas):', debug_flux(:,2)
1820) ! endif
1821) ! debug_flux = 0.d0
1822) !#endif
1823)
1824)
1825) #ifdef TOIL_CONDUCTION
1826) ! add heat conduction flux
1827) heat_flux = 0.d0
1828) select case (ibndtype(TOIL_IMS_ENERGY_EQUATION_INDEX))
1829) case (DIRICHLET_BC)
1830) ! based on Somerton et al., 1974:
1831) ! k_eff = k_dry + sqrt(s_l)*(k_sat-k_dry)
1832) !k_eff_dn = thermal_conductivity_dn(1) + &
1833) ! sqrt(gen_auxvar_dn%sat(option%liquid_phase)) * &
1834) ! (thermal_conductivity_dn(2) - thermal_conductivity_dn(1))
1835) ! considered the formation fully saturated in water for heat conduction
1836) k_eff_dn = thermal_conductivity_dn(1)
1837) ! units:
1838) ! k_eff = W/K/m/m = J/s/K/m/m
1839) ! delta_temp = K
1840) ! area = m^2
1841) ! heat_flux = J/s
1842) k_eff_ave = k_eff_dn / dist(0)
1843) delta_temp = toil_auxvar_up%temp - toil_auxvar_dn%temp
1844) heat_flux = k_eff_ave * delta_temp * area * 1.d-6 ! convert W -> MW
1845) case(NEUMANN_BC)
1846) ! flux prescribed as MW/m^2
1847) heat_flux = auxvars(auxvar_mapping(TOIL_IMS_ENERGY_FLUX_INDEX)) * area
1848) case(ZERO_GRADIENT_BC)
1849) ! No contribution to heat_flux
1850) case default
1851) option%io_buffer = 'Boundary condition type not recognized in ' // &
1852) 'TOilImsBCFlux heat conduction loop.'
1853) call printErrMsg(option)
1854) end select
1855) Res(energy_id) = Res(energy_id) + heat_flux ! MW
1856) #endif
1857) ! end of TOIL_CONDUCTION
1858)
1859) !#ifdef DEBUG_FLUXES
1860) ! if (debug_connection) then
1861) !! write(*,'(a,7es12.4)') 'in: ', adv_flux(:)*dist(1), diff_flux(:)*dist(1)
1862) ! write(*,'('' phase: gas'')')
1863) ! write(*,'('' pressure :'',2es12.4)') gen_auxvar_up%pres(2), gen_auxvar_dn%pres(2)
1864) ! write(*,'('' saturation :'',2es12.4)') gen_auxvar_up%sat(2), gen_auxvar_dn%sat(2)
1865) ! write(*,'('' water --'')')
1866) ! write(*,'('' darcy flux:'',es12.4)') adv_flux(1,2)
1867) ! write(*,'('' xmol :'',2es12.4)') gen_auxvar_up%xmol(1,2), gen_auxvar_dn%xmol(1,2)
1868) ! write(*,'('' diff flux :'',es12.4)') diff_flux(1,2)
1869) ! write(*,'('' air --'')')
1870) ! write(*,'('' darcy flux:'',es12.4)') adv_flux(2,2)
1871) ! write(*,'('' xmol :'',2es12.4)') gen_auxvar_up%xmol(2,2), gen_auxvar_dn%xmol(2,2)
1872) ! write(*,'('' diff flux :'',es12.4)') diff_flux(2,2)
1873) ! write(*,'('' heat flux :'',es12.4)') (adv_flux(3,2) + heat_flux)*1.d6
1874) ! write(*,'('' phase: liquid'')')
1875) ! write(*,'('' pressure :'',2es12.4)') gen_auxvar_up%pres(1), gen_auxvar_dn%pres(1)
1876) ! write(*,'('' saturation :'',2es12.4)') gen_auxvar_up%sat(1), gen_auxvar_dn%sat(1)
1877) ! write(*,'('' water --'')')
1878) ! write(*,'('' darcy flux:'',es12.4)') adv_flux(1,1)
1879) ! write(*,'('' xmol :'',2es12.4)') gen_auxvar_up%xmol(1,1), gen_auxvar_dn%xmol(1,1)
1880) ! write(*,'('' diff flux :'',es12.4)') diff_flux(1,1)
1881) ! write(*,'('' air --'')')
1882) ! write(*,'('' darcy flux:'',es12.4)') adv_flux(2,1)
1883) ! write(*,'('' xmol :'',2es12.4)') gen_auxvar_up%xmol(2,1), gen_auxvar_dn%xmol(2,1)
1884) ! write(*,'('' diff flux :'',es12.4)') diff_flux(2,1)
1885) ! write(*,'('' heat flux :'',es12.4)') (adv_flux(3,1) + heat_flux)*1.d6
1886) ! endif
1887) !#endif
1888)
1889) !#ifdef DEBUG_GENERAL_FILEOUTPUT
1890) ! debug_flux(energy_id,1) = debug_flux(energy_id,1) + heat_flux
1891) ! if (debug_flag > 0) then
1892) ! write(debug_unit,'(a,7es24.15)') 'bc dif flux (liquid):', debug_flux(:,1)*dist(3)
1893) ! write(debug_unit,'(a,7es24.15)') 'bc dif flux (gas):', debug_flux(:,2)*dist(3)
1894) ! endif
1895) !#endif
1896)
1897) end subroutine TOilImsBCFlux
1898)
1899) ! ************************************************************************** !
1900)
1901) subroutine TOilImsSrcSink(option,src_sink_condition, toil_auxvar, &
1902) global_auxvar,ss_flow_vol_flux,scale,Res)
1903) !
1904) ! Computes the source/sink terms for the residual
1905) !
1906) ! Author: Paolo Orsini
1907) ! Date: 11/04/15
1908) !
1909)
1910) use Option_module
1911) use Condition_module
1912)
1913) use EOS_Water_module
1914) use EOS_Oil_module
1915)
1916) implicit none
1917)
1918) type(option_type) :: option
1919) type(flow_toil_ims_condition_type), pointer :: src_sink_condition
1920) type(toil_ims_auxvar_type) :: toil_auxvar
1921) type(global_auxvar_type) :: global_auxvar !keep global_auxvar for salinity
1922) PetscReal :: ss_flow_vol_flux(option%nphase)
1923) PetscReal :: scale
1924) PetscReal :: Res(option%nflowdof)
1925)
1926) ! local parameter
1927) PetscInt, parameter :: SRC_TEMPERATURE = 1
1928) PetscInt, parameter :: SRC_ENTHALPY = 2
1929) ! local variables
1930) PetscReal, pointer :: qsrc(:)
1931) PetscInt :: flow_src_sink_type
1932) PetscReal :: qsrc_mol
1933) PetscReal :: den, den_kg, enthalpy, internal_energy, temperature
1934) PetscReal :: cell_pressure, dummy_pressure
1935) PetscInt :: iphase
1936) PetscInt :: energy_var
1937) PetscErrorCode :: ierr
1938)
1939) ! this can be removed when etxending to pressure condition
1940) if (.not.associated(src_sink_condition%rate) ) then
1941) option%io_buffer = 'TOilImsSrcSink fow condition rate not defined ' // &
1942) 'rate is needed for a valid src/sink term'
1943) call printErrMsg(option)
1944) end if
1945)
1946) !qsrc => src_sink_condition%rate%dataset%rarray(:)
1947) qsrc => src_sink_condition%rate%dataset%rarray
1948)
1949) energy_var = 0
1950) if ( associated(src_sink_condition%temperature) ) then
1951) energy_var = SRC_TEMPERATURE
1952) else if ( associated(src_sink_condition%enthalpy) ) then
1953) energy_var = SRC_ENTHALPY
1954) end if
1955)
1956) flow_src_sink_type = src_sink_condition%rate%itype
1957)
1958) ! checks that qsrc(liquid_phase) and qsrc(oil_phase)
1959) ! do not have different signs
1960) if ( (qsrc(option%liquid_phase)>0.0d0 .and. qsrc(option%oil_phase)<0.d0).or.&
1961) (qsrc(option%liquid_phase)<0.0d0 .and. qsrc(option%oil_phase)>0.d0) &
1962) ) then
1963) option%io_buffer = "TOilImsSrcSink error: " // &
1964) "src(wat) and src(oil) with opposite sign"
1965) call printErrMsg(option)
1966) end if
1967)
1968) ! approximates BHP with local pressure
1969) ! to compute BHP we need to solve an IPR equation
1970) if ( ( (flow_src_sink_type == VOLUMETRIC_RATE_SS) .or. &
1971) ( associated(src_sink_condition%temperature) ) &
1972) ) .and. &
1973) ( (qsrc(option%liquid_phase) > 0.d0).or. &
1974) (qsrc(option%oil_phase) > 0.d0) &
1975) ) &
1976) ) then
1977) cell_pressure = &
1978) maxval(toil_auxvar%pres(option%liquid_phase:option%oil_phase))
1979) end if
1980)
1981) ! if enthalpy is used to define enthelpy or energy rate is used
1982) ! approximate bottom hole temperature (BHT) with local temp
1983) if ( energy_var == SRC_TEMPERATURE) then
1984) temperature = src_sink_condition%temperature%dataset%rarray(1)
1985) else
1986) temperature = toil_auxvar%temp
1987) end if
1988)
1989)
1990) Res = 0.d0
1991) do iphase = 1, option%nphase
1992) qsrc_mol = 0.d0
1993) if ( qsrc(iphase) > 0.d0) then
1994) select case(iphase)
1995) case(LIQUID_PHASE)
1996) call EOSWaterDensity(temperature,cell_pressure,den_kg,den,ierr)
1997) case(TOIL_IMS_OIL_PHASE)
1998) call EOSOilDensity(temperature,cell_pressure,den,ierr)
1999) end select
2000) else
2001) den = toil_auxvar%den(iphase)
2002) end if
2003)
2004) select case(flow_src_sink_type)
2005) ! injection and production
2006) case(MASS_RATE_SS)
2007) qsrc_mol = qsrc(iphase)/toil_ims_fmw_comp(iphase) ! kg/sec -> kmol/sec
2008) case(SCALED_MASS_RATE_SS) ! kg/sec -> kmol/sec
2009) qsrc_mol = qsrc(iphase)/toil_ims_fmw_comp(iphase)*scale
2010) case(VOLUMETRIC_RATE_SS) ! assume local density for now
2011) ! qsrc(iphase) = m^3/sec
2012) qsrc_mol = qsrc(iphase)*den ! den = kmol/m^3
2013) case(SCALED_VOLUMETRIC_RATE_SS) ! assume local density for now
2014) ! qsrc1 = m^3/sec ! den = kmol/m^3
2015) qsrc_mol = qsrc(iphase)* den * scale
2016) !qsrc_mol = qsrc(iphase)*gen_auxvar%den(iphase)*scale
2017) end select
2018) ss_flow_vol_flux(iphase) = qsrc_mol/ den
2019) Res(iphase) = qsrc_mol
2020) enddo
2021)
2022) ! when using scaled src/sinks, the rates (marr or vol) scaling
2023) ! at this point the scale factor is already included in Res(iphase)
2024)
2025) ! Res(option%energy_id), energy units: MJ/sec
2026)
2027) if ( associated(src_sink_condition%temperature) .or. &
2028) associated(src_sink_condition%enthalpy) &
2029) ) then
2030) ! if injection compute local pressure that will be used as BHP
2031) ! approximation used to overcome the solution of an IPR
2032) !if ( qsrc(option%liquid_phase)>0.d0 .or.
2033) ! qsrc(option%oil_phase)>0.d0 ) then
2034) ! cell_pressure = &
2035) ! maxval(toil_auxvar%pres(option%liquid_phase:option%oil_phase))
2036) !end if
2037) ! water injection
2038) if (qsrc(option%liquid_phase) > 0.d0) then !implies qsrc(option%oil_phase)>=0
2039) if ( energy_var == SRC_TEMPERATURE ) then
2040) call EOSWaterDensity(src_sink_condition%temperature% &
2041) dataset%rarray(1), cell_pressure, &
2042) den_kg,den,ierr)
2043) call EOSWaterEnthalpy(src_sink_condition%temperature% &
2044) dataset%rarray(1), cell_pressure, &
2045) enthalpy,ierr)
2046) ! enthalpy = [J/kmol]
2047) else if ( energy_var == SRC_ENTHALPY ) then
2048) !input as J/kg
2049) enthalpy = src_sink_condition%enthalpy% &
2050) dataset%rarray(option%liquid_phase)
2051) ! J/kg * kg/kmol = J/kmol
2052) enthalpy = enthalpy * toil_ims_fmw_comp(option%liquid_phase)
2053) end if
2054) enthalpy = enthalpy * 1.d-6 ! J/kmol -> whatever units
2055) ! enthalpy units: MJ/kmol ! water component mass
2056) Res(option%energy_id) = Res(option%energy_id) + &
2057) Res(option%liquid_phase) * enthalpy
2058) end if
2059) ! oil injection
2060) if (qsrc(option%oil_phase) > 0.d0) then !implies qsrc(option%liquid_phase)>=0
2061) if ( energy_var == SRC_TEMPERATURE ) then
2062) call EOSOilEnthalpy(src_sink_condition%temperature%dataset%rarray(1), &
2063) cell_pressure, enthalpy, ierr)
2064) ! enthalpy = [J/kmol]
2065) else if ( energy_var == SRC_ENTHALPY ) then
2066) enthalpy = src_sink_condition%enthalpy% &
2067) dataset%rarray(option%oil_phase)
2068) !J/kg * kg/kmol = J/kmol
2069) enthalpy = enthalpy * toil_ims_fmw_comp(option%oil_phase)
2070) end if
2071) enthalpy = enthalpy * 1.d-6 ! J/kmol -> whatever units
2072) ! enthalpy units: MJ/kmol ! oil component mass
2073) Res(option%energy_id) = Res(option%energy_id) + &
2074) Res(option%oil_phase) * enthalpy
2075) end if
2076) ! water energy extraction due to water production
2077) if (qsrc(option%liquid_phase) < 0.d0) then !implies qsrc(option%oil_phase)<=0
2078) ! auxvar enthalpy units: MJ/kmol ! water component mass
2079) Res(option%energy_id) = Res(option%energy_id) + &
2080) Res(option%liquid_phase) * &
2081) toil_auxvar%H(option%liquid_phase)
2082) end if
2083) !oil energy extraction due to oil production
2084) if (qsrc(option%oil_phase) < 0.d0) then !implies qsrc(option%liquid_phase)<=0
2085) ! auxvar enthalpy units: MJ/kmol ! water component mass
2086) Res(option%energy_id) = Res(option%energy_id) + &
2087) Res(option%oil_phase) * &
2088) toil_auxvar%H(option%oil_phase)
2089) end if
2090)
2091) else !if not temp or enthalpy are given
2092) ! if energy rate is given, loaded in qsrc(3) in MJ/sec
2093) Res(option%energy_id) = qsrc(THREE_INTEGER)* scale ! MJ/s
2094) end if
2095)
2096)
2097) nullify(qsrc)
2098)
2099) end subroutine TOilImsSrcSink
2100)
2101) ! ************************************************************************** !
2102)
2103) subroutine TOilImsAccumDerivative(toil_auxvar,material_auxvar, &
2104) soil_heat_capacity,option,J)
2105) !
2106) ! Computes derivatives of the accumulation
2107) ! term for the Jacobian
2108) !
2109) ! Author: Paolo Orsini
2110) ! Date: 11/06/15
2111) !
2112)
2113) use Option_module
2114) use Saturation_Function_module
2115) use Material_Aux_class
2116)
2117) implicit none
2118)
2119) type(toil_ims_auxvar_type) :: toil_auxvar(0:)
2120) class(material_auxvar_type) :: material_auxvar
2121) type(option_type) :: option
2122) PetscReal :: soil_heat_capacity
2123) PetscReal :: J(option%nflowdof,option%nflowdof)
2124)
2125) PetscReal :: res(option%nflowdof), res_pert(option%nflowdof)
2126) PetscInt :: idof, irow
2127)
2128) !print *, 'ToilImsAccumDerivative'
2129)
2130) call TOilImsAccumulation(toil_auxvar(ZERO_INTEGER), &
2131) material_auxvar,soil_heat_capacity,option,Res)
2132)
2133) do idof = 1, option%nflowdof
2134) call TOilImsAccumulation(toil_auxvar(idof), &
2135) material_auxvar,soil_heat_capacity,option,res_pert)
2136) do irow = 1, option%nflowdof
2137) J(irow,idof) = (res_pert(irow)-res(irow))/toil_auxvar(idof)%pert
2138) !print *, irow, idof, J(irow,idof), toil_auxvar(idof)%pert
2139) enddo !irow
2140) enddo ! idof
2141)
2142) if (toil_ims_isothermal) then
2143) J(TOIL_IMS_ENERGY_EQUATION_INDEX,:) = 0.d0
2144) J(:,TOIL_IMS_ENERGY_EQUATION_INDEX) = 0.d0
2145) endif
2146)
2147) !#ifdef DEBUG_GENERAL_FILEOUTPUT
2148) ! if (debug_flag > 0) then
2149) ! write(debug_unit,'(a,10es24.15)') 'accum deriv:', J
2150) ! endif
2151) !#endif
2152)
2153) end subroutine TOilImsAccumDerivative
2154)
2155) ! ************************************************************************** !
2156)
2157) subroutine ToilImsFluxDerivative(toil_auxvar_up,global_auxvar_up, &
2158) material_auxvar_up, &
2159) sir_up, &
2160) thermal_conductivity_up, &
2161) toil_auxvar_dn,global_auxvar_dn, &
2162) material_auxvar_dn, &
2163) sir_dn, &
2164) thermal_conductivity_dn, &
2165) area, dist, &
2166) toil_parameter, &
2167) option,Jup,Jdn)
2168) !
2169) ! Computes the derivatives of the internal flux terms
2170) ! for the Jacobian
2171) !
2172) ! Author: Paolo Orsini
2173) ! Date: 11/06/15
2174) !
2175) use Option_module
2176) use Material_Aux_class
2177)
2178) implicit none
2179)
2180) type(toil_ims_auxvar_type) :: toil_auxvar_up(0:), toil_auxvar_dn(0:)
2181) type(global_auxvar_type) :: global_auxvar_up, global_auxvar_dn
2182) class(material_auxvar_type) :: material_auxvar_up, material_auxvar_dn
2183) type(option_type) :: option
2184) PetscReal :: sir_up(:), sir_dn(:)
2185) PetscReal :: thermal_conductivity_dn(2)
2186) PetscReal :: thermal_conductivity_up(2)
2187) PetscReal :: area
2188) PetscReal :: dist(-1:3)
2189) type(toil_ims_parameter_type) :: toil_parameter
2190) PetscReal :: Jup(option%nflowdof,option%nflowdof), Jdn(option%nflowdof,option%nflowdof)
2191)
2192) PetscReal :: v_darcy(option%nphase)
2193) PetscReal :: res(option%nflowdof), res_pert(option%nflowdof)
2194) PetscInt :: idof, irow
2195)
2196) Jup = 0.d0
2197) Jdn = 0.d0
2198)
2199) !geh:print *, 'ToilImsFluxDerivative'
2200) option%iflag = -2
2201) call ToilImsFlux(toil_auxvar_up(ZERO_INTEGER),global_auxvar_up, &
2202) material_auxvar_up,sir_up, &
2203) thermal_conductivity_up, &
2204) toil_auxvar_dn(ZERO_INTEGER),global_auxvar_dn, &
2205) material_auxvar_dn,sir_dn, &
2206) thermal_conductivity_dn, &
2207) area,dist,toil_parameter, &
2208) option,v_darcy,res)
2209)
2210) ! upgradient derivatives
2211) do idof = 1, option%nflowdof
2212) call ToilImsFlux(toil_auxvar_up(idof),global_auxvar_up, &
2213) material_auxvar_up,sir_up, &
2214) thermal_conductivity_up, &
2215) toil_auxvar_dn(ZERO_INTEGER),global_auxvar_dn, &
2216) material_auxvar_dn,sir_dn, &
2217) thermal_conductivity_dn, &
2218) area,dist,toil_parameter, &
2219) option,v_darcy,res_pert)
2220) do irow = 1, option%nflowdof
2221) Jup(irow,idof) = (res_pert(irow)-res(irow))/toil_auxvar_up(idof)%pert
2222) !print *, 'up: ', irow, idof, Jup(irow,idof), toil_auxvar_up(idof)%pert
2223) enddo !irow
2224) enddo ! idof
2225)
2226) ! downgradient derivatives
2227) do idof = 1, option%nflowdof
2228) call ToilImsFlux(toil_auxvar_up(ZERO_INTEGER),global_auxvar_up, &
2229) material_auxvar_up,sir_up, &
2230) thermal_conductivity_up, &
2231) toil_auxvar_dn(idof),global_auxvar_dn, &
2232) material_auxvar_dn,sir_dn, &
2233) thermal_conductivity_dn, &
2234) area,dist,toil_parameter, &
2235) option,v_darcy,res_pert)
2236) do irow = 1, option%nflowdof
2237) Jdn(irow,idof) = (res_pert(irow)-res(irow))/toil_auxvar_dn(idof)%pert
2238) !geh:print *, 'dn: ', irow, idof, Jdn(irow,idof), gen_auxvar_dn(idof)%pert
2239) enddo !irow
2240) enddo ! idof
2241)
2242) if (toil_ims_isothermal) then
2243) Jup(TOIL_IMS_ENERGY_EQUATION_INDEX,:) = 0.d0
2244) Jup(:,TOIL_IMS_ENERGY_EQUATION_INDEX) = 0.d0
2245) Jdn(TOIL_IMS_ENERGY_EQUATION_INDEX,:) = 0.d0
2246) Jdn(:,TOIL_IMS_ENERGY_EQUATION_INDEX) = 0.d0
2247) endif
2248)
2249)
2250) !#ifdef DEBUG_GENERAL_FILEOUTPUT
2251) ! if (debug_flag > 0) then
2252) ! write(debug_unit,'(a,20es24.15)') 'flux deriv:', Jup, Jdn
2253) ! endif
2254) !#endif
2255)
2256) end subroutine ToilImsFluxDerivative
2257)
2258) ! ************************************************************************** !
2259)
2260) subroutine ToilImsBCFluxDerivative(ibndtype,auxvar_mapping,auxvars, &
2261) toil_auxvar_up, &
2262) global_auxvar_up, &
2263) toil_auxvar_dn,global_auxvar_dn, &
2264) material_auxvar_dn, &
2265) sir_dn, &
2266) thermal_conductivity_dn, &
2267) area,dist,toil_parameter, &
2268) option,Jdn)
2269) !
2270) ! Computes the derivatives of the boundary flux terms
2271) ! for the Jacobian
2272) !
2273) ! Author: Paolo Orsini
2274) ! Date: 11/06/15
2275) !
2276)
2277) use Option_module
2278) use Material_Aux_class
2279)
2280) implicit none
2281)
2282) PetscReal :: auxvars(:) ! from aux_real_var array
2283) type(toil_ims_auxvar_type) :: toil_auxvar_up, toil_auxvar_dn(0:)
2284) type(global_auxvar_type) :: global_auxvar_up, global_auxvar_dn
2285) class(material_auxvar_type) :: material_auxvar_dn
2286) type(option_type) :: option
2287) PetscReal :: sir_dn(:)
2288) PetscReal :: area
2289) PetscReal :: dist(-1:3)
2290) type(toil_ims_parameter_type) :: toil_parameter
2291) PetscReal :: Jdn(option%nflowdof,option%nflowdof)
2292) PetscInt :: ibndtype(1:option%nflowdof)
2293) PetscInt :: auxvar_mapping(TOIL_IMS_MAX_INDEX)
2294) PetscReal :: thermal_conductivity_dn(2)
2295)
2296) PetscReal :: v_darcy(option%nphase)
2297) PetscReal :: res(option%nflowdof), res_pert(option%nflowdof)
2298) PetscInt :: idof, irow
2299)
2300) Jdn = 0.d0
2301) !geh:print *, 'GeneralBCFluxDerivative'
2302)
2303) option%iflag = -2
2304) call ToilImsBCFlux(ibndtype,auxvar_mapping,auxvars, &
2305) toil_auxvar_up,global_auxvar_up, &
2306) toil_auxvar_dn(ZERO_INTEGER),global_auxvar_dn, &
2307) material_auxvar_dn, &
2308) sir_dn, &
2309) thermal_conductivity_dn, &
2310) area,dist,toil_parameter, &
2311) option,v_darcy,res)
2312) ! downgradient derivatives
2313) do idof = 1, option%nflowdof
2314) call ToilImsBCFlux(ibndtype,auxvar_mapping,auxvars, &
2315) toil_auxvar_up,global_auxvar_up, &
2316) toil_auxvar_dn(idof),global_auxvar_dn, &
2317) material_auxvar_dn, &
2318) sir_dn, &
2319) thermal_conductivity_dn, &
2320) area,dist,toil_parameter, &
2321) option,v_darcy,res_pert)
2322) do irow = 1, option%nflowdof
2323) Jdn(irow,idof) = (res_pert(irow)-res(irow))/toil_auxvar_dn(idof)%pert
2324) !print *, 'bc: ', irow, idof, Jdn(irow,idof), gen_auxvar_dn(idof)%pert
2325) enddo !irow
2326) enddo ! idof
2327)
2328) if (toil_ims_isothermal) then
2329) Jdn(TOIL_IMS_ENERGY_EQUATION_INDEX,:) = 0.d0
2330) Jdn(:,TOIL_IMS_ENERGY_EQUATION_INDEX) = 0.d0
2331) endif
2332)
2333)
2334) !#ifdef DEBUG_GENERAL_FILEOUTPUT
2335) ! if (debug_flag > 0) then
2336) ! write(debug_unit,'(a,10es24.15)') 'bc flux deriv:', Jdn
2337) ! endif
2338) !#endif
2339)
2340) end subroutine ToilImsBCFluxDerivative
2341)
2342)
2343) ! ************************************************************************** !
2344)
2345) subroutine ToilImsSrcSinkDerivative(option,src_sink_condition, toil_auxvar, &
2346) global_auxvar,scale,Jac)
2347) !
2348) ! Computes the source/sink terms for the residual
2349) !
2350) ! Author: Paolo Orsini
2351) ! Date: 11/06/15
2352) !
2353)
2354) use Option_module
2355) use Condition_module
2356)
2357) implicit none
2358)
2359) type(option_type) :: option
2360) type(flow_toil_ims_condition_type), pointer :: src_sink_condition
2361) type(toil_ims_auxvar_type) :: toil_auxvar(0:)
2362) type(global_auxvar_type) :: global_auxvar
2363) PetscReal :: scale
2364) PetscReal :: Jac(option%nflowdof,option%nflowdof)
2365)
2366) PetscReal :: res(option%nflowdof), res_pert(option%nflowdof)
2367) PetscReal :: dummy_real(option%nphase)
2368) PetscInt :: idof, irow
2369)
2370) option%iflag = -3
2371)
2372) call TOilImsSrcSink(option,src_sink_condition,toil_auxvar(ZERO_INTEGER), &
2373) global_auxvar,dummy_real,scale,Res)
2374)
2375) ! downgradient derivatives
2376) do idof = 1, option%nflowdof
2377)
2378) call TOilImsSrcSink(option,src_sink_condition,toil_auxvar(idof), &
2379) global_auxvar,dummy_real,scale,res_pert)
2380)
2381) do irow = 1, option%nflowdof
2382) Jac(irow,idof) = (res_pert(irow)-res(irow))/toil_auxvar(idof)%pert
2383) enddo !irow
2384) enddo ! idof
2385)
2386) if (toil_ims_isothermal) then
2387) Jac(TOIL_IMS_ENERGY_EQUATION_INDEX,:) = 0.d0
2388) Jac(:,TOIL_IMS_ENERGY_EQUATION_INDEX) = 0.d0
2389) endif
2390)
2391) !#ifdef DEBUG_GENERAL_FILEOUTPUT
2392) ! if (debug_flag > 0) then
2393) ! write(debug_unit,'(a,20es24.15)') 'src/sink deriv:', Jac
2394) ! endif
2395) !#endif
2396)
2397) end subroutine ToilImsSrcSinkDerivative
2398)
2399) ! ************************************************************************** !
2400)
2401) subroutine TOilImsResidual(snes,xx,r,realization,ierr)
2402) !
2403) ! Computes the residual equation
2404) !
2405) ! Author: Paolo Orsini (OGS)
2406) ! Date: 11/05/15
2407) !
2408)
2409) use Realization_Subsurface_class
2410) use Field_module
2411) use Patch_module
2412) use Discretization_module
2413) use Option_module
2414)
2415) use Connection_module
2416) use Grid_module
2417) use Coupler_module
2418) use Debug_module
2419) use Material_Aux_class
2420)
2421) !#define DEBUG_WITH_TECPLOT
2422) #ifdef DEBUG_WITH_TECPLOT
2423) use Output_Tecplot_module
2424) #endif
2425)
2426) implicit none
2427)
2428) SNES :: snes
2429) Vec :: xx
2430) Vec :: r
2431) type(realization_subsurface_type) :: realization
2432) PetscViewer :: viewer
2433) PetscErrorCode :: ierr
2434)
2435) Mat, parameter :: null_mat = 0
2436) type(discretization_type), pointer :: discretization
2437) type(grid_type), pointer :: grid
2438) type(patch_type), pointer :: patch
2439) type(option_type), pointer :: option
2440) type(field_type), pointer :: field
2441) type(coupler_type), pointer :: boundary_condition
2442) type(coupler_type), pointer :: source_sink
2443) type(material_parameter_type), pointer :: material_parameter
2444)
2445) type(toil_ims_parameter_type), pointer :: toil_parameter
2446)
2447)
2448) type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:), toil_auxvars_bc(:)
2449) type(global_auxvar_type), pointer :: global_auxvars(:)
2450) type(global_auxvar_type), pointer :: global_auxvars_bc(:)
2451) type(global_auxvar_type), pointer :: global_auxvars_ss(:)
2452) class(material_auxvar_type), pointer :: material_auxvars(:)
2453) type(connection_set_list_type), pointer :: connection_set_list
2454) type(connection_set_type), pointer :: cur_connection_set
2455)
2456) PetscInt :: iconn
2457)
2458) !PetscInt :: iphase
2459)
2460) PetscReal :: scale
2461) PetscReal :: ss_flow_vol_flux(realization%option%nphase)
2462)
2463) PetscInt :: sum_connection
2464) PetscInt :: local_start, local_end
2465) PetscInt :: local_id, ghosted_id
2466) PetscInt :: local_id_up, local_id_dn, ghosted_id_up, ghosted_id_dn
2467) PetscInt :: i, imat, imat_up, imat_dn
2468) PetscInt, save :: iplot = 0
2469)
2470) PetscReal, pointer :: r_p(:)
2471) PetscReal, pointer :: accum_p(:), accum_p2(:)
2472)
2473) character(len=MAXSTRINGLENGTH) :: string
2474) character(len=MAXWORDLENGTH) :: word
2475)
2476) PetscInt :: icap_up, icap_dn
2477) PetscReal :: Res(realization%option%nflowdof)
2478) PetscReal :: v_darcy(realization%option%nphase)
2479)
2480) discretization => realization%discretization
2481) option => realization%option
2482) patch => realization%patch
2483) grid => patch%grid
2484) field => realization%field
2485) material_parameter => patch%aux%Material%material_parameter
2486) toil_auxvars => patch%aux%TOil_ims%auxvars
2487) toil_auxvars_bc => patch%aux%TOil_ims%auxvars_bc
2488)
2489) ! for toil_ims specific paramters - currently not used
2490) toil_parameter => patch%aux%Toil_ims%parameter
2491)
2492) global_auxvars => patch%aux%Global%auxvars
2493) global_auxvars_bc => patch%aux%Global%auxvars_bc
2494) global_auxvars_ss => patch%aux%Global%auxvars_ss
2495) material_auxvars => patch%aux%Material%auxvars
2496)
2497) ! Communication -----------------------------------------
2498) ! These 3 must be called before GeneralUpdateAuxVars()
2499) call DiscretizationGlobalToLocal(discretization,xx,field%flow_xx_loc,NFLOWDOF)
2500)
2501) call TOilImsUpdateAuxVars(realization)
2502)
2503) ! override flags since they will soon be out of date
2504) patch%aux%TOil_ims%auxvars_up_to_date = PETSC_FALSE
2505)
2506) ! always assume variables have been swapped; therefore, must copy back
2507) ! PO check when copied at the end of iteration - this copy might not
2508) ! be needed
2509) call VecLockPop(xx,ierr); CHKERRQ(ierr) !unlock vector from writing
2510) call DiscretizationLocalToGlobal(discretization,field%flow_xx_loc,xx, &
2511) NFLOWDOF)
2512) call VecLockPush(xx,ierr); CHKERRQ(ierr) ! block vector from writing
2513)
2514) if (option%compute_mass_balance_new) then
2515) call TOilImsZeroMassBalanceDelta(realization)
2516) endif
2517)
2518) option%iflag = 1
2519) ! now assign access pointer to local variables
2520) call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
2521)
2522) ! Accumulation terms ------------------------------------
2523) ! accumulation at t(k) (doesn't change during Newton iteration)
2524) call VecGetArrayReadF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
2525) r_p = -accum_p
2526)
2527)
2528) !Heeho dynamically update p+1 accumulation term
2529) if (toil_ims_tough2_conv_criteria) then
2530) call VecGetArrayReadF90(field%flow_accum2, accum_p2, ierr);CHKERRQ(ierr)
2531) endif
2532)
2533) ! accumulation at t(k+1)
2534) do local_id = 1, grid%nlmax ! For each local node do...
2535) ghosted_id = grid%nL2G(local_id)
2536) !geh - Ignore inactive cells with inactive materials
2537) imat = patch%imat(ghosted_id)
2538) if (imat <= 0) cycle
2539) local_end = local_id * option%nflowdof
2540) local_start = local_end - option%nflowdof + 1
2541) call TOilImsAccumulation(toil_auxvars(ZERO_INTEGER,ghosted_id), &
2542) material_auxvars(ghosted_id), &
2543) material_parameter%soil_heat_capacity(imat), &
2544) option,Res)
2545) r_p(local_start:local_end) = r_p(local_start:local_end) + Res(:)
2546)
2547) !TOUGH2 conv. creteria: update p+1 accumulation term
2548) if (toil_ims_tough2_conv_criteria) then
2549) accum_p2(local_start:local_end) = Res(:)
2550) endif
2551)
2552) enddo
2553)
2554) call VecRestoreArrayReadF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
2555) !TOUGH2 conv. creteria: update p+1 accumulation term
2556) if (toil_ims_tough2_conv_criteria) then
2557) call VecRestoreArrayReadF90(field%flow_accum2, accum_p2, ierr);CHKERRQ(ierr)
2558) endif
2559)
2560) ! Interior Flux Terms -----------------------------------
2561) connection_set_list => grid%internal_connection_set_list
2562) cur_connection_set => connection_set_list%first
2563) sum_connection = 0
2564) do
2565) if (.not.associated(cur_connection_set)) exit
2566) do iconn = 1, cur_connection_set%num_connections
2567) sum_connection = sum_connection + 1
2568)
2569) ghosted_id_up = cur_connection_set%id_up(iconn)
2570) ghosted_id_dn = cur_connection_set%id_dn(iconn)
2571)
2572) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
2573) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
2574)
2575) imat_up = patch%imat(ghosted_id_up)
2576) imat_dn = patch%imat(ghosted_id_dn)
2577) if (imat_up <= 0 .or. imat_dn <= 0) cycle
2578)
2579) icap_up = patch%sat_func_id(ghosted_id_up)
2580) icap_dn = patch%sat_func_id(ghosted_id_dn)
2581)
2582) call TOilImsFlux(toil_auxvars(ZERO_INTEGER,ghosted_id_up), &
2583) global_auxvars(ghosted_id_up), &
2584) material_auxvars(ghosted_id_up), &
2585) material_parameter%soil_residual_saturation(:,icap_up), &
2586) material_parameter%soil_thermal_conductivity(:,imat_up), &
2587) toil_auxvars(ZERO_INTEGER,ghosted_id_dn), &
2588) global_auxvars(ghosted_id_dn), &
2589) material_auxvars(ghosted_id_dn), &
2590) material_parameter%soil_residual_saturation(:,icap_dn), &
2591) material_parameter%soil_thermal_conductivity(:,imat_dn), &
2592) cur_connection_set%area(iconn), &
2593) cur_connection_set%dist(:,iconn), &
2594) toil_parameter,option,v_darcy,Res)
2595)
2596) patch%internal_velocities(:,sum_connection) = v_darcy
2597) if (associated(patch%internal_flow_fluxes)) then
2598) patch%internal_flow_fluxes(:,sum_connection) = Res(:)
2599) endif
2600)
2601) if (local_id_up > 0) then
2602) local_end = local_id_up * option%nflowdof
2603) local_start = local_end - option%nflowdof + 1
2604) r_p(local_start:local_end) = r_p(local_start:local_end) + Res(:)
2605) endif
2606)
2607) if (local_id_dn > 0) then
2608) local_end = local_id_dn * option%nflowdof
2609) local_start = local_end - option%nflowdof + 1
2610) r_p(local_start:local_end) = r_p(local_start:local_end) - Res(:)
2611) endif
2612) enddo
2613)
2614) cur_connection_set => cur_connection_set%next
2615) enddo
2616)
2617) ! Boundary Flux Terms -----------------------------------
2618) boundary_condition => patch%boundary_condition_list%first
2619) sum_connection = 0
2620) do
2621) if (.not.associated(boundary_condition)) exit
2622)
2623) cur_connection_set => boundary_condition%connection_set
2624)
2625) do iconn = 1, cur_connection_set%num_connections
2626) sum_connection = sum_connection + 1
2627)
2628) local_id = cur_connection_set%id_dn(iconn)
2629) ghosted_id = grid%nL2G(local_id)
2630)
2631) imat_dn = patch%imat(ghosted_id)
2632) if (imat_dn <= 0) cycle
2633)
2634) if (ghosted_id<=0) then
2635) print *, "Wrong boundary node index... STOP!!!"
2636) stop
2637) endif
2638)
2639) icap_dn = patch%sat_func_id(ghosted_id)
2640)
2641) call TOilImsBCFlux(boundary_condition%flow_bc_type, &
2642) boundary_condition%flow_aux_mapping, &
2643) boundary_condition%flow_aux_real_var(:,iconn), &
2644) toil_auxvars_bc(sum_connection), &
2645) global_auxvars_bc(sum_connection), &
2646) toil_auxvars(ZERO_INTEGER,ghosted_id), &
2647) global_auxvars(ghosted_id), &
2648) material_auxvars(ghosted_id), &
2649) material_parameter%soil_residual_saturation(:,icap_dn), &
2650) material_parameter%soil_thermal_conductivity(:,imat_dn), &
2651) cur_connection_set%area(iconn), &
2652) cur_connection_set%dist(:,iconn), &
2653) toil_parameter,option, &
2654) v_darcy,Res)
2655)
2656) patch%boundary_velocities(:,sum_connection) = v_darcy
2657) if (associated(patch%boundary_flow_fluxes)) then
2658) patch%boundary_flow_fluxes(:,sum_connection) = Res(:)
2659) endif
2660) if (option%compute_mass_balance_new) then
2661) ! contribution to boundary
2662) global_auxvars_bc(sum_connection)%mass_balance_delta(1:2,1) = &
2663) global_auxvars_bc(sum_connection)%mass_balance_delta(1:2,1) - &
2664) Res(1:2) ! one-component phase molar fluxes
2665) endif
2666)
2667) local_end = local_id * option%nflowdof
2668) local_start = local_end - option%nflowdof + 1
2669) r_p(local_start:local_end)= r_p(local_start:local_end) - Res(:)
2670)
2671) enddo
2672) boundary_condition => boundary_condition%next
2673) enddo
2674)
2675) ! Source/sink terms -------------------------------------
2676) source_sink => patch%source_sink_list%first
2677) sum_connection = 0
2678) do
2679) if (.not.associated(source_sink)) exit
2680)
2681) cur_connection_set => source_sink%connection_set
2682)
2683) do iconn = 1, cur_connection_set%num_connections
2684) sum_connection = sum_connection + 1
2685) local_id = cur_connection_set%id_dn(iconn)
2686) ghosted_id = grid%nL2G(local_id)
2687) if (patch%imat(ghosted_id) <= 0) cycle
2688)
2689) local_end = local_id * option%nflowdof
2690) local_start = local_end - option%nflowdof + 1
2691)
2692) ! if the src/sink is not scaled, flow_aux_real_var is not allocated
2693) ! time varying rate loaded in flow_condition%toil_ims%rate%dataset%rarray(:)
2694) if (associated(source_sink%flow_aux_real_var)) then
2695) scale = source_sink%flow_aux_real_var(ONE_INTEGER,iconn)
2696) else
2697) scale = 1.d0
2698) endif
2699)
2700) call TOilImsSrcSink(option,source_sink%flow_condition%toil_ims, &
2701) toil_auxvars(ZERO_INTEGER,ghosted_id), &
2702) global_auxvars(ghosted_id),ss_flow_vol_flux, &
2703) scale,Res)
2704)
2705) r_p(local_start:local_end) = r_p(local_start:local_end) - Res(:)
2706)
2707) if (associated(patch%ss_flow_vol_fluxes)) then
2708) patch%ss_flow_vol_fluxes(:,sum_connection) = ss_flow_vol_flux
2709) endif
2710) if (associated(patch%ss_flow_fluxes)) then
2711) patch%ss_flow_fluxes(:,sum_connection) = Res(:)
2712) endif
2713) if (option%compute_mass_balance_new) then
2714) ! src/sinks contribution
2715) global_auxvars_ss(sum_connection)%mass_balance_delta(1:2,1) = &
2716) global_auxvars_ss(sum_connection)%mass_balance_delta(1:2,1) - &
2717) Res(1:2)
2718) endif
2719)
2720) enddo
2721) source_sink => source_sink%next
2722) enddo
2723)
2724) if (patch%aux%TOil_ims%inactive_cells_exist) then
2725) do i=1,patch%aux%TOil_ims%n_inactive_rows
2726) r_p(patch%aux%TOil_ims%inactive_rows_local(i)) = 0.d0
2727) enddo
2728) endif
2729)
2730) call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
2731)
2732) !do not use sandbox
2733) !call GeneralSSSandbox(r,null_mat,PETSC_FALSE,grid,material_auxvars, &
2734) ! gen_auxvars,option)
2735)
2736) !if (Initialized(toil_ims_debug_cell_id)) then
2737) ! call VecGetArrayReadF90(r, r_p, ierr);CHKERRQ(ierr)
2738) ! do local_id = general_debug_cell_id-1, general_debug_cell_id+1
2739) ! write(*,'('' residual : '',i2,10es12.4)') local_id, &
2740) ! r_p((local_id-1)*option%nflowdof+1:(local_id-1)*option%nflowdof+2), &
2741) ! r_p(local_id*option%nflowdof)*1.d6
2742) ! enddo
2743) ! call VecRestoreArrayReadF90(r, r_p, ierr);CHKERRQ(ierr)
2744) !endif
2745)
2746) if (toil_ims_isothermal) then
2747) call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
2748) ! zero energy residual
2749) do local_id = 1, grid%nlmax
2750) r_p((local_id-1)*option%nflowdof+TOIL_IMS_ENERGY_EQUATION_INDEX) = 0.d0
2751) enddo
2752) call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
2753) endif
2754)
2755)
2756) if (realization%debug%vecview_residual) then
2757) string = 'Gresidual'
2758) call DebugCreateViewer(realization%debug,string,option,viewer)
2759) call VecView(r,viewer,ierr);CHKERRQ(ierr)
2760) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2761) endif
2762) if (realization%debug%vecview_solution) then
2763) string = 'Gxx'
2764) call DebugCreateViewer(realization%debug,string,option,viewer)
2765) call VecView(xx,viewer,ierr);CHKERRQ(ierr)
2766) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2767) endif
2768)
2769)
2770) end subroutine TOilImsResidual
2771)
2772) ! ************************************************************************** !
2773)
2774) ! ************************************************************************** !
2775)
2776) subroutine TOilImsJacobian(snes,xx,A,B,realization,ierr)
2777) !
2778) ! Computes the Jacobian for TOilIms Mode
2779) !
2780) ! Author: Paolo Orsini
2781) ! Date: 11/05/15
2782) !
2783)
2784) use Realization_Subsurface_class
2785) use Patch_module
2786) use Grid_module
2787) use Option_module
2788) use Connection_module
2789) use Coupler_module
2790) use Field_module
2791) use Debug_module
2792) use Material_Aux_class
2793)
2794) implicit none
2795)
2796) SNES :: snes
2797) Vec :: xx
2798) Mat :: A, B
2799) type(realization_subsurface_type) :: realization
2800) PetscErrorCode :: ierr
2801)
2802) Mat :: J
2803) MatType :: mat_type
2804) PetscReal :: norm
2805) PetscViewer :: viewer
2806)
2807) PetscInt :: icap_up,icap_dn
2808) PetscReal :: qsrc, scale
2809) PetscInt :: imat, imat_up, imat_dn
2810) PetscInt :: local_id, ghosted_id
2811) PetscInt :: irow
2812) PetscInt :: local_id_up, local_id_dn
2813) PetscInt :: ghosted_id_up, ghosted_id_dn
2814) Vec, parameter :: null_vec = 0
2815)
2816) PetscReal :: Jup(realization%option%nflowdof,realization%option%nflowdof), &
2817) Jdn(realization%option%nflowdof,realization%option%nflowdof)
2818)
2819) type(coupler_type), pointer :: boundary_condition, source_sink
2820) type(connection_set_list_type), pointer :: connection_set_list
2821) type(connection_set_type), pointer :: cur_connection_set
2822) PetscInt :: iconn
2823) PetscInt :: sum_connection
2824) PetscReal :: distance, fraction_upwind
2825) PetscReal :: distance_gravity
2826) PetscInt, pointer :: zeros(:)
2827) type(grid_type), pointer :: grid
2828) type(patch_type), pointer :: patch
2829) type(option_type), pointer :: option
2830) type(field_type), pointer :: field
2831) type(material_parameter_type), pointer :: material_parameter
2832) type(toil_ims_parameter_type), pointer :: toil_parameter
2833) type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:), toil_auxvars_bc(:)
2834) type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
2835) class(material_auxvar_type), pointer :: material_auxvars(:)
2836)
2837) character(len=MAXSTRINGLENGTH) :: string
2838) character(len=MAXWORDLENGTH) :: word
2839)
2840) patch => realization%patch
2841) grid => patch%grid
2842) option => realization%option
2843) field => realization%field
2844) material_parameter => patch%aux%Material%material_parameter
2845) toil_auxvars => patch%aux%TOil_ims%auxvars
2846) toil_auxvars_bc => patch%aux%TOil_ims%auxvars_bc
2847) toil_parameter => patch%aux%TOil_ims%parameter
2848) global_auxvars => patch%aux%Global%auxvars
2849) global_auxvars_bc => patch%aux%Global%auxvars_bc
2850) material_auxvars => patch%aux%Material%auxvars
2851)
2852) call MatGetType(A,mat_type,ierr);CHKERRQ(ierr)
2853) if (mat_type == MATMFFD) then
2854) J = B
2855) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2856) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2857) else
2858) J = A
2859) endif
2860)
2861) call MatZeroEntries(J,ierr);CHKERRQ(ierr)
2862)
2863) !#ifdef DEBUG_GENERAL_FILEOUTPUT
2864) ! if (debug_flag > 0) then
2865) ! write(word,*) debug_timestep_count
2866) ! string = 'jacobian_debug_data_' // trim(adjustl(word))
2867) ! write(word,*) debug_timestep_cut_count
2868) ! string = trim(string) // '_' // trim(adjustl(word))
2869) ! write(word,*) debug_iteration_count
2870) ! debug_filename = trim(string) // '_' // trim(adjustl(word)) // '.txt'
2871) ! open(debug_unit, file=debug_filename, action="write", status="unknown")
2872) ! open(debug_info_unit, file='debug_info.txt', action="write", &
2873) ! position="append", status="unknown")
2874) ! write(debug_info_unit,*) 'jacobian ', debug_timestep_count, &
2875) ! debug_timestep_cut_count, debug_iteration_count
2876) ! close(debug_info_unit)
2877) ! endif
2878) !#endif
2879)
2880) ! Perturb aux vars
2881) do ghosted_id = 1, grid%ngmax ! For each local node do...
2882) if (patch%imat(ghosted_id) <= 0) cycle
2883)
2884) call TOilImsAuxVarPerturb(toil_auxvars(:,ghosted_id), &
2885) global_auxvars(ghosted_id), &
2886) material_auxvars(ghosted_id), &
2887) patch%characteristic_curves_array( &
2888) patch%sat_func_id(ghosted_id))%ptr, &
2889) ghosted_id,option)
2890) enddo
2891)
2892) !#ifdef DEBUG_GENERAL_LOCAL
2893) ! call GeneralOutputAuxVars(gen_auxvars,global_auxvars,option)
2894) !#endif
2895)
2896) ! Accumulation terms ------------------------------------
2897) do local_id = 1, grid%nlmax ! For each local node do...
2898) ghosted_id = grid%nL2G(local_id)
2899) !geh - Ignore inactive cells with inactive materials
2900) imat = patch%imat(ghosted_id)
2901) if (imat <= 0) cycle
2902)
2903) call TOilImsAccumDerivative(toil_auxvars(:,ghosted_id), &
2904) material_auxvars(ghosted_id), &
2905) material_parameter%soil_heat_capacity(imat), &
2906) option,Jup)
2907)
2908) call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup, &
2909) ADD_VALUES,ierr);CHKERRQ(ierr)
2910) enddo
2911)
2912) if (realization%debug%matview_Jacobian_detailed) then
2913) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2914) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2915) string = 'jacobian_accum'
2916) call DebugCreateViewer(realization%debug,string,option,viewer)
2917) call MatView(A,viewer,ierr);CHKERRQ(ierr)
2918) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2919) endif
2920)
2921)
2922) ! Interior Flux Terms -----------------------------------
2923) connection_set_list => grid%internal_connection_set_list
2924) cur_connection_set => connection_set_list%first
2925) sum_connection = 0
2926) do
2927) if (.not.associated(cur_connection_set)) exit
2928) do iconn = 1, cur_connection_set%num_connections
2929) sum_connection = sum_connection + 1
2930)
2931) ghosted_id_up = cur_connection_set%id_up(iconn)
2932) ghosted_id_dn = cur_connection_set%id_dn(iconn)
2933)
2934) imat_up = patch%imat(ghosted_id_up)
2935) imat_dn = patch%imat(ghosted_id_dn)
2936) if (imat_up <= 0 .or. imat_dn <= 0) cycle
2937)
2938) local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
2939) local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping
2940)
2941) icap_up = patch%sat_func_id(ghosted_id_up)
2942) icap_dn = patch%sat_func_id(ghosted_id_dn)
2943)
2944) call TOilImsFluxDerivative(toil_auxvars(:,ghosted_id_up), &
2945) global_auxvars(ghosted_id_up), &
2946) material_auxvars(ghosted_id_up), &
2947) material_parameter%soil_residual_saturation(:,icap_up), &
2948) material_parameter%soil_thermal_conductivity(:,imat_up), &
2949) toil_auxvars(:,ghosted_id_dn), &
2950) global_auxvars(ghosted_id_dn), &
2951) material_auxvars(ghosted_id_dn), &
2952) material_parameter%soil_residual_saturation(:,icap_dn), &
2953) material_parameter%soil_thermal_conductivity(:,imat_dn), &
2954) cur_connection_set%area(iconn), &
2955) cur_connection_set%dist(:,iconn), &
2956) toil_parameter,option, &
2957) Jup,Jdn)
2958)
2959) if (local_id_up > 0) then
2960) call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_up-1, &
2961) Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
2962) call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_dn-1, &
2963) Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
2964) endif
2965) if (local_id_dn > 0) then
2966) Jup = -Jup
2967) Jdn = -Jdn
2968) call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_dn-1, &
2969) Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
2970) call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_up-1, &
2971) Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
2972) endif
2973) enddo
2974) cur_connection_set => cur_connection_set%next
2975) enddo
2976)
2977) if (realization%debug%matview_Jacobian_detailed) then
2978) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2979) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
2980) string = 'jacobian_flux'
2981) call DebugCreateViewer(realization%debug,string,option,viewer)
2982) call MatView(A,viewer,ierr);CHKERRQ(ierr)
2983) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
2984) endif
2985)
2986) ! Boundary Flux Terms -----------------------------------
2987) boundary_condition => patch%boundary_condition_list%first
2988) sum_connection = 0
2989) do
2990) if (.not.associated(boundary_condition)) exit
2991)
2992) cur_connection_set => boundary_condition%connection_set
2993)
2994) do iconn = 1, cur_connection_set%num_connections
2995) sum_connection = sum_connection + 1
2996)
2997) local_id = cur_connection_set%id_dn(iconn)
2998) ghosted_id = grid%nL2G(local_id)
2999)
3000) imat_dn = patch%imat(ghosted_id)
3001) if (imat_dn <= 0) cycle
3002)
3003) if (ghosted_id<=0) then
3004) print *, "Wrong boundary node index... STOP!!!"
3005) stop
3006) endif
3007)
3008) icap_dn = patch%sat_func_id(ghosted_id)
3009)
3010) call TOilImsBCFluxDerivative(boundary_condition%flow_bc_type, &
3011) boundary_condition%flow_aux_mapping, &
3012) boundary_condition%flow_aux_real_var(:,iconn), &
3013) toil_auxvars_bc(sum_connection), &
3014) global_auxvars_bc(sum_connection), &
3015) toil_auxvars(:,ghosted_id), &
3016) global_auxvars(ghosted_id), &
3017) material_auxvars(ghosted_id), &
3018) material_parameter%soil_residual_saturation(:,icap_dn), &
3019) material_parameter%soil_thermal_conductivity(:,imat_dn), &
3020) cur_connection_set%area(iconn), &
3021) cur_connection_set%dist(:,iconn), &
3022) toil_parameter,option, &
3023) Jdn)
3024)
3025) Jdn = -Jdn
3026) call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jdn, &
3027) ADD_VALUES,ierr);CHKERRQ(ierr)
3028) enddo
3029) boundary_condition => boundary_condition%next
3030) enddo
3031)
3032) if (realization%debug%matview_Jacobian_detailed) then
3033) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3034) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3035) string = 'jacobian_bcflux'
3036) call DebugCreateViewer(realization%debug,string,option,viewer)
3037) call MatView(A,viewer,ierr);CHKERRQ(ierr)
3038) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3039) endif
3040)
3041) ! Source/sinks
3042) source_sink => patch%source_sink_list%first
3043) do
3044) if (.not.associated(source_sink)) exit
3045)
3046) cur_connection_set => source_sink%connection_set
3047)
3048) do iconn = 1, cur_connection_set%num_connections
3049) local_id = cur_connection_set%id_dn(iconn)
3050) ghosted_id = grid%nL2G(local_id)
3051) if (patch%imat(ghosted_id) <= 0) cycle
3052)
3053) if (associated(source_sink%flow_aux_real_var)) then
3054) scale = source_sink%flow_aux_real_var(ONE_INTEGER,iconn)
3055) else
3056) scale = 1.d0
3057) endif
3058)
3059) Jup = 0.d0
3060)
3061) call TOilImsSrcSinkDerivative(option, &
3062) source_sink%flow_condition%toil_ims, &
3063) toil_auxvars(:,ghosted_id), &
3064) global_auxvars(ghosted_id), &
3065) scale,Jup)
3066)
3067) call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup, &
3068) ADD_VALUES,ierr);CHKERRQ(ierr)
3069)
3070) enddo
3071) source_sink => source_sink%next
3072) enddo
3073)
3074) ! SSSandBox not supported
3075) !call GeneralSSSandbox(null_vec,A,PETSC_TRUE,grid,material_auxvars, &
3076) ! gen_auxvars,option)
3077)
3078) if (realization%debug%matview_Jacobian_detailed) then
3079) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3080) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3081) string = 'jacobian_srcsink'
3082) call DebugCreateViewer(realization%debug,string,option,viewer)
3083) call MatView(A,viewer,ierr);CHKERRQ(ierr)
3084) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3085) endif
3086)
3087) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3088) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
3089)
3090) ! zero out isothermal and inactive cells
3091) if (patch%aux%TOil_ims%inactive_cells_exist) then
3092) qsrc = 1.d0 ! solely a temporary variable in this conditional
3093) call MatZeroRowsLocal(A,patch%aux%TOil_ims%n_inactive_rows, &
3094) patch%aux%TOil_ims%inactive_rows_local_ghosted, &
3095) qsrc,PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
3096) ierr);CHKERRQ(ierr)
3097) endif
3098)
3099) if (toil_ims_isothermal) then
3100) qsrc = 1.d0 ! solely a temporary variable in this conditional
3101) zeros => patch%aux%Toil_ims%row_zeroing_array
3102) ! zero energy residual
3103) do local_id = 1, grid%nlmax
3104) ghosted_id = grid%nL2G(local_id)
3105) zeros(local_id) = (ghosted_id-1)*option%nflowdof+ &
3106) TOIL_IMS_ENERGY_EQUATION_INDEX - 1 ! zero-based
3107) enddo
3108) call MatZeroRowsLocal(A,grid%nlmax,zeros,qsrc,PETSC_NULL_OBJECT, &
3109) PETSC_NULL_OBJECT,ierr);CHKERRQ(ierr)
3110) endif
3111)
3112) if (realization%debug%matview_Jacobian) then
3113) string = 'Gjacobian'
3114) call DebugCreateViewer(realization%debug,string,option,viewer)
3115) call MatView(J,viewer,ierr);CHKERRQ(ierr)
3116) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3117) endif
3118) if (realization%debug%norm_Jacobian) then
3119) option => realization%option
3120) call MatNorm(J,NORM_1,norm,ierr);CHKERRQ(ierr)
3121) write(option%io_buffer,'("1 norm: ",es11.4)') norm
3122) call printMsg(option)
3123) call MatNorm(J,NORM_FROBENIUS,norm,ierr);CHKERRQ(ierr)
3124) write(option%io_buffer,'("2 norm: ",es11.4)') norm
3125) call printMsg(option)
3126) call MatNorm(J,NORM_INFINITY,norm,ierr);CHKERRQ(ierr)
3127) write(option%io_buffer,'("inf norm: ",es11.4)') norm
3128) call printMsg(option)
3129) endif
3130)
3131) ! call MatView(J,PETSC_VIEWER_STDOUT_WORLD,ierr)
3132)
3133) !#if 0
3134) ! imat = 1
3135) ! if (imat == 1) then
3136) ! call GeneralNumericalJacobianTest(xx,realization,J)
3137) ! endif
3138) !#endif
3139)
3140) !#ifdef DEBUG_GENERAL_FILEOUTPUT
3141) ! if (debug_flag > 0) then
3142) ! write(word,*) debug_timestep_count
3143) ! string = 'jacobian_' // trim(adjustl(word))
3144) ! write(word,*) debug_timestep_cut_count
3145) ! string = trim(string) // '_' // trim(adjustl(word))
3146) ! write(word,*) debug_iteration_count
3147) ! string = trim(string) // '_' // trim(adjustl(word)) // '.out'
3148) ! call PetscViewerASCIIOpen(realization%option%mycomm,trim(string), &
3149) ! viewer,ierr);CHKERRQ(ierr)
3150) ! call MatView(J,viewer,ierr);CHKERRQ(ierr)
3151) ! call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
3152) ! close(debug_unit)
3153) ! endif
3154) !#endif
3155)
3156) end subroutine ToilImsJacobian
3157)
3158) ! ************************************************************************** !
3159)
3160) subroutine TOilImsDestroy(realization)
3161) !
3162) ! Deallocates variables associated with TOilIms
3163) !
3164) ! Author: Paolo Orsini
3165) ! Date: 11/09/15
3166) !
3167)
3168) use Realization_Subsurface_class
3169)
3170) implicit none
3171)
3172) type(realization_subsurface_type) :: realization
3173)
3174) ! place anything that needs to be freed here.
3175) ! auxvars are deallocated in auxiliary.F90.
3176)
3177) end subroutine TOilImsDestroy
3178)
3179) ! ************************************************************************** !
3180)
3181) ! ************************************************************************** !
3182) ! PO rewritten again by mistake!!!! need comment it out
3183) ! in this version the write statements for debugging from General
3184) ! appear commented
3185) !subroutine ToilImsCheckUpdatePre(line_search,X,dX,changed,realization,ierr)
3186) ! !
3187) ! ! Checks update prior to update
3188) ! !
3189) ! ! Author: Paolo Orsini
3190) ! ! Date: 11/05/15
3191) ! !
3192) !
3193) ! use Realization_Subsurface_class
3194) ! use Grid_module
3195) ! use Field_module
3196) ! use Option_module
3197) ! use Saturation_Function_module
3198) ! use Patch_module
3199) !
3200) ! implicit none
3201) !
3202) ! SNESLineSearch :: line_search
3203) ! Vec :: X
3204) ! Vec :: dX
3205) ! PetscBool :: changed
3206) ! type(realization_subsurface_type) :: realization
3207) !
3208) ! PetscReal, pointer :: X_p(:)
3209) ! PetscReal, pointer :: dX_p(:)
3210) ! PetscReal, pointer :: r_p(:)
3211) ! type(grid_type), pointer :: grid
3212) ! type(option_type), pointer :: option
3213) ! type(patch_type), pointer :: patch
3214) ! type(field_type), pointer :: field
3215) ! type(toil_ims_auxvar_type), pointer :: toil_auxvars(:,:)
3216) ! type(global_auxvar_type), pointer :: global_auxvars(:)
3217) !
3218) ! PetscInt :: local_id, ghosted_id
3219) ! PetscInt :: offset
3220) !
3221) ! PetscInt :: pressure_index, saturation_index, temperature_index
3222) ! PetscReal :: pressure0, pressure1, del_pressure
3223) ! PetscReal :: temperature0, temperature1, del_temperature
3224) ! PetscReal :: saturation0, saturation1, del_saturation
3225)
3226) ! PetscReal :: max_saturation_change = 0.125d0
3227) ! PetscReal :: max_temperature_change = 10.d0
3228) ! PetscReal :: min_pressure
3229) ! PetscReal :: scale, temp_scale, temp_real
3230) ! PetscReal, parameter :: tolerance = 0.99d0
3231) ! PetscReal, parameter :: initial_scale = 1.d0
3232) ! SNES :: snes
3233) ! PetscInt :: newton_iteration
3234) ! PetscErrorCode :: ierr
3235) !
3236) ! grid => realization%patch%grid
3237) ! option => realization%option
3238) ! field => realization%field
3239) ! toil_auxvars => realization%patch%aux%TOil_Ims%auxvars
3240) ! global_auxvars => realization%patch%aux%Global%auxvars
3241) !
3242) ! patch => realization%patch
3243) !
3244) ! call SNESLineSearchGetSNES(line_search,snes,ierr)
3245) ! call SNESGetIterationNumber(snes,newton_iteration,ierr)
3246) !
3247) ! call VecGetArrayF90(dX,dX_p,ierr);CHKERRQ(ierr)
3248) ! call VecGetArrayReadF90(X,X_p,ierr);CHKERRQ(ierr)
3249) !
3250) ! changed = PETSC_TRUE
3251) !
3252) ! scale = initial_scale
3253) !
3254) ! if (toil_ims_max_it_before_damping > 0 .and. &
3255) ! newton_iteration > toil_ims_max_it_before_damping) then
3256) ! scale = toil_ims_damping_factor
3257) ! endif
3258) !
3259) !#define LIMIT_MAX_PRESSURE_CHANGE
3260) !#define LIMIT_MAX_SATURATION_CHANGE
3261) !!#define TRUNCATE_PRESSURE
3262)
3263) !!!#define LIMIT_MAX_TEMPERATURE_CHANGE
3264) !!#define TRUNCATE_LIQUID_PRESSURE
3265) !!! TRUNCATE_GAS/AIR_PRESSURE is needed for times when the solve wants
3266) !!! to pull them negative.
3267) !!#define TRUNCATE_GAS_PRESSURE
3268) !!#define TRUNCATE_AIR_PRESSURE
3269) !
3270) ! ! scaling
3271) ! do local_id = 1, grid%nlmax
3272) ! ghosted_id = grid%nL2G(local_id)
3273) ! offset = (local_id-1)*option%nflowdof
3274) ! temp_scale = 1.d0
3275) !
3276) !!#ifdef DEBUG_GENERAL_INFO
3277) !! cell_id = grid%nG2A(ghosted_id)
3278) !! write(cell_id_word,*) cell_id
3279) !! cell_id_word = '(Cell ' // trim(adjustl(cell_id_word)) // '): '
3280) !!#endif
3281) !
3282) ! pressure_index = offset + TOIL_IMS_PRESSURE_DOF
3283) ! saturation_index = offset + TOIL_IMS_SATURATION_DOF
3284) ! temperature_index = offset + TOIL_IMS_ENERGY_DOF
3285) ! dX_p(pressure_index) = dX_p(pressure_index) * &
3286) ! toil_ims_pressure_scale
3287) ! temp_scale = 1.d0
3288) ! del_pressure = dX_p(pressure_index)
3289) ! pressure0 = X_p(pressure_index)
3290) ! pressure1 = pressure0 - del_pressure
3291) ! del_saturation = dX_p(saturation_index)
3292) ! saturation0 = X_p(saturation_index)
3293) ! saturation1 = saturation0 - del_saturation
3294) !
3295) !#ifdef LIMIT_MAX_PRESSURE_CHANGE
3296) ! if (dabs(del_pressure) > toil_ims_max_pressure_change) then
3297) ! temp_real = dabs(toil_ims_max_pressure_change/del_pressure)
3298) !!#ifdef DEBUG_GENERAL_INFO
3299) !! if (cell_locator(0) < max_cell_id) then
3300) !! cell_locator(0) = cell_locator(0) + 1
3301) !! cell_locator(cell_locator(0)) = ghosted_id
3302) !! endif
3303) !! string = trim(cell_id_word) // &
3304) !! 'Gas pressure change scaled to truncate at max_pressure_change: '
3305) !! call printMsg(option,string)
3306) !! write(string2,*) gas_pressure0
3307) !! string = ' Gas Pressure 0 : ' // adjustl(string2)
3308) !! call printMsg(option,string)
3309) !! write(string2,*) gas_pressure1
3310) !! string = ' Gas Pressure 1 : ' // adjustl(string2)
3311) !! call printMsg(option,string)
3312) !! write(string2,*) -1.d0*del_gas_pressure
3313) !! string = 'Gas Pressure change : ' // adjustl(string2)
3314) !! call printMsg(option,string)
3315) !! write(string2,*) temp_real
3316) !! string = ' scaling : ' // adjustl(string2)
3317) !! call printMsg(option,string)
3318) !!#endif
3319) ! temp_scale = min(temp_scale,temp_real)
3320) ! endif
3321) !#endif !LIMIT_MAX_PRESSURE_CHANGE
3322) !
3323) !#ifdef TRUNCATE_PRESSURE
3324) ! if (pressure1 <= 0.d0) then
3325) ! if (dabs(del_pressure) > 1.d-40) then
3326) ! temp_real = tolerance * dabs(pressure0 / del_pressure)
3327) !!#ifdef DEBUG_GENERAL_INFO
3328) !! if (cell_locator(0) < max_cell_id) then
3329) !! cell_locator(0) = cell_locator(0) + 1
3330) !! cell_locator(cell_locator(0)) = ghosted_id
3331) !! endif
3332) !! string = trim(cell_id_word) // &
3333) !! 'Gas pressure change scaled to prevent gas ' // &
3334) !! 'pressure from dropping below zero: '
3335) !! call printMsg(option,string)
3336) !! write(string2,*) gas_pressure0
3337) !! string = ' Gas pressure 0 : ' // adjustl(string2)
3338) !! call printMsg(option,string)
3339) !! write(string2,*) gas_pressure1
3340) !! string = ' Gas pressure 1 : ' // adjustl(string2)
3341) !! call printMsg(option,string)
3342) !! write(string2,*) -1.d0*del_gas_pressure
3343) !! string = ' pressure change : ' // adjustl(string2)
3344) !! call printMsg(option,string)
3345) !! write(string2,*) temp_real
3346) !! string = ' scaling : ' // adjustl(string2)
3347) !! call printMsg(option,string)
3348) !!#endif
3349) ! temp_scale = min(temp_scale,temp_real)
3350) ! endif
3351) ! endif
3352) !#endif !TRUNCATE_PRESSURE
3353) !
3354) !#ifdef LIMIT_MAX_SATURATION_CHANGE
3355) ! if (dabs(del_saturation) > max_saturation_change) then
3356) ! temp_real = dabs(max_saturation_change/del_saturation)
3357) !!#ifdef DEBUG_GENERAL_INFO
3358) !! if (cell_locator(0) < max_cell_id) then
3359) !! cell_locator(0) = cell_locator(0) + 1
3360) !! cell_locator(cell_locator(0)) = ghosted_id
3361) !! endif
3362) !! string = trim(cell_id_word) // &
3363) !! 'Gas saturation change scaled to truncate at ' // &
3364) !! 'max_saturation_change: '
3365) !! call printMsg(option,string)
3366) !! write(string2,*) saturation0
3367) !! string = ' Saturation 0 : ' // adjustl(string2)
3368) !! call printMsg(option,string)
3369) !! write(string2,*) saturation1
3370) !! string = ' Saturation 1 : ' // adjustl(string2)
3371) !! call printMsg(option,string)
3372) !! write(string2,*) -1.d0*del_saturation
3373) !! string = 'Saturation change : ' // adjustl(string2)
3374) !! call printMsg(option,string)
3375) !! write(string2,*) temp_real
3376) !! string = ' scaling : ' // adjustl(string2)
3377) !! call printMsg(option,string)
3378) !!#endif
3379) ! temp_scale = min(temp_scale,temp_real)
3380) ! endif
3381) !#endif !LIMIT_MAX_SATURATION_CHANGE
3382) !
3383) ! scale = min(scale,temp_scale)
3384) ! enddo
3385) !
3386) ! temp_scale = scale
3387) ! call MPI_Allreduce(temp_scale,scale,ONE_INTEGER_MPI, &
3388) ! MPI_DOUBLE_PRECISION, &
3389) ! MPI_MIN,option%mycomm,ierr)
3390) !
3391) !
3392) ! if (scale < 0.9999d0) then
3393) !!#ifdef DEBUG_GENERAL_INFO
3394) !! string = '++++++++++++++++++++++++++++++++++++++++++++++++++++++'
3395) !! call printMsg(option,string)
3396) !! write(string2,*) scale, (grid%nG2A(cell_locator(i)),i=1,cell_locator(0))
3397) !! string = 'Final scaling: : ' // adjustl(string2)
3398) !! call printMsg(option,string)
3399) !! do i = 1, cell_locator(0)
3400) !! ghosted_id = cell_locator(i)
3401) !! offset = (ghosted_id-1)*option%nflowdof
3402) !! write(string2,*) grid%nG2A(ghosted_id)
3403) !! string = 'Cell ' // trim(adjustl(string2))
3404) !! write(string2,*) global_auxvars(ghosted_id)%istate
3405) !! string = trim(string) // ' (State = ' // trim(adjustl(string2)) // ') '
3406) !! call printMsg(option,string)
3407) !! ! for some reason cannot perform array operation on dX_p(:)
3408) !! write(string2,*) (X_p(offset+ii),ii=1,3)
3409) !! string = ' Orig. Solution: ' // trim(adjustl(string2))
3410) !! call printMsg(option,string)
3411) !! write(string2,*) (X_p(offset+ii)-dX_p(offset+ii),ii=1,3)
3412) !! string = ' Solution before: ' // trim(adjustl(string2))
3413) !! call printMsg(option,string)
3414) !! write(string2,*) (X_p(offset+ii)-scale*dX_p(offset+ii),ii=1,3)
3415) !! string = ' Solution after: ' // trim(adjustl(string2))
3416) !! call printMsg(option,string)
3417) !! enddo
3418) !! string = '++++++++++++++++++++++++++++++++++++++++++++++++++++++'
3419) !! call printMsg(option,string)
3420) !!#endif
3421) ! dX_p = scale*dX_p
3422) ! endif
3423) !
3424) ! call VecRestoreArrayF90(dX,dX_p,ierr);CHKERRQ(ierr)
3425) ! call VecRestoreArrayReadF90(X,X_p,ierr);CHKERRQ(ierr)
3426) !
3427) !end subroutine ToilImsCheckUpdatePre
3428) !
3429) !! ************************************************************************** !
3430)
3431)
3432) ! ************************************************************************** !
3433)
3434) function TOilImsAverageDensity(sat_up,sat_dn,density_up,density_dn)
3435) !
3436) ! Averages density, using opposite cell density if phase non-existent
3437) !
3438) ! Author: Paolo Orsini
3439) ! Date: 11/28/15
3440) !
3441)
3442) implicit none
3443)
3444) PetscReal :: sat_up, sat_dn
3445) PetscReal :: density_up, density_dn
3446)
3447) PetscReal :: TOilImsAverageDensity
3448)
3449) if (sat_up < eps ) then
3450) TOilImsAverageDensity = density_dn
3451) else if (sat_dn < eps ) then
3452) TOilImsAverageDensity = density_up
3453) else ! in here we could use an armonic average,
3454) ! other idea sat weighted average but it needs truncation
3455) TOilImsAverageDensity = 0.5d0*(density_up+density_dn)
3456) end if
3457)
3458) end function TOilImsAverageDensity
3459)
3460) ! ************************************************************************** !
3461)
3462)
3463) end module TOilIms_module
3464)