patch.F90       coverage:  70.73 %func     43.45 %block


     1) module Patch_module
     2) 
     3)   use Option_module
     4)   use Grid_module
     5)   use Coupler_module
     6)   use Observation_module
     7)   use Integral_Flux_module
     8)   use Strata_module
     9)   use Region_module
    10)   use Reaction_Aux_module
    11)   use Dataset_Base_class
    12)   use Material_module
    13)   use Field_module
    14)   use Saturation_Function_module
    15)   use Characteristic_Curves_module
    16)   use Surface_Field_module
    17)   use Surface_Material_module
    18)   use Surface_Auxiliary_module
    19)   
    20)   use Auxiliary_module
    21) 
    22)   use PFLOTRAN_Constants_module
    23) 
    24)   implicit none
    25) 
    26)   private
    27) 
    28) #include "petsc/finclude/petscsys.h"
    29) 
    30)   type, public :: patch_type 
    31)     
    32)     PetscInt :: id
    33)     
    34)     ! These arrays will be used by all modes, mode-specific arrays should
    35)     ! go in the auxiliary data stucture for that mode
    36)     PetscInt, pointer :: imat(:)
    37)     PetscInt, pointer :: imat_internal_to_external(:)
    38)     PetscInt, pointer :: sat_func_id(:)
    39) 
    40)     PetscReal, pointer :: internal_velocities(:,:)
    41)     PetscReal, pointer :: boundary_velocities(:,:)
    42)     PetscReal, pointer :: internal_tran_coefs(:,:)
    43)     PetscReal, pointer :: boundary_tran_coefs(:,:)
    44)     PetscReal, pointer :: internal_flow_fluxes(:,:)    
    45)     PetscReal, pointer :: boundary_flow_fluxes(:,:)  
    46)     ! fluid fluxes in moles/sec
    47)     PetscReal, pointer :: ss_flow_fluxes(:,:)        
    48)     ! volumetric flux (m^3/sec) for liquid phase needed for transport
    49)     PetscReal, pointer :: ss_flow_vol_fluxes(:,:)  
    50)     PetscReal, pointer :: internal_tran_fluxes(:,:)    
    51)     PetscReal, pointer :: boundary_tran_fluxes(:,:)  
    52)     PetscReal, pointer :: ss_tran_fluxes(:,:)
    53)     
    54)     ! for TH surface/subsurface
    55)     PetscReal, pointer :: boundary_energy_flux(:,:)
    56) 
    57)     type(grid_type), pointer :: grid
    58) 
    59)     type(region_list_type), pointer :: region_list
    60) 
    61)     type(coupler_list_type), pointer :: boundary_condition_list
    62)     type(coupler_list_type), pointer :: initial_condition_list
    63)     type(coupler_list_type), pointer :: source_sink_list
    64) 
    65)     type(material_property_type), pointer :: material_properties
    66)     type(material_property_ptr_type), pointer :: material_property_array(:)
    67)     type(saturation_function_type), pointer :: saturation_functions
    68)     type(saturation_function_ptr_type), pointer :: saturation_function_array(:)
    69)     class(characteristic_curves_type), pointer :: characteristic_curves
    70)     type(characteristic_curves_ptr_type), pointer :: characteristic_curves_array(:)
    71) 
    72)     type(strata_list_type), pointer :: strata_list
    73)     type(observation_list_type), pointer :: observation_list
    74)     type(integral_flux_list_type), pointer :: integral_flux_list
    75) 
    76)     ! Pointers to objects in mother realization object
    77)     type(field_type), pointer :: field 
    78)     type(reaction_type), pointer :: reaction
    79)     class(dataset_base_type), pointer :: datasets
    80)     
    81)     type(auxiliary_type) :: aux
    82)     
    83)     type(patch_type), pointer :: next
    84) 
    85)     PetscInt :: surf_or_subsurf_flag  ! Flag to identify if the current patch
    86)                                       ! is a surface or subsurface (default)
    87)     type(surface_material_property_type), pointer :: surf_material_properties
    88)     type(surface_material_property_ptr_type), pointer :: surf_material_property_array(:)
    89)     type(surface_field_type), pointer :: surf_field
    90)     type(surface_auxiliary_type) :: surf_aux
    91)     
    92)   end type patch_type
    93) 
    94)   ! pointer data structure required for making an array of patch pointers in F90
    95)   type, public :: patch_ptr_type
    96)     type(patch_type), pointer :: ptr           ! pointer to the patch_type
    97)   end type patch_ptr_type 
    98) 
    99)   type, public :: patch_list_type
   100)     PetscInt :: num_patch_objects
   101)     type(patch_type), pointer :: first
   102)     type(patch_type), pointer :: last
   103)     type(patch_ptr_type), pointer :: array(:)
   104)   end type patch_list_type
   105) 
   106)   PetscInt, parameter, public :: INT_VAR = 0
   107)   PetscInt, parameter, public :: REAL_VAR = 1
   108)     
   109)   interface PatchGetVariable
   110)     module procedure PatchGetVariable1
   111)     module procedure PatchGetVariable2
   112)   end interface
   113) 
   114)   public :: PatchCreate, PatchDestroy, PatchCreateList, PatchDestroyList, &
   115)             PatchAddToList, PatchConvertListToArray, PatchProcessCouplers, &
   116)             PatchUpdateAllCouplerAuxVars, PatchInitAllCouplerAuxVars, &
   117)             PatchLocalizeRegions, PatchUpdateUniformVelocity, &
   118)             PatchGetVariable, PatchGetVariableValueAtCell, &
   119)             PatchSetVariable, PatchCouplerInputRecord, &
   120)             PatchInitConstraints, &
   121)             PatchCountCells, PatchGetIvarsFromKeyword, &
   122)             PatchGetVarNameFromKeyword, &
   123)             PatchCalculateCFL1Timestep, &
   124)             PatchGetCellCenteredVelocities, &
   125)             PatchGetCompMassInRegion, &
   126)             PatchGetCompMassInRegionAssign
   127) 
   128) contains
   129) 
   130) ! ************************************************************************** !
   131) 
   132) function PatchCreate()
   133)   ! 
   134)   ! Allocates and initializes a new Patch object
   135)   ! 
   136)   ! Author: Glenn Hammond
   137)   ! Date: 02/22/08
   138)   ! 
   139) 
   140)   implicit none
   141)   
   142)   type(patch_type), pointer :: PatchCreate
   143)   
   144)   type(patch_type), pointer :: patch
   145)   
   146)   allocate(patch)
   147) 
   148)   patch%id = 0
   149)   patch%surf_or_subsurf_flag = SUBSURFACE
   150)   nullify(patch%imat)
   151)   nullify(patch%imat_internal_to_external)
   152)   nullify(patch%sat_func_id)
   153)   nullify(patch%internal_velocities)
   154)   nullify(patch%boundary_velocities)
   155)   nullify(patch%internal_tran_coefs)
   156)   nullify(patch%boundary_tran_coefs)
   157)   nullify(patch%internal_flow_fluxes)
   158)   nullify(patch%boundary_flow_fluxes)
   159)   nullify(patch%internal_tran_fluxes)
   160)   nullify(patch%boundary_tran_fluxes)
   161)   nullify(patch%ss_flow_fluxes)
   162)   nullify(patch%ss_tran_fluxes)
   163)   nullify(patch%ss_flow_vol_fluxes)
   164)   nullify(patch%boundary_energy_flux)
   165) 
   166)   nullify(patch%grid)
   167) 
   168)   allocate(patch%region_list)
   169)   call RegionInitList(patch%region_list)
   170)   
   171)   allocate(patch%boundary_condition_list)
   172)   call CouplerInitList(patch%boundary_condition_list)
   173)   allocate(patch%initial_condition_list)
   174)   call CouplerInitList(patch%initial_condition_list)
   175)   allocate(patch%source_sink_list)
   176)   call CouplerInitList(patch%source_sink_list)
   177) 
   178)   nullify(patch%material_properties)
   179)   nullify(patch%material_property_array)
   180)   nullify(patch%saturation_functions)
   181)   nullify(patch%saturation_function_array)
   182)   nullify(patch%characteristic_curves)
   183)   nullify(patch%characteristic_curves_array)
   184) 
   185)   allocate(patch%observation_list)
   186)   call ObservationInitList(patch%observation_list)
   187)   allocate(patch%integral_flux_list)
   188)   call IntegralFluxInitList(patch%integral_flux_list)
   189)   allocate(patch%strata_list)
   190)   call StrataInitList(patch%strata_list)
   191)   
   192)   call AuxInit(patch%aux)
   193)   
   194)   nullify(patch%field)
   195)   nullify(patch%reaction)
   196)   nullify(patch%datasets)
   197)   
   198)   nullify(patch%next)
   199)   
   200)   nullify(patch%surf_material_properties)
   201)   nullify(patch%surf_material_property_array)
   202)   nullify(patch%surf_field)
   203)   call SurfaceAuxInit(patch%surf_aux)
   204) 
   205)   PatchCreate => patch
   206)   
   207) end function PatchCreate
   208) 
   209) ! ************************************************************************** !
   210) 
   211) function PatchCreateList()
   212)   ! 
   213)   ! PatchListCreate: Creates a patch list
   214)   ! 
   215)   ! Author: Glenn Hammond
   216)   ! Date: 02/22/08
   217)   ! 
   218) 
   219)   implicit none
   220) 
   221)   type(patch_list_type), pointer :: PatchCreateList
   222) 
   223)   type(patch_list_type), pointer :: patch_list
   224)   
   225)   allocate(patch_list)
   226)   nullify(patch_list%first)
   227)   nullify(patch_list%last)
   228)   nullify(patch_list%array)
   229)   patch_list%num_patch_objects = 0
   230) 
   231)   PatchCreateList => patch_list
   232) 
   233) end function PatchCreateList
   234) 
   235) ! ************************************************************************** !
   236) 
   237) subroutine PatchAddToList(new_patch,patch_list)
   238)   ! 
   239)   ! Adds a new patch to list
   240)   ! 
   241)   ! Author: Glenn Hammond
   242)   ! Date: 02/22/08
   243)   ! 
   244) 
   245)   implicit none
   246)   
   247)   type(patch_type), pointer :: new_patch
   248)   type(patch_list_type) :: patch_list
   249)   
   250)   if (associated(new_patch)) then
   251)      patch_list%num_patch_objects = patch_list%num_patch_objects + 1
   252)      new_patch%id = patch_list%num_patch_objects
   253)      if (.not.associated(patch_list%first)) patch_list%first => new_patch
   254)      if (associated(patch_list%last)) patch_list%last%next => new_patch
   255)      patch_list%last => new_patch
   256)   end if
   257) end subroutine PatchAddToList
   258) 
   259) ! ************************************************************************** !
   260) 
   261) subroutine PatchConvertListToArray(patch_list)
   262)   ! 
   263)   ! Creates an array of pointers to the
   264)   ! patchs in the patch list
   265)   ! 
   266)   ! Author: Glenn Hammond
   267)   ! Date: 02/22/08
   268)   ! 
   269) 
   270)   implicit none
   271)   
   272)   type(patch_list_type) :: patch_list
   273)     
   274)   PetscInt :: count
   275)   type(patch_type), pointer :: cur_patch
   276)   
   277)   
   278)   allocate(patch_list%array(patch_list%num_patch_objects))
   279)   
   280)   cur_patch => patch_list%first
   281)   do 
   282)     if (.not.associated(cur_patch)) exit
   283)     patch_list%array(cur_patch%id)%ptr => cur_patch
   284)     cur_patch => cur_patch%next
   285)   enddo
   286) 
   287) end subroutine PatchConvertListToArray
   288) 
   289) ! ************************************************************************** !
   290) 
   291) subroutine PatchLocalizeRegions(patch,regions,option)
   292)   ! 
   293)   ! Localizes regions within each patch
   294)   ! 
   295)   ! Author: Glenn Hammond
   296)   ! Date: 02/22/08
   297)   ! 
   298) 
   299)   use Option_module
   300)   use Output_Aux_module
   301)   use Region_module
   302) 
   303)   implicit none
   304)   
   305)   type(patch_type) :: patch
   306)   type(region_list_type) :: regions
   307)   type(option_type) :: option
   308)   
   309)   type(region_type), pointer :: cur_region
   310)   type(region_type), pointer :: patch_region
   311)   
   312)   cur_region => regions%first
   313)   do
   314)     if (.not.associated(cur_region)) exit
   315)     patch_region => RegionCreate(cur_region)
   316)     call RegionAddToList(patch_region,patch%region_list)
   317)     cur_region => cur_region%next
   318)   enddo
   319)   
   320)   !geh: All grids must be localized through GridLocalizeRegions.  Patch
   321)   !     should not differentiate between structured/unstructured, etc.
   322)   call GridLocalizeRegions(patch%grid,patch%region_list,option)
   323)  
   324) end subroutine PatchLocalizeRegions
   325) 
   326) ! ************************************************************************** !
   327) 
   328) subroutine PatchProcessCouplers(patch,flow_conditions,transport_conditions, &
   329)                                 option)
   330)   ! 
   331)   ! Assigns conditions and regions to couplers
   332)   ! 
   333)   ! Author: Glenn Hammond
   334)   ! Date: 02/22/08
   335)   ! 
   336) 
   337)   use Option_module
   338)   use Material_module
   339)   use Condition_module
   340)   use Transport_Constraint_module
   341)   use Connection_module
   342) 
   343)   implicit none
   344)   
   345)   type(patch_type) :: patch
   346)   type(condition_list_type) :: flow_conditions
   347)   type(tran_condition_list_type) :: transport_conditions
   348)   type(option_type) :: option
   349)   
   350)   type(coupler_type), pointer :: coupler
   351)   type(coupler_list_type), pointer :: coupler_list 
   352)   type(strata_type), pointer :: strata
   353)   type(observation_type), pointer :: observation, next_observation
   354)   type(integral_flux_type), pointer :: integral_flux
   355)   
   356)   PetscInt :: temp_int, isub
   357)   PetscErrorCode :: ierr
   358)   
   359)   ! boundary conditions
   360)   coupler => patch%boundary_condition_list%first
   361)   do
   362)     if (.not.associated(coupler)) exit
   363)     ! pointer to region
   364)     coupler%region => RegionGetPtrFromList(coupler%region_name, &
   365)                                            patch%region_list)
   366)     if (.not.associated(coupler%region)) then
   367)       option%io_buffer = 'Region "' // trim(coupler%region_name) // &
   368)                  '" in boundary condition "' // &
   369)                  trim(coupler%name) // &
   370)                  '" not found in region list'
   371)       call printErrMsg(option)
   372)     endif
   373)     if (associated(patch%grid%structured_grid)) then
   374)       if (coupler%region%num_cells > 0 .and. &
   375)           (coupler%region%iface == 0 .and. &
   376)            .not.associated(coupler%region%faces))) then
   377)         option%io_buffer = 'Region "' // trim(coupler%region_name) // &
   378)                  '", which is tied to a boundary condition, has not ' // &
   379)                  'been assigned a face in the structured grid. '
   380)         call printErrMsg(option)
   381)       endif
   382)     endif
   383)     ! pointer to flow condition
   384)     if (option%nflowdof > 0) then
   385)       if (len_trim(coupler%flow_condition_name) > 0) then
   386)         coupler%flow_condition => &
   387)           FlowConditionGetPtrFromList(coupler%flow_condition_name,flow_conditions)
   388)         if (.not.associated(coupler%flow_condition)) then
   389)           option%io_buffer = 'Flow condition "' // &
   390)                    trim(coupler%flow_condition_name) // &
   391)                    '" in boundary condition "' // &
   392)                    trim(coupler%name) // &
   393)                    '" not found in flow condition list'
   394)           call printErrMsg(option)
   395)         endif
   396)       else
   397)         option%io_buffer = 'A FLOW_CONDITION must be specified in ' // &
   398)                            'BOUNDARY_CONDITION: ' // trim(coupler%name) // '.'
   399)         call printErrMsg(option)
   400)       endif
   401)     endif
   402)     ! pointer to transport condition
   403)     if (option%ntrandof > 0) then
   404)       if (len_trim(coupler%tran_condition_name) > 0) then
   405)         coupler%tran_condition => &
   406)           TranConditionGetPtrFromList(coupler%tran_condition_name,transport_conditions)
   407)         if (.not.associated(coupler%tran_condition)) then
   408)            option%io_buffer = 'Transport condition "' // &
   409)                    trim(coupler%tran_condition_name) // &
   410)                    '" in boundary condition "' // &
   411)                    trim(coupler%name) // &
   412)                    '" not found in transport condition list'
   413)           call printErrMsg(option)
   414)         endif
   415)       else
   416)         option%io_buffer = 'A TRANSPORT_CONDITION must be specified in ' // &
   417)                            'BOUNDARY_CONDITION: ' // trim(coupler%name) // '.'
   418)         call printErrMsg(option)
   419)       endif
   420)     endif
   421)     coupler => coupler%next
   422)   enddo
   423) 
   424) 
   425)   ! initial conditions
   426)   coupler => patch%initial_condition_list%first
   427)   do
   428)     if (.not.associated(coupler)) exit
   429)     ! pointer to region
   430)     coupler%region => RegionGetPtrFromList(coupler%region_name, &
   431)                                            patch%region_list)
   432)     if (.not.associated(coupler%region)) then
   433)       option%io_buffer = 'Region "' // trim(coupler%region_name) // &
   434)                  '" in initial condition "' // &
   435)                  trim(coupler%name) // &
   436)                  '" not found in region list'
   437)       call printErrMsg(option)
   438)     endif
   439)     ! pointer to flow condition
   440)     if (option%nflowdof > 0) then
   441)       if (len_trim(coupler%flow_condition_name) > 0) then
   442)         coupler%flow_condition => &
   443)           FlowConditionGetPtrFromList(coupler%flow_condition_name,flow_conditions)
   444)         if (.not.associated(coupler%flow_condition)) then
   445)           option%io_buffer = 'Flow condition "' // &
   446)                    trim(coupler%flow_condition_name) // &
   447)                    '" in initial condition "' // &
   448)                    trim(coupler%name) // &
   449)                    '" not found in flow condition list'
   450)           call printErrMsg(option)
   451)         endif
   452)       else
   453)         option%io_buffer = 'A FLOW_CONDITION must be specified in ' // &
   454)                            'INITIAL_CONDITION: ' // trim(coupler%name) // '.'
   455)         call printErrMsg(option)
   456)       endif
   457)     endif
   458)     ! pointer to transport condition
   459)     if (option%ntrandof > 0) then
   460)       if (len_trim(coupler%tran_condition_name) > 0) then
   461)         coupler%tran_condition => &
   462)           TranConditionGetPtrFromList(coupler%tran_condition_name,transport_conditions)
   463)         if (.not.associated(coupler%tran_condition)) then
   464)           option%io_buffer = 'Transport condition "' // &
   465)                    trim(coupler%tran_condition_name) // &
   466)                    '" in initial condition "' // &
   467)                    trim(coupler%name) // &
   468)                    '" not found in transport condition list'
   469)           call printErrMsg(option)
   470)         endif
   471)       else
   472)         option%io_buffer = 'A TRANSPORT_CONDITION must be specified in ' // &
   473)                            'INITIAL_CONDITION: ' // trim(coupler%name) // '.'
   474)         call printErrMsg(option)
   475)       endif
   476)     endif
   477)     coupler => coupler%next
   478)   enddo
   479) 
   480)   ! source/sinks
   481)   coupler => patch%source_sink_list%first
   482)   do
   483)     if (.not.associated(coupler)) exit
   484)     ! pointer to region
   485)     coupler%region => RegionGetPtrFromList(coupler%region_name, &
   486)                                            patch%region_list)
   487)     if (.not.associated(coupler%region)) then
   488)       option%io_buffer = 'Region "' // trim(coupler%region_name) // &
   489)                  '" in source/sink "' // &
   490)                  trim(coupler%name) // &
   491)                  '" not found in region list'
   492)       call printErrMsg(option)
   493)     endif
   494)     ! pointer to flow condition
   495)     if (option%nflowdof > 0) then    
   496)       if (len_trim(coupler%flow_condition_name) > 0) then
   497)         coupler%flow_condition => &
   498)           FlowConditionGetPtrFromList(coupler%flow_condition_name,flow_conditions)
   499)         if (.not.associated(coupler%flow_condition)) then
   500)           option%io_buffer = 'Flow condition "' // &
   501)                    trim(coupler%flow_condition_name) // &
   502)                    '" in source/sink "' // &
   503)                    trim(coupler%name) // &
   504)                    '" not found in flow condition list'
   505)           call printErrMsg(option)
   506)         endif
   507)         ! check to ensure that a rate subcondition exists
   508)         if (.not.associated(coupler%flow_condition%rate) .and. &
   509)               .not.associated(coupler%flow_condition%well)) then
   510)           temp_int = 0
   511)           if (associated(coupler%flow_condition%general)) then
   512)             if (associated(coupler%flow_condition%general%rate)) then
   513)               temp_int = 1
   514)             endif
   515)           endif
   516)           if (associated(coupler%flow_condition%toil_ims)) then          
   517)             if (associated(coupler%flow_condition%toil_ims%rate)) then
   518)               temp_int = 1
   519)             endif
   520)           end if
   521)           if (temp_int == 0) then
   522)             option%io_buffer = 'FLOW_CONDITIONs associated with ' // &
   523)               'SOURCE_SINKs must have a RATE or WELL expression within them.'
   524)             call printErrMsg(option)
   525)           endif
   526)         endif
   527)       else
   528)         option%io_buffer = 'A FLOW_CONDITION must be specified in ' // &
   529)                            'SOURCE_SINK: ' // trim(coupler%name) // '.'
   530)         call printErrMsg(option)
   531)       endif
   532)     endif
   533)     ! pointer to transport condition
   534)     if (option%ntrandof > 0) then    
   535)       if (len_trim(coupler%tran_condition_name) > 0) then
   536)         coupler%tran_condition => &
   537)           TranConditionGetPtrFromList(coupler%tran_condition_name, &
   538)                                       transport_conditions)
   539)         if (.not.associated(coupler%tran_condition)) then
   540)           option%io_buffer = 'Transport condition "' // &
   541)                    trim(coupler%flow_condition_name) // &
   542)                    '" in source/sink "' // &
   543)                    trim(coupler%name) // &
   544)                    '" not found in transport condition list'
   545)           call printErrMsg(option)
   546)         endif
   547)       else
   548)         option%io_buffer = 'A TRANSPORT_CONDITION must be specified in ' // &
   549)                            'SOURCE_SINK: ' // trim(coupler%name) // '.'
   550)         call printErrMsg(option)
   551)       endif
   552)     endif
   553)     coupler => coupler%next
   554)   enddo
   555) 
   556) !----------------------------  
   557) ! AUX  
   558)     
   559)   ! strata
   560)   ! connect pointers from strata to regions
   561)   strata => patch%strata_list%first
   562)   do
   563)     if (.not.associated(strata)) exit
   564)     ! pointer to region
   565)     if (len_trim(strata%region_name) > 0) then
   566)       strata%region => RegionGetPtrFromList(strata%region_name, &
   567)                                                   patch%region_list)
   568)       if (.not.associated(strata%region)) then
   569)         option%io_buffer = 'Region "' // trim(strata%region_name) // &
   570)                  '" in strata not found in region list'
   571)         call printErrMsg(option)
   572)       endif
   573)       if (strata%active) then
   574)         ! pointer to material
   575)         ! gb: Depending on a surface/subsurface patch, use corresponding
   576)         !     material properties
   577)         if (patch%surf_or_subsurf_flag == SUBSURFACE) then
   578)           strata%material_property => &
   579)             MaterialPropGetPtrFromArray(strata%material_property_name, &
   580)                                         patch%material_property_array)
   581)           if (.not.associated(strata%material_property)) then
   582)             option%io_buffer = 'Material "' // &
   583)                               trim(strata%material_property_name) // &
   584)                               '" not found in material list'
   585)             call printErrMsg(option)
   586)           endif
   587)         endif
   588) 
   589)         if (patch%surf_or_subsurf_flag == SURFACE) then
   590)           strata%surf_material_property => &
   591)             SurfaceMaterialPropGetPtrFromArray(strata%material_property_name, &
   592)                                             patch%surf_material_property_array)
   593)           if (.not.associated(strata%surf_material_property)) then
   594)             option%io_buffer = 'Material "' // &
   595)                               trim(strata%material_property_name) // &
   596)                               '" not found in material list'
   597)             call printErrMsg(option)
   598)           endif
   599)         endif
   600) 
   601)       endif
   602)     else
   603)       nullify(strata%region)
   604)       nullify(strata%material_property)
   605)     endif
   606)     strata => strata%next
   607)   enddo
   608) 
   609)   ! connectivity between initial conditions, boundary conditions, srcs/sinks, etc and grid
   610)   call CouplerListComputeConnections(patch%grid,option, &
   611)                                      patch%initial_condition_list)
   612)   call CouplerListComputeConnections(patch%grid,option, &
   613)                                      patch%boundary_condition_list)
   614)   call CouplerListComputeConnections(patch%grid,option, &
   615)                                      patch%source_sink_list)
   616) 
   617)   ! linkage of observation to regions and couplers must take place after
   618)   ! connection list have been created.
   619)   ! observation
   620)   observation => patch%observation_list%first
   621)   do
   622)     if (.not.associated(observation)) exit
   623)     next_observation => observation%next
   624)     select case(observation%itype)
   625)       case(OBSERVATION_SCALAR)
   626)         ! pointer to region
   627)         observation%region => RegionGetPtrFromList(observation%linkage_name, &
   628)                                                     patch%region_list)
   629)         if (.not.associated(observation%region)) then
   630)           option%io_buffer = 'Region "' // &
   631)                    trim(observation%linkage_name) // &
   632)                  '" in observation point "' // &
   633)                  trim(observation%name) // &
   634)                  '" not found in region list'                   
   635)           call printErrMsg(option)
   636)         endif
   637)         call MPI_Allreduce(observation%region%num_cells,temp_int, &
   638)                            ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM, &
   639)                            option%mycomm,ierr)
   640)         if (temp_int == 0) then
   641)           option%io_buffer = 'Region "' // trim(observation%region%name) // &
   642)             '" is used in an observation point but lies outside the ' // &
   643)             'model domain.'
   644)           call printErrMsg(option)
   645)         endif
   646)         if (observation%region%num_cells == 0) then
   647)           ! remove the observation object
   648)           call ObservationRemoveFromList(observation,patch%observation_list)
   649)         endif
   650)       case(OBSERVATION_FLUX)
   651)         coupler => CouplerGetPtrFromList(observation%linkage_name, &
   652)                                          patch%boundary_condition_list)
   653)         if (associated(coupler)) then
   654)           observation%connection_set => coupler%connection_set
   655)         else
   656)           option%io_buffer = 'Boundary Condition "' // &
   657)                    trim(observation%linkage_name) // &
   658)                    '" not found in Boundary Condition list'
   659)           call printErrMsg(option)
   660)         endif
   661)         if (observation%connection_set%num_connections == 0) then
   662)           ! cannot remove from list, since there must be a global reduction
   663)           ! across all procs
   664)           ! therefore, just nullify connection set
   665)           nullify(observation%connection_set)
   666)         endif                                      
   667)     end select
   668)     observation => next_observation
   669)   enddo
   670)  
   671)   ! linkage of observation to regions and couplers must take place after
   672)   ! connection list have been created.
   673)   ! observation
   674)   integral_flux => patch%integral_flux_list%first
   675)   do
   676)     if (.not.associated(integral_flux)) exit
   677)     integral_flux%connections => &
   678)       PatchGetConnectionsFromCoords(patch,integral_flux%coordinates, &
   679)                                     integral_flux%name,option)
   680)     call IntegralFluxSizeStorage(integral_flux,option)
   681)     integral_flux => integral_flux%next
   682)     option%flow%store_fluxes = PETSC_TRUE
   683)     option%transport%store_fluxes = PETSC_TRUE
   684)   enddo 
   685)   
   686)   temp_int = ConnectionGetNumberInList(patch%grid%internal_connection_set_list)
   687)   temp_int = max(temp_int,1)
   688)   
   689)   ! all simulations
   690)   allocate(patch%internal_velocities(option%nphase,temp_int))
   691)   patch%internal_velocities = 0.d0
   692)   
   693)   ! flow
   694)   if (option%nflowdof > 0) then
   695)     if (option%flow%store_fluxes .or. (patch%surf_or_subsurf_flag == SURFACE) ) then
   696)       allocate(patch%internal_flow_fluxes(option%nflowdof,temp_int))
   697)       patch%internal_flow_fluxes = 0.d0
   698)     endif
   699)   endif
   700)   
   701)   ! transport
   702)   if (option%ntrandof > 0) then
   703)     allocate(patch%internal_tran_coefs(option%nphase,temp_int))
   704)     patch%internal_tran_coefs = 0.d0
   705)     if (option%transport%store_fluxes) then
   706)       allocate(patch%internal_tran_fluxes(option%ntrandof,temp_int))
   707)       patch%internal_tran_fluxes = 0.d0
   708)     endif
   709)   endif
   710) 
   711)   temp_int = CouplerGetNumConnectionsInList(patch%boundary_condition_list)
   712) 
   713)   if (temp_int > 0) then
   714)     ! all simulations
   715)     allocate(patch%boundary_velocities(option%nphase,temp_int)) 
   716)     patch%boundary_velocities = 0.d0
   717)     ! flow
   718)     if (option%nflowdof > 0) then
   719)       if (option%flow%store_fluxes .or. (patch%surf_or_subsurf_flag == SURFACE)) then
   720)         allocate(patch%boundary_flow_fluxes(option%nflowdof,temp_int))
   721)         patch%boundary_flow_fluxes = 0.d0
   722)       endif
   723)       ! surface/subsurface storage
   724)       if (option%iflowmode == TH_MODE) then
   725)         allocate(patch%boundary_energy_flux(2,temp_int))
   726)         patch%boundary_energy_flux = 0.d0
   727)       endif
   728)     endif
   729)     ! transport
   730)     if (option%ntrandof > 0) then
   731)       allocate(patch%boundary_tran_coefs(option%nphase,temp_int))
   732)       patch%boundary_tran_coefs = 0.d0
   733)       if (option%transport%store_fluxes) then
   734)         allocate(patch%boundary_tran_fluxes(option%ntrandof,temp_int))
   735)         patch%boundary_tran_fluxes = 0.d0
   736)       endif
   737)     endif
   738)   endif
   739) 
   740)   temp_int = CouplerGetNumConnectionsInList(patch%source_sink_list)
   741)   if (temp_int > 0) then
   742)     ! flow
   743)     if (option%nflowdof > 0) then
   744)       allocate(patch%ss_flow_fluxes(option%nflowdof,temp_int))
   745)       patch%ss_flow_fluxes = 0.d0
   746)     endif
   747)     ! transport
   748)     if (option%ntrandof > 0) then
   749)       allocate(patch%ss_tran_fluxes(option%ntrandof,temp_int))
   750)       patch%ss_tran_fluxes = 0.d0
   751)       ! only needed by transport
   752)       allocate(patch%ss_flow_vol_fluxes(option%nphase,temp_int))
   753)       patch%ss_flow_vol_fluxes = 0.d0
   754)     endif
   755)   endif
   756) 
   757) end subroutine PatchProcessCouplers
   758) 
   759) ! ************************************************************************** !
   760) 
   761) subroutine PatchInitAllCouplerAuxVars(patch,option)
   762)   ! 
   763)   ! Initializes coupler auxillary variables
   764)   ! within list
   765)   ! 
   766)   ! Author: Glenn Hammond
   767)   ! Date: 02/22/08
   768)   ! 
   769) 
   770)   use Option_module
   771)   use Reaction_Aux_module
   772)   
   773)   implicit none
   774)   
   775)   type(patch_type), pointer :: patch
   776)   type(option_type) :: option
   777)   
   778)   PetscBool :: force_update_flag = PETSC_TRUE
   779)   
   780)   call PatchInitCouplerAuxVars(patch%initial_condition_list,patch, &
   781)                                option)
   782)   call PatchInitCouplerAuxVars(patch%boundary_condition_list,patch, &
   783)                                option)
   784)   call PatchInitCouplerAuxVars(patch%source_sink_list,patch, &
   785)                                option)
   786) 
   787)   !geh: This should not be included in PatchUpdateAllCouplerAuxVars
   788)   ! as it will result in excessive updates to initial conditions
   789)   ! that are not necessary after the simulation has started time stepping.
   790)   call PatchUpdateCouplerAuxVars(patch,patch%initial_condition_list, &
   791)                                  force_update_flag,option)
   792)   call PatchUpdateAllCouplerAuxVars(patch,force_update_flag,option)
   793) 
   794) end subroutine PatchInitAllCouplerAuxVars
   795) 
   796) ! ************************************************************************** !
   797) 
   798) subroutine PatchInitCouplerAuxVars(coupler_list,patch,option)
   799)   ! 
   800)   ! Initializes coupler auxillary variables
   801)   ! within list
   802)   ! 
   803)   ! Author: Glenn Hammond
   804)   ! Date: 02/22/08
   805)   ! 
   806) 
   807)   use Option_module
   808)   use Connection_module
   809)   use Reaction_Aux_module
   810)   use Reactive_Transport_Aux_module
   811)   use Global_Aux_module
   812)   use Condition_module
   813)   use Transport_Constraint_module
   814)   use General_Aux_module
   815)   use TOilIms_Aux_module
   816)   
   817)   implicit none
   818)   
   819)   type(coupler_list_type), pointer :: coupler_list
   820)   type(patch_type), pointer :: patch
   821)   type(option_type) :: option
   822)   
   823)   PetscInt :: num_connections
   824)   PetscBool :: force_update_flag
   825)   
   826)   type(coupler_type), pointer :: coupler
   827)   type(tran_constraint_coupler_type), pointer :: cur_constraint_coupler
   828)   PetscInt :: idof
   829)   character(len=MAXSTRINGLENGTH) :: string
   830)   
   831)   if (.not.associated(coupler_list)) return
   832)     
   833)   coupler => coupler_list%first
   834)   do
   835)     if (.not.associated(coupler)) exit
   836)     
   837)     if (associated(coupler%connection_set)) then
   838)       num_connections = coupler%connection_set%num_connections
   839)       
   840)       ! FLOW
   841)       if (associated(coupler%flow_condition)) then
   842)         ! determine whether flow_condition is transient
   843)         coupler%flow_condition%is_transient = & 
   844)           FlowConditionIsTransient(coupler%flow_condition)
   845)         if (coupler%itype == INITIAL_COUPLER_TYPE .or. &
   846)             coupler%itype == BOUNDARY_COUPLER_TYPE) then
   847) 
   848)           if (associated(coupler%flow_condition%pressure) .or. &
   849)               associated(coupler%flow_condition%concentration) .or. &
   850)               associated(coupler%flow_condition%saturation) .or. &
   851)               associated(coupler%flow_condition%rate) .or. &
   852)               associated(coupler%flow_condition%temperature) .or. &
   853)               associated(coupler%flow_condition%toil_ims) .or. & 
   854)               associated(coupler%flow_condition%general)) then
   855) 
   856)             ! allocate arrays that match the number of connections
   857)             select case(option%iflowmode)
   858) 
   859)               case(RICHARDS_MODE)
   860)                 allocate(coupler%flow_aux_real_var(2,num_connections))
   861)                 allocate(coupler%flow_aux_int_var(1,num_connections))
   862)                 coupler%flow_aux_real_var = 0.d0
   863)                 coupler%flow_aux_int_var = 0
   864) 
   865)               case(TH_MODE)
   866)                 allocate(coupler%flow_aux_real_var(option%nflowdof* &
   867)                                                  option%nphase,num_connections))
   868)                 allocate(coupler%flow_aux_int_var(1,num_connections))
   869)                 coupler%flow_aux_real_var = 0.d0
   870)                 coupler%flow_aux_int_var = 0
   871) 
   872)               case(MPH_MODE, IMS_MODE, FLASH2_MODE, MIS_MODE)
   873)                 allocate(coupler%flow_aux_real_var(option%nflowdof, &
   874)                                                    num_connections))
   875)                 allocate(coupler%flow_aux_int_var(1,num_connections))
   876)                 coupler%flow_aux_real_var = 0.d0
   877)                 coupler%flow_aux_int_var = 0
   878)                 
   879)               case(G_MODE)
   880)                 allocate(coupler%flow_aux_mapping(GENERAL_MAX_INDEX))
   881)                 allocate(coupler%flow_bc_type(THREE_INTEGER))
   882)                 allocate(coupler%flow_aux_real_var(FIVE_INTEGER, &
   883)                                                    num_connections))
   884)                 allocate(coupler%flow_aux_int_var(ONE_INTEGER,num_connections))
   885)                 coupler%flow_aux_mapping = 0
   886)                 coupler%flow_bc_type = 0
   887)                 coupler%flow_aux_real_var = 0.d0
   888)                 coupler%flow_aux_int_var = 0
   889) 
   890)               case(TOIL_IMS_MODE)
   891)                 allocate(coupler%flow_aux_mapping(TOIL_IMS_MAX_INDEX))
   892)                 allocate(coupler%flow_bc_type(THREE_INTEGER))
   893)                 allocate(coupler%flow_aux_real_var(option%nflowdof, &
   894)                                                    num_connections))
   895)                 coupler%flow_aux_mapping = 0
   896)                 coupler%flow_bc_type = 0
   897)                 coupler%flow_aux_real_var = 0.d0
   898)                 
   899)               case default
   900)             end select
   901)       
   902)           endif ! associated(coupler%flow_condition%pressure)
   903)       
   904)         else if (coupler%itype == SRC_SINK_COUPLER_TYPE) then
   905) 
   906)           if (associated(coupler%flow_condition%rate)) then
   907) 
   908)             select case(coupler%flow_condition%rate%itype)
   909)               case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS, &
   910)                    VOLUMETRIC_RATE_SS,MASS_RATE_SS, &
   911)                    HET_VOL_RATE_SS,HET_MASS_RATE_SS)
   912)                 select case(option%iflowmode)
   913)                   case(RICHARDS_MODE)
   914)                     allocate(coupler%flow_aux_real_var(1,num_connections))
   915)                     coupler%flow_aux_real_var = 0.d0
   916)                   case(TH_MODE)
   917)                     allocate(coupler%flow_aux_real_var(option%nflowdof,num_connections))
   918)                     coupler%flow_aux_real_var = 0.d0
   919)                   case(MPH_MODE,FLASH2_MODE,MIS_MODE,IMS_MODE)
   920)                     ! do nothing
   921)                   case default
   922)                     string = GetSubConditionName(coupler%flow_condition%rate%itype)
   923)                     option%io_buffer='Source/Sink of rate%itype = "' // &
   924)                       trim(adjustl(string)) // '", not implemented in this mode.'
   925)                     call printErrMsg(option)
   926)                 end select
   927)               case default
   928)                 string = GetSubConditionName(coupler%flow_condition%rate%itype)
   929)                 option%io_buffer = &
   930)                   FlowConditionUnknownItype(coupler%flow_condition,'rate', &
   931)                                             string)
   932)                 call printErrMsg(option)
   933)             end select
   934)           ! handles source/sinks in general mode
   935)           else if (associated(coupler%flow_condition%general)) then
   936)             if (associated(coupler%flow_condition%general%rate)) then
   937)               select case(coupler%flow_condition%general%rate%itype)
   938)                 case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
   939)                   allocate(coupler%flow_aux_real_var(1,num_connections))
   940)                   coupler%flow_aux_real_var = 0.d0
   941)               end select
   942)             endif
   943)           ! source/sinks for toil_ims
   944)           else if (associated(coupler%flow_condition%toil_ims)) then
   945)             if (associated(coupler%flow_condition%toil_ims%rate)) then
   946)               select case(coupler%flow_condition%toil_ims%rate%itype)
   947)                 case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
   948)                   allocate(coupler%flow_aux_real_var(1,num_connections))
   949)                   coupler%flow_aux_real_var = 0.d0
   950)               end select
   951)             endif
   952)           endif ! associated(coupler%flow_condition%rate)
   953)         endif ! coupler%itype == SRC_SINK_COUPLER_TYPE
   954)       endif ! associated(coupler%flow_condition)
   955)     endif ! associated(coupler%connection_set)
   956) 
   957)     ! TRANSPORT   
   958)     if (associated(coupler%tran_condition)) then
   959)       cur_constraint_coupler => &
   960)         coupler%tran_condition%constraint_coupler_list
   961)       do
   962)         if (.not.associated(cur_constraint_coupler)) exit
   963)         ! Setting option%iflag = 0 ensures that the "mass_balance" array
   964)         ! is not allocated.
   965)         option%iflag = 0
   966)         ! Only allocate the XXX_auxvar objects if they have not been allocated.
   967)         ! Since coupler%tran_condition is a pointer to a separate list of
   968)         ! tran conditions, the XXX_auxvar object may already be allocated.
   969)         if (.not.associated(cur_constraint_coupler%global_auxvar)) then
   970)           allocate(cur_constraint_coupler%global_auxvar)
   971)           call GlobalAuxVarInit(cur_constraint_coupler%global_auxvar,option)
   972)         endif
   973)         if (.not.associated(cur_constraint_coupler%rt_auxvar)) then
   974)           allocate(cur_constraint_coupler%rt_auxvar)
   975)           call RTAuxVarInit(cur_constraint_coupler%rt_auxvar,patch%reaction, &
   976)                             option)
   977)         endif
   978)         cur_constraint_coupler => cur_constraint_coupler%next
   979)       enddo
   980)     endif
   981)       
   982)     coupler => coupler%next
   983)   enddo
   984)   
   985) end subroutine PatchInitCouplerAuxVars
   986) 
   987) ! ************************************************************************** !
   988) 
   989) subroutine PatchUpdateAllCouplerAuxVars(patch,force_update_flag,option)
   990)   ! 
   991)   ! Updates auxiliary variables associated
   992)   ! with couplers in list
   993)   ! 
   994)   ! Author: Glenn Hammond
   995)   ! Date: 02/22/08
   996)   ! 
   997) 
   998)   use Option_module
   999)   
  1000)   implicit none
  1001)   
  1002)   type(patch_type) :: patch
  1003)   PetscBool :: force_update_flag
  1004)   type(option_type) :: option
  1005) 
  1006)   PetscInt :: iconn
  1007)   
  1008)   !geh: no need to update initial conditions as they only need updating
  1009)   !     once as performed in PatchInitCouplerAuxVars()
  1010)   call PatchUpdateCouplerAuxVars(patch,patch%boundary_condition_list, &
  1011)                                  force_update_flag,option)
  1012)   call PatchUpdateCouplerAuxVars(patch,patch%source_sink_list, &
  1013)                                  force_update_flag,option)
  1014) 
  1015) !  stop
  1016) end subroutine PatchUpdateAllCouplerAuxVars
  1017) 
  1018) ! ************************************************************************** !
  1019) 
  1020) subroutine PatchUpdateCouplerAuxVars(patch,coupler_list,force_update_flag, &
  1021)                                      option)
  1022)   ! 
  1023)   ! Updates auxiliary variables associated
  1024)   ! with couplers in list
  1025)   ! 
  1026)   ! Author: Glenn Hammond
  1027)   ! Date: 11/26/07
  1028)   ! 
  1029)   use Option_module
  1030)   use Condition_module
  1031)   use Hydrostatic_module
  1032)   use Saturation_module
  1033)   
  1034)   
  1035)   use General_Aux_module
  1036)   use Grid_module
  1037)   use Dataset_Common_HDF5_class
  1038)   use Dataset_Gridded_HDF5_class
  1039) 
  1040)   implicit none
  1041)   
  1042)   type(patch_type) :: patch
  1043)   type(coupler_list_type), pointer :: coupler_list
  1044)   PetscBool :: force_update_flag
  1045)   type(option_type) :: option
  1046)   
  1047)   type(coupler_type), pointer :: coupler
  1048)   type(flow_condition_type), pointer :: flow_condition
  1049) 
  1050)   if (.not.associated(coupler_list)) return
  1051)  
  1052)   coupler => coupler_list%first
  1053) 
  1054)   do
  1055)     if (.not.associated(coupler)) exit
  1056)     
  1057)     ! FLOW
  1058)     if (associated(coupler%flow_aux_real_var)) then
  1059) 
  1060)       flow_condition => coupler%flow_condition
  1061)       if (force_update_flag .or. flow_condition%is_transient) then 
  1062)         select case(option%iflowmode)
  1063)           case(G_MODE)
  1064)             call PatchUpdateCouplerAuxVarsG(patch,coupler,option)
  1065)           case(MPH_MODE)
  1066)             call PatchUpdateCouplerAuxVarsMPH(patch,coupler,option)
  1067)           case(IMS_MODE)
  1068)             call PatchUpdateCouplerAuxVarsIMS(patch,coupler,option)
  1069)           case(FLASH2_MODE)
  1070)             call PatchUpdateCouplerAuxVarsFLASH2(patch,coupler,option)
  1071)           case(TH_MODE)
  1072)             call PatchUpdateCouplerAuxVarsTH(patch,coupler,option)
  1073)           case(MIS_MODE)
  1074)             call PatchUpdateCouplerAuxVarsMIS(patch,coupler,option)
  1075)           case(RICHARDS_MODE)
  1076)             call PatchUpdateCouplerAuxVarsRich(patch,coupler,option)
  1077)           case(TOIL_IMS_MODE)
  1078)             call PatchUpdateCouplerAuxVarsTOI(patch,coupler,option)
  1079)         end select
  1080)       endif
  1081)     endif
  1082)       
  1083)     ! TRANSPORT
  1084)     ! nothing for transport at this point in time
  1085)     coupler => coupler%next
  1086)   enddo
  1087) 
  1088) end subroutine PatchUpdateCouplerAuxVars
  1089) 
  1090) ! ************************************************************************** !
  1091) 
  1092) subroutine PatchUpdateCouplerAuxVarsG(patch,coupler,option)
  1093)   ! 
  1094)   ! Updates flow auxiliary variables associated
  1095)   ! with a coupler for G_MODE
  1096)   ! 
  1097)   ! Author: Glenn Hammond
  1098)   ! Date: 11/26/13
  1099)   ! 
  1100) 
  1101)   use Option_module
  1102)   use Condition_module
  1103)   use Hydrostatic_module
  1104)   use Saturation_module
  1105)   use EOS_Water_module
  1106)   
  1107)   use General_Aux_module
  1108)   use Grid_module
  1109)   use Dataset_Common_HDF5_class
  1110)   use Dataset_Gridded_HDF5_class
  1111)   use Dataset_Ascii_class
  1112)   use Dataset_module
  1113) 
  1114)   implicit none
  1115)   
  1116)   type(patch_type) :: patch
  1117)   type(coupler_type), pointer :: coupler
  1118)   type(option_type) :: option
  1119)   
  1120)   type(flow_condition_type), pointer :: flow_condition
  1121)   type(tran_condition_type), pointer :: tran_condition
  1122)   type(flow_general_condition_type), pointer :: general
  1123)   PetscBool :: update
  1124)   PetscBool :: dof1, dof2, dof3
  1125)   PetscReal :: temperature, p_sat, p_air, p_gas, p_cap, s_liq
  1126)   PetscReal :: relative_humidity
  1127)   PetscReal :: dummy_real
  1128)   PetscReal :: x(option%nflowdof)
  1129)   character(len=MAXSTRINGLENGTH) :: string, string2
  1130)   PetscErrorCode :: ierr
  1131)   
  1132)   PetscInt :: idof, num_connections,sum_connection
  1133)   PetscInt :: iconn, local_id, ghosted_id
  1134)   ! use to map flow_aux_map to the flow_aux_real_var array
  1135)   PetscInt :: real_count 
  1136)   
  1137)   num_connections = coupler%connection_set%num_connections
  1138) 
  1139)   flow_condition => coupler%flow_condition
  1140) 
  1141)   general => flow_condition%general
  1142)   dof1 = PETSC_FALSE
  1143)   dof2 = PETSC_FALSE
  1144)   dof3 = PETSC_FALSE
  1145)   real_count = 0
  1146)   select case(flow_condition%iphase)
  1147)     case(TWO_PHASE_STATE)
  1148)       coupler%flow_aux_int_var(GENERAL_STATE_INDEX,1:num_connections) = TWO_PHASE_STATE
  1149)       real_count = real_count + 1
  1150)       select case(general%gas_pressure%itype)
  1151)         case(DIRICHLET_BC)
  1152)           coupler%flow_aux_mapping(GENERAL_GAS_PRESSURE_INDEX) = real_count
  1153)           coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1154)             general%gas_pressure%dataset%rarray(1)
  1155)           dof1 = PETSC_TRUE
  1156)           coupler%flow_bc_type(GENERAL_LIQUID_EQUATION_INDEX) = DIRICHLET_BC
  1157)         case default
  1158)           string = &
  1159)             GetSubConditionName(general%gas_pressure%itype)
  1160)           option%io_buffer = &
  1161)             FlowConditionUnknownItype(coupler%flow_condition, &
  1162)               'general two phase state gas pressure',string)
  1163)           call printErrMsg(option)
  1164)       end select
  1165)       ! in two-phase flow, air pressure is second dof
  1166)       real_count = real_count + 1
  1167)       select case(general%temperature%itype)
  1168)         case(DIRICHLET_BC)
  1169)           coupler%flow_aux_mapping(general_2ph_energy_dof) = real_count
  1170)           temperature = general%temperature%dataset%rarray(1)
  1171)           if (general_2ph_energy_dof == GENERAL_TEMPERATURE_INDEX) then
  1172)             coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1173)               temperature
  1174)           else
  1175)             call EOSWaterSaturationPressure(temperature,p_sat,ierr)
  1176)             coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1177)               general%gas_pressure%dataset%rarray(1) - p_sat
  1178)           endif
  1179)           dof3 = PETSC_TRUE
  1180)           coupler%flow_bc_type(GENERAL_ENERGY_EQUATION_INDEX) = DIRICHLET_BC
  1181)         case default
  1182)           string = &
  1183)             GetSubConditionName(general%temperature%itype)
  1184)           option%io_buffer = &
  1185)             FlowConditionUnknownItype(coupler%flow_condition, &
  1186)               'general two phase state temperature',string)
  1187)           call printErrMsg(option)
  1188)       end select
  1189)       ! in two-phase flow, gas saturation is third dof
  1190)       real_count = real_count + 1
  1191)       select case(general%gas_saturation%itype)
  1192)         case(DIRICHLET_BC)
  1193)           coupler%flow_aux_mapping(GENERAL_GAS_SATURATION_INDEX) = real_count
  1194)           coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1195)             general%gas_saturation%dataset%rarray(1)
  1196)           dof2 = PETSC_TRUE
  1197)           coupler%flow_bc_type(GENERAL_GAS_EQUATION_INDEX) = DIRICHLET_BC
  1198)         case default
  1199)           string = &
  1200)             GetSubConditionName(general%gas_saturation%itype)
  1201)           option%io_buffer = &
  1202)             FlowConditionUnknownItype(coupler%flow_condition, &
  1203)               'general two phase state gas saturation',string)
  1204)           call printErrMsg(option)
  1205)       end select
  1206)     case(LIQUID_STATE)
  1207)       coupler%flow_aux_int_var(GENERAL_STATE_INDEX,1:num_connections) = LIQUID_STATE
  1208)       if (general%liquid_pressure%itype == HYDROSTATIC_BC) then
  1209) !        option%io_buffer = 'Hydrostatic BC for general phase cannot possibly ' // &
  1210) !          'be set up correctly. - GEH'
  1211) !        call printErrMsg(option)
  1212)         if (general%mole_fraction%itype /= DIRICHLET_BC) then
  1213)           option%io_buffer = &
  1214)             'Hydrostatic liquid state pressure bc for flow condition "' // &
  1215)             trim(flow_condition%name) // &
  1216)             '" requires a mole fraction bc of type dirichlet'
  1217)           call printErrMsg(option)
  1218)         endif
  1219)         if (general%temperature%itype /= DIRICHLET_BC) then
  1220)           option%io_buffer = &
  1221)             'Hydrostatic liquid state pressure bc for flow condition "' // &
  1222)             trim(flow_condition%name) // &
  1223)             '" requires a temperature bc of type dirichlet'
  1224)           call printErrMsg(option)
  1225)         endif
  1226)         call HydrostaticUpdateCoupler(coupler,option,patch%grid)
  1227)         do iconn=1,coupler%connection_set%num_connections
  1228)           if (coupler%flow_aux_int_var(ONE_INTEGER,iconn) == TWO_PHASE_STATE) then
  1229)             !geh: This cannot possibly be working.  real_count needs to be incremented
  1230)             !     but what variable is mapped?  Need to figure out how real_count
  1231)             !     factors into the hydrostatic condition
  1232)             option%io_buffer = 'Need to fix PatchUpdateCouplerAuxVarsG() ' // &
  1233)               'for a variable saturated hydrostatic condition.'
  1234)             call printErrMsg(option)
  1235)           
  1236)             ! we have to remap the capillary pressure to saturation and 
  1237)             ! temperature to air pressure
  1238)             local_id = coupler%connection_set%id_dn(iconn)
  1239)             ghosted_id = patch%grid%nL2G(local_id)
  1240)             ! we have to convert capillary pressure (stored in air 
  1241)             ! pressure index) to a saturation
  1242)             ! index     variable
  1243)             !  1        coupler%flow_aux_mapping(GENERAL_GAS_PRESSURE_INDEX) = 1
  1244)             !        air pressure in this case hijacked for capillary pressure
  1245)             !  2        coupler%flow_aux_mapping(GENERAL_AIR_PRESSURE_INDEX) = 2
  1246)             !  3        coupler%flow_aux_mapping(GENERAL_TEMPERATURE_INDEX) = 3
  1247)             p_gas = coupler%flow_aux_real_var( &
  1248)                       coupler%flow_aux_mapping( &
  1249)                         GENERAL_GAS_PRESSURE_INDEX),iconn)
  1250)             p_cap = coupler%flow_aux_real_var( &
  1251)                       coupler%flow_aux_mapping( &
  1252)                         GENERAL_AIR_PRESSURE_INDEX),iconn)
  1253)             temperature = coupler%flow_aux_real_var( &
  1254)                             coupler%flow_aux_mapping( &
  1255)                               GENERAL_TEMPERATURE_INDEX),iconn)
  1256)             coupler%flow_aux_mapping(general_2ph_energy_dof) = real_count
  1257)             if (general_2ph_energy_dof == GENERAL_TEMPERATURE_INDEX) then
  1258)               coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1259)                 temperature
  1260)             else
  1261)               call EOSWaterSaturationPressure(temperature,p_sat,ierr)
  1262)               coupler%flow_aux_real_var( &
  1263)                 coupler%flow_aux_mapping( &
  1264)                   GENERAL_AIR_PRESSURE_INDEX),iconn) = &
  1265)                     p_gas - p_sat ! air pressure
  1266)             endif
  1267)             call patch%characteristic_curves_array(patch%sat_func_id(ghosted_id))% &
  1268)                    ptr%saturation_function%Saturation(p_cap,s_liq,dummy_real,option)
  1269)             ! %flow_aux_mapping(GENERAL_GAS_SATURATION_INDEX) set to 3 in hydrostatic
  1270)             coupler%flow_aux_real_var( &
  1271)               coupler%flow_aux_mapping( &
  1272)                 GENERAL_GAS_SATURATION_INDEX),iconn) = &
  1273)               1.d0 - s_liq
  1274)           endif  
  1275)         enddo
  1276)         coupler%flow_bc_type(1) = HYDROSTATIC_BC
  1277)         coupler%flow_bc_type(2:3) = DIRICHLET_BC
  1278)       else
  1279)         real_count = real_count + 1
  1280)         select case(general%liquid_pressure%itype)
  1281)           case(DIRICHLET_BC)
  1282)             coupler%flow_aux_mapping(GENERAL_LIQUID_PRESSURE_INDEX) = real_count
  1283)             select type(selector => general%liquid_pressure%dataset)
  1284)               class is(dataset_ascii_type)
  1285)                 coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1286)                   selector%rarray(1)
  1287)                 dof1 = PETSC_TRUE
  1288)               class is(dataset_gridded_hdf5_type)
  1289)                 call PatchUpdateCouplerFromDataset(coupler,option, &
  1290)                                                    patch%grid,selector, &
  1291)                                                    real_count)
  1292)                 dof1 = PETSC_TRUE
  1293)               class default
  1294)                 option%io_buffer = 'Unknown dataset class (general%liquid_' // &
  1295)                   'pressure%itype,LIQUID_STATE,DIRICHLET_BC)'
  1296)                 call printErrMsg(option)
  1297)             end select
  1298)             coupler%flow_bc_type(GENERAL_LIQUID_EQUATION_INDEX) = DIRICHLET_BC
  1299)           case default
  1300)             string = &
  1301)               GetSubConditionName(general%liquid_pressure%itype)
  1302)             option%io_buffer = &
  1303)               FlowConditionUnknownItype(coupler%flow_condition, &
  1304)                 'general liquid state liquid pressure',string)
  1305)             call printErrMsg(option)
  1306)         end select
  1307)         real_count = real_count + 1
  1308)         select case(general%mole_fraction%itype)
  1309)           case(DIRICHLET_BC)
  1310)             coupler%flow_aux_mapping(GENERAL_MOLE_FRACTION_INDEX) = real_count
  1311)             coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1312)               general%mole_fraction%dataset%rarray(1)
  1313)             dof2 = PETSC_TRUE
  1314)             coupler%flow_bc_type(GENERAL_GAS_EQUATION_INDEX) = DIRICHLET_BC
  1315)           case default
  1316)             string = &
  1317)               GetSubConditionName(general%mole_fraction%itype)
  1318)             option%io_buffer = &
  1319)               FlowConditionUnknownItype(coupler%flow_condition, &
  1320)                 'general liquid state mole fraction',string)
  1321)             call printErrMsg(option)
  1322)         end select
  1323)         real_count = real_count + 1
  1324)         select case(general%temperature%itype)
  1325)           case(DIRICHLET_BC)
  1326)             coupler%flow_aux_mapping(GENERAL_TEMPERATURE_INDEX) = real_count
  1327)             select type(selector =>general%temperature%dataset)
  1328)               class is(dataset_ascii_type)
  1329)                 coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1330)                   selector%rarray(1)
  1331)                 dof3 = PETSC_TRUE
  1332)               class is(dataset_gridded_hdf5_type)
  1333)                 call PatchUpdateCouplerFromDataset(coupler,option, &
  1334)                                                    patch%grid,selector, &
  1335)                                                    real_count)
  1336)                 dof3 = PETSC_TRUE
  1337)               class default
  1338)                 option%io_buffer = 'Unknown dataset class (general%' // &
  1339)                   'temperature%itype,LIQUID_STATE,DIRICHLET_BC)'
  1340)                 call printErrMsg(option)
  1341)             end select
  1342)             coupler%flow_bc_type(GENERAL_ENERGY_EQUATION_INDEX) = DIRICHLET_BC
  1343)           case default
  1344)             string = &
  1345)               GetSubConditionName(general%temperature%itype)
  1346)             option%io_buffer = &
  1347)               FlowConditionUnknownItype(coupler%flow_condition, &
  1348)                 'general liquid state temperature',string)
  1349)             call printErrMsg(option)
  1350)         end select
  1351)       endif
  1352)     case(GAS_STATE)
  1353)       p_gas = UNINITIALIZED_DOUBLE ! set to uninitialized
  1354)       temperature = UNINITIALIZED_DOUBLE
  1355)       real_count = real_count + 1
  1356)       coupler%flow_aux_int_var(GENERAL_STATE_INDEX,1:num_connections) = GAS_STATE
  1357)       select case(general%gas_pressure%itype)
  1358)         case(DIRICHLET_BC)
  1359)           coupler%flow_aux_mapping(GENERAL_GAS_PRESSURE_INDEX) = real_count
  1360)           p_gas = general%gas_pressure%dataset%rarray(1)
  1361)           coupler%flow_aux_real_var(real_count,1:num_connections) = p_gas
  1362)           dof1 = PETSC_TRUE
  1363)           coupler%flow_bc_type(GENERAL_GAS_EQUATION_INDEX) = DIRICHLET_BC
  1364)         case default
  1365)           string = &
  1366)             GetSubConditionName(general%gas_pressure%itype)
  1367)           option%io_buffer = &
  1368)             FlowConditionUnknownItype(coupler%flow_condition, &
  1369)               'general gas state gas pressure',string)
  1370)           call printErrMsg(option)
  1371)       end select
  1372)       real_count = real_count + 1
  1373)       select case(general%temperature%itype)
  1374)         case(DIRICHLET_BC)
  1375)           temperature = general%temperature%dataset%rarray(1)
  1376)           coupler%flow_aux_mapping(GENERAL_TEMPERATURE_INDEX) = real_count
  1377)           coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1378)             temperature
  1379)           dof3 = PETSC_TRUE
  1380)           coupler%flow_bc_type(GENERAL_ENERGY_EQUATION_INDEX) = DIRICHLET_BC
  1381)         case default
  1382)           string = &
  1383)             GetSubConditionName(general%temperature%itype)
  1384)           option%io_buffer = &
  1385)             FlowConditionUnknownItype(coupler%flow_condition, &
  1386)               'general gas state temperature',string)
  1387)           call printErrMsg(option)
  1388)       end select
  1389)       real_count = real_count + 1
  1390)       if (associated(general%mole_fraction)) then
  1391)         select case(general%mole_fraction%itype)
  1392)           case(DIRICHLET_BC)
  1393)             if (Uninitialized(p_gas) .or. Uninitialized(temperature)) then
  1394)               option%io_buffer = 'Gas pressure or temperature not set ' // &
  1395)                 'correctly in flow condition "' // &
  1396)                 trim(flow_condition%name) // '".'
  1397)               call printErrMsg(option)
  1398)             endif
  1399)             coupler%flow_aux_mapping(GENERAL_AIR_PRESSURE_INDEX) = real_count
  1400)             p_air = general%mole_fraction%dataset%rarray(1) * p_gas
  1401)             call EOSWaterSaturationPressure(temperature,p_sat,ierr)
  1402)             if (p_gas - p_air >= p_sat) then
  1403)               option%io_buffer = 'MOLE_FRACTION set in flow condition "' // &
  1404)                 trim(flow_condition%name) // &
  1405)                 '" results in a vapor pressure exceeding the water ' // &
  1406)                 'saturation pressure, which indicates that a two-phase ' // &
  1407)                 'state with GAS_PRESSURE and GAS_SATURATION should be used.'
  1408)               call printErrMsg(option)
  1409)             endif
  1410)             coupler%flow_aux_real_var(real_count,1:num_connections) = p_air
  1411)             dof2 = PETSC_TRUE
  1412)             coupler%flow_bc_type(GENERAL_LIQUID_EQUATION_INDEX) = DIRICHLET_BC
  1413)           case default
  1414)             string = &
  1415)               GetSubConditionName(general%mole_fraction%itype)
  1416)             option%io_buffer = &
  1417)                 FlowConditionUnknownItype(coupler%flow_condition, &
  1418)                 'general gas state mole fraction',string)
  1419)             call printErrMsg(option)
  1420)         end select                
  1421)       else
  1422)         select case(general%relative_humidity%itype)
  1423)           case(DIRICHLET_BC)
  1424)             if (Uninitialized(p_gas) .or. Uninitialized(temperature)) then
  1425)               option%io_buffer = 'Gas pressure or temperature not set ' // &
  1426)                 'correctly in flow condition "' // &
  1427)                 trim(flow_condition%name) // '".'
  1428)               call printErrMsg(option)
  1429)             endif
  1430)             coupler%flow_aux_mapping(GENERAL_AIR_PRESSURE_INDEX) = real_count
  1431)             ! relative humidity in %
  1432)             relative_humidity = general%relative_humidity%dataset%rarray(1)
  1433)             if (relative_humidity < 0.d0 .or. relative_humidity > 100.d0) then
  1434)               option%io_buffer = 'Relative humidity in flow condition "' // &
  1435)                 trim(flow_condition%name) // '" outside bounds of 0-100%.'
  1436)               call printErrMsg(option)
  1437)             endif
  1438)             call EOSWaterSaturationPressure(temperature,p_sat,ierr)
  1439)                              ! convert from % to fraction
  1440)             p_air = p_gas - relative_humidity*1.d-2*p_sat
  1441)             coupler%flow_aux_real_var(real_count,1:num_connections) = p_air
  1442)             dof2 = PETSC_TRUE
  1443)             coupler%flow_bc_type(GENERAL_LIQUID_EQUATION_INDEX) = DIRICHLET_BC
  1444)           case default
  1445)             string = &
  1446)               GetSubConditionName(general%mole_fraction%itype)
  1447)             option%io_buffer = &
  1448)                 FlowConditionUnknownItype(coupler%flow_condition, &
  1449)                 'general gas state relative humidity',string)
  1450)             call printErrMsg(option)
  1451)         end select                
  1452)       endif
  1453)     case(ANY_STATE)
  1454)       if (associated(coupler%flow_aux_int_var)) then ! not used with rate
  1455)         coupler%flow_aux_int_var(GENERAL_STATE_INDEX,1:num_connections) = &
  1456)           ANY_STATE
  1457)       endif
  1458)       if (associated(general%temperature)) then
  1459)         real_count = real_count + 1
  1460)         select case(general%temperature%itype)
  1461)           case(DIRICHLET_BC)
  1462)             coupler%flow_aux_mapping(GENERAL_TEMPERATURE_INDEX) = real_count
  1463)             select type(selector =>general%temperature%dataset)
  1464)               class is(dataset_ascii_type)
  1465)                 coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1466)                   selector%rarray(1)
  1467)                 dof3 = PETSC_TRUE
  1468)               class is(dataset_gridded_hdf5_type)
  1469)                 call PatchUpdateCouplerFromDataset(coupler,option, &
  1470)                                                    patch%grid,selector, &
  1471)                                                    real_count)
  1472)                 dof3 = PETSC_TRUE
  1473)               class default
  1474)                 option%io_buffer = 'Unknown dataset class (general%' // &
  1475)                   'temperature%itype,LIQUID_STATE,DIRICHLET_BC)'
  1476)                 call printErrMsg(option)
  1477)             end select
  1478)             coupler%flow_bc_type(GENERAL_ENERGY_EQUATION_INDEX) = DIRICHLET_BC
  1479)           case default
  1480)             string = &
  1481)               GetSubConditionName(general%temperature%itype)
  1482)             option%io_buffer = &
  1483)               FlowConditionUnknownItype(coupler%flow_condition, &
  1484)                 'general gas state temperature',string)
  1485)             call printErrMsg(option)
  1486)         end select
  1487)       endif
  1488)   end select
  1489)   
  1490)   if (associated(general%liquid_flux)) then
  1491)     coupler%flow_bc_type(GENERAL_LIQUID_EQUATION_INDEX) = NEUMANN_BC
  1492)     real_count = real_count + 1
  1493)     coupler%flow_aux_mapping(GENERAL_LIQUID_FLUX_INDEX) = real_count
  1494)     coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1495)       general%liquid_flux%dataset%rarray(1)
  1496)     dof1 = PETSC_TRUE
  1497)   endif
  1498)   if (associated(general%gas_flux)) then
  1499)     coupler%flow_bc_type(GENERAL_GAS_EQUATION_INDEX) = NEUMANN_BC
  1500)     real_count = real_count + 1
  1501)     coupler%flow_aux_mapping(GENERAL_GAS_FLUX_INDEX) = real_count
  1502)     coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1503)       general%gas_flux%dataset%rarray(1)
  1504)     dof2 = PETSC_TRUE
  1505)   endif
  1506)   if (associated(general%energy_flux)) then
  1507)     coupler%flow_bc_type(GENERAL_ENERGY_EQUATION_INDEX) = NEUMANN_BC
  1508)     real_count = real_count + 1
  1509)     coupler%flow_aux_mapping(GENERAL_ENERGY_FLUX_INDEX) = real_count
  1510)     coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1511)       general%energy_flux%dataset%rarray(1)
  1512)     dof3 = PETSC_TRUE
  1513)   endif
  1514) 
  1515)   if (associated(general%rate)) then
  1516)     select case(general%rate%itype)
  1517)       case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
  1518)         call PatchScaleSourceSink(patch,coupler,general%rate%isubtype,option)
  1519)     end select
  1520)   endif
  1521) 
  1522)   !geh: is this really correct, or should it be .or.
  1523)   if (.not.dof1 .or. .not.dof2 .or. .not.dof3) then
  1524)     option%io_buffer = 'Error with general phase boundary condition'
  1525)   endif
  1526) 
  1527) end subroutine PatchUpdateCouplerAuxVarsG
  1528) 
  1529) ! ************************************************************************** !
  1530) 
  1531) subroutine PatchUpdateCouplerAuxVarsTOI(patch,coupler,option)
  1532)   ! 
  1533)   ! Updates flow auxiliary variables associated
  1534)   ! with a coupler for TOIL_IMS_MODE
  1535)   ! only ascii database option currenlty available 
  1536)   !
  1537)   ! Author: Paolo Orsini
  1538)   ! Date: 09/09/15
  1539)   ! 
  1540) 
  1541)   use Option_module
  1542)   use Condition_module
  1543)   use Hydrostatic_module
  1544)   use HydrostaticMultiPhase_module  
  1545)   use Saturation_module
  1546)   
  1547)   use TOilIms_Aux_module
  1548)   use Grid_module
  1549)   use Dataset_Common_HDF5_class
  1550)   use Dataset_Gridded_HDF5_class
  1551)   use Dataset_Ascii_class
  1552)   use Dataset_module
  1553) 
  1554)   implicit none
  1555)   
  1556)   type(patch_type) :: patch
  1557)   type(coupler_type), pointer :: coupler
  1558)   type(option_type) :: option
  1559)   
  1560)   type(flow_condition_type), pointer :: flow_condition
  1561)   character(len=MAXSTRINGLENGTH) :: string
  1562)   !type(tran_condition_type), pointer :: tran_condition
  1563) 
  1564)   type(flow_toil_ims_condition_type), pointer :: toil_ims
  1565) 
  1566)   PetscBool :: dof1, dof2, dof3
  1567) 
  1568)   PetscErrorCode :: ierr
  1569)   
  1570)   PetscInt :: idof, num_connections
  1571)   PetscInt :: iconn, local_id, ghosted_id
  1572)   ! use to map flow_aux_map to the flow_aux_real_var array
  1573)   PetscInt :: real_count 
  1574)   
  1575)   num_connections = coupler%connection_set%num_connections
  1576) 
  1577)   flow_condition => coupler%flow_condition
  1578) 
  1579)   toil_ims => flow_condition%toil_ims
  1580)   dof1 = PETSC_FALSE
  1581)   dof2 = PETSC_FALSE
  1582)   dof3 = PETSC_FALSE
  1583) 
  1584)   real_count = 0
  1585) 
  1586)   if ( associated(toil_ims%pressure) ) then
  1587)     ! pressure is either hydrostatic or dirichlet
  1588)     if (toil_ims%pressure%itype == HYDROSTATIC_BC) then
  1589)       if (toil_ims%saturation%itype /= DIRICHLET_BC) then
  1590)             option%io_buffer = &
  1591)               'Hydrostatic pressure bc for flow condition "' // &
  1592)               trim(flow_condition%name) // &
  1593)               '" requires a saturation bc of type dirichlet'
  1594)             call printErrMsg(option)
  1595)       endif 
  1596)       if (toil_ims%temperature%itype /= DIRICHLET_BC) then
  1597)             option%io_buffer = &
  1598)               'Hydrostatic pressure bc for flow condition "' // &
  1599)               trim(flow_condition%name) // &
  1600)               '" requires a temperature bc of type dirichlet'
  1601)             call printErrMsg(option)
  1602)       endif
  1603)       ! at the moment hydrostatic pressure is valid only for regions
  1604)       ! fully saturated in water Sw=Sw_max, where Pw=Po (i.e. Pc=0)
  1605)       !coupler%flow_aux_mapping(TOIL_IMS_OIL_SATURATION_INDEX) = 2
  1606)       !coupler%flow_aux_real_var(2,1:num_connections) = 0.d0 
  1607)       !allow for exception when zero capillary pressure (pw=po)
  1608)       !coupler%flow_aux_real_var(2,1:num_connections) = & 
  1609)       !  toil_ims%saturation%dataset%rarray(1)
  1610)       dof2 = PETSC_TRUE
  1611)       call TOIHydrostaticUpdateCoupler(coupler,option,patch%grid, &
  1612)                    patch%characteristic_curves_array,patch%sat_func_id, & 
  1613)                    patch%imat)    
  1614)       coupler%flow_bc_type(TOIL_IMS_OIL_EQUATION_INDEX) = HYDROSTATIC_BC 
  1615)       coupler%flow_bc_type(TOIL_IMS_LIQUID_EQUATION_INDEX) = HYDROSTATIC_BC
  1616)       coupler%flow_bc_type(TOIL_IMS_ENERGY_EQUATION_INDEX) = DIRICHLET_BC
  1617)       dof1 = PETSC_TRUE
  1618)       dof3 = PETSC_TRUE
  1619)     else
  1620)       real_count = real_count + 1
  1621)       select case(toil_ims%pressure%itype)
  1622)         case(DIRICHLET_BC)
  1623)           coupler%flow_aux_mapping(TOIL_IMS_PRESSURE_INDEX) = real_count
  1624)           coupler%flow_bc_type(TOIL_IMS_LIQUID_EQUATION_INDEX) = DIRICHLET_BC
  1625)           select type(selector => toil_ims%pressure%dataset)
  1626)             class is(dataset_ascii_type)
  1627)               coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1628)                 selector%rarray(1)
  1629)               dof1 = PETSC_TRUE
  1630)             class is(dataset_gridded_hdf5_type)
  1631)               call PatchUpdateCouplerFromDataset(coupler,option, &
  1632)                                                  patch%grid,selector, &
  1633)                                                  real_count)
  1634)               dof1 = PETSC_TRUE
  1635)             class default
  1636)               option%io_buffer = 'Unknown dataset class (toil_ims%' // &
  1637)                                  'pressure%itype,DIRICHLET_BC)'
  1638)               call printErrMsg(option)
  1639)           end select
  1640)         !case(CONDUCTANCE_BC) !not implemented yet
  1641)         !case(SEEPAGE_BC) !not implemented yet
  1642)         case default
  1643)           string = &
  1644)             GetSubConditionName(toil_ims%pressure%itype)
  1645)           option%io_buffer = &
  1646)             FlowConditionUnknownItype(coupler%flow_condition, &
  1647)               'toi_ims pressure',string)
  1648)           call printErrMsg(option)
  1649)       end select
  1650) 
  1651)       real_count = real_count + 1
  1652)       select case(toil_ims%saturation%itype)
  1653)         case(DIRICHLET_BC)
  1654)           coupler%flow_aux_mapping(TOIL_IMS_OIL_SATURATION_INDEX) = real_count
  1655)           !coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1656)           !  toil_ims%saturation%dataset%rarray(1)
  1657)           !dof2 = PETSC_TRUE
  1658)           coupler%flow_bc_type(TOIL_IMS_OIL_EQUATION_INDEX) = DIRICHLET_BC
  1659)           select type(selector => toil_ims%saturation%dataset)
  1660)             class is(dataset_ascii_type)
  1661)               coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1662)                 selector%rarray(1)
  1663)               dof2 = PETSC_TRUE
  1664)             class is(dataset_gridded_hdf5_type)
  1665)               call PatchUpdateCouplerFromDataset(coupler,option, &
  1666)                                                  patch%grid,selector, &
  1667)                                                  real_count)
  1668)               dof2 = PETSC_TRUE
  1669)             class default
  1670)               option%io_buffer = 'Unknown dataset class (toil_ims%' // &
  1671)                                  'saturation%itype,DIRICHLET_BC)'
  1672)               call printErrMsg(option)
  1673)           end select
  1674)         case default
  1675)           string = &
  1676)             GetSubConditionName(toil_ims%saturation%itype)
  1677)           option%io_buffer = &
  1678)             FlowConditionUnknownItype(coupler%flow_condition, &
  1679)               'toi_ims saturation',string)
  1680)           call printErrMsg(option)
  1681)       end select
  1682)  
  1683)       real_count = real_count + 1
  1684)       select case(toil_ims%temperature%itype)
  1685)         case(DIRICHLET_BC)
  1686)           coupler%flow_aux_mapping(TOIL_IMS_TEMPERATURE_INDEX) = real_count
  1687)           !temperature = toil_ims%temperature%dataset%rarray(1)
  1688)           !coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1689)           !  temperature
  1690)           !dof3 = PETSC_TRUE
  1691)           coupler%flow_bc_type(TOIL_IMS_ENERGY_EQUATION_INDEX) = DIRICHLET_BC
  1692)           select type(selector => toil_ims%temperature%dataset)
  1693)             class is(dataset_ascii_type)
  1694)               coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1695)                 selector%rarray(1)
  1696)               dof3 = PETSC_TRUE
  1697)             class is(dataset_gridded_hdf5_type)
  1698)               call PatchUpdateCouplerFromDataset(coupler,option, &
  1699)                                                  patch%grid,selector, &
  1700)                                                  real_count)
  1701)               dof3 = PETSC_TRUE
  1702)             class default
  1703)               option%io_buffer = 'Unknown dataset class (toil_ims%' // &
  1704)                                  'temperature%itype,DIRICHLET_BC)'
  1705)               call printErrMsg(option)
  1706)           end select
  1707)         ! to add here therma gradient option
  1708)         case default
  1709)           string = &
  1710)             GetSubConditionName(toil_ims%temperature%itype)
  1711)           option%io_buffer = &
  1712)             FlowConditionUnknownItype(coupler%flow_condition, &
  1713)               'toi_ims temperature',string)      
  1714)           call printErrMsg(option)
  1715)       end select
  1716) 
  1717)     end if ! end else branch for pressure /= HYDROSTATIC_BC
  1718)   end if !if associated pressure 
  1719)   
  1720)   if (associated(toil_ims%liquid_flux)) then
  1721)     coupler%flow_bc_type(TOIL_IMS_LIQUID_EQUATION_INDEX) = NEUMANN_BC
  1722)     real_count = real_count + 1
  1723)     coupler%flow_aux_mapping(TOIL_IMS_LIQUID_FLUX_INDEX) = real_count
  1724)     coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1725)       toil_ims%liquid_flux%dataset%rarray(1)
  1726)     dof1 = PETSC_TRUE
  1727)   endif
  1728)   if (associated(toil_ims%oil_flux)) then
  1729)     coupler%flow_bc_type(TOIL_IMS_OIL_EQUATION_INDEX) = NEUMANN_BC
  1730)     real_count = real_count + 1
  1731)     coupler%flow_aux_mapping(TOIL_IMS_OIL_FLUX_INDEX) = real_count
  1732)     coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1733)       toil_ims%oil_flux%dataset%rarray(1)
  1734)     dof2 = PETSC_TRUE
  1735)   endif
  1736)   if (associated(toil_ims%energy_flux)) then
  1737)     coupler%flow_bc_type(TOIL_IMS_ENERGY_EQUATION_INDEX) = NEUMANN_BC
  1738)     real_count = real_count + 1
  1739)     coupler%flow_aux_mapping(TOIL_IMS_ENERGY_FLUX_INDEX) = real_count
  1740)     coupler%flow_aux_real_var(real_count,1:num_connections) = &
  1741)       toil_ims%energy_flux%dataset%rarray(1)
  1742)     dof3 = PETSC_TRUE
  1743)   endif
  1744) 
  1745)   if (associated(toil_ims%rate)) then
  1746)     select case(toil_ims%rate%itype)
  1747)       case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
  1748)         call PatchScaleSourceSink(patch,coupler,toil_ims%rate%isubtype,option)
  1749)     end select
  1750)   endif
  1751) 
  1752)   ! if not all primary variables updated for toil_ims, it returns an error
  1753)   !if (.not.dof1 .or. .not.dof2 .or. .not.dof3) then
  1754)   !  option%io_buffer = 'Error with themal oil phase boundary condition'
  1755)   !endif
  1756) 
  1757) end subroutine PatchUpdateCouplerAuxVarsTOI
  1758) 
  1759) ! ************************************************************************** !
  1760) 
  1761) subroutine PatchUpdateCouplerAuxVarsMPH(patch,coupler,option)
  1762)   ! 
  1763)   ! Updates flow auxiliary variables associated
  1764)   ! with a coupler for MPH_MODE
  1765)   ! 
  1766)   ! Author: Glenn Hammond
  1767)   ! Date: 11/26/07
  1768)   ! 
  1769) 
  1770)   use Option_module
  1771)   use Condition_module
  1772)   use Hydrostatic_module
  1773)   use Saturation_module
  1774)   
  1775)   
  1776)   use General_Aux_module
  1777)   use Grid_module
  1778)   use Dataset_Common_HDF5_class
  1779)   use Dataset_Gridded_HDF5_class
  1780) 
  1781)   implicit none
  1782)   
  1783)   type(patch_type) :: patch
  1784)   type(coupler_type), pointer :: coupler
  1785)   type(option_type) :: option
  1786)   
  1787)   type(flow_condition_type), pointer :: flow_condition
  1788)   type(tran_condition_type), pointer :: tran_condition
  1789)   type(flow_general_condition_type), pointer :: general
  1790)   class(dataset_common_hdf5_type), pointer :: dataset
  1791)   PetscBool :: update
  1792)   PetscBool :: dof1, dof2, dof3
  1793)   PetscReal :: temperature, p_sat
  1794)   PetscReal :: x(option%nflowdof)
  1795)   character(len=MAXSTRINGLENGTH) :: string, string2
  1796)   PetscErrorCode :: ierr
  1797)   
  1798)   PetscInt :: idof, num_connections,sum_connection
  1799)   PetscInt :: iconn, local_id, ghosted_id
  1800) 
  1801)   num_connections = coupler%connection_set%num_connections
  1802) 
  1803)   flow_condition => coupler%flow_condition
  1804) 
  1805)   if (associated(flow_condition%pressure)) then
  1806)     coupler%flow_aux_int_var(COUPLER_IPHASE_INDEX,1:num_connections) = &
  1807)                 flow_condition%iphase
  1808)     select case(flow_condition%pressure%itype)
  1809)       case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
  1810)         coupler%flow_aux_real_var(MPH_PRESSURE_DOF,1:num_connections) = &
  1811)                 flow_condition%pressure%dataset%rarray(1)
  1812)       case(HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
  1813)         call HydrostaticUpdateCoupler(coupler,option,patch%grid)
  1814)  !  case(SATURATION_BC)
  1815)     end select
  1816)     select case(flow_condition%temperature%itype)
  1817)       case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
  1818)         if (flow_condition%pressure%itype /= HYDROSTATIC_BC .or. &
  1819)            (flow_condition%pressure%itype == HYDROSTATIC_BC .and. &
  1820)            flow_condition%temperature%itype /= DIRICHLET_BC)) then
  1821)           coupler%flow_aux_real_var(MPH_TEMPERATURE_DOF,1:num_connections) = &
  1822)                   flow_condition%temperature%dataset%rarray(1)
  1823)         endif
  1824)     end select
  1825)     select case(flow_condition%concentration%itype)
  1826)       case(DIRICHLET_BC,ZERO_GRADIENT_BC)
  1827)         if (flow_condition%pressure%itype /= HYDROSTATIC_BC .or. &
  1828)            (flow_condition%pressure%itype == HYDROSTATIC_BC .and. &
  1829)            flow_condition%concentration%itype /= DIRICHLET_BC)) then
  1830)           coupler%flow_aux_real_var(MPH_CONCENTRATION_DOF,1:num_connections) = &
  1831)                   flow_condition%concentration%dataset%rarray(1)
  1832)         endif
  1833)     end select
  1834)   else
  1835)     select case(flow_condition%temperature%itype)
  1836)       case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
  1837)         coupler%flow_aux_real_var(MPH_TEMPERATURE_DOF,1:num_connections) = &
  1838)                   flow_condition%temperature%dataset%rarray(1)
  1839)     end select
  1840)     select case(flow_condition%concentration%itype)
  1841)       case(DIRICHLET_BC,ZERO_GRADIENT_BC)
  1842)          coupler%flow_aux_real_var(MPH_CONCENTRATION_DOF,1:num_connections) = &
  1843)                   flow_condition%concentration%dataset%rarray(1)
  1844)     end select
  1845)   endif
  1846)   if (associated(flow_condition%rate)) then
  1847)     select case(flow_condition%rate%itype)
  1848)       case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
  1849)         call PatchScaleSourceSink(patch,coupler,flow_condition%rate%isubtype, &
  1850)                                   option)
  1851)     end select
  1852)   endif
  1853)   if (associated(flow_condition%saturation)) then
  1854)     call SaturationUpdateCoupler(coupler,option,patch%grid, &
  1855)                                  patch%saturation_function_array, &
  1856)                                  patch%sat_func_id)
  1857)   endif
  1858) 
  1859) end subroutine PatchUpdateCouplerAuxVarsMPH
  1860) 
  1861) ! ************************************************************************** !
  1862) 
  1863) subroutine PatchUpdateCouplerAuxVarsIMS(patch,coupler,option)
  1864)   ! 
  1865)   ! Updates flow auxiliary variables associated
  1866)   ! with a coupler for IMS_MODE
  1867)   ! 
  1868)   ! Author: Glenn Hammond
  1869)   ! Date: 11/26/07
  1870)   ! 
  1871) 
  1872)   use Option_module
  1873)   use Condition_module
  1874)   use Hydrostatic_module
  1875)   use Saturation_module
  1876)   
  1877)   
  1878)   use General_Aux_module
  1879)   use Grid_module
  1880)   use Dataset_Common_HDF5_class
  1881)   use Dataset_Gridded_HDF5_class
  1882) 
  1883)   implicit none
  1884)   
  1885)   type(patch_type) :: patch
  1886)   type(coupler_type), pointer :: coupler
  1887)   type(option_type) :: option
  1888)   
  1889)   type(flow_condition_type), pointer :: flow_condition
  1890)   type(tran_condition_type), pointer :: tran_condition
  1891)   type(flow_general_condition_type), pointer :: general
  1892)   class(dataset_common_hdf5_type), pointer :: dataset
  1893)   PetscBool :: update
  1894)   PetscBool :: dof1, dof2, dof3
  1895)   PetscReal :: temperature, p_sat
  1896)   PetscReal :: x(option%nflowdof)
  1897)   character(len=MAXSTRINGLENGTH) :: string, string2
  1898)   PetscErrorCode :: ierr
  1899)   
  1900)   PetscInt :: idof, num_connections,sum_connection
  1901)   PetscInt :: iconn, local_id, ghosted_id
  1902)   
  1903)   num_connections = coupler%connection_set%num_connections
  1904) 
  1905)   flow_condition => coupler%flow_condition
  1906) 
  1907)   if (associated(flow_condition%pressure)) then
  1908)     coupler%flow_aux_int_var(COUPLER_IPHASE_INDEX,1:num_connections) = &
  1909)                 flow_condition%iphase
  1910)     select case(flow_condition%pressure%itype)
  1911)       case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
  1912)         coupler%flow_aux_real_var(MPH_PRESSURE_DOF,1:num_connections) = &
  1913)                 flow_condition%pressure%dataset%rarray(1)
  1914)       case(HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
  1915)         call HydrostaticUpdateCoupler(coupler,option,patch%grid)
  1916)  !  case(SATURATION_BC)
  1917)     end select
  1918)     select case(flow_condition%temperature%itype)
  1919)       case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
  1920)         if (flow_condition%pressure%itype /= HYDROSTATIC_BC .or. &
  1921)            (flow_condition%pressure%itype == HYDROSTATIC_BC .and. &
  1922)            flow_condition%temperature%itype /= DIRICHLET_BC)) then
  1923)           coupler%flow_aux_real_var(MPH_TEMPERATURE_DOF,1:num_connections) = &
  1924)                   flow_condition%temperature%dataset%rarray(1)
  1925)         endif
  1926)     end select
  1927)     select case(flow_condition%concentration%itype)
  1928)       case(DIRICHLET_BC,ZERO_GRADIENT_BC)
  1929)         if (flow_condition%pressure%itype /= HYDROSTATIC_BC .or. &
  1930)            (flow_condition%pressure%itype == HYDROSTATIC_BC .and. &
  1931)            flow_condition%concentration%itype /= DIRICHLET_BC)) then
  1932)           coupler%flow_aux_real_var(MPH_CONCENTRATION_DOF,1:num_connections) = &
  1933)                   flow_condition%concentration%dataset%rarray(1)
  1934)         endif
  1935)     end select
  1936)   else
  1937)     select case(flow_condition%temperature%itype)
  1938)       case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
  1939)         coupler%flow_aux_real_var(MPH_TEMPERATURE_DOF,1:num_connections) = &
  1940)                   flow_condition%temperature%dataset%rarray(1)
  1941)     end select
  1942)     select case(flow_condition%concentration%itype)
  1943)       case(DIRICHLET_BC,ZERO_GRADIENT_BC)
  1944)          coupler%flow_aux_real_var(MPH_CONCENTRATION_DOF,1:num_connections) = &
  1945)                   flow_condition%concentration%dataset%rarray(1)
  1946)     end select
  1947)   endif
  1948)   if (associated(flow_condition%rate)) then
  1949)     select case(flow_condition%rate%itype)
  1950)       case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
  1951)         call PatchScaleSourceSink(patch,coupler,flow_condition%rate%isubtype, &
  1952)                                   option)
  1953)     end select
  1954)   endif
  1955)   if (associated(flow_condition%saturation)) then
  1956)     call SaturationUpdateCoupler(coupler,option,patch%grid, &
  1957)                                  patch%saturation_function_array, &
  1958)                                  patch%sat_func_id)
  1959)   endif
  1960) 
  1961) end subroutine PatchUpdateCouplerAuxVarsIMS
  1962) 
  1963) ! ************************************************************************** !
  1964) 
  1965) subroutine PatchUpdateCouplerAuxVarsFLASH2(patch,coupler,option)
  1966)   ! 
  1967)   ! Updates flow auxiliary variables associated
  1968)   ! with a coupler for FLASH2_MODE
  1969)   ! 
  1970)   ! Author: Glenn Hammond
  1971)   ! Date: 11/26/07
  1972)   ! 
  1973) 
  1974)   use Option_module
  1975)   use Condition_module
  1976)   use Hydrostatic_module
  1977)   use Saturation_module
  1978)   
  1979)   
  1980)   use General_Aux_module
  1981)   use Grid_module
  1982)   use Dataset_Common_HDF5_class
  1983)   use Dataset_Gridded_HDF5_class
  1984) 
  1985)   implicit none
  1986)   
  1987)   type(patch_type) :: patch
  1988)   type(coupler_type), pointer :: coupler
  1989)   type(option_type) :: option
  1990)   
  1991)   type(flow_condition_type), pointer :: flow_condition
  1992)   type(tran_condition_type), pointer :: tran_condition
  1993)   type(flow_general_condition_type), pointer :: general
  1994)   class(dataset_common_hdf5_type), pointer :: dataset
  1995)   PetscBool :: update
  1996)   PetscBool :: dof1, dof2, dof3
  1997)   PetscReal :: temperature, p_sat
  1998)   PetscReal :: x(option%nflowdof)
  1999)   character(len=MAXSTRINGLENGTH) :: string, string2
  2000)   PetscErrorCode :: ierr
  2001)   
  2002)   PetscInt :: idof, num_connections,sum_connection
  2003)   PetscInt :: iconn, local_id, ghosted_id
  2004) 
  2005)   num_connections = coupler%connection_set%num_connections
  2006) 
  2007)   flow_condition => coupler%flow_condition
  2008) 
  2009)   if (associated(flow_condition%pressure)) then
  2010)     coupler%flow_aux_int_var(COUPLER_IPHASE_INDEX,1:num_connections) = &
  2011)                 flow_condition%iphase
  2012)     select case(flow_condition%pressure%itype)
  2013)       case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
  2014)         coupler%flow_aux_real_var(MPH_PRESSURE_DOF,1:num_connections) = &
  2015)                 flow_condition%pressure%dataset%rarray(1)
  2016)       case(HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
  2017)         call HydrostaticUpdateCoupler(coupler,option,patch%grid)
  2018)  !  case(SATURATION_BC)
  2019)     end select
  2020)     select case(flow_condition%temperature%itype)
  2021)       case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
  2022)         if (flow_condition%pressure%itype /= HYDROSTATIC_BC .or. &
  2023)            (flow_condition%pressure%itype == HYDROSTATIC_BC .and. &
  2024)            flow_condition%temperature%itype /= DIRICHLET_BC)) then
  2025)           coupler%flow_aux_real_var(MPH_TEMPERATURE_DOF,1:num_connections) = &
  2026)                   flow_condition%temperature%dataset%rarray(1)
  2027)         endif
  2028)     end select
  2029)     select case(flow_condition%concentration%itype)
  2030)       case(DIRICHLET_BC,ZERO_GRADIENT_BC)
  2031)         if (flow_condition%pressure%itype /= HYDROSTATIC_BC .or. &
  2032)            (flow_condition%pressure%itype == HYDROSTATIC_BC .and. &
  2033)            flow_condition%concentration%itype /= DIRICHLET_BC)) then
  2034)           coupler%flow_aux_real_var(MPH_CONCENTRATION_DOF,1:num_connections) = &
  2035)                   flow_condition%concentration%dataset%rarray(1)
  2036)         endif
  2037)     end select
  2038)   else
  2039)     select case(flow_condition%temperature%itype)
  2040)       case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
  2041)         coupler%flow_aux_real_var(MPH_TEMPERATURE_DOF,1:num_connections) = &
  2042)                   flow_condition%temperature%dataset%rarray(1)
  2043)     end select
  2044)     select case(flow_condition%concentration%itype)
  2045)       case(DIRICHLET_BC,ZERO_GRADIENT_BC)
  2046)          coupler%flow_aux_real_var(MPH_CONCENTRATION_DOF,1:num_connections) = &
  2047)                   flow_condition%concentration%dataset%rarray(1)
  2048)     end select
  2049)   endif
  2050)   if (associated(flow_condition%rate)) then
  2051)     select case(flow_condition%rate%itype)
  2052)       case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
  2053)         call PatchScaleSourceSink(patch,coupler,flow_condition%rate%isubtype, &
  2054)                                   option)
  2055)     end select
  2056)   endif
  2057)   if (associated(flow_condition%saturation)) then
  2058)     call SaturationUpdateCoupler(coupler,option,patch%grid, &
  2059)                                  patch%saturation_function_array, &
  2060)                                  patch%sat_func_id)
  2061)   endif
  2062) 
  2063) end subroutine PatchUpdateCouplerAuxVarsFLASH2
  2064) 
  2065) ! ************************************************************************** !
  2066) 
  2067) subroutine PatchUpdateCouplerAuxVarsTH(patch,coupler,option)
  2068)   ! 
  2069)   ! Updates flow auxiliary variables associated
  2070)   ! with a coupler for TH_MODE
  2071)   ! 
  2072)   ! Author: Glenn Hammond
  2073)   ! Date: 11/26/07
  2074)   ! 
  2075) 
  2076)   use Option_module
  2077)   use Condition_module
  2078)   use Hydrostatic_module
  2079)   use Saturation_module
  2080)   
  2081)   
  2082)   use General_Aux_module
  2083)   use Grid_module
  2084)   use Dataset_Common_HDF5_class
  2085)   use Dataset_Gridded_HDF5_class
  2086)   use Dataset_Ascii_class
  2087) 
  2088)   implicit none
  2089)   
  2090)   type(patch_type) :: patch
  2091)   type(coupler_type), pointer :: coupler
  2092)   type(option_type) :: option
  2093)   
  2094)   type(flow_condition_type), pointer :: flow_condition
  2095)   type(tran_condition_type), pointer :: tran_condition
  2096)   type(flow_general_condition_type), pointer :: general
  2097)   class(dataset_common_hdf5_type), pointer :: dataset
  2098)   PetscBool :: update
  2099)   PetscBool :: dof1, dof2, dof3
  2100)   PetscReal :: temperature, p_sat
  2101)   PetscReal :: x(option%nflowdof)
  2102)   character(len=MAXSTRINGLENGTH) :: string, string2
  2103)   PetscErrorCode :: ierr
  2104)   PetscBool :: apply_temp_cond
  2105)   PetscInt :: rate_scale_type
  2106)   
  2107)   PetscInt :: idof, num_connections,sum_connection
  2108)   PetscInt :: iconn, local_id, ghosted_id
  2109)   PetscInt :: iphase
  2110)   
  2111)   num_connections = coupler%connection_set%num_connections
  2112) 
  2113)   flow_condition => coupler%flow_condition
  2114) 
  2115)   if (associated(flow_condition%pressure)) then
  2116)     !geh: this is a fix for an Intel compiler bug. Not sure why Intel cannot
  2117)     !     access flow_condition%iphase directly....
  2118)     iphase = flow_condition%iphase
  2119)     coupler%flow_aux_int_var(COUPLER_IPHASE_INDEX,1:num_connections) = iphase
  2120) !    coupler%flow_aux_int_var(COUPLER_IPHASE_INDEX,1:num_connections) = &
  2121) !                                                        flow_condition%iphase
  2122)     select case(flow_condition%pressure%itype)
  2123)       case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC,SPILLOVER_BC)
  2124)         select type(selector =>flow_condition%pressure%dataset)
  2125)           class is(dataset_ascii_type)
  2126)             coupler%flow_aux_real_var(TH_PRESSURE_DOF,1:num_connections) = &
  2127)               selector%rarray(1)
  2128)           class is(dataset_gridded_hdf5_type)
  2129)             call PatchUpdateCouplerFromDataset(coupler,option, &
  2130)                                                patch%grid,selector, &
  2131)                                                TH_PRESSURE_DOF)
  2132)           class default
  2133)             option%io_buffer = 'Unknown dataset class (TH%' // &
  2134)               'pressure%itype,DIRICHLET_BC)'
  2135)             call printErrMsg(option)
  2136)         end select
  2137)       case(HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
  2138)         call HydrostaticUpdateCoupler(coupler,option,patch%grid)
  2139)       case(HET_DIRICHLET)
  2140)         call PatchUpdateHetroCouplerAuxVars(patch,coupler, &
  2141)                 flow_condition%pressure%dataset, &
  2142)                 num_connections,TH_PRESSURE_DOF,option)
  2143)       case(HET_SURF_SEEPAGE_BC)
  2144)         ! Do nothing, since this BC type is only used for coupling of
  2145)         ! surface-subsurface model
  2146)       case default
  2147)         string = &
  2148)           GetSubConditionName(flow_condition%pressure%itype)
  2149)         option%io_buffer = &
  2150)           FlowConditionUnknownItype(flow_condition,'TH pressure',string)
  2151)         call printErrMsg(option)
  2152)     end select
  2153)     if (associated(flow_condition%temperature)) then
  2154)       select case(flow_condition%temperature%itype)
  2155)         case(DIRICHLET_BC,ZERO_GRADIENT_BC)
  2156)           select type(selector =>flow_condition%temperature%dataset)
  2157)             class is(dataset_ascii_type)
  2158)               if (flow_condition%pressure%itype /= HYDROSTATIC_BC .or. &
  2159)                  (flow_condition%pressure%itype == HYDROSTATIC_BC .and. &
  2160)                  flow_condition%temperature%itype /= DIRICHLET_BC)) then
  2161)                 coupler%flow_aux_real_var(TH_TEMPERATURE_DOF, &
  2162)                                           1:num_connections) = &
  2163)                   selector%rarray(1)
  2164)               endif
  2165)             class is(dataset_gridded_hdf5_type)
  2166)               call PatchUpdateCouplerFromDataset(coupler,option, &
  2167)                                                  patch%grid,selector, &
  2168)                                                  TH_TEMPERATURE_DOF)
  2169)             class default
  2170)               option%io_buffer = 'Unknown dataset class (TH%' // &
  2171)                 'temperature%itype,DIRICHLET_BC)'
  2172)               call printErrMsg(option)
  2173)           end select
  2174)         case (HET_DIRICHLET)
  2175)           call PatchUpdateHetroCouplerAuxVars(patch,coupler, &
  2176)                   flow_condition%temperature%dataset, &
  2177)                   num_connections,TH_TEMPERATURE_DOF,option)
  2178)         case default
  2179)           string = &
  2180)             GetSubConditionName(flow_condition%temperature%itype)
  2181)           option%io_buffer = &
  2182)             FlowConditionUnknownItype(flow_condition,'TH temperature',string)
  2183)           call printErrMsg(option)
  2184)       end select
  2185)     endif
  2186)     if (associated(flow_condition%energy_flux)) then
  2187)       coupler%flow_aux_real_var(TH_TEMPERATURE_DOF,1:num_connections) = &
  2188)         flow_condition%energy_flux%dataset%rarray(1)
  2189)     endif
  2190)   endif
  2191) 
  2192)   apply_temp_cond = PETSC_FALSE
  2193)   if (associated(flow_condition%temperature) .and. associated(flow_condition%pressure)) then
  2194)     if (flow_condition%pressure%itype /= HYDROSTATIC_BC) then
  2195)       apply_temp_cond = PETSC_TRUE
  2196)     else
  2197)       if (flow_condition%temperature%itype /= DIRICHLET_BC) then
  2198)         apply_temp_cond = PETSC_TRUE
  2199)       endif
  2200)     endif
  2201)   else
  2202)     apply_temp_cond = PETSC_TRUE
  2203)   endif
  2204) 
  2205)   if (associated(flow_condition%temperature) .and. apply_temp_cond) then
  2206)     select case(flow_condition%temperature%itype)
  2207)       case(DIRICHLET_BC,ZERO_GRADIENT_BC)
  2208)         select type(selector =>flow_condition%temperature%dataset)
  2209)           class is(dataset_ascii_type)
  2210)             coupler%flow_aux_real_var(TH_TEMPERATURE_DOF, &
  2211)                                       1:num_connections) = &
  2212)               selector%rarray(1)
  2213)           class is(dataset_gridded_hdf5_type)
  2214)             call PatchUpdateCouplerFromDataset(coupler,option, &
  2215)                                                patch%grid,selector, &
  2216)                                                TH_TEMPERATURE_DOF)
  2217)           class default
  2218)             option%io_buffer = 'Unknown dataset class (TH%' // &
  2219)               'pressure%itype,DIRICHLET_BC)'
  2220)             call printErrMsg(option)
  2221)         end select
  2222)       case (HET_DIRICHLET)
  2223)         call PatchUpdateHetroCouplerAuxVars(patch,coupler, &
  2224)                 flow_condition%temperature%dataset, &
  2225)                 num_connections,TH_TEMPERATURE_DOF,option)
  2226)       case default
  2227)         string = &
  2228)           GetSubConditionName(flow_condition%temperature%itype)
  2229)         option%io_buffer = &
  2230)           FlowConditionUnknownItype(flow_condition,'TH temperature',string)      
  2231)         call printErrMsg(option)
  2232)     end select
  2233)   endif
  2234) 
  2235)   if (associated(flow_condition%energy_flux)) then
  2236)     select case(flow_condition%energy_flux%itype)
  2237)       case(NEUMANN_BC)
  2238)         select type(selector =>flow_condition%energy_flux%dataset)
  2239)           class is(dataset_ascii_type)
  2240)             coupler%flow_aux_real_var(TH_TEMPERATURE_DOF, &
  2241)                                       1:num_connections) = &
  2242)               selector%rarray(1)
  2243)           class is(dataset_gridded_hdf5_type)
  2244)             call PatchUpdateCouplerFromDataset(coupler,option, &
  2245)                                                patch%grid,selector, &
  2246)                                                TH_TEMPERATURE_DOF)
  2247)           class default
  2248)             option%io_buffer = 'Unknown dataset class (TH%' // &
  2249)               'pressure%itype,NEUMANN_BC)'
  2250)             call printErrMsg(option)
  2251)         end select
  2252)       case default
  2253)         string = &
  2254)           GetSubConditionName(flow_condition%energy_flux%itype)
  2255)         option%io_buffer = &
  2256)           FlowConditionUnknownItype(flow_condition,'TH energy flux',string)      
  2257)         call printErrMsg(option)
  2258)     end select
  2259)   endif
  2260)   
  2261)   !geh: we set this flag to ensure that we are not scaling mass and energy
  2262)   !     differently
  2263)   rate_scale_type = 0
  2264)   if (associated(flow_condition%rate)) then
  2265)     select case(flow_condition%rate%itype)
  2266)       case (HET_MASS_RATE_SS,HET_VOL_RATE_SS)
  2267)         call PatchUpdateHetroCouplerAuxVars(patch,coupler, &
  2268)                   flow_condition%rate%dataset, &
  2269)                   num_connections,TH_PRESSURE_DOF,option)
  2270)       case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
  2271)         call PatchScaleSourceSink(patch,coupler,flow_condition%rate%isubtype, &
  2272)                                   option)
  2273)         rate_scale_type = flow_condition%rate%isubtype
  2274)       case(MASS_RATE_SS,VOLUMETRIC_RATE_SS)
  2275)       ! do nothing here
  2276)       case default
  2277)         string = &
  2278)           GetSubConditionName(flow_condition%rate%itype)
  2279)         option%io_buffer = &
  2280)           FlowConditionUnknownItype(flow_condition,'TH rate',string)      
  2281)         call printErrMsg(option)
  2282)     end select
  2283)   endif
  2284)   if (associated(flow_condition%energy_rate)) then
  2285)     select case (flow_condition%energy_rate%itype)
  2286)       case (ENERGY_RATE_SS)
  2287)         !geh: this is pointless as %dataset%rarray(1) is reference in TH, 
  2288)         !     not the flow_aux_real_var!
  2289)         coupler%flow_aux_real_var(TH_TEMPERATURE_DOF,1:num_connections) = &
  2290)                   flow_condition%energy_rate%dataset%rarray(1)
  2291)       case (SCALED_ENERGY_RATE_SS)
  2292)         if (rate_scale_type == 0) then
  2293)           call PatchScaleSourceSink(patch,coupler, &
  2294)                                     flow_condition%energy_rate%isubtype,option)
  2295)         else if (rate_scale_type == flow_condition%energy_rate%isubtype) then
  2296)           !geh: do nothing as it is taken care of later.
  2297)         else
  2298)           option%io_buffer = 'MASS and ENERGY scaling mismatch in ' // &
  2299)             'FLOW_CONDITION "' // trim(flow_condition%name) // '".'
  2300)           call printErrMsg(option)
  2301)         endif
  2302)         !geh: do nothing as the
  2303)       case (HET_ENERGY_RATE_SS)
  2304)         call PatchUpdateHetroCouplerAuxVars(patch,coupler, &
  2305)                 flow_condition%energy_rate%dataset, &
  2306)                 num_connections,TH_TEMPERATURE_DOF,option)
  2307)       case default
  2308)         string = &
  2309)           GetSubConditionName(flow_condition%energy_rate%itype)
  2310)         option%io_buffer = &
  2311)           FlowConditionUnknownItype(flow_condition,'TH energy rate',string)      
  2312)         call printErrMsg(option)
  2313)     end select
  2314)   endif
  2315)   if (associated(flow_condition%saturation)) then
  2316)     call SaturationUpdateCoupler(coupler,option,patch%grid, &
  2317)                                  patch%saturation_function_array, &
  2318)                                  patch%sat_func_id)
  2319)   endif
  2320) 
  2321) end subroutine PatchUpdateCouplerAuxVarsTH
  2322) 
  2323) ! ************************************************************************** !
  2324) 
  2325) subroutine PatchUpdateCouplerAuxVarsMIS(patch,coupler,option)
  2326)   ! 
  2327)   ! Updates flow auxiliary variables associated
  2328)   ! with a coupler for MIS_MODE
  2329)   ! 
  2330)   ! Author: Glenn Hammond
  2331)   ! Date: 11/26/07
  2332)   ! 
  2333) 
  2334)   use Option_module
  2335)   use Condition_module
  2336)   use Hydrostatic_module
  2337)   use Saturation_module
  2338)   
  2339)   
  2340)   use General_Aux_module
  2341)   use Grid_module
  2342)   use Dataset_Common_HDF5_class
  2343)   use Dataset_Gridded_HDF5_class
  2344) 
  2345)   implicit none
  2346)   
  2347)   type(patch_type) :: patch
  2348)   type(coupler_type), pointer :: coupler
  2349)   type(option_type) :: option
  2350)   
  2351)   type(flow_condition_type), pointer :: flow_condition
  2352)   type(tran_condition_type), pointer :: tran_condition
  2353)   type(flow_general_condition_type), pointer :: general
  2354)   class(dataset_common_hdf5_type), pointer :: dataset
  2355)   PetscBool :: update
  2356)   PetscBool :: dof1, dof2, dof3
  2357)   PetscReal :: temperature, p_sat
  2358)   PetscReal :: x(option%nflowdof)
  2359)   character(len=MAXSTRINGLENGTH) :: string, string2
  2360)   PetscErrorCode :: ierr
  2361)   
  2362)   PetscInt :: idof, num_connections,sum_connection
  2363)   PetscInt :: iconn, local_id, ghosted_id
  2364)   
  2365)   num_connections = coupler%connection_set%num_connections
  2366) 
  2367)   flow_condition => coupler%flow_condition
  2368)   if (associated(flow_condition%pressure)) then
  2369)     select case(flow_condition%pressure%itype)
  2370)       case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
  2371)         coupler%flow_aux_real_var(MIS_PRESSURE_DOF, &
  2372)                                   1:num_connections) = &
  2373)           flow_condition%pressure%dataset%rarray(1)
  2374)       case(HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
  2375)         call HydrostaticUpdateCoupler(coupler,option,patch%grid)
  2376)    !  case(SATURATION_BC)
  2377)     end select
  2378)   endif
  2379)   if (associated(flow_condition%concentration)) then
  2380)     select case(flow_condition%concentration%itype)
  2381)       case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
  2382)         if (associated(flow_condition%concentration%dataset)) then
  2383)           coupler%flow_aux_real_var(MIS_CONCENTRATION_DOF, &
  2384)                                     1:num_connections) = &
  2385)             flow_condition%concentration%dataset%rarray(1)
  2386)         endif
  2387)       case(HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
  2388)         call HydrostaticUpdateCoupler(coupler,option,patch%grid)
  2389)    !  case(SATURATION_BC)
  2390)     end select
  2391)   endif
  2392)   if (associated(flow_condition%rate)) then
  2393)     select case(flow_condition%rate%itype)
  2394)       case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
  2395)         call PatchScaleSourceSink(patch,coupler, &
  2396)                                   flow_condition%rate%isubtype,option)
  2397)     end select
  2398)   endif  
  2399) 
  2400) end subroutine PatchUpdateCouplerAuxVarsMIS
  2401) 
  2402) ! ************************************************************************** !
  2403) 
  2404) subroutine PatchUpdateCouplerAuxVarsRich(patch,coupler,option)
  2405)   ! 
  2406)   ! Updates flow auxiliary variables associated
  2407)   ! with a coupler for RICHARDS_MODE
  2408)   ! 
  2409)   ! Author: Glenn Hammond
  2410)   ! Date: 11/26/07
  2411)   ! 
  2412) 
  2413)   use Option_module
  2414)   use Condition_module
  2415)   use Hydrostatic_module
  2416)   use Saturation_module
  2417)   
  2418)   
  2419)   use General_Aux_module
  2420)   use Grid_module
  2421)   use Dataset_Common_HDF5_class
  2422)   use Dataset_Gridded_HDF5_class
  2423)   use Dataset_Ascii_class
  2424) 
  2425)   implicit none
  2426)   
  2427)   type(patch_type) :: patch
  2428)   type(coupler_type), pointer :: coupler
  2429)   type(option_type) :: option
  2430)   
  2431)   type(flow_condition_type), pointer :: flow_condition
  2432)   type(tran_condition_type), pointer :: tran_condition
  2433)   type(flow_general_condition_type), pointer :: general
  2434)   class(dataset_common_hdf5_type), pointer :: dataset
  2435)   PetscBool :: update
  2436)   PetscBool :: dof1, dof2, dof3
  2437)   PetscReal :: temperature, p_sat
  2438)   PetscReal :: x(option%nflowdof)
  2439)   character(len=MAXSTRINGLENGTH) :: string, string2
  2440)   PetscErrorCode :: ierr
  2441)   
  2442)   PetscInt :: idof, num_connections,sum_connection
  2443)   PetscInt :: iconn, local_id, ghosted_id
  2444) 
  2445)   num_connections = coupler%connection_set%num_connections
  2446) 
  2447)   flow_condition => coupler%flow_condition
  2448)   if (associated(flow_condition%pressure)) then
  2449)     select case(flow_condition%pressure%itype)
  2450)       case(DIRICHLET_BC,NEUMANN_BC,ZERO_GRADIENT_BC)
  2451)         select type(dataset => &
  2452)                     flow_condition%pressure%dataset)
  2453)           class is(dataset_ascii_type)
  2454)             coupler%flow_aux_real_var(RICHARDS_PRESSURE_DOF, &
  2455)                                       1:num_connections) = dataset%rarray(1)
  2456)           class is(dataset_gridded_hdf5_type)
  2457)             call PatchUpdateCouplerFromDataset(coupler,option, &
  2458)                                             patch%grid,dataset, &
  2459)                                             RICHARDS_PRESSURE_DOF)
  2460)           class default
  2461)         end select
  2462)       case(HYDROSTATIC_BC,SEEPAGE_BC,CONDUCTANCE_BC)
  2463)         call HydrostaticUpdateCoupler(coupler,option,patch%grid)
  2464)    !  case(SATURATION_BC)
  2465)       case(HET_DIRICHLET)
  2466)         call PatchUpdateHetroCouplerAuxVars(patch,coupler, &
  2467)                 flow_condition%pressure%dataset, &
  2468)                 num_connections,RICHARDS_PRESSURE_DOF,option)
  2469)     end select
  2470)   endif
  2471)   if (associated(flow_condition%saturation)) then
  2472)     call SaturationUpdateCoupler(coupler,option,patch%grid, &
  2473)                                  patch%saturation_function_array, &
  2474)                                  patch%sat_func_id)
  2475)   endif
  2476)   if (associated(flow_condition%rate)) then
  2477)     select case(flow_condition%rate%itype)
  2478)       case(SCALED_MASS_RATE_SS,SCALED_VOLUMETRIC_RATE_SS)
  2479)         call PatchScaleSourceSink(patch,coupler, &
  2480)                                   flow_condition%rate%isubtype,option)
  2481)       case (HET_VOL_RATE_SS,HET_MASS_RATE_SS)
  2482)         call PatchUpdateHetroCouplerAuxVars(patch,coupler, &
  2483)                 flow_condition%rate%dataset, &
  2484)                 num_connections,RICHARDS_PRESSURE_DOF,option)
  2485)     end select
  2486)   endif
  2487) 
  2488) end subroutine PatchUpdateCouplerAuxVarsRich
  2489) 
  2490) ! ************************************************************************** !
  2491) 
  2492) subroutine PatchUpdateCouplerFromDataset(coupler,option,grid,dataset,dof)
  2493)   ! 
  2494)   ! Updates auxiliary variables from dataset.
  2495)   ! 
  2496)   ! Author: Glenn Hammond
  2497)   ! Date: 11/26/07
  2498)   ! 
  2499) 
  2500)   use Option_module
  2501)   use Grid_module
  2502)   use Coupler_module
  2503)   use Dataset_Gridded_HDF5_class
  2504)   
  2505)   implicit none
  2506) 
  2507)   type(coupler_type) :: coupler
  2508)   type(option_type) :: option
  2509)   type(grid_type) :: grid
  2510)   class(dataset_gridded_hdf5_type) :: dataset
  2511)   PetscInt :: dof
  2512)   
  2513)   PetscReal :: temp_real
  2514)   PetscInt :: iconn
  2515)   PetscInt :: local_id
  2516)   PetscInt :: ghosted_id
  2517)   PetscReal :: x
  2518)   PetscReal :: y
  2519)   PetscReal :: z
  2520)   PetscReal :: dist(-1:3)
  2521)   
  2522)   do iconn = 1, coupler%connection_set%num_connections
  2523)     local_id = coupler%connection_set%id_dn(iconn)
  2524)     ghosted_id = grid%nL2G(local_id)
  2525)     x = grid%x(ghosted_id)
  2526)     y = grid%y(ghosted_id)
  2527)     z = grid%z(ghosted_id)
  2528)     if (associated(coupler%connection_set%dist)) then
  2529)       dist = coupler%connection_set%dist(:,iconn)
  2530)       x = x-dist(0)*dist(1)
  2531)       y = y-dist(0)*dist(2)
  2532)       z = z-dist(0)*dist(3)
  2533)     endif
  2534)     call DatasetGriddedHDF5InterpolateReal(dataset,x,y,z,temp_real,option)
  2535)     coupler%flow_aux_real_var(dof,iconn) = temp_real
  2536)   enddo
  2537)   
  2538) end subroutine PatchUpdateCouplerFromDataset
  2539) 
  2540) ! ************************************************************************** !
  2541) 
  2542) subroutine PatchScaleSourceSink(patch,source_sink,iscale_type,option)
  2543)   ! 
  2544)   ! Scales select source/sinks based on perms*volume
  2545)   ! 
  2546)   ! Author: Glenn Hammond
  2547)   ! Date: 01/12/11
  2548)   ! 
  2549) 
  2550)   use Option_module
  2551)   use Field_module
  2552)   use Coupler_module
  2553)   use Connection_module
  2554)   use Condition_module
  2555)   use Grid_module
  2556)   use Material_Aux_class
  2557)   use Variables_module, only : PERMEABILITY_X
  2558)   
  2559)   implicit none
  2560) 
  2561) #include "petsc/finclude/petscvec.h"
  2562) #include "petsc/finclude/petscvec.h90"
  2563) #include "petsc/finclude/petscdmda.h"
  2564)   
  2565)   type(patch_type) :: patch
  2566)   type(coupler_type) :: source_sink
  2567)   PetscInt :: iscale_type
  2568)   type(option_type) :: option
  2569)   
  2570)   PetscErrorCode :: ierr
  2571)   
  2572)   type(grid_type), pointer :: grid
  2573)   type(connection_set_type), pointer :: cur_connection_set
  2574)   type(field_type), pointer :: field
  2575)   
  2576)   PetscReal, pointer :: vec_ptr(:)
  2577)   PetscInt :: local_id
  2578)   PetscInt :: ghosted_id, neighbor_ghosted_id
  2579)   PetscInt :: iconn
  2580)   PetscReal :: scale, sum
  2581)   PetscInt :: icount, x_count, y_count, z_count
  2582)   PetscInt, parameter :: x_width = 1, y_width = 1, z_width = 0
  2583)   PetscInt :: ghosted_neighbors(27)
  2584)   class(material_auxvar_type), pointer :: material_auxvars(:)
  2585)     
  2586)   field => patch%field
  2587)   grid => patch%grid
  2588)   material_auxvars => patch%aux%Material%auxvars
  2589) 
  2590)   grid => patch%grid
  2591) 
  2592)   call VecZeroEntries(field%work,ierr);CHKERRQ(ierr)
  2593)   call VecGetArrayF90(field%work,vec_ptr,ierr);CHKERRQ(ierr)
  2594) 
  2595)   cur_connection_set => source_sink%connection_set
  2596) 
  2597)   select case(iscale_type)
  2598)     case(SCALE_BY_VOLUME)
  2599)       do iconn = 1, cur_connection_set%num_connections
  2600)         local_id = cur_connection_set%id_dn(iconn)
  2601)         ghosted_id = grid%nL2G(local_id)
  2602)         vec_ptr(local_id) = vec_ptr(local_id) + &
  2603)           material_auxvars(ghosted_id)%volume
  2604)       enddo
  2605)     case(SCALE_BY_PERM)
  2606)       do iconn = 1, cur_connection_set%num_connections
  2607)         local_id = cur_connection_set%id_dn(iconn)
  2608)         ghosted_id = grid%nL2G(local_id)
  2609)         vec_ptr(local_id) = vec_ptr(local_id) + &
  2610)           ! this function protects from error in gfortran compiler when indexing
  2611)           ! the permeability array
  2612)           MaterialAuxVarGetValue(material_auxvars(ghosted_id), &
  2613)                                  PERMEABILITY_X) * &
  2614)           material_auxvars(ghosted_id)%volume
  2615)       enddo
  2616)     case(SCALE_BY_NEIGHBOR_PERM)
  2617)       do iconn = 1, cur_connection_set%num_connections
  2618)         local_id = cur_connection_set%id_dn(iconn)
  2619)         ghosted_id = grid%nL2G(local_id)
  2620)         !geh: kludge for 64-bit integers.
  2621)         call GridGetGhostedNeighbors(grid,ghosted_id,DMDA_STENCIL_STAR, &
  2622)                                     x_width,y_width,z_width, &
  2623)                                     x_count,y_count,z_count, &
  2624)                                     ghosted_neighbors,option)
  2625)         ! ghosted neighbors is ordered first in x, then, y, then z
  2626)         icount = 0
  2627)         sum = 0.d0
  2628)         ! x-direction
  2629)         do while (icount < x_count)
  2630)           icount = icount + 1
  2631)           neighbor_ghosted_id = ghosted_neighbors(icount)
  2632)           sum = sum + &
  2633)                 MaterialAuxVarGetValue(material_auxvars(neighbor_ghosted_id), &
  2634)                                        PERMEABILITY_X) * &
  2635)                 grid%structured_grid%dy(neighbor_ghosted_id)* &
  2636)                 grid%structured_grid%dz(neighbor_ghosted_id)
  2637)         enddo
  2638)         ! y-direction
  2639)         do while (icount < x_count + y_count)
  2640)           icount = icount + 1
  2641)           neighbor_ghosted_id = ghosted_neighbors(icount)                 
  2642)           sum = sum + &
  2643)                 MaterialAuxVarGetValue(material_auxvars(neighbor_ghosted_id), &
  2644)                                        PERMEABILITY_X) * &
  2645)                 grid%structured_grid%dx(neighbor_ghosted_id)* &
  2646)                 grid%structured_grid%dz(neighbor_ghosted_id)
  2647)         enddo
  2648)         ! z-direction
  2649)         do while (icount < x_count + y_count + z_count)
  2650)           icount = icount + 1
  2651)           neighbor_ghosted_id = ghosted_neighbors(icount)                 
  2652)           sum = sum + &
  2653)                 MaterialAuxVarGetValue(material_auxvars(neighbor_ghosted_id), &
  2654)                                        PERMEABILITY_X) * &
  2655)                 grid%structured_grid%dx(neighbor_ghosted_id)* &
  2656)                 grid%structured_grid%dy(neighbor_ghosted_id)
  2657)         enddo
  2658)         vec_ptr(local_id) = vec_ptr(local_id) + sum
  2659)       enddo
  2660)     case(0)
  2661)       option%io_buffer = 'Unknown scaling type in PatchScaleSourceSink ' // &
  2662)         'for FLOW_CONDITION "' // trim(source_sink%flow_condition%name) // '".'
  2663)       call printErrMsg(option)
  2664)   end select
  2665) 
  2666)   call VecRestoreArrayF90(field%work,vec_ptr,ierr);CHKERRQ(ierr)
  2667)   call VecNorm(field%work,NORM_1,scale,ierr);CHKERRQ(ierr)
  2668)   if (scale < 1.d-40) then
  2669)     option%io_buffer = 'Zero infinity norm in PatchScaleSourceSink for ' // &
  2670)       'FLOW_CONDITION "' // trim(source_sink%flow_condition%name) // '".'
  2671)     call printErrMsg(option)
  2672)   endif
  2673)   scale = 1.d0/scale
  2674)   call VecScale(field%work,scale,ierr);CHKERRQ(ierr)
  2675) 
  2676)   call VecGetArrayF90(field%work,vec_ptr, ierr);CHKERRQ(ierr)
  2677)   do iconn = 1, cur_connection_set%num_connections      
  2678)     local_id = cur_connection_set%id_dn(iconn)
  2679)     select case(option%iflowmode)
  2680)       case(RICHARDS_MODE,G_MODE,TH_MODE,TOIL_IMS_MODE)
  2681)         source_sink%flow_aux_real_var(ONE_INTEGER,iconn) = &
  2682)           vec_ptr(local_id)
  2683)       case(MPH_MODE,IMS_MODE,MIS_MODE,FLASH2_MODE)
  2684)         option%io_buffer = 'PatchScaleSourceSink not set up for flow mode'
  2685)         call printErrMsg(option)
  2686)     end select 
  2687)   enddo
  2688)   call VecRestoreArrayF90(field%work,vec_ptr,ierr);CHKERRQ(ierr)
  2689) 
  2690) end subroutine PatchScaleSourceSink
  2691) 
  2692) ! ************************************************************************** !
  2693) 
  2694) subroutine PatchUpdateHetroCouplerAuxVars(patch,coupler,dataset_base, &
  2695)                                           sum_connection,isub_condition,option)
  2696)   ! 
  2697)   ! This subroutine updates aux vars for distributed copuler_type
  2698)   ! 
  2699)   ! Author: Gautam Bisht, LBL
  2700)   ! Date: 10/03/2012
  2701)   ! 
  2702) 
  2703)   use Option_module
  2704)   use Field_module
  2705)   use Coupler_module
  2706)   use Connection_module
  2707)   use Condition_module
  2708)   use Grid_module
  2709)   use Dataset_module
  2710)   use Dataset_Map_HDF5_class
  2711)   use Dataset_Base_class
  2712)   use Dataset_Ascii_class
  2713) 
  2714)   implicit none
  2715) 
  2716) #include "petsc/finclude/petscvec.h"
  2717) #include "petsc/finclude/petscvec.h90"
  2718) #include "petsc/finclude/petscdmda.h"
  2719) 
  2720)   type(patch_type) :: patch
  2721)   type(coupler_type) :: coupler
  2722)   class(dataset_base_type), pointer :: dataset_base
  2723)   PetscInt :: isub_condition
  2724)   type(option_type) :: option
  2725) 
  2726)   type(connection_set_type), pointer :: cur_connection_set
  2727)   type(grid_type),pointer :: grid
  2728)   PetscErrorCode :: ierr
  2729)   PetscInt :: iconn,sum_connection
  2730)   PetscInt :: ghosted_id,local_id
  2731)   PetscInt,pointer ::cell_ids_nat(:)
  2732)   type(flow_sub_condition_type) :: flow_sub_condition
  2733) 
  2734)   class(dataset_map_hdf5_type), pointer :: dataset_map_hdf5
  2735)   class(dataset_ascii_type), pointer :: dataset_ascii
  2736) 
  2737)   grid => patch%grid
  2738)   
  2739)   if (isub_condition>option%nflowdof*option%nphase) then
  2740)     option%io_buffer='ERROR: PatchUpdateHetroCouplerAuxVars  '// &
  2741)       'isub_condition > option%nflowdof*option%nphase.'
  2742)     call printErrMsg(option)
  2743)   endif
  2744)   
  2745)   if (option%iflowmode/=RICHARDS_MODE.and.option%iflowmode/=TH_MODE) then
  2746)     option%io_buffer='PatchUpdateHetroCouplerAuxVars only implemented '// &
  2747)       ' for RICHARDS or TH mode.'
  2748)     call printErrMsg(option)
  2749)   endif
  2750) 
  2751)   cur_connection_set => coupler%connection_set
  2752) 
  2753)   select type(selector=>dataset_base)
  2754)     class is(dataset_map_hdf5_type)
  2755)       dataset_map_hdf5 => selector
  2756) 
  2757)       ! If called for the first time, create the map
  2758)       if (dataset_map_hdf5%first_time) then
  2759)         allocate(cell_ids_nat(cur_connection_set%num_connections))
  2760)         do iconn=1,cur_connection_set%num_connections
  2761)           sum_connection = sum_connection + 1
  2762)           local_id = cur_connection_set%id_dn(iconn)
  2763)           ghosted_id = grid%nL2G(local_id)
  2764)           cell_ids_nat(iconn)=grid%nG2A(ghosted_id)
  2765)         enddo
  2766) 
  2767)         call PatchCreateFlowConditionDatasetMap(patch%grid,dataset_map_hdf5,&
  2768)                 cell_ids_nat,cur_connection_set%num_connections,option)
  2769) 
  2770)         dataset_map_hdf5%first_time = PETSC_FALSE
  2771)         deallocate(cell_ids_nat)
  2772) 
  2773)       endif
  2774)     
  2775)       ! Save the data in the array
  2776)       do iconn=1,cur_connection_set%num_connections
  2777)         coupler%flow_aux_real_var(isub_condition,iconn) = &
  2778)           dataset_map_hdf5%rarray(dataset_map_hdf5%datatocell_ids(iconn))
  2779)       enddo
  2780) 
  2781)     class is(dataset_ascii_type)
  2782)       dataset_ascii => selector
  2783) 
  2784)       do iconn=1,cur_connection_set%num_connections
  2785)         coupler%flow_aux_real_var(isub_condition,iconn) = &
  2786)           dataset_ascii%rarray(1)
  2787)       enddo
  2788) 
  2789)     class default
  2790)       option%io_buffer = 'Incorrect dataset class (' // &
  2791)         trim(DatasetGetClass(dataset_base)) // &
  2792)         ') for coupler "' // trim(coupler%name) // &
  2793)         '" in PatchUpdateHetroCouplerAuxVars.'
  2794)       call printErrMsg(option)
  2795)   end select
  2796)   
  2797) end subroutine PatchUpdateHetroCouplerAuxVars
  2798) 
  2799) ! ************************************************************************** !
  2800) 
  2801) subroutine PatchCreateFlowConditionDatasetMap(grid,dataset_map_hdf5,cell_ids,ncells,option)
  2802)   ! 
  2803)   ! This routine creates dataset-map for flow condition
  2804)   ! 
  2805)   ! Author: Gautam Bisht, LBL
  2806)   ! Date: 10/26/12
  2807)   ! 
  2808) 
  2809)   use Grid_module
  2810)   use Dataset_Map_HDF5_class
  2811)   use Option_module
  2812)   
  2813)   implicit none
  2814) #include "petsc/finclude/petscvec.h"
  2815) #include "petsc/finclude/petscvec.h90"
  2816) #include "petsc/finclude/petscis.h"
  2817) #include "petsc/finclude/petscis.h90"
  2818) #include "petsc/finclude/petscviewer.h"
  2819) 
  2820)   type(grid_type) :: grid
  2821)   class(dataset_map_hdf5_type) :: dataset_map_hdf5
  2822)   type(option_type) :: option
  2823)   PetscInt,pointer :: cell_ids(:)
  2824)   PetscInt :: ncells
  2825)   
  2826)   PetscInt, allocatable :: int_array(:)
  2827)   PetscInt :: ghosted_id,local_id
  2828)   PetscInt :: ii,count
  2829)   PetscReal, pointer :: vec_ptr(:)  
  2830)   PetscErrorCode :: ierr
  2831)   PetscInt :: nloc,nglo
  2832)   PetscInt :: istart
  2833)   
  2834)   IS :: is_from, is_to
  2835)   Vec :: map_ids_1, map_ids_2,map_ids_3
  2836)   VecScatter ::vec_scatter
  2837)   PetscViewer :: viewer
  2838)   
  2839)   ! Step-1: Rearrange map dataset
  2840)   nloc = maxval(dataset_map_hdf5%mapping(2,:))
  2841)   call MPI_Allreduce(nloc,nglo,ONE_INTEGER,MPIU_INTEGER,MPI_Max,option%mycomm,ierr)
  2842)   call VecCreateMPI(option%mycomm,dataset_map_hdf5%map_dims_local(2),&
  2843)                     PETSC_DETERMINE,map_ids_1,ierr);CHKERRQ(ierr)
  2844)   call VecCreateMPI(option%mycomm,PETSC_DECIDE,nglo,map_ids_2, &
  2845)                     ierr);CHKERRQ(ierr)
  2846)   call VecSet(map_ids_2,0,ierr);CHKERRQ(ierr)
  2847) 
  2848)   istart = 0
  2849)   call MPI_Exscan(dataset_map_hdf5%map_dims_local(2), istart, ONE_INTEGER_MPI, &
  2850)                   MPIU_INTEGER, MPI_SUM, option%mycomm, ierr)
  2851) 
  2852)   allocate(int_array(dataset_map_hdf5%map_dims_local(2)))
  2853)   do ii=1,dataset_map_hdf5%map_dims_local(2)
  2854)     int_array(ii)=ii+istart
  2855)   enddo
  2856)   int_array=int_array-1
  2857)   
  2858)   call ISCreateBlock(option%mycomm,1,dataset_map_hdf5%map_dims_local(2), &
  2859)                      int_array,PETSC_COPY_VALUES,is_from,ierr);CHKERRQ(ierr)
  2860)   deallocate(int_array)
  2861)   
  2862)   allocate(int_array(dataset_map_hdf5%map_dims_local(2)))
  2863)   do ii=1,dataset_map_hdf5%map_dims_local(2)
  2864)     int_array(ii)=dataset_map_hdf5%mapping(2,ii)
  2865)   enddo
  2866)   int_array=int_array-1
  2867) 
  2868)   call ISCreateBlock(option%mycomm,1,dataset_map_hdf5%map_dims_local(2), &
  2869)                      int_array,PETSC_COPY_VALUES,is_to,ierr);CHKERRQ(ierr)
  2870)   deallocate(int_array)
  2871) 
  2872)   !call VecCreateSeq(PETSC_COMM_SELF,dataset_map%map_dims_global(2),map_ids_1,ierr)
  2873)   !call VecCreateSeq(PETSC_COMM_SELF,maxval(dataset_map%map(2,:)),map_ids_2,ierr)
  2874)   !call VecSet(map_ids_2,0,ierr)
  2875) 
  2876)   call VecScatterCreate(map_ids_1,is_from,map_ids_2,is_to,vec_scatter, &
  2877)                         ierr);CHKERRQ(ierr)
  2878)   call ISDestroy(is_from,ierr);CHKERRQ(ierr)
  2879)   call ISDestroy(is_to,ierr);CHKERRQ(ierr)
  2880) 
  2881)   call VecGetArrayF90(map_ids_1,vec_ptr,ierr);CHKERRQ(ierr)
  2882)   do ii=1,dataset_map_hdf5%map_dims_local(2)
  2883)     vec_ptr(ii)=dataset_map_hdf5%mapping(1,ii)
  2884)   enddo
  2885)   call VecRestoreArrayF90(map_ids_1,vec_ptr,ierr);CHKERRQ(ierr)
  2886) 
  2887)   call VecScatterBegin(vec_scatter,map_ids_1,map_ids_2, &
  2888)                        INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
  2889)   call VecScatterEnd(vec_scatter,map_ids_1,map_ids_2, &
  2890)                      INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
  2891)   call VecScatterDestroy(vec_scatter,ierr);CHKERRQ(ierr)
  2892) 
  2893)   ! Step-2: Get ids in map dataset for cells
  2894)   allocate(int_array(ncells))
  2895)   allocate(dataset_map_hdf5%cell_ids_local(ncells))
  2896)   int_array=cell_ids-1
  2897) 
  2898)   call ISCreateBlock(option%mycomm,1,ncells,int_array,PETSC_COPY_VALUES,is_from, &
  2899)                      ierr);CHKERRQ(ierr)
  2900)     
  2901)   istart = 0
  2902)   call MPI_Exscan(ncells, istart, ONE_INTEGER_MPI, &
  2903)                   MPIU_INTEGER, MPI_SUM, option%mycomm, ierr)
  2904) 
  2905)   do local_id=1,ncells
  2906)     int_array(local_id)=local_id+istart
  2907)   enddo
  2908)   int_array=int_array-1
  2909)   
  2910)   call ISCreateBlock(option%mycomm,1,ncells,int_array,PETSC_COPY_VALUES,is_to, &
  2911)                      ierr);CHKERRQ(ierr)
  2912)   deallocate(int_array)
  2913)   
  2914)   !call VecCreateSeq(PETSC_COMM_SELF,ncells,map_ids_3,ierr)
  2915)   call VecCreateMPI(option%mycomm,ncells,PETSC_DETERMINE,map_ids_3, &
  2916)                     ierr);CHKERRQ(ierr)
  2917)   
  2918)   call VecScatterCreate(map_ids_2,is_from,map_ids_3,is_to,vec_scatter, &
  2919)                         ierr);CHKERRQ(ierr)
  2920)   call ISDestroy(is_from,ierr);CHKERRQ(ierr)
  2921)   call ISDestroy(is_to,ierr);CHKERRQ(ierr)
  2922) 
  2923)   call VecScatterBegin(vec_scatter,map_ids_2,map_ids_3, &
  2924)                        INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
  2925)   call VecScatterEnd(vec_scatter,map_ids_2,map_ids_3, &
  2926)                      INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
  2927)   call VecScatterDestroy(vec_scatter,ierr);CHKERRQ(ierr)
  2928) 
  2929)   ! Step-3: Save the datatocell_ids
  2930)   allocate(dataset_map_hdf5%datatocell_ids(ncells))
  2931)   call VecGetArrayF90(map_ids_3,vec_ptr,ierr);CHKERRQ(ierr)
  2932)   do local_id=1,ncells
  2933)     dataset_map_hdf5%datatocell_ids(local_id) = int(vec_ptr(local_id))
  2934)   enddo
  2935)   call VecRestoreArrayF90(map_ids_3,vec_ptr,ierr);CHKERRQ(ierr)
  2936)   
  2937)   call VecDestroy(map_ids_1,ierr);CHKERRQ(ierr)
  2938)   call VecDestroy(map_ids_2,ierr);CHKERRQ(ierr)
  2939)   call VecDestroy(map_ids_3,ierr);CHKERRQ(ierr)
  2940) 
  2941) end subroutine PatchCreateFlowConditionDatasetMap
  2942) 
  2943) ! ************************************************************************** !
  2944) 
  2945) subroutine PatchInitConstraints(patch,reaction,option)
  2946)   ! 
  2947)   ! Initializes constraint concentrations
  2948)   ! 
  2949)   ! Author: Glenn Hammond
  2950)   ! Date: 12/04/08
  2951)   ! 
  2952) 
  2953)   use Reaction_Aux_module
  2954)     
  2955)   implicit none
  2956) 
  2957)   type(patch_type) :: patch
  2958)   type(option_type) :: option
  2959)   type(reaction_type), pointer :: reaction
  2960)   
  2961)   call PatchInitCouplerConstraints(patch%initial_condition_list, &
  2962)                                    reaction,option)
  2963)   
  2964)   call PatchInitCouplerConstraints(patch%boundary_condition_list, &
  2965)                                    reaction,option)
  2966)   
  2967)   call PatchInitCouplerConstraints(patch%source_sink_list, &
  2968)                                    reaction,option)
  2969) 
  2970) end subroutine PatchInitConstraints
  2971) 
  2972) ! ************************************************************************** !
  2973) 
  2974) subroutine PatchInitCouplerConstraints(coupler_list,reaction,option)
  2975)   ! 
  2976)   ! Initializes constraint concentrations
  2977)   ! for a given coupler
  2978)   ! 
  2979)   ! Author: Glenn Hammond
  2980)   ! Date: 12/04/08
  2981)   ! 
  2982) 
  2983)   use Reaction_module
  2984)   use Reactive_Transport_Aux_module
  2985)   use Reaction_Aux_module
  2986)   use Global_Aux_module
  2987)   use Material_Aux_class
  2988)   use Transport_Constraint_module
  2989)   
  2990)   use EOS_Water_module
  2991)     
  2992)   implicit none
  2993) 
  2994)   type(coupler_list_type), pointer :: coupler_list
  2995)   type(option_type) :: option
  2996)   type(reaction_type), pointer :: reaction
  2997) 
  2998)   type(reactive_transport_auxvar_type), pointer :: rt_auxvar
  2999)   type(global_auxvar_type), pointer :: global_auxvar
  3000)   class(material_auxvar_type), allocatable :: material_auxvar
  3001)   type(coupler_type), pointer :: cur_coupler
  3002)   type(tran_constraint_coupler_type), pointer :: cur_constraint_coupler
  3003)   PetscReal :: dum1
  3004)   PetscErrorCode :: ierr
  3005) 
  3006)   allocate(material_auxvar)
  3007)   call MaterialAuxVarInit(material_auxvar,option)
  3008)   material_auxvar%porosity = option%reference_porosity
  3009)   
  3010)   cur_coupler => coupler_list%first
  3011)   do
  3012)     if (.not.associated(cur_coupler)) exit
  3013) 
  3014)     if (.not.associated(cur_coupler%tran_condition)) then
  3015)       option%io_buffer = 'Null transport condition found in coupler'
  3016)       if (len_trim(cur_coupler%name) > 1) then
  3017)         option%io_buffer = trim(option%io_buffer) // &
  3018)                            ' "' // trim(cur_coupler%name) // '"'
  3019)       endif
  3020)       call printErrMsg(option)
  3021)     endif
  3022) 
  3023)     cur_constraint_coupler => &
  3024)       cur_coupler%tran_condition%constraint_coupler_list
  3025)     do
  3026)       if (.not.associated(cur_constraint_coupler)) exit
  3027)       global_auxvar => cur_constraint_coupler%global_auxvar
  3028)       rt_auxvar => cur_constraint_coupler%rt_auxvar
  3029)       if (associated(cur_coupler%flow_condition)) then
  3030)         if (associated(cur_coupler%flow_condition%pressure)) then
  3031)           if (associated(cur_coupler%flow_condition%pressure%dataset)) then
  3032)             global_auxvar%pres = &
  3033)               cur_coupler%flow_condition%pressure%dataset%rarray(1)
  3034)           else
  3035)             global_auxvar%pres = option%reference_pressure
  3036)           endif
  3037)         else
  3038)           global_auxvar%pres = option%reference_pressure
  3039)         endif
  3040)         if (associated(cur_coupler%flow_condition%temperature)) then
  3041)           if (associated(cur_coupler%flow_condition%temperature%dataset)) then
  3042)             global_auxvar%temp = &
  3043)               cur_coupler%flow_condition%temperature%dataset%rarray(1)
  3044)           else
  3045)             global_auxvar%temp = option%reference_temperature
  3046)           endif
  3047)         else
  3048)           global_auxvar%temp = option%reference_temperature
  3049)         endif
  3050) 
  3051)         call EOSWaterDensity(global_auxvar%temp, &
  3052)                              global_auxvar%pres(1), &
  3053)                              global_auxvar%den_kg(1), &
  3054)                              dum1,ierr)
  3055)       else
  3056)         global_auxvar%pres = option%reference_pressure
  3057)         global_auxvar%temp = option%reference_temperature
  3058)         global_auxvar%den_kg = option%reference_water_density
  3059)       endif     
  3060)       global_auxvar%sat = option%reference_saturation  
  3061)   
  3062)       call ReactionEquilibrateConstraint(rt_auxvar,global_auxvar, &
  3063)                             material_auxvar, &
  3064)                             reaction,cur_constraint_coupler%constraint_name, &
  3065)                             cur_constraint_coupler%aqueous_species, &
  3066)                             cur_constraint_coupler%free_ion_guess, &
  3067)                             cur_constraint_coupler%minerals, &
  3068)                             cur_constraint_coupler%surface_complexes, &
  3069)                             cur_constraint_coupler%colloids, &
  3070)                             cur_constraint_coupler%immobile_species, &
  3071)                             cur_constraint_coupler%num_iterations, &
  3072)                             PETSC_FALSE,option)
  3073)       ! update CO2 mole fraction for CO2 modes
  3074)       select case(option%iflowmode)
  3075)         case(MPH_MODE,FLASH2_MODE)
  3076)           if (cur_coupler%flow_condition%iphase == 1) then
  3077)             dum1 = RCO2MoleFraction(rt_auxvar,global_auxvar,reaction,option)
  3078)             cur_coupler%flow_condition%concentration%dataset%rarray(1) = dum1
  3079)             if (associated(cur_coupler%flow_aux_real_var)) then
  3080)               cur_coupler%flow_aux_real_var(MPH_CONCENTRATION_DOF,:) = dum1
  3081)             endif
  3082)           endif
  3083)       end select
  3084)       cur_constraint_coupler => cur_constraint_coupler%next
  3085)     enddo
  3086)     cur_coupler => cur_coupler%next
  3087)   enddo
  3088) 
  3089)   call MaterialAuxVarStrip(material_auxvar)
  3090)   deallocate(material_auxvar)
  3091) 
  3092) end subroutine PatchInitCouplerConstraints
  3093) 
  3094) ! ************************************************************************** !
  3095) 
  3096) subroutine PatchUpdateUniformVelocity(patch,velocity,option)
  3097)   ! 
  3098)   ! Assigns uniform velocity in connection list
  3099)   ! darcy velocities
  3100)   ! 
  3101)   ! Author: Glenn Hammond
  3102)   ! Date: 02/20/08
  3103)   ! 
  3104) 
  3105)   use Option_module
  3106)   use Coupler_module
  3107)   use Condition_module
  3108)   use Connection_module
  3109)   
  3110)   implicit none
  3111)   
  3112)   type(patch_type), pointer :: patch   
  3113)   PetscReal :: velocity(3)
  3114)   type(option_type), pointer :: option
  3115) 
  3116)   type(grid_type), pointer :: grid
  3117)   type(coupler_type), pointer :: boundary_condition
  3118)   type(connection_set_type), pointer :: cur_connection_set
  3119)   PetscInt :: iconn, sum_connection
  3120)   PetscReal :: vdarcy
  3121) 
  3122)   grid => patch%grid
  3123)     
  3124)   ! Internal Flux Terms -----------------------------------
  3125)   cur_connection_set => grid%internal_connection_set_list%first
  3126)   sum_connection = 0
  3127)   do 
  3128)     if (.not.associated(cur_connection_set)) exit
  3129)     do iconn = 1, cur_connection_set%num_connections
  3130)       sum_connection = sum_connection + 1
  3131)       vdarcy = dot_product(velocity, &
  3132)                            cur_connection_set%dist(1:3,iconn))
  3133)       patch%internal_velocities(1,sum_connection) = vdarcy
  3134)     enddo
  3135)     cur_connection_set => cur_connection_set%next
  3136)   enddo    
  3137) 
  3138)   ! Boundary Flux Terms -----------------------------------
  3139)   boundary_condition => patch%boundary_condition_list%first
  3140)   sum_connection = 0
  3141)   do 
  3142)     if (.not.associated(boundary_condition)) exit
  3143)     cur_connection_set => boundary_condition%connection_set
  3144)     do iconn = 1, cur_connection_set%num_connections
  3145)       sum_connection = sum_connection + 1
  3146)       vdarcy = dot_product(velocity, &
  3147)                            cur_connection_set%dist(1:3,iconn))
  3148)       patch%boundary_velocities(1,sum_connection) = vdarcy
  3149)     enddo
  3150)     boundary_condition => boundary_condition%next
  3151)   enddo
  3152) 
  3153) end subroutine PatchUpdateUniformVelocity
  3154) 
  3155) ! ************************************************************************** !
  3156) 
  3157) function PatchAuxVarsUpToDate(patch)
  3158)   ! 
  3159)   ! Checks to see if aux vars are up to date
  3160)   ! 
  3161)   ! Author: Glenn Hammond
  3162)   ! Date: 09/12/08
  3163)   ! 
  3164) 
  3165)   use Grid_module
  3166)   use Option_module
  3167)   use Field_module
  3168)   
  3169)   use Mphase_Aux_module
  3170)   use TH_Aux_module
  3171)   use Richards_Aux_module
  3172)   use Reactive_Transport_Aux_module  
  3173)   
  3174)   type(patch_type) :: patch
  3175)   
  3176)   PetscBool :: PatchAuxVarsUpToDate
  3177)   PetscBool :: flow_up_to_date
  3178)   PetscBool :: transport_up_to_date
  3179)   PetscInt :: dummy
  3180)   dummy = 1
  3181) 
  3182)   if (associated(patch%aux%TH)) then
  3183)     flow_up_to_date = patch%aux%TH%auxvars_up_to_date
  3184)   else if (associated(patch%aux%Richards)) then
  3185)     flow_up_to_date = patch%aux%Richards%auxvars_up_to_date
  3186)   else if (associated(patch%aux%Mphase)) then
  3187)     flow_up_to_date = patch%aux%Mphase%auxvars_up_to_date
  3188)   else if (associated(patch%aux%Flash2)) then
  3189)     flow_up_to_date = patch%aux%Flash2%auxvars_up_to_date
  3190)   else if (associated(patch%aux%Immis)) then
  3191)     flow_up_to_date = patch%aux%Immis%auxvars_up_to_date
  3192)   endif
  3193) 
  3194)   if (associated(patch%aux%RT)) then
  3195)     transport_up_to_date = patch%aux%RT%auxvars_up_to_date
  3196)   endif
  3197)   
  3198)   PatchAuxVarsUpToDate = flow_up_to_date .and. transport_up_to_date
  3199)   
  3200) end function PatchAuxVarsUpToDate
  3201) 
  3202) ! ************************************************************************** !
  3203) 
  3204) subroutine PatchGetVariable1(patch,field,reaction,option,output_option,vec, &
  3205)                              ivar,isubvar,isubvar1)
  3206)   ! 
  3207)   ! PatchGetVariable: Extracts variables indexed by ivar and isubvar from a patch
  3208)   ! 
  3209)   ! Author: Glenn Hammond
  3210)   ! Date: 09/12/08
  3211)   ! 
  3212) 
  3213)   use Grid_module
  3214)   use Option_module
  3215)   use Field_module
  3216)   
  3217)   use Immis_Aux_module
  3218)   use Miscible_Aux_module
  3219)   use Mphase_Aux_module
  3220)   use TH_Aux_module
  3221)   use Richards_Aux_module
  3222)   use Reaction_Mineral_module
  3223)   use Reaction_module
  3224)   use Reactive_Transport_Aux_module  
  3225)   use Reaction_Surface_Complexation_Aux_module
  3226)   use General_Aux_module
  3227)   use Output_Aux_module
  3228)   use Variables_module
  3229)   use Material_Aux_class
  3230)   
  3231)   implicit none
  3232) 
  3233) #include "petsc/finclude/petscvec.h"
  3234) #include "petsc/finclude/petscvec.h90"
  3235) 
  3236)   type(option_type), pointer :: option
  3237)   type(reaction_type), pointer :: reaction
  3238)   type(output_option_type), pointer :: output_option
  3239)   type(field_type), pointer :: field
  3240)   type(patch_type), pointer :: patch  
  3241)   Vec :: vec
  3242)   PetscInt :: ivar
  3243)   PetscInt :: isubvar
  3244)   PetscInt, optional :: isubvar1
  3245)   PetscInt :: iphase
  3246) 
  3247)   PetscInt :: local_id, ghosted_id
  3248)   type(grid_type), pointer :: grid
  3249)   class(material_auxvar_type), pointer :: material_auxvars(:)
  3250)   PetscReal, pointer :: vec_ptr(:), vec_ptr2(:)
  3251)   PetscReal :: xmass, lnQKgas, ehfac, eh0, pe0, ph0, tk
  3252)   PetscReal :: tempreal
  3253)   PetscInt :: tempint, tempint2
  3254)   PetscInt :: irate, istate, irxn, ifo2, jcomp, comp_id
  3255)   PetscInt :: ivar_temp
  3256)   PetscErrorCode :: ierr
  3257) 
  3258)   grid => patch%grid
  3259)   material_auxvars => patch%aux%Material%auxvars
  3260)   
  3261)   call VecGetArrayF90(vec,vec_ptr,ierr);CHKERRQ(ierr)
  3262) 
  3263)   iphase = 1
  3264)   select case(ivar)
  3265)     case(TEMPERATURE,LIQUID_PRESSURE,GAS_PRESSURE,AIR_PRESSURE, &
  3266)          LIQUID_SATURATION,GAS_SATURATION,ICE_SATURATION, &
  3267)          LIQUID_MOLE_FRACTION,GAS_MOLE_FRACTION,LIQUID_ENERGY,GAS_ENERGY, &
  3268)          LIQUID_DENSITY,GAS_DENSITY,GAS_DENSITY_MOL,LIQUID_VISCOSITY, &
  3269)          GAS_VISCOSITY,CAPILLARY_PRESSURE,LIQUID_DENSITY_MOL, &
  3270)          LIQUID_MOBILITY,GAS_MOBILITY,SC_FUGA_COEFF,STATE,ICE_DENSITY, &
  3271)          EFFECTIVE_POROSITY,LIQUID_HEAD,VAPOR_PRESSURE,SATURATION_PRESSURE, &
  3272)          MAXIMUM_PRESSURE,LIQUID_MASS_FRACTION,GAS_MASS_FRACTION, &
  3273)          OIL_PRESSURE,OIL_SATURATION,OIL_DENSITY,OIL_DENSITY_MOL,OIL_ENERGY, &
  3274)          OIL_MOBILITY)
  3275) 
  3276)       if (associated(patch%aux%TH)) then
  3277)         select case(ivar)
  3278)           case(TEMPERATURE)
  3279)             do local_id=1,grid%nlmax
  3280)               vec_ptr(local_id) = &
  3281)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%temp
  3282)             enddo
  3283)           case(LIQUID_PRESSURE)
  3284)             do local_id=1,grid%nlmax
  3285)               vec_ptr(local_id) = &
  3286)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%pres(1)
  3287)             enddo
  3288)           case(LIQUID_SATURATION)
  3289)             do local_id=1,grid%nlmax
  3290)               vec_ptr(local_id) = &
  3291)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%sat(1)
  3292)             enddo
  3293)           case(LIQUID_DENSITY)
  3294)             do local_id=1,grid%nlmax
  3295)               vec_ptr(local_id) = &
  3296)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%den_kg(1)
  3297)             enddo
  3298)           case(GAS_MOLE_FRACTION,GAS_ENERGY,GAS_DENSITY,GAS_VISCOSITY) ! still needs implementation
  3299)             call printErrMsg(option,'GAS_MOLE_FRACTION not supported by TH')
  3300)           case(GAS_SATURATION)
  3301)             do local_id=1,grid%nlmax
  3302)               if (option%use_th_freezing) then
  3303)                 vec_ptr(local_id) = &
  3304)                   patch%aux%TH%auxvars(grid%nL2G(local_id))%ice%sat_gas
  3305)               else
  3306)                 vec_ptr(local_id) = 0.d0
  3307)               endif
  3308)             enddo
  3309)           case(ICE_SATURATION)
  3310)             if (option%use_th_freezing) then
  3311)               do local_id=1,grid%nlmax
  3312)                 vec_ptr(local_id) = &
  3313)                   patch%aux%TH%auxvars(grid%nL2G(local_id))%ice%sat_ice
  3314)               enddo
  3315)             endif
  3316)           case(ICE_DENSITY)
  3317)             if (option%use_th_freezing) then
  3318)               do local_id=1,grid%nlmax
  3319)                 vec_ptr(local_id) = &
  3320)                   patch%aux%TH%auxvars(grid%nL2G(local_id))%ice%den_ice*FMWH2O
  3321)               enddo
  3322)             endif
  3323)           case(LIQUID_VISCOSITY)
  3324)             do local_id=1,grid%nlmax
  3325)               vec_ptr(local_id) = &
  3326)                   patch%aux%TH%auxvars(grid%nL2G(local_id))%vis
  3327)             enddo
  3328)           case(LIQUID_MOBILITY)
  3329)             do local_id=1,grid%nlmax
  3330)               vec_ptr(local_id) = &
  3331)                   patch%aux%TH%auxvars(grid%nL2G(local_id))%kvr
  3332)             enddo
  3333)           case(LIQUID_MOLE_FRACTION)
  3334)             call printErrMsg(option,'LIQUID_MOLE_FRACTION not supported by TH')
  3335)           case(LIQUID_ENERGY)
  3336)             do local_id=1,grid%nlmax
  3337)               vec_ptr(local_id) = &
  3338)                   patch%aux%TH%auxvars(grid%nL2G(local_id))%u
  3339)             enddo
  3340)           case(EFFECTIVE_POROSITY)
  3341)             do local_id=1,grid%nlmax
  3342)               vec_ptr(local_id) = &
  3343)                   patch%aux%TH%auxvars(grid%nL2G(local_id))%transient_por
  3344)             enddo
  3345)         end select
  3346)         
  3347)       else if (associated(patch%aux%Richards)) then
  3348)       
  3349)         select case(ivar)
  3350)           case(TEMPERATURE)
  3351)             call printErrMsg(option,'TEMPERATURE not supported by Richards')
  3352)           case(GAS_SATURATION)
  3353)             call printErrMsg(option,'GAS_SATURATION not supported by Richards')
  3354)           case(ICE_SATURATION)
  3355)             call printErrMsg(option,'ICE_SATURATION not supported by Richards')
  3356)           case(ICE_DENSITY)
  3357)             call printErrMsg(option,'ICE_DENSITY not supported by Richards')
  3358)           case(GAS_DENSITY)
  3359)             call printErrMsg(option,'GAS_DENSITY not supported by Richards')
  3360)           case(LIQUID_MOLE_FRACTION)
  3361)             call printErrMsg(option,'LIQUID_MOLE_FRACTION not supported by Richards')
  3362)           case(GAS_MOLE_FRACTION)
  3363)             call printErrMsg(option,'GAS_MOLE_FRACTION not supported by Richards')
  3364)           case(LIQUID_ENERGY)
  3365)             call printErrMsg(option,'LIQUID_ENERGY not supported by Richards')
  3366)           case(GAS_ENERGY)
  3367)             call printErrMsg(option,'GAS_ENERGY not supported by Richards')
  3368)           case(LIQUID_VISCOSITY)
  3369)             call printErrMsg(option,'LIQUID_VISCOSITY not supported by Richards')
  3370)           case(GAS_VISCOSITY)
  3371)             call printErrMsg(option,'GAS_VISCOSITY not supported by Richards')
  3372)           case(GAS_MOBILITY)
  3373)             call printErrMsg(option,'GAS_MOBILITY not supported by Richards')
  3374)           case(EFFECTIVE_POROSITY)
  3375)             call printErrMsg(option,'EFFECTIVE_POROSITY not supported by Richards')
  3376)           case(LIQUID_PRESSURE)
  3377)             do local_id=1,grid%nlmax
  3378)               vec_ptr(local_id) = &
  3379)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%pres(1)
  3380)             enddo
  3381)           case(LIQUID_HEAD)
  3382)             do local_id=1,grid%nlmax
  3383)               vec_ptr(local_id) = &
  3384)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%pres(1)/9.81/ &
  3385)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%den_kg(1)                
  3386)             enddo
  3387)           case(LIQUID_SATURATION)
  3388)             do local_id=1,grid%nlmax
  3389)               vec_ptr(local_id) = &
  3390)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%sat(1)
  3391)             enddo
  3392)           case(LIQUID_DENSITY)
  3393)             do local_id=1,grid%nlmax
  3394)               vec_ptr(local_id) = &
  3395)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%den_kg(1)
  3396)             enddo
  3397)           case(LIQUID_MOBILITY)
  3398)             do local_id=1,grid%nlmax
  3399)               vec_ptr(local_id) = &
  3400)                   patch%aux%Richards%auxvars(grid%nL2G(local_id))%kvr
  3401)             enddo
  3402)         end select
  3403)       else if (associated(patch%aux%Flash2)) then
  3404)       
  3405)         select case(ivar)
  3406)           case(TEMPERATURE)
  3407)             do local_id=1,grid%nlmax
  3408)               vec_ptr(local_id) = &
  3409)                   patch%aux%Global%auxvars(grid%nL2G(local_id))%temp
  3410)             enddo
  3411)           case(LIQUID_PRESSURE)
  3412)             do local_id=1,grid%nlmax
  3413)               vec_ptr(local_id) = &
  3414)                   patch%aux%Global%auxvars(grid%nL2G(local_id))%pres(2)
  3415)             enddo
  3416)           case(LIQUID_SATURATION)
  3417)             do local_id=1,grid%nlmax
  3418)               vec_ptr(local_id) = &
  3419)                   patch%aux%Global%auxvars(grid%nL2G(local_id))%sat(1)
  3420)             enddo
  3421)           case(LIQUID_DENSITY)
  3422)             do local_id=1,grid%nlmax
  3423)               vec_ptr(local_id) = &
  3424)                   patch%aux%Global%auxvars(grid%nL2G(local_id))%den_kg(1)
  3425)             enddo
  3426)           case(GAS_SATURATION)
  3427)             do local_id=1,grid%nlmax
  3428)               vec_ptr(local_id) = &
  3429)                   patch%aux%Global%auxvars(grid%nL2G(local_id))%sat(2)
  3430)             enddo
  3431)           case(GAS_MOLE_FRACTION)
  3432)             do local_id=1,grid%nlmax
  3433)               vec_ptr(local_id) = &
  3434)                   patch%aux%Flash2%auxvars(grid%nL2G(local_id))%auxvar_elem(0)%xmol(2+isubvar)
  3435)             enddo
  3436)           case(GAS_ENERGY)
  3437)             do local_id=1,grid%nlmax
  3438)               vec_ptr(local_id) = patch%aux%Flash2% &
  3439)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%u(2)
  3440)             enddo
  3441)           case(GAS_VISCOSITY)
  3442)             do local_id=1,grid%nlmax
  3443)               vec_ptr(local_id) = patch%aux%Flash2% &
  3444)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%vis(2)
  3445)             enddo
  3446)           case(GAS_MOBILITY)
  3447)             do local_id=1,grid%nlmax
  3448)               vec_ptr(local_id) = patch%aux%Flash2% &
  3449)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%kvr(2)
  3450)             enddo
  3451)           case(GAS_DENSITY) 
  3452)             do local_id=1,grid%nlmax
  3453)               vec_ptr(local_id) = patch%aux%Global% &
  3454)                 auxvars(grid%nL2G(local_id))%den_kg(2)
  3455)             enddo
  3456)           case(GAS_DENSITY_MOL) 
  3457)             do local_id=1,grid%nlmax
  3458)               vec_ptr(local_id) = patch%aux%Global% &
  3459)                 auxvars(grid%nL2G(local_id))%den(2)
  3460)             enddo
  3461)           case(SC_FUGA_COEFF)
  3462)             if (.not.associated(patch%aux%Global% &
  3463)                 auxvars(1)%fugacoeff) .and. &
  3464)                 OptionPrintToScreen(option))then
  3465)                print *,'ERRor, fugacoeff not allocated for ', option%iflowmode, 1
  3466)             endif
  3467)             do local_id=1,grid%nlmax
  3468)              vec_ptr(local_id) = patch%aux%Global% &
  3469)                 auxvars(grid%nL2G(local_id))%fugacoeff(1)
  3470)             enddo 
  3471)           case(LIQUID_MOLE_FRACTION)
  3472)             do local_id=1,grid%nlmax
  3473)               vec_ptr(local_id) = patch%aux%Flash2% &
  3474)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%xmol(isubvar)
  3475)             enddo
  3476)           case(LIQUID_VISCOSITY)
  3477)             do local_id=1,grid%nlmax
  3478)               vec_ptr(local_id) = patch%aux%Flash2% &
  3479)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%vis(1)
  3480)             enddo
  3481)           case(LIQUID_MOBILITY)
  3482)             do local_id=1,grid%nlmax
  3483)               vec_ptr(local_id) = patch%aux%Flash2% &
  3484)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%kvr(1)
  3485)             enddo
  3486)           case(LIQUID_ENERGY)
  3487)             do local_id=1,grid%nlmax
  3488)               vec_ptr(local_id) = patch%aux%Flash2% &
  3489)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%u(1)
  3490)             enddo
  3491)         end select
  3492)         
  3493)       else if (associated(patch%aux%Mphase)) then
  3494)         
  3495)         select case(ivar)
  3496)         
  3497)           case(TEMPERATURE)
  3498)             do local_id=1,grid%nlmax
  3499)               vec_ptr(local_id) = patch%aux%Global% &
  3500)                 auxvars(grid%nL2G(local_id))%temp
  3501)             enddo
  3502)           case(LIQUID_PRESSURE)
  3503)             do local_id=1,grid%nlmax
  3504)               vec_ptr(local_id) = patch%aux%Global% &
  3505)                 auxvars(grid%nL2G(local_id))%pres(1)
  3506)             enddo
  3507)           case(GAS_PRESSURE)
  3508)             do local_id=1,grid%nlmax
  3509)               vec_ptr(local_id) = patch%aux%Global% &
  3510)                 auxvars(grid%nL2G(local_id))%pres(2)
  3511)             enddo
  3512)           case(LIQUID_SATURATION)
  3513)             do local_id=1,grid%nlmax
  3514)               vec_ptr(local_id) = patch%aux%Global% &
  3515)                 auxvars(grid%nL2G(local_id))%sat(1)
  3516)             enddo
  3517)           case(LIQUID_DENSITY)
  3518) !geh: CO2 Mass Balance Fix (change to #if 0 to scale the mixture density by the water mole fraction)
  3519) #if 1          
  3520)             do local_id=1,grid%nlmax
  3521)               vec_ptr(local_id) = patch%aux%Global% &
  3522)                 auxvars(grid%nL2G(local_id))%den_kg(1)
  3523)             enddo
  3524) #else
  3525)             do local_id=1,grid%nlmax
  3526)               vec_ptr(local_id) = &
  3527)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%den(1) * &
  3528)                 patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
  3529)                   auxvar_elem(0)%xmol(1) * FMWH2O
  3530)             enddo
  3531) #endif
  3532)           case(LIQUID_VISCOSITY)
  3533)             do local_id=1,grid%nlmax
  3534)               vec_ptr(local_id) = patch%aux%Mphase% &
  3535)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%vis(1)
  3536)             enddo
  3537)           case(LIQUID_MOBILITY)
  3538)             do local_id=1,grid%nlmax
  3539)               vec_ptr(local_id) = patch%aux%Mphase% &
  3540)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%kvr(1)
  3541)             enddo
  3542)           case(GAS_SATURATION)
  3543)             do local_id=1,grid%nlmax
  3544)               vec_ptr(local_id) = patch%aux%Global% &
  3545)                 auxvars(grid%nL2G(local_id))%sat(2)
  3546)             enddo
  3547)           case(GAS_MOLE_FRACTION)
  3548)             do local_id=1,grid%nlmax
  3549)               vec_ptr(local_id) = patch%aux%Mphase% &
  3550)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%xmol(2+isubvar)
  3551)             enddo
  3552)           case(GAS_ENERGY)
  3553)             do local_id=1,grid%nlmax
  3554)               vec_ptr(local_id) = patch%aux%Mphase% &
  3555)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%u(2)
  3556)             enddo
  3557)           case(GAS_VISCOSITY) 
  3558)             do local_id=1,grid%nlmax
  3559)               vec_ptr(local_id) = patch%aux%Mphase% &
  3560)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%vis(2)
  3561)             enddo
  3562)           case(GAS_MOBILITY) 
  3563)             do local_id=1,grid%nlmax
  3564)               vec_ptr(local_id) = patch%aux%Mphase% &
  3565)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%kvr(2)
  3566)             enddo
  3567)           case(GAS_DENSITY) 
  3568)             do local_id=1,grid%nlmax
  3569)               vec_ptr(local_id) = patch%aux%Global% &
  3570)                 auxvars(grid%nL2G(local_id))%den_kg(2)
  3571)             enddo
  3572)           case(GAS_DENSITY_MOL) 
  3573)             do local_id=1,grid%nlmax
  3574)               vec_ptr(local_id) = &
  3575)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%den(2)
  3576)             enddo
  3577)           case(SC_FUGA_COEFF)
  3578)             if (.not.associated(patch%aux%Global%auxvars(1)%fugacoeff) .and. &
  3579)                 OptionPrintToScreen(option))then
  3580)                print *,'ERRor, fugacoeff not allocated for ', option%iflowmode, 1
  3581)             endif
  3582)             do local_id=1,grid%nlmax
  3583)              vec_ptr(local_id) = patch%aux%Global%&
  3584)                 auxvars(grid%nL2G(local_id))%fugacoeff(1)
  3585)             enddo 
  3586)           case(LIQUID_MOLE_FRACTION)
  3587)             do local_id=1,grid%nlmax
  3588)               vec_ptr(local_id) = patch%aux%Mphase%&
  3589)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%xmol(isubvar)
  3590)             enddo
  3591)           case(LIQUID_ENERGY)
  3592)             do local_id=1,grid%nlmax
  3593)               vec_ptr(local_id) = patch%aux%Mphase%&
  3594)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%u(1)
  3595)             enddo
  3596)         end select
  3597)         
  3598)       else if (associated(patch%aux%Miscible)) then
  3599)         
  3600)         select case(ivar)
  3601)         
  3602) !         case(TEMPERATURE)
  3603) !           do local_id=1,grid%nlmax
  3604) !             vec_ptr(local_id) = patch%aux%Global%auxvars(grid%nL2G(local_id))%temp
  3605) !           enddo
  3606)           case(LIQUID_PRESSURE)
  3607)             do local_id=1,grid%nlmax
  3608)               vec_ptr(local_id) = &
  3609)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%pres(1)
  3610)             enddo
  3611)           case(LIQUID_DENSITY)
  3612)             do local_id=1,grid%nlmax
  3613)               vec_ptr(local_id) = &
  3614)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%den_kg(1)
  3615)             enddo
  3616)           case(LIQUID_VISCOSITY)
  3617)             do local_id=1,grid%nlmax
  3618)               vec_ptr(local_id) = patch%aux%Miscible% &
  3619)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%vis(1)
  3620)             enddo
  3621)           case(LIQUID_MOLE_FRACTION)
  3622)             do local_id=1,grid%nlmax
  3623)               vec_ptr(local_id) = patch%aux%Miscible% &
  3624)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%xmol(isubvar)
  3625)             enddo
  3626)         end select
  3627)         
  3628)       else if (associated(patch%aux%immis)) then
  3629)       
  3630)         select case(ivar)
  3631)           case(TEMPERATURE)
  3632)             do local_id=1,grid%nlmax
  3633)               vec_ptr(local_id) = patch%aux%Global% &
  3634)                 auxvars(grid%nL2G(local_id))%temp
  3635)             enddo
  3636)           case(LIQUID_PRESSURE)
  3637)             do local_id=1,grid%nlmax
  3638)               vec_ptr(local_id) = patch%aux%Global% &
  3639)                 auxvars(grid%nL2G(local_id))%pres(2)
  3640)             enddo
  3641)           case(LIQUID_SATURATION)
  3642)             do local_id=1,grid%nlmax
  3643)               vec_ptr(local_id) = patch%aux%Global% &
  3644)                 auxvars(grid%nL2G(local_id))%sat(1)
  3645)             enddo
  3646)           case(LIQUID_DENSITY)
  3647)             do local_id=1,grid%nlmax
  3648)               vec_ptr(local_id) = patch%aux%Global% &
  3649)                 auxvars(grid%nL2G(local_id))%den_kg(1)
  3650)             enddo
  3651)           case(LIQUID_ENERGY)
  3652)             do local_id=1,grid%nlmax
  3653)               vec_ptr(local_id) = patch%aux%Immis% &
  3654)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%u(1)
  3655)             enddo
  3656)           case(LIQUID_VISCOSITY)
  3657)             do local_id=1,grid%nlmax
  3658)               vec_ptr(local_id) = patch%aux%Immis% &
  3659)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%vis(1)
  3660)             enddo
  3661)           case(LIQUID_MOBILITY)
  3662)             do local_id=1,grid%nlmax
  3663)               vec_ptr(local_id) = patch%aux%Immis% &
  3664)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%kvr(1)
  3665)             enddo
  3666)           case(GAS_SATURATION)
  3667)             do local_id=1,grid%nlmax
  3668)               vec_ptr(local_id) = patch%aux%Global% &
  3669)                 auxvars(grid%nL2G(local_id))%sat(2)
  3670)             enddo
  3671)           case(GAS_ENERGY)
  3672)             do local_id=1,grid%nlmax
  3673)               vec_ptr(local_id) = patch%aux%Immis% &
  3674)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%u(2)
  3675)             enddo
  3676)           case(GAS_DENSITY) 
  3677)             do local_id=1,grid%nlmax
  3678)               vec_ptr(local_id) = patch%aux%Global% &
  3679)                 auxvars(grid%nL2G(local_id))%den_kg(2)
  3680)             enddo
  3681)           case(GAS_VISCOSITY)
  3682)             do local_id=1,grid%nlmax
  3683)               vec_ptr(local_id) = patch%aux%Immis% &
  3684)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%vis(2)
  3685)             enddo
  3686)           case(GAS_MOBILITY)
  3687)             do local_id=1,grid%nlmax
  3688)               vec_ptr(local_id) = patch%aux%Immis% &
  3689)                 auxvars(grid%nL2G(local_id))%auxvar_elem(0)%kvr(2)
  3690)             enddo
  3691)         end select
  3692)       else if (associated(patch%aux%General)) then
  3693)         select case(ivar)
  3694)           case(TEMPERATURE)
  3695)             do local_id=1,grid%nlmax
  3696)               vec_ptr(local_id) = &
  3697)                 patch%aux%General%auxvars(ZERO_INTEGER, &
  3698)                                           grid%nL2G(local_id))%temp
  3699)             enddo
  3700)           case(MAXIMUM_PRESSURE)
  3701)             do local_id=1,grid%nlmax
  3702)               ghosted_id = grid%nL2G(local_id)
  3703)               vec_ptr(local_id) = &
  3704)                   maxval(patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  3705)                            pres(option%liquid_phase:option%gas_phase))
  3706)             enddo
  3707)           case(LIQUID_PRESSURE)
  3708)             if (output_option%filter_non_state_variables) then
  3709)               do local_id=1,grid%nlmax
  3710)                 ghosted_id = grid%nL2G(local_id)
  3711)                 if (patch%aux%Global%auxvars(ghosted_id)%istate /= &
  3712)                     GAS_STATE) then
  3713)                   vec_ptr(local_id) = &
  3714)                     patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  3715)                       pres(option%liquid_phase)
  3716)                 else
  3717)                   vec_ptr(local_id) = 0.d0
  3718)                 endif
  3719)               enddo
  3720)             else
  3721)               do local_id=1,grid%nlmax
  3722)                 ghosted_id = grid%nL2G(local_id)
  3723)                 vec_ptr(local_id) = &
  3724)                   patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  3725)                     pres(option%liquid_phase)
  3726)               enddo
  3727)             endif
  3728)           case(GAS_PRESSURE)
  3729)             if (output_option%filter_non_state_variables) then
  3730)               do local_id=1,grid%nlmax
  3731)                 ghosted_id = grid%nL2G(local_id)
  3732)                 if (patch%aux%Global%auxvars(ghosted_id)%istate /= &
  3733)                     LIQUID_STATE) then
  3734)                   vec_ptr(local_id) = &
  3735)                     patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  3736)                       pres(option%gas_phase)
  3737)                 else
  3738)                   vec_ptr(local_id) = 0.d0
  3739)                 endif
  3740)               enddo
  3741)             else
  3742)               do local_id=1,grid%nlmax
  3743)                 ghosted_id = grid%nL2G(local_id)
  3744)                 vec_ptr(local_id) = &
  3745)                   patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  3746)                     pres(option%gas_phase)
  3747)               enddo
  3748)             endif
  3749)           case(AIR_PRESSURE)
  3750)             if (output_option%filter_non_state_variables) then
  3751)               do local_id=1,grid%nlmax
  3752)                 ghosted_id = grid%nL2G(local_id)
  3753)                 if (patch%aux%Global%auxvars(ghosted_id)%istate /= &
  3754)                     LIQUID_STATE) then
  3755)                   vec_ptr(local_id) = &
  3756)                     patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  3757)                       pres(option%air_pressure_id)
  3758)                 else
  3759)                   vec_ptr(local_id) = 0.d0
  3760)                 endif
  3761)               enddo
  3762)             else
  3763)               do local_id=1,grid%nlmax
  3764)                 ghosted_id = grid%nL2G(local_id)
  3765)                 vec_ptr(local_id) = &
  3766)                   patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  3767)                     pres(option%air_pressure_id)
  3768)               enddo
  3769)             endif
  3770)           case(CAPILLARY_PRESSURE)
  3771)             do local_id=1,grid%nlmax
  3772)               ghosted_id = grid%nL2G(local_id)
  3773)               vec_ptr(local_id) = &
  3774)                 patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  3775)                   pres(option%capillary_pressure_id)
  3776)             enddo
  3777)           case(VAPOR_PRESSURE)
  3778)             do local_id=1,grid%nlmax
  3779)               ghosted_id = grid%nL2G(local_id)
  3780)               vec_ptr(local_id) = &
  3781)                 patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  3782)                   pres(option%vapor_pressure_id)
  3783)             enddo
  3784)           case(SATURATION_PRESSURE)
  3785)             do local_id=1,grid%nlmax
  3786)               ghosted_id = grid%nL2G(local_id)
  3787)               vec_ptr(local_id) = &
  3788)                 patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  3789)                   pres(option%saturation_pressure_id)
  3790)             enddo
  3791)           case(STATE)
  3792)             do local_id=1,grid%nlmax
  3793)               vec_ptr(local_id) = &
  3794)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%istate
  3795)             enddo
  3796)           case(LIQUID_SATURATION)
  3797)             do local_id=1,grid%nlmax
  3798)               vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
  3799)                   grid%nL2G(local_id))%sat(option%liquid_phase)
  3800)             enddo
  3801)           case(LIQUID_DENSITY)
  3802)             do local_id=1,grid%nlmax
  3803)               vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
  3804)                   grid%nL2G(local_id))%den_kg(option%liquid_phase)
  3805)             enddo
  3806)           case(LIQUID_DENSITY_MOL)
  3807)             do local_id=1,grid%nlmax
  3808)               vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
  3809)                   grid%nL2G(local_id))%den(option%liquid_phase)
  3810)             enddo
  3811)           case(LIQUID_ENERGY)
  3812)             if (isubvar == ZERO_INTEGER) then
  3813)               do local_id=1,grid%nlmax
  3814)                 vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
  3815)                     grid%nL2G(local_id))%U(option%liquid_phase)
  3816)               enddo
  3817)             else
  3818)               do local_id=1,grid%nlmax
  3819)                 vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
  3820)                       grid%nL2G(local_id))%U(option%liquid_phase) * &
  3821)                     patch%aux%General%auxvars(ZERO_INTEGER, &
  3822)                       grid%nL2G(local_id))%den(option%liquid_phase)
  3823)               enddo
  3824)             endif
  3825)           case(LIQUID_MOLE_FRACTION,LIQUID_MASS_FRACTION)
  3826)             do local_id=1,grid%nlmax
  3827)               vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
  3828)                   grid%nL2G(local_id))%xmol(isubvar,option%liquid_phase)
  3829)             enddo
  3830)             if (ivar == LIQUID_MASS_FRACTION) then
  3831)               tempint = isubvar
  3832)               tempint2 = tempint+1
  3833)               if (tempint2 > 2) tempint2 = 1
  3834)               vec_ptr(:) = vec_ptr(:)*fmw_comp(tempint) / &
  3835)                            (vec_ptr(:)*fmw_comp(tempint) + &
  3836)                             (1.d0-vec_ptr(:))*fmw_comp(tempint2))
  3837)             endif
  3838)           case(LIQUID_MOBILITY)
  3839)             do local_id=1,grid%nlmax
  3840)               vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
  3841)                   grid%nL2G(local_id))%mobility(option%liquid_phase)
  3842)             enddo
  3843)           case(GAS_SATURATION)
  3844)             do local_id=1,grid%nlmax
  3845)               vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
  3846)                   grid%nL2G(local_id))%sat(option%gas_phase)
  3847)             enddo
  3848)           case(GAS_ENERGY)
  3849)             if (isubvar == ZERO_INTEGER) then
  3850)               do local_id=1,grid%nlmax
  3851)                 vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
  3852)                     grid%nL2G(local_id))%U(option%gas_phase)
  3853)               enddo
  3854)             else
  3855)               do local_id=1,grid%nlmax
  3856)                 vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
  3857)                       grid%nL2G(local_id))%U(option%gas_phase) * &
  3858)                     patch%aux%General%auxvars(ZERO_INTEGER, &
  3859)                       grid%nL2G(local_id))%den(option%gas_phase)
  3860)               enddo
  3861)             endif
  3862)           case(GAS_DENSITY) 
  3863)             do local_id=1,grid%nlmax
  3864)               vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
  3865)                   grid%nL2G(local_id))%den_kg(option%gas_phase)
  3866)             enddo
  3867)           case(GAS_DENSITY_MOL) 
  3868)             do local_id=1,grid%nlmax
  3869)               vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
  3870)                   grid%nL2G(local_id))%den(option%gas_phase)
  3871)             enddo
  3872)           case(GAS_MOLE_FRACTION,GAS_MASS_FRACTION)
  3873)             do local_id=1,grid%nlmax
  3874)               vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
  3875)                   grid%nL2G(local_id))%xmol(isubvar,option%gas_phase)
  3876)             enddo
  3877)             if (ivar == GAS_MASS_FRACTION) then
  3878)               tempint = isubvar
  3879)               tempint2 = tempint+1
  3880)               if (tempint2 > 2) tempint2 = 1
  3881)               vec_ptr(:) = vec_ptr(:)*fmw_comp(tempint) / &
  3882)                            (vec_ptr(:)*fmw_comp(tempint) + &
  3883)                             (1.d0-vec_ptr(:))*fmw_comp(tempint2))
  3884)             endif
  3885)           case(GAS_MOBILITY)
  3886)             do local_id=1,grid%nlmax
  3887)               vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
  3888)                   grid%nL2G(local_id))%mobility(option%gas_phase)
  3889)             enddo
  3890)           case(EFFECTIVE_POROSITY)
  3891)             do local_id=1,grid%nlmax
  3892)               vec_ptr(local_id) = patch%aux%General%auxvars(ZERO_INTEGER, &
  3893)                   grid%nL2G(local_id))%effective_porosity
  3894)             enddo
  3895)         end select 
  3896) 
  3897)       else if (associated(patch%aux%TOil_ims)) then
  3898) 
  3899)         select case(ivar)
  3900)           case(TEMPERATURE)
  3901)             do local_id=1,grid%nlmax
  3902)               vec_ptr(local_id) = patch%aux%TOil_ims% &
  3903)                 auxvars(ZERO_INTEGER,grid%nL2G(local_id))%temp
  3904)             enddo
  3905)           case(MAXIMUM_PRESSURE)
  3906)             do local_id=1,grid%nlmax
  3907)               ghosted_id = grid%nL2G(local_id)
  3908)               vec_ptr(local_id) = &
  3909)                   maxval(patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  3910)                            pres(option%liquid_phase:option%oil_phase))
  3911)             enddo
  3912)           case(LIQUID_PRESSURE)
  3913)             do local_id=1,grid%nlmax
  3914)               ghosted_id = grid%nL2G(local_id)
  3915)               vec_ptr(local_id) = &
  3916)                 patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  3917)                   pres(option%liquid_phase)
  3918)             enddo
  3919)           case(OIL_PRESSURE)
  3920)             do local_id=1,grid%nlmax
  3921)               ghosted_id = grid%nL2G(local_id)
  3922)               vec_ptr(local_id) = &
  3923)                 patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  3924)                   pres(option%oil_phase)
  3925)             enddo
  3926)           case(CAPILLARY_PRESSURE)
  3927)             do local_id=1,grid%nlmax
  3928)               ghosted_id = grid%nL2G(local_id)
  3929)               vec_ptr(local_id) = &
  3930)                 patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  3931)                   pres(option%capillary_pressure_id)
  3932)             enddo
  3933)           case(LIQUID_SATURATION)
  3934)             do local_id=1,grid%nlmax
  3935)               vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
  3936)                   grid%nL2G(local_id))%sat(option%liquid_phase)
  3937)             enddo
  3938)           case(LIQUID_DENSITY)
  3939)             do local_id=1,grid%nlmax
  3940)               vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
  3941)                   grid%nL2G(local_id))%den_kg(option%liquid_phase)
  3942)             enddo
  3943)           case(LIQUID_DENSITY_MOL)
  3944)             do local_id=1,grid%nlmax
  3945)               vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
  3946)                   grid%nL2G(local_id))%den(option%liquid_phase)
  3947)             enddo
  3948)           case(LIQUID_ENERGY)
  3949)             if (isubvar == ZERO_INTEGER) then
  3950)               do local_id=1,grid%nlmax
  3951)                 vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
  3952)                     grid%nL2G(local_id))%U(option%liquid_phase)
  3953)               enddo
  3954)             else
  3955)               do local_id=1,grid%nlmax
  3956)                 vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
  3957)                       grid%nL2G(local_id))%U(option%liquid_phase) * &
  3958)                     patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
  3959)                       grid%nL2G(local_id))%den(option%liquid_phase)
  3960)               enddo
  3961)             endif
  3962)           case(LIQUID_MOBILITY)
  3963)             do local_id=1,grid%nlmax
  3964)               vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
  3965)                   grid%nL2G(local_id))%mobility(option%liquid_phase)
  3966)             enddo
  3967)           case(OIL_SATURATION)
  3968)             do local_id=1,grid%nlmax
  3969)               vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
  3970)                   grid%nL2G(local_id))%sat(option%oil_phase)
  3971)             enddo
  3972)           case(OIL_ENERGY)
  3973)             if (isubvar == ZERO_INTEGER) then
  3974)               do local_id=1,grid%nlmax
  3975)                 vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
  3976)                     grid%nL2G(local_id))%U(option%oil_phase)
  3977)               enddo
  3978)             else
  3979)               do local_id=1,grid%nlmax
  3980)                 vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
  3981)                       grid%nL2G(local_id))%U(option%oil_phase) * &
  3982)                     patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
  3983)                       grid%nL2G(local_id))%den(option%oil_phase)
  3984)               enddo
  3985)             endif
  3986)           case(OIL_DENSITY) 
  3987)             do local_id=1,grid%nlmax
  3988)               vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
  3989)                   grid%nL2G(local_id))%den_kg(option%oil_phase)
  3990)             enddo
  3991)           case(OIL_DENSITY_MOL) 
  3992)             do local_id=1,grid%nlmax
  3993)               vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
  3994)                   grid%nL2G(local_id))%den(option%oil_phase)
  3995)             enddo
  3996)           case(OIL_MOBILITY)
  3997)             do local_id=1,grid%nlmax
  3998)               vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
  3999)                   grid%nL2G(local_id))%mobility(option%oil_phase)
  4000)             enddo
  4001)           case(EFFECTIVE_POROSITY)
  4002)             do local_id=1,grid%nlmax
  4003)               vec_ptr(local_id) = patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
  4004)                   grid%nL2G(local_id))%effective_porosity
  4005)             enddo
  4006)         end select 
  4007)         
  4008)       endif
  4009)       
  4010)     case(PH,PE,EH,O2,PRIMARY_MOLALITY,PRIMARY_MOLARITY,SECONDARY_MOLALITY, &
  4011)          SECONDARY_MOLARITY,TOTAL_MOLALITY,TOTAL_MOLARITY, &
  4012)          MINERAL_RATE,MINERAL_VOLUME_FRACTION,MINERAL_SATURATION_INDEX, &
  4013)          SURFACE_CMPLX,SURFACE_CMPLX_FREE,SURFACE_SITE_DENSITY, &
  4014)          KIN_SURFACE_CMPLX,KIN_SURFACE_CMPLX_FREE, PRIMARY_ACTIVITY_COEF, &
  4015)          SECONDARY_ACTIVITY_COEF,PRIMARY_KD,TOTAL_SORBED,TOTAL_SORBED_MOBILE, &
  4016)          COLLOID_MOBILE,COLLOID_IMMOBILE,AGE,TOTAL_BULK,IMMOBILE_SPECIES)
  4017) 
  4018)       select case(ivar)
  4019)         case(PH)
  4020)           if (isubvar > 0) then
  4021)             do local_id=1,grid%nlmax
  4022)               ghosted_id = grid%nL2G(local_id)
  4023)               vec_ptr(local_id) = &
  4024)                 -log10(patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(isubvar)* &
  4025)                        patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar))
  4026)             enddo
  4027)           else
  4028)             do local_id=1,grid%nlmax
  4029)               ghosted_id = grid%nL2G(local_id)
  4030)               vec_ptr(local_id) = &
  4031)                -log10(patch%aux%RT%auxvars(ghosted_id)%sec_act_coef(-isubvar)* &
  4032)                       patch%aux%RT%auxvars(ghosted_id)%sec_molal(-isubvar))
  4033)             enddo
  4034)           endif
  4035)         case(EH)
  4036)           do local_id=1,grid%nlmax
  4037)             ghosted_id = grid%nL2G(local_id)
  4038)             if (patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) > &
  4039)                 0.d0) then
  4040)               !geh: all the below should be calculated somewhere else, not in
  4041)               !     patch.F90.  most likely reactive_transport.F90
  4042)               ph0 = &
  4043)                 -log10(patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(isubvar)* &
  4044)                        patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar))
  4045)               ifo2 = reaction%species_idx%o2_gas_id
  4046)               ! compute gas partial pressure
  4047)               lnQKgas = -reaction%eqgas_logK(ifo2)*LOG_TO_LN
  4048)               ! activity of water
  4049)               if (reaction%eqgash2oid(ifo2) > 0) then
  4050)                 lnQKgas = lnQKgas + reaction%eqgash2ostoich(ifo2) * &
  4051)                     patch%aux%RT%auxvars(ghosted_id)%ln_act_h2o
  4052)               endif
  4053)               do jcomp = 1, reaction%eqgasspecid(0,ifo2)
  4054)                 comp_id = reaction%eqgasspecid(jcomp,ifo2)
  4055)                 lnQKgas = lnQKgas + reaction%eqgasstoich(jcomp,ifo2)* &
  4056)                       log(patch%aux%RT%auxvars(ghosted_id)%pri_molal(comp_id)* &
  4057)                         patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(comp_id))
  4058)               enddo
  4059)               tk = patch%aux%Global%auxvars(ghosted_id)%temp + &
  4060)                    273.15d0
  4061)               ehfac = IDEAL_GAS_CONSTANT*tk*LOG_TO_LN/faraday
  4062)               eh0 = ehfac*(-4.d0*ph0+lnQKgas*LN_TO_LOG+logKeh(tk))/4.d0
  4063)               pe0 = eh0/ehfac
  4064)               vec_ptr(local_id) = eh0
  4065)             else
  4066)               vec_ptr(local_id) = 0.d0
  4067)             endif
  4068)           enddo
  4069)         case(PE)
  4070)           do local_id=1,grid%nlmax
  4071)             ghosted_id = grid%nL2G(local_id)
  4072)             if (patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) > &
  4073)                 0.d0) then
  4074)               !geh: all the below should be calculated somewhere else, not in
  4075)               !     patch.F90.  most likely reactive_transport.F90
  4076)               ph0 = &
  4077)                 -log10(patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(isubvar)* &
  4078)                        patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar))
  4079)               ifo2 = reaction%species_idx%o2_gas_id
  4080)               ! compute gas partial pressure
  4081)               lnQKgas = -reaction%eqgas_logK(ifo2)*LOG_TO_LN
  4082)               ! activity of water
  4083)               if (reaction%eqgash2oid(ifo2) > 0) then
  4084)                 lnQKgas = lnQKgas + reaction%eqgash2ostoich(ifo2) * &
  4085)                     patch%aux%RT%auxvars(ghosted_id)%ln_act_h2o
  4086)               endif
  4087)               do jcomp = 1, reaction%eqgasspecid(0,ifo2)
  4088)                 comp_id = reaction%eqgasspecid(jcomp,ifo2)
  4089)                 lnQKgas = lnQKgas + reaction%eqgasstoich(jcomp,ifo2)* &
  4090)                       log(patch%aux%RT%auxvars(ghosted_id)%pri_molal(comp_id)* &
  4091)                         patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(comp_id))
  4092)               enddo
  4093)               tk = patch%aux%Global%auxvars(ghosted_id)%temp + &
  4094)                    273.15d0
  4095)               ehfac = IDEAL_GAS_CONSTANT*tk*LOG_TO_LN/faraday
  4096)               eh0 = ehfac*(-4.d0*ph0+lnQKgas*LN_TO_LOG+logKeh(tk))/4.d0
  4097)               pe0 = eh0/ehfac
  4098)               vec_ptr(local_id) = pe0
  4099)             else
  4100)               vec_ptr(local_id) = 0.d0
  4101)             endif
  4102)           enddo
  4103) 
  4104)         case(O2)
  4105)           do local_id=1,grid%nlmax
  4106)             ghosted_id = grid%nL2G(local_id)
  4107)             if (patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) > &
  4108)                 0.d0) then
  4109)               !geh: all the below should be calculated somewhere else, not in
  4110)               !     patch.F90.  most likely reactive_transport.F90
  4111)               ifo2 = reaction%species_idx%o2_gas_id
  4112)               ! compute gas partial pressure
  4113)               lnQKgas = -reaction%eqgas_logK(ifo2)*LOG_TO_LN
  4114)               ! activity of water
  4115)               if (reaction%eqgash2oid(ifo2) > 0) then
  4116)                 lnQKgas = lnQKgas + reaction%eqgash2ostoich(ifo2) * &
  4117)                     patch%aux%RT%auxvars(ghosted_id)%ln_act_h2o
  4118)               endif
  4119)               do jcomp = 1, reaction%eqgasspecid(0,ifo2)
  4120)                 comp_id = reaction%eqgasspecid(jcomp,ifo2)
  4121)                 lnQKgas = lnQKgas + reaction%eqgasstoich(jcomp,ifo2)* &
  4122)                       log(patch%aux%RT%auxvars(ghosted_id)%pri_molal(comp_id)* &
  4123)                         patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(comp_id))
  4124)               enddo
  4125)               vec_ptr(local_id) = lnQKgas * LN_TO_LOG
  4126)             else
  4127)               vec_ptr(local_id) = 0.d0
  4128)             endif
  4129)           enddo
  4130)         case(PRIMARY_MOLALITY)
  4131)           do local_id=1,grid%nlmax
  4132)             vec_ptr(local_id) = &
  4133)               patch%aux%RT%auxvars(grid%nL2G(local_id))%pri_molal(isubvar)
  4134)           enddo
  4135)         case(PRIMARY_MOLARITY)
  4136)           do local_id=1,grid%nlmax
  4137)             ghosted_id = grid%nL2G(local_id)
  4138)             if (associated(patch%aux%Global%auxvars(ghosted_id)%xmass)) then
  4139)               xmass = patch%aux%Global%auxvars(ghosted_id)%xmass(iphase)
  4140)             else
  4141)               xmass = 1.d0
  4142)             endif
  4143)             vec_ptr(local_id) = &
  4144)               patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) * xmass * &
  4145)               (patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase)/1000.d0)
  4146)           enddo
  4147)         case(SECONDARY_MOLALITY)
  4148)           do local_id=1,grid%nlmax
  4149)             ghosted_id = grid%nL2G(local_id)
  4150)             vec_ptr(local_id) = &
  4151)               patch%aux%RT%auxvars(ghosted_id)%sec_molal(isubvar)
  4152)           enddo
  4153)         case(SECONDARY_MOLARITY)
  4154)           do local_id=1,grid%nlmax
  4155)             ghosted_id = grid%nL2G(local_id)
  4156)             if (associated(patch%aux%Global%auxvars(ghosted_id)%xmass)) then
  4157)               xmass = patch%aux%Global%auxvars(ghosted_id)%xmass(iphase)
  4158)             else
  4159)               xmass = 1.d0
  4160)             endif
  4161)             vec_ptr(local_id) = &
  4162)               patch%aux%RT%auxvars(ghosted_id)%sec_molal(isubvar) * xmass * &
  4163)               (patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase)/1000.d0)
  4164)           enddo
  4165)         case(TOTAL_MOLALITY)
  4166)           do local_id=1,grid%nlmax
  4167)             ghosted_id =grid%nL2G(local_id)
  4168)             if (associated(patch%aux%Global%auxvars(ghosted_id)%xmass)) then
  4169)               xmass = patch%aux%Global%auxvars(ghosted_id)%xmass(iphase)
  4170)             else
  4171)               xmass = 1.d0
  4172)             endif
  4173)             if (patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase) > 0.d0) then
  4174)               vec_ptr(local_id) = &
  4175)                 patch%aux%RT%auxvars(ghosted_id)%total(isubvar,iphase) / &
  4176)                 xmass / &
  4177)                 (patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase)/1000.d0)
  4178)             else
  4179)               vec_ptr(local_id) = 0.d0
  4180)             endif
  4181)           enddo
  4182)         case(TOTAL_MOLARITY)
  4183)           do local_id=1,grid%nlmax
  4184)             vec_ptr(local_id) = &
  4185)               patch%aux%RT%auxvars(grid%nL2G(local_id))%total(isubvar,iphase)
  4186)           enddo
  4187)         case(TOTAL_BULK) ! mol/m^3 bulk
  4188)           ! add in total molarity and convert to mol/m^3 bulk
  4189)           do local_id=1,grid%nlmax
  4190)             ghosted_id = grid%nL2G(local_id)
  4191)             vec_ptr(local_id) = &
  4192)               patch%aux%RT%auxvars(ghosted_id)%total(isubvar,iphase) * &
  4193)               patch%aux%Material%auxvars(ghosted_id)%porosity * &
  4194)                                                              ! mol/L -> mol/m^3
  4195)               patch%aux%Global%auxvars(ghosted_id)%sat(iphase) * 1.d-3 
  4196)           enddo
  4197)           ! add in total sorbed.  already in mol/m^3 bulk
  4198)           if (patch%reaction%nsorb > 0) then
  4199)             do local_id=1,grid%nlmax
  4200)               ghosted_id = grid%nL2G(local_id)
  4201)               if (patch%reaction%surface_complexation%neqsrfcplxrxn > 0) then
  4202)                 vec_ptr(local_id) = vec_ptr(local_id) + &
  4203)                   patch%aux%RT%auxvars(ghosted_id)%total_sorb_eq(isubvar)
  4204)               endif
  4205)               if (patch%reaction%surface_complexation%nkinmrsrfcplxrxn > 0) then
  4206)                 do irxn = 1, &
  4207)                    patch%reaction%surface_complexation%nkinmrsrfcplxrxn
  4208)                   do irate = 1, &
  4209)                      patch%reaction%surface_complexation%kinmr_nrate(irxn)
  4210)                     vec_ptr(local_id) = vec_ptr(local_id) + &
  4211)                       patch%aux%RT%auxvars(ghosted_id)% &
  4212)                         kinmr_total_sorb(isubvar,irate,irxn)
  4213)                   enddo 
  4214)                 enddo
  4215)               endif
  4216)             enddo
  4217)           endif
  4218)         case(MINERAL_VOLUME_FRACTION)
  4219)           do local_id=1,grid%nlmax
  4220)             vec_ptr(local_id) = &
  4221)               patch%aux%RT%auxvars(grid%nL2G(local_id))%mnrl_volfrac(isubvar)
  4222)           enddo
  4223)         case(MINERAL_RATE)
  4224)           do local_id=1,grid%nlmax
  4225)             vec_ptr(local_id) = &
  4226)               patch%aux%RT%auxvars(grid%nL2G(local_id))%mnrl_rate(isubvar)
  4227)           enddo
  4228)         case(MINERAL_SATURATION_INDEX)
  4229)           do local_id = 1, grid%nlmax
  4230)             ghosted_id = grid%nL2G(local_id)
  4231)             vec_ptr(local_id) = &
  4232)               RMineralSaturationIndex(isubvar, &
  4233)                                       patch%aux%RT%auxvars(ghosted_id), &
  4234)                                       patch%aux%Global%auxvars(ghosted_id), &
  4235)                                       reaction,option)
  4236)           enddo
  4237)         case(IMMOBILE_SPECIES)
  4238)           do local_id=1,grid%nlmax
  4239)             vec_ptr(local_id) = &
  4240)               patch%aux%RT%auxvars(grid%nL2G(local_id))%immobile(isubvar)
  4241)           enddo          
  4242)         case(SURFACE_CMPLX)
  4243)           if (associated(patch%aux%RT%auxvars(1)%eqsrfcplx_conc)) then
  4244)             do local_id=1,grid%nlmax
  4245)               vec_ptr(local_id) = patch%aux%RT%auxvars(grid%nL2G(local_id))% &
  4246)                                     eqsrfcplx_conc(isubvar)
  4247)             enddo
  4248)           else
  4249)             vec_ptr = UNINITIALIZED_DOUBLE
  4250)           endif
  4251)         case(SURFACE_SITE_DENSITY)
  4252)           tempreal = &
  4253)             reaction%surface_complexation%srfcplxrxn_site_density(isubvar)
  4254)           select case(reaction%surface_complexation% &
  4255)                         srfcplxrxn_surf_type(isubvar))
  4256)             case(ROCK_SURFACE)
  4257)               do local_id=1,grid%nlmax
  4258)                 ghosted_id = grid%nL2G(local_id)
  4259)                 vec_ptr(local_id) = tempreal* &
  4260)                         material_auxvars(ghosted_id)%soil_particle_density * &
  4261)                         (1.d0-material_auxvars(ghosted_id)%porosity)
  4262)               enddo
  4263)             case(MINERAL_SURFACE)
  4264)               tempint = &
  4265)                 reaction%surface_complexation%srfcplxrxn_to_surf(isubvar)
  4266)               do local_id=1,grid%nlmax
  4267)                 vec_ptr(local_id) = tempreal* &
  4268)                                     patch%aux%RT%auxvars(grid%nL2G(local_id))% &
  4269)                                       mnrl_volfrac(tempint)
  4270)               enddo
  4271)             case(COLLOID_SURFACE)
  4272)                 option%io_buffer = 'Printing of surface site density for ' // &
  4273)                                      'colloidal surfaces not implemented.'
  4274)                 call printErrMsg(option)
  4275)             case(NULL_SURFACE)
  4276)               do local_id=1,grid%nlmax
  4277)                 vec_ptr(local_id) = tempreal
  4278)               enddo
  4279)           end select          
  4280)         case(SURFACE_CMPLX_FREE)
  4281)           do local_id=1,grid%nlmax
  4282)             vec_ptr(local_id) = patch%aux%RT%auxvars(grid%nL2G(local_id))% &
  4283)               srfcplxrxn_free_site_conc(isubvar)
  4284)           enddo
  4285)         case(KIN_SURFACE_CMPLX)
  4286)           do local_id=1,grid%nlmax
  4287)             vec_ptr(local_id) = patch%aux%RT%auxvars(grid%nL2G(local_id))% &
  4288)               kinsrfcplx_conc(isubvar,1)
  4289)           enddo
  4290)         case(KIN_SURFACE_CMPLX_FREE)
  4291)           do local_id=1,grid%nlmax
  4292)             vec_ptr(local_id) = patch%aux%RT%auxvars(grid%nL2G(local_id))% &
  4293)               kinsrfcplx_free_site_conc(isubvar)
  4294)           enddo
  4295)         case(PRIMARY_ACTIVITY_COEF)
  4296)           do local_id=1,grid%nlmax
  4297)             ghosted_id = grid%nL2G(local_id)
  4298)             vec_ptr(local_id) = &
  4299)               patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(isubvar)
  4300)           enddo
  4301)         case(SECONDARY_ACTIVITY_COEF)
  4302)           do local_id=1,grid%nlmax
  4303)             ghosted_id = grid%nL2G(local_id)
  4304)             vec_ptr(local_id) = &
  4305)               patch%aux%RT%auxvars(ghosted_id)%sec_act_coef(isubvar)
  4306)           enddo
  4307)         case(PRIMARY_KD)
  4308)           do local_id=1,grid%nlmax
  4309)             ghosted_id = grid%nL2G(local_id)
  4310)             call ReactionComputeKd(isubvar,vec_ptr(local_id), &
  4311)                                    patch%aux%RT%auxvars(ghosted_id), &
  4312)                                    patch%aux%Global%auxvars(ghosted_id), &
  4313)                                    patch%aux%Material%auxvars(ghosted_id), &
  4314)                                    patch%reaction,option)
  4315)           enddo
  4316)         case(TOTAL_SORBED)
  4317)           if (patch%reaction%nsorb > 0) then
  4318)             if (patch%reaction%neqsorb > 0) then
  4319)               do local_id=1,grid%nlmax
  4320)                 ghosted_id = grid%nL2G(local_id)
  4321)                 vec_ptr(local_id) = &
  4322)                   patch%aux%RT%auxvars(ghosted_id)%total_sorb_eq(isubvar)
  4323)               enddo
  4324)             endif
  4325)             if (patch%reaction%surface_complexation%nkinmrsrfcplxrxn > 0) then
  4326)               do local_id=1,grid%nlmax
  4327)                 ghosted_id = grid%nL2G(local_id)
  4328)                 vec_ptr(local_id) = 0.d0
  4329)                 do irxn = 1, &
  4330)                   patch%reaction%surface_complexation%nkinmrsrfcplxrxn
  4331)                   do irate = 1, &
  4332)                     patch%reaction%surface_complexation%kinmr_nrate(irxn)
  4333)                     vec_ptr(local_id) = vec_ptr(local_id) + &
  4334)                       patch%aux%RT%auxvars(ghosted_id)% &
  4335)                         kinmr_total_sorb(isubvar,irate,irxn)
  4336)                   enddo            
  4337)                 enddo            
  4338)               enddo
  4339)             endif
  4340)           endif
  4341)         case(TOTAL_SORBED_MOBILE)
  4342)           if (patch%reaction%nsorb > 0 .and. patch%reaction%ncollcomp > 0) then
  4343)             do local_id=1,grid%nlmax
  4344)               ghosted_id = grid%nL2G(local_id)
  4345)               vec_ptr(local_id) = patch%aux%RT%auxvars(ghosted_id)%colloid% &
  4346)                 total_eq_mob(isubvar)
  4347)             enddo
  4348)           endif
  4349)         case(COLLOID_MOBILE)
  4350)           if (patch%reaction%print_tot_conc_type == TOTAL_MOLALITY) then
  4351)             do local_id=1,grid%nlmax
  4352)               ghosted_id =grid%nL2G(local_id)
  4353)               if (patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase) > &
  4354)                   0.d0) then
  4355)                 vec_ptr(local_id) = &
  4356)                   patch%aux%RT%auxvars(ghosted_id)% &
  4357)                     colloid%conc_mob(isubvar) / &
  4358)                   (patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase)/1000.d0)
  4359)               else
  4360)                 vec_ptr(local_id) = 0.d0
  4361)               endif
  4362)             enddo
  4363)           else
  4364)             do local_id=1,grid%nlmax
  4365)               vec_ptr(local_id) = patch%aux%RT%auxvars(grid%nL2G(local_id))% &
  4366)                                     colloid%conc_mob(isubvar)
  4367)             enddo
  4368)           endif      
  4369)         case(COLLOID_IMMOBILE)
  4370)           if (patch%reaction%print_tot_conc_type == TOTAL_MOLALITY) then
  4371)             do local_id=1,grid%nlmax
  4372)               ghosted_id =grid%nL2G(local_id)
  4373)               if (patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase) > &
  4374)                   0.d0) then
  4375)                 vec_ptr(local_id) = &
  4376)                   patch%aux%RT%auxvars(ghosted_id)% &
  4377)                     colloid%conc_imb(isubvar) / &
  4378)                   (patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase)/1000.d0)
  4379)               else
  4380)                 vec_ptr(local_id) = 0.d0
  4381)               endif
  4382)             enddo
  4383)           else
  4384)             do local_id=1,grid%nlmax
  4385)               vec_ptr(local_id) = patch%aux%RT%auxvars(grid%nL2G(local_id))% &
  4386)                                     colloid%conc_imb(isubvar)
  4387)             enddo
  4388)           endif
  4389)         case(AGE)
  4390)           do local_id=1,grid%nlmax
  4391)             ghosted_id = grid%nL2G(local_id)
  4392)             if (patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) > &
  4393)                 0.d0) then
  4394)               vec_ptr(local_id) = &
  4395)                 patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) / &
  4396)                 patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar1) / &
  4397)                 output_option%tconv
  4398)             endif
  4399)           enddo        
  4400)       end select
  4401)     case(POROSITY,MINERAL_POROSITY,PERMEABILITY,PERMEABILITY_X, &
  4402)          PERMEABILITY_Y, PERMEABILITY_Z,PERMEABILITY_XY,PERMEABILITY_XZ, &
  4403)          PERMEABILITY_YZ,VOLUME,TORTUOSITY,SOIL_COMPRESSIBILITY, &
  4404)          SOIL_REFERENCE_PRESSURE)
  4405)       ivar_temp = ivar
  4406)       if (ivar_temp == PERMEABILITY) ivar_temp = PERMEABILITY_X 
  4407)       do local_id=1,grid%nlmax
  4408)         vec_ptr(local_id) = &
  4409)           MaterialAuxVarGetValue(material_auxvars(grid%nL2G(local_id)), &
  4410)                                  ivar_temp)
  4411)       enddo
  4412)     case(PHASE)
  4413)       call VecGetArrayF90(field%iphas_loc,vec_ptr2,ierr);CHKERRQ(ierr)
  4414)       do local_id=1,grid%nlmax
  4415)         vec_ptr(local_id) = vec_ptr2(grid%nL2G(local_id))
  4416)       enddo
  4417)       call VecRestoreArrayF90(field%iphas_loc,vec_ptr2,ierr);CHKERRQ(ierr)
  4418)     case(MATERIAL_ID)
  4419)       do local_id=1,grid%nlmax
  4420)         vec_ptr(local_id) = &
  4421)           patch%imat_internal_to_external(iabs(patch%imat(grid%nL2G(local_id))))
  4422)       enddo
  4423)     case(PROCESS_ID)
  4424)       do local_id=1,grid%nlmax
  4425)         vec_ptr(local_id) = option%myrank
  4426)       enddo
  4427)     case(RESIDUAL)
  4428)       call VecRestoreArrayF90(vec,vec_ptr,ierr);CHKERRQ(ierr)
  4429)       call VecStrideGather(field%flow_r,isubvar-1,vec,INSERT_VALUES,ierr)
  4430)       call VecGetArrayF90(vec,vec_ptr,ierr);CHKERRQ(ierr)
  4431)     case default
  4432)       write(option%io_buffer, &
  4433)             '(''IVAR ('',i3,'') not found in PatchGetVariable'')') ivar
  4434)       call printErrMsg(option)
  4435)   end select
  4436) 
  4437)   call VecRestoreArrayF90(vec,vec_ptr,ierr);CHKERRQ(ierr)
  4438)   
  4439) end subroutine PatchGetVariable1
  4440) 
  4441) ! ************************************************************************** !
  4442) 
  4443) function PatchGetVariableValueAtCell(patch,field,reaction,option, &
  4444)                                     output_option, &
  4445)                                     ivar,isubvar,ghosted_id,isubvar1)
  4446)   ! 
  4447)   ! Returns variables indexed by ivar,
  4448)   ! isubvar, local id from Reactive Transport type
  4449)   ! 
  4450)   ! Author: Glenn Hammond
  4451)   ! Date: 02/11/08
  4452)   ! 
  4453) 
  4454)   use Grid_module
  4455)   use Option_module
  4456)   use Field_module
  4457) 
  4458)   use Mphase_Aux_module
  4459)   use TH_Aux_module
  4460)   use Richards_Aux_module
  4461)   use Miscible_Aux_module
  4462)   use Reactive_Transport_Aux_module  
  4463)   use Reaction_Mineral_module
  4464)   use Reaction_module
  4465)   use Reaction_Mineral_Aux_module
  4466)   use Reaction_Surface_Complexation_Aux_module
  4467)   use Output_Aux_module
  4468)   use Variables_module
  4469)   use General_Aux_module  
  4470)   use Material_Aux_class
  4471) 
  4472)   implicit none
  4473) 
  4474) #include "petsc/finclude/petscvec.h"
  4475) #include "petsc/finclude/petscvec.h90"
  4476) 
  4477)   PetscReal :: PatchGetVariableValueAtCell
  4478)   type(option_type), pointer :: option
  4479)   type(reaction_type), pointer :: reaction
  4480)   type(output_option_type), pointer :: output_option
  4481)   type(field_type), pointer :: field
  4482)   type(patch_type), pointer :: patch
  4483)   class(material_auxvar_type), pointer :: material_auxvars(:)
  4484)   PetscInt :: ivar
  4485)   PetscInt :: isubvar
  4486)   PetscInt :: tempint, tempint2
  4487)   PetscInt, optional :: isubvar1
  4488)   PetscInt :: iphase
  4489)   PetscInt :: ghosted_id, local_id
  4490)   PetscInt :: ivar_temp
  4491) 
  4492)   PetscReal :: value, xmass, lnQKgas, tk, ehfac, eh0, pe0, ph0
  4493)   PetscInt :: irate, istate, irxn, ifo2, jcomp, comp_id
  4494)   type(grid_type), pointer :: grid
  4495)   PetscReal, pointer :: vec_ptr2(:)  
  4496)   PetscErrorCode :: ierr
  4497) 
  4498)   grid => patch%grid
  4499)   material_auxvars => patch%aux%Material%auxvars
  4500)   
  4501)   value = UNINITIALIZED_DOUBLE
  4502) 
  4503)   ! inactive grid cell
  4504)   if (patch%imat(ghosted_id) <= 0) then
  4505)     PatchGetVariableValueAtCell = 0.d0
  4506)     return
  4507)   endif
  4508) 
  4509)   iphase = 1
  4510)   xmass = 1.d0
  4511)   if (associated(patch%aux%Global%auxvars(ghosted_id)%xmass)) &
  4512)     xmass = patch%aux%Global%auxvars(ghosted_id)%xmass(iphase)
  4513)              
  4514)   select case(ivar)
  4515)     case(TEMPERATURE,LIQUID_PRESSURE,GAS_PRESSURE, &
  4516)          LIQUID_SATURATION,GAS_SATURATION,ICE_SATURATION, &
  4517)          LIQUID_MOLE_FRACTION,GAS_MOLE_FRACTION,LIQUID_ENERGY,GAS_ENERGY, &
  4518)          LIQUID_DENSITY,GAS_DENSITY,GAS_DENSITY_MOL,LIQUID_VISCOSITY, &
  4519)          GAS_VISCOSITY,AIR_PRESSURE,CAPILLARY_PRESSURE, &
  4520)          LIQUID_MOBILITY,GAS_MOBILITY,SC_FUGA_COEFF,STATE,ICE_DENSITY, &
  4521)          SECONDARY_TEMPERATURE,LIQUID_DENSITY_MOL,EFFECTIVE_POROSITY, &
  4522)          LIQUID_HEAD,VAPOR_PRESSURE,SATURATION_PRESSURE,MAXIMUM_PRESSURE, &
  4523)          LIQUID_MASS_FRACTION,GAS_MASS_FRACTION, &
  4524)          OIL_PRESSURE,OIL_SATURATION,OIL_DENSITY,OIL_DENSITY_MOL,OIL_ENERGY, &
  4525)          OIL_MOBILITY)
  4526)          
  4527)      if (associated(patch%aux%TH)) then
  4528)         select case(ivar)
  4529)           case(TEMPERATURE)
  4530)             value = patch%aux%Global%auxvars(ghosted_id)%temp
  4531)           case(LIQUID_PRESSURE)
  4532)             value = patch%aux%Global%auxvars(ghosted_id)%pres(1)
  4533)           case(LIQUID_SATURATION)
  4534)             value = patch%aux%Global%auxvars(ghosted_id)%sat(1)
  4535)           case(LIQUID_DENSITY)
  4536)             value = patch%aux%Global%auxvars(ghosted_id)%den_kg(1)
  4537)           case(LIQUID_VISCOSITY)
  4538)             value = patch%aux%TH%auxvars(ghosted_id)%vis
  4539)           case(LIQUID_MOBILITY)
  4540)             value = patch%aux%TH%auxvars(ghosted_id)%kvr
  4541)           case(GAS_MOLE_FRACTION,GAS_ENERGY,GAS_DENSITY) ! still need implementation
  4542)             call printErrMsg(option,'GAS_MOLE_FRACTION not supported by TH')
  4543)           case(GAS_SATURATION)
  4544)             if (option%use_th_freezing) then
  4545)               value = patch%aux%TH%auxvars(ghosted_id)%ice%sat_gas
  4546)             else
  4547)               value = 0.d0
  4548)             endif
  4549)           case(ICE_SATURATION)
  4550)             if (option%use_th_freezing) then
  4551)               value = patch%aux%TH%auxvars(ghosted_id)%ice%sat_ice
  4552)             endif
  4553)           case(ICE_DENSITY)
  4554)             if (option%use_th_freezing) then
  4555)               value = patch%aux%TH%auxvars(ghosted_id)%ice%den_ice*FMWH2O
  4556)             endif
  4557)           case(LIQUID_MOLE_FRACTION)
  4558)             call printErrMsg(option,'LIQUID_MOLE_FRACTION not supported by TH')
  4559)           case(LIQUID_ENERGY)
  4560)             value = patch%aux%TH%auxvars(ghosted_id)%u
  4561)           case(SECONDARY_TEMPERATURE)
  4562)             local_id = grid%nG2L(ghosted_id)
  4563)             value = patch%aux%SC_heat%sec_heat_vars(local_id)%sec_temp(isubvar)
  4564)           case(EFFECTIVE_POROSITY)
  4565)             value = patch%aux%TH%auxvars(ghosted_id)%transient_por
  4566)         end select
  4567)       else if (associated(patch%aux%Richards)) then
  4568)         select case(ivar)
  4569)           case(TEMPERATURE)
  4570)             call printErrMsg(option,'TEMPERATURE not supported by Richards')
  4571)           case(GAS_SATURATION)
  4572)             call printErrMsg(option,'GAS_SATURATION not supported by Richards')
  4573)           case(GAS_DENSITY)
  4574)             call printErrMsg(option,'GAS_DENSITY not supported by Richards')
  4575)           case(LIQUID_MOLE_FRACTION)
  4576)             call printErrMsg(option,'LIQUID_MOLE_FRACTION not supported by Richards')
  4577)           case(GAS_MOLE_FRACTION)
  4578)             call printErrMsg(option,'GAS_MOLE_FRACTION not supported by Richards')
  4579)           case(LIQUID_ENERGY)
  4580)             call printErrMsg(option,'LIQUID_ENERGY not supported by Richards')
  4581)           case(GAS_ENERGY)
  4582)             call printErrMsg(option,'GAS_ENERGY not supported by Richards')
  4583)           case(EFFECTIVE_POROSITY)
  4584)             call printErrMsg(option,'EFFECTIVE_POROSITY not supported by Richards')
  4585)           case(LIQUID_PRESSURE)
  4586)             value = patch%aux%Global%auxvars(ghosted_id)%pres(1)
  4587)           case(LIQUID_HEAD)
  4588)             value = patch%aux%Global%auxvars(ghosted_id)%pres(1)/9.81/ &
  4589)                     patch%aux%Global%auxvars(ghosted_id)%den_kg(1)
  4590)           case(LIQUID_SATURATION)
  4591)             value = patch%aux%Global%auxvars(ghosted_id)%sat(1)
  4592)           case(LIQUID_DENSITY)
  4593)             value = patch%aux%Global%auxvars(ghosted_id)%den_kg(1)
  4594)           case(LIQUID_MOBILITY)
  4595)             value = patch%aux%Richards%auxvars(ghosted_id)%kvr
  4596)         end select
  4597)       else if (associated(patch%aux%Flash2)) then
  4598)         select case(ivar)
  4599)           case(TEMPERATURE)
  4600)             value = patch%aux%Global%auxvars(ghosted_id)%temp
  4601)           case(LIQUID_PRESSURE)
  4602)             value = patch%aux%Global%auxvars(ghosted_id)%pres(1)
  4603)           case(LIQUID_SATURATION)
  4604)             value = patch%aux%Global%auxvars(ghosted_id)%sat(1)
  4605)           case(LIQUID_DENSITY)
  4606)             value = patch%aux%Global%auxvars(ghosted_id)%den_kg(1)
  4607)           case(LIQUID_VISCOSITY)
  4608)             value = patch%aux%Flash2%auxvars(ghosted_id)%auxvar_elem(0)%vis(1)
  4609)           case(LIQUID_MOBILITY)
  4610)             value = patch%aux%Flash2%auxvars(ghosted_id)%auxvar_elem(0)%kvr(1)
  4611)           case(GAS_PRESSURE)
  4612)             value = patch%aux%Global%auxvars(ghosted_id)%pres(2)
  4613)           case(GAS_SATURATION)
  4614)             value = patch%aux%Global%auxvars(ghosted_id)%sat(2)
  4615)           case(GAS_MOLE_FRACTION)
  4616)             value = patch%aux%Flash2%auxvars(ghosted_id)%auxvar_elem(0)%xmol(2+isubvar)
  4617)           case(GAS_ENERGY)
  4618)             value = patch%aux%Flash2%auxvars(ghosted_id)%auxvar_elem(0)%u(2)
  4619)           case(GAS_DENSITY) 
  4620)             value = patch%aux%Global%auxvars(ghosted_id)%den_kg(2)
  4621)           case(GAS_DENSITY_MOL) 
  4622)             value = patch%aux%Global%auxvars(ghosted_id)%den(2)
  4623)           case(GAS_VISCOSITY) 
  4624)             value = patch%aux%Flash2%auxvars(ghosted_id)%auxvar_elem(0)%vis(2)
  4625)           case(GAS_MOBILITY) 
  4626)             value = patch%aux%Flash2%auxvars(ghosted_id)%auxvar_elem(0)%kvr(2)
  4627)           case(SC_FUGA_COEFF)
  4628)             value = patch%aux%Global%auxvars(ghosted_id)%fugacoeff(1)   
  4629)           case(LIQUID_MOLE_FRACTION)
  4630)             value = patch%aux%Flash2%auxvars(ghosted_id)%auxvar_elem(0)%xmol(isubvar)
  4631)           case(LIQUID_ENERGY)
  4632)             value = patch%aux%Flash2%auxvars(ghosted_id)%auxvar_elem(0)%u(1)
  4633)         end select
  4634)       else if (associated(patch%aux%Mphase)) then
  4635)         select case(ivar)
  4636)           case(TEMPERATURE)
  4637)             value = patch%aux%Global%auxvars(ghosted_id)%temp
  4638)           case(LIQUID_PRESSURE)
  4639)             value = patch%aux%Global%auxvars(ghosted_id)%pres(1)
  4640)           case(GAS_PRESSURE)
  4641)             value = patch%aux%Global%auxvars(ghosted_id)%pres(2)
  4642)           case(LIQUID_SATURATION)
  4643)             value = patch%aux%Global%auxvars(ghosted_id)%sat(1)
  4644)           case(LIQUID_MOLE_FRACTION)
  4645)             if (patch%aux%Global%auxvars(ghosted_id)%sat(1) > 0.d0) then
  4646)               value = patch%aux%Mphase%auxvars(ghosted_id)%auxvar_elem(0)%xmol(isubvar)
  4647)             else
  4648)               value = 0.d0
  4649)             endif
  4650)           case(LIQUID_ENERGY)
  4651)             value = patch%aux%Mphase%auxvars(ghosted_id)%auxvar_elem(0)%u(1)
  4652)           case(LIQUID_DENSITY)
  4653)             value = patch%aux%Global%auxvars(ghosted_id)%den_kg(1)
  4654)           case(LIQUID_VISCOSITY)
  4655)             value = patch%aux%Mphase%auxvars(ghosted_id)%auxvar_elem(0)%vis(1)
  4656)           case(LIQUID_MOBILITY)
  4657)             value = patch%aux%Mphase%auxvars(ghosted_id)%auxvar_elem(0)%kvr(1)
  4658)           case(GAS_SATURATION)
  4659)             value = patch%aux%Global%auxvars(ghosted_id)%sat(2)
  4660)           case(GAS_MOLE_FRACTION)
  4661)             if (patch%aux%Global%auxvars(ghosted_id)%sat(2) > 0.d0) then
  4662)               value = patch%aux%Mphase%auxvars(ghosted_id)%auxvar_elem(0)%xmol(2+isubvar)
  4663)             else
  4664)               value = 0.d0
  4665)             endif
  4666)           case(GAS_ENERGY)
  4667)             value = patch%aux%Mphase%auxvars(ghosted_id)%auxvar_elem(0)%u(2)
  4668)           case(GAS_DENSITY) 
  4669)             value = patch%aux%Global%auxvars(ghosted_id)%den_kg(2)
  4670)           case(GAS_VISCOSITY) 
  4671)             value = patch%aux%Mphase%auxvars(ghosted_id)%auxvar_elem(0)%vis(2)
  4672)           case(GAS_MOBILITY) 
  4673)             value = patch%aux%Mphase%auxvars(ghosted_id)%auxvar_elem(0)%kvr(2)
  4674)           case(GAS_DENSITY_MOL) 
  4675)             value = patch%aux%Global%auxvars(ghosted_id)%den(2)
  4676)           case(SC_FUGA_COEFF)
  4677)             value = patch%aux%Global%auxvars(ghosted_id)%fugacoeff(1)   
  4678)           case(SECONDARY_TEMPERATURE)
  4679)             local_id = grid%nG2L(ghosted_id)
  4680)             value = patch%aux%SC_heat%sec_heat_vars(local_id)%sec_temp(isubvar)
  4681)         end select
  4682)       else if (associated(patch%aux%Immis)) then
  4683)         select case(ivar)
  4684)           case(TEMPERATURE)
  4685)             value = patch%aux%Global%auxvars(ghosted_id)%temp
  4686)           case(LIQUID_PRESSURE)
  4687)             value = patch%aux%Global%auxvars(ghosted_id)%pres(1)
  4688)           case(GAS_PRESSURE)
  4689)             value = patch%aux%Global%auxvars(ghosted_id)%pres(2)
  4690)           case(LIQUID_SATURATION)
  4691)             value = patch%aux%Global%auxvars(ghosted_id)%sat(1)
  4692)           case(LIQUID_DENSITY)
  4693)             value = patch%aux%Global%auxvars(ghosted_id)%den_kg(1)
  4694)           case(LIQUID_ENERGY)
  4695)             value = patch%aux%Immis%auxvars(ghosted_id)%auxvar_elem(0)%u(1)
  4696)           case(LIQUID_VISCOSITY)
  4697)             value = patch%aux%Immis%auxvars(ghosted_id)%auxvar_elem(0)%vis(1)
  4698)           case(LIQUID_MOBILITY)
  4699)             value = patch%aux%Immis%auxvars(ghosted_id)%auxvar_elem(0)%kvr(1)
  4700)           case(GAS_SATURATION)
  4701)             value = patch%aux%Global%auxvars(ghosted_id)%sat(2)
  4702)           case(GAS_ENERGY)
  4703)             value = patch%aux%Immis%auxvars(ghosted_id)%auxvar_elem(0)%u(2)
  4704)           case(GAS_DENSITY) 
  4705)             value = patch%aux%Global%auxvars(ghosted_id)%den_kg(2)
  4706)           case(GAS_DENSITY_MOL) 
  4707)             value = patch%aux%Global%auxvars(ghosted_id)%den(2)
  4708)           case(GAS_VISCOSITY)
  4709)             value = patch%aux%Immis%auxvars(ghosted_id)%auxvar_elem(0)%vis(2)
  4710)           case(GAS_MOBILITY)
  4711)             value = patch%aux%Immis%auxvars(ghosted_id)%auxvar_elem(0)%kvr(2)
  4712)         end select
  4713)       else if (associated(patch%aux%Miscible)) then
  4714)         select case(ivar)
  4715) !         case(TEMPERATURE)
  4716) !           value = patch%aux%Global%auxvars(ghosted_id)%temp
  4717)           case(LIQUID_PRESSURE)
  4718)             value = patch%aux%Global%auxvars(ghosted_id)%pres(1)
  4719) !         case(LIQUID_SATURATION)
  4720) !           value = patch%aux%Global%auxvars(ghosted_id)%sat(1)
  4721)           case(LIQUID_DENSITY)
  4722)             value = patch%aux%Global%auxvars(ghosted_id)%den_kg(1)
  4723) !         case(LIQUID_ENERGY)
  4724) !           value = patch%aux%Miscible%auxvars(ghosted_id)%auxvar_elem(0)%u(1)
  4725)           case(LIQUID_VISCOSITY)
  4726)             value = patch%aux%Miscible%auxvars(ghosted_id)%auxvar_elem(0)%vis(1)
  4727) !         case(LIQUID_MOBILITY)
  4728) !           value = patch%aux%Miscible%auxvars(ghosted_id)%auxvar_elem(0)%kvr(1)
  4729)           case(LIQUID_MOLE_FRACTION)
  4730)             value = patch%aux%Miscible%auxvars(ghosted_id)%auxvar_elem(0)%xmol(isubvar)
  4731)         end select
  4732)       else if (associated(patch%aux%General)) then
  4733)         select case(ivar)
  4734)           case(TEMPERATURE)
  4735)             value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)%temp
  4736)           case(MAXIMUM_PRESSURE)
  4737)             value = maxval(patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4738)                            pres(option%liquid_phase:option%gas_phase))
  4739)           case(LIQUID_PRESSURE)
  4740)             if (output_option%filter_non_state_variables) then
  4741)               if (patch%aux%Global%auxvars(ghosted_id)%istate /= GAS_STATE) then
  4742)                 value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4743)                           pres(option%liquid_phase)
  4744)               else
  4745)                 value = 0.d0
  4746)               endif
  4747)             else
  4748)               value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4749)                         pres(option%liquid_phase)
  4750)             endif
  4751)           case(GAS_PRESSURE)
  4752)             if (output_option%filter_non_state_variables) then
  4753)               if (patch%aux%Global%auxvars(ghosted_id)%istate /= &
  4754)                   LIQUID_STATE) then
  4755)                 value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4756)                           pres(option%gas_phase)
  4757)               else
  4758)                 value = 0.d0
  4759)               endif
  4760)             else
  4761)               value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4762)                         pres(option%gas_phase)
  4763)             endif
  4764)           case(AIR_PRESSURE)
  4765)             if (output_option%filter_non_state_variables) then
  4766)               if (patch%aux%Global%auxvars(ghosted_id)%istate /= &
  4767)                   LIQUID_STATE) then
  4768)                 value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4769)                           pres(option%air_pressure_id)
  4770)               else
  4771)                 value = 0.d0
  4772)               endif
  4773)             else
  4774)               value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4775)                         pres(option%air_pressure_id)
  4776)             endif
  4777)           case(CAPILLARY_PRESSURE)
  4778)             value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4779)                       pres(option%capillary_pressure_id)
  4780)           case(VAPOR_PRESSURE)
  4781)             value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4782)                       pres(option%vapor_pressure_id)
  4783)           case(SATURATION_PRESSURE)
  4784)             value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4785)                       pres(option%saturation_pressure_id)
  4786)           case(STATE)
  4787)             value = patch%aux%Global%auxvars(ghosted_id)%istate
  4788)           case(LIQUID_SATURATION)
  4789)             value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4790)                       sat(option%liquid_phase)
  4791)           case(LIQUID_DENSITY)
  4792)             value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4793)                       den_kg(option%liquid_phase)
  4794)           case(LIQUID_DENSITY_MOL)
  4795)             value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4796)                       den(option%liquid_phase)
  4797)           case(LIQUID_ENERGY)
  4798)             if (isubvar == ZERO_INTEGER) then
  4799)               value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4800)                         U(option%liquid_phase)
  4801)             else
  4802)               value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4803)                         U(option%liquid_phase) * &
  4804)                       patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4805)                         den(option%liquid_phase)
  4806)             endif
  4807)           case(LIQUID_MOLE_FRACTION,LIQUID_MASS_FRACTION)
  4808)             value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4809)                       xmol(isubvar,option%liquid_phase)
  4810)             if (ivar == LIQUID_MASS_FRACTION) then
  4811)               tempint = isubvar
  4812)               tempint2 = tempint+1
  4813)               if (tempint2 > 2) tempint2 = 1
  4814)               value = value*fmw_comp(tempint) / &
  4815)                       (value*fmw_comp(tempint) + &
  4816)                        (1.d0-value)*fmw_comp(tempint2))
  4817)             endif                      
  4818)           case(LIQUID_MOBILITY)
  4819)             value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4820)                       mobility(option%liquid_phase)
  4821)           case(GAS_SATURATION)
  4822)             value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4823)                       sat(option%gas_phase)
  4824)           case(GAS_DENSITY) 
  4825)             value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4826)                       den_kg(option%gas_phase)
  4827)           case(GAS_DENSITY_MOL) 
  4828)             value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4829)                       den(option%gas_phase)
  4830)           case(GAS_ENERGY)
  4831)             if (isubvar == ZERO_INTEGER) then
  4832)               value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4833)                         U(option%gas_phase)
  4834)             else
  4835)               value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4836)                         U(option%gas_phase) * &
  4837)                       patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4838)                         den(option%gas_phase)
  4839)             endif
  4840)           case(GAS_MOLE_FRACTION,GAS_MASS_FRACTION)
  4841)             value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4842)                       xmol(isubvar,option%gas_phase)
  4843)             if (ivar == GAS_MASS_FRACTION) then
  4844)               tempint = isubvar
  4845)               tempint2 = tempint+1
  4846)               if (tempint2 > 2) tempint2 = 1
  4847)               value = value*fmw_comp(tempint) / &
  4848)                       (value*fmw_comp(tempint) + &
  4849)                        (1.d0-value)*fmw_comp(tempint2))
  4850)             endif                      
  4851)           case(GAS_MOBILITY)
  4852)             value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4853)                       mobility(option%gas_phase)
  4854)           case(EFFECTIVE_POROSITY)
  4855)             value = patch%aux%General%auxvars(ZERO_INTEGER,ghosted_id)% &
  4856)                       effective_porosity
  4857)         end select    
  4858) 
  4859)       else if (associated(patch%aux%TOil_ims)) then
  4860) 
  4861)         select case(ivar)
  4862)           case(TEMPERATURE)
  4863)             value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)%temp
  4864)           case(MAXIMUM_PRESSURE)
  4865)             value = maxval(patch%aux%TOil_ims%auxvars(ZERO_INTEGER, &
  4866)                ghosted_id)%pres(option%liquid_phase:option%oil_phase))
  4867)           case(LIQUID_PRESSURE)
  4868)             value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4869)                       pres(option%liquid_phase)
  4870)           case(OIL_PRESSURE)
  4871)             value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4872)                       pres(option%oil_phase)
  4873)           case(CAPILLARY_PRESSURE)
  4874)             value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4875)                       pres(option%capillary_pressure_id)
  4876)           case(LIQUID_SATURATION)
  4877)             value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4878)                       sat(option%liquid_phase)
  4879)           case(LIQUID_DENSITY)
  4880)             value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4881)                       den_kg(option%liquid_phase)
  4882)           case(LIQUID_DENSITY_MOL)
  4883)             value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4884)                      den(option%liquid_phase)
  4885)           case(LIQUID_ENERGY)
  4886)             if (isubvar == ZERO_INTEGER) then
  4887)               value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4888)                         U(option%liquid_phase)
  4889)             else
  4890)               value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4891)                       U(option%liquid_phase) * &
  4892)                       patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4893)                       den(option%liquid_phase)
  4894)             end if
  4895)           case(LIQUID_MOBILITY)
  4896)               value = &
  4897)                 patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4898)                   mobility(option%liquid_phase)
  4899)           case(OIL_SATURATION)
  4900)               value = &
  4901)                 patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4902)                   sat(option%oil_phase)
  4903)           case(OIL_ENERGY)
  4904)             if (isubvar == ZERO_INTEGER) then
  4905)               value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4906)                         U(option%oil_phase)
  4907)             else
  4908)               value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4909)                       U(option%oil_phase) * &
  4910)                       patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4911)                       den(option%oil_phase)
  4912)             endif
  4913)           case(OIL_DENSITY) 
  4914)             value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4915)                     den_kg(option%oil_phase)
  4916)           case(OIL_DENSITY_MOL) 
  4917)             value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4918)                     den(option%oil_phase)
  4919)           case(OIL_MOBILITY)
  4920)             value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4921)                     mobility(option%gas_phase)
  4922)           case(EFFECTIVE_POROSITY)
  4923)             value = patch%aux%TOil_ims%auxvars(ZERO_INTEGER,ghosted_id)% &
  4924)                     effective_porosity
  4925)         end select 
  4926)     
  4927)       endif
  4928)       
  4929)     case(PH,PE,EH,O2,PRIMARY_MOLALITY,PRIMARY_MOLARITY,SECONDARY_MOLALITY, &
  4930)          SECONDARY_MOLARITY, TOTAL_MOLALITY,TOTAL_MOLARITY, &
  4931)          MINERAL_VOLUME_FRACTION,MINERAL_RATE,MINERAL_SATURATION_INDEX, &
  4932)          SURFACE_CMPLX,SURFACE_CMPLX_FREE,SURFACE_SITE_DENSITY, &
  4933)          KIN_SURFACE_CMPLX,KIN_SURFACE_CMPLX_FREE, PRIMARY_ACTIVITY_COEF, &
  4934)          SECONDARY_ACTIVITY_COEF,PRIMARY_KD, TOTAL_SORBED, &
  4935)          TOTAL_SORBED_MOBILE,COLLOID_MOBILE,COLLOID_IMMOBILE,AGE,TOTAL_BULK, &
  4936)          IMMOBILE_SPECIES)
  4937)          
  4938)       select case(ivar)
  4939)         case(PH)
  4940)           if (isubvar > 0) then
  4941)             value = -log10(patch%aux%RT%auxvars(ghosted_id)% &
  4942)                            pri_act_coef(isubvar)* &
  4943)                            patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar))
  4944)           else
  4945)             value = -log10(patch%aux%RT%auxvars(ghosted_id)% &
  4946)                            sec_act_coef(-isubvar)* &
  4947)                            patch%aux%RT%auxvars(ghosted_id)%sec_molal(-isubvar))
  4948)           endif
  4949)         case(EH)
  4950)           ph0 = -log10(patch%aux%RT%auxvars(ghosted_id)% &
  4951)                          pri_act_coef(isubvar)* &
  4952)                          patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar))
  4953) 
  4954)           ifo2 = reaction%species_idx%o2_gas_id
  4955)       
  4956)       ! compute gas partial pressure
  4957)           lnQKgas = -reaction%eqgas_logK(ifo2)*LOG_TO_LN
  4958)       
  4959)       ! activity of water
  4960)           if (reaction%eqgash2oid(ifo2) > 0) then
  4961)             lnQKgas = lnQKgas + reaction%eqgash2ostoich(ifo2) * &
  4962)                     patch%aux%RT%auxvars(ghosted_id)%ln_act_h2o
  4963)           endif
  4964)           do jcomp = 1, reaction%eqgasspecid(0,ifo2)
  4965)             comp_id = reaction%eqgasspecid(jcomp,ifo2)
  4966)             lnQKgas = lnQKgas + reaction%eqgasstoich(jcomp,ifo2)* &
  4967)                       log(patch%aux%RT%auxvars(ghosted_id)%pri_molal(comp_id)* &
  4968)                         patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(comp_id))
  4969)           enddo
  4970) 
  4971)           tk = patch%aux%Global%auxvars(ghosted_id)%temp+273.15d0
  4972)           ehfac = IDEAL_GAS_CONSTANT*tk*LOG_TO_LN/faraday
  4973)           eh0 = ehfac*(-4.d0*ph0+lnQKgas*LN_TO_LOG+logKeh(tk))/4.d0
  4974) 
  4975)           value = eh0
  4976) 
  4977)         case(PE)
  4978)           ph0 = -log10(patch%aux%RT%auxvars(ghosted_id)% &
  4979)                          pri_act_coef(isubvar)* &
  4980)                          patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar))
  4981) 
  4982)           ifo2 = reaction%species_idx%o2_gas_id
  4983)       
  4984)       ! compute gas partial pressure
  4985)           lnQKgas = -reaction%eqgas_logK(ifo2)*LOG_TO_LN
  4986)       
  4987)       ! activity of water
  4988)           if (reaction%eqgash2oid(ifo2) > 0) then
  4989)             lnQKgas = lnQKgas + reaction%eqgash2ostoich(ifo2) * &
  4990)                     patch%aux%RT%auxvars(ghosted_id)%ln_act_h2o
  4991)           endif
  4992)           do jcomp = 1, reaction%eqgasspecid(0,ifo2)
  4993)             comp_id = reaction%eqgasspecid(jcomp,ifo2)
  4994)             lnQKgas = lnQKgas + reaction%eqgasstoich(jcomp,ifo2)* &
  4995)                       log(patch%aux%RT%auxvars(ghosted_id)%pri_molal(comp_id)* &
  4996)                         patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(comp_id))
  4997)           enddo
  4998) 
  4999)           tk = patch%aux%Global%auxvars(ghosted_id)%temp+273.15d0
  5000)           ehfac = IDEAL_GAS_CONSTANT*tk*LOG_TO_LN/faraday
  5001)           eh0 = ehfac*(-4.d0*ph0+lnQKgas*LN_TO_LOG+logKeh(tk))/4.d0
  5002)           pe0 = eh0/ehfac
  5003)           value = pe0
  5004) 
  5005)         case(O2)
  5006)       
  5007)       ! compute gas partial pressure
  5008)               ifo2 = reaction%species_idx%o2_gas_id
  5009)               lnQKgas = -reaction%eqgas_logK(ifo2)*LOG_TO_LN
  5010)       
  5011)       ! activity of water
  5012)               if (reaction%eqgash2oid(ifo2) > 0) then
  5013)                 lnQKgas = lnQKgas + reaction%eqgash2ostoich(ifo2) * &
  5014)                     patch%aux%RT%auxvars(ghosted_id)%ln_act_h2o
  5015)               endif
  5016)               do jcomp = 1, reaction%eqgasspecid(0,ifo2)
  5017)                 comp_id = reaction%eqgasspecid(jcomp,ifo2)
  5018)                 lnQKgas = lnQKgas + reaction%eqgasstoich(jcomp,ifo2)* &
  5019)                       log(patch%aux%RT%auxvars(ghosted_id)%pri_molal(comp_id)* &
  5020)                         patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(comp_id))
  5021)               enddo
  5022)            value = lnQKgas * LN_TO_LOG
  5023)         case(PRIMARY_MOLALITY)
  5024)           value = patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar)
  5025)         case(PRIMARY_MOLARITY)
  5026)           value = patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar)*xmass * &
  5027)                   patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase) / 1000.d0
  5028)         case(SECONDARY_MOLALITY)
  5029)           value = patch%aux%RT%auxvars(ghosted_id)%sec_molal(isubvar)
  5030)         case(SECONDARY_MOLARITY)
  5031)           value = patch%aux%RT%auxvars(ghosted_id)%sec_molal(isubvar)*xmass * &
  5032)                   patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase) / 1000.d0
  5033)         case(TOTAL_MOLALITY)
  5034)           value = patch%aux%RT%auxvars(ghosted_id)%total(isubvar,iphase) / &
  5035)                   xmass / &
  5036)                   patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase)*1000.d0
  5037)         case(TOTAL_MOLARITY)
  5038)           value = patch%aux%RT%auxvars(ghosted_id)%total(isubvar,iphase)
  5039)         case(TOTAL_BULK) ! mol/m^3 bulk
  5040)           ! add in total molarity and convert to mol/m^3 bulk
  5041)           value = &
  5042)               patch%aux%RT%auxvars(ghosted_id)%total(isubvar,iphase) * &
  5043)               patch%aux%Material%auxvars(ghosted_id)%porosity * &
  5044)                                                               ! mol/L -> mol/m^3
  5045)               patch%aux%Global%auxvars(ghosted_id)%sat(iphase) * 1.d-3 
  5046)           ! add in total sorbed.  already in mol/m^3 bulk
  5047)           if (patch%reaction%nsorb > 0) then
  5048)             if (patch%reaction%surface_complexation%neqsrfcplxrxn > 0) then
  5049)               value = value + &
  5050)                 patch%aux%RT%auxvars(ghosted_id)%total_sorb_eq(isubvar)
  5051)             endif
  5052)             if (patch%reaction%surface_complexation%nkinmrsrfcplxrxn > 0) then
  5053)               do irxn = 1, patch%reaction%surface_complexation%nkinmrsrfcplxrxn
  5054)                 do irate = 1, &
  5055)                   patch%reaction%surface_complexation%kinmr_nrate(irxn)
  5056)                   value = value + &
  5057)                       patch%aux%RT%auxvars(ghosted_id)% &
  5058)                         kinmr_total_sorb(isubvar,irate,irxn)
  5059)                 enddo
  5060)               enddo            
  5061)             endif
  5062)           endif          
  5063)         case(MINERAL_VOLUME_FRACTION)
  5064)           value = patch%aux%RT%auxvars(ghosted_id)%mnrl_volfrac(isubvar)
  5065)         case(MINERAL_RATE)
  5066)           value = patch%aux%RT%auxvars(ghosted_id)%mnrl_rate(isubvar)
  5067)         case(MINERAL_SATURATION_INDEX)
  5068)           value = RMineralSaturationIndex(isubvar, &
  5069)                                          patch%aux%RT%auxvars(ghosted_id), &
  5070)                                          patch%aux%Global%auxvars(ghosted_id), &
  5071)                                          reaction,option)
  5072)         case(IMMOBILE_SPECIES)
  5073)           value = patch%aux%RT%auxvars(ghosted_id)%immobile(isubvar)
  5074)         case(SURFACE_CMPLX)
  5075)           if (associated(patch%aux%RT%auxvars(ghosted_id)%eqsrfcplx_conc)) then
  5076)             value = patch%aux%RT%auxvars(ghosted_id)%eqsrfcplx_conc(isubvar)
  5077)           else
  5078)             value = UNINITIALIZED_DOUBLE
  5079)           endif
  5080)         case(SURFACE_CMPLX_FREE)
  5081)           value = &
  5082)             patch%aux%RT%auxvars(ghosted_id)%srfcplxrxn_free_site_conc(isubvar)
  5083)         case(SURFACE_SITE_DENSITY)
  5084)           select case(reaction%surface_complexation% &
  5085)                         srfcplxrxn_surf_type(isubvar))
  5086)             case(ROCK_SURFACE)
  5087)               value = reaction%surface_complexation% &
  5088)                         srfcplxrxn_site_density(isubvar)* &
  5089)                       material_auxvars(ghosted_id)%soil_particle_density * &
  5090)                       (1.d0-material_auxvars(ghosted_id)%porosity)
  5091)             case(MINERAL_SURFACE)
  5092)               value = reaction%surface_complexation% &
  5093)                         srfcplxrxn_site_density(isubvar)* &
  5094)                       patch%aux%RT%auxvars(ghosted_id)% &
  5095)                         mnrl_volfrac(reaction%surface_complexation% &
  5096)                                        srfcplxrxn_to_surf(isubvar))
  5097)             case(COLLOID_SURFACE)
  5098)                 option%io_buffer = 'Printing of surface site density for ' // &
  5099)                   'colloidal surfaces not implemented.'
  5100)                 call printErrMsg(option)
  5101)             case(NULL_SURFACE)
  5102)               value = reaction%surface_complexation% &
  5103)                         srfcplxrxn_site_density(isubvar)
  5104)           end select
  5105)         case(KIN_SURFACE_CMPLX)
  5106)           value = patch%aux%RT%auxvars(ghosted_id)%kinsrfcplx_conc(isubvar,1)
  5107)         case(KIN_SURFACE_CMPLX_FREE)
  5108)           value = &
  5109)             patch%aux%RT%auxvars(ghosted_id)%kinsrfcplx_free_site_conc(isubvar)
  5110)         case(PRIMARY_ACTIVITY_COEF)
  5111)           value = patch%aux%RT%auxvars(ghosted_id)%pri_act_coef(isubvar)
  5112)         case(SECONDARY_ACTIVITY_COEF)
  5113)           value = patch%aux%RT%auxvars(ghosted_id)%sec_act_coef(isubvar)
  5114)         case(PRIMARY_KD)
  5115)           call ReactionComputeKd(isubvar,value, &
  5116)                                  patch%aux%RT%auxvars(ghosted_id), &
  5117)                                  patch%aux%Global%auxvars(ghosted_id), &
  5118)                                  material_auxvars(ghosted_id), &
  5119)                                  patch%reaction,option)
  5120)         case(TOTAL_SORBED)
  5121)           if (patch%reaction%nsorb > 0) then
  5122)             if (patch%reaction%neqsorb > 0) then
  5123)               value = patch%aux%RT%auxvars(ghosted_id)%total_sorb_eq(isubvar)
  5124)             endif
  5125)             if (patch%reaction%surface_complexation%nkinmrsrfcplxrxn > 0) then
  5126)               value = 0.d0
  5127)               do irxn = 1, patch%reaction%surface_complexation%nkinmrsrfcplxrxn
  5128)                 do irate = 1, &
  5129)                   patch%reaction%surface_complexation%kinmr_nrate(irxn)
  5130)                   value = value + &
  5131)                     patch%aux%RT%auxvars(ghosted_id)% &
  5132)                       kinmr_total_sorb(isubvar,irate,irxn)
  5133)                 enddo
  5134)               enddo            
  5135)             endif
  5136)           endif          
  5137)         case(TOTAL_SORBED_MOBILE)
  5138)           if (patch%reaction%nsorb > 0 .and. patch%reaction%ncollcomp > 0) then
  5139)             value = &
  5140)               patch%aux%RT%auxvars(ghosted_id)%colloid%total_eq_mob(isubvar)
  5141)           endif
  5142)         case(COLLOID_MOBILE)
  5143)           if (patch%reaction%print_tot_conc_type == TOTAL_MOLALITY) then
  5144)             value = patch%aux%RT%auxvars(ghosted_id)% &
  5145)                       colloid%conc_mob(isubvar) / &
  5146)                     patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase)*1000.d0
  5147)           else
  5148)             value = patch%aux%RT%auxvars(ghosted_id)%colloid%conc_mob(isubvar)
  5149)           endif
  5150)         case(COLLOID_IMMOBILE)
  5151)           if (patch%reaction%print_tot_conc_type == TOTAL_MOLALITY) then
  5152)             value = patch%aux%RT%auxvars(ghosted_id)% &
  5153)                       colloid%conc_imb(isubvar) / &
  5154)                     patch%aux%Global%auxvars(ghosted_id)%den_kg(iphase)*1000.d0
  5155)           else
  5156)             value = patch%aux%RT%auxvars(ghosted_id)%colloid%conc_imb(isubvar)
  5157)           endif
  5158)         case(AGE)
  5159)           if (patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) > &
  5160)               0.d0) then
  5161)             value = patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) / &
  5162)             patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar1) / &
  5163)             output_option%tconv
  5164)           endif
  5165)       end select
  5166)     case(POROSITY,MINERAL_POROSITY,PERMEABILITY,PERMEABILITY_X, &
  5167)          PERMEABILITY_Y, PERMEABILITY_Z,PERMEABILITY_XY,PERMEABILITY_XZ, &
  5168)          PERMEABILITY_YZ,VOLUME,TORTUOSITY,SOIL_COMPRESSIBILITY, &
  5169)          SOIL_REFERENCE_PRESSURE)
  5170)       ivar_temp = ivar
  5171)       if (ivar_temp == PERMEABILITY) ivar_temp = PERMEABILITY_X 
  5172)       value = MaterialAuxVarGetValue(material_auxvars(ghosted_id),ivar_temp)
  5173)     case(PHASE)
  5174)       call VecGetArrayF90(field%iphas_loc,vec_ptr2,ierr);CHKERRQ(ierr)
  5175)       value = vec_ptr2(ghosted_id)
  5176)       call VecRestoreArrayF90(field%iphas_loc,vec_ptr2,ierr);CHKERRQ(ierr)
  5177)     case(MATERIAL_ID)
  5178)       value = patch%imat_internal_to_external(iabs(patch%imat(ghosted_id)))
  5179)     case(PROCESS_ID)
  5180)       value = option%myrank
  5181)     ! Need to fix the below two cases (they assume only one component) -- SK 02/06/13  
  5182)     case(SECONDARY_CONCENTRATION)
  5183)       ! Note that the units are in mol/kg
  5184)       local_id = grid%nG2L(ghosted_id)
  5185)       value = patch%aux%SC_RT%sec_transport_vars(local_id)% &
  5186)               sec_rt_auxvar(isubvar)%pri_molal(isubvar1)
  5187)     case(SEC_MIN_VOLFRAC)
  5188)       local_id = grid%nG2L(ghosted_id)        
  5189)       value = patch%aux%SC_RT%sec_transport_vars(local_id)% &
  5190)               sec_rt_auxvar(isubvar)%mnrl_volfrac(isubvar1)
  5191)     case(SEC_MIN_RATE)
  5192)       local_id = grid%nG2L(ghosted_id)        
  5193)       value = patch%aux%SC_RT%sec_transport_vars(local_id)% &
  5194)               sec_rt_auxvar(isubvar)%mnrl_rate(isubvar1)
  5195)     case(SEC_MIN_SI)
  5196)       local_id = grid%nG2L(ghosted_id)  
  5197)       value = RMineralSaturationIndex(isubvar1,&
  5198)                                       patch%aux%SC_RT% &
  5199)                                       sec_transport_vars(local_id)% &
  5200)                                       sec_rt_auxvar(isubvar), &
  5201)                                       patch%aux%Global%auxvars(ghosted_id),&
  5202)                                       reaction,option)      
  5203)     case(RESIDUAL)
  5204)       local_id = grid%nG2L(ghosted_id)
  5205)       call VecGetArrayF90(field%flow_r,vec_ptr2,ierr);CHKERRQ(ierr)
  5206)       value = vec_ptr2((local_id-1)*option%nflowdof+isubvar)
  5207)       call VecRestoreArrayF90(field%flow_r,vec_ptr2,ierr);CHKERRQ(ierr)
  5208)     case default
  5209)       write(option%io_buffer, &
  5210)             '(''IVAR ('',i3,'') not found in PatchGetVariableValueAtCell'')') &
  5211)             ivar
  5212)       call printErrMsg(option)
  5213)   end select
  5214) 
  5215)   PatchGetVariableValueAtCell = value
  5216)  
  5217) end function PatchGetVariableValueAtCell
  5218) 
  5219) ! ************************************************************************** !
  5220) 
  5221) subroutine PatchSetVariable(patch,field,option,vec,vec_format,ivar,isubvar)
  5222)   ! 
  5223)   ! Sets variables indexed by ivar and isubvar within a patch
  5224)   ! 
  5225)   ! Author: Glenn Hammond
  5226)   ! Date: 09/12/08
  5227)   ! 
  5228) 
  5229)   use Grid_module
  5230)   use Option_module
  5231)   use Field_module
  5232)   use Variables_module
  5233)   use General_Aux_module  
  5234)   use Material_Aux_class
  5235) 
  5236)   implicit none
  5237) 
  5238) #include "petsc/finclude/petscvec.h"
  5239) #include "petsc/finclude/petscvec.h90"
  5240) 
  5241)   type(option_type), pointer :: option
  5242)   type(field_type), pointer :: field
  5243)   type(patch_type), pointer :: patch  
  5244)   Vec :: vec
  5245)   PetscInt :: vec_format
  5246)   PetscInt :: ivar
  5247)   PetscInt :: isubvar
  5248)   PetscInt :: iphase, istate
  5249) 
  5250)   PetscInt :: local_id, ghosted_id
  5251)   type(grid_type), pointer :: grid
  5252)   class(material_auxvar_type), pointer :: material_auxvars(:)
  5253)   PetscReal, pointer :: vec_ptr(:), vec_ptr2(:)
  5254)   PetscErrorCode :: ierr
  5255) 
  5256)   grid => patch%grid
  5257)   material_auxvars => patch%aux%Material%auxvars
  5258)   
  5259)   call VecGetArrayF90(vec,vec_ptr,ierr);CHKERRQ(ierr)
  5260) 
  5261)   if (vec_format == NATURAL) then
  5262)     call printErrMsg(option,&
  5263)                      'NATURAL vector format not supported by PatchSetVariable')
  5264)   endif
  5265) 
  5266)   iphase = 1
  5267)   select case(ivar)
  5268)     case(TEMPERATURE,LIQUID_PRESSURE,GAS_PRESSURE,LIQUID_SATURATION, &
  5269)          GAS_SATURATION,AIR_PRESSURE,CAPILLARY_PRESSURE, &
  5270)          LIQUID_MOLE_FRACTION,GAS_MOLE_FRACTION,LIQUID_ENERGY,GAS_ENERGY, &
  5271)          LIQUID_DENSITY,GAS_DENSITY,GAS_DENSITY_MOL,LIQUID_VISCOSITY, &
  5272)          GAS_VISCOSITY, &
  5273)          LIQUID_MOBILITY,GAS_MOBILITY,STATE)
  5274)          
  5275)       if (associated(patch%aux%TH)) then
  5276)         select case(ivar)
  5277)           case(TEMPERATURE)
  5278)             if (vec_format == GLOBAL) then
  5279)               do local_id=1,grid%nlmax
  5280)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%temp = &
  5281)                   vec_ptr(local_id)
  5282)               enddo
  5283)             else if (vec_format == LOCAL) then
  5284)               do ghosted_id=1,grid%ngmax
  5285)                 patch%aux%Global%auxvars(ghosted_id)%temp = vec_ptr(ghosted_id)
  5286)               enddo
  5287)             endif
  5288)           case(LIQUID_PRESSURE)
  5289)             if (vec_format == GLOBAL) then
  5290)               do local_id=1,grid%nlmax
  5291)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%pres = &
  5292)                   vec_ptr(local_id)
  5293)               enddo
  5294)             else if (vec_format == LOCAL) then
  5295)               do ghosted_id=1,grid%ngmax
  5296)                 patch%aux%Global%auxvars(ghosted_id)%pres = vec_ptr(ghosted_id)
  5297)               enddo
  5298)             endif
  5299)           case(LIQUID_SATURATION)
  5300)             if (vec_format == GLOBAL) then
  5301)               do local_id=1,grid%nlmax
  5302)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%sat = &
  5303)                   vec_ptr(local_id)
  5304)               enddo
  5305)             else if (vec_format == LOCAL) then
  5306)               do ghosted_id=1,grid%ngmax
  5307)                 patch%aux%Global%auxvars(ghosted_id)%sat = vec_ptr(ghosted_id)
  5308)               enddo
  5309)             endif
  5310)           case(LIQUID_DENSITY)
  5311)             if (vec_format == GLOBAL) then
  5312)               do local_id=1,grid%nlmax
  5313)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%den_kg = &
  5314)                   vec_ptr(local_id)
  5315)               enddo
  5316)             else if (vec_format == LOCAL) then
  5317)               do ghosted_id=1,grid%ngmax
  5318)                 patch%aux%Global%auxvars(ghosted_id)%den_kg = &
  5319)                   vec_ptr(ghosted_id)
  5320)               enddo
  5321)             endif
  5322)           case(GAS_MOLE_FRACTION,GAS_ENERGY,GAS_DENSITY) 
  5323)             call printErrMsg(option,'GAS_MOLE_FRACTION not supported by TH')
  5324)           case(GAS_SATURATION)
  5325)             if (option%use_th_freezing) then
  5326)               if (vec_format == GLOBAL) then
  5327)                 do local_id=1,grid%nlmax
  5328)                   patch%aux%TH%auxvars(grid%nL2G(local_id))%ice%sat_gas = &
  5329)                     vec_ptr(local_id)
  5330)                 enddo
  5331)               else if (vec_format == LOCAL) then
  5332)                 do ghosted_id=1,grid%ngmax
  5333)                   patch%aux%TH%auxvars(ghosted_id)%ice%sat_gas = vec_ptr(ghosted_id)
  5334)                 enddo
  5335)               endif
  5336)             endif
  5337)           case(ICE_SATURATION)
  5338)             if (option%use_th_freezing) then
  5339)               if (vec_format == GLOBAL) then
  5340)                 do local_id=1,grid%nlmax
  5341)                   patch%aux%TH%auxvars(grid%nL2G(local_id))%ice%sat_ice = &
  5342)                     vec_ptr(local_id)
  5343)                 enddo
  5344)               else if (vec_format == LOCAL) then
  5345)                 do ghosted_id=1,grid%ngmax
  5346)                   patch%aux%TH%auxvars(ghosted_id)%ice%sat_ice = vec_ptr(ghosted_id)
  5347)                 enddo
  5348)               endif
  5349)             endif
  5350)           case(ICE_DENSITY)
  5351)             if (option%use_th_freezing) then
  5352)               if (vec_format == GLOBAL) then
  5353)                 do local_id=1,grid%nlmax
  5354)                   patch%aux%TH%auxvars(grid%nL2G(local_id))%ice%den_ice = &
  5355)                     vec_ptr(local_id)
  5356)                 enddo
  5357)               else if (vec_format == LOCAL) then
  5358)                 do ghosted_id=1,grid%ngmax
  5359)                   patch%aux%TH%auxvars(ghosted_id)%ice%den_ice = vec_ptr(ghosted_id)
  5360)                 enddo
  5361)               endif
  5362)             endif
  5363)           case(LIQUID_VISCOSITY)
  5364)           case(GAS_VISCOSITY)
  5365)           case(LIQUID_MOLE_FRACTION)
  5366)             call printErrMsg(option,'LIQUID_MOLE_FRACTION not supported by TH')
  5367)           case(LIQUID_ENERGY)
  5368)             if (vec_format == GLOBAL) then
  5369)               do local_id=1,grid%nlmax
  5370)                 patch%aux%TH%auxvars(grid%nL2G(local_id))%u = vec_ptr(local_id)
  5371)               enddo
  5372)             else if (vec_format == LOCAL) then
  5373)               do ghosted_id=1,grid%ngmax
  5374)                 patch%aux%TH%auxvars(ghosted_id)%u = vec_ptr(ghosted_id)
  5375)               enddo
  5376)             endif
  5377)         end select
  5378)       else if (associated(patch%aux%Richards)) then
  5379)         select case(ivar)
  5380)           case(TEMPERATURE)
  5381)             call printErrMsg(option,'TEMPERATURE not supported by Richards')
  5382)           case(GAS_SATURATION)
  5383)             call printErrMsg(option,'GAS_SATURATION not supported by Richards')
  5384)           case(GAS_DENSITY)
  5385)             call printErrMsg(option,'GAS_DENSITY not supported by Richards')
  5386)           case(LIQUID_MOLE_FRACTION)
  5387)             call printErrMsg(option,'LIQUID_MOLE_FRACTION not supported by Richards')
  5388)           case(GAS_MOLE_FRACTION)
  5389)             call printErrMsg(option,'GAS_MOLE_FRACTION not supported by Richards')
  5390)           case(LIQUID_VISCOSITY)
  5391)             call printErrMsg(option,'LIQUID_VISCOSITY not supported by Richards')
  5392)           case(GAS_VISCOSITY)
  5393)             call printErrMsg(option,'GAS_VISCOSITY not supported by Richards')
  5394)           case(GAS_MOBILITY)
  5395)             call printErrMsg(option,'GAS_MOBILITY not supported by Richards')
  5396)           case(LIQUID_ENERGY)
  5397)             call printErrMsg(option,'LIQUID_ENERGY not supported by Richards')
  5398)           case(GAS_ENERGY)
  5399)             call printErrMsg(option,'GAS_ENERGY not supported by Richards')
  5400)           case(LIQUID_PRESSURE)
  5401)             if (vec_format == GLOBAL) then
  5402)               do local_id=1,grid%nlmax
  5403)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%pres(1) = &
  5404)                   vec_ptr(local_id)
  5405)               enddo
  5406)             else if (vec_format == LOCAL) then
  5407)               do ghosted_id=1,grid%ngmax
  5408)                 patch%aux%Global%auxvars(ghosted_id)%pres(1) = &
  5409)                   vec_ptr(ghosted_id)
  5410)               enddo
  5411)             endif
  5412)           case(LIQUID_SATURATION)
  5413)             if (vec_format == GLOBAL) then
  5414)               do local_id=1,grid%nlmax
  5415)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%sat(1) = &
  5416)                   vec_ptr(local_id)
  5417)               enddo
  5418)             else if (vec_format == LOCAL) then
  5419)               do ghosted_id=1,grid%ngmax
  5420)                 patch%aux%Global%auxvars(ghosted_id)%sat(1) = &
  5421)                   vec_ptr(ghosted_id)
  5422)               enddo
  5423)             endif
  5424)           case(LIQUID_DENSITY)
  5425)             if (vec_format == GLOBAL) then
  5426)               do local_id=1,grid%nlmax
  5427)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%den_kg(1) = &
  5428)                   vec_ptr(local_id)
  5429)               enddo
  5430)             else if (vec_format == LOCAL) then
  5431)               do ghosted_id=1,grid%ngmax
  5432)                 patch%aux%Global%auxvars(ghosted_id)%den_kg(1) = &
  5433)                   vec_ptr(ghosted_id)
  5434)               enddo
  5435)             endif
  5436)           case(LIQUID_MOBILITY)
  5437)             if (vec_format == GLOBAL) then
  5438)               do local_id=1,grid%nlmax
  5439)                 patch%aux%Richards%auxvars(grid%nL2G(local_id))%kvr = &
  5440)                   vec_ptr(local_id)
  5441)               enddo
  5442)             else if (vec_format == LOCAL) then
  5443)               do ghosted_id=1,grid%ngmax
  5444)                 patch%aux%Richards%auxvars(ghosted_id)%kvr = vec_ptr(ghosted_id)
  5445)               enddo
  5446)             endif
  5447)         end select
  5448)       else if (associated(patch%aux%Flash2)) then
  5449)         select case(ivar)
  5450)           case(TEMPERATURE)
  5451)             if (vec_format == GLOBAL) then
  5452)               do local_id=1,grid%nlmax
  5453)                 patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
  5454)                   auxvar_elem(0)%temp = vec_ptr(local_id)
  5455)               enddo
  5456)             else if (vec_format == LOCAL) then
  5457)               do ghosted_id=1,grid%ngmax
  5458)                 patch%aux%Flash2%auxvars(ghosted_id)% &
  5459)                   auxvar_elem(0)%temp = vec_ptr(ghosted_id)
  5460)               enddo
  5461)             endif
  5462)           case(LIQUID_PRESSURE)
  5463)             if (vec_format == GLOBAL) then
  5464)               do local_id=1,grid%nlmax
  5465)                 patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
  5466)                   auxvar_elem(0)%pres = vec_ptr(local_id)
  5467)               enddo
  5468)             else if (vec_format == LOCAL) then
  5469)               do ghosted_id=1,grid%ngmax
  5470)                 patch%aux%Flash2%auxvars(ghosted_id)% &
  5471)                   auxvar_elem(0)%pres = vec_ptr(ghosted_id)
  5472)               enddo
  5473)             endif
  5474)           case(LIQUID_SATURATION)
  5475)             if (vec_format == GLOBAL) then
  5476)               do local_id=1,grid%nlmax
  5477)                 patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
  5478)                   auxvar_elem(0)%sat(1) = vec_ptr(local_id)
  5479)               enddo
  5480)             else if (vec_format == LOCAL) then
  5481)               do ghosted_id=1,grid%ngmax
  5482)                 patch%aux%Flash2%auxvars(ghosted_id)% &
  5483)                   auxvar_elem(0)%sat(1) = vec_ptr(ghosted_id)
  5484)               enddo
  5485)             endif
  5486)           case(LIQUID_DENSITY)
  5487)             if (vec_format == GLOBAL) then
  5488)               do local_id=1,grid%nlmax
  5489)                 patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
  5490)                   auxvar_elem(0)%den(1) = vec_ptr(local_id)
  5491)               enddo
  5492)             else if (vec_format == LOCAL) then
  5493)               do ghosted_id=1,grid%ngmax
  5494)                 patch%aux%Flash2%auxvars(ghosted_id)% &
  5495)                   auxvar_elem(0)%den(1) = vec_ptr(ghosted_id)
  5496)               enddo
  5497)             endif
  5498)           case(LIQUID_VISCOSITY)
  5499)             if (vec_format == GLOBAL) then
  5500)               do local_id=1,grid%nlmax
  5501)                 patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
  5502)                   auxvar_elem(0)%vis(1) = vec_ptr(local_id)
  5503)               enddo
  5504)             else if (vec_format == LOCAL) then
  5505)               do ghosted_id=1,grid%ngmax
  5506)                 patch%aux%Flash2%auxvars(ghosted_id)% &
  5507)                   auxvar_elem(0)%vis(1) = vec_ptr(ghosted_id)
  5508)               enddo
  5509)             endif
  5510)           case(LIQUID_MOBILITY)
  5511)             if (vec_format == GLOBAL) then
  5512)               do local_id=1,grid%nlmax
  5513)                 patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
  5514)                   auxvar_elem(0)%kvr(1) = vec_ptr(local_id)
  5515)               enddo
  5516)             else if (vec_format == LOCAL) then
  5517)               do ghosted_id=1,grid%ngmax
  5518)                 patch%aux%Flash2%auxvars(ghosted_id)% &
  5519)                   auxvar_elem(0)%kvr(1) = vec_ptr(ghosted_id)
  5520)               enddo
  5521)             endif
  5522)           case(GAS_SATURATION)
  5523)             if (vec_format == GLOBAL) then
  5524)               do local_id=1,grid%nlmax
  5525)                 patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
  5526)                   auxvar_elem(0)%sat(2) = vec_ptr(local_id)
  5527)               enddo
  5528)             else if (vec_format == LOCAL) then
  5529)               do ghosted_id=1,grid%ngmax
  5530)                 patch%aux%Flash2%auxvars(ghosted_id)% &
  5531)                   auxvar_elem(0)%sat(2) = vec_ptr(ghosted_id)
  5532)               enddo
  5533)             endif
  5534)           case(GAS_MOLE_FRACTION)
  5535)             if (vec_format == GLOBAL) then
  5536)               do local_id=1,grid%nlmax
  5537)                 patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
  5538)                   auxvar_elem(0)%xmol(2+isubvar) = vec_ptr(local_id)
  5539)               enddo
  5540)             else if (vec_format == LOCAL) then
  5541)               do ghosted_id=1,grid%ngmax
  5542)                 patch%aux%Flash2%auxvars(ghosted_id)% &
  5543)                   auxvar_elem(0)%xmol(2+isubvar) = vec_ptr(ghosted_id)
  5544)               enddo
  5545)             endif
  5546)           case(GAS_ENERGY)
  5547)             if (vec_format == GLOBAL) then
  5548)               do local_id=1,grid%nlmax
  5549)                 patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
  5550)                   auxvar_elem(0)%u(2) = vec_ptr(local_id)
  5551)               enddo
  5552)             else if (vec_format == LOCAL) then
  5553)               do ghosted_id=1,grid%ngmax
  5554)                 patch%aux%Flash2%auxvars(ghosted_id)% &
  5555)                   auxvar_elem(0)%u(2) = vec_ptr(ghosted_id)
  5556)               enddo
  5557)             endif
  5558)           case(GAS_DENSITY, GAS_DENSITY_MOL) 
  5559)             if (vec_format == GLOBAL) then
  5560)               do local_id=1,grid%nlmax
  5561)                 patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
  5562)                   auxvar_elem(0)%den(2) = vec_ptr(local_id)
  5563)               enddo
  5564)             else if (vec_format == LOCAL) then
  5565)               do ghosted_id=1,grid%ngmax
  5566)                 patch%aux%Flash2%auxvars(ghosted_id)% &
  5567)                   auxvar_elem(0)%den(2) = vec_ptr(ghosted_id)
  5568)               enddo
  5569)             endif
  5570)           case(GAS_VISCOSITY) 
  5571)             if (vec_format == GLOBAL) then
  5572)               do local_id=1,grid%nlmax
  5573)                 patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
  5574)                   auxvar_elem(0)%vis(2) = vec_ptr(local_id)
  5575)               enddo
  5576)             else if (vec_format == LOCAL) then
  5577)               do ghosted_id=1,grid%ngmax
  5578)                 patch%aux%Flash2%auxvars(ghosted_id)% &
  5579)                   auxvar_elem(0)%vis(2) = vec_ptr(ghosted_id)
  5580)               enddo
  5581)             endif
  5582)           case(GAS_MOBILITY) 
  5583)             if (vec_format == GLOBAL) then
  5584)               do local_id=1,grid%nlmax
  5585)                 patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
  5586)                   auxvar_elem(0)%kvr(2) = vec_ptr(local_id)
  5587)               enddo
  5588)             else if (vec_format == LOCAL) then
  5589)               do ghosted_id=1,grid%ngmax
  5590)                 patch%aux%Flash2%auxvars(ghosted_id)% &
  5591)                   auxvar_elem(0)%kvr(2) = vec_ptr(ghosted_id)
  5592)               enddo
  5593)             endif
  5594)           case(LIQUID_MOLE_FRACTION)
  5595)             if (vec_format == GLOBAL) then
  5596)               do local_id=1,grid%nlmax
  5597)                 patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
  5598)                   auxvar_elem(0)%xmol(isubvar) = vec_ptr(local_id)
  5599)               enddo
  5600)             else if (vec_format == LOCAL) then
  5601)               do ghosted_id=1,grid%ngmax
  5602)                 patch%aux%Flash2%auxvars(ghosted_id)% &
  5603)                   auxvar_elem(0)%xmol(isubvar) = vec_ptr(ghosted_id)
  5604)               enddo
  5605)             endif
  5606)           case(LIQUID_ENERGY)
  5607)             if (vec_format == GLOBAL) then
  5608)               do local_id=1,grid%nlmax
  5609)                 patch%aux%Flash2%auxvars(grid%nL2G(local_id))% &
  5610)                   auxvar_elem(0)%u(1) = vec_ptr(local_id)
  5611)               enddo
  5612)             else if (vec_format == LOCAL) then
  5613)               do ghosted_id=1,grid%ngmax
  5614)                 patch%aux%Flash2%auxvars(ghosted_id)% &
  5615)                   auxvar_elem(0)%u(1) = vec_ptr(ghosted_id)
  5616)               enddo
  5617)             endif
  5618)         end select
  5619)       else if (associated(patch%aux%Mphase)) then
  5620)         select case(ivar)
  5621)           case(TEMPERATURE)
  5622)             if (vec_format == GLOBAL) then
  5623)               do local_id=1,grid%nlmax
  5624)                 patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
  5625)                   auxvar_elem(0)%temp = vec_ptr(local_id)
  5626)               enddo
  5627)             else if (vec_format == LOCAL) then
  5628)               do ghosted_id=1,grid%ngmax
  5629)                 patch%aux%Mphase%auxvars(ghosted_id)% &
  5630)                   auxvar_elem(0)%temp = vec_ptr(ghosted_id)
  5631)               enddo
  5632)             endif
  5633)           case(LIQUID_PRESSURE)
  5634)             if (vec_format == GLOBAL) then
  5635)               do local_id=1,grid%nlmax
  5636)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%pres(1) = &
  5637)                   vec_ptr(local_id)
  5638)               enddo
  5639)             else if (vec_format == LOCAL) then
  5640)               do ghosted_id=1,grid%ngmax
  5641)                 patch%aux%Global%auxvars(ghosted_id)%pres(1) = &
  5642)                   vec_ptr(ghosted_id)
  5643)               enddo
  5644)             endif
  5645)           case(GAS_PRESSURE)
  5646)             if (vec_format == GLOBAL) then
  5647)               do local_id=1,grid%nlmax
  5648)                 patch%aux%Global%auxvars(grid%nL2G(local_id))%pres(2) = &
  5649)                   vec_ptr(local_id)
  5650)               enddo
  5651)             else if (vec_format == LOCAL) then
  5652)               do ghosted_id=1,grid%ngmax
  5653)                 patch%aux%Global%auxvars(ghosted_id)%pres(2) = &
  5654)                   vec_ptr(ghosted_id)
  5655)               enddo
  5656)             endif
  5657)           case(LIQUID_SATURATION)
  5658)             if (vec_format == GLOBAL) then
  5659)               do local_id=1,grid%nlmax
  5660)                 patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
  5661)                   auxvar_elem(0)%sat(1) = vec_ptr(local_id)
  5662)               enddo
  5663)             else if (vec_format == LOCAL) then
  5664)               do ghosted_id=1,grid%ngmax
  5665)                 patch%aux%Mphase%auxvars(ghosted_id)% &
  5666)                   auxvar_elem(0)%sat(1) = vec_ptr(ghosted_id)
  5667)               enddo
  5668)             endif
  5669)           case(LIQUID_DENSITY)
  5670)             if (vec_format == GLOBAL) then
  5671)               do local_id=1,grid%nlmax
  5672)                 patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
  5673)                   auxvar_elem(0)%den(1) = vec_ptr(local_id)
  5674)               enddo
  5675)             else if (vec_format == LOCAL) then
  5676)               do ghosted_id=1,grid%ngmax
  5677)                 patch%aux%Mphase%auxvars(ghosted_id)% &
  5678)                   auxvar_elem(0)%den(1) = vec_ptr(ghosted_id)
  5679)               enddo
  5680)             endif
  5681)           case(LIQUID_VISCOSITY)
  5682)             if (vec_format == GLOBAL) then
  5683)               do local_id=1,grid%nlmax
  5684)                 patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
  5685)                   auxvar_elem(0)%vis(1) = vec_ptr(local_id)
  5686)               enddo
  5687)             else if (vec_format == LOCAL) then
  5688)               do ghosted_id=1,grid%ngmax
  5689)                 patch%aux%Mphase%auxvars(ghosted_id)% &
  5690)                   auxvar_elem(0)%vis(1) = vec_ptr(ghosted_id)
  5691)               enddo
  5692)             endif
  5693)           case(LIQUID_MOBILITY)
  5694)             if (vec_format == GLOBAL) then
  5695)               do local_id=1,grid%nlmax
  5696)                 patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
  5697)                   auxvar_elem(0)%kvr(1) = vec_ptr(local_id)
  5698)               enddo
  5699)             else if (vec_format == LOCAL) then
  5700)               do ghosted_id=1,grid%ngmax
  5701)                 patch%aux%Mphase%auxvars(ghosted_id)% &
  5702)                   auxvar_elem(0)%kvr(1) = vec_ptr(ghosted_id)
  5703)               enddo
  5704)             endif
  5705)           case(GAS_SATURATION)
  5706)             if (vec_format == GLOBAL) then
  5707)               do local_id=1,grid%nlmax
  5708)                 patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
  5709)                   auxvar_elem(0)%sat(2) = vec_ptr(local_id)
  5710)               enddo
  5711)             else if (vec_format == LOCAL) then
  5712)               do ghosted_id=1,grid%ngmax
  5713)                 patch%aux%Mphase%auxvars(ghosted_id)% &
  5714)                   auxvar_elem(0)%sat(2) = vec_ptr(ghosted_id)
  5715)               enddo
  5716)             endif
  5717)           case(GAS_MOLE_FRACTION)
  5718)             if (vec_format == GLOBAL) then
  5719)               do local_id=1,grid%nlmax
  5720)                 patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
  5721)                   auxvar_elem(0)%xmol(2+isubvar) = vec_ptr(local_id)
  5722)               enddo
  5723)             else if (vec_format == LOCAL) then
  5724)               do ghosted_id=1,grid%ngmax
  5725)                 patch%aux%Mphase%auxvars(ghosted_id)% &
  5726)                   auxvar_elem(0)%xmol(2+isubvar) = vec_ptr(ghosted_id)
  5727)               enddo
  5728)             endif
  5729)           case(GAS_ENERGY)
  5730)             if (vec_format == GLOBAL) then
  5731)               do local_id=1,grid%nlmax
  5732)                 patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
  5733)                   auxvar_elem(0)%u(2) = vec_ptr(local_id)
  5734)               enddo
  5735)             else if (vec_format == LOCAL) then
  5736)               do ghosted_id=1,grid%ngmax
  5737)                 patch%aux%Mphase%auxvars(ghosted_id)% &
  5738)                   auxvar_elem(0)%u(2) = vec_ptr(ghosted_id)
  5739)               enddo
  5740)             endif
  5741)           case(GAS_DENSITY, GAS_DENSITY_MOL) 
  5742)             if (vec_format == GLOBAL) then
  5743)               do local_id=1,grid%nlmax
  5744)                 patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
  5745)                   auxvar_elem(0)%den(2) = vec_ptr(local_id)
  5746)               enddo
  5747)             else if (vec_format == LOCAL) then
  5748)               do ghosted_id=1,grid%ngmax
  5749)                 patch%aux%Mphase%auxvars(ghosted_id)% &
  5750)                   auxvar_elem(0)%den(2) = vec_ptr(ghosted_id)
  5751)               enddo
  5752)             endif
  5753)           case(LIQUID_MOLE_FRACTION)
  5754)             if (vec_format == GLOBAL) then
  5755)               do local_id=1,grid%nlmax
  5756)                 patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
  5757)                   auxvar_elem(0)%xmol(isubvar) = vec_ptr(local_id)
  5758)               enddo
  5759)             else if (vec_format == LOCAL) then
  5760)               do ghosted_id=1,grid%ngmax
  5761)                 patch%aux%Mphase%auxvars(ghosted_id)% &
  5762)                   auxvar_elem(0)%xmol(isubvar) = vec_ptr(ghosted_id)
  5763)               enddo
  5764)             endif
  5765)           case(LIQUID_ENERGY)
  5766)             if (vec_format == GLOBAL) then
  5767)               do local_id=1,grid%nlmax
  5768)                 patch%aux%Mphase%auxvars(grid%nL2G(local_id))% &
  5769)                   auxvar_elem(0)%u(1) = vec_ptr(local_id)
  5770)               enddo
  5771)             else if (vec_format == LOCAL) then
  5772)               do ghosted_id=1,grid%ngmax
  5773)                 patch%aux%Mphase%auxvars(ghosted_id)% &
  5774)                   auxvar_elem(0)%u(1) = vec_ptr(ghosted_id)
  5775)               enddo
  5776)             endif
  5777)         end select
  5778)       else if (associated(patch%aux%Immis)) then
  5779)         select case(ivar)
  5780)           case(TEMPERATURE)
  5781)             if (vec_format == GLOBAL) then
  5782)               do local_id=1,grid%nlmax
  5783)                 patch%aux%Immis%auxvars(grid%nL2G(local_id))% &
  5784)                   auxvar_elem(0)%temp = vec_ptr(local_id)
  5785)               enddo
  5786)             else if (vec_format == LOCAL) then
  5787)               do ghosted_id=1,grid%ngmax
  5788)                 patch%aux%Immis%auxvars(ghosted_id)% &
  5789)                   auxvar_elem(0)%temp = vec_ptr(ghosted_id)
  5790)               enddo
  5791)             endif
  5792)           case(LIQUID_PRESSURE)
  5793)             if (vec_format == GLOBAL) then
  5794)               do local_id=1,grid%nlmax
  5795)                 patch%aux%Immis%auxvars(grid%nL2G(local_id))% &
  5796)                   auxvar_elem(0)%pres = vec_ptr(local_id)
  5797)               enddo
  5798)             else if (vec_format == LOCAL) then
  5799)               do ghosted_id=1,grid%ngmax
  5800)                 patch%aux%Immis%auxvars(ghosted_id)% &
  5801)                   auxvar_elem(0)%pres = vec_ptr(ghosted_id)
  5802)               enddo
  5803)             endif
  5804)           case(LIQUID_SATURATION)
  5805)             if (vec_format == GLOBAL) then
  5806)               do local_id=1,grid%nlmax
  5807)                 patch%aux%Immis%auxvars(grid%nL2G(local_id))% &
  5808)                   auxvar_elem(0)%sat(1) = vec_ptr(local_id)
  5809)               enddo
  5810)             else if (vec_format == LOCAL) then
  5811)               do ghosted_id=1,grid%ngmax
  5812)                 patch%aux%Immis%auxvars(ghosted_id)% &
  5813)                   auxvar_elem(0)%sat(1) = vec_ptr(ghosted_id)
  5814)               enddo
  5815)             endif
  5816)           case(LIQUID_DENSITY)
  5817)             if (vec_format == GLOBAL) then
  5818)               do local_id=1,grid%nlmax
  5819)                 patch%aux%Immis%auxvars(grid%nL2G(local_id))% &
  5820)                   auxvar_elem(0)%den(1) = vec_ptr(local_id)
  5821)               enddo
  5822)             else if (vec_format == LOCAL) then
  5823)               do ghosted_id=1,grid%ngmax
  5824)                 patch%aux%Immis%auxvars(ghosted_id)% &
  5825)                   auxvar_elem(0)%den(1) = vec_ptr(ghosted_id)
  5826)               enddo
  5827)             endif
  5828)           case(GAS_SATURATION)
  5829)             if (vec_format == GLOBAL) then
  5830)               do local_id=1,grid%nlmax
  5831)                 patch%aux%Immis%auxvars(grid%nL2G(local_id))% &
  5832)                   auxvar_elem(0)%sat(2) = vec_ptr(local_id)
  5833)               enddo
  5834)             else if (vec_format == LOCAL) then
  5835)               do ghosted_id=1,grid%ngmax
  5836)                 patch%aux%Immis%auxvars(ghosted_id)% &
  5837)                   auxvar_elem(0)%sat(2) = vec_ptr(ghosted_id)
  5838)               enddo
  5839)             endif
  5840)           case(GAS_ENERGY)
  5841)             if (vec_format == GLOBAL) then
  5842)               do local_id=1,grid%nlmax
  5843)                 patch%aux%Immis%auxvars(grid%nL2G(local_id))% &
  5844)                   auxvar_elem(0)%u(2) = vec_ptr(local_id)
  5845)               enddo
  5846)             else if (vec_format == LOCAL) then
  5847)               do ghosted_id=1,grid%ngmax
  5848)                 patch%aux%Immis%auxvars(ghosted_id)% &
  5849)                   auxvar_elem(0)%u(2) = vec_ptr(ghosted_id)
  5850)               enddo
  5851)             endif
  5852)           case(LIQUID_ENERGY)
  5853)             if (vec_format == GLOBAL) then
  5854)               do local_id=1,grid%nlmax
  5855)                 patch%aux%Immis%auxvars(grid%nL2G(local_id))% &
  5856)                   auxvar_elem(0)%u(1) = vec_ptr(local_id)
  5857)               enddo
  5858)             else if (vec_format == LOCAL) then
  5859)               do ghosted_id=1,grid%ngmax
  5860)                 patch%aux%Immis%auxvars(ghosted_id)% &
  5861)                   auxvar_elem(0)%u(1) = vec_ptr(ghosted_id)
  5862)               enddo
  5863)             endif
  5864)         end select
  5865)       else if (associated(patch%aux%General)) then
  5866)         select case(ivar)
  5867)           case(TEMPERATURE)
  5868)             do local_id=1,grid%nlmax
  5869)               patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
  5870)                 temp = vec_ptr(local_id)
  5871)             enddo
  5872)           case(LIQUID_PRESSURE)
  5873)             do local_id=1,grid%nlmax
  5874)               patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
  5875)                 pres(option%liquid_phase) = vec_ptr(local_id)
  5876)             enddo
  5877)           case(GAS_PRESSURE)
  5878)             do local_id=1,grid%nlmax
  5879)               patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
  5880)                 pres(option%gas_phase) = vec_ptr(local_id)
  5881)             enddo
  5882)           case(AIR_PRESSURE)
  5883)             do local_id=1,grid%nlmax
  5884)               patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
  5885)                 pres(option%air_pressure_id) = vec_ptr(local_id)
  5886)             enddo
  5887)           case(CAPILLARY_PRESSURE)
  5888)             do local_id=1,grid%nlmax
  5889)               patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
  5890)                 pres(option%capillary_pressure_id) = vec_ptr(local_id)
  5891)             enddo
  5892)           case(STATE)
  5893)             do local_id=1,grid%nlmax
  5894)               patch%aux%Global%auxvars(grid%nL2G(local_id))%istate = &
  5895)                 int(vec_ptr(local_id)+1.d-10)
  5896)             enddo
  5897)           case(LIQUID_SATURATION)
  5898)             do local_id=1,grid%nlmax
  5899)               patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
  5900)                 sat(option%liquid_phase) = vec_ptr(local_id)
  5901)             enddo
  5902)           case(LIQUID_DENSITY)
  5903)             do local_id=1,grid%nlmax
  5904)               patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
  5905)                den_kg(option%liquid_phase) = vec_ptr(local_id)
  5906)             enddo
  5907)           case(LIQUID_ENERGY)
  5908)             do local_id=1,grid%nlmax
  5909)               patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
  5910)                 U(option%liquid_phase) = vec_ptr(local_id)
  5911)             enddo
  5912)           case(LIQUID_MOLE_FRACTION)
  5913)             do local_id=1,grid%nlmax
  5914)               patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
  5915)                 xmol(isubvar,option%liquid_phase) = vec_ptr(local_id)
  5916)             enddo
  5917)           case(GAS_SATURATION)
  5918)             do local_id=1,grid%nlmax
  5919)               patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
  5920)                 sat(option%gas_phase) = vec_ptr(local_id)
  5921)             enddo
  5922)           case(GAS_DENSITY) 
  5923)             do local_id=1,grid%nlmax
  5924)               patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
  5925)                 den_kg(option%gas_phase) = vec_ptr(local_id)
  5926)             enddo
  5927)           case(GAS_ENERGY)
  5928)             do local_id=1,grid%nlmax
  5929)               patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
  5930)                 U(option%gas_phase) = vec_ptr(local_id)
  5931)             enddo
  5932)           case(GAS_MOLE_FRACTION)
  5933)             do local_id=1,grid%nlmax
  5934)               patch%aux%General%auxvars(ZERO_INTEGER,grid%nL2G(local_id))% &
  5935)                 xmol(isubvar,option%gas_phase) = vec_ptr(local_id)
  5936)             enddo
  5937)         end select         
  5938)       endif
  5939)     case(PRIMARY_MOLALITY,TOTAL_MOLARITY,MINERAL_VOLUME_FRACTION, &
  5940)          PRIMARY_ACTIVITY_COEF,SECONDARY_ACTIVITY_COEF,IMMOBILE_SPECIES)
  5941)       select case(ivar)
  5942)         case(PRIMARY_MOLALITY)
  5943)           if (vec_format == GLOBAL) then
  5944)             do local_id=1,grid%nlmax
  5945)               patch%aux%RT%auxvars(grid%nL2G(local_id))%pri_molal(isubvar) = &
  5946)                 vec_ptr(local_id)
  5947)             enddo
  5948)           else if (vec_format == LOCAL) then
  5949)             do ghosted_id=1,grid%ngmax
  5950)               patch%aux%RT%auxvars(ghosted_id)%pri_molal(isubvar) = &
  5951)                 vec_ptr(ghosted_id)
  5952)             enddo
  5953)           endif
  5954)         case(TOTAL_MOLARITY)
  5955)           if (vec_format == GLOBAL) then
  5956)             do local_id=1,grid%nlmax
  5957)               patch%aux%RT%auxvars(grid%nL2G(local_id))% &
  5958)                 total(isubvar,iphase) = vec_ptr(local_id)
  5959)             enddo
  5960)           else if (vec_format == LOCAL) then
  5961)             do ghosted_id=1,grid%ngmax
  5962)               patch%aux%RT%auxvars(ghosted_id)% &
  5963)                 total(isubvar,iphase) = vec_ptr(ghosted_id)
  5964)             enddo
  5965)           endif
  5966)         case(MINERAL_VOLUME_FRACTION)
  5967)           if (vec_format == GLOBAL) then
  5968)             do local_id=1,grid%nlmax
  5969)               patch%aux%RT%auxvars(grid%nL2G(local_id))% &
  5970)                 mnrl_volfrac(isubvar) = vec_ptr(local_id)
  5971)             enddo
  5972)           else if (vec_format == LOCAL) then
  5973)             do ghosted_id=1,grid%ngmax
  5974)               patch%aux%RT%auxvars(ghosted_id)% &
  5975)                 mnrl_volfrac(isubvar) = vec_ptr(ghosted_id)
  5976)             enddo
  5977)           endif
  5978)         case(IMMOBILE_SPECIES)
  5979)           if (vec_format == GLOBAL) then
  5980)             do local_id=1,grid%nlmax
  5981)               patch%aux%RT%auxvars(grid%nL2G(local_id))% &
  5982)                 immobile(isubvar) = vec_ptr(local_id)
  5983)             enddo
  5984)           else if (vec_format == LOCAL) then
  5985)             do ghosted_id=1,grid%ngmax
  5986)               patch%aux%RT%auxvars(ghosted_id)% &
  5987)                 immobile(isubvar) = vec_ptr(ghosted_id)
  5988)             enddo
  5989)           endif
  5990)         case(PRIMARY_ACTIVITY_COEF)
  5991)           if (vec_format == GLOBAL) then
  5992)             do local_id=1,grid%nlmax
  5993)               patch%aux%RT%auxvars(grid%nL2G(local_id))% &
  5994)                 pri_act_coef(isubvar) = vec_ptr(local_id)
  5995)             enddo
  5996)           else if (vec_format == LOCAL) then
  5997)             do ghosted_id=1,grid%ngmax
  5998)               patch%aux%RT%auxvars(ghosted_id)% &
  5999)                 pri_act_coef(isubvar) = vec_ptr(ghosted_id)
  6000)             enddo
  6001)           endif
  6002)         case(SECONDARY_ACTIVITY_COEF)
  6003)           if (vec_format == GLOBAL) then
  6004)             do local_id=1,grid%nlmax
  6005)               patch%aux%RT%auxvars(grid%nL2G(local_id))% &
  6006)                 sec_act_coef(isubvar) = vec_ptr(local_id)
  6007)             enddo
  6008)           else if (vec_format == LOCAL) then
  6009)             do ghosted_id=1,grid%ngmax
  6010)               patch%aux%RT%auxvars(ghosted_id)% &
  6011)                 sec_act_coef(isubvar) = vec_ptr(ghosted_id)
  6012)             enddo
  6013)           endif
  6014)       end select
  6015)     case(PRIMARY_MOLARITY,SECONDARY_MOLALITY,SECONDARY_MOLARITY,TOTAL_MOLALITY, &
  6016)          COLLOID_MOBILE,COLLOID_IMMOBILE)
  6017)       select case(ivar)
  6018)         case(PRIMARY_MOLARITY)
  6019)           call printErrMsg(option,'Setting of primary molarity at grid cell not supported.')
  6020)         case(SECONDARY_MOLALITY)
  6021)           call printErrMsg(option,'Setting of secondary molality at grid cell not supported.')
  6022)         case(SECONDARY_MOLARITY)
  6023)           call printErrMsg(option,'Setting of secondary molarity at grid cell not supported.')
  6024)         case(TOTAL_MOLALITY)
  6025)           call printErrMsg(option,'Setting of total molality at grid cell not supported.')
  6026)         case(COLLOID_MOBILE)
  6027)           call printErrMsg(option,'Setting of mobile colloid concentration at grid cell not supported.')
  6028)         case(COLLOID_IMMOBILE)
  6029)           call printErrMsg(option,'Setting of immobile colloid concentration at grid cell not supported.')
  6030)       end select
  6031)     case(POROSITY,MINERAL_POROSITY)
  6032)       if (vec_format == GLOBAL) then
  6033)         do local_id=1,grid%nlmax
  6034)           call MaterialAuxVarSetValue(material_auxvars(grid%nL2G(local_id)), &
  6035)                                       ivar,vec_ptr(local_id))
  6036)         enddo
  6037)       else if (vec_format == LOCAL) then
  6038)         do ghosted_id=1,grid%ngmax
  6039)           call MaterialAuxVarSetValue(material_auxvars(ghosted_id), &
  6040)                                       ivar,vec_ptr(ghosted_id))
  6041)         enddo
  6042)       endif
  6043)     case(VOLUME,TORTUOSITY,SOIL_COMPRESSIBILITY,SOIL_REFERENCE_PRESSURE)
  6044)       option%io_buffer = 'Setting of volume, tortuosity, ' // &
  6045)         'soil compressibility or soil reference pressure in ' // &
  6046)         '"PatchSetVariable" not supported.'
  6047)       call printErrMsg(option)
  6048)     case(PERMEABILITY,PERMEABILITY_X,PERMEABILITY_Y,PERMEABILITY_Z)
  6049)       option%io_buffer = 'Setting of permeability in "PatchSetVariable"' // &
  6050)         ' not supported.'
  6051)       call printErrMsg(option)
  6052)     case(PHASE)
  6053)       if (vec_format == GLOBAL) then
  6054)         call VecGetArrayF90(field%iphas_loc,vec_ptr2,ierr);CHKERRQ(ierr)
  6055)         do local_id=1,grid%nlmax
  6056)           vec_ptr2(grid%nL2G(local_id)) = vec_ptr(local_id)
  6057)         enddo
  6058)         call VecRestoreArrayF90(field%iphas_loc,vec_ptr2,ierr);CHKERRQ(ierr)
  6059)       else if (vec_format == LOCAL) then
  6060)         call VecGetArrayF90(field%iphas_loc,vec_ptr2,ierr);CHKERRQ(ierr)
  6061)         vec_ptr2(1:grid%ngmax) = vec_ptr(1:grid%ngmax)
  6062)         call VecRestoreArrayF90(field%iphas_loc,vec_ptr2,ierr);CHKERRQ(ierr)
  6063)       endif
  6064)     case(MATERIAL_ID)
  6065)       !geh: this would require the creation of a permanent mapping between
  6066)       !     external and internal material ids, which we want to avoid.
  6067)       call printErrMsg(option, &
  6068)                        'Cannot set MATERIAL_ID through PatchSetVariable()')
  6069)       if (vec_format == GLOBAL) then
  6070)         do local_id=1,grid%nlmax
  6071)           patch%imat(grid%nL2G(local_id)) = int(vec_ptr(local_id))
  6072)         enddo
  6073)       else if (vec_format == LOCAL) then
  6074)         patch%imat(1:grid%ngmax) = int(vec_ptr(1:grid%ngmax))
  6075)       endif
  6076)     case(PROCESS_ID)
  6077)       call printErrMsg(option, &
  6078)                        'Cannot set PROCESS_ID through PatchSetVariable()')
  6079)     case default
  6080)       write(option%io_buffer, &
  6081)             '(''IVAR ('',i3,'') not found in PatchSetVariable'')') ivar
  6082)       call printErrMsg(option)
  6083)   end select
  6084) 
  6085)   call VecRestoreArrayF90(vec,vec_ptr,ierr);CHKERRQ(ierr)
  6086)   
  6087) end subroutine PatchSetVariable
  6088) 
  6089) ! ************************************************************************** !
  6090) 
  6091) subroutine PatchCountCells(patch,total_count,active_count)
  6092)   ! 
  6093)   ! Counts # of active and inactive grid cells
  6094)   ! 
  6095)   ! Author: Glenn Hammond
  6096)   ! Date: 06/01/10
  6097)   ! 
  6098) 
  6099)   use Option_module
  6100) 
  6101)   implicit none
  6102)   
  6103)   type(patch_type) :: patch
  6104)   PetscInt :: total_count
  6105)   PetscInt :: active_count
  6106)   
  6107)   type(grid_type), pointer :: grid
  6108)   PetscInt :: local_id
  6109)   
  6110)   grid => patch%grid
  6111)   
  6112)   total_count = grid%nlmax
  6113)   
  6114)   active_count = 0
  6115)   do local_id = 1, grid%nlmax
  6116)     if (patch%imat(grid%nL2G(local_id)) <= 0) cycle
  6117)     active_count = active_count + 1
  6118)   enddo
  6119) 
  6120) end subroutine PatchCountCells
  6121) 
  6122) ! ************************************************************************** !
  6123) 
  6124) subroutine PatchCalculateCFL1Timestep(patch,option,max_dt_cfl_1)
  6125)   ! 
  6126)   ! Calculates largest time step to preserves a
  6127)   ! CFL # of 1 in a patch
  6128)   ! 
  6129)   ! Author: Glenn Hammond
  6130)   ! Date: 10/06/11
  6131)   ! 
  6132) 
  6133)   use Option_module
  6134)   use Connection_module
  6135)   use Coupler_module
  6136)   use Field_module
  6137)   use Global_Aux_module
  6138)   use Material_Aux_class
  6139)   
  6140)   implicit none
  6141) 
  6142) #include "petsc/finclude/petscvec.h"
  6143) #include "petsc/finclude/petscvec.h90"
  6144)   
  6145)   type(patch_type) :: patch
  6146)   type(option_type) :: option
  6147)   PetscReal :: max_dt_cfl_1
  6148)   
  6149)   type(grid_type), pointer :: grid
  6150)   type(field_type), pointer :: field
  6151)   type(coupler_type), pointer :: boundary_condition
  6152)   type(global_auxvar_type), pointer :: global_auxvars(:)
  6153)   class(material_auxvar_type), pointer :: material_auxvars(:)
  6154)   type(connection_set_list_type), pointer :: connection_set_list
  6155)   type(connection_set_type), pointer :: cur_connection_set
  6156)   PetscInt :: iconn
  6157)   PetscInt :: sum_connection
  6158)   PetscReal :: distance, fraction_upwind
  6159)   PetscReal :: por_sat_ave, por_sat_min, v_darcy, v_pore_ave, v_pore_max
  6160)   PetscInt :: local_id_up, local_id_dn
  6161)   PetscInt :: ghosted_id_up, ghosted_id_dn
  6162)   PetscInt :: iphase
  6163) 
  6164)   PetscReal :: dt_cfl_1
  6165)   PetscErrorCode :: ierr
  6166) 
  6167)   field => patch%field
  6168)   global_auxvars => patch%aux%Global%auxvars
  6169)   material_auxvars => patch%aux%Material%auxvars
  6170)   grid => patch%grid
  6171) 
  6172)   max_dt_cfl_1 = 1.d20
  6173)   
  6174)   connection_set_list => grid%internal_connection_set_list
  6175)   cur_connection_set => connection_set_list%first
  6176)   sum_connection = 0  
  6177)   do 
  6178)     if (.not.associated(cur_connection_set)) exit
  6179)     do iconn = 1, cur_connection_set%num_connections
  6180)       sum_connection = sum_connection + 1
  6181)       ghosted_id_up = cur_connection_set%id_up(iconn)
  6182)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
  6183)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
  6184)       local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping   
  6185)       if (patch%imat(ghosted_id_up) <= 0 .or.  &
  6186)           patch%imat(ghosted_id_dn) <= 0) cycle
  6187)       distance = cur_connection_set%dist(0,iconn)
  6188)       fraction_upwind = cur_connection_set%dist(-1,iconn)
  6189)       do iphase = 1, option%nphase
  6190)         ! if the phase is not present in either cell, skip the connection
  6191)         if (.not.(global_auxvars(ghosted_id_up)%sat(iphase) > 0.d0 .and. &
  6192)                   global_auxvars(ghosted_id_dn)%sat(iphase) > 0.d0)) cycle
  6193)         por_sat_min = min(material_auxvars(ghosted_id_up)%porosity* &
  6194)                           global_auxvars(ghosted_id_up)%sat(iphase), &
  6195)                           material_auxvars(ghosted_id_dn)%porosity* &
  6196)                           global_auxvars(ghosted_id_dn)%sat(iphase))
  6197)         por_sat_ave = (fraction_upwind* &
  6198)                        material_auxvars(ghosted_id_up)%porosity* &
  6199)                        global_auxvars(ghosted_id_up)%sat(iphase) + &
  6200)                       (1.d0-fraction_upwind)* &
  6201)                       material_auxvars(ghosted_id_dn)%porosity* &
  6202)                       global_auxvars(ghosted_id_dn)%sat(iphase))
  6203)         v_darcy = patch%internal_velocities(iphase,sum_connection)
  6204)         v_pore_max = v_darcy / por_sat_min
  6205)         v_pore_ave = v_darcy / por_sat_ave
  6206)         !geh: I use v_por_max to ensure that we limit the cfl based on the
  6207)         !     highest velocity through the face.  If porosity*saturation
  6208)         !     varies, the pore water velocity will be highest on the side
  6209)         !     of the face with the smalled value of porosity*saturation.
  6210)         dt_cfl_1 = distance / dabs(v_pore_max)
  6211)         max_dt_cfl_1 = min(dt_cfl_1,max_dt_cfl_1)
  6212)       enddo
  6213)     enddo
  6214)     cur_connection_set => cur_connection_set%next
  6215)   enddo
  6216) 
  6217)   boundary_condition => patch%boundary_condition_list%first
  6218)   sum_connection = 0    
  6219)   do 
  6220)     if (.not.associated(boundary_condition)) exit
  6221)     cur_connection_set => boundary_condition%connection_set
  6222)     do iconn = 1, cur_connection_set%num_connections
  6223)       sum_connection = sum_connection + 1
  6224)       local_id_dn = cur_connection_set%id_dn(iconn)
  6225)       ghosted_id_dn = grid%nL2G(local_id_dn)
  6226)       if (patch%imat(ghosted_id_dn) <= 0) cycle
  6227)       !geh: since on boundary, dist must be scaled by 2.d0
  6228)       distance = 2.d0*cur_connection_set%dist(0,iconn)
  6229)       do iphase = 1, option%nphase
  6230)         por_sat_ave = material_auxvars(ghosted_id_dn)%porosity* &
  6231)                       global_auxvars(ghosted_id_dn)%sat(iphase)
  6232)         v_darcy = patch%boundary_velocities(iphase,sum_connection)
  6233)         v_pore_ave = v_darcy / por_sat_ave
  6234)         dt_cfl_1 = distance / dabs(v_pore_ave)
  6235)         max_dt_cfl_1 = min(dt_cfl_1,max_dt_cfl_1)
  6236)       enddo
  6237)     enddo
  6238)     boundary_condition => boundary_condition%next
  6239)   enddo
  6240) 
  6241) end subroutine PatchCalculateCFL1Timestep
  6242) 
  6243) ! ************************************************************************** !
  6244) 
  6245) function PatchGetVarNameFromKeyword(keyword,option)
  6246)   ! 
  6247)   ! Returns the name of variable defined by keyword
  6248)   ! 
  6249)   ! Author: Glenn Hammond
  6250)   ! Date: 07/28/11
  6251)   ! 
  6252)  
  6253)   use Option_module
  6254) 
  6255)   implicit none
  6256) 
  6257)   character(len=MAXWORDLENGTH) :: keyword
  6258)   type(option_type) :: option
  6259) 
  6260)   character(len=MAXSTRINGLENGTH) :: PatchGetVarNameFromKeyword
  6261)   character(len=MAXSTRINGLENGTH) :: var_name
  6262) 
  6263)   select case(keyword)
  6264)     case('PROCESS_ID')
  6265)       var_name = 'Processor ID'
  6266)     case default
  6267)       option%io_buffer = 'Keyword "' // trim(keyword) // '" not ' // &
  6268)                          'recognized in PatchGetIvarsFromKeyword()'
  6269)       call printErrMsg(option)
  6270)   end select
  6271) 
  6272)   PatchGetVarNameFromKeyword = var_name
  6273) 
  6274) end function PatchGetVarNameFromKeyword
  6275) 
  6276) ! ************************************************************************** !
  6277) 
  6278) subroutine PatchGetIvarsFromKeyword(keyword,ivar,isubvar,var_type,option)
  6279)   ! 
  6280)   ! Returns the ivar and isubvars for extracting
  6281)   ! datasets using PatchGet/PatchSet routines
  6282)   ! 
  6283)   ! Author: Glenn Hammond
  6284)   ! Date: 07/28/11
  6285)   ! 
  6286)  
  6287)   use Option_module
  6288)   use Variables_module
  6289) 
  6290)   implicit none
  6291) 
  6292)   character(len=MAXWORDLENGTH) :: keyword
  6293)   PetscInt :: ivar
  6294)   PetscInt :: isubvar
  6295)   PetscInt :: var_type
  6296)   type(option_type) :: option
  6297) 
  6298)   select case(keyword)
  6299)     case('PROCESS_ID')
  6300)       ivar = PROCESS_ID
  6301)       isubvar = ZERO_INTEGER
  6302)       var_type = INT_VAR
  6303)     case default
  6304)       option%io_buffer = 'Keyword "' // trim(keyword) // '" not ' // &
  6305)                          'recognized in PatchGetIvarsFromKeyword()'
  6306)       call printErrMsg(option)
  6307)   end select
  6308) 
  6309) end subroutine
  6310) 
  6311) ! ************************************************************************** !
  6312) 
  6313) subroutine PatchGetVariable2(patch,surf_field,option,output_option,vec,ivar, &
  6314)                            isubvar,isubvar1)
  6315)   ! 
  6316)   ! PatchGetVariable: Extracts variables indexed by ivar and isubvar from a patch
  6317)   ! 
  6318)   ! Author: Glenn Hammond
  6319)   ! Date: 09/12/08
  6320)   ! 
  6321) 
  6322)   use Grid_module
  6323)   use Option_module
  6324)   use Output_Aux_module
  6325)   use Surface_Field_module
  6326)   use Variables_module
  6327) 
  6328)   implicit none
  6329) 
  6330) #include "petsc/finclude/petscvec.h"
  6331) #include "petsc/finclude/petscvec.h90"
  6332) 
  6333)   type(option_type), pointer :: option
  6334)   !type(reaction_type), pointer :: reaction
  6335)   type(output_option_type), pointer :: output_option
  6336)   type(surface_field_type), pointer :: surf_field
  6337)   type(patch_type), pointer :: patch  
  6338)   Vec :: vec
  6339)   PetscInt :: ivar
  6340)   PetscInt :: isubvar
  6341)   PetscInt, optional :: isubvar1
  6342)   PetscInt :: iphase
  6343) 
  6344)   PetscInt :: local_id, ghosted_id
  6345)   type(grid_type), pointer :: grid
  6346)   PetscReal, pointer :: vec_ptr(:), vec_ptr2(:)
  6347)   PetscReal :: xmass
  6348)   PetscReal :: tempreal
  6349)   PetscInt :: tempint
  6350)   PetscInt :: irate, istate, irxn
  6351)   PetscErrorCode :: ierr
  6352) 
  6353)   grid => patch%grid
  6354) 
  6355)   call VecGetArrayF90(vec,vec_ptr,ierr);CHKERRQ(ierr)
  6356)   
  6357)   iphase = 1
  6358)   
  6359)   select case(ivar)
  6360)     case(SURFACE_LIQUID_HEAD)
  6361)       do local_id=1,grid%nlmax
  6362)         vec_ptr(local_id) = patch%surf_aux%SurfaceGlobal%auxvars(grid%nL2G(local_id))%head(1)
  6363)       enddo
  6364)     case(SURFACE_LIQUID_TEMPERATURE)
  6365)       do local_id=1,grid%nlmax
  6366)         vec_ptr(local_id) = patch%surf_aux%SurfaceGlobal%auxvars(grid%nL2G(local_id))%temp
  6367)       enddo
  6368)     case(MATERIAL_ID)
  6369)       do local_id=1,grid%nlmax
  6370)         vec_ptr(local_id) = &
  6371)           patch%imat_internal_to_external(iabs(patch%imat(grid%nL2G(local_id))))
  6372)       enddo
  6373)     case(PROCESS_ID)
  6374)       do local_id=1,grid%nlmax
  6375)         vec_ptr(local_id) = option%myrank
  6376)       enddo
  6377)     case default
  6378)       write(option%io_buffer, &
  6379)             '(''IVAR ('',i3,'') not found in PatchGetVariable'')') ivar
  6380)       call printErrMsg(option)
  6381)   end select
  6382) 
  6383) end subroutine PatchGetVariable2
  6384) 
  6385) ! ************************************************************************** !
  6386) 
  6387) subroutine PatchGetCellCenteredVelocities(patch,iphase,velocities)
  6388)   ! 
  6389)   ! Calculates the Darcy velocity at the center of all cells in a patch
  6390)   ! 
  6391)   ! Author: Glenn Hammond
  6392)   ! Date: 01/31/14
  6393)   ! 
  6394)   use Connection_module
  6395)   use Coupler_module
  6396)   
  6397)   implicit none
  6398)   
  6399)   type(patch_type), pointer :: patch
  6400)   PetscInt :: iphase
  6401)   PetscReal, intent(out) :: velocities(:,:)
  6402)   
  6403)   type(grid_type), pointer :: grid
  6404)   type(option_type), pointer :: option
  6405)   type(coupler_type), pointer :: boundary_condition
  6406)   type(connection_set_list_type), pointer :: connection_set_list
  6407)   type(connection_set_type), pointer :: cur_connection_set  
  6408)   PetscInt :: sum_connection, iconn, num_connections
  6409)   PetscReal, allocatable :: sum_area(:,:), sum_velocity(:,:)
  6410)   PetscReal :: area(3), velocity(3)
  6411)   PetscInt :: ghosted_id_up, ghosted_id_dn
  6412)   PetscInt :: local_id_up, local_id_dn
  6413)   PetscInt :: local_id
  6414)   PetscInt :: i
  6415)   
  6416)   grid => patch%grid
  6417)   
  6418)   allocate(sum_velocity(3,grid%nlmax))
  6419)   allocate(sum_area(3,grid%nlmax))
  6420)   sum_velocity(:,:) = 0.d0
  6421)   sum_area(:,:) = 0.d0
  6422) 
  6423)   ! interior velocities  
  6424)   connection_set_list => grid%internal_connection_set_list
  6425)   cur_connection_set => connection_set_list%first
  6426)   sum_connection = 0
  6427)   do 
  6428)     if (.not.associated(cur_connection_set)) exit
  6429)     do iconn = 1, cur_connection_set%num_connections
  6430)       sum_connection = sum_connection + 1
  6431)       ghosted_id_up = cur_connection_set%id_up(iconn)
  6432)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
  6433)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
  6434)       local_id_dn = grid%nG2L(ghosted_id_dn) ! = zero for ghost nodes
  6435)       ! velocities are stored as the downwind face of the upwind cell
  6436)       area = cur_connection_set%area(iconn)* &
  6437)              cur_connection_set%dist(1:3,iconn)
  6438)       velocity = patch%internal_velocities(iphase,sum_connection)*area
  6439)       if (local_id_up > 0) then
  6440)         sum_velocity(:,local_id_up) = sum_velocity(:,local_id_up) + velocity
  6441)         sum_area(:,local_id_up) = sum_area(:,local_id_up) + dabs(area)
  6442)       endif
  6443)       if (local_id_dn > 0) then
  6444)         sum_velocity(:,local_id_dn) = sum_velocity(:,local_id_dn) + velocity
  6445)         sum_area(:,local_id_dn) = sum_area(:,local_id_dn) + dabs(area)
  6446)       endif
  6447)     enddo
  6448)     cur_connection_set => cur_connection_set%next
  6449)   enddo
  6450) 
  6451)   ! boundary velocities
  6452)   boundary_condition => patch%boundary_condition_list%first
  6453)   sum_connection = 0
  6454)   do
  6455)     if (.not.associated(boundary_condition)) exit
  6456)     cur_connection_set => boundary_condition%connection_set
  6457)     do iconn = 1, cur_connection_set%num_connections
  6458)       sum_connection = sum_connection + 1
  6459)       local_id = cur_connection_set%id_dn(iconn)
  6460)       area = cur_connection_set%area(iconn)* &
  6461)              cur_connection_set%dist(1:3,iconn)
  6462)       velocity = patch%boundary_velocities(iphase,sum_connection)*area
  6463)       sum_velocity(:,local_id) = sum_velocity(:,local_id) + velocity
  6464)       sum_area(:,local_id) = sum_area(:,local_id) + dabs(area)
  6465)     enddo
  6466)     boundary_condition => boundary_condition%next
  6467)   enddo
  6468) 
  6469)   ! divide by total area
  6470)   do local_id=1,grid%nlmax
  6471)     do i=1,3
  6472)       if (sum_area(i,local_id) > 0.d0) then
  6473)         velocities(i,local_id) = sum_velocity(i,local_id) / &
  6474)                                  sum_area(i,local_id)  
  6475)       else
  6476)         velocities(i,local_id) = 0.d0
  6477)       endif
  6478)     enddo
  6479)   enddo
  6480)       
  6481)   deallocate(sum_velocity)
  6482)   deallocate(sum_area)
  6483) 
  6484) end subroutine PatchGetCellCenteredVelocities
  6485) 
  6486) ! ************************************************************************** !
  6487) 
  6488) function PatchGetConnectionsFromCoords(patch,coordinates,integral_flux_name, &
  6489)                                        option)
  6490)   ! 
  6491)   ! 
  6492)   ! Returns a list of internal and boundary connection ids for cell
  6493)   ! interfaces within a polygon.
  6494)   ! 
  6495)   ! Author: Glenn Hammond
  6496)   ! Date: 10/20/14
  6497)   ! 
  6498)   use Option_module
  6499)   use Geometry_module
  6500)   use Utility_module
  6501)   use Connection_module
  6502)   use Coupler_module
  6503)   
  6504)   implicit none
  6505) 
  6506)   type(patch_type) :: patch
  6507)   type(point3d_type) :: coordinates(:)
  6508)   character(len=MAXWORDLENGTH) :: integral_flux_name
  6509)   type(option_type) :: option
  6510)   
  6511)   PetscInt, pointer :: PatchGetConnectionsFromCoords(:)
  6512)   
  6513)   PetscInt, pointer :: connections(:)
  6514)   type(grid_type), pointer :: grid
  6515)   type(connection_set_list_type), pointer :: connection_set_list
  6516)   type(connection_set_type), pointer :: cur_connection_set
  6517)   type(coupler_type), pointer :: boundary_condition
  6518)   
  6519)   PetscInt :: idir
  6520)   PetscInt :: icount
  6521)   PetscInt :: array_size
  6522)   PetscInt :: sum_connection
  6523)   PetscInt :: iconn
  6524)   PetscInt :: i
  6525)   PetscInt :: local_id
  6526)   PetscInt :: local_id_up
  6527)   PetscInt :: ghosted_id
  6528)   PetscInt :: ghosted_id_up
  6529)   PetscInt :: ghosted_id_dn
  6530)   PetscReal :: fraction_upwind
  6531)   PetscReal :: magnitude
  6532)   PetscReal :: v1(3), v2(3)
  6533)   PetscReal :: x, y, z
  6534)   PetscReal :: value1, value2
  6535)   PetscReal, parameter :: relative_tolerance = 1.d-6
  6536)   PetscBool :: within_tolerance
  6537)   PetscErrorCode :: ierr
  6538)   
  6539)   grid => patch%grid
  6540)   
  6541)   ! determine orientation of polygon
  6542)   if (size(coordinates) > 2) then
  6543)     v1(1) = coordinates(2)%x - coordinates(1)%x
  6544)     v1(2) = coordinates(2)%y - coordinates(1)%y
  6545)     v1(3) = coordinates(2)%z - coordinates(1)%z
  6546)     v2(1) = coordinates(2)%x - coordinates(3)%x
  6547)     v2(2) = coordinates(2)%y - coordinates(3)%y
  6548)     v2(3) = coordinates(2)%z - coordinates(3)%z
  6549)     v1 = CrossProduct(v1,v2)
  6550)     icount = 0
  6551)     idir = 0
  6552)     do i = X_DIRECTION, Z_DIRECTION
  6553)       if (v1(i) > 1.d-10) then
  6554)         icount = icount + 1
  6555)         idir = i
  6556)       endif
  6557)     enddo
  6558)   else
  6559)     v1(1) = coordinates(1)%x
  6560)     v1(2) = coordinates(1)%y
  6561)     v1(3) = coordinates(1)%z
  6562)     v2(1) = coordinates(2)%x
  6563)     v2(2) = coordinates(2)%y
  6564)     v2(3) = coordinates(2)%z
  6565)     icount = 0
  6566)     do i = X_DIRECTION, Z_DIRECTION
  6567)       if (Equal(v2(i),v1(i))) then
  6568)         idir = i
  6569)         icount = icount + 1
  6570)       endif
  6571)     enddo
  6572)     if (icount == 0) icount = 3
  6573)   endif
  6574) 
  6575)   if (icount > 1) then
  6576)     option%io_buffer = 'Rectangle defined in integral flux "' // &
  6577)       trim(adjustl(integral_flux_name)) // &
  6578)       '" must be aligned with structured grid coordinates axes.'
  6579)     call printErrMsg(option)
  6580)   endif
  6581)     
  6582)   array_size = 100
  6583)   allocate(connections(array_size))
  6584)   icount = 0
  6585)   ! Interior Flux Terms -----------------------------------
  6586)   connection_set_list => grid%internal_connection_set_list
  6587)   cur_connection_set => connection_set_list%first
  6588)   sum_connection = 0  
  6589)   do 
  6590)     if (.not.associated(cur_connection_set)) exit
  6591)     do iconn = 1, cur_connection_set%num_connections
  6592)       sum_connection = sum_connection + 1
  6593) 
  6594)       ghosted_id_up = cur_connection_set%id_up(iconn)
  6595)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
  6596) 
  6597)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
  6598)       ! if one of the cells is ghosted, the process stores the flux only
  6599)       ! when the upwind cell is non-ghosted.
  6600)       if (local_id_up <= 0) cycle 
  6601) 
  6602)       fraction_upwind = cur_connection_set%dist(-1,iconn)
  6603)       magnitude = cur_connection_set%dist(0,iconn)
  6604)       x = grid%x(ghosted_id_up) + fraction_upwind * magnitude * &
  6605)           cur_connection_set%dist(X_DIRECTION,iconn)
  6606)       y = grid%y(ghosted_id_up) + fraction_upwind * magnitude * &
  6607)           cur_connection_set%dist(Y_DIRECTION,iconn)
  6608)       z = grid%z(ghosted_id_up) + fraction_upwind * magnitude * &
  6609)           cur_connection_set%dist(Z_DIRECTION,iconn)
  6610)       select case(idir)
  6611)         case(X_DIRECTION)
  6612)           value1 = x
  6613)           value2 = coordinates(1)%x
  6614)         case(Y_DIRECTION)
  6615)           value1 = y
  6616)           value2 = coordinates(1)%y
  6617)         case(Z_DIRECTION)
  6618)           value1 = z
  6619)           value2 = coordinates(1)%z
  6620)       end select
  6621)       within_tolerance = PETSC_FALSE
  6622)       if (Equal(value1,0.d0)) then
  6623)         within_tolerance = Equal(value1,value2)
  6624)       else
  6625)         within_tolerance = dabs((value1-value2)/value1) < relative_tolerance
  6626)       endif
  6627)       if (within_tolerance .and. &
  6628)           GeometryPointInPolygon(x,y,z,idir,coordinates)) then
  6629)         icount = icount + 1
  6630)         if (icount > size(connections)) then
  6631)           call reallocateIntArray(connections,array_size)
  6632)         endif
  6633)         connections(icount) = sum_connection
  6634)       endif
  6635)     enddo
  6636)     cur_connection_set => cur_connection_set%next
  6637)   enddo
  6638) 
  6639)   ! Boundary Flux Terms -----------------------------------
  6640)   boundary_condition => patch%boundary_condition_list%first
  6641)   sum_connection = 0    
  6642)   do 
  6643)     if (.not.associated(boundary_condition)) exit
  6644)     cur_connection_set => boundary_condition%connection_set
  6645)     do iconn = 1, cur_connection_set%num_connections
  6646)       sum_connection = sum_connection + 1
  6647)       local_id = cur_connection_set%id_dn(iconn)
  6648)       ghosted_id = grid%nL2G(local_id)
  6649)       fraction_upwind = 1.d0
  6650)       magnitude = cur_connection_set%dist(0,iconn)
  6651)       x = grid%x(ghosted_id) - fraction_upwind * magnitude * &
  6652)                                cur_connection_set%dist(X_DIRECTION,iconn)
  6653)       y = grid%y(ghosted_id) - fraction_upwind * magnitude * &
  6654)                                cur_connection_set%dist(Y_DIRECTION,iconn)
  6655)       z = grid%z(ghosted_id) - fraction_upwind * magnitude * &
  6656)                                cur_connection_set%dist(Z_DIRECTION,iconn)
  6657)       select case(idir)
  6658)         case(X_DIRECTION)
  6659)           value1 = x
  6660)           value2 = coordinates(1)%x
  6661)         case(Y_DIRECTION)
  6662)           value1 = y
  6663)           value2 = coordinates(1)%y
  6664)         case(Z_DIRECTION)
  6665)           value1 = z
  6666)           value2 = coordinates(1)%z
  6667)       end select
  6668)       within_tolerance = PETSC_FALSE
  6669)       if (Equal(value1,0.d0)) then
  6670)         within_tolerance = Equal(value1,value2)
  6671)       else
  6672)         within_tolerance = dabs((value1-value2)/value1) < relative_tolerance
  6673)       endif
  6674)       if (within_tolerance .and. &
  6675)           GeometryPointInPolygon(x,y,z,idir,coordinates)) then
  6676)         icount = icount + 1
  6677)         if (icount > size(connections)) then
  6678)           call reallocateIntArray(connections,array_size)
  6679)         endif
  6680)         connections(icount) = -1 * sum_connection
  6681)       endif
  6682)     enddo
  6683)     boundary_condition => boundary_condition%next
  6684)   enddo
  6685)   
  6686)   nullify(PatchGetConnectionsFromCoords)
  6687)   if (icount > 0) then
  6688)     allocate(PatchGetConnectionsFromCoords(icount))
  6689)     PatchGetConnectionsFromCoords = connections(1:icount)
  6690)   endif
  6691)   deallocate(connections)
  6692)   nullify(connections)
  6693) 
  6694)   call MPI_Allreduce(icount,i,ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM, &
  6695)                      option%mycomm,ierr)
  6696)   if (i == 0) then
  6697)     option%io_buffer = 'Zero connections found for INTEGRAL_FLUX "' // &
  6698)       trim(adjustl(integral_flux_name)) // &
  6699)       '".  Please ensure that the coordinates coincide with a cell boundary.'
  6700)     call printErrMsg(option)
  6701)   endif
  6702)   
  6703) end function PatchGetConnectionsFromCoords
  6704) 
  6705) ! **************************************************************************** !
  6706) 
  6707) subroutine PatchCouplerInputRecord(patch)
  6708)   ! 
  6709)   ! Prints ingested coupler information to the input record file.
  6710)   ! 
  6711)   ! Author: Jenn Frederick
  6712)   ! Date: 04/18/2016
  6713)   ! 
  6714)   use Coupler_module
  6715) 
  6716)   implicit none
  6717)   
  6718)   type(patch_type), pointer :: patch
  6719) 
  6720)   type(coupler_type), pointer :: cur_coupler
  6721)   character(len=MAXWORDLENGTH) :: word1, word2
  6722)   character(len=MAXSTRINGLENGTH) :: string
  6723)   PetscInt :: k
  6724)   PetscInt :: id = INPUT_RECORD_UNIT
  6725)   
  6726)   k = 0
  6727)   
  6728)   write(id,'(a)') ' '
  6729)   write(id,'(a)') '---------------------------------------------------------&
  6730)                   &-----------------------'
  6731)   write(id,'(a29)',advance='no') '---------------------------: '
  6732)   write(id,'(a)') 'INITIAL CONDITIONS'
  6733)   
  6734)   ! Initial conditions
  6735)   cur_coupler => patch%initial_condition_list%first
  6736)   do
  6737)     if (.not.associated(cur_coupler)) exit
  6738)     k = k + 1
  6739)     write(id,'(a29)',advance='no') 'initial condition listed: '
  6740)     write(word1,*) k
  6741)     write(id,'(a)') '#' // adjustl(trim(word1))
  6742)     write(id,'(a29)',advance='no') 'applies to region: '
  6743)     write(id,'(a)') adjustl(trim(cur_coupler%region_name))
  6744)     if (len_trim(cur_coupler%flow_condition_name) > 0) then
  6745)       write(id,'(a29)',advance='no') 'flow condition name: '
  6746)       write(id,'(a)') adjustl(trim(cur_coupler%flow_condition_name))
  6747)     endif
  6748)     if (len_trim(cur_coupler%tran_condition_name) > 0) then
  6749)       write(id,'(a29)',advance='no') 'transport condition name: '
  6750)       write(id,'(a)') adjustl(trim(cur_coupler%tran_condition_name))
  6751)     endif
  6752)     write(id,'(a29)') '---------------------------: '
  6753)     cur_coupler => cur_coupler%next
  6754)   enddo
  6755)   
  6756)   write(id,'(a)') ' '
  6757)   write(id,'(a)') '---------------------------------------------------------&
  6758)                   &-----------------------'
  6759)   write(id,'(a29)',advance='no') '---------------------------: '
  6760)   write(id,'(a)') 'BOUNDARY CONDITIONS'
  6761)   
  6762)   ! Boundary conditions
  6763)   cur_coupler => patch%boundary_condition_list%first
  6764)   do
  6765)     if (.not.associated(cur_coupler)) exit
  6766)     write(id,'(a29)',advance='no') 'boundary condition name: '
  6767)     write(id,'(a)') adjustl(trim(cur_coupler%name))
  6768)     write(id,'(a29)',advance='no') 'applies to region: '
  6769)     write(id,'(a)') adjustl(trim(cur_coupler%region_name))
  6770)     if (len_trim(cur_coupler%flow_condition_name) > 0) then
  6771)       write(id,'(a29)',advance='no') 'flow condition name: '
  6772)       write(id,'(a)') adjustl(trim(cur_coupler%flow_condition_name))
  6773)     endif
  6774)     if (len_trim(cur_coupler%tran_condition_name) > 0) then
  6775)       write(id,'(a29)',advance='no') 'transport condition name: '
  6776)       write(id,'(a)') adjustl(trim(cur_coupler%tran_condition_name))
  6777)     endif
  6778)     write(id,'(a29)') '---------------------------: '
  6779)     cur_coupler => cur_coupler%next
  6780)   enddo
  6781)   
  6782)   write(id,'(a)') ' '
  6783)   write(id,'(a)') '---------------------------------------------------------&
  6784)                   &-----------------------'
  6785)   write(id,'(a29)',advance='no') '---------------------------: '
  6786)   write(id,'(a)') 'SOURCE-SINKS'
  6787)   
  6788)   ! Source-Sink conditions
  6789)   cur_coupler => patch%source_sink_list%first
  6790)   do
  6791)     if (.not.associated(cur_coupler)) exit
  6792)     write(id,'(a29)',advance='no') 'source-sink name: '
  6793)     write(id,'(a)') adjustl(trim(cur_coupler%name))
  6794)     write(id,'(a29)',advance='no') 'applies to region: '
  6795)     write(id,'(a)') adjustl(trim(cur_coupler%region_name))
  6796)     if (len_trim(cur_coupler%flow_condition_name) > 0) then
  6797)       write(id,'(a29)',advance='no') 'flow condition name: '
  6798)       write(id,'(a)') adjustl(trim(cur_coupler%flow_condition_name))
  6799)     endif
  6800)     if (len_trim(cur_coupler%tran_condition_name) > 0) then
  6801)       write(id,'(a29)',advance='no') 'transport condition name: '
  6802)       write(id,'(a)') adjustl(trim(cur_coupler%tran_condition_name))
  6803)     endif
  6804)     write(id,'(a29)') '---------------------------: '
  6805)     cur_coupler => cur_coupler%next
  6806)   enddo
  6807)   
  6808) end subroutine PatchCouplerInputRecord
  6809) 
  6810) ! **************************************************************************** !
  6811) 
  6812) subroutine PatchGetCompMassInRegion(cell_ids,num_cells,patch,option, &
  6813)                                     global_total_mass)
  6814)   ! 
  6815)   ! Calculates the total mass (aqueous, sorbed, and precipitated) in a region
  6816)   ! in units of mol.
  6817)   ! 
  6818)   ! Author: Jenn Frederick
  6819)   ! Date: 04/25/2016
  6820)   ! 
  6821)   use Global_Aux_module
  6822)   use Material_Aux_class
  6823)   use Reaction_Aux_module
  6824)   use Grid_module
  6825)   use Option_module
  6826)   use Reactive_Transport_Aux_module
  6827) 
  6828)   implicit none
  6829)   
  6830)   PetscInt, pointer :: cell_ids(:)
  6831)   PetscInt :: num_cells
  6832)   type(patch_type), pointer :: patch
  6833)   type(option_type), pointer :: option
  6834)   PetscReal :: global_total_mass  ! [mol]
  6835)   
  6836)   type(global_auxvar_type), pointer :: global_auxvars(:)
  6837)   class(material_auxvar_type), pointer :: material_auxvars(:)
  6838)   type(reactive_transport_auxvar_type), pointer :: rt_auxvars(:)
  6839)   type(reaction_type), pointer :: reaction
  6840)   PetscReal :: aq_species_mass    ! [mol]
  6841)   PetscReal :: sorb_species_mass  ! [mol]
  6842)   PetscReal :: ppt_species_mass   ! [mol]
  6843)   PetscReal :: m3_water           ! [m^3-water]
  6844)   PetscReal :: m3_bulk            ! [m^3-bulk]
  6845)   PetscInt :: k, j, m
  6846)   PetscInt :: local_id, ghosted_id
  6847)   PetscErrorCode :: ierr
  6848)   PetscReal :: local_total_mass
  6849)   
  6850)   global_auxvars => patch%aux%Global%auxvars
  6851)   material_auxvars => patch%aux%Material%auxvars
  6852)   rt_auxvars => patch%aux%RT%auxvars
  6853)   reaction => patch%reaction
  6854)   local_total_mass = 0.d0
  6855)   global_total_mass = 0.d0
  6856)   
  6857)   ! Loop through all cells in the region:
  6858)   do k = 1,num_cells
  6859)     local_id = cell_ids(k)
  6860)     ghosted_id = patch%grid%nL2G(local_id)
  6861)     if (patch%imat(ghosted_id) <= 0) cycle
  6862)     m3_water = material_auxvars(ghosted_id)%porosity * &         ! [-]
  6863)                global_auxvars(ghosted_id)%sat(LIQUID_PHASE) * &  ! [water]
  6864)                material_auxvars(ghosted_id)%volume               ! [m^3-bulk]
  6865)     m3_bulk = material_auxvars(ghosted_id)%volume                ! [m^3-bulk]
  6866)     ! Loop through aqueous and sorbed species:
  6867)     do j = 1,reaction%ncomp
  6868)       aq_species_mass = 0.d0
  6869)       sorb_species_mass = 0.d0
  6870)       ! aqueous species; units [mol/L-water]*[m^3-water]*[1000L/m^3-water]=[mol]
  6871)       aq_species_mass = rt_auxvars(ghosted_id)%total(j,LIQUID_PHASE) * &
  6872)                         m3_water * 1.0d3
  6873)       if (associated(rt_auxvars(ghosted_id)%total_sorb_eq)) then
  6874)         ! sorbed species; units [mol/m^3-bulk]*[m^3-bulk]=[mol]
  6875)         sorb_species_mass = rt_auxvars(ghosted_id)%total_sorb_eq(j) * m3_bulk
  6876)       else
  6877)         sorb_species_mass = 0.d0
  6878)       endif
  6879)       local_total_mass = local_total_mass + aq_species_mass + &
  6880)                                             sorb_species_mass
  6881)     enddo
  6882)     ! Loop through precipitated species:
  6883)     do m = 1,reaction%mineral%nkinmnrl
  6884)       ppt_species_mass = 0.d0
  6885)       ! precip. species; units [m^3-mnrl/m^3-bulk]*[m^3-bulk]/[m^3-mnrl/mol-mnrl]=[mol]
  6886)       ppt_species_mass = rt_auxvars(ghosted_id)%mnrl_volfrac(m) * m3_bulk / &
  6887)                          reaction%mineral%kinmnrl_molar_vol(m)      
  6888)       local_total_mass = local_total_mass + ppt_species_mass
  6889)     enddo 
  6890)   enddo ! Cell loop
  6891)   
  6892)   ! Sum the local_total_mass across all processes that own the region: 
  6893)   call MPI_Allreduce(local_total_mass,global_total_mass,ONE_INTEGER_MPI, &
  6894)                      MPI_DOUBLE_PRECISION,MPI_SUM,option%mycomm,ierr)
  6895) 
  6896) end subroutine PatchGetCompMassInRegion
  6897) 
  6898) ! **************************************************************************** !
  6899) 
  6900) subroutine PatchGetCompMassInRegionAssign(region_list, &
  6901)            mass_balance_region_list,option)
  6902)   ! 
  6903)   ! Assigns patch%region information to the mass balance region object
  6904)   ! 
  6905)   ! Author: Jenn Frederick
  6906)   ! Date: 04/26/2016
  6907)   ! 
  6908)   use Output_Aux_module
  6909)   use Region_module
  6910)   use String_module
  6911) 
  6912)   implicit none
  6913)   
  6914)   type(region_list_type), pointer :: region_list
  6915)   type(mass_balance_region_type), pointer :: mass_balance_region_list
  6916)   type(option_type), pointer :: option
  6917)   
  6918)   type(region_type), pointer :: cur_region
  6919)   type(mass_balance_region_type), pointer :: cur_mbr
  6920)   PetscBool :: success
  6921)   
  6922)   cur_mbr => mass_balance_region_list
  6923)   do
  6924)     if (.not.associated(cur_mbr)) exit
  6925)     ! Loop through patch%region_list to find wanted region:
  6926)     cur_region => region_list%first
  6927)     do
  6928)       if (.not.associated(cur_region)) exit
  6929)       success = PETSC_TRUE
  6930)       if (StringCompareIgnoreCase(cur_region%name,cur_mbr%region_name)) exit
  6931)       success = PETSC_FALSE  
  6932)       cur_region => cur_region%next
  6933)     enddo
  6934)     ! If the wanted region was not found, throw an error msg:
  6935)     if (.not.success) then
  6936)       option%io_buffer = 'Region ' // trim(cur_mbr%region_name) // ' not &
  6937)                           &found among listed regions.'
  6938)       call printErrMsg(option)
  6939)     endif
  6940)     ! Assign the mass balance region the wanted region's info:
  6941)     cur_mbr%num_cells = cur_region%num_cells
  6942)     cur_mbr%region_cell_ids => cur_region%cell_ids
  6943)     ! Go to next mass balance region
  6944)     cur_mbr => cur_mbr%next
  6945)   enddo
  6946)   
  6947) end subroutine PatchGetCompMassInRegionAssign
  6948) 
  6949) ! ************************************************************************** !
  6950) 
  6951) subroutine PatchDestroyList(patch_list)
  6952)   ! 
  6953)   ! Deallocates a patch list and array of patches
  6954)   ! 
  6955)   ! Author: Glenn Hammond
  6956)   ! Date: 10/15/07
  6957)   ! 
  6958) 
  6959)   implicit none
  6960)   
  6961)   type(patch_list_type), pointer :: patch_list
  6962)     
  6963)   type(patch_type), pointer :: cur_patch, prev_patch
  6964)   
  6965)   if (.not.associated(patch_list)) return
  6966)   
  6967)   if (associated(patch_list%array)) deallocate(patch_list%array)
  6968)   nullify(patch_list%array)
  6969)   
  6970)   cur_patch => patch_list%first
  6971)   do 
  6972)     if (.not.associated(cur_patch)) exit
  6973)     prev_patch => cur_patch
  6974)     cur_patch => cur_patch%next
  6975)     call PatchDestroy(prev_patch)
  6976)   enddo
  6977)   
  6978)   nullify(patch_list%first)
  6979)   nullify(patch_list%last)
  6980)   patch_list%num_patch_objects = 0
  6981)   
  6982)   deallocate(patch_list)
  6983)   nullify(patch_list)
  6984) 
  6985) end subroutine PatchDestroyList
  6986) 
  6987) ! ************************************************************************** !
  6988) 
  6989) subroutine PatchDestroy(patch)
  6990)   ! 
  6991)   ! Deallocates a patch object
  6992)   ! 
  6993)   ! Author: Glenn Hammond
  6994)   ! Date: 02/22/08
  6995)   ! 
  6996) 
  6997)   use Utility_module, only : DeallocateArray
  6998) 
  6999)   implicit none
  7000)   
  7001)   type(patch_type), pointer :: patch
  7002)   
  7003)   call DeallocateArray(patch%imat)
  7004)   call DeallocateArray(patch%imat_internal_to_external)
  7005)   call DeallocateArray(patch%sat_func_id)
  7006)   call DeallocateArray(patch%internal_velocities)
  7007)   call DeallocateArray(patch%boundary_velocities)
  7008)   call DeallocateArray(patch%internal_tran_coefs)
  7009)   call DeallocateArray(patch%boundary_tran_coefs)
  7010)   call DeallocateArray(patch%internal_flow_fluxes)
  7011)   call DeallocateArray(patch%boundary_flow_fluxes)
  7012)   call DeallocateArray(patch%ss_flow_fluxes)
  7013)   call DeallocateArray(patch%internal_tran_fluxes)
  7014)   call DeallocateArray(patch%boundary_tran_fluxes)
  7015)   call DeallocateArray(patch%ss_tran_fluxes)
  7016)   call DeallocateArray(patch%ss_flow_vol_fluxes)
  7017)   
  7018)   call DeallocateArray(patch%boundary_energy_flux)
  7019) 
  7020) 
  7021)   if (associated(patch%material_property_array)) &
  7022)     deallocate(patch%material_property_array)
  7023)   nullify(patch%material_property_array)
  7024)   ! Since this linked list will be destroyed by realization, just nullify here
  7025)   nullify(patch%material_properties)
  7026)   if (associated(patch%saturation_function_array)) &
  7027)     deallocate(patch%saturation_function_array)
  7028)   nullify(patch%saturation_function_array)
  7029)   ! Since this linked list will be destroyed by realization, just nullify here
  7030)   nullify(patch%saturation_functions)
  7031)   if (associated(patch%characteristic_curves_array)) &
  7032)     deallocate(patch%characteristic_curves_array)
  7033)   nullify(patch%characteristic_curves_array)
  7034)   ! Since this linked list will be destroyed by realization, just nullify here
  7035)   nullify(patch%characteristic_curves)
  7036) 
  7037)   nullify(patch%surf_field)
  7038)   if (associated(patch%surf_material_property_array)) &
  7039)     deallocate(patch%surf_material_property_array)
  7040)   nullify(patch%surf_material_property_array)
  7041)   nullify(patch%surf_material_properties)
  7042) 
  7043)   ! solely nullify grid since destroyed in discretization
  7044)   nullify(patch%grid)
  7045)   call RegionDestroyList(patch%region_list)
  7046)   call CouplerDestroyList(patch%boundary_condition_list)
  7047)   call CouplerDestroyList(patch%initial_condition_list)
  7048)   call CouplerDestroyList(patch%source_sink_list)
  7049)   
  7050)   call ObservationDestroyList(patch%observation_list)
  7051)   call IntegralFluxDestroyList(patch%integral_flux_list)
  7052)   call StrataDestroyList(patch%strata_list)
  7053)   
  7054)   call AuxDestroy(patch%aux)
  7055)   call SurfaceAuxDestroy(patch%surf_aux)
  7056)   
  7057)   ! these are solely pointers, must not destroy.
  7058)   nullify(patch%reaction)
  7059)   nullify(patch%datasets)
  7060)   nullify(patch%field)
  7061)   
  7062)   deallocate(patch)
  7063)   nullify(patch)
  7064)   
  7065) end subroutine PatchDestroy
  7066) 
  7067) end module Patch_module

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