geomechanics_force.F90 coverage: 77.78 %func 79.30 %block
1) module Geomechanics_Force_module
2)
3) use Geomechanics_Global_Aux_module
4) use PFLOTRAN_Constants_module
5)
6) implicit none
7)
8) private
9)
10) #include "petsc/finclude/petscsys.h"
11)
12) #include "petsc/finclude/petscvec.h"
13) #include "petsc/finclude/petscvec.h90"
14) #include "petsc/finclude/petscmat.h"
15) #include "petsc/finclude/petscmat.h90"
16) !#include "petsc/finclude/petscsnes.h"
17) #include "petsc/finclude/petscviewer.h"
18) #include "petsc/finclude/petsclog.h"
19) #include "petsc/finclude/petscts.h"
20)
21) ! Cutoff parameters
22) PetscReal, parameter :: eps = 1.d-12
23) PetscReal, parameter :: perturbation_tolerance = 1.d-6
24)
25) public :: GeomechForceSetup, &
26) GeomechForceUpdateAuxVars, &
27) GeomechanicsForceInitialGuess, &
28) GeomechForceResidual, &
29) GeomechForceJacobian, &
30) GeomechUpdateFromSubsurf, &
31) GeomechUpdateSubsurfFromGeomech, &
32) GeomechCreateGeomechSubsurfVec, &
33) GeomechCreateSubsurfStressStrainVec, &
34) GeomechUpdateSolution, &
35) GeomechStoreInitialPressTemp, &
36) GeomechStoreInitialDisp, &
37) GeomechStoreInitialPorosity, &
38) GeomechUpdateSubsurfPorosity, &
39) GeomechForceJacobianLinearPart
40)
41) contains
42)
43) ! ************************************************************************** !
44)
45) subroutine GeomechForceSetup(geomech_realization)
46) !
47) ! Sets up the geomechanics calculations
48) !
49) ! Author: Satish Karra, LANL
50) ! Date: 06/17/13
51) !
52)
53) use Geomechanics_Realization_class
54) use Output_Aux_module
55)
56) class(realization_geomech_type) :: geomech_realization
57) type(output_variable_list_type), pointer :: list
58)
59) call GeomechForceSetupPatch(geomech_realization)
60)
61) list => geomech_realization%output_option%output_snap_variable_list
62) call GeomechForceSetPlotVariables(list)
63) list => geomech_realization%output_option%output_obs_variable_list
64) call GeomechForceSetPlotVariables(list)
65)
66) end subroutine GeomechForceSetup
67)
68) ! ************************************************************************** !
69)
70) subroutine GeomechForceSetupPatch(geomech_realization)
71) !
72) ! Sets up the arrays for geomech parameters
73) !
74) ! Author: Satish Karra, LANL
75) ! Date: 09/11/13
76) !
77)
78) use Geomechanics_Realization_class
79) use Geomechanics_Patch_module
80) use Option_module
81)
82) implicit none
83)
84) class(realization_geomech_type) :: geomech_realization
85) type(option_type), pointer :: option
86) type(geomech_patch_type), pointer :: patch
87)
88) PetscInt :: i
89)
90) option => geomech_realization%option
91) patch => geomech_realization%geomech_patch
92)
93) allocate(patch%geomech_aux%GeomechParam%youngs_modulus &
94) (size(geomech_realization%geomech_material_property_array)))
95) allocate(patch%geomech_aux%GeomechParam%poissons_ratio &
96) (size(geomech_realization%geomech_material_property_array)))
97) allocate(patch%geomech_aux%GeomechParam%biot_coef &
98) (size(geomech_realization%geomech_material_property_array)))
99) allocate(patch%geomech_aux%GeomechParam%thermal_exp_coef &
100) (size(geomech_realization%geomech_material_property_array)))
101) allocate(patch%geomech_aux%GeomechParam%density &
102) (size(geomech_realization%geomech_material_property_array)))
103)
104) do i = 1, size(geomech_realization%geomech_material_property_array)
105) patch%geomech_aux%GeomechParam%youngs_modulus(geomech_realization% &
106) geomech_material_property_array(i)%ptr%id) = geomech_realization% &
107) geomech_material_property_array(i)%ptr%youngs_modulus
108) patch%geomech_aux%GeomechParam%poissons_ratio(geomech_realization% &
109) geomech_material_property_array(i)%ptr%id) = geomech_realization% &
110) geomech_material_property_array(i)%ptr%poissons_ratio
111) patch%geomech_aux%GeomechParam%density(geomech_realization% &
112) geomech_material_property_array(i)%ptr%id) = geomech_realization% &
113) geomech_material_property_array(i)%ptr%density
114) patch%geomech_aux%GeomechParam%biot_coef(geomech_realization% &
115) geomech_material_property_array(i)%ptr%id) = geomech_realization% &
116) geomech_material_property_array(i)%ptr%biot_coeff
117) patch%geomech_aux%GeomechParam%thermal_exp_coef(geomech_realization% &
118) geomech_material_property_array(i)%ptr%id) = geomech_realization% &
119) geomech_material_property_array(i)%ptr%thermal_exp_coeff
120) enddo
121)
122) end subroutine GeomechForceSetupPatch
123)
124) ! ************************************************************************** !
125)
126) subroutine GeomechForceSetPlotVariables(list)
127) !
128) ! Set up of geomechanics plot variables
129) !
130) ! Author: Satish Karra, LANL
131) ! Date: 06/17/13
132) !
133)
134) use Output_Aux_module
135) use Variables_module
136)
137) implicit none
138)
139) type(output_variable_list_type), pointer :: list
140) type(output_variable_type), pointer :: output_variable
141)
142) character(len=MAXWORDLENGTH) :: name, units
143)
144) if (associated(list%first)) then
145) return
146) endif
147)
148) name = 'disp_x'
149) units = 'm'
150) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
151) GEOMECH_DISP_X)
152)
153) name = 'disp_y'
154) units = 'm'
155) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
156) GEOMECH_DISP_Y)
157)
158) name = 'disp_z'
159) units = 'm'
160) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
161) GEOMECH_DISP_Z)
162)
163) units = ''
164) name = 'Material ID'
165) output_variable => OutputVariableCreate(name,OUTPUT_DISCRETE, &
166) units,GEOMECH_MATERIAL_ID)
167) output_variable%iformat = 1 ! integer
168) call OutputVariableAddToList(list,output_variable)
169)
170) name = 'strain_xx'
171) units = ''
172) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
173) STRAIN_XX)
174)
175) name = 'strain_yy'
176) units = ''
177) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
178) STRAIN_YY)
179)
180) name = 'strain_zz'
181) units = ''
182) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
183) STRAIN_ZZ)
184)
185) name = 'strain_xy'
186) units = ''
187) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
188) STRAIN_XY)
189)
190) name = 'strain_yz'
191) units = ''
192) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
193) STRAIN_YZ)
194)
195) name = 'strain_zx'
196) units = ''
197) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
198) STRAIN_ZX)
199)
200) name = 'stress_xx'
201) units = ''
202) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
203) STRESS_XX)
204)
205) name = 'stress_yy'
206) units = ''
207) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
208) STRESS_YY)
209)
210) name = 'stress_zz'
211) units = ''
212) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
213) STRESS_ZZ)
214)
215) name = 'stress_xy'
216) units = ''
217) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
218) STRESS_XY)
219)
220) name = 'stress_yz'
221) units = ''
222) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
223) STRESS_YZ)
224)
225) name = 'stress_zx'
226) units = ''
227) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
228) STRESS_ZX)
229) name = 'rel_disp_x'
230) units = 'm'
231) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
232) GEOMECH_REL_DISP_X)
233)
234) name = 'rel_disp_y'
235) units = 'm'
236) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
237) GEOMECH_REL_DISP_Y)
238)
239) name = 'rel_disp_z'
240) units = 'm'
241) call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
242) GEOMECH_REL_DISP_Z)
243)
244)
245) end subroutine GeomechForceSetPlotVariables
246)
247) ! ************************************************************************** !
248)
249) subroutine GeomechanicsForceInitialGuess(geomech_realization)
250) !
251) ! Sets up the inital guess for the solution
252) ! The boundary conditions are set here
253) !
254) ! Author: Satish Karra, LANL
255) ! Date: 06/19/13
256) !
257)
258) use Geomechanics_Realization_class
259) use Geomechanics_Field_module
260) use Option_module
261) use Geomechanics_Grid_Aux_module
262) use Geomechanics_Grid_module
263) use Geomechanics_Patch_module
264) use Geomechanics_Coupler_module
265) use Geomechanics_Region_module
266)
267) implicit none
268)
269) class(realization_geomech_type) :: geomech_realization
270)
271) type(option_type), pointer :: option
272) type(geomech_field_type), pointer :: field
273) type(geomech_patch_type), pointer :: patch
274) type(geomech_coupler_type), pointer :: boundary_condition
275) type(geomech_grid_type), pointer :: grid
276) type(gm_region_type), pointer :: region
277)
278) PetscInt :: ghosted_id,local_id,total_verts,ivertex
279) PetscReal, pointer :: xx_p(:)
280) PetscErrorCode :: ierr
281)
282) option => geomech_realization%option
283) field => geomech_realization%geomech_field
284) patch => geomech_realization%geomech_patch
285) grid => patch%geomech_grid
286)
287) call GeomechGridVecGetArrayF90(grid,field%disp_xx,xx_p,ierr)
288)
289) boundary_condition => patch%geomech_boundary_condition_list%first
290) total_verts = 0
291) do
292) if (.not.associated(boundary_condition)) exit
293) region => boundary_condition%region
294) do ivertex = 1, region%num_verts
295) total_verts = total_verts + 1
296) local_id = region%vertex_ids(ivertex)
297) ghosted_id = grid%nL2G(local_id)
298) if (associated(patch%imat)) then
299) if (patch%imat(ghosted_id) <= 0) cycle
300) endif
301)
302) ! X displacement
303) if (associated(boundary_condition%geomech_condition%displacement_x)) then
304) select case(boundary_condition%geomech_condition%displacement_x%itype)
305) case(DIRICHLET_BC)
306) xx_p(THREE_INTEGER*(local_id-1) + GEOMECH_DISP_X_DOF) = &
307) boundary_condition%geomech_aux_real_var(GEOMECH_DISP_X_DOF,ivertex)
308) case(ZERO_GRADIENT_BC,NEUMANN_BC)
309) ! do nothing
310) end select
311) endif
312)
313) ! Y displacement
314) if (associated(boundary_condition%geomech_condition%displacement_y)) then
315) select case(boundary_condition%geomech_condition%displacement_y%itype)
316) case(DIRICHLET_BC)
317) xx_p(THREE_INTEGER*(local_id-1) + GEOMECH_DISP_Y_DOF) = &
318) boundary_condition%geomech_aux_real_var(GEOMECH_DISP_Y_DOF,ivertex)
319) case(ZERO_GRADIENT_BC,NEUMANN_BC)
320) ! do nothing
321) end select
322) endif
323)
324) ! Z displacement
325) if (associated(boundary_condition%geomech_condition%displacement_z)) then
326) select case(boundary_condition%geomech_condition%displacement_z%itype)
327) case(DIRICHLET_BC)
328) xx_p(THREE_INTEGER*(local_id-1) + GEOMECH_DISP_Z_DOF) = &
329) boundary_condition%geomech_aux_real_var(GEOMECH_DISP_Z_DOF,ivertex)
330) case(ZERO_GRADIENT_BC,NEUMANN_BC)
331) ! do nothing
332) end select
333) endif
334)
335) enddo
336) boundary_condition => boundary_condition%next
337) enddo
338)
339) call GeomechGridVecRestoreArrayF90(grid,field%disp_xx,xx_p,ierr)
340)
341) end subroutine GeomechanicsForceInitialGuess
342)
343) ! ************************************************************************** !
344)
345) subroutine GeomechForceUpdateAuxVars(geomech_realization)
346) !
347) ! Updates the geomechanics variables
348) !
349) ! Author: Satish Karra, LANL
350) ! Date: 06/18/13
351) !
352)
353) use Geomechanics_Realization_class
354) use Geomechanics_Patch_module
355) use Option_module
356) use Geomechanics_Field_module
357) use Geomechanics_Grid_module
358) use Geomechanics_Grid_Aux_module
359) use Geomechanics_Coupler_module
360) use Geomechanics_Material_module
361) use Geomechanics_Global_Aux_module
362) use Geomechanics_Region_module
363)
364) implicit none
365)
366) class(realization_geomech_type) :: geomech_realization
367)
368) type(option_type), pointer :: option
369) type(geomech_patch_type), pointer :: patch
370) type(geomech_grid_type), pointer :: grid
371) type(geomech_field_type), pointer :: geomech_field
372) type(gm_region_type), pointer :: region
373) type(geomech_global_auxvar_type), pointer :: geomech_global_aux_vars(:)
374)
375) PetscInt :: ghosted_id, local_id
376) PetscReal, pointer :: xx_loc_p(:), xx_init_loc_p(:)
377) PetscErrorCode :: ierr
378)
379) option => geomech_realization%option
380) patch => geomech_realization%geomech_patch
381) grid => patch%geomech_grid
382) geomech_field => geomech_realization%geomech_field
383)
384) geomech_global_aux_vars => patch%geomech_aux%GeomechGlobal%aux_vars
385)
386) call GeomechGridVecGetArrayF90(grid,geomech_field%disp_xx_loc,xx_loc_p,ierr)
387) call GeomechGridVecGetArrayF90(grid,geomech_field%disp_xx_init_loc, &
388) xx_init_loc_p,ierr)
389)
390) ! Internal aux vars
391) do ghosted_id = 1, grid%ngmax_node
392) if (grid%nG2L(ghosted_id) < 0) cycle ! bypass ghosted corner cells
393) !geh - Ignore inactive cells with inactive materials
394) if (associated(patch%imat)) then
395) if (patch%imat(ghosted_id) <= 0) cycle
396) endif
397) geomech_global_aux_vars(ghosted_id)%disp_vector(GEOMECH_DISP_X_DOF) = &
398) xx_loc_p(GEOMECH_DISP_X_DOF + (ghosted_id-1)*THREE_INTEGER)
399) geomech_global_aux_vars(ghosted_id)%disp_vector(GEOMECH_DISP_Y_DOF) = &
400) xx_loc_p(GEOMECH_DISP_Y_DOF + (ghosted_id-1)*THREE_INTEGER)
401) geomech_global_aux_vars(ghosted_id)%disp_vector(GEOMECH_DISP_Z_DOF) = &
402) xx_loc_p(GEOMECH_DISP_Z_DOF + (ghosted_id-1)*THREE_INTEGER)
403)
404) geomech_global_aux_vars(ghosted_id)%rel_disp_vector(GEOMECH_DISP_X_DOF) = &
405) xx_loc_p(GEOMECH_DISP_X_DOF + (ghosted_id-1)*THREE_INTEGER) - &
406) xx_init_loc_p(GEOMECH_DISP_X_DOF + (ghosted_id-1)*THREE_INTEGER)
407) geomech_global_aux_vars(ghosted_id)%rel_disp_vector(GEOMECH_DISP_Y_DOF) = &
408) xx_loc_p(GEOMECH_DISP_Y_DOF + (ghosted_id-1)*THREE_INTEGER) - &
409) xx_init_loc_p(GEOMECH_DISP_Y_DOF + (ghosted_id-1)*THREE_INTEGER)
410) geomech_global_aux_vars(ghosted_id)%rel_disp_vector(GEOMECH_DISP_Z_DOF) = &
411) xx_loc_p(GEOMECH_DISP_Z_DOF + (ghosted_id-1)*THREE_INTEGER) - &
412) xx_init_loc_p(GEOMECH_DISP_Z_DOF + (ghosted_id-1)*THREE_INTEGER)
413) enddo
414)
415) call GeomechGridVecRestoreArrayF90(grid,geomech_field%disp_xx_loc, &
416) xx_loc_p,ierr)
417) call GeomechGridVecRestoreArrayF90(grid,geomech_field%disp_xx_init_loc, &
418) xx_init_loc_p,ierr)
419)
420)
421) end subroutine GeomechForceUpdateAuxVars
422)
423) ! ************************************************************************** !
424)
425) subroutine GeomechForceResidual(snes,xx,r,geomech_realization,ierr)
426) !
427) ! Computes the residual equation
428) !
429) ! Author: Satish Karra
430) ! Date: 06/21/13
431) !
432)
433) use Geomechanics_Realization_class
434) use Geomechanics_Field_module
435) use Geomechanics_Discretization_module
436) use Option_module
437)
438) implicit none
439)
440) SNES :: snes
441) Vec :: xx
442) Vec :: r
443) class(realization_geomech_type) :: geomech_realization
444) PetscViewer :: viewer
445) PetscErrorCode :: ierr
446)
447) type(geomech_discretization_type), pointer :: geomech_discretization
448) type(geomech_field_type), pointer :: field
449) type(option_type), pointer :: option
450)
451) field => geomech_realization%geomech_field
452) geomech_discretization => geomech_realization%geomech_discretization
453) option => geomech_realization%option
454)
455) ! Communication -----------------------------------------
456) call GeomechDiscretizationGlobalToLocal(geomech_discretization,xx, &
457) field%disp_xx_loc,NGEODOF)
458)
459) call GeomechForceResidualPatch(snes,xx,r,geomech_realization,ierr)
460)
461) if (geomech_realization%geomech_debug%vecview_residual) then
462) call PetscViewerASCIIOpen(geomech_realization%option%mycomm, &
463) 'Geomech_residual.out',viewer, &
464) ierr);CHKERRQ(ierr)
465) call VecView(r,viewer,ierr);CHKERRQ(ierr)
466) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
467)
468) endif
469)
470) if (geomech_realization%geomech_debug%vecview_solution) then
471) call PetscViewerASCIIOpen(geomech_realization%option%mycomm, &
472) 'Geomech_xx.out', &
473) viewer,ierr);CHKERRQ(ierr)
474) call VecView(xx,viewer,ierr);CHKERRQ(ierr)
475) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
476) endif
477)
478) end subroutine GeomechForceResidual
479)
480) ! ************************************************************************** !
481)
482) subroutine GeomechForceResidualPatch(snes,xx,r,geomech_realization,ierr)
483) !
484) ! Computes the residual equation on a patch
485) !
486) ! Author: Satish Karra
487) ! Date: 06/24/13
488) !
489)
490) use Geomechanics_Realization_class
491) use Geomechanics_Field_module
492) use Geomechanics_Discretization_module
493) use Geomechanics_Patch_module
494) use Geomechanics_Grid_Aux_module
495) use Geomechanics_Grid_module
496) use Grid_Unstructured_Cell_module
497) use Geomechanics_Region_module
498) use Geomechanics_Coupler_module
499) use Option_module
500) use Geomechanics_Auxiliary_module
501)
502) implicit none
503)
504) SNES :: snes
505) Vec :: xx
506) Vec :: r
507) class(realization_geomech_type) :: geomech_realization
508) PetscViewer :: viewer
509) PetscErrorCode :: ierr
510)
511) type(geomech_discretization_type), pointer :: geomech_discretization
512) type(geomech_patch_type), pointer :: patch
513) type(geomech_field_type), pointer :: field
514) type(geomech_grid_type), pointer :: grid
515) type(geomech_global_auxvar_type), pointer :: geomech_global_aux_vars(:)
516) type(option_type), pointer :: option
517) type(gm_region_type), pointer :: region
518) type(geomech_coupler_type), pointer :: boundary_condition
519) type(geomech_parameter_type), pointer :: GeomechParam
520)
521) PetscInt, allocatable :: elenodes(:)
522) PetscReal, allocatable :: local_coordinates(:,:)
523) PetscReal, allocatable :: local_disp(:,:)
524) PetscReal, allocatable :: local_press(:), local_temp(:)
525) PetscInt, allocatable :: petsc_ids(:)
526) PetscInt, allocatable :: ids(:)
527) PetscReal, allocatable :: res_vec(:)
528) PetscReal, pointer :: press(:), temp(:)
529) PetscReal, pointer :: press_init(:), temp_init(:)
530) PetscReal, allocatable :: beta_vec(:), alpha_vec(:)
531) PetscReal, allocatable :: density_vec(:)
532) PetscReal, allocatable :: youngs_vec(:), poissons_vec(:)
533) PetscInt :: ielem, ivertex
534) PetscInt :: ghosted_id
535) PetscInt :: eletype, idof
536) PetscInt :: petsc_id, local_id
537) PetscReal :: error_H1_global, error_L2_global
538) PetscReal :: error_L2, error_H1
539) PetscReal, pointer :: imech_loc_p(:)
540) PetscInt :: size_elenodes
541)
542) field => geomech_realization%geomech_field
543) geomech_discretization => geomech_realization%geomech_discretization
544) patch => geomech_realization%geomech_patch
545) grid => patch%geomech_grid
546) option => geomech_realization%option
547) geomech_global_aux_vars => patch%geomech_aux%GeomechGlobal%aux_vars
548) GeomechParam => patch%geomech_aux%GeomechParam
549)
550) call GeomechForceUpdateAuxVars(geomech_realization)
551) ! Add flag for the update
552)
553) call VecSet(r,0.d0,ierr);CHKERRQ(ierr)
554)
555) #if 0
556) error_H1_global = 0.d0
557) error_L2_global = 0.d0
558) #endif
559)
560) ! Get pressure and temperature from subsurface
561) call VecGetArrayF90(field%press_loc,press,ierr);CHKERRQ(ierr)
562) call VecGetArrayF90(field%temp_loc,temp,ierr);CHKERRQ(ierr)
563) call VecGetArrayF90(field%imech_loc,imech_loc_p,ierr);CHKERRQ(ierr)
564)
565) ! Get initial pressure and temperature
566) call VecGetArrayF90(field%press_init_loc,press_init,ierr);CHKERRQ(ierr)
567) call VecGetArrayF90(field%temp_init_loc,temp_init,ierr);CHKERRQ(ierr)
568)
569) ! Loop over elements on a processor
570) do ielem = 1, grid%nlmax_elem
571) allocate(elenodes(grid%elem_nodes(0,ielem)))
572) allocate(local_coordinates(size(elenodes),THREE_INTEGER))
573) allocate(local_disp(size(elenodes),option%ngeomechdof))
574) allocate(local_press(size(elenodes)))
575) allocate(local_temp(size(elenodes)))
576) allocate(petsc_ids(size(elenodes)))
577) allocate(ids(size(elenodes)*option%ngeomechdof))
578) allocate(res_vec(size(elenodes)*option%ngeomechdof))
579) allocate(beta_vec(size(elenodes)))
580) allocate(alpha_vec(size(elenodes)))
581) allocate(density_vec(size(elenodes)))
582) allocate(youngs_vec(size(elenodes)))
583) allocate(poissons_vec(size(elenodes)))
584) elenodes = grid%elem_nodes(1:grid%elem_nodes(0,ielem),ielem)
585) eletype = grid%gauss_node(ielem)%EleType
586) do ivertex = 1, grid%elem_nodes(0,ielem)
587) ghosted_id = elenodes(ivertex)
588) local_coordinates(ivertex,GEOMECH_DISP_X_DOF) = grid%nodes(ghosted_id)%x
589) local_coordinates(ivertex,GEOMECH_DISP_Y_DOF) = grid%nodes(ghosted_id)%y
590) local_coordinates(ivertex,GEOMECH_DISP_Z_DOF) = grid%nodes(ghosted_id)%z
591) petsc_ids(ivertex) = grid%node_ids_ghosted_petsc(ghosted_id)
592) enddo
593) do ivertex = 1, grid%elem_nodes(0,ielem)
594) ghosted_id = elenodes(ivertex)
595) do idof = 1, option%ngeomechdof
596) local_disp(ivertex,idof) = &
597) geomech_global_aux_vars(ghosted_id)%disp_vector(idof)
598) ids(idof + (ivertex-1)*option%ngeomechdof) = &
599) (petsc_ids(ivertex)-1)*option%ngeomechdof + (idof-1)
600) enddo
601) local_press(ivertex) = press(ghosted_id) - press_init(ghosted_id) ! p - p_0
602) local_temp(ivertex) = temp(ghosted_id) - temp_init(ghosted_id) ! T - T_0
603) alpha_vec(ivertex) = &
604) GeomechParam%thermal_exp_coef(int(imech_loc_p(ghosted_id)))
605) beta_vec(ivertex) = &
606) GeomechParam%biot_coef(int(imech_loc_p(ghosted_id)))
607) density_vec(ivertex) = &
608) GeomechParam%density(int(imech_loc_p(ghosted_id)))
609) youngs_vec(ivertex) = &
610) GeomechParam%youngs_modulus(int(imech_loc_p(ghosted_id)))
611) poissons_vec(ivertex) = &
612) GeomechParam%poissons_ratio(int(imech_loc_p(ghosted_id)))
613) enddo
614) size_elenodes = size(elenodes)
615) call GeomechForceLocalElemResidual(size_elenodes,local_coordinates, &
616) local_disp,local_press,local_temp,youngs_vec,poissons_vec, &
617) density_vec,beta_vec,alpha_vec,eletype, &
618) grid%gauss_node(ielem)%dim,grid%gauss_node(ielem)%r, &
619) grid%gauss_node(ielem)%w,res_vec,option)
620) call VecSetValues(r,size(ids),ids,res_vec,ADD_VALUES,ierr);CHKERRQ(ierr)
621) #if 0
622) call GeomechForceLocalElemError(size_elenodes,local_coordinates, &
623) local_disp, &
624) eletype,grid%gauss_node(ielem)%dim, &
625) grid%gauss_node(ielem)%r, &
626) grid%gauss_node(ielem)%w,error_L2, &
627) error_H1,option)
628) error_H1_global = error_H1_global + error_H1
629) error_L2_global = error_L2_global + error_L2
630) #endif
631) deallocate(elenodes)
632) deallocate(local_coordinates)
633) deallocate(local_disp)
634) deallocate(petsc_ids)
635) deallocate(ids)
636) deallocate(res_vec)
637) deallocate(local_press)
638) deallocate(local_temp)
639) deallocate(beta_vec)
640) deallocate(alpha_vec)
641) deallocate(density_vec)
642) deallocate(youngs_vec)
643) deallocate(poissons_vec)
644) enddo
645)
646) call VecRestoreArrayF90(field%press_loc,press,ierr);CHKERRQ(ierr)
647) call VecRestoreArrayF90(field%temp_loc,temp,ierr);CHKERRQ(ierr)
648) call VecRestoreArrayF90(field%imech_loc,imech_loc_p,ierr);CHKERRQ(ierr)
649)
650) call VecRestoreArrayF90(field%press_init_loc,press_init,ierr);CHKERRQ(ierr)
651) call VecRestoreArrayF90(field%temp_init_loc,temp_init,ierr);CHKERRQ(ierr)
652)
653) #if 0
654) call MPI_Allreduce(error_H1_global,error_H1_global,ONE_INTEGER_MPI, &
655) MPI_DOUBLE_PRECISION, &
656) MPI_SUM,option%mycomm,ierr)
657) call MPI_Allreduce(error_L2_global,error_L2_global,ONE_INTEGER_MPI, &
658) MPI_DOUBLE_PRECISION, &
659) MPI_SUM,option%mycomm,ierr)
660)
661) if (option%myrank == option%io_rank) then
662) print *, 'L2 error:', sqrt(error_L2_global)
663) print *, 'H1 error:', sqrt(error_H1_global)
664) endif
665) #endif
666)
667)
668) call VecAssemblyBegin(r,ierr);CHKERRQ(ierr)
669) call VecAssemblyEnd(r,ierr);CHKERRQ(ierr)
670)
671) ! Find the boundary nodes with dirichlet and set the residual at those nodes
672) ! to zero, later set the Jacobian to 1
673)
674) ! displacement boundary conditions
675) boundary_condition => patch%geomech_boundary_condition_list%first
676) do
677) if (.not.associated(boundary_condition)) exit
678) region => boundary_condition%region
679) do ivertex = 1, region%num_verts
680) local_id = region%vertex_ids(ivertex)
681) ghosted_id = grid%nL2G(local_id)
682) petsc_id = grid%node_ids_ghosted_petsc(ghosted_id)
683) if (associated(patch%imat)) then
684) if (patch%imat(ghosted_id) <= 0) cycle
685) endif
686)
687) ! X displacement
688) if (associated(boundary_condition%geomech_condition%displacement_x)) then
689) select case(boundary_condition%geomech_condition%displacement_x%itype)
690) case(DIRICHLET_BC)
691) call VecSetValue(r,(petsc_id-1)*option%ngeomechdof + &
692) GEOMECH_DISP_X_DOF-1,0.d0,INSERT_VALUES,ierr);CHKERRQ(ierr)
693) case(ZERO_GRADIENT_BC)
694) ! do nothing
695) case(NEUMANN_BC)
696) option%io_buffer = 'Neumann BC for displacement not available.'
697) call printErrMsg(option)
698) end select
699) endif
700)
701) ! Y displacement
702) if (associated(boundary_condition%geomech_condition%displacement_y)) then
703) select case(boundary_condition%geomech_condition%displacement_y%itype)
704) case(DIRICHLET_BC)
705) call VecSetValue(r,(petsc_id-1)*option%ngeomechdof + &
706) GEOMECH_DISP_Y_DOF-1,0.d0,INSERT_VALUES,ierr);CHKERRQ(ierr)
707) case(ZERO_GRADIENT_BC)
708) ! do nothing
709) case(NEUMANN_BC)
710) option%io_buffer = 'Neumann BC for displacement not available.'
711) call printErrMsg(option)
712) end select
713) endif
714)
715) ! Z displacement
716) if (associated(boundary_condition%geomech_condition%displacement_z)) then
717) select case(boundary_condition%geomech_condition%displacement_z%itype)
718) case(DIRICHLET_BC)
719) call VecSetValue(r,(petsc_id-1)*option%ngeomechdof + &
720) GEOMECH_DISP_Z_DOF-1,0.d0,INSERT_VALUES,ierr);CHKERRQ(ierr)
721) case(ZERO_GRADIENT_BC)
722) ! do nothing
723) case(NEUMANN_BC)
724) option%io_buffer = 'Neumann BC for displacement not available.'
725) call printErrMsg(option)
726) end select
727) endif
728)
729) enddo
730) boundary_condition => boundary_condition%next
731) enddo
732)
733) ! Need to assemby here since one cannot mix INSERT_VALUES
734) ! and ADD_VALUES
735) call VecAssemblyBegin(r,ierr);CHKERRQ(ierr)
736) call VecAssemblyEnd(r,ierr);CHKERRQ(ierr)
737)
738) ! Force boundary conditions
739) boundary_condition => patch%geomech_boundary_condition_list%first
740) do
741) if (.not.associated(boundary_condition)) exit
742) region => boundary_condition%region
743) do ivertex = 1, region%num_verts
744) local_id = region%vertex_ids(ivertex)
745) ghosted_id = grid%nL2G(local_id)
746) petsc_id = grid%node_ids_ghosted_petsc(ghosted_id)
747) if (associated(patch%imat)) then
748) if (patch%imat(ghosted_id) <= 0) cycle
749) endif
750)
751) ! X force
752) if (associated(boundary_condition%geomech_condition%force_x)) then
753) select case(boundary_condition%geomech_condition%force_x%itype)
754) case(DIRICHLET_BC)
755) call VecSetValue(r,(petsc_id-1)*option%ngeomechdof + &
756) GEOMECH_DISP_X_DOF-1, &
757) -boundary_condition%geomech_aux_real_var &
758) (GEOMECH_DISP_X_DOF,ivertex),ADD_VALUES,ierr);CHKERRQ(ierr)
759) case(ZERO_GRADIENT_BC)
760) ! do nothing
761) case(NEUMANN_BC)
762) option%io_buffer = 'Neumann BC for force not available.'
763) call printErrMsg(option)
764) end select
765) endif
766)
767) ! Y force
768) if (associated(boundary_condition%geomech_condition%force_y)) then
769) select case(boundary_condition%geomech_condition%force_y%itype)
770) case(DIRICHLET_BC)
771) call VecSetValue(r,(petsc_id-1)*option%ngeomechdof + &
772) GEOMECH_DISP_Y_DOF-1, &
773) -boundary_condition%geomech_aux_real_var &
774) (GEOMECH_DISP_Y_DOF,ivertex),ADD_VALUES,ierr);CHKERRQ(ierr)
775) case(ZERO_GRADIENT_BC)
776) ! do nothing
777) case(NEUMANN_BC)
778) option%io_buffer = 'Neumann BC for force not available.'
779) call printErrMsg(option)
780)
781) end select
782) endif
783)
784) ! Z force
785) if (associated(boundary_condition%geomech_condition%force_z)) then
786) select case(boundary_condition%geomech_condition%force_z%itype)
787) case(DIRICHLET_BC)
788) call VecSetValue(r,(petsc_id-1)*option%ngeomechdof + &
789) GEOMECH_DISP_Z_DOF-1, &
790) -boundary_condition%geomech_aux_real_var &
791) (GEOMECH_DISP_Z_DOF,ivertex),ADD_VALUES,ierr);CHKERRQ(ierr)
792) case(ZERO_GRADIENT_BC)
793) ! do nothing
794) case(NEUMANN_BC)
795) option%io_buffer = 'Neumann BC for force not available.'
796) call printErrMsg(option)
797) end select
798) endif
799)
800) enddo
801) boundary_condition => boundary_condition%next
802) enddo
803)
804) call VecAssemblyBegin(r,ierr);CHKERRQ(ierr)
805) call VecAssemblyEnd(r,ierr);CHKERRQ(ierr)
806)
807) end subroutine GeomechForceResidualPatch
808)
809) ! ************************************************************************** !
810)
811) subroutine GeomechForceLocalElemResidual(size_elenodes,local_coordinates, &
812) local_disp, &
813) local_press,local_temp, &
814) local_youngs,local_poissons, &
815) local_density,local_beta, &
816) local_alpha, &
817) eletype,dim,r,w,res_vec,option)
818) !
819) ! Computes the residual for a local element
820) !
821) ! Author: Satish Karra
822) ! Date: 06/24/13
823) !
824)
825) use Grid_Unstructured_Cell_module
826) use Shape_Function_module
827) use Option_module
828) use Utility_module
829)
830) type(shapefunction_type) :: shapefunction
831) type(option_type) :: option
832)
833) PetscReal, allocatable :: local_coordinates(:,:)
834) PetscReal, allocatable :: B(:,:), Kmat(:,:)
835) PetscReal, allocatable :: res_vec(:)
836) PetscReal, allocatable :: local_disp(:,:)
837) PetscReal, allocatable :: local_press(:)
838) PetscReal, allocatable :: local_temp(:)
839) PetscReal, allocatable :: local_youngs(:)
840) PetscReal, allocatable :: local_poissons(:)
841) PetscReal, allocatable :: local_density(:)
842) PetscReal, allocatable :: local_beta(:)
843) PetscReal, allocatable :: local_alpha(:)
844)
845) PetscReal, pointer :: r(:,:), w(:)
846) PetscInt :: igpt
847) PetscInt :: len_w
848) PetscInt :: eletype
849) PetscReal :: x(THREE_INTEGER), J_map(THREE_INTEGER,THREE_INTEGER)
850) PetscReal :: inv_J_map(THREE_INTEGER,THREE_INTEGER)
851) PetscReal :: detJ_map
852) PetscInt :: i,j,d
853) PetscReal :: eye_three(THREE_INTEGER)
854) PetscInt :: indx(THREE_INTEGER)
855) PetscInt :: dim
856) PetscReal :: lambda, mu, beta, alpha
857) PetscReal :: density, youngs_mod, poissons_ratio
858) PetscInt :: load_type
859) PetscReal :: bf(THREE_INTEGER)
860) PetscReal :: identity(THREE_INTEGER,THREE_INTEGER)
861) PetscReal, allocatable :: N(:,:)
862) PetscReal, allocatable :: vecB_transpose(:,:)
863) PetscReal, allocatable :: kron_B_eye(:,:)
864) PetscReal, allocatable :: kron_B_transpose_eye(:,:)
865) PetscReal, allocatable :: Trans(:,:)
866) PetscReal, allocatable :: kron_eye_B_transpose(:,:)
867) PetscReal, allocatable :: kron_N_eye(:,:)
868) PetscReal, allocatable :: vec_local_disp(:,:)
869) PetscReal, allocatable :: force(:), res_vec_mat(:,:)
870) PetscInt :: size_elenodes
871)
872) allocate(B(size_elenodes,dim))
873) allocate(Kmat(size_elenodes*option%ngeomechdof, &
874) size_elenodes*option%ngeomechdof))
875) allocate(force(size_elenodes*option%ngeomechdof))
876) allocate(res_vec_mat(size_elenodes*option%ngeomechdof,1))
877)
878) res_vec = 0.d0
879) res_vec_mat = 0.d0
880) Kmat = 0.d0
881) force = 0.d0
882) len_w = size(w)
883)
884) identity = 0.d0
885) do i = 1, THREE_INTEGER
886) do j = 1, THREE_INTEGER
887) if (i == j) identity(i,j) = 1.d0
888) enddo
889) enddo
890)
891) call Transposer(option%ngeomechdof,size_elenodes,Trans)
892)
893) do igpt = 1, len_w
894) shapefunction%EleType = eletype
895) call ShapeFunctionInitialize(shapefunction)
896) shapefunction%zeta = r(igpt,:)
897) call ShapeFunctionCalculate(shapefunction)
898) x = matmul(transpose(local_coordinates),shapefunction%N)
899) J_map = matmul(transpose(local_coordinates),shapefunction%DN)
900) allocate(N(size(shapefunction%N),ONE_INTEGER))
901) call Determinant(J_map,detJ_map)
902) if (detJ_map <= 0.d0) then
903) option%io_buffer = 'GEOMECHANICS: Determinant of J_map has' // &
904) ' to be positive!'
905) call printErrMsg(option)
906) endif
907) ! Find the inverse of J_map
908) ! Set identity matrix
909) call ludcmp(J_map,THREE_INTEGER,indx,d)
910) do i = 1, THREE_INTEGER
911) eye_three = 0.d0
912) eye_three(i) = 1.d0
913) call lubksb(J_map,THREE_INTEGER,indx,eye_three)
914) inv_J_map(:,i) = eye_three
915) enddo
916) B = matmul(shapefunction%DN,inv_J_map)
917) youngs_mod = dot_product(shapefunction%N,local_youngs)
918) poissons_ratio = dot_product(shapefunction%N,local_poissons)
919) alpha = dot_product(shapefunction%N,local_alpha)
920) beta = dot_product(shapefunction%N,local_beta)
921) density = dot_product(shapefunction%N,local_density)
922) call GeomechGetLambdaMu(lambda,mu,youngs_mod,poissons_ratio)
923) call GeomechGetBodyForce(load_type,lambda,mu,x,bf,option)
924) call ConvertMatrixToVector(transpose(B),vecB_transpose)
925) Kmat = Kmat + w(igpt)*lambda* &
926) matmul(vecB_transpose,transpose(vecB_transpose))*detJ_map
927) call Kron(B,identity,kron_B_eye)
928) call Kron(transpose(B),identity,kron_B_transpose_eye)
929) call Kron(identity,transpose(B),kron_eye_B_transpose)
930) N(:,1)= shapefunction%N
931) call Kron(N,identity,kron_N_eye)
932) Kmat = Kmat + w(igpt)*mu*matmul(kron_B_eye,kron_B_transpose_eye)*detJ_map
933) Kmat = Kmat + w(igpt)*mu* &
934) matmul(matmul(kron_B_eye,kron_eye_B_transpose),Trans)*detJ_map
935) force = force + w(igpt)*density*matmul(kron_N_eye,bf)*detJ_map
936) force = force + w(igpt)*beta*dot_product(N(:,1),local_press)* &
937) vecB_transpose(:,1)*detJ_map
938) force = force + w(igpt)*alpha*(3*lambda+2*mu)* &
939) dot_product(N(:,1),local_temp)*vecB_transpose(:,1)*detJ_map
940) call ShapeFunctionDestroy(shapefunction)
941) deallocate(N)
942) deallocate(vecB_transpose)
943) deallocate(kron_B_eye)
944) deallocate(kron_B_transpose_eye)
945) deallocate(kron_eye_B_transpose)
946) deallocate(kron_N_eye)
947) enddo
948)
949) call ConvertMatrixToVector(transpose(local_disp),vec_local_disp)
950) res_vec_mat = matmul(Kmat,vec_local_disp)
951) res_vec = res_vec + res_vec_mat(:,1)
952) res_vec = res_vec - force
953)
954) deallocate(B)
955) deallocate(force)
956) deallocate(Kmat)
957) deallocate(res_vec_mat)
958) deallocate(vec_local_disp)
959) deallocate(Trans)
960)
961) end subroutine GeomechForceLocalElemResidual
962)
963) ! ************************************************************************** !
964) !
965) ! GeomechForceLocalElemError: Computes the error for a local element
966) ! author: Satish Karra
967) ! date: 07/08/13
968) !
969) ! ************************************************************************** !
970) #if 0
971)
972) ! ************************************************************************** !
973)
974) subroutine GeomechForceLocalElemError(size_elenodes,local_coordinates, &
975) local_disp, &
976) eletype,dim,r,w,error_L2,error_H1,option)
977)
978) use Grid_Unstructured_Cell_module
979) use Shape_Function_module
980) use Option_module
981) use Utility_module
982)
983) type(shapefunction_type) :: shapefunction
984) type(option_type) :: option
985)
986)
987) PetscReal, allocatable :: local_coordinates(:,:)
988) PetscReal, allocatable :: B(:,:), Kmat(:,:)
989) PetscReal, allocatable :: res_vec(:)
990) PetscReal, allocatable :: local_disp(:,:)
991) PetscReal, pointer :: r(:,:), w(:)
992) PetscInt :: igpt
993) PetscInt :: len_w
994) PetscInt :: eletype
995) PetscReal :: x(THREE_INTEGER), J_map(THREE_INTEGER,THREE_INTEGER)
996) PetscReal :: u(THREE_INTEGER)
997) PetscReal :: inv_J_map(THREE_INTEGER,THREE_INTEGER)
998) PetscReal :: detJ_map
999) PetscInt :: i,j,d
1000) PetscReal :: eye_three(THREE_INTEGER)
1001) PetscInt :: indx(THREE_INTEGER)
1002) PetscInt :: dim
1003) PetscReal :: lambda, mu
1004) PetscInt :: load_type
1005) PetscReal :: bf(THREE_INTEGER)
1006) PetscReal :: identity(THREE_INTEGER,THREE_INTEGER)
1007) PetscReal :: den_rock
1008) PetscReal :: grad_u(THREE_INTEGER,THREE_INTEGER)
1009) PetscReal :: grad_u_exact(THREE_INTEGER,THREE_INTEGER)
1010) PetscReal :: u_exact(THREE_INTEGER)
1011) PetscReal :: error_H1, error_L2
1012) PetscReal :: trace_disp, trace_disp_grad
1013)
1014) allocate(B(size_elenodes,dim))
1015)
1016) error_H1 = 0.d0
1017) error_L2 = 0.d0
1018)
1019) len_w = size(w)
1020)
1021) identity = 0.d0
1022) do i = 1, THREE_INTEGER
1023) do j = 1, THREE_INTEGER
1024) if (i == j) identity(i,j) = 1.d0
1025) enddo
1026) enddo
1027)
1028) do igpt = 1, len_w
1029) shapefunction%EleType = eletype
1030) call ShapeFunctionInitialize(shapefunction)
1031) shapefunction%zeta = r(igpt,:)
1032) call ShapeFunctionCalculate(shapefunction)
1033) x = matmul(transpose(local_coordinates),shapefunction%N)
1034) J_map = matmul(transpose(local_coordinates),shapefunction%DN)
1035) u = matmul(transpose(local_disp),shapefunction%N)
1036) call Determinant(J_map,detJ_map)
1037) if (detJ_map <= 0.d0) then
1038) option%io_buffer = 'GEOMECHANICS: Determinant of J_map has' // &
1039) ' to be positive!'
1040) call printErrMsg(option)
1041) endif
1042) ! Find the inverse of J_map
1043) ! Set identity matrix
1044) call ludcmp(J_map,THREE_INTEGER,indx,d)
1045) do i = 1, THREE_INTEGER
1046) eye_three = 0.d0
1047) eye_three(i) = 1.d0
1048) call lubksb(J_map,THREE_INTEGER,indx,eye_three)
1049) inv_J_map(:,i) = eye_three
1050) enddo
1051) B = matmul(shapefunction%DN,inv_J_map)
1052) grad_u = matmul(transpose(local_disp),B)
1053) call GeomechGetLambdaMu(lambda,mu,x)
1054) load_type = 2 ! Need to change
1055) call GeomechGetBodyForce(load_type,lambda,mu,x,bf,option)
1056) call GetAnalytical(load_type,lambda,mu,x,u_exact,grad_u_exact)
1057) trace_disp = 0.d0
1058) do i = 1,3
1059) trace_disp = trace_disp + (u_exact(i) - u(i))**2
1060) enddo
1061) error_L2 = error_L2 + w(igpt)*trace_disp*detJ_map
1062) trace_disp_grad = 0.d0
1063) do i = 1,3
1064) do j = 1,3
1065) trace_disp_grad = trace_disp_grad + (grad_u_exact(i,j) - grad_u(i,j))**2
1066) enddo
1067) enddo
1068) error_H1 = error_H1 + w(igpt)*trace_disp_grad*detJ_map
1069) call ShapeFunctionDestroy(shapefunction)
1070) enddo
1071)
1072) deallocate(B)
1073)
1074) end subroutine GeomechForceLocalElemError
1075) #endif
1076)
1077) ! ************************************************************************** !
1078)
1079) subroutine GetAnalytical(load_type,lambda,mu,coord,u,grad_u)
1080) !
1081) ! GeomechGetBodyForce: Gets the body force at a given position
1082) ! of the point
1083) !
1084) ! Author: Satish Karra
1085) ! Date: 06/24/13
1086) !
1087)
1088) PetscReal :: lambda, mu
1089) PetscReal :: coord(THREE_INTEGER)
1090) PetscReal :: u(THREE_INTEGER)
1091) PetscReal :: grad_u(THREE_INTEGER,THREE_INTEGER)
1092) PetscInt :: load_type
1093) PetscReal :: x, y, z
1094)
1095) x = coord(1)
1096) y = coord(2)
1097) z = coord(3)
1098)
1099) select case(load_type)
1100) case(2)
1101) u(1) = 2*y*(x+y+z)
1102) u(2) = 4*x-y**2-z**2
1103) u(3) = sin(PI*x)*sin(PI*y)*sin(PI*z)
1104) grad_u(1,1) = 2*y
1105) grad_u(1,2) = 2*x + 4*y + 2*z
1106) grad_u(1,3) = 2*y
1107) grad_u(2,1) = 4
1108) grad_u(2,2) = (-2)*y
1109) grad_u(2,3) = (-2)*z
1110) grad_u(3,1) = PI*cos(PI*x)*sin(PI*y)*sin(PI*z)
1111) grad_u(3,2) = PI*cos(PI*y)*sin(PI*x)*sin(PI*z)
1112) grad_u(3,3) = PI*cos(PI*z)*sin(PI*x)*sin(PI*y)
1113) case default
1114) end select
1115)
1116) end subroutine GetAnalytical
1117)
1118) ! ************************************************************************** !
1119)
1120) subroutine GeomechForceLocalElemJacobian(size_elenodes,local_coordinates, &
1121) local_disp, &
1122) local_youngs,local_poissons, &
1123) eletype,dim,r,w,Kmat,option)
1124) !
1125) ! Computes the Jacobian for a local element
1126) !
1127) ! Author: Satish Karra
1128) ! Date: 06/24/13
1129) !
1130)
1131) use Grid_Unstructured_Cell_module
1132) use Shape_Function_module
1133) use Option_module
1134) use Utility_module
1135)
1136) type(shapefunction_type) :: shapefunction
1137) type(option_type) :: option
1138)
1139) PetscReal, allocatable :: local_coordinates(:,:)
1140) PetscReal, allocatable :: B(:,:), Kmat(:,:)
1141) PetscReal, allocatable :: local_disp(:)
1142) PetscReal, pointer :: r(:,:), w(:)
1143) PetscInt :: igpt
1144) PetscInt :: len_w
1145) PetscInt :: eletype
1146) PetscReal :: x(THREE_INTEGER), J_map(THREE_INTEGER,THREE_INTEGER)
1147) PetscReal :: inv_J_map(THREE_INTEGER,THREE_INTEGER)
1148) PetscReal :: detJ_map
1149) PetscInt :: i,j,d
1150) PetscReal :: eye_three(THREE_INTEGER)
1151) PetscInt :: indx(THREE_INTEGER)
1152) PetscInt :: dim
1153) PetscReal :: lambda, mu
1154) PetscReal :: youngs_mod, poissons_ratio
1155) PetscReal :: identity(THREE_INTEGER,THREE_INTEGER)
1156) PetscReal, allocatable :: N(:,:)
1157) PetscReal, allocatable :: vecB_transpose(:,:)
1158) PetscReal, allocatable :: kron_B_eye(:,:)
1159) PetscReal, allocatable :: kron_B_transpose_eye(:,:)
1160) PetscReal, allocatable :: Trans(:,:)
1161) PetscReal, allocatable :: kron_eye_B_transpose(:,:)
1162) PetscReal, allocatable :: kron_N_eye(:,:)
1163) PetscReal, allocatable :: local_youngs(:)
1164) PetscReal, allocatable :: local_poissons(:)
1165) PetscInt :: size_elenodes
1166)
1167) allocate(B(size_elenodes,dim))
1168)
1169) Kmat = 0.d0
1170) len_w = size(w)
1171)
1172) identity = 0.d0
1173) do i = 1, THREE_INTEGER
1174) do j = 1, THREE_INTEGER
1175) if (i == j) identity(i,j) = 1.d0
1176) enddo
1177) enddo
1178)
1179) call Transposer(option%ngeomechdof,size_elenodes,Trans)
1180)
1181) do igpt = 1, len_w
1182) shapefunction%EleType = eletype
1183) call ShapeFunctionInitialize(shapefunction)
1184) shapefunction%zeta = r(igpt,:)
1185) call ShapeFunctionCalculate(shapefunction)
1186) x = matmul(transpose(local_coordinates),shapefunction%N)
1187) J_map = matmul(transpose(local_coordinates),shapefunction%DN)
1188) allocate(N(size(shapefunction%N),ONE_INTEGER))
1189) call Determinant(J_map,detJ_map)
1190) if (detJ_map <= 0.d0) then
1191) option%io_buffer = 'GEOMECHANICS: Determinant of J_map has' // &
1192) ' to be positive!'
1193) call printErrMsg(option)
1194) endif
1195) ! Find the inverse of J_map
1196) ! Set identity matrix
1197) call ludcmp(J_map,THREE_INTEGER,indx,d)
1198) do i = 1, THREE_INTEGER
1199) eye_three = 0.d0
1200) eye_three(i) = 1.d0
1201) call lubksb(J_map,THREE_INTEGER,indx,eye_three)
1202) inv_J_map(:,i) = eye_three
1203) enddo
1204) B = matmul(shapefunction%DN,inv_J_map)
1205) youngs_mod = dot_product(shapefunction%N,local_youngs)
1206) poissons_ratio = dot_product(shapefunction%N,local_poissons)
1207) call GeomechGetLambdaMu(lambda,mu,youngs_mod,poissons_ratio)
1208) call ConvertMatrixToVector(transpose(B),vecB_transpose)
1209) Kmat = Kmat + w(igpt)*lambda* &
1210) matmul(vecB_transpose,transpose(vecB_transpose))*detJ_map
1211) call Kron(B,identity,kron_B_eye)
1212) call Kron(transpose(B),identity,kron_B_transpose_eye)
1213) call Kron(identity,transpose(B),kron_eye_B_transpose)
1214) N(:,1)= shapefunction%N
1215) call Kron(N,identity,kron_N_eye)
1216) Kmat = Kmat + w(igpt)*mu* &
1217) matmul(kron_B_eye,kron_B_transpose_eye)*detJ_map
1218) Kmat = Kmat + w(igpt)*mu* &
1219) matmul(matmul(kron_B_eye,kron_eye_B_transpose),Trans)*detJ_map
1220) call ShapeFunctionDestroy(shapefunction)
1221) deallocate(N)
1222) deallocate(vecB_transpose)
1223) deallocate(kron_B_eye)
1224) deallocate(kron_B_transpose_eye)
1225) deallocate(kron_eye_B_transpose)
1226) deallocate(kron_N_eye)
1227) enddo
1228)
1229) deallocate(B)
1230) deallocate(Trans)
1231)
1232) end subroutine GeomechForceLocalElemJacobian
1233)
1234) ! ************************************************************************** !
1235)
1236) subroutine GeomechGetLambdaMu(lambda,mu,E,nu)
1237) !
1238) ! Gets the material properties given the position
1239) ! of the point
1240) !
1241) ! Author: Satish Karra
1242) ! Date: 06/24/13
1243) !
1244)
1245) PetscReal :: lambda, mu
1246) PetscReal :: E, nu
1247) PetscReal :: coord(THREE_INTEGER)
1248)
1249) lambda = E*nu/(1.d0+nu)/(1.d0-2.d0*nu)
1250) mu = E/2.d0/(1.d0+nu)
1251)
1252)
1253) end subroutine GeomechGetLambdaMu
1254)
1255) ! ************************************************************************** !
1256)
1257) subroutine GeomechGetBodyForce(load_type,lambda,mu,coord,bf,option)
1258) !
1259) ! Gets the body force at a given position
1260) ! of the point
1261) !
1262) ! Author: Satish Karra
1263) ! Date: 06/24/13
1264) !
1265)
1266) use Option_module
1267)
1268) type(option_type) :: option
1269)
1270) PetscInt :: load_type
1271) PetscReal :: lambda, mu, den_rock
1272) PetscReal :: coord(THREE_INTEGER)
1273) PetscReal :: bf(THREE_INTEGER)
1274) PetscReal :: x, y, z
1275)
1276) bf = 0.d0
1277)
1278) x = coord(1)
1279) y = coord(2)
1280) z = coord(3)
1281)
1282) ! This subroutine needs major changes. For given position, it needs to give
1283) ! out lambda, mu, also need to add density of rock
1284)
1285)
1286) select case(load_type)
1287) case default
1288) bf(GEOMECH_DISP_X_DOF) = option%geomech_gravity(X_DIRECTION)
1289) bf(GEOMECH_DISP_Y_DOF) = option%geomech_gravity(Y_DIRECTION)
1290) bf(GEOMECH_DISP_Z_DOF) = option%geomech_gravity(Z_DIRECTION)
1291) end select
1292)
1293) end subroutine GeomechGetBodyForce
1294)
1295) ! ************************************************************************** !
1296)
1297) subroutine GeomechForceJacobian(snes,xx,A,B,geomech_realization,ierr)
1298) !
1299) ! Computes the Jacobian
1300) !
1301) ! Author: Satish Karra
1302) ! Date: 06/21/13
1303) !
1304)
1305) use Geomechanics_Realization_class
1306) use Geomechanics_Patch_module
1307) use Geomechanics_Grid_module
1308) use Geomechanics_Grid_Aux_module
1309) use Option_module
1310)
1311) implicit none
1312)
1313) SNES :: snes
1314) Vec :: xx
1315) Mat :: A, B
1316) class(realization_geomech_type) :: geomech_realization
1317) PetscErrorCode :: ierr
1318)
1319) Mat :: J
1320) MatType :: mat_type
1321) PetscViewer :: viewer
1322) type(geomech_grid_type), pointer :: grid
1323) type(option_type), pointer :: option
1324) PetscReal :: norm
1325)
1326) option => geomech_realization%option
1327)
1328) call MatGetType(A,mat_type,ierr);CHKERRQ(ierr)
1329) if (mat_type == MATMFFD) then
1330) J = B
1331) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
1332) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
1333) else
1334) J = A
1335) endif
1336)
1337) call GeomechForceJacobianPatch(snes,xx,J,J,geomech_realization,ierr)
1338)
1339) if (geomech_realization%geomech_debug%matview_Jacobian) then
1340) call PetscViewerASCIIOpen(geomech_realization%option%mycomm, &
1341) 'Geomech_jacobian.out', &
1342) viewer,ierr);CHKERRQ(ierr)
1343)
1344) call MatView(J,viewer,ierr);CHKERRQ(ierr)
1345) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
1346) endif
1347) if (geomech_realization%geomech_debug%norm_Jacobian) then
1348) option => geomech_realization%option
1349) call MatNorm(J,NORM_1,norm,ierr);CHKERRQ(ierr)
1350) write(option%io_buffer,'("1 norm: ",es11.4)') norm
1351) call printMsg(option)
1352) call MatNorm(J,NORM_FROBENIUS,norm,ierr);CHKERRQ(ierr)
1353) write(option%io_buffer,'("2 norm: ",es11.4)') norm
1354) call printMsg(option)
1355) call MatNorm(J,NORM_INFINITY,norm,ierr);CHKERRQ(ierr)
1356) write(option%io_buffer,'("inf norm: ",es11.4)') norm
1357) call printMsg(option)
1358) endif
1359)
1360) end subroutine GeomechForceJacobian
1361)
1362) ! ************************************************************************** !
1363)
1364) subroutine GeomechForceJacobianPatch(snes,xx,A,B,geomech_realization,ierr)
1365) !
1366) ! Computes the nonlinear part of the Jacobian on a patch
1367) !
1368) ! Author: Satish Karra
1369) ! Date: 06/21/13
1370) ! Modified: 07/12/16
1371)
1372) use Geomechanics_Realization_class
1373)
1374) implicit none
1375)
1376) SNES, intent(in) :: snes
1377) Vec, intent(in) :: xx
1378) Mat, intent(inout) :: A
1379) Mat, intent(out) :: B
1380) PetscViewer :: viewer
1381)
1382) PetscErrorCode :: ierr
1383)
1384) class(realization_geomech_type) :: geomech_realization
1385)
1386) ! Do nothing here since Jacobian is always linear and is computed
1387) ! once at the setup of geomechanics realization
1388)
1389) end subroutine GeomechForceJacobianPatch
1390)
1391) ! ************************************************************************** !
1392)
1393) subroutine GeomechForceJacobianLinearPart(A,geomech_realization)
1394) !
1395) ! Computes the Linear part of the Jacobian on a patch
1396) !
1397) ! Author: Satish Karra
1398) ! Date: 06/21/13
1399) ! Modified: 07/12/16
1400) !
1401)
1402) use Geomechanics_Realization_class
1403) use Geomechanics_Patch_module
1404) use Geomechanics_Grid_module
1405) use Geomechanics_Grid_Aux_module
1406) use Geomechanics_Coupler_module
1407) use Geomechanics_Field_module
1408) use Geomechanics_Debug_module
1409) use Geomechanics_Discretization_module
1410) use Option_module
1411) use Grid_Unstructured_Cell_module
1412) use Geomechanics_Region_module
1413) use Geomechanics_Auxiliary_module
1414)
1415) implicit none
1416)
1417) Mat :: A
1418) PetscViewer :: viewer
1419)
1420) PetscErrorCode :: ierr
1421)
1422) class(realization_geomech_type) :: geomech_realization
1423) type(geomech_discretization_type), pointer :: geomech_discretization
1424) type(geomech_patch_type), pointer :: patch
1425) type(geomech_field_type), pointer :: field
1426) type(geomech_grid_type), pointer :: grid
1427) type(geomech_global_auxvar_type), pointer :: geomech_global_aux_vars(:)
1428) type(option_type), pointer :: option
1429) type(gm_region_type), pointer :: region
1430) type(geomech_coupler_type), pointer :: boundary_condition
1431) type(geomech_parameter_type), pointer :: GeomechParam
1432)
1433) PetscInt, allocatable :: elenodes(:)
1434) PetscReal, allocatable :: local_coordinates(:,:)
1435) PetscReal, allocatable :: local_disp(:)
1436) PetscInt, allocatable :: ghosted_ids(:)
1437) PetscReal, allocatable :: Jac_full(:,:)
1438) PetscReal, allocatable :: Jac_sub_mat(:,:)
1439) PetscInt, allocatable :: rows(:)
1440) PetscReal, allocatable :: youngs_vec(:), poissons_vec(:)
1441) PetscInt :: ielem,ivertex
1442) PetscInt :: ghosted_id
1443) PetscInt :: eletype, idof
1444) PetscInt :: local_id, petsc_id
1445) PetscInt :: ghosted_id1, ghosted_id2
1446) PetscInt :: petsc_id1, petsc_id2
1447) PetscInt :: id1, id2, i, j, vertex_count, count
1448) PetscReal, pointer :: imech_loc_p(:)
1449) PetscInt :: size_elenodes
1450)
1451) field => geomech_realization%geomech_field
1452) geomech_discretization => geomech_realization%geomech_discretization
1453) patch => geomech_realization%geomech_patch
1454) grid => patch%geomech_grid
1455) option => geomech_realization%option
1456) geomech_global_aux_vars => patch%geomech_aux%GeomechGlobal%aux_vars
1457) GeomechParam => patch%geomech_aux%GeomechParam
1458)
1459) call MatZeroEntries(A,ierr);CHKERRQ(ierr)
1460) call VecGetArrayF90(field%imech_loc,imech_loc_p,ierr);CHKERRQ(ierr)
1461)
1462) ! Loop over elements on a processor
1463) do ielem = 1, grid%nlmax_elem
1464) allocate(elenodes(grid%elem_nodes(0,ielem)))
1465) allocate(local_coordinates(size(elenodes),THREE_INTEGER))
1466) allocate(local_disp(size(elenodes)*option%ngeomechdof))
1467) allocate(ghosted_ids(size(elenodes)))
1468) allocate(Jac_full(size(elenodes)*option%ngeomechdof, &
1469) size(elenodes)*option%ngeomechdof))
1470) allocate(Jac_sub_mat(option%ngeomechdof,option%ngeomechdof))
1471) allocate(youngs_vec(size(elenodes)))
1472) allocate(poissons_vec(size(elenodes)))
1473) elenodes = grid%elem_nodes(1:grid%elem_nodes(0,ielem),ielem)
1474) eletype = grid%gauss_node(ielem)%EleType
1475) do ivertex = 1, grid%elem_nodes(0,ielem)
1476) ghosted_id = elenodes(ivertex)
1477) local_coordinates(ivertex,GEOMECH_DISP_X_DOF) = grid%nodes(ghosted_id)%x
1478) local_coordinates(ivertex,GEOMECH_DISP_Y_DOF) = grid%nodes(ghosted_id)%y
1479) local_coordinates(ivertex,GEOMECH_DISP_Z_DOF) = grid%nodes(ghosted_id)%z
1480) ghosted_ids(ivertex) = ghosted_id
1481) enddo
1482) do ivertex = 1, grid%elem_nodes(0,ielem)
1483) ghosted_id = elenodes(ivertex)
1484) do idof = 1, option%ngeomechdof
1485) local_disp(idof + (ivertex-1)*option%ngeomechdof) = &
1486) geomech_global_aux_vars(ghosted_id)%disp_vector(idof)
1487) enddo
1488) youngs_vec(ivertex) = &
1489) GeomechParam%youngs_modulus(int(imech_loc_p(ghosted_id)))
1490) poissons_vec(ivertex) = &
1491) GeomechParam%poissons_ratio(int(imech_loc_p(ghosted_id)))
1492) enddo
1493) size_elenodes = size(elenodes)
1494) call GeomechForceLocalElemJacobian(size_elenodes,local_coordinates, &
1495) local_disp,youngs_vec,poissons_vec,eletype, &
1496) grid%gauss_node(ielem)%dim,grid%gauss_node(ielem)%r, &
1497) grid%gauss_node(ielem)%w,Jac_full,option)
1498) do id1 = 1, size(ghosted_ids)
1499) ghosted_id1 = ghosted_ids(id1)
1500) petsc_id1 = grid%node_ids_ghosted_petsc(ghosted_id1)
1501) do id2 = 1, size(ghosted_ids)
1502) ghosted_id2 = ghosted_ids(id2)
1503) petsc_id2 = grid%node_ids_ghosted_petsc(ghosted_id2)
1504) Jac_sub_mat = 0.d0
1505) Jac_sub_mat = &
1506) Jac_full(option%ngeomechdof*(id1-1)+GEOMECH_DISP_X_DOF: &
1507) option%ngeomechdof*(id1-1)+GEOMECH_DISP_Z_DOF, &
1508) option%ngeomechdof*(id2-1)+GEOMECH_DISP_X_DOF: &
1509) option%ngeomechdof*(id2-1)+GEOMECH_DISP_Z_DOF)
1510)
1511) call MatSetValuesBlocked(A,1,petsc_id1-1,1,petsc_id2-1, &
1512) Jac_sub_mat,ADD_VALUES,ierr);CHKERRQ(ierr)
1513) enddo
1514) enddo
1515)
1516) deallocate(elenodes)
1517) deallocate(local_coordinates)
1518) deallocate(local_disp)
1519) deallocate(ghosted_ids)
1520) deallocate(Jac_full)
1521) deallocate(Jac_sub_mat)
1522) deallocate(youngs_vec)
1523) deallocate(poissons_vec)
1524) enddo
1525)
1526) call VecRestoreArrayF90(field%imech_loc,imech_loc_p,ierr);CHKERRQ(ierr)
1527)
1528) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
1529) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
1530)
1531) ! Find the boundary nodes with dirichlet and set the residual at those nodes
1532) ! to zero, later set the Jacobian to 1
1533)
1534) ! Find the number of boundary vertices
1535) vertex_count = 0
1536) boundary_condition => patch%geomech_boundary_condition_list%first
1537) do
1538) if (.not.associated(boundary_condition)) exit
1539) region => boundary_condition%region
1540) vertex_count = vertex_count + region%num_verts
1541) boundary_condition => boundary_condition%next
1542) enddo
1543)
1544) allocate(rows(vertex_count*option%ngeomechdof))
1545) count = 0
1546)
1547) boundary_condition => patch%geomech_boundary_condition_list%first
1548) do
1549) if (.not.associated(boundary_condition)) exit
1550) region => boundary_condition%region
1551) do ivertex = 1, region%num_verts
1552) local_id = region%vertex_ids(ivertex)
1553) ghosted_id = grid%nL2G(local_id)
1554) petsc_id = grid%node_ids_ghosted_petsc(ghosted_id)
1555) if (associated(patch%imat)) then
1556) if (patch%imat(ghosted_id) <= 0) cycle
1557) endif
1558)
1559) ! X displacement
1560) if (associated(boundary_condition%geomech_condition%displacement_x)) then
1561) select case(boundary_condition%geomech_condition%displacement_x%itype)
1562) case(DIRICHLET_BC)
1563) count = count + 1
1564) rows(count) = (ghosted_id-1)*option%ngeomechdof + &
1565) GEOMECH_DISP_X_DOF-1
1566) case(ZERO_GRADIENT_BC,NEUMANN_BC)
1567) ! do nothing
1568) end select
1569) endif
1570)
1571) ! Y displacement
1572) if (associated(boundary_condition%geomech_condition%displacement_y)) then
1573) select case(boundary_condition%geomech_condition%displacement_y%itype)
1574) case(DIRICHLET_BC)
1575) count = count + 1
1576) rows(count) = (ghosted_id-1)*option%ngeomechdof + &
1577) GEOMECH_DISP_Y_DOF-1
1578) case(ZERO_GRADIENT_BC,NEUMANN_BC)
1579) ! do nothing
1580) end select
1581) endif
1582)
1583) ! Z displacement
1584) if (associated(boundary_condition%geomech_condition%displacement_z)) then
1585) select case(boundary_condition%geomech_condition%displacement_z%itype)
1586) case(DIRICHLET_BC)
1587) count = count + 1
1588) rows(count) = (ghosted_id-1)*option%ngeomechdof + &
1589) GEOMECH_DISP_Z_DOF-1
1590) case(ZERO_GRADIENT_BC,NEUMANN_BC)
1591) ! do nothing
1592) end select
1593) endif
1594)
1595) enddo
1596) boundary_condition => boundary_condition%next
1597) enddo
1598)
1599) call MatZeroRowsLocal(A,count,rows,1.d0, &
1600) PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
1601) ierr);CHKERRQ(ierr)
1602) call MatSetOption(A,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE, &
1603) ierr);CHKERRQ(ierr)
1604) call MatStoreValues(A,ierr);CHKERRQ(ierr) ! Store the linear part of Jacobian
1605)
1606) deallocate(rows)
1607)
1608) end subroutine GeomechForceJacobianLinearPart
1609)
1610) ! ************************************************************************** !
1611)
1612) subroutine GeomechUpdateFromSubsurf(realization,geomech_realization)
1613) !
1614) ! The pressure/temperature from subsurface are
1615) ! mapped to geomech
1616) !
1617) ! Author: Satish Karra, LANL
1618) ! Date: 09/10/13
1619) !
1620)
1621) use Realization_Subsurface_class
1622) use Grid_module
1623) use Field_module
1624) use Geomechanics_Realization_class
1625) use Geomechanics_Grid_module
1626) use Geomechanics_Grid_Aux_module
1627) use Geomechanics_Field_module
1628) use Geomechanics_Discretization_module
1629) use Option_module
1630)
1631) implicit none
1632)
1633) class(realization_subsurface_type) :: realization
1634) class(realization_geomech_type) :: geomech_realization
1635) type(grid_type), pointer :: grid
1636) type(geomech_grid_type), pointer :: geomech_grid
1637) type(option_type), pointer :: option
1638) type(field_type), pointer :: field
1639) type(geomech_field_type), pointer :: geomech_field
1640) type(gmdm_ptr_type), pointer :: dm_ptr
1641)
1642) PetscErrorCode :: ierr
1643) PetscReal, pointer :: vec_p(:), xx_loc_p(:)
1644) PetscInt :: local_id, ghosted_id
1645)
1646) option => realization%option
1647) grid => realization%discretization%grid
1648) field => realization%field
1649) geomech_grid => geomech_realization%geomech_discretization%grid
1650) geomech_field => geomech_realization%geomech_field
1651)
1652) ! use the subsurface output option parameters for geomechanics as well
1653) geomech_realization%output_option%tunit = realization%output_option%tunit
1654) geomech_realization%output_option%tconv = realization%output_option%tconv
1655)
1656) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_realization% &
1657) geomech_discretization, &
1658) ONEDOF)
1659)
1660)
1661) ! pressure
1662) call VecGetArrayF90(field%flow_xx_loc,xx_loc_p,ierr);CHKERRQ(ierr)
1663) call GeomechGridVecGetArrayF90(geomech_grid, &
1664) geomech_field%subsurf_vec_1dof,vec_p,ierr)
1665) do local_id = 1, grid%nlmax
1666) ghosted_id = grid%nL2G(local_id)
1667) vec_p(local_id) = xx_loc_p(option%nflowdof*(ghosted_id-1)+1)
1668) enddo
1669) call GeomechGridVecRestoreArrayF90(geomech_grid, &
1670) geomech_field%subsurf_vec_1dof,vec_p,ierr)
1671) call VecRestoreArrayF90(field%flow_xx_loc,xx_loc_p,ierr);CHKERRQ(ierr)
1672)
1673) ! Scatter the data
1674) call VecScatterBegin(dm_ptr%gmdm%scatter_subsurf_to_geomech_ndof, &
1675) geomech_field%subsurf_vec_1dof, &
1676) geomech_field%press, &
1677) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
1678) call VecScatterEnd(dm_ptr%gmdm%scatter_subsurf_to_geomech_ndof, &
1679) geomech_field%subsurf_vec_1dof, &
1680) geomech_field%press, &
1681) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
1682)
1683) ! temperature
1684) if (option%nflowdof > 1) then
1685) call VecGetArrayF90(field%flow_xx_loc,xx_loc_p,ierr);CHKERRQ(ierr)
1686) call GeomechGridVecGetArrayF90(geomech_grid, &
1687) geomech_field%subsurf_vec_1dof,vec_p,ierr)
1688) do local_id = 1, grid%nlmax
1689) ghosted_id = grid%nL2G(local_id)
1690) vec_p(local_id) = xx_loc_p(option%nflowdof*(ghosted_id-1)+2)
1691) enddo
1692) call GeomechGridVecRestoreArrayF90(geomech_grid, &
1693) geomech_field%subsurf_vec_1dof, &
1694) vec_p,ierr)
1695) call VecRestoreArrayF90(field%flow_xx_loc,xx_loc_p,ierr);CHKERRQ(ierr)
1696)
1697) ! Scatter the data
1698) call VecScatterBegin(dm_ptr%gmdm%scatter_subsurf_to_geomech_ndof, &
1699) geomech_field%subsurf_vec_1dof, &
1700) geomech_field%temp, &
1701) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
1702) call VecScatterEnd(dm_ptr%gmdm%scatter_subsurf_to_geomech_ndof, &
1703) geomech_field%subsurf_vec_1dof, &
1704) geomech_field%temp, &
1705) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
1706) endif
1707)
1708) call GeomechDiscretizationGlobalToLocal(&
1709) geomech_realization%geomech_discretization, &
1710) geomech_field%press, &
1711) geomech_field%press_loc,ONEDOF)
1712)
1713) if (option%nflowdof > 1) &
1714) call GeomechDiscretizationGlobalToLocal(&
1715) geomech_realization%geomech_discretization, &
1716) geomech_field%temp, &
1717) geomech_field%temp_loc,ONEDOF)
1718)
1719) end subroutine GeomechUpdateFromSubsurf
1720)
1721) ! ************************************************************************** !
1722)
1723) subroutine GeomechUpdateSubsurfFromGeomech(realization,geomech_realization)
1724) !
1725) ! The stresses and strains from geomech
1726) ! are mapped to subsurf.
1727) !
1728) ! Author: Satish Karra, LANL
1729) ! Date: 10/10/13
1730) !
1731)
1732) use Realization_Subsurface_class
1733) use Discretization_module
1734) use Grid_module
1735) use Field_module
1736) use Geomechanics_Realization_class
1737) use Geomechanics_Grid_module
1738) use Geomechanics_Grid_Aux_module
1739) use Geomechanics_Field_module
1740) use Geomechanics_Discretization_module
1741) use Option_module
1742)
1743) implicit none
1744)
1745) class(realization_subsurface_type) :: realization
1746) class(realization_geomech_type) :: geomech_realization
1747) type(grid_type), pointer :: grid
1748) type(geomech_grid_type), pointer :: geomech_grid
1749) type(option_type), pointer :: option
1750) type(field_type), pointer :: field
1751) type(geomech_field_type), pointer :: geomech_field
1752) type(gmdm_ptr_type), pointer :: dm_ptr
1753)
1754) PetscErrorCode :: ierr
1755)
1756) option => realization%option
1757) grid => realization%discretization%grid
1758) field => realization%field
1759) geomech_grid => geomech_realization%geomech_discretization%grid
1760) geomech_field => geomech_realization%geomech_field
1761)
1762) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_realization% &
1763) geomech_discretization, &
1764) ONEDOF)
1765)
1766) ! Scatter the strains
1767) call VecScatterBegin(dm_ptr%gmdm%scatter_geomech_to_subsurf_ndof, &
1768) geomech_field%strain, &
1769) geomech_field%strain_subsurf, &
1770) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
1771) call VecScatterEnd(dm_ptr%gmdm%scatter_geomech_to_subsurf_ndof, &
1772) geomech_field%strain, &
1773) geomech_field%strain_subsurf, &
1774) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
1775)
1776) ! Scatter the stresses
1777) call VecScatterBegin(dm_ptr%gmdm%scatter_geomech_to_subsurf_ndof, &
1778) geomech_field%stress, &
1779) geomech_field%stress_subsurf, &
1780) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
1781) call VecScatterEnd(dm_ptr%gmdm%scatter_geomech_to_subsurf_ndof, &
1782) geomech_field%stress, &
1783) geomech_field%stress_subsurf, &
1784) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
1785)
1786) ! Scatter from global to local vectors
1787) call DiscretizationGlobalToLocal(realization%discretization, &
1788) geomech_field%strain_subsurf, &
1789) geomech_field%strain_subsurf_loc, &
1790) NGEODOF)
1791) call DiscretizationGlobalToLocal(realization%discretization, &
1792) geomech_field%stress_subsurf, &
1793) geomech_field%stress_subsurf_loc, &
1794) NGEODOF)
1795)
1796) end subroutine GeomechUpdateSubsurfFromGeomech
1797)
1798) ! ************************************************************************** !
1799)
1800) subroutine GeomechCreateGeomechSubsurfVec(realization,geomech_realization)
1801) !
1802) ! Creates the MPI vector that stores the
1803) ! variables from subsurface
1804) !
1805) ! Author: Satish Karra, LANL
1806) ! Date: 09/10/13
1807) !
1808)
1809) use Grid_module
1810) use Geomechanics_Discretization_module
1811) use Geomechanics_Realization_class
1812) use Geomechanics_Grid_Aux_module
1813) use Geomechanics_Grid_module
1814) use Geomechanics_Field_module
1815) use String_module
1816) use Realization_Subsurface_class
1817) use Option_module
1818)
1819) implicit none
1820)
1821) #include "petsc/finclude/petscvec.h"
1822) #include "petsc/finclude/petscvec.h90"
1823) #include "petsc/finclude/petscmat.h"
1824) #include "petsc/finclude/petscmat.h90"
1825)
1826) class(realization_subsurface_type) :: realization
1827) class(realization_geomech_type) :: geomech_realization
1828)
1829) type(grid_type), pointer :: grid
1830) type(geomech_grid_type), pointer :: geomech_grid
1831) type(option_type), pointer :: option
1832) type(geomech_field_type), pointer :: geomech_field
1833)
1834) PetscErrorCode :: ierr
1835)
1836) option => realization%option
1837) grid => realization%discretization%grid
1838) geomech_field => geomech_realization%geomech_field
1839)
1840) call VecCreate(option%mycomm,geomech_field%subsurf_vec_1dof, &
1841) ierr);CHKERRQ(ierr)
1842) call VecSetSizes(geomech_field%subsurf_vec_1dof, &
1843) grid%nlmax,PETSC_DECIDE,ierr);CHKERRQ(ierr)
1844) call VecSetFromOptions(geomech_field%subsurf_vec_1dof,ierr);CHKERRQ(ierr)
1845)
1846) end subroutine GeomechCreateGeomechSubsurfVec
1847)
1848) ! ************************************************************************** !
1849)
1850) subroutine GeomechCreateSubsurfStressStrainVec(realization,geomech_realization)
1851) !
1852) ! Creates the subsurface stress and strain
1853) ! MPI vectors to store information from geomechanics
1854) !
1855) ! Author: Satish Karra, LANL
1856) ! Date: 10/10/13
1857) !
1858)
1859) use Grid_module
1860) use Geomechanics_Discretization_module
1861) use Geomechanics_Realization_class
1862) use Geomechanics_Grid_Aux_module
1863) use Geomechanics_Grid_module
1864) use Geomechanics_Field_module
1865) use String_module
1866) use Realization_Subsurface_class
1867) use Option_module
1868)
1869) implicit none
1870)
1871) #include "petsc/finclude/petscvec.h"
1872) #include "petsc/finclude/petscvec.h90"
1873) #include "petsc/finclude/petscmat.h"
1874) #include "petsc/finclude/petscmat.h90"
1875)
1876) class(realization_subsurface_type) :: realization
1877) class(realization_geomech_type) :: geomech_realization
1878)
1879) type(grid_type), pointer :: grid
1880) type(geomech_grid_type), pointer :: geomech_grid
1881) type(option_type), pointer :: option
1882) type(geomech_field_type), pointer :: geomech_field
1883)
1884) PetscErrorCode :: ierr
1885)
1886) option => realization%option
1887) grid => realization%discretization%grid
1888) geomech_field => geomech_realization%geomech_field
1889)
1890) ! strain
1891) call VecCreate(option%mycomm,geomech_field%strain_subsurf, &
1892) ierr);CHKERRQ(ierr)
1893) call VecSetSizes(geomech_field%strain_subsurf, &
1894) grid%nlmax*SIX_INTEGER,PETSC_DECIDE,ierr);CHKERRQ(ierr)
1895) call VecSetBlockSize(geomech_field%strain_subsurf,SIX_INTEGER, &
1896) ierr);CHKERRQ(ierr)
1897) call VecSetFromOptions(geomech_field%strain_subsurf,ierr);CHKERRQ(ierr)
1898)
1899) ! stress
1900) call VecCreate(option%mycomm,geomech_field%stress_subsurf, &
1901) ierr);CHKERRQ(ierr)
1902) call VecSetSizes(geomech_field%stress_subsurf, &
1903) grid%nlmax*SIX_INTEGER,PETSC_DECIDE,ierr);CHKERRQ(ierr)
1904) call VecSetBlockSize(geomech_field%stress_subsurf,SIX_INTEGER, &
1905) ierr);CHKERRQ(ierr)
1906) call VecSetFromOptions(geomech_field%stress_subsurf,ierr);CHKERRQ(ierr)
1907)
1908) ! strain_loc
1909) call VecCreate(PETSC_COMM_SELF,geomech_field%strain_subsurf_loc, &
1910) ierr);CHKERRQ(ierr)
1911) call VecSetSizes(geomech_field%strain_subsurf_loc, &
1912) grid%ngmax*SIX_INTEGER,PETSC_DECIDE,ierr);CHKERRQ(ierr)
1913) call VecSetBlockSize(geomech_field%strain_subsurf_loc,SIX_INTEGER, &
1914) ierr);CHKERRQ(ierr)
1915) call VecSetFromOptions(geomech_field%strain_subsurf_loc,ierr);CHKERRQ(ierr)
1916)
1917) ! stress_loc
1918) call VecCreate(PETSC_COMM_SELF,geomech_field%stress_subsurf_loc, &
1919) ierr);CHKERRQ(ierr)
1920) call VecSetSizes(geomech_field%stress_subsurf_loc, &
1921) grid%ngmax*SIX_INTEGER,PETSC_DECIDE,ierr);CHKERRQ(ierr)
1922) call VecSetBlockSize(geomech_field%stress_subsurf_loc,SIX_INTEGER, &
1923) ierr);CHKERRQ(ierr)
1924) call VecSetFromOptions(geomech_field%stress_subsurf_loc,ierr);CHKERRQ(ierr)
1925)
1926) end subroutine GeomechCreateSubsurfStressStrainVec
1927)
1928) ! ************************************************************************** !
1929)
1930) subroutine GeomechForceStressStrain(geomech_realization)
1931) !
1932) ! Computes the stress strain on a patch
1933) !
1934) ! Author: Satish Karra
1935) ! Date: 09/17/13
1936) !
1937)
1938) use Geomechanics_Realization_class
1939) use Geomechanics_Field_module
1940) use Geomechanics_Discretization_module
1941) use Geomechanics_Patch_module
1942) use Geomechanics_Grid_Aux_module
1943) use Geomechanics_Grid_module
1944) use Grid_Unstructured_Cell_module
1945) use Geomechanics_Region_module
1946) use Geomechanics_Coupler_module
1947) use Option_module
1948) use Geomechanics_Auxiliary_module
1949)
1950) implicit none
1951)
1952) class(realization_geomech_type) :: geomech_realization
1953) type(geomech_discretization_type), pointer :: geomech_discretization
1954) type(geomech_patch_type), pointer :: patch
1955) type(geomech_field_type), pointer :: field
1956) type(geomech_grid_type), pointer :: grid
1957) type(geomech_global_auxvar_type), pointer :: geomech_global_aux_vars(:)
1958) type(option_type), pointer :: option
1959) type(gm_region_type), pointer :: region
1960) type(geomech_coupler_type), pointer :: boundary_condition
1961) type(geomech_parameter_type), pointer :: GeomechParam
1962)
1963) PetscInt, allocatable :: elenodes(:)
1964) PetscReal, allocatable :: local_coordinates(:,:)
1965) PetscReal, allocatable :: local_disp(:,:)
1966) PetscInt, allocatable :: petsc_ids(:)
1967) PetscInt, allocatable :: ids(:)
1968) PetscReal, allocatable :: youngs_vec(:), poissons_vec(:)
1969) PetscReal, allocatable :: strain(:,:), stress(:,:)
1970) PetscInt, allocatable :: count(:)
1971) PetscInt :: ielem, ivertex
1972) PetscInt :: ghosted_id
1973) PetscInt :: eletype, idof
1974) PetscInt :: petsc_id, local_id
1975) PetscInt :: size_elenodes
1976) PetscReal, pointer :: imech_loc_p(:)
1977) PetscReal, pointer :: strain_loc_p(:)
1978) PetscReal, pointer :: stress_loc_p(:)
1979) PetscReal, pointer :: strain_p(:), stress_p(:)
1980) PetscReal, pointer :: no_elems_p(:)
1981)
1982) PetscErrorCode :: ierr
1983)
1984) field => geomech_realization%geomech_field
1985) geomech_discretization => geomech_realization%geomech_discretization
1986) patch => geomech_realization%geomech_patch
1987) grid => patch%geomech_grid
1988) option => geomech_realization%option
1989) geomech_global_aux_vars => patch%geomech_aux%GeomechGlobal%aux_vars
1990) GeomechParam => patch%geomech_aux%GeomechParam
1991)
1992) call VecSet(field%strain,0.d0,ierr);CHKERRQ(ierr)
1993) call VecSet(field%stress,0.d0,ierr);CHKERRQ(ierr)
1994)
1995) call VecGetArrayF90(field%imech_loc,imech_loc_p,ierr);CHKERRQ(ierr)
1996) call VecGetArrayF90(field%strain_loc,strain_loc_p,ierr);CHKERRQ(ierr)
1997) call VecGetArrayF90(field%stress_loc,stress_loc_p,ierr);CHKERRQ(ierr)
1998)
1999) strain_loc_p = 0.d0
2000) stress_loc_p = 0.d0
2001)
2002) ! Loop over elements on a processor
2003) do ielem = 1, grid%nlmax_elem
2004) allocate(elenodes(grid%elem_nodes(0,ielem)))
2005) allocate(local_coordinates(size(elenodes),THREE_INTEGER))
2006) allocate(local_disp(size(elenodes),option%ngeomechdof))
2007) allocate(petsc_ids(size(elenodes)))
2008) allocate(ids(size(elenodes)*option%ngeomechdof))
2009) allocate(youngs_vec(size(elenodes)))
2010) allocate(poissons_vec(size(elenodes)))
2011) allocate(strain(size(elenodes),SIX_INTEGER))
2012) allocate(stress(size(elenodes),SIX_INTEGER))
2013) elenodes = grid%elem_nodes(1:grid%elem_nodes(0,ielem),ielem)
2014) eletype = grid%gauss_node(ielem)%EleType
2015) do ivertex = 1, grid%elem_nodes(0,ielem)
2016) ghosted_id = elenodes(ivertex)
2017) local_coordinates(ivertex,GEOMECH_DISP_X_DOF) = grid%nodes(ghosted_id)%x
2018) local_coordinates(ivertex,GEOMECH_DISP_Y_DOF) = grid%nodes(ghosted_id)%y
2019) local_coordinates(ivertex,GEOMECH_DISP_Z_DOF) = grid%nodes(ghosted_id)%z
2020) petsc_ids(ivertex) = grid%node_ids_ghosted_petsc(ghosted_id)
2021) enddo
2022) do ivertex = 1, grid%elem_nodes(0,ielem)
2023) ghosted_id = elenodes(ivertex)
2024) do idof = 1, option%ngeomechdof
2025) local_disp(ivertex,idof) = &
2026) geomech_global_aux_vars(ghosted_id)%disp_vector(idof)
2027) ids(idof + (ivertex-1)*option%ngeomechdof) = &
2028) (petsc_ids(ivertex)-1)*option%ngeomechdof + (idof-1)
2029) enddo
2030) youngs_vec(ivertex) = &
2031) GeomechParam%youngs_modulus(int(imech_loc_p(ghosted_id)))
2032) poissons_vec(ivertex) = &
2033) GeomechParam%poissons_ratio(int(imech_loc_p(ghosted_id)))
2034) enddo
2035) size_elenodes = size(elenodes)
2036) call GeomechForceLocalElemStressStrain(size_elenodes,local_coordinates, &
2037) local_disp,youngs_vec,poissons_vec, &
2038) eletype,grid%gauss_node(ielem)%dim,strain,stress,option)
2039)
2040) do ivertex = 1, grid%elem_nodes(0,ielem)
2041) ghosted_id = elenodes(ivertex)
2042) do idof = 1, SIX_INTEGER
2043) strain_loc_p(idof + (ghosted_id-1)*SIX_INTEGER) = &
2044) strain_loc_p(idof + (ghosted_id-1)*SIX_INTEGER) + &
2045) strain(ivertex,idof)
2046) stress_loc_p(idof + (ghosted_id-1)*SIX_INTEGER) = &
2047) stress_loc_p(idof + (ghosted_id-1)*SIX_INTEGER) + &
2048) stress(ivertex,idof)
2049) enddo
2050) enddo
2051)
2052) deallocate(elenodes)
2053) deallocate(local_coordinates)
2054) deallocate(local_disp)
2055) deallocate(petsc_ids)
2056) deallocate(ids)
2057) deallocate(youngs_vec)
2058) deallocate(poissons_vec)
2059) deallocate(strain)
2060) deallocate(stress)
2061) enddo
2062)
2063) call VecRestoreArrayF90(field%imech_loc,imech_loc_p,ierr);CHKERRQ(ierr)
2064) call VecRestoreArrayF90(field%strain_loc,strain_loc_p,ierr);CHKERRQ(ierr)
2065) call VecRestoreArrayF90(field%stress_loc,stress_loc_p,ierr);CHKERRQ(ierr)
2066)
2067) call GeomechDiscretizationLocalToGlobalAdd(geomech_discretization, &
2068) field%strain_loc,field%strain, &
2069) SIX_INTEGER)
2070) call GeomechDiscretizationLocalToGlobalAdd(geomech_discretization, &
2071) field%stress_loc,field%stress, &
2072) SIX_INTEGER)
2073)
2074) ! Now take the average at each node for elements sharing the node
2075) call VecGetArrayF90(grid%no_elems_sharing_node,no_elems_p, &
2076) ierr);CHKERRQ(ierr)
2077) call VecGetArrayF90(field%strain,strain_p,ierr);CHKERRQ(ierr)
2078) call VecGetArrayF90(field%stress,stress_p,ierr);CHKERRQ(ierr)
2079) do local_id = 1, grid%nlmax_node
2080) do idof = 1, SIX_INTEGER
2081) strain_p(idof + (local_id-1)*SIX_INTEGER) = &
2082) strain_p(idof + (local_id-1)*SIX_INTEGER)/int(no_elems_p(local_id))
2083) stress_p(idof + (local_id-1)*SIX_INTEGER) = &
2084) stress_p(idof + (local_id-1)*SIX_INTEGER)/int(no_elems_p(local_id))
2085) enddo
2086) enddo
2087) call VecRestoreArrayF90(field%stress,stress_p,ierr);CHKERRQ(ierr)
2088) call VecRestoreArrayF90(field%strain,strain_p,ierr);CHKERRQ(ierr)
2089) call VecRestoreArrayF90(grid%no_elems_sharing_node,no_elems_p, &
2090) ierr);CHKERRQ(ierr)
2091)
2092) ! Now scatter back to local domains
2093) call GeomechDiscretizationGlobalToLocal(geomech_discretization, &
2094) field%strain,field%strain_loc, &
2095) SIX_INTEGER)
2096) call GeomechDiscretizationGlobalToLocal(geomech_discretization, &
2097) field%stress,field%stress_loc, &
2098) SIX_INTEGER)
2099)
2100) call VecGetArrayF90(field%strain_loc,strain_loc_p,ierr);CHKERRQ(ierr)
2101) call VecGetArrayF90(field%stress_loc,stress_loc_p,ierr);CHKERRQ(ierr)
2102) ! Copy them to global_aux_vars
2103) do ghosted_id = 1, grid%ngmax_node
2104) do idof = 1, SIX_INTEGER
2105) geomech_global_aux_vars(ghosted_id)%strain(idof) = &
2106) strain_loc_p(idof + (ghosted_id-1)*SIX_INTEGER)
2107) geomech_global_aux_vars(ghosted_id)%stress(idof) = &
2108) stress_loc_p(idof + (ghosted_id-1)*SIX_INTEGER)
2109) enddo
2110) enddo
2111) call VecRestoreArrayF90(field%strain_loc,strain_loc_p,ierr);CHKERRQ(ierr)
2112) call VecRestoreArrayF90(field%stress_loc,stress_loc_p,ierr);CHKERRQ(ierr)
2113)
2114) end subroutine GeomechForceStressStrain
2115)
2116) ! ************************************************************************** !
2117)
2118) subroutine GeomechForceLocalElemStressStrain(size_elenodes,local_coordinates, &
2119) local_disp, &
2120) local_youngs,local_poissons, &
2121) eletype,dim,strain,stress,option)
2122) !
2123) ! Computes the stress-strain for a local
2124) ! element
2125) !
2126) ! Author: Satish Karra
2127) ! Date: 09/17/13
2128) !
2129)
2130) use Grid_Unstructured_Cell_module
2131) use Shape_Function_module
2132) use Option_module
2133) use Utility_module
2134)
2135) type(shapefunction_type) :: shapefunction
2136) type(option_type) :: option
2137)
2138) PetscReal, allocatable :: local_coordinates(:,:)
2139) PetscReal, allocatable :: B(:,:), Kmat(:,:)
2140) PetscReal, allocatable :: res_vec(:)
2141) PetscReal, allocatable :: local_disp(:,:)
2142) PetscReal, allocatable :: local_youngs(:)
2143) PetscReal, allocatable :: local_poissons(:)
2144) PetscReal, allocatable :: strain(:,:)
2145) PetscReal, allocatable :: stress(:,:)
2146) PetscReal :: strain_local(NINE_INTEGER,ONE_INTEGER)
2147) PetscReal :: stress_local(NINE_INTEGER,ONE_INTEGER)
2148)
2149) PetscReal, pointer :: r(:,:), w(:)
2150) PetscInt :: ivertex
2151) PetscInt :: eletype
2152) PetscReal :: identity(THREE_INTEGER,THREE_INTEGER)
2153) PetscInt :: indx(THREE_INTEGER)
2154) PetscInt :: dim
2155) PetscInt :: i, j, d
2156) PetscReal :: lambda, mu
2157) PetscReal :: youngs_mod, poissons_ratio
2158) PetscReal, allocatable :: kron_B_eye(:,:)
2159) PetscReal, allocatable :: kron_B_transpose_eye(:,:)
2160) PetscReal, allocatable :: Trans(:,:)
2161) PetscReal, allocatable :: kron_eye_B_transpose(:,:)
2162) PetscReal, allocatable :: vec_local_disp(:,:)
2163) PetscInt :: size_elenodes
2164) PetscReal :: J_map(THREE_INTEGER,THREE_INTEGER)
2165) PetscReal :: inv_J_map(THREE_INTEGER,THREE_INTEGER)
2166) PetscReal :: eye_three(THREE_INTEGER)
2167) PetscReal :: eye_vec(NINE_INTEGER,ONE_INTEGER)
2168)
2169) allocate(B(size_elenodes,dim))
2170)
2171) call Transposer(option%ngeomechdof,size_elenodes,Trans)
2172) strain = 0.d0
2173) stress = 0.d0
2174)
2175) call ConvertMatrixToVector(transpose(local_disp),vec_local_disp)
2176)
2177) identity = 0.d0
2178) do i = 1, THREE_INTEGER
2179) do j = 1, THREE_INTEGER
2180) if (i == j) identity(i,j) = 1.d0
2181) enddo
2182) enddo
2183)
2184) eye_vec = 0.d0
2185) eye_vec(1,1) = 1.d0
2186) eye_vec(5,1) = 1.d0
2187) eye_vec(9,1) = 1.d0
2188)
2189) do ivertex = 1, size_elenodes
2190) strain_local = 0.d0
2191) stress_local = 0.d0
2192) shapefunction%EleType = eletype
2193) call ShapeFunctionInitialize(shapefunction)
2194) shapefunction%zeta = shapefunction%coord(ivertex,:)
2195) call ShapeFunctionCalculate(shapefunction)
2196) J_map = matmul(transpose(local_coordinates),shapefunction%DN)
2197) call ludcmp(J_map,THREE_INTEGER,indx,d)
2198) do i = 1, THREE_INTEGER
2199) eye_three = 0.d0
2200) eye_three(i) = 1.d0
2201) call lubksb(J_map,THREE_INTEGER,indx,eye_three)
2202) inv_J_map(:,i) = eye_three
2203) enddo
2204) B = matmul(shapefunction%DN,inv_J_map)
2205) youngs_mod = dot_product(shapefunction%N,local_youngs)
2206) poissons_ratio = dot_product(shapefunction%N,local_poissons)
2207) call GeomechGetLambdaMu(lambda,mu,youngs_mod,poissons_ratio)
2208) call Kron(B,identity,kron_B_eye)
2209) call Kron(transpose(B),identity,kron_B_transpose_eye)
2210) call Kron(identity,transpose(B),kron_eye_B_transpose)
2211) strain_local = 0.5*matmul((kron_B_transpose_eye + &
2212) matmul(kron_eye_B_transpose,Trans)),vec_local_disp)
2213) stress_local = lambda*(strain_local(1,1)+ &
2214) strain_local(5,1)+strain_local(9,1))*eye_vec + &
2215) 2*mu*strain_local
2216) call ShapeFunctionDestroy(shapefunction)
2217) deallocate(kron_B_eye)
2218) deallocate(kron_B_transpose_eye)
2219) deallocate(kron_eye_B_transpose)
2220) strain(ivertex,1) = strain_local(1,1)
2221) strain(ivertex,2) = strain_local(5,1)
2222) strain(ivertex,3) = strain_local(9,1)
2223) strain(ivertex,4) = strain_local(2,1)
2224) strain(ivertex,5) = strain_local(6,1)
2225) strain(ivertex,6) = strain_local(3,1)
2226) stress(ivertex,1) = stress_local(1,1)
2227) stress(ivertex,2) = stress_local(5,1)
2228) stress(ivertex,3) = stress_local(9,1)
2229) stress(ivertex,4) = stress_local(2,1)
2230) stress(ivertex,5) = stress_local(6,1)
2231) stress(ivertex,6) = stress_local(3,1)
2232) enddo
2233)
2234) deallocate(B)
2235) deallocate(vec_local_disp)
2236) deallocate(Trans)
2237)
2238) end subroutine GeomechForceLocalElemStressStrain
2239)
2240) ! ************************************************************************** !
2241)
2242) subroutine GeomechUpdateSolution(geomech_realization)
2243) !
2244) ! Updates data in module after a successful time
2245) ! step
2246) !
2247) ! Author: Satish Karra, LANL
2248) ! Date: 09/17/13
2249) !
2250)
2251) use Geomechanics_Realization_class
2252) use Geomechanics_Field_module
2253)
2254) implicit none
2255)
2256) class(realization_geomech_type) :: geomech_realization
2257) type(geomech_field_type), pointer :: field
2258)
2259) PetscErrorCode :: ierr
2260) PetscViewer :: viewer
2261)
2262) field => geomech_realization%geomech_field
2263)
2264) call GeomechUpdateSolutionPatch(geomech_realization)
2265)
2266) end subroutine GeomechUpdateSolution
2267)
2268) ! ************************************************************************** !
2269)
2270) subroutine GeomechUpdateSolutionPatch(geomech_realization)
2271) !
2272) ! updates data in module after a successful time
2273) ! step
2274) !
2275) ! Author: satish karra, lanl
2276) ! Date: 09/17/13
2277) !
2278)
2279) use Geomechanics_Realization_class
2280)
2281) implicit none
2282)
2283) class(realization_geomech_type) :: geomech_realization
2284)
2285) call GeomechForceStressStrain(geomech_realization)
2286)
2287) end subroutine GeomechUpdateSolutionPatch
2288)
2289) ! ************************************************************************** !
2290)
2291) subroutine GeomechStoreInitialPressTemp(geomech_realization)
2292) !
2293) ! Stores initial pressure and temperature from
2294) ! subsurface
2295) !
2296) ! Author: Satish Karra, LANL
2297) ! Date: 09/24/13
2298) !
2299)
2300) use Geomechanics_Realization_class
2301)
2302) implicit none
2303)
2304) class(realization_geomech_type) :: geomech_realization
2305)
2306) PetscErrorCode :: ierr
2307)
2308) call VecCopy(geomech_realization%geomech_field%press_loc, &
2309) geomech_realization%geomech_field%press_init_loc, &
2310) ierr);CHKERRQ(ierr)
2311)
2312) call VecCopy(geomech_realization%geomech_field%temp_loc, &
2313) geomech_realization%geomech_field%temp_init_loc, &
2314) ierr);CHKERRQ(ierr)
2315)
2316) end subroutine GeomechStoreInitialPressTemp
2317)
2318) ! ************************************************************************** !
2319)
2320) subroutine GeomechStoreInitialPorosity(realization,geomech_realization)
2321) !
2322) ! Stores initial porosity from
2323) ! subsurface
2324) !
2325) ! Author: Satish Karra, LANL
2326) ! Date: 10/22/13
2327) !
2328)
2329) use Geomechanics_Realization_class
2330) use Realization_Subsurface_class
2331) use Discretization_module
2332)
2333) implicit none
2334)
2335) class(realization_geomech_type) :: geomech_realization
2336) class(realization_subsurface_type) :: realization
2337) type(discretization_type) :: discretization
2338)
2339) PetscErrorCode :: ierr
2340)
2341) call DiscretizationDuplicateVector(discretization, &
2342) realization%field%work_loc, &
2343) geomech_realization%geomech_field% &
2344) porosity_init_loc)
2345)
2346) end subroutine GeomechStoreInitialPorosity
2347)
2348) ! ************************************************************************** !
2349)
2350) subroutine GeomechStoreInitialDisp(geomech_realization)
2351) !
2352) ! Stores initial displacement for calculating
2353) ! relative displacements
2354) !
2355) ! Author: Satish Karra, LANL
2356) ! Date: 09/30/13
2357) !
2358)
2359) use Geomechanics_Realization_class
2360)
2361) implicit none
2362)
2363) class(realization_geomech_type) :: geomech_realization
2364)
2365) PetscErrorCode :: ierr
2366)
2367) call VecCopy(geomech_realization%geomech_field%disp_xx_loc, &
2368) geomech_realization%geomech_field%disp_xx_init_loc, &
2369) ierr);CHKERRQ(ierr)
2370)
2371) end subroutine GeomechStoreInitialDisp
2372)
2373) ! ************************************************************************** !
2374)
2375) subroutine GeomechUpdateSubsurfPorosity(realization,geomech_realization)
2376) !
2377) ! Updates the porosity in the subsurface based
2378) ! on the deformation in geomechanics
2379) !
2380) ! Author: Satish Karra, LANL
2381) ! Date: 10/08/13
2382) !
2383)
2384) use Realization_Subsurface_class
2385) use Option_module
2386) use Patch_module
2387) use Field_module
2388) use Grid_module
2389) use Discretization_module
2390) use Geomechanics_Field_module
2391) use Material_Aux_class
2392) use Material_module
2393) use Variables_module, only : POROSITY
2394) use Geomechanics_Realization_class
2395)
2396) implicit none
2397)
2398) class(realization_subsurface_type) :: realization
2399) class(realization_geomech_type) :: geomech_realization
2400) type(field_type), pointer :: field
2401) type(option_type), pointer :: option
2402) type(patch_type), pointer :: patch
2403) type(geomech_field_type), pointer :: geomech_field
2404) type(grid_type), pointer :: grid
2405) class(material_auxvar_type), pointer :: material_auxvars(:)
2406)
2407) PetscReal :: trace_epsilon
2408) PetscReal, pointer :: por0_loc_p(:), strain_loc_p(:)
2409) PetscInt :: ghosted_id
2410) PetscErrorCode :: ierr
2411)
2412) option => realization%option
2413) field => realization%field
2414) patch => realization%patch
2415) grid => patch%grid
2416) geomech_field => geomech_realization%geomech_field
2417) material_auxvars => realization%patch%aux%Material%auxvars
2418)
2419) if (.not.associated(patch%imat)) then
2420) option%io_buffer = 'Materials IDs not present in run. Material ' // &
2421) ' properties cannot be updated without material ids'
2422) call printErrMsg(option)
2423) endif
2424)
2425) call VecGetArrayF90(geomech_field%porosity_init_loc,por0_loc_p, &
2426) ierr);CHKERRQ(ierr)
2427) call VecGetArrayF90(geomech_field%strain_subsurf_loc,strain_loc_p, &
2428) ierr);CHKERRQ(ierr)
2429)
2430) do ghosted_id = 1, grid%ngmax
2431) trace_epsilon = strain_loc_p((ghosted_id-1)*SIX_INTEGER+ONE_INTEGER) + &
2432) strain_loc_p((ghosted_id-1)*SIX_INTEGER+TWO_INTEGER) + &
2433) strain_loc_p((ghosted_id-1)*SIX_INTEGER+THREE_INTEGER)
2434) material_auxvars(ghosted_id)%porosity = por0_loc_p(ghosted_id)/ &
2435) (1.d0 + (1.d0 - por0_loc_p(ghosted_id))*trace_epsilon)
2436) enddo
2437)
2438) call VecRestoreArrayF90(geomech_field%porosity_init_loc,por0_loc_p, &
2439) ierr);CHKERRQ(ierr)
2440) call VecRestoreArrayF90(geomech_field%strain_subsurf_loc,strain_loc_p, &
2441) ierr);CHKERRQ(ierr)
2442)
2443) call MaterialGetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
2444) POROSITY,ZERO_INTEGER)
2445) call DiscretizationLocalToLocal(realization%discretization,field%work_loc, &
2446) field%work_loc,ONEDOF)
2447) call MaterialSetAuxVarVecLoc(patch%aux%Material,field%work_loc, &
2448) POROSITY,ZERO_INTEGER)
2449)
2450) end subroutine GeomechUpdateSubsurfPorosity
2451)
2452) end module Geomechanics_Force_module