geomechanics_realization.F90       coverage:  94.44 %func     73.04 %block


     1) module Geomechanics_Realization_class
     2) 
     3)   use Realization_Base_class
     4)   use Geomechanics_Discretization_module
     5)   use Geomechanics_Patch_module
     6)   use Geomechanics_Material_module
     7)   use Geomechanics_Field_module
     8)   use Geomechanics_Debug_module
     9)   use Geomechanics_Region_module
    10)   use Geomechanics_Condition_module
    11)   use Input_Aux_module
    12)   use Option_module
    13)   use Output_Aux_module
    14)   use Dataset_Base_class
    15)   use PFLOTRAN_Constants_module
    16) 
    17)   implicit none
    18) 
    19) private
    20) 
    21) #include "petsc/finclude/petscsys.h"
    22) 
    23)   type, public, extends(realization_base_type) :: realization_geomech_type
    24) 
    25)     type(geomech_discretization_type), pointer :: geomech_discretization
    26)     type(geomech_patch_type), pointer :: geomech_patch
    27) 
    28)     type(geomech_material_property_type), &
    29)                            pointer :: geomech_material_properties
    30)     type(geomech_material_property_ptr_type), &
    31)                            pointer :: geomech_material_property_array(:)
    32) 
    33)     type(geomech_field_type), pointer :: geomech_field
    34)     type(geomech_debug_type), pointer :: geomech_debug
    35)     type(gm_region_list_type), pointer :: geomech_region_list
    36)     type(geomech_condition_list_type),pointer :: geomech_conditions
    37)     class(dataset_base_type), pointer :: geomech_datasets
    38)     PetscReal :: dt_coupling
    39) 
    40)   end type realization_geomech_type
    41) 
    42)   public :: GeomechRealizCreate, &
    43)             GeomechRealizDestroy, &
    44)             GeomechRealizAddStrata, &
    45)             GeomechRealizAddGeomechCoupler, &
    46)             GeomechRealizLocalizeRegions, &
    47)             GeomechRealizPassFieldPtrToPatch, &
    48)             GeomechRealizProcessMatProp, &
    49)             GeomechRealizProcessGeomechCouplers, &
    50)             GeomechRealizCreateDiscretization, &
    51)             GeomechRealizProcessGeomechConditions, &
    52)             GeomechRealizInitAllCouplerAuxVars, &
    53)             GeomechRealizPrintCouplers, &
    54)             GeomechRealizAddWaypointsToList, &
    55)             GeomechRealizGetDataset, &
    56)             GeomechRealizLocalToLocalWithArray, &
    57)             GeomechRealizMapSubsurfGeomechGrid, &
    58)             GeomechGridElemSharedByNodes
    59) contains
    60) 
    61) ! ************************************************************************** !
    62) 
    63) function GeomechRealizCreate(option)
    64)   ! 
    65)   ! This subroutine creates realization for geomechanics
    66)   ! 
    67)   ! Author: Satish Karra, LANL
    68)   ! Date: 05/23/13
    69)   ! 
    70) 
    71)   implicit none
    72) 
    73)   class(realization_geomech_type), pointer :: GeomechRealizCreate
    74)   class(realization_geomech_type), pointer :: geomech_realization
    75)   type(option_type), pointer :: option
    76)   
    77)   allocate(geomech_realization)
    78)   geomech_realization%id = 0
    79)   if (associated(option)) then
    80)     geomech_realization%option => option
    81)   else
    82)     geomech_realization%option => OptionCreate()
    83)   endif
    84)   
    85)   nullify(geomech_realization%input)
    86)   geomech_realization%geomech_discretization => GeomechDiscretizationCreate()
    87)   
    88)   geomech_realization%geomech_field => GeomechFieldCreate()
    89)   geomech_realization%output_option => OutputOptionCreate()
    90)   geomech_realization%geomech_debug => GeomechDebugCreate()
    91)   
    92)   allocate(geomech_realization%geomech_region_list)
    93)   call GeomechRegionInitList(geomech_realization%geomech_region_list)
    94)   
    95)   allocate(geomech_realization%geomech_conditions)
    96)   call GeomechConditionInitList(geomech_realization%geomech_conditions)
    97) 
    98)   nullify(geomech_realization%geomech_material_properties)
    99)   nullify(geomech_realization%geomech_material_property_array)
   100)   
   101)   nullify(geomech_realization%geomech_patch)
   102)   geomech_realization%dt_coupling = 0.d0
   103) 
   104)   GeomechRealizCreate => geomech_realization
   105)   
   106) end function GeomechRealizCreate
   107) 
   108) ! ************************************************************************** !
   109) 
   110) subroutine GeomechRealizAddStrata(geomech_realization,strata)
   111)   ! 
   112)   ! Adds strata to a list
   113)   ! 
   114)   ! Author: Satish Karra, LANL
   115)   ! Date: 05/23/13
   116)   ! 
   117) 
   118)   use Geomechanics_Strata_module
   119) 
   120)   implicit none
   121)   
   122)   class(realization_geomech_type) :: geomech_realization
   123)   type(geomech_strata_type), pointer :: strata
   124)   
   125)   type(geomech_patch_type), pointer :: geomech_patch
   126)   type(geomech_strata_type), pointer :: new_strata
   127)   
   128)   geomech_patch => geomech_realization%geomech_patch
   129) 
   130)   if (.not.associated(geomech_patch)) return
   131)  
   132)   new_strata => GeomechStrataCreate(strata)
   133)   call GeomechStrataAddToList(new_strata,geomech_patch%geomech_strata_list)
   134)   nullify(new_strata)
   135)   
   136)   call GeomechStrataDestroy(strata)
   137)  
   138) end subroutine GeomechRealizAddStrata
   139) 
   140) ! ************************************************************************** !
   141) 
   142) subroutine GeomechRealizLocalizeRegions(geomech_realization)
   143)   ! 
   144)   ! This routine localizes geomechanics regions
   145)   ! within each patch
   146)   ! 
   147)   ! Author: Satish Karra, LANL
   148)   ! Date: 06/07/13
   149)   ! 
   150) 
   151)   use Option_module
   152)   use String_module
   153) 
   154)   implicit none
   155)   
   156)   class(realization_geomech_type) :: geomech_realization
   157)   type(geomech_patch_type), pointer :: patch
   158)   type(option_type), pointer :: option
   159) 
   160)   option => geomech_realization%option
   161) 
   162)   ! localize the regions on each patch
   163)   patch => geomech_realization%geomech_patch
   164)   call GeomechPatchLocalizeRegions(patch, &
   165)                                    geomech_realization%geomech_region_list, &
   166)                                    option)
   167)                                    
   168) end subroutine GeomechRealizLocalizeRegions
   169) 
   170) ! ************************************************************************** !
   171) 
   172) subroutine GeomechRealizProcessMatProp(geomech_realization)
   173)   ! 
   174)   ! Setup for material properties
   175)   ! 
   176)   ! Author: Satish Karra, LANL
   177)   ! Date: 06/13/13
   178)   ! 
   179) 
   180)   use String_module
   181)   
   182)   implicit none
   183)   
   184)   class(realization_geomech_type) :: geomech_realization
   185)   type(geomech_patch_type), pointer :: patch  
   186)   type(option_type), pointer :: option
   187) 
   188)   
   189)   option => geomech_realization%option
   190)   
   191)   ! organize lists
   192)   call GeomechanicsMaterialPropConvertListToArray( &
   193)                         geomech_realization%geomech_material_properties, &
   194)                         geomech_realization%geomech_material_property_array, &
   195)                         option)
   196)   ! set up mirrored pointer arrays within patches to saturation functions
   197)   ! and material properties
   198)   patch => geomech_realization%geomech_patch
   199)   patch%geomech_material_properties => geomech_realization% &
   200)                                        geomech_material_properties
   201)   call GeomechanicsMaterialPropConvertListToArray( &
   202)                                     patch%geomech_material_properties, &
   203)                                     patch%geomech_material_property_array, &
   204)                                     option)
   205)                                       
   206) end subroutine GeomechRealizProcessMatProp
   207) 
   208) ! ************************************************************************** !
   209) 
   210) subroutine GeomechRealizCreateDiscretization(geomech_realization)
   211)   ! 
   212)   ! Creates grid
   213)   ! 
   214)   ! Author: Satish Karra, LANL
   215)   ! Date: 05/23/13
   216)   ! 
   217) 
   218)   use Geomechanics_Grid_Aux_module
   219)   
   220)   implicit none
   221)   
   222) #include "petsc/finclude/petscvec.h"
   223) #include "petsc/finclude/petscvec.h90"
   224) 
   225)   class(realization_geomech_type) :: geomech_realization
   226)   type(geomech_discretization_type), pointer :: geomech_discretization
   227)   type(geomech_grid_type), pointer :: grid
   228)   type(option_type), pointer :: option
   229)   type(geomech_field_type), pointer :: geomech_field
   230)   type(gmdm_ptr_type), pointer :: dm_ptr
   231)   PetscErrorCode :: ierr
   232) 
   233)   geomech_discretization => geomech_realization%geomech_discretization
   234)   grid => geomech_discretization%grid
   235)   option => geomech_realization%option
   236)   geomech_field => geomech_realization%geomech_field
   237)   
   238)   call GeomechDiscretizationCreateDMs(geomech_discretization,option)
   239)   
   240)   ! n degree of freedom, global
   241)   call GeomechDiscretizationCreateVector(geomech_discretization,NGEODOF, &
   242)                                          geomech_field%disp_xx, &
   243)                                          GLOBAL,option)
   244)   call VecSet(geomech_field%disp_xx,0.d0,ierr);CHKERRQ(ierr)
   245) 
   246)   call GeomechDiscretizationDuplicateVector(geomech_discretization, &
   247)                                             geomech_field%disp_xx, &
   248)                                             geomech_field%disp_r)
   249)   call GeomechDiscretizationDuplicateVector(geomech_discretization, &
   250)                                             geomech_field%disp_xx, &
   251)                                             geomech_field%work)
   252)   
   253)   ! 1 degree of freedom, global                                                                                    
   254)   call GeomechDiscretizationCreateVector(geomech_discretization,ONEDOF, &
   255)                                          geomech_field%press, &
   256)                                          GLOBAL,option)
   257)   call VecSet(geomech_field%press,0.d0,ierr);CHKERRQ(ierr)
   258)   
   259)   call GeomechDiscretizationDuplicateVector(geomech_discretization, &
   260)                                             geomech_field%press, &
   261)                                             geomech_field%temp)
   262)                                             
   263)   ! n degrees of freedom, local
   264)   call GeomechDiscretizationCreateVector(geomech_discretization,NGEODOF, &
   265)                                          geomech_field%disp_xx_loc, &
   266)                                          LOCAL,option)
   267)   call VecSet(geomech_field%disp_xx_loc,0.d0,ierr);CHKERRQ(ierr)
   268)  
   269)   call GeomechDiscretizationDuplicateVector(geomech_discretization, &
   270)                                             geomech_field%disp_xx_loc, &
   271)                                             geomech_field%work_loc)
   272) 
   273)   call GeomechDiscretizationDuplicateVector(geomech_discretization, &
   274)                                             geomech_field%disp_xx_loc, &
   275)                                             geomech_field%disp_xx_init_loc)
   276)                                             
   277)   ! 1 degree of freedom, local
   278)   call GeomechDiscretizationCreateVector(geomech_discretization,ONEDOF, &
   279)                                          geomech_field%press_loc, &
   280)                                          LOCAL,option)
   281) 
   282)   call VecSet(geomech_field%press_loc,0.d0,ierr);CHKERRQ(ierr)
   283)   
   284)   call GeomechDiscretizationDuplicateVector(geomech_discretization, &
   285)                                             geomech_field%press_loc, &
   286)                                             geomech_field%temp_loc)
   287) 
   288)   call GeomechDiscretizationDuplicateVector(geomech_discretization, &
   289)                                             geomech_field%press_loc, &
   290)                                             geomech_field%press_init_loc)
   291) 
   292)   call GeomechDiscretizationDuplicateVector(geomech_discretization, &
   293)                                             geomech_field%press_loc, &
   294)                                             geomech_field%temp_init_loc)
   295) 
   296)   call GeomechDiscretizationDuplicateVector(geomech_discretization, &
   297)                                             geomech_field%press_loc, &
   298)                                             geomech_field%imech_loc)
   299) 
   300)   ! 6 dof for strain and stress
   301)   call GeomechDiscretizationCreateVector(geomech_discretization,SIX_INTEGER, &
   302)                                          geomech_field%strain_loc, &
   303)                                          LOCAL,option)
   304) 
   305)   call VecSet(geomech_field%strain_loc,0.d0,ierr);CHKERRQ(ierr)
   306)  
   307)   call GeomechDiscretizationDuplicateVector(geomech_discretization, &
   308)                                             geomech_field%strain_loc, &
   309)                                             geomech_field%stress_loc)
   310) 
   311)   call GeomechDiscretizationCreateVector(geomech_discretization,SIX_INTEGER, &
   312)                                          geomech_field%strain, &
   313)                                          GLOBAL,option)
   314) 
   315)   call VecSet(geomech_field%strain,0.d0,ierr);CHKERRQ(ierr)
   316)  
   317)   call GeomechDiscretizationDuplicateVector(geomech_discretization, &
   318)                                             geomech_field%strain, &
   319)                                             geomech_field%stress) 
   320) 
   321)   grid => geomech_discretization%grid
   322)   
   323)   ! set up nG2L, NL2G, etc.
   324)   call GMGridMapIndices(grid,geomech_discretization%dm_1dof%gmdm, &
   325)                         grid%nG2L,grid%nL2G,grid%nG2A,option)
   326)                         
   327)   ! SK, Need to add a subroutine to ensure right hand rule
   328)   ! SK, Need to add a subroutine equivalent to UGridComputeCoord                      
   329) 
   330)   
   331) end subroutine GeomechRealizCreateDiscretization
   332) 
   333) ! ************************************************************************** !
   334) 
   335) subroutine GeomechRealizMapSubsurfGeomechGrid(realization, &
   336)                                               geomech_realization, &
   337)                                               option)
   338)   ! 
   339)   ! This routine creates scatter contexts
   340)   ! betweeen subsurface and geomech grids
   341)   ! 
   342)   ! Author: Satish Karra, LANL
   343)   ! Date: 09/09/13
   344)   ! 
   345) 
   346)   use Option_module
   347)   use Geomechanics_Grid_Aux_module
   348)   use Realization_Subsurface_class
   349)   use Grid_module
   350) 
   351)   implicit none
   352) 
   353) #include "petsc/finclude/petscvec.h"
   354) #include "petsc/finclude/petscvec.h90"
   355) #include "petsc/finclude/petscdm.h"  
   356) #include "petsc/finclude/petscdm.h90"
   357) #include "petsc/finclude/petscis.h"
   358) #include "petsc/finclude/petscis.h90"
   359) #include "petsc/finclude/petscviewer.h"
   360) 
   361)   class(realization_subsurface_type), pointer :: realization
   362)   class(realization_geomech_type), pointer :: geomech_realization
   363)   type(geomech_grid_type), pointer :: geomech_grid
   364)   type(option_type) :: option
   365)   type(grid_type), pointer :: grid
   366)   type(gmdm_type), pointer :: gmdm
   367)   type(gmdm_ptr_type), pointer :: dm_ptr
   368)   IS :: is_geomech, is_subsurf
   369)   IS :: is_subsurf_natural
   370)   IS :: is_subsurf_petsc
   371)   PetscViewer :: viewer
   372)   PetscErrorCode :: ierr
   373)   AO :: ao_geomech_to_subsurf_natural
   374)   PetscInt, allocatable :: int_array(:)
   375)   PetscInt :: local_id
   376)   VecScatter :: scatter
   377)   IS :: is_geomech_petsc
   378)   PetscInt, pointer :: int_ptr(:)
   379)   IS :: is_geomech_petsc_block
   380)   IS :: is_subsurf_petsc_block
   381) 
   382)   geomech_grid => geomech_realization%geomech_discretization%grid
   383)   grid => realization%discretization%grid
   384)     
   385)   ! Convert from 1-based to 0-based  
   386)   call ISCreateGeneral(option%mycomm,geomech_grid%mapping_num_cells, &
   387)                        geomech_grid%mapping_cell_ids_flow-1, &
   388)                        PETSC_COPY_VALUES,is_subsurf,ierr);CHKERRQ(ierr)
   389)                        
   390) #if GEOMECH_DEBUG
   391)   call PetscViewerASCIIOpen(option%mycomm, &
   392)                             'geomech_is_mapping_cell_ids_flow.out', &
   393)                             viewer,ierr);CHKERRQ(ierr)
   394)   call ISView(is_subsurf,viewer,ierr);CHKERRQ(ierr)
   395)   call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
   396) #endif   
   397)  
   398)   call ISCreateGeneral(option%mycomm,geomech_grid%mapping_num_cells, &
   399)                        geomech_grid%mapping_vertex_ids_geomech-1, &
   400)                        PETSC_COPY_VALUES,is_geomech,ierr);CHKERRQ(ierr)
   401) 
   402) #if GEOMECH_DEBUG
   403)   call PetscViewerASCIIOpen(option%mycomm, &
   404)                             'geomech_is_mapping_vertex_ids_geomech.out', &
   405)                             viewer,ierr);CHKERRQ(ierr)
   406)   call ISView(is_geomech,viewer,ierr);CHKERRQ(ierr)
   407)   call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
   408) #endif   
   409) 
   410)   call AOCreateMappingIS(is_geomech,is_subsurf,ao_geomech_to_subsurf_natural, &
   411)                          ierr);CHKERRQ(ierr)
   412)   call ISDestroy(is_geomech,ierr);CHKERRQ(ierr)
   413)   call ISDestroy(is_subsurf,ierr);CHKERRQ(ierr)
   414) 
   415) #if GEOMECH_DEBUG
   416)   call PetscViewerASCIIOpen(option%mycomm, &
   417)                             'geomech_ao_geomech_to_subsurf_natural.out', &
   418)                             viewer,ierr);CHKERRQ(ierr)
   419)   call AOView(ao_geomech_to_subsurf_natural,viewer,ierr);CHKERRQ(ierr)
   420)   call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
   421) #endif  
   422)   
   423)   allocate(int_array(grid%nlmax))
   424)   do local_id = 1, grid%nlmax
   425)     int_array(local_id) = grid%nG2A(grid%nL2G(local_id)) - 1
   426)   enddo
   427) 
   428)   call ISCreateGeneral(option%mycomm,grid%nlmax, &
   429)                        int_array,PETSC_COPY_VALUES,is_subsurf_natural, &
   430)                        ierr);CHKERRQ(ierr)
   431)   deallocate(int_array)
   432) 
   433) #if GEOMECH_DEBUG
   434)   call PetscViewerASCIIOpen(option%mycomm,'geomech_is_subsurf_natural.out', &
   435)                             viewer,ierr);CHKERRQ(ierr)
   436)   call ISView(is_subsurf_natural,viewer,ierr);CHKERRQ(ierr)
   437)   call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
   438) #endif  
   439) 
   440)   allocate(int_array(grid%nlmax))
   441)   do local_id = 1, grid%nlmax
   442)     int_array(local_id) = (local_id-1) + grid%global_offset
   443)   enddo
   444) 
   445)   call ISCreateGeneral(option%mycomm,grid%nlmax, &
   446)                        int_array,PETSC_COPY_VALUES,is_subsurf_petsc, &
   447)                        ierr);CHKERRQ(ierr)
   448)   deallocate(int_array)
   449)   
   450) #if GEOMECH_DEBUG
   451)   call PetscViewerASCIIOpen(option%mycomm,'geomech_is_subsurf_petsc.out', &
   452)                             viewer,ierr);CHKERRQ(ierr)
   453)   call ISView(is_subsurf_natural,viewer,ierr);CHKERRQ(ierr)
   454)   call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
   455) #endif  
   456)   
   457)   call ISDuplicate(is_subsurf_natural,is_geomech_petsc,ierr);CHKERRQ(ierr)
   458)   call ISCopy(is_subsurf_natural,is_geomech_petsc,ierr);CHKERRQ(ierr)
   459)   
   460)   call AOPetscToApplicationIS(ao_geomech_to_subsurf_natural,is_geomech_petsc, &
   461)                               ierr);CHKERRQ(ierr)
   462)  
   463) #if GEOMECH_DEBUG
   464)   call PetscViewerASCIIOpen(option%mycomm, &
   465)                             'geomech_is_subsurf_petsc_geomech_natural.out', &
   466)                             viewer,ierr);CHKERRQ(ierr)
   467)   call ISView(is_geomech_petsc,viewer,ierr);CHKERRQ(ierr)
   468)   call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
   469) #endif   
   470) 
   471)   call AOApplicationToPetscIS(geomech_grid%ao_natural_to_petsc_nodes, &
   472)                               is_geomech_petsc,ierr);CHKERRQ(ierr)
   473)                               
   474) #if GEOMECH_DEBUG
   475)   call PetscViewerASCIIOpen(option%mycomm, &
   476)                             'geomech_is_subsurf_petsc_geomech_petsc.out', &
   477)                             viewer,ierr);CHKERRQ(ierr)
   478)   call ISView(is_geomech_petsc,viewer,ierr);CHKERRQ(ierr)
   479)   call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
   480) #endif                              
   481) 
   482)   call VecScatterCreate(realization%field%porosity0,is_subsurf_petsc, &
   483)                         geomech_realization%geomech_field%press, &
   484)                         is_geomech_petsc,scatter,ierr);CHKERRQ(ierr)
   485)                         
   486)   if (ierr /= 0) then
   487)     option%io_buffer = 'The number of cells specified in ' // &
   488)                        'input file might not be same as the ' // &
   489)                        'SUBSURF->GEOMECH mapping used.'
   490)     call printErrMsg(option)
   491)   endif
   492) 
   493) #if GEOMECH_DEBUG
   494)   call PetscViewerASCIIOpen(option%mycomm, &
   495)                             'geomech_scatter_subsurf_to_geomech.out', &
   496)                             viewer,ierr);CHKERRQ(ierr)
   497)   call VecScatterView(scatter,viewer,ierr);CHKERRQ(ierr)
   498)   call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
   499) #endif
   500) 
   501)   dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_realization% &
   502)                                                    geomech_discretization, &
   503)                                                    ONEDOF)
   504) 
   505)   call VecScatterCopy(scatter,dm_ptr%gmdm%scatter_subsurf_to_geomech_ndof, &
   506)                       ierr);CHKERRQ(ierr)
   507)   
   508)   call VecScatterDestroy(scatter,ierr);CHKERRQ(ierr)
   509)   
   510)   ! Geomech to subsurf scatter
   511)   
   512)   allocate(int_array(grid%nlmax))
   513)   call ISGetIndicesF90(is_geomech_petsc,int_ptr,ierr);CHKERRQ(ierr)
   514)   do local_id = 1, grid%nlmax
   515)     int_array(local_id) = int_ptr(local_id)
   516)   enddo  
   517)   call ISRestoreIndicesF90(is_geomech_petsc,int_ptr,ierr);CHKERRQ(ierr)
   518)   call ISCreateBlock(option%mycomm,SIX_INTEGER,grid%nlmax, &
   519)                      int_array,PETSC_COPY_VALUES,is_geomech_petsc_block, &
   520)                      ierr);CHKERRQ(ierr)
   521)   deallocate(int_array)
   522) 
   523) #if GEOMECH_DEBUG
   524)   call PetscViewerASCIIOpen(option%mycomm, &
   525)                             'geomech_is_geomech_petsc_block.out', &
   526)                             viewer,ierr);CHKERRQ(ierr)
   527)   call ISView(is_geomech_petsc_block,viewer,ierr);CHKERRQ(ierr)
   528)   call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
   529) #endif 
   530) 
   531)   allocate(int_array(grid%nlmax))
   532)   call ISGetIndicesF90(is_subsurf_petsc,int_ptr,ierr);CHKERRQ(ierr)
   533)   do local_id = 1, grid%nlmax
   534)     int_array(local_id) = int_ptr(local_id)
   535)   enddo  
   536)   call ISRestoreIndicesF90(is_subsurf_petsc,int_ptr,ierr);CHKERRQ(ierr)
   537)   call ISCreateBlock(option%mycomm,SIX_INTEGER,grid%nlmax, &
   538)                      int_array,PETSC_COPY_VALUES,is_subsurf_petsc_block, &
   539)                      ierr);CHKERRQ(ierr)
   540)   deallocate(int_array)
   541) 
   542) #if GEOMECH_DEBUG
   543)   call PetscViewerASCIIOpen(option%mycomm, &
   544)                             'geomech_is_subsurf_petsc_block.out', &
   545)                             viewer,ierr);CHKERRQ(ierr)
   546)   call ISView(is_subsurf_petsc_block,viewer,ierr);CHKERRQ(ierr)
   547)   call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
   548) #endif  
   549)   
   550)   call VecScatterCreate(geomech_realization%geomech_field%strain, &
   551)                         is_geomech_petsc_block, &
   552)                         geomech_realization%geomech_field%strain_subsurf, &
   553)                         is_subsurf_petsc_block,scatter,ierr);CHKERRQ(ierr)
   554)                         
   555)   if (ierr /= 0) then
   556)     option%io_buffer = 'The number of cells specified in ' // &
   557)                        'input file might not be same as the ' // &
   558)                        'GEOMECH->SUBSURF mapping used.'
   559)     call printErrMsg(option)
   560)   endif
   561) 
   562) #if GEOMECH_DEBUG
   563)   call PetscViewerASCIIOpen(option%mycomm, &
   564)                             'geomech_scatter_geomech_to_subsurf_block.out', &
   565)                             viewer,ierr);CHKERRQ(ierr)
   566)   call VecScatterView(scatter,viewer,ierr);CHKERRQ(ierr)
   567)   call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
   568) #endif
   569) 
   570)   dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_realization% &
   571)                                                    geomech_discretization, &
   572)                                                    ONEDOF)
   573) 
   574)   call VecScatterCopy(scatter,dm_ptr%gmdm%scatter_geomech_to_subsurf_ndof, &
   575)                       ierr);CHKERRQ(ierr)
   576)  
   577)   call VecScatterDestroy(scatter,ierr);CHKERRQ(ierr) 
   578)   call ISDestroy(is_geomech,ierr);CHKERRQ(ierr)
   579)   call ISDestroy(is_subsurf,ierr);CHKERRQ(ierr)
   580)   call ISDestroy(is_subsurf_natural,ierr);CHKERRQ(ierr)
   581)   call ISDestroy(is_geomech_petsc,ierr);CHKERRQ(ierr)
   582)   call ISDestroy(is_subsurf_petsc,ierr);CHKERRQ(ierr)
   583)   call AODestroy(ao_geomech_to_subsurf_natural,ierr);CHKERRQ(ierr)
   584)   call ISDestroy(is_subsurf_petsc_block,ierr);CHKERRQ(ierr)
   585)   call ISDestroy(is_geomech_petsc_block,ierr);CHKERRQ(ierr)
   586) 
   587) end subroutine GeomechRealizMapSubsurfGeomechGrid
   588) 
   589) ! ************************************************************************** !
   590) 
   591) subroutine GeomechGridElemSharedByNodes(geomech_realization,option)
   592)   ! 
   593)   ! GeomechGridElemsSharedByNodes: Calculates the number of elements common
   594)   ! to a node (vertex)
   595)   ! 
   596)   ! Author: Satish Karra
   597)   ! Date: 09/17/13
   598)   ! 
   599)   
   600)   use Option_module
   601)   use Geomechanics_Grid_Aux_module
   602) 
   603)   implicit none
   604)   
   605) #include "petsc/finclude/petscvec.h"
   606) #include "petsc/finclude/petscvec.h90"
   607) 
   608)   class(realization_geomech_type) :: geomech_realization
   609)   type(geomech_grid_type), pointer :: grid
   610)   type(option_type) :: option
   611)   
   612)   PetscInt :: ielem
   613)   PetscInt :: ivertex
   614)   PetscInt :: ghosted_id
   615)   PetscInt :: elenodes(10)
   616)   PetscReal, pointer :: elem_sharing_node_loc_p(:)
   617)   PetscErrorCode :: ierr
   618)   PetscViewer :: viewer
   619)   character(len=MAXSTRINGLENGTH) :: string
   620)   
   621)   grid => geomech_realization%geomech_discretization%grid
   622)   
   623)   call VecGetArrayF90(grid%no_elems_sharing_node_loc,elem_sharing_node_loc_p, &
   624)                       ierr);CHKERRQ(ierr)
   625)   
   626)   ! Calculate the common elements to a node on a process
   627)   do ielem = 1, grid%nlmax_elem
   628)     elenodes(1:grid%elem_nodes(0,ielem)) = &
   629)       grid%elem_nodes(1:grid%elem_nodes(0,ielem),ielem)
   630)     do ivertex = 1, grid%elem_nodes(0,ielem)
   631)       ghosted_id = elenodes(ivertex)
   632)       elem_sharing_node_loc_p(ghosted_id) = &
   633)         elem_sharing_node_loc_p(ghosted_id) + 1
   634)     enddo
   635)   enddo
   636)     
   637)   call VecRestoreArrayF90(grid%no_elems_sharing_node_loc, &
   638)                           elem_sharing_node_loc_p,ierr);CHKERRQ(ierr)
   639)                           
   640)   ! Local to global scatter
   641)   call GeomechDiscretizationLocalToGlobalAdd(&
   642)                                 geomech_realization%geomech_discretization, &
   643)                                 grid%no_elems_sharing_node_loc, &
   644)                                 grid%no_elems_sharing_node, &
   645)                                 ONEDOF)  
   646)                                              
   647) #if GEOMECH_DEBUG
   648)   write(string,*) option%myrank
   649)   string = 'no_elems_sharing_node_loc_' // trim(adjustl(string)) // '.out'
   650) 
   651)   call PetscViewerASCIIOpen(PETSC_COMM_SELF,trim(string), &
   652)                             viewer,ierr);CHKERRQ(ierr)
   653)   call VecView(grid%no_elems_sharing_node_loc,viewer,ierr);CHKERRQ(ierr)
   654)   call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
   655)   call PetscViewerASCIIOpen(option%mycomm,'no_elems_sharing_node.out', &
   656)                             viewer,ierr);CHKERRQ(ierr)
   657)   call VecView(grid%no_elems_sharing_node,viewer,ierr);CHKERRQ(ierr)
   658)   call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
   659) #endif
   660) 
   661) end subroutine GeomechGridElemSharedByNodes
   662) 
   663) ! ************************************************************************** !
   664) 
   665) subroutine GeomechRealizInitAllCouplerAuxVars(geomech_realization)
   666)   ! 
   667)   ! This routine initializez coupler
   668)   ! auxillary variables
   669)   ! 
   670)   ! Author: Satish Karra, LANL
   671)   ! Date: 06/17/13
   672)   ! 
   673) 
   674)   use Option_module
   675) 
   676)   implicit none
   677)   
   678)   class(realization_geomech_type) :: geomech_realization
   679)   
   680)   type(geomech_patch_type), pointer :: patch
   681)   
   682)   patch => geomech_realization%geomech_patch
   683) 
   684)   call GeomechPatchInitAllCouplerAuxVars(patch,geomech_realization%option)
   685) 
   686) end subroutine GeomechRealizInitAllCouplerAuxVars
   687) 
   688) ! ************************************************************************** !
   689) 
   690) subroutine GeomechRealizLocalToLocalWithArray(geomech_realization,array_id)
   691)   ! 
   692)   ! This routine takes an F90 array that is
   693)   ! ghosted and updates the ghosted values
   694)   ! 
   695)   ! Author: Satish Karra, LANL
   696)   ! Date: 06/17/13
   697)   ! 
   698) 
   699)   use Geomechanics_Grid_Aux_module
   700)   use Geomechanics_Grid_module
   701)   use Geomechanics_Field_module
   702) 
   703)   implicit none
   704) 
   705)   class(realization_geomech_type) :: geomech_realization
   706)   PetscInt :: array_id
   707)   
   708)   type(geomech_patch_type), pointer :: patch
   709)   type(geomech_grid_type), pointer :: grid
   710)   type(geomech_field_type), pointer :: geomech_field
   711) 
   712)   geomech_field => geomech_realization%geomech_field
   713)   patch => geomech_realization%geomech_patch
   714)   grid => patch%geomech_grid
   715) 
   716)   select case(array_id)
   717)     case(MATERIAL_ID_ARRAY)
   718)       call GeomechGridCopyIntegerArrayToVec(grid,patch%imat, &
   719)                                             geomech_field%work_loc, &
   720)                                             grid%ngmax_node)
   721)   end select
   722)     
   723)   call GeomechDiscretizationLocalToLocal(& 
   724)                             geomech_realization%geomech_discretization, &
   725)                             geomech_field%work_loc, &
   726)                             geomech_field%work_loc,ONEDOF)
   727)                                   
   728)   select case(array_id)
   729)     case(MATERIAL_ID_ARRAY)
   730)       call GeomechGridCopyVecToIntegerArray(grid,patch%imat, &
   731)                                             geomech_field%work_loc, &
   732)                                             grid%ngmax_node)
   733)   end select
   734)   
   735) end subroutine GeomechRealizLocalToLocalWithArray
   736) 
   737) ! ************************************************************************** !
   738) 
   739) subroutine GeomechRealizPrintCouplers(geomech_realization)
   740)   ! 
   741)   ! Print boundary data for geomechanics
   742)   ! 
   743)   ! Author: Satish Karra, LANL
   744)   ! Date: 06/17/13
   745)   ! 
   746) 
   747)   use Geomechanics_Coupler_module
   748)   
   749)   implicit none
   750)   
   751)   class(realization_geomech_type) :: geomech_realization
   752)   
   753)   type(geomech_patch_type), pointer :: patch
   754)   type(geomech_coupler_type), pointer :: cur_coupler
   755)   type(option_type), pointer :: option
   756)  
   757)   option => geomech_realization%option
   758)  
   759)   if (.not.OptionPrintToFile(option)) return
   760)   
   761)   patch => geomech_realization%geomech_patch
   762)    
   763)   cur_coupler => patch%geomech_boundary_condition_list%first
   764)   do
   765)     if (.not.associated(cur_coupler)) exit
   766)     call GeomechRealizPrintCoupler(cur_coupler,option)    
   767)     cur_coupler => cur_coupler%next
   768)   enddo
   769)      
   770)   cur_coupler => patch%geomech_source_sink_list%first
   771)   do
   772)     if (.not.associated(cur_coupler)) exit
   773)     call GeomechRealizPrintCoupler(cur_coupler,option)    
   774)     cur_coupler => cur_coupler%next
   775)   enddo
   776)  
   777) end subroutine GeomechRealizPrintCouplers
   778) 
   779) ! ************************************************************************** !
   780) 
   781) subroutine GeomechRealizPrintCoupler(coupler,option)
   782)   ! 
   783)   ! Prints boundary condition coupler for geomechanics
   784)   ! 
   785)   ! Author: Satish Karra, LANL
   786)   ! Date: 06/17/13
   787)   ! 
   788) 
   789)   use Geomechanics_Coupler_module
   790)   
   791)   implicit none
   792)   
   793)   type(geomech_coupler_type) :: coupler
   794)   type(option_type) :: option
   795)   
   796)   character(len=MAXSTRINGLENGTH) :: string
   797)   
   798)   type(geomech_condition_type), pointer :: geomech_condition
   799)   type(gm_region_type), pointer :: region
   800)    
   801) 98 format(40('=+'))
   802) 99 format(80('-'))
   803)   
   804)   geomech_condition => coupler%geomech_condition
   805)   region => coupler%region
   806) 
   807)   write(option%fid_out,*)
   808)   write(option%fid_out,98)
   809) 
   810) 
   811)   select case(coupler%itype)
   812)     case(GM_BOUNDARY_COUPLER_TYPE)
   813)       string = 'Geomech Boundary Condition'
   814)     case(GM_SRC_SINK_COUPLER_TYPE)
   815)       string = 'Geomech Source Sink'
   816)   end select
   817)   write(option%fid_out,'(/,2x,a,/)') trim(string)
   818) 
   819)   write(option%fid_out,99)
   820) 101 format(5x,'     Geomech Condition: ',2x,a)
   821)   if (associated(geomech_condition)) &
   822)     write(option%fid_out,101) trim(geomech_condition%name)
   823) 102 format(5x,'             Region: ',2x,a)
   824)   if (associated(region)) &
   825)     write(option%fid_out,102) trim(region%name)
   826)   write(option%fid_out,99)
   827)   
   828)   if (associated(geomech_condition)) then
   829)     call GeomechConditionPrint(geomech_condition,option)
   830)   endif
   831)  
   832) end subroutine GeomechRealizPrintCoupler
   833) 
   834) ! ************************************************************************** !
   835) 
   836) subroutine GeomechRealizPassFieldPtrToPatch(geomech_realization)
   837)   ! 
   838)   ! This subroutine passes field to patch
   839)   ! 
   840)   ! Author: Satish Karra, LANL
   841)   ! Date: 06/13/13
   842)   ! 
   843) 
   844)   use Option_module
   845) 
   846)   implicit none
   847)   
   848)   class(realization_geomech_type) :: geomech_realization
   849) 
   850)   type(geomech_patch_type), pointer :: patch
   851) 
   852)   patch => geomech_realization%geomech_patch
   853)    
   854)   patch%geomech_field => geomech_realization%geomech_field
   855)   
   856) end subroutine GeomechRealizPassFieldPtrToPatch
   857) 
   858) ! ************************************************************************** !
   859) 
   860) subroutine GeomechRealizProcessGeomechCouplers(geomech_realization)
   861)   ! 
   862)   ! This subroutine sets up couplers in
   863)   ! geomech realization
   864)   ! 
   865)   ! Author: Satish Karra, LANL
   866)   ! Date: 06/14/13
   867)   ! 
   868) 
   869)   implicit none
   870)   
   871)   class(realization_geomech_type) :: geomech_realization
   872) 
   873)   type(geomech_patch_type), pointer :: patch
   874)   
   875)   patch => geomech_realization%geomech_patch
   876)   
   877)   call GeomechPatchProcessGeomechCouplers(patch, &
   878)                                    geomech_realization%geomech_conditions, &
   879)                                    geomech_realization%option)
   880)  
   881) end subroutine GeomechRealizProcessGeomechCouplers
   882) 
   883) ! ************************************************************************** !
   884) 
   885) subroutine GeomechRealizProcessGeomechConditions(geomech_realization)
   886)   ! 
   887)   ! This subroutine sets up condition in
   888)   ! geomech realization
   889)   ! 
   890)   ! Author: Satish Karra, LANL
   891)   ! Date: 06/17/13
   892)   ! 
   893) 
   894)   use Dataset_Base_class
   895)   use Dataset_module
   896) 
   897)   implicit none
   898) 
   899)   class(realization_geomech_type), pointer :: geomech_realization
   900)   
   901)   type(geomech_condition_type), pointer :: cur_geomech_condition
   902)   type(geomech_sub_condition_type), pointer :: cur_geomech_sub_condition
   903)   type(option_type), pointer :: option
   904)   character(len=MAXSTRINGLENGTH) :: string
   905)   character(len=MAXWORDLENGTH) :: dataset_name
   906)   class(dataset_base_type), pointer :: dataset
   907)   PetscInt :: i
   908)   
   909)   option => geomech_realization%option
   910)   
   911)   ! loop over geomech conditions looking for linkage to datasets
   912)   cur_geomech_condition => geomech_realization%geomech_conditions%first
   913)   do
   914)     if (.not.associated(cur_geomech_condition)) exit
   915)       do i = 1, size(cur_geomech_condition%sub_condition_ptr)
   916)         ! find dataset
   917)         call DatasetFindInList(geomech_realization%geomech_datasets, &
   918)                  cur_geomech_condition%sub_condition_ptr(i)%ptr%dataset, &
   919)                  cur_geomech_condition%default_time_storage, &
   920)                  string,option)
   921)       enddo
   922)      cur_geomech_condition => cur_geomech_condition%next
   923)   enddo
   924)   
   925) end subroutine GeomechRealizProcessGeomechConditions
   926) 
   927) ! ************************************************************************** !
   928) 
   929) subroutine GeomechRealizGetDataset(geomech_realization,vec,ivar,isubvar, &
   930)                                    isubvar1)
   931)   ! 
   932)   ! This routine extracts variables indexed by
   933)   ! ivar and isubvar from geomechanics realization
   934)   ! 
   935)   ! Author: Satish Karra, LANL
   936)   ! Date: 07/03/13
   937)   ! 
   938) 
   939)   implicit none
   940) 
   941)   class(realization_geomech_type) :: geomech_realization
   942)   Vec :: vec
   943)   PetscInt :: ivar
   944)   PetscInt :: isubvar
   945)   PetscInt, optional :: isubvar1
   946) 
   947)   call GeomechPatchGetDataset(geomech_realization%geomech_patch, &
   948)                               geomech_realization%geomech_field, &
   949)                               geomech_realization%option, &
   950)                               geomech_realization%output_option, &
   951)                               vec,ivar,isubvar,isubvar1)
   952) 
   953) end subroutine GeomechRealizGetDataset
   954) 
   955) ! ************************************************************************** !
   956) 
   957) subroutine GeomechRealizAddGeomechCoupler(geomech_realization,coupler)
   958)   ! 
   959)   ! This subroutine addes a geomechanics
   960)   ! coupler to a geomechanics realization
   961)   ! 
   962)   ! Author: Satish Karra, LANL
   963)   ! Date: 06/13/13
   964)   ! 
   965) 
   966)   use Geomechanics_Coupler_module
   967) 
   968)   implicit none
   969)   
   970)   class(realization_geomech_type) :: geomech_realization
   971)   type(geomech_coupler_type), pointer :: coupler
   972)   
   973)   type(geomech_patch_type), pointer :: patch
   974)   type(geomech_coupler_type), pointer :: new_coupler
   975)   
   976)   patch => geomech_realization%geomech_patch
   977)   
   978)  ! only add to geomech list for now, since they will be split out later
   979)   new_coupler => GeomechCouplerCreate(coupler)
   980)   select case(coupler%itype)
   981)     case(GM_BOUNDARY_COUPLER_TYPE)
   982)       call GeomechCouplerAddToList(new_coupler, &
   983)                                    patch%geomech_boundary_condition_list)
   984)     case(GM_SRC_SINK_COUPLER_TYPE)
   985)       call GeomechCouplerAddToList(new_coupler,patch%geomech_source_sink_list)
   986)   end select
   987)   nullify(new_coupler)
   988)   
   989)   call GeomechCouplerDestroy(coupler)
   990)  
   991) end subroutine GeomechRealizAddGeomechCoupler
   992) 
   993) ! ************************************************************************** !
   994) 
   995) subroutine GeomechRealizAddWaypointsToList(geomech_realization,waypoint_list)
   996)   ! 
   997)   ! Adds waypoints from BCs and source/sink
   998)   ! to waypoint list
   999)   ! 
  1000)   ! Author: Satish Karra, LANL
  1001)   ! Date: 06/17/13
  1002)   ! 
  1003) 
  1004)   use Option_module
  1005)   use Waypoint_module
  1006)   use Time_Storage_module
  1007) 
  1008)   implicit none
  1009)   
  1010)   class(realization_geomech_type) :: geomech_realization
  1011)   type(waypoint_list_type), pointer :: waypoint_list
  1012) 
  1013)   type(geomech_condition_type), pointer :: cur_geomech_condition
  1014)   type(geomech_sub_condition_type), pointer :: sub_condition
  1015)   type(waypoint_type), pointer :: waypoint, cur_waypoint
  1016)   type(option_type), pointer :: option
  1017)   PetscInt :: itime, isub_condition
  1018)   PetscReal :: temp_real, final_time
  1019)   PetscReal, pointer :: times(:)
  1020) 
  1021)   option => geomech_realization%option
  1022)   nullify(times)
  1023)   
  1024)   ! set flag for final output
  1025)   cur_waypoint => waypoint_list%first
  1026)   do
  1027)     if (.not.associated(cur_waypoint)) exit
  1028)     if (cur_waypoint%final) then
  1029)       cur_waypoint%print_snap_output = &
  1030)         geomech_realization%output_option%print_final_snap
  1031)       exit
  1032)     endif
  1033)     cur_waypoint => cur_waypoint%next
  1034)   enddo
  1035)   ! use final time in conditional below
  1036)   if (associated(cur_waypoint)) then
  1037)     final_time = cur_waypoint%time
  1038)   else
  1039)     option%io_buffer = 'Final time not found in GeomechRealizAddWaypointsToList'
  1040)     call printErrMsg(option)
  1041)   endif
  1042) 
  1043)   ! add update of geomech conditions
  1044)   cur_geomech_condition => geomech_realization%geomech_conditions%first
  1045)   do
  1046)     if (.not.associated(cur_geomech_condition)) exit
  1047)     if (cur_geomech_condition%sync_time_with_update) then
  1048)       do isub_condition = 1, cur_geomech_condition%num_sub_conditions
  1049)         sub_condition => cur_geomech_condition% &
  1050)                          sub_condition_ptr(isub_condition)%ptr
  1051)         call TimeStorageGetTimes(sub_condition%dataset%time_storage, option, &
  1052)                                 final_time, times)
  1053)         if (associated(times)) then
  1054)           if (size(times) > 1000) then
  1055)             option%io_buffer = 'For geomech condition "' // &
  1056)               trim(cur_geomech_condition%name) // &
  1057)               '" dataset "' // trim(sub_condition%name) // &
  1058)               '", the number of times is excessive for synchronization ' // &
  1059)               'with waypoints.'
  1060)             call printErrMsg(option)
  1061)           endif
  1062)           do itime = 1, size(times)
  1063)             waypoint => WaypointCreate()
  1064)             waypoint%time = times(itime)
  1065)             waypoint%update_conditions = PETSC_TRUE
  1066)             call WaypointInsertInList(waypoint,waypoint_list)
  1067)           enddo
  1068)           deallocate(times)
  1069)           nullify(times)
  1070)         endif
  1071)       enddo
  1072)     endif
  1073)     cur_geomech_condition => cur_geomech_condition%next
  1074)   enddo
  1075)       
  1076) end subroutine GeomechRealizAddWaypointsToList
  1077) 
  1078) ! ************************************************************************** !
  1079) 
  1080) subroutine GeomechRealizDestroy(geomech_realization)
  1081)   ! 
  1082)   ! This subroutine deallocates geomechanics realization
  1083)   ! 
  1084)   ! Author: Satish Karra, LANL
  1085)   ! Date: 05/23/13
  1086)   ! 
  1087) 
  1088)   implicit none
  1089)   
  1090)   class(realization_geomech_type), pointer :: geomech_realization
  1091)   
  1092)   if (.not.associated(geomech_realization)) return
  1093)     
  1094)   call GeomechFieldDestroy(geomech_realization%geomech_field)
  1095) 
  1096)   call OutputOptionDestroy(geomech_realization%output_option)
  1097) 
  1098)   call GeomechRegionDestroyList(geomech_realization%geomech_region_list)
  1099) 
  1100)   call GeomechConditionDestroyList(geomech_realization%geomech_conditions)
  1101)   
  1102)   if (associated(geomech_realization%geomech_debug)) &
  1103)     deallocate(geomech_realization%geomech_debug)
  1104)   nullify(geomech_realization%geomech_debug)
  1105)   
  1106)   if (associated(geomech_realization%geomech_material_property_array)) &
  1107)     deallocate(geomech_realization%geomech_material_property_array)
  1108)   nullify(geomech_realization%geomech_material_property_array)
  1109)   if (associated(geomech_realization%geomech_patch)) &
  1110)     call GeomechanicsPatchDestroy(geomech_realization%geomech_patch)                                       
  1111)   call GeomechanicsMaterialPropertyDestroy(geomech_realization% &
  1112)                                            geomech_material_properties)
  1113)   call GeomechDiscretizationDestroy(geomech_realization%geomech_discretization)
  1114) 
  1115)   if (associated(geomech_realization%output_option)) &
  1116)     deallocate(geomech_realization%output_option)
  1117)   nullify(geomech_realization%output_option)
  1118) 
  1119)   if (associated(geomech_realization)) deallocate(geomech_realization)
  1120)   nullify(geomech_realization)
  1121)   
  1122) end subroutine GeomechRealizDestroy
  1123) 
  1124) 
  1125) end module Geomechanics_Realization_class

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