miscible.F90       coverage:  0.00 %func     0.00 %block


     1) module Miscible_module
     2)   
     3)   use Miscible_Aux_module
     4)   use Global_Aux_module
     5) 
     6)   use PFLOTRAN_Constants_module
     7) 
     8)   implicit none
     9)   
    10)   private 
    11) 
    12) #include "petsc/finclude/petscsys.h"
    13)   
    14) !#include "include/petscf90.h"
    15) #include "petsc/finclude/petscvec.h"
    16) #include "petsc/finclude/petscvec.h90"
    17)   ! It is VERY IMPORTANT to make sure that the above .h90 file gets included.
    18)   ! Otherwise some very strange things will happen and PETSc will give no
    19)   ! indication of what the problem is.
    20) #include "petsc/finclude/petscmat.h"
    21) #include "petsc/finclude/petscmat.h90"
    22) #include "petsc/finclude/petscdm.h"
    23) #include "petsc/finclude/petscdm.h90"
    24) !#ifdef USE_PETSC216
    25) !#include "petsc/finclude/petscsles.h"
    26) !#endif
    27) #include "petsc/finclude/petscsnes.h"
    28) #include "petsc/finclude/petscviewer.h"
    29) #include "petsc/finclude/petscsysdef.h"
    30) #include "petsc/finclude/petscis.h"
    31) #include "petsc/finclude/petscis.h90"
    32) #include "petsc/finclude/petsclog.h"
    33) #include "petsc/finclude/petscerror.h"
    34) 
    35) ! Cutoff parameters
    36)   PetscReal, parameter :: formeps = 1.D-4
    37)   PetscReal, parameter :: eps = 1.D-5 
    38)   PetscReal, parameter :: dfac = 1D-8
    39)   PetscReal, parameter :: floweps = 1.D-24
    40)   PetscReal, parameter :: zerocut =0.D0 
    41) 
    42)   PetscInt, parameter :: jh2o=1, jglyc=2
    43)   
    44)   public MiscibleResidual,MiscibleJacobian, &
    45)          MiscibleUpdateFixedAccumulation,MiscibleTimeCut, &
    46)          MiscibleSetup, &
    47)          MiscibleMaxChange, MiscibleUpdateSolution, &
    48)          MiscibleGetTecplotHeader, MiscibleInitializeTimestep, &
    49)          MiscibleUpdateAuxVars,MiscibleComputeMassBalance, &
    50)          MiscibleDestroy
    51) 
    52) contains
    53) 
    54) ! ************************************************************************** !
    55) 
    56) subroutine MiscibleTimeCut(realization)
    57)   ! 
    58)   ! Resets arrays for time step cut
    59)   ! 
    60)   ! Author: Chuan Lu
    61)   ! Date: 9/13/08
    62)   ! 
    63)  
    64)   use Realization_Subsurface_class
    65)   use Option_module
    66)   use Field_module
    67)  
    68)   implicit none
    69)   
    70)   type(realization_subsurface_type) :: realization
    71)   type(option_type), pointer :: option
    72)   type(field_type), pointer :: field
    73)   
    74)   PetscReal, pointer :: xx_p(:),yy_p(:)
    75)   PetscErrorCode :: ierr
    76)   PetscInt :: local_id
    77) 
    78)   option => realization%option
    79)   field => realization%field
    80) 
    81) end subroutine MiscibleTimeCut
    82) 
    83) ! ************************************************************************** !
    84) 
    85) subroutine MiscibleSetup(realization)
    86)   ! 
    87)   ! Author: Chuan Lu
    88)   ! Date: 9/13/08
    89)   ! 
    90) 
    91)   use Realization_Subsurface_class
    92)   use Patch_module
    93)   use Output_Aux_module
    94)    
    95)   type(realization_subsurface_type) :: realization
    96) 
    97)   type(output_variable_list_type), pointer :: list
    98)   type(patch_type), pointer :: cur_patch
    99)  
   100)   cur_patch => realization%patch_list%first
   101)   do
   102)     if (.not.associated(cur_patch)) exit
   103)     realization%patch => cur_patch
   104)     call MiscibleSetupPatch(realization)
   105)     cur_patch => cur_patch%next
   106)   enddo
   107) 
   108)   list => realization%output_option%output_snap_variable_list
   109)   call MiscibleSetPlotVariables(list)
   110)   list => realization%output_option%output_obs_variable_list
   111)   call MiscibleSetPlotVariables(list)
   112) 
   113) end subroutine MiscibleSetup
   114) 
   115) ! ************************************************************************** !
   116) 
   117) subroutine MiscibleSetupPatch(realization)
   118)   ! 
   119)   ! Creates arrays for auxiliary variables
   120)   ! 
   121)   ! Author: Chuan Lu
   122)   ! Date: 10/1/08
   123)   ! 
   124) 
   125)   use Realization_Subsurface_class
   126)   use Patch_module
   127)   use Option_module
   128)   use Coupler_module
   129)   use Connection_module
   130)   use Grid_module
   131)  
   132)   implicit none
   133)   
   134)   type(realization_subsurface_type) :: realization
   135) 
   136)   type(option_type), pointer :: option
   137)   type(patch_type),pointer :: patch
   138)   type(grid_type), pointer :: grid
   139)   type(coupler_type), pointer :: boundary_condition
   140) 
   141)   PetscInt :: ghosted_id, iconn, sum_connection, ipara
   142)   type(Miscible_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)  
   143)   
   144)   option => realization%option
   145)   patch => realization%patch
   146)   grid => patch%grid
   147)   patch%aux%Miscible => MiscibleAuxCreate()
   148)   
   149) !  option%io_buffer = 'Before Miscible can be run, the Miscible_parameter object ' // &
   150) !                     'must be initialized with the proper variables ' // &
   151) !                     'MiscibleAuxCreate() is called anyhwere.'
   152) !  call printErrMsg(option)
   153)      
   154) ! Miscible_parameters create *********************************************
   155)   allocate(patch%aux%Miscible%Miscible_parameter%sir(option%nphase, &
   156)                                   size(patch%saturation_function_array)))
   157)   do ipara = 1, size(patch%saturation_function_array)
   158)     patch%aux%Miscible%Miscible_parameter%sir(:,patch% &
   159)                        saturation_function_array(ipara)%ptr%id) = &
   160)       patch%saturation_function_array(ipara)%ptr%Sr(:)
   161)   enddo
   162)   
   163) ! dencpr  
   164)   allocate(patch%aux%Miscible%Miscible_parameter%dencpr(size(patch%material_property_array)))
   165)   do ipara = 1, size(patch%material_property_array)
   166)     patch%aux%Miscible%Miscible_parameter%dencpr(iabs(patch% &
   167)         material_property_array(ipara)%ptr%internal_id)) = &
   168)       patch%material_property_array(ipara)%ptr%rock_density*option%scale*&
   169)       patch%material_property_array(ipara)%ptr%specific_heat
   170)   enddo
   171)   
   172) ! ckwet
   173)   allocate(patch%aux%Miscible%Miscible_parameter%ckwet(size(patch%material_property_array)))
   174)   do ipara = 1, size(patch%material_property_array)
   175)     patch%aux%Miscible%Miscible_parameter%ckwet(iabs(patch% &
   176)         material_property_array(ipara)%ptr%internal_id)) = &
   177)       patch%material_property_array(ipara)%ptr%thermal_conductivity_wet*option%scale
   178)   enddo
   179) ! Miscible_parameters create_end *****************************************
   180) 
   181) ! allocate auxvar data structures for all grid cells  
   182)   allocate(auxvars(grid%ngmax))
   183)   do ghosted_id = 1, grid%ngmax
   184)     call MiscibleAuxVarInit(auxvars(ghosted_id),option)
   185)   enddo
   186)   patch%aux%Miscible%auxvars => auxvars
   187)   patch%aux%Miscible%num_aux = grid%ngmax
   188)   
   189)   ! count the number of boundary connections and allocate
   190)   ! auxvar data structures for them  
   191)   boundary_condition => patch%boundary_condition_list%first
   192)   sum_connection = 0    
   193)   do 
   194)     if (.not.associated(boundary_condition)) exit
   195)     sum_connection = sum_connection + &
   196)                      boundary_condition%connection_set%num_connections
   197)     boundary_condition => boundary_condition%next
   198)   enddo
   199)   allocate(auxvars_bc(sum_connection))
   200)   do iconn = 1, sum_connection
   201)     call MiscibleAuxVarInit(auxvars_bc(iconn),option)
   202)   enddo
   203)   patch%aux%Miscible%auxvars_bc => auxvars_bc
   204)   patch%aux%Miscible%num_aux_bc = sum_connection
   205)   option%flow%numerical_derivatives = PETSC_TRUE
   206)   
   207)   allocate(patch%aux%Miscible%delx(option%nflowdof, grid%ngmax))
   208)   allocate(patch%aux%Miscible%Resold_AR(grid%nlmax,option%nflowdof))
   209)   allocate(patch%aux%Miscible%Resold_BC(grid%nlmax,option%nflowdof))
   210)   ! should be allocated by the number of BC connections, just for debug now
   211)   allocate(patch%aux%Miscible%Resold_FL(ConnectionGetNumberInList(patch%grid%&
   212)            internal_connection_set_list),option%nflowdof))
   213) 
   214) end subroutine MiscibleSetupPatch
   215) 
   216) ! ************************************************************************** !
   217) 
   218) subroutine MiscibleComputeMassBalance(realization,mass_balance)
   219)   ! 
   220)   ! Adapted from RichardsComputeMassBalance: need to be checked
   221)   ! 
   222)   ! Author: Jitendra Kumar
   223)   ! Date: 07/21/2010
   224)   ! 
   225) 
   226)   use Realization_Subsurface_class
   227)   use Patch_module
   228) 
   229)   type(realization_subsurface_type) :: realization
   230)   PetscReal :: mass_balance(realization%option%nflowspec,1)
   231)    
   232)   type(patch_type), pointer :: cur_patch
   233) 
   234)   mass_balance = 0.d0
   235) 
   236)   cur_patch => realization%patch_list%first
   237)   do
   238)     if (.not.associated(cur_patch)) exit
   239)     realization%patch => cur_patch
   240)     call MiscibleComputeMassBalancePatch(realization,mass_balance)
   241)     cur_patch => cur_patch%next
   242)   enddo
   243) 
   244) end subroutine MiscibleComputeMassBalance    
   245) 
   246) ! ************************************************************************** !
   247) 
   248) subroutine MiscibleComputeMassBalancePatch(realization,mass_balance)
   249)   ! 
   250)   ! Adapted from RichardsComputeMassBalancePatch: need to be checked
   251)   ! 
   252)   ! Author: Jitendra Kumar
   253)   ! Date: 07/21/2010
   254)   ! 
   255)  
   256)   use Realization_Subsurface_class
   257)   use Option_module
   258)   use Patch_module
   259)   use Field_module
   260)   use Grid_module
   261)  
   262)   implicit none
   263)   
   264)   type(realization_subsurface_type) :: realization
   265)   PetscReal :: mass_balance(realization%option%nflowspec,1)
   266) 
   267)   type(option_type), pointer :: option
   268)   type(patch_type), pointer :: patch
   269)   type(field_type), pointer :: field
   270)   type(grid_type), pointer :: grid
   271)   type(miscible_auxvar_type), pointer :: miscible_auxvars(:)
   272)   type(global_auxvar_type), pointer :: global_auxvars(:)
   273)   PetscReal, pointer :: volume_p(:), porosity_loc_p(:)
   274) 
   275)   PetscErrorCode :: ierr
   276)   PetscInt :: local_id
   277)   PetscInt :: ghosted_id
   278)   PetscInt :: ispec
   279)   PetscInt :: jh2o=1,jglyc=2
   280)   
   281)   option => realization%option
   282)   patch => realization%patch
   283)   grid => patch%grid
   284)   field => realization%field
   285) 
   286)   global_auxvars => patch%aux%Global%auxvars
   287)   miscible_auxvars => patch%aux%Miscible%auxvars
   288) 
   289) !geh refactor  call VecGetArrayF90(field%volume,volume_p,ierr)
   290) !geh refactor  call VecGetArrayF90(field%porosity_loc,porosity_loc_p,ierr)
   291) 
   292)   do local_id = 1, grid%nlmax
   293)     ghosted_id = grid%nL2G(local_id)
   294)     !geh - Ignore inactive cells with inactive materials
   295)     if (associated(patch%imat)) then
   296)       if (patch%imat(ghosted_id) <= 0) cycle
   297)     endif
   298)     ! mass = saturation * density * mole fraction * volume
   299)     do ispec = 1,option%nflowspec
   300)       mass_balance(ispec,1) = mass_balance(ispec,1) + &
   301)         miscible_auxvars(ghosted_id)%auxvar_elem(0)%xmol(ispec)* &
   302)         global_auxvars(ghosted_id)%den(1)* &
   303)         porosity_loc_p(ghosted_id)*volume_p(local_id)
   304)     enddo
   305)   enddo
   306)   mass_balance(jh2o,1) = mass_balance(jh2o,1)*FMWH2O
   307)   mass_balance(jglyc,1) = mass_balance(jglyc,1)*FMWGLYC
   308) 
   309) !geh refactor  call VecRestoreArrayF90(field%volume,volume_p,ierr)
   310) !geh refactor  call VecRestoreArrayF90(field%porosity_loc,porosity_loc_p,ierr)
   311)   
   312) end subroutine MiscibleComputeMassBalancePatch
   313) 
   314) ! ************************************************************************** !
   315) 
   316) subroutine MiscibleZeroMassBalDeltaPatch(realization)
   317)   ! 
   318)   ! Zeros mass balance delta array
   319)   ! 
   320)   ! Author: Satish Karra, LANL
   321)   ! Date: 12/13/11
   322)   ! 
   323)  
   324)   use Realization_Subsurface_class
   325)   use Option_module
   326)   use Patch_module
   327)   use Grid_module
   328)  
   329)   implicit none
   330)   
   331)   type(realization_subsurface_type) :: realization
   332) 
   333)   type(option_type), pointer :: option
   334)   type(patch_type), pointer :: patch
   335)   type(global_auxvar_type), pointer :: global_auxvars_bc(:)
   336)   type(global_auxvar_type), pointer :: global_auxvars_ss(:)
   337) 
   338)   PetscInt :: iconn
   339) 
   340)   option => realization%option
   341)   patch => realization%patch
   342) 
   343)   global_auxvars_bc => patch%aux%Global%auxvars_bc
   344)   global_auxvars_ss => patch%aux%Global%auxvars_ss
   345) 
   346) #ifdef COMPUTE_INTERNAL_MASS_FLUX
   347)   do iconn = 1, patch%aux%Miscible%num_aux
   348)     patch%aux%Global%auxvars(iconn)%mass_balance_delta = 0.d0
   349)   enddo
   350) #endif
   351) 
   352)   ! Intel 10.1 on Chinook reports a SEGV if this conditional is not
   353)   ! placed around the internal do loop - geh
   354)   if (patch%aux%Miscible%num_aux_bc > 0) then
   355)     do iconn = 1, patch%aux%Miscible%num_aux_bc
   356)       global_auxvars_bc(iconn)%mass_balance_delta = 0.d0
   357)     enddo
   358)   endif
   359)   if (patch%aux%Miscible%num_aux_ss > 0) then
   360)     do iconn = 1, patch%aux%Miscible%num_aux_ss
   361)       global_auxvars_ss(iconn)%mass_balance_delta = 0.d0
   362)     enddo
   363)   endif
   364)  
   365) end subroutine MiscibleZeroMassBalDeltaPatch
   366) 
   367) ! ************************************************************************** !
   368) 
   369) subroutine MiscibleUpdateMassBalancePatch(realization)
   370)   ! 
   371)   ! Updates mass balance
   372)   ! 
   373)   ! Author: Glenn Hammond
   374)   ! Date: 12/13/11
   375)   ! 
   376)  
   377)   use Realization_Subsurface_class
   378)   use Option_module
   379)   use Patch_module
   380)   use Grid_module
   381)  
   382)   implicit none
   383)   
   384)   type(realization_subsurface_type) :: realization
   385) 
   386)   type(option_type), pointer :: option
   387)   type(patch_type), pointer :: patch
   388)   type(global_auxvar_type), pointer :: global_auxvars_bc(:)
   389)   type(global_auxvar_type), pointer :: global_auxvars_ss(:)
   390) 
   391)   PetscInt :: iconn
   392) 
   393)   option => realization%option
   394)   patch => realization%patch
   395) 
   396)   global_auxvars_bc => patch%aux%Global%auxvars_bc
   397)   global_auxvars_ss => patch%aux%Global%auxvars_ss
   398) 
   399) #ifdef COMPUTE_INTERNAL_MASS_FLUX
   400)   do iconn = 1, patch%aux%Miscible%num_aux
   401)     patch%aux%Global%auxvars(iconn)%mass_balance = &
   402)       patch%aux%Global%auxvars(iconn)%mass_balance + &
   403)       patch%aux%Global%auxvars(iconn)%mass_balance_delta* &
   404)       option%flow_dt
   405)   enddo
   406) #endif
   407) 
   408)   if (patch%aux%Miscible%num_aux_bc > 0) then
   409)     do iconn = 1, patch%aux%Miscible%num_aux_bc
   410)       global_auxvars_bc(iconn)%mass_balance = &
   411)         global_auxvars_bc(iconn)%mass_balance + &
   412)         global_auxvars_bc(iconn)%mass_balance_delta*option%flow_dt
   413)     enddo
   414)   endif
   415) 
   416)   if (patch%aux%Miscible%num_aux_ss > 0) then
   417)     do iconn = 1, patch%aux%Miscible%num_aux_ss
   418)       global_auxvars_bc(iconn)%mass_balance = &
   419)         global_auxvars_bc(iconn)%mass_balance + &
   420)         global_auxvars_bc(iconn)%mass_balance_delta*option%flow_dt
   421)     enddo
   422)   endif
   423) 
   424) 
   425) end subroutine MiscibleUpdateMassBalancePatch
   426) 
   427) ! ************************************************************************** !
   428) 
   429)   function MiscibleInitGuessCheck(realization)
   430)   ! 
   431)   ! MiscibleInitGuessCheckPatch:
   432)   ! 
   433)   ! Author: Chuan Lu
   434)   ! Date: 12/10/07
   435)   ! 
   436)  
   437)   use Realization_Subsurface_class
   438)   use Patch_module
   439)   use Option_module
   440)   
   441)   PetscInt ::  MiscibleInitGuessCheck
   442)   type(realization_subsurface_type) :: realization
   443)   type(option_type), pointer :: option
   444)   type(patch_type), pointer :: cur_patch
   445)   PetscInt :: ipass, ipass0
   446)   PetscErrorCode :: ierr
   447) 
   448)   option => realization%option
   449)   ipass = 1
   450)   cur_patch => realization%patch_list%first
   451)   do
   452)     if (.not.associated(cur_patch)) exit
   453)     realization%patch => cur_patch
   454)     ipass= MiscibleInitGuessCheckPatch(realization)
   455)     if (ipass<=0)then
   456)       exit 
   457)     endif
   458)     cur_patch => cur_patch%next
   459)   enddo
   460) 
   461)   call MPI_Barrier(option%mycomm,ierr)
   462)   if (option%mycommsize >1)then
   463)     call MPI_Allreduce(ipass,ipass0,ONE_INTEGER_MPI,MPIU_INTEGER,MPI_SUM, &
   464)                        option%mycomm,ierr)
   465)     if (ipass0 < option%mycommsize) ipass=-1
   466)   endif
   467)    MiscibleInitGuessCheck =ipass
   468) 
   469) end function MiscibleInitGuessCheck
   470) 
   471) ! ************************************************************************** !
   472) 
   473)   function MiscibleInitGuessCheckPatch(realization)
   474)   ! 
   475)   ! Author: Chuan Lu
   476)   ! Date: 10/10/08
   477)   ! 
   478)    
   479)     use co2_span_wagner_module
   480)      
   481)     use Realization_Subsurface_class
   482)     use Patch_module
   483)     use Field_module
   484)     use Grid_module
   485)     use Option_module
   486)     implicit none
   487)     
   488)     PetscInt :: MiscibleInitGuessCheckPatch 
   489)     type(realization_subsurface_type) :: realization
   490)     type(grid_type), pointer :: grid
   491)     type(patch_type), pointer :: patch
   492)     type(option_type), pointer :: option
   493)     type(field_type), pointer :: field
   494)       
   495)     PetscInt :: local_id, ghosted_id, ipass
   496)     PetscErrorCode :: ierr
   497)     PetscReal, pointer :: xx_p(:)
   498) 
   499)     patch => realization%patch
   500)     grid => patch%grid
   501)     option => realization%option
   502)     field => realization%field
   503)     
   504) !geh: not sure why this is here, therefore, commenting out.
   505) !    call VecGetArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
   506)     
   507)     ipass=1
   508)     MiscibleInitGuessCheckPatch = ipass
   509)   end function MiscibleInitGuessCheckPatch
   510) 
   511) ! ************************************************************************** !
   512) 
   513) subroutine MiscibleUpdateAuxVars(realization)
   514)   ! 
   515)   ! Updates the auxiliary variables associated with
   516)   ! the Miscible problem
   517)   ! 
   518)   ! Author: Chuan Lu
   519)   ! Date: 10/10/08
   520)   ! 
   521) 
   522)   use Realization_Subsurface_class
   523)   use Patch_module
   524) 
   525)   type(realization_subsurface_type) :: realization
   526)   
   527)   type(patch_type), pointer :: cur_patch
   528)   
   529)   cur_patch => realization%patch_list%first
   530)   do
   531)     if (.not.associated(cur_patch)) exit
   532)     realization%patch => cur_patch
   533)     call MiscibleUpdateAuxVarsPatch(realization)
   534)     cur_patch => cur_patch%next
   535)   enddo
   536) 
   537) end subroutine MiscibleUpdateAuxVars
   538) 
   539) ! ************************************************************************** !
   540) 
   541) subroutine MiscibleUpdateAuxVarsPatch(realization)
   542)   ! 
   543)   ! Updates the auxiliary variables associated with
   544)   ! the Miscible problem
   545)   ! 
   546)   ! Author: Chuan Lu
   547)   ! Date: 12/10/07
   548)   ! 
   549) 
   550)   use Realization_Subsurface_class
   551)   use Patch_module
   552)   use Field_module
   553)   use Option_module
   554)   use Grid_module
   555)   use Coupler_module
   556)   use Connection_module
   557)   use Material_module
   558)   
   559)   implicit none
   560) 
   561)   type(realization_subsurface_type) :: realization
   562)   
   563)   type(option_type), pointer :: option
   564)   type(patch_type), pointer :: patch
   565)   type(grid_type), pointer :: grid
   566)   type(field_type), pointer :: field
   567)   type(coupler_type), pointer :: boundary_condition
   568)   type(connection_set_type), pointer :: cur_connection_set
   569)   type(Miscible_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
   570)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
   571) 
   572)   PetscInt :: ghosted_id, local_id, istart, iend, sum_connection, idof, iconn
   573)   PetscInt :: iphasebc, iphase
   574)   PetscReal, pointer :: xx_loc_p(:), icap_loc_p(:), iphase_loc_p(:)
   575)   PetscReal :: xxbc(realization%option%nflowdof)
   576)   PetscReal :: mnacl, ynacl, xphi
   577)   PetscErrorCode :: ierr
   578)   
   579)   option => realization%option
   580)   patch => realization%patch
   581)   grid => patch%grid
   582)   field => realization%field
   583)   
   584)   auxvars => patch%aux%Miscible%auxvars
   585)   auxvars_bc => patch%aux%Miscible%auxvars_bc
   586)   global_auxvars => patch%aux%Global%auxvars
   587)   global_auxvars_bc => patch%aux%Global%auxvars_bc
   588) 
   589)   
   590)   call VecGetArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
   591)   call VecGetArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
   592) 
   593)   do ghosted_id = 1, grid%ngmax
   594)     if (grid%nG2L(ghosted_id) < 0) cycle ! bypass ghosted corner cells
   595)     !geh - Ignore inactive cells with inactive materials
   596)     if (associated(patch%imat)) then
   597)       if (patch%imat(ghosted_id) <= 0) cycle
   598)     endif
   599)     iend = ghosted_id*option%nflowdof
   600)     istart = iend-option%nflowdof+1
   601)     if (.not. associated(patch%saturation_function_array(int(icap_loc_p(ghosted_id)))%ptr))then
   602)        print*, 'error!!! saturation function not allocated', ghosted_id,icap_loc_p(ghosted_id)
   603)     endif
   604)     
   605)     call MiscibleAuxVarCompute_NINC(xx_loc_p(istart:iend), &
   606)                        auxvars(ghosted_id)%auxvar_elem(0), &
   607)                        global_auxvars(ghosted_id), &
   608)                        realization%fluid_properties,option)
   609)                       
   610) !   update global variables
   611)     if ( associated(global_auxvars))then
   612)       global_auxvars(ghosted_id)%pres = auxvars(ghosted_id)%auxvar_elem(0)%pres
   613)       global_auxvars(ghosted_id)%sat(:) = 1D0
   614)       global_auxvars(ghosted_id)%den(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:)
   615)       global_auxvars(ghosted_id)%den_kg(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:) &
   616)                                           *auxvars(ghosted_id)%auxvar_elem(0)%avgmw(:)
   617)     else
   618)       print *,'Not associated global for Miscible'
   619)     endif
   620) 
   621)   enddo
   622) 
   623)   boundary_condition => patch%boundary_condition_list%first
   624)   sum_connection = 0    
   625)   do 
   626)     if (.not.associated(boundary_condition)) exit
   627)     cur_connection_set => boundary_condition%connection_set
   628)     do iconn = 1, cur_connection_set%num_connections
   629)       sum_connection = sum_connection + 1
   630)       local_id = cur_connection_set%id_dn(iconn)
   631)       ghosted_id = grid%nL2G(local_id)
   632)       if (associated(patch%imat)) then
   633)         if (patch%imat(ghosted_id) <= 0) cycle
   634)       endif
   635)       do idof=1,option%nflowdof
   636)         select case(boundary_condition%flow_condition%itype(idof))
   637)           case(DIRICHLET_BC,HYDROSTATIC_BC)
   638)             xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
   639)           case(NEUMANN_BC,ZERO_GRADIENT_BC)
   640)             xxbc(:) = xx_loc_p((ghosted_id-1)*option%nflowdof+1:ghosted_id*option%nflowdof)
   641)         end select
   642)       enddo
   643)  
   644)       call MiscibleAuxVarCompute_NINC(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0), &
   645)                          global_auxvars_bc(sum_connection), &
   646)                          realization%fluid_properties, option)
   647) 
   648)       if (associated(global_auxvars_bc)) then
   649)         global_auxvars_bc(sum_connection)%pres(:)= auxvars_bc(sum_connection)%auxvar_elem(0)%pres
   650)         global_auxvars_bc(sum_connection)%sat(:)=1.D0
   651)         global_auxvars_bc(sum_connection)%den(:)=auxvars_bc(sum_connection)%auxvar_elem(0)%den(:)
   652)         global_auxvars_bc(sum_connection)%den_kg = auxvars_bc(sum_connection)%auxvar_elem(0)%den(:) &
   653)             * auxvars_bc(sum_connection)%auxvar_elem(0)%avgmw(:)
   654)       endif
   655) 
   656)     enddo
   657)     boundary_condition => boundary_condition%next
   658)   enddo
   659) 
   660)   call VecRestoreArrayF90(field%flow_xx_loc,xx_loc_p, ierr);CHKERRQ(ierr)
   661)   call VecRestoreArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
   662)   
   663)   patch%aux%Miscible%auxvars_up_to_date = PETSC_TRUE
   664) 
   665) end subroutine MiscibleUpdateAuxVarsPatch
   666) 
   667) ! ************************************************************************** !
   668) 
   669) subroutine MiscibleInitializeTimestep(realization)
   670)   ! 
   671)   ! Update data in module prior to time step
   672)   ! 
   673)   ! Author: Chuan Lu
   674)   ! Date: 10/12/08
   675)   ! 
   676) 
   677)   use Realization_Subsurface_class
   678)   
   679)   implicit none
   680)   
   681)   type(realization_subsurface_type) :: realization
   682) 
   683)   call MiscibleUpdateFixedAccumulation(realization)
   684) 
   685) end subroutine MiscibleInitializeTimestep
   686) 
   687) ! ************************************************************************** !
   688) 
   689) subroutine MiscibleUpdateSolution(realization)
   690)   ! 
   691)   ! Updates data in module after a successful time step
   692)   ! 
   693)   ! Author: Chuan Lu
   694)   ! Date: 10/13/08
   695)   ! 
   696) 
   697)   use Realization_Subsurface_class
   698)   use Field_module
   699)   use Patch_module
   700)   
   701)   implicit none
   702)   
   703)   type(realization_subsurface_type) :: realization
   704)   
   705)   type(field_type), pointer :: field
   706)   type(patch_type), pointer :: cur_patch
   707) 
   708)   PetscErrorCode :: ierr
   709)   
   710)   field => realization%field
   711)   
   712)   cur_patch => realization%patch_list%first
   713)   do 
   714)     if (.not.associated(cur_patch)) exit
   715)     realization%patch => cur_patch
   716)     call MiscibleUpdateSolutionPatch(realization)
   717)     cur_patch => cur_patch%next
   718)   enddo
   719) 
   720) end subroutine MiscibleUpdateSolution
   721) 
   722) ! ************************************************************************** !
   723) 
   724) subroutine MiscibleUpdateSolutionPatch(realization)
   725)   ! 
   726)   ! Updates data in module after a successful time
   727)   ! step
   728)   ! written based on RichardsUpdateSolutionPatch
   729)   ! 
   730)   ! Author: Satish Karra, LANL
   731)   ! Date: 08/23/11
   732)   ! 
   733) 
   734)   use Realization_Subsurface_class
   735)     
   736)   implicit none
   737)   
   738)   type(realization_subsurface_type) :: realization
   739) 
   740)   if (realization%option%compute_mass_balance_new) then
   741)     call MiscibleUpdateMassBalancePatch(realization)
   742)   endif
   743) 
   744) end subroutine MiscibleUpdateSolutionPatch
   745) 
   746) ! ************************************************************************** !
   747) 
   748) subroutine MiscibleUpdateFixedAccumulation(realization)
   749)   ! 
   750)   ! Updates the fixed portion of the
   751)   ! accumulation term
   752)   ! 
   753)   ! Author: Chuan Lu
   754)   ! Date: 10/12/08
   755)   ! 
   756) 
   757)   use Realization_Subsurface_class
   758)   use Patch_module
   759) 
   760)   type(realization_subsurface_type) :: realization
   761)   
   762)   type(patch_type), pointer :: cur_patch
   763)   
   764)   cur_patch => realization%patch_list%first
   765)   do
   766)     if (.not.associated(cur_patch)) exit
   767)     realization%patch => cur_patch
   768)     call MiscibleUpdateFixedAccumPatch(realization)
   769)     cur_patch => cur_patch%next
   770)   enddo
   771) 
   772) end subroutine MiscibleUpdateFixedAccumulation
   773) 
   774) ! ************************************************************************** !
   775) 
   776) subroutine MiscibleUpdateFixedAccumPatch(realization)
   777)   ! 
   778)   ! Updates the fixed portion of the
   779)   ! accumulation term
   780)   ! 
   781)   ! Author: Chuan Lu
   782)   ! Date: 10/12/08
   783)   ! 
   784) 
   785)   use Realization_Subsurface_class
   786)   use Patch_module
   787)   use Option_module
   788)   use Field_module
   789)   use Grid_module
   790) 
   791)   implicit none
   792)   
   793)   type(realization_subsurface_type) :: realization
   794)   
   795)   type(option_type), pointer :: option
   796)   type(patch_type), pointer :: patch
   797)   type(grid_type), pointer :: grid
   798)   type(field_type), pointer :: field
   799)   type(Miscible_parameter_type), pointer :: Miscible_parameter
   800)   type(Miscible_auxvar_type), pointer :: auxvars(:)
   801)   type(global_auxvar_type), pointer :: global_auxvars(:)
   802) 
   803)   PetscInt :: ghosted_id, local_id, istart, iend, iphase
   804)   PetscReal, pointer :: xx_p(:), icap_loc_p(:), iphase_loc_p(:)
   805)   PetscReal, pointer :: porosity_loc_p(:), tortuosity_loc_p(:), volume_p(:), &
   806)                         ithrm_loc_p(:), accum_p(:)
   807)                           
   808)   PetscErrorCode :: ierr
   809)   
   810)   call MiscibleUpdateAuxVarsPatch(realization) 
   811)   option => realization%option
   812)   field => realization%field
   813)   patch => realization%patch
   814)   grid => patch%grid
   815) 
   816)   global_auxvars => patch%aux%Global%auxvars
   817)   Miscible_parameter => patch%aux%Miscible%Miscible_parameter
   818)   auxvars => patch%aux%Miscible%auxvars
   819)     
   820)   call VecGetArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
   821)   call VecGetArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
   822) !geh refactor  call VecGetArrayF90(field%porosity_loc,porosity_loc_p,ierr)
   823) !geh refactor  call VecGetArrayF90(field%tortuosity_loc,tortuosity_loc_p,ierr)
   824) !geh refactor  call VecGetArrayF90(field%volume,volume_p,ierr)
   825)   call VecGetArrayF90(field%ithrm_loc,ithrm_loc_p,ierr);CHKERRQ(ierr)
   826)   call VecGetArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
   827) 
   828)   do local_id = 1, grid%nlmax
   829)     ghosted_id = grid%nL2G(local_id)
   830)     !geh - Ignore inactive cells with inactive materials
   831)     if (associated(patch%imat)) then
   832)       if (patch%imat(ghosted_id) <= 0) cycle
   833)     endif
   834)     iend = local_id*option%nflowdof
   835)     istart = iend-option%nflowdof+1
   836) 
   837)     call MiscibleAccumulation(auxvars(ghosted_id)%auxvar_elem(0), &
   838)                               global_auxvars(ghosted_id), &
   839)                               porosity_loc_p(ghosted_id), &
   840)                               volume_p(local_id), &
   841)                               Miscible_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
   842)                               option,accum_p(istart:iend)) 
   843)   enddo
   844) 
   845)   call VecRestoreArrayReadF90(field%flow_xx,xx_p, ierr);CHKERRQ(ierr)
   846)   call VecRestoreArrayF90(field%icap_loc,icap_loc_p,ierr);CHKERRQ(ierr)
   847) !geh refactor  call VecRestoreArrayF90(field%porosity_loc,porosity_loc_p,ierr)
   848) !geh refactor  call VecRestoreArrayF90(field%tortuosity_loc,tortuosity_loc_p,ierr)
   849) !geh refactor  call VecRestoreArrayF90(field%volume,volume_p,ierr)
   850)   call VecRestoreArrayF90(field%ithrm_loc,ithrm_loc_p,ierr);CHKERRQ(ierr)
   851) 
   852)   call VecRestoreArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
   853) 
   854) end subroutine MiscibleUpdateFixedAccumPatch
   855) 
   856) ! ************************************************************************** !
   857) 
   858) subroutine MiscibleAccumulation(auxvar,global_auxvar,por,vol,rock_dencpr,option,Res)
   859)   ! 
   860)   ! Computes the non-fixed portion of the accumulation
   861)   ! term for the residual
   862)   ! 
   863)   ! Author: Chuan Lu
   864)   ! Date: 10/12/08
   865)   ! 
   866) 
   867)   use Option_module
   868)   
   869)   implicit none
   870) 
   871)   type(Miscible_auxvar_elem_type) :: auxvar
   872)   type(option_type) :: option
   873)   type(global_auxvar_type) :: global_auxvar
   874)   PetscReal :: Res(1:option%nflowdof) 
   875)   PetscReal :: vol,por,rock_dencpr
   876)      
   877)   PetscInt :: ispec, np
   878)   PetscReal :: porXvol, mol(option%nflowspec)
   879) 
   880)   porXvol = por*vol
   881)   mol=0.d0
   882)   do np = 1, option%nphase
   883)     do ispec = 1, option%nflowspec  
   884)       mol(ispec) = mol(ispec) + &
   885)         auxvar%den(np) * auxvar%xmol(ispec + (np-1)*option%nflowspec)
   886)     enddo
   887)   enddo
   888)   mol = mol*porXvol
   889)   Res(1:option%nflowspec) = mol(:)
   890) 
   891) end subroutine MiscibleAccumulation
   892) 
   893) ! ************************************************************************** !
   894) 
   895) subroutine MiscibleAccumulation_Xp(auxvar,global_auxvar,por,vol,rock_dencpr,option,Res)
   896)   ! 
   897)   ! MiscibleAccumulation: Computes the non-fixed portion of the accumulation
   898)   ! term for the residual
   899)   ! 
   900)   ! Author: Chuan Lu
   901)   ! Date: 10/12/08
   902)   ! 
   903) 
   904) use Option_module
   905) 
   906) implicit none
   907) 
   908) type(Miscible_auxvar_elem_type) :: auxvar
   909) type(option_type) :: option
   910) type(global_auxvar_type) :: global_auxvar
   911) PetscReal :: Res(1:option%nflowdof) 
   912) PetscReal :: vol,por,rock_dencpr
   913) 
   914) PetscInt :: ispec, np
   915) PetscReal :: porXvol, mol(option%nflowspec)
   916) 
   917) porXvol = por*vol
   918) mol = 0.d0
   919) np = 1
   920) 
   921) ! pressure equation
   922) ispec = 1
   923) mol(ispec) = mol(ispec) + auxvar%den(np)
   924) 
   925) !PPG
   926) ispec = 2
   927) mol(ispec) = mol(ispec) + &
   928) auxvar%den(np) * auxvar%xmol(ispec + (np-1)*option%nflowspec)
   929) 
   930) mol = mol*porXvol
   931) Res(1:option%nflowspec) = mol(:)
   932) 
   933) end subroutine MiscibleAccumulation_Xp
   934) 
   935) ! ************************************************************************** !
   936) 
   937) subroutine MiscibleSourceSink(mmsrc,nsrcpara,psrc,tsrc,hsrc,csrc,auxvar,isrctype,Res,&
   938)                               qsrc_vol,energy_flag, option)
   939)   ! 
   940)   ! Computes the non-fixed portion of the accumulation
   941)   ! term for the residual
   942)   ! 
   943)   ! Author: Chuan Lu
   944)   ! Date: 10/12/08
   945)   ! 
   946) 
   947)   use Option_module
   948)   
   949)   
   950)   use EOS_Water_module
   951)   use co2eos_module
   952)   use co2_span_wagner_spline_module, only: sw_prop
   953)   use co2_sw_module, only: co2_sw_interp
   954)   use co2_span_wagner_module 
   955)   
   956)   implicit none
   957) 
   958)   type(Miscible_auxvar_elem_type) :: auxvar
   959)   type(option_type) :: option
   960)   PetscReal Res(1:option%nflowdof) 
   961)   PetscReal, pointer :: mmsrc(:)
   962)   PetscReal psrc(option%nphase),tsrc,hsrc, csrc 
   963)   PetscInt isrctype, nsrcpara
   964)   PetscBool :: energy_flag
   965)   PetscReal :: qsrc_vol(option%nphase)
   966)      
   967)   PetscReal, pointer :: msrc(:)
   968)   PetscReal dw_kg, dw_mol,dddt,dddp
   969)   PetscReal :: enth_src_h2o, enth_src_co2 
   970)   PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
   971)   PetscReal :: ukvr, v_darcy, dq, dphi
   972)   PetscReal :: well_status, well_diameter
   973)   PetscReal :: pressure_bh, well_factor, pressure_max, pressure_min
   974)   PetscReal :: well_inj_water, well_inj_co2
   975)   PetscInt :: np
   976)   PetscInt :: iflag
   977)   PetscErrorCode :: ierr
   978)   
   979)   Res=0D0
   980)   allocate(msrc(nsrcpara))
   981)   msrc = mmsrc(1:nsrcpara)
   982)   qsrc_vol(:) = 0.d0
   983)  ! if (present(ireac)) iireac=ireac
   984) !  if (energy_flag) then
   985) !    Res(option%nflowdof) = Res(option%nflowdof) + hsrc * option%flow_dt   
   986) !  endif         
   987)  
   988)   select case(isrctype)
   989)     case(MASS_RATE_SS)
   990)       msrc(1) = msrc(1) / FMWH2O
   991)       msrc(2) = msrc(2) / FMWGLYC
   992)       if (msrc(1) /= 0.d0 .or. msrc(2) /= 0.d0) then ! H2O injection
   993) !        call EOSWaterDensityEnthalpy(tsrc,auxvar%pres,dw_kg,dw_mol,enth_src_h2o,ierr)
   994)         ! J/kmol -> whatever units
   995)         !enth_src_h2o = enth_src_h2o * option%scale
   996) !           units: dw_mol [mol/dm^3]; dw_kg [kg/m^3]
   997) !           qqsrc = qsrc1/dw_mol ! [kmol/s (mol/dm^3 = kmol/m^3)]
   998)         Res(jh2o) = Res(jh2o) + msrc(1)*option%flow_dt
   999)         Res(jglyc) = Res(jglyc) + msrc(2)*option%flow_dt
  1000)       endif  
  1001) #if 0   
  1002)  !  End of mass rate inplementation
  1003)     case(WELL_SS) ! production well
  1004)      !if node pessure is lower than the given extraction pressure, shut it down
  1005)     ! Flow term
  1006) !  well parameter explaination
  1007) !   1. well status. 1 injection; -1 production; 0 shut in
  1008) !                   2 rate controled injection (same as rate_ss, with max pressure control, not completed yet) 
  1009) !                  -2 rate controled production(not implemented for now) 
  1010) !
  1011) !   2. well factor [m^3],  the effective permeability [m^2/s]
  1012) !   3. bottomhole pressure:  [Pa]
  1013) !   4. max pressure: [Pa]
  1014) !   5. min pressure: [Pa]   
  1015) !   6. preferred mass flux of water [kg/s]
  1016) !   7. preferred mass flux of CO2 [kg/s]
  1017) !   8. well diameter, not used now
  1018) !   9. skin factor, not used now
  1019) 
  1020)       well_status = msrc(1)
  1021)       well_factor = msrc(2)
  1022)       pressure_bh = msrc(3)
  1023)       pressure_max = msrc(4)
  1024)       pressure_min = msrc(5)
  1025)       well_inj_water = msrc(6)
  1026)       well_inj_co2 = msrc(7)
  1027)     
  1028) !     if (pressure_min < 0D0) pressure_min = 0D0 !not limited by pressure lower bound   
  1029) 
  1030)     ! production well (well status = -1)
  1031)       if (dabs(well_status + 1D0) < 1D-1) then 
  1032)         if (auxvar%pres > pressure_min) then
  1033)           Dq = well_factor 
  1034)           do np = 1, option%nphase
  1035)             dphi = auxvar%pres - auxvar%pc(np) - pressure_bh
  1036)             if (dphi>=0.D0) then ! outflow only
  1037)               ukvr = auxvar%kvr(np)
  1038)               if (ukvr<1e-20) ukvr=0D0
  1039)               v_darcy=0D0
  1040)               if (ukvr*Dq>floweps) then
  1041)                 v_darcy = Dq * ukvr * dphi
  1042)                 ! store volumetric rate for ss_fluid_fluxes()
  1043)                 qsrc_liq(1) = -1.d0*v_darcy
  1044)                 Res(1) = Res(1) - v_darcy* auxvar%den(np)* &
  1045)                   auxvar%xmol((np-1)*option%nflowspec+1)*option%flow_dt
  1046)                 Res(2) = Res(2) - v_darcy* auxvar%den(np)* &
  1047)                   auxvar%xmol((np-1)*option%nflowspec+2)*option%flow_dt
  1048)                 if (energy_flag) Res(3) = Res(3) - v_darcy * auxvar%den(np)* &
  1049)                   auxvar%h(np)*option%flow_dt
  1050)               ! print *,'produce: ',np,v_darcy
  1051)               endif
  1052)             endif
  1053)           enddo
  1054)         endif
  1055)       endif 
  1056)      !print *,'well-prod: ',  auxvar%pres,psrc(1), res
  1057)     ! injection well (well status = 2)
  1058)       if (dabs(well_status - 2D0) < 1D-1) then 
  1059) 
  1060)         call EOSWaterDensity(tsrc,auxvar%pres,dw_kg,dw_mol,ierr)
  1061)         call EOSWaterEnthalpy(tsrc,auxvar%pres,enth_src_h2o,ierr)
  1062)         ! J/kmol -> whatever units
  1063)         enth_src_h2o = enth_src_h2o * option%scale
  1064)         
  1065)         Dq = msrc(2) ! well parameter, read in input file
  1066)                       ! Take the place of 2nd parameter 
  1067)         ! Flow term
  1068)         if (auxvar%pres < pressure_max) then  
  1069)           do np = 1, option%nphase
  1070)             dphi = pressure_bh - auxvar%pres + auxvar%pc(np)
  1071)             if (dphi>=0.D0) then ! outflow only
  1072)               ukvr = auxvar%kvr(np)
  1073)               v_darcy=0.D0
  1074)               if (ukvr*Dq>floweps) then
  1075)                 v_darcy = Dq * ukvr * dphi
  1076)                 ! store volumetric rate for ss_fluid_fluxes()
  1077)                 qsrc_liq(1) = v_darcy
  1078)                 Res(1) = Res(1) + v_darcy* auxvar%den(np)* &
  1079) !                 auxvar%xmol((np-1)*option%nflowspec+1) * option%flow_dt
  1080)                   (1.d0-csrc) * option%flow_dt
  1081)                 Res(2) = Res(2) + v_darcy* auxvar%den(np)* &
  1082) !                 auxvar%xmol((np-1)*option%nflowspec+2) * option%flow_dt
  1083)                   csrc * option%flow_dt
  1084) !               if (energy_flag) Res(3) = Res(3) + v_darcy*auxvar%den(np)*auxvar%h(np)*option%flow_dt
  1085)                 if (energy_flag) Res(3) = Res(3) + v_darcy*auxvar%den(np)* &
  1086)                   enth_src_h2o*option%flow_dt
  1087)                 
  1088) !               print *,'inject: ',np,v_darcy
  1089)               endif
  1090)             endif
  1091)           enddo
  1092)         endif
  1093)       endif
  1094) #endif          
  1095)     case default
  1096)     print *,'Unrecognized Source/Sink condition: ', isrctype 
  1097)   end select      
  1098) !  deallocate(msrc)
  1099)   
  1100) end subroutine MiscibleSourceSink
  1101) 
  1102) ! ************************************************************************** !
  1103) 
  1104) subroutine MiscibleFlux(auxvar_up,por_up,tor_up,dd_up,perm_up, &
  1105)                         auxvar_dn,por_dn,tor_dn,dd_dn,perm_dn, &
  1106)                         area,dist_gravity,upweight, &
  1107)                         option,vv_darcy,Res)
  1108)   ! 
  1109)   ! Computes the internal flux terms for the residual
  1110)   ! 
  1111)   ! Author: Chuan Lu
  1112)   ! Date: 10/12/08
  1113)   ! 
  1114)   use Option_module                              
  1115)   
  1116)   implicit none
  1117)   
  1118)   type(Miscible_auxvar_elem_type) :: auxvar_up, auxvar_dn
  1119)   type(option_type) :: option
  1120)   PetscReal :: por_up, por_dn
  1121)   PetscReal :: tor_up, tor_dn
  1122)   PetscReal :: dd_up, dd_dn
  1123)   PetscReal :: perm_up, perm_dn
  1124)   PetscReal :: vv_darcy(:),area
  1125)   PetscReal :: Res(1:option%nflowdof) 
  1126)   PetscReal :: dist_gravity  ! distance along gravity vector
  1127)      
  1128)   PetscInt :: ispec, np, ind
  1129)   PetscReal :: fluxm(option%nflowspec),q,v_darcy
  1130)   PetscReal :: uxmol(1:option%nflowspec),ukvr,Dq
  1131)   PetscReal :: upweight,density_ave,gravity,dphi
  1132)   PetscReal :: portor_up,portor_dn,dendif_up,dendif_dn,dif_harmonic
  1133) 
  1134)   Dq = (perm_up*perm_dn)/(dd_up*perm_dn + dd_dn*perm_up)
  1135)   
  1136) ! harmonic average porosity and tortuosity
  1137)   portor_up = por_up*tor_up
  1138)   portor_dn = por_dn*tor_dn
  1139)   
  1140)   fluxm = 0.D0
  1141)   vv_darcy = 0.D0 
  1142)   
  1143)   do np = 1, option%nphase
  1144)       
  1145) !   Flow term
  1146)       
  1147)     density_ave = upweight*auxvar_up%den(np) + (1.D0-upweight)*auxvar_dn%den(np) 
  1148)         
  1149)     gravity = (upweight*auxvar_up%den(np)*auxvar_up%avgmw(np) + &
  1150)              (1.D0-upweight)*auxvar_dn%den(np)*auxvar_dn%avgmw(np)) &
  1151)              *dist_gravity
  1152) 
  1153)     dphi = auxvar_up%pres - auxvar_dn%pres + gravity
  1154) 
  1155)     v_darcy = 0.D0
  1156)     ukvr = 0.D0
  1157)     uxmol = 0.D0
  1158) 
  1159) !   note uxmol only contains one phase xmol
  1160)     if (dphi >= 0.D0) then
  1161)       ukvr = auxvar_up%kvr(np)
  1162)       uxmol(:) = auxvar_up%xmol((np-1)*option%nflowspec+1:np*option%nflowspec)
  1163)     else
  1164)       ukvr = auxvar_dn%kvr(np)
  1165)       uxmol(:) = auxvar_dn%xmol((np-1)*option%nflowspec+1:np*option%nflowspec)
  1166)     endif
  1167) 
  1168)     v_darcy = Dq * ukvr * dphi
  1169)     vv_darcy(np) = v_darcy
  1170)     q = v_darcy * area
  1171)     do ispec = 1, option%nflowspec
  1172)       fluxm(ispec) = fluxm(ispec) + q*density_ave*uxmol(ispec)
  1173)     enddo  
  1174) 
  1175) !   Diffusion term   
  1176) !   Note : use harmonic average rule for diffusion
  1177)     do ispec=1, option%nflowspec
  1178)       ind = ispec + (np-1)*option%nflowspec
  1179)       dendif_up = auxvar_up%den(1)*auxvar_up%diff(ispec)
  1180)       dendif_dn = auxvar_dn%den(1)*auxvar_dn%diff(ispec)
  1181)       dif_harmonic = (portor_up*portor_dn*dendif_up*dendif_dn) &
  1182)         /(dd_dn*portor_up*dendif_up + dd_up*portor_dn*dendif_dn)*area
  1183)       fluxm(ispec) = fluxm(ispec) + dif_harmonic* &
  1184)         (auxvar_up%xmol(ind) - auxvar_dn%xmol(ind))
  1185)     enddo
  1186)   enddo
  1187) 
  1188)  ! note: Res is the flux contribution, for node 1 R = R + Res_FL
  1189)  !                                              2 R = R - Res_FL  
  1190)   Res(1:option%nflowspec) = fluxm(:)*option%flow_dt
  1191) 
  1192) end subroutine MiscibleFlux
  1193) 
  1194) ! ************************************************************************** !
  1195) 
  1196) subroutine MiscibleBCFlux(ibndtype,auxvars,auxvar_up,auxvar_dn, &
  1197)      por_dn,tor_dn,dd_up,perm_dn, &
  1198)      area,dist_gravity,option,vv_darcy,Res)
  1199)   ! 
  1200)   ! Computes the  boundary flux terms for the residual
  1201)   ! 
  1202)   ! Author: Chuan Lu
  1203)   ! Date: 10/12/08
  1204)   ! 
  1205)   use Option_module
  1206)   
  1207)   implicit none
  1208)   
  1209)   PetscInt :: ibndtype(:)
  1210)   type(Miscible_auxvar_elem_type) :: auxvar_up, auxvar_dn
  1211)   type(option_type) :: option
  1212)   PetscReal :: dd_up
  1213)   PetscReal :: auxvars(:) ! from aux_real_var array
  1214)   PetscReal :: por_dn,perm_dn,tor_dn
  1215)   PetscReal :: vv_darcy(:), area
  1216)   PetscReal :: Res(1:option%nflowdof) 
  1217)   
  1218)   PetscReal :: dist_gravity  ! distance along gravity vector
  1219)           
  1220)   PetscInt :: ispec, np
  1221)   PetscReal :: fluxm(option%nflowspec),q,density_ave, v_darcy
  1222)   PetscReal :: uxmol(1:option%nflowspec),ukvr,diff,portor,Dq
  1223)   PetscReal :: gravity,dphi
  1224)   
  1225)   fluxm = 0.d0
  1226)   v_darcy = 0.d0
  1227)   density_ave = 0.d0
  1228)   q = 0.d0
  1229) 
  1230)   portor = por_dn*tor_dn/dd_up*area
  1231) 
  1232)   ! Flow   
  1233)   do np = 1, option%nphase   ! note: nphase = 1
  1234)     select case(ibndtype(1))
  1235)       case(DIRICHLET_BC,HYDROSTATIC_BC,SEEPAGE_BC)
  1236)         Dq = perm_dn / dd_up
  1237)         ! Flow term
  1238)         ukvr=0.D0
  1239)         v_darcy=0.D0
  1240) 
  1241)         density_ave = auxvar_up%den(np)
  1242)         
  1243)         gravity = auxvar_up%den(np)*auxvar_up%avgmw(np)*dist_gravity
  1244)        
  1245)         dphi = auxvar_up%pres - auxvar_dn%pres &
  1246)                 - auxvar_up%pc(np) + auxvar_dn%pc(np) &
  1247)                 + gravity
  1248)    
  1249)         ! figure out the direction of flow
  1250)         if (dphi >= 0.D0) then
  1251)           ukvr = auxvar_up%kvr(np)
  1252)         else
  1253)           ukvr = auxvar_dn%kvr(np)
  1254)         endif
  1255)      
  1256)         if (ukvr*Dq > floweps) then
  1257)           v_darcy = Dq * ukvr * dphi
  1258)         endif
  1259) 
  1260)       case(NEUMANN_BC) !may not work
  1261)         v_darcy = 0.D0
  1262)         if (dabs(auxvars(1)) > floweps) then
  1263)           v_darcy = auxvars(MIS_PRESSURE_DOF)
  1264)           if (v_darcy > 0.d0) then 
  1265)             density_ave = auxvar_up%den(np)
  1266)           else 
  1267)             density_ave = auxvar_dn%den(np)
  1268)           endif
  1269)         endif
  1270)     end select
  1271)      
  1272)     q = v_darcy*area
  1273)     vv_darcy(np) = v_darcy
  1274)     uxmol = 0.D0
  1275)      
  1276)     if (v_darcy >= 0.D0) then
  1277)       uxmol(:) = auxvar_up%xmol((np-1)*option%nflowspec+1:np*option%nflowspec)
  1278)     else
  1279)       uxmol(:) = auxvar_dn%xmol((np-1)*option%nflowspec+1:np*option%nflowspec)
  1280)     endif
  1281)     
  1282)     do ispec=1, option%nflowspec
  1283)       fluxm(ispec) = fluxm(ispec) + q*density_ave*uxmol(ispec)
  1284)     end do 
  1285)   enddo
  1286) 
  1287)     ! Diffusion term   
  1288)   select case(ibndtype(2))
  1289)     case(DIRICHLET_BC) 
  1290)       do np = 1, option%nphase ! note: nphase = 1
  1291)         diff = portor*auxvar_up%den(np)
  1292)         do ispec = 1, option%nflowspec
  1293)           fluxm(ispec) = fluxm(ispec) + diff* &
  1294)                    auxvar_dn%diff((np-1)*option%nflowspec+ispec)* &
  1295)                    (auxvar_up%xmol((np-1)*option%nflowspec+ispec) &
  1296)                    -auxvar_dn%xmol((np-1)*option%nflowspec+ispec))
  1297)         enddo
  1298)       enddo
  1299)   end select
  1300) 
  1301)   Res(1:option%nflowspec) = fluxm(:)*option%flow_dt
  1302) 
  1303) end subroutine MiscibleBCFlux
  1304) 
  1305) ! ************************************************************************** !
  1306) 
  1307) subroutine MiscibleResidual(snes,xx,r,realization,ierr)
  1308)   ! 
  1309)   ! Computes the residual equation
  1310)   ! 
  1311)   ! Author: Chuan Lu
  1312)   ! Date: 10/10/08
  1313)   ! 
  1314) 
  1315)   use Realization_Subsurface_class
  1316)   use Patch_module
  1317)   use Discretization_module
  1318)   use Field_module
  1319)   use Option_module
  1320)   use Grid_module 
  1321)   use Logging_module
  1322)   use Debug_module
  1323) 
  1324)   implicit none
  1325) 
  1326)   SNES :: snes
  1327)   Vec :: xx
  1328)   Vec :: r
  1329)   type(realization_subsurface_type) :: realization
  1330)   PetscViewer :: viewer
  1331)   PetscErrorCode :: ierr
  1332)   
  1333)   type(discretization_type), pointer :: discretization
  1334)   type(option_type), pointer :: option
  1335)   type(grid_type), pointer :: grid
  1336)   type(field_type), pointer :: field
  1337)   type(patch_type), pointer :: cur_patch
  1338)   PetscInt :: ichange  
  1339)   character(len=MAXSTRINGLENGTH) :: string
  1340) 
  1341)   field => realization%field
  1342)   grid => realization%patch%grid
  1343)   option => realization%option
  1344)   discretization => realization%discretization
  1345)   
  1346)   call PetscLogEventBegin(logging%event_r_residual,ierr);CHKERRQ(ierr)
  1347)  
  1348)   call DiscretizationGlobalToLocal(discretization,xx,field%flow_xx_loc,NFLOWDOF)
  1349) 
  1350)  ! check initial guess -----------------------------------------------
  1351)   ierr = MiscibleInitGuessCheck(realization)
  1352)   if (ierr<0)then
  1353)     !ierr = PETSC_ERR_ARG_OUTOFRANGE
  1354)     if (option%myrank==0) print *,'table out of range: ',ierr
  1355)     call SNESSetFunctionDomainError(snes,ierr);CHKERRQ(ierr)
  1356)     return
  1357)   endif 
  1358)   ! end check ---------------------------------------------------------
  1359) 
  1360)   ! Communication -----------------------------------------
  1361)   ! These 3 must be called before MiscibleUpdateAuxVars()
  1362) !  call DiscretizationGlobalToLocal(discretization,xx,field%flow_xx_loc,NFLOWDOF)
  1363)   call DiscretizationLocalToLocal(discretization,field%icap_loc,field%icap_loc,ONEDOF)
  1364) 
  1365) !geh refactor  call DiscretizationLocalToLocal(discretization,field%perm_xx_loc,field%perm_xx_loc,ONEDOF)
  1366) !geh refactor  call DiscretizationLocalToLocal(discretization,field%perm_yy_loc,field%perm_yy_loc,ONEDOF)
  1367) !geh refactor  call DiscretizationLocalToLocal(discretization,field%perm_zz_loc,field%perm_zz_loc,ONEDOF)
  1368)   call DiscretizationLocalToLocal(discretization,field%ithrm_loc,field%ithrm_loc,ONEDOF)
  1369) 
  1370) !  call DiscretizationLocalToLocal(discretization,field%iphas_loc,field%iphas_loc,ONEDOF)
  1371) 
  1372) 
  1373) ! pass #0 prepare numerical increment  
  1374)   cur_patch => realization%patch_list%first
  1375)   do
  1376)     if (.not.associated(cur_patch)) exit
  1377)     realization%patch => cur_patch
  1378)     call MiscibleResidualPatch0(snes,xx,r,realization,ierr)
  1379)     cur_patch => cur_patch%next
  1380)   enddo
  1381) 
  1382) ! pass #1 internal and boundary flux terms
  1383)   cur_patch => realization%patch_list%first
  1384)   do
  1385)     if (.not.associated(cur_patch)) exit
  1386)     realization%patch => cur_patch
  1387)     call MiscibleResidualPatch1(snes,xx,r,realization,ierr)
  1388)     cur_patch => cur_patch%next
  1389)   enddo
  1390) 
  1391) ! pass #2 for everything else
  1392)   cur_patch => realization%patch_list%first
  1393)   do
  1394)     if (.not.associated(cur_patch)) exit
  1395)     realization%patch => cur_patch
  1396)     call MiscibleResidualPatch2(snes,xx,r,realization,ierr)
  1397)     cur_patch => cur_patch%next
  1398)   enddo
  1399) 
  1400)   if (realization%debug%vecview_residual) then
  1401)     string = 'MISresidual'
  1402)     call DebugCreateViewer(realization%debug,string,option,viewer)
  1403)     call VecView(r,viewer,ierr);CHKERRQ(ierr)
  1404)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  1405)   endif
  1406)   if (realization%debug%vecview_solution) then
  1407)     string = 'MISxx'
  1408)     call DebugCreateViewer(realization%debug,string,option,viewer)
  1409)     call VecView(xx,viewer,ierr);CHKERRQ(ierr)
  1410)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  1411)   endif
  1412)   
  1413)   call PetscLogEventEnd(logging%event_r_residual,ierr);CHKERRQ(ierr)
  1414) 
  1415) end subroutine MiscibleResidual
  1416) 
  1417) ! ************************************************************************** !
  1418) 
  1419) subroutine MiscibleResidualPatch1(snes,xx,r,realization,ierr)
  1420)   ! 
  1421)   ! Computes the Residual by Flux
  1422)   ! 
  1423)   ! Author: Chuan Lu
  1424)   ! Date: 10/10/08
  1425)   ! 
  1426) 
  1427)   use Connection_module
  1428)   use Realization_Subsurface_class
  1429)   use Patch_module
  1430)   use Grid_module
  1431)   use Option_module
  1432)   use Coupler_module  
  1433)   use Field_module
  1434)   use Debug_module
  1435)   
  1436)   implicit none
  1437) 
  1438)   type :: flux_ptrs
  1439)     PetscReal, dimension(:), pointer :: flux_p 
  1440)   end type
  1441) 
  1442)   type (flux_ptrs), dimension(0:2) :: fluxes
  1443)   SNES, intent(in) :: snes
  1444)   Vec, intent(inout) :: xx
  1445)   Vec, intent(out) :: r
  1446)   type(realization_subsurface_type) :: realization
  1447) 
  1448)   PetscErrorCode :: ierr
  1449)   PetscInt :: i, jn
  1450)   PetscInt :: ip1, ip2
  1451)   PetscInt :: local_id, ghosted_id, local_id_up, local_id_dn, ghosted_id_up, ghosted_id_dn
  1452) 
  1453)   PetscReal, pointer ::accum_p(:)
  1454) 
  1455)   PetscReal, pointer :: r_p(:), porosity_loc_p(:), volume_p(:), &
  1456)                xx_loc_p(:), tortuosity_loc_p(:),&
  1457)                perm_xx_loc_p(:), perm_yy_loc_p(:), perm_zz_loc_p(:)
  1458)                           
  1459)                
  1460)   PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
  1461) 
  1462)   PetscInt :: iphase
  1463)   PetscInt :: icap_up, icap_dn, ithrm_up, ithrm_dn
  1464)   PetscReal :: dd_up, dd_dn
  1465)   PetscReal :: dd, f_up, f_dn, ff
  1466)   PetscReal :: perm_up, perm_dn
  1467)   PetscReal :: D_up, D_dn  ! "Diffusion" constants at upstream, downstream faces.
  1468)   PetscReal :: dw_kg, dw_mol,dddt,dddp
  1469)   PetscReal :: tsrc1, qsrc1, csrc1, enth_src_h2o, enth_src_co2 , hsrc1
  1470)   PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
  1471)   PetscReal :: upweight
  1472)   PetscReal :: Res(realization%option%nflowdof), v_darcy(realization%option%nphase)
  1473)   PetscReal :: xxbc(realization%option%nflowdof)
  1474)   PetscViewer :: viewer
  1475) 
  1476) 
  1477)   type(grid_type), pointer :: grid
  1478)   type(patch_type), pointer :: patch
  1479)   type(option_type), pointer :: option
  1480)   type(field_type), pointer :: field
  1481)   type(Miscible_parameter_type), pointer :: Miscible_parameter
  1482)   type(Miscible_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
  1483)   type(coupler_type), pointer :: boundary_condition, source_sink
  1484)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
  1485)   type(connection_set_list_type), pointer :: connection_set_list
  1486)   type(connection_set_type), pointer :: cur_connection_set
  1487)   PetscBool :: enthalpy_flag
  1488)   PetscInt :: ng
  1489)   PetscInt :: axis, side, nlx, nly, nlz, ngx, ngxy, pstart, pend, flux_id
  1490)   PetscInt :: direction, max_x_conn, max_y_conn
  1491)   PetscInt :: iconn, idof, istart, iend
  1492)   PetscInt :: sum_connection
  1493)   PetscReal :: distance, fraction_upwind
  1494)   PetscReal :: distance_gravity
  1495)   
  1496)   
  1497)   patch => realization%patch
  1498)   grid => patch%grid
  1499)   option => realization%option
  1500)   field => realization%field
  1501) 
  1502)   Miscible_parameter => patch%aux%Miscible%Miscible_parameter
  1503)   auxvars => patch%aux%Miscible%auxvars
  1504)   auxvars_bc => patch%aux%Miscible%auxvars_bc
  1505)   global_auxvars => patch%aux%Global%auxvars
  1506)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  1507) 
  1508)  ! call MiscibleUpdateAuxVarsPatchNinc(realization)
  1509)   ! override flags since they will soon be out of date  
  1510)  ! patch%MiscibleAux%auxvars_up_to_date = PETSC_FALSE 
  1511)   
  1512)   if (option%compute_mass_balance_new) then
  1513)     call MiscibleZeroMassBalDeltaPatch(realization)
  1514)   endif
  1515) 
  1516) ! now assign access pointer to local variables
  1517)   call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
  1518)   call VecGetArrayF90( r, r_p, ierr);CHKERRQ(ierr)
  1519) !geh refactor  call VecGetArrayF90(field%porosity_loc, porosity_loc_p, ierr)
  1520) !geh refactor  call VecGetArrayF90(field%tortuosity_loc, tortuosity_loc_p, ierr)
  1521) !geh refactor  call VecGetArrayF90(field%perm_xx_loc, perm_xx_loc_p, ierr)
  1522) !geh refactor  call VecGetArrayF90(field%perm_yy_loc, perm_yy_loc_p, ierr)
  1523) !geh refactor  call VecGetArrayF90(field%perm_zz_loc, perm_zz_loc_p, ierr)
  1524) !geh refactor  call VecGetArrayF90(field%volume, volume_p, ierr)
  1525)   call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  1526)   call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  1527) 
  1528)   r_p = 0.d0
  1529)  
  1530)   ! Boundary Flux Terms -----------------------------------
  1531)   boundary_condition => patch%boundary_condition_list%first
  1532)   sum_connection = 0    
  1533)   do 
  1534)     if (.not.associated(boundary_condition)) exit
  1535)     
  1536)     cur_connection_set => boundary_condition%connection_set
  1537)         
  1538)     do iconn = 1, cur_connection_set%num_connections
  1539)       sum_connection = sum_connection + 1
  1540)     
  1541)       local_id = cur_connection_set%id_dn(iconn)
  1542)       ghosted_id = grid%nL2G(local_id)
  1543) 
  1544)       if (associated(patch%imat)) then
  1545)         if (patch%imat(ghosted_id) <= 0) cycle
  1546)       endif
  1547) 
  1548)       if (ghosted_id<=0) then
  1549)         print *, "Wrong boundary node index... STOP!!!"
  1550)         stop
  1551)       endif
  1552) 
  1553)       ithrm_dn = int(ithrm_loc_p(ghosted_id))
  1554)       D_dn = Miscible_parameter%ckwet(ithrm_dn)
  1555) 
  1556)       ! for now, just assume diagonal tensor
  1557)       perm_dn = perm_xx_loc_p(ghosted_id)*abs(cur_connection_set%dist(1,iconn))+ &
  1558)                 perm_yy_loc_p(ghosted_id)*abs(cur_connection_set%dist(2,iconn))+ &
  1559)                 perm_zz_loc_p(ghosted_id)*abs(cur_connection_set%dist(3,iconn))
  1560)       ! dist(0,iconn) = scalar - magnitude of distance
  1561)       ! gravity = vector(3)
  1562)       ! dist(1:3,iconn) = vector(3) - unit vector
  1563)       distance_gravity = cur_connection_set%dist(0,iconn) * &
  1564)                          dot_product(option%gravity, &
  1565)                                      cur_connection_set%dist(1:3,iconn))
  1566) 
  1567)       icap_dn = int(icap_loc_p(ghosted_id))  
  1568) ! Then need fill up increments for BCs
  1569)       do idof =1, option%nflowdof   
  1570)         select case(boundary_condition%flow_condition%itype(idof))
  1571)           case(DIRICHLET_BC)
  1572)             xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
  1573)           case(HYDROSTATIC_BC)
  1574)             xxbc(1) = boundary_condition%flow_aux_real_var(1,iconn)
  1575)             if (idof >= 2) then
  1576)               xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
  1577)             endif 
  1578)           case(NEUMANN_BC, ZERO_GRADIENT_BC)
  1579)           ! solve for pb from Darcy's law given qb /= 0
  1580)             xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
  1581)         end select
  1582)       enddo
  1583) 
  1584)  
  1585)     call MiscibleAuxVarCompute_Ninc(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0),&
  1586)            global_auxvars_bc(sum_connection),&
  1587)            realization%fluid_properties, option)
  1588) 
  1589)     if ( associated(global_auxvars_bc))then
  1590)       global_auxvars_bc(sum_connection)%pres(:) = auxvars_bc(sum_connection)%auxvar_elem(0)%pres - &
  1591)                      auxvars(ghosted_id)%auxvar_elem(0)%pc(:)
  1592)       global_auxvars_bc(sum_connection)%sat(:) = 1.D0
  1593)       global_auxvars_bc(sum_connection)%den(:) = auxvars_bc(sum_connection)%auxvar_elem(0)%den(:)
  1594)       global_auxvars_bc(sum_connection)%den_kg = auxvars_bc(sum_connection)%auxvar_elem(0)%den(:) &
  1595)           * auxvars_bc(sum_connection)%auxvar_elem(0)%avgmw(:)
  1596)   !   global_auxvars(ghosted_id)%den_kg_store
  1597)     endif
  1598) 
  1599)     call MiscibleBCFlux(boundary_condition%flow_condition%itype, &
  1600)          boundary_condition%flow_aux_real_var(:,iconn), &
  1601)          auxvars_bc(sum_connection)%auxvar_elem(0), &
  1602)          auxvars(ghosted_id)%auxvar_elem(0), &
  1603)          porosity_loc_p(ghosted_id), &
  1604)          tortuosity_loc_p(ghosted_id), &
  1605)          cur_connection_set%dist(0,iconn),perm_dn, &
  1606)          cur_connection_set%area(iconn), &
  1607)          distance_gravity,option, &
  1608)          v_darcy,Res)
  1609)     patch%boundary_velocities(:,sum_connection) = v_darcy(:)
  1610)     patch%aux%Miscible%Resold_BC(local_id,1:option%nflowdof) = &
  1611)     patch%aux%Miscible%ResOld_BC(local_id,1:option%nflowdof) - Res(1:option%nflowdof)
  1612) 
  1613)     if (option%compute_mass_balance_new) then
  1614)       ! contribution to boundary
  1615)       global_auxvars_bc(sum_connection)%mass_balance_delta(:,1) = &
  1616)         global_auxvars_bc(sum_connection)%mass_balance_delta(:,1) &
  1617)           - Res(:)/option%flow_dt 
  1618)     endif
  1619)   
  1620)     iend = local_id*option%nflowdof
  1621)     istart = iend-option%nflowdof+1
  1622)     r_p(istart:iend)= r_p(istart:iend) - Res(1:option%nflowdof)
  1623)   enddo
  1624)   boundary_condition => boundary_condition%next
  1625)  enddo
  1626) 
  1627)   ! Interior Flux Terms -----------------------------------
  1628)   connection_set_list => grid%internal_connection_set_list
  1629)   cur_connection_set => connection_set_list%first
  1630)   sum_connection = 0  
  1631)   do 
  1632)     if (.not.associated(cur_connection_set)) exit
  1633)     do iconn = 1, cur_connection_set%num_connections
  1634)       sum_connection = sum_connection + 1
  1635) 
  1636)       ghosted_id_up = cur_connection_set%id_up(iconn)
  1637)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
  1638) 
  1639)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
  1640)       local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping   
  1641) 
  1642)       if (associated(patch%imat)) then
  1643)         if (patch%imat(ghosted_id_up) <= 0 .or.  &
  1644)             patch%imat(ghosted_id_dn) <= 0) cycle
  1645)       endif
  1646) 
  1647)       fraction_upwind = cur_connection_set%dist(-1,iconn)
  1648)       distance = cur_connection_set%dist(0,iconn)
  1649)       ! distance = scalar - magnitude of distance
  1650)       ! gravity = vector(3)
  1651)       ! dist(1:3,iconn) = vector(3) - unit vector
  1652)       distance_gravity = distance * &
  1653)                          dot_product(option%gravity, &
  1654)                                      cur_connection_set%dist(1:3,iconn))
  1655)       dd_up = distance*fraction_upwind
  1656)       dd_dn = distance-dd_up ! should avoid truncation error
  1657)       ! upweight could be calculated as 1.d0-fraction_upwind
  1658)       ! however, this introduces ever so slight error causing pflow-overhaul not
  1659)       ! to match pflow-orig.  This can be changed to 1.d0-fraction_upwind
  1660)       upweight = dd_dn/(dd_up+dd_dn)
  1661)         
  1662)       ! for now, just assume diagonal tensor
  1663)       perm_up = perm_xx_loc_p(ghosted_id_up)*abs(cur_connection_set%dist(1,iconn))+ &
  1664)                 perm_yy_loc_p(ghosted_id_up)*abs(cur_connection_set%dist(2,iconn))+ &
  1665)                 perm_zz_loc_p(ghosted_id_up)*abs(cur_connection_set%dist(3,iconn))
  1666) 
  1667)       perm_dn = perm_xx_loc_p(ghosted_id_dn)*abs(cur_connection_set%dist(1,iconn))+ &
  1668)                 perm_yy_loc_p(ghosted_id_dn)*abs(cur_connection_set%dist(2,iconn))+ &
  1669)                 perm_zz_loc_p(ghosted_id_dn)*abs(cur_connection_set%dist(3,iconn))
  1670) 
  1671)       call MiscibleFlux(auxvars(ghosted_id_up)%auxvar_elem(0),porosity_loc_p(ghosted_id_up), &
  1672)         tortuosity_loc_p(ghosted_id_up), &
  1673)         dd_up,perm_up, &
  1674)         auxvars(ghosted_id_dn)%auxvar_elem(0),porosity_loc_p(ghosted_id_dn), &
  1675)         tortuosity_loc_p(ghosted_id_dn), &
  1676)         dd_dn,perm_dn, &
  1677)         cur_connection_set%area(iconn),distance_gravity, &
  1678)         upweight,option,v_darcy,Res)
  1679) 
  1680)       patch%internal_velocities(:,sum_connection) = v_darcy(:)
  1681)       patch%aux%Miscible%Resold_FL(sum_connection,1:option%nflowdof)= Res(1:option%nflowdof)
  1682) 
  1683)       if (local_id_up > 0) then
  1684)         iend = local_id_up*option%nflowdof
  1685)         istart = iend-option%nflowdof+1
  1686)         r_p(istart:iend) = r_p(istart:iend) + Res(1:option%nflowdof)
  1687)       endif
  1688)    
  1689)       if (local_id_dn > 0) then
  1690)         iend = local_id_dn*option%nflowdof
  1691)         istart = iend-option%nflowdof+1
  1692)         r_p(istart:iend) = r_p(istart:iend) - Res(1:option%nflowdof)
  1693)       endif
  1694)     enddo
  1695)     cur_connection_set => cur_connection_set%next
  1696)   enddo    
  1697) 
  1698)   call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
  1699)   call VecRestoreArrayF90( r, r_p, ierr);CHKERRQ(ierr)
  1700) !geh refactor  call VecRestoreArrayF90(field%porosity_loc, porosity_loc_p, ierr)
  1701) !geh refactor  call VecRestoreArrayF90(field%tortuosity_loc, tortuosity_loc_p, ierr)
  1702) !geh refactor  call VecRestoreArrayF90(field%perm_xx_loc, perm_xx_loc_p, ierr)
  1703) !geh refactor  call VecRestoreArrayF90(field%perm_yy_loc, perm_yy_loc_p, ierr)
  1704) !geh refactor  call VecRestoreArrayF90(field%perm_zz_loc, perm_zz_loc_p, ierr)
  1705) !geh refactor  call VecRestoreArrayF90(field%volume, volume_p, ierr)
  1706)   call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  1707)   call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  1708) 
  1709) end subroutine MiscibleResidualPatch1
  1710) 
  1711) ! ************************************************************************** !
  1712) 
  1713) subroutine MiscibleResidualPatch0(snes,xx,r,realization,ierr)
  1714)   ! 
  1715)   ! MiscibleJacobianPatch0: Computes the Residual Aux vars for numerical Jacobin
  1716)   ! 
  1717)   ! Author: Chuan Lu
  1718)   ! Date: 10/10/08
  1719)   ! 
  1720) 
  1721)   use Connection_module
  1722)   use Realization_Subsurface_class
  1723)   use Patch_module
  1724)   use Grid_module
  1725)   use Option_module
  1726)   use Coupler_module  
  1727)   use Field_module
  1728)   use Debug_module
  1729)   
  1730)   implicit none
  1731) 
  1732)   SNES, intent(in) :: snes
  1733)   Vec, intent(inout) :: xx
  1734)   Vec, intent(out) :: r
  1735)   type(realization_subsurface_type) :: realization
  1736) 
  1737)   PetscErrorCode :: ierr
  1738)   PetscInt :: i, jn
  1739)   PetscInt :: ip1, ip2
  1740)   PetscInt :: local_id, ghosted_id, local_id_up, local_id_dn, ghosted_id_up, ghosted_id_dn
  1741) 
  1742)   PetscReal, pointer ::accum_p(:)
  1743) 
  1744)   PetscReal, pointer :: r_p(:), porosity_loc_p(:), volume_p(:), &
  1745)                xx_loc_p(:), xx_p(:), yy_p(:),&
  1746)                tortuosity_loc_p(:),&
  1747)                perm_xx_loc_p(:), perm_yy_loc_p(:), perm_zz_loc_p(:)
  1748)                           
  1749)                
  1750)   PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:)
  1751) 
  1752)   PetscReal :: dw_kg, dw_mol,dddt,dddp
  1753)   PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
  1754)   PetscReal :: upweight
  1755)   PetscReal :: Res(realization%option%nflowdof)
  1756) 
  1757) 
  1758)   type(grid_type), pointer :: grid
  1759)   type(patch_type), pointer :: patch
  1760)   type(option_type), pointer :: option
  1761)   type(field_type), pointer :: field
  1762)   type(Miscible_parameter_type), pointer :: Miscible_parameter
  1763)   type(Miscible_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
  1764)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
  1765)   PetscBool :: enthalpy_flag
  1766)   PetscInt :: ng
  1767)   PetscInt :: iconn, idof, istart, iend
  1768)   PetscReal, pointer :: delx(:)
  1769)   PetscReal :: logx2
  1770)   
  1771)   patch => realization%patch
  1772)   grid => patch%grid
  1773)   option => realization%option
  1774)   field => realization%field
  1775) 
  1776)   Miscible_parameter => patch%aux%Miscible%Miscible_parameter
  1777)   auxvars => patch%aux%Miscible%auxvars
  1778)   auxvars_bc => patch%aux%Miscible%auxvars_bc
  1779)   global_auxvars => patch%aux%Global%auxvars
  1780)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  1781) 
  1782)  ! call MiscibleUpdateAuxVarsPatchNinc(realization)
  1783)   ! override flags since they will soon be out of date  
  1784)  ! patch%MiscibleAux%auxvars_up_to_date = PETSC_FALSE 
  1785) 
  1786) ! now assign access pointer to local variables
  1787)   call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
  1788)   call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  1789) 
  1790)   allocate(delx(option%nflowdof))
  1791) 
  1792)   patch%aux%Miscible%Resold_AR=0.D0
  1793)   patch%aux%Miscible%Resold_BC=0.D0
  1794)   patch%aux%Miscible%ResOld_FL=0.D0
  1795) 
  1796) ! Multiphase flash calculation is more expensive, so calculate once per iteration
  1797) 
  1798)   ! Pertubations for aux terms --------------------------------
  1799)   do ng = 1, grid%ngmax
  1800)     if (grid%nG2L(ng)<0) cycle
  1801)     if (associated(patch%imat)) then
  1802)       if (patch%imat(ng) <= 0) cycle
  1803)     endif
  1804)     ghosted_id = ng   
  1805)     istart = (ng-1) * option%nflowdof + 1; iend = istart - 1 + option%nflowdof
  1806)      ! iphase =int(iphase_loc_p(ng))
  1807)     call MiscibleAuxVarCompute_Ninc(xx_loc_p(istart:iend),auxvars(ng)%auxvar_elem(0),&
  1808)           global_auxvars(ng),&
  1809)           realization%fluid_properties,option)
  1810) !    print *,'mis: Respatch0 ', xx_loc_p(istart:iend),auxvars(ng)%auxvar_elem(0)%den
  1811) 
  1812)     if (associated(global_auxvars)) then
  1813)       global_auxvars(ghosted_id)%pres(:) = auxvars(ghosted_id)%auxvar_elem(0)%pres
  1814)       global_auxvars(ghosted_id)%sat(:) = 1D0
  1815)       global_auxvars(ghosted_id)%den(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:)
  1816)       global_auxvars(ghosted_id)%den_kg(:) = auxvars(ghosted_id)%auxvar_elem(0)%den(:) &
  1817)             * auxvars(ghosted_id)%auxvar_elem(0)%avgmw(:)
  1818)     else
  1819)       print *,'Not associated global for Miscible'
  1820)     endif
  1821) 
  1822)     if (option%flow%numerical_derivatives) then
  1823)       delx(1) = xx_loc_p((ng-1)*option%nflowdof+1)*dfac * 1.D-3
  1824) 
  1825) !     print *,'mis_res_p: ',delx(1),xx_loc_p((ng-1)*option%nflowdof+1)
  1826) 
  1827) !      linear formulation
  1828) #if 0
  1829)       do idof = 2, option%nflowdof
  1830)         if (xx_loc_p((ng-1)*option%nflowdof+idof) <= 0.9) then
  1831)           delx(idof) = dfac*xx_loc_p((ng-1)*option%nflowdof+idof)*1.d1 
  1832)         else
  1833)           delx(idof) = -dfac*xx_loc_p((ng-1)*option%nflowdof+idof)*1D1 
  1834)         endif
  1835) 
  1836)         if (delx(idof) <  1D-8 .and. delx(idof) >= 0.D0) delx(idof) = 1D-8
  1837)         if (delx(idof) > -1D-8 .and. delx(idof) <  0.D0) delx(idof) =-1D-8
  1838) 
  1839)         if ((delx(idof)+xx_loc_p((ng-1)*option%nflowdof+idof)) > 1.D0) then
  1840)           delx(idof) = (1.D0-xx_loc_p((ng-1)*option%nflowdof+idof))*1D-4
  1841)         endif
  1842)         if ((delx(idof)+xx_loc_p((ng-1)*option%nflowdof+idof)) < 0.D0) then
  1843)           delx(idof) = xx_loc_p((ng-1)*option%nflowdof+idof)*1D-4
  1844)         endif
  1845) 
  1846) !       print *,'mis_res_x: ',delx(idof),xx_loc_p((ng-1)*option%nflowdof+idof)
  1847)       enddo
  1848) #endif
  1849) 
  1850) !      log formulation
  1851) !#if 0
  1852)       do idof = 2, option%nflowdof
  1853)         logx2 = xx_loc_p((ng-1)*option%nflowdof+idof)
  1854) !         x2 = exp(logx2)
  1855)         if (logx2 <= 0.d0) then
  1856)           delx(idof) = 1.d-6 
  1857)         else
  1858)           delx(idof) = -1.d-6 
  1859)         endif
  1860) 
  1861) !       print *,'mis_res_x: ',delx(idof),xx_loc_p((ng-1)*option%nflowdof+idof)
  1862)       enddo
  1863) !#endif
  1864) 
  1865) !      store increments
  1866)       patch%aux%Miscible%delx(:,ng) = delx(:)
  1867) 
  1868)       call MiscibleAuxVarCompute_Winc(xx_loc_p(istart:iend),delx(:),&
  1869)             auxvars(ng)%auxvar_elem(1:option%nflowdof),global_auxvars(ng),&
  1870)             realization%fluid_properties,option)
  1871)     endif
  1872)   enddo
  1873) 
  1874)   deallocate(delx)
  1875)   call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
  1876)   call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  1877) 
  1878) end subroutine MiscibleResidualPatch0
  1879) 
  1880) ! ************************************************************************** !
  1881) 
  1882) subroutine MiscibleResidualPatch2(snes,xx,r,realization,ierr)
  1883)   ! 
  1884)   ! Computes other terms in Residual
  1885)   ! (accumulation, source/sink, reaction)
  1886)   ! 
  1887)   ! Author: Chuan Lu
  1888)   ! Date: 10/10/08
  1889)   ! 
  1890) 
  1891)   use Connection_module
  1892)   use Realization_Subsurface_class
  1893)   use Patch_module
  1894)   use Grid_module
  1895)   use Option_module
  1896)   use Coupler_module  
  1897)   use Field_module
  1898)   use Debug_module
  1899)   
  1900)   implicit none
  1901) 
  1902)   SNES, intent(in) :: snes
  1903)   Vec, intent(inout) :: xx
  1904)   Vec, intent(out) :: r
  1905)   type(realization_subsurface_type) :: realization
  1906) 
  1907)   PetscErrorCode :: ierr
  1908)   PetscInt :: i, jn
  1909)   PetscInt :: ip1, ip2
  1910)   PetscInt :: local_id, ghosted_id
  1911)   
  1912)   PetscReal, pointer ::accum_p(:)
  1913) 
  1914)   PetscReal, pointer :: r_p(:), porosity_loc_p(:), volume_p(:)
  1915)                
  1916)   PetscReal, pointer :: ithrm_loc_p(:)
  1917) 
  1918)   PetscReal :: dw_kg, dw_mol,dddt,dddp
  1919)   PetscReal :: tsrc1, qsrc1, csrc1, enth_src_h2o, enth_src_co2 , hsrc1
  1920)   PetscReal :: rho, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt, dvdp, xphi
  1921)   PetscReal :: Res(realization%option%nflowdof), v_darcy(realization%option%nphase)
  1922)   PetscReal :: xxbc(realization%option%nflowdof)
  1923)   PetscReal :: psrc(1:realization%option%nphase)
  1924)   PetscViewer :: viewer
  1925)   PetscInt :: nsrcpara
  1926)   PetscReal, pointer :: msrc(:)
  1927) 
  1928)   type(grid_type), pointer :: grid
  1929)   type(patch_type), pointer :: patch
  1930)   type(option_type), pointer :: option
  1931)   type(field_type), pointer :: field
  1932)   type(Miscible_parameter_type), pointer :: Miscible_parameter
  1933)   type(Miscible_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
  1934)   type(coupler_type), pointer :: boundary_condition, source_sink
  1935)   type(global_auxvar_type), pointer :: global_auxvars(:)
  1936)   type(global_auxvar_type), pointer :: global_auxvars_bc(:)
  1937)   type(global_auxvar_type), pointer :: global_auxvars_ss(:)
  1938)   type(connection_set_list_type), pointer :: connection_set_list
  1939)   type(connection_set_type), pointer :: cur_connection_set
  1940)   PetscReal :: ss_flow_vol_flux(realization%option%nphase)
  1941)   PetscBool :: enthalpy_flag
  1942)   PetscInt :: ng
  1943)   PetscInt :: iconn, idof, istart, iend
  1944)   PetscInt :: sum_connection
  1945)   PetscReal :: distance, fraction_upwind
  1946)   PetscReal :: distance_gravity
  1947) 
  1948) ! PetscReal, pointer :: iphase_loc_p(:) 
  1949) 
  1950)   patch => realization%patch
  1951)   grid => patch%grid
  1952)   option => realization%option
  1953)   field => realization%field
  1954) 
  1955)   Miscible_parameter => patch%aux%Miscible%Miscible_parameter
  1956)   auxvars => patch%aux%Miscible%auxvars
  1957)   auxvars_bc => patch%aux%Miscible%auxvars_bc
  1958)   global_auxvars => patch%aux%Global%auxvars
  1959)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  1960)   global_auxvars_ss => patch%aux%Global%auxvars_ss
  1961)   
  1962)  ! call MiscibleUpdateAuxVarsPatchNinc(realization)
  1963)   ! override flags since they will soon be out of date  
  1964)  ! patch%MiscibleAux%auxvars_up_to_date = PETSC_FALSE 
  1965) 
  1966) ! now assign access pointer to local variables
  1967)   call VecGetArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  1968)   call VecGetArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
  1969) !geh refactor  call VecGetArrayF90(field%porosity_loc, porosity_loc_p, ierr)
  1970) !geh refactor  call VecGetArrayF90(field%volume, volume_p, ierr)
  1971)   call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  1972) 
  1973) ! call VecGetArrayF90(field%iphas_loc, iphase_loc_p, ierr); 
  1974) 
  1975)   ! Accumulation terms (include reaction------------------------------------
  1976)   if (.not.option%steady_state) then
  1977) 
  1978)     r_p = r_p - accum_p
  1979) 
  1980)     do local_id = 1, grid%nlmax  ! For each local node do...
  1981) 
  1982)       ghosted_id = grid%nL2G(local_id)
  1983)       !geh - Ignore inactive cells with inactive materials
  1984)       if (associated(patch%imat)) then
  1985)         if (patch%imat(ghosted_id) <= 0) cycle
  1986)       endif
  1987)       iend = local_id*option%nflowdof
  1988)       istart = iend-option%nflowdof+1
  1989) 
  1990)       call MiscibleAccumulation(auxvars(ghosted_id)%auxvar_elem(0),&
  1991)                             global_auxvars(ghosted_id), &
  1992)                             porosity_loc_p(ghosted_id), &
  1993)                             volume_p(local_id), &
  1994)                             Miscible_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
  1995)                             option,Res) 
  1996)       r_p(istart:iend) = r_p(istart:iend) + Res(1:option%nflowdof)
  1997) 
  1998)       patch%aux%Miscible%Resold_AR(local_id, :) = &
  1999)       patch%aux%Miscible%Resold_AR(local_id, :)+ Res(1:option%nflowdof)
  2000)     enddo
  2001)   endif
  2002) 
  2003) ! call VecRestoreArrayF90(field%iphas_loc, iphase_loc_p, ierr); 
  2004) 
  2005)   ! Source/sink terms -------------------------------------
  2006)   source_sink => patch%source_sink_list%first
  2007)   sum_connection = 0 
  2008)   do 
  2009)     if (.not.associated(source_sink)) exit
  2010)     !print *, 'RES s/s begin'
  2011)     ! check whether enthalpy dof is included
  2012)   !  if (source_sink%flow_condition%num_sub_conditions > 3) then
  2013)       enthalpy_flag = PETSC_TRUE
  2014)    ! else
  2015)    !   enthalpy_flag = PETSC_FALSE
  2016)    ! endif
  2017)       
  2018)     if (associated(source_sink%flow_condition%pressure)) then
  2019)       psrc(:) = source_sink%flow_condition%pressure%dataset%rarray(:)
  2020)     endif 
  2021) !    qsrc1 = source_sink%flow_condition%pressure%dataset%rarray(1)
  2022)     tsrc1 = source_sink%flow_condition%temperature%dataset%rarray(1)
  2023)     csrc1 = source_sink%flow_condition%concentration%dataset%rarray(1)
  2024)     if (enthalpy_flag) hsrc1 = source_sink%flow_condition%enthalpy%dataset%rarray(1)
  2025) !    hsrc1=0D0
  2026) !    qsrc1 = qsrc1 / FMWH2O ! [kg/s -> kmol/s; fmw -> g/mol = kg/kmol]
  2027) !    csrc1 = csrc1 / FMWCO2
  2028) !    msrc(1)=qsrc1; msrc(2) =csrc1
  2029)     select case(source_sink%flow_condition%itype(1))
  2030)       case(MASS_RATE_SS)
  2031)         msrc => source_sink%flow_condition%rate%dataset%rarray
  2032)         nsrcpara= 2
  2033)       case(WELL_SS)
  2034)         msrc => source_sink%flow_condition%well%dataset%rarray
  2035)         nsrcpara = 7 + option%nflowspec 
  2036)       case default
  2037)         print *, 'Flash mode does not support source/sink type: ', source_sink%flow_condition%itype(1)
  2038)         stop  
  2039)     end select
  2040) 
  2041)     cur_connection_set => source_sink%connection_set
  2042)        
  2043)     do iconn = 1, cur_connection_set%num_connections      
  2044)       sum_connection = sum_connection + 1 
  2045)       local_id = cur_connection_set%id_dn(iconn)
  2046)       ghosted_id = grid%nL2G(local_id)
  2047)       if (associated(patch%imat)) then
  2048)         if (patch%imat(ghosted_id) <= 0) cycle
  2049)       endif
  2050)       
  2051)       call MiscibleSourceSink(msrc,nsrcpara,psrc,tsrc1,hsrc1,csrc1, &
  2052)                             auxvars(ghosted_id)%auxvar_elem(0), &
  2053)                             source_sink%flow_condition%itype(1),Res, &
  2054)                             ss_flow_vol_flux, &
  2055)                             enthalpy_flag,option)
  2056)       if (associated(patch%ss_flow_vol_fluxes)) then
  2057)         patch%ss_flow_vol_fluxes(:,sum_connection) = ss_flow_vol_flux/ &
  2058)                                                      option%flow_dt
  2059)       endif
  2060)       if (associated(patch%ss_flow_fluxes)) then
  2061)         patch%ss_flow_fluxes(:,sum_connection) = Res(:)/option%flow_dt
  2062)       endif
  2063)       if (option%compute_mass_balance_new) then
  2064)         global_auxvars_ss(sum_connection)%mass_balance_delta(:,1) = &
  2065)           global_auxvars_ss(sum_connection)%mass_balance_delta(:,1) - &
  2066)           Res(:)/option%flow_dt
  2067)       endif
  2068)       r_p((local_id-1)*option%nflowdof + jh2o) = r_p((local_id-1)*option%nflowdof + jh2o) - Res(jh2o)
  2069)       r_p((local_id-1)*option%nflowdof + jglyc) = r_p((local_id-1)*option%nflowdof + jglyc) - Res(jglyc)
  2070)       patch%aux%Miscible%Resold_AR(local_id,jh2o) = patch%aux%Miscible%Resold_AR(local_id,jh2o) - Res(jh2o)    
  2071)       patch%aux%Miscible%Resold_AR(local_id,jglyc) = patch%aux%Miscible%Resold_AR(local_id,jglyc) - Res(jglyc)    
  2072)       if (enthalpy_flag)then
  2073)         r_p( local_id*option%nflowdof) = r_p(local_id*option%nflowdof) - Res(option%nflowdof)
  2074)         patch%aux%Miscible%Resold_AR(local_id,option%nflowdof)=&
  2075)           patch%aux%Miscible%Resold_AR(local_id,option%nflowdof) - Res(option%nflowdof)
  2076)       endif 
  2077)   !  else if (qsrc1 < 0.d0) then ! withdrawal
  2078)   !  endif
  2079)     enddo
  2080)     source_sink => source_sink%next
  2081)   enddo
  2082)   
  2083) ! adjust residual to R/dt
  2084)   select case (option%idt_switch) 
  2085)     case(1) 
  2086)       r_p(:) = r_p(:)/option%flow_dt
  2087)     case(-1)
  2088)       if (option%flow_dt > 1.D0) r_p(:) = r_p(:)/option%flow_dt
  2089)   end select
  2090)   
  2091)   do local_id = 1, grid%nlmax
  2092)     if (associated(patch%imat)) then
  2093)       if (patch%imat(grid%nL2G(local_id)) <= 0) cycle
  2094)     endif
  2095) 
  2096) !    scale residual by grid cell volume
  2097)     istart = 1 + (local_id-1)*option%nflowdof
  2098) !   if (volume_p(local_id) > 1.D0) r_p(istart:istart+2) = &
  2099) !     r_p(istart:istart+2)/volume_p(local_id)
  2100)     if (volume_p(local_id) > 1.D0) r_p(istart:istart+1) = &
  2101)       r_p(istart:istart+1)/volume_p(local_id)
  2102) !   r_p(istart:istart+1) = r_p(istart:istart+1)/volume_p(local_id)
  2103)     if (r_p(istart) > 1.E10 .or. r_p(istart) < -1.E10) then
  2104)       ghosted_id = grid%nL2G(local_id)
  2105)       print *, 'overflow in res: ', &
  2106)       local_id,ghosted_id,istart,r_p (istart:istart+1), &
  2107)       auxvars(ghosted_id)%auxvar_elem(0)%pres, &
  2108)       auxvars(ghosted_id)%auxvar_elem(0)%xmol(1), &
  2109)       auxvars(ghosted_id)%auxvar_elem(0)%xmol(2)
  2110)     endif
  2111)   enddo
  2112) 
  2113) ! if (option%use_isothermal) then
  2114) !   do local_id = 1, grid%nlmax  ! For each local node do...
  2115) !     ghosted_id = grid%nL2G(local_id)   ! corresponding ghost index
  2116) !     if (associated(patch%imat)) then
  2117) !       if (patch%imat(ghosted_id) <= 0) cycle
  2118) !     endif
  2119) !     istart = 3 + (local_id-1)*option%nflowdof
  2120) !     r_p(istart) = 0.D0 ! xx_loc_p(2 + (ng-1)*option%nflowdof) - yy_p(p1-1)
  2121) !   enddo
  2122) ! endif
  2123)  
  2124)   if (patch%aux%Miscible%inactive_cells_exist) then
  2125)     do i=1,patch%aux%Miscible%n_zero_rows
  2126)       r_p(patch%aux%Miscible%zero_rows_local(i)) = 0.d0
  2127)     enddo
  2128)   endif
  2129)  
  2130)   call VecRestoreArrayF90(r, r_p, ierr);CHKERRQ(ierr)
  2131)   call VecRestoreArrayF90(field%flow_accum, accum_p, ierr);CHKERRQ(ierr)
  2132) !geh refactor  call VecRestoreArrayF90(field%porosity_loc, porosity_loc_p, ierr)
  2133) !geh refactor  call VecRestoreArrayF90(field%volume, volume_p, ierr)
  2134)   call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  2135)  
  2136) end subroutine MiscibleResidualPatch2
  2137) 
  2138) ! ************************************************************************** !
  2139) 
  2140) subroutine MiscibleJacobian(snes,xx,A,B,realization,ierr)
  2141)   ! 
  2142)   ! Computes the Jacobian
  2143)   ! 
  2144)   ! Author: Chuan Lu
  2145)   ! Date: 10/10/08
  2146)   ! 
  2147) 
  2148)   use Realization_Subsurface_class
  2149)   use Patch_module
  2150)   use Grid_module
  2151)   use Option_module
  2152)   use Logging_module
  2153)   use Debug_module
  2154)   
  2155)   implicit none
  2156) 
  2157)   SNES :: snes
  2158)   Vec :: xx
  2159)   Mat :: A, B, J
  2160)   MatType :: mat_type
  2161)   type(realization_subsurface_type) :: realization
  2162)   PetscErrorCode :: ierr
  2163)   PetscViewer :: viewer
  2164)   type(patch_type), pointer :: cur_patch
  2165)   type(grid_type),  pointer :: grid
  2166)   character(len=MAXSTRINGLENGTH) :: string
  2167) 
  2168)   call PetscLogEventBegin(logging%event_r_jacobian,ierr);CHKERRQ(ierr)
  2169) 
  2170)   call MatGetType(A,mat_type,ierr);CHKERRQ(ierr)
  2171)   if (mat_type == MATMFFD) then
  2172)     J = B
  2173)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2174)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2175)   else
  2176)     J = A
  2177)   endif
  2178) 
  2179)   
  2180)   call MatZeroEntries(J,ierr);CHKERRQ(ierr)
  2181) 
  2182)  ! pass #1 for internal and boundary flux terms
  2183)   cur_patch => realization%patch_list%first
  2184)   do
  2185)     if (.not.associated(cur_patch)) exit
  2186)     realization%patch => cur_patch
  2187)     call MiscibleJacobianPatch1(snes,xx,J,J,realization,ierr)
  2188)     cur_patch => cur_patch%next
  2189)   enddo
  2190) 
  2191) ! pass #2 for everything else
  2192)   cur_patch => realization%patch_list%first
  2193)   do
  2194)     if (.not.associated(cur_patch)) exit
  2195)     realization%patch => cur_patch
  2196)     call MiscibleJacobianPatch2(snes,xx,J,J,realization,ierr)
  2197)     cur_patch => cur_patch%next
  2198)   enddo
  2199) 
  2200) 
  2201)   if (realization%debug%matview_Jacobian) then
  2202)     string = 'MISjacobian'
  2203)     call DebugCreateViewer(realization%debug,string,realization%option,viewer)
  2204)     call MatView(J,viewer,ierr);CHKERRQ(ierr)
  2205)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2206)   endif
  2207) 
  2208) #if 0
  2209)   if (realization%debug%norm_Jacobian) then
  2210)     option => realization%option
  2211)     call MatNorm(J,NORM_1,norm,ierr);CHKERRQ(ierr)
  2212)     write(option%io_buffer,'("1 norm: ",es11.4)') norm
  2213)     call printMsg(option) 
  2214)     call MatNorm(J,NORM_FROBENIUS,norm,ierr);CHKERRQ(ierr)
  2215)     write(option%io_buffer,'("2 norm: ",es11.4)') norm
  2216)     call printMsg(option) 
  2217)     call MatNorm(J,NORM_INFINITY,norm,ierr);CHKERRQ(ierr)
  2218)     write(option%io_buffer,'("inf norm: ",es11.4)') norm
  2219)     call printMsg(option) 
  2220)   endif
  2221) #endif
  2222) 
  2223)   call PetscLogEventEnd(logging%event_r_jacobian,ierr);CHKERRQ(ierr)
  2224) 
  2225) end subroutine MiscibleJacobian
  2226) 
  2227) ! ************************************************************************** !
  2228) 
  2229) subroutine MiscibleJacobianPatch1(snes,xx,A,B,realization,ierr)
  2230)   ! 
  2231)   ! Computes the Jacobian: Flux term
  2232)   ! 
  2233)   ! Author: Chuan Lu
  2234)   ! Date: 10/13/08
  2235)   ! 
  2236) 
  2237)   use Connection_module
  2238)   use Option_module
  2239)   use Grid_module
  2240)   use Realization_Subsurface_class
  2241)   use Patch_module
  2242)   use Coupler_module
  2243)   use Field_module
  2244)   use Debug_module
  2245)   
  2246)   implicit none
  2247) 
  2248)   SNES :: snes
  2249)   Vec :: xx
  2250)   Mat :: A, B
  2251)   type(realization_subsurface_type) :: realization
  2252) 
  2253)   PetscErrorCode :: ierr
  2254)   PetscInt :: nvar,neq,nr
  2255)   PetscInt :: ithrm_up, ithrm_dn, i
  2256)   PetscInt :: ip1, ip2 
  2257) 
  2258)   PetscReal, pointer :: porosity_loc_p(:), volume_p(:), &
  2259)                           xx_loc_p(:), tortuosity_loc_p(:),&
  2260)                           perm_xx_loc_p(:), perm_yy_loc_p(:), perm_zz_loc_p(:)
  2261)   PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
  2262)   PetscInt :: icap,iphas,iphas_up,iphas_dn,icap_up,icap_dn
  2263)   PetscInt :: ii, jj
  2264)   PetscReal :: dw_kg,dw_mol,enth_src_co2,enth_src_h2o,rho
  2265)   PetscReal :: tsrc1,qsrc1,csrc1,hsrc1
  2266)   PetscReal :: dd_up, dd_dn, dd, f_up, f_dn
  2267)   PetscReal :: perm_up, perm_dn
  2268)   PetscReal :: dw_dp,dw_dt,hw_dp,hw_dt,dresT_dp,dresT_dt
  2269)   PetscReal :: D_up, D_dn  ! "Diffusion" constants upstream and downstream of a face.
  2270)   PetscReal :: zero, norm
  2271)   PetscReal :: upweight
  2272)   PetscReal :: max_dev  
  2273)   PetscInt :: local_id, ghosted_id
  2274)   PetscInt :: local_id_up, local_id_dn
  2275)   PetscInt :: ghosted_id_up, ghosted_id_dn
  2276)   PetscInt :: natural_id_up, natural_id_dn
  2277)   
  2278)   PetscReal :: Jup(1:realization%option%nflowdof,1:realization%option%nflowdof), &
  2279)             Jdn(1:realization%option%nflowdof,1:realization%option%nflowdof)
  2280)   
  2281)   PetscInt :: istart, iend
  2282)   
  2283)   type(coupler_type), pointer :: boundary_condition, source_sink
  2284)   type(connection_set_list_type), pointer :: connection_set_list
  2285)   type(connection_set_type), pointer :: cur_connection_set
  2286)   PetscBool :: enthalpy_flag
  2287)   PetscInt :: iconn, idof
  2288)   PetscInt :: sum_connection  
  2289)   PetscReal :: distance, fraction_upwind
  2290)   PetscReal :: distance_gravity
  2291)   PetscReal :: Res(realization%option%nflowdof) 
  2292)   PetscReal :: xxbc(1:realization%option%nflowdof), delxbc(1:realization%option%nflowdof)
  2293)   PetscReal :: ResInc(realization%patch%grid%nlmax,realization%option%nflowdof,&
  2294)            realization%option%nflowdof)
  2295)   type(grid_type), pointer :: grid
  2296)   type(patch_type), pointer :: patch
  2297)   type(option_type), pointer :: option 
  2298)   type(field_type), pointer :: field 
  2299)   type(Miscible_parameter_type), pointer :: Miscible_parameter
  2300)   type(Miscible_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
  2301)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
  2302) 
  2303)   PetscReal :: vv_darcy(realization%option%nphase), voltemp
  2304)   PetscReal :: ra(1:realization%option%nflowdof,1:realization%option%nflowdof*2) 
  2305)   PetscReal :: msrc(1:realization%option%nflowspec)
  2306)   PetscReal :: psrc(1:realization%option%nphase)
  2307)   PetscReal :: dddt, dddp, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt,&
  2308)                dvdp, xphi
  2309)   PetscInt :: iphasebc                
  2310)   
  2311)   PetscViewer :: viewer
  2312)   Vec :: debug_vec
  2313)   character(len=MAXSTRINGLENGTH) :: string
  2314) 
  2315) !-----------------------------------------------------------------------
  2316) ! R stand for residual
  2317) !  ra       1              2              3              4          5              6            7      8
  2318) ! 1: p     dR/dpi         dR/dTi          dR/dci        dR/dsi   dR/dpim        dR/dTim
  2319) ! 2: T
  2320) ! 3: c
  2321) ! 4  s         
  2322) !-----------------------------------------------------------------------
  2323) 
  2324)   patch => realization%patch
  2325)   grid => patch%grid
  2326)   option => realization%option
  2327)   field => realization%field
  2328) 
  2329)   Miscible_parameter => patch%aux%Miscible%Miscible_parameter
  2330)   auxvars => patch%aux%Miscible%auxvars
  2331)   auxvars_bc => patch%aux%Miscible%auxvars_bc
  2332)   global_auxvars => patch%aux%Global%auxvars
  2333)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  2334) 
  2335) ! dropped derivatives:
  2336) !   1.D0 gas phase viscocity to all p,t,c,s
  2337) !   2. Average molecular weights to p,t,s
  2338) !  flag = SAME_NONZERO_PATTERN
  2339) 
  2340) #if 0
  2341) !  call MiscibleNumericalJacobianTest(xx,realization)
  2342) #endif
  2343) 
  2344)  ! print *,'*********** In Jacobian ********************** '
  2345)  ! MatzeroEntries has been called in MiscibleJacobin ! clu removed on 11/04/2010 
  2346)  !  call MatZeroEntries(A,ierr)
  2347) 
  2348)   call VecGetArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
  2349) !geh refactor  call VecGetArrayF90(field%porosity_loc, porosity_loc_p, ierr)
  2350) !geh refactor  call VecGetArrayF90(field%tortuosity_loc, tortuosity_loc_p, ierr)
  2351) !geh refactor  call VecGetArrayF90(field%perm_xx_loc, perm_xx_loc_p, ierr)
  2352) !geh refactor  call VecGetArrayF90(field%perm_yy_loc, perm_yy_loc_p, ierr)
  2353) !geh refactor  call VecGetArrayF90(field%perm_zz_loc, perm_zz_loc_p, ierr)
  2354) !geh refactor  call VecGetArrayF90(field%volume, volume_p, ierr)
  2355) 
  2356)   call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  2357)   call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  2358) !  call VecGetArrayF90(field%iphas_loc, iphase_loc_p, ierr)
  2359) 
  2360)  ResInc = 0.D0
  2361) 
  2362) ! Boundary conditions
  2363) 
  2364)   ! Boundary Flux Terms -----------------------------------
  2365)   boundary_condition => patch%boundary_condition_list%first
  2366)   sum_connection = 0    
  2367)   do 
  2368)     if (.not.associated(boundary_condition)) exit
  2369)     
  2370)     cur_connection_set => boundary_condition%connection_set
  2371)     
  2372)     do iconn = 1, cur_connection_set%num_connections
  2373)       sum_connection = sum_connection + 1
  2374)     
  2375)       local_id = cur_connection_set%id_dn(iconn)
  2376)       ghosted_id = grid%nL2G(local_id)
  2377) 
  2378)       if (associated(patch%imat)) then
  2379)         if (patch%imat(ghosted_id) <= 0) cycle
  2380)       endif
  2381) 
  2382)       if (ghosted_id<=0) then
  2383)         print *, "Wrong boundary node index... STOP!!!"
  2384)         stop
  2385)       endif
  2386) 
  2387)       ithrm_dn = int(ithrm_loc_p(ghosted_id))
  2388)       D_dn = Miscible_parameter%ckwet(ithrm_dn)
  2389) 
  2390)       ! for now, just assume diagonal tensor
  2391)       perm_dn = perm_xx_loc_p(ghosted_id)*abs(cur_connection_set%dist(1,iconn))+ &
  2392)                 perm_yy_loc_p(ghosted_id)*abs(cur_connection_set%dist(2,iconn))+ &
  2393)                 perm_zz_loc_p(ghosted_id)*abs(cur_connection_set%dist(3,iconn))
  2394)       ! dist(0,iconn) = scalar - magnitude of distance
  2395)       ! gravity = vector(3)
  2396)       ! dist(1:3,iconn) = vector(3) - unit vector
  2397)       distance_gravity = cur_connection_set%dist(0,iconn) * &
  2398)                          dot_product(option%gravity, &
  2399)                                      cur_connection_set%dist(1:3,iconn))
  2400)       icap_dn = int(icap_loc_p(ghosted_id))
  2401) 
  2402) ! Then need fill up increments for BCs
  2403)       delxbc=0.D0;
  2404)       do idof =1, option%nflowdof   
  2405)         select case(boundary_condition%flow_condition%itype(idof))
  2406)           case(DIRICHLET_BC)
  2407)             xxbc(idof) = boundary_condition%flow_aux_real_var(idof,iconn)
  2408)             delxbc(idof)=0.D0
  2409)           case(HYDROSTATIC_BC)
  2410)             xxbc(1) = boundary_condition%flow_aux_real_var(1,iconn)
  2411)             if (idof >= 2)then
  2412)               xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
  2413)               delxbc(idof)=patch%aux%Miscible%delx(idof,ghosted_id)
  2414)             endif 
  2415)           case(NEUMANN_BC, ZERO_GRADIENT_BC)
  2416)           ! solve for pb from Darcy's law given qb /= 0
  2417)             xxbc(idof) = xx_loc_p((ghosted_id-1)*option%nflowdof+idof)
  2418)             delxbc(idof)=patch%aux%Miscible%delx(idof,ghosted_id)
  2419)         end select
  2420)       enddo
  2421)  
  2422)       call MiscibleAuxVarCompute_Ninc(xxbc,auxvars_bc(sum_connection)%auxvar_elem(0),&
  2423)          global_auxvars_bc(sum_connection),&
  2424)          realization%fluid_properties, option)
  2425)       call MiscibleAuxVarCompute_Winc(xxbc,delxbc,&
  2426)          auxvars_bc(sum_connection)%auxvar_elem(1:option%nflowdof),&
  2427)          global_auxvars_bc(sum_connection),&
  2428)          realization%fluid_properties,option)
  2429)     
  2430)       do nvar=1,option%nflowdof
  2431)         call MiscibleBCFlux(boundary_condition%flow_condition%itype, &
  2432)           boundary_condition%flow_aux_real_var(:,iconn), &
  2433)           auxvars_bc(sum_connection)%auxvar_elem(nvar), &
  2434)           auxvars(ghosted_id)%auxvar_elem(nvar), &
  2435)           porosity_loc_p(ghosted_id), &
  2436)           tortuosity_loc_p(ghosted_id), &
  2437)           cur_connection_set%dist(0,iconn),perm_dn, &
  2438)           cur_connection_set%area(iconn), &
  2439)           distance_gravity,option, &
  2440)           vv_darcy,Res)
  2441)         ResInc(local_id,1:option%nflowdof,nvar) = ResInc(local_id,1:option%nflowdof,nvar) - Res(1:option%nflowdof)
  2442)       enddo
  2443)     enddo
  2444)     boundary_condition => boundary_condition%next
  2445)   enddo
  2446) 
  2447) ! Set matrix values related to single node terms: Accumulation, Source/Sink, BC
  2448)   do local_id = 1, grid%nlmax  ! For each local node do...
  2449)     ghosted_id = grid%nL2G(local_id)
  2450)     !geh - Ignore inactive cells with inactive materials
  2451)     if (associated(patch%imat)) then
  2452)       if (patch%imat(ghosted_id) <= 0) cycle
  2453)     endif
  2454) 
  2455)     ra=0.D0
  2456)     do neq=1, option%nflowdof
  2457)       do nvar=1, option%nflowdof
  2458)         ra(neq,nvar) = (ResInc(local_id,neq,nvar) - patch%aux%Miscible%ResOld_BC(local_id,neq))&
  2459)           /patch%aux%Miscible%delx(nvar,ghosted_id)
  2460) 
  2461) !       print *,'jacobian: ',neq,nvar,local_id,ghosted_id,grid%nlmax,ra(neq,nvar),ResInc(local_id,neq,nvar), &
  2462) !         patch%aux%Miscible%ResOld_BC(local_id,neq),patch%aux%Miscible%delx(nvar,ghosted_id)
  2463)       enddo
  2464)     enddo
  2465)    
  2466)     select case(option%idt_switch)
  2467)       case(1) 
  2468)         ra(1:option%nflowdof,1:option%nflowdof) = ra(1:option%nflowdof,1:option%nflowdof) / option%flow_dt
  2469)       case(-1)
  2470)         if (option%flow_dt > 1) ra(1:option%nflowdof,1:option%nflowdof) = ra(1:option%nflowdof,1:option%nflowdof) / option%flow_dt
  2471)     end select
  2472) 
  2473)     Jup = ra(1:option%nflowdof,1:option%nflowdof)
  2474)     if (volume_p(local_id) > 1.D0) Jup = Jup / volume_p(local_id)
  2475) !   Jup = Jup / volume_p(local_id)
  2476)    
  2477)     call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup,ADD_VALUES, &
  2478)                                   ierr);CHKERRQ(ierr)
  2479)   end do
  2480) 
  2481)   if (realization%debug%matview_Jacobian_detailed) then
  2482)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2483)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2484)     string = 'jacobian_bcflux'
  2485)     call DebugCreateViewer(realization%debug,string,option,viewer)
  2486)     call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
  2487)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2488)   endif
  2489) 
  2490)   ! Interior Flux Terms -----------------------------------  
  2491)   connection_set_list => grid%internal_connection_set_list
  2492)   cur_connection_set => connection_set_list%first
  2493)   sum_connection = 0    
  2494)   ResInc = 0.D0
  2495)   do 
  2496)     if (.not.associated(cur_connection_set)) exit
  2497)     do iconn = 1, cur_connection_set%num_connections
  2498)       sum_connection = sum_connection + 1
  2499)     
  2500)       ghosted_id_up = cur_connection_set%id_up(iconn)
  2501)       ghosted_id_dn = cur_connection_set%id_dn(iconn)
  2502) 
  2503)       if (associated(patch%imat)) then
  2504)         if (patch%imat(ghosted_id_up) <= 0 .or. &
  2505)             patch%imat(ghosted_id_dn) <= 0) cycle
  2506)       endif
  2507) 
  2508)       local_id_up = grid%nG2L(ghosted_id_up) ! = zero for ghost nodes
  2509)       local_id_dn = grid%nG2L(ghosted_id_dn) ! Ghost to local mapping   
  2510)    
  2511)       fraction_upwind = cur_connection_set%dist(-1,iconn)
  2512)       distance = cur_connection_set%dist(0,iconn)
  2513)       ! distance = scalar - magnitude of distance
  2514)       ! gravity = vector(3)
  2515)       ! dist(1:3,iconn) = vector(3) - unit vector
  2516)       distance_gravity = distance * &
  2517)                          dot_product(option%gravity, &
  2518)                                      cur_connection_set%dist(1:3,iconn))
  2519)       dd_up = distance*fraction_upwind
  2520)       dd_dn = distance-dd_up ! should avoid truncation error
  2521)       ! upweight could be calculated as 1.d0-fraction_upwind
  2522)       ! however, this introduces ever so slight error causing pflow-overhaul not
  2523)       ! to match pflow-orig.  This can be changed to 1.d0-fraction_upwind
  2524)       upweight = dd_dn/(dd_up+dd_dn)
  2525)     
  2526)       ! for now, just assume diagonal tensor
  2527)       perm_up = perm_xx_loc_p(ghosted_id_up)*abs(cur_connection_set%dist(1,iconn))+ &
  2528)         perm_yy_loc_p(ghosted_id_up)*abs(cur_connection_set%dist(2,iconn))+ &
  2529)         perm_zz_loc_p(ghosted_id_up)*abs(cur_connection_set%dist(3,iconn))
  2530) 
  2531)       perm_dn = perm_xx_loc_p(ghosted_id_dn)*abs(cur_connection_set%dist(1,iconn))+ &
  2532)         perm_yy_loc_p(ghosted_id_dn)*abs(cur_connection_set%dist(2,iconn))+ &
  2533)         perm_zz_loc_p(ghosted_id_dn)*abs(cur_connection_set%dist(3,iconn))
  2534) 
  2535)       ithrm_up = int(ithrm_loc_p(ghosted_id_up))
  2536)       ithrm_dn = int(ithrm_loc_p(ghosted_id_dn))
  2537)       D_up = Miscible_parameter%ckwet(ithrm_up)
  2538)       D_dn = Miscible_parameter%ckwet(ithrm_dn)
  2539)     
  2540)       icap_up = int(icap_loc_p(ghosted_id_up))
  2541)       icap_dn = int(icap_loc_p(ghosted_id_dn))
  2542)       
  2543)       do nvar = 1, option%nflowdof 
  2544)         call MiscibleFlux(auxvars(ghosted_id_up)%auxvar_elem(nvar),porosity_loc_p(ghosted_id_up), &
  2545)             tortuosity_loc_p(ghosted_id_up), &
  2546)             dd_up,perm_up, &
  2547)             auxvars(ghosted_id_dn)%auxvar_elem(0),porosity_loc_p(ghosted_id_dn), &
  2548)             tortuosity_loc_p(ghosted_id_dn), &
  2549)             dd_dn,perm_dn, &
  2550)             cur_connection_set%area(iconn),distance_gravity, &
  2551)             upweight, option, vv_darcy, Res)
  2552)         ra(:,nvar) = (Res(:)-patch%aux%Miscible%ResOld_FL(iconn,:)) &
  2553)               /patch%aux%Miscible%delx(nvar,ghosted_id_up)
  2554)         call MiscibleFlux(auxvars(ghosted_id_up)%auxvar_elem(0),porosity_loc_p(ghosted_id_up), &
  2555)             tortuosity_loc_p(ghosted_id_up), &
  2556)             dd_up,perm_up, &
  2557)             auxvars(ghosted_id_dn)%auxvar_elem(nvar),porosity_loc_p(ghosted_id_dn),&
  2558)             tortuosity_loc_p(ghosted_id_dn), &
  2559)             dd_dn,perm_dn, &
  2560)             cur_connection_set%area(iconn),distance_gravity, &
  2561)             upweight, option, vv_darcy, Res)
  2562)          ra(:,nvar+option%nflowdof) = (Res(:)-patch%aux%Miscible%ResOld_FL(iconn,:))&
  2563)            /patch%aux%Miscible%delx(nvar,ghosted_id_dn)
  2564)       enddo
  2565) 
  2566)       select case(option%idt_switch)
  2567)         case(1)
  2568)           ra = ra / option%flow_dt
  2569)         case(-1)  
  2570)           if (option%flow_dt > 1.d0) ra = ra / option%flow_dt
  2571)       end select
  2572)     
  2573)       if (local_id_up > 0) then
  2574)         voltemp = 1.D0
  2575)         if (volume_p(local_id_up) > 1.D0) voltemp = 1.D0/volume_p(local_id_up)
  2576)         Jup(:,1:option%nflowdof) = ra(:,1:option%nflowdof)*voltemp !11
  2577)         jdn(:,1:option%nflowdof) = ra(:,1 + option%nflowdof:2*option%nflowdof)*voltemp !12
  2578) 
  2579)         call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_up-1, &
  2580)             Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
  2581)         call MatSetValuesBlockedLocal(A,1,ghosted_id_up-1,1,ghosted_id_dn-1, &
  2582)             Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
  2583)       endif
  2584)       if (local_id_dn > 0) then
  2585)         voltemp = 1.D0
  2586)         if (volume_p(local_id_dn) > 1.D0) voltemp = 1.D0/volume_p(local_id_dn)
  2587)         Jup(:,1:option%nflowdof)= -ra(:,1:option%nflowdof)*voltemp !21
  2588)         jdn(:,1:option%nflowdof)= -ra(:,1 + option%nflowdof:2*option%nflowdof)*voltemp !22
  2589)  
  2590)         call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_dn-1, &
  2591)             Jdn,ADD_VALUES,ierr);CHKERRQ(ierr)
  2592)         call MatSetValuesBlockedLocal(A,1,ghosted_id_dn-1,1,ghosted_id_up-1, &
  2593)             Jup,ADD_VALUES,ierr);CHKERRQ(ierr)
  2594)       endif
  2595)     enddo
  2596)     cur_connection_set => cur_connection_set%next
  2597)   enddo
  2598) 
  2599)   if (realization%debug%matview_Jacobian_detailed) then
  2600)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2601)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2602)     string = 'jacobian_flux'
  2603)     call DebugCreateViewer(realization%debug,string,option,viewer)
  2604)     call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
  2605)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2606)   endif
  2607)   
  2608)   call VecRestoreArrayF90(field%flow_xx_loc, xx_loc_p, ierr);CHKERRQ(ierr)
  2609) !geh refactor  call VecRestoreArrayF90(field%porosity_loc, porosity_loc_p, ierr)
  2610) !geh refactor  call VecRestoreArrayF90(field%tortuosity_loc, tortuosity_loc_p, ierr)
  2611) !geh refactor  call VecRestoreArrayF90(field%perm_xx_loc, perm_xx_loc_p, ierr)
  2612) !geh refactor  call VecRestoreArrayF90(field%perm_yy_loc, perm_yy_loc_p, ierr)
  2613) !geh refactor  call VecRestoreArrayF90(field%perm_zz_loc, perm_zz_loc_p, ierr)
  2614) !geh refactor  call VecRestoreArrayF90(field%volume, volume_p, ierr)
  2615) 
  2616)    
  2617)   call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  2618)   call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  2619) 
  2620) end subroutine MiscibleJacobianPatch1
  2621) 
  2622) ! ************************************************************************** !
  2623) 
  2624) subroutine MiscibleJacobianPatch2(snes,xx,A,B,realization,ierr)
  2625)   ! 
  2626)   ! Computes the Jacobian: Accum, source, reaction
  2627)   ! 
  2628)   ! Author: Chuan Lu
  2629)   ! Date: 10/13/08
  2630)   ! 
  2631) 
  2632)   use Connection_module
  2633)   use Option_module
  2634)   use Grid_module
  2635)   use Realization_Subsurface_class
  2636)   use Patch_module
  2637)   use Coupler_module
  2638)   use Field_module
  2639)   use Debug_module
  2640)   
  2641)   implicit none
  2642) 
  2643)   SNES :: snes
  2644)   Vec :: xx
  2645)   Mat :: A, B
  2646)   type(realization_subsurface_type) :: realization
  2647) 
  2648)   PetscErrorCode :: ierr
  2649)   PetscInt :: nvar,neq,nr
  2650)   PetscInt :: ithrm_up, ithrm_dn, i
  2651)   PetscInt :: ip1, ip2 
  2652) 
  2653)   PetscReal, pointer :: porosity_loc_p(:), volume_p(:), &
  2654)                           xx_loc_p(:), tortuosity_loc_p(:),&
  2655)                           perm_xx_loc_p(:), perm_yy_loc_p(:), perm_zz_loc_p(:)
  2656)   PetscReal, pointer :: iphase_loc_p(:), icap_loc_p(:), ithrm_loc_p(:)
  2657)   PetscInt :: icap,iphas,iphas_up,iphas_dn,icap_up,icap_dn
  2658)   PetscInt :: ii, jj
  2659)   PetscReal :: dw_kg,dw_mol,enth_src_co2,enth_src_h2o,rho
  2660)   PetscReal :: tsrc1,qsrc1,csrc1,hsrc1
  2661)   PetscReal :: dd_up, dd_dn, dd, f_up, f_dn
  2662)   PetscReal :: perm_up, perm_dn
  2663)   PetscReal :: dw_dp,dw_dt,hw_dp,hw_dt,dresT_dp,dresT_dt
  2664)   PetscReal :: D_up, D_dn  ! "Diffusion" constants upstream and downstream of a face.
  2665)   PetscReal :: zero, norm
  2666)   PetscReal :: upweight
  2667)   PetscReal :: max_dev  
  2668)   PetscInt :: local_id, ghosted_id
  2669)   PetscInt :: local_id_up, local_id_dn
  2670)   PetscInt :: ghosted_id_up, ghosted_id_dn
  2671)   PetscInt ::  natural_id_up,natural_id_dn
  2672)   
  2673)   PetscReal :: Jup(1:realization%option%nflowdof,1:realization%option%nflowdof), &
  2674)             Jdn(1:realization%option%nflowdof,1:realization%option%nflowdof)
  2675)   
  2676)   PetscInt :: istart, iend
  2677)   
  2678)   type(coupler_type), pointer :: boundary_condition, source_sink
  2679)   type(connection_set_list_type), pointer :: connection_set_list
  2680)   type(connection_set_type), pointer :: cur_connection_set
  2681)   PetscBool :: enthalpy_flag
  2682)   PetscInt :: iconn, idof
  2683)   PetscInt :: sum_connection  
  2684)   PetscReal :: distance, fraction_upwind
  2685)   PetscReal :: distance_gravity
  2686)   PetscReal :: Res(realization%option%nflowdof) 
  2687)   PetscReal :: xxbc(1:realization%option%nflowdof), delxbc(1:realization%option%nflowdof)
  2688)   PetscReal :: ResInc(realization%patch%grid%nlmax,realization%option%nflowdof,&
  2689)            realization%option%nflowdof)
  2690)   type(grid_type), pointer :: grid
  2691)   type(patch_type), pointer :: patch
  2692)   type(option_type), pointer :: option 
  2693)   type(field_type), pointer :: field 
  2694)   type(Miscible_parameter_type), pointer :: Miscible_parameter
  2695)   type(Miscible_auxvar_type), pointer :: auxvars(:), auxvars_bc(:)
  2696)   type(global_auxvar_type), pointer :: global_auxvars(:), global_auxvars_bc(:)
  2697) 
  2698)   PetscReal :: vv_darcy(realization%option%nphase), voltemp
  2699)   PetscReal :: ra(1:realization%option%nflowdof,1:realization%option%nflowdof*2) 
  2700)   PetscReal, pointer :: msrc(:)
  2701)   PetscReal :: psrc(1:realization%option%nphase)
  2702)   PetscReal :: dddt, dddp, fg, dfgdp, dfgdt, eng, dhdt, dhdp, visc, dvdt,&
  2703)                dvdp, xphi
  2704)   PetscReal :: dummy_real(realization%option%nphase)
  2705)   PetscInt :: nsrcpara, flow_pc                
  2706)   
  2707)   PetscViewer :: viewer
  2708)   Vec :: debug_vec
  2709)   character(len=MAXSTRINGLENGTH) :: string
  2710) 
  2711) !-----------------------------------------------------------------------
  2712) ! R stand for residual
  2713) !  ra       1              2              3              4          5              6            7      8
  2714) ! 1: p     dR/dpi         dR/dTi          dR/dci        dR/dsi   dR/dpim        dR/dTim
  2715) ! 2: T
  2716) ! 3: c
  2717) ! 4  s         
  2718) !-----------------------------------------------------------------------
  2719) 
  2720)   patch => realization%patch
  2721)   grid => patch%grid
  2722)   option => realization%option
  2723)   field => realization%field
  2724) 
  2725)   Miscible_parameter => patch%aux%Miscible%Miscible_parameter
  2726)   auxvars => patch%aux%Miscible%auxvars
  2727)   auxvars_bc => patch%aux%Miscible%auxvars_bc
  2728)   global_auxvars => patch%aux%Global%auxvars
  2729)   global_auxvars_bc => patch%aux%Global%auxvars_bc
  2730) 
  2731) ! dropped derivatives:
  2732) !   1.D0 gas phase viscocity to all p,t,c,s
  2733) !   2. Average molecular weights to p,t,s
  2734) !  flag = SAME_NONZERO_PATTERN
  2735) 
  2736) #if 0
  2737) !  call MiscibleNumericalJacobianTest(xx,realization)
  2738) #endif
  2739) 
  2740)  ! print *,'*********** In Jacobian ********************** '
  2741) !  call MatZeroEntries(A,ierr)
  2742) 
  2743) !geh refactor  call VecGetArrayF90(field%porosity_loc, porosity_loc_p, ierr)
  2744) !geh refactor  call VecGetArrayF90(field%volume, volume_p, ierr)
  2745)   call VecGetArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  2746)   call VecGetArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  2747) ! call VecGetArrayF90(field%iphas_loc, iphase_loc_p, ierr)
  2748) 
  2749)   ResInc = 0.D0
  2750) #if 1
  2751)   ! Accumulation terms ------------------------------------
  2752)   do local_id = 1, grid%nlmax  ! For each local node do...
  2753)     ghosted_id = grid%nL2G(local_id)
  2754)     !geh - Ignore inactive cells with inactive materials
  2755)     if (associated(patch%imat)) then
  2756)       if (patch%imat(ghosted_id) <= 0) cycle
  2757)     endif
  2758)     iend = local_id*option%nflowdof
  2759)     istart = iend-option%nflowdof+1
  2760)     icap = int(icap_loc_p(ghosted_id))
  2761)      
  2762)     do nvar =1, option%nflowdof
  2763)       call MiscibleAccumulation(auxvars(ghosted_id)%auxvar_elem(nvar), &
  2764)              global_auxvars(ghosted_id),& 
  2765)              porosity_loc_p(ghosted_id), &
  2766)              volume_p(local_id), &
  2767)              Miscible_parameter%dencpr(int(ithrm_loc_p(ghosted_id))), &
  2768)              option,res) 
  2769)       ResInc( local_id,:,nvar) =  ResInc(local_id,:,nvar) + Res(:)
  2770)     enddo
  2771)   enddo
  2772) #endif
  2773) #if 1
  2774)   ! Source/sink terms -------------------------------------
  2775)   source_sink => patch%source_sink_list%first
  2776)   sum_connection = 0 
  2777)   do 
  2778)     if (.not.associated(source_sink)) exit
  2779)     
  2780)     ! check whether enthalpy dof is included
  2781)   !  if (source_sink%flow_condition%num_sub_conditions > 3) then
  2782)       enthalpy_flag = PETSC_TRUE
  2783)    ! else
  2784)    !   enthalpy_flag = PETSC_FALSE
  2785)    ! endif
  2786) 
  2787)     if (associated(source_sink%flow_condition%pressure)) then
  2788)       psrc(:) = source_sink%flow_condition%pressure%dataset%rarray(:)
  2789)     endif
  2790)     tsrc1 = source_sink%flow_condition%temperature%dataset%rarray(1)
  2791)     csrc1 = source_sink%flow_condition%concentration%dataset%rarray(1)
  2792)  !   hsrc1=0.D0
  2793)     if (enthalpy_flag) hsrc1 = source_sink%flow_condition%enthalpy%dataset%rarray(1)
  2794) 
  2795)    ! qsrc1 = qsrc1 / FMWH2O ! [kg/s -> kmol/s; fmw -> g/mol = kg/kmol]
  2796)    ! csrc1 = csrc1 / FMWCO2
  2797)     select case(source_sink%flow_condition%itype(1))
  2798)       case(MASS_RATE_SS)
  2799)         msrc => source_sink%flow_condition%rate%dataset%rarray
  2800)         nsrcpara= 2
  2801)       case(WELL_SS)
  2802)         msrc => source_sink%flow_condition%well%dataset%rarray
  2803)         nsrcpara = 7 + option%nflowspec 
  2804)       case default
  2805)         print *, 'Flash mode does not support source/sink type: ', source_sink%flow_condition%itype(1)
  2806)         stop  
  2807)     end select
  2808)     cur_connection_set => source_sink%connection_set
  2809)  
  2810)     do iconn = 1, cur_connection_set%num_connections      
  2811)       local_id = cur_connection_set%id_dn(iconn)
  2812)       ghosted_id = grid%nL2G(local_id)
  2813) 
  2814)       if (associated(patch%imat)) then
  2815)         if (patch%imat(ghosted_id) <= 0) cycle
  2816)       endif
  2817) !     if (enthalpy_flag) then
  2818) !       r_p(local_id*option%nflowdof) = r_p(local_id*option%nflowdof) - hsrc1 * option%flow_dt   
  2819) !     endif         
  2820)       do nvar =1, option%nflowdof
  2821)         call MiscibleSourceSink(msrc,nsrcpara,psrc,tsrc1,hsrc1,csrc1, &
  2822)                                 auxvars(ghosted_id)%auxvar_elem(nvar),&
  2823)                                 source_sink%flow_condition%itype(1), Res,&
  2824)                                 dummy_real, &
  2825)                                 enthalpy_flag, option)
  2826) 
  2827)         ResInc(local_id,jh2o,nvar)=  ResInc(local_id,jh2o,nvar) - Res(jh2o)
  2828)         ResInc(local_id,jglyc,nvar)=  ResInc(local_id,jglyc,nvar) - Res(jglyc)
  2829)         if (enthalpy_flag) & 
  2830)           ResInc(local_id,option%nflowdof,nvar) = &
  2831)           ResInc(local_id,option%nflowdof,nvar) - Res(option%nflowdof)
  2832)       enddo 
  2833)     enddo
  2834)     source_sink => source_sink%next
  2835)   enddo
  2836) #endif
  2837) 
  2838) ! Set matrix values related to single node terms: Accumulation, Source/Sink, BC
  2839)   do local_id = 1, grid%nlmax  ! For each local node do...
  2840)     ghosted_id = grid%nL2G(local_id)
  2841)     !geh - Ignore inactive cells with inactive materials
  2842)     if (associated(patch%imat)) then
  2843)       if (patch%imat(ghosted_id) <= 0) cycle
  2844)     endif
  2845) 
  2846)     ra=0.D0
  2847)     max_dev=0.D0
  2848)     do neq=1, option%nflowdof
  2849)       do nvar=1, option%nflowdof
  2850)         ra(neq,nvar)=(ResInc(local_id,neq,nvar)-patch%aux%Miscible%ResOld_AR(local_id,neq))&
  2851)         /patch%aux%Miscible%delx(nvar,ghosted_id)
  2852)       enddo
  2853)     enddo
  2854)    
  2855)     select case(option%idt_switch)
  2856)       case(1) 
  2857)         ra(1:option%nflowdof,1:option%nflowdof) = &
  2858)           ra(1:option%nflowdof,1:option%nflowdof) / option%flow_dt
  2859)       case(-1)
  2860)         if (option%flow_dt > 1.d0) ra(1:option%nflowdof,1:option%nflowdof) = &
  2861)           ra(1:option%nflowdof,1:option%nflowdof) / option%flow_dt
  2862)     end select
  2863) 
  2864)     Jup = ra(1:option%nflowdof,1:option%nflowdof)
  2865)     if (volume_p(local_id) > 1.D0) Jup = Jup / volume_p(local_id)
  2866) !   Jup = Jup / volume_p(local_id)
  2867)     call MatSetValuesBlockedLocal(A,1,ghosted_id-1,1,ghosted_id-1,Jup,ADD_VALUES, &
  2868)                                   ierr);CHKERRQ(ierr)
  2869)   end do
  2870) 
  2871)   if (realization%debug%matview_Jacobian_detailed) then
  2872)     call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2873)     call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2874)     string = 'jacobian_srcsink'
  2875)     call DebugCreateViewer(realization%debug,string,option,viewer)
  2876)     call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
  2877)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2878)   endif
  2879)   
  2880) !geh refactor  call VecRestoreArrayF90(field%porosity_loc, porosity_loc_p, ierr)
  2881) !geh refactor  call VecRestoreArrayF90(field%volume, volume_p, ierr)
  2882)   call VecRestoreArrayF90(field%ithrm_loc, ithrm_loc_p, ierr);CHKERRQ(ierr)
  2883)   call VecRestoreArrayF90(field%icap_loc, icap_loc_p, ierr);CHKERRQ(ierr)
  2884) ! call VecRestoreArrayF90(field%iphas_loc, iphase_loc_p, ierr)
  2885) 
  2886)   call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2887)   call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2888)  ! call MatView(A,PETSC_VIEWER_STDOUT_WORLD,ierr)
  2889) #if 0
  2890) ! zero out isothermal and inactive cells
  2891) #ifdef ISOTHERMAL
  2892)   zero = 0.d0
  2893)   call MatZeroRowsLocal(A,n_zero_rows,zero_rows_local_ghosted,zero, &
  2894)                         PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
  2895)                         ierr);CHKERRQ(ierr)
  2896)   do i=1, n_zero_rows
  2897)     ii = mod(zero_rows_local(i),option%nflowdof)
  2898)     ip1 = zero_rows_local_ghosted(i)
  2899)     if (ii == 0) then
  2900)       ip2 = ip1-1
  2901)     elseif (ii == option%nflowdof-1) then
  2902)       ip2 = ip1+1
  2903)     else
  2904)       ip2 = ip1
  2905)     endif
  2906)     call MatSetValuesLocal(A,1,ip1,1,ip2,1.d0,INSERT_VALUES, &
  2907)                            ierr);CHKERRQ(ierr)
  2908)   enddo
  2909) 
  2910)   call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2911)   call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
  2912) #else
  2913) #endif
  2914) #endif
  2915) 
  2916)   if (patch%aux%Miscible%inactive_cells_exist) then
  2917)     f_up = 1.d0
  2918)     call MatZeroRowsLocal(A,patch%aux%Miscible%n_zero_rows, &
  2919)                           patch%aux%Miscible%zero_rows_local_ghosted,f_up, &
  2920)                           PETSC_NULL_OBJECT,PETSC_NULL_OBJECT, &
  2921)                           ierr);CHKERRQ(ierr)
  2922)   endif
  2923) 
  2924)   if (realization%debug%matview_Jacobian) then
  2925)     string = 'MISjacobian'
  2926)     call DebugCreateViewer(realization%debug,string,option,viewer)
  2927)     call MatView(A,viewer,ierr);CHKERRQ(ierr)
  2928)     call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
  2929)   endif
  2930)   if (realization%debug%norm_Jacobian) then
  2931)     call MatNorm(A,NORM_1,norm,ierr);CHKERRQ(ierr)
  2932)     write(option%io_buffer,'("1 norm: ",es11.4)') norm
  2933)     call printMsg(option)
  2934)     call MatNorm(A,NORM_FROBENIUS,norm,ierr);CHKERRQ(ierr)
  2935)     write(option%io_buffer,'("2 norm: ",es11.4)') norm
  2936)     call printMsg(option)
  2937)     call MatNorm(A,NORM_INFINITY,norm,ierr);CHKERRQ(ierr)
  2938)     write(option%io_buffer,'("inf norm: ",es11.4)') norm
  2939)     call printMsg(option)
  2940) !    call GridCreateVector(grid,ONEDOF,debug_vec,GLOBAL)
  2941) !    call MatGetRowMaxAbs(A,debug_vec,PETSC_NULL_INTEGER,ierr)
  2942) !    call VecMax(debug_vec,i,norm,ierr)
  2943) !    call VecDestroy(debug_vec,ierr)
  2944)   endif
  2945) 
  2946) end subroutine MiscibleJacobianPatch2
  2947) 
  2948) ! ************************************************************************** !
  2949) 
  2950) subroutine MiscibleMaxChange(realization,dpmax,dcmax)
  2951)   ! 
  2952)   ! Computes the maximum change in the solution vector
  2953)   ! 
  2954)   ! Author: Chuan Lu
  2955)   ! Date: 01/15/08
  2956)   ! 
  2957) 
  2958)   use Realization_Subsurface_class
  2959)   use Field_module
  2960)   use Option_module
  2961)   use Field_module
  2962) 
  2963)   implicit none
  2964)   
  2965)   type(realization_subsurface_type) :: realization
  2966) 
  2967)   type(option_type), pointer :: option
  2968)   type(field_type), pointer :: field
  2969)   PetscReal :: dpmax, dcmax
  2970)   PetscReal :: temp
  2971)   PetscInt :: idof
  2972)   PetscErrorCode :: ierr 
  2973) 
  2974)   option => realization%option
  2975)   field => realization%field
  2976) 
  2977)   dpmax = 0.d0
  2978)   dcmax = 0.d0
  2979) 
  2980)   call VecWAXPY(field%flow_dxx,-1.d0,field%flow_xx,field%flow_yy, &
  2981)                 ierr);CHKERRQ(ierr)
  2982)   call VecStrideNorm(field%flow_dxx,ZERO_INTEGER,NORM_INFINITY,dpmax, &
  2983)                      ierr);CHKERRQ(ierr)
  2984) 
  2985)   do idof = 1,option%nflowdof-1 
  2986)     call VecStrideNorm(field%flow_dxx,idof,NORM_INFINITY,temp, &
  2987)                        ierr);CHKERRQ(ierr)
  2988)     dcmax = max(dcmax,temp)
  2989)   enddo
  2990)   
  2991) end subroutine MiscibleMaxChange
  2992) 
  2993) ! ************************************************************************** !
  2994) 
  2995) function MiscibleGetTecplotHeader(realization, icolumn)
  2996)   ! 
  2997)   ! Returns Richards contribution to
  2998)   ! Tecplot file header
  2999)   ! 
  3000)   ! Author: Chuan Lu
  3001)   ! Date: 10/13/08
  3002)   ! 
  3003) 
  3004)   use Realization_Subsurface_class
  3005)   use Option_module
  3006)   use Field_module
  3007) 
  3008)   implicit none
  3009)   
  3010)   character(len=MAXSTRINGLENGTH) :: MiscibleGetTecplotHeader
  3011)   type(realization_subsurface_type) :: realization
  3012)   PetscInt :: icolumn
  3013)   
  3014)   character(len=MAXSTRINGLENGTH) :: string, string2
  3015)   type(option_type), pointer :: option
  3016)   type(field_type), pointer :: field  
  3017)   PetscInt :: i
  3018)   
  3019)   option => realization%option
  3020)   field => realization%field
  3021)   
  3022)   string = ''
  3023) 
  3024)   if (icolumn > -1) then
  3025)     icolumn = icolumn + 1
  3026)     write(string2,'('',"'',i2,''-P [Pa]"'')') icolumn
  3027)   else
  3028)     write(string2,'('',"P [Pa]"'')')
  3029)   endif
  3030)   string = trim(string) // trim(string2)
  3031) 
  3032)   if (icolumn > -1) then
  3033)     icolumn = icolumn + 1
  3034)     write(string2,'('',"'',i2,''-d(l)"'')') icolumn
  3035)   else
  3036)     write(string2,'('',"d(l)"'')')
  3037)   endif
  3038)   string = trim(string) // trim(string2)
  3039) 
  3040)     
  3041)   if (icolumn > -1) then
  3042)     icolumn = icolumn + 1
  3043)     write(string2,'('',"'',i2,''-vis(l)"'')') icolumn
  3044)   else
  3045)     write(string2,'('',"vis(l)"'')')
  3046)   endif
  3047)   string = trim(string) // trim(string2)
  3048) 
  3049)   do i=1,option%nflowspec
  3050)     if (icolumn > -1) then
  3051)       icolumn = icolumn + 1
  3052)       write(string2,'('',"'',i2,''-Xl('',i2,'')"'')') icolumn, i
  3053)     else
  3054)       write(string2,'('',"Xl('',i2,'')"'')') i
  3055)     endif
  3056)     string = trim(string) // trim(string2)
  3057)   enddo
  3058) 
  3059) 
  3060)   MiscibleGetTecplotHeader = string
  3061) 
  3062) end function MiscibleGetTecplotHeader
  3063) 
  3064) ! ************************************************************************** !
  3065) 
  3066) subroutine MiscibleSetPlotVariables(list)
  3067)   ! 
  3068)   ! Adds variables to be printed to list
  3069)   ! 
  3070)   ! Author: Glenn Hammond
  3071)   ! Date: 10/15/12
  3072)   ! 
  3073)   
  3074)   use Output_Aux_module
  3075)   use Variables_module
  3076) 
  3077)   implicit none
  3078) 
  3079)   type(output_variable_list_type), pointer :: list
  3080)   character(len=MAXWORDLENGTH) :: name, units
  3081)   
  3082)   if (associated(list%first)) then
  3083)     return
  3084)   endif
  3085) 
  3086)   name = 'Temperature'
  3087)   units = 'C'
  3088)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  3089)                                TEMPERATURE)
  3090)   
  3091)   name = 'Liquid Pressure'
  3092)   units = 'Pa'
  3093)   call OutputVariableAddToList(list,name,OUTPUT_PRESSURE,units, &
  3094)                                LIQUID_PRESSURE)
  3095) 
  3096)   name = 'Liquid Density'
  3097)   units = ''
  3098)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  3099)                                LIQUID_DENSITY)
  3100) 
  3101)   name = 'Liquid Viscosity'
  3102)   units = ''
  3103)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  3104)                                LIQUID_VISCOSITY)
  3105) 
  3106)   name = 'Liquid Mole Fraction H2O'
  3107)   units = ''
  3108)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  3109)                                LIQUID_MOLE_FRACTION,ONE_INTEGER)
  3110) 
  3111)   name = 'Liquid Mole Fraction CO2'
  3112)   units = ''
  3113)   call OutputVariableAddToList(list,name,OUTPUT_GENERIC,units, &
  3114)                                LIQUID_MOLE_FRACTION,TWO_INTEGER)
  3115) 
  3116) end subroutine MiscibleSetPlotVariables
  3117) 
  3118) ! ************************************************************************** !
  3119) 
  3120) subroutine MiscibleDestroy(realization)
  3121)   ! 
  3122)   ! MphaseDestroy: Deallocates variables associated with Miscible
  3123)   ! 
  3124)   ! Author: Gautam Bisht
  3125)   ! Date: 11/27/13
  3126)   ! 
  3127) 
  3128)   use Realization_Subsurface_class
  3129) 
  3130)   implicit none
  3131)   
  3132)   type(realization_subsurface_type) :: realization
  3133)   
  3134)   ! need to free array in aux vars
  3135)   !call MiscibleAuxDestroy(patch%aux%miscible)
  3136) 
  3137) end subroutine MiscibleDestroy
  3138) 
  3139) end module Miscible_module

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