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

generated by
Intel(R) C++/Fortran Compiler code-coverage tool
Web-Page Owner: Nobody