geomechanics_coupler.F90       coverage:  88.89 %func     81.25 %block


     1) module Geomechanics_Coupler_module
     2)  
     3)   use Geomechanics_Condition_module
     4)   use Geomechanics_Region_module
     5)   use PFLOTRAN_Constants_module
     6)  
     7)   implicit none
     8) 
     9)   private
    10)  
    11) #include "petsc/finclude/petscsys.h"
    12) 
    13)   ! coupler types
    14)   ! SK: Note that there is no initial coupler since we solve 
    15)   ! a quasi-static problem for geomechanics (when coupled to flow, otherwise
    16)   ! it is a steady state problem)
    17)   PetscInt, parameter, public :: GM_BOUNDARY_COUPLER_TYPE = 1
    18)   PetscInt, parameter, public :: GM_SRC_SINK_COUPLER_TYPE = 2
    19) 
    20)    type, public :: geomech_coupler_type
    21)     PetscInt :: id                           ! id of coupler
    22)     character(len=MAXWORDLENGTH) :: name                         ! name of coupler
    23)     PetscInt :: itype                        ! integer defining type
    24)     character(len=MAXWORDLENGTH) :: ctype                        ! character string defining type
    25)     character(len=MAXWORDLENGTH) :: geomech_condition_name       ! character string defining name of condition to be applied
    26)     character(len=MAXWORDLENGTH) :: region_name                  ! character string defining name of region to be applied
    27)     PetscInt :: igeomech_condition           ! id of condition in condition array/list
    28)     PetscInt :: iregion                      ! id of region in region array/list
    29)     PetscInt, pointer :: geomech_aux_int_var(:,:)     ! auxiliary array for integer value
    30)     PetscReal, pointer :: geomech_aux_real_var(:,:)    ! auxiliary array for real values
    31)     type(geomech_condition_type), pointer :: geomech_condition            ! pointer to condition in condition array/list
    32)     type(gm_region_type), pointer :: region                       ! pointer to region in region array/list
    33)     type(geomech_coupler_type), pointer :: next                         ! pointer to next coupler
    34)   end type geomech_coupler_type
    35)   
    36)   type, public :: geomech_coupler_ptr_type
    37)     type(geomech_coupler_type), pointer :: ptr
    38)   end type geomech_coupler_ptr_type
    39)     
    40)   type, public :: geomech_coupler_list_type
    41)     PetscInt :: num_couplers
    42)     type(geomech_coupler_type), pointer :: first
    43)     type(geomech_coupler_type), pointer :: last
    44)     type(geomech_coupler_type), pointer :: array(:)    
    45)   end type geomech_coupler_list_type
    46)   
    47)   public :: GeomechCouplerCreate, &
    48)             GeomechCouplerDestroy, &
    49)             GeomechCouplerInitList, &
    50)             GeomechCouplerAddToList, &
    51)             GeomechCouplerRead, &
    52)             GeomechCouplerDestroyList, &
    53)             GeomechCouplerGetPtrFromList
    54) 
    55)   interface GeomechCouplerCreate
    56)     module procedure GeomechCouplerCreate1
    57)     module procedure GeomechCouplerCreate2
    58)     module procedure GeomechCouplerCreateFromGeomechCoupler
    59)   end interface
    60)     
    61) contains
    62) 
    63) ! ************************************************************************** !
    64) 
    65) function GeomechCouplerCreate1()
    66)   ! 
    67)   ! GeomechCouplerCreate: Creates a coupler
    68)   ! 
    69)   ! Author: Satish Karra, LANL
    70)   ! Date: 06/13/13
    71)   ! 
    72) 
    73)   implicit none
    74) 
    75)   type(geomech_coupler_type), pointer :: GeomechCouplerCreate1
    76)   
    77)   type(geomech_coupler_type), pointer :: coupler
    78)   
    79)   allocate(coupler)
    80)   coupler%id = 0
    81)   coupler%name = ''
    82)   coupler%itype = GM_BOUNDARY_COUPLER_TYPE
    83)   coupler%ctype = "boundary"
    84)   coupler%geomech_condition_name = ""
    85)   coupler%region_name = ""
    86)   coupler%igeomech_condition = 0
    87)   coupler%iregion = 0
    88)   nullify(coupler%geomech_aux_int_var)
    89)   nullify(coupler%geomech_aux_real_var)
    90)   nullify(coupler%geomech_condition)
    91)   nullify(coupler%region)
    92)   nullify(coupler%next)
    93)   
    94)   GeomechCouplerCreate1 => coupler
    95) 
    96) end function GeomechCouplerCreate1
    97) 
    98) ! ************************************************************************** !
    99) 
   100) function GeomechCouplerCreate2(itype)
   101)   ! 
   102)   ! Creates a coupler
   103)   ! 
   104)   ! Author: Satish Karra, LANL
   105)   ! Date: 06/13/13
   106)   ! 
   107) 
   108)   implicit none
   109) 
   110)   PetscInt :: itype
   111)   
   112)   type(geomech_coupler_type), pointer :: GeomechCouplerCreate2
   113)   
   114)   type(geomech_coupler_type), pointer :: coupler
   115)   
   116)   coupler => GeomechCouplerCreate1()
   117)   coupler%itype = itype
   118)   select case(itype)
   119)     case(GM_BOUNDARY_COUPLER_TYPE)
   120)       coupler%ctype = 'boundary'
   121)     case(GM_SRC_SINK_COUPLER_TYPE)
   122)       coupler%ctype = 'source_sink'
   123)   end select
   124) 
   125)   GeomechCouplerCreate2 => coupler
   126) 
   127) end function GeomechCouplerCreate2
   128) 
   129) ! ************************************************************************** !
   130) 
   131) function GeomechCouplerCreateFromGeomechCoupler(coupler)
   132)   ! 
   133)   ! Creates a coupler
   134)   ! 
   135)   ! Author: Satish Karra, LANL
   136)   ! Date: 06/13/13
   137)   ! 
   138) 
   139)   implicit none
   140)   
   141)   type(geomech_coupler_type), pointer :: coupler
   142)   
   143)   type(geomech_coupler_type), pointer :: GeomechCouplerCreateFromGeomechCoupler
   144)   type(geomech_coupler_type), pointer :: new_coupler
   145) 
   146)   new_coupler => GeomechCouplerCreate1()
   147) 
   148)   new_coupler%id = coupler%id
   149)   new_coupler%name = coupler%name
   150)   new_coupler%itype = coupler%itype
   151)   new_coupler%ctype = coupler%ctype
   152)   new_coupler%geomech_condition_name = coupler%geomech_condition_name
   153)   new_coupler%region_name = coupler%region_name
   154)   new_coupler%igeomech_condition = coupler%igeomech_condition
   155)   new_coupler%iregion = coupler%iregion
   156) 
   157)   ! these must remain null  
   158)   nullify(coupler%geomech_condition)
   159)   nullify(coupler%region)
   160)   nullify(coupler%geomech_aux_int_var)
   161)   nullify(coupler%geomech_aux_real_var)
   162)   nullify(coupler%next)
   163) 
   164)   GeomechCouplerCreateFromGeomechCoupler => new_coupler
   165) 
   166) end function GeomechCouplerCreateFromGeomechCoupler
   167) 
   168) ! ************************************************************************** !
   169) 
   170) subroutine GeomechCouplerInitList(list)
   171)   ! 
   172)   ! Initializes a coupler list
   173)   ! 
   174)   ! Author: Satish Karra, LANL
   175)   ! Date: 06/13/13
   176)   ! 
   177) 
   178)   implicit none
   179) 
   180)   type(geomech_coupler_list_type) :: list
   181)   
   182)   nullify(list%first)
   183)   nullify(list%last)
   184)   nullify(list%array)
   185)   list%num_couplers = 0
   186) 
   187) end subroutine GeomechCouplerInitList
   188) 
   189) ! ************************************************************************** !
   190) 
   191) subroutine GeomechCouplerRead(coupler,input,option)
   192)   ! 
   193)   ! Reads a coupler from the input file
   194)   ! 
   195)   ! Author: Satish Karra, LANL
   196)   ! Date: 06/13/13
   197)   ! 
   198) 
   199)   use Input_Aux_module
   200)   use String_module
   201)   use Option_module
   202)   
   203)   implicit none
   204)   
   205)   type(option_type) :: option
   206)   type(geomech_coupler_type) :: coupler
   207)   type(input_type), pointer :: input
   208)   
   209)   character(len=MAXWORDLENGTH) :: word
   210) 
   211)   input%ierr = 0
   212)   do
   213)   
   214)     call InputReadPflotranString(input,option)
   215)     if (InputError(input)) exit
   216)     if (InputCheckExit(input,option)) exit
   217)     
   218)     call InputReadWord(input,option,word,PETSC_TRUE)
   219)     call InputErrorMsg(input,option,'keyword','GEOMECHANICS COUPLER')   
   220)     call StringToUpper(word)      
   221)     
   222)     select case(trim(word))
   223)     
   224)       case('GEOMECHANICS_REGION')
   225)         call InputReadWord(input,option,coupler%region_name,PETSC_TRUE)
   226)       case('GEOMECHANICS_CONDITION')
   227)         call InputReadWord(input,option,coupler%geomech_condition_name, &
   228)                            PETSC_TRUE)
   229)       case default
   230)         call InputKeywordUnrecognized(word, &
   231)                      'geomechanics coupler',option)
   232)     end select 
   233)   
   234)   enddo  
   235) 
   236) end subroutine GeomechCouplerRead
   237) 
   238) ! ************************************************************************** !
   239) 
   240) subroutine GeomechCouplerAddToList(new_coupler,list)
   241)   ! 
   242)   ! Adds a new coupler to a coupler list
   243)   ! 
   244)   ! Author: Satish Karra, LANL
   245)   ! Date: 06/13/13
   246)   ! 
   247) 
   248)   implicit none
   249)   
   250)   type(geomech_coupler_type), pointer :: new_coupler
   251)   type(geomech_coupler_list_type) :: list
   252)   
   253)   list%num_couplers = list%num_couplers + 1
   254)   new_coupler%id = list%num_couplers
   255)   if (.not.associated(list%first)) list%first => new_coupler
   256)   if (associated(list%last)) list%last%next => new_coupler
   257)   list%last => new_coupler
   258)   
   259) end subroutine GeomechCouplerAddToList
   260) 
   261) ! ************************************************************************** !
   262) 
   263) function GeomechCouplerGetPtrFromList(coupler_name,coupler_list)
   264)   ! 
   265)   ! Returns a pointer to the geomech coupler
   266)   ! matching coupler_name
   267)   ! 
   268)   ! Author: Satish Karra, LANL
   269)   ! Date: 06/13/13
   270)   ! 
   271) 
   272)   use String_module
   273) 
   274)   implicit none
   275)   
   276)   type(geomech_coupler_type), pointer :: GeomechCouplerGetPtrFromList
   277)   character(len=MAXWORDLENGTH) :: coupler_name
   278)   PetscInt :: length
   279)   type(geomech_coupler_list_type) :: coupler_list
   280) 
   281)   type(geomech_coupler_type), pointer :: coupler
   282)     
   283)   nullify(GeomechCouplerGetPtrFromList)
   284) 
   285)   coupler => coupler_list%first
   286)   do 
   287)     if (.not.associated(coupler)) exit
   288)     length = len_trim(coupler_name)
   289)     if (length == len_trim(coupler%name) .and. &
   290)         StringCompare(coupler%name,coupler_name,length)) then
   291)       GeomechCouplerGetPtrFromList => coupler
   292)       return
   293)     endif
   294)     coupler => coupler%next
   295)   enddo
   296)   
   297) end function GeomechCouplerGetPtrFromList
   298) 
   299) ! ************************************************************************** !
   300) 
   301) subroutine GeomechCouplerDestroyList(coupler_list)
   302)   ! 
   303)   ! Deallocates a list of geomech couplers
   304)   ! 
   305)   ! Author: Satish Karra, LANL
   306)   ! Date: 06/13/13
   307)   ! 
   308) 
   309)   implicit none
   310)   
   311)   type(geomech_coupler_list_type), pointer :: coupler_list
   312)   
   313)   type(geomech_coupler_type), pointer :: coupler, prev_coupler
   314)   
   315)   if (.not.associated(coupler_list)) return
   316)   
   317)   coupler => coupler_list%first
   318)   do 
   319)     if (.not.associated(coupler)) exit
   320)     prev_coupler => coupler
   321)     coupler => coupler%next
   322)     call GeomechCouplerDestroy(prev_coupler)
   323)   enddo
   324)   
   325)   coupler_list%num_couplers = 0
   326)   nullify(coupler_list%first)
   327)   nullify(coupler_list%last)
   328)   if (associated(coupler_list%array)) deallocate(coupler_list%array)
   329)   nullify(coupler_list%array)
   330)   
   331)   deallocate(coupler_list)
   332)   nullify(coupler_list)
   333) 
   334) end subroutine GeomechCouplerDestroyList
   335) 
   336) ! ************************************************************************** !
   337) 
   338) subroutine GeomechCouplerDestroy(coupler)
   339)   ! 
   340)   ! Destroys a coupler
   341)   ! 
   342)   ! Author: Satish Karra, LANL
   343)   ! Date: 06/13/13
   344)   ! 
   345) 
   346)   implicit none
   347)   
   348)   type(geomech_coupler_type), pointer :: coupler
   349)   
   350)   if (.not.associated(coupler)) return
   351)   
   352)   ! since the below are simply pointers to objects in list that have already
   353)   ! or will be deallocated from the list, nullify instead of destroying
   354)   
   355)   nullify(coupler%geomech_condition)     ! since these are simply pointers to 
   356)   nullify(coupler%region)                ! conditions in list, nullify
   357) 
   358)   if (associated(coupler%geomech_aux_int_var)) &
   359)     deallocate(coupler%geomech_aux_int_var)
   360)   nullify(coupler%geomech_aux_int_var)
   361)   if (associated(coupler%geomech_aux_real_var)) &
   362)     deallocate(coupler%geomech_aux_real_var)
   363)   nullify(coupler%geomech_aux_real_var)
   364)    
   365)   deallocate(coupler)
   366)   nullify(coupler)
   367) 
   368) end subroutine GeomechCouplerDestroy
   369) 
   370)   
   371) end module Geomechanics_Coupler_module

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