geomechanics_condition.F90 coverage: 93.33 %func 73.04 %block
1) module Geomechanics_Condition_module
2)
3) ! use Global_Aux_module
4) use Dataset_Base_class
5) use Dataset_Ascii_class
6) use Time_Storage_module
7)
8) use PFLOTRAN_Constants_module
9)
10) implicit none
11)
12) private
13)
14) #include "petsc/finclude/petscsys.h"
15)
16) #if 0
17) !geh: no longer needed
18) PetscInt, parameter :: NULL = 0
19) PetscInt, parameter :: STEP = 1
20) PetscInt, parameter :: LINEAR = 2
21)
22) type, public :: geomech_condition_dataset_type
23) type(time_series_type), pointer :: time_series
24) class(dataset_base_type), pointer :: dataset
25) end type geomech_condition_dataset_type
26) #endif
27)
28) type, public :: geomech_condition_type
29) PetscInt :: id ! id from which condition can be referenced
30) PetscBool :: sync_time_with_update
31) character(len=MAXWORDLENGTH) :: name ! name of condition (e.g. boundary)
32) PetscInt :: num_sub_conditions
33) PetscInt, pointer :: itype(:)
34) character(len=MAXWORDLENGTH) :: time_units
35) character(len=MAXWORDLENGTH) :: length_units
36) type(time_storage_type), pointer :: default_time_storage
37) type(geomech_sub_condition_type), pointer :: displacement_x
38) type(geomech_sub_condition_type), pointer :: displacement_y
39) type(geomech_sub_condition_type), pointer :: displacement_z
40) type(geomech_sub_condition_type), pointer :: force_x ! Added force conditions 09/19/2013, SK
41) type(geomech_sub_condition_type), pointer :: force_y
42) type(geomech_sub_condition_type), pointer :: force_z
43) type(geomech_sub_condition_ptr_type), pointer :: sub_condition_ptr(:)
44) type(geomech_condition_type), pointer :: next ! pointer to next condition_type for linked-lists
45) end type geomech_condition_type
46)
47) type, public :: geomech_sub_condition_type
48) PetscInt :: itype ! integer describing type of condition
49) PetscInt :: isubtype
50) character(len=MAXWORDLENGTH) :: ctype ! character string describing type of condition
51) character(len=MAXWORDLENGTH) :: units ! units
52) character(len=MAXWORDLENGTH) :: name
53) class(dataset_base_type), pointer :: dataset
54) end type geomech_sub_condition_type
55)
56) type, public :: geomech_sub_condition_ptr_type
57) type(geomech_sub_condition_type), pointer :: ptr
58) end type geomech_sub_condition_ptr_type
59)
60) type, public :: geomech_condition_ptr_type
61) type(geomech_condition_type), pointer :: ptr
62) end type geomech_condition_ptr_type
63)
64) type, public :: geomech_condition_list_type
65) PetscInt :: num_conditions
66) type(geomech_condition_type), pointer :: first
67) type(geomech_condition_type), pointer :: last
68) type(geomech_condition_type), pointer :: array(:)
69) end type geomech_condition_list_type
70)
71) public :: GeomechConditionCreate, &
72) GeomechConditionDestroy, &
73) GeomechConditionRead, &
74) GeomechConditionAddToList, &
75) GeomechConditionInitList, &
76) GeomechConditionDestroyList, &
77) GeomechConditionGetPtrFromList, &
78) GeomechConditionUpdate, &
79) GeomechConditionPrint, &
80) GeomechConditionIsTransient
81)
82)
83) contains
84)
85) ! ************************************************************************** !
86)
87) function GeomechConditionCreate(option)
88) !
89) ! Creates a condition
90) !
91) ! Author: Satish Karra, LANL
92) ! Date: 06/07/13
93) !
94)
95) use Option_module
96)
97) implicit none
98)
99) type(option_type) :: option
100) type(geomech_condition_type), pointer :: GeomechConditionCreate
101)
102) type(geomech_condition_type), pointer :: condition
103)
104) allocate(condition)
105) nullify(condition%displacement_x)
106) nullify(condition%displacement_y)
107) nullify(condition%displacement_z)
108) nullify(condition%force_x)
109) nullify(condition%force_y)
110) nullify(condition%force_z)
111) nullify(condition%sub_condition_ptr)
112) nullify(condition%itype)
113) nullify(condition%next)
114) condition%sync_time_with_update = PETSC_FALSE
115) condition%time_units = ''
116) condition%length_units = ''
117) condition%id = 0
118) condition%num_sub_conditions = 0
119) condition%name = ''
120)
121) GeomechConditionCreate => condition
122)
123) end function GeomechConditionCreate
124)
125) ! ************************************************************************** !
126)
127) function GeomechSubConditionCreate(ndof)
128) !
129) ! Creates a sub_condition
130) !
131) ! Author: Satish Karra, LANL
132) ! Date: 06/12/13
133) !
134)
135) use Option_module
136)
137) implicit none
138)
139) type(geomech_sub_condition_type), pointer :: GeomechSubConditionCreate
140)
141) PetscInt :: ndof
142)
143) type(geomech_sub_condition_type), pointer :: sub_condition
144) class(dataset_ascii_type), pointer :: dataset_ascii
145)
146) allocate(sub_condition)
147) sub_condition%units = ''
148) sub_condition%itype = 0
149) sub_condition%isubtype = 0
150) sub_condition%ctype = ''
151) sub_condition%name = ''
152) nullify(sub_condition%dataset)
153)
154) ! by default, all dataset are of type dataset_ascii_type, unless overwritten
155) dataset_ascii => DatasetAsciiCreate()
156) call DatasetAsciiInit(dataset_ascii)
157) dataset_ascii%array_width = ndof
158) dataset_ascii%data_type = DATASET_REAL
159) sub_condition%dataset => dataset_ascii
160) nullify(dataset_ascii)
161)
162) GeomechSubConditionCreate => sub_condition
163)
164) end function GeomechSubConditionCreate
165)
166) ! ************************************************************************** !
167)
168) subroutine GeomechSubConditionVerify(option, condition, sub_condition_name, &
169) sub_condition, default_time_storage, &
170) destroy_if_null)
171) !
172) ! Verifies the data in a subcondition
173) !
174) ! Author: Satish Karra, LANL
175) ! Date: 06/12/13
176) !
177)
178) use Option_module
179) use Dataset_module
180)
181) implicit none
182)
183) type(option_type) :: option
184) type(geomech_condition_type) :: condition
185) character(len=MAXWORDLENGTH) :: sub_condition_name
186) type(geomech_sub_condition_type), pointer :: sub_condition
187) type(time_storage_type), pointer :: default_time_storage
188) PetscBool :: destroy_if_null
189)
190) if (.not.associated(sub_condition)) return
191)
192) ! dataset is not optional
193) if (.not.(associated(sub_condition%dataset%rarray) .or. &
194) associated(sub_condition%dataset%rbuffer) .or. &
195) ! if a dataset name is read, instead of data at this point
196) len_trim(sub_condition%dataset%name) > 0)) then
197) if (destroy_if_null) call GeomechSubConditionDestroy(sub_condition)
198) return
199) endif
200)
201) if (len_trim(sub_condition%ctype) == NULL_CONDITION) then
202) option%io_buffer = 'TYPE of condition ' // trim(condition%name) // &
203) ' ' // trim(sub_condition_name) // ' dataset not defined.'
204) call printErrMsg(option)
205) endif
206)
207) call DatasetVerify(sub_condition%dataset,default_time_storage,option)
208)
209) end subroutine GeomechSubConditionVerify
210)
211) ! ************************************************************************** !
212)
213) subroutine GeomechConditionRead(condition,input,option)
214) !
215) ! Reads a condition from the input file
216) !
217) ! Author: Satish Karra, LANL
218) ! Date: 06/12/13
219) !
220)
221) use Option_module
222) use Input_Aux_module
223) use String_module
224) use Condition_module
225)
226) implicit none
227)
228) type(geomech_condition_type) :: condition
229) type(input_type), pointer :: input
230) type(option_type) :: option
231)
232) character(len=MAXSTRINGLENGTH) :: string
233) character(len=MAXWORDLENGTH) :: word, internal_units
234) type(geomech_sub_condition_type), pointer :: sub_condition_ptr, &
235) displacement_x, displacement_y, &
236) displacement_z
237) type(geomech_sub_condition_type), pointer :: force_x, force_y, force_z
238) PetscReal :: default_time
239) PetscInt :: default_iphase
240) character(len=MAXWORDLENGTH) :: default_ctype
241) PetscInt :: default_itype
242) PetscInt :: array_size, idof
243) PetscBool :: found
244) PetscBool :: destroy_if_null
245) PetscErrorCode :: ierr
246) PetscInt :: num_sub_conditions
247) PetscInt :: count
248) !geh: may not need default_time_storage
249) type(time_storage_type), pointer :: default_time_storage
250)
251) default_time = 0.d0
252) default_iphase = 0
253)
254) !geh: may not need default_time_storage
255) default_time_storage => TimeStorageCreate()
256) default_time_storage%is_cyclic = PETSC_FALSE
257) default_time_storage%time_interpolation_method = INTERPOLATION_STEP
258)
259) #if 0
260) !geh: no longer needed
261) call GeomechConditionDatasetInit(default_geomech_dataset)
262) default_geomech_dataset%time_series => TimeSeriesCreate()
263) default_geomech_dataset%time_series%rank = 1
264) default_geomech_dataset%time_series%interpolation_method = STEP
265) default_geomech_dataset%time_series%is_cyclic = PETSC_FALSE
266) #endif
267)
268) displacement_x => GeomechSubConditionCreate(ONE_INTEGER)
269) displacement_y => GeomechSubConditionCreate(ONE_INTEGER)
270) displacement_z => GeomechSubConditionCreate(ONE_INTEGER)
271) force_x => GeomechSubConditionCreate(ONE_INTEGER)
272) force_y => GeomechSubConditionCreate(ONE_INTEGER)
273) force_z => GeomechSubConditionCreate(ONE_INTEGER)
274) displacement_x%name = 'displacement_x'
275) displacement_y%name = 'displacement_y'
276) displacement_z%name = 'displacement_z'
277) force_x%name = 'force_x'
278) force_y%name = 'force_y'
279) force_z%name = 'force_z'
280)
281) condition%time_units = 'yr'
282) condition%length_units = 'm'
283)
284) default_ctype = 'dirichlet'
285) default_itype = DIRICHLET_BC
286)
287) displacement_x%units = 'm'
288) displacement_y%units = 'm'
289) displacement_z%units = 'm'
290) force_x%units = 'N'
291) force_y%units = 'N'
292) force_z%units = 'N'
293)
294) default_ctype = 'dirichlet'
295) default_itype = DIRICHLET_BC
296)
297) ! read the condition
298) input%ierr = 0
299) do
300)
301) call InputReadPflotranString(input,option)
302) call InputReadStringErrorMsg(input,option,'CONDITION')
303)
304) if (InputCheckExit(input,option)) exit
305)
306) call InputReadWord(input,option,word,PETSC_TRUE)
307) call InputErrorMsg(input,option,'keyword','CONDITION')
308)
309) select case(trim(word))
310)
311) case('UNITS') ! read default units for condition arguments
312) do
313) call InputReadWord(input,option,word,PETSC_TRUE)
314) if (InputError(input)) exit
315) select case(trim(word))
316) case('s','sec','min','hr','d','day','y','yr')
317) condition%time_units = trim(word)
318) case('mm','cm','m','met','meter','dm','km')
319) condition%length_units = trim(word)
320) end select
321) enddo
322) case('CYCLIC')
323) ! by default, is_cyclic is set to PETSC_FALSE
324) default_time_storage%is_cyclic = PETSC_TRUE
325) case('SYNC_TIMESTEP_WITH_UPDATE')
326) condition%sync_time_with_update = PETSC_TRUE
327) case('INTERPOLATION')
328) call InputReadWord(input,option,word,PETSC_TRUE)
329) call InputErrorMsg(input,option,'INTERPOLATION','CONDITION')
330) call StringToLower(word)
331) select case(word)
332) case('step')
333) default_time_storage%time_interpolation_method = &
334) INTERPOLATION_STEP
335) case('linear')
336) default_time_storage%time_interpolation_method = &
337) INTERPOLATION_LINEAR
338) end select
339) case('TYPE') ! read condition type (dirichlet, neumann, etc) for each dof
340) do
341) call InputReadPflotranString(input,option)
342) call InputReadStringErrorMsg(input,option,'CONDITION')
343)
344) if (InputCheckExit(input,option)) exit
345)
346) if (InputError(input)) exit
347) call InputReadWord(input,option,word,PETSC_TRUE)
348) call InputErrorMsg(input,option,'keyword','CONDITION,TYPE')
349) call StringToUpper(word)
350) select case(trim(word))
351) case('PRESSURE')
352) case('DISPLACEMENT_X')
353) sub_condition_ptr => displacement_x
354) case('DISPLACEMENT_Y')
355) sub_condition_ptr => displacement_y
356) case('DISPLACEMENT_Z')
357) sub_condition_ptr => displacement_z
358) case('FORCE_X')
359) sub_condition_ptr => force_x
360) case('FORCE_Y')
361) sub_condition_ptr => force_y
362) case('FORCE_Z')
363) sub_condition_ptr => force_z
364) case default
365) call InputKeywordUnrecognized(word, &
366) 'geomechanics condition type',option)
367) end select
368) call InputReadWord(input,option,word,PETSC_TRUE)
369) call InputErrorMsg(input,option,'TYPE','CONDITION')
370) call StringToLower(word)
371) sub_condition_ptr%ctype = word
372) select case(word)
373) case('dirichlet')
374) sub_condition_ptr%itype = DIRICHLET_BC
375) case('neumann')
376) sub_condition_ptr%itype = NEUMANN_BC
377) case('zero_gradient')
378) sub_condition_ptr%itype = ZERO_GRADIENT_BC
379) case default
380) call InputKeywordUnrecognized(word, &
381) 'geomechanics condition bc type',option)
382) end select
383) enddo
384) case('TIME','TIMES')
385) call InputReadDouble(input,option,default_time)
386) call InputErrorMsg(input,option,'TIME','CONDITION')
387) case('DISPLACEMENT_X')
388) internal_units = 'meter'
389) call ConditionReadValues(input,option,word, &
390) displacement_x%dataset, &
391) displacement_x%units, &
392) internal_units)
393) case('DISPLACEMENT_Y')
394) internal_units = 'meter'
395) call ConditionReadValues(input,option,word, &
396) displacement_y%dataset, &
397) displacement_y%units, &
398) internal_units)
399) case('DISPLACEMENT_Z')
400) internal_units = 'meter'
401) call ConditionReadValues(input,option,word, &
402) displacement_z%dataset, &
403) displacement_z%units, &
404) internal_units)
405) case('FORCE_X')
406) internal_units = 'N'
407) call ConditionReadValues(input,option,word, &
408) force_x%dataset, &
409) force_x%units, &
410) internal_units)
411) case('FORCE_Y')
412) internal_units = 'N'
413) call ConditionReadValues(input,option,word, &
414) force_y%dataset, &
415) force_y%units, &
416) internal_units)
417) case('FORCE_Z')
418) internal_units = 'N'
419) call ConditionReadValues(input,option,word, &
420) force_z%dataset, &
421) force_z%units, &
422) internal_units)
423) case default
424) call InputKeywordUnrecognized(word, &
425) 'geomechanics condition',option)
426) end select
427)
428) enddo
429)
430) word = 'displacement_x'
431) call GeomechSubConditionVerify(option,condition,word,displacement_x, &
432) default_time_storage, &
433) PETSC_TRUE)
434) word = 'displacement_y'
435) call GeomechSubConditionVerify(option,condition,word,displacement_y, &
436) default_time_storage, &
437) PETSC_TRUE)
438) word = 'displacement_z'
439) call GeomechSubConditionVerify(option,condition,word,displacement_z, &
440) default_time_storage, &
441) PETSC_TRUE)
442)
443) word = 'force_x'
444) call GeomechSubConditionVerify(option,condition,word,force_x, &
445) default_time_storage, &
446) PETSC_TRUE)
447)
448) word = 'force_y'
449) call GeomechSubConditionVerify(option,condition,word,force_y, &
450) default_time_storage, &
451) PETSC_TRUE)
452)
453) word = 'force_z'
454) call GeomechSubConditionVerify(option,condition,word,force_z, &
455) default_time_storage, &
456) PETSC_TRUE)
457)
458)
459)
460) num_sub_conditions = 0
461) if (associated(displacement_x)) then
462) condition%displacement_x => displacement_x
463) num_sub_conditions = num_sub_conditions + 1
464) condition%displacement_x%isubtype = ONE_INTEGER
465) endif
466)
467) if (associated(displacement_y)) then
468) condition%displacement_y => displacement_y
469) num_sub_conditions = num_sub_conditions + 1
470) condition%displacement_y%isubtype = TWO_INTEGER
471) endif
472)
473) if (associated(displacement_z)) then
474) condition%displacement_z => displacement_z
475) num_sub_conditions = num_sub_conditions + 1
476) condition%displacement_z%isubtype = THREE_INTEGER
477) endif
478)
479) if (associated(force_x)) then
480) condition%force_x => force_x
481) num_sub_conditions = num_sub_conditions + 1
482) condition%force_x%isubtype = FOUR_INTEGER
483) endif
484)
485) if (associated(force_y)) then
486) condition%force_y => force_y
487) num_sub_conditions = num_sub_conditions + 1
488) condition%force_y%isubtype = FIVE_INTEGER
489) endif
490)
491) if (associated(force_z)) then
492) condition%force_z => force_z
493) num_sub_conditions = num_sub_conditions + 1
494) condition%force_z%isubtype = THREE_INTEGER
495) endif
496)
497) if (num_sub_conditions == 0) then
498) option%io_buffer = 'displacement/force condition null in condition: ' // &
499) trim(condition%name)
500) call printErrMsg(option)
501) endif
502)
503) condition%num_sub_conditions = num_sub_conditions
504) allocate(condition%sub_condition_ptr(condition%num_sub_conditions))
505) do idof = 1, num_sub_conditions
506) nullify(condition%sub_condition_ptr(idof)%ptr)
507) enddo
508)
509) ! SK: I am using isubtype to differentiate between x, y, z in sub_condition_ptr
510) ! since all of the displacements need not be specified.
511) count = 0
512) if (associated(displacement_x)) then
513) count = count + 1
514) condition%sub_condition_ptr(count)%ptr => displacement_x
515) endif
516) if (associated(displacement_y)) then
517) count = count + 1
518) condition%sub_condition_ptr(count)%ptr => displacement_y
519) endif
520) if (associated(displacement_z)) then
521) count = count + 1
522) condition%sub_condition_ptr(count)%ptr => displacement_z
523) endif
524) if (associated(force_x)) then
525) count = count + 1
526) condition%sub_condition_ptr(count)%ptr => force_x
527) endif
528) if (associated(force_y)) then
529) count = count + 1
530) condition%sub_condition_ptr(count)%ptr => force_y
531) endif
532) if (associated(force_z)) then
533) count = count + 1
534) condition%sub_condition_ptr(count)%ptr => force_z
535) endif
536)
537) condition%default_time_storage => default_time_storage
538)
539) end subroutine GeomechConditionRead
540)
541) ! ************************************************************************** !
542)
543) subroutine GeomechConditionPrint(condition,option)
544) !
545) ! Prints Geomech condition info
546) !
547) ! Author: Satish Karra, LANL
548) ! Date: 06/12/13
549) !
550)
551) use Option_module
552)
553) implicit none
554)
555) type(geomech_condition_type) :: condition
556) type(option_type) :: option
557)
558) character(len=MAXSTRINGLENGTH) :: string
559) PetscInt :: i
560)
561) 99 format(/,80('-'))
562)
563) write(option%fid_out,'(/,2x,''Geomech Condition: '',a)') trim(condition%name)
564)
565) if (condition%sync_time_with_update) then
566) string = 'yes'
567) else
568) string = 'no'
569) endif
570) write(option%fid_out,'(4x,''Synchronize time with update: '', a)') &
571) trim(string)
572) write(option%fid_out,'(4x,''Time units: '', a)') &
573) trim(condition%time_units)
574) write(option%fid_out,'(4x,''Length units: '', a)') &
575) trim(condition%length_units)
576)
577) do i=1, condition%num_sub_conditions
578) call GeomechConditionPrintSubCondition(&
579) condition%sub_condition_ptr(i)%ptr, &
580) option)
581) enddo
582) write(option%fid_out,99)
583)
584) end subroutine GeomechConditionPrint
585)
586) ! ************************************************************************** !
587)
588) subroutine GeomechConditionPrintSubCondition(subcondition,option)
589) !
590) ! Prints Geomech subcondition info
591) !
592) ! Author: Satish Karra, LANL
593) ! Date: 06/12/13
594) !
595)
596) use Option_module
597)
598) implicit none
599)
600) type(geomech_sub_condition_type) :: subcondition
601) type(option_type) :: option
602)
603) character(len=MAXSTRINGLENGTH) :: string
604)
605) write(option%fid_out,'(/,4x,''Sub Condition: '',a)') trim(subcondition%name)
606) select case(subcondition%itype)
607) case(DIRICHLET_BC)
608) string = 'dirichlet'
609) case(NEUMANN_BC)
610) string = 'neumann'
611) case(ZERO_GRADIENT_BC)
612) string = 'zero gradient'
613) end select
614) 100 format(6x,'Type: ',a)
615) write(option%fid_out,100) trim(string)
616)
617) 110 format(6x,a)
618)
619) write(option%fid_out,110) 'Geomech Dataset:'
620) if (associated(subcondition%dataset)) then
621) !geh call DatasetPrint(subcondition%dataset,option)
622) option%io_buffer = 'TODO(geh): add DatasetPrint()'
623) call printMsg(option)
624) endif
625)
626) end subroutine GeomechConditionPrintSubCondition
627)
628) ! ************************************************************************** !
629)
630) subroutine GeomechConditionUpdate(condition_list,option,time)
631) !
632) ! Updates a transient condition
633) !
634) ! Author: Satish Karra, LANL
635) ! Date: 06/12/13
636) !
637)
638) use Option_module
639) use Dataset_module
640)
641) implicit none
642)
643) type(geomech_condition_list_type) :: condition_list
644) type(option_type) :: option
645) PetscReal :: time
646)
647) type(geomech_condition_type), pointer :: condition
648) type(geomech_sub_condition_type), pointer :: sub_condition
649) PetscInt :: isub_condition
650)
651) condition => condition_list%first
652) do
653) if (.not.associated(condition)) exit
654)
655) do isub_condition = 1, condition%num_sub_conditions
656)
657) sub_condition => condition%sub_condition_ptr(isub_condition)%ptr
658)
659) if (associated(sub_condition)) then
660) call DatasetUpdate(sub_condition%dataset,time,option)
661) endif
662)
663) enddo
664)
665) condition => condition%next
666)
667) enddo
668)
669) end subroutine GeomechConditionUpdate
670)
671) ! ************************************************************************** !
672)
673) subroutine GeomechConditionInitList(list)
674) !
675) ! Initializes a condition list
676) !
677) ! Author: Satish Karra, LANL
678) ! Date: 06/12/13
679) !
680)
681) implicit none
682)
683) type(geomech_condition_list_type) :: list
684)
685) nullify(list%first)
686) nullify(list%last)
687) nullify(list%array)
688) list%num_conditions = 0
689)
690) end subroutine GeomechConditionInitList
691)
692) ! ************************************************************************** !
693)
694) subroutine GeomechConditionAddToList(new_condition,list)
695) !
696) ! Adds a new condition to a condition list
697) !
698) ! Author: Satish Karra, LANL
699) ! Date: 06/12/13
700) !
701)
702) implicit none
703)
704) type(geomech_condition_type), pointer :: new_condition
705) type(geomech_condition_list_type) :: list
706)
707) list%num_conditions = list%num_conditions + 1
708) new_condition%id = list%num_conditions
709) if (.not.associated(list%first)) list%first => new_condition
710) if (associated(list%last)) list%last%next => new_condition
711) list%last => new_condition
712)
713) end subroutine GeomechConditionAddToList
714)
715) ! ************************************************************************** !
716)
717) function GeomechConditionGetPtrFromList(condition_name,condition_list)
718) !
719) ! Returns a pointer to the condition matching &
720) ! condition_name
721) !
722) ! Author: Satish Karra, LANL
723) ! Date: 06/12/13
724) !
725)
726) use String_module
727)
728) implicit none
729)
730) type(geomech_condition_type), pointer :: GeomechConditionGetPtrFromList
731) character(len=MAXWORDLENGTH) :: condition_name
732) type(geomech_condition_list_type) :: condition_list
733)
734) PetscInt :: length
735) type(geomech_condition_type), pointer :: condition
736)
737) nullify(GeomechConditionGetPtrFromList)
738) condition => condition_list%first
739)
740) do
741) if (.not.associated(condition)) exit
742) length = len_trim(condition_name)
743) if (length == len_trim(condition%name) .and. &
744) StringCompare(condition%name,condition_name, &
745) length)) then
746) GeomechConditionGetPtrFromList => condition
747) return
748) endif
749) condition => condition%next
750) enddo
751)
752) end function GeomechConditionGetPtrFromList
753)
754) ! ************************************************************************** !
755)
756) function GeomechConditionIsTransient(condition)
757) !
758) ! Returns PETSC_TRUE for geomech condition if
759) ! it is transient
760) !
761) ! Author: Satish Karra, LANL
762) ! Date: 06/12/13
763) !
764)
765) implicit none
766)
767) type(geomech_condition_type) :: condition
768)
769) PetscBool :: GeomechConditionIsTransient
770)
771) GeomechConditionIsTransient = PETSC_FALSE
772)
773) if (GeomechSubConditionIsTransient(condition%displacement_x) .or. &
774) GeomechSubConditionIsTransient(condition%displacement_y) .or. &
775) GeomechSubConditionIsTransient(condition%displacement_z)) then
776) GeomechConditionIsTransient = PETSC_TRUE
777) endif
778)
779) if (GeomechSubConditionIsTransient(condition%force_x) .or. &
780) GeomechSubConditionIsTransient(condition%force_y) .or. &
781) GeomechSubConditionIsTransient(condition%force_z)) then
782) GeomechConditionIsTransient = PETSC_TRUE
783) endif
784)
785)
786) end function GeomechConditionIsTransient
787)
788) ! ************************************************************************** !
789)
790) function GeomechSubConditionIsTransient(sub_condition)
791) !
792) ! Returns PETSC_TRUE for geomech sub condition
793) ! if it is transient
794) !
795) ! Author: Satish Karra, LANL
796) ! Date: 06/12/13
797) !
798)
799) use Dataset_module
800)
801) implicit none
802)
803) type(geomech_sub_condition_type), pointer :: sub_condition
804)
805) PetscBool :: GeomechSubConditionIsTransient
806)
807) GeomechSubConditionIsTransient = PETSC_FALSE
808)
809) if (associated(sub_condition)) then
810) if (DatasetIsTransient(sub_condition%dataset)) then
811) GeomechSubConditionIsTransient = PETSC_TRUE
812) endif
813) endif
814)
815) end function GeomechSubConditionIsTransient
816)
817) ! ************************************************************************** !
818)
819) subroutine GeomechConditionDestroyList(condition_list)
820) !
821) ! Deallocates a list of conditions
822) !
823) ! Author: Satish Karra, LANL
824) ! Date: 06/06/13
825) !
826)
827) implicit none
828)
829) type(geomech_condition_list_type), pointer :: condition_list
830)
831) type(geomech_condition_type), pointer :: condition, &
832) prev_condition
833)
834) if (.not.associated(condition_list)) return
835)
836) condition => condition_list%first
837) do
838) if (.not.associated(condition)) exit
839) prev_condition => condition
840) condition => condition%next
841) call GeomechConditionDestroy(prev_condition)
842) enddo
843)
844) condition_list%num_conditions = 0
845) nullify(condition_list%first)
846) nullify(condition_list%last)
847) if (associated(condition_list%array)) deallocate(condition_list%array)
848) nullify(condition_list%array)
849)
850) deallocate(condition_list)
851) nullify(condition_list)
852)
853) end subroutine GeomechConditionDestroyList
854)
855) ! ************************************************************************** !
856)
857) subroutine GeomechConditionDestroy(condition)
858) !
859) ! Deallocates a condition
860) !
861) ! Author: Satish Karra, LANL
862) ! Date: 10/23/07
863) !
864)
865) implicit none
866)
867) type(geomech_condition_type), pointer :: condition
868)
869) PetscInt :: i
870)
871) if (.not.associated(condition)) return
872)
873) if (associated(condition%sub_condition_ptr)) then
874) do i=1,condition%num_sub_conditions
875) call GeomechSubConditionDestroy(condition%sub_condition_ptr(i)%ptr)
876) enddo
877) deallocate(condition%sub_condition_ptr)
878) nullify(condition%sub_condition_ptr)
879) endif
880)
881) if (associated(condition%itype)) deallocate(condition%itype)
882) nullify(condition%itype)
883)
884) nullify(condition%displacement_x)
885) nullify(condition%displacement_y)
886) nullify(condition%displacement_z)
887) nullify(condition%force_x)
888) nullify(condition%force_y)
889) nullify(condition%force_z)
890)
891) nullify(condition%next)
892)
893) deallocate(condition)
894) nullify(condition)
895)
896) end subroutine GeomechConditionDestroy
897)
898) ! ************************************************************************** !
899)
900) subroutine GeomechSubConditionDestroy(sub_condition)
901) !
902) ! Destroys a sub_condition
903) !
904) ! Author: Satish Karra, LANL
905) ! Date: 02/04/08
906) !
907)
908) use Dataset_module
909) use Dataset_Ascii_class
910)
911) implicit none
912)
913) type(geomech_sub_condition_type), pointer :: sub_condition
914) class(dataset_ascii_type), pointer :: dataset_ascii
915)
916) if (.not.associated(sub_condition)) return
917)
918) ! if dataset_ascii_type, destroy. Otherwise, they are in another list
919) dataset_ascii => DatasetAsciiCast(sub_condition%dataset)
920) ! dataset_ascii will be NULL if not dataset_ascii_type
921) call DatasetAsciiDestroy(dataset_ascii)
922)
923) deallocate(sub_condition)
924) nullify(sub_condition)
925)
926) end subroutine GeomechSubConditionDestroy
927)
928) end module Geomechanics_Condition_module